From 62f264ddf1befcbf39f72af22c125b528a635ff3 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 14 Apr 2023 19:43:00 -0600 Subject: [PATCH 001/319] Remove buoyancy flag --- .../user/aerodyn-aeroacoustics/App-usage.rst | 2 +- .../aerodyn-aeroacoustics/example/AD15.ipt | 1 - .../aerodyn/examples/ad_primary_example.dat | 11 +++--- modules/aerodyn/src/AeroDyn.f90 | 34 +++++++++---------- .../aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 | 2 +- modules/aerodyn/src/AeroDyn_IO.f90 | 30 +++++----------- modules/aerodyn/src/AeroDyn_Registry.txt | 2 -- modules/aerodyn/src/AeroDyn_Types.f90 | 14 -------- 8 files changed, 32 insertions(+), 64 deletions(-) diff --git a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst index d442d13001..63e362ccab 100644 --- a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst +++ b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst @@ -5,7 +5,7 @@ Using the Aeroacoustics Model in AeroDyn A live version of this documentation is available at https://openfast.readthedocs.io/. To run the aeroacoustics model, the -flag **CompAA** needs to be set to **True** at line 14 of the AeroDyn15 main +flag **CompAA** needs to be set to **True** at line 13 of the AeroDyn15 main input file in the inputs block **General Options**. When the flag is set to **True**, the following line must include the name of the file containing the inputs to the aeroacoustics model, which is discussed in diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt b/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt index 57c3752e01..e2de2282d5 100644 --- a/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt +++ b/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt @@ -10,7 +10,6 @@ False Echo - Echo the input to ".AD.ech"? (flag) False TwrAero - Calculate tower aerodynamic loads? (flag) False FrozenWake - Assume frozen wake during linearization? (flag False CavitCheck - Perform cavitation check? (flag) -False Buoyancy - Include buoyancy effects? (flag) True CompAA - Flag to compute AeroAcoustics calculation "AeroAcousticsInput.dat" AA_InputFile ====== Environmental Conditions ========================================== diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.dat b/docs/source/user/aerodyn/examples/ad_primary_example.dat index da090b58bd..df3559981c 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.dat +++ b/docs/source/user/aerodyn/examples/ad_primary_example.dat @@ -10,7 +10,6 @@ True Echo - Echo the input to ".AD.ech"? (flag False TwrAero - Calculate tower aerodynamic loads? (flag) False FrozenWake - Assume frozen wake during linearization? (flag) [used only when WakeMod=1 and when linearizing] False CavitCheck - Perform cavitation check? (flag) [AFAeroMod must be 1 when CavitCheck=true] -False Buoyancy - Include buoyancy effects? (flag) False CompAA - Flag to compute AeroAcoustics calculation [only used when WakeMod=1 or 2] "unused" AA_InputFile - Aeroacoustics input file ====== Environmental Conditions =================================================================== @@ -62,15 +61,15 @@ True UseBlCm - Include aerodynamic pitching moment in calcul "Test01_UAE_AeroDyn_blade.dat" ADBlFile(1) - Name of file containing distributed aerodynamic properties for Blade #1 (-) "Test01_UAE_AeroDyn_blade.dat" ADBlFile(2) - Name of file containing distributed aerodynamic properties for Blade #2 (-) [unused if NumBl < 2] "Test01_UAE_AeroDyn_blade.dat" ADBlFile(3) - Name of file containing distributed aerodynamic properties for Blade #3 (-) [unused if NumBl < 3] -====== Hub Properties ============================================================================== [used only when Buoyancy=True] +====== Hub Properties ============================================================================== [used only when MHK=1 or 2] 0.0 VolHub - Hub volume (m^3) 0.0 HubCenBx - Hub center of buoyancy x direction offset (m) -====== Nacelle Properties ========================================================================== [used only when Buoyancy=True] +====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2] 0.0 VolNac - Nacelle volume (m^3) 0.0, 0.0, 0.0 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) -====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] - 5 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] -TwrElev TwrDiam TwrCd TwrTI (used only with TwrShadow=2) TwrCb (used only with Buoyancy=True) +====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] + 5 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] +TwrElev TwrDiam TwrCd TwrTI (used only with TwrShadow=2) TwrCb (used only with MHK=1 or 2) (m) (m) (-) (-) (-) 0.0000000E+00 6.0000000E+00 0.0000000E+00 1.0000000E-01 0.0 2.0000000E+01 5.5000000E+00 0.0000000E+00 1.0000000E-01 0.0 diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index b4425d424f..e81ac8e844 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -385,7 +385,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Calculate buoyancy parameters !............................................................................................ do iR = 1, nRotors - if ( p%rotors(iR)%Buoyancy ) then + if ( p%rotors(iR)%MHK > 0 ) then call SetBuoyancyParameters( InputFileData%rotors(iR), u%rotors(iR), p%rotors(iR), ErrStat2, ErrMsg2 ) if (Failed()) return; end if @@ -703,7 +703,7 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) if (ErrStat >= AbortErrLev) RETURN - if (p%Buoyancy) then + if (p%MHK > 0) then ! Point mesh for blade buoyant loads allocate(m%BladeBuoyLoadPoint(p%NumBlades), Stat = ErrStat2) if (ErrStat2 /= 0) then @@ -911,7 +911,7 @@ subroutine Init_y(y, u, p, errStat, errMsg) errMsg = "" - if (p%TwrAero .or. p%Buoyancy .and. p%NumTwrNds > 0) then + if (p%TwrAero .or. p%MHK > 0 .and. p%NumTwrNds > 0) then call MeshCopy ( SrcMesh = u%TowerMotion & , DestMesh = y%TowerLoad & @@ -1270,7 +1270,6 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p%TwrShadow = InputFileData%TwrShadow p%TwrAero = InputFileData%TwrAero p%CavitCheck = InputFileData%CavitCheck - p%Buoyancy = InputFileData%Buoyancy if (InitInp%Linearize .and. InputFileData%WakeMod == WakeMod_BEMT) then @@ -1289,17 +1288,17 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p%NumBlNds = 0 endif - if (p%NumBlades>0 .and. p%Buoyancy) then + if (p%NumBlades>0 .and. p%MHK > 0) then call AllocAry( p%BlCenBn, p%NumBlNds, p%NumBlades, 'BlCenBn', ErrStat2, ErrMsg2 ) call AllocAry( p%BlCenBt, p%NumBlNds, p%NumBlades, 'BlCenBt', ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) endif - if (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. .not. p%Buoyancy ) then + if (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. p%MHK == 0 ) then p%NumTwrNds = 0 - elseif (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. p%Buoyancy .and. RotData%NumTwrNds <= 0 ) then + elseif (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. p%MHK > 0 .and. RotData%NumTwrNds <= 0 ) then p%NumTwrNds = 0 - elseif (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. p%Buoyancy .and. RotData%NumTwrNds > 0 ) then + elseif (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. p%MHK > 0 .and. RotData%NumTwrNds > 0 ) then p%NumTwrNds = RotData%NumTwrNds call move_alloc( RotData%TwrDiam, p%TwrDiam ) @@ -1315,7 +1314,7 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err call move_alloc( RotData%TwrCb, p%TwrCb ) end if - if (p%Buoyancy) then + if (p%MHK > 0) then do k = 1,p%NumBlades p%BlCenBn(:,k) = RotData%BladeProps(k)%BlCenBn p%BlCenBt(:,k) = RotData%BladeProps(k)%BlCenBt @@ -1707,7 +1706,7 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! Calculate buoyant loads do iR = 1,size(p%rotors) - if ( p%rotors(iR)%Buoyancy ) then + if ( p%rotors(iR)%MHK > 0 ) then call CalcBuoyantLoads( u%rotors(iR), p%rotors(iR), m%rotors(iR), y%rotors(iR), ErrStat, ErrMsg ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -3485,7 +3484,6 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) endif if (InitInp%MHK == 0 .and. InputFileData%CavitCheck) call SetErrStat ( ErrID_Fatal, 'A cavitation check can only be performed for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) - if (InitInp%MHK == 0 .and. InputFileData%Buoyancy) call SetErrStat ( ErrID_Fatal, 'Buoyancy can only be calculated for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) if (InitInp%MHK == 1 .and. InputFileData%CompAA .or. InitInp%MHK == 2 .and. InputFileData%CompAA) call SetErrStat ( ErrID_Fatal, 'The aeroacoustics module cannot be used with an MHK turbine.', ErrStat, ErrMsg, RoutineName ) do iR = 1,size(NumBl) if (InitInp%MHK == 1 .and. InputFileData%rotors(iR)%TFinAero .or. InitInp%MHK == 2 .and. InputFileData%rotors(iR)%TFinAero) call SetErrStat ( ErrID_Fatal, 'A tail fin cannot be modeled for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) @@ -3566,8 +3564,8 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end do ! j=nodes end do ! k=blades - ! If the Buoyancy flag is True, check that the blade buoyancy coefficients are >= 0. - if ( InputFileData%Buoyancy ) then + ! If the MHK flag is set to 1 or 2, check that the blade buoyancy coefficients are >= 0. + if ( InitInp%MHK > 0 ) then do k=1,NumBl(iR) do j=1,InputFileData%rotors(iR)%BladeProps(k)%NumBlNds if ( InputFileData%rotors(iR)%BladeProps(k)%BlCb(j) < 0.0_ReKi ) then @@ -3583,7 +3581,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! check tower mesh data: ! ............................. do iR = 1,size(NumBl) - if (InputFileData%TwrPotent /= TwrPotent_none .or. InputFileData%TwrShadow /= TwrShadow_none .or. InputFileData%TwrAero .or. InputFileData%Buoyancy .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then + if (InputFileData%TwrPotent /= TwrPotent_none .or. InputFileData%TwrShadow /= TwrShadow_none .or. InputFileData%TwrAero .or. InitInp%MHK > 0 .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then if (InputFileData%rotors(iR)%NumTwrNds < 2) call SetErrStat( ErrID_Fatal, 'There must be at least two nodes on the tower.',ErrStat, ErrMsg, RoutineName ) ! Check that the tower diameter is > 0. @@ -3609,8 +3607,8 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end if end do ! j=nodes - ! If the Buoyancy flag is True, check that the tower buoyancy coefficients are >= 0. - if ( InputFileData%Buoyancy .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then + ! If the MHK flag is set to 1 or 2, check that the tower buoyancy coefficients are >= 0. + if ( InitInp%MHK > 0 .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then do j=1,InputFileData%rotors(iR)%NumTwrNds if ( InputFileData%rotors(iR)%TwrCb(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The buoyancy coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) @@ -3626,7 +3624,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! ............................. ! check hub mesh data: ! ............................. - if ( InputFileData%Buoyancy ) then + if ( InitInp%MHK > 0 ) then ! Check that the hub volume is >= 0. do iR = 1,size(NumBl) @@ -3640,7 +3638,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! ............................. ! check nacelle mesh data: ! ............................. - if ( InputFileData%Buoyancy ) then + if ( InitInp%MHK > 0 ) then ! Check that the nacelle volume is >= 0. do iR = 1,size(NumBl) diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index 72a199cce9..abf1b39e4a 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -1437,7 +1437,7 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) ! ..... Developer must add checking for invalid inputs here: ..... - if (.not. p%Buoyancy) then + if ( p%MHK == 0 ) then InvalidOutput( BldNd_Fbn ) = .true. InvalidOutput( BldNd_Fbt ) = .true. InvalidOutput( BldNd_Fbs ) = .true. diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index f509f4ee43..ad4a95d091 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -175,7 +175,7 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( TwNFdx( beta) ) = m%X_Twr(j) m%AllOuts( TwNFdy( beta) ) = m%Y_Twr(j) - if ( p%Buoyancy ) then + if ( p%MHK > 0 ) then tmp = matmul( u%TowerMotion%Orientation(:,:,j) , m%TwrBuoyLoad%Force(:,j) ) m%AllOuts( TwNFbx(beta) ) = tmp(1) m%AllOuts( TwNFby(beta) ) = tmp(2) @@ -190,7 +190,7 @@ subroutine Calc_WriteOutput_AD() end do ! out nodes ! hub outputs - if ( p%Buoyancy ) then + if ( p%MHK > 0 ) then tmpHubFB = matmul( u%HubMotion%Orientation(:,:,1) , m%HubFB ) m%AllOuts( HbFbx ) = tmpHubFB(1) m%AllOuts( HbFby ) = tmpHubFB(2) @@ -203,7 +203,7 @@ subroutine Calc_WriteOutput_AD() end if ! nacelle outputs - if ( p%Buoyancy ) then + if ( p%MHK > 0 ) then tmp = matmul( u%NacelleMotion%Orientation(:,:,1) , m%NacFB ) m%AllOuts( NcFbx ) = tmp(1) m%AllOuts( NcFby ) = tmp(2) @@ -240,7 +240,7 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( BNSigCr( beta,k) ) = m%SigmaCavitCrit(j,k) m%AllOuts( BNSgCav( beta,k) ) = m%SigmaCavit(j,k) - if ( p%Buoyancy ) then + if ( p%MHK > 0 ) then tmp = matmul( u%BladeMotion(k)%Orientation(:,:,j), m%BladeBuoyLoad(k)%Force(:,j) ) m%AllOuts( BNFbn(beta,k) ) = tmp(1) m%AllOuts( BNFbt(beta,k) ) = tmp(2) @@ -700,9 +700,6 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade if (Failed()) return ! CavitCheck - Perform cavitation check? (flag) [AFAeroMod must be 1 when CavitCheck=true] call ParseVar( FileInfo_In, CurLine, "CavitCheck", InputFileData%CavitCheck, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return - ! Buoyancy - Include buoyancy effects? (flag) - call ParseVar( FileInfo_In, CurLine, "Buoyancy", InputFileData%Buoyancy, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return ! CompAA - Flag to compute AeroAcoustics calculation [only used when WakeMod=1 or 2] call ParseVar( FileInfo_In, CurLine, "CompAA", InputFileData%CompAA, ErrStat2, ErrMsg2, UnEc ) @@ -853,7 +850,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade IF ( PathIsRelative( InputFileData%ADBlFile(I) ) ) InputFileData%ADBlFile(I) = TRIM(PriPath)//TRIM(InputFileData%ADBlFile(I)) enddo - !====== Hub Properties ============================================================================== [used only when Buoyancy=True] + !====== Hub Properties ============================================================================== [used only when MHK=1 or 2] do iR = 1,size(NumBlades) ! Loop on rotors if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 @@ -865,7 +862,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade if (Failed()) return end do - !====== Nacelle Properties ========================================================================== [used only when Buoyancy=True] + !====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2] do iR = 1,size(NumBlades) ! Loop on rotors if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 @@ -892,11 +889,11 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade endif enddo - !====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] + !====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] do iR = 1,size(NumBlades) ! Loop on rotors if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 - ! NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] + ! NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] call ParseVar( FileInfo_In, CurLine, "NumTwrNds", InputFileData%rotors(iR)%NumTwrNds, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return !TwrElev TwrDiam TwrCd TwrTI TwrCb @@ -1379,15 +1376,6 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) end if WRITE (UnSu,Ec_LgFrmt) p%CavitCheck, 'CavitCheck', 'Perform cavitation check? '//TRIM(Msg) - ! Buoyancy - if (p%Buoyancy) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) p%Buoyancy, 'Buoyancy', 'Include buoyancy effects? '//TRIM(Msg) - - if (p_AD%WakeMod/=WakeMod_none) then WRITE (UnSu,'(A)') '====== Blade-Element/Momentum Theory Options ======================================================' @@ -1629,7 +1617,7 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) InvalidOutput( DBEMTau1 ) = .true. end if - if (.not. p%Buoyancy) then ! Invalid buoyant loads + if ( p%MHK == 0 ) then ! Invalid buoyant loads InvalidOutput( HbFbx ) = .true. InvalidOutput( HbFby ) = .true. InvalidOutput( HbFbz ) = .true. diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 441e24f6a1..fab6c89c73 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -168,7 +168,6 @@ typedef ^ AD_InputFile IntKi TwrShadow - - - "Type of tower influence on wind ba typedef ^ AD_InputFile LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag typedef ^ AD_InputFile Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - typedef ^ AD_InputFile Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - -typedef ^ AD_InputFile Logical Buoyancy - - - "Include buoyancy effects?" flag typedef ^ AD_InputFile Logical CompAA - - - "Compute AeroAcoustic noise" flag typedef ^ AD_InputFile CHARACTER(1024) AA_InputFile - - - "AeroAcoustics input file name" "quoted strings" typedef ^ AD_InputFile CHARACTER(1024) ADBlFile {:} - - "AD blade file (NumBl filenames)" "quoted strings" @@ -363,7 +362,6 @@ typedef ^ RotParameterType IntKi TwrShadow - - - "Type of tower influence on win typedef ^ RotParameterType LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag typedef ^ RotParameterType Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - typedef ^ RotParameterType Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - -typedef ^ RotParameterType Logical Buoyancy - - - "Include buoyancy effects?" flag typedef ^ RotParameterType IntKi MHK - - - "MHK" flag typedef ^ RotParameterType Logical CompAA - - - "Compute AeroAcoustic noise" flag typedef ^ RotParameterType ReKi AirDens - - - "Air density" kg/m^3 diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 77135b3b37..e7499100a6 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -196,7 +196,6 @@ MODULE AeroDyn_Types LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy !< Include buoyancy effects? [flag] LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] CHARACTER(1024) :: AA_InputFile !< AeroAcoustics input file name [quoted strings] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: ADBlFile !< AD blade file (NumBl filenames) [quoted strings] @@ -402,7 +401,6 @@ MODULE AeroDyn_Types LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy !< Include buoyancy effects? [flag] INTEGER(IntKi) :: MHK !< MHK [flag] LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] REAL(ReKi) :: AirDens !< Air density [kg/m^3] @@ -5232,7 +5230,6 @@ SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%TwrAero = SrcInputFileData%TwrAero DstInputFileData%FrozenWake = SrcInputFileData%FrozenWake DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck - DstInputFileData%Buoyancy = SrcInputFileData%Buoyancy DstInputFileData%CompAA = SrcInputFileData%CompAA DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile IF (ALLOCATED(SrcInputFileData%ADBlFile)) THEN @@ -5425,7 +5422,6 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + 1 ! TwrAero Int_BufSz = Int_BufSz + 1 ! FrozenWake Int_BufSz = Int_BufSz + 1 ! CavitCheck - Int_BufSz = Int_BufSz + 1 ! Buoyancy Int_BufSz = Int_BufSz + 1 ! CompAA Int_BufSz = Int_BufSz + 1*LEN(InData%AA_InputFile) ! AA_InputFile Int_BufSz = Int_BufSz + 1 ! ADBlFile allocated yes/no @@ -5555,8 +5551,6 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Buoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 DO I = 1, LEN(InData%AA_InputFile) @@ -5803,8 +5797,6 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = Int_Xferred + 1 OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) Int_Xferred = Int_Xferred + 1 - OutData%Buoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%Buoyancy) - Int_Xferred = Int_Xferred + 1 OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) Int_Xferred = Int_Xferred + 1 DO I = 1, LEN(OutData%AA_InputFile) @@ -13457,7 +13449,6 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero DstRotParameterTypeData%FrozenWake = SrcRotParameterTypeData%FrozenWake DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck - DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens @@ -13805,7 +13796,6 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! TwrAero Int_BufSz = Int_BufSz + 1 ! FrozenWake Int_BufSz = Int_BufSz + 1 ! CavitCheck - Int_BufSz = Int_BufSz + 1 ! Buoyancy Int_BufSz = Int_BufSz + 1 ! MHK Int_BufSz = Int_BufSz + 1 ! CompAA Re_BufSz = Re_BufSz + 1 ! AirDens @@ -14323,8 +14313,6 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Buoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%MHK Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) @@ -15010,8 +14998,6 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Xferred = Int_Xferred + 1 OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) Int_Xferred = Int_Xferred + 1 - OutData%Buoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%Buoyancy) - Int_Xferred = Int_Xferred + 1 OutData%MHK = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) From c55fb0ef524885fe04c72643ac2c436debfe9187 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 14 Apr 2023 19:51:18 -0600 Subject: [PATCH 002/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index b0013e8854..e583e39556 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit b0013e8854ade5c3895a4a9c0c7b4e0a82508f6d +Subproject commit e583e395569a295c0358e6a47da7bc7f1ff53225 From 99e9e0be61a8ffcf4cb8db43bdd548b0e6ce9da8 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 17 Apr 2023 09:52:46 -0600 Subject: [PATCH 003/319] Update documentation after removing Buoyancy flag --- docs/source/user/aerodyn/driver.rst | 16 ++++++++-------- docs/source/user/aerodyn/input.rst | 15 +++++---------- 2 files changed, 13 insertions(+), 18 deletions(-) diff --git a/docs/source/user/aerodyn/driver.rst b/docs/source/user/aerodyn/driver.rst index 86469839f3..c63ef65efc 100644 --- a/docs/source/user/aerodyn/driver.rst +++ b/docs/source/user/aerodyn/driver.rst @@ -381,16 +381,16 @@ An example is given below for two turbines: .. code:: - ====== Hub Properties ============================================================================== [used only when Buoyancy=True] + ====== Hub Properties ============================================================================== [used only when MHK=1 or 2] 7.0 VolHub - Hub volume (m^3) 0.0 HubCenBx - Hub center of buoyancy x direction offset (m) - ====== Hub Properties ============================================================================== [used only when Buoyancy=True] + ====== Hub Properties ============================================================================== [used only when MHK=1 or 2] 5.0 VolHub - Hub volume (m^3) 0.2 HubCenBx - Hub center of buoyancy x direction offset (m) - ====== Nacelle Properties ========================================================================== [used only when Buoyancy=True] + ====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2] 32.0 VolNac - Nacelle volume (m^3) 0.3, 0.0, 0.05 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) - ====== Nacelle Properties ========================================================================== [used only when Buoyancy=True] + ====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2] 30.0 VolNac - Nacelle volume (m^3) 0.5, 0.1, 0.05 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) @@ -406,14 +406,14 @@ An example is given below for two turbines: .. code:: - ====== Turbine(1) Tower Influence and Aerodynamics ================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] - 2 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] + ====== Turbine(1) Tower Influence and Aerodynamics ================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] + 2 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] TwrElev TwrDiam TwrCd TwrTI TwrCb (m) (m) (-) (-) (-) 0.0 2.0 1.0 0.1 0.0 10.0 1.0 1.0 0.1 0.0 - ====== Turbine(2) Tower Influence and Aerodynamics ================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] - 3 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] + ====== Turbine(2) Tower Influence and Aerodynamics ================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] + 3 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] TwrElev TwrDiam TwrCd TwrTI TwrCb (m) (m) (-) (-) (-) 0.0 4.0 1.0 0.1 0.0 diff --git a/docs/source/user/aerodyn/input.rst b/docs/source/user/aerodyn/input.rst index 3fe7ff7a38..b7e0045ef7 100644 --- a/docs/source/user/aerodyn/input.rst +++ b/docs/source/user/aerodyn/input.rst @@ -106,11 +106,6 @@ not function with unsteady airfoil aerodynamics. If ``CavitCheck`` is TRUE, the ``MHK`` flag in the AeroDyn or OpenFAST driver input file must be set to 1 or 2 to indicate an MHK turbine is being modeled. -Set the ``Buoyancy`` flag to TRUE to calculate buoyant loads on the blades, -tower, nacelle, and hub of an MHK turbine or FALSE to disable this calculation. -If ``Buoyancy`` is TRUE, the ``MHK`` flag in the AeroDyn or OpenFAST driver -input file must be set to 1 or 2 to indicate an MHK turbine is being modeled. - Set the ``CompAA`` flag to TRUE to run aero-acoustic calculations. This option is only available for ``WakeMod = 1`` or ``2`` and is not available for an MHK turbine. See section :numref:`AeroAcoustics` for information on how to @@ -327,19 +322,19 @@ permits modeling of aerodynamic imbalances. Hub Properties ~~~~~~~~~~~~~~ The input parameters in this section pertain to the calculation of buoyant loads -on the hub and are only used when ``Buoyancy = TRUE``. +on the hub. ``VolHub`` is the volume of the hub and ``HubCenBx`` is the x offset of the hub center of buoyancy from the hub center in local hub coordinates; offsets in the y and z directions are assumed to be zero. To neglect buoyant loads on the hub, set ``VolHub`` to 0. -Since the hub and blades are joined elements, hub buoyancy should be turned on if blade buoyancy is on, and vice versa. +Since the hub and blades are joined elements, hub buoyancy should be included if blade buoyancy is included, and vice versa. Nacelle Properties ~~~~~~~~~~~~~~~~~~ The input parameters in this section pertain to the calculation of buoyant loads -on the nacelle and are only used when ``Buoyancy = TRUE``. +on the nacelle. ``VolNac`` is the volume of the nacelle and ``NacCenB``` is the position (x,y,z vector) of the nacelle center of buoyancy from @@ -372,7 +367,7 @@ Tower Influence and Aerodynamics The input parameters in this section pertain to the tower influence, tower drag, and/or tower buoyancy calculations and are only used when ``TwrPotent`` > -0, ``TwrShadow`` > 0, ``TwrAero = TRUE``, or ``Buoyancy = TRUE``. +0, ``TwrShadow`` > 0, ``TwrAero = TRUE``, ``MHK = 1``, or ``MHK = 2``. ``NumTwrNds`` is the user-specified number of tower analysis nodes and determines the number of rows in the subsequent table (after two table @@ -840,7 +835,7 @@ nodes. For each node: - ``BlCb`` specifies the blade buoyancy coefficient, defined as the local cross-sectional area of the blade divided by the area of a circle with diameter equal to ``BlChord``; to neglect buoyant loads on the blade, - set ``BlCb`` to 0; since the blades and hub are joined elements, blade buoyancy should be turned on if hub buoyancy is on, and vice versa; + set ``BlCb`` to 0; since the blades and hub are joined elements, blade buoyancy should be included if hub buoyancy is included, and vice versa; - ``BlCenBn`` specifies the offset of the blade center of buoyancy from the aerodynamic center in the direction normal to the chord (positive pointing From 1e1cae5cf69d51d9287ae98b6533c085be461ecb Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Tue, 18 Apr 2023 14:32:11 -0600 Subject: [PATCH 004/319] Update AeroDyn with rotor inertia and added mass inputs --- modules/aerodyn/src/AeroDyn.f90 | 85 +++- modules/aerodyn/src/AeroDyn_IO.f90 | 68 ++- modules/aerodyn/src/AeroDyn_Registry.txt | 10 + modules/aerodyn/src/AeroDyn_Types.f90 | 540 +++++++++++++++++++++++ 4 files changed, 675 insertions(+), 28 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index e81ac8e844..a6eecaec58 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1302,16 +1302,20 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p%NumTwrNds = RotData%NumTwrNds call move_alloc( RotData%TwrDiam, p%TwrDiam ) - call move_alloc( RotData%TwrCd, p%TwrCd ) - call move_alloc( RotData%TwrTI, p%TwrTI ) - call move_alloc( RotData%TwrCb, p%TwrCb ) + call move_alloc( RotData%TwrCd , p%TwrCd ) + call move_alloc( RotData%TwrTI , p%TwrTI ) + call move_alloc( RotData%TwrCb , p%TwrCb ) + call move_alloc( RotData%TwrCpt , p%TwrCpt ) + call move_alloc( RotData%TwrCat , p%TwrCat ) else p%NumTwrNds = RotData%NumTwrNds call move_alloc( RotData%TwrDiam, p%TwrDiam ) - call move_alloc( RotData%TwrCd, p%TwrCd ) - call move_alloc( RotData%TwrTI, p%TwrTI ) - call move_alloc( RotData%TwrCb, p%TwrCb ) + call move_alloc( RotData%TwrCd , p%TwrCd ) + call move_alloc( RotData%TwrTI , p%TwrTI ) + call move_alloc( RotData%TwrCb , p%TwrCb ) + call move_alloc( RotData%TwrCpt , p%TwrCpt ) + call move_alloc( RotData%TwrCat , p%TwrCat ) end if if (p%MHK > 0) then @@ -1713,6 +1717,15 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end if end do + ! Calculate added mass and inertia loads + do iR = 1,size(p%rotors) + if ( p%rotors(iR)%MHK > 0 ) then + call CalcAddedMassInertiaLoads( u%rotors(iR), p%rotors(iR), m%rotors(iR), y%rotors(iR), ErrStat, ErrMsg ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + end do + !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- @@ -2315,6 +2328,42 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) end subroutine CalcBuoyantLoads !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine calculates added mass and inertia loads on an MHK turbine. +subroutine CalcAddedMassInertiaLoads( u, p, m, y, ErrStat, ErrMsg ) + TYPE(RotInputType), INTENT(IN ) :: u !< AD inputs - used for mesh node positions + TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters + TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(RotOutputType), INTENT(INOUT) :: y !< Outputs computed at t + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + INTEGER(IntKi) :: k !< Loop counter for blades + INTEGER(IntKi) :: j !< Loop counter for nodes + CHARACTER(*), PARAMETER :: RoutineName = 'CalcAddedMassInertiaLoads' + + + ! Initialize variables for this routine + ErrStat = ErrID_None + ErrMsg = "" + + ! Blades + do k = 1,p%NumBlades ! loop through all blades + do j = 1,p%NumBlNds ! loop through all nodes + + ! Convert fluid acceleration at node to local blade coordinates + + ! Calculate per-unit-length inertia forces at node + + ! Convert inertia forces to global coordinates + + ! ... + + end do + end do +end subroutine CalcAddedMassInertiaLoads +!---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for solving for the residual of the constraint state equations subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -3564,7 +3613,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end do ! j=nodes end do ! k=blades - ! If the MHK flag is set to 1 or 2, check that the blade buoyancy coefficients are >= 0. + ! If the MHK flag is set to 1 or 2, check that the blade buoyancy and added mass coefficients are >= 0. if ( InitInp%MHK > 0 ) then do k=1,NumBl(iR) do j=1,InputFileData%rotors(iR)%BladeProps(k)%NumBlNds @@ -3572,6 +3621,22 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) call SetErrStat( ErrID_Fatal, 'The buoyancy coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif + if ( InputFileData%rotors(iR)%BladeProps(k)%t_c(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The thickness to chord ratio for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & + //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCac(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The chordwise added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & + //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCae(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The edgewise added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & + //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCap(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The pitch added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & + //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif end do ! j=nodes end do ! k=blades end if @@ -3607,12 +3672,16 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end if end do ! j=nodes - ! If the MHK flag is set to 1 or 2, check that the tower buoyancy coefficients are >= 0. + ! If the MHK flag is set to 1 or 2, check that the tower buoyancy and added mass coefficients are >= 0. if ( InitInp%MHK > 0 .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then do j=1,InputFileData%rotors(iR)%NumTwrNds if ( InputFileData%rotors(iR)%TwrCb(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The buoyancy coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif + + if ( InputFileData%rotors(iR)%TwrCat(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The added mass coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif end do ! j=nodes end if diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index ad4a95d091..28cb4c3a44 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -635,7 +635,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade character(ErrMsgLen) :: ErrMsg2 !< Temporary Error message character(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array - real(ReKi) :: TmpRe5(5) !< temporary 8 number array for reading values in + real(ReKi) :: TmpRe7(7) !< temporary 8 number array for reading values in character(*), parameter :: RoutineName = 'ParsePrimaryFileInfo' @@ -896,7 +896,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] call ParseVar( FileInfo_In, CurLine, "NumTwrNds", InputFileData%rotors(iR)%NumTwrNds, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return - !TwrElev TwrDiam TwrCd TwrTI TwrCb + !TwrElev TwrDiam TwrCd TwrTI TwrCb TwrCpt TwrCat if ( InputFileData%Echo ) WRITE(UnEc, '(A)') 'Tower Table Header: '//FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 !(m) (m) (-) (-) (-) @@ -913,14 +913,20 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade if (Failed()) return CALL AllocAry( InputFileData%rotors(iR)%TwrCb, InputFileData%rotors(iR)%NumTwrNds, 'TwrCb', ErrStat2, ErrMsg2) if (Failed()) return + CALL AllocAry( InputFileData%rotors(iR)%TwrCpt, InputFileData%rotors(iR)%NumTwrNds, 'TwrCpt', ErrStat2, ErrMsg2) + if (Failed()) return + CALL AllocAry( InputFileData%rotors(iR)%TwrCat, InputFileData%rotors(iR)%NumTwrNds, 'TwrCat', ErrStat2, ErrMsg2) + if (Failed()) return do I=1,InputFileData%rotors(iR)%NumTwrNds - call ParseAry ( FileInfo_In, CurLine, 'Properties for tower node '//trim( Int2LStr( I ) )//'.', TmpRe5, 5, ErrStat2, ErrMsg2, UnEc ) + call ParseAry ( FileInfo_In, CurLine, 'Properties for tower node '//trim( Int2LStr( I ) )//'.', TmpRe7, 7, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - InputFileData%rotors(iR)%TwrElev(I) = TmpRe5( 1) - InputFileData%rotors(iR)%TwrDiam(I) = TmpRe5( 2) - InputFileData%rotors(iR)%TwrCd(I) = TmpRe5( 3) - InputFileData%rotors(iR)%TwrTI(I) = TmpRe5( 4) - InputFileData%rotors(iR)%TwrCb(I) = TmpRe5( 5) + InputFileData%rotors(iR)%TwrElev(I) = TmpRe7( 1) + InputFileData%rotors(iR)%TwrDiam(I) = TmpRe7( 2) + InputFileData%rotors(iR)%TwrCd(I) = TmpRe7( 3) + InputFileData%rotors(iR)%TwrTI(I) = TmpRe7( 4) + InputFileData%rotors(iR)%TwrCb(I) = TmpRe7( 5) + InputFileData%rotors(iR)%TwrCpt(I) = TmpRe7( 6) + InputFileData%rotors(iR)%TwrCat(I) = TmpRe7( 7) end do enddo @@ -1043,8 +1049,8 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' CHARACTER(len=1024) :: Line - CHARACTER(len=50) :: HeaderCols(10) ! Header columns in file - LOGICAL :: hasBuoyancy ! Does file contain Buoyancy columns + CHARACTER(len=50) :: HeaderCols(16) ! Header columns in file + LOGICAL :: hasMHK ! Does file contain MHK columns ErrStat = ErrID_None @@ -1086,12 +1092,12 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E CALL ReadCom ( UnIn, ADBlFile, 'Table header: names', ErrStat2, ErrMsg2, UnEc, Comment=Line ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Check if 10 columns are present - READ (Line,*, IOSTAT=ErrStat2) ( HeaderCols(I), I=1,10 ) - hasBuoyancy = .true. + ! Check if 16 columns are present + READ (Line,*, IOSTAT=ErrStat2) ( HeaderCols(I), I=1,16 ) + hasMHK = .true. IF ( ErrStat2 < 0 ) THEN ! end of line reached - hasBuoyancy = .false. - !call WrScr('Blade input file is missing buoyancy columns.') + hasMHK = .false. + call WrScr('Blade input file is missing MHK columns.') ELSE IF ( ErrStat2 > 0 ) THEN CALL SetErrStat(ErrID_Fatal, 'Unexpected error while trying to infer column headers in blade file.', ErrStat, ErrMsg, RoutineName) endif @@ -1121,17 +1127,35 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlAFID, BladeKInputFileData%NumBlNds, 'BlAFID', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%t_c, BladeKInputFileData%NumBlNds, 't_c', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlCb, BladeKInputFileData%NumBlNds, 'BlCb', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlCenBn, BladeKInputFileData%NumBlNds, 'BlCenBn', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlCenBt, BladeKInputFileData%NumBlNds, 'BlCenBt', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCpc, BladeKInputFileData%NumBlNds, 'BlCpc', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCpe, BladeKInputFileData%NumBlNds, 'BlCpe', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCac, BladeKInputFileData%NumBlNds, 'BlCac', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCae, BladeKInputFileData%NumBlNds, 'BlCae', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCap, BladeKInputFileData%NumBlNds, 'BlCap', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (.not. hasBuoyancy) THEN + IF (.not. hasMHK) THEN + BladeKInputFileData%t_c = 0.0_ReKi BladeKInputFileData%BlCb = 0.0_ReKi BladeKInputFileData%BlCenBn = 0.0_ReKi BladeKInputFileData%BlCenBt = 0.0_ReKi + BladeKInputFileData%BlCpc = 0.0_ReKi + BladeKInputFileData%BlCpe = 0.0_ReKi + BladeKInputFileData%BlCac = 0.0_ReKi + BladeKInputFileData%BlCae = 0.0_ReKi + BladeKInputFileData%BlCap = 0.0_ReKi ENDIF ! Return on error if we didn't allocate space for the next inputs @@ -1141,10 +1165,13 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E END IF DO I=1,BladeKInputFileData%NumBlNds - IF (hasBuoyancy) THEN + IF (hasMHK) THEN READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I), BladeKInputFileData%BlCb(I), BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I) + BladeKInputFileData%BlAFID(I), BladeKInputFileData%t_c(I), BladeKInputFileData%BlCb(I), & + BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I), BladeKInputFileData%BlCpc(I), & + BladeKInputFileData%BlCpe(I), BladeKInputFileData%BlCac(I), BladeKInputFileData%BlCae(I), & + BladeKInputFileData%BlCap(I) ELSE READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & @@ -1159,9 +1186,10 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E END IF IF (UnEc > 0) THEN - WRITE( UnEc, "(6(F9.4,1x),I9,4(F9.4,1x))", IOStat=IOS) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & + WRITE( UnEc, "(6(F9.4,1x),I9,10(F9.4,1x))", IOStat=IOS) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I), BladeKInputFileData%BlCb(I), BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I) + BladeKInputFileData%BlAFID(I), BladeKInputFileData%t_c(I), BladeKInputFileData%BlCb(I), BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I), & + BladeKInputFileData%BlCpc(I), BladeKInputFileData%BlCpe(I), BladeKInputFileData%BlCac(I), BladeKInputFileData%BlCae(I), BladeKInputFileData%BlCap(I) END IF END DO diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index fab6c89c73..34131088e3 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -111,9 +111,15 @@ typedef ^ AD_BladePropsType ReKi BlCrvAng {:} - - "Curve angle at blade node" ra typedef ^ AD_BladePropsType ReKi BlTwist {:} - - "Twist at blade node" radians typedef ^ AD_BladePropsType ReKi BlChord {:} - - "Chord at blade node" m typedef ^ AD_BladePropsType IntKi BlAFID {:} - - "ID of Airfoil at blade node" - +typedef ^ AD_BladePropsType ReKi t_c {:} - - "Thickness to chord ratio at blade node" - typedef ^ AD_BladePropsType ReKi BlCb {:} - - "Coefficient of buoyancy at blade node" - typedef ^ AD_BladePropsType ReKi BlCenBn {:} - - "Center of buoyancy normal offset at blade node" m typedef ^ AD_BladePropsType ReKi BlCenBt {:} - - "Center of buoyancy tangential offset at blade node" m +typedef ^ AD_BladePropsType ReKi BlCpc {:} - - "Chordwise coefficient of dynamic pressure at blade node" - +typedef ^ AD_BladePropsType ReKi BlCpe {:} - - "Edgewise coefficient of dynamic pressure at blade node" - +typedef ^ AD_BladePropsType ReKi BlCac {:} - - "Chordwise coefficient of added mass at blade node" - +typedef ^ AD_BladePropsType ReKi BlCae {:} - - "Edgewise coefficient of added mass at blade node" - +typedef ^ AD_BladePropsType ReKi BlCap {:} - - "Pitch coefficient of added mass at blade node" - # Define outputs from the initialization routine here: typedef ^ AD_BladeShape SiKi AirfoilCoords {:}{:}{:} - - "x-y coordinates for airfoils, relative to node" m @@ -148,6 +154,8 @@ typedef ^ RotInputFile ReKi TwrDiam {:} - - "Diameter of tower at node" m typedef ^ RotInputFile ReKi TwrCd {:} - - "Coefficient of drag at tower node" - typedef ^ RotInputFile ReKi TwrTI {:} - - "Turbulence intensity for tower shadow at tower node" - typedef ^ RotInputFile ReKi TwrCb {:} - - "Coefficient of buoyancy at tower node" - +typedef ^ RotInputFile ReKi TwrCpt {:} - - "Coefficient of dynamic pressure at tower node" - +typedef ^ RotInputFile ReKi TwrCat {:} - - "Coefficient of added mass at tower node" - # Hub typedef ^ RotInputFile ReKi VolHub - - - "Hub volume" m^3 typedef ^ RotInputFile ReKi HubCenBx - - - "Hub center of buoyancy x direction offset" m @@ -333,6 +341,8 @@ typedef ^ RotParameterType ReKi TwrCd {:} - - "Coefficient of drag at tower node typedef ^ RotParameterType ReKi TwrTI {:} - - "Turbulence intensity for tower shadow at tower node" - typedef ^ ^ ReKi BlTwist {:}{:} - - "Twist at blade node" radians typedef ^ RotParameterType ReKi TwrCb {:} - - "Coefficient of buoyancy at tower node" - +typedef ^ RotParameterType ReKi TwrCpt {:} - - "Coefficient of dynamic pressure at tower node" - +typedef ^ RotParameterType ReKi TwrCat {:} - - "Coefficient of added mass at tower node" - typedef ^ RotParameterType ReKi BlCenBn {:}{:} - - "Normal offset between aerodynamic center and center of buoyancy at blade node" m typedef ^ RotParameterType ReKi BlCenBt {:}{:} - - "Tangential offset between aerodynamic center and center of buoyancy at blade node" m typedef ^ RotParameterType ReKi VolHub - - - "Hub volume" m^3 diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index e7499100a6..9842d60366 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -132,9 +132,15 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlTwist !< Twist at blade node [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlChord !< Chord at blade node [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BlAFID !< ID of Airfoil at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: t_c !< Thickness to chord ratio at blade node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCb !< Coefficient of buoyancy at blade node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCenBn !< Center of buoyancy normal offset at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCenBt !< Center of buoyancy tangential offset at blade node [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCpc !< Chordwise coefficient of dynamic pressure at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCpe !< Edgewise coefficient of dynamic pressure at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCac !< Chordwise coefficient of added mass at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCae !< Edgewise coefficient of added mass at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCap !< Pitch coefficient of added mass at blade node [-] END TYPE AD_BladePropsType ! ======================= ! ========= AD_BladeShape ======= @@ -176,6 +182,8 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCpt !< Coefficient of dynamic pressure at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCat !< Coefficient of added mass at tower node [-] REAL(ReKi) :: VolHub !< Hub volume [m^3] REAL(ReKi) :: HubCenBx !< Hub center of buoyancy x direction offset [m] REAL(ReKi) :: VolNac !< Nacelle volume [m^3] @@ -373,6 +381,8 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTwist !< Twist at blade node [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCpt !< Coefficient of dynamic pressure at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCat !< Coefficient of added mass at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBn !< Normal offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBt !< Tangential offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) :: VolHub !< Hub volume [m^3] @@ -2290,6 +2300,18 @@ SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, END IF DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%t_c)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%t_c,1) + i1_u = UBOUND(SrcBladePropsTypeData%t_c,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%t_c)) THEN + ALLOCATE(DstBladePropsTypeData%t_c(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%t_c.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%t_c = SrcBladePropsTypeData%t_c +ENDIF IF (ALLOCATED(SrcBladePropsTypeData%BlCb)) THEN i1_l = LBOUND(SrcBladePropsTypeData%BlCb,1) i1_u = UBOUND(SrcBladePropsTypeData%BlCb,1) @@ -2325,6 +2347,66 @@ SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, END IF END IF DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt +ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%BlCpc)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCpc,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCpc,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCpc)) THEN + ALLOCATE(DstBladePropsTypeData%BlCpc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCpc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%BlCpc = SrcBladePropsTypeData%BlCpc +ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%BlCpe)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCpe,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCpe,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCpe)) THEN + ALLOCATE(DstBladePropsTypeData%BlCpe(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCpe.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%BlCpe = SrcBladePropsTypeData%BlCpe +ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%BlCac)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCac,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCac,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCac)) THEN + ALLOCATE(DstBladePropsTypeData%BlCac(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCac.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%BlCac = SrcBladePropsTypeData%BlCac +ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%BlCae)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCae,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCae,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCae)) THEN + ALLOCATE(DstBladePropsTypeData%BlCae(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCae.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%BlCae = SrcBladePropsTypeData%BlCae +ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%BlCap)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCap,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCap,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCap)) THEN + ALLOCATE(DstBladePropsTypeData%BlCap(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCap.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%BlCap = SrcBladePropsTypeData%BlCap ENDIF END SUBROUTINE AD_CopyBladePropsType @@ -2370,6 +2452,9 @@ SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(BladePropsTypeData%BlAFID)) THEN DEALLOCATE(BladePropsTypeData%BlAFID) ENDIF +IF (ALLOCATED(BladePropsTypeData%t_c)) THEN + DEALLOCATE(BladePropsTypeData%t_c) +ENDIF IF (ALLOCATED(BladePropsTypeData%BlCb)) THEN DEALLOCATE(BladePropsTypeData%BlCb) ENDIF @@ -2378,6 +2463,21 @@ SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLO ENDIF IF (ALLOCATED(BladePropsTypeData%BlCenBt)) THEN DEALLOCATE(BladePropsTypeData%BlCenBt) +ENDIF +IF (ALLOCATED(BladePropsTypeData%BlCpc)) THEN + DEALLOCATE(BladePropsTypeData%BlCpc) +ENDIF +IF (ALLOCATED(BladePropsTypeData%BlCpe)) THEN + DEALLOCATE(BladePropsTypeData%BlCpe) +ENDIF +IF (ALLOCATED(BladePropsTypeData%BlCac)) THEN + DEALLOCATE(BladePropsTypeData%BlCac) +ENDIF +IF (ALLOCATED(BladePropsTypeData%BlCae)) THEN + DEALLOCATE(BladePropsTypeData%BlCae) +ENDIF +IF (ALLOCATED(BladePropsTypeData%BlCap)) THEN + DEALLOCATE(BladePropsTypeData%BlCap) ENDIF END SUBROUTINE AD_DestroyBladePropsType @@ -2452,6 +2552,11 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! BlAFID upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID END IF + Int_BufSz = Int_BufSz + 1 ! t_c allocated yes/no + IF ( ALLOCATED(InData%t_c) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! t_c upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%t_c) ! t_c + END IF Int_BufSz = Int_BufSz + 1 ! BlCb allocated yes/no IF ( ALLOCATED(InData%BlCb) ) THEN Int_BufSz = Int_BufSz + 2*1 ! BlCb upper/lower bounds for each dimension @@ -2467,6 +2572,31 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! BlCenBt upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%BlCenBt) ! BlCenBt END IF + Int_BufSz = Int_BufSz + 1 ! BlCpc allocated yes/no + IF ( ALLOCATED(InData%BlCpc) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCpc upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCpc) ! BlCpc + END IF + Int_BufSz = Int_BufSz + 1 ! BlCpe allocated yes/no + IF ( ALLOCATED(InData%BlCpe) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCpe upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCpe) ! BlCpe + END IF + Int_BufSz = Int_BufSz + 1 ! BlCac allocated yes/no + IF ( ALLOCATED(InData%BlCac) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCac upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCac) ! BlCac + END IF + Int_BufSz = Int_BufSz + 1 ! BlCae allocated yes/no + IF ( ALLOCATED(InData%BlCae) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCae upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCae) ! BlCae + END IF + Int_BufSz = Int_BufSz + 1 ! BlCap allocated yes/no + IF ( ALLOCATED(InData%BlCap) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCap upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCap) ! BlCap + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2601,6 +2731,21 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%t_c) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%t_c,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_c,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%t_c,1), UBOUND(InData%t_c,1) + ReKiBuf(Re_Xferred) = InData%t_c(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%BlCb) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2646,6 +2791,81 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%BlCpc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCpc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCpc,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BlCpc,1), UBOUND(InData%BlCpc,1) + ReKiBuf(Re_Xferred) = InData%BlCpc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlCpe) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCpe,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCpe,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BlCpe,1), UBOUND(InData%BlCpe,1) + ReKiBuf(Re_Xferred) = InData%BlCpe(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlCac) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCac,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCac,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BlCac,1), UBOUND(InData%BlCac,1) + ReKiBuf(Re_Xferred) = InData%BlCac(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlCae) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCae,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCae,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BlCae,1), UBOUND(InData%BlCae,1) + ReKiBuf(Re_Xferred) = InData%BlCae(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlCap) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCap,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCap,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BlCap,1), UBOUND(InData%BlCap,1) + ReKiBuf(Re_Xferred) = InData%BlCap(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF END SUBROUTINE AD_PackBladePropsType SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2803,6 +3023,24 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = Int_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_c not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%t_c)) DEALLOCATE(OutData%t_c) + ALLOCATE(OutData%t_c(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_c.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%t_c,1), UBOUND(OutData%t_c,1) + OutData%t_c(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCb not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2857,6 +3095,96 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCpc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlCpc)) DEALLOCATE(OutData%BlCpc) + ALLOCATE(OutData%BlCpc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCpc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BlCpc,1), UBOUND(OutData%BlCpc,1) + OutData%BlCpc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCpe not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlCpe)) DEALLOCATE(OutData%BlCpe) + ALLOCATE(OutData%BlCpe(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCpe.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BlCpe,1), UBOUND(OutData%BlCpe,1) + OutData%BlCpe(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCac not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlCac)) DEALLOCATE(OutData%BlCac) + ALLOCATE(OutData%BlCac(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCac.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BlCac,1), UBOUND(OutData%BlCac,1) + OutData%BlCac(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCae not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlCae)) DEALLOCATE(OutData%BlCae) + ALLOCATE(OutData%BlCae(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCae.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BlCae,1), UBOUND(OutData%BlCae,1) + OutData%BlCae(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCap not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlCap)) DEALLOCATE(OutData%BlCap) + ALLOCATE(OutData%BlCap(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCap.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BlCap,1), UBOUND(OutData%BlCap,1) + OutData%BlCap(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF END SUBROUTINE AD_UnPackBladePropsType SUBROUTINE AD_CopyBladeShape( SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg ) @@ -4613,6 +4941,30 @@ SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCo END IF END IF DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb +ENDIF +IF (ALLOCATED(SrcRotInputFileData%TwrCpt)) THEN + i1_l = LBOUND(SrcRotInputFileData%TwrCpt,1) + i1_u = UBOUND(SrcRotInputFileData%TwrCpt,1) + IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCpt)) THEN + ALLOCATE(DstRotInputFileData%TwrCpt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCpt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotInputFileData%TwrCpt = SrcRotInputFileData%TwrCpt +ENDIF +IF (ALLOCATED(SrcRotInputFileData%TwrCat)) THEN + i1_l = LBOUND(SrcRotInputFileData%TwrCat,1) + i1_u = UBOUND(SrcRotInputFileData%TwrCat,1) + IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCat)) THEN + ALLOCATE(DstRotInputFileData%TwrCat(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotInputFileData%TwrCat = SrcRotInputFileData%TwrCat ENDIF DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx @@ -4667,6 +5019,12 @@ SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg, DEALLOCATE ENDIF IF (ALLOCATED(RotInputFileData%TwrCb)) THEN DEALLOCATE(RotInputFileData%TwrCb) +ENDIF +IF (ALLOCATED(RotInputFileData%TwrCpt)) THEN + DEALLOCATE(RotInputFileData%TwrCpt) +ENDIF +IF (ALLOCATED(RotInputFileData%TwrCat)) THEN + DEALLOCATE(RotInputFileData%TwrCat) ENDIF CALL AD_Destroytfininputfiletype( RotInputFileData%TFin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4756,6 +5114,16 @@ SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IF ( ALLOCATED(InData%TwrCb) ) THEN Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb + END IF + Int_BufSz = Int_BufSz + 1 ! TwrCpt allocated yes/no + IF ( ALLOCATED(InData%TwrCpt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrCpt upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrCpt) ! TwrCpt + END IF + Int_BufSz = Int_BufSz + 1 ! TwrCat allocated yes/no + IF ( ALLOCATED(InData%TwrCat) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrCat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrCat) ! TwrCat END IF Re_BufSz = Re_BufSz + 1 ! VolHub Re_BufSz = Re_BufSz + 1 ! HubCenBx @@ -4924,6 +5292,36 @@ SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ReKiBuf(Re_Xferred) = InData%TwrCb(i1) Re_Xferred = Re_Xferred + 1 END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrCpt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCpt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCpt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TwrCpt,1), UBOUND(InData%TwrCpt,1) + ReKiBuf(Re_Xferred) = InData%TwrCpt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrCat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCat,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TwrCat,1), UBOUND(InData%TwrCat,1) + ReKiBuf(Re_Xferred) = InData%TwrCat(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF ReKiBuf(Re_Xferred) = InData%VolHub Re_Xferred = Re_Xferred + 1 @@ -5145,6 +5543,42 @@ SUBROUTINE AD_UnPackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%TwrCb(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCpt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrCpt)) DEALLOCATE(OutData%TwrCpt) + ALLOCATE(OutData%TwrCpt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCpt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TwrCpt,1), UBOUND(OutData%TwrCpt,1) + OutData%TwrCpt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrCat)) DEALLOCATE(OutData%TwrCat) + ALLOCATE(OutData%TwrCat(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TwrCat,1), UBOUND(OutData%TwrCat,1) + OutData%TwrCat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF OutData%VolHub = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 @@ -13260,6 +13694,30 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType END IF DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%TwrCpt)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%TwrCpt,1) + i1_u = UBOUND(SrcRotParameterTypeData%TwrCpt,1) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCpt)) THEN + ALLOCATE(DstRotParameterTypeData%TwrCpt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCpt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%TwrCpt = SrcRotParameterTypeData%TwrCpt +ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%TwrCat)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%TwrCat,1) + i1_u = UBOUND(SrcRotParameterTypeData%TwrCat,1) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCat)) THEN + ALLOCATE(DstRotParameterTypeData%TwrCat(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%TwrCat = SrcRotParameterTypeData%TwrCat +ENDIF IF (ALLOCATED(SrcRotParameterTypeData%BlCenBn)) THEN i1_l = LBOUND(SrcRotParameterTypeData%BlCenBn,1) i1_u = UBOUND(SrcRotParameterTypeData%BlCenBn,1) @@ -13556,6 +14014,12 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE IF (ALLOCATED(RotParameterTypeData%TwrCb)) THEN DEALLOCATE(RotParameterTypeData%TwrCb) ENDIF +IF (ALLOCATED(RotParameterTypeData%TwrCpt)) THEN + DEALLOCATE(RotParameterTypeData%TwrCpt) +ENDIF +IF (ALLOCATED(RotParameterTypeData%TwrCat)) THEN + DEALLOCATE(RotParameterTypeData%TwrCat) +ENDIF IF (ALLOCATED(RotParameterTypeData%BlCenBn)) THEN DEALLOCATE(RotParameterTypeData%BlCenBn) ENDIF @@ -13683,6 +14147,16 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb END IF + Int_BufSz = Int_BufSz + 1 ! TwrCpt allocated yes/no + IF ( ALLOCATED(InData%TwrCpt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrCpt upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrCpt) ! TwrCpt + END IF + Int_BufSz = Int_BufSz + 1 ! TwrCat allocated yes/no + IF ( ALLOCATED(InData%TwrCat) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrCat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrCat) ! TwrCat + END IF Int_BufSz = Int_BufSz + 1 ! BlCenBn allocated yes/no IF ( ALLOCATED(InData%BlCenBn) ) THEN Int_BufSz = Int_BufSz + 2*2 ! BlCenBn upper/lower bounds for each dimension @@ -13999,6 +14473,36 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%TwrCpt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCpt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCpt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TwrCpt,1), UBOUND(InData%TwrCpt,1) + ReKiBuf(Re_Xferred) = InData%TwrCpt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrCat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCat,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TwrCat,1), UBOUND(InData%TwrCat,1) + ReKiBuf(Re_Xferred) = InData%TwrCat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%BlCenBn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -14619,6 +15123,42 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCpt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrCpt)) DEALLOCATE(OutData%TwrCpt) + ALLOCATE(OutData%TwrCpt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCpt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TwrCpt,1), UBOUND(OutData%TwrCpt,1) + OutData%TwrCpt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrCat)) DEALLOCATE(OutData%TwrCat) + ALLOCATE(OutData%TwrCat(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TwrCat,1), UBOUND(OutData%TwrCat,1) + OutData%TwrCat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBn not allocated Int_Xferred = Int_Xferred + 1 ELSE From 8a31a32b3412e63cffdb12325cdcf22ed2096d6c Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 1 May 2023 10:43:59 -0600 Subject: [PATCH 005/319] Adjust blade/tower inertia and added mass coefficient names --- modules/aerodyn/src/AeroDyn.f90 | 16 +- modules/aerodyn/src/AeroDyn_IO.f90 | 38 +- modules/aerodyn/src/AeroDyn_Registry.txt | 18 +- modules/aerodyn/src/AeroDyn_Types.f90 | 450 +++++++++++------------ 4 files changed, 261 insertions(+), 261 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 925f5c8f50..ef89adf5d2 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1306,8 +1306,8 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err call move_alloc( RotData%TwrCd , p%TwrCd ) call move_alloc( RotData%TwrTI , p%TwrTI ) call move_alloc( RotData%TwrCb , p%TwrCb ) - call move_alloc( RotData%TwrCpt , p%TwrCpt ) - call move_alloc( RotData%TwrCat , p%TwrCat ) + call move_alloc( RotData%TwrCp , p%TwrCp ) + call move_alloc( RotData%TwrCa , p%TwrCa ) else p%NumTwrNds = RotData%NumTwrNds @@ -1315,8 +1315,8 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err call move_alloc( RotData%TwrCd , p%TwrCd ) call move_alloc( RotData%TwrTI , p%TwrTI ) call move_alloc( RotData%TwrCb , p%TwrCb ) - call move_alloc( RotData%TwrCpt , p%TwrCpt ) - call move_alloc( RotData%TwrCat , p%TwrCat ) + call move_alloc( RotData%TwrCp , p%TwrCp ) + call move_alloc( RotData%TwrCa , p%TwrCa ) end if if (p%MHK > 0) then @@ -3626,15 +3626,15 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) call SetErrStat( ErrID_Fatal, 'The thickness to chord ratio for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif - if ( InputFileData%rotors(iR)%BladeProps(k)%BlCac(j) < 0.0_ReKi ) then + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCan(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The chordwise added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif - if ( InputFileData%rotors(iR)%BladeProps(k)%BlCae(j) < 0.0_ReKi ) then + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCat(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The edgewise added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif - if ( InputFileData%rotors(iR)%BladeProps(k)%BlCap(j) < 0.0_ReKi ) then + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCam(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The pitch added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif @@ -3680,7 +3680,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) call SetErrStat( ErrID_Fatal, 'The buoyancy coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif - if ( InputFileData%rotors(iR)%TwrCat(j) < 0.0_ReKi ) then + if ( InputFileData%rotors(iR)%TwrCa(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The added mass coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif end do ! j=nodes diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 778be7b90a..6882254499 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -896,7 +896,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] call ParseVar( FileInfo_In, CurLine, "NumTwrNds", InputFileData%rotors(iR)%NumTwrNds, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return - !TwrElev TwrDiam TwrCd TwrTI TwrCb TwrCpt TwrCat + !TwrElev TwrDiam TwrCd TwrTI TwrCb TwrCp TwrCa if ( InputFileData%Echo ) WRITE(UnEc, '(A)') 'Tower Table Header: '//FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 !(m) (m) (-) (-) (-) @@ -913,9 +913,9 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade if (Failed()) return CALL AllocAry( InputFileData%rotors(iR)%TwrCb, InputFileData%rotors(iR)%NumTwrNds, 'TwrCb', ErrStat2, ErrMsg2) if (Failed()) return - CALL AllocAry( InputFileData%rotors(iR)%TwrCpt, InputFileData%rotors(iR)%NumTwrNds, 'TwrCpt', ErrStat2, ErrMsg2) + CALL AllocAry( InputFileData%rotors(iR)%TwrCp, InputFileData%rotors(iR)%NumTwrNds, 'TwrCp', ErrStat2, ErrMsg2) if (Failed()) return - CALL AllocAry( InputFileData%rotors(iR)%TwrCat, InputFileData%rotors(iR)%NumTwrNds, 'TwrCat', ErrStat2, ErrMsg2) + CALL AllocAry( InputFileData%rotors(iR)%TwrCa, InputFileData%rotors(iR)%NumTwrNds, 'TwrCa', ErrStat2, ErrMsg2) if (Failed()) return do I=1,InputFileData%rotors(iR)%NumTwrNds call ParseAry ( FileInfo_In, CurLine, 'Properties for tower node '//trim( Int2LStr( I ) )//'.', TmpRe7, 7, ErrStat2, ErrMsg2, UnEc ) @@ -925,8 +925,8 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade InputFileData%rotors(iR)%TwrCd(I) = TmpRe7( 3) InputFileData%rotors(iR)%TwrTI(I) = TmpRe7( 4) InputFileData%rotors(iR)%TwrCb(I) = TmpRe7( 5) - InputFileData%rotors(iR)%TwrCpt(I) = TmpRe7( 6) - InputFileData%rotors(iR)%TwrCat(I) = TmpRe7( 7) + InputFileData%rotors(iR)%TwrCp(I) = TmpRe7( 6) + InputFileData%rotors(iR)%TwrCa(I) = TmpRe7( 7) end do enddo @@ -1135,15 +1135,15 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlCenBt, BladeKInputFileData%NumBlNds, 'BlCenBt', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCpc, BladeKInputFileData%NumBlNds, 'BlCpc', ErrStat2, ErrMsg2) + CALL AllocAry( BladeKInputFileData%BlCpn, BladeKInputFileData%NumBlNds, 'BlCpn', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCpe, BladeKInputFileData%NumBlNds, 'BlCpe', ErrStat2, ErrMsg2) + CALL AllocAry( BladeKInputFileData%BlCpt, BladeKInputFileData%NumBlNds, 'BlCpt', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCac, BladeKInputFileData%NumBlNds, 'BlCac', ErrStat2, ErrMsg2) + CALL AllocAry( BladeKInputFileData%BlCan, BladeKInputFileData%NumBlNds, 'BlCan', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCae, BladeKInputFileData%NumBlNds, 'BlCae', ErrStat2, ErrMsg2) + CALL AllocAry( BladeKInputFileData%BlCat, BladeKInputFileData%NumBlNds, 'BlCat', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCap, BladeKInputFileData%NumBlNds, 'BlCap', ErrStat2, ErrMsg2) + CALL AllocAry( BladeKInputFileData%BlCam, BladeKInputFileData%NumBlNds, 'BlCam', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (.not. hasMHK) THEN @@ -1151,11 +1151,11 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E BladeKInputFileData%BlCb = 0.0_ReKi BladeKInputFileData%BlCenBn = 0.0_ReKi BladeKInputFileData%BlCenBt = 0.0_ReKi - BladeKInputFileData%BlCpc = 0.0_ReKi - BladeKInputFileData%BlCpe = 0.0_ReKi - BladeKInputFileData%BlCac = 0.0_ReKi - BladeKInputFileData%BlCae = 0.0_ReKi - BladeKInputFileData%BlCap = 0.0_ReKi + BladeKInputFileData%BlCpn = 0.0_ReKi + BladeKInputFileData%BlCpt = 0.0_ReKi + BladeKInputFileData%BlCan = 0.0_ReKi + BladeKInputFileData%BlCat = 0.0_ReKi + BladeKInputFileData%BlCam = 0.0_ReKi ENDIF ! Return on error if we didn't allocate space for the next inputs @@ -1169,9 +1169,9 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & BladeKInputFileData%BlAFID(I), BladeKInputFileData%t_c(I), BladeKInputFileData%BlCb(I), & - BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I), BladeKInputFileData%BlCpc(I), & - BladeKInputFileData%BlCpe(I), BladeKInputFileData%BlCac(I), BladeKInputFileData%BlCae(I), & - BladeKInputFileData%BlCap(I) + BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I), BladeKInputFileData%BlCpn(I), & + BladeKInputFileData%BlCpt(I), BladeKInputFileData%BlCan(I), BladeKInputFileData%BlCat(I), & + BladeKInputFileData%BlCam(I) ELSE READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & @@ -1189,7 +1189,7 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E WRITE( UnEc, "(6(F9.4,1x),I9,10(F9.4,1x))", IOStat=IOS) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & BladeKInputFileData%BlAFID(I), BladeKInputFileData%t_c(I), BladeKInputFileData%BlCb(I), BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I), & - BladeKInputFileData%BlCpc(I), BladeKInputFileData%BlCpe(I), BladeKInputFileData%BlCac(I), BladeKInputFileData%BlCae(I), BladeKInputFileData%BlCap(I) + BladeKInputFileData%BlCpn(I), BladeKInputFileData%BlCpt(I), BladeKInputFileData%BlCan(I), BladeKInputFileData%BlCat(I), BladeKInputFileData%BlCam(I) END IF END DO diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 34131088e3..d2aca333ad 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -115,11 +115,11 @@ typedef ^ AD_BladePropsType ReKi t_c {:} - - "Thickness to chord typedef ^ AD_BladePropsType ReKi BlCb {:} - - "Coefficient of buoyancy at blade node" - typedef ^ AD_BladePropsType ReKi BlCenBn {:} - - "Center of buoyancy normal offset at blade node" m typedef ^ AD_BladePropsType ReKi BlCenBt {:} - - "Center of buoyancy tangential offset at blade node" m -typedef ^ AD_BladePropsType ReKi BlCpc {:} - - "Chordwise coefficient of dynamic pressure at blade node" - -typedef ^ AD_BladePropsType ReKi BlCpe {:} - - "Edgewise coefficient of dynamic pressure at blade node" - -typedef ^ AD_BladePropsType ReKi BlCac {:} - - "Chordwise coefficient of added mass at blade node" - -typedef ^ AD_BladePropsType ReKi BlCae {:} - - "Edgewise coefficient of added mass at blade node" - -typedef ^ AD_BladePropsType ReKi BlCap {:} - - "Pitch coefficient of added mass at blade node" - +typedef ^ AD_BladePropsType ReKi BlCpn {:} - - "Chordwise coefficient of dynamic pressure at blade node" - +typedef ^ AD_BladePropsType ReKi BlCpt {:} - - "Edgewise coefficient of dynamic pressure at blade node" - +typedef ^ AD_BladePropsType ReKi BlCan {:} - - "Chordwise coefficient of added mass at blade node" - +typedef ^ AD_BladePropsType ReKi BlCat {:} - - "Edgewise coefficient of added mass at blade node" - +typedef ^ AD_BladePropsType ReKi BlCam {:} - - "Pitch coefficient of added mass at blade node" - # Define outputs from the initialization routine here: typedef ^ AD_BladeShape SiKi AirfoilCoords {:}{:}{:} - - "x-y coordinates for airfoils, relative to node" m @@ -154,8 +154,8 @@ typedef ^ RotInputFile ReKi TwrDiam {:} - - "Diameter of tower at node" m typedef ^ RotInputFile ReKi TwrCd {:} - - "Coefficient of drag at tower node" - typedef ^ RotInputFile ReKi TwrTI {:} - - "Turbulence intensity for tower shadow at tower node" - typedef ^ RotInputFile ReKi TwrCb {:} - - "Coefficient of buoyancy at tower node" - -typedef ^ RotInputFile ReKi TwrCpt {:} - - "Coefficient of dynamic pressure at tower node" - -typedef ^ RotInputFile ReKi TwrCat {:} - - "Coefficient of added mass at tower node" - +typedef ^ RotInputFile ReKi TwrCp {:} - - "Coefficient of dynamic pressure at tower node" - +typedef ^ RotInputFile ReKi TwrCa {:} - - "Coefficient of added mass at tower node" - # Hub typedef ^ RotInputFile ReKi VolHub - - - "Hub volume" m^3 typedef ^ RotInputFile ReKi HubCenBx - - - "Hub center of buoyancy x direction offset" m @@ -341,8 +341,8 @@ typedef ^ RotParameterType ReKi TwrCd {:} - - "Coefficient of drag at tower node typedef ^ RotParameterType ReKi TwrTI {:} - - "Turbulence intensity for tower shadow at tower node" - typedef ^ ^ ReKi BlTwist {:}{:} - - "Twist at blade node" radians typedef ^ RotParameterType ReKi TwrCb {:} - - "Coefficient of buoyancy at tower node" - -typedef ^ RotParameterType ReKi TwrCpt {:} - - "Coefficient of dynamic pressure at tower node" - -typedef ^ RotParameterType ReKi TwrCat {:} - - "Coefficient of added mass at tower node" - +typedef ^ RotParameterType ReKi TwrCp {:} - - "Coefficient of dynamic pressure at tower node" - +typedef ^ RotParameterType ReKi TwrCa {:} - - "Coefficient of added mass at tower node" - typedef ^ RotParameterType ReKi BlCenBn {:}{:} - - "Normal offset between aerodynamic center and center of buoyancy at blade node" m typedef ^ RotParameterType ReKi BlCenBt {:}{:} - - "Tangential offset between aerodynamic center and center of buoyancy at blade node" m typedef ^ RotParameterType ReKi VolHub - - - "Hub volume" m^3 diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 9842d60366..8ebf3d1dd8 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -136,11 +136,11 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCb !< Coefficient of buoyancy at blade node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCenBn !< Center of buoyancy normal offset at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCenBt !< Center of buoyancy tangential offset at blade node [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCpc !< Chordwise coefficient of dynamic pressure at blade node [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCpe !< Edgewise coefficient of dynamic pressure at blade node [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCac !< Chordwise coefficient of added mass at blade node [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCae !< Edgewise coefficient of added mass at blade node [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCap !< Pitch coefficient of added mass at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCpn !< Chordwise coefficient of dynamic pressure at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCpt !< Edgewise coefficient of dynamic pressure at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCan !< Chordwise coefficient of added mass at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCat !< Edgewise coefficient of added mass at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCam !< Pitch coefficient of added mass at blade node [-] END TYPE AD_BladePropsType ! ======================= ! ========= AD_BladeShape ======= @@ -182,8 +182,8 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCpt !< Coefficient of dynamic pressure at tower node [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCat !< Coefficient of added mass at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCp !< Coefficient of dynamic pressure at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCa !< Coefficient of added mass at tower node [-] REAL(ReKi) :: VolHub !< Hub volume [m^3] REAL(ReKi) :: HubCenBx !< Hub center of buoyancy x direction offset [m] REAL(ReKi) :: VolNac !< Nacelle volume [m^3] @@ -381,8 +381,8 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTwist !< Twist at blade node [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCpt !< Coefficient of dynamic pressure at tower node [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCat !< Coefficient of added mass at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCp !< Coefficient of dynamic pressure at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCa !< Coefficient of added mass at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBn !< Normal offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBt !< Tangential offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) :: VolHub !< Hub volume [m^3] @@ -2348,65 +2348,65 @@ SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, END IF DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCpc)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCpc,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCpc,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCpc)) THEN - ALLOCATE(DstBladePropsTypeData%BlCpc(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBladePropsTypeData%BlCpn)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCpn,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCpn,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCpn)) THEN + ALLOCATE(DstBladePropsTypeData%BlCpn(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCpc.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCpn.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstBladePropsTypeData%BlCpc = SrcBladePropsTypeData%BlCpc + DstBladePropsTypeData%BlCpn = SrcBladePropsTypeData%BlCpn ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCpe)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCpe,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCpe,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCpe)) THEN - ALLOCATE(DstBladePropsTypeData%BlCpe(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBladePropsTypeData%BlCpt)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCpt,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCpt,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCpt)) THEN + ALLOCATE(DstBladePropsTypeData%BlCpt(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCpe.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCpt.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstBladePropsTypeData%BlCpe = SrcBladePropsTypeData%BlCpe + DstBladePropsTypeData%BlCpt = SrcBladePropsTypeData%BlCpt ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCac)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCac,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCac,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCac)) THEN - ALLOCATE(DstBladePropsTypeData%BlCac(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBladePropsTypeData%BlCan)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCan,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCan,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCan)) THEN + ALLOCATE(DstBladePropsTypeData%BlCan(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCac.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCan.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstBladePropsTypeData%BlCac = SrcBladePropsTypeData%BlCac + DstBladePropsTypeData%BlCan = SrcBladePropsTypeData%BlCan ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCae)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCae,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCae,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCae)) THEN - ALLOCATE(DstBladePropsTypeData%BlCae(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBladePropsTypeData%BlCat)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCat,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCat,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCat)) THEN + ALLOCATE(DstBladePropsTypeData%BlCat(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCae.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCat.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstBladePropsTypeData%BlCae = SrcBladePropsTypeData%BlCae + DstBladePropsTypeData%BlCat = SrcBladePropsTypeData%BlCat ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCap)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCap,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCap,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCap)) THEN - ALLOCATE(DstBladePropsTypeData%BlCap(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBladePropsTypeData%BlCam)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%BlCam,1) + i1_u = UBOUND(SrcBladePropsTypeData%BlCam,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCam)) THEN + ALLOCATE(DstBladePropsTypeData%BlCam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCap.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCam.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstBladePropsTypeData%BlCap = SrcBladePropsTypeData%BlCap + DstBladePropsTypeData%BlCam = SrcBladePropsTypeData%BlCam ENDIF END SUBROUTINE AD_CopyBladePropsType @@ -2464,20 +2464,20 @@ SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(BladePropsTypeData%BlCenBt)) THEN DEALLOCATE(BladePropsTypeData%BlCenBt) ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCpc)) THEN - DEALLOCATE(BladePropsTypeData%BlCpc) +IF (ALLOCATED(BladePropsTypeData%BlCpn)) THEN + DEALLOCATE(BladePropsTypeData%BlCpn) ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCpe)) THEN - DEALLOCATE(BladePropsTypeData%BlCpe) +IF (ALLOCATED(BladePropsTypeData%BlCpt)) THEN + DEALLOCATE(BladePropsTypeData%BlCpt) ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCac)) THEN - DEALLOCATE(BladePropsTypeData%BlCac) +IF (ALLOCATED(BladePropsTypeData%BlCan)) THEN + DEALLOCATE(BladePropsTypeData%BlCan) ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCae)) THEN - DEALLOCATE(BladePropsTypeData%BlCae) +IF (ALLOCATED(BladePropsTypeData%BlCat)) THEN + DEALLOCATE(BladePropsTypeData%BlCat) ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCap)) THEN - DEALLOCATE(BladePropsTypeData%BlCap) +IF (ALLOCATED(BladePropsTypeData%BlCam)) THEN + DEALLOCATE(BladePropsTypeData%BlCam) ENDIF END SUBROUTINE AD_DestroyBladePropsType @@ -2572,30 +2572,30 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! BlCenBt upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%BlCenBt) ! BlCenBt END IF - Int_BufSz = Int_BufSz + 1 ! BlCpc allocated yes/no - IF ( ALLOCATED(InData%BlCpc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCpc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCpc) ! BlCpc + Int_BufSz = Int_BufSz + 1 ! BlCpn allocated yes/no + IF ( ALLOCATED(InData%BlCpn) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCpn upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCpn) ! BlCpn END IF - Int_BufSz = Int_BufSz + 1 ! BlCpe allocated yes/no - IF ( ALLOCATED(InData%BlCpe) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCpe upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCpe) ! BlCpe + Int_BufSz = Int_BufSz + 1 ! BlCpt allocated yes/no + IF ( ALLOCATED(InData%BlCpt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCpt upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCpt) ! BlCpt END IF - Int_BufSz = Int_BufSz + 1 ! BlCac allocated yes/no - IF ( ALLOCATED(InData%BlCac) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCac upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCac) ! BlCac + Int_BufSz = Int_BufSz + 1 ! BlCan allocated yes/no + IF ( ALLOCATED(InData%BlCan) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCan upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCan) ! BlCan END IF - Int_BufSz = Int_BufSz + 1 ! BlCae allocated yes/no - IF ( ALLOCATED(InData%BlCae) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCae upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCae) ! BlCae + Int_BufSz = Int_BufSz + 1 ! BlCat allocated yes/no + IF ( ALLOCATED(InData%BlCat) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCat) ! BlCat END IF - Int_BufSz = Int_BufSz + 1 ! BlCap allocated yes/no - IF ( ALLOCATED(InData%BlCap) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCap upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCap) ! BlCap + Int_BufSz = Int_BufSz + 1 ! BlCam allocated yes/no + IF ( ALLOCATED(InData%BlCam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlCam upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlCam) ! BlCam END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -2791,78 +2791,78 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%BlCpc) ) THEN + IF ( .NOT. ALLOCATED(InData%BlCpn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCpc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCpc,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCpn,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCpn,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%BlCpc,1), UBOUND(InData%BlCpc,1) - ReKiBuf(Re_Xferred) = InData%BlCpc(i1) + DO i1 = LBOUND(InData%BlCpn,1), UBOUND(InData%BlCpn,1) + ReKiBuf(Re_Xferred) = InData%BlCpn(i1) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%BlCpe) ) THEN + IF ( .NOT. ALLOCATED(InData%BlCpt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCpe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCpe,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCpt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCpt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%BlCpe,1), UBOUND(InData%BlCpe,1) - ReKiBuf(Re_Xferred) = InData%BlCpe(i1) + DO i1 = LBOUND(InData%BlCpt,1), UBOUND(InData%BlCpt,1) + ReKiBuf(Re_Xferred) = InData%BlCpt(i1) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%BlCac) ) THEN + IF ( .NOT. ALLOCATED(InData%BlCan) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCac,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCan,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCan,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%BlCac,1), UBOUND(InData%BlCac,1) - ReKiBuf(Re_Xferred) = InData%BlCac(i1) + DO i1 = LBOUND(InData%BlCan,1), UBOUND(InData%BlCan,1) + ReKiBuf(Re_Xferred) = InData%BlCan(i1) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%BlCae) ) THEN + IF ( .NOT. ALLOCATED(InData%BlCat) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCae,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCae,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCat,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%BlCae,1), UBOUND(InData%BlCae,1) - ReKiBuf(Re_Xferred) = InData%BlCae(i1) + DO i1 = LBOUND(InData%BlCat,1), UBOUND(InData%BlCat,1) + ReKiBuf(Re_Xferred) = InData%BlCat(i1) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%BlCap) ) THEN + IF ( .NOT. ALLOCATED(InData%BlCam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCap,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCam,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%BlCap,1), UBOUND(InData%BlCap,1) - ReKiBuf(Re_Xferred) = InData%BlCap(i1) + DO i1 = LBOUND(InData%BlCam,1), UBOUND(InData%BlCam,1) + ReKiBuf(Re_Xferred) = InData%BlCam(i1) Re_Xferred = Re_Xferred + 1 END DO END IF @@ -3095,93 +3095,93 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCpc not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCpn not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCpc)) DEALLOCATE(OutData%BlCpc) - ALLOCATE(OutData%BlCpc(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%BlCpn)) DEALLOCATE(OutData%BlCpn) + ALLOCATE(OutData%BlCpn(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCpc.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCpn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%BlCpc,1), UBOUND(OutData%BlCpc,1) - OutData%BlCpc(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%BlCpn,1), UBOUND(OutData%BlCpn,1) + OutData%BlCpn(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCpe not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCpt not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCpe)) DEALLOCATE(OutData%BlCpe) - ALLOCATE(OutData%BlCpe(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%BlCpt)) DEALLOCATE(OutData%BlCpt) + ALLOCATE(OutData%BlCpt(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCpe.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCpt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%BlCpe,1), UBOUND(OutData%BlCpe,1) - OutData%BlCpe(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%BlCpt,1), UBOUND(OutData%BlCpt,1) + OutData%BlCpt(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCac not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCan not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCac)) DEALLOCATE(OutData%BlCac) - ALLOCATE(OutData%BlCac(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%BlCan)) DEALLOCATE(OutData%BlCan) + ALLOCATE(OutData%BlCan(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCac.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCan.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%BlCac,1), UBOUND(OutData%BlCac,1) - OutData%BlCac(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%BlCan,1), UBOUND(OutData%BlCan,1) + OutData%BlCan(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCae not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCat not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCae)) DEALLOCATE(OutData%BlCae) - ALLOCATE(OutData%BlCae(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%BlCat)) DEALLOCATE(OutData%BlCat) + ALLOCATE(OutData%BlCat(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCae.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%BlCae,1), UBOUND(OutData%BlCae,1) - OutData%BlCae(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%BlCat,1), UBOUND(OutData%BlCat,1) + OutData%BlCat(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCap not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCam not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCap)) DEALLOCATE(OutData%BlCap) - ALLOCATE(OutData%BlCap(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%BlCam)) DEALLOCATE(OutData%BlCam) + ALLOCATE(OutData%BlCam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCap.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%BlCap,1), UBOUND(OutData%BlCap,1) - OutData%BlCap(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%BlCam,1), UBOUND(OutData%BlCam,1) + OutData%BlCam(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF @@ -4942,29 +4942,29 @@ SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCo END IF DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrCpt)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrCpt,1) - i1_u = UBOUND(SrcRotInputFileData%TwrCpt,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCpt)) THEN - ALLOCATE(DstRotInputFileData%TwrCpt(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRotInputFileData%TwrCp)) THEN + i1_l = LBOUND(SrcRotInputFileData%TwrCp,1) + i1_u = UBOUND(SrcRotInputFileData%TwrCp,1) + IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCp)) THEN + ALLOCATE(DstRotInputFileData%TwrCp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCpt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCp.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstRotInputFileData%TwrCpt = SrcRotInputFileData%TwrCpt + DstRotInputFileData%TwrCp = SrcRotInputFileData%TwrCp ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrCat)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrCat,1) - i1_u = UBOUND(SrcRotInputFileData%TwrCat,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCat)) THEN - ALLOCATE(DstRotInputFileData%TwrCat(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRotInputFileData%TwrCa)) THEN + i1_l = LBOUND(SrcRotInputFileData%TwrCa,1) + i1_u = UBOUND(SrcRotInputFileData%TwrCa,1) + IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCa)) THEN + ALLOCATE(DstRotInputFileData%TwrCa(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCat.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCa.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstRotInputFileData%TwrCat = SrcRotInputFileData%TwrCat + DstRotInputFileData%TwrCa = SrcRotInputFileData%TwrCa ENDIF DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx @@ -5020,11 +5020,11 @@ SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(RotInputFileData%TwrCb)) THEN DEALLOCATE(RotInputFileData%TwrCb) ENDIF -IF (ALLOCATED(RotInputFileData%TwrCpt)) THEN - DEALLOCATE(RotInputFileData%TwrCpt) +IF (ALLOCATED(RotInputFileData%TwrCp)) THEN + DEALLOCATE(RotInputFileData%TwrCp) ENDIF -IF (ALLOCATED(RotInputFileData%TwrCat)) THEN - DEALLOCATE(RotInputFileData%TwrCat) +IF (ALLOCATED(RotInputFileData%TwrCa)) THEN + DEALLOCATE(RotInputFileData%TwrCa) ENDIF CALL AD_Destroytfininputfiletype( RotInputFileData%TFin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5115,15 +5115,15 @@ SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb END IF - Int_BufSz = Int_BufSz + 1 ! TwrCpt allocated yes/no - IF ( ALLOCATED(InData%TwrCpt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCpt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCpt) ! TwrCpt + Int_BufSz = Int_BufSz + 1 ! TwrCp allocated yes/no + IF ( ALLOCATED(InData%TwrCp) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrCp upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrCp) ! TwrCp END IF - Int_BufSz = Int_BufSz + 1 ! TwrCat allocated yes/no - IF ( ALLOCATED(InData%TwrCat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCat) ! TwrCat + Int_BufSz = Int_BufSz + 1 ! TwrCa allocated yes/no + IF ( ALLOCATED(InData%TwrCa) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrCa upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrCa) ! TwrCa END IF Re_BufSz = Re_BufSz + 1 ! VolHub Re_BufSz = Re_BufSz + 1 ! HubCenBx @@ -5293,33 +5293,33 @@ SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%TwrCpt) ) THEN + IF ( .NOT. ALLOCATED(InData%TwrCp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCpt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCpt,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCp,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%TwrCpt,1), UBOUND(InData%TwrCpt,1) - ReKiBuf(Re_Xferred) = InData%TwrCpt(i1) + DO i1 = LBOUND(InData%TwrCp,1), UBOUND(InData%TwrCp,1) + ReKiBuf(Re_Xferred) = InData%TwrCp(i1) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%TwrCat) ) THEN + IF ( .NOT. ALLOCATED(InData%TwrCa) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCat,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCa,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCa,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%TwrCat,1), UBOUND(InData%TwrCat,1) - ReKiBuf(Re_Xferred) = InData%TwrCat(i1) + DO i1 = LBOUND(InData%TwrCa,1), UBOUND(InData%TwrCa,1) + ReKiBuf(Re_Xferred) = InData%TwrCa(i1) Re_Xferred = Re_Xferred + 1 END DO END IF @@ -5544,39 +5544,39 @@ SUBROUTINE AD_UnPackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCpt not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCp not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCpt)) DEALLOCATE(OutData%TwrCpt) - ALLOCATE(OutData%TwrCpt(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%TwrCp)) DEALLOCATE(OutData%TwrCp) + ALLOCATE(OutData%TwrCp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCpt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%TwrCpt,1), UBOUND(OutData%TwrCpt,1) - OutData%TwrCpt(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%TwrCp,1), UBOUND(OutData%TwrCp,1) + OutData%TwrCp(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCat not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCa not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCat)) DEALLOCATE(OutData%TwrCat) - ALLOCATE(OutData%TwrCat(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%TwrCa)) DEALLOCATE(OutData%TwrCa) + ALLOCATE(OutData%TwrCa(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCat.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%TwrCat,1), UBOUND(OutData%TwrCat,1) - OutData%TwrCat(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%TwrCa,1), UBOUND(OutData%TwrCa,1) + OutData%TwrCa(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF @@ -13694,29 +13694,29 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType END IF DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrCpt)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrCpt,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrCpt,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCpt)) THEN - ALLOCATE(DstRotParameterTypeData%TwrCpt(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRotParameterTypeData%TwrCp)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%TwrCp,1) + i1_u = UBOUND(SrcRotParameterTypeData%TwrCp,1) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCp)) THEN + ALLOCATE(DstRotParameterTypeData%TwrCp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCpt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCp.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstRotParameterTypeData%TwrCpt = SrcRotParameterTypeData%TwrCpt + DstRotParameterTypeData%TwrCp = SrcRotParameterTypeData%TwrCp ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrCat)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrCat,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrCat,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCat)) THEN - ALLOCATE(DstRotParameterTypeData%TwrCat(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRotParameterTypeData%TwrCa)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%TwrCa,1) + i1_u = UBOUND(SrcRotParameterTypeData%TwrCa,1) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCa)) THEN + ALLOCATE(DstRotParameterTypeData%TwrCa(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCat.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCa.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstRotParameterTypeData%TwrCat = SrcRotParameterTypeData%TwrCat + DstRotParameterTypeData%TwrCa = SrcRotParameterTypeData%TwrCa ENDIF IF (ALLOCATED(SrcRotParameterTypeData%BlCenBn)) THEN i1_l = LBOUND(SrcRotParameterTypeData%BlCenBn,1) @@ -14014,11 +14014,11 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE IF (ALLOCATED(RotParameterTypeData%TwrCb)) THEN DEALLOCATE(RotParameterTypeData%TwrCb) ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrCpt)) THEN - DEALLOCATE(RotParameterTypeData%TwrCpt) +IF (ALLOCATED(RotParameterTypeData%TwrCp)) THEN + DEALLOCATE(RotParameterTypeData%TwrCp) ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrCat)) THEN - DEALLOCATE(RotParameterTypeData%TwrCat) +IF (ALLOCATED(RotParameterTypeData%TwrCa)) THEN + DEALLOCATE(RotParameterTypeData%TwrCa) ENDIF IF (ALLOCATED(RotParameterTypeData%BlCenBn)) THEN DEALLOCATE(RotParameterTypeData%BlCenBn) @@ -14147,15 +14147,15 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb END IF - Int_BufSz = Int_BufSz + 1 ! TwrCpt allocated yes/no - IF ( ALLOCATED(InData%TwrCpt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCpt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCpt) ! TwrCpt + Int_BufSz = Int_BufSz + 1 ! TwrCp allocated yes/no + IF ( ALLOCATED(InData%TwrCp) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrCp upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrCp) ! TwrCp END IF - Int_BufSz = Int_BufSz + 1 ! TwrCat allocated yes/no - IF ( ALLOCATED(InData%TwrCat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCat) ! TwrCat + Int_BufSz = Int_BufSz + 1 ! TwrCa allocated yes/no + IF ( ALLOCATED(InData%TwrCa) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrCa upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrCa) ! TwrCa END IF Int_BufSz = Int_BufSz + 1 ! BlCenBn allocated yes/no IF ( ALLOCATED(InData%BlCenBn) ) THEN @@ -14473,33 +14473,33 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%TwrCpt) ) THEN + IF ( .NOT. ALLOCATED(InData%TwrCp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCpt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCpt,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCp,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%TwrCpt,1), UBOUND(InData%TwrCpt,1) - ReKiBuf(Re_Xferred) = InData%TwrCpt(i1) + DO i1 = LBOUND(InData%TwrCp,1), UBOUND(InData%TwrCp,1) + ReKiBuf(Re_Xferred) = InData%TwrCp(i1) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%TwrCat) ) THEN + IF ( .NOT. ALLOCATED(InData%TwrCa) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCat,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCa,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCa,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%TwrCat,1), UBOUND(InData%TwrCat,1) - ReKiBuf(Re_Xferred) = InData%TwrCat(i1) + DO i1 = LBOUND(InData%TwrCa,1), UBOUND(InData%TwrCa,1) + ReKiBuf(Re_Xferred) = InData%TwrCa(i1) Re_Xferred = Re_Xferred + 1 END DO END IF @@ -15123,39 +15123,39 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCpt not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCp not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCpt)) DEALLOCATE(OutData%TwrCpt) - ALLOCATE(OutData%TwrCpt(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%TwrCp)) DEALLOCATE(OutData%TwrCp) + ALLOCATE(OutData%TwrCp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCpt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%TwrCpt,1), UBOUND(OutData%TwrCpt,1) - OutData%TwrCpt(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%TwrCp,1), UBOUND(OutData%TwrCp,1) + OutData%TwrCp(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCat not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCa not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCat)) DEALLOCATE(OutData%TwrCat) - ALLOCATE(OutData%TwrCat(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%TwrCa)) DEALLOCATE(OutData%TwrCa) + ALLOCATE(OutData%TwrCa(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCat.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%TwrCat,1), UBOUND(OutData%TwrCat,1) - OutData%TwrCat(i1) = ReKiBuf(Re_Xferred) + DO i1 = LBOUND(OutData%TwrCa,1), UBOUND(OutData%TwrCa,1) + OutData%TwrCa(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END IF From 109c1b894cd60afa255fef3b15f93eaf0fd46727 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 1 May 2023 13:00:53 -0600 Subject: [PATCH 006/319] Calculate rotor inertia and added mass parameters --- modules/aerodyn/src/AeroDyn.f90 | 76 ++++ modules/aerodyn/src/AeroDyn_Registry.txt | 7 + modules/aerodyn/src/AeroDyn_Types.f90 | 438 +++++++++++++++++++++++ 3 files changed, 521 insertions(+) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index ef89adf5d2..81d9b70efa 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -392,6 +392,16 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut end if end do + !............................................................................................ + ! Calculate inertia and added mass parameters + !............................................................................................ + do iR = 1, nRotors + if ( p%rotors(iR)%MHK > 0 ) then + call SetInertiaAddedMassParameters( InputFileData%rotors(iR), p%rotors(iR), ErrStat2, ErrMsg2 ) + if (Failed()) return; + end if + end do + !............................................................................................ ! Initialize the BEMT module (also sets other variables for sub module) !............................................................................................ @@ -1473,6 +1483,72 @@ subroutine SetBuoyancyParameters( InputFileData, u, p, ErrStat, ErrMsg ) end subroutine SetBuoyancyParameters !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets parameters for use during the inertia and added mass calculations; these variables are not changed after AD_Init. +subroutine SetInertiaAddedMassParameters( InputFileData, p, ErrStat, ErrMsg ) + TYPE(RotInputFile), INTENT(IN ) :: InputFileData !< All the data in the AeroDyn input file + TYPE(RotParameterType), INTENT(INOUT) :: p !< Parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + INTEGER(IntKi) :: ErrStat2 !< Temporary error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 !< Temporary error message if ErrStat /= ErrID_None + INTEGER(IntKi) :: k !< Loop counter for blades + INTEGER(IntKi) :: j !< Loop counter for nodes + + CHARACTER(*), PARAMETER :: RoutineName = 'SetInertiaAddedMassParameters' + + + ! Initialize variables for this routine + ErrStat = ErrID_None + ErrMsg = "" + + + ! Allocate inertia and added mass parameters + call AllocAry( p%BlIN, p%NumBlNds, p%NumBlades, 'BlIN', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%BlIT, p%NumBlNds, p%NumBlades, 'BlIT', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%BlAN, p%NumBlNds, p%NumBlades, 'BlAN', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%BlAT, p%NumBlNds, p%NumBlades, 'BlAT', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%BlAM, p%NumBlNds, p%NumBlades, 'BlAM', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if ( p%NumTwrNds > 0 ) then + call AllocAry( p%TwrIT, p%NumTwrNds, 'TwrIT', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%TwrAT, p%NumTwrNds, 'TwrAT', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + ! Calculate blade inertia and added mass parameters + do k = 1,p%NumBlades ! loop through all blades + + do j = 1,p%NumBlNds ! loop through all nodes + p%BlIN(j,k) = (InputFileData%BladeProps(k)%BlCpn(j) + InputFileData%BladeProps(k)%BlCan(j)) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) ! node j normal-to-chord inertia factor + p%BlIT(j,k) = (InputFileData%BladeProps(k)%BlCpt(j) + InputFileData%BladeProps(k)%BlCat(j)) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) ! node j tangential-to-chord inertia factor + p%BlAN(j,k) = -InputFileData%BladeProps(k)%BlCan(j) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) ! node j normal-to-chord added mass factor + p%BlAT(j,k) = -InputFileData%BladeProps(k)%BlCat(j) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) ! node j tangential-to-chord added mass factor + p%BlAM(j,k) = -InputFileData%BladeProps(k)%BlCam(j) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) * (InputFileData%BladeProps(k)%BlChord(j)**2 + InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j)**2) ! node j pitch added mass factor + end do ! j = nodes + + end do ! k = blades + + ! Calculate tower inertia and added mass parameters + if ( p%NumTwrNds > 0 ) then + + do j = 1,p%NumTwrNds ! loop through all nodes + p%TwrIT(j) = (p%TwrCp(j) + p%TwrCa(j)) * p%airDens * pi * (p%TwrDiam(j)/2.0_ReKi)**2 ! node j tangential inertia factor + p%TwrAT(j) = -p%TwrCa(j) * p%airDens * pi * (p%TwrDiam(j)/2.0_ReKi)**2 ! node j tangential added mass factor + end do ! j = nodes + + end if + +end subroutine SetInertiaAddedMassParameters +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index d2aca333ad..95317cebfb 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -355,10 +355,17 @@ typedef ^ RotParameterType ReKi BlRad {:}{:} - - "Matrix of equivalent bla typedef ^ RotParameterType ReKi BlDL {:}{:} - - "Matrix of blade element length based on CB, used in buoyancy calculation" m typedef ^ RotParameterType ReKi BlTaper {:}{:} - - "Matrix of blade element taper, used in buoyancy calculation" - typedef ^ RotParameterType ReKi BlAxCent {:}{:} - - "Matrix of blade element axial centroid, used in buoyancy calculation" - +typedef ^ RotParameterType ReKi BlIN {:}{:} - - "Matrix of blade node normal-to-chord inertia factor" kg/m +typedef ^ RotParameterType ReKi BlIT {:}{:} - - "Matrix of blade node tangential-to-chord inertia factor" kg/m +typedef ^ RotParameterType ReKi BlAN {:}{:} - - "Matrix of blade node normal-to-chord added mass factor" kg/m +typedef ^ RotParameterType ReKi BlAT {:}{:} - - "Matrix of blade node tangential-to-chord added mass factor" kg/m +typedef ^ RotParameterType ReKi BlAM {:}{:} - - "Matrix of blade node pitch added mass factor" kgm typedef ^ RotParameterType ReKi TwrRad {:} - - "Array of equivalent tower radius at each node, used in buoyancy calculation" m typedef ^ RotParameterType ReKi TwrDL {:} - - "Array of tower element length, used in buoyancy calculation" m typedef ^ RotParameterType ReKi TwrTaper {:} - - "Array of tower element taper, used in buoyancy calculation" - typedef ^ RotParameterType ReKi TwrAxCent {:} - - "Array of tower element axial centroid, used in buoyancy calculation" - +typedef ^ RotParameterType ReKi TwrIT {:} - - "Array of tower node tangential inertia factor" kg/m +typedef ^ RotParameterType ReKi TwrAT {:} - - "Array of tower node tangential added mass factor" kg/m typedef ^ RotParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" typedef ^ RotParameterType AA_ParameterType AA - - - "Parameters for AA module" typedef ^ RotParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 8ebf3d1dd8..075cf0c063 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -395,10 +395,17 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlDL !< Matrix of blade element length based on CB, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTaper !< Matrix of blade element taper, used in buoyancy calculation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlAxCent !< Matrix of blade element axial centroid, used in buoyancy calculation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlIN !< Matrix of blade node normal-to-chord inertia factor [kg/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlIT !< Matrix of blade node tangential-to-chord inertia factor [kg/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlAN !< Matrix of blade node normal-to-chord added mass factor [kg/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlAT !< Matrix of blade node tangential-to-chord added mass factor [kg/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlAM !< Matrix of blade node pitch added mass factor [kgm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrRad !< Array of equivalent tower radius at each node, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDL !< Array of tower element length, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTaper !< Array of tower element taper, used in buoyancy calculation [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrAxCent !< Array of tower element axial centroid, used in buoyancy calculation [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrIT !< Array of tower node tangential inertia factor [kg/m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrAT !< Array of tower node tangential added mass factor [kg/m] TYPE(BEMT_ParameterType) :: BEMT !< Parameters for BEMT module [-] TYPE(AA_ParameterType) :: AA !< Parameters for AA module [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] @@ -13808,6 +13815,76 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType END IF DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%BlIN)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%BlIN,1) + i1_u = UBOUND(SrcRotParameterTypeData%BlIN,1) + i2_l = LBOUND(SrcRotParameterTypeData%BlIN,2) + i2_u = UBOUND(SrcRotParameterTypeData%BlIN,2) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlIN)) THEN + ALLOCATE(DstRotParameterTypeData%BlIN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlIN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%BlIN = SrcRotParameterTypeData%BlIN +ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%BlIT)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%BlIT,1) + i1_u = UBOUND(SrcRotParameterTypeData%BlIT,1) + i2_l = LBOUND(SrcRotParameterTypeData%BlIT,2) + i2_u = UBOUND(SrcRotParameterTypeData%BlIT,2) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlIT)) THEN + ALLOCATE(DstRotParameterTypeData%BlIT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlIT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%BlIT = SrcRotParameterTypeData%BlIT +ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%BlAN)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%BlAN,1) + i1_u = UBOUND(SrcRotParameterTypeData%BlAN,1) + i2_l = LBOUND(SrcRotParameterTypeData%BlAN,2) + i2_u = UBOUND(SrcRotParameterTypeData%BlAN,2) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlAN)) THEN + ALLOCATE(DstRotParameterTypeData%BlAN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%BlAN = SrcRotParameterTypeData%BlAN +ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%BlAT)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%BlAT,1) + i1_u = UBOUND(SrcRotParameterTypeData%BlAT,1) + i2_l = LBOUND(SrcRotParameterTypeData%BlAT,2) + i2_u = UBOUND(SrcRotParameterTypeData%BlAT,2) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlAT)) THEN + ALLOCATE(DstRotParameterTypeData%BlAT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%BlAT = SrcRotParameterTypeData%BlAT +ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%BlAM)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%BlAM,1) + i1_u = UBOUND(SrcRotParameterTypeData%BlAM,1) + i2_l = LBOUND(SrcRotParameterTypeData%BlAM,2) + i2_u = UBOUND(SrcRotParameterTypeData%BlAM,2) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlAM)) THEN + ALLOCATE(DstRotParameterTypeData%BlAM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%BlAM = SrcRotParameterTypeData%BlAM +ENDIF IF (ALLOCATED(SrcRotParameterTypeData%TwrRad)) THEN i1_l = LBOUND(SrcRotParameterTypeData%TwrRad,1) i1_u = UBOUND(SrcRotParameterTypeData%TwrRad,1) @@ -13855,6 +13932,30 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType END IF END IF DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent +ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%TwrIT)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%TwrIT,1) + i1_u = UBOUND(SrcRotParameterTypeData%TwrIT,1) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrIT)) THEN + ALLOCATE(DstRotParameterTypeData%TwrIT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrIT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%TwrIT = SrcRotParameterTypeData%TwrIT +ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%TwrAT)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%TwrAT,1) + i1_u = UBOUND(SrcRotParameterTypeData%TwrAT,1) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrAT)) THEN + ALLOCATE(DstRotParameterTypeData%TwrAT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%TwrAT = SrcRotParameterTypeData%TwrAT ENDIF CALL BEMT_CopyParam( SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -14038,6 +14139,21 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE IF (ALLOCATED(RotParameterTypeData%BlAxCent)) THEN DEALLOCATE(RotParameterTypeData%BlAxCent) ENDIF +IF (ALLOCATED(RotParameterTypeData%BlIN)) THEN + DEALLOCATE(RotParameterTypeData%BlIN) +ENDIF +IF (ALLOCATED(RotParameterTypeData%BlIT)) THEN + DEALLOCATE(RotParameterTypeData%BlIT) +ENDIF +IF (ALLOCATED(RotParameterTypeData%BlAN)) THEN + DEALLOCATE(RotParameterTypeData%BlAN) +ENDIF +IF (ALLOCATED(RotParameterTypeData%BlAT)) THEN + DEALLOCATE(RotParameterTypeData%BlAT) +ENDIF +IF (ALLOCATED(RotParameterTypeData%BlAM)) THEN + DEALLOCATE(RotParameterTypeData%BlAM) +ENDIF IF (ALLOCATED(RotParameterTypeData%TwrRad)) THEN DEALLOCATE(RotParameterTypeData%TwrRad) ENDIF @@ -14049,6 +14165,12 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE ENDIF IF (ALLOCATED(RotParameterTypeData%TwrAxCent)) THEN DEALLOCATE(RotParameterTypeData%TwrAxCent) +ENDIF +IF (ALLOCATED(RotParameterTypeData%TwrIT)) THEN + DEALLOCATE(RotParameterTypeData%TwrIT) +ENDIF +IF (ALLOCATED(RotParameterTypeData%TwrAT)) THEN + DEALLOCATE(RotParameterTypeData%TwrAT) ENDIF CALL BEMT_DestroyParam( RotParameterTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -14193,6 +14315,31 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*2 ! BlAxCent upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%BlAxCent) ! BlAxCent END IF + Int_BufSz = Int_BufSz + 1 ! BlIN allocated yes/no + IF ( ALLOCATED(InData%BlIN) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlIN upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlIN) ! BlIN + END IF + Int_BufSz = Int_BufSz + 1 ! BlIT allocated yes/no + IF ( ALLOCATED(InData%BlIT) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlIT upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlIT) ! BlIT + END IF + Int_BufSz = Int_BufSz + 1 ! BlAN allocated yes/no + IF ( ALLOCATED(InData%BlAN) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlAN upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlAN) ! BlAN + END IF + Int_BufSz = Int_BufSz + 1 ! BlAT allocated yes/no + IF ( ALLOCATED(InData%BlAT) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlAT upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlAT) ! BlAT + END IF + Int_BufSz = Int_BufSz + 1 ! BlAM allocated yes/no + IF ( ALLOCATED(InData%BlAM) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlAM upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlAM) ! BlAM + END IF Int_BufSz = Int_BufSz + 1 ! TwrRad allocated yes/no IF ( ALLOCATED(InData%TwrRad) ) THEN Int_BufSz = Int_BufSz + 2*1 ! TwrRad upper/lower bounds for each dimension @@ -14212,6 +14359,16 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IF ( ALLOCATED(InData%TwrAxCent) ) THEN Int_BufSz = Int_BufSz + 2*1 ! TwrAxCent upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%TwrAxCent) ! TwrAxCent + END IF + Int_BufSz = Int_BufSz + 1 ! TwrIT allocated yes/no + IF ( ALLOCATED(InData%TwrIT) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrIT upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrIT) ! TwrIT + END IF + Int_BufSz = Int_BufSz + 1 ! TwrAT allocated yes/no + IF ( ALLOCATED(InData%TwrAT) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrAT upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrAT) ! TwrAT END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype @@ -14637,6 +14794,106 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%BlIN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlIN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlIN,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlIN,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlIN,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlIN,2), UBOUND(InData%BlIN,2) + DO i1 = LBOUND(InData%BlIN,1), UBOUND(InData%BlIN,1) + ReKiBuf(Re_Xferred) = InData%BlIN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlIT) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlIT,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlIT,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlIT,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlIT,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlIT,2), UBOUND(InData%BlIT,2) + DO i1 = LBOUND(InData%BlIT,1), UBOUND(InData%BlIT,1) + ReKiBuf(Re_Xferred) = InData%BlIT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlAN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAN,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAN,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAN,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlAN,2), UBOUND(InData%BlAN,2) + DO i1 = LBOUND(InData%BlAN,1), UBOUND(InData%BlAN,1) + ReKiBuf(Re_Xferred) = InData%BlAN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlAT) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAT,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAT,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAT,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAT,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlAT,2), UBOUND(InData%BlAT,2) + DO i1 = LBOUND(InData%BlAT,1), UBOUND(InData%BlAT,1) + ReKiBuf(Re_Xferred) = InData%BlAT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlAM) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAM,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAM,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAM,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlAM,2), UBOUND(InData%BlAM,2) + DO i1 = LBOUND(InData%BlAM,1), UBOUND(InData%BlAM,1) + ReKiBuf(Re_Xferred) = InData%BlAM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%TwrRad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -14696,6 +14953,36 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ReKiBuf(Re_Xferred) = InData%TwrAxCent(i1) Re_Xferred = Re_Xferred + 1 END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrIT) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrIT,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrIT,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TwrIT,1), UBOUND(InData%TwrIT,1) + ReKiBuf(Re_Xferred) = InData%TwrIT(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrAT) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAT,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAT,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TwrAT,1), UBOUND(InData%TwrAT,1) + ReKiBuf(Re_Xferred) = InData%TwrAT(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL BEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -15313,6 +15600,121 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlIN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlIN)) DEALLOCATE(OutData%BlIN) + ALLOCATE(OutData%BlIN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlIN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlIN,2), UBOUND(OutData%BlIN,2) + DO i1 = LBOUND(OutData%BlIN,1), UBOUND(OutData%BlIN,1) + OutData%BlIN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlIT not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlIT)) DEALLOCATE(OutData%BlIT) + ALLOCATE(OutData%BlIT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlIT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlIT,2), UBOUND(OutData%BlIT,2) + DO i1 = LBOUND(OutData%BlIT,1), UBOUND(OutData%BlIT,1) + OutData%BlIT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlAN)) DEALLOCATE(OutData%BlAN) + ALLOCATE(OutData%BlAN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlAN,2), UBOUND(OutData%BlAN,2) + DO i1 = LBOUND(OutData%BlAN,1), UBOUND(OutData%BlAN,1) + OutData%BlAN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAT not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlAT)) DEALLOCATE(OutData%BlAT) + ALLOCATE(OutData%BlAT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlAT,2), UBOUND(OutData%BlAT,2) + DO i1 = LBOUND(OutData%BlAT,1), UBOUND(OutData%BlAT,1) + OutData%BlAT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlAM)) DEALLOCATE(OutData%BlAM) + ALLOCATE(OutData%BlAM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlAM,2), UBOUND(OutData%BlAM,2) + DO i1 = LBOUND(OutData%BlAM,1), UBOUND(OutData%BlAM,1) + OutData%BlAM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRad not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -15384,6 +15786,42 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt OutData%TwrAxCent(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrIT not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrIT)) DEALLOCATE(OutData%TwrIT) + ALLOCATE(OutData%TwrIT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrIT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TwrIT,1), UBOUND(OutData%TwrIT,1) + OutData%TwrIT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrAT not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrAT)) DEALLOCATE(OutData%TwrAT) + ALLOCATE(OutData%TwrAT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TwrAT,1), UBOUND(OutData%TwrAT,1) + OutData%TwrAT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 From 8a980701d8946ea9bfb3886b456d3d237527841d Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 1 May 2023 15:06:32 -0600 Subject: [PATCH 007/319] Pass inflow accelerations to AeroDyn --- modules/aerodyn/src/AeroDyn.f90 | 45 ++++- modules/aerodyn/src/AeroDyn_Inflow.f90 | 20 +- modules/aerodyn/src/AeroDyn_Registry.txt | 2 + modules/aerodyn/src/AeroDyn_Types.f90 | 190 +++++++++++++++++++ modules/openfast-library/src/FAST_Solver.f90 | 12 +- 5 files changed, 262 insertions(+), 7 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 81d9b70efa..3c987d85f7 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -64,6 +64,7 @@ module AeroDyn PUBLIC :: AD_NumWindPoints !< Routine to return then number of windpoints required by AeroDyn PUBLIC :: AD_BoxExceedPointsIdx !< Routine to set the start of the OLAF wind points PUBLIC :: AD_GetExternalWind !< Set the external wind into AeroDyn inputs + PUBLIC :: AD_GetExternalAccel !< Set the external accelerations into AeroDyn inputs PUBLIC :: AD_SetExternalWindPositions !< Set the external wind points needed by AeroDyn inputs contains @@ -1056,6 +1057,10 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) call AllocAry( u%InflowOnTower, 3_IntKi, p%NumTwrNds, 'u%InflowOnTower', ErrStat2, ErrMsg2 ) ! could be size zero call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( u%AccelOnBlade, 3_IntKi, p%NumBlNds, p%numBlades, 'u%AccelOnBlade', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( u%AccelOnTower, 3_IntKi, p%NumTwrNds, 'u%AccelOnTower', ErrStat2, ErrMsg2 ) ! could be size zero + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) call AllocAry( u%UserProp, p%NumBlNds, p%numBlades, 'u%UserProp', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -1063,6 +1068,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er if (errStat >= AbortErrLev) return u%InflowOnBlade = 0.0_ReKi + u%AccelOnBlade = 0.0_ReKi u%UserProp = 0.0_ReKi u%InflowOnHub = 0.0_ReKi u%InflowOnNacelle = 0.0_ReKi @@ -1074,7 +1080,8 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er !................ if (p%NumTwrNds > 0) then - u%InflowOnTower = 0.0_ReKi + u%InflowOnTower = 0.0_ReKi + u%AccelOnTower = 0.0_ReKi call MeshCreate ( BlankMesh = u%TowerMotion & ,IOS = COMPONENT_INPUT & @@ -7336,6 +7343,42 @@ subroutine AD_GetExternalWind(u_AD, VelUVW, node, errStat, errMsg) end if end subroutine AD_GetExternalWind !---------------------------------------------------------------------------------------------------------------------------------- +!> Sets the flow accelerations calculated by InflowWind into the AeroDyn arrays ("InputSolve_IfW") for MHK turbines +!! Should respect the order of AD_NumWindPoints and AD_SetExternalWindPositions +subroutine AD_GetExternalAccel(u_AD, AccUVW, node, errStat, errMsg) + ! Passed variables + type(AD_InputType), intent(inout) :: u_AD !< AeroDyn inputs + real(ReKi), dimension(:,:), intent(in ) :: AccUVW !< Acceleration array 3 x n (as typically returned by InflowWind) + integer(IntKi), intent(inout) :: node !< Counter for dimension 2 of AccUVW. Initialized by caller and returned! + integer(IntKi) :: errStat!< Error status of the operation + character(*) :: errMsg !< Error message if errStat /= ErrID_None + ! Local variables: + integer(IntKi) :: j ! Loops through nodes / elements. + integer(IntKi) :: k ! Loops through blades. + integer(IntKi) :: nNodes + integer(IntKi) :: iWT + errStat = ErrID_None + errMsg = "" + + do iWT=1,size(u_AD%rotors) + nNodes = size(u_AD%rotors(iWT)%AccelOnBlade,2) + ! Blades + do k=1,size(u_AD%rotors(iWT)%AccelOnBlade,3) + do j=1,nNodes + u_AD%rotors(iWT)%AccelOnBlade(:,j,k) = AccUVW(:,node) + node = node + 1 + end do + end do + ! Tower + if ( allocated(u_AD%rotors(iWT)%AccelOnTower) ) then + do j=1,size(u_AD%rotors(iWT)%AccelOnTower,2) + u_AD%rotors(iWT)%AccelOnTower(:,j) = AccUVW(:,node) + node = node + 1 + end do + end if + enddo ! rotors +end subroutine AD_GetExternalAccel +!---------------------------------------------------------------------------------------------------------------------------------- !> Set inputs for inflow wind !! Order should match AD_NumWindPoints and AD_GetExternalWind subroutine AD_SetExternalWindPositions(u_AD, o_AD, PosXYZ, node, errStat, errMsg) diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index e513c1085f..0ced9cce9e 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -5,7 +5,7 @@ module AeroDyn_Inflow use AeroDyn_Inflow_Types use AeroDyn_Types use AeroDyn, only: AD_Init, AD_ReInit, AD_CalcOutput, AD_UpdateStates, AD_End - use AeroDyn, only: AD_NumWindPoints, AD_GetExternalWind, AD_SetExternalWindPositions + use AeroDyn, only: AD_NumWindPoints, AD_GetExternalWind, AD_GetExternalAccel, AD_SetExternalWindPositions use AeroDyn_IO, only: AD_SetVTKSurface use InflowWind, only: InflowWind_Init, InflowWind_CalcOutput, InflowWind_End @@ -427,7 +427,7 @@ subroutine ADI_ADIW_Solve(t, p_AD, u_AD, o_AD, u_IfW, IW, hubHeightFirst, errSta ! Compute IW%y%VelocityUVW call ADI_CalcOutput_IW(t, u_IfW, IW, errStat2, errMsg2); if(Failed()) return ! Set u_AD%..%InflowOnBlade, u_AD%..%InflowOnTower, etc - call ADI_AD_InputSolve_IfW(u_AD, IW%y, hubHeightFirst, errStat2, errMsg2); if(Failed()) return + call ADI_AD_InputSolve_IfW(p_AD, u_AD, IW%y, hubHeightFirst, errStat2, errMsg2); if(Failed()) return contains logical function Failed() @@ -499,11 +499,12 @@ end subroutine ADI_CalcOutput_IW !> This routine sets the wind claculated by InflowWind to the AeroDyn arrays !! See similar routine in FAST_Solver !! TODO put this in AeroDyn -subroutine ADI_AD_InputSolve_IfW(u_AD, y_IfW, hubHeightFirst, errStat, errMsg) +subroutine ADI_AD_InputSolve_IfW(p_AD, u_AD, y_IfW, hubHeightFirst, errStat, errMsg) ! Passed variables + TYPE(ADI_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn - TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< The outputs from InflowWind - logical, intent(in ) :: hubHeightFirst ! Hub Height velocity is packed at beginning + TYPE(InflowWind_OutputType), INTENT(IN ) :: y_IfW !< The outputs from InflowWind + logical, INTENT(IN ) :: hubHeightFirst !< Hub Height velocity is packed at beginning INTEGER(IntKi) :: errStat !< Error status of the operation CHARACTER(*) :: errMsg !< Error message if errStat /= ErrID_None ! Local variables: @@ -520,6 +521,15 @@ subroutine ADI_AD_InputSolve_IfW(u_AD, y_IfW, hubHeightFirst, errStat, errMsg) endif call AD_GetExternalWind(u_AD, y_IfW%VelocityUVW, node, errStat, errMsg) + if ( p_AD%MHK > 0 ) then + if (hubHeightFirst) then + do iWT=1,size(u_AD%rotors) + node = node + 1 ! Hub velocities for each rotor + enddo + endif + call AD_GetExternalAccel(u_AD, y_IfW%AccelUVW, node, errStat, errMsg) + endif + end subroutine ADI_AD_InputSolve_IfW diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 95317cebfb..893576e16c 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -436,6 +436,8 @@ typedef ^ RotInputType ReKi InflowOnTower {:}{:} - - "U,V,W at nodes on the towe typedef ^ RotInputType ReKi InflowOnHub {3} - - "U,V,W at hub" m/s typedef ^ RotInputType ReKi InflowOnNacelle {3} - - "U,V,W at nacelle" m/s typedef ^ RotInputType ReKi InflowOnTailFin {3} - - "U,V,W at tailfin" m/s +typedef ^ RotInputType ReKi AccelOnBlade {:}{:}{:} - - "U,V,W accelerations at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s^2 +typedef ^ RotInputType ReKi AccelOnTower {:}{:} - - "U,V,W accelerations at nodes on the tower" m/s^2 typedef ^ RotInputType ReKi UserProp {:}{:} - - "Optional user property for interpolating airfoils (per element per blade)" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 075cf0c063..a7ff96882d 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -472,6 +472,8 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(1:3) :: InflowOnHub !< U,V,W at hub [m/s] REAL(ReKi) , DIMENSION(1:3) :: InflowOnNacelle !< U,V,W at nacelle [m/s] REAL(ReKi) , DIMENSION(1:3) :: InflowOnTailFin !< U,V,W at tailfin [m/s] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AccelOnBlade !< U,V,W accelerations at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s^2] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AccelOnTower !< U,V,W accelerations at nodes on the tower [m/s^2] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] END TYPE RotInputType ! ======================= @@ -16846,6 +16848,36 @@ SUBROUTINE AD_CopyRotInputType( SrcRotInputTypeData, DstRotInputTypeData, CtrlCo DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin +IF (ALLOCATED(SrcRotInputTypeData%AccelOnBlade)) THEN + i1_l = LBOUND(SrcRotInputTypeData%AccelOnBlade,1) + i1_u = UBOUND(SrcRotInputTypeData%AccelOnBlade,1) + i2_l = LBOUND(SrcRotInputTypeData%AccelOnBlade,2) + i2_u = UBOUND(SrcRotInputTypeData%AccelOnBlade,2) + i3_l = LBOUND(SrcRotInputTypeData%AccelOnBlade,3) + i3_u = UBOUND(SrcRotInputTypeData%AccelOnBlade,3) + IF (.NOT. ALLOCATED(DstRotInputTypeData%AccelOnBlade)) THEN + ALLOCATE(DstRotInputTypeData%AccelOnBlade(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%AccelOnBlade.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotInputTypeData%AccelOnBlade = SrcRotInputTypeData%AccelOnBlade +ENDIF +IF (ALLOCATED(SrcRotInputTypeData%AccelOnTower)) THEN + i1_l = LBOUND(SrcRotInputTypeData%AccelOnTower,1) + i1_u = UBOUND(SrcRotInputTypeData%AccelOnTower,1) + i2_l = LBOUND(SrcRotInputTypeData%AccelOnTower,2) + i2_u = UBOUND(SrcRotInputTypeData%AccelOnTower,2) + IF (.NOT. ALLOCATED(DstRotInputTypeData%AccelOnTower)) THEN + ALLOCATE(DstRotInputTypeData%AccelOnTower(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%AccelOnTower.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotInputTypeData%AccelOnTower = SrcRotInputTypeData%AccelOnTower +ENDIF IF (ALLOCATED(SrcRotInputTypeData%UserProp)) THEN i1_l = LBOUND(SrcRotInputTypeData%UserProp,1) i1_u = UBOUND(SrcRotInputTypeData%UserProp,1) @@ -16911,6 +16943,12 @@ SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(RotInputTypeData%InflowOnTower)) THEN DEALLOCATE(RotInputTypeData%InflowOnTower) ENDIF +IF (ALLOCATED(RotInputTypeData%AccelOnBlade)) THEN + DEALLOCATE(RotInputTypeData%AccelOnBlade) +ENDIF +IF (ALLOCATED(RotInputTypeData%AccelOnTower)) THEN + DEALLOCATE(RotInputTypeData%AccelOnTower) +ENDIF IF (ALLOCATED(RotInputTypeData%UserProp)) THEN DEALLOCATE(RotInputTypeData%UserProp) ENDIF @@ -17079,6 +17117,16 @@ SUBROUTINE AD_PackRotInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_BufSz = Re_BufSz + SIZE(InData%InflowOnHub) ! InflowOnHub Re_BufSz = Re_BufSz + SIZE(InData%InflowOnNacelle) ! InflowOnNacelle Re_BufSz = Re_BufSz + SIZE(InData%InflowOnTailFin) ! InflowOnTailFin + Int_BufSz = Int_BufSz + 1 ! AccelOnBlade allocated yes/no + IF ( ALLOCATED(InData%AccelOnBlade) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! AccelOnBlade upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AccelOnBlade) ! AccelOnBlade + END IF + Int_BufSz = Int_BufSz + 1 ! AccelOnTower allocated yes/no + IF ( ALLOCATED(InData%AccelOnTower) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AccelOnTower upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AccelOnTower) ! AccelOnTower + END IF Int_BufSz = Int_BufSz + 1 ! UserProp allocated yes/no IF ( ALLOCATED(InData%UserProp) ) THEN Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension @@ -17362,6 +17410,51 @@ SUBROUTINE AD_PackRotInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ReKiBuf(Re_Xferred) = InData%InflowOnTailFin(i1) Re_Xferred = Re_Xferred + 1 END DO + IF ( .NOT. ALLOCATED(InData%AccelOnBlade) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelOnBlade,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelOnBlade,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelOnBlade,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelOnBlade,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelOnBlade,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelOnBlade,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%AccelOnBlade,3), UBOUND(InData%AccelOnBlade,3) + DO i2 = LBOUND(InData%AccelOnBlade,2), UBOUND(InData%AccelOnBlade,2) + DO i1 = LBOUND(InData%AccelOnBlade,1), UBOUND(InData%AccelOnBlade,1) + ReKiBuf(Re_Xferred) = InData%AccelOnBlade(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AccelOnTower) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelOnTower,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelOnTower,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelOnTower,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelOnTower,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%AccelOnTower,2), UBOUND(InData%AccelOnTower,2) + DO i1 = LBOUND(InData%AccelOnTower,1), UBOUND(InData%AccelOnTower,1) + ReKiBuf(Re_Xferred) = InData%AccelOnTower(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -17754,6 +17847,57 @@ SUBROUTINE AD_UnPackRotInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%InflowOnTailFin(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccelOnBlade not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%AccelOnBlade)) DEALLOCATE(OutData%AccelOnBlade) + ALLOCATE(OutData%AccelOnBlade(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%AccelOnBlade.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%AccelOnBlade,3), UBOUND(OutData%AccelOnBlade,3) + DO i2 = LBOUND(OutData%AccelOnBlade,2), UBOUND(OutData%AccelOnBlade,2) + DO i1 = LBOUND(OutData%AccelOnBlade,1), UBOUND(OutData%AccelOnBlade,1) + OutData%AccelOnBlade(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccelOnTower not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AccelOnTower)) DEALLOCATE(OutData%AccelOnTower) + ALLOCATE(OutData%AccelOnTower(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelOnTower.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%AccelOnTower,2), UBOUND(OutData%AccelOnTower,2) + DO i1 = LBOUND(OutData%AccelOnTower,1), UBOUND(OutData%AccelOnTower,1) + OutData%AccelOnTower(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -19263,6 +19407,28 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) END DO ENDDO DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) +IF (ALLOCATED(u_out%rotors(i01)%AccelOnBlade) .AND. ALLOCATED(u1%rotors(i01)%AccelOnBlade)) THEN + DO i3 = LBOUND(u_out%rotors(i01)%AccelOnBlade,3),UBOUND(u_out%rotors(i01)%AccelOnBlade,3) + DO i2 = LBOUND(u_out%rotors(i01)%AccelOnBlade,2),UBOUND(u_out%rotors(i01)%AccelOnBlade,2) + DO i1 = LBOUND(u_out%rotors(i01)%AccelOnBlade,1),UBOUND(u_out%rotors(i01)%AccelOnBlade,1) + b = -(u1%rotors(i01)%AccelOnBlade(i1,i2,i3) - u2%rotors(i01)%AccelOnBlade(i1,i2,i3)) + u_out%rotors(i01)%AccelOnBlade(i1,i2,i3) = u1%rotors(i01)%AccelOnBlade(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO +END IF ! check if allocated + ENDDO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) +IF (ALLOCATED(u_out%rotors(i01)%AccelOnTower) .AND. ALLOCATED(u1%rotors(i01)%AccelOnTower)) THEN + DO i2 = LBOUND(u_out%rotors(i01)%AccelOnTower,2),UBOUND(u_out%rotors(i01)%AccelOnTower,2) + DO i1 = LBOUND(u_out%rotors(i01)%AccelOnTower,1),UBOUND(u_out%rotors(i01)%AccelOnTower,1) + b = -(u1%rotors(i01)%AccelOnTower(i1,i2) - u2%rotors(i01)%AccelOnTower(i1,i2)) + u_out%rotors(i01)%AccelOnTower(i1,i2) = u1%rotors(i01)%AccelOnTower(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated + ENDDO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN DO i2 = LBOUND(u_out%rotors(i01)%UserProp,2),UBOUND(u_out%rotors(i01)%UserProp,2) DO i1 = LBOUND(u_out%rotors(i01)%UserProp,1),UBOUND(u_out%rotors(i01)%UserProp,1) @@ -19421,6 +19587,30 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM END DO ENDDO DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) +IF (ALLOCATED(u_out%rotors(i01)%AccelOnBlade) .AND. ALLOCATED(u1%rotors(i01)%AccelOnBlade)) THEN + DO i3 = LBOUND(u_out%rotors(i01)%AccelOnBlade,3),UBOUND(u_out%rotors(i01)%AccelOnBlade,3) + DO i2 = LBOUND(u_out%rotors(i01)%AccelOnBlade,2),UBOUND(u_out%rotors(i01)%AccelOnBlade,2) + DO i1 = LBOUND(u_out%rotors(i01)%AccelOnBlade,1),UBOUND(u_out%rotors(i01)%AccelOnBlade,1) + b = (t(3)**2*(u1%rotors(i01)%AccelOnBlade(i1,i2,i3) - u2%rotors(i01)%AccelOnBlade(i1,i2,i3)) + t(2)**2*(-u1%rotors(i01)%AccelOnBlade(i1,i2,i3) + u3%rotors(i01)%AccelOnBlade(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%rotors(i01)%AccelOnBlade(i1,i2,i3) + t(3)*u2%rotors(i01)%AccelOnBlade(i1,i2,i3) - t(2)*u3%rotors(i01)%AccelOnBlade(i1,i2,i3) ) * scaleFactor + u_out%rotors(i01)%AccelOnBlade(i1,i2,i3) = u1%rotors(i01)%AccelOnBlade(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO +END IF ! check if allocated + ENDDO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) +IF (ALLOCATED(u_out%rotors(i01)%AccelOnTower) .AND. ALLOCATED(u1%rotors(i01)%AccelOnTower)) THEN + DO i2 = LBOUND(u_out%rotors(i01)%AccelOnTower,2),UBOUND(u_out%rotors(i01)%AccelOnTower,2) + DO i1 = LBOUND(u_out%rotors(i01)%AccelOnTower,1),UBOUND(u_out%rotors(i01)%AccelOnTower,1) + b = (t(3)**2*(u1%rotors(i01)%AccelOnTower(i1,i2) - u2%rotors(i01)%AccelOnTower(i1,i2)) + t(2)**2*(-u1%rotors(i01)%AccelOnTower(i1,i2) + u3%rotors(i01)%AccelOnTower(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%rotors(i01)%AccelOnTower(i1,i2) + t(3)*u2%rotors(i01)%AccelOnTower(i1,i2) - t(2)*u3%rotors(i01)%AccelOnTower(i1,i2) ) * scaleFactor + u_out%rotors(i01)%AccelOnTower(i1,i2) = u1%rotors(i01)%AccelOnTower(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated + ENDDO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN DO i2 = LBOUND(u_out%rotors(i01)%UserProp,2),UBOUND(u_out%rotors(i01)%UserProp,2) DO i1 = LBOUND(u_out%rotors(i01)%UserProp,1),UBOUND(u_out%rotors(i01)%UserProp,1) diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 1f6653285c..a46ea1e101 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -515,9 +515,19 @@ SUBROUTINE AD_InputSolve_IfW( p_FAST, u_AD, y_IfW, y_OpFM, ErrStat, ErrMsg ) node = 1 end if - ! Set the external wind from inflowwin into the AeroDyn inputs. Node counter is incremented + ! Set the external wind from inflowwind into the AeroDyn inputs. Node counter is incremented call AD_GetExternalWind(u_AD, y_IfW%VelocityUVW, node, errStat, errMsg) + ! Set the external accelerations from inflowwind into the AeroDyn inputs. Node counter is incremented + if (p_FAST%MHK > 0) then + if (p_FAST%CompServo == MODULE_SrvD) then + node = 2 + else + node = 1 + end if + call AD_GetExternalAccel(u_AD, y_IfW%AccelUVW, node, errStat, errMsg) + end if + ELSEIF ( p_FAST%CompInflow == MODULE_OpFM ) THEN node = 2 !start of inputs to AD15 From fff5430b47dea3c96af023437ccf41547db9806d Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Tue, 2 May 2023 13:10:22 -0600 Subject: [PATCH 008/319] Initialize inflow accelerations for AeroDyn driver --- modules/aerodyn/src/AeroDyn_Inflow.f90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 0ced9cce9e..96dfe56242 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -334,6 +334,10 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt call AllocAry(IW%y%VelocityUVW, 3, InitInData%NumWindPoints, 'VelocityUVW', errStat2, errMsg2); if (Failed()) return IW%u%PositionXYZ = myNaN IW%y%VelocityUVW = myNaN + if (i_IW%MHK > 0) then + call AllocAry(IW%y%AccelUVW, 3, InitInData%NumWindPoints, 'AccelUVW', errStat2, errMsg2); if (Failed()) return + IW%y%AccelUVW = myNaN + endif else ! Module init InitInData%InputFileName = i_IW%InputFile @@ -344,6 +348,7 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt endif InitInData%RootName = trim(Root)//'.IfW' InitInData%MHK = i_IW%MHK + InitInData%OutputAccel = InitInData%MHK > 0 CALL InflowWind_Init( InitInData, IW%u, IW%p, & IW%x, IW%xd, IW%z, IW%OtherSt, & IW%y, IW%m, dt, InitOutData, errStat2, errMsg2 ) @@ -490,7 +495,10 @@ subroutine ADI_CalcOutput_IW(t, u_IfW, IW, errStat, errMsg) IW%y%VelocityUVW(1,j) = IW%HWindSpeed*(z/IW%RefHt)**IW%PLExp IW%y%VelocityUVW(2,j) = 0.0_ReKi !V IW%y%VelocityUVW(3,j) = 0.0_ReKi !W - end do + end do + if (allocated(IW%y%AccelUVW)) then + IW%y%AccelUVW(:,j) = 0.0_ReKi + endif !$OMP END DO !$OMP END PARALLEL endif @@ -522,6 +530,8 @@ subroutine ADI_AD_InputSolve_IfW(p_AD, u_AD, y_IfW, hubHeightFirst, errStat, err call AD_GetExternalWind(u_AD, y_IfW%VelocityUVW, node, errStat, errMsg) if ( p_AD%MHK > 0 ) then + node = 1 + ! Order important! if (hubHeightFirst) then do iWT=1,size(u_AD%rotors) node = node + 1 ! Hub velocities for each rotor From a06c51122a4b8649b8b1dae08906110655c43f60 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Tue, 2 May 2023 15:29:06 -0600 Subject: [PATCH 009/319] Calculate blade and tower inertia loads --- modules/aerodyn/src/AeroDyn.f90 | 74 ++++++++++-- modules/aerodyn/src/AeroDyn_Registry.txt | 2 + modules/aerodyn/src/AeroDyn_Types.f90 | 144 +++++++++++++++++++++++ 3 files changed, 213 insertions(+), 7 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 3c987d85f7..47decaa8e6 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -398,7 +398,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !............................................................................................ do iR = 1, nRotors if ( p%rotors(iR)%MHK > 0 ) then - call SetInertiaAddedMassParameters( InputFileData%rotors(iR), p%rotors(iR), ErrStat2, ErrMsg2 ) + call SetAddedMassInertiaParameters( InputFileData%rotors(iR), p%rotors(iR), ErrStat2, ErrMsg2 ) if (Failed()) return; end if end do @@ -864,9 +864,13 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':T_P_2_T_L') if (ErrStat >= AbortErrLev) RETURN - + + call AllocAry( m%TwrFI, 3_IntKi, p%NumTwrNds, 'm%TwrFI', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) end if - + + call AllocAry( m%BlFI, 3_IntKi, p%NumBlNds, p%numBlades, 'm%BlFI', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) end if ! @@ -1491,7 +1495,7 @@ subroutine SetBuoyancyParameters( InputFileData, u, p, ErrStat, ErrMsg ) end subroutine SetBuoyancyParameters !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets parameters for use during the inertia and added mass calculations; these variables are not changed after AD_Init. -subroutine SetInertiaAddedMassParameters( InputFileData, p, ErrStat, ErrMsg ) +subroutine SetAddedMassInertiaParameters( InputFileData, p, ErrStat, ErrMsg ) TYPE(RotInputFile), INTENT(IN ) :: InputFileData !< All the data in the AeroDyn input file TYPE(RotParameterType), INTENT(INOUT) :: p !< Parameters INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -1504,7 +1508,7 @@ subroutine SetInertiaAddedMassParameters( InputFileData, p, ErrStat, ErrMsg ) INTEGER(IntKi) :: k !< Loop counter for blades INTEGER(IntKi) :: j !< Loop counter for nodes - CHARACTER(*), PARAMETER :: RoutineName = 'SetInertiaAddedMassParameters' + CHARACTER(*), PARAMETER :: RoutineName = 'SetAddedMassInertiaParameters' ! Initialize variables for this routine @@ -1554,7 +1558,7 @@ subroutine SetInertiaAddedMassParameters( InputFileData, p, ErrStat, ErrMsg ) end if -end subroutine SetInertiaAddedMassParameters +end subroutine SetAddedMassInertiaParameters !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) @@ -2425,27 +2429,83 @@ subroutine CalcAddedMassInertiaLoads( u, p, m, y, ErrStat, ErrMsg ) ! Local variables INTEGER(IntKi) :: k !< Loop counter for blades INTEGER(IntKi) :: j !< Loop counter for nodes + REAL(ReKi), DIMENSION(3) :: aBTemp !< Inflow acceleration at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: BlFItmp !< Inertia force at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: aTTemp !< Inflow acceleration at tower node in local coordinates + REAL(ReKi), DIMENSION(3) :: TwrFItmp !< Inertia force at tower node in local coordinates CHARACTER(*), PARAMETER :: RoutineName = 'CalcAddedMassInertiaLoads' ! Initialize variables for this routine ErrStat = ErrID_None ErrMsg = "" + aBTemp = 0.0_ReKi + BlFItmp = 0.0_ReKi + aTTemp = 0.0_ReKi + TwrFItmp = 0.0_ReKi ! Blades do k = 1,p%NumBlades ! loop through all blades do j = 1,p%NumBlNds ! loop through all nodes ! Convert fluid acceleration at node to local blade coordinates + aBTemp = matmul( u%BladeMotion(k)%Orientation(:,:,j), u%AccelOnBlade(:,j,k) ) ! Calculate per-unit-length inertia forces at node + BlFItmp(1) = p%BlIN(j,k) * aBTemp(1) + BlFItmp(2) = p%BlIT(j,k) * aBTemp(2) + BlFItmp(3) = 0.0_ReKi ! Convert inertia forces to global coordinates + m%BlFI(:,j,k) = matmul( transpose(u%BladeMotion(k)%Orientation(:,:,j)), BlFItmp ) + + ! Convert body acceleration at node to local blade coordinates + + ! Calculate per-unit-length added mass forces at node - ! ... + ! Calculate per-unit-length added mass pitching moment at node + + ! Convert added mass forces and moments to global coordinates end do end do + + ! Add added mass and inertia loads to aerodynamic loads + do k = 1,p%NumBlades ! loop through all blades + do j = 1,p%NumBlNds ! loop through all nodes + y%BladeLoad(k)%Force(:,j) = y%BladeLoad(k)%Force(:,j) + m%BlFI(:,j,k) + end do ! j = nodes + end do ! k = blades + + ! Tower + if ( p%NumTwrNds > 0 ) then + do j = 1,p%NumTwrNds ! loop through all nodes + + ! Convert fluid acceleration at node to local tower coordinates + aTTemp = matmul( u%TowerMotion%Orientation(:,:,j), u%AccelOnTower(:,j) ) + + ! Calculate per-unit-length inertia forces at node + TwrFItmp(1) = p%TwrIT(j) * aTTemp(1) + TwrFItmp(2) = p%TwrIT(j) * aTTemp(2) + TwrFItmp(3) = 0.0_ReKi + + ! Convert inertia forces to global coordinates + m%TwrFI(:,j) = matmul( transpose(u%TowerMotion%Orientation(:,:,j)), TwrFItmp ) + + ! Convert body acceleration at node to local tower coordinates + + ! Calculate per-unit-length added mass forces at node + + ! Convert added mass forces to global coordinates + + end do + end if + + ! Add buoyant loads to aerodynamic loads + do j = 1,p%NumTwrNds ! loop through all nodes + y%TowerLoad%Force(:,j) = y%TowerLoad%Force(:,j) + m%TwrFI(:,j) + end do ! j = nodes + end subroutine CalcAddedMassInertiaLoads !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for solving for the residual of the constraint state equations diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 893576e16c..84b12519cd 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -301,6 +301,8 @@ typedef ^ RotMiscVarType ReKi HubFB {:} - - "buoyant force at hub node typedef ^ RotMiscVarType ReKi HubMB {:} - - "buoyant moment at hub node" Nm typedef ^ RotMiscVarType ReKi NacFB {:} - - "buoyant force at nacelle (tower top) node" N typedef ^ RotMiscVarType ReKi NacMB {:} - - "buoyant moment at nacelle (tower top) node" Nm +typedef ^ RotMiscVarType ReKi BlFI {:}{:}{:} - - "inertia force per unit length at blade node" N/m +typedef ^ RotMiscVarType ReKi TwrFI {:}{:} - - "inertia force per unit length at tower node" N/m typedef ^ RotMiscVarType MeshType BladeRootLoad {:} - - "meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only)" - typedef ^ RotMiscVarType MeshMapType B_L_2_R_P {:} - - "mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh" typedef ^ RotMiscVarType MeshType BladeBuoyLoadPoint {:} - - "point mesh for lumped buoyant blade loads" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index a7ff96882d..69500e8df4 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -341,6 +341,8 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubMB !< buoyant moment at hub node [Nm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFB !< buoyant force at nacelle (tower top) node [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMB !< buoyant moment at nacelle (tower top) node [Nm] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BlFI !< inertia force per unit length at blade node [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFI !< inertia force per unit length at tower node [N/m] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootLoad !< meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only) [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_R_P !< mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoadPoint !< point mesh for lumped buoyant blade loads [-] @@ -9686,6 +9688,36 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, END IF DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%BlFI)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%BlFI,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%BlFI,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%BlFI,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%BlFI,2) + i3_l = LBOUND(SrcRotMiscVarTypeData%BlFI,3) + i3_u = UBOUND(SrcRotMiscVarTypeData%BlFI,3) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BlFI)) THEN + ALLOCATE(DstRotMiscVarTypeData%BlFI(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlFI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%BlFI = SrcRotMiscVarTypeData%BlFI +ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%TwrFI)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%TwrFI,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%TwrFI,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%TwrFI,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%TwrFI,2) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrFI)) THEN + ALLOCATE(DstRotMiscVarTypeData%TwrFI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%TwrFI = SrcRotMiscVarTypeData%TwrFI +ENDIF IF (ALLOCATED(SrcRotMiscVarTypeData%BladeRootLoad)) THEN i1_l = LBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) i1_u = UBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) @@ -9914,6 +9946,12 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(RotMiscVarTypeData%NacMB)) THEN DEALLOCATE(RotMiscVarTypeData%NacMB) ENDIF +IF (ALLOCATED(RotMiscVarTypeData%BlFI)) THEN + DEALLOCATE(RotMiscVarTypeData%BlFI) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%TwrFI)) THEN + DEALLOCATE(RotMiscVarTypeData%TwrFI) +ENDIF IF (ALLOCATED(RotMiscVarTypeData%BladeRootLoad)) THEN DO i1 = LBOUND(RotMiscVarTypeData%BladeRootLoad,1), UBOUND(RotMiscVarTypeData%BladeRootLoad,1) CALL MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2 ) @@ -10276,6 +10314,16 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! NacMB upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%NacMB) ! NacMB END IF + Int_BufSz = Int_BufSz + 1 ! BlFI allocated yes/no + IF ( ALLOCATED(InData%BlFI) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! BlFI upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlFI) ! BlFI + END IF + Int_BufSz = Int_BufSz + 1 ! TwrFI allocated yes/no + IF ( ALLOCATED(InData%TwrFI) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TwrFI upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrFI) ! TwrFI + END IF Int_BufSz = Int_BufSz + 1 ! BladeRootLoad allocated yes/no IF ( ALLOCATED(InData%BladeRootLoad) ) THEN Int_BufSz = Int_BufSz + 2*1 ! BladeRootLoad upper/lower bounds for each dimension @@ -11250,6 +11298,51 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%BlFI) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFI,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFI,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFI,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFI,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFI,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFI,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%BlFI,3), UBOUND(InData%BlFI,3) + DO i2 = LBOUND(InData%BlFI,2), UBOUND(InData%BlFI,2) + DO i1 = LBOUND(InData%BlFI,1), UBOUND(InData%BlFI,1) + ReKiBuf(Re_Xferred) = InData%BlFI(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrFI) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFI,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFI,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFI,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFI,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TwrFI,2), UBOUND(InData%TwrFI,2) + DO i1 = LBOUND(InData%TwrFI,1), UBOUND(InData%TwrFI,1) + ReKiBuf(Re_Xferred) = InData%TwrFI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%BladeRootLoad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12564,6 +12657,57 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFI not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%BlFI)) DEALLOCATE(OutData%BlFI) + ALLOCATE(OutData%BlFI(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%BlFI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%BlFI,3), UBOUND(OutData%BlFI,3) + DO i2 = LBOUND(OutData%BlFI,2), UBOUND(OutData%BlFI,2) + DO i1 = LBOUND(OutData%BlFI,1), UBOUND(OutData%BlFI,1) + OutData%BlFI(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFI not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrFI)) DEALLOCATE(OutData%TwrFI) + ALLOCATE(OutData%TwrFI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TwrFI,2), UBOUND(OutData%TwrFI,2) + DO i1 = LBOUND(OutData%TwrFI,1), UBOUND(OutData%TwrFI,1) + OutData%TwrFI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootLoad not allocated Int_Xferred = Int_Xferred + 1 ELSE From 724bf3109f90c457e504fbdead5d6dfdfeef2e64 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Wed, 3 May 2023 09:08:53 -0600 Subject: [PATCH 010/319] Update r-tests --- modules/aerodyn/src/AeroDyn.f90 | 6 +++--- reg_tests/r-test | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 47decaa8e6..a3a9fe540c 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -2439,10 +2439,10 @@ subroutine CalcAddedMassInertiaLoads( u, p, m, y, ErrStat, ErrMsg ) ! Initialize variables for this routine ErrStat = ErrID_None ErrMsg = "" - aBTemp = 0.0_ReKi + aBTemp = 0.0_ReKi BlFItmp = 0.0_ReKi - aTTemp = 0.0_ReKi - TwrFItmp = 0.0_ReKi + aTTemp = 0.0_ReKi + TwrFItmp = 0.0_ReKi ! Blades do k = 1,p%NumBlades ! loop through all blades diff --git a/reg_tests/r-test b/reg_tests/r-test index d8a55e6530..e234fd8eba 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit d8a55e653014ce2870dddb09c76ed275f3c89ecc +Subproject commit e234fd8ebaa0e3b192a14e3205a785ff17c19ae7 From f4cd5225c3ca9dfc379aca94ecec8bbe2c87036b Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Wed, 3 May 2023 10:01:36 -0600 Subject: [PATCH 011/319] Fix initialization error for AccelUVW --- modules/aerodyn/src/AeroDyn_Inflow.f90 | 2 +- reg_tests/r-test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 96dfe56242..48eaa9fdd8 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -497,7 +497,7 @@ subroutine ADI_CalcOutput_IW(t, u_IfW, IW, errStat, errMsg) IW%y%VelocityUVW(3,j) = 0.0_ReKi !W end do if (allocated(IW%y%AccelUVW)) then - IW%y%AccelUVW(:,j) = 0.0_ReKi + IW%y%AccelUVW = 0.0_ReKi endif !$OMP END DO !$OMP END PARALLEL diff --git a/reg_tests/r-test b/reg_tests/r-test index e234fd8eba..409d9567aa 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit e234fd8ebaa0e3b192a14e3205a785ff17c19ae7 +Subproject commit 409d9567aaaf01030464669c4ca8afeb116dd21d From 9f96f7e536f889a8e49b07d871d34b8f9de4015b Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Wed, 3 May 2023 10:20:05 -0600 Subject: [PATCH 012/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 409d9567aa..41366f4c94 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 409d9567aaaf01030464669c4ca8afeb116dd21d +Subproject commit 41366f4c94c4fd2a1726820d315f4905ead8c435 From 3a928ac3d720cecbf6cb3b0c651860a5aaaad7d3 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Wed, 3 May 2023 16:25:04 -0600 Subject: [PATCH 013/319] Move initialization of AccelUVW in AeroDyn_Inflow --- modules/aerodyn/src/AeroDyn_Inflow.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 48eaa9fdd8..e9fee2350c 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -496,11 +496,11 @@ subroutine ADI_CalcOutput_IW(t, u_IfW, IW, errStat, errMsg) IW%y%VelocityUVW(2,j) = 0.0_ReKi !V IW%y%VelocityUVW(3,j) = 0.0_ReKi !W end do + !$OMP END DO + !$OMP END PARALLEL if (allocated(IW%y%AccelUVW)) then IW%y%AccelUVW = 0.0_ReKi endif - !$OMP END DO - !$OMP END PARALLEL endif end subroutine ADI_CalcOutput_IW !---------------------------------------------------------------------------------------------------------------------------------- From 731883eb8aba4ca181f85ebd4fea99c41bebc34c Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Tue, 9 May 2023 13:45:36 -0600 Subject: [PATCH 014/319] Calculate blade and tower added mass loads --- modules/aerodyn/src/AeroDyn.f90 | 69 +++++-- modules/aerodyn/src/AeroDyn_Registry.txt | 3 + modules/aerodyn/src/AeroDyn_Types.f90 | 222 +++++++++++++++++++++++ 3 files changed, 276 insertions(+), 18 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index a3a9fe540c..ebdfad2c14 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -867,10 +867,19 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) call AllocAry( m%TwrFI, 3_IntKi, p%NumTwrNds, 'm%TwrFI', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call AllocAry( m%TwrFA, 3_IntKi, p%NumTwrNds, 'm%TwrFA', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) end if call AllocAry( m%BlFI, 3_IntKi, p%NumBlNds, p%numBlades, 'm%BlFI', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call AllocAry( m%BlFA, 3_IntKi, p%NumBlNds, p%numBlades, 'm%BlFA', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call AllocAry( m%BlMA, 3_IntKi, p%NumBlNds, p%numBlades, 'm%BlMA', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) end if ! @@ -1191,6 +1200,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er ,TranslationVel = .true. & ,RotationVel = .true. & ,TranslationAcc = .true. & + ,RotationAcc = .true. & ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -1240,6 +1250,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er u%BladeMotion(k)%TranslationVel = 0.0_ReKi u%BladeMotion(k)%RotationVel = 0.0_ReKi u%BladeMotion(k)%TranslationAcc = 0.0_ReKi + u%BladeMotion(k)%RotationAcc = 0.0_ReKi @@ -2429,43 +2440,61 @@ subroutine CalcAddedMassInertiaLoads( u, p, m, y, ErrStat, ErrMsg ) ! Local variables INTEGER(IntKi) :: k !< Loop counter for blades INTEGER(IntKi) :: j !< Loop counter for nodes - REAL(ReKi), DIMENSION(3) :: aBTemp !< Inflow acceleration at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: aFBTemp !< Inflow acceleration at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: aBBTemp !< Body translational acceleration at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: alphaBBTemp !< Body rotational acceleration at blade node in local coordinates REAL(ReKi), DIMENSION(3) :: BlFItmp !< Inertia force at blade node in local coordinates - REAL(ReKi), DIMENSION(3) :: aTTemp !< Inflow acceleration at tower node in local coordinates + REAL(ReKi), DIMENSION(3) :: BlFAtmp !< Added mass force at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: BlMAtmp !< Added mass moment at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: aFTTemp !< Inflow acceleration at tower node in local coordinates + REAL(ReKi), DIMENSION(3) :: aBTTemp !< Body translational acceleration at tower node in local coordinates REAL(ReKi), DIMENSION(3) :: TwrFItmp !< Inertia force at tower node in local coordinates + REAL(ReKi), DIMENSION(3) :: TwrFAtmp !< Added mass force at tower node in local coordinates CHARACTER(*), PARAMETER :: RoutineName = 'CalcAddedMassInertiaLoads' ! Initialize variables for this routine - ErrStat = ErrID_None - ErrMsg = "" - aBTemp = 0.0_ReKi - BlFItmp = 0.0_ReKi - aTTemp = 0.0_ReKi - TwrFItmp = 0.0_ReKi + ErrStat = ErrID_None + ErrMsg = "" + aFBTemp = 0.0_ReKi + aBBTemp = 0.0_ReKi + alphaBBTemp = 0.0_ReKi + BlFItmp = 0.0_ReKi + BlFAtmp = 0.0_ReKi + BlMAtmp = 0.0_ReKi + aFTTemp = 0.0_ReKi + aBTTemp = 0.0_ReKi + TwrFItmp = 0.0_ReKi + TwrFAtmp = 0.0_ReKi ! Blades do k = 1,p%NumBlades ! loop through all blades do j = 1,p%NumBlNds ! loop through all nodes ! Convert fluid acceleration at node to local blade coordinates - aBTemp = matmul( u%BladeMotion(k)%Orientation(:,:,j), u%AccelOnBlade(:,j,k) ) + aFBTemp = matmul( u%BladeMotion(k)%Orientation(:,:,j), u%AccelOnBlade(:,j,k) ) ! Calculate per-unit-length inertia forces at node - BlFItmp(1) = p%BlIN(j,k) * aBTemp(1) - BlFItmp(2) = p%BlIT(j,k) * aBTemp(2) - BlFItmp(3) = 0.0_ReKi + BlFItmp(1) = p%BlIN(j,k) * aFBTemp(1) + BlFItmp(2) = p%BlIT(j,k) * aFBTemp(2) ! Convert inertia forces to global coordinates m%BlFI(:,j,k) = matmul( transpose(u%BladeMotion(k)%Orientation(:,:,j)), BlFItmp ) ! Convert body acceleration at node to local blade coordinates + aBBTemp = matmul( u%BladeMotion(k)%Orientation(:,:,j), u%BladeMotion(k)%TranslationAcc(:,j) ) + alphaBBTemp(3) = u%BladeMotion(k)%Orientation(3,1,j)*u%BladeMotion(k)%RotationAcc(1,j) + u%BladeMotion(k)%Orientation(3,2,j)*u%BladeMotion(k)%RotationAcc(2,j) + u%BladeMotion(k)%Orientation(3,3,j)*u%BladeMotion(k)%RotationAcc(3,j) ! Calculate per-unit-length added mass forces at node + BlFAtmp(1) = p%BlAN(j,k) * aBBTemp(1) + BlFAtmp(2) = p%BlAT(j,k) * aBBTemp(2) ! Calculate per-unit-length added mass pitching moment at node + BlMAtmp(3) = p%BlAM(j,k) * alphaBBTemp(3) ! Convert added mass forces and moments to global coordinates + m%BlFA(:,j,k) = matmul( transpose(u%BladeMotion(k)%Orientation(:,:,j)), BlFAtmp ) + m%BlMA(:,j,k) = matmul( transpose(u%BladeMotion(k)%Orientation(:,:,j)), BlMAtmp ) end do end do @@ -2473,7 +2502,8 @@ subroutine CalcAddedMassInertiaLoads( u, p, m, y, ErrStat, ErrMsg ) ! Add added mass and inertia loads to aerodynamic loads do k = 1,p%NumBlades ! loop through all blades do j = 1,p%NumBlNds ! loop through all nodes - y%BladeLoad(k)%Force(:,j) = y%BladeLoad(k)%Force(:,j) + m%BlFI(:,j,k) + y%BladeLoad(k)%Force(:,j) = y%BladeLoad(k)%Force(:,j) + m%BlFI(:,j,k) + m%BlFA(:,j,k) + y%BladeLoad(k)%Moment(:,j) = y%BladeLoad(k)%Moment(:,j) + m%BlMA(:,j,k) end do ! j = nodes end do ! k = blades @@ -2482,28 +2512,31 @@ subroutine CalcAddedMassInertiaLoads( u, p, m, y, ErrStat, ErrMsg ) do j = 1,p%NumTwrNds ! loop through all nodes ! Convert fluid acceleration at node to local tower coordinates - aTTemp = matmul( u%TowerMotion%Orientation(:,:,j), u%AccelOnTower(:,j) ) + aFTTemp = matmul( u%TowerMotion%Orientation(:,:,j), u%AccelOnTower(:,j) ) ! Calculate per-unit-length inertia forces at node - TwrFItmp(1) = p%TwrIT(j) * aTTemp(1) - TwrFItmp(2) = p%TwrIT(j) * aTTemp(2) - TwrFItmp(3) = 0.0_ReKi + TwrFItmp(1) = p%TwrIT(j) * aFTTemp(1) + TwrFItmp(2) = p%TwrIT(j) * aFTTemp(2) ! Convert inertia forces to global coordinates m%TwrFI(:,j) = matmul( transpose(u%TowerMotion%Orientation(:,:,j)), TwrFItmp ) ! Convert body acceleration at node to local tower coordinates + aBTTemp = matmul( u%TowerMotion%Orientation(:,:,j), u%TowerMotion%TranslationAcc(:,j) ) ! Calculate per-unit-length added mass forces at node + TwrFAtmp(1) = p%TwrAT(j) * aBTTemp(1) + TwrFAtmp(2) = p%TwrAT(j) * aBTTemp(2) ! Convert added mass forces to global coordinates + m%TwrFA(:,j) = matmul( transpose(u%TowerMotion%Orientation(:,:,j)), TwrFAtmp ) end do end if ! Add buoyant loads to aerodynamic loads do j = 1,p%NumTwrNds ! loop through all nodes - y%TowerLoad%Force(:,j) = y%TowerLoad%Force(:,j) + m%TwrFI(:,j) + y%TowerLoad%Force(:,j) = y%TowerLoad%Force(:,j) + m%TwrFI(:,j) + m%TwrFA(:,j) end do ! j = nodes end subroutine CalcAddedMassInertiaLoads diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 84b12519cd..e54dde5642 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -302,7 +302,10 @@ typedef ^ RotMiscVarType ReKi HubMB {:} - - "buoyant moment at hub node" typedef ^ RotMiscVarType ReKi NacFB {:} - - "buoyant force at nacelle (tower top) node" N typedef ^ RotMiscVarType ReKi NacMB {:} - - "buoyant moment at nacelle (tower top) node" Nm typedef ^ RotMiscVarType ReKi BlFI {:}{:}{:} - - "inertia force per unit length at blade node" N/m +typedef ^ RotMiscVarType ReKi BlFA {:}{:}{:} - - "added mass force per unit length at blade node" N/m +typedef ^ RotMiscVarType ReKi BlMA {:}{:}{:} - - "added mass moment per unit length at blade node" N/m typedef ^ RotMiscVarType ReKi TwrFI {:}{:} - - "inertia force per unit length at tower node" N/m +typedef ^ RotMiscVarType ReKi TwrFA {:}{:} - - "added mass force per unit length at tower node" N/m typedef ^ RotMiscVarType MeshType BladeRootLoad {:} - - "meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only)" - typedef ^ RotMiscVarType MeshMapType B_L_2_R_P {:} - - "mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh" typedef ^ RotMiscVarType MeshType BladeBuoyLoadPoint {:} - - "point mesh for lumped buoyant blade loads" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 69500e8df4..13d98f7c9e 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -342,7 +342,10 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFB !< buoyant force at nacelle (tower top) node [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMB !< buoyant moment at nacelle (tower top) node [Nm] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BlFI !< inertia force per unit length at blade node [N/m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BlFA !< added mass force per unit length at blade node [N/m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BlMA !< added mass moment per unit length at blade node [N/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFI !< inertia force per unit length at tower node [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFA !< added mass force per unit length at tower node [N/m] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootLoad !< meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only) [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_R_P !< mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoadPoint !< point mesh for lumped buoyant blade loads [-] @@ -9704,6 +9707,38 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, END IF DstRotMiscVarTypeData%BlFI = SrcRotMiscVarTypeData%BlFI ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%BlFA)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%BlFA,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%BlFA,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%BlFA,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%BlFA,2) + i3_l = LBOUND(SrcRotMiscVarTypeData%BlFA,3) + i3_u = UBOUND(SrcRotMiscVarTypeData%BlFA,3) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BlFA)) THEN + ALLOCATE(DstRotMiscVarTypeData%BlFA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlFA.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%BlFA = SrcRotMiscVarTypeData%BlFA +ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%BlMA)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%BlMA,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%BlMA,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%BlMA,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%BlMA,2) + i3_l = LBOUND(SrcRotMiscVarTypeData%BlMA,3) + i3_u = UBOUND(SrcRotMiscVarTypeData%BlMA,3) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BlMA)) THEN + ALLOCATE(DstRotMiscVarTypeData%BlMA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlMA.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%BlMA = SrcRotMiscVarTypeData%BlMA +ENDIF IF (ALLOCATED(SrcRotMiscVarTypeData%TwrFI)) THEN i1_l = LBOUND(SrcRotMiscVarTypeData%TwrFI,1) i1_u = UBOUND(SrcRotMiscVarTypeData%TwrFI,1) @@ -9718,6 +9753,20 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, END IF DstRotMiscVarTypeData%TwrFI = SrcRotMiscVarTypeData%TwrFI ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%TwrFA)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%TwrFA,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%TwrFA,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%TwrFA,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%TwrFA,2) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrFA)) THEN + ALLOCATE(DstRotMiscVarTypeData%TwrFA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFA.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%TwrFA = SrcRotMiscVarTypeData%TwrFA +ENDIF IF (ALLOCATED(SrcRotMiscVarTypeData%BladeRootLoad)) THEN i1_l = LBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) i1_u = UBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) @@ -9949,9 +9998,18 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(RotMiscVarTypeData%BlFI)) THEN DEALLOCATE(RotMiscVarTypeData%BlFI) ENDIF +IF (ALLOCATED(RotMiscVarTypeData%BlFA)) THEN + DEALLOCATE(RotMiscVarTypeData%BlFA) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%BlMA)) THEN + DEALLOCATE(RotMiscVarTypeData%BlMA) +ENDIF IF (ALLOCATED(RotMiscVarTypeData%TwrFI)) THEN DEALLOCATE(RotMiscVarTypeData%TwrFI) ENDIF +IF (ALLOCATED(RotMiscVarTypeData%TwrFA)) THEN + DEALLOCATE(RotMiscVarTypeData%TwrFA) +ENDIF IF (ALLOCATED(RotMiscVarTypeData%BladeRootLoad)) THEN DO i1 = LBOUND(RotMiscVarTypeData%BladeRootLoad,1), UBOUND(RotMiscVarTypeData%BladeRootLoad,1) CALL MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2 ) @@ -10319,11 +10377,26 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*3 ! BlFI upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%BlFI) ! BlFI END IF + Int_BufSz = Int_BufSz + 1 ! BlFA allocated yes/no + IF ( ALLOCATED(InData%BlFA) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! BlFA upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlFA) ! BlFA + END IF + Int_BufSz = Int_BufSz + 1 ! BlMA allocated yes/no + IF ( ALLOCATED(InData%BlMA) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! BlMA upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlMA) ! BlMA + END IF Int_BufSz = Int_BufSz + 1 ! TwrFI allocated yes/no IF ( ALLOCATED(InData%TwrFI) ) THEN Int_BufSz = Int_BufSz + 2*2 ! TwrFI upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%TwrFI) ! TwrFI END IF + Int_BufSz = Int_BufSz + 1 ! TwrFA allocated yes/no + IF ( ALLOCATED(InData%TwrFA) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TwrFA upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrFA) ! TwrFA + END IF Int_BufSz = Int_BufSz + 1 ! BladeRootLoad allocated yes/no IF ( ALLOCATED(InData%BladeRootLoad) ) THEN Int_BufSz = Int_BufSz + 2*1 ! BladeRootLoad upper/lower bounds for each dimension @@ -11323,6 +11396,56 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%BlFA) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFA,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFA,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFA,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFA,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFA,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFA,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%BlFA,3), UBOUND(InData%BlFA,3) + DO i2 = LBOUND(InData%BlFA,2), UBOUND(InData%BlFA,2) + DO i1 = LBOUND(InData%BlFA,1), UBOUND(InData%BlFA,1) + ReKiBuf(Re_Xferred) = InData%BlFA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlMA) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlMA,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMA,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlMA,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMA,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlMA,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMA,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%BlMA,3), UBOUND(InData%BlMA,3) + DO i2 = LBOUND(InData%BlMA,2), UBOUND(InData%BlMA,2) + DO i1 = LBOUND(InData%BlMA,1), UBOUND(InData%BlMA,1) + ReKiBuf(Re_Xferred) = InData%BlMA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%TwrFI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11343,6 +11466,26 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%TwrFA) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFA,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFA,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFA,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFA,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TwrFA,2), UBOUND(InData%TwrFA,2) + DO i1 = LBOUND(InData%TwrFA,1), UBOUND(InData%TwrFA,1) + ReKiBuf(Re_Xferred) = InData%TwrFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%BladeRootLoad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12685,6 +12828,62 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFA not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%BlFA)) DEALLOCATE(OutData%BlFA) + ALLOCATE(OutData%BlFA(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%BlFA.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%BlFA,3), UBOUND(OutData%BlFA,3) + DO i2 = LBOUND(OutData%BlFA,2), UBOUND(OutData%BlFA,2) + DO i1 = LBOUND(OutData%BlFA,1), UBOUND(OutData%BlFA,1) + OutData%BlFA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlMA not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%BlMA)) DEALLOCATE(OutData%BlMA) + ALLOCATE(OutData%BlMA(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%BlMA.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%BlMA,3), UBOUND(OutData%BlMA,3) + DO i2 = LBOUND(OutData%BlMA,2), UBOUND(OutData%BlMA,2) + DO i1 = LBOUND(OutData%BlMA,1), UBOUND(OutData%BlMA,1) + OutData%BlMA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12708,6 +12907,29 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFA not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrFA)) DEALLOCATE(OutData%TwrFA) + ALLOCATE(OutData%TwrFA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFA.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TwrFA,2), UBOUND(OutData%TwrFA,2) + DO i1 = LBOUND(OutData%TwrFA,1), UBOUND(OutData%TwrFA,1) + OutData%TwrFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootLoad not allocated Int_Xferred = Int_Xferred + 1 ELSE From 495d1998b2cf673e46ab66bcb9528538fbb2c7f5 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Tue, 9 May 2023 17:01:41 -0600 Subject: [PATCH 015/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 41366f4c94..82dcf71f8f 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 41366f4c94c4fd2a1726820d315f4905ead8c435 +Subproject commit 82dcf71f8fd4116edb7d916c16ecacf52ff9d7c7 From 6feb0e8aed5665c5776294c815d486be5e06698d Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Wed, 20 Sep 2023 17:06:48 -0600 Subject: [PATCH 016/319] Linking IfW FlowField to SeaSt WaveField for MHK turbines --- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 1 + modules/hydrodyn/src/Morison.f90 | 6 +- modules/openfast-library/src/FAST_Subs.f90 | 8 ++ modules/seastate/CMakeLists.txt | 2 +- modules/seastate/src/SeaSt_WaveField.f90 | 85 +++++++++++++++++-- modules/seastate/src/SeaSt_WaveField.txt | 6 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 41 ++++++++- modules/seastate/src/SeaState.f90 | 2 +- modules/seastate/src/SeaState_DriverCode.f90 | 1 + 9 files changed, 136 insertions(+), 16 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index aa09c9bc97..1ca42dc99a 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -178,6 +178,7 @@ PROGRAM HydroDynDriver call SeaSt_Init( InitInData_SeaSt, u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, Interval, InitOutData_SeaSt, ErrStat, ErrMsg ) SeaState_Initialized = .true. CALL CheckError() + p_SeaSt%WaveField%hasCurrField = .FALSE. if ( Interval /= drvrData%TimeInterval) then ErrMsg = 'The SeaState Module attempted to change timestep interval, but this is not allowed. The SeaState Module must use the Driver Interval.' diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 1192036db1..adde7e57d9 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2584,7 +2584,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !=============================================================================================== ! Calculate the fluid kinematics at all mesh nodes and store for use in the equations below - CALL WaveField_GetWaveKin( p%WaveField, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetWaveKin( p%WaveField, Time, m%DispNodePosHdn, .FALSE., .TRUE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Compute fluid velocity relative to the structure DO j = 1, p%NNodes @@ -3018,7 +3018,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Compute the distributed loads at the point of intersection between the member and the free surface ! !----------------------------------------------------------------------------------------------------! ! Get wave kinematics at the free-surface intersection. Set forceNodeInWater=.TRUE. to guarantee the free-surface intersection is in water. - CALL WaveField_GetNodeWaveKin( p%WaveField, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, Time, FSInt, .TRUE., .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynPFSInt = REAL(FDynP,ReKi) FVFSInt = REAL(FV, ReKi) @@ -4189,7 +4189,7 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat END IF ! Get fluid velocity at the joint - CALL WaveField_GetNodeWaveVel( p%WaveField, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVel( p%WaveField, Time, pos, .FALSE., .TRUE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV = REAL(FVTmp, ReKi) vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 837d3e0ab7..7002ea6952 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -811,6 +811,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + IF ( p_FAST%MHK .NE. 0_IntKi .AND. p_FAST%CompInflow == Module_IfW) THEN + ! Simulating an MHK turbine; load dynamic current from IfW + SeaSt%p%WaveField%CurrField => Init%OutData_IfW%FlowField + SeaSt%p%WaveField%hasCurrField = .TRUE. + ELSE + SeaSt%p%WaveField%hasCurrField = .FALSE. + END IF + ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup if ( p_FAST%CompHydro == Module_HD ) then Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave diff --git a/modules/seastate/CMakeLists.txt b/modules/seastate/CMakeLists.txt index a9d852866d..4a25f9231b 100644 --- a/modules/seastate/CMakeLists.txt +++ b/modules/seastate/CMakeLists.txt @@ -40,7 +40,7 @@ add_library(seastlib src/SeaSt_WaveField_Types.f90 src/SeaState_Types.f90 ) -target_link_libraries(seastlib nwtclibs versioninfolib) +target_link_libraries(seastlib ifwlib nwtclibs versioninfolib) # Driver add_executable(seastate_driver diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index c33c053aaf..c8f4d251cb 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -2,6 +2,7 @@ MODULE SeaSt_WaveField USE SeaState_Interp USE SeaSt_WaveField_Types +USE IfW_FlowField IMPLICIT NONE @@ -138,11 +139,12 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, Time, pos, r, n, ErrStat, Err END SUBROUTINE WaveField_GetNodeWaveNormal !-------------------- Subroutine for full wave field kinematics --------------------! -SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(3) LOGICAL, INTENT( IN ) :: forceNodeInWater + LOGICAL, INTENT( IN ) :: fetchDynCurrent REAL(SiKi), INTENT( OUT ) :: WaveElev1 REAL(SiKi), INTENT( OUT ) :: WaveElev2 REAL(SiKi), INTENT( OUT ) :: WaveElev @@ -155,7 +157,9 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nod INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) + REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) + INTEGER(IntKi) :: startNode + REAL(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveKin' @@ -291,21 +295,44 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nod END IF ! If wave stretching is on or off + IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN + startNode = 1 + PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) + posDummy(:,1) = pos + ALLOCATE(FV_DC(3,1), STAT=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Info, 'Error allocationg FV_DC', ErrStat, ErrMsg, RoutineName ) + return + end if + ALLOCATE(FA_DC(3,1), STAT=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Info, 'Error allocationg FA_DC', ErrStat, ErrMsg, RoutineName ) + return + end if + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, posDummy, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV = FV + nodeInWater * FV_DC(:,1) + FA = FA + nodeInWater * FA_DC(:,1) + END IF + END SUBROUTINE WaveField_GetNodeWaveKin !-------------------- Subroutine for wave field velocity only --------------------! -SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, FV, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(3) LOGICAL, INTENT( IN ) :: forceNodeInWater + LOGICAL, INTENT( IN ) :: fetchDynCurrent INTEGER(IntKi), INTENT( OUT ) :: nodeInWater REAL(SiKi), INTENT( OUT ) :: FV(3) INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None REAL(SiKi) :: WaveElev - REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) + REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) + REAL(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) + INTEGER(IntKi) :: startNode TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveVel' @@ -392,13 +419,28 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, nod END IF ! If wave stretching is on or off + IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN + startNode = 1 + PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) + posDummy(:,1) = pos + ALLOCATE(FV_DC(3,1), STAT=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Info, 'Error allocationg FV_DC', ErrStat, ErrMsg, RoutineName ) + return + end if + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, posDummy, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV = FV + nodeInWater * FV_DC(:,1) + END IF + END SUBROUTINE WaveField_GetNodeWaveVel -SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(:,:) LOGICAL, INTENT( IN ) :: forceNodeInWater + LOGICAL, INTENT( IN ) :: fetchDynCurrent REAL(SiKi), INTENT( OUT ) :: WaveElev1(:) REAL(SiKi), INTENT( OUT ) :: WaveElev2(:) REAL(SiKi), INTENT( OUT ) :: WaveElev(:) @@ -414,15 +456,17 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, nodeInW INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 - INTEGER(IntKi) :: NumPoints, i - REAL(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3) + INTEGER(IntKi) :: NumPoints, i, startNode + REAL(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3), PosOffset(3) + + REAL(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) ErrStat = ErrID_None ErrMsg = "" NumPoints = size(pos, dim=2) DO i = 1, NumPoints - CALL WaveField_GetNodeWaveKin( WaveField, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( WaveField, Time, pos(:,i), forceNodeInWater, .FALSE., nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynP(i) = REAL(FDynP_node,ReKi) FV(:, i) = REAL(FV_node, ReKi) @@ -432,6 +476,31 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, nodeInW END IF END DO + ! If dynamic current field from IfW is present, get velocity and acceleration contributions + IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN + startNode = 1 + PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) + ALLOCATE(FV_DC( 3, NumPoints ), STAT=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Info, 'Error allocationg FV_DC', ErrStat, ErrMsg, RoutineName ) + return + end if + ALLOCATE(FA_DC( 3, NumPoints ), STAT=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Info, 'Error allocationg FA_DC', ErrStat, ErrMsg, RoutineName ) + return + end if + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, pos, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Add contributions from IfW current field if node is in water + DO i = 1, NumPoints + FV(:,i) = FV(:,i) + nodeInWater(i) * FV_DC(:,i) + FA(:,i) = FA(:,i) + nodeInWater(i) * FA_DC(:,i) + END DO + + END IF + END SUBROUTINE WaveField_GetWaveKin END MODULE SeaSt_WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index d46f9fb211..9dae92e074 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -2,6 +2,7 @@ # Data structures for representing wave fields. # usefrom SeaState_Interp.txt +usefrom IfW_FlowField.txt #--------------------------------------------------------------------------------------------------------------------------------------------------------- # #--------------------------------------------------------------------------------------------------------------------------------------------------------- @@ -19,9 +20,10 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WaveElev2 {:}{:}{:} - - "Second order wave elevation" (m) typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "Parameter information from the SeaState Interpolation module" (-) typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" -typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) +typedef ^ ^ ReKi EffWtrDpth - - - "Effective water depth from the seabed to SWL" (-) typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (m) typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) - +typedef ^ ^ LOGICAL hasCurrField - - - "True if CurrField is populated for MHK simulations" (-) +typedef ^ ^ FlowFieldType *CurrField - - - "Pointer to FlowField type from InflowWind containing the dynamic current information" (-) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index c0626b5641..34a0881fc7 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -32,6 +32,7 @@ MODULE SeaSt_WaveField_Types !--------------------------------------------------------------------------------------------------------------------------------- USE SeaState_Interp_Types +USE IfW_FlowField_Types USE NWTC_Library IMPLICIT NONE ! ========= SeaSt_WaveFieldType ======= @@ -50,11 +51,13 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [(m)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< Parameter information from the SeaState Interpolation module [(-)] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] - REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Water depth [(-)] + REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Effective water depth from the seabed to SWL [(-)] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Vertical distance from mean sea level to still water level [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(m)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part [(m)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] + LOGICAL :: hasCurrField = .false. !< True if CurrField is populated for MHK simulations [(-)] + TYPE(FlowFieldType) , POINTER :: CurrField => NULL() !< Pointer to FlowField type from InflowWind containing the dynamic current information [(-)] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -257,6 +260,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr end if + DstSeaSt_WaveFieldTypeData%hasCurrField = SrcSeaSt_WaveFieldTypeData%hasCurrField + DstSeaSt_WaveFieldTypeData%CurrField => SrcSeaSt_WaveFieldTypeData%CurrField end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -315,12 +320,14 @@ subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, E if (allocated(SeaSt_WaveFieldTypeData%WaveDirArr)) then deallocate(SeaSt_WaveFieldTypeData%WaveDirArr) end if + nullify(SeaSt_WaveFieldTypeData%CurrField) end subroutine subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_WaveFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then @@ -401,6 +408,14 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) call RegPack(Buf, InData%WaveDirArr) end if + call RegPack(Buf, InData%hasCurrField) + call RegPack(Buf, associated(InData%CurrField)) + if (associated(InData%CurrField)) then + call RegPackPointer(Buf, c_loc(InData%CurrField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(Buf, InData%CurrField) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -411,6 +426,8 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) integer(IntKi) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) @@ -629,6 +646,28 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveDirArr) if (RegCheckErr(Buf, RoutineName)) return end if + call RegUnpack(Buf, OutData%hasCurrField) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%CurrField)) deallocate(OutData%CurrField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%CurrField) + else + allocate(OutData%CurrField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%CurrField) + call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%CurrField) ! CurrField + end if + else + OutData%CurrField => null() + end if end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index e12645a9fd..6c4c574d5d 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -857,7 +857,7 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveKin positionXYZ = (/p%WaveKinxi(i),p%WaveKinyi(i),p%WaveKinzi(i)/) - CALL WaveField_GetNodeWaveKin( p%WaveField, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, Time, positionXYZ, .FALSE., .TRUE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index ae6bad8550..4fa27c2e6b 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -208,6 +208,7 @@ program SeaStateDriver ! Clean up and exit call SeaSt_DvrCleanup() end if + p%WaveField%hasCurrField = .FALSE. if ( Interval /= drvrInitInp%TimeInterval) then call SetErrStat( ErrID_Fatal, 'The SeaState Module attempted to change timestep interval, but this is not allowed. The SeaState Module must use the Driver Interval.', ErrStat, ErrMsg, 'Driver') From 689db3009d2785d21447bf983596d51e6162fc19 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Wed, 20 Sep 2023 17:34:31 -0600 Subject: [PATCH 017/319] Fix PosOffset type --- modules/seastate/src/SeaSt_WaveField.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index c8f4d251cb..26554df768 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -457,7 +457,8 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, fetchDy CHARACTER(ErrMsgLen) :: errMsg2 INTEGER(IntKi) :: NumPoints, i, startNode - REAL(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3), PosOffset(3) + REAL(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3) + REAL(ReKi) :: PosOffset(3) REAL(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) From c48bebfc330c66a003c162b36ab08737fcc832fe Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Wed, 20 Sep 2023 18:10:19 -0600 Subject: [PATCH 018/319] SeaSt: Warn if CurrMod>0 and set CurrMod=0 when expecting IfW current field. --- modules/openfast-library/src/FAST_Subs.f90 | 6 ++++++ modules/seastate/src/SeaState.txt | 2 +- modules/seastate/src/SeaState_Input.f90 | 5 +++++ modules/seastate/src/SeaState_Types.f90 | 5 +++++ 4 files changed, 17 insertions(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 7002ea6952..75f00c3a47 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -798,6 +798,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_SeaSt%TMax = p_FAST%TMax + IF ( p_FAST%MHK .NE. 0_IntKi .AND. p_FAST%CompInflow == Module_IfW) THEN + Init%InData_SeaSt%hasCurrField = .TRUE. + ELSE + Init%InData_SeaSt%hasCurrField = .FALSE. + END IF + CALL SeaSt_Init( Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module( MODULE_SeaSt ), Init%OutData_SeaSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 64f94c59dc..129ffa959c 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -64,7 +64,7 @@ typedef ^ ^ ReKi Ptf typedef ^ ^ IntKi WrWvKinMod - 0 - "0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname]" - typedef ^ ^ LOGICAL HasIce - - - "Supplied by Driver: Whether this simulation has ice loading (flag)" - typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - - +typedef ^ ^ LOGICAL hasCurrField - - - "Flag to indicate whether to expect current field from IfW" - # # # Define outputs from the initialization routine here: diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 708a46827d..2eac7462a9 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -983,6 +983,11 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! CurrMod - Current profile model switch + if ( InitInp%hasCurrField ) then + call SetErrStat( ErrID_Warn,'Expecting current field from InflowWind. Setting CurrMod to 0.',ErrStat,ErrMsg,RoutineName) + InputFileData%Current%CurrMod = 0 + end if + if ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InputFileData%Current%CurrMod /= 1 ) .AND. ( InputFileData%Current%CurrMod /= 2 ) ) then call SetErrStat( ErrID_Fatal,'CurrMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 4bbcd889d9..ca7962af82 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -86,6 +86,7 @@ MODULE SeaState_Types INTEGER(IntKi) :: WrWvKinMod = 0 !< 0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname] [-] LOGICAL :: HasIce = .false. !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + LOGICAL :: hasCurrField = .false. !< Flag to indicate whether to expect current field from IfW [-] END TYPE SeaSt_InitInputType ! ======================= ! ========= SeaSt_InitOutputType ======= @@ -598,6 +599,7 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WrWvKinMod = SrcInitInputData%WrWvKinMod DstInitInputData%HasIce = SrcInitInputData%HasIce DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%hasCurrField = SrcInitInputData%hasCurrField end subroutine subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -641,6 +643,7 @@ subroutine SeaSt_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WrWvKinMod) call RegPack(Buf, InData%HasIce) call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%hasCurrField) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -695,6 +698,8 @@ subroutine SeaSt_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%hasCurrField) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) From 0891bc3fc1aaed36dcc6d753b35996f22af09fe2 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Thu, 21 Sep 2023 22:56:25 -0600 Subject: [PATCH 019/319] Linking SeaState WaveField to AeroDyn for MHK turbines --- modules/aerodyn/CMakeLists.txt | 2 +- modules/aerodyn/src/AeroDyn.f90 | 146 ++++++++---- modules/aerodyn/src/AeroDyn_Registry.txt | 3 +- modules/aerodyn/src/AeroDyn_Types.f90 | 31 +++ modules/openfast-library/src/FAST_Subs.f90 | 2 + modules/seastate/src/SeaSt_WaveField.f90 | 244 ++++++++++++++++++++- 6 files changed, 369 insertions(+), 59 deletions(-) diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index 0248f647e8..a156301b54 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -68,7 +68,7 @@ add_library(aerodynlib src/AeroDyn_Inflow.f90 src/AeroDyn_Inflow_Types.f90 ) -target_link_libraries(aerodynlib ifwlib nwtclibs) +target_link_libraries(aerodynlib ifwlib seastlib nwtclibs) # AeroDyn Driver Subs Library add_library(aerodyn_driver_subs diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 5373bd0f28..24371e78f6 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -32,6 +32,7 @@ module AeroDyn use FVW use FVW_Subs, only: FVW_AeroOuts use IfW_FlowField, only: IfW_FlowField_GetVelAcc + use SeaSt_WaveField, only: WaveField_GetWaveVelAcc_AD implicit none @@ -1695,56 +1696,111 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) PosOffset = 0.0_ReKi end if - ! Hub - if (u%rotors(iWT)%HubMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%HubMotion%TranslationDisp + u%rotors(iWT)%HubMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - else - u%rotors(iWT)%InflowOnHub = 0.0_ReKi - end if - StartNode = StartNode + 1 + if (p%rotors(iWT)%MHK .EQ. 0_IntKi) then ! Wind turbines + ! Hub + if (u%rotors(iWT)%HubMotion%Committed) then + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + real(u%rotors(iWT)%HubMotion%TranslationDisp + u%rotors(iWT)%HubMotion%Position, ReKi), & + u%rotors(iWT)%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + else + u%rotors(iWT)%InflowOnHub = 0.0_ReKi + end if + StartNode = StartNode + 1 - ! Blade - do k = 1, p%rotors(iWT)%NumBlades - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%BladeMotion(k)%TranslationDisp + u%rotors(iWT)%BladeMotion(k)%Position, ReKi), & - u%rotors(iWT)%Bld(k)%InflowOnBlade, u%rotors(iWT)%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + p%rotors(iWT)%NumBlNds - end do + ! Blade + do k = 1, p%rotors(iWT)%NumBlades + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + real(u%rotors(iWT)%BladeMotion(k)%TranslationDisp + u%rotors(iWT)%BladeMotion(k)%Position, ReKi), & + u%rotors(iWT)%Bld(k)%InflowOnBlade, u%rotors(iWT)%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + p%rotors(iWT)%NumBlNds + end do - ! Tower - if (u%rotors(iWT)%TowerMotion%Nnodes > 0) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%TowerMotion%TranslationDisp + u%rotors(iWT)%TowerMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnTower, u%rotors(iWT)%AccelOnTower, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + p%rotors(iWT)%NumTwrNds - end if + ! Tower + if (u%rotors(iWT)%TowerMotion%Nnodes > 0) then + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + real(u%rotors(iWT)%TowerMotion%TranslationDisp + u%rotors(iWT)%TowerMotion%Position, ReKi), & + u%rotors(iWT)%InflowOnTower, u%rotors(iWT)%AccelOnTower, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + p%rotors(iWT)%NumTwrNds + end if - ! Nacelle - if (u%rotors(iWT)%NacelleMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%NacelleMotion%TranslationDisp + u%rotors(iWT)%NacelleMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + 1 - else - u%rotors(iWT)%InflowOnNacelle = 0.0_ReKi - end if + ! Nacelle + if (u%rotors(iWT)%NacelleMotion%Committed) then + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + real(u%rotors(iWT)%NacelleMotion%TranslationDisp + u%rotors(iWT)%NacelleMotion%Position, ReKi), & + u%rotors(iWT)%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + 1 + else + u%rotors(iWT)%InflowOnNacelle = 0.0_ReKi + end if - ! TailFin - if (u%rotors(iWT)%TFinMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%TFinMotion%TranslationDisp + u%rotors(iWT)%TFinMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return + ! TailFin + if (u%rotors(iWT)%TFinMotion%Committed) then + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + real(u%rotors(iWT)%TFinMotion%TranslationDisp + u%rotors(iWT)%TFinMotion%Position, ReKi), & + u%rotors(iWT)%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + 1 + else + u%rotors(iWT)%InflowOnTailFin = 0.0_ReKi + end if + + else ! MHK turbines + ! Hub + if (u%rotors(iWT)%HubMotion%Committed) then + call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + real(u%rotors(iWT)%HubMotion%TranslationDisp + u%rotors(iWT)%HubMotion%Position, ReKi), & + u%rotors(iWT)%InflowOnHub, NoAcc, ErrStat2, ErrMsg2) + if(Failed()) return + else + u%rotors(iWT)%InflowOnHub = 0.0_ReKi + end if StartNode = StartNode + 1 - else - u%rotors(iWT)%InflowOnTailFin = 0.0_ReKi - end if + + ! Blade + do k = 1, p%rotors(iWT)%NumBlades + call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + real(u%rotors(iWT)%BladeMotion(k)%TranslationDisp + u%rotors(iWT)%BladeMotion(k)%Position, ReKi), & + u%rotors(iWT)%Bld(k)%InflowOnBlade, u%rotors(iWT)%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2) + if(Failed()) return + StartNode = StartNode + p%rotors(iWT)%NumBlNds + end do + + ! Tower + if (u%rotors(iWT)%TowerMotion%Nnodes > 0) then + call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + real(u%rotors(iWT)%TowerMotion%TranslationDisp + u%rotors(iWT)%TowerMotion%Position, ReKi), & + u%rotors(iWT)%InflowOnTower, u%rotors(iWT)%AccelOnTower, ErrStat2, ErrMsg2) + if(Failed()) return + StartNode = StartNode + p%rotors(iWT)%NumTwrNds + end if + + ! Nacelle + if (u%rotors(iWT)%NacelleMotion%Committed) then + call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + real(u%rotors(iWT)%NacelleMotion%TranslationDisp + u%rotors(iWT)%NacelleMotion%Position, ReKi), & + u%rotors(iWT)%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2) + if(Failed()) return + StartNode = StartNode + 1 + else + u%rotors(iWT)%InflowOnNacelle = 0.0_ReKi + end if + + ! TailFin + if (u%rotors(iWT)%TFinMotion%Committed) then + call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + real(u%rotors(iWT)%TFinMotion%TranslationDisp + u%rotors(iWT)%TFinMotion%Position, ReKi), & + u%rotors(iWT)%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2) + if(Failed()) return + StartNode = StartNode + 1 + else + u%rotors(iWT)%InflowOnTailFin = 0.0_ReKi + end if + + end if ! Wind or MHK turbines enddo ! iWT diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index e24324836e..bbc77106ed 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -17,6 +17,7 @@ usefrom FVW_Registry.txt usefrom UnsteadyAero_Registry.txt usefrom AeroAcoustics_Registry.txt usefrom InflowWind.txt +usefrom SeaSt_WaveField.txt param AeroDyn/AD - IntKi ModelUnknown - -1 - "" - param ^ - IntKi WakeMod_none - 0 - "Wake model - none" - @@ -410,7 +411,7 @@ typedef ^ ParameterType FVW_ParameterType FVW - - - "Parameters for FVW module" typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ ParameterType LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - typedef ^ ParameterType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - - +typedef ^ ParameterType SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field data type" - # ..... Inputs .................................................................................................................... typedef ^ BldInputType ReKi InflowOnBlade {:}{:} - - "U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 47acb4d235..48c6328430 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -36,6 +36,7 @@ MODULE AeroDyn_Types USE FVW_Types USE AeroAcoustics_Types USE InflowWind_Types +USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: ModelUnknown = -1 ! [-] @@ -447,6 +448,7 @@ MODULE AeroDyn_Types LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field data type [-] END TYPE AD_ParameterType ! ======================= ! ========= BldInputType ======= @@ -6336,6 +6338,7 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps DstParamData%UA_Flag = SrcParamData%UA_Flag DstParamData%FlowField => SrcParamData%FlowField + DstParamData%WaveField => SrcParamData%WaveField end subroutine subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -6370,6 +6373,7 @@ subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(ParamData%FlowField) + nullify(ParamData%WaveField) end subroutine subroutine AD_PackParam(Buf, Indata) @@ -6412,6 +6416,13 @@ subroutine AD_PackParam(Buf, Indata) call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) end if end if + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6489,6 +6500,26 @@ subroutine AD_UnPackParam(Buf, OutData) else OutData%FlowField => null() end if + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if end subroutine subroutine AD_CopyBldInputType(SrcBldInputTypeData, DstBldInputTypeData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 75f00c3a47..3b6527dd75 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -821,6 +821,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Simulating an MHK turbine; load dynamic current from IfW SeaSt%p%WaveField%CurrField => Init%OutData_IfW%FlowField SeaSt%p%WaveField%hasCurrField = .TRUE. + ! Set AD pointers to wavefield + IF (p_FAST%CompAero == Module_AD) AD%p%WaveField => Init%OutData_SeaSt%WaveField ELSE SeaSt%p%WaveField%hasCurrField = .FALSE. END IF diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 26554df768..0723eb3d39 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -2,7 +2,7 @@ MODULE SeaSt_WaveField USE SeaState_Interp USE SeaSt_WaveField_Types -USE IfW_FlowField +USE IfW_FlowField, only: IfW_FlowField_GetVelAcc IMPLICIT NONE @@ -15,8 +15,9 @@ MODULE SeaSt_WaveField PUBLIC WaveField_GetNodeWaveNormal PUBLIC WaveField_GetNodeWaveKin PUBLIC WaveField_GetNodeWaveVel - +PUBLIC WaveField_GetNodeWaveVelAcc PUBLIC WaveField_GetWaveKin +PUBLIC WaveField_GetWaveVelAcc_AD CONTAINS @@ -259,7 +260,7 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, fet END IF END IF - END IF ! Node is submerged + END IF ! Node is above or below SWL ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL @@ -296,17 +297,17 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, fet END IF ! If wave stretching is on or off IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN - startNode = 1 + startNode = -1 PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) posDummy(:,1) = pos ALLOCATE(FV_DC(3,1), STAT=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Info, 'Error allocationg FV_DC', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Info, 'Error allocating FV_DC', ErrStat, ErrMsg, RoutineName ) return end if ALLOCATE(FA_DC(3,1), STAT=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Info, 'Error allocationg FA_DC', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Info, 'Error allocating FA_DC', ErrStat, ErrMsg, RoutineName ) return end if CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, posDummy, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset) @@ -393,7 +394,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fet CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - END IF ! Node is submerged + END IF ! Node is above or below SWL ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL @@ -420,12 +421,12 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fet END IF ! If wave stretching is on or off IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN - startNode = 1 + startNode = -1 PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) posDummy(:,1) = pos ALLOCATE(FV_DC(3,1), STAT=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Info, 'Error allocationg FV_DC', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Info, 'Error allocating FV_DC', ErrStat, ErrMsg, RoutineName ) return end if CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, posDummy, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset) @@ -435,6 +436,143 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fet END SUBROUTINE WaveField_GetNodeWaveVel +SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, FV, FA, ErrStat, ErrMsg ) + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + REAL(DbKi), INTENT( IN ) :: Time + REAL(ReKi), INTENT( IN ) :: pos(3) + LOGICAL, INTENT( IN ) :: forceNodeInWater + LOGICAL, INTENT( IN ) :: fetchDynCurrent + REAL(SiKi), INTENT( OUT ) :: FV(3) + REAL(SiKi), INTENT( OUT ) :: FA(3) + INTEGER(IntKi), INTENT( OUT ) :: nodeInWater + + INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None + + REAL(SiKi) :: WaveElev + REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) + INTEGER(IntKi) :: startNode + REAL(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) + TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m + LOGICAL :: FirstWarn_Clamp + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveVelAcc' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + posXY = pos(1:2) + posXY0 = (/pos(1),pos(2),0.0_ReKi/) + + ! Wave elevation + WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (WaveField%WaveStMod == 0) THEN ! No wave stretching + + IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL + nodeInWater = 1_IntKi + ! Use location to obtain interpolated values of kinematics + CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE ! Node is above the SWL + nodeInWater = 0_IntKi + FV(:) = 0.0 + FA(:) = 0.0 + END IF + + ELSE ! Wave stretching enabled + + IF ( (pos(3) <= WaveElev) .OR. forceNodeInWater ) THEN ! Node is submerged + + nodeInWater = 1_IntKi + + IF ( WaveField%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching + + IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual + + ! Use location to obtain interpolated values of kinematics + CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE ! Node is above SWL - need wave stretching + + ! Vertical wave stretching + CALL SeaSt_Interp_Setup( Time, posXY0, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV(:) = SeaSt_Interp_4D_vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FA(:) = SeaSt_Interp_4D_vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Extrapoled wave stretching + IF (WaveField%WaveStMod == 2) THEN + FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + END IF ! Node is above or below SWL + + ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL + + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] + posPrime = pos + posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth + posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. + + ! Obtain the wave-field variables by interpolation with the mapped position. + CALL SeaSt_Interp_Setup( Time, posPrime, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF ! Wave stretching method + + ELSE ! Node is out of water - zero-out all wave dynamics + + nodeInWater = 0_IntKi + FV(:) = 0.0 + FA(:) = 0.0 + + END IF ! If node is in or out of water + + END IF ! If wave stretching is on or off + + IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN + startNode = -1 + PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) + posDummy(:,1) = pos + ALLOCATE(FV_DC(3,1), STAT=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Info, 'Error allocating FV_DC', ErrStat, ErrMsg, RoutineName ) + return + end if + ALLOCATE(FA_DC(3,1), STAT=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Info, 'Error allocating FA_DC', ErrStat, ErrMsg, RoutineName ) + return + end if + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, posDummy, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV = FV + nodeInWater * FV_DC(:,1) + FA = FA + nodeInWater * FA_DC(:,1) + END IF + +END SUBROUTINE WaveField_GetNodeWaveVelAcc + + SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField REAL(DbKi), INTENT( IN ) :: Time @@ -479,16 +617,16 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, fetchDy ! If dynamic current field from IfW is present, get velocity and acceleration contributions IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN - startNode = 1 + startNode = -1 PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) ALLOCATE(FV_DC( 3, NumPoints ), STAT=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Info, 'Error allocationg FV_DC', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Info, 'Error allocating FV_DC', ErrStat, ErrMsg, RoutineName ) return end if ALLOCATE(FA_DC( 3, NumPoints ), STAT=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Info, 'Error allocationg FA_DC', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Info, 'Error allocating FA_DC', ErrStat, ErrMsg, RoutineName ) return end if CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, pos, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset) @@ -504,4 +642,86 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, fetchDy END SUBROUTINE WaveField_GetWaveKin +! This subroutine is intended for AeroDyn when modeling MHK turbines +SUBROUTINE WaveField_GetWaveVelAcc_AD( WaveField, StartNode, Time, pos, FV, FA, ErrStat, ErrMsg ) + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + INTEGER(IntKi), INTENT( IN ) :: StartNode + REAL(DbKi), INTENT( IN ) :: Time + REAL(ReKi), INTENT( IN ) :: pos(:,:) ! z=0 at MSL + REAL(ReKi), INTENT( OUT ) :: FV(:,:) + REAL(ReKi), ALLOCATABLE, INTENT( OUT ) :: FA(:,:) + INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None + INTEGER(IntKi), ALLOCATABLE :: nodeInWater(:) + INTEGER(IntKi) :: NumPoints, i + REAL(SiKi) :: FV_node(3), FA_node(3) + REAL(ReKi) :: PosOffset(3), MSL2SWL, WtrDpth + REAL(ReKi), ALLOCATABLE :: FV_DC(:,:), FA_DC(:,:) + LOGICAL :: getAcc + + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetWaveVelAcc_AD' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + MSL2SWL = WaveField%MSL2SWL + WtrDpth = WaveField%EffWtrDpth - MSL2SWL + getAcc = ALLOCATED(FA) + NumPoints = size(pos, dim=2) + + ALLOCATE( nodeInWater(NumPoints), STAT=ErrStat2) + IF (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Info, 'Error allocating FA_DC', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + ! Note: SeaState wavefield grid has z=0 on the SWL + IF (getAcc) THEN + DO i = 1, NumPoints + CALL WaveField_GetNodeWaveVelAcc( WaveField, Time, pos(:,i)-(/0.0,0.0,MSL2SWL/), .FALSE., .FALSE., nodeInWater(i), FV_node, FA_node, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV(:, i) = REAL(FV_node, ReKi) + FA(:, i) = REAL(FA_node, ReKi) + END DO + ELSE + DO i = 1, NumPoints + CALL WaveField_GetNodeWaveVel( WaveField, Time, pos(:,i)-(/0.0,0.0,MSL2SWL/), .FALSE., .FALSE., nodeInWater(i), FV_node, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV(:, i) = REAL(FV_node, ReKi) + END DO + END IF + + ! If dynamic current field from IfW is present, get velocity and acceleration contributions + IF (WaveField%hasCurrField) THEN + PosOffset = (/0.0_ReKi,0.0_ReKi,WtrDpth/) ! IfW FlowField grid effectively has z=0 on the seabed + ALLOCATE(FV_DC( 3, NumPoints ), STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat( ErrID_Info, 'Error allocating FV_DC', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + IF (getAcc) THEN + ALLOCATE(FA_DC( 3, NumPoints ), STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat( ErrID_Info, 'Error allocating FA_DC', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + END IF + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, StartNode, Time, pos, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Add contributions from IfW current field if node is in water + DO i = 1, NumPoints + FV(:,i) = FV(:,i) + nodeInWater(i) * FV_DC(:,i) + END DO + IF (getAcc) THEN + DO i = 1, NumPoints + FA(:,i) = FA(:,i) + nodeInWater(i) * FA_DC(:,i) + END DO + END IF + END IF + +END SUBROUTINE WaveField_GetWaveVelAcc_AD + END MODULE SeaSt_WaveField From ec3b5cea56fc0a427816d31e405c6e32efed44b8 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Wed, 6 Dec 2023 17:05:39 -0700 Subject: [PATCH 020/319] Move FirstWarn_Clamp back in SeaSt_Interp_m and pass to AeroDyn --- modules/aerodyn/src/AeroDyn.f90 | 11 ++-- modules/aerodyn/src/AeroDyn_Registry.txt | 2 + modules/aerodyn/src/AeroDyn_Types.f90 | 9 +++ modules/hydrodyn/src/Morison.f90 | 4 +- modules/seastate/src/SeaSt_WaveField.f90 | 70 ++++++++++++------------ modules/seastate/src/SeaState.f90 | 4 +- 6 files changed, 55 insertions(+), 45 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index e27d1ed3d5..4e0d597697 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -32,6 +32,7 @@ module AeroDyn use FVW use FVW_Subs, only: FVW_AeroOuts use IfW_FlowField, only: IfW_FlowField_GetVelAcc + USE SeaState_Interp use SeaSt_WaveField, only: WaveField_GetWaveVelAcc_AD implicit none @@ -1882,7 +1883,7 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) else ! MHK turbines ! Hub if (u%rotors(iWT)%HubMotion%Committed) then - call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%HubMotion%TranslationDisp + u%rotors(iWT)%HubMotion%Position, ReKi), & u%rotors(iWT)%InflowOnHub, NoAcc, ErrStat2, ErrMsg2) if(Failed()) return @@ -1893,7 +1894,7 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) ! Blade do k = 1, p%rotors(iWT)%NumBlades - call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%BladeMotion(k)%TranslationDisp + u%rotors(iWT)%BladeMotion(k)%Position, ReKi), & u%rotors(iWT)%Bld(k)%InflowOnBlade, u%rotors(iWT)%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2) if(Failed()) return @@ -1902,7 +1903,7 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) ! Tower if (u%rotors(iWT)%TowerMotion%Nnodes > 0) then - call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%TowerMotion%TranslationDisp + u%rotors(iWT)%TowerMotion%Position, ReKi), & u%rotors(iWT)%InflowOnTower, u%rotors(iWT)%AccelOnTower, ErrStat2, ErrMsg2) if(Failed()) return @@ -1911,7 +1912,7 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) ! Nacelle if (u%rotors(iWT)%NacelleMotion%Committed) then - call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%NacelleMotion%TranslationDisp + u%rotors(iWT)%NacelleMotion%Position, ReKi), & u%rotors(iWT)%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2) if(Failed()) return @@ -1922,7 +1923,7 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) ! TailFin if (u%rotors(iWT)%TFinMotion%Committed) then - call WaveField_GetWaveVelAcc_AD(p%WaveField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%TFinMotion%TranslationDisp + u%rotors(iWT)%TFinMotion%Position, ReKi), & u%rotors(iWT)%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2) if(Failed()) return diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index d482129951..d48ba3e20c 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -17,6 +17,7 @@ usefrom FVW_Registry.txt usefrom UnsteadyAero_Registry.txt usefrom AeroAcoustics_Registry.txt usefrom InflowWind.txt +usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt param AeroDyn/AD - IntKi ModelUnknown - -1 - "" - @@ -340,6 +341,7 @@ typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - typedef ^ MiscVarType ReKi WindPos {:}{:} - - "XYZ coordinates to query for wind velocity/acceleration" - typedef ^ MiscVarType ReKi WindVel {:}{:} - - "XYZ components of wind velocity" - typedef ^ MiscVarType ReKi WindAcc {:}{:} - - "XYZ components of wind acceleration" - +typedef ^ MiscVarType SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "MiscVars from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 07d90e2d47..ced3000e2a 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -36,6 +36,7 @@ MODULE AeroDyn_Types USE FVW_Types USE AeroAcoustics_Types USE InflowWind_Types +USE SeaState_Interp_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE @@ -382,6 +383,7 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] + TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< MiscVars from the SeaState Interpolation module [-] END TYPE AD_MiscVarType ! ======================= ! ========= RotParameterType ======= @@ -5611,6 +5613,9 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%WindAcc = SrcMiscData%WindAcc end if + call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -5655,6 +5660,8 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%WindAcc)) then deallocate(MiscData%WindAcc) end if + call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackMisc(Buf, Indata) @@ -5699,6 +5706,7 @@ subroutine AD_PackMisc(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%WindAcc), ubound(InData%WindAcc)) call RegPack(Buf, InData%WindAcc) end if + call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5785,6 +5793,7 @@ subroutine AD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WindAcc) if (RegCheckErr(Buf, RoutineName)) return end if + call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 14adeb9e24..94cebe1281 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -3579,7 +3579,7 @@ SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, Time, pos, ErrStat2, ErrMsg2 ) + Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, m%SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE GetTotalWaveElev @@ -4212,7 +4212,7 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat END IF ! Get fluid velocity at the joint - CALL WaveField_GetNodeWaveVel( p%WaveField, Time, pos, .FALSE., .TRUE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVel( p%WaveField, m%SeaSt_Interp_m, Time, pos, .FALSE., .TRUE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV = REAL(FVTmp, ReKi) vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 21fb4a673d..a8dc9c7457 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -22,8 +22,9 @@ MODULE SeaSt_WaveField CONTAINS !-------------------- Subroutine for wave elevation ------------------! -FUNCTION WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) +FUNCTION WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation @@ -31,7 +32,6 @@ FUNCTION WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetNodeWaveElev1 REAL(SiKi) :: Zeta - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveElev1' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -40,7 +40,7 @@ FUNCTION WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev1)) THEN - Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE Zeta = 0.0_SiKi @@ -50,8 +50,9 @@ FUNCTION WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) END FUNCTION WaveField_GetNodeWaveElev1 -FUNCTION WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) +FUNCTION WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation @@ -59,7 +60,6 @@ FUNCTION WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetNodeWaveElev2 REAL(SiKi) :: Zeta - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveElev2' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -68,7 +68,7 @@ FUNCTION WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev2)) THEN - Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE Zeta = 0.0_SiKi @@ -78,8 +78,9 @@ FUNCTION WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) END FUNCTION WaveField_GetNodeWaveElev2 -FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) +FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation @@ -87,7 +88,6 @@ FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetNodeTotalWaveElev REAL(SiKi) :: Zeta1, Zeta2 - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeTotalWaveElev' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -95,9 +95,9 @@ FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - Zeta1 = WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + Zeta1 = WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta2 = WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + Zeta2 = WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveField_GetNodeTotalWaveElev = Zeta1 + Zeta2 @@ -123,15 +123,15 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, SeaSt_Interp_m, Time, pos, r, r1 = MAX(r,real(1.0e-6,ReKi)) ! In case r is zero - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ) + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ) + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) dZetadx = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ) + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ) + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) dZetady = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) @@ -143,6 +143,7 @@ END SUBROUTINE WaveField_GetNodeWaveNormal !-------------------- Subroutine for full wave field kinematics --------------------! SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT( INOUT ) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(3) LOGICAL, INTENT( IN ) :: forceNodeInWater @@ -162,8 +163,6 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, force REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) INTEGER(IntKi) :: startNode REAL(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveKin' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -176,9 +175,9 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, force FAMCF(:) = 0.0 ! Wave elevation - WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveElev = WaveElev1 + WaveElev2 @@ -249,14 +248,14 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, force ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = FDynP + SeaSt_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FDynP = FDynP + SeaSt_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF END IF @@ -320,8 +319,9 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, force END SUBROUTINE WaveField_GetNodeWaveKin !-------------------- Subroutine for wave field velocity only --------------------! -SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, FV, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveVel( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, FV, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(3) LOGICAL, INTENT( IN ) :: forceNodeInWater @@ -335,8 +335,6 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fet REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) REAL(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) INTEGER(IntKi) :: startNode - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveVel' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -348,7 +346,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fet posXY0 = (/pos(1),pos(2),0.0_ReKi/) ! Wave elevation - WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (WaveField%WaveStMod == 0) THEN ! No wave stretching @@ -391,7 +389,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fet ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -437,8 +435,9 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, fet END SUBROUTINE WaveField_GetNodeWaveVel -SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, FV, FA, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, FV, FA, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(3) LOGICAL, INTENT( IN ) :: forceNodeInWater @@ -453,8 +452,6 @@ SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, Time, pos, forceNodeInWater, REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) INTEGER(IntKi) :: startNode REAL(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveVelAcc' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -466,7 +463,7 @@ SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, Time, pos, forceNodeInWater, posXY0 = (/pos(1),pos(2),0.0_ReKi/) ! Wave elevation - WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (WaveField%WaveStMod == 0) THEN ! No wave stretching @@ -516,9 +513,9 @@ SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, Time, pos, forceNodeInWater, ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -644,8 +641,9 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNode END SUBROUTINE WaveField_GetWaveKin ! This subroutine is intended for AeroDyn when modeling MHK turbines -SUBROUTINE WaveField_GetWaveVelAcc_AD( WaveField, StartNode, Time, pos, FV, FA, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetWaveVelAcc_AD( WaveField, SeaSt_Interp_m, StartNode, Time, pos, FV, FA, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m INTEGER(IntKi), INTENT( IN ) :: StartNode REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(:,:) ! z=0 at MSL @@ -681,14 +679,14 @@ SUBROUTINE WaveField_GetWaveVelAcc_AD( WaveField, StartNode, Time, pos, FV, FA, ! Note: SeaState wavefield grid has z=0 on the SWL IF (getAcc) THEN DO i = 1, NumPoints - CALL WaveField_GetNodeWaveVelAcc( WaveField, Time, pos(:,i)-(/0.0,0.0,MSL2SWL/), .FALSE., .FALSE., nodeInWater(i), FV_node, FA_node, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVelAcc( WaveField, SeaSt_Interp_m, Time, pos(:,i)-(/0.0,0.0,MSL2SWL/), .FALSE., .FALSE., nodeInWater(i), FV_node, FA_node, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV(:, i) = REAL(FV_node, ReKi) FA(:, i) = REAL(FA_node, ReKi) END DO ELSE DO i = 1, NumPoints - CALL WaveField_GetNodeWaveVel( WaveField, Time, pos(:,i)-(/0.0,0.0,MSL2SWL/), .FALSE., .FALSE., nodeInWater(i), FV_node, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVel( WaveField, SeaSt_Interp_m, Time, pos(:,i)-(/0.0,0.0,MSL2SWL/), .FALSE., .FALSE., nodeInWater(i), FV_node, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV(:, i) = REAL(FV_node, ReKi) END DO diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index d453e93423..42e0eb746f 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -714,9 +714,9 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveElev positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) - WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, Time, positionXY, ErrStat2, ErrMsg2 ) + WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%SeaSt_Interp_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, Time, positionXY, ErrStat2, ErrMsg2 ) + WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%SeaSt_Interp_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveElev(i) = WaveElev1(i) + WaveElev2(i) END DO From 6157f88d7c344384f56790b7a9fffc998981c2f2 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 8 Dec 2023 12:15:52 -0700 Subject: [PATCH 021/319] Correct unallocated variable for MHK turbines --- modules/aerodyn/src/AeroDyn.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 4e0d597697..ce88454f23 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1129,7 +1129,9 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er if (p%NumTwrNds > 0) then u%InflowOnTower = 0.0_ReKi - u%AccelOnTower = 0.0_ReKi + if (p%MHK > 0) then + u%AccelOnTower = 0.0_ReKi + end if call MeshCreate ( BlankMesh = u%TowerMotion & ,IOS = COMPONENT_INPUT & From 5e72701665b195b66a952671a6f152a8c857bda1 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 8 Dec 2023 13:38:09 -0700 Subject: [PATCH 022/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index f524e20238..407bad1db1 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit f524e20238cfacc3f2383af247a8ac2009dd4234 +Subproject commit 407bad1db1c2f41cf02cb8bf4061e2b70a4d712b From 284f81631687ae0288f3bd91d8b458d7c5bf5cd0 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 8 Dec 2023 16:57:20 -0700 Subject: [PATCH 023/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 407bad1db1..f61e7f237f 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 407bad1db1c2f41cf02cb8bf4061e2b70a4d712b +Subproject commit f61e7f237fcf4fc572f561693faacfe67e5ded7d From 4ff1f2b3d2d8c8485689e41f1659e0f0cacdb580 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 11 Dec 2023 16:18:28 -0700 Subject: [PATCH 024/319] Change intent of FA variable in WaveField subroutine --- modules/seastate/src/SeaSt_WaveField.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index a8dc9c7457..65e461caa8 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -648,7 +648,7 @@ SUBROUTINE WaveField_GetWaveVelAcc_AD( WaveField, SeaSt_Interp_m, StartNode, Tim REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(:,:) ! z=0 at MSL REAL(ReKi), INTENT( OUT ) :: FV(:,:) - REAL(ReKi), ALLOCATABLE, INTENT( OUT ) :: FA(:,:) + REAL(ReKi), ALLOCATABLE, INTENT( INOUT ) :: FA(:,:) INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None INTEGER(IntKi), ALLOCATABLE :: nodeInWater(:) From 2621d630cb1068bedda5adefc2cea5f77676352c Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 11 Dec 2023 16:20:16 -0700 Subject: [PATCH 025/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index f61e7f237f..c27065ba9c 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit f61e7f237fcf4fc572f561693faacfe67e5ded7d +Subproject commit c27065ba9cb9664c255773500ddea01a319c2fb5 From 3a32d4dd6b77d2e14155f075dcc0b27c8031bb98 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Tue, 12 Dec 2023 11:59:07 -0700 Subject: [PATCH 026/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index c27065ba9c..a8443f2589 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit c27065ba9cb9664c255773500ddea01a319c2fb5 +Subproject commit a8443f2589f7bb7ff0d082b27d4828d68984db44 From 5cc9c53ae754934c525334a318f83db6798cf133 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Wed, 13 Dec 2023 10:18:37 -0700 Subject: [PATCH 027/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index a8443f2589..fb582b6ad7 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit a8443f2589f7bb7ff0d082b27d4828d68984db44 +Subproject commit fb582b6ad760cdf49b24de99d18a09babb09d449 From 365b2e149f3a6f8506ec96473e2cead5ff346030 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Wed, 13 Dec 2023 22:49:35 -0700 Subject: [PATCH 028/319] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index fb582b6ad7..adf4a0c38b 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit fb582b6ad760cdf49b24de99d18a09babb09d449 +Subproject commit adf4a0c38b9702319d06a72a9217247a74fb3e73 From ec54852916ed342bf40c409102994912c84e5d5e Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 14 Dec 2023 11:46:52 -0700 Subject: [PATCH 029/319] Allow MHK turbines to be run without SeaState and update fixed MHK r-test --- modules/aerodyn/src/AeroDyn.f90 | 46 +++++++++++----------- modules/aerodyn/src/AeroDyn_Registry.txt | 2 + modules/aerodyn/src/AeroDyn_Types.f90 | 10 +++++ modules/openfast-library/src/FAST_Subs.f90 | 1 + reg_tests/r-test | 2 +- 5 files changed, 37 insertions(+), 24 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index ce88454f23..d8a9219994 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1340,6 +1340,7 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p_AD%UA_Flag = InputFileData%AFAeroMod == AFAeroMod_BL_unsteady p_AD%CompAeroMaps = InitInp%CompAeroMaps + p_AD%CompSeaSt = InitInp%CompSeaSt p%MHK = InitInp%MHK @@ -1830,12 +1831,12 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) PosOffset = 0.0_ReKi end if - if (p%rotors(iWT)%MHK .EQ. 0_IntKi) then ! Wind turbines + if (p%rotors(iWT)%MHK .NE. MHK_None .and. p%CompSeaSt) then ! MHK turbines with waves ! Hub if (u%rotors(iWT)%HubMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%HubMotion%TranslationDisp + u%rotors(iWT)%HubMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + u%rotors(iWT)%InflowOnHub, NoAcc, ErrStat2, ErrMsg2) if(Failed()) return else u%rotors(iWT)%InflowOnHub = 0.0_ReKi @@ -1844,27 +1845,27 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) ! Blade do k = 1, p%rotors(iWT)%NumBlades - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%BladeMotion(k)%TranslationDisp + u%rotors(iWT)%BladeMotion(k)%Position, ReKi), & - u%rotors(iWT)%Bld(k)%InflowOnBlade, u%rotors(iWT)%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2, PosOffset=PosOffset) + u%rotors(iWT)%Bld(k)%InflowOnBlade, u%rotors(iWT)%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2) if(Failed()) return StartNode = StartNode + p%rotors(iWT)%NumBlNds end do ! Tower if (u%rotors(iWT)%TowerMotion%Nnodes > 0) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%TowerMotion%TranslationDisp + u%rotors(iWT)%TowerMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnTower, u%rotors(iWT)%AccelOnTower, ErrStat2, ErrMsg2, PosOffset=PosOffset) + u%rotors(iWT)%InflowOnTower, u%rotors(iWT)%AccelOnTower, ErrStat2, ErrMsg2) if(Failed()) return StartNode = StartNode + p%rotors(iWT)%NumTwrNds end if ! Nacelle if (u%rotors(iWT)%NacelleMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%NacelleMotion%TranslationDisp + u%rotors(iWT)%NacelleMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + u%rotors(iWT)%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2) if(Failed()) return StartNode = StartNode + 1 else @@ -1873,21 +1874,20 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) ! TailFin if (u%rotors(iWT)%TFinMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & + call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & real(u%rotors(iWT)%TFinMotion%TranslationDisp + u%rotors(iWT)%TFinMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + u%rotors(iWT)%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2) if(Failed()) return StartNode = StartNode + 1 else u%rotors(iWT)%InflowOnTailFin = 0.0_ReKi end if - - else ! MHK turbines + else ! Wind turbines or MHK turbines without waves ! Hub if (u%rotors(iWT)%HubMotion%Committed) then - call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & real(u%rotors(iWT)%HubMotion%TranslationDisp + u%rotors(iWT)%HubMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnHub, NoAcc, ErrStat2, ErrMsg2) + u%rotors(iWT)%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) if(Failed()) return else u%rotors(iWT)%InflowOnHub = 0.0_ReKi @@ -1896,27 +1896,27 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) ! Blade do k = 1, p%rotors(iWT)%NumBlades - call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & real(u%rotors(iWT)%BladeMotion(k)%TranslationDisp + u%rotors(iWT)%BladeMotion(k)%Position, ReKi), & - u%rotors(iWT)%Bld(k)%InflowOnBlade, u%rotors(iWT)%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2) + u%rotors(iWT)%Bld(k)%InflowOnBlade, u%rotors(iWT)%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2, PosOffset=PosOffset) if(Failed()) return StartNode = StartNode + p%rotors(iWT)%NumBlNds end do ! Tower if (u%rotors(iWT)%TowerMotion%Nnodes > 0) then - call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & real(u%rotors(iWT)%TowerMotion%TranslationDisp + u%rotors(iWT)%TowerMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnTower, u%rotors(iWT)%AccelOnTower, ErrStat2, ErrMsg2) + u%rotors(iWT)%InflowOnTower, u%rotors(iWT)%AccelOnTower, ErrStat2, ErrMsg2, PosOffset=PosOffset) if(Failed()) return StartNode = StartNode + p%rotors(iWT)%NumTwrNds end if ! Nacelle if (u%rotors(iWT)%NacelleMotion%Committed) then - call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & real(u%rotors(iWT)%NacelleMotion%TranslationDisp + u%rotors(iWT)%NacelleMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2) + u%rotors(iWT)%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) if(Failed()) return StartNode = StartNode + 1 else @@ -1925,9 +1925,9 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) ! TailFin if (u%rotors(iWT)%TFinMotion%Committed) then - call WaveField_GetWaveVelAcc_AD(p%WaveField, m%SeaSt_Interp_m, StartNode, t, & + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & real(u%rotors(iWT)%TFinMotion%TranslationDisp + u%rotors(iWT)%TFinMotion%Position, ReKi), & - u%rotors(iWT)%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2) + u%rotors(iWT)%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) if(Failed()) return StartNode = StartNode + 1 else diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index d48ba3e20c..f1efd212d1 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -99,6 +99,7 @@ typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this modu typedef ^ InitInputType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ InitInputType ReKi Gravity - - - "Gravity force" Nm/s^2 typedef ^ InitInputType IntKi MHK - - - "MHK turbine type switch" - +typedef ^ InitInputType LOGICAL CompSeaSt - - - "Flag to indicate whether SeaState is selected" - typedef ^ InitInputType ReKi defFldDens - - - "Default fluid density from the driver; may be overwritten" kg/m^3 typedef ^ InitInputType ReKi defKinVisc - - - "Default kinematic viscosity from the driver; may be overwritten" m^2/s typedef ^ InitInputType ReKi defSpdSound - - - "Default speed of sound from the driver; may be overwritten" m/s @@ -435,6 +436,7 @@ typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=non typedef ^ ParameterType FVW_ParameterType FVW - - - "Parameters for FVW module" typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ ParameterType LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - +typedef ^ ParameterType LOGICAL CompSeaSt - - - "Flag to indicate whether SeaState is selected" - typedef ^ ParameterType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - typedef ^ ParameterType SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field data type" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index ced3000e2a..e26ef0b60d 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -119,6 +119,7 @@ MODULE AeroDyn_Types LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity force [Nm/s^2] INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + LOGICAL :: CompSeaSt = .false. !< Flag to indicate whether SeaState is selected [-] REAL(ReKi) :: defFldDens = 0.0_ReKi !< Default fluid density from the driver; may be overwritten [kg/m^3] REAL(ReKi) :: defKinVisc = 0.0_ReKi !< Default kinematic viscosity from the driver; may be overwritten [m^2/s] REAL(ReKi) :: defSpdSound = 0.0_ReKi !< Default speed of sound from the driver; may be overwritten [m/s] @@ -472,6 +473,7 @@ MODULE AeroDyn_Types TYPE(FVW_ParameterType) :: FVW !< Parameters for FVW module [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: CompSeaSt = .false. !< Flag to indicate whether SeaState is selected [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field data type [-] END TYPE AD_ParameterType @@ -1030,6 +1032,7 @@ subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%CompAeroMaps = SrcInitInputData%CompAeroMaps DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%CompSeaSt = SrcInitInputData%CompSeaSt DstInitInputData%defFldDens = SrcInitInputData%defFldDens DstInitInputData%defKinVisc = SrcInitInputData%defKinVisc DstInitInputData%defSpdSound = SrcInitInputData%defSpdSound @@ -1087,6 +1090,7 @@ subroutine AD_PackInitInput(Buf, Indata) call RegPack(Buf, InData%CompAeroMaps) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%CompSeaSt) call RegPack(Buf, InData%defFldDens) call RegPack(Buf, InData%defKinVisc) call RegPack(Buf, InData%defSpdSound) @@ -1136,6 +1140,8 @@ subroutine AD_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompSeaSt) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%defFldDens) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%defKinVisc) @@ -7122,6 +7128,7 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%CompSeaSt = SrcParamData%CompSeaSt DstParamData%FlowField => SrcParamData%FlowField DstParamData%WaveField => SrcParamData%WaveField end subroutine @@ -7194,6 +7201,7 @@ subroutine AD_PackParam(Buf, Indata) call FVW_PackParam(Buf, InData%FVW) call RegPack(Buf, InData%CompAeroMaps) call RegPack(Buf, InData%UA_Flag) + call RegPack(Buf, InData%CompSeaSt) call RegPack(Buf, associated(InData%FlowField)) if (associated(InData%FlowField)) then call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) @@ -7265,6 +7273,8 @@ subroutine AD_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompSeaSt) + if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%FlowField)) deallocate(OutData%FlowField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 4eda20efc6..581f061162 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -505,6 +505,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_AD%InputFile = p_FAST%AeroFile Init%InData_AD%RootName = p_FAST%OutFileRoot Init%InData_AD%MHK = p_FAST%MHK + Init%InData_AD%CompSeaSt = p_FAST%ModuleInitialized(Module_SeaSt) if ( p_FAST%MHK == MHK_None ) then Init%InData_AD%defFldDens = p_FAST%AirDens else diff --git a/reg_tests/r-test b/reg_tests/r-test index adf4a0c38b..c2585ba841 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit adf4a0c38b9702319d06a72a9217247a74fb3e73 +Subproject commit c2585ba8410c40c0f1ac259a6fb43fc7bff9827e From d6cd2392d93cc57440fbf678d4ee9879536cd360 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 14 Dec 2023 13:36:58 -0700 Subject: [PATCH 030/319] Check that CurrMod is always set to zero in SeaState for MHK turbines --- modules/openfast-library/src/FAST_Subs.f90 | 1 + modules/seastate/src/SeaState.txt | 1 + modules/seastate/src/SeaState_Input.f90 | 5 +++++ modules/seastate/src/SeaState_Types.f90 | 5 +++++ 4 files changed, 12 insertions(+) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 581f061162..fd6627c366 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -807,6 +807,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_SeaSt%defWtrDens = p_FAST%WtrDens Init%InData_SeaSt%defWtrDpth = p_FAST%WtrDpth Init%InData_SeaSt%defMSL2SWL = p_FAST%MSL2SWL + Init%InData_SeaSt%MHK = p_FAST%MHK Init%InData_SeaSt%UseInputFile = .TRUE. Init%InData_SeaSt%Linearize = p_FAST%Linearize Init%InData_SeaSt%hasIce = p_FAST%CompIce /= Module_None diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 9447251e6c..c1aea43c4a 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -72,6 +72,7 @@ typedef ^ ^ ReKi Gra typedef ^ ^ ReKi defWtrDens - - - "Default water density from the driver; may be overwritten " "(kg/m^3)" typedef ^ ^ ReKi defWtrDpth - - - "Default water depth from the driver; may be overwritten " "m" typedef ^ ^ ReKi defMSL2SWL - - - "Default mean sea level to still water level from the driver; may be overwritten" "m" +typedef ^ ^ IntKi MHK - - - "MHK flag" - typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ SiKi WaveElevXY {:}{:} - - "Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number." "m,-" typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index d500c3135b..19b347d4e9 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -901,6 +901,11 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er return end if + if ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InitInp%MHK /= 0 ) ) then + call SetErrStat( ErrID_Fatal,'CurrMod must be set to 0 for an MHK turbine.',ErrStat,ErrMsg,RoutineName) + return + end if + ! CurrSSV0 - Sub-surface current velocity at still water level diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 26a6a3d4c7..f5c616a12d 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -93,6 +93,7 @@ MODULE SeaState_Types REAL(ReKi) :: defWtrDens = 0.0_ReKi !< Default water density from the driver; may be overwritten [(kg/m^3)] REAL(ReKi) :: defWtrDpth = 0.0_ReKi !< Default water depth from the driver; may be overwritten [m] REAL(ReKi) :: defMSL2SWL = 0.0_ReKi !< Default mean sea level to still water level from the driver; may be overwritten [m] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK flag [-] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] @@ -596,6 +597,7 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%defWtrDens = SrcInitInputData%defWtrDens DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL + DstInitInputData%MHK = SrcInitInputData%MHK DstInitInputData%TMax = SrcInitInputData%TMax if (allocated(SrcInitInputData%WaveElevXY)) then LB(1:2) = lbound(SrcInitInputData%WaveElevXY) @@ -647,6 +649,7 @@ subroutine SeaSt_PackInitInput(Buf, Indata) call RegPack(Buf, InData%defWtrDens) call RegPack(Buf, InData%defWtrDpth) call RegPack(Buf, InData%defMSL2SWL) + call RegPack(Buf, InData%MHK) call RegPack(Buf, InData%TMax) call RegPack(Buf, allocated(InData%WaveElevXY)) if (allocated(InData%WaveElevXY)) then @@ -686,6 +689,8 @@ subroutine SeaSt_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%defMSL2SWL) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) From b03fcb7da12cb1369aab578e18133abf9f557c5b Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 14 Dec 2023 21:58:12 -0700 Subject: [PATCH 031/319] Correct setting of CompSeaSt parameter for AeroDyn --- modules/aerodyn/src/AeroDyn.f90 | 2 +- modules/openfast-library/src/FAST_Subs.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index d8a9219994..03a1da6473 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1825,7 +1825,7 @@ subroutine AD_CalcWind(t, u, p, o, m, ErrStat, ErrMsg) do iWT = 1, size(u%rotors) ! If rotor is MHK, add water depth to z coordinate - if (p%rotors(iWT)%MHK > 0) then + if (p%rotors(iWT)%MHK .NE. MHK_None) then PosOffset = [0.0_ReKi, 0.0_ReKi, p%rotors(iWT)%WtrDpth] else PosOffset = 0.0_ReKi diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index fd6627c366..d60276cca1 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -505,7 +505,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_AD%InputFile = p_FAST%AeroFile Init%InData_AD%RootName = p_FAST%OutFileRoot Init%InData_AD%MHK = p_FAST%MHK - Init%InData_AD%CompSeaSt = p_FAST%ModuleInitialized(Module_SeaSt) + Init%InData_AD%CompSeaSt = p_FAST%CompSeaSt if ( p_FAST%MHK == MHK_None ) then Init%InData_AD%defFldDens = p_FAST%AirDens else From 322798e07ef4535338c339fdc2c82b1b3e118f54 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 14 Dec 2023 22:26:05 -0700 Subject: [PATCH 032/319] Update formatting of AeroDyn primary input example file --- .../aerodyn/examples/ad_primary_example.dat | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.dat b/docs/source/user/aerodyn/examples/ad_primary_example.dat index dce442dd31..9fc2068667 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.dat +++ b/docs/source/user/aerodyn/examples/ad_primary_example.dat @@ -21,8 +21,8 @@ False CompAA - Flag to compute AeroAcoustics calculation [us ====== Blade-Element/Momentum Theory Options ====================================================== [unused when WakeMod=0 or 3] 1 SkewMod - Type of skewed-wake correction model (switch) {1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0 or 3] "default" SkewModFactor - Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when SkewMod=2; unused when WakeMod=0 or 3] -f TipLoss - Use the Prandtl tip-loss model? (flag) [unused when WakeMod=0 or 3] -f HubLoss - Use the Prandtl hub-loss model? (flag) [unused when WakeMod=0 or 3] +False TipLoss - Use the Prandtl tip-loss model? (flag) [unused when WakeMod=0 or 3] +False HubLoss - Use the Prandtl hub-loss model? (flag) [unused when WakeMod=0 or 3] True TanInd - Include tangential induction in BEMT calculations? (flag) [unused when WakeMod=0 or 3] True AIDrag - Include the drag term in the axial-induction calculation? (flag) [unused when WakeMod=0 or 3] True TIDrag - Include the drag term in the tangential-induction calculation? (flag) [unused when WakeMod=0,3 or TanInd=FALSE] @@ -62,23 +62,23 @@ True UseBlCm - Include aerodynamic pitching moment in calcul "Test01_UAE_AeroDyn_blade.dat" ADBlFile(2) - Name of file containing distributed aerodynamic properties for Blade #2 (-) [unused if NumBl < 2] "Test01_UAE_AeroDyn_blade.dat" ADBlFile(3) - Name of file containing distributed aerodynamic properties for Blade #3 (-) [unused if NumBl < 3] ====== Hub Properties ============================================================================== [used only when MHK=1 or 2] - 0.0 VolHub - Hub volume (m^3) - 0.0 HubCenBx - Hub center of buoyancy x direction offset (m) + 0 VolHub - Hub volume (m^3) + 0 HubCenBx - Hub center of buoyancy x direction offset (m) ====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2] - 0.0 VolNac - Nacelle volume (m^3) -0.0, 0.0, 0.0 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) + 0 VolNac - Nacelle volume (m^3) + 0, 0, 0 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) ====== Tail Fin Aerodynamics ======================================================================= False TFinAero - Calculate tail fin aerodynamics model (flag) "unused" TFinFile - Input file for tail fin aerodynamics [used only when TFinAero=True] ====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] 5 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] -TwrElev TwrDiam TwrCd TwrTI (used only with TwrShadow=2) TwrCb TwrCp TwrCa !TwrTI used only with TwrShadow=2, TwrCb/TwrCp/TwrCa used only with MHK=1 or 2 -(m) (m) (-) (-) (-) (-) (-) -0.0000000E+00 6.0000000E+00 0.0000000E+00 1.0000000E-01 0.0 0.0 0.0 -2.0000000E+01 5.5000000E+00 0.0000000E+00 1.0000000E-01 0.0 0.0 0.0 -4.0000000E+01 5.0000000E+00 0.0000000E+00 1.0000000E-01 0.0 0.0 0.0 -6.0000000E+01 4.5000000E+00 0.0000000E+00 1.0000000E-01 0.0 0.0 0.0 -8.0000000E+01 4.0000000E+00 0.0000000E+00 1.0000000E-01 0.0 0.0 0.0 +TwrElev TwrDiam TwrCd TwrTI TwrCb TwrCp TwrCa !TwrTI used only with TwrShadow=2, TwrCb/TwrCp/TwrCa used only with MHK=1 or 2 +(m) (m) (-) (-) (-) (-) (-) +0.0000000E+00 6.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 +2.0000000E+01 5.5000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 +4.0000000E+01 5.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 +6.0000000E+01 4.5000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 +8.0000000E+01 4.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 ====== Outputs ==================================================================================== True SumPrint - Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag) 4 NBlOuts - Number of blade node outputs [0 - 9] (-) From 08eaeaefa0a65a64dc4f3da87bfec11c255e3e50 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 15 Dec 2023 10:11:22 -0700 Subject: [PATCH 033/319] Add checks to ensure blade and hub and tower and nacelle buoyancy are activated together --- modules/aerodyn/src/AeroDyn.f90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 03a1da6473..792950a549 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -3904,6 +3904,8 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! local variables + real(ReKi) :: BlCbSum + real(ReKi) :: TwrCbSum integer(IntKi) :: k ! Blade number integer(IntKi) :: j ! node number integer(IntKi) :: iR ! rotor index @@ -4047,6 +4049,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! If the MHK flag is set to 1 or 2, check that the blade buoyancy and added mass coefficients are >= 0. if ( InitInp%MHK > 0 ) then do k=1,NumBl(iR) + BlCbSum = 0.0_ReKi do j=1,InputFileData%rotors(iR)%BladeProps(k)%NumBlNds if ( InputFileData%rotors(iR)%BladeProps(k)%BlCb(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The buoyancy coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & @@ -4068,7 +4071,11 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) call SetErrStat( ErrID_Fatal, 'The pitch added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif + BlCbSum = BlCbSum + InputFileData%rotors(iR)%BladeProps(k)%BlCb(j) end do ! j=nodes + if ( BlCbSum <= 0.0_ReKi .and. InputFileData%rotors(iR)%VolHub > 0.0_ReKi .or. InputFileData%rotors(iR)%VolHub <= 0.0_ReKi .and. BlCbSum > 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'If blade buoyancy is calculated, hub buoyancy must be calculated, and vice versa.', ErrStat, ErrMsg, RoutineName ) + endif end do ! k=blades end if end do ! iR rotor @@ -4105,6 +4112,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! If the MHK flag is set to 1 or 2, check that the tower buoyancy and added mass coefficients are >= 0. if ( InitInp%MHK > 0 .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then + TwrCbSum = 0.0_ReKi do j=1,InputFileData%rotors(iR)%NumTwrNds if ( InputFileData%rotors(iR)%TwrCb(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The buoyancy coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) @@ -4113,7 +4121,11 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) if ( InputFileData%rotors(iR)%TwrCa(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The added mass coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif + TwrCbSum = TwrCbSum + InputFileData%rotors(iR)%TwrCb(j) end do ! j=nodes + if ( TwrCbSum <= 0.0_ReKi .and. InputFileData%rotors(iR)%VolNac > 0.0_ReKi .or. InputFileData%rotors(iR)%VolNac <= 0.0_ReKi .and. TwrCbSum > 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'If tower buoyancy is calculated, nacelle buoyancy must be calculated, and vice versa.', ErrStat, ErrMsg, RoutineName ) + endif end if end if From 4e203be2f6d781bd007e990f4b025dced5db2dbb Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 4 Jan 2024 10:44:35 -0700 Subject: [PATCH 034/319] Allow AeroDyn driver to call SeaState for wave and current superposition --- modules/aerodyn/src/AeroDyn_Driver.f90 | 4 +- .../aerodyn/src/AeroDyn_Driver_Registry.txt | 28 +++- modules/aerodyn/src/AeroDyn_Driver_Subs.f90 | 73 +++++++-- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 140 ++++++++++++++++++ modules/aerodyn/src/AeroDyn_Inflow.f90 | 4 +- .../aerodyn/src/AeroDyn_Inflow_Registry.txt | 3 + modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 15 ++ modules/openfast-library/src/FAST_Subs.f90 | 6 +- modules/seastate/src/SeaState.txt | 1 + modules/seastate/src/SeaState_Types.f90 | 5 + reg_tests/r-test | 2 +- 11 files changed, 258 insertions(+), 23 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Driver.f90 b/modules/aerodyn/src/AeroDyn_Driver.f90 index fdc343249c..d8639de118 100644 --- a/modules/aerodyn/src/AeroDyn_Driver.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver.f90 @@ -41,12 +41,12 @@ program AeroDyn_Driver ! ----- dat%initialized=.false. - call Dvr_Init(dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + call Dvr_Init(dat%dvr, dat%ADI, dat%FED, dat%SeaSt, dat%errStat, dat%errMsg); call CheckError() do iCase= 1,dat%dvr%numCases ! Initial case - call Dvr_InitCase(iCase, dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + call Dvr_InitCase(iCase, dat%dvr, dat%ADI, dat%FED, dat%SeaSt, dat%errStat, dat%errMsg); call CheckError() dat%initialized=.true. ! Init of time estimator diff --git a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt index 8cd3d8dd7d..f3f2d6ff9c 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt @@ -13,6 +13,7 @@ include Registry_NWTC_Library.txt usefrom AeroDyn_Registry.txt usefrom AeroDyn_Inflow_Registry.txt +usefrom SeaState.txt # # ..... Table of combined cases to run ....................................................................................................... typedef AeroDyn_Driver/AD_Dvr Dvr_Case ReKi HWindSpeed - - - "Hub wind speed" "m/s" @@ -151,13 +152,26 @@ typedef ^ ^ IntKi iTimeSe typedef ^ ^ character(1024) root - - - "Output file rootname" "-" typedef ^ ^ Dvr_Outputs out - - - "data for driver output file" "-" typedef ^ ^ ADI_IW_InputData IW_InitInp - - - "" - +typedef ^ ^ SeaSt_InitInputType SS_InitInp - - - "" - -# ..... Data to wrap the driver .......................................................................................................... -typedef ^ AllData Dvr_SimData dvr - - - "Driver data" - -typedef ^ ^ ADI_Data ADI - - - "AeroDyn InflowWind Data" - -typedef ^ ^ FED_Data FED - - - "Elastic wind turbine data (Fake ElastoDyn)" "-" -typedef ^ ^ IntKi errStat - - - "" - -typedef ^ ^ character(ErrMsgLen) errMsg - - - "" - -typedef ^ ^ logical initialized - - - "" - +# ..... SeaState data ....................................................................................................... +typedef ^ SeaState_Data SeaSt_ContinuousStateType x - - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd - - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z - - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherState - - - "Other states" +typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" +typedef ^ ^ SeaSt_InputType u - - - "System inputs" +typedef ^ ^ SeaSt_OutputType y - - - "System outputs" +typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ SeaSt_InitInputType InitInp - - - "Array of inputs associated with InputTimes" +typedef ^ ^ SeaSt_InitOutputType InitOut - - - "Array of outputs associated with CalcSteady Azimuths" +# ..... Data to wrap the driver .......................................................................................................... +typedef ^ AllData Dvr_SimData dvr - - - "Driver data" - +typedef ^ ^ ADI_Data ADI - - - "AeroDyn InflowWind Data" - +typedef ^ ^ FED_Data FED - - - "Elastic wind turbine data (Fake ElastoDyn)" "-" +typedef ^ ^ IntKi errStat - - - "" - +typedef ^ ^ character(ErrMsgLen) errMsg - - - "" - +typedef ^ ^ logical initialized - - - "" - +typedef ^ ^ SeaState_Data SeaSt - - - "SeaState data" - diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index 40d4b71039..38e04f79d5 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -24,6 +24,7 @@ module AeroDyn_Driver_Subs use AeroDyn_Inflow, only: concatOutputHeaders use AeroDyn_Inflow, only: Init_MeshMap_For_ADI, Set_Inputs_For_ADI use AeroDyn_IO, only: AD_WrVTK_Surfaces, AD_WrVTK_LinesPoints + use SeaState, only: SeaSt_Init use AeroDyn_Driver_Types use AeroDyn @@ -90,10 +91,11 @@ module AeroDyn_Driver_Subs !---------------------------------------------------------------------------------------------------------------------------------- !> -subroutine Dvr_Init(dvr, ADI, FED, errStat, errMsg ) +subroutine Dvr_Init(dvr, ADI, FED, SeaSt, errStat, errMsg ) type(Dvr_SimData), intent( out) :: dvr !< driver data type(ADI_Data), intent( out) :: ADI !< AeroDyn/InflowWind data type(FED_Data), intent( out) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + type(SeaState_Data), intent( out) :: SeaSt !< SeaState data integer(IntKi) , intent( out) :: errStat !< Status of error message character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None ! local variables @@ -139,13 +141,15 @@ end subroutine Dvr_Init !---------------------------------------------------------------------------------------------------------------------------------- !> -subroutine Dvr_InitCase(iCase, dvr, ADI, FED, errStat, errMsg ) - integer(IntKi) , intent(in ) :: iCase - type(Dvr_SimData), intent(inout) :: dvr !< driver data - type(ADI_Data), intent(inout) :: ADI !< AeroDyn/InflowWind data - type(FED_Data), intent(inout) :: FED !< Elastic wind turbine data (Fake ElastoDyn) - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None +subroutine Dvr_InitCase(iCase, dvr, ADI, FED, SeaSt, errStat, errMsg ) + integer(IntKi) , intent(in ) :: iCase + type(Dvr_SimData) , intent(inout) :: dvr !< driver data + type(ADI_Data) , intent(inout) :: ADI !< AeroDyn/InflowWind data + type(FED_Data) , intent(inout) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + type(SeaState_Data) , intent(inout) :: SeaSt !< SeaState data + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + ! local variables integer(IntKi) :: errStat2 ! local status of error message character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None @@ -253,6 +257,41 @@ subroutine Dvr_InitCase(iCase, dvr, ADI, FED, errStat, errMsg ) call SetVTKParameters(dvr%out, dvr, ADI, errStat2, errMsg2); if(Failed()) return endif + ! --- Initialize SeaState + if ( dvr%SS_InitInp%CompSeaSt == 1 ) then + + SeaSt%InitInp%Gravity = 9.80665_ReKi + SeaSt%InitInp%hasIce = .FALSE. + SeaSt%InitInp%defWtrDens = dvr%FldDens + SeaSt%InitInp%defWtrDpth = dvr%WtrDpth + SeaSt%InitInp%defMSL2SWL = dvr%MSL2SWL + SeaSt%InitInp%MHK = dvr%MHK + SeaSt%InitInp%UseInputFile = .TRUE. + SeaSt%InitInp%Linearize = .FALSE. + SeaSt%InitInp%InputFile = dvr%SS_InitInp%InputFile + SeaSt%InitInp%OutRootName = trim(dvr%out%Root)//'.SEA' + SeaSt%InitInp%TMax = dvr%TMax + + IF ( dvr%MHK .NE. 0_IntKi .AND. dvr%IW_InitInp%CompInflow == 1) THEN + SeaSt%InitInp%hasCurrField = .TRUE. + ELSE + SeaSt%InitInp%hasCurrField = .FALSE. + END IF + + CALL SeaSt_Init( SeaSt%InitInp, SeaSt%u, SeaSt%p, SeaSt%x, SeaSt%xd, SeaSt%z, SeaSt%OtherState, SeaSt%y, SeaSt%m, dvr%dt, SeaSt%InitOut, ErrStat, ErrMsg ) + + IF ( dvr%MHK .NE. 0_IntKi .AND. dvr%IW_InitInp%CompInflow == 1 ) THEN ! MHK turbine + ! Simulating an MHK turbine; load dynamic current from IfW + SeaSt%p%WaveField%CurrField => ADI%p%AD%FlowField + SeaSt%p%WaveField%hasCurrField = .TRUE. + ! Set AD pointers to wavefield + ADI%p%AD%WaveField => SeaSt%InitOut%WaveField + ELSE ! Wind turbine + SeaSt%p%WaveField%hasCurrField = .FALSE. + END IF + + end if + call cleanUp() contains subroutine cleanUp() @@ -467,6 +506,9 @@ subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, errStat, errMsg) InitInp%IW_InitInp%PLExp = dvr%IW_InitInp%PLExp InitInp%IW_InitInp%UseInputFile = .true. ! read input file instead of passed file data InitInp%IW_InitInp%MHK = dvr%MHK + InitInp%IW_InitInp%WtrDpth = dvr%WtrDpth + InitInp%IW_InitInp%MSL2SWL = dvr%MSL2SWL + InitInp%IW_InitInp%RootName = trim(dvr%out%Root) ! AeroDyn InitInp%AD%Gravity = 9.80665_ReKi InitInp%AD%RootName = dvr%out%Root ! 'C:/Work/XFlow/' @@ -987,8 +1029,14 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) dvr%IW_InitInp%HWindSpeed = myNaN endif + ! --- SeaState data + call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return + call ParseVar(FileInfo_In, CurLine, "CompSeaSt" , dvr%SS_InitInp%CompSeaSt , errStat2, errMsg2, unEc); if (Failed()) return + call ParseVar(FileInfo_In, CurLine, "SeaStFile" , dvr%SS_InitInp%InputFile , errStat2, errMsg2, unEc); if (Failed()) return + if (PathIsRelative(dvr%AD_InputFile)) dvr%AD_InputFile = trim(PriPath)//trim(dvr%AD_InputFile) if (PathIsRelative(dvr%IW_InitInp%InputFile)) dvr%IW_InitInp%InputFile = trim(PriPath)//trim(dvr%IW_InitInp%InputFile) + if (PathIsRelative(dvr%SS_InitInp%InputFile)) dvr%SS_InitInp%InputFile = trim(PriPath)//trim(dvr%SS_InitInp%InputFile) ! --- Turbines call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return @@ -1347,10 +1395,15 @@ subroutine ValidateInputs(dvr, errStat, errMsg) ! Turbine Data: !if ( dvr%numBlades < 1 ) call SetErrStat( ErrID_Fatal, "There must be at least 1 blade (numBlades).", errStat, ErrMsg, RoutineName) ! Combined-Case Analysis: - if (dvr%MHK /= MHK_None .and. dvr%MHK /= MHK_FixedBottom .and. dvr%MHK /= MHK_Floating) call SetErrStat(ErrID_Fatal, 'MHK switch must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName) - if (dvr%DT < epsilon(0.0_ReKi) ) call SetErrStat(ErrID_Fatal,'dT must be larger than 0.',errStat, errMsg,RoutineName) if (Check(.not.(ANY((/0,1/) == dvr%IW_InitInp%compInflow) ), 'CompInflow needs to be 0 or 1')) return + if (Check(.not.(ANY((/0,1/) == dvr%SS_InitInp%CompSeaSt) ), 'CompSeaSt needs to be 0 or 1')) return + + if (dvr%MHK /= MHK_None .and. dvr%MHK /= MHK_FixedBottom .and. dvr%MHK /= MHK_Floating) call SetErrStat(ErrID_Fatal, 'MHK switch must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName) + + if (dvr%MHK /= MHK_None .and. dvr%SS_InitInp%CompSeaSt == 1 .and. dvr%IW_InitInp%CompInflow /= 1) call SetErrStat( ErrID_Fatal, 'InflowWind must be activated for MHK turbines when SeaState is used.', ErrStat, ErrMsg, RoutineName ) + + if (dvr%MHK == MHK_None .and. dvr%SS_InitInp%CompSeaSt /= 0) call SetErrStat( ErrID_Fatal, 'SeaState cannot be used with wind turbines.', ErrStat, ErrMsg, RoutineName ) if (Check(.not.(ANY(idAnalysisVALID == dvr%analysisType )), 'Analysis type not supported: '//trim(Num2LStr(dvr%analysisType)) )) return diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 71835dac10..7cb8216761 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -33,6 +33,7 @@ MODULE AeroDyn_Driver_Types !--------------------------------------------------------------------------------------------------------------------------------- USE AeroDyn_Types USE AeroDyn_Inflow_Types +USE SeaState_Types USE NWTC_Library IMPLICIT NONE ! ========= Dvr_Case ======= @@ -185,8 +186,23 @@ MODULE AeroDyn_Driver_Types character(1024) :: root !< Output file rootname [-] TYPE(Dvr_Outputs) :: out !< data for driver output file [-] TYPE(ADI_IW_InputData) :: IW_InitInp !< [-] + TYPE(SeaSt_InitInputType) :: SS_InitInp !< [-] END TYPE Dvr_SimData ! ======================= +! ========= SeaState_Data ======= + TYPE, PUBLIC :: SeaState_Data + TYPE(SeaSt_ContinuousStateType) :: x !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) :: xd !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) :: z !< Constraint states [-] + TYPE(SeaSt_OtherStateType) :: OtherState !< Other states [-] + TYPE(SeaSt_ParameterType) :: p !< Parameters [-] + TYPE(SeaSt_InputType) :: u !< System inputs [-] + TYPE(SeaSt_OutputType) :: y !< System outputs [-] + TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(SeaSt_InitInputType) :: InitInp !< Array of inputs associated with InputTimes [-] + TYPE(SeaSt_InitOutputType) :: InitOut !< Array of outputs associated with CalcSteady Azimuths [-] + END TYPE SeaState_Data +! ======================= ! ========= AllData ======= TYPE, PUBLIC :: AllData TYPE(Dvr_SimData) :: dvr !< Driver data [-] @@ -195,6 +211,7 @@ MODULE AeroDyn_Driver_Types INTEGER(IntKi) :: errStat = 0_IntKi !< [-] character(ErrMsgLen) :: errMsg !< [-] LOGICAL :: initialized = .false. !< [-] + TYPE(SeaState_Data) :: SeaSt !< SeaState data [-] END TYPE AllData ! ======================= CONTAINS @@ -1461,6 +1478,9 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo call ADI_CopyIW_InputData(SrcDvr_SimDataData%IW_InitInp, DstDvr_SimDataData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitInput(SrcDvr_SimDataData%SS_InitInp, DstDvr_SimDataData%SS_InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) @@ -1499,6 +1519,8 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADI_DestroyIW_InputData(Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitInput(Dvr_SimDataData%SS_InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) @@ -1551,6 +1573,7 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) call RegPack(Buf, InData%root) call AD_Dvr_PackDvr_Outputs(Buf, InData%out) call ADI_PackIW_InputData(Buf, InData%IW_InitInp) + call SeaSt_PackInitInput(Buf, InData%SS_InitInp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1645,6 +1668,116 @@ subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call AD_Dvr_UnpackDvr_Outputs(Buf, OutData%out) ! out call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp + call SeaSt_UnpackInitInput(Buf, OutData%SS_InitInp) ! SS_InitInp +end subroutine + +subroutine AD_Dvr_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) + type(SeaState_Data), intent(in) :: SrcSeaState_DataData + type(SeaState_Data), intent(inout) :: DstSeaState_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_CopyContState(SrcSeaState_DataData%x, DstSeaState_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyDiscState(SrcSeaState_DataData%xd, DstSeaState_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyConstrState(SrcSeaState_DataData%z, DstSeaState_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherState, DstSeaState_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitInput(SrcSeaState_DataData%InitInp, DstSeaState_DataData%InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitOutput(SrcSeaState_DataData%InitOut, DstSeaState_DataData%InitOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_Dvr_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) + type(SeaState_Data), intent(inout) :: SeaState_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_DestroyContState(SeaState_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyDiscState(SeaState_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyConstrState(SeaState_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherState, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitInput(SeaState_DataData%InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitOutput(SeaState_DataData%InitOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_Dvr_PackSeaState_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaState_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackSeaState_Data' + if (Buf%ErrStat >= AbortErrLev) return + call SeaSt_PackContState(Buf, InData%x) + call SeaSt_PackDiscState(Buf, InData%xd) + call SeaSt_PackConstrState(Buf, InData%z) + call SeaSt_PackOtherState(Buf, InData%OtherState) + call SeaSt_PackParam(Buf, InData%p) + call SeaSt_PackInput(Buf, InData%u) + call SeaSt_PackOutput(Buf, InData%y) + call SeaSt_PackMisc(Buf, InData%m) + call SeaSt_PackInitInput(Buf, InData%InitInp) + call SeaSt_PackInitOutput(Buf, InData%InitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackSeaState_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaState_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackSeaState_Data' + if (Buf%ErrStat /= ErrID_None) return + call SeaSt_UnpackContState(Buf, OutData%x) ! x + call SeaSt_UnpackDiscState(Buf, OutData%xd) ! xd + call SeaSt_UnpackConstrState(Buf, OutData%z) ! z + call SeaSt_UnpackOtherState(Buf, OutData%OtherState) ! OtherState + call SeaSt_UnpackParam(Buf, OutData%p) ! p + call SeaSt_UnpackInput(Buf, OutData%u) ! u + call SeaSt_UnpackOutput(Buf, OutData%y) ! y + call SeaSt_UnpackMisc(Buf, OutData%m) ! m + call SeaSt_UnpackInitInput(Buf, OutData%InitInp) ! InitInp + call SeaSt_UnpackInitOutput(Buf, OutData%InitOut) ! InitOut end subroutine subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg) @@ -1670,6 +1803,9 @@ subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, DstAllDataData%errStat = SrcAllDataData%errStat DstAllDataData%errMsg = SrcAllDataData%errMsg DstAllDataData%initialized = SrcAllDataData%initialized + call AD_Dvr_CopySeaState_Data(SrcAllDataData%SeaSt, DstAllDataData%SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) @@ -1687,6 +1823,8 @@ subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADI_DestroyFED_Data(AllDataData%FED, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_Dvr_DestroySeaState_Data(AllDataData%SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_Dvr_PackAllData(Buf, Indata) @@ -1700,6 +1838,7 @@ subroutine AD_Dvr_PackAllData(Buf, Indata) call RegPack(Buf, InData%errStat) call RegPack(Buf, InData%errMsg) call RegPack(Buf, InData%initialized) + call AD_Dvr_PackSeaState_Data(Buf, InData%SeaSt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1717,6 +1856,7 @@ subroutine AD_Dvr_UnPackAllData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%initialized) if (RegCheckErr(Buf, RoutineName)) return + call AD_Dvr_UnpackSeaState_Data(Buf, OutData%SeaSt) ! SeaSt end subroutine END MODULE AeroDyn_Driver_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index c169a4e651..54f7c85f6a 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -80,7 +80,7 @@ subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_AD%rotors(1)%WriteOutputHdr, InitOut_AD%rotors(1)%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return ! --- Initialize Inflow Wind - call ADI_InitInflowWind(InitInp%RootName, InitInp%IW_InitInp, u%AD, OtherState%AD, m%IW, Interval, InitOut_IW, errStat2, errMsg2); if (Failed()) return + call ADI_InitInflowWind(InitInp%IW_InitInp%RootName, InitInp%IW_InitInp, u%AD, OtherState%AD, m%IW, Interval, InitOut_IW, errStat2, errMsg2); if (Failed()) return ! Concatenate AD outputs to IW outputs call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_IW%WriteOutputHdr, InitOut_IW%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return ! Link InflowWind's FlowField to AeroDyn's FlowField @@ -372,6 +372,8 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt InitInData%InputFileName = i_IW%InputFile InitInData%Linearize = i_IW%Linearize InitInData%UseInputFile = i_IW%UseInputFile + InitInData%WtrDpth = i_IW%WtrDpth + InitInData%MSL2SWL = i_IW%MSL2SWL InitInData%NumWindPoints = 1 if (.not. i_IW%UseInputFile) then call NWTC_Library_Copyfileinfotype( i_IW%PassedFileData, InitInData%PassedFileData, MESH_NEWCOPY, errStat2, errMsg2 ); if (Failed()) return diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt index f47582f5fd..60f38f6e54 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt @@ -40,6 +40,9 @@ typedef ^ ^ IntKi MHK typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Should we read everthing from an input file, or is it passed in?" - typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - typedef ^ ^ LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ ReKi WtrDpth - - - "Water depth" m +typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m +typedef ^ ^ Character(1024) RootName - - - "RootName for writing output files" - # ..... InitIn .................................................................................................................... diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index d0acace6f4..d87bfd3f14 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -62,6 +62,9 @@ MODULE AeroDyn_Inflow_Types LOGICAL :: UseInputFile = .TRUE. !< Should we read everthing from an input file, or is it passed in? [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + Character(1024) :: RootName !< RootName for writing output files [-] END TYPE ADI_IW_InputData ! ======================= ! ========= ADI_InitInputType ======= @@ -309,6 +312,9 @@ subroutine ADI_CopyIW_InputData(SrcIW_InputDataData, DstIW_InputDataData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize + DstIW_InputDataData%WtrDpth = SrcIW_InputDataData%WtrDpth + DstIW_InputDataData%MSL2SWL = SrcIW_InputDataData%MSL2SWL + DstIW_InputDataData%RootName = SrcIW_InputDataData%RootName end subroutine subroutine ADI_DestroyIW_InputData(IW_InputDataData, ErrStat, ErrMsg) @@ -338,6 +344,9 @@ subroutine ADI_PackIW_InputData(Buf, Indata) call RegPack(Buf, InData%UseInputFile) call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -363,6 +372,12 @@ subroutine ADI_UnPackIW_InputData(Buf, OutData) call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index d60276cca1..d684252768 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -840,13 +840,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - IF ( p_FAST%MHK .NE. 0_IntKi .AND. p_FAST%CompInflow == Module_IfW) THEN + IF ( p_FAST%MHK .NE. 0_IntKi .AND. p_FAST%CompInflow == Module_IfW) THEN ! MHK turbine ! Simulating an MHK turbine; load dynamic current from IfW SeaSt%p%WaveField%CurrField => Init%OutData_IfW%FlowField SeaSt%p%WaveField%hasCurrField = .TRUE. ! Set AD pointers to wavefield IF (p_FAST%CompAero == Module_AD) AD%p%WaveField => Init%OutData_SeaSt%WaveField - ELSE + ELSE ! Wind turbine SeaSt%p%WaveField%hasCurrField = .FALSE. END IF @@ -2037,6 +2037,8 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%MHK /= MHK_None .and. p%Linearize) CALL SetErrStat( ErrID_Fatal, 'Linearization has not yet been implemented for an MHK turbine. Change MHK or Linearize in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%MHK /= MHK_None .and. p%CompSeaSt == Module_SeaSt .and. p%CompInflow /= Module_IfW) CALL SetErrStat( ErrID_Fatal, 'InflowWind must be activated for MHK turbines when SeaState is used.', ErrStat, ErrMsg, RoutineName ) + IF (p%Gravity < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'Gravity must not be negative.', ErrStat, ErrMsg, RoutineName ) IF (p%WtrDpth < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'WtrDpth must not be negative.', ErrStat, ErrMsg, RoutineName ) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index c1aea43c4a..b75291aa09 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -82,6 +82,7 @@ typedef ^ ^ IntKi WrW typedef ^ ^ LOGICAL HasIce - - - "Supplied by Driver: Whether this simulation has ice loading (flag)" - typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - typedef ^ ^ LOGICAL hasCurrField - - - "Flag to indicate whether to expect current field from IfW" - +typedef ^ ^ IntKi CompSeaSt - - - "Flag to indicate whether SeaState module is activated" - # # # Define outputs from the initialization routine here: diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index f5c616a12d..d1325b100c 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -103,6 +103,7 @@ MODULE SeaState_Types LOGICAL :: HasIce = .false. !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: hasCurrField = .false. !< Flag to indicate whether to expect current field from IfW [-] + INTEGER(IntKi) :: CompSeaSt = 0_IntKi !< Flag to indicate whether SeaState module is activated [-] END TYPE SeaSt_InitInputType ! ======================= ! ========= SeaSt_InitOutputType ======= @@ -618,6 +619,7 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%HasIce = SrcInitInputData%HasIce DstInitInputData%Linearize = SrcInitInputData%Linearize DstInitInputData%hasCurrField = SrcInitInputData%hasCurrField + DstInitInputData%CompSeaSt = SrcInitInputData%CompSeaSt end subroutine subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -663,6 +665,7 @@ subroutine SeaSt_PackInitInput(Buf, Indata) call RegPack(Buf, InData%HasIce) call RegPack(Buf, InData%Linearize) call RegPack(Buf, InData%hasCurrField) + call RegPack(Buf, InData%CompSeaSt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -721,6 +724,8 @@ subroutine SeaSt_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%hasCurrField) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompSeaSt) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) diff --git a/reg_tests/r-test b/reg_tests/r-test index c2585ba841..4a28d64c38 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit c2585ba8410c40c0f1ac259a6fb43fc7bff9827e +Subproject commit 4a28d64c38af4c03164ba5c04c8617a120669b2b From 1a5b0f4169bbf1d7fb407d0fc8d767ee217b4e5c Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 4 Jan 2024 11:14:09 -0700 Subject: [PATCH 035/319] Update AeroDyn driver example input files --- docs/source/user/aerodyn/examples/ad_driver_example.dvr | 3 +++ docs/source/user/aerodyn/examples/ad_driver_multiple.dvr | 3 +++ 2 files changed, 6 insertions(+) diff --git a/docs/source/user/aerodyn/examples/ad_driver_example.dvr b/docs/source/user/aerodyn/examples/ad_driver_example.dvr index c93fcfe122..35c27d5f59 100644 --- a/docs/source/user/aerodyn/examples/ad_driver_example.dvr +++ b/docs/source/user/aerodyn/examples/ad_driver_example.dvr @@ -20,6 +20,9 @@ False Echo - Echo input parameters to ".ech"? 9.0 HWindSpeed - Horizontal wind speed [used only when CompInflow=0 and AnalysisType=1] (m/s) 140 RefHt - Reference height for horizontal wind speed [used only when CompInflow=0] (m) 0.10 PLExp - Power law exponent [used only when CompInflow=0 and AnalysisType=1] (-) +----- SeaState Data [used only when MHK = 1 or 2] --------------------------------------- + 0 CompSeaSt - Compute wave velocities (switch) {0=No Waves; 1=SeaState} +"unused" SeaStFile - Name of the SeaState input file [used only when CompSeaSt=1] ----- Turbine Data ---------------------------------------------------------------------- 1 NumTurbines - Number of turbines ----- Turbine(1) Geometry --------------------------------------------------------------- diff --git a/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr b/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr index 00cf198871..8cd074dfe0 100644 --- a/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr +++ b/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr @@ -20,6 +20,9 @@ False Echo - Echo input parameters to ".ech"? 10 HWindSpeed - Horizontal wind speed [used only when CompInflow=0 and AnalysisType=1] (m/s) 200 RefHt - Reference height for horizontal wind speed [used only when CompInflow=0] (m) 0 PLExp - Power law exponent [used only when CompInflow=0 and AnalysisType=1] (-) +----- SeaState Data [used only when MHK = 1 or 2] --------------------------------------- + 0 CompSeaSt - Compute wave velocities (switch) {0=No Waves; 1=SeaState} +"unused" SeaStFile - Name of the SeaState input file [used only when CompSeaSt=1] ----- Turbine Data ---------------------------------------------------------------------- 2 NumTurbines - Number of turbines ----- Turbine(1) ------------------------------------------------------------------------ From b36f3fc27e08955bb74d271e032e9cab587c2aab Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 5 Jan 2024 13:27:17 -0700 Subject: [PATCH 036/319] Enable AeroDyn driver to write SeaState outputs --- modules/aerodyn/src/AeroDyn_Driver.f90 | 2 +- .../aerodyn/src/AeroDyn_Driver_Registry.txt | 12 -- modules/aerodyn/src/AeroDyn_Driver_Subs.f90 | 51 ++++--- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 132 +----------------- .../aerodyn/src/AeroDyn_Inflow_C_Binding.f90 | 7 +- .../aerodyn/src/AeroDyn_Inflow_Registry.txt | 13 ++ modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 124 ++++++++++++++++ 7 files changed, 178 insertions(+), 163 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Driver.f90 b/modules/aerodyn/src/AeroDyn_Driver.f90 index d8639de118..d85c71461c 100644 --- a/modules/aerodyn/src/AeroDyn_Driver.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver.f90 @@ -58,7 +58,7 @@ program AeroDyn_Driver ! One time loop do nt = 1, dat%dvr%numSteps - call Dvr_TimeStep(nt, dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + call Dvr_TimeStep(nt, dat%dvr, dat%ADI, dat%FED, dat%SeaSt, dat%errStat, dat%errMsg); call CheckError() ! Time update to screen t_global=nt*dat%dvr%dt if (dat%dvr%analysisType/=idAnalysisCombi) then diff --git a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt index f3f2d6ff9c..a64cd5b332 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt @@ -154,18 +154,6 @@ typedef ^ ^ Dvr_Outputs out typedef ^ ^ ADI_IW_InputData IW_InitInp - - - "" - typedef ^ ^ SeaSt_InitInputType SS_InitInp - - - "" - -# ..... SeaState data ....................................................................................................... -typedef ^ SeaState_Data SeaSt_ContinuousStateType x - - - "Continuous states" -typedef ^ ^ SeaSt_DiscreteStateType xd - - - "Discrete states" -typedef ^ ^ SeaSt_ConstraintStateType z - - - "Constraint states" -typedef ^ ^ SeaSt_OtherStateType OtherState - - - "Other states" -typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" -typedef ^ ^ SeaSt_InputType u - - - "System inputs" -typedef ^ ^ SeaSt_OutputType y - - - "System outputs" -typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ SeaSt_InitInputType InitInp - - - "Array of inputs associated with InputTimes" -typedef ^ ^ SeaSt_InitOutputType InitOut - - - "Array of outputs associated with CalcSteady Azimuths" - # ..... Data to wrap the driver .......................................................................................................... typedef ^ AllData Dvr_SimData dvr - - - "Driver data" - typedef ^ ^ ADI_Data ADI - - - "AeroDyn InflowWind Data" - diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index 38e04f79d5..2d2199de24 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -24,7 +24,7 @@ module AeroDyn_Driver_Subs use AeroDyn_Inflow, only: concatOutputHeaders use AeroDyn_Inflow, only: Init_MeshMap_For_ADI, Set_Inputs_For_ADI use AeroDyn_IO, only: AD_WrVTK_Surfaces, AD_WrVTK_LinesPoints - use SeaState, only: SeaSt_Init + use SeaState, only: SeaSt_Init, SeaSt_CalcOutput use AeroDyn_Driver_Types use AeroDyn @@ -245,18 +245,6 @@ subroutine Dvr_InitCase(iCase, dvr, ADI, FED, SeaSt, errStat, errMsg ) ! --- AeroDyn + Inflow at T=0 call ADI_CalcOutput(ADI%inputTimes(1), ADI%u(1), ADI%p, ADI%x(1), ADI%xd(1), ADI%z(1), ADI%OtherState(1), ADI%y, ADI%m, errStat2, errMsg2); if(Failed()) return - ! --- Initialize outputs - call Dvr_InitializeOutputs(dvr%numTurbines, dvr%out, dvr%numSteps, errStat2, errMsg2); if(Failed()) return - - call Dvr_CalcOutputDriver(dvr, ADI%y, FED, errStat2, errMsg2); if(Failed()) return - - ! --- Initialize VTK - if (dvr%out%WrVTK>0) then - dvr%out%n_VTKTime = 1 - dvr%out%VTKRefPoint = (/0.0_SiKi, 0.0_SiKi, 0.0_SiKi /) - call SetVTKParameters(dvr%out, dvr, ADI, errStat2, errMsg2); if(Failed()) return - endif - ! --- Initialize SeaState if ( dvr%SS_InitInp%CompSeaSt == 1 ) then @@ -289,9 +277,25 @@ subroutine Dvr_InitCase(iCase, dvr, ADI, FED, SeaSt, errStat, errMsg ) ELSE ! Wind turbine SeaSt%p%WaveField%hasCurrField = .FALSE. END IF + + if (iCase==1) then + call concatOutputHeaders(dvr%out%WriteOutputHdr, dvr%out%WriteOutputUnt, SeaSt%InitOut%WriteOutputHdr, SeaSt%InitOut%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return + endif end if + ! --- Initialize outputs + call Dvr_InitializeOutputs(dvr%numTurbines, dvr%out, dvr%numSteps, errStat2, errMsg2); if(Failed()) return + + call Dvr_CalcOutputDriver(dvr, ADI%y, FED, errStat2, errMsg2); if(Failed()) return + + ! --- Initialize VTK + if (dvr%out%WrVTK>0) then + dvr%out%n_VTKTime = 1 + dvr%out%VTKRefPoint = (/0.0_SiKi, 0.0_SiKi, 0.0_SiKi /) + call SetVTKParameters(dvr%out, dvr, ADI, errStat2, errMsg2); if(Failed()) return + endif + call cleanUp() contains subroutine cleanUp() @@ -307,11 +311,12 @@ end subroutine Dvr_InitCase !---------------------------------------------------------------------------------------------------------------------------------- !> Perform one time step -subroutine Dvr_TimeStep(nt, dvr, ADI, FED, errStat, errMsg) +subroutine Dvr_TimeStep(nt, dvr, ADI, FED, SeaSt, errStat, errMsg) integer(IntKi) , intent(in ) :: nt ! next time step (current time is nt-1) type(Dvr_SimData), intent(inout) :: dvr ! driver data type(ADI_Data), intent(inout) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) type(FED_Data), intent(inout) :: FED ! Elastic wind turbine data (Fake ElastoDyn) + type(SeaState_Data) , intent(inout) :: SeaSt !< SeaState data integer(IntKi) , intent( out) :: errStat ! Status of error message character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None ! local variables @@ -334,8 +339,11 @@ subroutine Dvr_TimeStep(nt, dvr, ADI, FED, errStat, errMsg) ! Calculate outputs at nt - 1 (current time) call ADI_CalcOutput(time, ADI%u(2), ADI%p, ADI%x(1), ADI%xd(1), ADI%z(1), ADI%OtherState(1), ADI%y, ADI%m, errStat2, errMsg2 ); if(Failed()) return + ! Call SeaSt_CalcOutput for writing to the file + call SeaSt_CalcOutput( time, SeaSt%u, SeaSt%p, SeaSt%x, SeaSt%xd, SeaSt%z, SeaSt%OtherState, SeaSt%y, SeaSt%m, errStat2, errMsg2 ) + ! Write outputs for all turbines at nt-1 - call Dvr_WriteOutputs(nt, time, dvr, dvr%out, ADI%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(nt, time, dvr, dvr%out, ADI%y, SeaSt%y, errStat2, errMsg2); if(Failed()) return ! We store the "driver-level" outputs only now, above, the old outputs are used call Dvr_CalcOutputDriver(dvr, ADI%y, FED, errStat, errMsg) @@ -1696,17 +1704,18 @@ subroutine Dvr_CalcOutputDriver(dvr, y_ADI, FED, errStat, errMsg) end subroutine Dvr_CalcOutputDriver !---------------------------------------------------------------------------------------------------------------------------------- -subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) +subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, ySeaSt, errStat, errMsg) integer(IntKi) , intent(in ) :: nt ! simulation time step real(DbKi) , intent(in ) :: t ! simulation time (s) type(Dvr_SimData), intent(inout) :: dvr ! driver data type(Dvr_Outputs) , intent(inout) :: out ! driver uotput options type(ADI_OutputType) , intent(in ) :: yADI ! aerodyn outputs + type(SeaSt_OutputType) , intent(in ) :: ySeaSt ! SeaSt outputs integer(IntKi) , intent(inout) :: errStat ! Status of error message character(*) , intent(inout) :: errMsg ! Error message if errStat /= ErrID_None ! Local variables. character(ChanLen) :: tmpStr ! temporary string to print the time output as text - integer :: nDV , nAD, nIW, iWT, k, j + integer :: nDV , nAD, nIW, nSS, iWT, k, j real(ReKi) :: rotations(3) integer(IntKi) :: errStat2 ! Status of error message character(ErrMsgLen) :: errMsg2 ! Error message @@ -1716,6 +1725,7 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) ! Packing all outputs excpet time into one array nAD = size(yADI%AD%rotors(1)%WriteOutput) nIW = size(yADI%IW_WriteOutput) + nSS = size(ySeaSt%WriteOutput) nDV = out%nDvrOutputs do iWT = 1, dvr%numTurbines if (dvr%wt(iWT)%numBlades >0 ) then ! TODO, export for tower only @@ -1723,8 +1733,9 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) out%outLine(1:nDV) = dvr%wt(iWT)%WriteOutput(1:nDV) ! Driver Write Outputs ! out%outLine(11) = dvr%WT(iWT)%hub%azimuth ! azimuth already stored a nt-1 - out%outLine(nDV+1:nDV+nAD) = yADI%AD%rotors(iWT)%WriteOutput ! AeroDyn WriteOutputs - out%outLine(nDV+nAD+1:) = yADI%IW_WriteOutput ! InflowWind WriteOutputs + out%outLine(nDV+1:nDV+nAD) = yADI%AD%rotors(iWT)%WriteOutput ! AeroDyn WriteOutputs + out%outLine(nDV+nAD+1:nDV+nAD+nIW) = yADI%IW_WriteOutput ! InflowWind WriteOutputs + out%outLine(nDV+nAD+nIW+1:) = ySeaSt%WriteOutput ! SeaState WriteOutputs if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtAscii) then ! ASCII @@ -1737,7 +1748,7 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) endif if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtBinary) then ! Store for binary - out%storage(1:nDV+nAD+nIW, nt, iWT) = out%outLine(1:nDV+nAD+nIW) + out%storage(1:nDV+nAD+nIW+nSS, nt, iWT) = out%outLine(1:nDV+nAD+nIW+nSS) endif endif enddo diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 7cb8216761..5422abd648 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -33,7 +33,6 @@ MODULE AeroDyn_Driver_Types !--------------------------------------------------------------------------------------------------------------------------------- USE AeroDyn_Types USE AeroDyn_Inflow_Types -USE SeaState_Types USE NWTC_Library IMPLICIT NONE ! ========= Dvr_Case ======= @@ -189,20 +188,6 @@ MODULE AeroDyn_Driver_Types TYPE(SeaSt_InitInputType) :: SS_InitInp !< [-] END TYPE Dvr_SimData ! ======================= -! ========= SeaState_Data ======= - TYPE, PUBLIC :: SeaState_Data - TYPE(SeaSt_ContinuousStateType) :: x !< Continuous states [-] - TYPE(SeaSt_DiscreteStateType) :: xd !< Discrete states [-] - TYPE(SeaSt_ConstraintStateType) :: z !< Constraint states [-] - TYPE(SeaSt_OtherStateType) :: OtherState !< Other states [-] - TYPE(SeaSt_ParameterType) :: p !< Parameters [-] - TYPE(SeaSt_InputType) :: u !< System inputs [-] - TYPE(SeaSt_OutputType) :: y !< System outputs [-] - TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(SeaSt_InitInputType) :: InitInp !< Array of inputs associated with InputTimes [-] - TYPE(SeaSt_InitOutputType) :: InitOut !< Array of outputs associated with CalcSteady Azimuths [-] - END TYPE SeaState_Data -! ======================= ! ========= AllData ======= TYPE, PUBLIC :: AllData TYPE(Dvr_SimData) :: dvr !< Driver data [-] @@ -1671,115 +1656,6 @@ subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) call SeaSt_UnpackInitInput(Buf, OutData%SS_InitInp) ! SS_InitInp end subroutine -subroutine AD_Dvr_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) - type(SeaState_Data), intent(in) :: SrcSeaState_DataData - type(SeaState_Data), intent(inout) :: DstSeaState_DataData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_Dvr_CopySeaState_Data' - ErrStat = ErrID_None - ErrMsg = '' - call SeaSt_CopyContState(SrcSeaState_DataData%x, DstSeaState_DataData%x, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyDiscState(SrcSeaState_DataData%xd, DstSeaState_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyConstrState(SrcSeaState_DataData%z, DstSeaState_DataData%z, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherState, DstSeaState_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyInitInput(SrcSeaState_DataData%InitInp, DstSeaState_DataData%InitInp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyInitOutput(SrcSeaState_DataData%InitOut, DstSeaState_DataData%InitOut, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine AD_Dvr_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) - type(SeaState_Data), intent(inout) :: SeaState_DataData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_Dvr_DestroySeaState_Data' - ErrStat = ErrID_None - ErrMsg = '' - call SeaSt_DestroyContState(SeaState_DataData%x, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyDiscState(SeaState_DataData%xd, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyConstrState(SeaState_DataData%z, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyOtherState(SeaState_DataData%OtherState, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyInitInput(SeaState_DataData%InitInp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyInitOutput(SeaState_DataData%InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine AD_Dvr_PackSeaState_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(SeaState_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_Dvr_PackSeaState_Data' - if (Buf%ErrStat >= AbortErrLev) return - call SeaSt_PackContState(Buf, InData%x) - call SeaSt_PackDiscState(Buf, InData%xd) - call SeaSt_PackConstrState(Buf, InData%z) - call SeaSt_PackOtherState(Buf, InData%OtherState) - call SeaSt_PackParam(Buf, InData%p) - call SeaSt_PackInput(Buf, InData%u) - call SeaSt_PackOutput(Buf, InData%y) - call SeaSt_PackMisc(Buf, InData%m) - call SeaSt_PackInitInput(Buf, InData%InitInp) - call SeaSt_PackInitOutput(Buf, InData%InitOut) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine AD_Dvr_UnPackSeaState_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(SeaState_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_Dvr_UnPackSeaState_Data' - if (Buf%ErrStat /= ErrID_None) return - call SeaSt_UnpackContState(Buf, OutData%x) ! x - call SeaSt_UnpackDiscState(Buf, OutData%xd) ! xd - call SeaSt_UnpackConstrState(Buf, OutData%z) ! z - call SeaSt_UnpackOtherState(Buf, OutData%OtherState) ! OtherState - call SeaSt_UnpackParam(Buf, OutData%p) ! p - call SeaSt_UnpackInput(Buf, OutData%u) ! u - call SeaSt_UnpackOutput(Buf, OutData%y) ! y - call SeaSt_UnpackMisc(Buf, OutData%m) ! m - call SeaSt_UnpackInitInput(Buf, OutData%InitInp) ! InitInp - call SeaSt_UnpackInitOutput(Buf, OutData%InitOut) ! InitOut -end subroutine - subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg) type(AllData), intent(inout) :: SrcAllDataData type(AllData), intent(inout) :: DstAllDataData @@ -1803,7 +1679,7 @@ subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, DstAllDataData%errStat = SrcAllDataData%errStat DstAllDataData%errMsg = SrcAllDataData%errMsg DstAllDataData%initialized = SrcAllDataData%initialized - call AD_Dvr_CopySeaState_Data(SrcAllDataData%SeaSt, DstAllDataData%SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call ADI_CopySeaState_Data(SrcAllDataData%SeaSt, DstAllDataData%SeaSt, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -1823,7 +1699,7 @@ subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADI_DestroyFED_Data(AllDataData%FED, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AD_Dvr_DestroySeaState_Data(AllDataData%SeaSt, ErrStat2, ErrMsg2) + call ADI_DestroySeaState_Data(AllDataData%SeaSt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -1838,7 +1714,7 @@ subroutine AD_Dvr_PackAllData(Buf, Indata) call RegPack(Buf, InData%errStat) call RegPack(Buf, InData%errMsg) call RegPack(Buf, InData%initialized) - call AD_Dvr_PackSeaState_Data(Buf, InData%SeaSt) + call ADI_PackSeaState_Data(Buf, InData%SeaSt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1856,7 +1732,7 @@ subroutine AD_Dvr_UnPackAllData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%initialized) if (RegCheckErr(Buf, RoutineName)) return - call AD_Dvr_UnpackSeaState_Data(Buf, OutData%SeaSt) ! SeaSt + call ADI_UnpackSeaState_Data(Buf, OutData%SeaSt) ! SeaSt end subroutine END MODULE AeroDyn_Driver_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 index 0920c4ff5e..477a36436e 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 @@ -97,6 +97,9 @@ MODULE AeroDyn_Inflow_C_BINDING type(ADI_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. type(ADI_InputType) :: ADI_u !< ADI inputs -- set by AD_SetInputMotion. Copied as needed (necessary for correction steps) !------------------------------ + ! Primary SeaSt data derived data types + type(SeaState_Data) :: SeaSt !< SeaState data + !------------------------------ ! Simulation data type(Dvr_SimData) :: Sim !< data about the simulation !------------------------------ @@ -794,7 +797,7 @@ subroutine SetupFileOutputs() WrOutputsData%unOutFile = -1 !FIXME: number of timesteps is incorrect! call Dvr_InitializeOutputs(Sim%numTurbines, WrOutputsData, Sim%numSteps-1, ErrStat2, ErrMsg2); if(Failed()) return - call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, SeaSt%y, errStat2, errMsg2); if(Failed()) return end subroutine SetupFileOutputs @@ -1039,7 +1042,7 @@ SUBROUTINE ADI_C_CalcOutput(Time_C, & if (WrOutputsData%fileFmt > idFmtNone) then !FIXME: need some way to overwrite the correction timesteps (for text file)! - call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, SeaSt%y, errStat2, errMsg2); if(Failed()) return endif ! Set error status diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt index 60f38f6e54..a179523b44 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt @@ -13,6 +13,7 @@ include Registry_NWTC_Library.txt usefrom AeroDyn_Registry.txt usefrom InflowWind.txt +usefrom SeaState.txt param AeroDyn_Inflow/ADI - IntKi ADI_Version - 1 - "" - @@ -110,6 +111,18 @@ typedef ^ ^ ADI_InputType u typedef ^ ^ ADI_OutputType y - - - "System outputs" typedef ^ ^ DbKi inputTimes {:} - - "Array of times associated with u array" +# ..... SeaState data ....................................................................................................... +typedef ^ SeaState_Data SeaSt_ContinuousStateType x - - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd - - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z - - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherState - - - "Other states" +typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" +typedef ^ ^ SeaSt_InputType u - - - "System inputs" +typedef ^ ^ SeaSt_OutputType y - - - "System outputs" +typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ SeaSt_InitInputType InitInp - - - "Array of inputs associated with InputTimes" +typedef ^ ^ SeaSt_InitOutputType InitOut - - - "Array of outputs associated with CalcSteady Azimuths" + # ..... Rotor elastic data .................................................................................................. # NOTE: useful for driver/wrapper of this module typedef ^ RotFED MeshType PlatformPtMesh - - - "Platform reference point positions/orientations/velocities/accelerations" - diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index d87bfd3f14..77c0fe8a23 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -32,6 +32,7 @@ MODULE AeroDyn_Inflow_Types !--------------------------------------------------------------------------------------------------------------------------------- USE AeroDyn_Types +USE SeaState_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_Version = 1 ! [-] @@ -151,6 +152,20 @@ MODULE AeroDyn_Inflow_Types REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: inputTimes !< Array of times associated with u array [-] END TYPE ADI_Data ! ======================= +! ========= SeaState_Data ======= + TYPE, PUBLIC :: SeaState_Data + TYPE(SeaSt_ContinuousStateType) :: x !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) :: xd !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) :: z !< Constraint states [-] + TYPE(SeaSt_OtherStateType) :: OtherState !< Other states [-] + TYPE(SeaSt_ParameterType) :: p !< Parameters [-] + TYPE(SeaSt_InputType) :: u !< System inputs [-] + TYPE(SeaSt_OutputType) :: y !< System outputs [-] + TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(SeaSt_InitInputType) :: InitInp !< Array of inputs associated with InputTimes [-] + TYPE(SeaSt_InitOutputType) :: InitOut !< Array of outputs associated with CalcSteady Azimuths [-] + END TYPE SeaState_Data +! ======================= ! ========= RotFED ======= TYPE, PUBLIC :: RotFED TYPE(MeshType) :: PlatformPtMesh !< Platform reference point positions/orientations/velocities/accelerations [-] @@ -1492,6 +1507,115 @@ subroutine ADI_UnPackData(Buf, OutData) end if end subroutine +subroutine ADI_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) + type(SeaState_Data), intent(in) :: SrcSeaState_DataData + type(SeaState_Data), intent(inout) :: DstSeaState_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_CopyContState(SrcSeaState_DataData%x, DstSeaState_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyDiscState(SrcSeaState_DataData%xd, DstSeaState_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyConstrState(SrcSeaState_DataData%z, DstSeaState_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherState, DstSeaState_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitInput(SrcSeaState_DataData%InitInp, DstSeaState_DataData%InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitOutput(SrcSeaState_DataData%InitOut, DstSeaState_DataData%InitOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) + type(SeaState_Data), intent(inout) :: SeaState_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_DestroyContState(SeaState_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyDiscState(SeaState_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyConstrState(SeaState_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherState, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitInput(SeaState_DataData%InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitOutput(SeaState_DataData%InitOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackSeaState_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaState_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackSeaState_Data' + if (Buf%ErrStat >= AbortErrLev) return + call SeaSt_PackContState(Buf, InData%x) + call SeaSt_PackDiscState(Buf, InData%xd) + call SeaSt_PackConstrState(Buf, InData%z) + call SeaSt_PackOtherState(Buf, InData%OtherState) + call SeaSt_PackParam(Buf, InData%p) + call SeaSt_PackInput(Buf, InData%u) + call SeaSt_PackOutput(Buf, InData%y) + call SeaSt_PackMisc(Buf, InData%m) + call SeaSt_PackInitInput(Buf, InData%InitInp) + call SeaSt_PackInitOutput(Buf, InData%InitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackSeaState_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaState_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackSeaState_Data' + if (Buf%ErrStat /= ErrID_None) return + call SeaSt_UnpackContState(Buf, OutData%x) ! x + call SeaSt_UnpackDiscState(Buf, OutData%xd) ! xd + call SeaSt_UnpackConstrState(Buf, OutData%z) ! z + call SeaSt_UnpackOtherState(Buf, OutData%OtherState) ! OtherState + call SeaSt_UnpackParam(Buf, OutData%p) ! p + call SeaSt_UnpackInput(Buf, OutData%u) ! u + call SeaSt_UnpackOutput(Buf, OutData%y) ! y + call SeaSt_UnpackMisc(Buf, OutData%m) ! m + call SeaSt_UnpackInitInput(Buf, OutData%InitInp) ! InitInp + call SeaSt_UnpackInitOutput(Buf, OutData%InitOut) ! InitOut +end subroutine + subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg) type(RotFED), intent(inout) :: SrcRotFEDData type(RotFED), intent(inout) :: DstRotFEDData From 1fb07d5abf9e4e63021217211d73e985e0fb42b0 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 5 Jan 2024 15:21:17 -0700 Subject: [PATCH 037/319] Allocate unallocated SeaState variable --- modules/aerodyn/src/AeroDyn_Driver_Subs.f90 | 22 ++++++++++++++----- .../aerodyn/src/AeroDyn_Inflow_C_Binding.f90 | 4 ++-- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index 2d2199de24..34ac51e674 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -343,7 +343,7 @@ subroutine Dvr_TimeStep(nt, dvr, ADI, FED, SeaSt, errStat, errMsg) call SeaSt_CalcOutput( time, SeaSt%u, SeaSt%p, SeaSt%x, SeaSt%xd, SeaSt%z, SeaSt%OtherState, SeaSt%y, SeaSt%m, errStat2, errMsg2 ) ! Write outputs for all turbines at nt-1 - call Dvr_WriteOutputs(nt, time, dvr, dvr%out, ADI%y, SeaSt%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(nt, time, dvr, dvr%out, ADI%y, SeaSt, errStat2, errMsg2); if(Failed()) return ! We store the "driver-level" outputs only now, above, the old outputs are used call Dvr_CalcOutputDriver(dvr, ADI%y, FED, errStat, errMsg) @@ -1704,13 +1704,13 @@ subroutine Dvr_CalcOutputDriver(dvr, y_ADI, FED, errStat, errMsg) end subroutine Dvr_CalcOutputDriver !---------------------------------------------------------------------------------------------------------------------------------- -subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, ySeaSt, errStat, errMsg) +subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, SeaSt, errStat, errMsg) integer(IntKi) , intent(in ) :: nt ! simulation time step real(DbKi) , intent(in ) :: t ! simulation time (s) - type(Dvr_SimData), intent(inout) :: dvr ! driver data + type(Dvr_SimData) , intent(inout) :: dvr ! driver data type(Dvr_Outputs) , intent(inout) :: out ! driver uotput options type(ADI_OutputType) , intent(in ) :: yADI ! aerodyn outputs - type(SeaSt_OutputType) , intent(in ) :: ySeaSt ! SeaSt outputs + type(SeaState_Data) , intent(inout) :: SeaSt ! SeaState data integer(IntKi) , intent(inout) :: errStat ! Status of error message character(*) , intent(inout) :: errMsg ! Error message if errStat /= ErrID_None ! Local variables. @@ -1722,10 +1722,20 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, ySeaSt, errStat, errMsg) errStat = ErrID_None errMsg = '' + IF ( .not. allocated( SeaSt%y%WriteOutput ) ) then + ALLOCATE ( SeaSt%y%WriteOutput ( SeaSt%p%NumOuts ) , STAT=ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = ' Error allocating memory for the SeaState WriteOutput array.' + ErrStat = ErrID_Fatal + RETURN + END IF + SeaSt%y%WriteOutput = 0.0_ReKi + END IF + ! Packing all outputs excpet time into one array nAD = size(yADI%AD%rotors(1)%WriteOutput) nIW = size(yADI%IW_WriteOutput) - nSS = size(ySeaSt%WriteOutput) + nSS = size(SeaSt%y%WriteOutput) nDV = out%nDvrOutputs do iWT = 1, dvr%numTurbines if (dvr%wt(iWT)%numBlades >0 ) then ! TODO, export for tower only @@ -1735,7 +1745,7 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, ySeaSt, errStat, errMsg) out%outLine(nDV+1:nDV+nAD) = yADI%AD%rotors(iWT)%WriteOutput ! AeroDyn WriteOutputs out%outLine(nDV+nAD+1:nDV+nAD+nIW) = yADI%IW_WriteOutput ! InflowWind WriteOutputs - out%outLine(nDV+nAD+nIW+1:) = ySeaSt%WriteOutput ! SeaState WriteOutputs + out%outLine(nDV+nAD+nIW+1:) = SeaSt%y%WriteOutput ! SeaState WriteOutputs if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtAscii) then ! ASCII diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 index 477a36436e..482a0b6f65 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 @@ -797,7 +797,7 @@ subroutine SetupFileOutputs() WrOutputsData%unOutFile = -1 !FIXME: number of timesteps is incorrect! call Dvr_InitializeOutputs(Sim%numTurbines, WrOutputsData, Sim%numSteps-1, ErrStat2, ErrMsg2); if(Failed()) return - call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, SeaSt%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, SeaSt, errStat2, errMsg2); if(Failed()) return end subroutine SetupFileOutputs @@ -1042,7 +1042,7 @@ SUBROUTINE ADI_C_CalcOutput(Time_C, & if (WrOutputsData%fileFmt > idFmtNone) then !FIXME: need some way to overwrite the correction timesteps (for text file)! - call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, SeaSt%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, SeaSt, errStat2, errMsg2); if(Failed()) return endif ! Set error status From ac3bea05f90225f7fb553277f5bec95a1979ec58 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Fri, 5 Jan 2024 16:25:49 -0700 Subject: [PATCH 038/319] Regenerate types files --- modules/aerodyn/src/AeroDyn_Types.f90 | 132 +++++++++--------- .../seastate/src/SeaSt_WaveField_Types.f90 | 2 +- 2 files changed, 67 insertions(+), 67 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 4743522239..eae4b5e56c 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -1255,8 +1255,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID end if if (allocated(SrcBladePropsTypeData%t_c)) then - LB(1:1) = lbound(SrcBladePropsTypeData%t_c) - UB(1:1) = ubound(SrcBladePropsTypeData%t_c) + LB(1:1) = lbound(SrcBladePropsTypeData%t_c, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%t_c, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%t_c)) then allocate(DstBladePropsTypeData%t_c(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1303,8 +1303,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt end if if (allocated(SrcBladePropsTypeData%BlCpn)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCpn) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCpn) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCpn, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCpn, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCpn)) then allocate(DstBladePropsTypeData%BlCpn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1315,8 +1315,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCpn = SrcBladePropsTypeData%BlCpn end if if (allocated(SrcBladePropsTypeData%BlCpt)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCpt) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCpt) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCpt, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCpt, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCpt)) then allocate(DstBladePropsTypeData%BlCpt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1327,8 +1327,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCpt = SrcBladePropsTypeData%BlCpt end if if (allocated(SrcBladePropsTypeData%BlCan)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCan) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCan) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCan, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCan, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCan)) then allocate(DstBladePropsTypeData%BlCan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1339,8 +1339,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCan = SrcBladePropsTypeData%BlCan end if if (allocated(SrcBladePropsTypeData%BlCat)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCat) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCat) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCat, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCat, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCat)) then allocate(DstBladePropsTypeData%BlCat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1351,8 +1351,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCat = SrcBladePropsTypeData%BlCat end if if (allocated(SrcBladePropsTypeData%BlCam)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCam) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCam) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCam, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCam, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCam)) then allocate(DstBladePropsTypeData%BlCam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1464,7 +1464,7 @@ subroutine AD_PackBladePropsType(Buf, Indata) end if call RegPack(Buf, allocated(InData%t_c)) if (allocated(InData%t_c)) then - call RegPackBounds(Buf, 1, lbound(InData%t_c), ubound(InData%t_c)) + call RegPackBounds(Buf, 1, lbound(InData%t_c, kind=B8Ki), ubound(InData%t_c, kind=B8Ki)) call RegPack(Buf, InData%t_c) end if call RegPack(Buf, allocated(InData%BlCb)) @@ -1484,27 +1484,27 @@ subroutine AD_PackBladePropsType(Buf, Indata) end if call RegPack(Buf, allocated(InData%BlCpn)) if (allocated(InData%BlCpn)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCpn), ubound(InData%BlCpn)) + call RegPackBounds(Buf, 1, lbound(InData%BlCpn, kind=B8Ki), ubound(InData%BlCpn, kind=B8Ki)) call RegPack(Buf, InData%BlCpn) end if call RegPack(Buf, allocated(InData%BlCpt)) if (allocated(InData%BlCpt)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCpt), ubound(InData%BlCpt)) + call RegPackBounds(Buf, 1, lbound(InData%BlCpt, kind=B8Ki), ubound(InData%BlCpt, kind=B8Ki)) call RegPack(Buf, InData%BlCpt) end if call RegPack(Buf, allocated(InData%BlCan)) if (allocated(InData%BlCan)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCan), ubound(InData%BlCan)) + call RegPackBounds(Buf, 1, lbound(InData%BlCan, kind=B8Ki), ubound(InData%BlCan, kind=B8Ki)) call RegPack(Buf, InData%BlCan) end if call RegPack(Buf, allocated(InData%BlCat)) if (allocated(InData%BlCat)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCat), ubound(InData%BlCat)) + call RegPackBounds(Buf, 1, lbound(InData%BlCat, kind=B8Ki), ubound(InData%BlCat, kind=B8Ki)) call RegPack(Buf, InData%BlCat) end if call RegPack(Buf, allocated(InData%BlCam)) if (allocated(InData%BlCam)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCam), ubound(InData%BlCam)) + call RegPackBounds(Buf, 1, lbound(InData%BlCam, kind=B8Ki), ubound(InData%BlCam, kind=B8Ki)) call RegPack(Buf, InData%BlCam) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2575,8 +2575,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb end if if (allocated(SrcRotInputFileData%TwrCp)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrCp) - UB(1:1) = ubound(SrcRotInputFileData%TwrCp) + LB(1:1) = lbound(SrcRotInputFileData%TwrCp, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputFileData%TwrCp, kind=B8Ki) if (.not. allocated(DstRotInputFileData%TwrCp)) then allocate(DstRotInputFileData%TwrCp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2587,8 +2587,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrCp = SrcRotInputFileData%TwrCp end if if (allocated(SrcRotInputFileData%TwrCa)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrCa) - UB(1:1) = ubound(SrcRotInputFileData%TwrCa) + LB(1:1) = lbound(SrcRotInputFileData%TwrCa, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputFileData%TwrCa, kind=B8Ki) if (.not. allocated(DstRotInputFileData%TwrCa)) then allocate(DstRotInputFileData%TwrCa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2698,12 +2698,12 @@ subroutine AD_PackRotInputFile(Buf, Indata) end if call RegPack(Buf, allocated(InData%TwrCp)) if (allocated(InData%TwrCp)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCp), ubound(InData%TwrCp)) + call RegPackBounds(Buf, 1, lbound(InData%TwrCp, kind=B8Ki), ubound(InData%TwrCp, kind=B8Ki)) call RegPack(Buf, InData%TwrCp) end if call RegPack(Buf, allocated(InData%TwrCa)) if (allocated(InData%TwrCa)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCa), ubound(InData%TwrCa)) + call RegPackBounds(Buf, 1, lbound(InData%TwrCa, kind=B8Ki), ubound(InData%TwrCa, kind=B8Ki)) call RegPack(Buf, InData%TwrCa) end if call RegPack(Buf, InData%VolHub) @@ -4334,8 +4334,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB end if if (allocated(SrcRotMiscVarTypeData%BlFI)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFI) - UB(1:3) = ubound(SrcRotMiscVarTypeData%BlFI) + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFI, kind=B8Ki) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlFI, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%BlFI)) then allocate(DstRotMiscVarTypeData%BlFI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4346,8 +4346,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%BlFI = SrcRotMiscVarTypeData%BlFI end if if (allocated(SrcRotMiscVarTypeData%BlFA)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFA) - UB(1:3) = ubound(SrcRotMiscVarTypeData%BlFA) + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFA, kind=B8Ki) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlFA, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%BlFA)) then allocate(DstRotMiscVarTypeData%BlFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4358,8 +4358,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%BlFA = SrcRotMiscVarTypeData%BlFA end if if (allocated(SrcRotMiscVarTypeData%BlMA)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%BlMA) - UB(1:3) = ubound(SrcRotMiscVarTypeData%BlMA) + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlMA, kind=B8Ki) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlMA, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%BlMA)) then allocate(DstRotMiscVarTypeData%BlMA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4370,8 +4370,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%BlMA = SrcRotMiscVarTypeData%BlMA end if if (allocated(SrcRotMiscVarTypeData%TwrFI)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFI) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFI) + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFI, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFI, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%TwrFI)) then allocate(DstRotMiscVarTypeData%TwrFI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4382,8 +4382,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%TwrFI = SrcRotMiscVarTypeData%TwrFI end if if (allocated(SrcRotMiscVarTypeData%TwrFA)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFA) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFA) + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFA, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFA, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%TwrFA)) then allocate(DstRotMiscVarTypeData%TwrFA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4851,27 +4851,27 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) end if call RegPack(Buf, allocated(InData%BlFI)) if (allocated(InData%BlFI)) then - call RegPackBounds(Buf, 3, lbound(InData%BlFI), ubound(InData%BlFI)) + call RegPackBounds(Buf, 3, lbound(InData%BlFI, kind=B8Ki), ubound(InData%BlFI, kind=B8Ki)) call RegPack(Buf, InData%BlFI) end if call RegPack(Buf, allocated(InData%BlFA)) if (allocated(InData%BlFA)) then - call RegPackBounds(Buf, 3, lbound(InData%BlFA), ubound(InData%BlFA)) + call RegPackBounds(Buf, 3, lbound(InData%BlFA, kind=B8Ki), ubound(InData%BlFA, kind=B8Ki)) call RegPack(Buf, InData%BlFA) end if call RegPack(Buf, allocated(InData%BlMA)) if (allocated(InData%BlMA)) then - call RegPackBounds(Buf, 3, lbound(InData%BlMA), ubound(InData%BlMA)) + call RegPackBounds(Buf, 3, lbound(InData%BlMA, kind=B8Ki), ubound(InData%BlMA, kind=B8Ki)) call RegPack(Buf, InData%BlMA) end if call RegPack(Buf, allocated(InData%TwrFI)) if (allocated(InData%TwrFI)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrFI), ubound(InData%TwrFI)) + call RegPackBounds(Buf, 2, lbound(InData%TwrFI, kind=B8Ki), ubound(InData%TwrFI, kind=B8Ki)) call RegPack(Buf, InData%TwrFI) end if call RegPack(Buf, allocated(InData%TwrFA)) if (allocated(InData%TwrFA)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrFA), ubound(InData%TwrFA)) + call RegPackBounds(Buf, 2, lbound(InData%TwrFA, kind=B8Ki), ubound(InData%TwrFA, kind=B8Ki)) call RegPack(Buf, InData%TwrFA) end if call RegPack(Buf, allocated(InData%BladeRootLoad)) @@ -5879,8 +5879,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb end if if (allocated(SrcRotParameterTypeData%TwrCp)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCp) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCp) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCp, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCp, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrCp)) then allocate(DstRotParameterTypeData%TwrCp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5891,8 +5891,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrCp = SrcRotParameterTypeData%TwrCp end if if (allocated(SrcRotParameterTypeData%TwrCa)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCa) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCa) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCa, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCa, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrCa)) then allocate(DstRotParameterTypeData%TwrCa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5981,8 +5981,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent end if if (allocated(SrcRotParameterTypeData%BlIN)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlIN) - UB(1:2) = ubound(SrcRotParameterTypeData%BlIN) + LB(1:2) = lbound(SrcRotParameterTypeData%BlIN, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlIN, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlIN)) then allocate(DstRotParameterTypeData%BlIN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5993,8 +5993,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlIN = SrcRotParameterTypeData%BlIN end if if (allocated(SrcRotParameterTypeData%BlIT)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlIT) - UB(1:2) = ubound(SrcRotParameterTypeData%BlIT) + LB(1:2) = lbound(SrcRotParameterTypeData%BlIT, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlIT, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlIT)) then allocate(DstRotParameterTypeData%BlIT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6005,8 +6005,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlIT = SrcRotParameterTypeData%BlIT end if if (allocated(SrcRotParameterTypeData%BlAN)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlAN) - UB(1:2) = ubound(SrcRotParameterTypeData%BlAN) + LB(1:2) = lbound(SrcRotParameterTypeData%BlAN, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAN, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlAN)) then allocate(DstRotParameterTypeData%BlAN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6017,8 +6017,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlAN = SrcRotParameterTypeData%BlAN end if if (allocated(SrcRotParameterTypeData%BlAT)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlAT) - UB(1:2) = ubound(SrcRotParameterTypeData%BlAT) + LB(1:2) = lbound(SrcRotParameterTypeData%BlAT, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAT, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlAT)) then allocate(DstRotParameterTypeData%BlAT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6029,8 +6029,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlAT = SrcRotParameterTypeData%BlAT end if if (allocated(SrcRotParameterTypeData%BlAM)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlAM) - UB(1:2) = ubound(SrcRotParameterTypeData%BlAM) + LB(1:2) = lbound(SrcRotParameterTypeData%BlAM, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAM, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlAM)) then allocate(DstRotParameterTypeData%BlAM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6089,8 +6089,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent end if if (allocated(SrcRotParameterTypeData%TwrIT)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrIT) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrIT) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrIT, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrIT, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrIT)) then allocate(DstRotParameterTypeData%TwrIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6101,8 +6101,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrIT = SrcRotParameterTypeData%TwrIT end if if (allocated(SrcRotParameterTypeData%TwrAT)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrAT) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrAT) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAT, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAT, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrAT)) then allocate(DstRotParameterTypeData%TwrAT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6390,12 +6390,12 @@ subroutine AD_PackRotParameterType(Buf, Indata) end if call RegPack(Buf, allocated(InData%TwrCp)) if (allocated(InData%TwrCp)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCp), ubound(InData%TwrCp)) + call RegPackBounds(Buf, 1, lbound(InData%TwrCp, kind=B8Ki), ubound(InData%TwrCp, kind=B8Ki)) call RegPack(Buf, InData%TwrCp) end if call RegPack(Buf, allocated(InData%TwrCa)) if (allocated(InData%TwrCa)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCa), ubound(InData%TwrCa)) + call RegPackBounds(Buf, 1, lbound(InData%TwrCa, kind=B8Ki), ubound(InData%TwrCa, kind=B8Ki)) call RegPack(Buf, InData%TwrCa) end if call RegPack(Buf, allocated(InData%BlCenBn)) @@ -6436,27 +6436,27 @@ subroutine AD_PackRotParameterType(Buf, Indata) end if call RegPack(Buf, allocated(InData%BlIN)) if (allocated(InData%BlIN)) then - call RegPackBounds(Buf, 2, lbound(InData%BlIN), ubound(InData%BlIN)) + call RegPackBounds(Buf, 2, lbound(InData%BlIN, kind=B8Ki), ubound(InData%BlIN, kind=B8Ki)) call RegPack(Buf, InData%BlIN) end if call RegPack(Buf, allocated(InData%BlIT)) if (allocated(InData%BlIT)) then - call RegPackBounds(Buf, 2, lbound(InData%BlIT), ubound(InData%BlIT)) + call RegPackBounds(Buf, 2, lbound(InData%BlIT, kind=B8Ki), ubound(InData%BlIT, kind=B8Ki)) call RegPack(Buf, InData%BlIT) end if call RegPack(Buf, allocated(InData%BlAN)) if (allocated(InData%BlAN)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAN), ubound(InData%BlAN)) + call RegPackBounds(Buf, 2, lbound(InData%BlAN, kind=B8Ki), ubound(InData%BlAN, kind=B8Ki)) call RegPack(Buf, InData%BlAN) end if call RegPack(Buf, allocated(InData%BlAT)) if (allocated(InData%BlAT)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAT), ubound(InData%BlAT)) + call RegPackBounds(Buf, 2, lbound(InData%BlAT, kind=B8Ki), ubound(InData%BlAT, kind=B8Ki)) call RegPack(Buf, InData%BlAT) end if call RegPack(Buf, allocated(InData%BlAM)) if (allocated(InData%BlAM)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAM), ubound(InData%BlAM)) + call RegPackBounds(Buf, 2, lbound(InData%BlAM, kind=B8Ki), ubound(InData%BlAM, kind=B8Ki)) call RegPack(Buf, InData%BlAM) end if call RegPack(Buf, allocated(InData%TwrRad)) @@ -6481,12 +6481,12 @@ subroutine AD_PackRotParameterType(Buf, Indata) end if call RegPack(Buf, allocated(InData%TwrIT)) if (allocated(InData%TwrIT)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrIT), ubound(InData%TwrIT)) + call RegPackBounds(Buf, 1, lbound(InData%TwrIT, kind=B8Ki), ubound(InData%TwrIT, kind=B8Ki)) call RegPack(Buf, InData%TwrIT) end if call RegPack(Buf, allocated(InData%TwrAT)) if (allocated(InData%TwrAT)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrAT), ubound(InData%TwrAT)) + call RegPackBounds(Buf, 1, lbound(InData%TwrAT, kind=B8Ki), ubound(InData%TwrAT, kind=B8Ki)) call RegPack(Buf, InData%TwrAT) end if call BEMT_PackParam(Buf, InData%BEMT) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 1a00eeeafc..fdb4e4ebf8 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -491,7 +491,7 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) From db6cb71d17d6615b55e85be85789d26c77823b99 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 25 Jan 2024 18:55:02 +0000 Subject: [PATCH 039/319] Fix bugs in ModVar, add ModIdxType --- modules/nwtc-library/src/ModVar.f90 | 686 ++++++++++-------- .../nwtc-library/src/NWTC_Library_Types.f90 | 529 ++++++++------ .../src/Registry_NWTC_Library.txt | 30 +- .../src/Registry_NWTC_Library_base.txt | 30 +- 4 files changed, 732 insertions(+), 543 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index f6c7db7fc0..5568a5e376 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -29,31 +29,33 @@ module ModVar implicit none private +public :: MV_InitVarsLin, MV_Pack, MV_Unpack +public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff +public :: MV_AddVar, MV_AddMeshVar, MV_AddModule +public :: SetFlags, UnsetFlags, MV_NumVars +public :: LoadFields, MotionFields, TransFields, AngularFields +public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_rvec, wm_from_rvec +public :: MV_FieldString, IdxStr +public :: MV_InitLinArrays, MV_InitVarIdx integer(IntKi), parameter :: & LoadFields(*) = [VF_Force, VF_Moment], & TransFields(*) = [VF_TransDisp, VF_TransVel, VF_TransAcc], & AngularFields(*) = [VF_Orientation, VF_AngularDisp, VF_AngularVel, VF_AngularAcc], & - MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc], & - MeshFields(*) = [LoadFields, MotionFields] + MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc] -interface MV_PackVar +interface MV_Pack module procedure MV_PackVarR4, MV_PackVarR4Ary module procedure MV_PackVarR8, MV_PackVarR8Ary + module procedure MV_PackMesh end interface -interface MV_UnpackVar +interface MV_Unpack module procedure MV_UnpackVarR4, MV_UnpackVarR4Ary module procedure MV_UnpackVarR8, MV_UnpackVarR8Ary + module procedure MV_UnpackMesh end interface -public :: MV_InitVarsVals, MV_LinkOutputInput, MV_VarIndex, MV_PackMesh, MV_UnpackMesh, MV_PackVar, MV_UnpackVar -public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff -public :: MV_AddVar, MV_AddMeshVar, MV_AddModule, SetFlags -public :: LoadFields, MotionFields, TransFields, AngularFields, MeshFields -public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_xyz, wm_from_xyz -public :: MV_FieldString, IdxStr - contains function MV_FieldString(Field) result(str) @@ -83,14 +85,14 @@ function MV_FieldString(Field) result(str) end select end function -subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) +subroutine MV_InitVarsLin(Vars, Lin, Linearize, ErrStat, ErrMsg) type(ModVarsType), intent(inout) :: Vars - type(ModValsType), intent(inout) :: Vals + type(ModLinType), intent(inout) :: Lin logical, intent(in) :: Linearize integer(IntKi), intent(out) :: ErrStat character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'MV_InitMod' + character(*), parameter :: RoutineName = 'MV_InitVarsLin' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, StartIndex @@ -103,21 +105,24 @@ subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) if (.not. allocated(Vars%x)) allocate (Vars%x(0)) StartIndex = 1 do i = 1, size(Vars%x) - call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return end do ! Initialize input variables if (.not. allocated(Vars%u)) allocate (Vars%u(0)) StartIndex = 1 do i = 1, size(Vars%u) - call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return end do ! Initialize output variables if (.not. allocated(Vars%y)) allocate (Vars%y(0)) StartIndex = 1 do i = 1, size(Vars%y) - call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return end do ! Calculate number of state, input, and output variables @@ -125,19 +130,25 @@ subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) Vars%Nu = sum(Vars%u%Num) Vars%Ny = sum(Vars%y%Num) - ! Allocate state, input, and output values - call AllocAry(Vals%x, Vars%Nx, "Vals%x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vals%dxdt, Vars%Nx, "Vals%dxdt", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vals%u, Vars%Nu, "Vals%u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vals%y, Vars%Ny, "Vals%y", ErrStat2, ErrMsg2); if (Failed()) return - - ! Allocate perturbation input and output values - call AllocAry(Vals%u_perturb, Vars%Nu, "Vals%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vals%x_perturb, Vars%Nx, "Vals%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vals%xp, Vars%Nx, "Vals%xp", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vals%xn, Vars%Nx, "Vals%xn", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vals%yp, Vars%Ny, "Vals%yp", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vals%yn, Vars%Ny, "Vals%yn", ErrStat2, ErrMsg2); if (Failed()) return + ! Allocate state, state derivative, input, and output arrays + call AllocAry(Lin%x, Vars%Nx, "Vals%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%dx, Vars%Nx, "Vals%dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%u, Vars%Nu, "Vals%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%y, Vars%Ny, "Vals%y", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate perturbation and +/- arrays + call AllocAry(Lin%u_perturb, Vars%Nu, "Vals%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%x_perturb, Vars%Nx, "Vals%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%x_pos, Vars%Nx, "Vals%x_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%x_neg, Vars%Nx, "Vals%x_neg", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%y_pos, Vars%Ny, "Vals%y_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%y_neg, Vars%Ny, "Vals%y_neg", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate Jacobian matrices + call AllocAry(Lin%dYdu, Vars%Ny, Vars%Nu, "Lin%dYdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%dXdu, Vars%Nx, Vars%Nu, "Lin%dXdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%dYdx, Vars%Ny, Vars%Nx, "Lin%dYdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Lin%dXdx, Vars%Nx, Vars%Nx, "Lin%dXdx", ErrStat2, ErrMsg2); if (Failed()) return contains @@ -172,7 +183,6 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j - integer(IntKi) :: nNodes character(1), parameter :: Comp(3) = ['X', 'Y', 'Z'] character(*), parameter :: Fmt = '(A," ",A,", node",I0,", ",A)' character(2) :: UnitDesc @@ -194,7 +204,7 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) ! Number of values Var%Num = Var%Nodes*3 - ! If linearization requested + ! If linearization enabled if (Linearize) then ! Set unit description for line mesh @@ -204,21 +214,21 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) ! Switch based on field number select case (Var%Field) case (VF_Force) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, nNodes)] + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, Var%Nodes)] case (VF_Moment) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, nNodes)] + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, Var%Nodes)] case (VF_TransDisp) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, nNodes)] + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, Var%Nodes)] case (VF_Orientation) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, nNodes)] + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, Var%Nodes)] case (VF_TransVel) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, nNodes)] + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, Var%Nodes)] case (VF_AngularVel) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, nNodes)] + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, Var%Nodes)] case (VF_TransAcc) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, nNodes)] + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, Var%Nodes)] case (VF_AngularAcc) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, nNodes)] + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, Var%Nodes)] case default call SetErrStat(ErrID_Fatal, "Invalid mesh field type", ErrStat, ErrMsg, RoutineName) return @@ -232,24 +242,27 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) !---------------------------------------------------------------------------- if (Linearize) then - - ! If incorrect number of linearization names, return error - if (size(Var%LinNames) < Var%Num) then + if (.not. allocated(Var%LinNames)) then + call SetErrStat(ErrID_Fatal, "LinNames not allocated for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + else if (size(Var%LinNames) < Var%Num) then call SetErrStat(ErrID_Fatal, "insufficient LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) return else if (size(Var%LinNames) > Var%Num) then call SetErrStat(ErrID_Fatal, "excessive LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) return end if + else + ! Deallocate linearization names if linearization is not enabled + if (allocated(Var%LinNames)) deallocate (Var%LinNames) end if !---------------------------------------------------------------------------- ! Indices !---------------------------------------------------------------------------- - ! Initialize local index - call AllocAry(Var%iLoc, Var%Num, "Var%iLoc", ErrStat2, ErrMsg2); if (Failed()) return - Var%iLoc = [(index + i, i=0, Var%Num - 1)] + ! Set start and end indices for local matrices + Var%iLoc = [index, index + Var%Num - 1] ! Update index based on variable size index = index + Var%Num @@ -266,158 +279,183 @@ function Failed() ! Functions for packing and unpacking data by variable !------------------------------------------------------------------------------- +subroutine MV_PackMatrix(RowVarAry, ColVarAry, FlagFilter, M, SubM) + type(ModVarType), intent(in) :: RowVarAry(:), ColVarAry(:) + real(R8Ki), intent(in) :: M(:, :) + real(R8Ki), intent(inout) :: SubM(:, :) + integer(IntKi), intent(in) :: FlagFilter + integer(IntKi) :: i, j + integer(IntKi) :: row, col + col = 1 + row = 1 + do i = 1, size(ColVarAry) + if (iand(ColVarAry(i)%Flags, FlagFilter) == 0) cycle + do j = 1, size(RowVarAry) + if (iand(RowVarAry(j)%Flags, FlagFilter) == 0) cycle + associate (rVar => RowVarAry(i), cVar => ColVarAry(i)) + SubM(row:row + rVar%Num - 1, col:col + cVar%Num - 1) = M(rVar%iLoc(1):rVar%iLoc(2), cVar%iLoc(1):cVar%iLoc(2)) + end associate + row = row + RowVarAry(j)%Num - 1 + end do + col = col + ColVarAry(i)%Num - 1 + end do +end subroutine + subroutine MV_PackVarR4(VarAry, iVar, Val, Ary) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R4Ki), intent(in) :: Val real(R8Ki), intent(inout) :: Ary(:) Ary(VarAry(iVar)%iLoc(1)) = real(Val, R8Ki) - iVar = iVar + 1 end subroutine subroutine MV_PackVarR8(VarAry, iVar, Val, Ary) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Val real(R8Ki), intent(inout) :: Ary(:) Ary(VarAry(iVar)%iLoc(1)) = Val - iVar = iVar + 1 end subroutine subroutine MV_PackVarR4Ary(VarAry, iVar, Val, Ary) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R4Ki), intent(in) :: Val(:) real(R8Ki), intent(inout) :: Ary(:) - Ary(VarAry(iVar)%iLoc) = real(pack(Val, .true.), R4Ki) - iVar = iVar + 1 + associate (iLoc => VarAry(iVar)%iLoc) + Ary(iLoc(1):iLoc(2)) = real(Val, R8Ki) + end associate end subroutine subroutine MV_PackVarR8Ary(VarAry, iVar, Vals, Ary) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Vals(:) real(R8Ki), intent(inout) :: Ary(:) - Ary(VarAry(iVar)%iLoc) = pack(Vals, .true.) - iVar = iVar + 1 + associate (iLoc => VarAry(iVar)%iLoc) + Ary(iLoc(1):iLoc(2)) = Vals + end associate end subroutine subroutine MV_UnpackVarR4(VarAry, iVar, Ary, Val) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R4Ki), intent(in) :: Ary(:) real(R8Ki), intent(inout) :: Val Val = Ary(VarAry(iVar)%iLoc(1)) - iVar = iVar + 1 end subroutine subroutine MV_UnpackVarR4Ary(VarAry, iVar, Ary, Vals) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R4Ki), intent(in) :: Ary(:) real(R8Ki), intent(inout) :: Vals(:) - Vals = Ary(VarAry(iVar)%iLoc) - iVar = iVar + 1 + associate (iLoc => VarAry(iVar)%iLoc) + Vals = real(Ary(iLoc(1):iLoc(2)), R4Ki) + end associate end subroutine subroutine MV_UnpackVarR8(VarAry, iVar, Ary, Vals) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Ary(:) real(R8Ki), intent(inout) :: Vals Vals = Ary(VarAry(iVar)%iLoc(1)) - iVar = iVar + 1 end subroutine subroutine MV_UnpackVarR8Ary(VarAry, iVar, Ary, Vals) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Ary(:) real(R8Ki), intent(inout) :: Vals(:) - Vals = Ary(VarAry(iVar)%iLoc) - iVar = iVar + 1 + associate (iLoc => VarAry(iVar)%iLoc) + Vals = Ary(iLoc(1):iLoc(2)) + end associate end subroutine subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar type(MeshType), intent(in) :: Mesh real(R8Ki), intent(inout) :: Values(:) - integer(IntKi) :: MeshID, j + integer(IntKi) :: MeshID, i, j MeshID = VarAry(iVar)%MeshID - do while (VarAry(iVar)%MeshID == MeshID) - select case (VarAry(iVar)%Field) - case (VF_Force) - Values(VarAry(iVar)%iLoc) = pack(Mesh%Force, .true.) - case (VF_Moment) - Values(VarAry(iVar)%iLoc) = pack(Mesh%Moment, .true.) - case (VF_TransDisp) - Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationDisp, .true.) - case (VF_Orientation) - do j = 1, VarAry(iVar)%Nodes - Values(VarAry(iVar)%iLoc(3*(j - 1) + 1:3*j)) = wm_from_dcm(Mesh%Orientation(:, :, j)) - end do - case (VF_TransVel) - Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationVel, .true.) - case (VF_AngularVel) - Values(VarAry(iVar)%iLoc) = pack(Mesh%RotationVel, .true.) - case (VF_TransAcc) - Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationAcc, .true.) - case (VF_AngularAcc) - Values(VarAry(iVar)%iLoc) = pack(Mesh%RotationAcc, .true.) - case (VF_Scalar) - Values(VarAry(iVar)%iLoc) = pack(Mesh%Scalars, .true.) - end select - iVar = iVar + 1 - if (iVar > size(VarAry)) exit + do i = iVar, size(VarAry) + if (VarAry(i)%MeshID /= MeshID) exit + associate (iLoc => VarAry(i)%iLoc) + select case (VarAry(i)%Field) + case (VF_Force) + Values(iLoc(1):iLoc(2)) = pack(Mesh%Force, .true.) + case (VF_Moment) + Values(iLoc(1):iLoc(2)) = pack(Mesh%Moment, .true.) + case (VF_TransDisp) + Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationDisp, .true.) + case (VF_Orientation) + do j = 1, VarAry(i)%Nodes + Values(iLoc(1) + 3*(j - 1):iLoc(1) + 3*j) = wm_from_dcm(Mesh%Orientation(:, :, j)) + end do + case (VF_TransVel) + Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationVel, .true.) + case (VF_AngularVel) + Values(iLoc(1):iLoc(2)) = pack(Mesh%RotationVel, .true.) + case (VF_TransAcc) + Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationAcc, .true.) + case (VF_AngularAcc) + Values(iLoc(1):iLoc(2)) = pack(Mesh%RotationAcc, .true.) + case (VF_Scalar) + Values(iLoc(1):iLoc(2)) = pack(Mesh%Scalars, .true.) + end select + end associate end do end subroutine subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Values(:) type(MeshType), intent(inout) :: Mesh - integer(IntKi) :: MeshID, j + integer(IntKi) :: MeshID, i, j MeshID = VarAry(iVar)%MeshID - do while (VarAry(iVar)%MeshID == MeshID) - select case (VarAry(iVar)%Field) - case (VF_Force) - Mesh%Force = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Force)) - case (VF_Moment) - Mesh%Moment = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Moment)) - case (VF_TransDisp) - Mesh%TranslationDisp = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationDisp)) - case (VF_Orientation) - do j = 1, VarAry(iVar)%Nodes - Mesh%Orientation(:, :, j) = wm_to_dcm(Values(VarAry(iVar)%iLoc(3*(j - 1) + 1:3*j))) - end do - case (VF_TransVel) - Mesh%TranslationVel = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationVel)) - case (VF_AngularVel) - Mesh%RotationVel = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%RotationVel)) - case (VF_TransAcc) - Mesh%TranslationAcc = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationAcc)) - case (VF_AngularAcc) - Mesh%RotationAcc = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%RotationAcc)) - case (VF_Scalar) - Mesh%Scalars = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Scalars)) - end select - iVar = iVar + 1 - if (iVar > size(VarAry)) exit + do i = iVar, size(VarAry) + if (VarAry(i)%MeshID /= MeshID) exit + associate (iLoc => VarAry(i)%iLoc) + select case (VarAry(i)%Field) + case (VF_Force) + Mesh%Force = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Force)) + case (VF_Moment) + Mesh%Moment = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Moment)) + case (VF_TransDisp) + Mesh%TranslationDisp = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationDisp)) + case (VF_Orientation) + do j = 1, VarAry(i)%Nodes + Mesh%Orientation(:, :, j) = wm_to_dcm(Values(iLoc(1) + 3*(j - 1):iLoc(1) + 3*j)) + end do + case (VF_TransVel) + Mesh%TranslationVel = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationVel)) + case (VF_AngularVel) + Mesh%RotationVel = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%RotationVel)) + case (VF_TransAcc) + Mesh%TranslationAcc = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationAcc)) + case (VF_AngularAcc) + Mesh%RotationAcc = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%RotationAcc)) + case (VF_Scalar) + Mesh%Scalars = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Scalars)) + end select + end associate end do end subroutine -subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry, iPerturb) +subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) type(ModVarType), intent(in) :: Var integer(IntKi), intent(in) :: iLin integer(IntKi), intent(in) :: PerturbSign real(R8Ki), intent(in) :: BaseAry(:) real(R8Ki), intent(inout) :: PerturbAry(:) - integer(IntKi), intent(out) :: iPerturb + + integer(IntKi) :: iAry real(R8Ki) :: Perturb - real(R8Ki) :: WM(3), WMp(3) - integer(IntKi) :: i, j, iLoc(3) + real(R8Ki) :: WM(3), rotvec(3) + integer(IntKi) :: i, j ! Copy base array to perturbed array PerturbAry = BaseAry @@ -426,19 +464,18 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry, iPerturb) Perturb = Var%Perturb*real(PerturbSign, R8Ki) ! Perturbation index within array - iPerturb = Var%iLoc(iLin) + iAry = Var%iLoc(1) + iLin - 1 ! If variable field is orientation, perturbation is in WM parameters if (Var%Field == VF_Orientation) then - j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) - i = iLin - j ! index of start of WM parameters (3) - iLoc = Var%iLoc(i:i + 2) ! array index vector - WMp = 0.0_R8Ki ! Init WM perturbation to zero - WMp(j + 1) = Perturb ! WM perturbation around X,Y,Z axis - WM = PerturbAry(iLoc) ! Current WM parameters value - PerturbAry(iLoc) = wm_compose(WM, wm_from_xyz(WMp)) ! Compose value and perturbation + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + i = iLin - j ! index of start of WM parameters (3) + rotvec = 0.0_R8Ki ! Init WM perturbation to zero + rotvec(j + 1) = Perturb ! WM perturbation around X,Y,Z axis + WM = PerturbAry(i:i + 2) ! Current WM parameters value + PerturbAry(i:i + 2) = wm_compose(WM, wm_from_rvec(rotvec)) ! Compose value and perturbation else - PerturbAry(Var%iLoc(iLin)) = PerturbAry(Var%iLoc(iLin)) + Perturb + PerturbAry(iAry) = PerturbAry(iAry) + Perturb end if end subroutine @@ -448,7 +485,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) real(R8Ki), intent(in) :: PosAry(:) ! Positive result array real(R8Ki), intent(in) :: NegAry(:) ! Negative result array real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference - integer(IntKi) :: i, j, ind(3) + integer(IntKi) :: i, j, k real(R8Ki) :: DeltaWM(3) ! Loop through variables @@ -461,19 +498,21 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) do j = 1, VarAry(i)%Nodes ! Get vector of indicies of WM rotation parameters in array - ind = VarAry(i)%iLoc(3*(j - 1) + 1:3*j) + k = VarAry(i)%iLoc(1) + 3*(j - 1) ! Compose WM parameters to go from negative to positive array - DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) + DeltaWM = wm_compose(PosAry(k:k + 2), wm_inv(NegAry(k:k + 2))) ! Calculate change in rotation in XYZ in radians - DiffAry(ind) = wm_to_xyz(DeltaWM) ! store delta as radians + DiffAry(k:k + 2) = wm_to_rvec(DeltaWM) end do else ! Subtract negative array from positive array - DiffAry(VarAry(i)%iLoc) = PosAry(VarAry(i)%iLoc) - NegAry(VarAry(i)%iLoc) + associate (iLoc => VarAry(i)%iLoc) + DiffAry(iLoc(1):iLoc(2)) = PosAry(iLoc(1):iLoc(2)) - NegAry(iLoc(1):iLoc(2)) + end associate end if end do end subroutine @@ -569,46 +608,79 @@ subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, end subroutine -subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs) +subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, VarIdx, Flags, Perturbs, Active) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Fields(:) - integer(IntKi), optional, intent(in) :: Flags type(MeshType), intent(inout) :: Mesh + integer(IntKi), intent(out) :: VarIdx + integer(IntKi), optional, intent(in) :: Flags real(R8Ki), optional, intent(in) :: Perturbs(:) - integer(IntKi) :: i, FlagsLocal + logical, optional, intent(in) :: Active + integer(IntKi) :: FlagsLocal logical :: ActiveLocal real(R8Ki), allocatable :: PerturbsLocal(:) + integer(IntKi) :: i, idx + + ! Initialize variable index, in case variable is not active + VarIdx = 0 + + ! If active argument specified and not active, return + if (present(Active)) then + if (.not. Active) return + end if + + ! If mesh has not been committed, return if (.not. Mesh%committed) return + + ! Set variable index if (allocated(VarAry)) then - Mesh%ID = size(VarAry) + 1 + VarIdx = size(VarAry) + 1 else - Mesh%ID = 1 + VarIdx = 1 end if - FlagsLocal = 0 - if (present(Flags)) FlagsLocal = Flags - FlagsLocal = ior(FlagsLocal, VF_Mesh) + + ! Set mesh ID based on variable index + Mesh%ID = VarIdx + + ! Apply flags if specified + FlagsLocal = VF_Mesh + if (present(Flags)) FlagsLocal = ior(FlagsLocal, Flags) + + ! Set perturbations if specified PerturbsLocal = [(0.0_R8Ki, i=1, size(Fields))] if (present(Perturbs)) PerturbsLocal = Perturbs + + ! Loop through fields in mesh do i = 1, size(Fields) - call MV_AddVar(VarAry, Name, Fields(i), Num=Mesh%Nnodes, Flags=FlagsLocal, & + + ! Add variable + call MV_AddVar(VarAry, Name, Fields(i), VarIdx=idx, & + Num=Mesh%Nnodes, & + Flags=FlagsLocal, & Perturb=PerturbsLocal(i)) + + ! Save mesh ID VarAry(size(VarAry))%MeshID = Mesh%ID end do end subroutine -subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Perturb, LinNames, Active) +subroutine MV_AddVar(VarAry, Name, Field, VarIdx, Num, Flags, iUsr, jUsr, DerivOrder, Perturb, LinNames, Active) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Field + integer(IntKi), intent(out) :: VarIdx integer(IntKi), optional, intent(in) :: Num, Flags, iUsr, jUsr real(R8Ki), optional, intent(in) :: Perturb integer(IntKi), optional, intent(in) :: DerivOrder - logical, optional, intent(in) :: Active character(*), optional, intent(in) :: LinNames(:) + logical, optional, intent(in) :: Active integer(IntKi) :: i type(ModVarType) :: Var + ! Initialize variable index, in case variable is not active + VarIdx = 0 + ! If active argument specified and not active, return if (present(Active)) then if (.not. Active) return @@ -652,103 +724,177 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Pe else VarAry = [Var] end if + + ! Set variable index if present + VarIdx = size(VarAry) end subroutine -! Get index of variable in array matching name and field -function MV_VarIndex(VarAry, Name, Field) result(Indx) - type(ModVarType), intent(in) :: VarAry(:) - character(*), intent(in) :: Name - integer(IntKi), intent(in) :: Field - integer(IntKi) :: Indx - do Indx = 1, size(VarAry) - if (string_equal_ci(VarAry(Indx)%Name, Name) .and. & - VarAry(Indx)%Field == Field) exit +subroutine MV_InitLinArrays(Vars, DerivOrder, LinNames_x, RotFrame_x, DerivOrder_x, & + LinNames_u, RotFrame_u, IsLoad_u, & + LinNames_y, RotFrame_y, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: Vars + integer(IntKi), intent(in) :: DerivOrder + character(LinChanLen), allocatable, intent(inout) :: LinNames_x(:) + logical, allocatable, intent(inout) :: RotFrame_x(:) + integer(IntKi), allocatable, intent(inout) :: DerivOrder_x(:) + character(LinChanLen), allocatable, intent(inout) :: LinNames_u(:) + logical, allocatable, intent(inout) :: RotFrame_u(:) + logical, allocatable, intent(inout) :: IsLoad_u(:) + character(LinChanLen), allocatable, intent(inout) :: LinNames_y(:) + logical, allocatable, intent(inout) :: RotFrame_y(:) + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'PopulateLinArrays' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + integer(IntKi) :: i + + ! State Variables + call AllocAry(LinNames_x, Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(RotFrame_x, Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(DerivOrder_x, Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return + DerivOrder_x = DerivOrder + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), iLoc => Vars%x(i)%iLoc) + LinNames_x(iLoc(1):iLoc(2)) = Var%LinNames + RotFrame_x(iLoc(1):iLoc(2)) = iand(Var%Flags, VF_RotFrame) > 0 + end associate end do - if (Indx > size(VarAry)) Indx = 0 -end function -!------------------------------------------------------------------------------- -! Functions for linking variables (Output and Input) -!------------------------------------------------------------------------------- + ! Input Variables + call AllocAry(LinNames_u, Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(RotFrame_u, Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(IsLoad_u, Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), iLoc => Vars%u(i)%iLoc) + LinNames_u(iLoc(1):iLoc(2)) = Var%LinNames + RotFrame_u(iLoc(1):iLoc(2)) = iand(Var%Flags, VF_RotFrame) > 0 + IsLoad_u(iLoc(1):iLoc(2)) = iand(Var%Field, VF_Force + VF_Moment) > 0 + end associate + end do + + ! Output variables + call AllocAry(LinNames_y, Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(RotFrame_y, Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), iLoc => Vars%y(i)%iLoc) + LinNames_y(iLoc(1):iLoc(2)) = Var%LinNames + RotFrame_y(iLoc(1):iLoc(2)) = iand(Var%Flags, VF_RotFrame) > 0 + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine -subroutine MV_LinkOutputInput(OutVars, InpVars, OutName, InpName, Field, ErrStat, ErrMsg) - type(ModVarsType), intent(inout) :: OutVars, InpVars - character(*), intent(in) :: OutName, InpName - integer(IntKi), intent(in) :: Field +subroutine MV_InitVarIdx(Vars, Idx, FlagFilter, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: Vars + type(ModIdxType), intent(out) :: Idx + integer(IntKi), intent(in) :: FlagFilter integer(IntKi), intent(out) :: ErrStat character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'MV_LinkOutputInput' - ! integer(IntKi) :: ErrStat2 - ! character(ErrMsgLen) :: ErrMsg2 - ! integer(IntKi) :: i - integer(IntKi) :: InpVarIndex, OutVarIndex + character(*), parameter :: RoutineName = 'MV_InitVarIdx' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + integer(IntKi) :: i, j, k - ! Initialize error outputs - ErrStat = ErrID_None - ErrMsg = '' + ! Save filter in index + Idx%FlagFilter = FlagFilter - ! Find name/field in input vars - InpVarIndex = MV_VarIndex(InpVars%u, InpName, Field) - if (InpVarIndex == 0) then - call SetErrStat(ErrID_Fatal, 'Input variable "'//InpName//'" with field '// & - trim(num2lstr(Field))//' not found', ErrStat, ErrMsg, RoutineName) - return - end if + ! Get number of filtered variables + Idx%Nx = MV_NumVars(Vars%x, FlagFilter) + Idx%Nu = MV_NumVars(Vars%u, FlagFilter) + Idx%Ny = MV_NumVars(Vars%y, FlagFilter) - ! Find name/field in output vars - OutVarIndex = MV_VarIndex(OutVars%u, OutName, Field) - if (OutVarIndex == 0) then - call SetErrStat(ErrID_Fatal, 'Output variable "'//OutName//'" with field '// & - trim(num2lstr(Field))//' not found', ErrStat, ErrMsg, RoutineName) - return - end if + ! Allocate index arrays + call AllocAry(Idx%ix, Idx%Nx, "ix", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Idx%idx, Idx%Nx, "idx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Idx%iu, Idx%Nu, "iu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Idx%iy, Idx%Ny, "iy", ErrStat2, ErrMsg2); if (Failed()) return - ! If error finding input or output variable, return - if (ErrStat >= AbortErrLev) return + ! Get indices for state variables + k = 1 + do i = 1, size(Vars%x) + if ((FlagFilter /= VF_None) .and. (iand(Vars%x(i)%Flags, FlagFilter) == 0)) cycle + do j = 0, Vars%x(i)%Num - 1 + Idx%ix(k + j) = Vars%x(i)%iLoc(1) + j + end do + k = k + Vars%x(i)%Num + end do - ! TODO: figure out what to do here + ! Copy state variable indices to state variable derivative indices + Idx%idx = Idx%ix + ! Get indices for input variables + k = 1 + do i = 1, size(Vars%u) + if ((FlagFilter /= VF_None) .and. (iand(Vars%u(i)%Flags, FlagFilter) == 0)) cycle + do j = 0, Vars%u(i)%Num - 1 + Idx%iu(k + j) = Vars%u(i)%iLoc(1) + j + end do + k = k + Vars%u(i)%Num + end do + + ! Get indices for output variables + k = 1 + do i = 1, size(Vars%y) + if ((FlagFilter /= VF_None) .and. (iand(Vars%y(i)%Flags, FlagFilter) == 0)) cycle + do j = 0, Vars%y(i)%Num - 1 + Idx%iy(k + j) = Vars%y(i)%iLoc(1) + j + end do + k = k + Vars%y(i)%Num + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function end subroutine +function MV_NumVars(VarAry, FlagFilter) result(Num) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), optional, intent(in) :: FlagFilter + integer(IntKi) :: Num, i + if (present(FlagFilter)) then + Num = 0 + do i = 1, size(VarAry) + if ((FlagFilter == VF_None) .or. (iand(VarAry(i)%Flags, FlagFilter) /= 0)) Num = Num + VarAry(i)%Num + end do + else + Num = sum(VarAry%Num) + end if +end function + !------------------------------------------------------------------------------- ! Flag Utilities !------------------------------------------------------------------------------- -subroutine SetFlags(Var, Mask) - type(ModVarType), intent(inout) :: Var +subroutine SetFlags(Flags, Mask) + integer(IntKi), intent(inout) :: Flags + integer(IntKi), intent(in) :: Mask + integer(IntKi) :: i + Flags = ior(Flags, Mask) +end subroutine + +subroutine UnsetFlags(Flags, Mask) + integer(IntKi), intent(inout) :: Flags integer(IntKi), intent(in) :: Mask integer(IntKi) :: i - Var%Flags = ior(Var%Flags, Mask) + Flags = iand(Flags, not(Mask)) end subroutine !------------------------------------------------------------------------------- ! String Utilities !------------------------------------------------------------------------------- -! Compare strings s1 and s2 while ignoring case -function string_equal_ci(s1, s2) result(is_equal) - character(*), intent(in) :: s1, s2 - logical :: is_equal - integer(IntKi), parameter :: ca = iachar("a") - integer(IntKi), parameter :: cz = iachar("z") - integer(IntKi) :: i, j - integer(IntKi) :: c1, c2 - is_equal = .false. - i = len_trim(s1) - j = len_trim(s2) - if (i /= j) return - do i = 1, j - c1 = iachar(s1(i:i)) - c2 = iachar(s2(i:i)) - if (c1 == c2) cycle - if (c1 >= ca .and. c1 <= cz) c1 = c1 - 32 - if (c2 >= ca .and. c2 <= cz) c2 = c2 - 32 - if (c1 /= c2) return - end do - is_equal = .true. -end function - function IdxStr(i1, i2, i3, i4, i5) result(s) integer(IntKi), intent(in) :: i1 integer(IntKi), optional, intent(in) :: i2, i3, i4, i5 @@ -828,49 +974,35 @@ pure function wm_from_quat(q) result(c) c = 4.0_R8Ki*e/(1.0_R8Ki + e0) end function -! pure function wm_to_dcm(c) result(R) -! real(R8Ki), intent(in) :: c(3) -! real(R8Ki) :: R(3, 3) -! R = quat_to_dcm(wm_to_quat(c)) -! end function - -! pure function wm_to_dcm(c) result(R) -! real(R8Ki), intent(in) :: c(3) -! real(R8Ki) :: R(3, 3), cct, F(3, 3) -! integer(IntKi) :: i, j -! cct = dot_product(c, c) -! F = reshape([0.0_R8Ki, -c(3), c(2), c(3), 0.0_R8Ki, -c(1), -c(2), c(1), 0.0_R8Ki], [3, 3])/2.0_R8Ki -! do i = 1, 3 -! F(i, i) = F(i, i) + 1.0_R8Ki - cct/16.0_R8Ki -! do j = 1, 3 -! F(i, j) = F(i, j) + c(i)*c(j)/8.0_R8Ki -! end do -! end do -! F = F/(1.0_R8Ki + cct/16.0_R8Ki) -! R = matmul(F, F) -! end function - pure function wm_to_dcm(c) result(R) real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: R(3, 3), c0, vc, ct(3, 3) + real(R8Ki) :: R(3, 3), c0, c1, c2, c3 integer(IntKi) :: i, j - ct(1, :) = [0.0_R8Ki, -c(3), c(2)] - ct(2, :) = [c(3), 0.0_R8Ki, -c(1)] - ct(3, :) = [-c(2), c(1), 0.0_R8Ki] + c1 = c(1) + c2 = c(2) + c3 = c(3) c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki - vc = 2.0_R8Ki/(4.0_R8Ki - c0) - R = vc*vc*(c0*ct + matmul(ct, ct))/2.0_R8Ki - do i = 1, 3 - R(i, i) = R(i, i) + 1.0_R8Ki - end do + R(:, 1) = [c0*c0 + c1*c1 - c2*c2 - c3*c3, & + 2.0_R8Ki*(c1*c2 - c0*c3), & + 2.0_R8Ki*(c1*c3 + c0*c2)] + R(:, 2) = [2.0_R8Ki*(c1*c2 + c0*c3), & + c0*c0 - c1*c1 + c2*c2 - c3*c3, & + 2.0_R8Ki*(c2*c3 - c0*c1)] + R(:, 3) = [2.0_R8Ki*(c1*c3 - c0*c2), & + 2.0_R8Ki*(c2*c3 + c0*c1), & + c0*c0 - c1*c1 - c2*c2 + c3*c3] + R = R / (4.0_R8Ki - c0)**2 + ! ct(1, :) = [0.0_R8Ki, -c(3), c(2)] + ! ct(2, :) = [c(3), 0.0_R8Ki, -c(1)] + ! ct(3, :) = [-c(2), c(1), 0.0_R8Ki] + ! c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + ! vc = 2.0_R8Ki/(4.0_R8Ki - c0) + ! R = vc*vc*(c0*ct + matmul(ct, ct))/2.0_R8Ki + ! do i = 1, 3 + ! R(i, i) = R(i, i) + 1.0_R8Ki + ! end do end function -! pure function wm_from_dcm(R) result(c) -! real(R8Ki), intent(in) :: R(3, 3) -! real(R8Ki) :: c(3), cct -! c = wm_from_quat(quat_from_dcm(R)) -! end function - pure function wm_from_dcm(R) result(c) real(R8Ki), intent(in) :: R(3, 3) real(R8Ki) :: pivot(4) ! Trace of the rotation matrix and diagonal elements @@ -879,7 +1011,7 @@ pure function wm_from_dcm(R) result(c) real(R8Ki) :: Rr(3, 3), c(3) integer :: i ! case indicator - Rr = R + Rr = transpose(R) ! mjs--find max value of T := Tr(Rr) and diagonal elements of Rr ! This tells us which denominator is largest (and less likely to produce numerical noise) @@ -914,46 +1046,29 @@ pure function wm_from_dcm(R) result(c) c = em*sm(1:3) end function -pure function wm_to_xyz(c) result(xyz) +pure function wm_to_rvec(c) result(rvec) real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: phi, n(3), xyz(3), m - m = sqrt(dot_product(c,c)) + real(R8Ki) :: phi, m, rvec(3) + m = sqrt(dot_product(c, c)) if (m == 0.0_R8Ki) then - xyz = 0.0_R8Ki + rvec = 0.0_R8Ki return end if - n = c/m phi = 4.0_R8Ki*atan(m/4.0_R8Ki) - xyz = phi*n - ! xyz = c + rvec = phi*c/m end function -pure function wm_from_xyz(xyz) result(c) - real(R8Ki), intent(in) :: xyz(3) - real(R8Ki) :: phi, n(3), c(3) - phi = sqrt(dot_product(xyz,xyz)) +pure function wm_from_rvec(rvec) result(c) + real(R8Ki), intent(in) :: rvec(3) + real(R8Ki) :: phi, c(3) + phi = sqrt(dot_product(rvec, rvec)) if (phi == 0.0_R8Ki) then c = 0.0_R8Ki return end if - n = xyz / phi - c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n - ! c = xyz + c = 4.0_R8Ki*tan(phi/4.0_R8Ki)*rvec/phi end function -! pure function wm_from_dcm(R) result(c) -! real(R8Ki), intent(in) :: R(3, 3) -! real(R8Ki) :: c(3), t1, t2, cct -! t1 = 1.0_R8Ki + R(1,1) + R(2,2) + R(3,3) -! t2 = 2.0_R8Ki*sqrt(t1) -! c(1) = (R(3,2) - R(2,3)) -! c(2) = (R(1,3) - R(3,1)) -! c(3) = (R(2,1) - R(1,2)) -! c = 4.0_R8Ki * c / (t1 + t2) -! cct = dot_product(c,c) -! if (cct > 16.0_R8Ki) c = 16.0_R8Ki*c / cct -! end function - pure function wm_compose(p, q) result(r) real(R8Ki), intent(in) :: p(3), q(3) real(R8Ki) :: r(3) @@ -962,10 +1077,11 @@ pure function wm_compose(p, q) result(r) q0 = 2.0_R8Ki - dot_product(q, q)/8.0_R8Ki D1 = (4.0_R8Ki - p0)*(4.0_R8Ki - q0) D2 = p0*q0 - dot_product(p, q) + r = 4.0_R8Ki*(q0*p + p0*q + cross(p, q)) if (D2 >= 0.0_R8Ki) then - r = 4.0_R8Ki*(q0*p + p0*q + cross(p, q))/(D1 + D2) + r = r / (D1 + D2) else - r = -4.0_R8Ki*(q0*p + p0*q + cross(p, q))/(D1 - D2) + r = -r / (D1 - D2) end if end function diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 14ecb2c8a4..52d9c95c9d 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -50,6 +50,7 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 8 ! Variable for extended linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 16 ! Variable for aeromap [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Any = 4095 ! Enable all flags (used for filtering) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] @@ -114,14 +115,10 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: Num = 1 !< [-] INTEGER(IntKi) :: Flags = 0 !< [-] INTEGER(IntKi) :: DerivOrder = 0 !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSol !< indices in solver arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLin !< indices in linearization arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< row index in solver q matrix [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0_IntKi !< indices in local arrays [-] INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] - LOGICAL :: Solve = .false. !< flag indicating that variable is used by solver [-] REAL(R8Ki) :: Perturb = 0 !< perturbation [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType @@ -138,23 +135,35 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: Ny = 0_IntKi !< [-] END TYPE ModVarsType ! ======================= -! ========= ModValsType ======= - TYPE, PUBLIC :: ModValsType +! ========= ModIdxType ======= + TYPE, PUBLIC :: ModIdxType + INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ix !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: idx !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iu !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iy !< [-] + END TYPE ModIdxType +! ======================= +! ========= ModLinType ======= + TYPE, PUBLIC :: ModLinType REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< input perturbation array [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xp !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yp !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] - END TYPE ModValsType + END TYPE ModLinType ! ======================= ! ========= ModDataType ======= TYPE, PUBLIC :: ModDataType @@ -610,58 +619,10 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr DstModVarTypeData%Num = SrcModVarTypeData%Num DstModVarTypeData%Flags = SrcModVarTypeData%Flags DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder - if (allocated(SrcModVarTypeData%iLoc)) then - LB(1:1) = lbound(SrcModVarTypeData%iLoc, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%iLoc, kind=B8Ki) - if (.not. allocated(DstModVarTypeData%iLoc)) then - allocate(DstModVarTypeData%iLoc(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLoc.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc - end if - if (allocated(SrcModVarTypeData%iSol)) then - LB(1:1) = lbound(SrcModVarTypeData%iSol, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%iSol, kind=B8Ki) - if (.not. allocated(DstModVarTypeData%iSol)) then - allocate(DstModVarTypeData%iSol(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iSol.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iSol = SrcModVarTypeData%iSol - end if - if (allocated(SrcModVarTypeData%iLin)) then - LB(1:1) = lbound(SrcModVarTypeData%iLin, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%iLin, kind=B8Ki) - if (.not. allocated(DstModVarTypeData%iLin)) then - allocate(DstModVarTypeData%iLin(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLin.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iLin = SrcModVarTypeData%iLin - end if - if (allocated(SrcModVarTypeData%iq)) then - LB(1:1) = lbound(SrcModVarTypeData%iq, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%iq, kind=B8Ki) - if (.not. allocated(DstModVarTypeData%iq)) then - allocate(DstModVarTypeData%iq(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iq.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iq = SrcModVarTypeData%iq - end if + DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID - DstModVarTypeData%Solve = SrcModVarTypeData%Solve DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb if (allocated(SrcModVarTypeData%LinNames)) then LB(1:1) = lbound(SrcModVarTypeData%LinNames, kind=B8Ki) @@ -684,18 +645,6 @@ subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModVarTypeData%iLoc)) then - deallocate(ModVarTypeData%iLoc) - end if - if (allocated(ModVarTypeData%iSol)) then - deallocate(ModVarTypeData%iSol) - end if - if (allocated(ModVarTypeData%iLin)) then - deallocate(ModVarTypeData%iLin) - end if - if (allocated(ModVarTypeData%iq)) then - deallocate(ModVarTypeData%iq) - end if if (allocated(ModVarTypeData%LinNames)) then deallocate(ModVarTypeData%LinNames) end if @@ -712,14 +661,10 @@ subroutine NWTC_Library_PackModVarType(RF, Indata) call RegPack(RF, InData%Num) call RegPack(RF, InData%Flags) call RegPack(RF, InData%DerivOrder) - call RegPackAlloc(RF, InData%iLoc) - call RegPackAlloc(RF, InData%iSol) - call RegPackAlloc(RF, InData%iLin) - call RegPackAlloc(RF, InData%iq) + call RegPack(RF, InData%iLoc) call RegPack(RF, InData%iUsr) call RegPack(RF, InData%jUsr) call RegPack(RF, InData%MeshID) - call RegPack(RF, InData%Solve) call RegPack(RF, InData%Perturb) call RegPackAlloc(RF, InData%LinNames) if (RegCheckErr(RF, RoutineName)) return @@ -739,14 +684,10 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Flags); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DerivOrder); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iSol); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iLin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iUsr); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%jUsr); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Solve); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Perturb); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -956,253 +897,373 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_CopyModValsType(SrcModValsTypeData, DstModValsTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModValsType), intent(in) :: SrcModValsTypeData - type(ModValsType), intent(inout) :: DstModValsTypeData +subroutine NWTC_Library_CopyModIdxType(SrcModIdxTypeData, DstModIdxTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModIdxType), intent(in) :: SrcModIdxTypeData + type(ModIdxType), intent(inout) :: DstModIdxTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModIdxType' + ErrStat = ErrID_None + ErrMsg = '' + DstModIdxTypeData%FlagFilter = SrcModIdxTypeData%FlagFilter + DstModIdxTypeData%Nx = SrcModIdxTypeData%Nx + DstModIdxTypeData%Nu = SrcModIdxTypeData%Nu + DstModIdxTypeData%Ny = SrcModIdxTypeData%Ny + if (allocated(SrcModIdxTypeData%ix)) then + LB(1:1) = lbound(SrcModIdxTypeData%ix, kind=B8Ki) + UB(1:1) = ubound(SrcModIdxTypeData%ix, kind=B8Ki) + if (.not. allocated(DstModIdxTypeData%ix)) then + allocate(DstModIdxTypeData%ix(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModIdxTypeData%ix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModIdxTypeData%ix = SrcModIdxTypeData%ix + end if + if (allocated(SrcModIdxTypeData%idx)) then + LB(1:1) = lbound(SrcModIdxTypeData%idx, kind=B8Ki) + UB(1:1) = ubound(SrcModIdxTypeData%idx, kind=B8Ki) + if (.not. allocated(DstModIdxTypeData%idx)) then + allocate(DstModIdxTypeData%idx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModIdxTypeData%idx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModIdxTypeData%idx = SrcModIdxTypeData%idx + end if + if (allocated(SrcModIdxTypeData%iu)) then + LB(1:1) = lbound(SrcModIdxTypeData%iu, kind=B8Ki) + UB(1:1) = ubound(SrcModIdxTypeData%iu, kind=B8Ki) + if (.not. allocated(DstModIdxTypeData%iu)) then + allocate(DstModIdxTypeData%iu(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModIdxTypeData%iu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModIdxTypeData%iu = SrcModIdxTypeData%iu + end if + if (allocated(SrcModIdxTypeData%iy)) then + LB(1:1) = lbound(SrcModIdxTypeData%iy, kind=B8Ki) + UB(1:1) = ubound(SrcModIdxTypeData%iy, kind=B8Ki) + if (.not. allocated(DstModIdxTypeData%iy)) then + allocate(DstModIdxTypeData%iy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModIdxTypeData%iy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModIdxTypeData%iy = SrcModIdxTypeData%iy + end if +end subroutine + +subroutine NWTC_Library_DestroyModIdxType(ModIdxTypeData, ErrStat, ErrMsg) + type(ModIdxType), intent(inout) :: ModIdxTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModIdxType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModIdxTypeData%ix)) then + deallocate(ModIdxTypeData%ix) + end if + if (allocated(ModIdxTypeData%idx)) then + deallocate(ModIdxTypeData%idx) + end if + if (allocated(ModIdxTypeData%iu)) then + deallocate(ModIdxTypeData%iu) + end if + if (allocated(ModIdxTypeData%iy)) then + deallocate(ModIdxTypeData%iy) + end if +end subroutine + +subroutine NWTC_Library_PackModIdxType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModIdxType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModIdxType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FlagFilter) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) + call RegPackAlloc(RF, InData%ix) + call RegPackAlloc(RF, InData%idx) + call RegPackAlloc(RF, InData%iu) + call RegPackAlloc(RF, InData%iy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModIdxType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModIdxType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModIdxType' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModLinType), intent(in) :: SrcModLinTypeData + type(ModLinType), intent(inout) :: DstModLinTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyModValsType' + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModLinType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcModValsTypeData%x)) then - LB(1:1) = lbound(SrcModValsTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%x, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%x)) then - allocate(DstModValsTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%x)) then + LB(1:1) = lbound(SrcModLinTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%x, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%x)) then + allocate(DstModLinTypeData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%x = SrcModValsTypeData%x + DstModLinTypeData%x = SrcModLinTypeData%x end if - if (allocated(SrcModValsTypeData%dxdt)) then - LB(1:1) = lbound(SrcModValsTypeData%dxdt, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%dxdt, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%dxdt)) then - allocate(DstModValsTypeData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dx)) then + LB(1:1) = lbound(SrcModLinTypeData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%dx, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dx)) then + allocate(DstModLinTypeData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dxdt.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dxdt = SrcModValsTypeData%dxdt + DstModLinTypeData%dx = SrcModLinTypeData%dx end if - if (allocated(SrcModValsTypeData%u)) then - LB(1:1) = lbound(SrcModValsTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%u, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%u)) then - allocate(DstModValsTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%u)) then + LB(1:1) = lbound(SrcModLinTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%u, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%u)) then + allocate(DstModLinTypeData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%u.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%u = SrcModValsTypeData%u + DstModLinTypeData%u = SrcModLinTypeData%u end if - if (allocated(SrcModValsTypeData%y)) then - LB(1:1) = lbound(SrcModValsTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%y, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%y)) then - allocate(DstModValsTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%y)) then + LB(1:1) = lbound(SrcModLinTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%y, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%y)) then + allocate(DstModLinTypeData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%y.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%y.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%y = SrcModValsTypeData%y + DstModLinTypeData%y = SrcModLinTypeData%y end if - if (allocated(SrcModValsTypeData%u_perturb)) then - LB(1:1) = lbound(SrcModValsTypeData%u_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%u_perturb, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%u_perturb)) then - allocate(DstModValsTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%u_perturb)) then + LB(1:1) = lbound(SrcModLinTypeData%u_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%u_perturb, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%u_perturb)) then + allocate(DstModLinTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%u_perturb = SrcModValsTypeData%u_perturb + DstModLinTypeData%u_perturb = SrcModLinTypeData%u_perturb end if - if (allocated(SrcModValsTypeData%x_perturb)) then - LB(1:1) = lbound(SrcModValsTypeData%x_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%x_perturb, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%x_perturb)) then - allocate(DstModValsTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%x_perturb)) then + LB(1:1) = lbound(SrcModLinTypeData%x_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%x_perturb, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%x_perturb)) then + allocate(DstModLinTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%x_perturb = SrcModValsTypeData%x_perturb + DstModLinTypeData%x_perturb = SrcModLinTypeData%x_perturb end if - if (allocated(SrcModValsTypeData%xp)) then - LB(1:1) = lbound(SrcModValsTypeData%xp, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%xp, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%xp)) then - allocate(DstModValsTypeData%xp(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%x_pos)) then + LB(1:1) = lbound(SrcModLinTypeData%x_pos, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%x_pos, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%x_pos)) then + allocate(DstModLinTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xp.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x_pos.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%xp = SrcModValsTypeData%xp + DstModLinTypeData%x_pos = SrcModLinTypeData%x_pos end if - if (allocated(SrcModValsTypeData%xn)) then - LB(1:1) = lbound(SrcModValsTypeData%xn, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%xn, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%xn)) then - allocate(DstModValsTypeData%xn(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%x_neg)) then + LB(1:1) = lbound(SrcModLinTypeData%x_neg, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%x_neg, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%x_neg)) then + allocate(DstModLinTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xn.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x_neg.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%xn = SrcModValsTypeData%xn + DstModLinTypeData%x_neg = SrcModLinTypeData%x_neg end if - if (allocated(SrcModValsTypeData%yp)) then - LB(1:1) = lbound(SrcModValsTypeData%yp, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%yp, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%yp)) then - allocate(DstModValsTypeData%yp(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%y_pos)) then + LB(1:1) = lbound(SrcModLinTypeData%y_pos, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%y_pos, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%y_pos)) then + allocate(DstModLinTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yp.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%y_pos.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%yp = SrcModValsTypeData%yp + DstModLinTypeData%y_pos = SrcModLinTypeData%y_pos end if - if (allocated(SrcModValsTypeData%yn)) then - LB(1:1) = lbound(SrcModValsTypeData%yn, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%yn, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%yn)) then - allocate(DstModValsTypeData%yn(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%y_neg)) then + LB(1:1) = lbound(SrcModLinTypeData%y_neg, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%y_neg, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%y_neg)) then + allocate(DstModLinTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yn.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%y_neg.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%yn = SrcModValsTypeData%yn + DstModLinTypeData%y_neg = SrcModLinTypeData%y_neg end if - if (allocated(SrcModValsTypeData%dYdx)) then - LB(1:2) = lbound(SrcModValsTypeData%dYdx, kind=B8Ki) - UB(1:2) = ubound(SrcModValsTypeData%dYdx, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%dYdx)) then - allocate(DstModValsTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dYdx)) then + LB(1:2) = lbound(SrcModLinTypeData%dYdx, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dYdx, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dYdx)) then + allocate(DstModLinTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dYdx = SrcModValsTypeData%dYdx + DstModLinTypeData%dYdx = SrcModLinTypeData%dYdx end if - if (allocated(SrcModValsTypeData%dXdx)) then - LB(1:2) = lbound(SrcModValsTypeData%dXdx, kind=B8Ki) - UB(1:2) = ubound(SrcModValsTypeData%dXdx, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%dXdx)) then - allocate(DstModValsTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dXdx)) then + LB(1:2) = lbound(SrcModLinTypeData%dXdx, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dXdx, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dXdx)) then + allocate(DstModLinTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dXdx = SrcModValsTypeData%dXdx + DstModLinTypeData%dXdx = SrcModLinTypeData%dXdx end if - if (allocated(SrcModValsTypeData%dYdu)) then - LB(1:2) = lbound(SrcModValsTypeData%dYdu, kind=B8Ki) - UB(1:2) = ubound(SrcModValsTypeData%dYdu, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%dYdu)) then - allocate(DstModValsTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dYdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dYdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dYdu, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dYdu)) then + allocate(DstModLinTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dYdu = SrcModValsTypeData%dYdu + DstModLinTypeData%dYdu = SrcModLinTypeData%dYdu end if - if (allocated(SrcModValsTypeData%dXdu)) then - LB(1:2) = lbound(SrcModValsTypeData%dXdu, kind=B8Ki) - UB(1:2) = ubound(SrcModValsTypeData%dXdu, kind=B8Ki) - if (.not. allocated(DstModValsTypeData%dXdu)) then - allocate(DstModValsTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dXdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dXdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dXdu, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dXdu)) then + allocate(DstModLinTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dXdu = SrcModValsTypeData%dXdu + DstModLinTypeData%dXdu = SrcModLinTypeData%dXdu end if end subroutine -subroutine NWTC_Library_DestroyModValsType(ModValsTypeData, ErrStat, ErrMsg) - type(ModValsType), intent(inout) :: ModValsTypeData +subroutine NWTC_Library_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) + type(ModLinType), intent(inout) :: ModLinTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModValsType' + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModLinType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModValsTypeData%x)) then - deallocate(ModValsTypeData%x) + if (allocated(ModLinTypeData%x)) then + deallocate(ModLinTypeData%x) end if - if (allocated(ModValsTypeData%dxdt)) then - deallocate(ModValsTypeData%dxdt) + if (allocated(ModLinTypeData%dx)) then + deallocate(ModLinTypeData%dx) end if - if (allocated(ModValsTypeData%u)) then - deallocate(ModValsTypeData%u) + if (allocated(ModLinTypeData%u)) then + deallocate(ModLinTypeData%u) end if - if (allocated(ModValsTypeData%y)) then - deallocate(ModValsTypeData%y) + if (allocated(ModLinTypeData%y)) then + deallocate(ModLinTypeData%y) end if - if (allocated(ModValsTypeData%u_perturb)) then - deallocate(ModValsTypeData%u_perturb) + if (allocated(ModLinTypeData%u_perturb)) then + deallocate(ModLinTypeData%u_perturb) end if - if (allocated(ModValsTypeData%x_perturb)) then - deallocate(ModValsTypeData%x_perturb) + if (allocated(ModLinTypeData%x_perturb)) then + deallocate(ModLinTypeData%x_perturb) end if - if (allocated(ModValsTypeData%xp)) then - deallocate(ModValsTypeData%xp) + if (allocated(ModLinTypeData%x_pos)) then + deallocate(ModLinTypeData%x_pos) end if - if (allocated(ModValsTypeData%xn)) then - deallocate(ModValsTypeData%xn) + if (allocated(ModLinTypeData%x_neg)) then + deallocate(ModLinTypeData%x_neg) end if - if (allocated(ModValsTypeData%yp)) then - deallocate(ModValsTypeData%yp) + if (allocated(ModLinTypeData%y_pos)) then + deallocate(ModLinTypeData%y_pos) end if - if (allocated(ModValsTypeData%yn)) then - deallocate(ModValsTypeData%yn) + if (allocated(ModLinTypeData%y_neg)) then + deallocate(ModLinTypeData%y_neg) end if - if (allocated(ModValsTypeData%dYdx)) then - deallocate(ModValsTypeData%dYdx) + if (allocated(ModLinTypeData%dYdx)) then + deallocate(ModLinTypeData%dYdx) end if - if (allocated(ModValsTypeData%dXdx)) then - deallocate(ModValsTypeData%dXdx) + if (allocated(ModLinTypeData%dXdx)) then + deallocate(ModLinTypeData%dXdx) end if - if (allocated(ModValsTypeData%dYdu)) then - deallocate(ModValsTypeData%dYdu) + if (allocated(ModLinTypeData%dYdu)) then + deallocate(ModLinTypeData%dYdu) end if - if (allocated(ModValsTypeData%dXdu)) then - deallocate(ModValsTypeData%dXdu) + if (allocated(ModLinTypeData%dXdu)) then + deallocate(ModLinTypeData%dXdu) end if end subroutine -subroutine NWTC_Library_PackModValsType(RF, Indata) +subroutine NWTC_Library_PackModLinType(RF, Indata) type(RegFile), intent(inout) :: RF - type(ModValsType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackModValsType' + type(ModLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModLinType' if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%x) - call RegPackAlloc(RF, InData%dxdt) + call RegPackAlloc(RF, InData%dx) call RegPackAlloc(RF, InData%u) call RegPackAlloc(RF, InData%y) call RegPackAlloc(RF, InData%u_perturb) call RegPackAlloc(RF, InData%x_perturb) - call RegPackAlloc(RF, InData%xp) - call RegPackAlloc(RF, InData%xn) - call RegPackAlloc(RF, InData%yp) - call RegPackAlloc(RF, InData%yn) + call RegPackAlloc(RF, InData%x_pos) + call RegPackAlloc(RF, InData%x_neg) + call RegPackAlloc(RF, InData%y_pos) + call RegPackAlloc(RF, InData%y_neg) call RegPackAlloc(RF, InData%dYdx) call RegPackAlloc(RF, InData%dXdx) call RegPackAlloc(RF, InData%dYdu) @@ -1210,24 +1271,24 @@ subroutine NWTC_Library_PackModValsType(RF, Indata) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackModValsType(RF, OutData) +subroutine NWTC_Library_UnPackModLinType(RF, OutData) type(RegFile), intent(inout) :: RF - type(ModValsType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModValsType' + type(ModLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModLinType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dxdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%yp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%yn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 8882bcc144..2bb5ce5c92 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -61,6 +61,7 @@ param ^ - IntKi VF_Mesh - 1 - param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - +param ^ - IntKi VF_AeroMap - 16 - "Variable for aeromap" - param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - param ^ - IntKi VC_None - 0 - "" - @@ -74,14 +75,10 @@ typedef ^ ^ IntKi Nodes - 1 - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - -typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - -typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iLoc 2 - - "indices in local arrays" - typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - -typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - @@ -94,16 +91,25 @@ typedef ^ ^ IntKi Nx - - - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ModValsType R8Ki x : - - "" - -typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ModIdxType IntKi FlagFilter - - - "" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ IntKi ix : - - "" - +typedef ^ ^ IntKi idx : - - "" - +typedef ^ ^ IntKi iu : - - "" - +typedef ^ ^ IntKi iy : - - "" - + +typedef ^ ModLinType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki u_perturb : - - "" - typedef ^ ^ R8Ki x_perturb : - - "" - -typedef ^ ^ R8Ki xp : - - "" - -typedef ^ ^ R8Ki xn : - - "" - -typedef ^ ^ R8Ki yp : - - "" - -typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki x_pos : - - "" - +typedef ^ ^ R8Ki x_neg : - - "" - +typedef ^ ^ R8Ki y_pos : - - "" - +typedef ^ ^ R8Ki y_neg : - - "" - typedef ^ ^ R8Ki dYdx :: - - "" - typedef ^ ^ R8Ki dXdx :: - - "" - typedef ^ ^ R8Ki dYdu :: - - "" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 310b3de0e9..ce7aa35472 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -61,6 +61,7 @@ param ^ - IntKi VF_Mesh - 1 - param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - +param ^ - IntKi VF_AeroMap - 16 - "Variable for aeromap" - param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - param ^ - IntKi VC_None - 0 - "" - @@ -74,14 +75,10 @@ typedef ^ ^ IntKi Nodes - 1 - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - -typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - -typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iLoc 2 - - "indices in local arrays" - typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - -typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - @@ -94,16 +91,25 @@ typedef ^ ^ IntKi Nx - - - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ModValsType R8Ki x : - - "" - -typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ModIdxType IntKi FlagFilter - - - "" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ IntKi ix : - - "" - +typedef ^ ^ IntKi idx : - - "" - +typedef ^ ^ IntKi iu : - - "" - +typedef ^ ^ IntKi iy : - - "" - + +typedef ^ ModLinType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki u_perturb : - - "" - typedef ^ ^ R8Ki x_perturb : - - "" - -typedef ^ ^ R8Ki xp : - - "" - -typedef ^ ^ R8Ki xn : - - "" - -typedef ^ ^ R8Ki yp : - - "" - -typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki x_pos : - - "" - +typedef ^ ^ R8Ki x_neg : - - "" - +typedef ^ ^ R8Ki y_pos : - - "" - +typedef ^ ^ R8Ki y_neg : - - "" - typedef ^ ^ R8Ki dYdx :: - - "" - typedef ^ ^ R8Ki dXdx :: - - "" - typedef ^ ^ R8Ki dYdu :: - - "" - From e240929de28f76ae5e88a4f89fd1751e6b9f7180 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 25 Jan 2024 18:55:45 +0000 Subject: [PATCH 040/319] Add module variables to ElastoDyn --- modules/elastodyn/src/ElastoDyn.f90 | 2091 ++++++++---------- modules/elastodyn/src/ElastoDyn_Registry.txt | 54 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 636 ++++-- 3 files changed, 1417 insertions(+), 1364 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 021eedaa85..7ca987239a 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -63,8 +63,15 @@ MODULE ElastoDyn ! states (z) PUBLIC :: ED_GetOP ! Routine to pack the operating point values (for linearization) into arrays + + PUBLIC :: ED_PackStateValues, ED_UnpackStateValues + PUBLIC :: ED_PackInputValues, ED_UnpackInputValues + PUBLIC :: ED_PackOutputValues + + PUBLIC :: ED_UpdateAzimuth CONTAINS + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. @@ -335,11 +342,11 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! set up data needed for linearization analysis !............................................................................................ - if (InitInp%Linearize .or. p%CompAeroMaps) then - call ED_Init_Jacobian(p, u, y, InitOut, ErrStat2, ErrMsg2) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - end if + ! if (InitInp%Linearize .or. p%CompAeroMaps) then + ! call ED_Init_Jacobian(p, u, y, InitOut, ErrStat2, ErrMsg2) + ! call CheckError( ErrStat2, ErrMsg2 ) + ! if (ErrStat >= AbortErrLev) return + ! end if !............................................................................................ @@ -349,6 +356,16 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut Interval = p%DT + !............................................................................................ + ! Module Variables + !............................................................................................ + + CALL ED_InitVars(u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + + !............................................................................................ + ! Summary and cleanup + !............................................................................................ ! Print the summary file if requested: IF (InputFileData%SumPrint) THEN @@ -523,6 +540,20 @@ SUBROUTINE ED_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat END SUBROUTINE ED_UpdateStates + +!> Limit azimuth to be between 0 and 2pi +SUBROUTINE ED_UpdateAzimuth(p, x, DT) + TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ED_ContinuousStateType), INTENT(INOUT) :: x + real(DbKi), INTENT(IN ) :: DT + + ! If the generator degree of freedom is not active, update the azimuth angle + IF (.not. p%DOF_Flag(DOF_GeAz)) x%QT(DOF_GeAz) = x%QT(DOF_GeAz) + DT*x%QDT(DOF_GeAz) + + ! If the azimuth is greater than 2pi, subtract 2pi + IF ((x%QT(DOF_GeAz) + x%QT(DOF_DrTr)) >= TwoPi_D) x%QT(DOF_GeAz) = x%QT(DOF_GeAz) - TwoPi_D +END SUBROUTINE + !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. !! This SUBROUTINE is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. @@ -10338,7 +10369,7 @@ END SUBROUTINE FixHSSBrTq !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, ModIdx ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -10355,204 +10386,165 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - !! respect to the inputs (u) [intent in to avoid deallocation] - - - ! local variables - TYPE(ED_OutputType) :: y_p - TYPE(ED_OutputType) :: y_m - TYPE(ED_ContinuousStateType) :: x_p - TYPE(ED_ContinuousStateType) :: x_m - TYPE(ED_InputType) :: u_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] + TYPE(ModIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' + integer(IntKi) :: i, j, row, col - - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function - - ! make a copy of the inputs to perturb - call ED_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - IF ( PRESENT( dYdu ) ) THEN + ! Update copy of the inputs to perturb + call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackInputValues(p, u, m%Lin%u) - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then - ! allocate dYdu if necessary + ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1)+p%NumExtendedInputs, 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + if (present(ModIdx)) then + call AllocAry(dYdu, ModIdx%Ny, ModIdx%Nu, 'dYdu', ErrStat2, ErrMsg2) + else + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2) end if + if (Failed()) return end if - - if (p%CompAeroMaps) then - dYdu = 0.0_R8Ki - else - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute y at u_op + delta u - call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get u_op - delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute y at u_op - delta u - call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) - - end do - - ! now do the extended input: sum the p%NumBl blade pitch columns - if (p%NumExtendedInputs > 0) then - dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom - do i=2,p%NumBl - dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)+1) + dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) - end do - end if - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return + + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle end if - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - end if !CompAeroMaps - END IF - + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) + call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) + call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdu(:,col)) + end do + end do + + ! Only include extended variables in full linearization + if (.not. present(ModIdx)) then - IF ( PRESENT( dXdu ) ) THEN + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + associate (Var => p%Vars%u(p%iVarBlPitchCom)) + m%Lin%dYdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(m%Lin%dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate + end if - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dYdu = m%Lin%dYdu(ModIdx%iy, ModIdx%iu) + else + dYdu = m%Lin%dYdu + end if + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu)) then - ! allocate dXdu if necessary + ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%NActvDOF_Lin + p%NActvVelDOF_Lin, size(p%Jac_u_indx,1)+p%NumExtendedInputs, 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + if (present(ModIdx)) then + call AllocAry(dXdu, ModIdx%Nx, ModIdx%Nu, 'dXdu', ErrStat2, ErrMsg2) + else + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2) end if + if (Failed()) return end if - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute x at u_op + delta u - call ED_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call ED_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute x at u_op - delta u - call ED_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return + + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta, dXdu(:,i) ) - end do - - - ! now do the extended input: sum the p%NumBl blade pitch columns - if (p%NumExtendedInputs > 0) then - dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom - do i=2,p%NumBl - dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)+1) + dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) + call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dx_perturb, m%Lin%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) + call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dx_perturb, m%Lin%x_neg) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + m%Lin%dXdu(:,col) = (m%Lin%x_pos - m%Lin%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) end do + end do + + ! Only include extended variables in full linearization + if (.not. present(ModIdx)) then + + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + associate (Var => p%Vars%u(p%iVarBlPitchCom)) + m%Lin%dXdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(m%Lin%dXdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate end if - - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - - END IF + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dXdu = m%Lin%dXdu(ModIdx%idx, ModIdx%iu) + else + dXdu = m%Lin%dXdu + end if + end if - - IF ( PRESENT( dXddu ) ) THEN + if ( present( dXddu ) ) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if - IF ( PRESENT( dZdu ) ) THEN + if ( present( dZdu ) ) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if call cleanup() contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function subroutine cleanup() - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call ED_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) m%IgnoreMod = .false. end subroutine cleanup @@ -10560,7 +10552,7 @@ END SUBROUTINE ED_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, ModIdx ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -10585,148 +10577,125 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the continuous states (x) [intent in to avoid deallocation] - - ! local variables - TYPE(ED_OutputType) :: y_p - TYPE(ED_OutputType) :: y_m - TYPE(ED_ContinuousStateType) :: x_p - TYPE(ED_ContinuousStateType) :: x_m - TYPE(ED_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j - + TYPE(ModIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' - - - ! Initialize ErrStat + INTEGER(IntKi) :: i, j, col + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function - ! make a copy of the continuous states to perturb - call ED_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - IF ( PRESENT( dYdx ) ) THEN + ! Copy state values + call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, x, m%Lin%x) - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then - ! allocate dYdx if necessary + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%NActvDOF_Lin + p%NActvVelDOF_Lin, 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + if (present(ModIdx)) then + call AllocAry(dYdx, ModIdx%Ny, ModIdx%Nx, 'dYdx', ErrStat2, ErrMsg2) + else + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2) end if + if (Failed()) return end if - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + + ! Loop through input variables + do i = 1, size(p%Vars%x) + + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%x(i)%Flags, ModIdx%FlagFilter) == 0) cycle end if - - - do i=1,p%NActvDOF_Lin + p%NActvVelDOF_Lin - - ! get x_op + delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_x( p, i, 1, x_perturb, delta ) - - ! compute y at x_op + delta x - call ED_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get x_op - delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call ED_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) - + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) + call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) + call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) + call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) + call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg) + + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdx(:,col)) + end do end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return + + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dYdx = m%Lin%dYdx(ModIdx%iy, ModIdx%ix) + else + dYdx = m%Lin%dYdx end if - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF - - IF ( PRESENT( dXdx ) ) THEN + end if - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if ( present( dXdx ) ) then - ! allocate dXdx if necessary + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%NActvDOF_Lin + p%NActvVelDOF_Lin, p%NActvDOF_Lin + p%NActvVelDOF_Lin, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + if (present(ModIdx)) then + call AllocAry(dXdx, ModIdx%Nx, ModIdx%Nx, 'dXdx', ErrStat2, ErrMsg2) + else + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2) end if + if (Failed()) return end if - - do i=1,p%NActvDOF_Lin + p%NActvVelDOF_Lin - - ! get x_op + delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_Perturb_x( p, i, 1, x_perturb, delta ) - - ! compute x at x_op + delta x - call ED_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get x_op - delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute x at x_op - delta x - call ED_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return + + ! Loop through input variables + do i = 1, size(p%Vars%x) + + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%x(i)%Flags, ModIdx%FlagFilter) == 0) cycle end if - - ! get central difference: - - call Compute_dX( p, x_p, x_m, delta, dXdx(:,i) ) - + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) + call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) + call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dx_perturb, m%Lin%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) + call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) + call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dx_perturb, m%Lin%x_neg) + + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + m%Lin%dXdx(:,col) = (m%Lin%x_pos - m%Lin%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + end do end do - - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - END IF + + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dXdx = m%Lin%dXdx(ModIdx%idx, ModIdx%ix) + else + dXdx = m%Lin%dXdx + end if + end if IF ( PRESENT( dXddx ) ) THEN if (allocated(dXddx)) deallocate(dXddx) @@ -10739,12 +10708,12 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, call cleanup() contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function subroutine cleanup() - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call ED_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) m%IgnoreMod = .false. end subroutine cleanup @@ -10895,926 +10864,728 @@ END SUBROUTINE ED_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. -SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) +!> Routine to pack the data structures representing the operating points into arrays for linearization. +SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP, ModIdx ) - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables: - INTEGER(IntKi) :: i,j,k, index_last, index_next + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(ED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(ED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(ED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(ED_OutputType), INTENT(IN ) :: y !< Output at operating point + TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) + TYPE(ModIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + + INTEGER(IntKi) :: i, k, index + INTEGER(IntKi) :: ny INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian_y' - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - LOGICAL :: BladeMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - logical, allocatable :: AllOut(:) - - - + CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' + integer(IntKi) :: FlagFilter + + ! Initialize ErrStat ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - p%Jac_ny = 0 - BladeMask = .true. ! default is all the fields - if (p%CompAeroMaps) then - if (allocated(y%BladeLn2Mesh)) then - do i=1,p%NumBl_Lin - p%Jac_ny = p%Jac_ny + y%BladeLn2Mesh(i)%NNodes * 12 ! 3 TranslationDisp, Orientation, TranslationVel, and RotationVel at each node on each blade (skip accelerations) - end do - end if - BladeMask(MASKID_TRANSLATIONACC) = .false. - BladeMask(MASKID_ROTATIONACC) = .false. + ErrMsg = '' + + ! Get flag filter from ModIdx if present, otherwise set to allow all + if (present(ModIdx)) then + FlagFilter = ModIdx%FlagFilter else - - if (allocated(y%BladeLn2Mesh)) then - do i=1,p%NumBl_Lin - p%Jac_ny = p%Jac_ny + y%BladeLn2Mesh(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node on each blade - end do - end if - - p%Jac_ny = p%Jac_ny & - + y%PlatformPtMesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + y%TowerLn2Mesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, and RotationVel at each node - + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + 3 & ! Yaw, YawRate, and HSS_Spd - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values + FlagFilter = not(0_IntKi) ! allow all + end if - do i=1,p%NumBl_Lin - p%Jac_ny = p%Jac_ny + y%BladeRootMotion(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each (1) node on each blade - end do + !.................................. + if ( present( u_op ) ) then - end if - - !................. - ! set linearization output names: - !................. - CALL AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%RotFrame_y = .false. ! note that meshes are in the global, not rotating frame - - - index_next = 1 - if (allocated(y%BladeLn2Mesh)) then - index_last = index_next - do i=1,p%NumBl_Lin - call PackMotionMesh_Names(y%BladeLn2Mesh(i), 'Blade '//trim(num2lstr(i)), InitOut%LinNames_y, index_next, FieldMask=BladeMask) - end do - end if - - if (.not. p%CompAeroMaps) then - call PackMotionMesh_Names(y%PlatformPtMesh, 'Platform', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%TowerLn2Mesh, 'Tower', InitOut%LinNames_y, index_next) - - ! note that this Mask is for the y%HubPtMotion mesh ONLY. The others pack *all* of the motion fields - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - - call PackMotionMesh_Names(y%HubPtMotion, 'Hub', InitOut%LinNames_y, index_next, FieldMask=Mask) - index_last = index_next - do i=1,p%NumBl_Lin - call PackMotionMesh_Names(y%BladeRootMotion(i), 'Blade root '//trim(num2lstr(i)), InitOut%LinNames_y, index_next) - end do - - call PackMotionMesh_Names(y%NacelleMotion, 'Nacelle', InitOut%LinNames_y, index_next) - InitOut%LinNames_y(index_next) = 'Yaw, rad'; index_next = index_next+1 - InitOut%LinNames_y(index_next) = 'YawRate, rad/s'; index_next = index_next+1 - InitOut%LinNames_y(index_next) = 'HSS_Spd, rad/s' - - do i=1,p%NumOuts + p%BldNd_TotNumOuts - InitOut%LinNames_y(i+index_next) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do - - - !! check for AllOuts in rotating frame - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; + if (.not. allocated(u_op)) then + if (present(ModIdx)) then + call AllocAry(u_op, ModIdx%Nu, 'u_op', ErrStat2, ErrMsg2) + else + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) + end if + if (Failed()) return end if - - AllOut = .false. - do k=1,3 - AllOut(TipDxc( k)) = .true. - AllOut(TipDyc( k)) = .true. - AllOut(TipDzc( k)) = .true. - AllOut(TipDxb( k)) = .true. - AllOut(TipDyb( k)) = .true. - AllOut(TipALxb( k)) = .true. - AllOut(TipALyb( k)) = .true. - AllOut(TipALzb( k)) = .true. - AllOut(TipRDxb( k)) = .true. - AllOut(TipRDyb( k)) = .true. - AllOut(TipRDzc( k)) = .true. - AllOut(TipClrnc(k)) = .true. - AllOut(PtchPMzc(k)) = .true. - AllOut(RootFxc( k)) = .true. - AllOut(RootFyc( k)) = .true. - AllOut(RootFzc( k)) = .true. - AllOut(RootFxb( k)) = .true. - AllOut(RootFyb( k)) = .true. - AllOut(RootMxc( k)) = .true. - AllOut(RootMyc( k)) = .true. - AllOut(RootMzc( k)) = .true. - AllOut(RootMxb( k)) = .true. - AllOut(RootMyb( k)) = .true. - - do j=1,9 - AllOut(SpnALxb( j,k)) = .true. - AllOut(SpnALyb( j,k)) = .true. - AllOut(SpnALzb( j,k)) = .true. - AllOut(SpnFLxb( j,k)) = .true. - AllOut(SpnFLyb( j,k)) = .true. - AllOut(SpnFLzb( j,k)) = .true. - AllOut(SpnMLxb( j,k)) = .true. - AllOut(SpnMLyb( j,k)) = .true. - AllOut(SpnMLzb( j,k)) = .true. - AllOut(SpnTDxb( j,k)) = .true. - AllOut(SpnTDyb( j,k)) = .true. - AllOut(SpnTDzb( j,k)) = .true. - AllOut(SpnRDxb( j,k)) = .true. - AllOut(SpnRDyb( j,k)) = .true. - AllOut(SpnRDzb( j,k)) = .true. + + ! Pack input type into array + call ED_PackInputValues(p, u, m%Lin%u) + + ! If extended inputs are requested + if (iand(FlagFilter, VF_Ext) /= 0) then + do k = 2,p%NumBl + if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then + call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & + "the commanded blade pitch angles are not the same for each blade.", ErrStat, ErrMsg, RoutineName) + exit + end if end do - end do - - do i=1,p%NumOuts - InitOut%RotFrame_y(i+index_next) = AllOut( p%OutParam(i)%Indx ) - end do - - do i=1, p%BldNd_TotNumOuts - InitOut%RotFrame_y(i+p%NumOuts+index_next) = .true. - end do - - deallocate(AllOut) - end if !.not. p%CompAeroMaps - -END SUBROUTINE ED_Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. -SUBROUTINE ED_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) + end if - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian_x' - - ! local variables: - INTEGER(IntKi) :: i, indx - - ErrStat = ErrID_None - ErrMsg = "" - - if (p%CompAeroMaps) then - p%NActvDOF_Lin = p%DOFs%NActvDOF / p%NumBl ! we have only blade DOFs, and we are going to use only 1 of the blades - p%NActvDOF_Stride = p%NumBl - p%NActvVelDOF_Lin = 0 ! we do NOT have velocity states - else - p%NActvDOF_Lin = p%DOFs%NActvDOF - p%NActvDOF_Stride = 1 - p%NActvVelDOF_Lin = p%NActvDOF_Lin ! we have velocity states - end if - - ! allocate space for the row/column names and for perturbation sizes - call allocAry(p%dx, p%NDof, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%LinNames_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! All Elastodyn continuous states are max order = 2 - if ( allocated(InitOut%DerivOrder_x) ) InitOut%DerivOrder_x = 2 - - p%dx = 0.0_R8Ki ! initialize in case we have only 1 blade - - ! set perturbation sizes: p%dx - p%dx(DOF_Sg :DOF_Hv) = 0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi) ! platform translational displacement states - p%dx(DOF_R :DOF_Y ) = 2.0_R8Ki * D2R_D ! platform rotational states - p%dx(DOF_TFA1:DOF_TSS1) = 0.020_R8Ki * D2R_D * p%TwrFlexL ! tower deflection states: 1st tower - p%dx(DOF_TFA2:DOF_TSS2) = 0.002_R8Ki * D2R_D * p%TwrFlexL ! tower deflection states: 2nd tower - p%dx(DOF_Yaw :DOF_TFrl) = 2.0_R8Ki * D2R_D ! nacelle-yaw, rotor-furl, generator azimuth, drivetrain, and tail-furl rotational states - - do i=1,p%NumBl - p%dx(DOF_BF(i,1))= 0.20_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 1st blade flap mode - p%dx(DOF_BF(i,2))= 0.02_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 2nd blade flap mode for blades (1/10 of the other perturbations) - p%dx(DOF_BE(i,1))= 0.20_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 1st blade edge mode - end do - - if ( p%NumBl == 2 ) then - p%dx(DOF_Teet) = 2.0_R8Ki * D2R_D ! rotor-teeter rotational state + ! If ModIdx is present + if (present(ModIdx)) then + u_op = m%Lin%u(ModIdx%iu) ! copy subset of array + else + u_op = m%Lin%u ! copy full array + end if end if - - !Set some limits in case perturbation is very small - do i=1,p%NDof - p%dx(i) = max(p%dx(i), MinPerturb) - end do + + !.................................. + if (present(y_op)) then - if (p%CompAeroMaps) then - InitOut%RotFrame_x = .true. - else - InitOut%RotFrame_x = .false. - do i=1,p%DOFs%NActvDOF - if ( p%DOFs%PS(i) >= DOF_BF(1,1) ) then - if ( p%NumBl == 2 ) then - InitOut%RotFrame_x(i) = p%DOFs%PS(i) < DOF_Teet - else - InitOut%RotFrame_x(i) = .true. ! = p%DOFs%PS(i) <= DOF_BF (MaxBl,NumBF) - end if + if (.not. allocated(y_op)) then + if (present(ModIdx)) then + call AllocAry(y_op, ModIdx%Ny, 'y_op', ErrStat2, ErrMsg2) + else + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) end if - end do + if (Failed()) return + end if + + call ED_PackOutputValues(p, y, m%Lin%y) + + ! If ModIdx is present + if (present(ModIdx)) then + y_op = m%Lin%y(ModIdx%iy) ! copy subset of array + else + y_op = m%Lin%y ! copy full array + end if end if - - ! set linearization output names: - indx = 0 - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride - indx = indx + 1 - InitOut%LinNames_x(indx) = p%DOF_Desc( p%DOFs%PS(i) ) - end do - - do i=1,p%NActvVelDOF_Lin - InitOut%LinNames_x(i+p%NActvDOF_Lin) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%NActvDOF_Lin) = InitOut%RotFrame_x(i) - end do - -END SUBROUTINE ED_Init_Jacobian_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding linearization routines ! -SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) + !.................................. + if (present(x_op)) then - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_InputType) , INTENT(IN ) :: u !< inputs - TYPE(ED_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField, m - REAL(R8Ki) :: MaxThrust, MaxTorque - REAL(R8Ki) :: ScaleLength - - - ErrStat = ErrID_None - ErrMsg = "" - - if (p%CompAeroMaps) then - p%NumBl_Lin = 1 - else - p%NumBl_Lin = p%NumBl - end if - - - call ED_Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call ED_Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - + if (.not. allocated(x_op)) then + if (present(ModIdx)) then + call AllocAry(x_op, ModIdx%Nx, 'x_op', ErrStat2, ErrMsg2) + else + call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2) + end if + if (Failed()) return + end if + + call ED_PackStateValues(p, x, m%Lin%x) - ! determine how many inputs there are in the Jacobians - nu = 0; - if (allocated(u%BladePtLoads)) then - do i=1,p%NumBl_Lin - nu = nu + u%BladePtLoads(i)%NNodes * 6 ! 3 forces + 3 moments at each node on each blade - end do - end if - - if (p%CompAeroMaps) then - p%NumExtendedInputs = 0 - else - nu = nu & - + u%PlatformPtMesh%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%TowerPtLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%HubPtLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%NacelleLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumBl & ! blade pitch command (BlPitchCom) - + 2 ! YawMom and GenTrq - p%NumExtendedInputs = 1 + ! If ModIdx is present + if (present(ModIdx)) then + x_op = m%Lin%x(ModIdx%ix) ! copy subset of array + else + x_op = m%Lin%x ! copy full array + end if end if - ! note: all other inputs are ignored - - !.................... - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see elastodyn::ed_perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index of the acceleration/load field - ! column 3 is the node - !.................... - - !............... - ! ED input mappings stored in p%Jac_u_indx: - !............... - call AllocAry(p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - + + !.................................. + if (present(dx_op)) then + + if (.not. allocated(dx_op)) then + if (present(ModIdx)) then + call AllocAry(dx_op, ModIdx%Nx, 'dx_op', ErrStat2, ErrMsg2) + else + call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2) + end if + if (Failed()) return + end if - index = 1 - if (allocated(u%BladePtLoads)) then - !Module/Mesh/Field: u%BladePtLoads(1)%Force = 1; - !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2; - !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3; - !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4; - !Module/Mesh/Field: u%BladePtLoads(3)%Force = 5; - !Module/Mesh/Field: u%BladePtLoads(3)%Moment = 6; - do k=1,p%NumBl_Lin - - do i_meshField = 1,2 - do i=1,u%BladePtLoads(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField + (k-1)*2 !Module/Mesh/Field: u%BladePtLoads(k)%{Force/Moment} = m - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - end if - - if (.not. p%CompAeroMaps) then - !if MaxBl ever changes (i.e., MaxBl /=3), we need to modify this accordingly: - do i_meshField = 7,8 - do i=1,u%PlatformPtMesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%PlatformPtMesh%Force = 7; u%PlatformPtMesh%Moment = 8; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 9,10 - do i=1,u%TowerPtLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%TowerPtLoads%Force = 9; u%TowerPtLoads%Moment = 10; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 11,12 - do i=1,u%HubPtLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%HubPtLoad%Force = 11; u%HubPtLoad%Moment = 12; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 13,14 - do i=1,u%NacelleLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%NacelleLoads%Force = 13; u%NacelleLoads%Moment = 14; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 1,p%NumBl ! scalars - p%Jac_u_indx(index,1) = 15 !Module/Mesh/Field: u%BlPitchCom = 15; - p%Jac_u_indx(index,2) = 1 !index: n/a - p%Jac_u_indx(index,3) = i_meshField !Node: blade - index = index + 1 - end do - - do i_meshField = 16,17 ! scalars - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%YawMom = 16; u%GenTrq = 17; - p%Jac_u_indx(index,2) = 1 !index: j - p%Jac_u_indx(index,3) = 1 !Node: i - index = index + 1 - end do - end if ! .not. p%CompAeroMaps - - !................ - ! input perturbations, du: - !................ - call AllocAry(p%du, 17, 'p%du', ErrStat2, ErrMsg2) ! 17 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! p%TipRad is set to 0 for BeamDyn simulations, so we're using a copy of the value from the input file here - ScaleLength = max(p%TipRad, p%TowerHt, 1.0_ReKi) - MaxThrust = 490.0_R8Ki * pi_D / 9.0_R8Ki * ScaleLength**2 - MaxTorque = 122.5_R8Ki * pi_D / 27.0_R8Ki * ScaleLength**3 - - if (allocated(u%BladePtLoads)) then - do k=1,p%NumBl - p%du(2*k-1) = MaxThrust / real(100*p%NumBl*u%BladePtLoads(k)%NNodes,R8Ki) ! u%BladePtLoads(k)%Force = 2*k-1 - p%du(2*k ) = MaxTorque / real(100*p%NumBl*u%BladePtLoads(k)%NNodes,R8Ki) ! u%BladePtLoads(k)%Moment = 2*k - end do !k - else - p%du(1:6) = 0.0_R8Ki - end if - - p%du( 7) = MaxThrust / 100.0_R8Ki ! u%PlatformPtMesh%Force = 7 - p%du( 8) = MaxTorque / 100.0_R8Ki ! u%PlatformPtMesh%Moment = 8 - p%du( 9) = MaxThrust / real(100*u%TowerPtLoads%NNodes,R8Ki) ! u%TowerPtLoads%Force = 9 - p%du(10) = MaxTorque / real(100*u%TowerPtLoads%NNodes,R8Ki) ! u%TowerPtLoads%Moment = 10 - p%du(11) = MaxThrust / 100.0_R8Ki ! u%HubPtLoad%Force = 11 - p%du(12) = MaxTorque / 100.0_R8Ki ! u%HubPtLoad%Moment = 12 - p%du(13) = MaxThrust / 100.0_R8Ki ! u%NacelleLoads%Force = 13 - p%du(14) = MaxTorque / 100.0_R8Ki ! u%NacelleLoads%Moment = 14 - p%du(15) = 2.0_R8Ki * D2R_D ! u%BlPitchCom = 15 - p%du(16) = MaxTorque / 100.0_R8Ki ! u%YawMom = 16 - p%du(17) = MaxTorque / (100.0_R8Ki*p%GBRatio) ! u%GenTrq = 17 - - !Set some limits in case perturbation is very small - do i=1,size(p%du) - p%du(i) = max(p%du(i), MinPerturb) - end do + call ED_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2) + if (Failed()) return - !................ - ! names of the columns, InitOut%LinNames_u: - !................ - call AllocAry(InitOut%LinNames_u, nu+p%NumExtendedInputs, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu+p%NumExtendedInputs, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu+p%NumExtendedInputs, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%IsLoad_u = .true. ! most of ED's inputs are loads; we will override the non-load inputs below. - InitOut%RotFrame_u = .false. - index = 1 - if (allocated(u%BladePtLoads)) then - index_last = index - do k=1,p%NumBl_Lin - call PackLoadMesh_Names(u%BladePtLoads(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index) - end do - !InitOut%RotFrame_u(index_last:index-1) = .true. ! values on the mesh are in global, not rotating frame + call ED_PackStateValues(p, m%dx_perturb, m%Lin%dx) + + ! If ModIdx is present + if (present(ModIdx)) then + dx_op = m%Lin%dx(ModIdx%idx) ! copy subset of array + else + dx_op = m%Lin%dx ! copy full array + end if end if - if (.not. p%CompAeroMaps) then - call PackLoadMesh_Names(u%PlatformPtMesh, 'Platform', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%TowerPtLoads, 'Tower', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%HubPtLoad, 'Hub', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%NacelleLoads, 'Nacelle', InitOut%LinNames_u, index) - - do k = 1,p%NumBl ! scalars - InitOut%LinNames_u(index) = 'Blade '//trim(num2lstr(k))//' pitch command, rad' - InitOut%IsLoad_u( index) = .false. - InitOut%RotFrame_u(index) = .true. - index = index + 1 - end do - InitOut%LinNames_u(index) = 'Yaw moment, Nm' ; index = index + 1 - InitOut%LinNames_u(index) = 'Generator torque, Nm' ; index = index + 1 - InitOut%LinNames_u(index) = 'Extended input: collective blade-pitch command, rad' - InitOut%IsLoad_u( index) = .false. + !.................................. + if (present(xd_op)) then end if -END SUBROUTINE ED_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE ED_Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(ED_InputType) , INTENT(INOUT) :: u !< perturbed ED inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - + !.................................. + if (present(z_op)) then + end if - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - CASE ( 1) !Module/Mesh/Field: u%BladePtLoads(1)%Force = 1 - u%BladePtLoads(1)%Force( fieldIndx,node) = u%BladePtLoads(1)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2 - u%BladePtLoads(1)%Moment(fieldIndx,node) = u%BladePtLoads(1)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 3) !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3 - u%BladePtLoads(2)%Force( fieldIndx,node) = u%BladePtLoads(2)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4 - u%BladePtLoads(2)%Moment(fieldIndx,node) = u%BladePtLoads(2)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%BladePtLoads(2)%Force = 5 - u%BladePtLoads(3)%Force( fieldIndx,node) = u%BladePtLoads(3)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 6 - u%BladePtLoads(3)%Moment(fieldIndx,node) = u%BladePtLoads(3)%Moment(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%PlatformPtMesh%Force = 7 - u%PlatformPtMesh%Force( fieldIndx,node) = u%PlatformPtMesh%Force( fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PlatformPtMesh%Moment = 8 - u%PlatformPtMesh%Moment(fieldIndx,node) = u%PlatformPtMesh%Moment(fieldIndx,node) + du * perturb_sign - - CASE ( 9) !Module/Mesh/Field: u%TowerPtLoads%Force = 9 - u%TowerPtLoads%Force( fieldIndx,node) = u%TowerPtLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%TowerPtLoads%Moment = 10 - u%TowerPtLoads%Moment(fieldIndx,node) = u%TowerPtLoads%Moment(fieldIndx,node) + du * perturb_sign - - CASE (11) !Module/Mesh/Field: u%HubPtLoad%Force = 11 - u%HubPtLoad%Force( fieldIndx,node) = u%HubPtLoad%Force( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%HubPtLoad%Moment = 12 - u%HubPtLoad%Moment(fieldIndx,node) = u%HubPtLoad%Moment(fieldIndx,node) + du * perturb_sign - - CASE (13) !Module/Mesh/Field: u%NacelleLoads%Force = 13 - u%NacelleLoads%Force( fieldIndx,node) = u%NacelleLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%NacelleLoads%Moment = 14 - u%NacelleLoads%Moment(fieldIndx,node) = u%NacelleLoads%Moment(fieldIndx,node) + du * perturb_sign - - CASE (15) !Module/Mesh/Field: u%BlPitchCom = 15 - u%BlPitchCom(node) = u%BlPitchCom(node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%YawMom = 16 - u%YawMom = u%YawMom + du * perturb_sign - CASE (17) !Module/Mesh/Field: u%GenTrq = 17 - u%GenTrq = u%GenTrq + du * perturb_sign - - END SELECT - -END SUBROUTINE ED_Perturb_u +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE ED_GetOP !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the continuous state array. -!! Do not change this without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE ED_Perturb_x( p, n_in, perturb_sign, x, dx ) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n_in !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(ED_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed ED states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - ! local variables - integer(intKi) :: indx - integer(intKi) :: n - - n = (n_in - 1) * p%NActvDOF_Stride + 1 - - if (n > p%DOFs%NActvDOF) then - - indx = p%DOFs%PS(n-p%DOFs%NActvDOF) - dx = p%dx( indx ) - - x%QDT( indx ) = x%QDT( indx ) + dx * perturb_sign - - else - - indx = p%DOFs%PS(n) - dx = p%dx( indx ) - - x%QT( indx ) = x%QT( indx ) + dx * perturb_sign - end if - -END SUBROUTINE ED_Perturb_x !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(ED_OutputType) , INTENT(IN ) :: y_p !< ED outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) - TYPE(ED_OutputType) , INTENT(IN ) :: y_m !< ED outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: k ! loop over blades - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - - indx_first = 1 - if (allocated(y_p%BladeLn2Mesh)) then - Mask = .true. - if (p%CompAeroMaps) then - Mask(MASKID_TRANSLATIONACC) = .false. - Mask(MASKID_ROTATIONACC) = .false. - end if - - do k=1,p%NumBl_Lin - call PackMotionMesh_dY(y_p%BladeLn2Mesh(k), y_m%BladeLn2Mesh(k), dY, indx_first, FieldMask=Mask) - end do - end if - - if (.not. p%CompAeroMaps) then - call PackMotionMesh_dY(y_p%PlatformPtMesh, y_m%PlatformPtMesh, dY, indx_first, UseSmlAngle=.true.) - call PackMotionMesh_dY(y_p%TowerLn2Mesh, y_m%TowerLn2Mesh, dY, indx_first, UseSmlAngle=.true.) - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - call PackMotionMesh_dY(y_p%HubPtMotion, y_m%HubPtMotion, dY, indx_first, FieldMask=Mask) - - do k=1,p%NumBl_Lin - call PackMotionMesh_dY(y_p%BladeRootMotion(k), y_m%BladeRootMotion(k), dY, indx_first) - end do - call PackMotionMesh_dY(y_p%NacelleMotion, y_m%NacelleMotion, dY, indx_first) - - dY(indx_first) = y_p%Yaw - y_m%Yaw; indx_first = indx_first + 1 - dY(indx_first) = y_p%YawRate - y_m%YawRate; indx_first = indx_first + 1 - dY(indx_first) = y_p%HSS_Spd - y_m%HSS_Spd; indx_first = indx_first + 1 - - !indx_last = indx_first + p%NumOuts - 1 - do k=1,p%NumOuts + p%BldNd_TotNumOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - end if - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY +! Tight Coupling !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two continuous state types to compute an array of differences. -!! Do not change this packing without making sure subroutine elastodyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_dX(p, x_p, x_m, delta, dX) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(ED_ContinuousStateType) , INTENT(IN ) :: x_p !< ED continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(ED_ContinuousStateType) , INTENT(IN ) :: x_m !< ED continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: i ! loop over blade nodes - INTEGER(IntKi) :: j ! loop over blades - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - - indx_first = 0 - - if (p%NActvVelDOF_Lin > 0) then - do j=1,p%DOFs%NActvDOF, p%NActvDOF_Stride ! Loop through all active (enabled) DOFs for linearization - indx_first = indx_first + 1 - dX(indx_first) = x_p%QT( p%DOFs%PS(j) ) - x_m%QT( p%DOFs%PS(j) ) - end do +subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ED_ParameterType), intent(inout) :: p !< Parameters + type(ED_ContinuousStateType), intent(inout) :: x !< Continuous state + type(ED_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ED_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + type(ED_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ED_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k, idx + integer(IntKi), allocatable :: BladeMeshFields(:) + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + type(ModVarType) :: Var + integer(IntKi) :: Flags + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating vars", ErrStat, ErrMsg, RoutineName) + return end if - - do j=1,p%DOFs%NActvDOF, p%NActvDOF_Stride ! Loop through all active (enabled) DOFs for linearization - indx_first = indx_first + 1 - dX(indx_first) = x_p%QDT( p%DOFs%PS(j) ) - x_m%QDT( p%DOFs%PS(j) ) - end do - - dX = dX / (2*delta) ! whole array operation -END SUBROUTINE Compute_dX -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + allocate(p%Vars%x(0)) + + ! Add continuous state variables (translation and rotation) + call MV_AddVar(p%Vars%x, 'PlatformSurge', VF_TransDisp, & + VarIdx=idx, & + iUsr=DOF_Sg, & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform horizontal surge translation DOF (internal DOF index = DOF_Sg), m'], & + Active=InputFileData%PtfmSgDOF) + + call MV_AddVar(p%Vars%x, 'PlatformSway', VF_TransDisp, & + VarIdx=idx, & + iUsr=DOF_Sw, & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform horizontal sway translation DOF (internal DOF index = DOF_Sw), m'], & + Active=InputFileData%PtfmSwDOF) + + call MV_AddVar(p%Vars%x, 'PlatformHeave', VF_TransDisp, & + VarIdx=idx, & + iUsr=DOF_Hv, & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform vertical heave translation DOF (internal DOF index = DOF_Hv), m'], & + Active=InputFileData%PtfmHvDOF) + + call MV_AddVar(p%Vars%x, 'PlatformRoll', VF_AngularDisp, & + VarIdx=idx, & + iUsr=DOF_R, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform roll tilt rotation DOF (internal DOF index = DOF_R), rad'], & + Active=InputFileData%PtfmRDOF) + + call MV_AddVar(p%Vars%x, 'PlatformPitch', VF_AngularDisp, & + VarIdx=idx, & + iUsr=DOF_P, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform pitch tilt rotation DOF (internal DOF index = DOF_P), rad'], & + Active=InputFileData%PtfmPDOF) + + call MV_AddVar(p%Vars%x, 'PlatformYaw', VF_AngularDisp, & + VarIdx=idx, & + iUsr=DOF_Y, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform yaw rotation DOF (internal DOF index = DOF_Y), rad'], & + Active=InputFileData%PtfmYDOF) + + call MV_AddVar(p%Vars%x, 'TowerFA1', VF_TransDisp, & + VarIdx=idx, & + iUsr=DOF_TFA1, & + Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['1st tower fore-aft bending mode DOF (internal DOF index = DOF_TFA1), m'], & + Active=InputFileData%TwFADOF1) + + call MV_AddVar(p%Vars%x, 'TowerSS1', VF_TransDisp, & + VarIdx=idx, & + iUsr=DOF_TSS1, & + Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['1st tower side-to-side bending mode DOF (internal DOF index = DOF_TSS1), m'], & + Active=InputFileData%TwSSDOF1) + + call MV_AddVar(p%Vars%x, 'TowerFA2', VF_TransDisp, & + VarIdx=idx, & + iUsr=DOF_TFA2, & + Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['2nd tower fore-aft bending mode DOF (internal DOF index = DOF_TFA2), m'], & + Active=InputFileData%TwFADOF2) + + call MV_AddVar(p%Vars%x, 'TowerSS2', VF_TransDisp, & + VarIdx=idx, & + iUsr=DOF_TSS2, & + Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['2nd tower side-to-side bending mode DOF (internal DOF index = DOF_TSS2), m'], & + Active=InputFileData%TwSSDOF2) + + call MV_AddVar(p%Vars%x, 'NacelleYaw', VF_AngularDisp, & + VarIdx=idx, & + iUsr=DOF_Yaw, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Nacelle yaw DOF (internal DOF index = DOF_Yaw), rad'], & + Active=InputFileData%YawDOF) + + call MV_AddVar(p%Vars%x, 'RotorFurl', VF_AngularDisp, & + VarIdx=idx, & + Flags=VF_AeroMap, & + iUsr=DOF_RFrl, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Rotor-furl DOF (internal DOF index = DOF_RFrl), rad'], & + Active=InputFileData%RFrlDOF) + + call MV_AddVar(p%Vars%x, 'GeneratorAzimuth', VF_AngularDisp, & + VarIdx=idx, & + iUsr=DOF_GeAz, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Variable speed generator DOF (internal DOF index = DOF_GeAz), rad'], & + Active=InputFileData%GenDOF) + + call MV_AddVar(p%Vars%x, 'DrivetrainFlexibility', VF_AngularDisp, & + VarIdx=idx, & + iUsr=DOF_DrTr, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Drivetrain rotational-flexibility DOF (internal DOF index = DOF_DrTr), rad'], & + Active=InputFileData%DrTrDOF) + + call MV_AddVar(p%Vars%x, 'TailFurl', VF_AngularDisp, & + VarIdx=idx, & + Flags=VF_AeroMap, & + iUsr=DOF_TFrl, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Tail-furl DOF (internal DOF index = DOF_TFrl), rad'], & + Active=InputFileData%TFrlDOF) + + call MV_AddVar(p%Vars%x, 'RotorTeeter', VF_AngularDisp, & + VarIdx=idx, & + iUsr=DOF_Teet, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Hub teetering DOF (internal DOF index = DOF_Teet), rad'], & + Active=InputFileData%TeetDOF) + + do i = 1, p%NumBl + Flags = VF_RotFrame + if (i == 1) call SetFlags(Flags, VF_AeroMap) + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', VF_TransDisp, & + VarIdx=idx, & + Flags=Flags, & + iUsr=DOF_BF(i,1), & + Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['1st flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',1)), m'], & + Active=InputFileData%FlapDOF1) + end do - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ED_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) + do i = 1, p%NumBl + Flags = VF_RotFrame + if (i == 1) call SetFlags(Flags, VF_AeroMap) + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', VF_TransDisp, & + VarIdx=idx, & + Flags=Flags, & + iUsr=DOF_BE(i,1), & + Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['1st edgewise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BE('//trim(Num2LStr(i))//',1)), m'], & + Active=InputFileData%EdgeDOF) + end do + do i = 1, p%NumBl + Flags = VF_RotFrame + if (i == 1) call SetFlags(Flags, VF_AeroMap) + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', VF_TransDisp, & + VarIdx=idx, & + Flags=Flags, & + iUsr=DOF_BF(i,2), & + Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['2nd flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',2)), m'], & + Active=InputFileData%FlapDOF2) + end do + ! Derivatives of continuous state variables + do i = 1, size(p%Vars%x) - INTEGER(IntKi) :: i, k, index - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' - LOGICAL :: ReturnTrimOP - TYPE(ED_ContinuousStateType) :: dx !< derivative of continuous states at operating point - LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing - - - ! Initialize ErrStat + ! Increase variable perturbation if below minimum + p%Vars%x(i)%Perturb = max(p%Vars%x(i)%Perturb, MinPerturb) - ErrStat = ErrID_None - ErrMsg = '' - - !.................................. - IF ( PRESENT( u_op ) ) THEN - if (.not. allocated(u_op)) then - call AllocAry(u_op, size(p%Jac_u_indx,1)+p%NumExtendedInputs,'u_op',ErrStat2,ErrMsg2) ! +1 for extended input here - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - index = 1 - if (allocated(u%BladePtLoads)) then - do k=1,p%NumBl_Lin - call PackLoadMesh(u%BladePtLoads(k), u_op, index) - end do - end if - if (.not. p%CompAeroMaps) then - call PackLoadMesh(u%PlatformPtMesh, u_op, index) - call PackLoadMesh(u%TowerPtLoads, u_op, index) - call PackLoadMesh(u%HubPtLoad, u_op, index) - call PackLoadMesh(u%NacelleLoads, u_op, index) - - do k = 1,p%NumBl_Lin ! scalars - u_op(index) = u%BlPitchCom(k) - index = index + 1 - end do - u_op(index) = u%YawMom ; index = index + 1 - u_op(index) = u%GenTrq ; index = index + 1 - - ! extended input: ! note this happens only if .not. p%CompAeroMaps, so p%NumExtendedInputs > 0 - u_op(index) = u%BlPitchCom(1) - - do k = 2,p%NumBl_Lin - if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then - call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & - "the commanded blade pitch angles are not the same for each blade.", ErrStat, ErrMsg, RoutineName) - exit - end if - end do - end if + ! Make a copy of variable + Var = p%Vars%x(i) - END IF + ! Update linearization name + Var%LinNames(1) = 'First time derivative of '//trim(Var%LinNames(1))//'/s' - !.................................. - IF ( PRESENT( y_op ) ) THEN - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .false. - end if + ! Update from position to velocity + if (Var%Field == VF_TransDisp) Var%Field = VF_TransVel + if (Var%Field == VF_AngularDisp) Var%Field = VF_AngularVel + + ! Get flags from variable and remove aero map flag + Flags = Var%Flags + call UnsetFlags(Flags, VF_AeroMap) - if (.not. allocated(y_op)) then - ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do - if (p%CompAeroMaps) then - ny = p%Jac_ny - else - ny = p%Jac_ny + y%PlatformPtMesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%TowerLn2Mesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%HubPtMotion%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%NacelleMotion%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node - - do k=1,p%NumBl_Lin - ny = ny + y%BladeRootMotion(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node on each blade + ! Add variable (only active variables are in x) + call MV_AddVar(p%Vars%x, Var%Name, Var%Field, & + VarIdx=idx, & + Flags=Flags, & + iUsr=Var%iUsr(1), & + Perturb=Var%Perturb, & + LinNames=Var%LinNames) + end do + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Calculate values used for input perturbations + ! p%TipRad is set to 0 for BeamDyn simulations, so we're using a copy of the value from the input file here + ScaleLength = max(p%TipRad, p%TowerHt, 1.0_ReKi) + MaxThrust = 490.0_R8Ki * pi_D / 9.0_R8Ki * ScaleLength**2 + MaxTorque = 122.5_R8Ki * pi_D / 27.0_R8Ki * ScaleLength**3 + + ! Blade Point Loads + if (allocated(u%BladePtLoads)) then + CALL AllocAry(p%iVarBladePtLoads, p%NumBl, 'iVarBladePtLoads', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(i), LoadFields, & + VarIdx=p%iVarBladePtLoads(i), & + Mesh=u%BladePtLoads(i), & + Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%BldNodes), & + MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)]) + ! Add aero map flag if first blade + if (i == 1) then + do j = p%iVarBladePtLoads(i), size(p%Vars%u) + p%Vars%u(j)%Flags = ior(p%Vars%u(j)%Flags, VF_AeroMap) end do - end if - - if (allocated(y%BladeLn2Mesh)) then - do k=1,p%NumBl_Lin - ny = ny + y%BladeLn2Mesh(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 (at each node on each blade) - end do + end do + end if + + ! Platform point loads + call MV_AddMeshVar(p%Vars%u, "Platform", LoadFields, & + VarIdx=p%iVarPlatformPtMesh, & + Mesh=u%PlatformPtMesh, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Tower point loads + call MV_AddMeshVar(p%Vars%u, "Tower", LoadFields, & + VarIdx=p%iVarTowerPtLoads, & + Mesh=u%TowerPtLoads, & + Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%TwrNodes), & + MaxTorque / (100.0_R8Ki*p%NumBl*p%TwrNodes)]) + ! Hub point loads + call MV_AddMeshVar(p%Vars%u, "Hub", LoadFields, & + VarIdx=p%iVarHubPtLoad, & + Mesh=u%HubPtLoad, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Nacelle point loads + call MV_AddMeshVar(p%Vars%u, "Nacelle", LoadFields, & + VarIdx=p%iVarNacelleLoads, & + Mesh=u%NacelleLoads, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Non-mesh input variables + call MV_AddVar(p%Vars%u, "BlPitchCom", VF_Scalar, & + VarIdx=p%iVarBlPitchCom, & + Num=p%NumBl, & + Flags=VF_RotFrame, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) + call MV_AddVar(p%Vars%u, "YawMom", VF_Scalar, & + VarIdx=p%iVarYawMom, & + Perturb=MaxTorque / 100.0_R8Ki, & + LinNames=['Yaw moment, Nm']) + call MV_AddVar(p%Vars%u, "GenTrq", VF_Scalar, & + VarIdx=p%iVarGenTrq, & + Perturb=MaxTorque / (100.0_R8Ki*p%GBRatio), & + LinNames=['Generator torque, Nm']) + call MV_AddVar(p%Vars%u, "BlPitchComC", VF_Scalar, & + VarIdx=p%iVarBlPitchComC, & + Flags=VF_Ext, & + LinNames=['Extended input: collective blade-pitch command, rad']) + + ! Set minimum input perturbations + do i = 1,size(p%Vars%u) + p%Vars%u(i)%Perturb = max(p%Vars%u(i)%Perturb, MinPerturb) + end do + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + CALL AllocAry(p%iVarBladeMotion, p%NumBl, 'iVarBladeMotion', ErrStat2, ErrMsg2); if (Failed()) return + p%iVarBladeMotion = 0 + CALL AllocAry(p%iVarBladeRootMotion, p%NumBl, 'iVarBladeRootMotion', ErrStat2, ErrMsg2); if (Failed()) return + p%iVarBladeRootMotion = 0 + + if (allocated(y%BladeLn2Mesh))then + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), MotionFields, & + VarIdx=p%iVarBladeMotion(i), & + Mesh=y%BladeLn2Mesh(i)) + ! Add aero map flag if first blade and field is translation/angular displacement/velocity + if (i == 1) then + do j = p%iVarBladeMotion(i), size(p%Vars%y) + if (iand(p%Vars%y(j)%Field, VF_TransDisp+VF_AngularDisp+VF_TransVel+VF_AngularVel) > 0) then + p%Vars%y(j)%Flags = ior(p%Vars%y(j)%Flags, VF_AeroMap) + end if + end do end if - - call AllocAry(y_op, ny,'y_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array + end do + end if - - if ( p%CompAeroMaps ) then - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_TRANSLATIONVEL) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - else - Mask = .true. - end if + call MV_AddMeshVar(p%Vars%y, 'Platform', MotionFields, & + VarIdx=p%iVarPlatformMotion, & + Mesh=y%PlatformPtMesh) - index = 1 - if (allocated(y%BladeLn2Mesh)) then - do k=1,p%NumBl_Lin - call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) - end do - end if - if (.not. p%CompAeroMaps) then - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - - call PackMotionMesh(y%PlatformPtMesh, y_op, index, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%TowerLn2Mesh, y_op, index, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) - do k=1,p%NumBl_Lin - call PackMotionMesh(y%BladeRootMotion(k), y_op, index, TrimOP=ReturnTrimOP) - end do - call PackMotionMesh(y%NacelleMotion, y_op, index, TrimOP=ReturnTrimOP) - - y_op(index) = y%Yaw ; index = index + 1 - y_op(index) = y%YawRate ; index = index + 1 - y_op(index) = y%HSS_Spd - - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - end if - - END IF + call MV_AddMeshVar(p%Vars%y, 'Tower', MotionFields, & + VarIdx=p%iVarTowerMotion, & + Mesh=y%TowerLn2Mesh, & + Flags=VF_Line) - !.................................. - IF ( PRESENT( x_op ) ) THEN + call MV_AddMeshVar(p%Vars%y, 'Hub', [VF_TransDisp, VF_Orientation, VF_AngularVel], & + VarIdx=p%iVarHubMotion, & + Mesh=y%HubPtMotion) - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - index = 0 - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian - index = index + 1 - x_op(index) = x%QT( p%DOFs%PS(i) ) + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%y, 'Blade root '//Num2LStr(i), MotionFields, & + VarIdx=p%iVarBladeRootMotion(i), & + Mesh=y%BladeRootMotion(i)) + end do + + call MV_AddMeshVar(p%Vars%y, 'Nacelle', MotionFields, & + VarIdx=p%iVarNacelleMotion, & + Mesh=y%NacelleMotion) + + call MV_AddVar(p%Vars%y, 'Yaw', VF_AngularDisp, & + VarIdx=p%iVarYaw, & + LinNames=['Yaw, rad']) + + call MV_AddVar(p%Vars%y, 'YawRate', VF_Scalar, & + VarIdx=p%iVarYawRate, & + LinNames=['YawRate, rad/s']) + + call MV_AddVar(p%Vars%y, 'HSS_Spd', VF_Scalar, & + VarIdx=p%iVarHSS_Spd, & + LinNames=['HSS_Spd, rad/s']) + + ! Write output variables + p%iVarOutput = size(p%Vars%y) + 1 + do i = 1, p%NumOuts + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & + VarIdx=idx, & + Flags=OutParamFlags(p%OutParam(i)%Indx), & + iUsr=i, & + LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & + Active=(p%OutParam(i)%Indx > 0)) + end do + k = p%NumOuts + 1 + do i = 1, p%BldNd_NumOuts + do j = 1, p%BldNd_BladesOut + call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & + Num=p%BldNodes, & + VarIdx=idx, & + Flags=VF_RotFrame, & + iUsr=k, & + LinNames=[(BldOutLinName(p%BldNd_OutParam(i), j, k), k=1, p%BldNodes)], & + Active=(p%BldNd_OutParam(i)%Indx > 0)) + k = k + p%BldNodes end do - - if (p%NActvVelDOF_Lin > 0) then ! .not. p%CompAeroMaps - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian - index = index + 1 - x_op(index) = x%QDT( p%DOFs%PS(i) ) - end do - end if - - END IF + end do - !.................................. - IF ( PRESENT( dx_op ) ) THEN + !---------------------------------------------------------------------------- + ! Initialize Variables and Linearization data + !---------------------------------------------------------------------------- - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - call ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call ED_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - - index = 0 - if (p%NActvVelDOF_Lin > 0) then ! p%CompAeroMaps - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian - index = index + 1 - dx_op(index) = dx%QT( p%DOFs%PS(i) ) - end do - end if - - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian - index = index + 1 - dx_op(index) = dx%QDT( p%DOFs%PS(i) ) - end do - - call ED_DestroyContState( dx, ErrStat2, ErrMsg2) - - END IF + call MV_InitVarsLin(p%Vars, m%Lin, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return - !.................................. - IF ( PRESENT( xd_op ) ) THEN - END IF - - !.................................. - IF ( PRESENT( z_op ) ) THEN - END IF + call ED_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyContState(x, m%dx_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyOutput(y, m%y_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return -END SUBROUTINE ED_GetOP -!---------------------------------------------------------------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is requested, initialize arrays + if (Linearize .or. p%CompAeroMaps) then + call MV_InitLinArrays(p%Vars, 2, & + InitOut%LinNames_x, InitOut%RotFrame_x, InitOut%DerivOrder_x, & + InitOut%LinNames_u, InitOut%RotFrame_u, InitOut%IsLoad_u, & + InitOut%LinNames_y, InitOut%RotFrame_y, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! AeroMap + !---------------------------------------------------------------------------- + + if (p%CompAeroMaps) then + + ! Initialize index for variables flagged with VF_AeroMap + call MV_InitVarIdx(p%Vars, p%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Update dx indices to select the accelerations + p%IdxAeroMap%idx = p%IdxAeroMap%idx + p%Vars%Nx/2 + + ! Set parameters + p%NActvDOF_Lin = p%DOFs%NActvDOF / p%NumBl ! we have only blade DOFs, and we are going to use only 1 of the blades + p%NActvDOF_Stride = p%NumBl + p%NActvVelDOF_Lin = 0 ! we do NOT have velocity states + + ! Get subset of linearization arrays + InitOut%LinNames_x = InitOut%LinNames_x(p%IdxAeroMap%ix) + InitOut%RotFrame_x = InitOut%RotFrame_x(p%IdxAeroMap%ix) + InitOut%DerivOrder_x = InitOut%DerivOrder_x(p%IdxAeroMap%ix) + InitOut%LinNames_u = InitOut%LinNames_u(p%IdxAeroMap%iu) + InitOut%RotFrame_u = InitOut%RotFrame_u(p%IdxAeroMap%iu) + InitOut%IsLoad_u = InitOut%IsLoad_u(p%IdxAeroMap%iu) + InitOut%LinNames_y = InitOut%LinNames_y(p%IdxAeroMap%iy) + InitOut%RotFrame_y = InitOut%RotFrame_y(p%IdxAeroMap%iy) + end if + +contains + function BldOutLinName(OutParam, iBlade, iNode) result(Name) + integer(IntKi), intent(in) :: iBlade, iNode + type(OutParmType), intent(in) :: OutParam + character(LinChanLen) :: Name + write(Name, '("B",I1.1,"N",I3.3,A,", ",A)') iBlade, iNode, trim(OutParam%Name), trim(OutParam%Units) + end function + function OutParamFlags(indx) result(flagsRes) + integer(IntKi), intent(in) :: indx + integer(IntKi) :: flagsRes + integer(IntKi), parameter :: RotatingFrameIndices(*) = [& + TipDxc, TipDyc, TipDzc, TipDxb, TipDyb, & + TipALxb, TipALyb, TipALzb, TipRDxb, TipRDyb, TipRDzc, TipClrnc, & + PtchPMzc, & + RootFxc, RootFyc, RootFzc, RootFxb, RootFyb, & + RootMxc, RootMyc, RootMzc, RootMxb, RootMyb, & + SpnALxb, SpnALyb, SpnALzb, SpnFLxb, SpnFLyb, SpnFLzb, & + SpnMLxb, SpnMLyb, SpnMLzb, SpnTDxb, SpnTDyb, SpnTDzb, & + SpnRDxb, SpnRDyb, SpnRDzb] + if (any(RotatingFrameIndices == indx)) then + flagsRes = VF_RotFrame + else + flagsRes = VF_None + end if + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +subroutine ED_PackStateValues(p, x, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp, VF_AngularDisp) + ary(p%Vars%x(i)%iLoc(1)) = x%QT(p%Vars%x(i)%iUsr(1)) + case (VF_TransVel, VF_AngularVel) + ary(p%Vars%x(i)%iLoc(1)) = x%QDT(p%Vars%x(i)%iUsr(1)) + end select + end do +end subroutine + +subroutine ED_UnpackStateValues(p, ary, x) + type(ED_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(ED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp, VF_AngularDisp) + x%QT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) + case (VF_TransVel, VF_AngularVel) + x%QDT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) + end select + end do +end subroutine +subroutine ED_PackInputValues(p, u, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_InputType), intent(in) :: u + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: i + if (allocated(u%BladePtLoads)) then + do i = 1, size(u%BladePtLoads) + call MV_Pack(p%Vars%u, p%iVarBladePtLoads(i), u%BladePtLoads(i), ary) + end do + end if + call MV_Pack(p%Vars%u, p%iVarPlatformPtMesh, u%PlatformPtMesh, ary) + call MV_Pack(p%Vars%u, p%iVarTowerPtLoads, u%TowerPtLoads, ary) + call MV_Pack(p%Vars%u, p%iVarHubPtLoad, u%HubPtLoad, ary) + call MV_Pack(p%Vars%u, p%iVarNacelleLoads, u%NacelleLoads, ary) + call MV_Pack(p%Vars%u, p%iVarBlPitchCom, u%BlPitchCom, ary) + call MV_Pack(p%Vars%u, p%iVarYawMom, u%YawMom, ary) + call MV_Pack(p%Vars%u, p%iVarGenTrq, u%GenTrq, ary) + call MV_Pack(p%Vars%u, p%iVarBlPitchComC, u%BlPitchCom(1), ary) +end subroutine + +subroutine ED_UnpackInputValues(p, ary, u) + type(ED_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(ED_InputType), intent(inout) :: u + integer(IntKi) :: i + if (allocated(u%BladePtLoads)) then + do i = 1, size(u%BladePtLoads) + call MV_Unpack(p%Vars%u, p%iVarBladePtLoads(i), ary, u%BladePtLoads(i)) + end do + end if + call MV_Unpack(p%Vars%u, p%iVarPlatformPtMesh, ary, u%PlatformPtMesh) + call MV_Unpack(p%Vars%u, p%iVarTowerPtLoads, ary, u%TowerPtLoads) + call MV_Unpack(p%Vars%u, p%iVarHubPtLoad, ary, u%HubPtLoad) + call MV_Unpack(p%Vars%u, p%iVarNacelleLoads, ary, u%NacelleLoads) + call MV_Unpack(p%Vars%u, p%iVarBlPitchCom, ary, u%BlPitchCom) + call MV_Unpack(p%Vars%u, p%iVarYawMom, ary, u%YawMom) + call MV_Unpack(p%Vars%u, p%iVarGenTrq, ary, u%GenTrq) +end subroutine + +subroutine ED_PackOutputValues(p, y, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: i + if (allocated(y%BladeLn2Mesh)) then + do i = 1, size(y%BladeLn2Mesh) + call MV_Pack(p%Vars%y, p%iVarBladeMotion(i), y%BladeLn2Mesh(i), ary) + end do + end if + call MV_Pack(p%Vars%y, p%iVarPlatformMotion, y%PlatformPtMesh, ary) + call MV_Pack(p%Vars%y, p%iVarTowerMotion, y%TowerLn2Mesh, ary) + call MV_Pack(p%Vars%y, p%iVarHubMotion, y%HubPtMotion, ary) + if (allocated(y%BladeRootMotion)) then + do i = 1, size(y%BladeRootMotion) + call MV_Pack(p%Vars%y, p%iVarBladeRootMotion(i), y%BladeRootMotion(i), ary) + end do + end if + call MV_Pack(p%Vars%y, p%iVarNacelleMotion, y%NacelleMotion, ary) + call MV_Pack(p%Vars%y, p%iVarYaw, y%Yaw, ary) + call MV_Pack(p%Vars%y, p%iVarYawRate, y%YawRate, ary) + call MV_Pack(p%Vars%y, p%iVarHSS_Spd, y%HSS_Spd, ary) + do i = p%iVarOutput, size(p%Vars%y) + call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), ary) + end do +end subroutine END MODULE ElastoDyn !********************************************************************************************************************************** diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 935d2ccc46..94b9eea8e6 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -58,6 +58,7 @@ typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - typedef ^ InitOutputType IntKi GearBox_index - - - "Index to gearbox rotation in state array (for steady-state calculations)" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # ..... Blade Input file data ........................................................................................................... typedef ElastoDyn/ED BladeInputData IntKi NBlInpSt - - - "Number of blade input stations" - @@ -513,21 +514,12 @@ typedef ^ OtherStateType ReKi HSSBrTrqC - - - "Commanded HSS brake torque (adjus typedef ^ OtherStateType IntKi SgnPrvLSTQ - - - "The sign of the low-speed shaft torque from the previous call to RtHS(). This is calculated at the end of RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run!" - typedef ^ OtherStateType IntKi SgnLSTQ {ED_NMX} - - "history of sign of LSTQ" -# ..... Misc Vars ................................................................................................................ -typedef ^ MiscVarType ED_CoordSys CoordSys - - - "Coordinate systems in the FAST framework" - -typedef ^ MiscVarType ED_RtHndSide RtHS - - - "Values used in calculating the right-hand-side RtHS (and outputs)" -typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" -typedef ^ MiscVarType R8Ki AugMat {:}{:} - - "The augmented matrix used for the solution of the QD2T()s" -typedef ^ MiscVarType R8Ki AugMat_factor {:}{:} - - "factored version of AugMat matrix" -typedef ^ MiscVarType R8Ki SolnVec {:} - - "b in the equation Ax=b (last column of AugMat)" -typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAPACK factorization" -typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - -typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" -typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" +typedef ^ ParameterType ModIdxType IdxAeroMap - - - "Module variable index for AeroMap" +typedef ^ ParameterType ModIdxType IdxSolver - - - "Module variable index for Solver" typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi DT24 - - - "=DT/24 (used in loose coupling)" seconds typedef ^ ParameterType IntKi BldNodes - - - "Number of blade nodes used in the analysis" - @@ -757,6 +749,27 @@ typedef ^ ParameterType Integer NumBl_Lin - - - "number of blades in the jacobia typedef ^ ParameterType Integer NActvVelDOF_Lin - - - "number of velocity states in the jacobian" - typedef ^ ParameterType Integer NActvDOF_Lin - - - "number of active DOFs to use in the jacobian" - typedef ^ ParameterType Integer NActvDOF_Stride - - - "stride for active DOFs to use in the jacobian" - +# Input variable indices +typedef ^ ParameterType IntKi iVarBladePtLoads {:} - - "Indices of blade point loads mesh variable" - +typedef ^ ParameterType IntKi iVarPlatformPtMesh - - - "Index of platform point loads mesh variable" - +typedef ^ ParameterType IntKi iVarTowerPtLoads - - - "Index of tower point loads mesh variable" - +typedef ^ ParameterType IntKi iVarHubPtLoad - - - "Index of hub point load mesh variable" - +typedef ^ ParameterType IntKi iVarNacelleLoads - - - "Index of nacelle loads mesh variable" - +typedef ^ ParameterType IntKi iVarBlPitchCom - - - "Index of blade pitch command variable" - +typedef ^ ParameterType IntKi iVarYawMom - - - "Index of yaw moment variable" - +typedef ^ ParameterType IntKi iVarGenTrq - - - "Index of generator torque variable" - +typedef ^ ParameterType IntKi iVarBlPitchComC - - - "Index of blade pitch command C variable" - +# Output variable indices +typedef ^ ParameterType IntKi iVarBladeMotion {:} - - "Indices of blade motion mesh variable" - +typedef ^ ParameterType IntKi iVarPlatformMotion - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarTowerMotion - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarHubMotion - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarBladeRootMotion {:} - - "Indices of variable" - +typedef ^ ParameterType IntKi iVarNacelleMotion - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarYaw - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarYawRate - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarHSS_Spd - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarOutput - - - "Index of variable" - # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: @@ -817,3 +830,20 @@ typedef ^ OutputType ReKi RotPwr - - - "Rotor power (this is equivalent to the l typedef ^ OutputType ReKi LSShftFxa - - - "Rotating low-speed shaft force x" N typedef ^ OutputType ReKi LSShftFys - - - "Nonrotating low-speed shaft force y" N typedef ^ OutputType ReKi LSShftFzs - - - "Nonrotating low-speed shaft force z" N + +# ..... Misc Vars ................................................................................................................ +typedef ^ MiscVarType ED_CoordSys CoordSys - - - "Coordinate systems in the FAST framework" - +typedef ^ MiscVarType ED_RtHndSide RtHS - - - "Values used in calculating the right-hand-side RtHS (and outputs)" +typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" +typedef ^ MiscVarType R8Ki AugMat {:}{:} - - "The augmented matrix used for the solution of the QD2T()s" +typedef ^ MiscVarType R8Ki AugMat_factor {:}{:} - - "factored version of AugMat matrix" +typedef ^ MiscVarType R8Ki SolnVec {:} - - "b in the equation Ax=b (last column of AugMat)" +typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAPACK factorization" +typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - +typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" +typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - +typedef ^ MiscVarType ModLinType Lin - - - "Values corresponding to module variables" +typedef ^ MiscVarType ED_ContinuousStateType x_perturb - - - "" - +typedef ^ MiscVarType ED_ContinuousStateType dx_perturb - - - "" - +typedef ^ MiscVarType ED_InputType u_perturb - - - "" - +typedef ^ MiscVarType ED_OutputType y_perturb - - - "" - diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index c80a1c72ca..da7cb785e2 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -78,6 +78,7 @@ MODULE ElastoDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] INTEGER(IntKi) :: GearBox_index = 0_IntKi !< Index to gearbox rotation in state array (for steady-state calculations) [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE ED_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -521,22 +522,11 @@ MODULE ElastoDyn_Types INTEGER(IntKi) , DIMENSION(1:ED_NMX) :: SgnLSTQ = 0_IntKi !< history of sign of LSTQ [-] END TYPE ED_OtherStateType ! ======================= -! ========= ED_MiscVarType ======= - TYPE, PUBLIC :: ED_MiscVarType - TYPE(ED_CoordSys) :: CoordSys !< Coordinate systems in the FAST framework [-] - TYPE(ED_RtHndSide) :: RtHS !< Values used in calculating the right-hand-side RtHS (and outputs) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: AugMat !< The augmented matrix used for the solution of the QD2T()s [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: AugMat_factor !< factored version of AugMat matrix [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SolnVec !< b in the equation Ax=b (last column of AugMat) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AugMat_pivot !< Pivot column for AugMat in LAPACK factorization [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlGeAzRo !< Original DOF_GeAz row in AugMat [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Solution (acceleration) vector; the first time derivative of QDT [-] - LOGICAL :: IgnoreMod = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] - END TYPE ED_MiscVarType -! ======================= ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModIdxType) :: IdxAeroMap !< Module variable index for AeroMap [-] + TYPE(ModIdxType) :: IdxSolver !< Module variable index for Solver [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] REAL(DbKi) :: DT24 = 0.0_R8Ki !< =DT/24 (used in loose coupling) [seconds] INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] @@ -761,6 +751,25 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: NActvVelDOF_Lin = 0_IntKi !< number of velocity states in the jacobian [-] INTEGER(IntKi) :: NActvDOF_Lin = 0_IntKi !< number of active DOFs to use in the jacobian [-] INTEGER(IntKi) :: NActvDOF_Stride = 0_IntKi !< stride for active DOFs to use in the jacobian [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladePtLoads !< Indices of blade point loads mesh variable [-] + INTEGER(IntKi) :: iVarPlatformPtMesh = 0_IntKi !< Index of platform point loads mesh variable [-] + INTEGER(IntKi) :: iVarTowerPtLoads = 0_IntKi !< Index of tower point loads mesh variable [-] + INTEGER(IntKi) :: iVarHubPtLoad = 0_IntKi !< Index of hub point load mesh variable [-] + INTEGER(IntKi) :: iVarNacelleLoads = 0_IntKi !< Index of nacelle loads mesh variable [-] + INTEGER(IntKi) :: iVarBlPitchCom = 0_IntKi !< Index of blade pitch command variable [-] + INTEGER(IntKi) :: iVarYawMom = 0_IntKi !< Index of yaw moment variable [-] + INTEGER(IntKi) :: iVarGenTrq = 0_IntKi !< Index of generator torque variable [-] + INTEGER(IntKi) :: iVarBlPitchComC = 0_IntKi !< Index of blade pitch command C variable [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeMotion !< Indices of blade motion mesh variable [-] + INTEGER(IntKi) :: iVarPlatformMotion = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) :: iVarTowerMotion = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) :: iVarHubMotion = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeRootMotion !< Indices of variable [-] + INTEGER(IntKi) :: iVarNacelleMotion = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) :: iVarYaw = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) :: iVarYawRate = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) :: iVarHSS_Spd = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) :: iVarOutput = 0_IntKi !< Index of variable [-] END TYPE ED_ParameterType ! ======================= ! ========= ED_InputType ======= @@ -822,6 +831,25 @@ MODULE ElastoDyn_Types REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] END TYPE ED_OutputType ! ======================= +! ========= ED_MiscVarType ======= + TYPE, PUBLIC :: ED_MiscVarType + TYPE(ED_CoordSys) :: CoordSys !< Coordinate systems in the FAST framework [-] + TYPE(ED_RtHndSide) :: RtHS !< Values used in calculating the right-hand-side RtHS (and outputs) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: AugMat !< The augmented matrix used for the solution of the QD2T()s [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: AugMat_factor !< factored version of AugMat matrix [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SolnVec !< b in the equation Ax=b (last column of AugMat) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AugMat_pivot !< Pivot column for AugMat in LAPACK factorization [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlGeAzRo !< Original DOF_GeAz row in AugMat [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Solution (acceleration) vector; the first time derivative of QDT [-] + LOGICAL :: IgnoreMod = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] + TYPE(ModLinType) :: Lin !< Values corresponding to module variables [-] + TYPE(ED_ContinuousStateType) :: x_perturb !< [-] + TYPE(ED_ContinuousStateType) :: dx_perturb !< [-] + TYPE(ED_InputType) :: u_perturb !< [-] + TYPE(ED_OutputType) :: y_perturb !< [-] + END TYPE ED_MiscVarType +! ======================= CONTAINS subroutine ED_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -1074,6 +1102,7 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if DstInitOutputData%GearBox_index = SrcInitOutputData%GearBox_index + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -1126,12 +1155,14 @@ subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%IsLoad_u)) then deallocate(InitOutputData%IsLoad_u) end if + nullify(InitOutputData%Vars) end subroutine subroutine ED_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) @@ -1161,6 +1192,13 @@ subroutine ED_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%IsLoad_u) call RegPack(RF, InData%GearBox_index) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1171,6 +1209,8 @@ subroutine ED_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -1200,6 +1240,24 @@ subroutine ED_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -4741,198 +4799,37 @@ subroutine ED_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%SgnLSTQ); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(ED_MiscVarType), intent(in) :: SrcMiscData - type(ED_MiscVarType), intent(inout) :: DstMiscData +subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ED_ParameterType), intent(in) :: SrcParamData + type(ED_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3, i4, i5 + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_CopyMisc' + character(*), parameter :: RoutineName = 'ED_CopyParam' ErrStat = ErrID_None ErrMsg = '' - call ED_CopyCoordSys(SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyRtHndSide(SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) - if (.not. allocated(DstMiscData%AllOuts)) then - allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%AllOuts = SrcMiscData%AllOuts - end if - if (allocated(SrcMiscData%AugMat)) then - LB(1:2) = lbound(SrcMiscData%AugMat, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AugMat, kind=B8Ki) - if (.not. allocated(DstMiscData%AugMat)) then - allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%AugMat = SrcMiscData%AugMat - end if - if (allocated(SrcMiscData%AugMat_factor)) then - LB(1:2) = lbound(SrcMiscData%AugMat_factor, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AugMat_factor, kind=B8Ki) - if (.not. allocated(DstMiscData%AugMat_factor)) then - allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor - end if - if (allocated(SrcMiscData%SolnVec)) then - LB(1:1) = lbound(SrcMiscData%SolnVec, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SolnVec, kind=B8Ki) - if (.not. allocated(DstMiscData%SolnVec)) then - allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%SolnVec = SrcMiscData%SolnVec - end if - if (allocated(SrcMiscData%AugMat_pivot)) then - LB(1:1) = lbound(SrcMiscData%AugMat_pivot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AugMat_pivot, kind=B8Ki) - if (.not. allocated(DstMiscData%AugMat_pivot)) then - allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot - end if - if (allocated(SrcMiscData%OgnlGeAzRo)) then - LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) - if (.not. allocated(DstMiscData%OgnlGeAzRo)) then - allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo - end if - if (allocated(SrcMiscData%QD2T)) then - LB(1:1) = lbound(SrcMiscData%QD2T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%QD2T, kind=B8Ki) - if (.not. allocated(DstMiscData%QD2T)) then - allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%QD2T = SrcMiscData%QD2T + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end if - DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod -end subroutine - -subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(ED_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - call ED_DestroyCoordSys(MiscData%CoordSys, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModIdxType(SrcParamData%IdxAeroMap, DstParamData%IdxAeroMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyRtHndSide(MiscData%RtHS, ErrStat2, ErrMsg2) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModIdxType(SrcParamData%IdxSolver, DstParamData%IdxSolver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%AllOuts)) then - deallocate(MiscData%AllOuts) - end if - if (allocated(MiscData%AugMat)) then - deallocate(MiscData%AugMat) - end if - if (allocated(MiscData%AugMat_factor)) then - deallocate(MiscData%AugMat_factor) - end if - if (allocated(MiscData%SolnVec)) then - deallocate(MiscData%SolnVec) - end if - if (allocated(MiscData%AugMat_pivot)) then - deallocate(MiscData%AugMat_pivot) - end if - if (allocated(MiscData%OgnlGeAzRo)) then - deallocate(MiscData%OgnlGeAzRo) - end if - if (allocated(MiscData%QD2T)) then - deallocate(MiscData%QD2T) - end if -end subroutine - -subroutine ED_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ED_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'ED_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call ED_PackCoordSys(RF, InData%CoordSys) - call ED_PackRtHndSide(RF, InData%RtHS) - call RegPackAlloc(RF, InData%AllOuts) - call RegPackAlloc(RF, InData%AugMat) - call RegPackAlloc(RF, InData%AugMat_factor) - call RegPackAlloc(RF, InData%SolnVec) - call RegPackAlloc(RF, InData%AugMat_pivot) - call RegPackAlloc(RF, InData%OgnlGeAzRo) - call RegPackAlloc(RF, InData%QD2T) - call RegPack(RF, InData%IgnoreMod) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ED_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ED_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call ED_UnpackCoordSys(RF, OutData%CoordSys) ! CoordSys - call ED_UnpackRtHndSide(RF, OutData%RtHS) ! RtHS - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AugMat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AugMat_factor); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SolnVec); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AugMat_pivot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%OgnlGeAzRo); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IgnoreMod); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(ED_ParameterType), intent(in) :: SrcParamData - type(ED_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' + if (ErrStat >= AbortErrLev) return DstParamData%DT = SrcParamData%DT DstParamData%DT24 = SrcParamData%DT24 DstParamData%BldNodes = SrcParamData%BldNodes @@ -5805,6 +5702,58 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NActvVelDOF_Lin = SrcParamData%NActvVelDOF_Lin DstParamData%NActvDOF_Lin = SrcParamData%NActvDOF_Lin DstParamData%NActvDOF_Stride = SrcParamData%NActvDOF_Stride + if (allocated(SrcParamData%iVarBladePtLoads)) then + LB(1:1) = lbound(SrcParamData%iVarBladePtLoads, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarBladePtLoads, kind=B8Ki) + if (.not. allocated(DstParamData%iVarBladePtLoads)) then + allocate(DstParamData%iVarBladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladePtLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarBladePtLoads = SrcParamData%iVarBladePtLoads + end if + DstParamData%iVarPlatformPtMesh = SrcParamData%iVarPlatformPtMesh + DstParamData%iVarTowerPtLoads = SrcParamData%iVarTowerPtLoads + DstParamData%iVarHubPtLoad = SrcParamData%iVarHubPtLoad + DstParamData%iVarNacelleLoads = SrcParamData%iVarNacelleLoads + DstParamData%iVarBlPitchCom = SrcParamData%iVarBlPitchCom + DstParamData%iVarYawMom = SrcParamData%iVarYawMom + DstParamData%iVarGenTrq = SrcParamData%iVarGenTrq + DstParamData%iVarBlPitchComC = SrcParamData%iVarBlPitchComC + if (allocated(SrcParamData%iVarBladeMotion)) then + LB(1:1) = lbound(SrcParamData%iVarBladeMotion, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarBladeMotion, kind=B8Ki) + if (.not. allocated(DstParamData%iVarBladeMotion)) then + allocate(DstParamData%iVarBladeMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarBladeMotion = SrcParamData%iVarBladeMotion + end if + DstParamData%iVarPlatformMotion = SrcParamData%iVarPlatformMotion + DstParamData%iVarTowerMotion = SrcParamData%iVarTowerMotion + DstParamData%iVarHubMotion = SrcParamData%iVarHubMotion + if (allocated(SrcParamData%iVarBladeRootMotion)) then + LB(1:1) = lbound(SrcParamData%iVarBladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarBladeRootMotion, kind=B8Ki) + if (.not. allocated(DstParamData%iVarBladeRootMotion)) then + allocate(DstParamData%iVarBladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarBladeRootMotion = SrcParamData%iVarBladeRootMotion + end if + DstParamData%iVarNacelleMotion = SrcParamData%iVarNacelleMotion + DstParamData%iVarYaw = SrcParamData%iVarYaw + DstParamData%iVarYawRate = SrcParamData%iVarYawRate + DstParamData%iVarHSS_Spd = SrcParamData%iVarHSS_Spd + DstParamData%iVarOutput = SrcParamData%iVarOutput end subroutine subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -5818,6 +5767,16 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ED_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if + call NWTC_Library_DestroyModIdxType(ParamData%IdxAeroMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModIdxType(ParamData%IdxSolver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%PH)) then deallocate(ParamData%PH) end if @@ -6006,6 +5965,15 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%dx)) then deallocate(ParamData%dx) end if + if (allocated(ParamData%iVarBladePtLoads)) then + deallocate(ParamData%iVarBladePtLoads) + end if + if (allocated(ParamData%iVarBladeMotion)) then + deallocate(ParamData%iVarBladeMotion) + end if + if (allocated(ParamData%iVarBladeRootMotion)) then + deallocate(ParamData%iVarBladeRootMotion) + end if end subroutine subroutine ED_PackParam(RF, Indata) @@ -6014,7 +5982,17 @@ subroutine ED_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'ED_PackParam' integer(B8Ki) :: i1, i2, i3, i4, i5 integer(B8Ki) :: LB(5), UB(5) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call NWTC_Library_PackModIdxType(RF, InData%IdxAeroMap) + call NWTC_Library_PackModIdxType(RF, InData%IdxSolver) call RegPack(RF, InData%DT) call RegPack(RF, InData%DT24) call RegPack(RF, InData%BldNodes) @@ -6255,6 +6233,25 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%NActvVelDOF_Lin) call RegPack(RF, InData%NActvDOF_Lin) call RegPack(RF, InData%NActvDOF_Stride) + call RegPackAlloc(RF, InData%iVarBladePtLoads) + call RegPack(RF, InData%iVarPlatformPtMesh) + call RegPack(RF, InData%iVarTowerPtLoads) + call RegPack(RF, InData%iVarHubPtLoad) + call RegPack(RF, InData%iVarNacelleLoads) + call RegPack(RF, InData%iVarBlPitchCom) + call RegPack(RF, InData%iVarYawMom) + call RegPack(RF, InData%iVarGenTrq) + call RegPack(RF, InData%iVarBlPitchComC) + call RegPackAlloc(RF, InData%iVarBladeMotion) + call RegPack(RF, InData%iVarPlatformMotion) + call RegPack(RF, InData%iVarTowerMotion) + call RegPack(RF, InData%iVarHubMotion) + call RegPackAlloc(RF, InData%iVarBladeRootMotion) + call RegPack(RF, InData%iVarNacelleMotion) + call RegPack(RF, InData%iVarYaw) + call RegPack(RF, InData%iVarYawRate) + call RegPack(RF, InData%iVarHSS_Spd) + call RegPack(RF, InData%iVarOutput) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6266,7 +6263,29 @@ subroutine ED_UnPackParam(RF, OutData) integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call NWTC_Library_UnpackModIdxType(RF, OutData%IdxAeroMap) ! IdxAeroMap + call NWTC_Library_UnpackModIdxType(RF, OutData%IdxSolver) ! IdxSolver call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT24); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return @@ -6515,6 +6534,25 @@ subroutine ED_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%NActvVelDOF_Lin); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NActvDOF_Lin); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NActvDOF_Stride); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladePtLoads); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPlatformPtMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTowerPtLoads); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHubPtLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarNacelleLoads); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarBlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarYawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarGenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarBlPitchComC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladeMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPlatformMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTowerMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHubMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladeRootMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarNacelleMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarYawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -7012,6 +7050,220 @@ subroutine ED_UnPackOutput(RF, OutData) call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(inout) :: SrcMiscData + type(ED_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call ED_CopyCoordSys(SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyRtHndSide(SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + if (allocated(SrcMiscData%AugMat)) then + LB(1:2) = lbound(SrcMiscData%AugMat, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%AugMat, kind=B8Ki) + if (.not. allocated(DstMiscData%AugMat)) then + allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat = SrcMiscData%AugMat + end if + if (allocated(SrcMiscData%AugMat_factor)) then + LB(1:2) = lbound(SrcMiscData%AugMat_factor, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%AugMat_factor, kind=B8Ki) + if (.not. allocated(DstMiscData%AugMat_factor)) then + allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor + end if + if (allocated(SrcMiscData%SolnVec)) then + LB(1:1) = lbound(SrcMiscData%SolnVec, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SolnVec, kind=B8Ki) + if (.not. allocated(DstMiscData%SolnVec)) then + allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SolnVec = SrcMiscData%SolnVec + end if + if (allocated(SrcMiscData%AugMat_pivot)) then + LB(1:1) = lbound(SrcMiscData%AugMat_pivot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AugMat_pivot, kind=B8Ki) + if (.not. allocated(DstMiscData%AugMat_pivot)) then + allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot + end if + if (allocated(SrcMiscData%OgnlGeAzRo)) then + LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) + if (.not. allocated(DstMiscData%OgnlGeAzRo)) then + allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo + end if + if (allocated(SrcMiscData%QD2T)) then + LB(1:1) = lbound(SrcMiscData%QD2T, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%QD2T, kind=B8Ki) + if (.not. allocated(DstMiscData%QD2T)) then + allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%QD2T = SrcMiscData%QD2T + end if + DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod + call NWTC_Library_CopyModLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyContState(SrcMiscData%dx_perturb, DstMiscData%dx_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyOutput(SrcMiscData%y_perturb, DstMiscData%y_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call ED_DestroyCoordSys(MiscData%CoordSys, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyRtHndSide(MiscData%RtHS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%AugMat)) then + deallocate(MiscData%AugMat) + end if + if (allocated(MiscData%AugMat_factor)) then + deallocate(MiscData%AugMat_factor) + end if + if (allocated(MiscData%SolnVec)) then + deallocate(MiscData%SolnVec) + end if + if (allocated(MiscData%AugMat_pivot)) then + deallocate(MiscData%AugMat_pivot) + end if + if (allocated(MiscData%OgnlGeAzRo)) then + deallocate(MiscData%OgnlGeAzRo) + end if + if (allocated(MiscData%QD2T)) then + deallocate(MiscData%QD2T) + end if + call NWTC_Library_DestroyModLinType(MiscData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyContState(MiscData%dx_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyOutput(MiscData%y_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ED_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call ED_PackCoordSys(RF, InData%CoordSys) + call ED_PackRtHndSide(RF, InData%RtHS) + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%AugMat) + call RegPackAlloc(RF, InData%AugMat_factor) + call RegPackAlloc(RF, InData%SolnVec) + call RegPackAlloc(RF, InData%AugMat_pivot) + call RegPackAlloc(RF, InData%OgnlGeAzRo) + call RegPackAlloc(RF, InData%QD2T) + call RegPack(RF, InData%IgnoreMod) + call NWTC_Library_PackModLinType(RF, InData%Lin) + call ED_PackContState(RF, InData%x_perturb) + call ED_PackContState(RF, InData%dx_perturb) + call ED_PackInput(RF, InData%u_perturb) + call ED_PackOutput(RF, InData%y_perturb) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackMisc' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call ED_UnpackCoordSys(RF, OutData%CoordSys) ! CoordSys + call ED_UnpackRtHndSide(RF, OutData%RtHS) ! RtHS + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat_factor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SolnVec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat_pivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OgnlGeAzRo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IgnoreMod); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin + call ED_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call ED_UnpackContState(RF, OutData%dx_perturb) ! dx_perturb + call ED_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call ED_UnpackOutput(RF, OutData%y_perturb) ! y_perturb +end subroutine + subroutine ED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time From 9e213eada1cee3ea478472e14460f8def4908a5e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 25 Jan 2024 18:56:18 +0000 Subject: [PATCH 041/319] Modify FAST_Lin/FAST_SS_Solver for ED module variables --- modules/openfast-library/src/FAST_Lin.f90 | 71 ++++++++++++++----- .../openfast-library/src/FAST_SS_Solver.f90 | 8 +-- 2 files changed, 57 insertions(+), 22 deletions(-) diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index f9847771ae..468db83bd2 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -974,7 +974,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, Module_Glue, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() @@ -1019,7 +1019,7 @@ end subroutine cleanup END SUBROUTINE FAST_Linearize_OP !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that writes the A,B,C,D matrices from linearization to a text file. -SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, ErrStat, ErrMsg) +SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, ModuleID, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: Un !< unit number REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time @@ -1027,6 +1027,7 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code TYPE(FAST_LinType), INTENT(IN ) :: LinData !< Linearization data for individual module or glue (coupled system) CHARACTER(*), INTENT(IN ) :: FileName !< root name of the linearization file to open for writing + integer(IntKi), INTENT(IN ) :: ModuleID !< module abbreviation INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -1131,30 +1132,30 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E !...................................................... if (n(Indx_x) > 0) then WRITE(Un, '(A)') 'Order of continuous states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, rotFrame=LinData%RotFrame_x, derivOrder=LinData%DerivOrder_x ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, ModuleID, rotFrame=LinData%RotFrame_x, derivOrder=LinData%DerivOrder_x ) WRITE(Un, '(A)') 'Order of continuous state derivatives:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, rotFrame=LinData%RotFrame_x, deriv=.true., derivOrder=LinData%DerivOrder_x ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, ModuleID, rotFrame=LinData%RotFrame_x, deriv=.true., derivOrder=LinData%DerivOrder_x ) end if if (n(Indx_xd) > 0) then WRITE(Un, '(A)') 'Order of discrete states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_xd, LinData%names_xd ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_xd, LinData%names_xd, ModuleID ) end if if (n(Indx_z) > 0) then WRITE(Un, '(A)') 'Order of constraint states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_z, LinData%names_z, rotFrame=LinData%RotFrame_z ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_z, LinData%names_z, ModuleID, rotFrame=LinData%RotFrame_z ) end if if (n(Indx_u) > 0) then WRITE(Un, '(A)') 'Order of inputs:' - call WrLinFile_txt_Table(p_FAST, Un, "Column ", LinData%op_u, LinData%names_u, rotFrame=LinData%RotFrame_u, UseCol=LinData%use_u ) + call WrLinFile_txt_Table(p_FAST, Un, "Column ", LinData%op_u, LinData%names_u, ModuleID, rotFrame=LinData%RotFrame_u, UseCol=LinData%use_u ) end if if (n(Indx_y) > 0) then WRITE(Un, '(A)') 'Order of outputs:' - call WrLinFile_txt_Table(p_FAST, Un, "Row ", LinData%op_y, LinData%names_y, rotFrame=LinData%RotFrame_y, UseCol=LinData%use_y ) + call WrLinFile_txt_Table(p_FAST, Un, "Row ", LinData%op_y, LinData%names_y, ModuleID, rotFrame=LinData%RotFrame_y, UseCol=LinData%use_y ) end if !............. @@ -1199,13 +1200,14 @@ SUBROUTINE WrLinFile_txt_End(Un, p_FAST, LinData) END SUBROUTINE WrLinFile_txt_End !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, derivOrder, UseCol,start_indx) +SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, ModuleID, rotFrame, deriv, derivOrder, UseCol,start_indx) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameters INTEGER(IntKi), INTENT(IN ) :: Un !< unit number CHARACTER(*), INTENT(IN ) :: RowCol !< Row/Column description REAL(ReKi), INTENT(IN ) :: op(:) !< operating point values (possibly different size that Desc because of orientations) CHARACTER(LinChanLen), INTENT(IN ) :: names(:) !< Descriptions of the channels (names and units) + integer(IntKi), INTENT(IN ) :: ModuleID !< Module identifier logical, optional, INTENT(IN ) :: rotFrame(:) !< determines if this parameter is in the rotating frame logical, optional, intent(in ) :: deriv !< flag that tells us if we need to modify the channel names for derivatives (xdot) integer(IntKi), optional, intent(in ) :: derivOrder(:) !< Order of the time derivatives associated with the channel @@ -1227,8 +1229,16 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d CHARACTER(100) :: FmtOrient CHARACTER(25) :: DerivStr CHARACTER(25) :: DerivUnitStr - + logical :: UsesWM + real(R8Ki) :: DCM(3,3) + integer(IntKi) :: row + select case (ModuleID) + case (Module_ED) + UsesWM = .true. + case default + UsesWM = .false. + end select if (present(deriv) ) then UseDerivNames = deriv @@ -1278,14 +1288,40 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d RotatingCol = .false. if (present(rotFrame)) RotatingCol = rotFrame(i) + + select case (ModuleID) + case (Module_Glue) + UsesWM = index(names(i), "ED") == 1 + case (Module_ED) + UsesWM = .true. + case default + UsesWM = .false. + end select - if (index(names(i), ' orientation angle, node ') > 0 ) then ! make sure this matches what is written in PackMotionMesh_Names() - if (UseThisCol) then - WRITE(Un, FmtOrient) i_print, op(i_op), op(i_op+1), op(i_op+2), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] - i_print = i_print + 1 + if (index(names(i), ' orientation angle, node ') > 0) then ! make sure this matches what is written in PackMotionMesh_Names() + if (UsesWM) then + if (UseThisCol) then + if (index(names(i), ' X orientation angle, node ') > 0) then + DCM = wm_to_dcm(op(i_op:i_op+2)) + row = 1 + else if (index(names(i), ' Y orientation angle, node ') > 0) then + DCM = wm_to_dcm(op(i_op-1:i_op+1)) + row = 2 + else if (index(names(i), ' Z orientation angle, node ') > 0) then + DCM = wm_to_dcm(op(i_op-2:i_op)) + row = 3 + end if + WRITE(Un, FmtOrient) i_print, dcm(row, 1), dcm(row, 2), dcm(row, 3), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] + i_print = i_print + 1 + end if + i_op = i_op + 1 + else + if (UseThisCol) then + WRITE(Un, FmtOrient) i_print, op(i_op), op(i_op+1), op(i_op+2), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] + i_print = i_print + 1 + end if + i_op = i_op + 3 end if - - i_op = i_op + 3 else if (UseThisCol) then if (UseDerivNames) then @@ -1295,7 +1331,6 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d end if i_print = i_print + 1 end if - i_op = i_op + 1 end if end do @@ -1332,7 +1367,7 @@ SUBROUTINE WriteModuleLinearMatrices(ThisModule, ThisInstance, t_global, p_FAST, OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(ThisModule)) if (size(y_FAST%Lin%Modules(ThisModule)%Instance) > 1 .or. ThisModule==Module_BD) OutFileName = trim(OutFileName)//TRIM(num2lstr(ThisInstance)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance), OutFileName, Un, ErrStat, ErrMsg ) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance), OutFileName, Un, ThisModule, ErrStat, ErrMsg ) if (ErrStat >=AbortErrLev) then if (Un > 0) close(Un) return diff --git a/modules/openfast-library/src/FAST_SS_Solver.f90 b/modules/openfast-library/src/FAST_SS_Solver.f90 index d91c741254..db9f616950 100644 --- a/modules/openfast-library/src/FAST_SS_Solver.f90 +++ b/modules/openfast-library/src/FAST_SS_Solver.f90 @@ -1232,7 +1232,7 @@ SUBROUTINE FormSteadyStateJacobian( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, if (output_debugging) then - call WrLinFile_txt_Head(SS_t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) + call WrLinFile_txt_Head(SS_t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, Module_Glue, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() @@ -1335,11 +1335,11 @@ SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD if ( p_FAST%CompElast == Module_ED ) then ! get the jacobians call ED_JacobianPInput( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) + ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B, ModIdx=ED%p%IdxAeroMap ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call ED_JacobianPContState( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) + ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A, ModIdx=ED%p%IdxAeroMap ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get the operating point @@ -1348,7 +1348,7 @@ SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, & y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, & - dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) + dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx, ModIdx=ED%p%IdxAeroMap ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) return From ec0a483aa85756eec5347ed77b9e89fd715c9cff Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 15:08:38 +0000 Subject: [PATCH 042/319] Use module variables in BD, fix bugs in ModVar --- modules/beamdyn/src/BeamDyn.f90 | 1297 +++++++++-------- modules/beamdyn/src/BeamDyn_IO.f90 | 102 -- modules/beamdyn/src/BeamDyn_Types.f90 | 180 ++- modules/beamdyn/src/Registry_BeamDyn.txt | 17 +- modules/elastodyn/src/ElastoDyn.f90 | 204 ++- modules/elastodyn/src/ElastoDyn_Registry.txt | 3 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 18 +- modules/nwtc-library/src/ModVar.f90 | 15 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 300 ++-- .../src/Registry_NWTC_Library.txt | 19 +- .../src/Registry_NWTC_Library_base.txt | 19 +- modules/openfast-library/src/FAST_Lin.f90 | 20 +- .../openfast-library/src/FAST_Registry.txt | 2 - .../openfast-library/src/FAST_SS_Solver.f90 | 4 +- modules/openfast-library/src/FAST_Types.f90 | 36 - 15 files changed, 1147 insertions(+), 1089 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 35f1c75d86..1222cc40f9 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -53,6 +53,9 @@ MODULE BeamDyn PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT + PUBLIC :: BD_PackStateValues, BD_UnpackStateValues + PUBLIC :: BD_PackInputValues, BD_UnpackInputValues + ! The original formulation kept all states in the inertial reference frame. This has been leading to convergence issues ! when there is a large rotational change from the reference frame (i.e. large turbine yaw, large blade pitch). During ! the development of the tight coupling algorithm for OpenFAST, we decided to try changing all the states in BeamDyn to @@ -249,16 +252,18 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I !............................................................................................ - ! Initialize Jacobian: + ! Module Variables + !............................................................................................ + + call BD_InitVars(u, p, x, y, MiscVar, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !............................................................................................ + ! Summary and cleanup !............................................................................................ - if (InitInp%Linearize) then - call Init_Jacobian( p, u, y, MiscVar, InitOut, ErrStat2, ErrMsg2); if (Failed()) return - end if - call Cleanup() - return CONTAINS SUBROUTINE Cleanup() if (allocated(GLL_nodes )) deallocate(GLL_nodes ) @@ -929,7 +934,6 @@ subroutine SetParameters(InitInp, InputFileData, p, OtherState, ErrStat, ErrMsg) p%RotStates = InputFileData%RotStates ! Rotate states in linearization? - p%RelStates = InputFileData%RelStates ! Define states relative to root motion in linearization? p%rhoinf = InputFileData%rhoinf ! Numerical damping coefficient: [0,1]. No numerical damping if rhoinf = 1; maximum numerical damping if rhoinf = 0. p%dt = InputFileData%DTBeam ! Time step size @@ -5779,13 +5783,327 @@ SUBROUTINE PitchActuator_SetBC(p, u, xd, AllOuts) END SUBROUTINE PitchActuator_SetBC + +subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(BD_ParameterType), intent(inout) :: p !< Parameters + type(BD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(BD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(BD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(BD_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'BD_InitVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + integer(IntKi) :: i, j, Flags, idx + REAL(R8Ki) :: MaxThrust, MaxTorque + CHARACTER(200) :: label + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Set flags to none, if rotating states is true, set flags to rotating states + Flags = VF_AeroMap + if (p%RotStates) call SetFlags(Flags, VF_RotFrame) + + ! Add translation displacement and orientation variables at blade nodes + ! Note: the first node is not included as it is a constraint state + do i = 2, p%node_total + label = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//& + trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransDisp, & + VarIdx=idx, & + Num=3, & + Flags=flags, & + iUsr=i, & + Perturb=0.2_BDKi*D2R_D * p%blade_length, & + LinNames=[trim(label)//' translational displacement in X, m', & + trim(label)//' translational displacement in Y, m', & + trim(label)//' translational displacement in Z, m']) + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_Orientation, & + VarIdx=idx, & + Num=3, & + Flags=flags, & + iUsr=i, & + Perturb=0.2_BDKi*D2R_D, & + LinNames=[trim(label)//' rotational displacement in X, rad', & + trim(label)//' rotational displacement in Y, rad', & + trim(label)//' rotational displacement in Z, rad']) + end do + ! Add translation velocity and angular velocity at blade nodes + do i = 2, p%node_total + label = 'First time derivative of finite element node '//trim(num2lstr(i))//' (number of elements = '//& + trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransVel, & + VarIdx=idx, & + Num=3, & + Flags=flags, & + iUsr=i, & + Perturb=0.2_BDKi*D2R_D * p%blade_length, & + LinNames=[trim(label)//' translational displacement in X, m/s', & + trim(label)//' translational displacement in Y, m/s', & + trim(label)//' translational displacement in Z, m/s']) + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_AngularVel, & + VarIdx=idx, & + Num=3, & + Flags=flags, & + iUsr=i, & + Perturb=0.2_BDKi*D2R_D, & + LinNames=[trim(label)//' rotational displacement in X, rad/s', & + trim(label)//' rotational displacement in Y, rad/s', & + trim(label)//' rotational displacement in Z, rad/s']) + end do + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + MaxThrust = 170.0_R8Ki*p%blade_length**2 + MaxTorque = 14.0_R8Ki*p%blade_length**3 + + call MV_AddMeshVar(p%Vars%u, "RootMotion", MotionFields, & + VarIdx=p%iVarRootMotion, & + Mesh=u%RootMotion, & + Perturbs=[0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransDisp + 0.2_R8Ki*D2R_D, & ! VF_Orientation + 0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransVel + 0.2_R8Ki*D2R_D, & ! VF_AngularVel + 0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransAcc + 0.2_R8Ki*D2R_D]) ! VF_AngularAcc + call MV_AddMeshVar(p%Vars%u, "PointLoad", LoadFields, & + VarIdx=p%iVarPointLoad, & + Mesh=u%PointLoad, & + Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! VF_Force + MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! VF_Moment + call MV_AddMeshVar(p%Vars%u, "DistrLoad", LoadFields, & + VarIdx=p%iVarDistrLoad, & + Flags=ior(VF_Line, VF_AeroMap), & + Mesh=u%DistrLoad, & + Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! VF_Force + MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! VF_Moment + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'Reaction force', LoadFields, & + VarIdx=p%iVarReactionForce, & + Mesh=y%ReactionForce) + + call MV_AddMeshVar(p%Vars%y, 'Blade motion', MotionFields, & + VarIdx=p%iVarBldMotion, & + Mesh=y%BldMotion) + if (p%CompAeroMaps) then + do i = p%iVarBldMotion, size(p%Vars%y) + select case (p%Vars%y(i)%Field) + case (VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel) + call SetFlags(p%Vars%y(i)%Flags, VF_AeroMap) + end select + end do + end if + + p%iVarWriteOutput = size(p%Vars%y) + 1 + do i = 1, p%NumOuts + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & + VarIdx = j, & + Flags=OutParamFlags(p%OutParam(i)%Indx), & + iUsr=i, & + LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & + Active=p%OutParam(i)%Indx > 0) + end do + idx = p%NumOuts + 1 + do i = 1, p%BldNd_NumOuts + call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & + VarIdx = j, & + Num=size(p%BldNd_BlOutNd), & + Flags=BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & + iUsr=idx, & + LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & + Active=p%BldNd_OutParam(i)%Indx > 0) + idx = idx + size(p%BldNd_BlOutNd) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsLin(p%Vars, m%Lin, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return + + call BD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_CopyContState(x, m%dx_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_CopyOutput(y, m%y_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is requested, initialize arrays + if (Linearize .or. p%CompAeroMaps) then + call MV_InitLinArrays(p%Vars, 2, & + InitOut%LinNames_x, InitOut%RotFrame_x, InitOut%DerivOrder_x, & + InitOut%LinNames_u, InitOut%RotFrame_u, InitOut%IsLoad_u, & + InitOut%LinNames_y, InitOut%RotFrame_y, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! AeroMap + !---------------------------------------------------------------------------- + + if (p%CompAeroMaps) then + + ! Initialize index for variables flagged with VF_AeroMap + call MV_InitVarIdx(p%Vars, p%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Get subset of linearization arrays + InitOut%LinNames_x = InitOut%LinNames_x(p%IdxAeroMap%ix) + InitOut%RotFrame_x = InitOut%RotFrame_x(p%IdxAeroMap%ix) + InitOut%DerivOrder_x = InitOut%DerivOrder_x(p%IdxAeroMap%ix) + InitOut%LinNames_u = InitOut%LinNames_u(p%IdxAeroMap%iu) + InitOut%RotFrame_u = InitOut%RotFrame_u(p%IdxAeroMap%iu) + InitOut%IsLoad_u = InitOut%IsLoad_u(p%IdxAeroMap%iu) + InitOut%LinNames_y = InitOut%LinNames_y(p%IdxAeroMap%iy) + InitOut%RotFrame_y = InitOut%RotFrame_y(p%IdxAeroMap%iy) + end if + +contains + + pure integer(IntKi) function OutParamFlags(indx) + integer(IntKi), intent(in) :: indx + integer(IntKi), parameter :: GlobalFrameIndices(*) = [& + TipTVXg, TipTVYg, TipTVZg, TipRVXg, TipRVYg, TipRVZg, NTVg, NRVg] + if (any(GlobalFrameIndices == indx)) then + OutParamFlags = VF_None + else + OutParamFlags = VF_RotFrame + end if + end function + + pure integer(IntKi) function BldNd_OutParamFlags(ChannelName) + character(*), intent(in) :: ChannelName + integer(IntKi) :: k + ! Get index of last character in channel name + k = len_trim(ChannelName) + ! If last letter is uppercase or lowercase G, then frame is global + if (ChannelName(k:k) == 'G' .or. ChannelName(k:k) == 'g') then + BldNd_OutParamFlags = VF_None + else + BldNd_OutParamFlags = VF_RotFrame + end if + end function + + pure character(LinChanLen) function BldNd_LinChan(BldNd_OutParam, IdxNode) result(name) + type(OutParmType), intent(in) :: BldNd_OutParam + integer(IntKi), intent(in) :: IdxNode + write(name, '("N",I3.3,A,", ",A)') IdxNode, trim(BldNd_OutParam%Name), trim(BldNd_OutParam%Units) + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +subroutine BD_PackStateValues(p, x, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: Values(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + associate (Var => p%Vars%x(i)) + select case(Var%Field) + case (VF_TransDisp) + Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ displacement + case (VF_Orientation) + Values(Var%iLoc(1):Var%iLoc(2)) = x%q(4:6,Var%iUsr(1)) ! WM Parameters + case (VF_TransVel) + Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ velocity + case (VF_AngularVel) + Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular velocity + end select + end associate + end do +end subroutine + +subroutine BD_UnpackStateValues(p, Values, x) + type(BD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Values(:) + type(BD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + associate (Var => p%Vars%x(i)) + select case(Var%Field) + case (VF_TransDisp) + x%q(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ displacement + case (VF_Orientation) + x%q(4:6,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! WM parameters + case (VF_TransVel) + x%dqdt(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ velocity + case (VF_AngularVel) + x%dqdt(4:6,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! Angular velocity + end select + end associate + end do +end subroutine + +subroutine BD_PackInputValues(p, u, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_InputType), intent(in) :: u + real(R8Ki), intent(out) :: Values(:) + call MV_Pack(p%Vars%u, p%iVarRootMotion, u%RootMotion, Values) + call MV_Pack(p%Vars%u, p%iVarPointLoad, u%PointLoad, Values) + call MV_Pack(p%Vars%u, p%iVarDistrLoad, u%DistrLoad, Values) +end subroutine + +subroutine BD_UnpackInputValues(p, Ary, u) + type(BD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Ary(:) + type(BD_InputType), intent(inout) :: u + call MV_Unpack(p%Vars%u, p%iVarRootMotion, Ary, u%RootMotion) + call MV_Unpack(p%Vars%u, p%iVarPointLoad, Ary, u%PointLoad) + call MV_Unpack(p%Vars%u, p%iVarDistrLoad, Ary, u%DistrLoad) +end subroutine + +subroutine BD_PackOutputValues(p, y, Ary, PackOut) + type(BD_ParameterType), intent(in) :: p + type(BD_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: Ary(:) + logical, intent(in) :: PackOut + integer(IntKi) :: i + call MV_Pack(p%Vars%y, p%iVarReactionForce, y%ReactionForce, Ary) + call MV_Pack(p%Vars%y, p%iVarBldMotion, y%BldMotion, Ary) + if (PackOut) then + do i = p%iVarWriteOutput, size(p%Vars%y) + call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) + end do + end if +end subroutine + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ###### The following four routines are Jacobian routines for linearization capabilities ####### ! If the module does not implement them, set ErrStat = ErrID_Fatal in BD_Init() when InitInp%Linearize is .true. !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, StateRel_x, StateRel_xdot) +SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, ModIdx) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -5802,236 +6120,140 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRel_x(:,:) !< Matrix by which the displacement states are optionally converted relative to root - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRel_xdot(:,:) !< Matrix by which the velocity states are optionally converted relative to root - - - ! local variables - TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m - TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m - TYPE(BD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i - REAL(R8Ki) :: RotateStates(3,3) - REAL(R8Ki), ALLOCATABLE :: RelState_x(:,:) - REAL(R8Ki), ALLOCATABLE :: RelState_xdot(:,:) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] + TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'BD_JacobianPInput' - - - ! Initialize ErrStat + character(*), parameter :: RoutineName = 'BD_JacobianPInput' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j, col + REAL(R8Ki) :: RotateStates(3,3) + logical :: PackOut ErrStat = ErrID_None ErrMsg = '' + ! Set flag to pack write outputs + PackOut = .not. present(ModIdx) + + ! Get OP values here + call BD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if (Failed()) return - ! get OP values here: - call BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Make a copy of the inputs to perturb + call BD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackInputValues(p, u, m%Lin%u) - ! make a copy of the inputs to perturb - call BD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - if (p%RelStates) then - if (.not. allocated(RelState_x)) then - call AllocAry(RelState_x, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'RelState_x', ErrStat2, ErrMsg2) ! 18=6 motion fields on mesh x 3 directions for each field - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - if (.not. allocated(RelState_xdot)) then - call AllocAry(RelState_xdot, size(RelState_x,1), size(RelState_x,2), 'RelState_xdot', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then - call Compute_RelState_Matrix(p, u, x, OtherState, RelState_x, RelState_xdot) - - if ( present(StateRel_x) ) then - if (.not. allocated(StateRel_x)) then - call AllocAry(StateRel_x, size(RelState_x,1), size(RelState_x,2), 'StateRel_x', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - StateRel_x = RelState_x - end if - if ( present(StateRel_xdot) ) then - if (.not. allocated(StateRel_xdot)) then - call AllocAry(StateRel_xdot, size(RelState_xdot,1), size(RelState_xdot,2), 'StateRel_xdot', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! Allocate dYdu if not allocated + if (.not. allocated(dYdu)) then + if (present(ModIdx)) then + call AllocAry(dYdu, ModIdx%Ny, ModIdx%Nu, 'dYdu', ErrStat2, ErrMsg2) + else + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2) end if - StateRel_xdot = RelState_xdot - end if - else - if ( present(StateRel_x) ) then - if (allocated(StateRel_x)) deallocate(StateRel_x) + if (Failed()) return end if - if ( present(StateRel_xdot) ) then - if (allocated(StateRel_xdot)) deallocate(StateRel_xdot) - end if - end if + ! If not computing aero maps + if (.not. p%CompAeroMaps) then + + ! Loop through input variables + do i = 1, size(p%Vars%u) - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - - ! allocate dYdu - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - if (p%CompAeroMaps) then - dYdu = 0.0_R8Ki - else - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call BD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta_p u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - ! compute y at u_op + delta_p u - call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - ! get u_op - delta_m u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! compute y at u_op - delta_m u - call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) - + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) + call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=PackOut); if (Failed()) return + call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, PackOut) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) + call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=PackOut); if (Failed()) return + call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, PackOut) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdu(:,col)) + end do end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dYdu = m%Lin%dYdu(ModIdx%iy, ModIdx%iu) + else + dYdu = m%Lin%dYdu end if - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - if (p%RelStates) then - call BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx=m%lin_C ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - dYdu = dYdu + matmul(m%lin_C, RelState_x) - end if - + else + dYdu = 0.0_R8Ki end if ! CompAeroMaps END IF - IF ( PRESENT( dXdu ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu)) then - ! allocate dXdu if necessary + ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + if (present(ModIdx)) then + call AllocAry(dXdu, ModIdx%Nx, ModIdx%Nu, 'dXdu', ErrStat2, ErrMsg2) + else + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2) end if + if (Failed()) return end if - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) + + ! Loop through input variables + do i = 1, size(p%Vars%u) - ! compute x at u_op + delta u - call BD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! compute x at u_op - delta u - call BD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) - + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) + call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dx_perturb, m%Lin%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) + call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dx_perturb, m%Lin%x_neg) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + m%Lin%dXdu(:,col) = (m%Lin%x_pos - m%Lin%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + end do end do - - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - if (p%RelStates) then - call BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dXdx=m%lin_A ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - dXdu = dXdu + matmul(m%lin_A, RelState_x) - RelState_xdot + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dXdu = m%Lin%dXdu(ModIdx%iy, ModIdx%iu) + else + dXdu = m%Lin%dXdu end if if (p%RotStates) then @@ -6040,33 +6262,26 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM dXdu(i:i+2, :) = matmul( RotateStates, dXdu(i:i+2, :) ) end do end if + end if ! dXdu - END IF ! dXdu - - IF ( PRESENT( dXddu ) ) THEN + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if - IF ( PRESENT( dZdu ) ) THEN + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if - call cleanup() contains - subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call BD_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - - if (allocated(RelState_x)) deallocate(RelState_x) - if (allocated(RelState_xdot)) deallocate(RelState_xdot) - end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE BD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, StateRotation ) +SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, ModIdx, StateRotation ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6083,65 +6298,40 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) + TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRotation(:,:) !< Matrix by which the states are optionally rotated - - ! local variables - TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m - TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m - TYPE(BD_ContinuousStateType) :: x_perturb - INTEGER(IntKi) :: i - REAL(R8Ki) :: RotateStates(3,3) - REAL(R8Ki) :: RotateStatesTranspose(3,3) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_JacobianPContState' - - - ! Initialize ErrStat + CHARACTER(*), PARAMETER :: RoutineName = 'BD_JacobianPContState' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j, col + REAL(R8Ki) :: RotateStates(3,3) + REAL(R8Ki) :: RotateStatesTranspose(3,3) + logical :: PackOut ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdx ) .AND. PRESENT( dXdx )) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx, dXdx) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dYdx, dXdx) - ELSEIF ( PRESENT( dYdx ) ) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx=dYdx ) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dYdx=dYdx ) - ELSEIF ( PRESENT( dXdx ) ) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dXdx=dXdx) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dXdx=dXdx) - END IF - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Set flag to pack write outputs + PackOut = .not. present(ModIdx) + + ! Copy state values + call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, x, m%Lin%x) + ! If rotate states is enabled if (p%RotStates) then - RotateStates = matmul( u%RootMotion%Orientation(:,:,1), transpose( u%RootMotion%RefOrientation(:,:,1) ) ) + + RotateStates = matmul(u%RootMotion%Orientation(:,:,1), transpose(u%RootMotion%RefOrientation(:,:,1))) RotateStatesTranspose = transpose( RotateStates ) - if ( present(StateRotation) ) then + if (present(StateRotation)) then if (.not. allocated(StateRotation)) then - call AllocAry(StateRotation, 3, 3, 'StateRotation', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(StateRotation, 3, 3, 'StateRotation', ErrStat2, ErrMsg2); if (Failed()) return end if StateRotation = RotateStates end if @@ -6151,252 +6341,140 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if end if - IF ( PRESENT( dYdx ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then - if (p%RotStates) then - do i=1,size(dYdx,2),3 - dYdx(:, i:i+2) = matmul( dYdx(:, i:i+2), RotateStatesTranspose ) - end do + ! Allocate dYdx if not allocated + if (.not. allocated(dYdx)) then + if (present(ModIdx)) then + call AllocAry(dYdx, ModIdx%Ny, ModIdx%Nx, 'dYdx', ErrStat2, ErrMsg2) + else + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2) + end if + if (Failed()) return end if - - END IF - IF ( PRESENT( dXdx ) ) THEN + ! Loop through input variables + do i = 1, size(p%Vars%x) - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - - if (p%RotStates) then - do i=1,size(dXdx,1),3 - dXdx(i:i+2,:) = matmul( RotateStates, dXdx(i:i+2,:) ) - end do - do i=1,size(dXdx,2),3 - dXdx(:, i:i+2) = matmul( dXdx(:, i:i+2), RotateStatesTranspose ) - end do - end if - - END IF - - IF ( PRESENT( dXddx ) ) THEN - if (allocated(dXddx)) deallocate(dXddx) - END IF - - IF ( PRESENT( dZdx ) ) THEN - if (allocated(dZdx)) deallocate(dZdx) - END IF - - call cleanup() - -contains - subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE BD_JacobianPContState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the continuous states (x). The partial derivatives dY/dx, and dX/dx are returned. -!SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, calledFrom, ErrStat, ErrMsg, dYdx, dXdx ) -SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(BD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(BD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(BD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdx. - TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - !INTEGER(IntKi), INTENT(IN ) :: calledFrom !< flag to help determine logic for when these matrices need to be recalculated - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - - - ! local variables - TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m - TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m - TYPE(BD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k - INTEGER(IntKi) :: index - INTEGER(IntKi) :: dof - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_JacobianPContState_noRotate' - - - ! Initialize ErrStat + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%x(i)%Flags, ModIdx%FlagFilter) == 0) cycle + end if - ErrStat = ErrID_None - ErrMsg = '' + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num - ! make a copy of the continuous states to perturb - call BD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) + call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=PackOut); if (Failed()) return + call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, PackOut) - IF ( PRESENT( dYdx ) ) THEN + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) + call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=PackOut); if (Failed()) return + call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, PackOut) - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 - ! allocate dYdx if necessary - if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%Jac_nx*2, 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call BD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - index = 1 - do k=1,2 - do i=2,p%node_total - do dof=1,p%dof_node - - ! get x_op + delta x - call BD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call perturb_x(p, k, i, dof, 1, x_perturb, delta ) - - ! compute y at x_op + delta x - call BD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get x_op - delta x - call BD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call perturb_x(p, k, i, dof, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call BD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdx(:,index) ) - - index = index+1 - end do + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdx(:,col)) end do end do - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return + + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dYdx = m%Lin%dYdx(ModIdx%iy, ModIdx%ix) + else + dYdx = m%Lin%dYdx end if - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF - - IF ( PRESENT( dXdx ) ) THEN + ! If rotate state is enabled, rotate + if (p%RotStates) then + do i=1,size(dYdx,2),3 + dYdx(:, i:i+2) = matmul( dYdx(:, i:i+2), RotateStatesTranspose) + end do + end if + end if - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx)) then - ! allocate dXdu if necessary + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Jac_nx * 2, p%Jac_nx * 2, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + if (present(ModIdx)) then + call AllocAry(dXdx, ModIdx%Nx, ModIdx%Nx, 'dXdx', ErrStat2, ErrMsg2) + else + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2) end if + if (Failed()) return end if - - index = 1 ! counter into dXdx - do k=1,2 ! 1=positions (x_perturb%q); 2=velocities (x_perturb%dqdt) - do i=2,p%node_total - do dof=1,p%dof_node - - ! get x_op + delta x - call BD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call perturb_x(p, k, i, dof, 1, x_perturb, delta ) - ! compute x at x_op + delta x - call BD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Loop through input variables + do i = 1, size(p%Vars%x) + + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%x(i)%Flags, ModIdx%FlagFilter) == 0) cycle + end if + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num - ! get x_op - delta x - call BD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call perturb_x(p, k, i, dof, -1, x_perturb, delta ) - - ! compute x at x_op - delta x - call BD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) + call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) + call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dx_perturb, m%Lin%x_pos) - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta, dXdx(:,index) ) - - index = index+1 - end do + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) + call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) + call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dx_perturb, m%Lin%x_neg) + + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + m%Lin%dXdx(:,col) = (m%Lin%x_pos - m%Lin%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) end do end do - - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - + + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dXdx = m%Lin%dXdx(ModIdx%idx, ModIdx%ix) + else + dXdx = m%Lin%dXdx + end if + + if (p%RotStates) then + do i=1,size(dXdx,1),3 + dXdx(i:i+2,:) = matmul(RotateStates, dXdx(i:i+2,:)) + end do + do i=1,size(dXdx,2),3 + dXdx(:, i:i+2) = matmul(dXdx(:, i:i+2), RotateStatesTranspose) + end do + end if + end if + + IF ( PRESENT( dXddx ) ) THEN + if (allocated(dXddx)) deallocate(dXddx) + END IF + + IF ( PRESENT( dZdx ) ) THEN + if (allocated(dZdx)) deallocate(dZdx) END IF - - call cleanup() - contains - subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE BD_JacobianPContState_noRotate + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE BD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. @@ -6532,7 +6610,7 @@ SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE BD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) +SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, ModIdx, NeedTrimOP ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6552,54 +6630,51 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - - INTEGER(IntKi) :: index, i, dof - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - LOGICAL :: ReturnTrimOP - TYPE(BD_ContinuousStateType) :: dx ! derivative of continuous states at operating point - - - ! Initialize ErrStat + TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + + INTEGER(IntKi) :: index, i, dof + INTEGER(IntKi) :: nu + INTEGER(IntKi) :: ny + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' + LOGICAL :: FieldMask(FIELDMASK_SIZE) + LOGICAL :: ReturnTrimOP + logical :: PackOut ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( u_op ) ) THEN - - nu = size(p%Jac_u_indx,1) + u%RootMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + ! Set flag to pack write outputs + PackOut = .not. present(ModIdx) + + ! If inputs requested + if (present(u_op)) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + ! Allocate array if not allocated + if (.not. allocated(u_op)) then + if (present(ModIdx)) then + call AllocAry(u_op, ModIdx%Nu, 'u_op', ErrStat2, ErrMsg2) + else + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) + end if + if (Failed()) return end if + ! Pack input type into array + call BD_PackInputValues(p, u, m%Lin%u) - index = 1 - if (.not. p%CompAeroMaps) then - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(u%RootMotion, u_op, index, FieldMask=FieldMask) - - call PackLoadMesh(u%PointLoad, u_op, index) + ! If ModIdx is present + if (present(ModIdx)) then + u_op = m%Lin%u(ModIdx%iu) ! copy subset of array + else + u_op = m%Lin%u ! copy full array end if - - call PackLoadMesh(u%DistrLoad, u_op, index) - - END IF + end if + + ! If outputs requested + if (present(y_op)) then - - IF ( PRESENT( y_op ) ) THEN ! Only the y operating points need to potentially return a smaller array than the "normal" call to this return. In the trim solution, we use a smaller array for y. if (present(NeedTrimOP)) then ReturnTrimOP = NeedTrimOP @@ -6607,112 +6682,84 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, ReturnTrimOP = .false. end if - if (.not. allocated(y_op)) then - ny = p%Jac_ny + y%BldMotion%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - - call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + ! Allocate array if not allocated + if (.not. allocated(y_op)) then + if (present(ModIdx)) then + call AllocAry(y_op, ModIdx%Ny, 'y_op', ErrStat2, ErrMsg2) + else + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) + end if + if (Failed()) return end if - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array - - index = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - - if (.not. p%CompAeroMaps) then - - call PackLoadMesh(y%ReactionForce, y_op, index) - - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - end if - call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - - if (.not. p%CompAeroMaps) then - index = index - 1 - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - end if - - - END IF + call BD_PackOutputValues(p, y, m%Lin%y, PackOut) + + ! If ModIdx is present + if (present(ModIdx)) then + y_op = m%Lin%y(ModIdx%iy) ! copy subset of array + else + y_op = m%Lin%y ! copy full array + end if + end if - IF ( PRESENT( x_op ) ) THEN + ! If continuous states requested + if (present(x_op)) then - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx * 2,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + ! Allocate array if not allocated + if (.not. allocated(x_op)) then + if (present(ModIdx)) then + call AllocAry(x_op, ModIdx%Nx, 'x_op', ErrStat2, ErrMsg2) + else + call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2) + end if + if (Failed()) return end if - index = 1 - do i=2,p%node_total - do dof=1,p%dof_node - x_op(index) = x%q( dof, i ) - index = index+1 - end do - end do - - do i=2,p%node_total - do dof=1,p%dof_node - x_op(index) = x%dqdt( dof, i ) - index = index+1 - end do - end do - - END IF + call BD_PackStateValues(p, x, m%Lin%x) + + ! If ModIdx is present + if (present(ModIdx)) then + x_op = m%Lin%x(ModIdx%ix) ! copy subset of array + else + x_op = m%Lin%x ! copy full array + end if + end if - IF ( PRESENT( dx_op ) ) THEN + ! If continuous state derivatives requested + if (present(dx_op)) then + ! Allocate array if not allocated if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx * 2,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + if (present(ModIdx)) then + call AllocAry(dx_op, ModIdx%Nx, 'dx_op', ErrStat2, ErrMsg2) + else + call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2) + end if + if (Failed()) return end if - call BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call BD_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - - index = 1 - do i=2,p%node_total - do dof=1,p%dof_node - dx_op(index) = dx%q( dof, i ) - index = index+1 - end do - end do - - do i=2,p%node_total - do dof=1,p%dof_node - dx_op(index) = dx%dqdt( dof, i ) - index = index+1 - end do - end do - - call BD_DestroyContState( dx, ErrStat2, ErrMsg2) + call BD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2) + if (Failed()) return - END IF + call BD_PackStateValues(p, m%dx_perturb, m%Lin%dx) - IF ( PRESENT( xd_op ) ) THEN + ! If ModIdx is present + if (present(ModIdx)) then + dx_op = m%Lin%dx(ModIdx%idx) ! copy subset of array + else + dx_op = m%Lin%dx ! copy full array + end if + end if - END IF + if (present(xd_op)) then + end if - IF ( PRESENT( z_op ) ) THEN ! this is a little weird, but seems to be how BD has implemented the first node in the continuous state array. + if (present(z_op)) then if (.not. allocated(z_op)) then call AllocAry(z_op, p%dof_node * 2,'z_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + if (Failed()) return end if index = 1 @@ -6725,9 +6772,13 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, z_op(index) = x%dqdt( dof, 1 ) index = index+1 end do - - END IF + end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE BD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -6832,6 +6883,7 @@ END SUBROUTINE BD_WriteMassStiffInFirstNodeFrame !> Update the state information to follow the blade rootmotion mesh. !! - move the state information in x from the previous reference frame at time T (u(2)%rootmotion) to the new reference frame at T+dt (u(1)%rootmation) !! - the GlbRot, GlbPos, and Glb_crv values are stored as otherstates and updated +!! - subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) type(BD_InputType), intent(in ) :: u !< Inputs at utimes type(BD_ParameterType), intent(in ) :: p !< Parameters @@ -6846,7 +6898,6 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) real(R8Ki) :: GlbPos_old(3), GlbPos_new(3) - real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) integer(IntKi) :: i, j, temp_id ErrStat = ErrID_None diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index 2a5ecea0de..c928cb19a6 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -756,10 +756,6 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF if (InputFileData%tngt_stf_fd) CALL WrScr( 'Using finite difference to compute tangent stiffness matrix'//NewLine ) - ! ! RelStates - Define states relative to root motion during linearization? (flag) [used only when linearizing] - !CALL ReadVar(UnIn,InputFile,InputFileData%RelStates,"RelStates", "Define states relative to root motion during linearization? (flag) [used only when linearizing]",ErrStat2,ErrMsg2,UnEc) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - InputFileData%RelStates = .false. ! this doesn't seem to be needed anymore (and I think there is a problem with using it in MBC3) Line = "" CALL ReadVar(UnIn, InputFile, Line, 'tngt_stf_comp','compare tangent stiffness using finite difference flag', ErrStat2, ErrMsg2, UnEc) @@ -2557,104 +2553,6 @@ SUBROUTINE Compute_dX(p, x_p, x_m, delta, dX) dX = dX / ( 2.0_R8Ki*delta) END SUBROUTINE Compute_dX -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_RelState_Matrix(p, u, x, OtherState, RelState_x, RelState_xdot) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(BD_InputType) , INTENT(IN ) :: u !< BD inputs - TYPE(BD_ContinuousStateType) , INTENT(IN ) :: x !< BD continuous states - TYPE(BD_OtherStateType) , INTENT(IN ) :: OtherState !< Other states at t - REAL(R8Ki) , INTENT(INOUT) :: RelState_x(:,:) !< - REAL(R8Ki) , INTENT(INOUT) :: RelState_xdot(:,:) !< - - ! local variables: - INTEGER(IntKi) :: i ! loop counter - INTEGER(IntKi) :: j ! loop counter - INTEGER(IntKi) :: dof ! loop over dofs - INTEGER(IntKi) :: q_index ! index into the state arrays - INTEGER(IntKi) :: dqdt_index ! index into the state arrays - INTEGER(IntKi) :: node ! node in the state arrays - - REAL(R8Ki) :: dp ! temporary dot product - REAL(R8Ki) :: cp(3) ! temporary cross product - REAL(R8Ki) :: RotVel(3) ! temporary velocity - REAL(R8Ki) :: RotAcc(3) ! temporary acceleration - REAL(R8Ki) :: DisplacedPosition(3) - REAL(R8Ki) :: fx_p(3,3) - - RelState_x = 0.0_ReKi - RelState_xdot = 0.0_ReKi - - !----------------------------------- - do i=1,p%elem_total - do j=2,p%nodes_per_elem - - node = (i-1)*(p%nodes_per_elem-1) + j ! index to state array (rows of conversion matrices) - q_index = (node - 2)*p%dof_node + 1 ! index into displacement portion of x (skipping node 1) - dqdt_index = p%Jac_nx + q_index - - DisplacedPosition = u%RootMotion%Position(:,1) + u%RootMotion%TranslationDisp(:,1) & - - OtherState%GlbPos - MATMUL(OtherState%GlbRot, p%uuN0(1:3,j,i) + x%q(1:3,node) ) - - RotVel = real(u%RootMotion%RotationVel(:,1),R8Ki) - RotAcc = real(u%RootMotion%RotationAcc(:,1),R8Ki) - - fx_p = SkewSymMat(DisplacedPosition) - - do dof=0,5 - RelState_x( q_index+dof, 1+dof ) = 1.0_R8Ki ! root displacements to node displacements - end do - do dof=0,5 - RelState_x( dqdt_index+dof, 7+dof ) = 1.0_R8Ki ! root velocities to node velocities - end do - - - RelState_x( q_index:q_index+2, 4: 6 ) = fx_p ! root rotational displacement to node translational displacement - RelState_x( dqdt_index:dqdt_index+2, 10:12 ) = fx_p ! root rotational velocity to node translational velocity - - ! root rotational displacement to node translational velocity: - RelState_x( dqdt_index:dqdt_index+2, 4:6 ) = OuterProduct( DisplacedPosition, RotVel ) - dp = dot_product( DisplacedPosition, RotVel ) - do dof=0,2 - RelState_x( dqdt_index+dof, 4+dof ) = RelState_x( dqdt_index+dof, 4+dof ) - dp ! root rotational displacement to node translational velocity - end do - !---------- - - - !............................................. - ! The first p%Jac_nx rows of RelState_xdot are the same as the last p%Jac_nx rows of RelState_x, so I'm not going to recalculate these rows, we'll set them after the loops: - !do dof=0,5 - ! RelState_xdot( q_index+dof, 7+dof ) = 1.0_ReKi ! root velocities to node velocities - !end do - !RelState_xdot( q_index:q_index+2, 4:6 ) = RelState_x( dqdt_index:dqdt_index+2, 4:6 ) ! root rotational displacement to node translational velocity - !RelState_xdot( q_index:q_index+2, 10:12 ) = fx_p ! root rotational velocity to node translational velocity - - do dof=0,5 - RelState_xdot( dqdt_index+dof, 13+dof ) = 1.0_R8Ki ! root accelerations to node accelerations - end do - - - ! root translational velocity to node translational acceleration: - cp = cross_product(u%RootMotion%RotationVel(:,1), DisplacedPosition) - RelState_xdot( dqdt_index:dqdt_index+2, 7:9 ) = OuterProduct( DisplacedPosition, RotAcc ) & - + OuterProduct( cp, RotVel ) - dp*SkewSymMat(RotVel) - dp = dot_product( DisplacedPosition, RotAcc ) - do dof=0,2 - RelState_xdot( dqdt_index+dof, 7+dof ) = RelState_xdot( dqdt_index+dof, 7+dof ) - dp - end do - !----------- - - RelState_xdot( dqdt_index:dqdt_index+2, 10:12 ) = RelState_x( dqdt_index:dqdt_index+2, 4:6 ) + SkewSymMat(cp) ! root rotational velocity to node translational acceleration - RelState_xdot( dqdt_index:dqdt_index+2, 16:18 ) = fx_p ! root rotational acceleration to node translational acceleration - - end do - end do - RelState_xdot(1:p%Jac_nx,:) = RelState_x(p%Jac_nx+1:,:) - -END SUBROUTINE Compute_RelState_Matrix -!---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- END MODULE BeamDyn_IO diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 1d3be92983..a0c7184a2b 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -61,6 +61,9 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] + INTEGER(IntKi) :: kp_total = 0_IntKi !< Total number of key points [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -108,7 +111,6 @@ MODULE BeamDyn_Types REAL(R8Ki) :: pitchC = 0.0_R8Ki !< Pitch actuator damping [-] LOGICAL :: Echo = .false. !< Echo [-] LOGICAL :: RotStates = .TRUE. !< Orient states in rotating frame during linearization? (flag) [-] - LOGICAL :: RelStates = .FALSE. !< Define states relative to root motion during linearization? (flag) [-] LOGICAL :: tngt_stf_fd = .false. !< Flag to compute tangent stifness matrix via finite difference [-] LOGICAL :: tngt_stf_comp = .false. !< Flag to compare finite differenced and analytical tangent stifness [-] INTEGER(IntKi) :: NNodeOuts = 0_IntKi !< Number of node outputs [0 - 9] [-] @@ -159,6 +161,14 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_ParameterType ======= TYPE, PUBLIC :: BD_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(VarsIdxType) :: IdxAeroMap !< Module variable index for AeroMap [-] + INTEGER(IntKi) :: iVarRootMotion = 0_IntKi !< Root motion variable index [-] + INTEGER(IntKi) :: iVarPointLoad = 0_IntKi !< Point load variable index [-] + INTEGER(IntKi) :: iVarDistrLoad = 0_IntKi !< Distributed load variable index [-] + INTEGER(IntKi) :: iVarReactionForce = 0_IntKi !< Reaction force variable index [-] + INTEGER(IntKi) :: iVarBldMotion = 0_IntKi !< Blade motion variable index [-] + INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Write output variable index [-] REAL(DbKi) :: dt = 0.0_R8Ki !< module dt [s] REAL(DbKi) , DIMENSION(1:9) :: coef = 0.0_R8Ki !< GA2 Coefficient [-] REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical Damping Coefficient for GA2 [-] @@ -235,7 +245,6 @@ MODULE BeamDyn_Types INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] - LOGICAL :: RelStates = .false. !< Define states relative to root motion during linearization? (flag) [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false) [-] END TYPE BD_ParameterType ! ======================= @@ -331,6 +340,11 @@ MODULE BeamDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LP_indx !< Index vector for LU [-] TYPE(BD_InputType) :: u !< Inputs converted to the internal BD coordinate system [-] TYPE(BD_InputType) :: u2 !< Inputs in the FAST coordinate system, possibly modified by pitch actuator [-] + TYPE(ModLinType) :: Lin !< Values corresponding to module variables [-] + TYPE(BD_ContinuousStateType) :: x_perturb !< [-] + TYPE(BD_ContinuousStateType) :: dx_perturb !< [-] + TYPE(BD_InputType) :: u_perturb !< [-] + TYPE(BD_OutputType) :: y_perturb !< [-] END TYPE BD_MiscVarType ! ======================= CONTAINS @@ -448,6 +462,20 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars + if (allocated(SrcInitOutputData%kp_coordinate)) then + LB(1:2) = lbound(SrcInitOutputData%kp_coordinate, kind=B8Ki) + UB(1:2) = ubound(SrcInitOutputData%kp_coordinate, kind=B8Ki) + if (.not. allocated(DstInitOutputData%kp_coordinate)) then + allocate(DstInitOutputData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%kp_coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate + end if + DstInitOutputData%kp_total = SrcInitOutputData%kp_total if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) @@ -563,6 +591,10 @@ subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) + if (allocated(InitOutputData%kp_coordinate)) then + deallocate(InitOutputData%kp_coordinate) + end if if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -593,10 +625,20 @@ subroutine BD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(BD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPackAlloc(RF, InData%kp_coordinate) + call RegPack(RF, InData%kp_total) call RegPackAlloc(RF, InData%LinNames_y) call RegPackAlloc(RF, InData%LinNames_x) call RegPackAlloc(RF, InData%LinNames_u) @@ -615,10 +657,32 @@ subroutine BD_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpackAlloc(RF, OutData%kp_coordinate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kp_total); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return @@ -792,7 +856,6 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%pitchC = SrcInputFileData%pitchC DstInputFileData%Echo = SrcInputFileData%Echo DstInputFileData%RotStates = SrcInputFileData%RotStates - DstInputFileData%RelStates = SrcInputFileData%RelStates DstInputFileData%tngt_stf_fd = SrcInputFileData%tngt_stf_fd DstInputFileData%tngt_stf_comp = SrcInputFileData%tngt_stf_comp DstInputFileData%NNodeOuts = SrcInputFileData%NNodeOuts @@ -897,7 +960,6 @@ subroutine BD_PackInputFile(RF, Indata) call RegPack(RF, InData%pitchC) call RegPack(RF, InData%Echo) call RegPack(RF, InData%RotStates) - call RegPack(RF, InData%RelStates) call RegPack(RF, InData%tngt_stf_fd) call RegPack(RF, InData%tngt_stf_comp) call RegPack(RF, InData%NNodeOuts) @@ -945,7 +1007,6 @@ subroutine BD_UnPackInputFile(RF, OutData) call RegUnpack(RF, OutData%pitchC); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RelStates); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%tngt_stf_fd); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%tngt_stf_comp); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NNodeOuts); if (RegCheckErr(RF, RoutineName)) return @@ -1289,6 +1350,27 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + call NWTC_Library_CopyVarsIdxType(SrcParamData%IdxAeroMap, DstParamData%IdxAeroMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%iVarRootMotion = SrcParamData%iVarRootMotion + DstParamData%iVarPointLoad = SrcParamData%iVarPointLoad + DstParamData%iVarDistrLoad = SrcParamData%iVarDistrLoad + DstParamData%iVarReactionForce = SrcParamData%iVarReactionForce + DstParamData%iVarBldMotion = SrcParamData%iVarBldMotion + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput DstParamData%dt = SrcParamData%dt DstParamData%coef = SrcParamData%coef DstParamData%rhoinf = SrcParamData%rhoinf @@ -1683,7 +1765,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_ny = SrcParamData%Jac_ny DstParamData%Jac_nx = SrcParamData%Jac_nx DstParamData%RotStates = SrcParamData%RotStates - DstParamData%RelStates = SrcParamData%RelStates DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps end subroutine @@ -1698,6 +1779,14 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if + call NWTC_Library_DestroyVarsIdxType(ParamData%IdxAeroMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%uuN0)) then deallocate(ParamData%uuN0) end if @@ -1804,7 +1893,22 @@ subroutine BD_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'BD_PackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call NWTC_Library_PackVarsIdxType(RF, InData%IdxAeroMap) + call RegPack(RF, InData%iVarRootMotion) + call RegPack(RF, InData%iVarPointLoad) + call RegPack(RF, InData%iVarDistrLoad) + call RegPack(RF, InData%iVarReactionForce) + call RegPack(RF, InData%iVarBldMotion) + call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%dt) call RegPack(RF, InData%coef) call RegPack(RF, InData%rhoinf) @@ -1897,7 +2001,6 @@ subroutine BD_PackParam(RF, Indata) call RegPack(RF, InData%Jac_ny) call RegPack(RF, InData%Jac_nx) call RegPack(RF, InData%RotStates) - call RegPack(RF, InData%RelStates) call RegPack(RF, InData%CompAeroMaps) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1910,7 +2013,34 @@ subroutine BD_UnPackParam(RF, OutData) integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxAeroMap) ! IdxAeroMap + call RegUnpack(RF, OutData%iVarRootMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPointLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDistrLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarReactionForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarBldMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%coef); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%rhoinf); if (RegCheckErr(RF, RoutineName)) return @@ -2011,7 +2141,6 @@ subroutine BD_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RelStates); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3123,6 +3252,21 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call BD_CopyInput(SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyContState(SrcMiscData%dx_perturb, DstMiscData%dx_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyOutput(SrcMiscData%y_perturb, DstMiscData%y_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -3238,6 +3382,16 @@ subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BD_DestroyInput(MiscData%u2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModLinType(MiscData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyContState(MiscData%dx_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyOutput(MiscData%y_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine BD_PackMisc(RF, Indata) @@ -3283,6 +3437,11 @@ subroutine BD_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%LP_indx) call BD_PackInput(RF, InData%u) call BD_PackInput(RF, InData%u2) + call NWTC_Library_PackModLinType(RF, InData%Lin) + call BD_PackContState(RF, InData%x_perturb) + call BD_PackContState(RF, InData%dx_perturb) + call BD_PackInput(RF, InData%u_perturb) + call BD_PackOutput(RF, InData%y_perturb) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3332,6 +3491,11 @@ subroutine BD_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%LP_indx); if (RegCheckErr(RF, RoutineName)) return call BD_UnpackInput(RF, OutData%u) ! u call BD_UnpackInput(RF, OutData%u2) ! u2 + call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin + call BD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call BD_UnpackContState(RF, OutData%dx_perturb) ! dx_perturb + call BD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call BD_UnpackOutput(RF, OutData%y_perturb) ! y_perturb end subroutine subroutine BD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 54037d8a73..50b52fe996 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -42,6 +42,7 @@ typedef ^ InitInputType LOGICAL CompAeroMaps - .FALSE. - "fl typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - #typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - @@ -98,7 +99,6 @@ typedef ^ BD_InputFile ^ pitchC - - - "Pitch actuator dam #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ typedef ^ BD_InputFile Logical Echo - - - "Echo" - typedef ^ BD_InputFile Logical RotStates - .TRUE. - "Orient states in rotating frame during linearization? (flag)" - -typedef ^ BD_InputFile Logical RelStates - .FALSE. - "Define states relative to root motion during linearization? (flag)" - typedef ^ BD_InputFile Logical tngt_stf_fd - - - "Flag to compute tangent stifness matrix via finite difference" - typedef ^ BD_InputFile Logical tngt_stf_comp - - - "Flag to compare finite differenced and analytical tangent stifness" - typedef ^ BD_InputFile IntKi NNodeOuts - - - "Number of node outputs [0 - 9]" - @@ -165,6 +165,14 @@ typedef ^ ^ ^ mEta ::: - - "Center of ma # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" +typedef ^ ParameterType VarsIdxType IdxAeroMap - - - "Module variable index for AeroMap" +typedef ^ ParameterType IntKi iVarRootMotion - - - "Root motion variable index" +typedef ^ ParameterType IntKi iVarPointLoad - - - "Point load variable index" +typedef ^ ParameterType IntKi iVarDistrLoad - - - "Distributed load variable index" +typedef ^ ParameterType IntKi iVarReactionForce - - - "Reaction force variable index" +typedef ^ ParameterType IntKi iVarBldMotion - - - "Blade motion variable index" +typedef ^ ParameterType IntKi iVarWriteOutput - - - "Write output variable index" typedef ^ ParameterType DbKi dt - - - "module dt" s typedef ^ ParameterType DbKi coef {9} - - "GA2 Coefficient" - typedef ^ ParameterType DbKi rhoinf - - - "Numerical Damping Coefficient for GA2" @@ -248,7 +256,6 @@ typedef ^ ParameterType R8Ki dx {6} typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - -typedef ^ ParameterType Logical RelStates - - - "Define states relative to root motion during linearization? (flag)" - typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false)" - @@ -374,4 +381,8 @@ typedef ^ MiscVarType ^ LP_RHS_LU {:} - - "R typedef ^ MiscVarType IntKi LP_indx {:} - - "Index vector for LU" - typedef ^ MiscVarType BD_InputType u - - - "Inputs converted to the internal BD coordinate system" - typedef ^ MiscVarType BD_InputType u2 - - - "Inputs in the FAST coordinate system, possibly modified by pitch actuator" - - +typedef ^ MiscVarType ModLinType Lin - - - "Values corresponding to module variables" +typedef ^ MiscVarType BD_ContinuousStateType x_perturb - - - "" - +typedef ^ MiscVarType BD_ContinuousStateType dx_perturb - - - "" - +typedef ^ MiscVarType BD_InputType u_perturb - - - "" - +typedef ^ MiscVarType BD_OutputType y_perturb - - - "" - diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 7ca987239a..9880e09288 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -338,17 +338,6 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut IF (ErrStat >= AbortErrLev) RETURN InitOut%BlPitch = InputFileData%BlPitch(1:p%NumBl) - !............................................................................................ - ! set up data needed for linearization analysis - !............................................................................................ - - ! if (InitInp%Linearize .or. p%CompAeroMaps) then - ! call ED_Init_Jacobian(p, u, y, InitOut, ErrStat2, ErrMsg2) - ! call CheckError( ErrStat2, ErrMsg2 ) - ! if (ErrStat >= AbortErrLev) return - ! end if - - !............................................................................................ ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which ! this module must be called here: @@ -10390,18 +10379,22 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] - TYPE(ModIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' - integer(IntKi) :: i, j, row, col + integer(IntKi) :: i, j, col + logical :: PackOut ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function + ! Set flag to pack write outputs + PackOut = .not. present(ModIdx) + ! Update copy of the inputs to perturb call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackInputValues(p, u, m%Lin%u) @@ -10419,51 +10412,57 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM if (Failed()) return end if - ! Loop through input variables - do i = 1, size(p%Vars%u) + ! If not computing aero maps + if (.not. p%CompAeroMaps) then - ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + ! Loop through input variables + do i = 1, size(p%Vars%u) - ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + ! If variable flag not in flag filter, skip + if (present(ModIdx)) then + if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle + end if - ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) - call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos) + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num - ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) - call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg) + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) + call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, PackOut) - ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) + call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) + call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, PackOut) - ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdu(:,col)) + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdu(:,col)) + end do end do - end do - - ! Only include extended variables in full linearization - if (.not. present(ModIdx)) then + + ! Only include extended variables in full linearization + if (.not. present(ModIdx)) then - ! Extended: BlPitchComC is the sum of BlPitchCom across all blades - associate (Var => p%Vars%u(p%iVarBlPitchCom)) - m%Lin%dYdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(m%Lin%dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) - end associate - end if + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + associate (Var => p%Vars%u(p%iVarBlPitchCom)) + m%Lin%dYdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(m%Lin%dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate + end if - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dYdu = m%Lin%dYdu(ModIdx%iy, ModIdx%iu) + ! If ModIdx is present, copy subset of Jacobian to output + if (present(ModIdx)) then + dYdu = m%Lin%dYdu(ModIdx%iy, ModIdx%iu) + else + dYdu = m%Lin%dYdu + end if else - dYdu = m%Lin%dYdu + dYdu = 0.0_R8Ki end if end if @@ -10494,14 +10493,14 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dx_perturb, m%Lin%x_pos) + call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%x_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%x_perturb, m%Lin%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dx_perturb, m%Lin%x_neg) + call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%x_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%x_perturb, m%Lin%x_neg) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -10577,18 +10576,22 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the continuous states (x) [intent in to avoid deallocation] - TYPE(ModIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' INTEGER(IntKi) :: i, j, col + logical :: PackOut ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function + ! Set flag to pack write outputs + PackOut = .not. present(ModIdx) + ! Copy state values call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackStateValues(p, x, m%Lin%x) @@ -10621,13 +10624,13 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos) + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, PackOut) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg) + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, PackOut) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -10885,26 +10888,18 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - TYPE(ModIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type INTEGER(IntKi) :: i, k, index INTEGER(IntKi) :: ny INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' - integer(IntKi) :: FlagFilter ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - - ! Get flag filter from ModIdx if present, otherwise set to allow all - if (present(ModIdx)) then - FlagFilter = ModIdx%FlagFilter - else - FlagFilter = not(0_IntKi) ! allow all - end if - + !.................................. if ( present( u_op ) ) then @@ -10920,8 +10915,8 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, ! Pack input type into array call ED_PackInputValues(p, u, m%Lin%u) - ! If extended inputs are requested - if (iand(FlagFilter, VF_Ext) /= 0) then + ! If full linearization, check extended inputs + if (.not. present(ModIdx)) then do k = 2,p%NumBl if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & @@ -10951,7 +10946,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, if (Failed()) return end if - call ED_PackOutputValues(p, y, m%Lin%y) + call ED_PackOutputValues(p, y, m%Lin%y, .not. present(ModIdx)) ! If ModIdx is present if (present(ModIdx)) then @@ -11521,70 +11516,73 @@ subroutine ED_UnpackStateValues(p, ary, x) end do end subroutine -subroutine ED_PackInputValues(p, u, ary) +subroutine ED_PackInputValues(p, u, Ary) type(ED_ParameterType), intent(in) :: p type(ED_InputType), intent(in) :: u - real(R8Ki), intent(out) :: ary(:) + real(R8Ki), intent(out) :: Ary(:) integer(IntKi) :: i if (allocated(u%BladePtLoads)) then do i = 1, size(u%BladePtLoads) - call MV_Pack(p%Vars%u, p%iVarBladePtLoads(i), u%BladePtLoads(i), ary) + call MV_Pack(p%Vars%u, p%iVarBladePtLoads(i), u%BladePtLoads(i), Ary) end do end if - call MV_Pack(p%Vars%u, p%iVarPlatformPtMesh, u%PlatformPtMesh, ary) - call MV_Pack(p%Vars%u, p%iVarTowerPtLoads, u%TowerPtLoads, ary) - call MV_Pack(p%Vars%u, p%iVarHubPtLoad, u%HubPtLoad, ary) - call MV_Pack(p%Vars%u, p%iVarNacelleLoads, u%NacelleLoads, ary) - call MV_Pack(p%Vars%u, p%iVarBlPitchCom, u%BlPitchCom, ary) - call MV_Pack(p%Vars%u, p%iVarYawMom, u%YawMom, ary) - call MV_Pack(p%Vars%u, p%iVarGenTrq, u%GenTrq, ary) - call MV_Pack(p%Vars%u, p%iVarBlPitchComC, u%BlPitchCom(1), ary) + call MV_Pack(p%Vars%u, p%iVarPlatformPtMesh, u%PlatformPtMesh, Ary) + call MV_Pack(p%Vars%u, p%iVarTowerPtLoads, u%TowerPtLoads, Ary) + call MV_Pack(p%Vars%u, p%iVarHubPtLoad, u%HubPtLoad, Ary) + call MV_Pack(p%Vars%u, p%iVarNacelleLoads, u%NacelleLoads, Ary) + call MV_Pack(p%Vars%u, p%iVarBlPitchCom, u%BlPitchCom, Ary) + call MV_Pack(p%Vars%u, p%iVarYawMom, u%YawMom, Ary) + call MV_Pack(p%Vars%u, p%iVarGenTrq, u%GenTrq, Ary) + call MV_Pack(p%Vars%u, p%iVarBlPitchComC, u%BlPitchCom(1), Ary) end subroutine -subroutine ED_UnpackInputValues(p, ary, u) +subroutine ED_UnpackInputValues(p, Ary, u) type(ED_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: ary(:) + real(R8Ki), intent(in) :: Ary(:) type(ED_InputType), intent(inout) :: u integer(IntKi) :: i if (allocated(u%BladePtLoads)) then do i = 1, size(u%BladePtLoads) - call MV_Unpack(p%Vars%u, p%iVarBladePtLoads(i), ary, u%BladePtLoads(i)) + call MV_Unpack(p%Vars%u, p%iVarBladePtLoads(i), Ary, u%BladePtLoads(i)) end do end if - call MV_Unpack(p%Vars%u, p%iVarPlatformPtMesh, ary, u%PlatformPtMesh) - call MV_Unpack(p%Vars%u, p%iVarTowerPtLoads, ary, u%TowerPtLoads) - call MV_Unpack(p%Vars%u, p%iVarHubPtLoad, ary, u%HubPtLoad) - call MV_Unpack(p%Vars%u, p%iVarNacelleLoads, ary, u%NacelleLoads) - call MV_Unpack(p%Vars%u, p%iVarBlPitchCom, ary, u%BlPitchCom) - call MV_Unpack(p%Vars%u, p%iVarYawMom, ary, u%YawMom) - call MV_Unpack(p%Vars%u, p%iVarGenTrq, ary, u%GenTrq) + call MV_Unpack(p%Vars%u, p%iVarPlatformPtMesh, Ary, u%PlatformPtMesh) + call MV_Unpack(p%Vars%u, p%iVarTowerPtLoads, Ary, u%TowerPtLoads) + call MV_Unpack(p%Vars%u, p%iVarHubPtLoad, Ary, u%HubPtLoad) + call MV_Unpack(p%Vars%u, p%iVarNacelleLoads, Ary, u%NacelleLoads) + call MV_Unpack(p%Vars%u, p%iVarBlPitchCom, Ary, u%BlPitchCom) + call MV_Unpack(p%Vars%u, p%iVarYawMom, Ary, u%YawMom) + call MV_Unpack(p%Vars%u, p%iVarGenTrq, Ary, u%GenTrq) end subroutine -subroutine ED_PackOutputValues(p, y, ary) +subroutine ED_PackOutputValues(p, y, Ary, PackOut) type(ED_ParameterType), intent(in) :: p type(ED_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: ary(:) + real(R8Ki), intent(out) :: Ary(:) + logical, intent(in) :: PackOut integer(IntKi) :: i if (allocated(y%BladeLn2Mesh)) then do i = 1, size(y%BladeLn2Mesh) - call MV_Pack(p%Vars%y, p%iVarBladeMotion(i), y%BladeLn2Mesh(i), ary) + call MV_Pack(p%Vars%y, p%iVarBladeMotion(i), y%BladeLn2Mesh(i), Ary) end do end if - call MV_Pack(p%Vars%y, p%iVarPlatformMotion, y%PlatformPtMesh, ary) - call MV_Pack(p%Vars%y, p%iVarTowerMotion, y%TowerLn2Mesh, ary) - call MV_Pack(p%Vars%y, p%iVarHubMotion, y%HubPtMotion, ary) + call MV_Pack(p%Vars%y, p%iVarPlatformMotion, y%PlatformPtMesh, Ary) + call MV_Pack(p%Vars%y, p%iVarTowerMotion, y%TowerLn2Mesh, Ary) + call MV_Pack(p%Vars%y, p%iVarHubMotion, y%HubPtMotion, Ary) if (allocated(y%BladeRootMotion)) then do i = 1, size(y%BladeRootMotion) - call MV_Pack(p%Vars%y, p%iVarBladeRootMotion(i), y%BladeRootMotion(i), ary) + call MV_Pack(p%Vars%y, p%iVarBladeRootMotion(i), y%BladeRootMotion(i), Ary) + end do + end if + call MV_Pack(p%Vars%y, p%iVarNacelleMotion, y%NacelleMotion, Ary) + call MV_Pack(p%Vars%y, p%iVarYaw, y%Yaw, Ary) + call MV_Pack(p%Vars%y, p%iVarYawRate, y%YawRate, Ary) + call MV_Pack(p%Vars%y, p%iVarHSS_Spd, y%HSS_Spd, Ary) + if (PackOut) then + do i = p%iVarOutput, size(p%Vars%y) + call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) end do end if - call MV_Pack(p%Vars%y, p%iVarNacelleMotion, y%NacelleMotion, ary) - call MV_Pack(p%Vars%y, p%iVarYaw, y%Yaw, ary) - call MV_Pack(p%Vars%y, p%iVarYawRate, y%YawRate, ary) - call MV_Pack(p%Vars%y, p%iVarHSS_Spd, y%HSS_Spd, ary) - do i = p%iVarOutput, size(p%Vars%y) - call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), ary) - end do end subroutine END MODULE ElastoDyn diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 94b9eea8e6..e9868018e6 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -518,8 +518,7 @@ typedef ^ OtherStateType IntKi SgnLSTQ {ED_NMX} - - "history of sign of LSTQ" # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ParameterType ModIdxType IdxAeroMap - - - "Module variable index for AeroMap" -typedef ^ ParameterType ModIdxType IdxSolver - - - "Module variable index for Solver" +typedef ^ ParameterType VarsIdxType IdxAeroMap - - - "Module variable index for AeroMap" typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi DT24 - - - "=DT/24 (used in loose coupling)" seconds typedef ^ ParameterType IntKi BldNodes - - - "Number of blade nodes used in the analysis" - diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index da7cb785e2..21895dc666 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -525,8 +525,7 @@ MODULE ElastoDyn_Types ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - TYPE(ModIdxType) :: IdxAeroMap !< Module variable index for AeroMap [-] - TYPE(ModIdxType) :: IdxSolver !< Module variable index for Solver [-] + TYPE(VarsIdxType) :: IdxAeroMap !< Module variable index for AeroMap [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] REAL(DbKi) :: DT24 = 0.0_R8Ki !< =DT/24 (used in loose coupling) [seconds] INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] @@ -4824,10 +4823,7 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - call NWTC_Library_CopyModIdxType(SrcParamData%IdxAeroMap, DstParamData%IdxAeroMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyModIdxType(SrcParamData%IdxSolver, DstParamData%IdxSolver, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyVarsIdxType(SrcParamData%IdxAeroMap, DstParamData%IdxAeroMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstParamData%DT = SrcParamData%DT @@ -5773,9 +5769,7 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Vars) ParamData%Vars => null() end if - call NWTC_Library_DestroyModIdxType(ParamData%IdxAeroMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyModIdxType(ParamData%IdxSolver, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyVarsIdxType(ParamData%IdxAeroMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%PH)) then deallocate(ParamData%PH) @@ -5991,8 +5985,7 @@ subroutine ED_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call NWTC_Library_PackModIdxType(RF, InData%IdxAeroMap) - call NWTC_Library_PackModIdxType(RF, InData%IdxSolver) + call NWTC_Library_PackVarsIdxType(RF, InData%IdxAeroMap) call RegPack(RF, InData%DT) call RegPack(RF, InData%DT24) call RegPack(RF, InData%BldNodes) @@ -6284,8 +6277,7 @@ subroutine ED_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call NWTC_Library_UnpackModIdxType(RF, OutData%IdxAeroMap) ! IdxAeroMap - call NWTC_Library_UnpackModIdxType(RF, OutData%IdxSolver) ! IdxSolver + call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxAeroMap) ! IdxAeroMap call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT24); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 5568a5e376..723103cae3 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -452,7 +452,6 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) real(R8Ki), intent(in) :: BaseAry(:) real(R8Ki), intent(inout) :: PerturbAry(:) - integer(IntKi) :: iAry real(R8Ki) :: Perturb real(R8Ki) :: WM(3), rotvec(3) integer(IntKi) :: i, j @@ -461,21 +460,21 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) PerturbAry = BaseAry ! Get variable perturbation and combine with sign - Perturb = Var%Perturb*real(PerturbSign, R8Ki) + Perturb = Var%Perturb*real(PerturbSign, R8Ki) - ! Perturbation index within array - iAry = Var%iLoc(1) + iLin - 1 + ! Index of perturbation value in array + i = Var%iLoc(1) + iLin - 1 ! If variable field is orientation, perturbation is in WM parameters if (Var%Field == VF_Orientation) then j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) - i = iLin - j ! index of start of WM parameters (3) rotvec = 0.0_R8Ki ! Init WM perturbation to zero rotvec(j + 1) = Perturb ! WM perturbation around X,Y,Z axis + i = i - j ! index of start of WM parameters (3) WM = PerturbAry(i:i + 2) ! Current WM parameters value - PerturbAry(i:i + 2) = wm_compose(WM, wm_from_rvec(rotvec)) ! Compose value and perturbation + PerturbAry(i:i + 2) = wm_compose(WM, wm_from_rvec(rotvec)) ! Compose value and perturbation else - PerturbAry(iAry) = PerturbAry(iAry) + Perturb + PerturbAry(i) = PerturbAry(i) + Perturb ! Add perturbation end if end subroutine @@ -794,7 +793,7 @@ logical function Failed() subroutine MV_InitVarIdx(Vars, Idx, FlagFilter, ErrStat, ErrMsg) type(ModVarsType), intent(in) :: Vars - type(ModIdxType), intent(out) :: Idx + type(VarsIdxType), intent(out) :: Idx integer(IntKi), intent(in) :: FlagFilter integer(IntKi), intent(out) :: ErrStat character(ErrMsgLen), intent(out) :: ErrMsg diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 52d9c95c9d..0166ced4d9 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -123,20 +123,8 @@ MODULE NWTC_Library_Types character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType ! ======================= -! ========= ModVarsType ======= - TYPE, PUBLIC :: ModVarsType - INTEGER(IntKi) :: ModNum = 0 !< [-] - character(6) :: ModAbbr !< [-] - TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] - TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] - TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] - INTEGER(IntKi) :: Nx = 0_IntKi !< [-] - INTEGER(IntKi) :: Nu = 0_IntKi !< [-] - INTEGER(IntKi) :: Ny = 0_IntKi !< [-] - END TYPE ModVarsType -! ======================= -! ========= ModIdxType ======= - TYPE, PUBLIC :: ModIdxType +! ========= VarsIdxType ======= + TYPE, PUBLIC :: VarsIdxType INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] INTEGER(IntKi) :: Nx = 0_IntKi !< [-] INTEGER(IntKi) :: Nu = 0_IntKi !< [-] @@ -145,7 +133,18 @@ MODULE NWTC_Library_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: idx !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iu !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iy !< [-] - END TYPE ModIdxType + END TYPE VarsIdxType +! ======================= +! ========= ModVarsType ======= + TYPE, PUBLIC :: ModVarsType + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] + TYPE(VarsIdxType) :: SolverIdx !< [-] + END TYPE ModVarsType ! ======================= ! ========= ModLinType ======= TYPE, PUBLIC :: ModLinType @@ -692,6 +691,126 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) call RegUnpackAlloc(RF, OutData%LinNames); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine NWTC_Library_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarsIdxType), intent(in) :: SrcVarsIdxTypeData + type(VarsIdxType), intent(inout) :: DstVarsIdxTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyVarsIdxType' + ErrStat = ErrID_None + ErrMsg = '' + DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter + DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx + DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu + DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny + if (allocated(SrcVarsIdxTypeData%ix)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%ix, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%ix, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%ix)) then + allocate(DstVarsIdxTypeData%ix(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%ix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarsIdxTypeData%ix = SrcVarsIdxTypeData%ix + end if + if (allocated(SrcVarsIdxTypeData%idx)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%idx, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%idx, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%idx)) then + allocate(DstVarsIdxTypeData%idx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%idx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarsIdxTypeData%idx = SrcVarsIdxTypeData%idx + end if + if (allocated(SrcVarsIdxTypeData%iu)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%iu, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%iu, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%iu)) then + allocate(DstVarsIdxTypeData%iu(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarsIdxTypeData%iu = SrcVarsIdxTypeData%iu + end if + if (allocated(SrcVarsIdxTypeData%iy)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%iy, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%iy, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%iy)) then + allocate(DstVarsIdxTypeData%iy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarsIdxTypeData%iy = SrcVarsIdxTypeData%iy + end if +end subroutine + +subroutine NWTC_Library_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) + type(VarsIdxType), intent(inout) :: VarsIdxTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyVarsIdxType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VarsIdxTypeData%ix)) then + deallocate(VarsIdxTypeData%ix) + end if + if (allocated(VarsIdxTypeData%idx)) then + deallocate(VarsIdxTypeData%idx) + end if + if (allocated(VarsIdxTypeData%iu)) then + deallocate(VarsIdxTypeData%iu) + end if + if (allocated(VarsIdxTypeData%iy)) then + deallocate(VarsIdxTypeData%iy) + end if +end subroutine + +subroutine NWTC_Library_PackVarsIdxType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarsIdxType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackVarsIdxType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FlagFilter) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) + call RegPackAlloc(RF, InData%ix) + call RegPackAlloc(RF, InData%idx) + call RegPackAlloc(RF, InData%iu) + call RegPackAlloc(RF, InData%iy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackVarsIdxType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarsIdxType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackVarsIdxType' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, CtrlCode, ErrStat, ErrMsg) type(ModVarsType), intent(in) :: SrcModVarsTypeData type(ModVarsType), intent(inout) :: DstModVarsTypeData @@ -705,8 +824,9 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarsType' ErrStat = ErrID_None ErrMsg = '' - DstModVarsTypeData%ModNum = SrcModVarsTypeData%ModNum - DstModVarsTypeData%ModAbbr = SrcModVarsTypeData%ModAbbr + DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx + DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu + DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny if (allocated(SrcModVarsTypeData%x)) then LB(1:1) = lbound(SrcModVarsTypeData%x, kind=B8Ki) UB(1:1) = ubound(SrcModVarsTypeData%x, kind=B8Ki) @@ -755,9 +875,9 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (ErrStat >= AbortErrLev) return end do end if - DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx - DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu - DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny + call NWTC_Library_CopyVarsIdxType(SrcModVarsTypeData%SolverIdx, DstModVarsTypeData%SolverIdx, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) @@ -798,6 +918,8 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) end do deallocate(ModVarsTypeData%y) end if + call NWTC_Library_DestroyVarsIdxType(ModVarsTypeData%SolverIdx, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine NWTC_Library_PackModVarsType(RF, Indata) @@ -807,8 +929,9 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%ModNum) - call RegPack(RF, InData%ModAbbr) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) @@ -836,9 +959,7 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) call NWTC_Library_PackModVarType(RF, InData%y(i1)) end do end if - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nu) - call RegPack(RF, InData%Ny) + call NWTC_Library_PackVarsIdxType(RF, InData%SolverIdx) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -851,8 +972,9 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%ModNum); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ModAbbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -892,129 +1014,7 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) call NWTC_Library_UnpackModVarType(RF, OutData%y(i1)) ! y end do end if - call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine NWTC_Library_CopyModIdxType(SrcModIdxTypeData, DstModIdxTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModIdxType), intent(in) :: SrcModIdxTypeData - type(ModIdxType), intent(inout) :: DstModIdxTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyModIdxType' - ErrStat = ErrID_None - ErrMsg = '' - DstModIdxTypeData%FlagFilter = SrcModIdxTypeData%FlagFilter - DstModIdxTypeData%Nx = SrcModIdxTypeData%Nx - DstModIdxTypeData%Nu = SrcModIdxTypeData%Nu - DstModIdxTypeData%Ny = SrcModIdxTypeData%Ny - if (allocated(SrcModIdxTypeData%ix)) then - LB(1:1) = lbound(SrcModIdxTypeData%ix, kind=B8Ki) - UB(1:1) = ubound(SrcModIdxTypeData%ix, kind=B8Ki) - if (.not. allocated(DstModIdxTypeData%ix)) then - allocate(DstModIdxTypeData%ix(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModIdxTypeData%ix.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModIdxTypeData%ix = SrcModIdxTypeData%ix - end if - if (allocated(SrcModIdxTypeData%idx)) then - LB(1:1) = lbound(SrcModIdxTypeData%idx, kind=B8Ki) - UB(1:1) = ubound(SrcModIdxTypeData%idx, kind=B8Ki) - if (.not. allocated(DstModIdxTypeData%idx)) then - allocate(DstModIdxTypeData%idx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModIdxTypeData%idx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModIdxTypeData%idx = SrcModIdxTypeData%idx - end if - if (allocated(SrcModIdxTypeData%iu)) then - LB(1:1) = lbound(SrcModIdxTypeData%iu, kind=B8Ki) - UB(1:1) = ubound(SrcModIdxTypeData%iu, kind=B8Ki) - if (.not. allocated(DstModIdxTypeData%iu)) then - allocate(DstModIdxTypeData%iu(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModIdxTypeData%iu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModIdxTypeData%iu = SrcModIdxTypeData%iu - end if - if (allocated(SrcModIdxTypeData%iy)) then - LB(1:1) = lbound(SrcModIdxTypeData%iy, kind=B8Ki) - UB(1:1) = ubound(SrcModIdxTypeData%iy, kind=B8Ki) - if (.not. allocated(DstModIdxTypeData%iy)) then - allocate(DstModIdxTypeData%iy(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModIdxTypeData%iy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModIdxTypeData%iy = SrcModIdxTypeData%iy - end if -end subroutine - -subroutine NWTC_Library_DestroyModIdxType(ModIdxTypeData, ErrStat, ErrMsg) - type(ModIdxType), intent(inout) :: ModIdxTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModIdxType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ModIdxTypeData%ix)) then - deallocate(ModIdxTypeData%ix) - end if - if (allocated(ModIdxTypeData%idx)) then - deallocate(ModIdxTypeData%idx) - end if - if (allocated(ModIdxTypeData%iu)) then - deallocate(ModIdxTypeData%iu) - end if - if (allocated(ModIdxTypeData%iy)) then - deallocate(ModIdxTypeData%iy) - end if -end subroutine - -subroutine NWTC_Library_PackModIdxType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ModIdxType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackModIdxType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%FlagFilter) - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nu) - call RegPack(RF, InData%Ny) - call RegPackAlloc(RF, InData%ix) - call RegPackAlloc(RF, InData%idx) - call RegPackAlloc(RF, InData%iu) - call RegPackAlloc(RF, InData%iy) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackModIdxType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ModIdxType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModIdxType' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ix); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%idx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iy); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackVarsIdxType(RF, OutData%SolverIdx) ! SolverIdx end subroutine subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 2bb5ce5c92..29ccee5fc0 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -82,16 +82,7 @@ typedef ^ ^ IntKi MeshID - 0 - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - -typedef ^ ModVarsType IntKi ModNum - 0 - "" - -typedef ^ ^ character(6) ModAbbr - - - "" - -typedef ^ ^ ModVarType x : - - "Module state variable array" - -typedef ^ ^ ModVarType u : - - "Module input variable array" - -typedef ^ ^ ModVarType y : - - "Module output variable array" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - - -typedef ^ ModIdxType IntKi FlagFilter - - - "" - +typedef ^ VarsIdxType IntKi FlagFilter - - - "" - typedef ^ ^ IntKi Nx - - - "" - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - @@ -100,6 +91,14 @@ typedef ^ ^ IntKi idx : - - typedef ^ ^ IntKi iu : - - "" - typedef ^ ^ IntKi iy : - - "" - +typedef ^ ModVarsType IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ VarsIdxType SolverIdx - - - "" - + typedef ^ ModLinType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - typedef ^ ^ R8Ki u : - - "" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index ce7aa35472..37bf4fe33f 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -82,16 +82,7 @@ typedef ^ ^ IntKi MeshID - 0 - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - -typedef ^ ModVarsType IntKi ModNum - 0 - "" - -typedef ^ ^ character(6) ModAbbr - - - "" - -typedef ^ ^ ModVarType x : - - "Module state variable array" - -typedef ^ ^ ModVarType u : - - "Module input variable array" - -typedef ^ ^ ModVarType y : - - "Module output variable array" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - - -typedef ^ ModIdxType IntKi FlagFilter - - - "" - +typedef ^ VarsIdxType IntKi FlagFilter - - - "" - typedef ^ ^ IntKi Nx - - - "" - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - @@ -100,6 +91,14 @@ typedef ^ ^ IntKi idx : - - typedef ^ ^ IntKi iu : - - "" - typedef ^ ^ IntKi iy : - - "" - +typedef ^ ModVarsType IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ VarsIdxType SolverIdx - - - "" - + typedef ^ ModLinType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - typedef ^ ^ R8Ki u : - - "" - diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 468db83bd2..8c91825ca4 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -679,9 +679,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ! get the jacobians call BD_JacobianPInput( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & - dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & - StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & - StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) + dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call BD_JacobianPContState( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & @@ -1191,10 +1189,6 @@ SUBROUTINE WrLinFile_txt_End(Un, p_FAST, LinData) ! StateRotation matrix if (allocated(LinData%StateRotation)) call WrPartialMatrix( LinData%StateRotation, Un, p_FAST%OutFmt, 'StateRotation' ) - ! RelState matrices - if (allocated(LinData%StateRel_x)) call WrPartialMatrix( LinData%StateRel_x, Un, p_FAST%OutFmt, 'State_Rel_x' ) - if (allocated(LinData%StateRel_xdot)) call WrPartialMatrix( LinData%StateRel_xdot, Un, p_FAST%OutFmt, 'State_Rel_xdot' ) - close(Un) Un = -1 @@ -1233,13 +1227,6 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, ModuleID, rotFrame real(R8Ki) :: DCM(3,3) integer(IntKi) :: row - select case (ModuleID) - case (Module_ED) - UsesWM = .true. - case default - UsesWM = .false. - end select - if (present(deriv) ) then UseDerivNames = deriv else @@ -1291,8 +1278,9 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, ModuleID, rotFrame select case (ModuleID) case (Module_Glue) - UsesWM = index(names(i), "ED") == 1 - case (Module_ED) + UsesWM = (index(names(i), "ED") == 1) .or. & + (index(names(i), "BD") == 1) + case (Module_ED, Module_BD) UsesWM = .true. case default UsesWM = .false. diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 183353d1ec..90ee44f2af 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -332,8 +332,6 @@ typedef ^ FAST_LinType R8Ki B {:}{:} - - "B matrix" typedef ^ FAST_LinType R8Ki C {:}{:} - - "C matrix" typedef ^ FAST_LinType R8Ki D {:}{:} - - "D matrix" typedef ^ FAST_LinType R8Ki StateRotation {:}{:} - - "Matrix that rotates the continuous states" -typedef ^ FAST_LinType R8Ki StateRel_x {:}{:} - - "Matrix that defines the continuous states relative to root motion" -typedef ^ FAST_LinType R8Ki StateRel_xdot {:}{:} - - "Matrix that defines the continuous states relative to root motion" typedef ^ FAST_LinType Logical IsLoad_u {:} - - "Whether the input is a load (used for scaling for potentially ill-conditioned G matrix)" typedef ^ FAST_LinType Logical RotFrame_u {:} - - "Whether corresponding input is in rotating frame" typedef ^ FAST_LinType Logical RotFrame_y {:} - - "Whether corresponding output is in rotating frame" diff --git a/modules/openfast-library/src/FAST_SS_Solver.f90 b/modules/openfast-library/src/FAST_SS_Solver.f90 index db9f616950..220e536cb7 100644 --- a/modules/openfast-library/src/FAST_SS_Solver.f90 +++ b/modules/openfast-library/src/FAST_SS_Solver.f90 @@ -1370,9 +1370,7 @@ SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD ! get the jacobians call BD_JacobianPInput( SS_t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & - dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & - StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & - StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) + dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call BD_JacobianPContState( SS_t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index b04269cff9..6cc964c930 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -325,8 +325,6 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: D !< D matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< Matrix that rotates the continuous states [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRel_x !< Matrix that defines the continuous states relative to root motion [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRel_xdot !< Matrix that defines the continuous states relative to root motion [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Whether the input is a load (used for scaling for potentially ill-conditioned G matrix) [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Whether corresponding input is in rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Whether corresponding output is in rotating frame [-] @@ -5159,30 +5157,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation end if - if (allocated(SrcLinTypeData%StateRel_x)) then - LB(1:2) = lbound(SrcLinTypeData%StateRel_x, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%StateRel_x, kind=B8Ki) - if (.not. allocated(DstLinTypeData%StateRel_x)) then - allocate(DstLinTypeData%StateRel_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x - end if - if (allocated(SrcLinTypeData%StateRel_xdot)) then - LB(1:2) = lbound(SrcLinTypeData%StateRel_xdot, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%StateRel_xdot, kind=B8Ki) - if (.not. allocated(DstLinTypeData%StateRel_xdot)) then - allocate(DstLinTypeData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot - end if if (allocated(SrcLinTypeData%IsLoad_u)) then LB(1:1) = lbound(SrcLinTypeData%IsLoad_u, kind=B8Ki) UB(1:1) = ubound(SrcLinTypeData%IsLoad_u, kind=B8Ki) @@ -5327,12 +5301,6 @@ subroutine FAST_DestroyLinType(LinTypeData, ErrStat, ErrMsg) if (allocated(LinTypeData%StateRotation)) then deallocate(LinTypeData%StateRotation) end if - if (allocated(LinTypeData%StateRel_x)) then - deallocate(LinTypeData%StateRel_x) - end if - if (allocated(LinTypeData%StateRel_xdot)) then - deallocate(LinTypeData%StateRel_xdot) - end if if (allocated(LinTypeData%IsLoad_u)) then deallocate(LinTypeData%IsLoad_u) end if @@ -5378,8 +5346,6 @@ subroutine FAST_PackLinType(RF, Indata) call RegPackAlloc(RF, InData%C) call RegPackAlloc(RF, InData%D) call RegPackAlloc(RF, InData%StateRotation) - call RegPackAlloc(RF, InData%StateRel_x) - call RegPackAlloc(RF, InData%StateRel_xdot) call RegPackAlloc(RF, InData%IsLoad_u) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%RotFrame_y) @@ -5420,8 +5386,6 @@ subroutine FAST_UnPackLinType(RF, OutData) call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%D); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StateRel_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StateRel_xdot); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return From 1b5935608a05a66b83ea6f59b2af0b6156e0f909 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 15:12:19 +0000 Subject: [PATCH 043/319] Update BeamDyn_Types after rebase --- modules/beamdyn/src/BeamDyn_Types.f90 | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index a0c7184a2b..91a92f7bd9 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -62,8 +62,6 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] - INTEGER(IntKi) :: kp_total = 0_IntKi !< Total number of key points [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -463,19 +461,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%Vars => SrcInitOutputData%Vars - if (allocated(SrcInitOutputData%kp_coordinate)) then - LB(1:2) = lbound(SrcInitOutputData%kp_coordinate, kind=B8Ki) - UB(1:2) = ubound(SrcInitOutputData%kp_coordinate, kind=B8Ki) - if (.not. allocated(DstInitOutputData%kp_coordinate)) then - allocate(DstInitOutputData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%kp_coordinate.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate - end if - DstInitOutputData%kp_total = SrcInitOutputData%kp_total if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) @@ -592,9 +577,6 @@ subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%Vars) - if (allocated(InitOutputData%kp_coordinate)) then - deallocate(InitOutputData%kp_coordinate) - end if if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -637,8 +619,6 @@ subroutine BD_PackInitOutput(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPackAlloc(RF, InData%kp_coordinate) - call RegPack(RF, InData%kp_total) call RegPackAlloc(RF, InData%LinNames_y) call RegPackAlloc(RF, InData%LinNames_x) call RegPackAlloc(RF, InData%LinNames_u) @@ -681,8 +661,6 @@ subroutine BD_UnPackInitOutput(RF, OutData) else OutData%Vars => null() end if - call RegUnpackAlloc(RF, OutData%kp_coordinate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%kp_total); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return From e4ab51c2cc353739b4bcbe7bf48fd4b7ceac2b06 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 26 Jan 2024 19:05:38 +0000 Subject: [PATCH 044/319] Fix single precision build --- modules/nwtc-library/src/ModVar.f90 | 8 ++++---- modules/openfast-library/src/FAST_Lin.f90 | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 723103cae3..2b8a22cad4 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -340,16 +340,16 @@ subroutine MV_PackVarR8Ary(VarAry, iVar, Vals, Ary) subroutine MV_UnpackVarR4(VarAry, iVar, Ary, Val) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar - real(R4Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Val + real(R8Ki), intent(in) :: Ary(:) + real(R4Ki), intent(inout) :: Val Val = Ary(VarAry(iVar)%iLoc(1)) end subroutine subroutine MV_UnpackVarR4Ary(VarAry, iVar, Ary, Vals) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar - real(R4Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:) + real(R8Ki), intent(in) :: Ary(:) + real(R4Ki), intent(inout) :: Vals(:) associate (iLoc => VarAry(iVar)%iLoc) Vals = real(Ary(iLoc(1):iLoc(2)), R4Ki) end associate diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 8c91825ca4..88d3a22489 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -1290,13 +1290,13 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, ModuleID, rotFrame if (UsesWM) then if (UseThisCol) then if (index(names(i), ' X orientation angle, node ') > 0) then - DCM = wm_to_dcm(op(i_op:i_op+2)) + DCM = wm_to_dcm(real(op(i_op:i_op+2), R8Ki)) row = 1 else if (index(names(i), ' Y orientation angle, node ') > 0) then - DCM = wm_to_dcm(op(i_op-1:i_op+1)) + DCM = wm_to_dcm(real(op(i_op-1:i_op+1), R8Ki)) row = 2 else if (index(names(i), ' Z orientation angle, node ') > 0) then - DCM = wm_to_dcm(op(i_op-2:i_op)) + DCM = wm_to_dcm(real(op(i_op-2:i_op), R8Ki)) row = 3 end if WRITE(Un, FmtOrient) i_print, dcm(row, 1), dcm(row, 2), dcm(row, 3), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] From fd133c1592efb40a4952da266734b7ad9edbc591 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 29 Jan 2024 17:42:26 +0000 Subject: [PATCH 045/319] ModVar: fix rotation perturbation/diff order --- modules/nwtc-library/src/ModVar.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 2b8a22cad4..9e2d5ee4fe 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -472,7 +472,7 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) rotvec(j + 1) = Perturb ! WM perturbation around X,Y,Z axis i = i - j ! index of start of WM parameters (3) WM = PerturbAry(i:i + 2) ! Current WM parameters value - PerturbAry(i:i + 2) = wm_compose(WM, wm_from_rvec(rotvec)) ! Compose value and perturbation + PerturbAry(i:i + 2) = wm_compose(wm_from_rvec(rotvec), WM) ! Compose value and perturbation else PerturbAry(i) = PerturbAry(i) + Perturb ! Add perturbation end if @@ -485,7 +485,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) real(R8Ki), intent(in) :: NegAry(:) ! Negative result array real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference integer(IntKi) :: i, j, k - real(R8Ki) :: DeltaWM(3) + real(R8Ki) :: DeltaWM(3), R(3,3), C1(3), C2(3) ! Loop through variables do i = 1, size(VarAry) @@ -500,7 +500,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) k = VarAry(i)%iLoc(1) + 3*(j - 1) ! Compose WM parameters to go from negative to positive array - DeltaWM = wm_compose(PosAry(k:k + 2), wm_inv(NegAry(k:k + 2))) + DeltaWM = wm_compose((PosAry(k:k + 2)), wm_inv(NegAry(k:k + 2))) ! Calculate change in rotation in XYZ in radians DiffAry(k:k + 2) = wm_to_rvec(DeltaWM) @@ -1002,19 +1002,19 @@ pure function wm_to_dcm(c) result(R) ! end do end function -pure function wm_from_dcm(R) result(c) - real(R8Ki), intent(in) :: R(3, 3) +pure function wm_from_dcm(dcm) result(c) + real(R8Ki), intent(in) :: dcm(3, 3) real(R8Ki) :: pivot(4) ! Trace of the rotation matrix and diagonal elements real(R8Ki) :: sm(0:3) real(R8Ki) :: em real(R8Ki) :: Rr(3, 3), c(3) integer :: i ! case indicator - Rr = transpose(R) + Rr = transpose(dcm) ! mjs--find max value of T := Tr(Rr) and diagonal elements of Rr ! This tells us which denominator is largest (and less likely to produce numerical noise) - pivot = (/Rr(1, 1) + Rr(2, 2) + Rr(3, 3), Rr(1, 1), Rr(2, 2), Rr(3, 3)/) + pivot = [Rr(1, 1) + Rr(2, 2) + Rr(3, 3), Rr(1, 1), Rr(2, 2), Rr(3, 3)] i = maxloc(pivot, 1) - 1 ! our sm array starts at 0, so we need to subtract 1 here to get the correct index select case (i) From 009f28a90d344688da2d7a22ac734134a8a9da2f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 29 Jan 2024 17:43:39 +0000 Subject: [PATCH 046/319] BD: apply rotate states before copying to output matrix --- modules/beamdyn/src/BeamDyn.f90 | 53 +++++++++++++++++---------------- 1 file changed, 28 insertions(+), 25 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 1222cc40f9..e733c7c1aa 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -6249,19 +6249,21 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end do end do + ! If rotate states is enabled, modify Jacobian + if (p%RotStates) then + RotateStates = matmul(u%RootMotion%Orientation(:,:,1), transpose(u%RootMotion%RefOrientation(:,:,1))) + do i=1,size(m%Lin%dXdu,1),3 + m%Lin%dXdu(i:i+2, :) = matmul(RotateStates, m%Lin%dXdu(i:i+2, :)) + end do + end if + ! If ModIdx is present, copy subset of Jacobian to output if (present(ModIdx)) then - dXdu = m%Lin%dXdu(ModIdx%iy, ModIdx%iu) + dXdu = m%Lin%dXdu(ModIdx%ix, ModIdx%iu) else dXdu = m%Lin%dXdu end if - - if (p%RotStates) then - RotateStates = matmul( u%RootMotion%Orientation(:,:,1), transpose( u%RootMotion%RefOrientation(:,:,1) ) ) - do i=1,size(dXdu,1),3 - dXdu(i:i+2, :) = matmul( RotateStates, dXdu(i:i+2, :) ) - end do - end if + end if ! dXdu if (present(dXddu)) then @@ -6385,19 +6387,19 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end do end do + ! If rotate state is enabled, modify Jacobian + if (p%RotStates) then + do i=1,size(m%Lin%dYdx,2),3 + m%Lin%dYdx(:, i:i+2) = matmul( m%Lin%dYdx(:, i:i+2), RotateStatesTranspose) + end do + end if + ! If ModIdx is present, copy subset of Jacobian to output if (present(ModIdx)) then dYdx = m%Lin%dYdx(ModIdx%iy, ModIdx%ix) else dYdx = m%Lin%dYdx end if - - ! If rotate state is enabled, rotate - if (p%RotStates) then - do i=1,size(dYdx,2),3 - dYdx(:, i:i+2) = matmul( dYdx(:, i:i+2), RotateStatesTranspose) - end do - end if end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: @@ -6444,21 +6446,22 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end do end do + ! If rotate state is enabled, modify Jacobian + if (p%RotStates) then + do i=1,size(m%Lin%dXdx,1),3 + m%Lin%dXdx(i:i+2,:) = matmul(RotateStates, m%Lin%dXdx(i:i+2,:)) + end do + do i=1,size(m%Lin%dXdx,2),3 + m%Lin%dXdx(:, i:i+2) = matmul(m%Lin%dXdx(:, i:i+2), RotateStatesTranspose) + end do + end if + ! If ModIdx is present, copy subset of Jacobian to output if (present(ModIdx)) then dXdx = m%Lin%dXdx(ModIdx%idx, ModIdx%ix) else dXdx = m%Lin%dXdx end if - - if (p%RotStates) then - do i=1,size(dXdx,1),3 - dXdx(i:i+2,:) = matmul(RotateStates, dXdx(i:i+2,:)) - end do - do i=1,size(dXdx,2),3 - dXdx(:, i:i+2) = matmul(dXdx(:, i:i+2), RotateStatesTranspose) - end do - end if end if IF ( PRESENT( dXddx ) ) THEN @@ -6646,7 +6649,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, ErrMsg = '' ! Set flag to pack write outputs - PackOut = .not. present(ModIdx) + PackOut = .true. ! If inputs requested if (present(u_op)) then From b549f9f8dec965ba40990c44d2bf57c6ab6ffab9 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 29 Jan 2024 17:48:57 +0000 Subject: [PATCH 047/319] ED/BD: change flag to CalcWriteOutput in Jacobian/OP routines --- modules/beamdyn/src/BeamDyn.f90 | 36 ++++++++++++++--------------- modules/elastodyn/src/ElastoDyn.f90 | 22 +++++++++--------- 2 files changed, 29 insertions(+), 29 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index e733c7c1aa..b636ee65f6 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -6082,15 +6082,15 @@ subroutine BD_UnpackInputValues(p, Ary, u) call MV_Unpack(p%Vars%u, p%iVarDistrLoad, Ary, u%DistrLoad) end subroutine -subroutine BD_PackOutputValues(p, y, Ary, PackOut) +subroutine BD_PackOutputValues(p, y, Ary, PackWriteOutput) type(BD_ParameterType), intent(in) :: p type(BD_OutputType), intent(in) :: y real(R8Ki), intent(out) :: Ary(:) - logical, intent(in) :: PackOut + logical, intent(in) :: PackWriteOutput integer(IntKi) :: i call MV_Pack(p%Vars%y, p%iVarReactionForce, y%ReactionForce, Ary) call MV_Pack(p%Vars%y, p%iVarBldMotion, y%BldMotion, Ary) - if (PackOut) then + if (PackWriteOutput) then do i = p%iVarWriteOutput, size(p%Vars%y) call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) end do @@ -6131,13 +6131,13 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM character(ErrMsgLen) :: ErrMsg2 INTEGER(IntKi) :: i, j, col REAL(R8Ki) :: RotateStates(3,3) - logical :: PackOut + logical :: CalcWriteOutput ErrStat = ErrID_None ErrMsg = '' ! Set flag to pack write outputs - PackOut = .not. present(ModIdx) + CalcWriteOutput = .not. present(ModIdx) ! Get OP values here call BD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if (Failed()) return @@ -6176,14 +6176,14 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=PackOut); if (Failed()) return - call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, PackOut) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=CalcWriteOutput); if (Failed()) return + call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, CalcWriteOutput) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=PackOut); if (Failed()) return - call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, PackOut) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=CalcWriteOutput); if (Failed()) return + call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, CalcWriteOutput) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -6313,13 +6313,13 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, INTEGER(IntKi) :: i, j, col REAL(R8Ki) :: RotateStates(3,3) REAL(R8Ki) :: RotateStatesTranspose(3,3) - logical :: PackOut + logical :: CalcWriteOutput ErrStat = ErrID_None ErrMsg = '' ! Set flag to pack write outputs - PackOut = .not. present(ModIdx) + CalcWriteOutput = .not. present(ModIdx) ! Copy state values call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -6370,14 +6370,14 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=PackOut); if (Failed()) return - call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, PackOut) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=CalcWriteOutput); if (Failed()) return + call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, CalcWriteOutput) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=PackOut); if (Failed()) return - call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, PackOut) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=CalcWriteOutput); if (Failed()) return + call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, CalcWriteOutput) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -6643,13 +6643,13 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' LOGICAL :: FieldMask(FIELDMASK_SIZE) LOGICAL :: ReturnTrimOP - logical :: PackOut + logical :: CalcWriteOutput ErrStat = ErrID_None ErrMsg = '' ! Set flag to pack write outputs - PackOut = .true. + CalcWriteOutput = .true. ! If inputs requested if (present(u_op)) then @@ -6695,7 +6695,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, if (Failed()) return end if - call BD_PackOutputValues(p, y, m%Lin%y, PackOut) + call BD_PackOutputValues(p, y, m%Lin%y, CalcWriteOutput) ! If ModIdx is present if (present(ModIdx)) then diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 9880e09288..b55a1d3da8 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -10385,7 +10385,7 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' integer(IntKi) :: i, j, col - logical :: PackOut + logical :: CalcWriteOutput ! Initialize ErrStat ErrStat = ErrID_None @@ -10393,7 +10393,7 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function ! Set flag to pack write outputs - PackOut = .not. present(ModIdx) + CalcWriteOutput = .not. present(ModIdx) ! Update copy of the inputs to perturb call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -10430,13 +10430,13 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, PackOut) + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, CalcWriteOutput) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, PackOut) + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, CalcWriteOutput) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -10582,7 +10582,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' INTEGER(IntKi) :: i, j, col - logical :: PackOut + logical :: CalcWriteOutput ! Initialize ErrStat ErrStat = ErrID_None @@ -10590,7 +10590,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function ! Set flag to pack write outputs - PackOut = .not. present(ModIdx) + CalcWriteOutput = .not. present(ModIdx) ! Copy state values call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -10624,13 +10624,13 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, PackOut) + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, CalcWriteOutput) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, PackOut) + call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, CalcWriteOutput) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -11555,11 +11555,11 @@ subroutine ED_UnpackInputValues(p, Ary, u) call MV_Unpack(p%Vars%u, p%iVarGenTrq, Ary, u%GenTrq) end subroutine -subroutine ED_PackOutputValues(p, y, Ary, PackOut) +subroutine ED_PackOutputValues(p, y, Ary, PackWriteOutput) type(ED_ParameterType), intent(in) :: p type(ED_OutputType), intent(in) :: y real(R8Ki), intent(out) :: Ary(:) - logical, intent(in) :: PackOut + logical, intent(in) :: PackWriteOutput integer(IntKi) :: i if (allocated(y%BladeLn2Mesh)) then do i = 1, size(y%BladeLn2Mesh) @@ -11578,7 +11578,7 @@ subroutine ED_PackOutputValues(p, y, Ary, PackOut) call MV_Pack(p%Vars%y, p%iVarYaw, y%Yaw, Ary) call MV_Pack(p%Vars%y, p%iVarYawRate, y%YawRate, Ary) call MV_Pack(p%Vars%y, p%iVarHSS_Spd, y%HSS_Spd, Ary) - if (PackOut) then + if (PackWriteOutput) then do i = p%iVarOutput, size(p%Vars%y) call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) end do From 770ebb79d3e42a85bd74b59110dec3bc7e74db50 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 8 Feb 2024 22:35:43 +0000 Subject: [PATCH 048/319] Added params and funds to access input/output meshes --- modules/aerodyn/src/AeroAcoustics_Types.f90 | 36 + modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 93 +- modules/aerodyn/src/AeroDyn_Registry.txt | 169 +- modules/aerodyn/src/AeroDyn_Types.f90 | 4529 +++++++++-------- modules/aerodyn/src/AirfoilInfo_Types.f90 | 42 +- modules/aerodyn/src/BEMT_Types.f90 | 50 +- modules/aerodyn/src/DBEMT_Types.f90 | 44 +- modules/aerodyn/src/FVW_Types.f90 | 45 +- modules/aerodyn/src/UnsteadyAero_Types.f90 | 50 +- modules/aerodyn14/src/AeroDyn14_Types.f90 | 56 + modules/aerodyn14/src/DWM_Types.f90 | 36 + modules/awae/src/AWAE_Types.f90 | 48 +- modules/beamdyn/src/BeamDyn_Types.f90 | 116 +- modules/beamdyn/src/Registry_BeamDyn.txt | 7 +- modules/elastodyn/src/ElastoDyn_Registry.txt | 9 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 169 +- .../src/ExternalInflow_Types.f90 | 36 + modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 46 + modules/feamooring/src/FEAMooring_Types.f90 | 56 + modules/hydrodyn/src/Conv_Radiation_Types.f90 | 36 + modules/hydrodyn/src/HydroDyn_Types.f90 | 80 +- modules/hydrodyn/src/Morison_Types.f90 | 51 + modules/hydrodyn/src/SS_Excitation_Types.f90 | 36 + modules/hydrodyn/src/SS_Radiation_Types.f90 | 36 + modules/hydrodyn/src/WAMIT2_Types.f90 | 25 +- modules/hydrodyn/src/WAMIT_Types.f90 | 46 + modules/icedyn/src/IceDyn_Types.f90 | 46 + modules/icefloe/src/icefloe/IceFloe_Types.f90 | 46 + .../inflowwind/src/IfW_FlowField_Types.f90 | 12 +- modules/inflowwind/src/InflowWind_Types.f90 | 60 +- modules/inflowwind/src/Lidar_Types.f90 | 44 +- modules/map/src/MAP_Types.f90 | 46 + modules/moordyn/src/MoorDyn_Types.f90 | 66 + .../nwtc-library/src/NWTC_Library_Types.f90 | 741 ++- .../src/Registry_NWTC_Library.txt | 67 +- .../src/Registry_NWTC_Library_base.txt | 67 +- .../src/Registry_NWTC_Library_mesh.txt | 1 - modules/openfast-library/src/FAST_Types.f90 | 1857 ++++++- modules/openfast-registry/src/registry.hpp | 50 + .../src/registry_gen_fortran.cpp | 68 +- .../openfast-registry/src/registry_parse.cpp | 39 + .../src/OrcaFlexInterface_Types.f90 | 46 + .../seastate/src/SeaSt_WaveField_Types.f90 | 39 +- modules/seastate/src/SeaState_Types.f90 | 36 + modules/servodyn/src/ServoDyn_Registry.txt | 52 +- modules/servodyn/src/ServoDyn_Types.f90 | 4021 ++++++++------- modules/servodyn/src/StrucCtrl_Types.f90 | 46 + modules/subdyn/src/SubDyn_Types.f90 | 61 + .../supercontroller/src/SCDataEx_Types.f90 | 36 + .../src/SuperController_Types.f90 | 36 + .../wakedynamics/src/WakeDynamics_Types.f90 | 50 +- 51 files changed, 9031 insertions(+), 4549 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 5829bb13f3..95bdda109b 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -2989,5 +2989,41 @@ subroutine AA_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputSep); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputNode); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function AA_InputMeshPointer(u, ML) result(Mesh) + type(AA_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function AA_InputMeshName(u, ML) result(Name) + type(AA_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function AA_OutputMeshPointer(y, ML) result(Mesh) + type(AA_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function AA_OutputMeshName(y, ML) result(Name) + type(AA_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 8d6ef20206..49fdd42ca4 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -34,7 +34,18 @@ MODULE AeroDyn_Inflow_Types USE AeroDyn_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_Version = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_Version = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_NacelleMotion = 1 ! Mesh number for ADI ADI_u_AD_rotors_NacelleMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_TowerMotion = 2 ! Mesh number for ADI ADI_u_AD_rotors_TowerMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_HubMotion = 3 ! Mesh number for ADI ADI_u_AD_rotors_HubMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_BladeRootMotion = 4 ! Mesh number for ADI ADI_u_AD_rotors_BladeRootMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_BladeMotion = 5 ! Mesh number for ADI ADI_u_AD_rotors_BladeMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_TFinMotion = 6 ! Mesh number for ADI ADI_u_AD_rotors_TFinMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_NacelleLoad = 7 ! Mesh number for ADI ADI_y_AD_rotors_NacelleLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_HubLoad = 8 ! Mesh number for ADI ADI_y_AD_rotors_HubLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_TowerLoad = 9 ! Mesh number for ADI ADI_y_AD_rotors_TowerLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_BladeLoad = 10 ! Mesh number for ADI ADI_y_AD_rotors_BladeLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_TFinLoad = 11 ! Mesh number for ADI ADI_y_AD_rotors_TFinLoad mesh [-] ! ========= ADI_InflowWindData ======= TYPE, PUBLIC :: ADI_InflowWindData TYPE(InflowWind_ContinuousStateType) :: x !< Continuous states [-] @@ -1749,5 +1760,85 @@ subroutine ADI_UnPackFED_Data(RF, OutData) end do end if end subroutine + +function ADI_InputMeshPointer(u, ML) result(Mesh) + type(ADI_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (ADI_u_AD_rotors_NacelleMotion) + Mesh => u%AD%rotors(ML%i1)%NacelleMotion + case (ADI_u_AD_rotors_TowerMotion) + Mesh => u%AD%rotors(ML%i1)%TowerMotion + case (ADI_u_AD_rotors_HubMotion) + Mesh => u%AD%rotors(ML%i1)%HubMotion + case (ADI_u_AD_rotors_BladeRootMotion) + Mesh => u%AD%rotors(ML%i1)%BladeRootMotion(ML%i2) + case (ADI_u_AD_rotors_BladeMotion) + Mesh => u%AD%rotors(ML%i1)%BladeMotion(ML%i2) + case (ADI_u_AD_rotors_TFinMotion) + Mesh => u%AD%rotors(ML%i1)%TFinMotion + end select +end function + +function ADI_InputMeshName(u, ML) result(Name) + type(ADI_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (ADI_u_AD_rotors_NacelleMotion) + Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%NacelleMotion" + case (ADI_u_AD_rotors_TowerMotion) + Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%TowerMotion" + case (ADI_u_AD_rotors_HubMotion) + Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%HubMotion" + case (ADI_u_AD_rotors_BladeRootMotion) + Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%BladeRootMotion("//trim(Num2LStr(ML%i2))//")" + case (ADI_u_AD_rotors_BladeMotion) + Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%BladeMotion("//trim(Num2LStr(ML%i2))//")" + case (ADI_u_AD_rotors_TFinMotion) + Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%TFinMotion" + end select +end function + +function ADI_OutputMeshPointer(y, ML) result(Mesh) + type(ADI_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (ADI_y_AD_rotors_NacelleLoad) + Mesh => y%AD%rotors(ML%i1)%NacelleLoad + case (ADI_y_AD_rotors_HubLoad) + Mesh => y%AD%rotors(ML%i1)%HubLoad + case (ADI_y_AD_rotors_TowerLoad) + Mesh => y%AD%rotors(ML%i1)%TowerLoad + case (ADI_y_AD_rotors_BladeLoad) + Mesh => y%AD%rotors(ML%i1)%BladeLoad(ML%i2) + case (ADI_y_AD_rotors_TFinLoad) + Mesh => y%AD%rotors(ML%i1)%TFinLoad + end select +end function + +function ADI_OutputMeshName(y, ML) result(Name) + type(ADI_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (ADI_y_AD_rotors_NacelleLoad) + Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%NacelleLoad" + case (ADI_y_AD_rotors_HubLoad) + Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%HubLoad" + case (ADI_y_AD_rotors_TowerLoad) + Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%TowerLoad" + case (ADI_y_AD_rotors_BladeLoad) + Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%BladeLoad("//trim(Num2LStr(ML%i2))//")" + case (ADI_y_AD_rotors_TFinLoad) + Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%TFinLoad" + end select +end function END MODULE AeroDyn_Inflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 618b6540d6..633bbba3f5 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -123,6 +123,7 @@ typedef ^ AD_BladePropsType ReKi BlCenBt {:} - - "Center of buoyancy typedef ^ AD_BladeShape SiKi AirfoilCoords {:}{:}{:} - - "x-y coordinates for airfoils, relative to node" m # Define outputs from the initialization routine here: +typedef ^ RotInitOutputType ModVarsType *Vars - - - "Module Variables" typedef ^ RotInitOutputType ReKi AirDens - - - "Air density" kg/m^3 typedef ^ RotInitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ RotInitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - @@ -257,82 +258,27 @@ typedef ^ OtherStateType FVW_OtherStateType FVW - - - "OtherStates from the FVW typedef ^ OtherStateType ReKi WakeLocationPoints {:}{:} - - "wake points velocity" m/s -# Define misc/optimization variables (any data that are not considered actual states) here: -typedef ^ RotMiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - -typedef ^ RotMiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - -typedef ^ RotMiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - -typedef ^ RotMiscVarType AA_MiscVarType AA - - - "MiscVars from the AA module" - -typedef ^ RotMiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - -typedef ^ RotMiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - - -typedef ^ RotMiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ RotMiscVarType R8Ki orientationAnnulus {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - -typedef ^ RotMiscVarType R8Ki R_li {:}{:}{:}{:} - - "Transformation matrix from inertial system to the staggered polar coordinate system of a given section" - -typedef ^ RotMiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - -typedef ^ RotMiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s -typedef ^ RotMiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s -typedef ^ RotMiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s -typedef ^ RotMiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possible output to file" rad -typedef ^ RotMiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m -typedef ^ RotMiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi Z {:}{:} - - "axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m -typedef ^ RotMiscVarType ReKi Mx {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in x direction)" Nm/m -typedef ^ RotMiscVarType ReKi My {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in y direction)" Nm/m -typedef ^ RotMiscVarType ReKi Mz {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in z direction)" Nm/m -typedef ^ RotMiscVarType ReKi Vind_i {:}{:}{:} - - "Induced velocities at jth node and kth blade (3xnSpanxnB)" m/s -typedef ^ RotMiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s -typedef ^ RotMiscVarType ReKi yaw - - - "Yaw calculated in SetInputsForBEMT" rad -typedef ^ RotMiscVarType ReKi tilt - - - "tilt calculated in SetInputsForBEMT" rad -typedef ^ RotMiscVarType ReKi hub_theta_x_root {:} - - "angles saved for FAST.Farm" rad -typedef ^ RotMiscVarType ReKi V_dot_x - - - -typedef ^ RotMiscVarType MeshType HubLoad - - - "mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only)" - -typedef ^ RotMiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" -typedef ^ RotMiscVarType ReKi SigmaCavitCrit {:}{:} - - "critical cavitation number- inception value (above which cavit will occur)" - -typedef ^ RotMiscVarType ReKi SigmaCavit {:}{:} - - "cavitation number at node " - -typedef ^ RotMiscVarType Logical CavitWarnSet {:}{:} - - "cavitation warning issued " - -typedef ^ RotMiscVarType ReKi TwrFB {:}{:} - - "buoyant force per unit length at tower node" N/m -typedef ^ RotMiscVarType ReKi TwrMB {:}{:} - - "buoyant moment per unit length at tower node" Nm/m -typedef ^ RotMiscVarType ReKi HubFB {:} - - "buoyant force at hub node" N -typedef ^ RotMiscVarType ReKi HubMB {:} - - "buoyant moment at hub node" Nm -typedef ^ RotMiscVarType ReKi NacFB {:} - - "buoyant force at nacelle (tower top) node" N -typedef ^ RotMiscVarType ReKi NacMB {:} - - "buoyant moment at nacelle (tower top) node" Nm -typedef ^ RotMiscVarType MeshType BladeRootLoad {:} - - "meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only)" - -typedef ^ RotMiscVarType MeshMapType B_L_2_R_P {:} - - "mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh" -typedef ^ RotMiscVarType MeshType BladeBuoyLoadPoint {:} - - "point mesh for lumped buoyant blade loads" - -typedef ^ RotMiscVarType MeshType BladeBuoyLoad {:} - - "line mesh for per unit length buoyant blade loads" - -typedef ^ RotMiscVarType MeshMapType B_P_2_B_L {:} - - "mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad)" -typedef ^ RotMiscVarType MeshType TwrBuoyLoadPoint - - - "point mesh for lumped buoyant tower loads" - -typedef ^ RotMiscVarType MeshType TwrBuoyLoad - - - "line mesh for per unit length buoyant tower loads" - -typedef ^ RotMiscVarType MeshMapType T_P_2_T_L - - - "mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad)" -typedef ^ RotMiscVarType Logical FirstWarn_TowerStrike - - - "flag to avoid printing tower strike multiple times" - -typedef ^ RotMiscVarType ReKi AvgDiskVel {3} - - "disk-averaged U,V,W (undisturbed)" m/s -typedef ^ RotMiscVarType ReKi AvgDiskVelDist {3} - - "disk-averaged U,V,W (disturbed)" m/s -# TailFin -typedef ^ RotMiscVarType ReKi TFinAlpha - - - "Angle of attack for tailfin" -typedef ^ RotMiscVarType ReKi TFinRe - - - "Reynolds number for tailfin" -typedef ^ RotMiscVarType ReKi TFinVrel - - - "Orthogonal relative velocity nrom at the reference point" -typedef ^ RotMiscVarType ReKi TFinVund_i 3 - - "Undisturbed wind velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinVind_i 3 - - "Induced velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinVrel_i 3 - - "Relative velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinSTV_i 3 - - "Structural velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinF_i 3 - - "Forces at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinM_i 3 - - "Moments at the reference point of the fin in the inertial system" - -typedef ^ MiscVarType RotMiscVarType rotors {:} - - "MiscVars for each rotor" - -typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - -typedef ^ MiscVarType FVW_OutputType FVW_y - - - "Outputs from the FVW module" - -typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - -typedef ^ MiscVarType ReKi WindPos {:}{:} - - "XYZ coordinates to query for wind velocity/acceleration" - -typedef ^ MiscVarType ReKi WindVel {:}{:} - - "XYZ components of wind velocity" - -typedef ^ MiscVarType ReKi WindAcc {:}{:} - - "XYZ components of wind acceleration" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Parameters for each rotor +typedef ^ RotParameterType ModVarsType &Vars - - - "Module Variables" +typedef ^ RotParameterType IntKi iVarDBEMT - 0 - "" - +typedef ^ RotParameterType IntKi iVarUA - 0 - "" - +typedef ^ RotParameterType IntKi iVarTowerMotion - 0 - "" - +typedef ^ RotParameterType IntKi iVarNacelleMotion - 0 - "" - +typedef ^ RotParameterType IntKi iVarHubMotion - 0 - "" - +typedef ^ RotParameterType IntKi iVarBladeRootMotion {:} - - "" - +typedef ^ RotParameterType IntKi iVarBladeMotion {:} - - "" - +typedef ^ RotParameterType IntKi iVarInflowOnBlade {:} - - "" - +typedef ^ RotParameterType IntKi iVarInflowOnTower - 0 - "" - +typedef ^ RotParameterType IntKi iVarUserProp {:} - - "" - +typedef ^ RotParameterType IntKi iVarTowerLoad - 0 - "" - +typedef ^ RotParameterType IntKi iVarHubLoad - 0 - "" - +typedef ^ RotParameterType IntKi iVarNacelleLoad - 0 - "" - +typedef ^ RotParameterType IntKi iVarBladeLoad {:} - - "" - +typedef ^ RotParameterType IntKi iVarWriteOutput - 0 - "" - typedef ^ RotParameterType IntKi NumBlades - - - "Number of blades on the turbine" - typedef ^ RotParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - typedef ^ RotParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - @@ -452,3 +398,84 @@ typedef ^ RotOutputType ReKi WriteOutput {:} - - "Data to be written to an outpu typedef ^ OutputType RotOutputType rotors {:} - - "Ouputs for each rotor" - + +# Define misc/optimization variables (any data that are not considered actual states) here: +typedef ^ RotMiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ RotMiscVarType RotContinuousStateType x_init - - - "" - +typedef ^ RotMiscVarType RotContinuousStateType x_perturb - - - "" - +typedef ^ RotMiscVarType RotContinuousStateType dxdt_lin - - - "" - +typedef ^ RotMiscVarType RotInputType u_perturb - - - "" - +typedef ^ RotMiscVarType RotOutputType y_lin - - - "" - +typedef ^ RotMiscVarType RotConstraintStateType z_lin - - - "" - +typedef ^ RotMiscVarType RotOtherStateType OtherState_init - - - "" - +typedef ^ RotMiscVarType RotOtherStateType OtherState_jac - - - "" - + +typedef ^ RotMiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - +typedef ^ RotMiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - +typedef ^ RotMiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - +typedef ^ RotMiscVarType AA_MiscVarType AA - - - "MiscVars from the AA module" - +typedef ^ RotMiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - +typedef ^ RotMiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - + +typedef ^ RotMiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s +typedef ^ RotMiscVarType R8Ki orientationAnnulus {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - +typedef ^ RotMiscVarType R8Ki R_li {:}{:}{:}{:} - - "Transformation matrix from inertial system to the staggered polar coordinate system of a given section" - +typedef ^ RotMiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - +typedef ^ RotMiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s +typedef ^ RotMiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s +typedef ^ RotMiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s +typedef ^ RotMiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possible output to file" rad +typedef ^ RotMiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m +typedef ^ RotMiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m +typedef ^ RotMiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m +typedef ^ RotMiscVarType ReKi Z {:}{:} - - "axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m +typedef ^ RotMiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m +typedef ^ RotMiscVarType ReKi Mx {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in x direction)" Nm/m +typedef ^ RotMiscVarType ReKi My {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in y direction)" Nm/m +typedef ^ RotMiscVarType ReKi Mz {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in z direction)" Nm/m +typedef ^ RotMiscVarType ReKi Vind_i {:}{:}{:} - - "Induced velocities at jth node and kth blade (3xnSpanxnB)" m/s +typedef ^ RotMiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s +typedef ^ RotMiscVarType ReKi yaw - - - "Yaw calculated in SetInputsForBEMT" rad +typedef ^ RotMiscVarType ReKi tilt - - - "tilt calculated in SetInputsForBEMT" rad +typedef ^ RotMiscVarType ReKi hub_theta_x_root {:} - - "angles saved for FAST.Farm" rad +typedef ^ RotMiscVarType ReKi V_dot_x - - - +typedef ^ RotMiscVarType MeshType HubLoad - - - "mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only)" - +typedef ^ RotMiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" +typedef ^ RotMiscVarType ReKi SigmaCavitCrit {:}{:} - - "critical cavitation number- inception value (above which cavit will occur)" - +typedef ^ RotMiscVarType ReKi SigmaCavit {:}{:} - - "cavitation number at node " - +typedef ^ RotMiscVarType Logical CavitWarnSet {:}{:} - - "cavitation warning issued " - +typedef ^ RotMiscVarType ReKi TwrFB {:}{:} - - "buoyant force per unit length at tower node" N/m +typedef ^ RotMiscVarType ReKi TwrMB {:}{:} - - "buoyant moment per unit length at tower node" Nm/m +typedef ^ RotMiscVarType ReKi HubFB {:} - - "buoyant force at hub node" N +typedef ^ RotMiscVarType ReKi HubMB {:} - - "buoyant moment at hub node" Nm +typedef ^ RotMiscVarType ReKi NacFB {:} - - "buoyant force at nacelle (tower top) node" N +typedef ^ RotMiscVarType ReKi NacMB {:} - - "buoyant moment at nacelle (tower top) node" Nm +typedef ^ RotMiscVarType MeshType BladeRootLoad {:} - - "meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only)" - +typedef ^ RotMiscVarType MeshMapType B_L_2_R_P {:} - - "mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh" +typedef ^ RotMiscVarType MeshType BladeBuoyLoadPoint {:} - - "point mesh for lumped buoyant blade loads" - +typedef ^ RotMiscVarType MeshType BladeBuoyLoad {:} - - "line mesh for per unit length buoyant blade loads" - +typedef ^ RotMiscVarType MeshMapType B_P_2_B_L {:} - - "mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad)" +typedef ^ RotMiscVarType MeshType TwrBuoyLoadPoint - - - "point mesh for lumped buoyant tower loads" - +typedef ^ RotMiscVarType MeshType TwrBuoyLoad - - - "line mesh for per unit length buoyant tower loads" - +typedef ^ RotMiscVarType MeshMapType T_P_2_T_L - - - "mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad)" +typedef ^ RotMiscVarType Logical FirstWarn_TowerStrike - - - "flag to avoid printing tower strike multiple times" - +typedef ^ RotMiscVarType ReKi AvgDiskVel {3} - - "disk-averaged U,V,W (undisturbed)" m/s +typedef ^ RotMiscVarType ReKi AvgDiskVelDist {3} - - "disk-averaged U,V,W (disturbed)" m/s +# TailFin +typedef ^ RotMiscVarType ReKi TFinAlpha - - - "Angle of attack for tailfin" +typedef ^ RotMiscVarType ReKi TFinRe - - - "Reynolds number for tailfin" +typedef ^ RotMiscVarType ReKi TFinVrel - - - "Orthogonal relative velocity nrom at the reference point" +typedef ^ RotMiscVarType ReKi TFinVund_i 3 - - "Undisturbed wind velocity at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinVind_i 3 - - "Induced velocity at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinVrel_i 3 - - "Relative velocity at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinSTV_i 3 - - "Structural velocity at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinF_i 3 - - "Forces at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinM_i 3 - - "Moments at the reference point of the fin in the inertial system" + +typedef ^ MiscVarType RotMiscVarType rotors {:} - - "MiscVars for each rotor" - +typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - +typedef ^ MiscVarType FVW_OutputType FVW_y - - - "Outputs from the FVW module" - +typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - +typedef ^ MiscVarType ReKi WindPos {:}{:} - - "XYZ coordinates to query for wind velocity/acceleration" - +typedef ^ MiscVarType ReKi WindVel {:}{:} - - "XYZ components of wind velocity" - +typedef ^ MiscVarType ReKi WindAcc {:}{:} - - "XYZ components of wind acceleration" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index fa691fffed..b810a50870 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -38,28 +38,39 @@ MODULE AeroDyn_Types USE InflowWind_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ModelUnknown = -1 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_none = 0 ! Wake model - none [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_BEMT = 1 ! Wake model - BEMT (blade elememnt momentum theory) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_DBEMT = 2 ! Wake model - DBEMT (dynamic elememnt momentum theory) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_FVW = 3 ! Wake model - FVW (free vortex wake, OLAF) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AFAeroMod_steady = 1 ! steady model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AFAeroMod_BL_unsteady = 2 ! Beddoes-Leishman unsteady model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_none = 0 ! no tower potential flow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_baseline = 1 ! baseline tower potential flow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_Bak = 2 ! tower potential flow with Bak correction [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_none = 0 ! no tower shadow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Powles = 1 ! Powles tower shadow model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Eames = 2 ! Eames tower shadow model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_none = 0 ! no tail fin aero [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_polar = 1 ! polar-based tail fin aerodynamics [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_USB = 2 ! unsteady slender body tail fin aerodynamics model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinIndMod_none = 0 ! no induction [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinIndMod_rotavg = 1 ! rotor averaged induction [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_NoSweepPitchTwist = 1 ! Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_Polar = 2 ! Use staggered polar grid for momentum balance in each annulus [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: APM_LiftingLine = 3 ! Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModelUnknown = -1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_none = 0 ! Wake model - none [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_BEMT = 1 ! Wake model - BEMT (blade elememnt momentum theory) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_DBEMT = 2 ! Wake model - DBEMT (dynamic elememnt momentum theory) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_FVW = 3 ! Wake model - FVW (free vortex wake, OLAF) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFAeroMod_steady = 1 ! steady model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFAeroMod_BL_unsteady = 2 ! Beddoes-Leishman unsteady model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_none = 0 ! no tower potential flow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_baseline = 1 ! baseline tower potential flow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_Bak = 2 ! tower potential flow with Bak correction [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_none = 0 ! no tower shadow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Powles = 1 ! Powles tower shadow model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Eames = 2 ! Eames tower shadow model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_none = 0 ! no tail fin aero [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_polar = 1 ! polar-based tail fin aerodynamics [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_USB = 2 ! unsteady slender body tail fin aerodynamics model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinIndMod_none = 0 ! no induction [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinIndMod_rotavg = 1 ! rotor averaged induction [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_NoSweepPitchTwist = 1 ! Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_Polar = 2 ! Use staggered polar grid for momentum balance in each annulus [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_LiftingLine = 3 ! Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_NacelleMotion = 1 ! Mesh number for AD AD_u_rotors_NacelleMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_TowerMotion = 2 ! Mesh number for AD AD_u_rotors_TowerMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_HubMotion = 3 ! Mesh number for AD AD_u_rotors_HubMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_BladeRootMotion = 4 ! Mesh number for AD AD_u_rotors_BladeRootMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_BladeMotion = 5 ! Mesh number for AD AD_u_rotors_BladeMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_TFinMotion = 6 ! Mesh number for AD AD_u_rotors_TFinMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_NacelleLoad = 7 ! Mesh number for AD AD_y_rotors_NacelleLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_HubLoad = 8 ! Mesh number for AD AD_y_rotors_HubLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_TowerLoad = 9 ! Mesh number for AD AD_y_rotors_TowerLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_BladeLoad = 10 ! Mesh number for AD AD_y_rotors_BladeLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_TFinLoad = 11 ! Mesh number for AD AD_y_rotors_TFinLoad mesh [-] ! ========= TFinParameterType ======= TYPE, PUBLIC :: TFinParameterType INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] @@ -148,6 +159,7 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotInitOutputType ======= TYPE, PUBLIC :: RotInitOutputType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] @@ -297,82 +309,24 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WakeLocationPoints !< wake points velocity [m/s] END TYPE AD_OtherStateType ! ======================= -! ========= RotMiscVarType ======= - TYPE, PUBLIC :: RotMiscVarType - TYPE(BEMT_MiscVarType) :: BEMT !< MiscVars from the BEMT module [-] - TYPE(BEMT_OutputType) :: BEMT_y !< Outputs from the BEMT module [-] - TYPE(BEMT_InputType) , DIMENSION(1:2) :: BEMT_u !< Inputs to the BEMT module [-] - TYPE(AA_MiscVarType) :: AA !< MiscVars from the AA module [-] - TYPE(AA_OutputType) :: AA_y !< Outputs from the AA module [-] - TYPE(AA_InputType) :: AA_u !< Inputs to the AA module [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: DisturbedInflow !< InflowOnBlade values modified by tower influence [m/s] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: orientationAnnulus !< Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: R_li !< Transformation matrix from inertial system to the staggered polar coordinate system of a given section [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: W_Twr !< relative wind speed normal to the tower at node j [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Twr !< local x-component of force per unit length of the jth node in the tower [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Twr !< local y-component of force per unit length of the jth node in the tower [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Curve !< curvature angle, saved for possible output to file [rad] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrClrnc !< Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: X !< normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade [N/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y !< tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Z !< axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M !< pitching moment per unit length of the jth node in the kth blade [Nm/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mx !< pitching moment per unit length of the jth node in the kth blade (in x direction) [Nm/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: My !< pitching moment per unit length of the jth node in the kth blade (in y direction) [Nm/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mz !< pitching moment per unit length of the jth node in the kth blade (in z direction) [Nm/m] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_i !< Induced velocities at jth node and kth blade (3xnSpanxnB) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg = 0.0_ReKi !< disk-average relative wind speed [m/s] - REAL(ReKi) :: yaw = 0.0_ReKi !< Yaw calculated in SetInputsForBEMT [rad] - REAL(ReKi) :: tilt = 0.0_ReKi !< tilt calculated in SetInputsForBEMT [rad] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: hub_theta_x_root !< angles saved for FAST.Farm [rad] - REAL(ReKi) :: V_dot_x = 0.0_ReKi - TYPE(MeshType) :: HubLoad !< mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only) [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_H_P !< mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavitCrit !< critical cavitation number- inception value (above which cavit will occur) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavit !< cavitation number at node [-] - LOGICAL , DIMENSION(:,:), ALLOCATABLE :: CavitWarnSet !< cavitation warning issued [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFB !< buoyant force per unit length at tower node [N/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrMB !< buoyant moment per unit length at tower node [Nm/m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubFB !< buoyant force at hub node [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubMB !< buoyant moment at hub node [Nm] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFB !< buoyant force at nacelle (tower top) node [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMB !< buoyant moment at nacelle (tower top) node [Nm] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootLoad !< meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only) [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_R_P !< mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoadPoint !< point mesh for lumped buoyant blade loads [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoad !< line mesh for per unit length buoyant blade loads [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_P_2_B_L !< mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad) [-] - TYPE(MeshType) :: TwrBuoyLoadPoint !< point mesh for lumped buoyant tower loads [-] - TYPE(MeshType) :: TwrBuoyLoad !< line mesh for per unit length buoyant tower loads [-] - TYPE(MeshMapType) :: T_P_2_T_L !< mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad) [-] - LOGICAL :: FirstWarn_TowerStrike = .false. !< flag to avoid printing tower strike multiple times [-] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W (undisturbed) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist = 0.0_ReKi !< disk-averaged U,V,W (disturbed) [m/s] - REAL(ReKi) :: TFinAlpha = 0.0_ReKi !< Angle of attack for tailfin [-] - REAL(ReKi) :: TFinRe = 0.0_ReKi !< Reynolds number for tailfin [-] - REAL(ReKi) :: TFinVrel = 0.0_ReKi !< Orthogonal relative velocity nrom at the reference point [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i = 0.0_ReKi !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i = 0.0_ReKi !< Induced velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i = 0.0_ReKi !< Relative velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i = 0.0_ReKi !< Structural velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinF_i = 0.0_ReKi !< Forces at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinM_i = 0.0_ReKi !< Moments at the reference point of the fin in the inertial system [-] - END TYPE RotMiscVarType -! ======================= -! ========= AD_MiscVarType ======= - TYPE, PUBLIC :: AD_MiscVarType - TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< MiscVars for each rotor [-] - TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] - TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] - TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] - END TYPE AD_MiscVarType -! ======================= ! ========= RotParameterType ======= TYPE, PUBLIC :: RotParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarDBEMT = 0 !< [-] + INTEGER(IntKi) :: iVarUA = 0 !< [-] + INTEGER(IntKi) :: iVarTowerMotion = 0 !< [-] + INTEGER(IntKi) :: iVarNacelleMotion = 0 !< [-] + INTEGER(IntKi) :: iVarHubMotion = 0 !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeRootMotion !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeMotion !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarInflowOnBlade !< [-] + INTEGER(IntKi) :: iVarInflowOnTower = 0 !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarUserProp !< [-] + INTEGER(IntKi) :: iVarTowerLoad = 0 !< [-] + INTEGER(IntKi) :: iVarHubLoad = 0 !< [-] + INTEGER(IntKi) :: iVarNacelleLoad = 0 !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeLoad !< [-] + INTEGER(IntKi) :: iVarWriteOutput = 0 !< [-] INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of nodes on the tower [-] @@ -497,6 +451,89 @@ MODULE AeroDyn_Types TYPE(RotOutputType) , DIMENSION(:), ALLOCATABLE :: rotors !< Ouputs for each rotor [-] END TYPE AD_OutputType ! ======================= +! ========= RotMiscVarType ======= + TYPE, PUBLIC :: RotMiscVarType + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(RotContinuousStateType) :: x_init !< [-] + TYPE(RotContinuousStateType) :: x_perturb !< [-] + TYPE(RotContinuousStateType) :: dxdt_lin !< [-] + TYPE(RotInputType) :: u_perturb !< [-] + TYPE(RotOutputType) :: y_lin !< [-] + TYPE(RotConstraintStateType) :: z_lin !< [-] + TYPE(RotOtherStateType) :: OtherState_init !< [-] + TYPE(RotOtherStateType) :: OtherState_jac !< [-] + TYPE(BEMT_MiscVarType) :: BEMT !< MiscVars from the BEMT module [-] + TYPE(BEMT_OutputType) :: BEMT_y !< Outputs from the BEMT module [-] + TYPE(BEMT_InputType) , DIMENSION(1:2) :: BEMT_u !< Inputs to the BEMT module [-] + TYPE(AA_MiscVarType) :: AA !< MiscVars from the AA module [-] + TYPE(AA_OutputType) :: AA_y !< Outputs from the AA module [-] + TYPE(AA_InputType) :: AA_u !< Inputs to the AA module [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: DisturbedInflow !< InflowOnBlade values modified by tower influence [m/s] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: orientationAnnulus !< Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: R_li !< Transformation matrix from inertial system to the staggered polar coordinate system of a given section [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: W_Twr !< relative wind speed normal to the tower at node j [m/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Twr !< local x-component of force per unit length of the jth node in the tower [m/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Twr !< local y-component of force per unit length of the jth node in the tower [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Curve !< curvature angle, saved for possible output to file [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrClrnc !< Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: X !< normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y !< tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Z !< axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M !< pitching moment per unit length of the jth node in the kth blade [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mx !< pitching moment per unit length of the jth node in the kth blade (in x direction) [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: My !< pitching moment per unit length of the jth node in the kth blade (in y direction) [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mz !< pitching moment per unit length of the jth node in the kth blade (in z direction) [Nm/m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_i !< Induced velocities at jth node and kth blade (3xnSpanxnB) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg = 0.0_ReKi !< disk-average relative wind speed [m/s] + REAL(ReKi) :: yaw = 0.0_ReKi !< Yaw calculated in SetInputsForBEMT [rad] + REAL(ReKi) :: tilt = 0.0_ReKi !< tilt calculated in SetInputsForBEMT [rad] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: hub_theta_x_root !< angles saved for FAST.Farm [rad] + REAL(ReKi) :: V_dot_x = 0.0_ReKi + TYPE(MeshType) :: HubLoad !< mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only) [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_H_P !< mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavitCrit !< critical cavitation number- inception value (above which cavit will occur) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavit !< cavitation number at node [-] + LOGICAL , DIMENSION(:,:), ALLOCATABLE :: CavitWarnSet !< cavitation warning issued [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFB !< buoyant force per unit length at tower node [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrMB !< buoyant moment per unit length at tower node [Nm/m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubFB !< buoyant force at hub node [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubMB !< buoyant moment at hub node [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFB !< buoyant force at nacelle (tower top) node [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMB !< buoyant moment at nacelle (tower top) node [Nm] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootLoad !< meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only) [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_R_P !< mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoadPoint !< point mesh for lumped buoyant blade loads [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoad !< line mesh for per unit length buoyant blade loads [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_P_2_B_L !< mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad) [-] + TYPE(MeshType) :: TwrBuoyLoadPoint !< point mesh for lumped buoyant tower loads [-] + TYPE(MeshType) :: TwrBuoyLoad !< line mesh for per unit length buoyant tower loads [-] + TYPE(MeshMapType) :: T_P_2_T_L !< mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad) [-] + LOGICAL :: FirstWarn_TowerStrike = .false. !< flag to avoid printing tower strike multiple times [-] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W (undisturbed) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist = 0.0_ReKi !< disk-averaged U,V,W (disturbed) [m/s] + REAL(ReKi) :: TFinAlpha = 0.0_ReKi !< Angle of attack for tailfin [-] + REAL(ReKi) :: TFinRe = 0.0_ReKi !< Reynolds number for tailfin [-] + REAL(ReKi) :: TFinVrel = 0.0_ReKi !< Orthogonal relative velocity nrom at the reference point [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i = 0.0_ReKi !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i = 0.0_ReKi !< Induced velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i = 0.0_ReKi !< Relative velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i = 0.0_ReKi !< Structural velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinF_i = 0.0_ReKi !< Forces at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinM_i = 0.0_ReKi !< Moments at the reference point of the fin in the inertial system [-] + END TYPE RotMiscVarType +! ======================= +! ========= AD_MiscVarType ======= + TYPE, PUBLIC :: AD_MiscVarType + TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< MiscVars for each rotor [-] + TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] + TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] + TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] + END TYPE AD_MiscVarType +! ======================= CONTAINS subroutine AD_CopyTFinParameterType(SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1304,6 +1341,7 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy character(*), parameter :: RoutineName = 'AD_CopyRotInitOutputType' ErrStat = ErrID_None ErrMsg = '' + DstRotInitOutputTypeData%Vars => SrcRotInitOutputTypeData%Vars DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens if (allocated(SrcRotInitOutputTypeData%WriteOutputHdr)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr, kind=B8Ki) @@ -1494,6 +1532,7 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_DestroyRotInitOutputType' ErrStat = ErrID_None ErrMsg = '' + nullify(RotInitOutputTypeData%Vars) if (allocated(RotInitOutputTypeData%WriteOutputHdr)) then deallocate(RotInitOutputTypeData%WriteOutputHdr) end if @@ -1556,7 +1595,15 @@ subroutine AD_PackRotInitOutputType(RF, Indata) character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPack(RF, InData%AirDens) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) @@ -1599,7 +1646,27 @@ subroutine AD_UnPackRotInitOutputType(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -2908,1069 +2975,869 @@ subroutine AD_UnPackOtherState(RF, OutData) call RegUnpackAlloc(RF, OutData%WakeLocationPoints); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotMiscVarType), intent(inout) :: SrcRotMiscVarTypeData - type(RotMiscVarType), intent(inout) :: DstRotMiscVarTypeData +subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotParameterType), intent(in) :: SrcRotParameterTypeData + type(RotParameterType), intent(inout) :: DstRotParameterTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' + character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' ErrStat = ErrID_None ErrMsg = '' - call BEMT_CopyMisc(SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) - do i1 = LB(1), UB(1) - call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) + if (associated(SrcRotParameterTypeData%Vars)) then + if (.not. associated(DstRotParameterTypeData%Vars)) then + allocate(DstRotParameterTypeData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcRotParameterTypeData%Vars, DstRotParameterTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - end do - call AA_CopyMisc(SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AA_CopyOutput(SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AA_CopyInput(SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) - UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then - allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + end if + DstRotParameterTypeData%iVarDBEMT = SrcRotParameterTypeData%iVarDBEMT + DstRotParameterTypeData%iVarUA = SrcRotParameterTypeData%iVarUA + DstRotParameterTypeData%iVarTowerMotion = SrcRotParameterTypeData%iVarTowerMotion + DstRotParameterTypeData%iVarNacelleMotion = SrcRotParameterTypeData%iVarNacelleMotion + DstRotParameterTypeData%iVarHubMotion = SrcRotParameterTypeData%iVarHubMotion + if (allocated(SrcRotParameterTypeData%iVarBladeRootMotion)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarBladeRootMotion)) then + allocate(DstRotParameterTypeData%iVarBladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeRootMotion.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow + DstRotParameterTypeData%iVarBladeRootMotion = SrcRotParameterTypeData%iVarBladeRootMotion end if - if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then - LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) - UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then - allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%iVarBladeMotion)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeMotion, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarBladeMotion)) then + allocate(DstRotParameterTypeData%iVarBladeMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeMotion.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus + DstRotParameterTypeData%iVarBladeMotion = SrcRotParameterTypeData%iVarBladeMotion end if - if (allocated(SrcRotMiscVarTypeData%R_li)) then - LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) - UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%R_li)) then - allocate(DstRotMiscVarTypeData%R_li(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%iVarInflowOnBlade)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarInflowOnBlade, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarInflowOnBlade, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarInflowOnBlade)) then + allocate(DstRotParameterTypeData%iVarInflowOnBlade(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%R_li.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarInflowOnBlade.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li + DstRotParameterTypeData%iVarInflowOnBlade = SrcRotParameterTypeData%iVarInflowOnBlade end if - if (allocated(SrcRotMiscVarTypeData%AllOuts)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then - allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + DstRotParameterTypeData%iVarInflowOnTower = SrcRotParameterTypeData%iVarInflowOnTower + if (allocated(SrcRotParameterTypeData%iVarUserProp)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarUserProp)) then + allocate(DstRotParameterTypeData%iVarUserProp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarUserProp.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts + DstRotParameterTypeData%iVarUserProp = SrcRotParameterTypeData%iVarUserProp end if - if (allocated(SrcRotMiscVarTypeData%W_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then - allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) + DstRotParameterTypeData%iVarTowerLoad = SrcRotParameterTypeData%iVarTowerLoad + DstRotParameterTypeData%iVarHubLoad = SrcRotParameterTypeData%iVarHubLoad + DstRotParameterTypeData%iVarNacelleLoad = SrcRotParameterTypeData%iVarNacelleLoad + if (allocated(SrcRotParameterTypeData%iVarBladeLoad)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarBladeLoad)) then + allocate(DstRotParameterTypeData%iVarBladeLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeLoad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr + DstRotParameterTypeData%iVarBladeLoad = SrcRotParameterTypeData%iVarBladeLoad end if - if (allocated(SrcRotMiscVarTypeData%X_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then - allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) + DstRotParameterTypeData%iVarWriteOutput = SrcRotParameterTypeData%iVarWriteOutput + DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades + DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds + DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds + if (allocated(SrcRotParameterTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then + allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr + DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam end if - if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then - allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrCd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrCd)) then + allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr + DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd end if - if (allocated(SrcRotMiscVarTypeData%Curve)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Curve, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Curve, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Curve)) then - allocate(DstRotMiscVarTypeData%Curve(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrTI)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrTI)) then + allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Curve.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve + DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI end if - if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then - allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlTwist)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlTwist)) then + allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc + DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist end if - if (allocated(SrcRotMiscVarTypeData%X)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%X, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%X, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%X)) then - allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrCb)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrCb)) then + allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X + DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb end if - if (allocated(SrcRotMiscVarTypeData%Y)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Y, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Y, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Y)) then - allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlCenBn)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then + allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y + DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn end if - if (allocated(SrcRotMiscVarTypeData%Z)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Z, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Z, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Z)) then - allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlCenBt)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then + allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z + DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt end if - if (allocated(SrcRotMiscVarTypeData%M)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%M, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%M, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%M)) then - allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub + DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx + DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac + DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB + DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl + DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr + if (allocated(SrcRotParameterTypeData%BlRad)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlRad, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlRad, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlRad)) then + allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M + DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad end if - if (allocated(SrcRotMiscVarTypeData%Mx)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Mx)) then - allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlDL)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlDL, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlDL, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlDL)) then + allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx + DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL end if - if (allocated(SrcRotMiscVarTypeData%My)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%My, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%My, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%My)) then - allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlTaper)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlTaper)) then + allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My + DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper end if - if (allocated(SrcRotMiscVarTypeData%Mz)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Mz)) then - allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlAxCent)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then + allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz + DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent end if - if (allocated(SrcRotMiscVarTypeData%Vind_i)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) - UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Vind_i)) then - allocate(DstRotMiscVarTypeData%Vind_i(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrRad)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrRad)) then + allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Vind_i.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Vind_i = SrcRotMiscVarTypeData%Vind_i + DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad end if - DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg - DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw - DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt - if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then - allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrDL)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrDL)) then + allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root + DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL end if - DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x - call MeshCopy(SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then - allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrTaper)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then + allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper end if - if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then - allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrAxCent)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then + allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit + DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent end if - if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then - allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + call BEMT_CopyParam(SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyParam(SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotParameterTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcRotParameterTypeData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%Jac_u_indx)) then + allocate(DstRotParameterTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit + DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx end if - if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then - allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%du)) then + LB(1:1) = lbound(SrcRotParameterTypeData%du, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%du, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%du)) then + allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet + DstRotParameterTypeData%du = SrcRotParameterTypeData%du end if - if (allocated(SrcRotMiscVarTypeData%TwrFB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then - allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%dx)) then + LB(1:1) = lbound(SrcRotParameterTypeData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%dx, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%dx)) then + allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB - end if - if (allocated(SrcRotMiscVarTypeData%TwrMB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then - allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB - end if - if (allocated(SrcRotMiscVarTypeData%HubFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then - allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB - end if - if (allocated(SrcRotMiscVarTypeData%HubMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then - allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB - end if - if (allocated(SrcRotMiscVarTypeData%NacFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then - allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB - end if - if (allocated(SrcRotMiscVarTypeData%NacMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then - allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB - end if - if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then - allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then - allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx end if - if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then - allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) + DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny + DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin + DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent + DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow + DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero + DstRotParameterTypeData%FrozenWake = SrcRotParameterTypeData%FrozenWake + DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck + DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy + DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK + DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA + DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens + DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc + DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound + DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity + DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm + DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap + DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth + DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL + DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod + DstRotParameterTypeData%AeroBEM_Mod = SrcRotParameterTypeData%AeroBEM_Mod + DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts + DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName + if (allocated(SrcRotParameterTypeData%OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%OutParam, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%OutParam)) then + allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then - allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) + DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts + DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd + DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts + DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd + DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts + DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts + if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then + allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then - allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then + allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd end if - call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2) + DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut + DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero + call AD_CopyTFinParameterType(SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike - DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel - DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist - DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha - DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe - DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel - DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i - DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i - DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i - DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i - DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i - DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i end subroutine -subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) - type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData +subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) + type(RotParameterType), intent(inout) :: RotParameterTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' + character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' ErrStat = ErrID_None ErrMsg = '' - call BEMT_DestroyMisc(RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) - do i1 = LB(1), UB(1) - call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) + if (associated(RotParameterTypeData%Vars)) then + call NWTC_Library_DestroyModVarsType(RotParameterTypeData%Vars, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call AA_DestroyMisc(RotMiscVarTypeData%AA, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyOutput(RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyInput(RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotMiscVarTypeData%DisturbedInflow)) then - deallocate(RotMiscVarTypeData%DisturbedInflow) + deallocate(RotParameterTypeData%Vars) + RotParameterTypeData%Vars => null() end if - if (allocated(RotMiscVarTypeData%orientationAnnulus)) then - deallocate(RotMiscVarTypeData%orientationAnnulus) + if (allocated(RotParameterTypeData%iVarBladeRootMotion)) then + deallocate(RotParameterTypeData%iVarBladeRootMotion) end if - if (allocated(RotMiscVarTypeData%R_li)) then - deallocate(RotMiscVarTypeData%R_li) + if (allocated(RotParameterTypeData%iVarBladeMotion)) then + deallocate(RotParameterTypeData%iVarBladeMotion) end if - if (allocated(RotMiscVarTypeData%AllOuts)) then - deallocate(RotMiscVarTypeData%AllOuts) + if (allocated(RotParameterTypeData%iVarInflowOnBlade)) then + deallocate(RotParameterTypeData%iVarInflowOnBlade) end if - if (allocated(RotMiscVarTypeData%W_Twr)) then - deallocate(RotMiscVarTypeData%W_Twr) + if (allocated(RotParameterTypeData%iVarUserProp)) then + deallocate(RotParameterTypeData%iVarUserProp) end if - if (allocated(RotMiscVarTypeData%X_Twr)) then - deallocate(RotMiscVarTypeData%X_Twr) + if (allocated(RotParameterTypeData%iVarBladeLoad)) then + deallocate(RotParameterTypeData%iVarBladeLoad) end if - if (allocated(RotMiscVarTypeData%Y_Twr)) then - deallocate(RotMiscVarTypeData%Y_Twr) + if (allocated(RotParameterTypeData%TwrDiam)) then + deallocate(RotParameterTypeData%TwrDiam) end if - if (allocated(RotMiscVarTypeData%Curve)) then - deallocate(RotMiscVarTypeData%Curve) + if (allocated(RotParameterTypeData%TwrCd)) then + deallocate(RotParameterTypeData%TwrCd) end if - if (allocated(RotMiscVarTypeData%TwrClrnc)) then - deallocate(RotMiscVarTypeData%TwrClrnc) + if (allocated(RotParameterTypeData%TwrTI)) then + deallocate(RotParameterTypeData%TwrTI) end if - if (allocated(RotMiscVarTypeData%X)) then - deallocate(RotMiscVarTypeData%X) + if (allocated(RotParameterTypeData%BlTwist)) then + deallocate(RotParameterTypeData%BlTwist) end if - if (allocated(RotMiscVarTypeData%Y)) then - deallocate(RotMiscVarTypeData%Y) + if (allocated(RotParameterTypeData%TwrCb)) then + deallocate(RotParameterTypeData%TwrCb) end if - if (allocated(RotMiscVarTypeData%Z)) then - deallocate(RotMiscVarTypeData%Z) + if (allocated(RotParameterTypeData%BlCenBn)) then + deallocate(RotParameterTypeData%BlCenBn) end if - if (allocated(RotMiscVarTypeData%M)) then - deallocate(RotMiscVarTypeData%M) + if (allocated(RotParameterTypeData%BlCenBt)) then + deallocate(RotParameterTypeData%BlCenBt) end if - if (allocated(RotMiscVarTypeData%Mx)) then - deallocate(RotMiscVarTypeData%Mx) - end if - if (allocated(RotMiscVarTypeData%My)) then - deallocate(RotMiscVarTypeData%My) - end if - if (allocated(RotMiscVarTypeData%Mz)) then - deallocate(RotMiscVarTypeData%Mz) - end if - if (allocated(RotMiscVarTypeData%Vind_i)) then - deallocate(RotMiscVarTypeData%Vind_i) - end if - if (allocated(RotMiscVarTypeData%hub_theta_x_root)) then - deallocate(RotMiscVarTypeData%hub_theta_x_root) - end if - call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotMiscVarTypeData%B_L_2_H_P) - end if - if (allocated(RotMiscVarTypeData%SigmaCavitCrit)) then - deallocate(RotMiscVarTypeData%SigmaCavitCrit) + if (allocated(RotParameterTypeData%BlRad)) then + deallocate(RotParameterTypeData%BlRad) end if - if (allocated(RotMiscVarTypeData%SigmaCavit)) then - deallocate(RotMiscVarTypeData%SigmaCavit) + if (allocated(RotParameterTypeData%BlDL)) then + deallocate(RotParameterTypeData%BlDL) end if - if (allocated(RotMiscVarTypeData%CavitWarnSet)) then - deallocate(RotMiscVarTypeData%CavitWarnSet) + if (allocated(RotParameterTypeData%BlTaper)) then + deallocate(RotParameterTypeData%BlTaper) end if - if (allocated(RotMiscVarTypeData%TwrFB)) then - deallocate(RotMiscVarTypeData%TwrFB) + if (allocated(RotParameterTypeData%BlAxCent)) then + deallocate(RotParameterTypeData%BlAxCent) end if - if (allocated(RotMiscVarTypeData%TwrMB)) then - deallocate(RotMiscVarTypeData%TwrMB) + if (allocated(RotParameterTypeData%TwrRad)) then + deallocate(RotParameterTypeData%TwrRad) end if - if (allocated(RotMiscVarTypeData%HubFB)) then - deallocate(RotMiscVarTypeData%HubFB) + if (allocated(RotParameterTypeData%TwrDL)) then + deallocate(RotParameterTypeData%TwrDL) end if - if (allocated(RotMiscVarTypeData%HubMB)) then - deallocate(RotMiscVarTypeData%HubMB) + if (allocated(RotParameterTypeData%TwrTaper)) then + deallocate(RotParameterTypeData%TwrTaper) end if - if (allocated(RotMiscVarTypeData%NacFB)) then - deallocate(RotMiscVarTypeData%NacFB) + if (allocated(RotParameterTypeData%TwrAxCent)) then + deallocate(RotParameterTypeData%TwrAxCent) end if - if (allocated(RotMiscVarTypeData%NacMB)) then - deallocate(RotMiscVarTypeData%NacMB) + call BEMT_DestroyParam(RotParameterTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyParam(RotParameterTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotParameterTypeData%Jac_u_indx)) then + deallocate(RotParameterTypeData%Jac_u_indx) end if - if (allocated(RotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotMiscVarTypeData%BladeRootLoad) + if (allocated(RotParameterTypeData%du)) then + deallocate(RotParameterTypeData%du) end if - if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotMiscVarTypeData%B_L_2_R_P) + if (allocated(RotParameterTypeData%dx)) then + deallocate(RotParameterTypeData%dx) end if - if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) + if (allocated(RotParameterTypeData%OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%OutParam, kind=B8Ki) + UB(1:1) = ubound(RotParameterTypeData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) + deallocate(RotParameterTypeData%OutParam) end if - if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + if (allocated(RotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotMiscVarTypeData%BladeBuoyLoad) + deallocate(RotParameterTypeData%BldNd_OutParam) end if - if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotMiscVarTypeData%B_P_2_B_L) + if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then + deallocate(RotParameterTypeData%BldNd_BlOutNd) end if - call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2) + call AD_DestroyTFinParameterType(RotParameterTypeData%TFin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotMiscVarType(RF, Indata) +subroutine AD_PackRotParameterType(RF, Indata) type(RegFile), intent(inout) :: RF - type(RotMiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + type(RotParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotParameterType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call BEMT_PackMisc(RF, InData%BEMT) - call BEMT_PackOutput(RF, InData%BEMT_y) - LB(1:1) = lbound(InData%BEMT_u, kind=B8Ki) - UB(1:1) = ubound(InData%BEMT_u, kind=B8Ki) - do i1 = LB(1), UB(1) - call BEMT_PackInput(RF, InData%BEMT_u(i1)) - end do - call AA_PackMisc(RF, InData%AA) - call AA_PackOutput(RF, InData%AA_y) - call AA_PackInput(RF, InData%AA_u) - call RegPackAlloc(RF, InData%DisturbedInflow) - call RegPackAlloc(RF, InData%orientationAnnulus) - call RegPackAlloc(RF, InData%R_li) - call RegPackAlloc(RF, InData%AllOuts) - call RegPackAlloc(RF, InData%W_Twr) - call RegPackAlloc(RF, InData%X_Twr) - call RegPackAlloc(RF, InData%Y_Twr) - call RegPackAlloc(RF, InData%Curve) - call RegPackAlloc(RF, InData%TwrClrnc) - call RegPackAlloc(RF, InData%X) - call RegPackAlloc(RF, InData%Y) - call RegPackAlloc(RF, InData%Z) - call RegPackAlloc(RF, InData%M) - call RegPackAlloc(RF, InData%Mx) - call RegPackAlloc(RF, InData%My) - call RegPackAlloc(RF, InData%Mz) - call RegPackAlloc(RF, InData%Vind_i) - call RegPack(RF, InData%V_DiskAvg) - call RegPack(RF, InData%yaw) - call RegPack(RF, InData%tilt) - call RegPackAlloc(RF, InData%hub_theta_x_root) - call RegPack(RF, InData%V_dot_x) - call MeshPack(RF, InData%HubLoad) - call RegPack(RF, allocated(InData%B_L_2_H_P)) - if (allocated(InData%B_L_2_H_P)) then - call RegPackBounds(RF, 1, lbound(InData%B_L_2_H_P, kind=B8Ki), ubound(InData%B_L_2_H_P, kind=B8Ki)) - LB(1:1) = lbound(InData%B_L_2_H_P, kind=B8Ki) - UB(1:1) = ubound(InData%B_L_2_H_P, kind=B8Ki) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarDBEMT) + call RegPack(RF, InData%iVarUA) + call RegPack(RF, InData%iVarTowerMotion) + call RegPack(RF, InData%iVarNacelleMotion) + call RegPack(RF, InData%iVarHubMotion) + call RegPackAlloc(RF, InData%iVarBladeRootMotion) + call RegPackAlloc(RF, InData%iVarBladeMotion) + call RegPackAlloc(RF, InData%iVarInflowOnBlade) + call RegPack(RF, InData%iVarInflowOnTower) + call RegPackAlloc(RF, InData%iVarUserProp) + call RegPack(RF, InData%iVarTowerLoad) + call RegPack(RF, InData%iVarHubLoad) + call RegPack(RF, InData%iVarNacelleLoad) + call RegPackAlloc(RF, InData%iVarBladeLoad) + call RegPack(RF, InData%iVarWriteOutput) + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumBlNds) + call RegPack(RF, InData%NumTwrNds) + call RegPackAlloc(RF, InData%TwrDiam) + call RegPackAlloc(RF, InData%TwrCd) + call RegPackAlloc(RF, InData%TwrTI) + call RegPackAlloc(RF, InData%BlTwist) + call RegPackAlloc(RF, InData%TwrCb) + call RegPackAlloc(RF, InData%BlCenBn) + call RegPackAlloc(RF, InData%BlCenBt) + call RegPack(RF, InData%VolHub) + call RegPack(RF, InData%HubCenBx) + call RegPack(RF, InData%VolNac) + call RegPack(RF, InData%NacCenB) + call RegPack(RF, InData%VolBl) + call RegPack(RF, InData%VolTwr) + call RegPackAlloc(RF, InData%BlRad) + call RegPackAlloc(RF, InData%BlDL) + call RegPackAlloc(RF, InData%BlTaper) + call RegPackAlloc(RF, InData%BlAxCent) + call RegPackAlloc(RF, InData%TwrRad) + call RegPackAlloc(RF, InData%TwrDL) + call RegPackAlloc(RF, InData%TwrTaper) + call RegPackAlloc(RF, InData%TwrAxCent) + call BEMT_PackParam(RF, InData%BEMT) + call AA_PackParam(RF, InData%AA) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%TwrPotent) + call RegPack(RF, InData%TwrShadow) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%FrozenWake) + call RegPack(RF, InData%CavitCheck) + call RegPack(RF, InData%Buoyancy) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%CompAA) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%AeroProjMod) + call RegPack(RF, InData%AeroBEM_Mod) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_H_P(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPackAlloc(RF, InData%SigmaCavitCrit) - call RegPackAlloc(RF, InData%SigmaCavit) - call RegPackAlloc(RF, InData%CavitWarnSet) - call RegPackAlloc(RF, InData%TwrFB) - call RegPackAlloc(RF, InData%TwrMB) - call RegPackAlloc(RF, InData%HubFB) - call RegPackAlloc(RF, InData%HubMB) - call RegPackAlloc(RF, InData%NacFB) - call RegPackAlloc(RF, InData%NacMB) - call RegPack(RF, allocated(InData%BladeRootLoad)) - if (allocated(InData%BladeRootLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootLoad, kind=B8Ki), ubound(InData%BladeRootLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootLoad, kind=B8Ki) + call RegPack(RF, InData%NBlOuts) + call RegPack(RF, InData%BlOutNd) + call RegPack(RF, InData%NTwOuts) + call RegPack(RF, InData%TwOutNd) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPack(RF, InData%BldNd_TotNumOuts) + call RegPack(RF, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeRootLoad(i1)) - end do - end if - call RegPack(RF, allocated(InData%B_L_2_R_P)) - if (allocated(InData%B_L_2_R_P)) then - call RegPackBounds(RF, 1, lbound(InData%B_L_2_R_P, kind=B8Ki), ubound(InData%B_L_2_R_P, kind=B8Ki)) - LB(1:1) = lbound(InData%B_L_2_R_P, kind=B8Ki) - UB(1:1) = ubound(InData%B_L_2_R_P, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_R_P(i1)) - end do - end if - call RegPack(RF, allocated(InData%BladeBuoyLoadPoint)) - if (allocated(InData%BladeBuoyLoadPoint)) then - call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoadPoint, kind=B8Ki), ubound(InData%BladeBuoyLoadPoint, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeBuoyLoadPoint, kind=B8Ki) - UB(1:1) = ubound(InData%BladeBuoyLoadPoint, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeBuoyLoadPoint(i1)) - end do - end if - call RegPack(RF, allocated(InData%BladeBuoyLoad)) - if (allocated(InData%BladeBuoyLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoad, kind=B8Ki), ubound(InData%BladeBuoyLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeBuoyLoad, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeBuoyLoad(i1)) - end do - end if - call RegPack(RF, allocated(InData%B_P_2_B_L)) - if (allocated(InData%B_P_2_B_L)) then - call RegPackBounds(RF, 1, lbound(InData%B_P_2_B_L, kind=B8Ki), ubound(InData%B_P_2_B_L, kind=B8Ki)) - LB(1:1) = lbound(InData%B_P_2_B_L, kind=B8Ki) - UB(1:1) = ubound(InData%B_P_2_B_L, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(RF, InData%B_P_2_B_L(i1)) + call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) end do end if - call MeshPack(RF, InData%TwrBuoyLoadPoint) - call MeshPack(RF, InData%TwrBuoyLoad) - call NWTC_Library_PackMeshMapType(RF, InData%T_P_2_T_L) - call RegPack(RF, InData%FirstWarn_TowerStrike) - call RegPack(RF, InData%AvgDiskVel) - call RegPack(RF, InData%AvgDiskVelDist) - call RegPack(RF, InData%TFinAlpha) - call RegPack(RF, InData%TFinRe) - call RegPack(RF, InData%TFinVrel) - call RegPack(RF, InData%TFinVund_i) - call RegPack(RF, InData%TFinVind_i) - call RegPack(RF, InData%TFinVrel_i) - call RegPack(RF, InData%TFinSTV_i) - call RegPack(RF, InData%TFinF_i) - call RegPack(RF, InData%TFinM_i) + call RegPackAlloc(RF, InData%BldNd_BlOutNd) + call RegPack(RF, InData%BldNd_BladesOut) + call RegPack(RF, InData%TFinAero) + call AD_PackTFinParameterType(RF, InData%TFin) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotMiscVarType(RF, OutData) +subroutine AD_UnPackRotParameterType(RF, OutData) type(RegFile), intent(inout) :: RF - type(RotMiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + type(RotParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - call BEMT_UnpackMisc(RF, OutData%BEMT) ! BEMT - call BEMT_UnpackOutput(RF, OutData%BEMT_y) ! BEMT_y - LB(1:1) = lbound(OutData%BEMT_u, kind=B8Ki) - UB(1:1) = ubound(OutData%BEMT_u, kind=B8Ki) - do i1 = LB(1), UB(1) - call BEMT_UnpackInput(RF, OutData%BEMT_u(i1)) ! BEMT_u - end do - call AA_UnpackMisc(RF, OutData%AA) ! AA - call AA_UnpackOutput(RF, OutData%AA_y) ! AA_y - call AA_UnpackInput(RF, OutData%AA_u) ! AA_u - call RegUnpackAlloc(RF, OutData%DisturbedInflow); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%orientationAnnulus); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%R_li); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%W_Twr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%X_Twr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Y_Twr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Curve); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrClrnc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%X); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Z); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Mx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%My); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Mz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Vind_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%V_DiskAvg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%yaw); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%tilt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%hub_theta_x_root); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%V_dot_x); if (RegCheckErr(RF, RoutineName)) return - call MeshUnpack(RF, OutData%HubLoad) ! HubLoad - if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarDBEMT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarUA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTowerMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarNacelleMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHubMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladeRootMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladeMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarInflowOnBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarInflowOnTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarUserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTowerLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHubLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarNacelleLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladeLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCenB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolTwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlDL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTaper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAxCent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTaper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrAxCent); if (RegCheckErr(RF, RoutineName)) return + call BEMT_UnpackParam(RF, OutData%BEMT) ! BEMT + call AA_UnpackParam(RF, OutData%AA) ! AA + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrozenWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Buoyancy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroProjMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroBEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%B_L_2_H_P(LB(1):UB(1)),stat=stat) + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpackAlloc(RF, OutData%SigmaCavitCrit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SigmaCavit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CavitWarnSet); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrFB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrMB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%HubFB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%HubMB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NacFB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NacMB); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) + call RegUnpack(RF, OutData%NBlOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeRootLoad(LB(1):UB(1)),stat=stat) + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeRootLoad(i1)) ! BladeRootLoad + call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam end do end if - if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAero); if (RegCheckErr(RF, RoutineName)) return + call AD_UnpackTFinParameterType(RF, OutData%TFin) ! TFin +end subroutine + +subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AD_ParameterType), intent(in) :: SrcParamData + type(AD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%rotors)) then + LB(1:1) = lbound(SrcParamData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotors, kind=B8Ki) + if (.not. allocated(DstParamData%rotors)) then + allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P + call AD_CopyRotParameterType(SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + DstParamData%DT = SrcParamData%DT + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%AFI)) then + LB(1:1) = lbound(SrcParamData%AFI, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%AFI, kind=B8Ki) + if (.not. allocated(DstParamData%AFI)) then + allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint + call AFI_CopyParam(SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad - end do - end if - if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(RF, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L - end do - end if - call MeshUnpack(RF, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint - call MeshUnpack(RF, OutData%TwrBuoyLoad) ! TwrBuoyLoad - call NWTC_Library_UnpackMeshMapType(RF, OutData%T_P_2_T_L) ! T_P_2_T_L - call RegUnpack(RF, OutData%FirstWarn_TowerStrike); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgDiskVelDist); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinAlpha); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinRe); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVrel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVund_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVind_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVrel_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinSTV_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinF_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinM_i); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(AD_MiscVarType), intent(inout) :: SrcMiscData - type(AD_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcMiscData%rotors)) then - LB(1:1) = lbound(SrcMiscData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%rotors, kind=B8Ki) - if (.not. allocated(DstMiscData%rotors)) then - allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcMiscData%FVW_u)) then - LB(1:1) = lbound(SrcMiscData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FVW_u, kind=B8Ki) - if (.not. allocated(DstMiscData%FVW_u)) then - allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + DstParamData%SkewMod = SrcParamData%SkewMod + DstParamData%WakeMod = SrcParamData%WakeMod + call FVW_CopyParam(SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%WindPos)) then - LB(1:2) = lbound(SrcMiscData%WindPos, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindPos, kind=B8Ki) - if (.not. allocated(DstMiscData%WindPos)) then - allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%WindPos = SrcMiscData%WindPos - end if - if (allocated(SrcMiscData%WindVel)) then - LB(1:2) = lbound(SrcMiscData%WindVel, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindVel, kind=B8Ki) - if (.not. allocated(DstMiscData%WindVel)) then - allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%WindVel = SrcMiscData%WindVel - end if - if (allocated(SrcMiscData%WindAcc)) then - LB(1:2) = lbound(SrcMiscData%WindAcc, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindAcc, kind=B8Ki) - if (.not. allocated(DstMiscData%WindAcc)) then - allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%WindAcc = SrcMiscData%WindAcc - end if + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps + DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%FlowField => SrcParamData%FlowField end subroutine -subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(AD_MiscVarType), intent(inout) :: MiscData +subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyMisc' + character(*), parameter :: RoutineName = 'AD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%rotors)) then - LB(1:1) = lbound(MiscData%rotors, kind=B8Ki) - UB(1:1) = ubound(MiscData%rotors, kind=B8Ki) + if (allocated(ParamData%rotors)) then + LB(1:1) = lbound(ParamData%rotors, kind=B8Ki) + UB(1:1) = ubound(ParamData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) + call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%rotors) + deallocate(ParamData%rotors) end if - if (allocated(MiscData%FVW_u)) then - LB(1:1) = lbound(MiscData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(MiscData%FVW_u, kind=B8Ki) + if (allocated(ParamData%AFI)) then + LB(1:1) = lbound(ParamData%AFI, kind=B8Ki) + UB(1:1) = ubound(ParamData%AFI, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) + call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%FVW_u) + deallocate(ParamData%AFI) end if - call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) + call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%WindPos)) then - deallocate(MiscData%WindPos) - end if - if (allocated(MiscData%WindVel)) then - deallocate(MiscData%WindVel) - end if - if (allocated(MiscData%WindAcc)) then - deallocate(MiscData%WindAcc) - end if + nullify(ParamData%FlowField) end subroutine -subroutine AD_PackMisc(RF, Indata) +subroutine AD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF - type(AD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + type(AD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackParam' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then @@ -3978,34 +3845,45 @@ subroutine AD_PackMisc(RF, Indata) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotMiscVarType(RF, InData%rotors(i1)) + call AD_PackRotParameterType(RF, InData%rotors(i1)) end do end if - call RegPack(RF, allocated(InData%FVW_u)) - if (allocated(InData%FVW_u)) then - call RegPackBounds(RF, 1, lbound(InData%FVW_u, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) - LB(1:1) = lbound(InData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(InData%FVW_u, kind=B8Ki) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%AFI)) + if (allocated(InData%AFI)) then + call RegPackBounds(RF, 1, lbound(InData%AFI, kind=B8Ki), ubound(InData%AFI, kind=B8Ki)) + LB(1:1) = lbound(InData%AFI, kind=B8Ki) + UB(1:1) = ubound(InData%AFI, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackInput(RF, InData%FVW_u(i1)) + call AFI_PackParam(RF, InData%AFI(i1)) end do end if - call FVW_PackOutput(RF, InData%FVW_y) - call FVW_PackMisc(RF, InData%FVW) - call RegPackAlloc(RF, InData%WindPos) - call RegPackAlloc(RF, InData%WindVel) - call RegPackAlloc(RF, InData%WindAcc) + call RegPack(RF, InData%SkewMod) + call RegPack(RF, InData%WakeMod) + call FVW_PackParam(RF, InData%FVW) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackMisc(RF, OutData) +subroutine AD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + type(AD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackParam' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return @@ -4017,1499 +3895,1880 @@ subroutine AD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors + call AD_UnpackRotParameterType(RF, OutData%rotors(i1)) ! rotors end do end if - if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%AFI)) deallocate(OutData%AFI) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) + allocate(OutData%AFI(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u + call AFI_UnpackParam(RF, OutData%AFI(i1)) ! AFI end do end if - call FVW_UnpackOutput(RF, OutData%FVW_y) ! FVW_y - call FVW_UnpackMisc(RF, OutData%FVW) ! FVW - call RegUnpackAlloc(RF, OutData%WindPos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WindVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WindAcc); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotParameterType), intent(in) :: SrcRotParameterTypeData - type(RotParameterType), intent(inout) :: DstRotParameterTypeData + call RegUnpack(RF, OutData%SkewMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeMod); if (RegCheckErr(RF, RoutineName)) return + call FVW_UnpackParam(RF, OutData%FVW) ! FVW + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +subroutine AD_CopyBldInputType(SrcBldInputTypeData, DstBldInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(BldInputType), intent(in) :: SrcBldInputTypeData + type(BldInputType), intent(inout) :: DstBldInputTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' + character(*), parameter :: RoutineName = 'AD_CopyBldInputType' ErrStat = ErrID_None ErrMsg = '' - DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades - DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds - DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds - if (allocated(SrcRotParameterTypeData%TwrDiam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then - allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcBldInputTypeData%InflowOnBlade)) then + LB(1:2) = lbound(SrcBldInputTypeData%InflowOnBlade, kind=B8Ki) + UB(1:2) = ubound(SrcBldInputTypeData%InflowOnBlade, kind=B8Ki) + if (.not. allocated(DstBldInputTypeData%InflowOnBlade)) then + allocate(DstBldInputTypeData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstBldInputTypeData%InflowOnBlade.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam + DstBldInputTypeData%InflowOnBlade = SrcBldInputTypeData%InflowOnBlade end if - if (allocated(SrcRotParameterTypeData%TwrCd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrCd)) then - allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcBldInputTypeData%AccelOnBlade)) then + LB(1:2) = lbound(SrcBldInputTypeData%AccelOnBlade, kind=B8Ki) + UB(1:2) = ubound(SrcBldInputTypeData%AccelOnBlade, kind=B8Ki) + if (.not. allocated(DstBldInputTypeData%AccelOnBlade)) then + allocate(DstBldInputTypeData%AccelOnBlade(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstBldInputTypeData%AccelOnBlade.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd + DstBldInputTypeData%AccelOnBlade = SrcBldInputTypeData%AccelOnBlade end if - if (allocated(SrcRotParameterTypeData%TwrTI)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrTI)) then - allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI +end subroutine + +subroutine AD_DestroyBldInputType(BldInputTypeData, ErrStat, ErrMsg) + type(BldInputType), intent(inout) :: BldInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyBldInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BldInputTypeData%InflowOnBlade)) then + deallocate(BldInputTypeData%InflowOnBlade) end if - if (allocated(SrcRotParameterTypeData%BlTwist)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlTwist)) then - allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist + if (allocated(BldInputTypeData%AccelOnBlade)) then + deallocate(BldInputTypeData%AccelOnBlade) end if - if (allocated(SrcRotParameterTypeData%TwrCb)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrCb)) then - allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) +end subroutine + +subroutine AD_PackBldInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BldInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackBldInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%InflowOnBlade) + call RegPackAlloc(RF, InData%AccelOnBlade) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackBldInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BldInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackBldInputType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%InflowOnBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccelOnBlade); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: SrcRotInputTypeData + type(RotInputType), intent(inout) :: DstRotInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) + if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then + allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcRotParameterTypeData%BlCenBn)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then - allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) + if (.not. allocated(DstRotInputTypeData%BladeMotion)) then + allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcRotParameterTypeData%BlCenBt)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then - allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%Bld)) then + LB(1:1) = lbound(SrcRotInputTypeData%Bld, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputTypeData%Bld, kind=B8Ki) + if (.not. allocated(DstRotInputTypeData%Bld)) then + allocate(DstRotInputTypeData%Bld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%Bld.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt + do i1 = LB(1), UB(1) + call AD_CopyBldInputType(SrcRotInputTypeData%Bld(i1), DstRotInputTypeData%Bld(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub - DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx - DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac - DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB - DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl - DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr - if (allocated(SrcRotParameterTypeData%BlRad)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlRad, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlRad, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlRad)) then - allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotInputTypeData%InflowOnTower)) then + LB(1:2) = lbound(SrcRotInputTypeData%InflowOnTower, kind=B8Ki) + UB(1:2) = ubound(SrcRotInputTypeData%InflowOnTower, kind=B8Ki) + if (.not. allocated(DstRotInputTypeData%InflowOnTower)) then + allocate(DstRotInputTypeData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnTower.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad + DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower end if - if (allocated(SrcRotParameterTypeData%BlDL)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlDL, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlDL, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlDL)) then - allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotInputTypeData%AccelOnTower)) then + LB(1:2) = lbound(SrcRotInputTypeData%AccelOnTower, kind=B8Ki) + UB(1:2) = ubound(SrcRotInputTypeData%AccelOnTower, kind=B8Ki) + if (.not. allocated(DstRotInputTypeData%AccelOnTower)) then + allocate(DstRotInputTypeData%AccelOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%AccelOnTower.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL + DstRotInputTypeData%AccelOnTower = SrcRotInputTypeData%AccelOnTower end if - if (allocated(SrcRotParameterTypeData%BlTaper)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlTaper)) then - allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub + DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle + DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin + DstRotInputTypeData%AvgDiskVel = SrcRotInputTypeData%AvgDiskVel + if (allocated(SrcRotInputTypeData%UserProp)) then + LB(1:2) = lbound(SrcRotInputTypeData%UserProp, kind=B8Ki) + UB(1:2) = ubound(SrcRotInputTypeData%UserProp, kind=B8Ki) + if (.not. allocated(DstRotInputTypeData%UserProp)) then + allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper + DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp end if - if (allocated(SrcRotParameterTypeData%BlAxCent)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then - allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent - end if - if (allocated(SrcRotParameterTypeData%TwrRad)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrRad)) then - allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad - end if - if (allocated(SrcRotParameterTypeData%TwrDL)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrDL)) then - allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL - end if - if (allocated(SrcRotParameterTypeData%TwrTaper)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then - allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper - end if - if (allocated(SrcRotParameterTypeData%TwrAxCent)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then - allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent - end if - call BEMT_CopyParam(SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) +end subroutine + +subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: RotInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AA_CopyParam(SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotParameterTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcRotParameterTypeData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%Jac_u_indx)) then - allocate(DstRotParameterTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx - end if - if (allocated(SrcRotParameterTypeData%du)) then - LB(1:1) = lbound(SrcRotParameterTypeData%du, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%du, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%du)) then - allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%du = SrcRotParameterTypeData%du - end if - if (allocated(SrcRotParameterTypeData%dx)) then - LB(1:1) = lbound(SrcRotParameterTypeData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%dx, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%dx)) then - allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx + call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(RotInputTypeData%BladeRootMotion, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeRootMotion) end if - DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny - DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin - DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent - DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow - DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero - DstRotParameterTypeData%FrozenWake = SrcRotParameterTypeData%FrozenWake - DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck - DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy - DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK - DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA - DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens - DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc - DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound - DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity - DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm - DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap - DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth - DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL - DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod - DstRotParameterTypeData%AeroBEM_Mod = SrcRotParameterTypeData%AeroBEM_Mod - DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts - DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName - if (allocated(SrcRotParameterTypeData%OutParam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%OutParam, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%OutParam)) then - allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + if (allocated(RotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeMotion, kind=B8Ki) + UB(1:1) = ubound(RotInputTypeData%BladeMotion, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(RotInputTypeData%BladeMotion) end if - DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts - DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd - DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts - DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd - DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts - DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts - if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then - allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%Bld)) then + LB(1:1) = lbound(RotInputTypeData%Bld, kind=B8Ki) + UB(1:1) = ubound(RotInputTypeData%Bld, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_DestroyBldInputType(RotInputTypeData%Bld(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(RotInputTypeData%Bld) end if - if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then - allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd + if (allocated(RotInputTypeData%InflowOnTower)) then + deallocate(RotInputTypeData%InflowOnTower) + end if + if (allocated(RotInputTypeData%AccelOnTower)) then + deallocate(RotInputTypeData%AccelOnTower) + end if + if (allocated(RotInputTypeData%UserProp)) then + deallocate(RotInputTypeData%UserProp) end if - DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut - DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero - call AD_CopyTFinParameterType(SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine -subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) - type(RotParameterType), intent(inout) :: RotParameterTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg +subroutine AD_PackRotInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInputType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(RotParameterTypeData%TwrDiam)) then - deallocate(RotParameterTypeData%TwrDiam) - end if - if (allocated(RotParameterTypeData%TwrCd)) then - deallocate(RotParameterTypeData%TwrCd) - end if - if (allocated(RotParameterTypeData%TwrTI)) then - deallocate(RotParameterTypeData%TwrTI) - end if - if (allocated(RotParameterTypeData%BlTwist)) then - deallocate(RotParameterTypeData%BlTwist) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%TowerMotion) + call MeshPack(RF, InData%HubMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do end if - if (allocated(RotParameterTypeData%TwrCb)) then - deallocate(RotParameterTypeData%TwrCb) + call RegPack(RF, allocated(InData%BladeMotion)) + if (allocated(InData%BladeMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeMotion, kind=B8Ki) + UB(1:1) = ubound(InData%BladeMotion, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeMotion(i1)) + end do end if - if (allocated(RotParameterTypeData%BlCenBn)) then - deallocate(RotParameterTypeData%BlCenBn) - end if - if (allocated(RotParameterTypeData%BlCenBt)) then - deallocate(RotParameterTypeData%BlCenBt) - end if - if (allocated(RotParameterTypeData%BlRad)) then - deallocate(RotParameterTypeData%BlRad) - end if - if (allocated(RotParameterTypeData%BlDL)) then - deallocate(RotParameterTypeData%BlDL) - end if - if (allocated(RotParameterTypeData%BlTaper)) then - deallocate(RotParameterTypeData%BlTaper) - end if - if (allocated(RotParameterTypeData%BlAxCent)) then - deallocate(RotParameterTypeData%BlAxCent) - end if - if (allocated(RotParameterTypeData%TwrRad)) then - deallocate(RotParameterTypeData%TwrRad) - end if - if (allocated(RotParameterTypeData%TwrDL)) then - deallocate(RotParameterTypeData%TwrDL) - end if - if (allocated(RotParameterTypeData%TwrTaper)) then - deallocate(RotParameterTypeData%TwrTaper) - end if - if (allocated(RotParameterTypeData%TwrAxCent)) then - deallocate(RotParameterTypeData%TwrAxCent) - end if - call BEMT_DestroyParam(RotParameterTypeData%BEMT, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyParam(RotParameterTypeData%AA, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotParameterTypeData%Jac_u_indx)) then - deallocate(RotParameterTypeData%Jac_u_indx) - end if - if (allocated(RotParameterTypeData%du)) then - deallocate(RotParameterTypeData%du) - end if - if (allocated(RotParameterTypeData%dx)) then - deallocate(RotParameterTypeData%dx) - end if - if (allocated(RotParameterTypeData%OutParam)) then - LB(1:1) = lbound(RotParameterTypeData%OutParam, kind=B8Ki) - UB(1:1) = ubound(RotParameterTypeData%OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotParameterTypeData%OutParam) - end if - if (allocated(RotParameterTypeData%BldNd_OutParam)) then - LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotParameterTypeData%BldNd_OutParam) - end if - if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then - deallocate(RotParameterTypeData%BldNd_BlOutNd) - end if - call AD_DestroyTFinParameterType(RotParameterTypeData%TFin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine AD_PackRotParameterType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(RotParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotParameterType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%NumBlades) - call RegPack(RF, InData%NumBlNds) - call RegPack(RF, InData%NumTwrNds) - call RegPackAlloc(RF, InData%TwrDiam) - call RegPackAlloc(RF, InData%TwrCd) - call RegPackAlloc(RF, InData%TwrTI) - call RegPackAlloc(RF, InData%BlTwist) - call RegPackAlloc(RF, InData%TwrCb) - call RegPackAlloc(RF, InData%BlCenBn) - call RegPackAlloc(RF, InData%BlCenBt) - call RegPack(RF, InData%VolHub) - call RegPack(RF, InData%HubCenBx) - call RegPack(RF, InData%VolNac) - call RegPack(RF, InData%NacCenB) - call RegPack(RF, InData%VolBl) - call RegPack(RF, InData%VolTwr) - call RegPackAlloc(RF, InData%BlRad) - call RegPackAlloc(RF, InData%BlDL) - call RegPackAlloc(RF, InData%BlTaper) - call RegPackAlloc(RF, InData%BlAxCent) - call RegPackAlloc(RF, InData%TwrRad) - call RegPackAlloc(RF, InData%TwrDL) - call RegPackAlloc(RF, InData%TwrTaper) - call RegPackAlloc(RF, InData%TwrAxCent) - call BEMT_PackParam(RF, InData%BEMT) - call AA_PackParam(RF, InData%AA) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%du) - call RegPackAlloc(RF, InData%dx) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%NumBl_Lin) - call RegPack(RF, InData%TwrPotent) - call RegPack(RF, InData%TwrShadow) - call RegPack(RF, InData%TwrAero) - call RegPack(RF, InData%FrozenWake) - call RegPack(RF, InData%CavitCheck) - call RegPack(RF, InData%Buoyancy) - call RegPack(RF, InData%MHK) - call RegPack(RF, InData%CompAA) - call RegPack(RF, InData%AirDens) - call RegPack(RF, InData%KinVisc) - call RegPack(RF, InData%SpdSound) - call RegPack(RF, InData%Gravity) - call RegPack(RF, InData%Patm) - call RegPack(RF, InData%Pvap) - call RegPack(RF, InData%WtrDpth) - call RegPack(RF, InData%MSL2SWL) - call RegPack(RF, InData%AeroProjMod) - call RegPack(RF, InData%AeroBEM_Mod) - call RegPack(RF, InData%NumOuts) - call RegPack(RF, InData%RootName) - call RegPack(RF, allocated(InData%OutParam)) - if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) - end do - end if - call RegPack(RF, InData%NBlOuts) - call RegPack(RF, InData%BlOutNd) - call RegPack(RF, InData%NTwOuts) - call RegPack(RF, InData%TwOutNd) - call RegPack(RF, InData%BldNd_NumOuts) - call RegPack(RF, InData%BldNd_TotNumOuts) - call RegPack(RF, allocated(InData%BldNd_OutParam)) - if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) + call MeshPack(RF, InData%TFinMotion) + call RegPack(RF, allocated(InData%Bld)) + if (allocated(InData%Bld)) then + call RegPackBounds(RF, 1, lbound(InData%Bld, kind=B8Ki), ubound(InData%Bld, kind=B8Ki)) + LB(1:1) = lbound(InData%Bld, kind=B8Ki) + UB(1:1) = ubound(InData%Bld, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) + call AD_PackBldInputType(RF, InData%Bld(i1)) end do end if - call RegPackAlloc(RF, InData%BldNd_BlOutNd) - call RegPack(RF, InData%BldNd_BladesOut) - call RegPack(RF, InData%TFinAero) - call AD_PackTFinParameterType(RF, InData%TFin) + call RegPackAlloc(RF, InData%InflowOnTower) + call RegPackAlloc(RF, InData%AccelOnTower) + call RegPack(RF, InData%InflowOnHub) + call RegPack(RF, InData%InflowOnNacelle) + call RegPack(RF, InData%InflowOnTailFin) + call RegPack(RF, InData%AvgDiskVel) + call RegPackAlloc(RF, InData%UserProp) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotParameterType(RF, OutData) +subroutine AD_UnPackRotInputType(RF, OutData) type(RegFile), intent(inout) :: RF - type(RotParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' + type(RotInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacCenB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VolBl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VolTwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlRad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlDL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlTaper); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlAxCent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrRad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrDL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrTaper); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrAxCent); if (RegCheckErr(RF, RoutineName)) return - call BEMT_UnpackParam(RF, OutData%BEMT) ! BEMT - call AA_UnpackParam(RF, OutData%AA) ! AA - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%FrozenWake); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Buoyancy); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AeroProjMod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AeroBEM_Mod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%TowerMotion) ! TowerMotion + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion end do end if - call RegUnpack(RF, OutData%NBlOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BlOutNd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NTwOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwOutNd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion end do end if - call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinAero); if (RegCheckErr(RF, RoutineName)) return - call AD_UnpackTFinParameterType(RF, OutData%TFin) ! TFin -end subroutine - -subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(AD_ParameterType), intent(in) :: SrcParamData - type(AD_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode + call MeshUnpack(RF, OutData%TFinMotion) ! TFinMotion + if (allocated(OutData%Bld)) deallocate(OutData%Bld) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Bld(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBldInputType(RF, OutData%Bld(i1)) ! Bld + end do + end if + call RegUnpackAlloc(RF, OutData%InflowOnTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccelOnTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnNacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnTailFin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: SrcInputData + type(AD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyParam' + character(*), parameter :: RoutineName = 'AD_CopyInput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcParamData%rotors)) then - LB(1:1) = lbound(SrcParamData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotors, kind=B8Ki) - if (.not. allocated(DstParamData%rotors)) then - allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%rotors)) then + LB(1:1) = lbound(SrcInputData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%rotors, kind=B8Ki) + if (.not. allocated(DstInputData%rotors)) then + allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyRotParameterType(SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_CopyRotInputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - DstParamData%DT = SrcParamData%DT - DstParamData%RootName = SrcParamData%RootName - if (allocated(SrcParamData%AFI)) then - LB(1:1) = lbound(SrcParamData%AFI, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AFI, kind=B8Ki) - if (.not. allocated(DstParamData%AFI)) then - allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%InflowWakeVel)) then + LB(1:2) = lbound(SrcInputData%InflowWakeVel, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%InflowWakeVel, kind=B8Ki) + if (.not. allocated(DstInputData%InflowWakeVel)) then + allocate(DstInputData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) return end if end if + DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel + end if +end subroutine + +subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%rotors)) then + LB(1:1) = lbound(InputData%rotors, kind=B8Ki) + UB(1:1) = ubound(InputData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AFI_CopyParam(SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(InputData%rotors) + end if + if (allocated(InputData%InflowWakeVel)) then + deallocate(InputData%InflowWakeVel) end if - DstParamData%SkewMod = SrcParamData%SkewMod - DstParamData%WakeMod = SrcParamData%WakeMod - call FVW_CopyParam(SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps - DstParamData%UA_Flag = SrcParamData%UA_Flag - DstParamData%FlowField => SrcParamData%FlowField end subroutine -subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(AD_ParameterType), intent(inout) :: ParamData +subroutine AD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInput' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackRotInputType(RF, InData%rotors(i1)) + end do + end if + call RegPackAlloc(RF, InData%InflowWakeVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInput' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInputType(RF, OutData%rotors(i1)) ! rotors + end do + end if + call RegUnpackAlloc(RF, OutData%InflowWakeVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: SrcRotOutputTypeData + type(RotOutputType), intent(inout) :: DstRotOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyParam' + character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ParamData%rotors)) then - LB(1:1) = lbound(ParamData%rotors, kind=B8Ki) - UB(1:1) = ubound(ParamData%rotors, kind=B8Ki) + call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) + UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) + if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then + allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) + call MeshCopy(SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do - deallocate(ParamData%rotors) end if - if (allocated(ParamData%AFI)) then - LB(1:1) = lbound(ParamData%AFI, kind=B8Ki) - UB(1:1) = ubound(ParamData%AFI, kind=B8Ki) + call MeshCopy(SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%WriteOutput)) then + LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) + if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then + allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput + end if +end subroutine + +subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: RotOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(RotOutputTypeData%BladeLoad, kind=B8Ki) + UB(1:1) = ubound(RotOutputTypeData%BladeLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) + call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%AFI) + deallocate(RotOutputTypeData%BladeLoad) end if - call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) + call MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(ParamData%FlowField) + if (allocated(RotOutputTypeData%WriteOutput)) then + deallocate(RotOutputTypeData%WriteOutput) + end if end subroutine -subroutine AD_PackParam(RF, Indata) +subroutine AD_PackRotOutputType(RF, Indata) type(RegFile), intent(inout) :: RF - type(AD_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackParam' + type(RotOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotOutputType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%rotors)) - if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call MeshPack(RF, InData%NacelleLoad) + call MeshPack(RF, InData%HubLoad) + call MeshPack(RF, InData%TowerLoad) + call RegPack(RF, allocated(InData%BladeLoad)) + if (allocated(InData%BladeLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLoad, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeLoad, kind=B8Ki) + UB(1:1) = ubound(InData%BladeLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotParameterType(RF, InData%rotors(i1)) + call MeshPack(RF, InData%BladeLoad(i1)) end do end if - call RegPack(RF, InData%DT) - call RegPack(RF, InData%RootName) - call RegPack(RF, allocated(InData%AFI)) - if (allocated(InData%AFI)) then - call RegPackBounds(RF, 1, lbound(InData%AFI, kind=B8Ki), ubound(InData%AFI, kind=B8Ki)) - LB(1:1) = lbound(InData%AFI, kind=B8Ki) - UB(1:1) = ubound(InData%AFI, kind=B8Ki) - do i1 = LB(1), UB(1) - call AFI_PackParam(RF, InData%AFI(i1)) + call MeshPack(RF, InData%TFinLoad) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%NacelleLoad) ! NacelleLoad + call MeshUnpack(RF, OutData%HubLoad) ! HubLoad + call MeshUnpack(RF, OutData%TowerLoad) ! TowerLoad + if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad + end do + end if + call MeshUnpack(RF, OutData%TFinLoad) ! TFinLoad + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: SrcOutputData + type(AD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%rotors)) then + LB(1:1) = lbound(SrcOutputData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%rotors, kind=B8Ki) + if (.not. allocated(DstOutputData%rotors)) then + allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotOutputType(SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%rotors)) then + LB(1:1) = lbound(OutputData%rotors, kind=B8Ki) + UB(1:1) = ubound(OutputData%rotors, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%rotors) + end if +end subroutine + +subroutine AD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackOutput' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackRotOutputType(RF, InData%rotors(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackOutput' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotOutputType(RF, OutData%rotors(i1)) ! rotors end do end if - call RegPack(RF, InData%SkewMod) - call RegPack(RF, InData%WakeMod) - call FVW_PackParam(RF, InData%FVW) - call RegPack(RF, InData%CompAeroMaps) - call RegPack(RF, InData%UA_Flag) - call RegPack(RF, associated(InData%FlowField)) - if (associated(InData%FlowField)) then - call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) - if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) +end subroutine + +subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: SrcRotMiscVarTypeData + type(RotMiscVarType), intent(inout) :: DstRotMiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcRotMiscVarTypeData%Jac, DstRotMiscVarTypeData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotContinuousStateType(SrcRotMiscVarTypeData%x_init, DstRotMiscVarTypeData%x_init, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotContinuousStateType(SrcRotMiscVarTypeData%x_perturb, DstRotMiscVarTypeData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotContinuousStateType(SrcRotMiscVarTypeData%dxdt_lin, DstRotMiscVarTypeData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotInputType(SrcRotMiscVarTypeData%u_perturb, DstRotMiscVarTypeData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotOutputType(SrcRotMiscVarTypeData%y_lin, DstRotMiscVarTypeData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotConstraintStateType(SrcRotMiscVarTypeData%z_lin, DstRotMiscVarTypeData%z_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotOtherStateType(SrcRotMiscVarTypeData%OtherState_init, DstRotMiscVarTypeData%OtherState_init, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotOtherStateType(SrcRotMiscVarTypeData%OtherState_jac, DstRotMiscVarTypeData%OtherState_jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BEMT_CopyMisc(SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) + do i1 = LB(1), UB(1) + call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AA_CopyMisc(SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyOutput(SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyInput(SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) + UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then + allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow + end if + if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then + LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) + UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then + allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus + end if + if (allocated(SrcRotMiscVarTypeData%R_li)) then + LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) + UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%R_li)) then + allocate(DstRotMiscVarTypeData%R_li(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%R_li.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li + end if + if (allocated(SrcRotMiscVarTypeData%AllOuts)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then + allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts + end if + if (allocated(SrcRotMiscVarTypeData%W_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then + allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr + end if + if (allocated(SrcRotMiscVarTypeData%X_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then + allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr + end if + if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then + allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr + end if + if (allocated(SrcRotMiscVarTypeData%Curve)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Curve, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Curve, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%Curve)) then + allocate(DstRotMiscVarTypeData%Curve(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Curve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve + end if + if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then + allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc + end if + if (allocated(SrcRotMiscVarTypeData%X)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%X, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%X, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%X)) then + allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X + end if + if (allocated(SrcRotMiscVarTypeData%Y)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Y, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Y, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%Y)) then + allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y + end if + if (allocated(SrcRotMiscVarTypeData%Z)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Z, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Z, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%Z)) then + allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z + end if + if (allocated(SrcRotMiscVarTypeData%M)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%M, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%M, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%M)) then + allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M + end if + if (allocated(SrcRotMiscVarTypeData%Mx)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%Mx)) then + allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx + end if + if (allocated(SrcRotMiscVarTypeData%My)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%My, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%My, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%My)) then + allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My + end if + if (allocated(SrcRotMiscVarTypeData%Mz)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%Mz)) then + allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz + end if + if (allocated(SrcRotMiscVarTypeData%Vind_i)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) + UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%Vind_i)) then + allocate(DstRotMiscVarTypeData%Vind_i(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Vind_i.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Vind_i = SrcRotMiscVarTypeData%Vind_i + end if + DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg + DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw + DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt + if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then + allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg, RoutineName) + return + end if end if + DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(AD_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%rotors(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x + call MeshCopy(SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call AD_UnpackRotParameterType(RF, OutData%rotors(i1)) ! rotors + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%AFI)) deallocate(OutData%AFI) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%AFI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then + allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call AFI_UnpackParam(RF, OutData%AFI(i1)) ! AFI - end do + DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit end if - call RegUnpack(RF, OutData%SkewMod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WakeMod); if (RegCheckErr(RF, RoutineName)) return - call FVW_UnpackParam(RF, OutData%FVW) ! FVW - call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%FlowField) - else - allocate(OutData%FlowField,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then + allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg, RoutineName) return end if - RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField end if - else - OutData%FlowField => null() + DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit end if -end subroutine - -subroutine AD_CopyBldInputType(SrcBldInputTypeData, DstBldInputTypeData, CtrlCode, ErrStat, ErrMsg) - type(BldInputType), intent(in) :: SrcBldInputTypeData - type(BldInputType), intent(inout) :: DstBldInputTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'AD_CopyBldInputType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcBldInputTypeData%InflowOnBlade)) then - LB(1:2) = lbound(SrcBldInputTypeData%InflowOnBlade, kind=B8Ki) - UB(1:2) = ubound(SrcBldInputTypeData%InflowOnBlade, kind=B8Ki) - if (.not. allocated(DstBldInputTypeData%InflowOnBlade)) then - allocate(DstBldInputTypeData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then + allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBldInputTypeData%InflowOnBlade.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg, RoutineName) return end if end if - DstBldInputTypeData%InflowOnBlade = SrcBldInputTypeData%InflowOnBlade + DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet end if - if (allocated(SrcBldInputTypeData%AccelOnBlade)) then - LB(1:2) = lbound(SrcBldInputTypeData%AccelOnBlade, kind=B8Ki) - UB(1:2) = ubound(SrcBldInputTypeData%AccelOnBlade, kind=B8Ki) - if (.not. allocated(DstBldInputTypeData%AccelOnBlade)) then - allocate(DstBldInputTypeData%AccelOnBlade(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%TwrFB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then + allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBldInputTypeData%AccelOnBlade.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstBldInputTypeData%AccelOnBlade = SrcBldInputTypeData%AccelOnBlade + DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB end if -end subroutine - -subroutine AD_DestroyBldInputType(BldInputTypeData, ErrStat, ErrMsg) - type(BldInputType), intent(inout) :: BldInputTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_DestroyBldInputType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(BldInputTypeData%InflowOnBlade)) then - deallocate(BldInputTypeData%InflowOnBlade) + if (allocated(SrcRotMiscVarTypeData%TwrMB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then + allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB end if - if (allocated(BldInputTypeData%AccelOnBlade)) then - deallocate(BldInputTypeData%AccelOnBlade) + if (allocated(SrcRotMiscVarTypeData%HubFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then + allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB end if -end subroutine - -subroutine AD_PackBldInputType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(BldInputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackBldInputType' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%InflowOnBlade) - call RegPackAlloc(RF, InData%AccelOnBlade) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackBldInputType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(BldInputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackBldInputType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%InflowOnBlade); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AccelOnBlade); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotInputType), intent(inout) :: SrcRotInputTypeData - type(RotInputType), intent(inout) :: DstRotInputTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotInputType' - ErrStat = ErrID_None - ErrMsg = '' - call MeshCopy(SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then - allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%HubMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then + allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB + end if + if (allocated(SrcRotMiscVarTypeData%NacFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then + allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB end if - if (allocated(SrcRotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%BladeMotion)) then - allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%NacMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then + allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB + end if + if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then + allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotInputTypeData%Bld)) then - LB(1:1) = lbound(SrcRotInputTypeData%Bld, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputTypeData%Bld, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%Bld)) then - allocate(DstRotInputTypeData%Bld(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%Bld.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyBldInputType(SrcRotInputTypeData%Bld(i1), DstRotInputTypeData%Bld(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcRotInputTypeData%InflowOnTower)) then - LB(1:2) = lbound(SrcRotInputTypeData%InflowOnTower, kind=B8Ki) - UB(1:2) = ubound(SrcRotInputTypeData%InflowOnTower, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%InflowOnTower)) then - allocate(DstRotInputTypeData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnTower.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcRotInputTypeData%AccelOnTower)) then - LB(1:2) = lbound(SrcRotInputTypeData%AccelOnTower, kind=B8Ki) - UB(1:2) = ubound(SrcRotInputTypeData%AccelOnTower, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%AccelOnTower)) then - allocate(DstRotInputTypeData%AccelOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%AccelOnTower.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotInputTypeData%AccelOnTower = SrcRotInputTypeData%AccelOnTower + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub - DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle - DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin - DstRotInputTypeData%AvgDiskVel = SrcRotInputTypeData%AvgDiskVel - if (allocated(SrcRotInputTypeData%UserProp)) then - LB(1:2) = lbound(SrcRotInputTypeData%UserProp, kind=B8Ki) - UB(1:2) = ubound(SrcRotInputTypeData%UserProp, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%UserProp)) then - allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) + if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then + allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike + DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel + DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist + DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha + DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe + DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel + DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i + DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i + DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i + DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i + DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i + DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i end subroutine -subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) - type(RotInputType), intent(inout) :: RotInputTypeData +subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' + character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' ErrStat = ErrID_None ErrMsg = '' - call MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModJacType(RotMiscVarTypeData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType(RotMiscVarTypeData%x_init, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType(RotMiscVarTypeData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(RotInputTypeData%BladeRootMotion, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotInputTypeData%BladeRootMotion) + call AD_DestroyRotContinuousStateType(RotMiscVarTypeData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotInputType(RotMiscVarTypeData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotOutputType(RotMiscVarTypeData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotConstraintStateType(RotMiscVarTypeData%z_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotOtherStateType(RotMiscVarTypeData%OtherState_init, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotOtherStateType(RotMiscVarTypeData%OtherState_jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BEMT_DestroyMisc(RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) + do i1 = LB(1), UB(1) + call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AA_DestroyMisc(RotMiscVarTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyOutput(RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyInput(RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotMiscVarTypeData%DisturbedInflow)) then + deallocate(RotMiscVarTypeData%DisturbedInflow) end if - if (allocated(RotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(RotInputTypeData%BladeMotion, kind=B8Ki) + if (allocated(RotMiscVarTypeData%orientationAnnulus)) then + deallocate(RotMiscVarTypeData%orientationAnnulus) + end if + if (allocated(RotMiscVarTypeData%R_li)) then + deallocate(RotMiscVarTypeData%R_li) + end if + if (allocated(RotMiscVarTypeData%AllOuts)) then + deallocate(RotMiscVarTypeData%AllOuts) + end if + if (allocated(RotMiscVarTypeData%W_Twr)) then + deallocate(RotMiscVarTypeData%W_Twr) + end if + if (allocated(RotMiscVarTypeData%X_Twr)) then + deallocate(RotMiscVarTypeData%X_Twr) + end if + if (allocated(RotMiscVarTypeData%Y_Twr)) then + deallocate(RotMiscVarTypeData%Y_Twr) + end if + if (allocated(RotMiscVarTypeData%Curve)) then + deallocate(RotMiscVarTypeData%Curve) + end if + if (allocated(RotMiscVarTypeData%TwrClrnc)) then + deallocate(RotMiscVarTypeData%TwrClrnc) + end if + if (allocated(RotMiscVarTypeData%X)) then + deallocate(RotMiscVarTypeData%X) + end if + if (allocated(RotMiscVarTypeData%Y)) then + deallocate(RotMiscVarTypeData%Y) + end if + if (allocated(RotMiscVarTypeData%Z)) then + deallocate(RotMiscVarTypeData%Z) + end if + if (allocated(RotMiscVarTypeData%M)) then + deallocate(RotMiscVarTypeData%M) + end if + if (allocated(RotMiscVarTypeData%Mx)) then + deallocate(RotMiscVarTypeData%Mx) + end if + if (allocated(RotMiscVarTypeData%My)) then + deallocate(RotMiscVarTypeData%My) + end if + if (allocated(RotMiscVarTypeData%Mz)) then + deallocate(RotMiscVarTypeData%Mz) + end if + if (allocated(RotMiscVarTypeData%Vind_i)) then + deallocate(RotMiscVarTypeData%Vind_i) + end if + if (allocated(RotMiscVarTypeData%hub_theta_x_root)) then + deallocate(RotMiscVarTypeData%hub_theta_x_root) + end if + call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotInputTypeData%BladeMotion) + deallocate(RotMiscVarTypeData%B_L_2_H_P) + end if + if (allocated(RotMiscVarTypeData%SigmaCavitCrit)) then + deallocate(RotMiscVarTypeData%SigmaCavitCrit) + end if + if (allocated(RotMiscVarTypeData%SigmaCavit)) then + deallocate(RotMiscVarTypeData%SigmaCavit) + end if + if (allocated(RotMiscVarTypeData%CavitWarnSet)) then + deallocate(RotMiscVarTypeData%CavitWarnSet) + end if + if (allocated(RotMiscVarTypeData%TwrFB)) then + deallocate(RotMiscVarTypeData%TwrFB) end if - call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotInputTypeData%Bld)) then - LB(1:1) = lbound(RotInputTypeData%Bld, kind=B8Ki) - UB(1:1) = ubound(RotInputTypeData%Bld, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyBldInputType(RotInputTypeData%Bld(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotInputTypeData%Bld) + if (allocated(RotMiscVarTypeData%TwrMB)) then + deallocate(RotMiscVarTypeData%TwrMB) end if - if (allocated(RotInputTypeData%InflowOnTower)) then - deallocate(RotInputTypeData%InflowOnTower) + if (allocated(RotMiscVarTypeData%HubFB)) then + deallocate(RotMiscVarTypeData%HubFB) end if - if (allocated(RotInputTypeData%AccelOnTower)) then - deallocate(RotInputTypeData%AccelOnTower) + if (allocated(RotMiscVarTypeData%HubMB)) then + deallocate(RotMiscVarTypeData%HubMB) end if - if (allocated(RotInputTypeData%UserProp)) then - deallocate(RotInputTypeData%UserProp) + if (allocated(RotMiscVarTypeData%NacFB)) then + deallocate(RotMiscVarTypeData%NacFB) end if -end subroutine - -subroutine AD_PackRotInputType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(RotInputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotInputType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%NacelleMotion) - call MeshPack(RF, InData%TowerMotion) - call MeshPack(RF, InData%HubMotion) - call RegPack(RF, allocated(InData%BladeRootMotion)) - if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeRootMotion(i1)) - end do + if (allocated(RotMiscVarTypeData%NacMB)) then + deallocate(RotMiscVarTypeData%NacMB) end if - call RegPack(RF, allocated(InData%BladeMotion)) - if (allocated(InData%BladeMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeMotion, kind=B8Ki) + if (allocated(RotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeMotion(i1)) + call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(RotMiscVarTypeData%BladeRootLoad) end if - call MeshPack(RF, InData%TFinMotion) - call RegPack(RF, allocated(InData%Bld)) - if (allocated(InData%Bld)) then - call RegPackBounds(RF, 1, lbound(InData%Bld, kind=B8Ki), ubound(InData%Bld, kind=B8Ki)) - LB(1:1) = lbound(InData%Bld, kind=B8Ki) - UB(1:1) = ubound(InData%Bld, kind=B8Ki) + if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackBldInputType(RF, InData%Bld(i1)) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(RotMiscVarTypeData%B_L_2_R_P) end if - call RegPackAlloc(RF, InData%InflowOnTower) - call RegPackAlloc(RF, InData%AccelOnTower) - call RegPack(RF, InData%InflowOnHub) - call RegPack(RF, InData%InflowOnNacelle) - call RegPack(RF, InData%InflowOnTailFin) - call RegPack(RF, InData%AvgDiskVel) - call RegPackAlloc(RF, InData%UserProp) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackRotInputType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(RotInputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion - call MeshUnpack(RF, OutData%TowerMotion) ! TowerMotion - call MeshUnpack(RF, OutData%HubMotion) ! HubMotion - if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) end if - if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(RotMiscVarTypeData%BladeBuoyLoad) end if - call MeshUnpack(RF, OutData%TFinMotion) ! TFinMotion - if (allocated(OutData%Bld)) deallocate(OutData%Bld) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Bld(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if + if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_UnpackBldInputType(RF, OutData%Bld(i1)) ! Bld + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(RotMiscVarTypeData%B_P_2_B_L) end if - call RegUnpackAlloc(RF, OutData%InflowOnTower); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AccelOnTower); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%InflowOnHub); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%InflowOnNacelle); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%InflowOnTailFin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) - type(AD_InputType), intent(inout) :: SrcInputData - type(AD_InputType), intent(inout) :: DstInputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyInput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcInputData%rotors)) then - LB(1:1) = lbound(SrcInputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%rotors, kind=B8Ki) - if (.not. allocated(DstInputData%rotors)) then - allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) - return - end if - end if +subroutine AD_PackRotMiscVarType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotMiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModJacType(RF, InData%Jac) + call AD_PackRotContinuousStateType(RF, InData%x_init) + call AD_PackRotContinuousStateType(RF, InData%x_perturb) + call AD_PackRotContinuousStateType(RF, InData%dxdt_lin) + call AD_PackRotInputType(RF, InData%u_perturb) + call AD_PackRotOutputType(RF, InData%y_lin) + call AD_PackRotConstraintStateType(RF, InData%z_lin) + call AD_PackRotOtherStateType(RF, InData%OtherState_init) + call AD_PackRotOtherStateType(RF, InData%OtherState_jac) + call BEMT_PackMisc(RF, InData%BEMT) + call BEMT_PackOutput(RF, InData%BEMT_y) + LB(1:1) = lbound(InData%BEMT_u, kind=B8Ki) + UB(1:1) = ubound(InData%BEMT_u, kind=B8Ki) + do i1 = LB(1), UB(1) + call BEMT_PackInput(RF, InData%BEMT_u(i1)) + end do + call AA_PackMisc(RF, InData%AA) + call AA_PackOutput(RF, InData%AA_y) + call AA_PackInput(RF, InData%AA_u) + call RegPackAlloc(RF, InData%DisturbedInflow) + call RegPackAlloc(RF, InData%orientationAnnulus) + call RegPackAlloc(RF, InData%R_li) + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%W_Twr) + call RegPackAlloc(RF, InData%X_Twr) + call RegPackAlloc(RF, InData%Y_Twr) + call RegPackAlloc(RF, InData%Curve) + call RegPackAlloc(RF, InData%TwrClrnc) + call RegPackAlloc(RF, InData%X) + call RegPackAlloc(RF, InData%Y) + call RegPackAlloc(RF, InData%Z) + call RegPackAlloc(RF, InData%M) + call RegPackAlloc(RF, InData%Mx) + call RegPackAlloc(RF, InData%My) + call RegPackAlloc(RF, InData%Mz) + call RegPackAlloc(RF, InData%Vind_i) + call RegPack(RF, InData%V_DiskAvg) + call RegPack(RF, InData%yaw) + call RegPack(RF, InData%tilt) + call RegPackAlloc(RF, InData%hub_theta_x_root) + call RegPack(RF, InData%V_dot_x) + call MeshPack(RF, InData%HubLoad) + call RegPack(RF, allocated(InData%B_L_2_H_P)) + if (allocated(InData%B_L_2_H_P)) then + call RegPackBounds(RF, 1, lbound(InData%B_L_2_H_P, kind=B8Ki), ubound(InData%B_L_2_H_P, kind=B8Ki)) + LB(1:1) = lbound(InData%B_L_2_H_P, kind=B8Ki) + UB(1:1) = ubound(InData%B_L_2_H_P, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_CopyRotInputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_H_P(i1)) end do end if - if (allocated(SrcInputData%InflowWakeVel)) then - LB(1:2) = lbound(SrcInputData%InflowWakeVel, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%InflowWakeVel, kind=B8Ki) - if (.not. allocated(DstInputData%InflowWakeVel)) then - allocate(DstInputData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel + call RegPackAlloc(RF, InData%SigmaCavitCrit) + call RegPackAlloc(RF, InData%SigmaCavit) + call RegPackAlloc(RF, InData%CavitWarnSet) + call RegPackAlloc(RF, InData%TwrFB) + call RegPackAlloc(RF, InData%TwrMB) + call RegPackAlloc(RF, InData%HubFB) + call RegPackAlloc(RF, InData%HubMB) + call RegPackAlloc(RF, InData%NacFB) + call RegPackAlloc(RF, InData%NacMB) + call RegPack(RF, allocated(InData%BladeRootLoad)) + if (allocated(InData%BladeRootLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootLoad, kind=B8Ki), ubound(InData%BladeRootLoad, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeRootLoad, kind=B8Ki) + UB(1:1) = ubound(InData%BladeRootLoad, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootLoad(i1)) + end do + end if + call RegPack(RF, allocated(InData%B_L_2_R_P)) + if (allocated(InData%B_L_2_R_P)) then + call RegPackBounds(RF, 1, lbound(InData%B_L_2_R_P, kind=B8Ki), ubound(InData%B_L_2_R_P, kind=B8Ki)) + LB(1:1) = lbound(InData%B_L_2_R_P, kind=B8Ki) + UB(1:1) = ubound(InData%B_L_2_R_P, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_R_P(i1)) + end do end if -end subroutine - -subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) - type(AD_InputType), intent(inout) :: InputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyInput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(InputData%rotors)) then - LB(1:1) = lbound(InputData%rotors, kind=B8Ki) - UB(1:1) = ubound(InputData%rotors, kind=B8Ki) + call RegPack(RF, allocated(InData%BladeBuoyLoadPoint)) + if (allocated(InData%BladeBuoyLoadPoint)) then + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoadPoint, kind=B8Ki), ubound(InData%BladeBuoyLoadPoint, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeBuoyLoadPoint, kind=B8Ki) + UB(1:1) = ubound(InData%BladeBuoyLoadPoint, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshPack(RF, InData%BladeBuoyLoadPoint(i1)) end do - deallocate(InputData%rotors) end if - if (allocated(InputData%InflowWakeVel)) then - deallocate(InputData%InflowWakeVel) + call RegPack(RF, allocated(InData%BladeBuoyLoad)) + if (allocated(InData%BladeBuoyLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoad, kind=B8Ki), ubound(InData%BladeBuoyLoad, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeBuoyLoad, kind=B8Ki) + UB(1:1) = ubound(InData%BladeBuoyLoad, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeBuoyLoad(i1)) + end do end if -end subroutine - -subroutine AD_PackInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AD_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%rotors)) - if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPack(RF, allocated(InData%B_P_2_B_L)) + if (allocated(InData%B_P_2_B_L)) then + call RegPackBounds(RF, 1, lbound(InData%B_P_2_B_L, kind=B8Ki), ubound(InData%B_P_2_B_L, kind=B8Ki)) + LB(1:1) = lbound(InData%B_P_2_B_L, kind=B8Ki) + UB(1:1) = ubound(InData%B_P_2_B_L, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotInputType(RF, InData%rotors(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%B_P_2_B_L(i1)) end do end if - call RegPackAlloc(RF, InData%InflowWakeVel) + call MeshPack(RF, InData%TwrBuoyLoadPoint) + call MeshPack(RF, InData%TwrBuoyLoad) + call NWTC_Library_PackMeshMapType(RF, InData%T_P_2_T_L) + call RegPack(RF, InData%FirstWarn_TowerStrike) + call RegPack(RF, InData%AvgDiskVel) + call RegPack(RF, InData%AvgDiskVelDist) + call RegPack(RF, InData%TFinAlpha) + call RegPack(RF, InData%TFinRe) + call RegPack(RF, InData%TFinVrel) + call RegPack(RF, InData%TFinVund_i) + call RegPack(RF, InData%TFinVind_i) + call RegPack(RF, InData%TFinVrel_i) + call RegPack(RF, InData%TFinSTV_i) + call RegPack(RF, InData%TFinF_i) + call RegPack(RF, InData%TFinM_i) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackInput(RF, OutData) +subroutine AD_UnPackRotMiscVarType(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + type(RotMiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call AD_UnpackRotContinuousStateType(RF, OutData%x_init) ! x_init + call AD_UnpackRotContinuousStateType(RF, OutData%x_perturb) ! x_perturb + call AD_UnpackRotContinuousStateType(RF, OutData%dxdt_lin) ! dxdt_lin + call AD_UnpackRotInputType(RF, OutData%u_perturb) ! u_perturb + call AD_UnpackRotOutputType(RF, OutData%y_lin) ! y_lin + call AD_UnpackRotConstraintStateType(RF, OutData%z_lin) ! z_lin + call AD_UnpackRotOtherStateType(RF, OutData%OtherState_init) ! OtherState_init + call AD_UnpackRotOtherStateType(RF, OutData%OtherState_jac) ! OtherState_jac + call BEMT_UnpackMisc(RF, OutData%BEMT) ! BEMT + call BEMT_UnpackOutput(RF, OutData%BEMT_y) ! BEMT_y + LB(1:1) = lbound(OutData%BEMT_u, kind=B8Ki) + UB(1:1) = ubound(OutData%BEMT_u, kind=B8Ki) + do i1 = LB(1), UB(1) + call BEMT_UnpackInput(RF, OutData%BEMT_u(i1)) ! BEMT_u + end do + call AA_UnpackMisc(RF, OutData%AA) ! AA + call AA_UnpackOutput(RF, OutData%AA_y) ! AA_y + call AA_UnpackInput(RF, OutData%AA_u) ! AA_u + call RegUnpackAlloc(RF, OutData%DisturbedInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%orientationAnnulus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%R_li); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Curve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrClrnc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%My); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_DiskAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%hub_theta_x_root); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_dot_x); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%HubLoad) ! HubLoad + if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + allocate(OutData%B_L_2_H_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotInputType(RF, OutData%rotors(i1)) ! rotors + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P end do end if - call RegUnpackAlloc(RF, OutData%InflowWakeVel); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotOutputType), intent(inout) :: SrcRotOutputTypeData - type(RotOutputType), intent(inout) :: DstRotOutputTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' - ErrStat = ErrID_None - ErrMsg = '' - call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) - if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then - allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) - return - end if + call RegUnpackAlloc(RF, OutData%SigmaCavitCrit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SigmaCavit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CavitWarnSet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacMB); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + return end if do i1 = LB(1), UB(1) - call MeshCopy(SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call MeshUnpack(RF, OutData%BladeRootLoad(i1)) ! BladeRootLoad end do end if - call MeshCopy(SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotOutputTypeData%WriteOutput)) then - LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) - if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then - allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg, RoutineName) - return - end if + if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return end if - DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput - end if -end subroutine - -subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) - type(RotOutputType), intent(inout) :: RotOutputTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' - ErrStat = ErrID_None - ErrMsg = '' - call MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(RotOutputTypeData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(RotOutputTypeData%BladeLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P end do - deallocate(RotOutputTypeData%BladeLoad) - end if - call MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotOutputTypeData%WriteOutput)) then - deallocate(RotOutputTypeData%WriteOutput) end if -end subroutine - -subroutine AD_PackRotOutputType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(RotOutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotOutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%NacelleLoad) - call MeshPack(RF, InData%HubLoad) - call MeshPack(RF, InData%TowerLoad) - call RegPack(RF, allocated(InData%BladeLoad)) - if (allocated(InData%BladeLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoad, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLoad, kind=B8Ki) + if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeLoad(i1)) + call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint end do end if - call MeshPack(RF, InData%TFinLoad) - call RegPackAlloc(RF, InData%WriteOutput) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackRotOutputType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(RotOutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%NacelleLoad) ! NacelleLoad - call MeshUnpack(RF, OutData%HubLoad) ! HubLoad - call MeshUnpack(RF, OutData%TowerLoad) ! TowerLoad - if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) + if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad + call MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad end do end if - call MeshUnpack(RF, OutData%TFinLoad) ! TFinLoad - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L + end do + end if + call MeshUnpack(RF, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint + call MeshUnpack(RF, OutData%TwrBuoyLoad) ! TwrBuoyLoad + call NWTC_Library_UnpackMeshMapType(RF, OutData%T_P_2_T_L) ! T_P_2_T_L + call RegUnpack(RF, OutData%FirstWarn_TowerStrike); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVelDist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinRe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVund_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinSTV_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinF_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinM_i); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(AD_OutputType), intent(inout) :: SrcOutputData - type(AD_OutputType), intent(inout) :: DstOutputData +subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: SrcMiscData + type(AD_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyOutput' + character(*), parameter :: RoutineName = 'AD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcOutputData%rotors)) then - LB(1:1) = lbound(SrcOutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%rotors, kind=B8Ki) - if (.not. allocated(DstOutputData%rotors)) then - allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%rotors)) then + LB(1:1) = lbound(SrcMiscData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%rotors, kind=B8Ki) + if (.not. allocated(DstMiscData%rotors)) then + allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyRotOutputType(SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%FVW_u)) then + LB(1:1) = lbound(SrcMiscData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FVW_u, kind=B8Ki) + if (.not. allocated(DstMiscData%FVW_u)) then + allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if + call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%WindPos)) then + LB(1:2) = lbound(SrcMiscData%WindPos, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindPos, kind=B8Ki) + if (.not. allocated(DstMiscData%WindPos)) then + allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindPos = SrcMiscData%WindPos + end if + if (allocated(SrcMiscData%WindVel)) then + LB(1:2) = lbound(SrcMiscData%WindVel, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindVel, kind=B8Ki) + if (.not. allocated(DstMiscData%WindVel)) then + allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindVel = SrcMiscData%WindVel + end if + if (allocated(SrcMiscData%WindAcc)) then + LB(1:2) = lbound(SrcMiscData%WindAcc, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindAcc, kind=B8Ki) + if (.not. allocated(DstMiscData%WindAcc)) then + allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAcc = SrcMiscData%WindAcc + end if end subroutine -subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(AD_OutputType), intent(inout) :: OutputData +subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyOutput' + character(*), parameter :: RoutineName = 'AD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%rotors)) then - LB(1:1) = lbound(OutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(OutputData%rotors, kind=B8Ki) + if (allocated(MiscData%rotors)) then + LB(1:1) = lbound(MiscData%rotors, kind=B8Ki) + UB(1:1) = ubound(MiscData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) + call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%rotors) + deallocate(MiscData%rotors) + end if + if (allocated(MiscData%FVW_u)) then + LB(1:1) = lbound(MiscData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(MiscData%FVW_u, kind=B8Ki) + do i1 = LB(1), UB(1) + call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FVW_u) + end if + call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%WindPos)) then + deallocate(MiscData%WindPos) + end if + if (allocated(MiscData%WindVel)) then + deallocate(MiscData%WindVel) + end if + if (allocated(MiscData%WindAcc)) then + deallocate(MiscData%WindAcc) end if end subroutine -subroutine AD_PackOutput(RF, Indata) +subroutine AD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(AD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + type(AD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then @@ -5517,18 +5776,32 @@ subroutine AD_PackOutput(RF, Indata) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotOutputType(RF, InData%rotors(i1)) + call AD_PackRotMiscVarType(RF, InData%rotors(i1)) + end do + end if + call RegPack(RF, allocated(InData%FVW_u)) + if (allocated(InData%FVW_u)) then + call RegPackBounds(RF, 1, lbound(InData%FVW_u, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) + LB(1:1) = lbound(InData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(InData%FVW_u, kind=B8Ki) + do i1 = LB(1), UB(1) + call FVW_PackInput(RF, InData%FVW_u(i1)) end do end if + call FVW_PackOutput(RF, InData%FVW_y) + call FVW_PackMisc(RF, InData%FVW) + call RegPackAlloc(RF, InData%WindPos) + call RegPackAlloc(RF, InData%WindVel) + call RegPackAlloc(RF, InData%WindAcc) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackOutput(RF, OutData) +subroutine AD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + type(AD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5542,9 +5815,27 @@ subroutine AD_UnPackOutput(RF, OutData) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotOutputType(RF, OutData%rotors(i1)) ! rotors + call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors + end do + end if + if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u end do end if + call FVW_UnpackOutput(RF, OutData%FVW_y) ! FVW_y + call FVW_UnpackMisc(RF, OutData%FVW) ! FVW + call RegUnpackAlloc(RF, OutData%WindPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindAcc); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -6084,5 +6375,85 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END DO END IF ! check if allocated END SUBROUTINE + +function AD_InputMeshPointer(u, ML) result(Mesh) + type(AD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (AD_u_rotors_NacelleMotion) + Mesh => u%rotors(ML%i1)%NacelleMotion + case (AD_u_rotors_TowerMotion) + Mesh => u%rotors(ML%i1)%TowerMotion + case (AD_u_rotors_HubMotion) + Mesh => u%rotors(ML%i1)%HubMotion + case (AD_u_rotors_BladeRootMotion) + Mesh => u%rotors(ML%i1)%BladeRootMotion(ML%i2) + case (AD_u_rotors_BladeMotion) + Mesh => u%rotors(ML%i1)%BladeMotion(ML%i2) + case (AD_u_rotors_TFinMotion) + Mesh => u%rotors(ML%i1)%TFinMotion + end select +end function + +function AD_InputMeshName(u, ML) result(Name) + type(AD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (AD_u_rotors_NacelleMotion) + Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%NacelleMotion" + case (AD_u_rotors_TowerMotion) + Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%TowerMotion" + case (AD_u_rotors_HubMotion) + Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%HubMotion" + case (AD_u_rotors_BladeRootMotion) + Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%BladeRootMotion("//trim(Num2LStr(ML%i2))//")" + case (AD_u_rotors_BladeMotion) + Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%BladeMotion("//trim(Num2LStr(ML%i2))//")" + case (AD_u_rotors_TFinMotion) + Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%TFinMotion" + end select +end function + +function AD_OutputMeshPointer(y, ML) result(Mesh) + type(AD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (AD_y_rotors_NacelleLoad) + Mesh => y%rotors(ML%i1)%NacelleLoad + case (AD_y_rotors_HubLoad) + Mesh => y%rotors(ML%i1)%HubLoad + case (AD_y_rotors_TowerLoad) + Mesh => y%rotors(ML%i1)%TowerLoad + case (AD_y_rotors_BladeLoad) + Mesh => y%rotors(ML%i1)%BladeLoad(ML%i2) + case (AD_y_rotors_TFinLoad) + Mesh => y%rotors(ML%i1)%TFinLoad + end select +end function + +function AD_OutputMeshName(y, ML) result(Name) + type(AD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (AD_y_rotors_NacelleLoad) + Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%NacelleLoad" + case (AD_y_rotors_HubLoad) + Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%HubLoad" + case (AD_y_rotors_TowerLoad) + Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%TowerLoad" + case (AD_y_rotors_BladeLoad) + Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%BladeLoad("//trim(Num2LStr(ML%i2))//")" + case (AD_y_rotors_TFinLoad) + Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%TFinLoad" + end select +end function END MODULE AeroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 83b789170b..ed1af5a35e 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -33,9 +33,9 @@ MODULE AirfoilInfo_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_1 = 1 ! 1D interpolation on AoA (first table only) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2Re = 2 ! 2D interpolation on AoA and Re [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2User = 3 ! 2D interpolation on AoA and UserProp [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_1 = 1 ! 1D interpolation on AoA (first table only) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2Re = 2 ! 2D interpolation on AoA and Re [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2User = 3 ! 2D interpolation on AoA and UserProp [-] ! ========= AFI_UA_BL_Type ======= TYPE, PUBLIC :: AFI_UA_BL_Type REAL(ReKi) :: alpha0 = 0.0_ReKi !< Angle of attack for zero lift (also used in HGM) [input in degrees; stored as radians] @@ -1447,5 +1447,41 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat u_out%c_alphaLowerWrap = a1*u1%c_alphaLowerWrap + a2*u2%c_alphaLowerWrap + a3*u3%c_alphaLowerWrap u_out%c_alphaUpperWrap = a1*u1%c_alphaUpperWrap + a2*u2%c_alphaUpperWrap + a3*u3%c_alphaUpperWrap END SUBROUTINE + +function AFI_InputMeshPointer(u, ML) result(Mesh) + type(AFI_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function AFI_InputMeshName(u, ML) result(Name) + type(AFI_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function AFI_OutputMeshPointer(y, ML) result(Mesh) + type(AFI_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function AFI_OutputMeshName(y, ML) result(Name) + type(AFI_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE AirfoilInfo_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 01b8ef02a6..b6ce060cd9 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -36,13 +36,13 @@ MODULE BEMT_Types USE DBEMT_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Orthogonal = 0 ! Inflow orthogonal to rotor [-] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Uncoupled = 1 ! Uncoupled (no correction) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters = 2 ! Pitt/Peters [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Coupled = 3 ! Coupled [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 0 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_3D = 2 ! 3D BEM assuming a momentum balance system, and an airfoil system [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Orthogonal = 0 ! Inflow orthogonal to rotor [-] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Uncoupled = 1 ! Uncoupled (no correction) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters = 2 ! Pitt/Peters [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Coupled = 3 ! Coupled [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 0 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_3D = 2 ! 3D BEM assuming a momentum balance system, and an airfoil system [-] ! ========= BEMT_InitInputType ======= TYPE, PUBLIC :: BEMT_InitInputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] @@ -2643,5 +2643,41 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + a3*y3%Cpmin END IF ! check if allocated END SUBROUTINE + +function BEMT_InputMeshPointer(u, ML) result(Mesh) + type(BEMT_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function BEMT_InputMeshName(u, ML) result(Name) + type(BEMT_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function BEMT_OutputMeshPointer(y, ML) result(Mesh) + type(BEMT_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function BEMT_OutputMeshName(y, ML) result(Name) + type(BEMT_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE BEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 17d9640ed6..ec92ed85e1 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -33,10 +33,10 @@ MODULE DBEMT_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_none = 0 ! use BEMT instead (not DBEMT) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauConst = 1 ! use constant tau1 [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauVaries = 2 ! use time-dependent tau1 [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_cont_tauConst = 3 ! use continuous formulation with constant tau1 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_none = 0 ! use BEMT instead (not DBEMT) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauConst = 1 ! use constant tau1 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauVaries = 2 ! use time-dependent tau1 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_cont_tauConst = 3 ! use continuous formulation with constant tau1 [-] ! ========= DBEMT_InitInputType ======= TYPE, PUBLIC :: DBEMT_InitInputType INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] @@ -1413,5 +1413,41 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, y_out%vind = a1*y1%vind + a2*y2%vind + a3*y3%vind END IF ! check if allocated END SUBROUTINE + +function DBEMT_InputMeshPointer(u, ML) result(Mesh) + type(DBEMT_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function DBEMT_InputMeshName(u, ML) result(Name) + type(DBEMT_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function DBEMT_OutputMeshPointer(y, ML) result(Mesh) + type(DBEMT_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function DBEMT_OutputMeshName(y, ML) result(Name) + type(DBEMT_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE DBEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 0cd9fbcbe1..8c3d5faa8c 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -35,8 +35,9 @@ MODULE FVW_Types USE UnsteadyAero_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelocity = 1 ! Grid stores velocity field [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelVorticity = 2 ! Grid stores velocity and vorticity [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelocity = 1 ! Grid stores velocity field [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelVorticity = 2 ! Grid stores velocity and vorticity [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FVW_u_WingsMesh = 1 ! Mesh number for FVW FVW_u_WingsMesh mesh [-] ! ========= GridOutType ======= TYPE, PUBLIC :: GridOutType CHARACTER(100) :: name !< Grid name [-] @@ -4087,5 +4088,45 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er END DO END IF ! check if allocated END SUBROUTINE + +function FVW_InputMeshPointer(u, ML) result(Mesh) + type(FVW_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (FVW_u_WingsMesh) + Mesh => u%WingsMesh(ML%i1) + end select +end function + +function FVW_InputMeshName(u, ML) result(Name) + type(FVW_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (FVW_u_WingsMesh) + Name = "u%WingsMesh("//trim(Num2LStr(ML%i1))//")" + end select +end function + +function FVW_OutputMeshPointer(y, ML) result(Mesh) + type(FVW_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function FVW_OutputMeshName(y, ML) result(Name) + type(FVW_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE FVW_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 8fad9bcdcf..8c8474dcfb 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -34,13 +34,13 @@ MODULE UnsteadyAero_Types USE AirfoilInfo_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_MinnemaPierce = 3 ! [Minnema/Pierce variant (changes in Cc and Cm)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGM = 4 ! [continuous variant of HGM (Hansen) model] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV = 5 ! [continuous variant of HGM (Hansen) model with vortex modifications] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Oye = 6 ! Stieg Oye dynamic stall model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_BV = 7 ! Boeing-Vertol dynamic stall model (e.g. used in CACTUS) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_MinnemaPierce = 3 ! [Minnema/Pierce variant (changes in Cc and Cm)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGM = 4 ! [continuous variant of HGM (Hansen) model] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV = 5 ! [continuous variant of HGM (Hansen) model with vortex modifications] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Oye = 6 ! Stieg Oye dynamic stall model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_BV = 7 ! Boeing-Vertol dynamic stall model (e.g. used in CACTUS) [-] ! ========= UA_InitInputType ======= TYPE, PUBLIC :: UA_InitInputType REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] @@ -2503,5 +2503,41 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function UA_InputMeshPointer(u, ML) result(Mesh) + type(UA_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function UA_InputMeshName(u, ML) result(Name) + type(UA_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function UA_OutputMeshPointer(y, ML) result(Mesh) + type(UA_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function UA_OutputMeshName(y, ML) result(Name) + type(UA_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE UnsteadyAero_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 9bf6ced3fa..cab2b06c47 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -34,6 +34,10 @@ MODULE AeroDyn14_Types USE DWM_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: AD14_u_InputMarkers = 1 ! Mesh number for AD14 AD14_u_InputMarkers mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD14_u_Twr_InputMarkers = 2 ! Mesh number for AD14 AD14_u_Twr_InputMarkers mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD14_y_OutputLoads = 3 ! Mesh number for AD14 AD14_y_OutputLoads mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD14_y_Twr_OutputLoads = 4 ! Mesh number for AD14 AD14_y_Twr_OutputLoads mesh [-] ! ========= Marker ======= TYPE, PUBLIC :: Marker REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0 @@ -4895,5 +4899,57 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL MeshExtrapInterp2(y1%Twr_OutputLoads, y2%Twr_OutputLoads, y3%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function AD14_InputMeshPointer(u, ML) result(Mesh) + type(AD14_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (AD14_u_InputMarkers) + Mesh => u%InputMarkers(ML%i1) + case (AD14_u_Twr_InputMarkers) + Mesh => u%Twr_InputMarkers + end select +end function + +function AD14_InputMeshName(u, ML) result(Name) + type(AD14_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (AD14_u_InputMarkers) + Name = "u%InputMarkers("//trim(Num2LStr(ML%i1))//")" + case (AD14_u_Twr_InputMarkers) + Name = "u%Twr_InputMarkers" + end select +end function + +function AD14_OutputMeshPointer(y, ML) result(Mesh) + type(AD14_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (AD14_y_OutputLoads) + Mesh => y%OutputLoads(ML%i1) + case (AD14_y_Twr_OutputLoads) + Mesh => y%Twr_OutputLoads + end select +end function + +function AD14_OutputMeshName(y, ML) result(Name) + type(AD14_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (AD14_y_OutputLoads) + Name = "y%OutputLoads("//trim(Num2LStr(ML%i1))//")" + case (AD14_y_Twr_OutputLoads) + Name = "y%Twr_OutputLoads" + end select +end function END MODULE AeroDyn14_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 9b729c5e33..6d42c26c29 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -3165,5 +3165,41 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL InflowWind_Output_ExtrapInterp2( y1%IfW, y2%IfW, y3%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function DWM_InputMeshPointer(u, ML) result(Mesh) + type(DWM_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function DWM_InputMeshName(u, ML) result(Name) + type(DWM_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function DWM_OutputMeshPointer(y, ML) result(Mesh) + type(DWM_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function DWM_OutputMeshName(y, ML) result(Name) + type(DWM_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE DWM_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index fdc1135a1f..571e594c2f 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -34,12 +34,12 @@ MODULE AWAE_Types USE InflowWind_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: XYSlice = 1 ! Extract an XY slice of data from the 3D grid [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: YZSlice = 2 ! Extract an YZ slice of data from the 3D grid [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: XZSlice = 3 ! Extract an XZ slice of data from the 3D grid [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_Uniform = 1 ! Spatial filter model for wake meandering: uniform [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_TruncJinc = 2 ! Spatial filter model for wake meandering: truncated jinc [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_WndwdJinc = 3 ! Spatial filter model for wake meandering: windowed jinc [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: XYSlice = 1 ! Extract an XY slice of data from the 3D grid [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: YZSlice = 2 ! Extract an YZ slice of data from the 3D grid [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: XZSlice = 3 ! Extract an XZ slice of data from the 3D grid [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_Uniform = 1 ! Spatial filter model for wake meandering: uniform [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_TruncJinc = 2 ! Spatial filter model for wake meandering: truncated jinc [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_WndwdJinc = 3 ! Spatial filter model for wake meandering: windowed jinc [-] ! ========= AWAE_HighWindGrid ======= TYPE, PUBLIC :: AWAE_HighWindGrid REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: data => NULL() !< UVW components of wind data across the high-res regularly-spaced grid [m/s] @@ -2494,5 +2494,41 @@ subroutine AWAE_UnPackInput(RF, OutData) call RegUnpackAlloc(RF, OutData%D_wake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WAT_k_mt); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function AWAE_InputMeshPointer(u, ML) result(Mesh) + type(AWAE_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function AWAE_InputMeshName(u, ML) result(Name) + type(AWAE_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function AWAE_OutputMeshPointer(y, ML) result(Mesh) + type(AWAE_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function AWAE_OutputMeshName(y, ML) result(Name) + type(AWAE_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE AWAE_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 91a92f7bd9..15daf16e5a 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -33,12 +33,18 @@ MODULE BeamDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_STATIC_ANALYSIS = 1 ! Constant for static analysis. InputType%Dynamic = FALSE. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_DYNAMIC_ANALYSIS = 2 ! Constant for dynamic analysis. InputType%Dynamic = TRUE .AND. BD_InputFile%QuasiStaticSolve = FALSE [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_DYN_SSS_ANALYSIS = 3 ! Constant for dynamic analysis with Steady State Startup solve. InputType%Dynamic = TRUE .AND. BD_InputFile%QuasiStaticSolve = TRUE [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_FE = 1 ! Constant for creating y%BldMotion at the FE (GLL) nodes [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_QP = 2 ! Constant for creating y%BldMotion at the quadrature nodes [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_STATIONS = 3 ! Constant for creating y%BldMotion at the blade property input stations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_STATIC_ANALYSIS = 1 ! Constant for static analysis. InputType%Dynamic = FALSE. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_DYNAMIC_ANALYSIS = 2 ! Constant for dynamic analysis. InputType%Dynamic = TRUE .AND. BD_InputFile%QuasiStaticSolve = FALSE [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_DYN_SSS_ANALYSIS = 3 ! Constant for dynamic analysis with Steady State Startup solve. InputType%Dynamic = TRUE .AND. BD_InputFile%QuasiStaticSolve = TRUE [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_FE = 1 ! Constant for creating y%BldMotion at the FE (GLL) nodes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_QP = 2 ! Constant for creating y%BldMotion at the quadrature nodes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_STATIONS = 3 ! Constant for creating y%BldMotion at the blade property input stations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_u_RootMotion = 1 ! Mesh number for BD BD_u_RootMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_u_PointLoad = 2 ! Mesh number for BD BD_u_PointLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_u_DistrLoad = 3 ! Mesh number for BD BD_u_DistrLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_u_HubMotion = 4 ! Mesh number for BD BD_u_HubMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_y_ReactionForce = 5 ! Mesh number for BD BD_y_ReactionForce mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_y_BldMotion = 6 ! Mesh number for BD BD_y_BldMotion mesh [-] ! ========= BD_InitInputType ======= TYPE, PUBLIC :: BD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] @@ -160,7 +166,6 @@ MODULE BeamDyn_Types ! ========= BD_ParameterType ======= TYPE, PUBLIC :: BD_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - TYPE(VarsIdxType) :: IdxAeroMap !< Module variable index for AeroMap [-] INTEGER(IntKi) :: iVarRootMotion = 0_IntKi !< Root motion variable index [-] INTEGER(IntKi) :: iVarPointLoad = 0_IntKi !< Point load variable index [-] INTEGER(IntKi) :: iVarDistrLoad = 0_IntKi !< Distributed load variable index [-] @@ -338,11 +343,11 @@ MODULE BeamDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LP_indx !< Index vector for LU [-] TYPE(BD_InputType) :: u !< Inputs converted to the internal BD coordinate system [-] TYPE(BD_InputType) :: u2 !< Inputs in the FAST coordinate system, possibly modified by pitch actuator [-] - TYPE(ModLinType) :: Lin !< Values corresponding to module variables [-] + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] TYPE(BD_ContinuousStateType) :: x_perturb !< [-] - TYPE(BD_ContinuousStateType) :: dx_perturb !< [-] + TYPE(BD_ContinuousStateType) :: dxdt_lin !< [-] TYPE(BD_InputType) :: u_perturb !< [-] - TYPE(BD_OutputType) :: y_perturb !< [-] + TYPE(BD_OutputType) :: y_lin !< [-] END TYPE BD_MiscVarType ! ======================= CONTAINS @@ -1340,9 +1345,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - call NWTC_Library_CopyVarsIdxType(SrcParamData%IdxAeroMap, DstParamData%IdxAeroMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstParamData%iVarRootMotion = SrcParamData%iVarRootMotion DstParamData%iVarPointLoad = SrcParamData%iVarPointLoad DstParamData%iVarDistrLoad = SrcParamData%iVarDistrLoad @@ -1763,8 +1765,6 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Vars) ParamData%Vars => null() end if - call NWTC_Library_DestroyVarsIdxType(ParamData%IdxAeroMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%uuN0)) then deallocate(ParamData%uuN0) end if @@ -1880,7 +1880,6 @@ subroutine BD_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call NWTC_Library_PackVarsIdxType(RF, InData%IdxAeroMap) call RegPack(RF, InData%iVarRootMotion) call RegPack(RF, InData%iVarPointLoad) call RegPack(RF, InData%iVarDistrLoad) @@ -2012,7 +2011,6 @@ subroutine BD_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxAeroMap) ! IdxAeroMap call RegUnpack(RF, OutData%iVarRootMotion); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarPointLoad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarDistrLoad); if (RegCheckErr(RF, RoutineName)) return @@ -3230,19 +3228,19 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call BD_CopyInput(SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyModLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call BD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call BD_CopyContState(SrcMiscData%dx_perturb, DstMiscData%dx_perturb, CtrlCode, ErrStat2, ErrMsg2) + call BD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call BD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call BD_CopyOutput(SrcMiscData%y_perturb, DstMiscData%y_perturb, CtrlCode, ErrStat2, ErrMsg2) + call BD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -3360,15 +3358,15 @@ subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BD_DestroyInput(MiscData%u2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyModLinType(MiscData%Lin, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call BD_DestroyContState(MiscData%dx_perturb, ErrStat2, ErrMsg2) + call BD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call BD_DestroyOutput(MiscData%y_perturb, ErrStat2, ErrMsg2) + call BD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -3415,11 +3413,11 @@ subroutine BD_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%LP_indx) call BD_PackInput(RF, InData%u) call BD_PackInput(RF, InData%u2) - call NWTC_Library_PackModLinType(RF, InData%Lin) + call NWTC_Library_PackModJacType(RF, InData%Jac) call BD_PackContState(RF, InData%x_perturb) - call BD_PackContState(RF, InData%dx_perturb) + call BD_PackContState(RF, InData%dxdt_lin) call BD_PackInput(RF, InData%u_perturb) - call BD_PackOutput(RF, InData%y_perturb) + call BD_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3469,11 +3467,11 @@ subroutine BD_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%LP_indx); if (RegCheckErr(RF, RoutineName)) return call BD_UnpackInput(RF, OutData%u) ! u call BD_UnpackInput(RF, OutData%u2) ! u2 - call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call BD_UnpackContState(RF, OutData%x_perturb) ! x_perturb - call BD_UnpackContState(RF, OutData%dx_perturb) ! dx_perturb + call BD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin call BD_UnpackInput(RF, OutData%u_perturb) ! u_perturb - call BD_UnpackOutput(RF, OutData%y_perturb) ! y_perturb + call BD_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine BD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -3817,5 +3815,65 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function BD_InputMeshPointer(u, ML) result(Mesh) + type(BD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (BD_u_RootMotion) + Mesh => u%RootMotion + case (BD_u_PointLoad) + Mesh => u%PointLoad + case (BD_u_DistrLoad) + Mesh => u%DistrLoad + case (BD_u_HubMotion) + Mesh => u%HubMotion + end select +end function + +function BD_InputMeshName(u, ML) result(Name) + type(BD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (BD_u_RootMotion) + Name = "u%RootMotion" + case (BD_u_PointLoad) + Name = "u%PointLoad" + case (BD_u_DistrLoad) + Name = "u%DistrLoad" + case (BD_u_HubMotion) + Name = "u%HubMotion" + end select +end function + +function BD_OutputMeshPointer(y, ML) result(Mesh) + type(BD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (BD_y_ReactionForce) + Mesh => y%ReactionForce + case (BD_y_BldMotion) + Mesh => y%BldMotion + end select +end function + +function BD_OutputMeshName(y, ML) result(Name) + type(BD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (BD_y_ReactionForce) + Name = "y%ReactionForce" + case (BD_y_BldMotion) + Name = "y%BldMotion" + end select +end function END MODULE BeamDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 50b52fe996..5fcdc97742 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -166,7 +166,6 @@ typedef ^ ^ ^ mEta ::: - - "Center of ma # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ParameterType VarsIdxType IdxAeroMap - - - "Module variable index for AeroMap" typedef ^ ParameterType IntKi iVarRootMotion - - - "Root motion variable index" typedef ^ ParameterType IntKi iVarPointLoad - - - "Point load variable index" typedef ^ ParameterType IntKi iVarDistrLoad - - - "Distributed load variable index" @@ -381,8 +380,8 @@ typedef ^ MiscVarType ^ LP_RHS_LU {:} - - "R typedef ^ MiscVarType IntKi LP_indx {:} - - "Index vector for LU" - typedef ^ MiscVarType BD_InputType u - - - "Inputs converted to the internal BD coordinate system" - typedef ^ MiscVarType BD_InputType u2 - - - "Inputs in the FAST coordinate system, possibly modified by pitch actuator" - -typedef ^ MiscVarType ModLinType Lin - - - "Values corresponding to module variables" +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" typedef ^ MiscVarType BD_ContinuousStateType x_perturb - - - "" - -typedef ^ MiscVarType BD_ContinuousStateType dx_perturb - - - "" - +typedef ^ MiscVarType BD_ContinuousStateType dxdt_lin - - - "" - typedef ^ MiscVarType BD_InputType u_perturb - - - "" - -typedef ^ MiscVarType BD_OutputType y_perturb - - - "" - +typedef ^ MiscVarType BD_OutputType y_lin - - - "" - diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index e9868018e6..78df5702f7 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -518,7 +518,6 @@ typedef ^ OtherStateType IntKi SgnLSTQ {ED_NMX} - - "history of sign of LSTQ" # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ParameterType VarsIdxType IdxAeroMap - - - "Module variable index for AeroMap" typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi DT24 - - - "=DT/24 (used in loose coupling)" seconds typedef ^ ParameterType IntKi BldNodes - - - "Number of blade nodes used in the analysis" - @@ -768,7 +767,7 @@ typedef ^ ParameterType IntKi iVarNacelleMotion - - - "Index of variable" - typedef ^ ParameterType IntKi iVarYaw - - - "Index of variable" - typedef ^ ParameterType IntKi iVarYawRate - - - "Index of variable" - typedef ^ ParameterType IntKi iVarHSS_Spd - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarOutput - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarWriteOut - - - "Index of variable" - # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: @@ -841,8 +840,8 @@ typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAP typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - -typedef ^ MiscVarType ModLinType Lin - - - "Values corresponding to module variables" +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" typedef ^ MiscVarType ED_ContinuousStateType x_perturb - - - "" - -typedef ^ MiscVarType ED_ContinuousStateType dx_perturb - - - "" - +typedef ^ MiscVarType ED_ContinuousStateType dxdt_lin - - - "" - typedef ^ MiscVarType ED_InputType u_perturb - - - "" - -typedef ^ MiscVarType ED_OutputType y_perturb - - - "" - +typedef ^ MiscVarType ED_OutputType y_lin - - - "" - diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 21895dc666..b3d61e016d 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -33,7 +33,24 @@ MODULE ElastoDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_BladePtLoads = 1 ! Mesh number for ED ED_u_BladePtLoads mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_PlatformPtMesh = 2 ! Mesh number for ED ED_u_PlatformPtMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_TowerPtLoads = 3 ! Mesh number for ED ED_u_TowerPtLoads mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_HubPtLoad = 4 ! Mesh number for ED ED_u_HubPtLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_NacelleLoads = 5 ! Mesh number for ED ED_u_NacelleLoads mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_TFinCMLoads = 6 ! Mesh number for ED ED_u_TFinCMLoads mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_BladeLn2Mesh = 7 ! Mesh number for ED ED_y_BladeLn2Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_PlatformPtMesh = 8 ! Mesh number for ED ED_y_PlatformPtMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_TowerLn2Mesh = 9 ! Mesh number for ED ED_y_TowerLn2Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_HubPtMotion14 = 10 ! Mesh number for ED ED_y_HubPtMotion14 mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_HubPtMotion = 11 ! Mesh number for ED ED_y_HubPtMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_BladeRootMotion14 = 12 ! Mesh number for ED ED_y_BladeRootMotion14 mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_BladeRootMotion = 13 ! Mesh number for ED ED_y_BladeRootMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_RotorFurlMotion14 = 14 ! Mesh number for ED ED_y_RotorFurlMotion14 mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_NacelleMotion = 15 ! Mesh number for ED ED_y_NacelleMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_TowerBaseMotion14 = 16 ! Mesh number for ED ED_y_TowerBaseMotion14 mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_TFinCMMotion = 17 ! Mesh number for ED ED_y_TFinCMMotion mesh [-] ! ========= ED_InitInputType ======= TYPE, PUBLIC :: ED_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] @@ -525,7 +542,6 @@ MODULE ElastoDyn_Types ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - TYPE(VarsIdxType) :: IdxAeroMap !< Module variable index for AeroMap [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] REAL(DbKi) :: DT24 = 0.0_R8Ki !< =DT/24 (used in loose coupling) [seconds] INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] @@ -768,7 +784,7 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: iVarYaw = 0_IntKi !< Index of variable [-] INTEGER(IntKi) :: iVarYawRate = 0_IntKi !< Index of variable [-] INTEGER(IntKi) :: iVarHSS_Spd = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) :: iVarOutput = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) :: iVarWriteOut = 0_IntKi !< Index of variable [-] END TYPE ED_ParameterType ! ======================= ! ========= ED_InputType ======= @@ -842,11 +858,11 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlGeAzRo !< Original DOF_GeAz row in AugMat [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Solution (acceleration) vector; the first time derivative of QDT [-] LOGICAL :: IgnoreMod = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] - TYPE(ModLinType) :: Lin !< Values corresponding to module variables [-] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] TYPE(ED_ContinuousStateType) :: x_perturb !< [-] - TYPE(ED_ContinuousStateType) :: dx_perturb !< [-] + TYPE(ED_ContinuousStateType) :: dxdt_lin !< [-] TYPE(ED_InputType) :: u_perturb !< [-] - TYPE(ED_OutputType) :: y_perturb !< [-] + TYPE(ED_OutputType) :: y_lin !< [-] END TYPE ED_MiscVarType ! ======================= CONTAINS @@ -4823,9 +4839,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - call NWTC_Library_CopyVarsIdxType(SrcParamData%IdxAeroMap, DstParamData%IdxAeroMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstParamData%DT = SrcParamData%DT DstParamData%DT24 = SrcParamData%DT24 DstParamData%BldNodes = SrcParamData%BldNodes @@ -5749,7 +5762,7 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%iVarYaw = SrcParamData%iVarYaw DstParamData%iVarYawRate = SrcParamData%iVarYawRate DstParamData%iVarHSS_Spd = SrcParamData%iVarHSS_Spd - DstParamData%iVarOutput = SrcParamData%iVarOutput + DstParamData%iVarWriteOut = SrcParamData%iVarWriteOut end subroutine subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -5769,8 +5782,6 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Vars) ParamData%Vars => null() end if - call NWTC_Library_DestroyVarsIdxType(ParamData%IdxAeroMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%PH)) then deallocate(ParamData%PH) end if @@ -5985,7 +5996,6 @@ subroutine ED_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call NWTC_Library_PackVarsIdxType(RF, InData%IdxAeroMap) call RegPack(RF, InData%DT) call RegPack(RF, InData%DT24) call RegPack(RF, InData%BldNodes) @@ -6244,7 +6254,7 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%iVarYaw) call RegPack(RF, InData%iVarYawRate) call RegPack(RF, InData%iVarHSS_Spd) - call RegPack(RF, InData%iVarOutput) + call RegPack(RF, InData%iVarWriteOut) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6277,7 +6287,6 @@ subroutine ED_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxAeroMap) ! IdxAeroMap call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT24); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return @@ -6544,7 +6553,7 @@ subroutine ED_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%iVarYaw); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarYawRate); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarHSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOut); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -7145,19 +7154,19 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%QD2T = SrcMiscData%QD2T end if DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod - call NWTC_Library_CopyModLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call ED_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call ED_CopyContState(SrcMiscData%dx_perturb, DstMiscData%dx_perturb, CtrlCode, ErrStat2, ErrMsg2) + call ED_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call ED_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call ED_CopyOutput(SrcMiscData%y_perturb, DstMiscData%y_perturb, CtrlCode, ErrStat2, ErrMsg2) + call ED_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -7196,15 +7205,15 @@ subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%QD2T)) then deallocate(MiscData%QD2T) end if - call NWTC_Library_DestroyModLinType(MiscData%Lin, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ED_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyContState(MiscData%dx_perturb, ErrStat2, ErrMsg2) + call ED_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ED_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyOutput(MiscData%y_perturb, ErrStat2, ErrMsg2) + call ED_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -7223,11 +7232,11 @@ subroutine ED_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%OgnlGeAzRo) call RegPackAlloc(RF, InData%QD2T) call RegPack(RF, InData%IgnoreMod) - call NWTC_Library_PackModLinType(RF, InData%Lin) + call NWTC_Library_PackModJacType(RF, InData%Jac) call ED_PackContState(RF, InData%x_perturb) - call ED_PackContState(RF, InData%dx_perturb) + call ED_PackContState(RF, InData%dxdt_lin) call ED_PackInput(RF, InData%u_perturb) - call ED_PackOutput(RF, InData%y_perturb) + call ED_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7249,11 +7258,11 @@ subroutine ED_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%OgnlGeAzRo); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%IgnoreMod); if (RegCheckErr(RF, RoutineName)) return - call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call ED_UnpackContState(RF, OutData%x_perturb) ! x_perturb - call ED_UnpackContState(RF, OutData%dx_perturb) ! dx_perturb + call ED_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin call ED_UnpackInput(RF, OutData%u_perturb) ! u_perturb - call ED_UnpackOutput(RF, OutData%y_perturb) ! y_perturb + call ED_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine ED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -7759,5 +7768,109 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%LSShftFys = a1*y1%LSShftFys + a2*y2%LSShftFys + a3*y3%LSShftFys y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs + a3*y3%LSShftFzs END SUBROUTINE + +function ED_InputMeshPointer(u, ML) result(Mesh) + type(ED_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (ED_u_BladePtLoads) + Mesh => u%BladePtLoads(ML%i1) + case (ED_u_PlatformPtMesh) + Mesh => u%PlatformPtMesh + case (ED_u_TowerPtLoads) + Mesh => u%TowerPtLoads + case (ED_u_HubPtLoad) + Mesh => u%HubPtLoad + case (ED_u_NacelleLoads) + Mesh => u%NacelleLoads + case (ED_u_TFinCMLoads) + Mesh => u%TFinCMLoads + end select +end function + +function ED_InputMeshName(u, ML) result(Name) + type(ED_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (ED_u_BladePtLoads) + Name = "u%BladePtLoads("//trim(Num2LStr(ML%i1))//")" + case (ED_u_PlatformPtMesh) + Name = "u%PlatformPtMesh" + case (ED_u_TowerPtLoads) + Name = "u%TowerPtLoads" + case (ED_u_HubPtLoad) + Name = "u%HubPtLoad" + case (ED_u_NacelleLoads) + Name = "u%NacelleLoads" + case (ED_u_TFinCMLoads) + Name = "u%TFinCMLoads" + end select +end function + +function ED_OutputMeshPointer(y, ML) result(Mesh) + type(ED_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (ED_y_BladeLn2Mesh) + Mesh => y%BladeLn2Mesh(ML%i1) + case (ED_y_PlatformPtMesh) + Mesh => y%PlatformPtMesh + case (ED_y_TowerLn2Mesh) + Mesh => y%TowerLn2Mesh + case (ED_y_HubPtMotion14) + Mesh => y%HubPtMotion14 + case (ED_y_HubPtMotion) + Mesh => y%HubPtMotion + case (ED_y_BladeRootMotion14) + Mesh => y%BladeRootMotion14 + case (ED_y_BladeRootMotion) + Mesh => y%BladeRootMotion(ML%i1) + case (ED_y_RotorFurlMotion14) + Mesh => y%RotorFurlMotion14 + case (ED_y_NacelleMotion) + Mesh => y%NacelleMotion + case (ED_y_TowerBaseMotion14) + Mesh => y%TowerBaseMotion14 + case (ED_y_TFinCMMotion) + Mesh => y%TFinCMMotion + end select +end function + +function ED_OutputMeshName(y, ML) result(Name) + type(ED_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (ED_y_BladeLn2Mesh) + Name = "y%BladeLn2Mesh("//trim(Num2LStr(ML%i1))//")" + case (ED_y_PlatformPtMesh) + Name = "y%PlatformPtMesh" + case (ED_y_TowerLn2Mesh) + Name = "y%TowerLn2Mesh" + case (ED_y_HubPtMotion14) + Name = "y%HubPtMotion14" + case (ED_y_HubPtMotion) + Name = "y%HubPtMotion" + case (ED_y_BladeRootMotion14) + Name = "y%BladeRootMotion14" + case (ED_y_BladeRootMotion) + Name = "y%BladeRootMotion("//trim(Num2LStr(ML%i1))//")" + case (ED_y_RotorFurlMotion14) + Name = "y%RotorFurlMotion14" + case (ED_y_NacelleMotion) + Name = "y%NacelleMotion" + case (ED_y_TowerBaseMotion14) + Name = "y%TowerBaseMotion14" + case (ED_y_TFinCMMotion) + Name = "y%TFinCMMotion" + end select +end function END MODULE ElastoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index b2abf20b7e..c1e25a3d94 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -2632,5 +2632,41 @@ SUBROUTINE ExtInfw_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function ExtInfw_InputMeshPointer(u, ML) result(Mesh) + type(ExtInfw_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function ExtInfw_InputMeshName(u, ML) result(Name) + type(ExtInfw_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function ExtInfw_OutputMeshPointer(y, ML) result(Mesh) + type(ExtInfw_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function ExtInfw_OutputMeshName(y, ML) result(Name) + type(ExtInfw_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE ExternalInflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 17debf3902..5f921613bb 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -33,6 +33,8 @@ MODULE ExtPtfm_MCKF_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtPtfm_u_PtfmMesh = 1 ! Mesh number for ExtPtfm ExtPtfm_u_PtfmMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtPtfm_y_PtfmMesh = 2 ! Mesh number for ExtPtfm ExtPtfm_y_PtfmMesh mesh [-] ! ========= ExtPtfm_InitInputType ======= TYPE, PUBLIC :: ExtPtfm_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] @@ -1858,5 +1860,49 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function ExtPtfm_InputMeshPointer(u, ML) result(Mesh) + type(ExtPtfm_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (ExtPtfm_u_PtfmMesh) + Mesh => u%PtfmMesh + end select +end function + +function ExtPtfm_InputMeshName(u, ML) result(Name) + type(ExtPtfm_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (ExtPtfm_u_PtfmMesh) + Name = "u%PtfmMesh" + end select +end function + +function ExtPtfm_OutputMeshPointer(y, ML) result(Mesh) + type(ExtPtfm_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (ExtPtfm_y_PtfmMesh) + Mesh => y%PtfmMesh + end select +end function + +function ExtPtfm_OutputMeshName(y, ML) result(Name) + type(ExtPtfm_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (ExtPtfm_y_PtfmMesh) + Name = "y%PtfmMesh" + end select +end function END MODULE ExtPtfm_MCKF_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index a96fa832aa..4a974c7a6a 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -33,6 +33,10 @@ MODULE FEAMooring_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: FEAM_u_HydroForceLineMesh = 1 ! Mesh number for FEAM FEAM_u_HydroForceLineMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FEAM_u_PtFairleadDisplacement = 2 ! Mesh number for FEAM FEAM_u_PtFairleadDisplacement mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FEAM_y_PtFairleadLoad = 3 ! Mesh number for FEAM FEAM_y_PtFairleadLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FEAM_y_LineMeshPosition = 4 ! Mesh number for FEAM FEAM_y_LineMeshPosition mesh [-] ! ========= FEAM_InputFile ======= TYPE, PUBLIC :: FEAM_InputFile REAL(DbKi) :: DT = 0.0_R8Ki !< Communication interval for mooring dynamics [s] @@ -2410,5 +2414,57 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL MeshExtrapInterp2(y1%LineMeshPosition, y2%LineMeshPosition, y3%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function FEAM_InputMeshPointer(u, ML) result(Mesh) + type(FEAM_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (FEAM_u_HydroForceLineMesh) + Mesh => u%HydroForceLineMesh + case (FEAM_u_PtFairleadDisplacement) + Mesh => u%PtFairleadDisplacement + end select +end function + +function FEAM_InputMeshName(u, ML) result(Name) + type(FEAM_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (FEAM_u_HydroForceLineMesh) + Name = "u%HydroForceLineMesh" + case (FEAM_u_PtFairleadDisplacement) + Name = "u%PtFairleadDisplacement" + end select +end function + +function FEAM_OutputMeshPointer(y, ML) result(Mesh) + type(FEAM_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (FEAM_y_PtFairleadLoad) + Mesh => y%PtFairleadLoad + case (FEAM_y_LineMeshPosition) + Mesh => y%LineMeshPosition + end select +end function + +function FEAM_OutputMeshName(y, ML) result(Name) + type(FEAM_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (FEAM_y_PtFairleadLoad) + Name = "y%PtFairleadLoad" + case (FEAM_y_LineMeshPosition) + Name = "y%LineMeshPosition" + end select +end function END MODULE FEAMooring_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 4b47ee2a95..18d23ccde0 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -971,5 +971,41 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt y_out%F_Rdtn = a1*y1%F_Rdtn + a2*y2%F_Rdtn + a3*y3%F_Rdtn END IF ! check if allocated END SUBROUTINE + +function Conv_Rdtn_InputMeshPointer(u, ML) result(Mesh) + type(Conv_Rdtn_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function Conv_Rdtn_InputMeshName(u, ML) result(Name) + type(Conv_Rdtn_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function Conv_Rdtn_OutputMeshPointer(y, ML) result(Mesh) + type(Conv_Rdtn_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function Conv_Rdtn_OutputMeshName(y, ML) result(Name) + type(Conv_Rdtn_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE Conv_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index d0c6fac27f..0315ea70f4 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -39,8 +39,16 @@ MODULE HydroDyn_Types USE Morison_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_Morison_Mesh = 1 ! Mesh number for HydroDyn HydroDyn_u_Morison_Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_WAMITMesh = 2 ! Mesh number for HydroDyn HydroDyn_u_WAMITMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PRPMesh = 3 ! Mesh number for HydroDyn HydroDyn_u_PRPMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_WAMIT_Mesh = 4 ! Mesh number for HydroDyn HydroDyn_y_WAMIT_Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_WAMIT2_Mesh = 5 ! Mesh number for HydroDyn HydroDyn_y_WAMIT2_Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_Morison_Mesh = 6 ! Mesh number for HydroDyn HydroDyn_y_Morison_Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_Morison_VisMesh = 7 ! Mesh number for HydroDyn HydroDyn_y_Morison_VisMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_WAMITMesh = 8 ! Mesh number for HydroDyn HydroDyn_y_WAMITMesh mesh [-] ! ========= HydroDyn_InputFile ======= TYPE, PUBLIC :: HydroDyn_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -2526,5 +2534,73 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function HydroDyn_InputMeshPointer(u, ML) result(Mesh) + type(HydroDyn_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (HydroDyn_u_Morison_Mesh) + Mesh => u%Morison%Mesh + case (HydroDyn_u_WAMITMesh) + Mesh => u%WAMITMesh + case (HydroDyn_u_PRPMesh) + Mesh => u%PRPMesh + end select +end function + +function HydroDyn_InputMeshName(u, ML) result(Name) + type(HydroDyn_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (HydroDyn_u_Morison_Mesh) + Name = "u%Morison%Mesh" + case (HydroDyn_u_WAMITMesh) + Name = "u%WAMITMesh" + case (HydroDyn_u_PRPMesh) + Name = "u%PRPMesh" + end select +end function + +function HydroDyn_OutputMeshPointer(y, ML) result(Mesh) + type(HydroDyn_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (HydroDyn_y_WAMIT_Mesh) + Mesh => y%WAMIT(ML%i1)%Mesh + case (HydroDyn_y_WAMIT2_Mesh) + Mesh => y%WAMIT2(ML%i1)%Mesh + case (HydroDyn_y_Morison_Mesh) + Mesh => y%Morison%Mesh + case (HydroDyn_y_Morison_VisMesh) + Mesh => y%Morison%VisMesh + case (HydroDyn_y_WAMITMesh) + Mesh => y%WAMITMesh + end select +end function + +function HydroDyn_OutputMeshName(y, ML) result(Name) + type(HydroDyn_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (HydroDyn_y_WAMIT_Mesh) + Name = "y%WAMIT("//trim(Num2LStr(ML%i1))//")%Mesh" + case (HydroDyn_y_WAMIT2_Mesh) + Name = "y%WAMIT2("//trim(Num2LStr(ML%i1))//")%Mesh" + case (HydroDyn_y_Morison_Mesh) + Name = "y%Morison%Mesh" + case (HydroDyn_y_Morison_VisMesh) + Name = "y%Morison%VisMesh" + case (HydroDyn_y_WAMITMesh) + Name = "y%WAMITMesh" + end select +end function END MODULE HydroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index c68757261d..fe3c3f0914 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -34,6 +34,9 @@ MODULE Morison_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: Morison_u_Mesh = 1 ! Mesh number for Morison Morison_u_Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Morison_y_Mesh = 2 ! Mesh number for Morison Morison_y_Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Morison_y_VisMesh = 3 ! Mesh number for Morison Morison_y_VisMesh mesh [-] ! ========= Morison_JointType ======= TYPE, PUBLIC :: Morison_JointType INTEGER(IntKi) :: JointID = 0_IntKi !< User-specified integer ID for the given joint [-] @@ -4657,5 +4660,53 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function Morison_InputMeshPointer(u, ML) result(Mesh) + type(Morison_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (Morison_u_Mesh) + Mesh => u%Mesh + end select +end function + +function Morison_InputMeshName(u, ML) result(Name) + type(Morison_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (Morison_u_Mesh) + Name = "u%Mesh" + end select +end function + +function Morison_OutputMeshPointer(y, ML) result(Mesh) + type(Morison_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (Morison_y_Mesh) + Mesh => y%Mesh + case (Morison_y_VisMesh) + Mesh => y%VisMesh + end select +end function + +function Morison_OutputMeshName(y, ML) result(Name) + type(Morison_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (Morison_y_Mesh) + Name = "y%Mesh" + case (Morison_y_VisMesh) + Name = "y%VisMesh" + end select +end function END MODULE Morison_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 3e7179fe5a..059294a612 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -1151,5 +1151,41 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function SS_Exc_InputMeshPointer(u, ML) result(Mesh) + type(SS_Exc_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SS_Exc_InputMeshName(u, ML) result(Name) + type(SS_Exc_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function SS_Exc_OutputMeshPointer(y, ML) result(Mesh) + type(SS_Exc_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SS_Exc_OutputMeshName(y, ML) result(Name) + type(SS_Exc_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE SS_Excitation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 1c91b852e4..0022c08c2d 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -1072,5 +1072,41 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function SS_Rad_InputMeshPointer(u, ML) result(Mesh) + type(SS_Rad_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SS_Rad_InputMeshName(u, ML) result(Name) + type(SS_Rad_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function SS_Rad_OutputMeshPointer(y, ML) result(Mesh) + type(SS_Rad_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SS_Rad_OutputMeshName(y, ML) result(Name) + type(SS_Rad_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE SS_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index c2b6e5baeb..7f57c52b9a 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -34,7 +34,8 @@ MODULE WAMIT2_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WAMIT2_y_Mesh = 1 ! Mesh number for WAMIT2 WAMIT2_y_Mesh mesh [-] ! ========= WAMIT2_InitInputType ======= TYPE, PUBLIC :: WAMIT2_InitInputType LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] @@ -631,5 +632,27 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function WAMIT2_OutputMeshPointer(y, ML) result(Mesh) + type(WAMIT2_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (WAMIT2_y_Mesh) + Mesh => y%Mesh + end select +end function + +function WAMIT2_OutputMeshName(y, ML) result(Name) + type(WAMIT2_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (WAMIT2_y_Mesh) + Name = "y%Mesh" + end select +end function END MODULE WAMIT2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 1f1bbd75dd..3bd101eb40 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -36,6 +36,8 @@ MODULE WAMIT_Types USE SS_Excitation_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: WAMIT_u_Mesh = 1 ! Mesh number for WAMIT WAMIT_u_Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WAMIT_y_Mesh = 2 ! Mesh number for WAMIT WAMIT_y_Mesh mesh [-] ! ========= WAMIT_InitInputType ======= TYPE, PUBLIC :: WAMIT_InitInputType INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] @@ -1424,5 +1426,49 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function WAMIT_InputMeshPointer(u, ML) result(Mesh) + type(WAMIT_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (WAMIT_u_Mesh) + Mesh => u%Mesh + end select +end function + +function WAMIT_InputMeshName(u, ML) result(Name) + type(WAMIT_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (WAMIT_u_Mesh) + Name = "u%Mesh" + end select +end function + +function WAMIT_OutputMeshPointer(y, ML) result(Mesh) + type(WAMIT_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (WAMIT_y_Mesh) + Mesh => y%Mesh + end select +end function + +function WAMIT_OutputMeshName(y, ML) result(Name) + type(WAMIT_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (WAMIT_y_Mesh) + Name = "y%Mesh" + end select +end function END MODULE WAMIT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index c62479cd44..e3bc43c58d 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -33,6 +33,8 @@ MODULE IceDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_u_PointMesh = 1 ! Mesh number for IceD IceD_u_PointMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_y_PointMesh = 2 ! Mesh number for IceD IceD_y_PointMesh mesh [-] ! ========= IceD_InputFile ======= TYPE, PUBLIC :: IceD_InputFile INTEGER(IntKi) :: IceModel = 0_IntKi !< The current ice model number [-] @@ -1739,5 +1741,49 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function IceD_InputMeshPointer(u, ML) result(Mesh) + type(IceD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (IceD_u_PointMesh) + Mesh => u%PointMesh + end select +end function + +function IceD_InputMeshName(u, ML) result(Name) + type(IceD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (IceD_u_PointMesh) + Name = "u%PointMesh" + end select +end function + +function IceD_OutputMeshPointer(y, ML) result(Mesh) + type(IceD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (IceD_y_PointMesh) + Mesh => y%PointMesh + end select +end function + +function IceD_OutputMeshName(y, ML) result(Name) + type(IceD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (IceD_y_PointMesh) + Name = "y%PointMesh" + end select +end function END MODULE IceDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 41cffbc0de..d2d5ea2242 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -33,6 +33,8 @@ MODULE IceFloe_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: IceFloe_u_iceMesh = 1 ! Mesh number for IceFloe IceFloe_u_iceMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: IceFloe_y_iceMesh = 2 ! Mesh number for IceFloe IceFloe_y_iceMesh mesh [-] ! ========= IceFloe_InitInputType ======= TYPE, PUBLIC :: IceFloe_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] @@ -1021,5 +1023,49 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function IceFloe_InputMeshPointer(u, ML) result(Mesh) + type(IceFloe_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (IceFloe_u_iceMesh) + Mesh => u%iceMesh + end select +end function + +function IceFloe_InputMeshName(u, ML) result(Name) + type(IceFloe_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (IceFloe_u_iceMesh) + Name = "u%iceMesh" + end select +end function + +function IceFloe_OutputMeshPointer(y, ML) result(Mesh) + type(IceFloe_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (IceFloe_y_iceMesh) + Mesh => y%iceMesh + end select +end function + +function IceFloe_OutputMeshName(y, ML) result(Name) + type(IceFloe_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (IceFloe_y_iceMesh) + Name = "y%iceMesh" + end select +end function END MODULE IceFloe_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 022bbb2cb9..0bad2a2bde 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -33,12 +33,12 @@ MODULE IfW_FlowField_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Undef_FieldType = 0 ! This is the code for an undefined FieldType [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Uniform_FieldType = 1 ! Uniform FieldType from SteadyWind or Uniform Wind [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Grid3D_FieldType = 2 ! 3D Grid FieldType from TurbSim, Bladed, HAWC [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Grid4D_FieldType = 3 ! 4D Grid FieldType from FAST.Farm [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Point_FieldType = 4 ! Points FieldType from ExtInflow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: User_FieldType = 5 ! User FieldType configured by the user [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Undef_FieldType = 0 ! This is the code for an undefined FieldType [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Uniform_FieldType = 1 ! Uniform FieldType from SteadyWind or Uniform Wind [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Grid3D_FieldType = 2 ! 3D Grid FieldType from TurbSim, Bladed, HAWC [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Grid4D_FieldType = 3 ! 4D Grid FieldType from FAST.Farm [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Point_FieldType = 4 ! Points FieldType from ExtInflow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: User_FieldType = 5 ! User FieldType configured by the user [-] ! ========= UniformFieldType ======= TYPE, PUBLIC :: UniformFieldType REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 98cd599ab4..e1eb750f1a 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -36,18 +36,18 @@ MODULE InflowWind_Types USE Lidar_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Undef_WindNumber = 0 ! This is the code for an undefined WindFileType [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Steady_WindNumber = 1 ! Steady wind. Calculated internally. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Uniform_WindNumber = 2 ! Uniform wind. Formally known as a Hub-Height wind file. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TSFF_WindNumber = 3 ! TurbSim full-field binary file. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BladedFF_WindNumber = 4 ! Bladed style binary full-field file. Includes native bladed format [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HAWC_WindNumber = 5 ! HAWC wind file. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: User_WindNumber = 6 ! User defined wind. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BladedFF_Shr_WindNumber = 7 ! Native Bladed binary full-field file. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FDext_WindNumber = 8 ! 4D wind from external souce (i.e., FAST.Farm). [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Point_WindNumber = 9 ! 1D wind components from ExtInflow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Highest_WindNumber = 9 ! Highest wind number supported. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: IfW_NumPtsAvg = 144 ! Number of points averaged for rotor-average wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Undef_WindNumber = 0 ! This is the code for an undefined WindFileType [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Steady_WindNumber = 1 ! Steady wind. Calculated internally. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Uniform_WindNumber = 2 ! Uniform wind. Formally known as a Hub-Height wind file. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TSFF_WindNumber = 3 ! TurbSim full-field binary file. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BladedFF_WindNumber = 4 ! Bladed style binary full-field file. Includes native bladed format [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HAWC_WindNumber = 5 ! HAWC wind file. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: User_WindNumber = 6 ! User defined wind. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BladedFF_Shr_WindNumber = 7 ! Native Bladed binary full-field file. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FDext_WindNumber = 8 ! 4D wind from external souce (i.e., FAST.Farm). [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Point_WindNumber = 9 ! 1D wind components from ExtInflow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Highest_WindNumber = 9 ! Highest wind number supported. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: IfW_NumPtsAvg = 144 ! Number of points averaged for rotor-average wind speed [-] ! ========= InflowWind_InputFile ======= TYPE, PUBLIC :: InflowWind_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -1848,5 +1848,41 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function InflowWind_InputMeshPointer(u, ML) result(Mesh) + type(InflowWind_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function InflowWind_InputMeshName(u, ML) result(Name) + type(InflowWind_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function InflowWind_OutputMeshPointer(y, ML) result(Mesh) + type(InflowWind_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function InflowWind_OutputMeshName(y, ML) result(Name) + type(InflowWind_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE InflowWind_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index bb71c0ad4b..7fbb97f0a5 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -33,10 +33,10 @@ MODULE Lidar_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_None = 0 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_SinglePoint = 1 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_ContinuousLidar = 2 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_PulsedLidar = 3 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_None = 0 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_SinglePoint = 1 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_ContinuousLidar = 2 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_PulsedLidar = 3 ! ========= Lidar_InitInputType ======= TYPE, PUBLIC :: Lidar_InitInputType INTEGER(IntKi) :: SensorType = SensorType_None !< SensorType_* parameter [-] @@ -1096,5 +1096,41 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, y_out%MsrPositionsZ = a1*y1%MsrPositionsZ + a2*y2%MsrPositionsZ + a3*y3%MsrPositionsZ END IF ! check if allocated END SUBROUTINE + +function Lidar_InputMeshPointer(u, ML) result(Mesh) + type(Lidar_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function Lidar_InputMeshName(u, ML) result(Name) + type(Lidar_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function Lidar_OutputMeshPointer(y, ML) result(Mesh) + type(Lidar_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function Lidar_OutputMeshName(y, ML) result(Name) + type(Lidar_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE Lidar_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index ae02cdbd28..511b3e3014 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -34,6 +34,8 @@ MODULE MAP_Types USE MAP_Fortran_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: MAP_u_PtFairDisplacement = 1 ! Mesh number for MAP MAP_u_PtFairDisplacement mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MAP_y_ptFairleadLoad = 2 ! Mesh number for MAP MAP_y_ptFairleadLoad mesh [-] ! ========= MAP_InitInputType_C ======= TYPE, BIND(C) :: MAP_InitInputType_C TYPE(C_PTR) :: object = C_NULL_PTR @@ -2789,5 +2791,49 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function MAP_InputMeshPointer(u, ML) result(Mesh) + type(MAP_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (MAP_u_PtFairDisplacement) + Mesh => u%PtFairDisplacement + end select +end function + +function MAP_InputMeshName(u, ML) result(Name) + type(MAP_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (MAP_u_PtFairDisplacement) + Name = "u%PtFairDisplacement" + end select +end function + +function MAP_OutputMeshPointer(y, ML) result(Mesh) + type(MAP_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (MAP_y_ptFairleadLoad) + Mesh => y%ptFairleadLoad + end select +end function + +function MAP_OutputMeshName(y, ML) result(Name) + type(MAP_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (MAP_y_ptFairleadLoad) + Name = "y%ptFairleadLoad" + end select +end function END MODULE MAP_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index e862234ef1..f89b8bffa3 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -33,6 +33,12 @@ MODULE MoorDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_u_CoupledKinematics = 1 ! Mesh number for MD MD_u_CoupledKinematics mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_CoupledLoads = 2 ! Mesh number for MD MD_y_CoupledLoads mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_VisLinesMesh = 3 ! Mesh number for MD MD_y_VisLinesMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_VisRodsMesh = 4 ! Mesh number for MD MD_y_VisRodsMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_VisBodiesMesh = 5 ! Mesh number for MD MD_y_VisBodiesMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_VisAnchsMesh = 6 ! Mesh number for MD MD_y_VisAnchsMesh mesh [-] ! ========= MD_InputFileType ======= TYPE, PUBLIC :: MD_InputFileType REAL(DbKi) :: DTIC = 0.5 !< convergence check time step for IC generation [[s]] @@ -4949,5 +4955,65 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END DO END IF ! check if allocated END SUBROUTINE + +function MD_InputMeshPointer(u, ML) result(Mesh) + type(MD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (MD_u_CoupledKinematics) + Mesh => u%CoupledKinematics(ML%i1) + end select +end function + +function MD_InputMeshName(u, ML) result(Name) + type(MD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (MD_u_CoupledKinematics) + Name = "u%CoupledKinematics("//trim(Num2LStr(ML%i1))//")" + end select +end function + +function MD_OutputMeshPointer(y, ML) result(Mesh) + type(MD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (MD_y_CoupledLoads) + Mesh => y%CoupledLoads(ML%i1) + case (MD_y_VisLinesMesh) + Mesh => y%VisLinesMesh(ML%i1) + case (MD_y_VisRodsMesh) + Mesh => y%VisRodsMesh(ML%i1) + case (MD_y_VisBodiesMesh) + Mesh => y%VisBodiesMesh(ML%i1) + case (MD_y_VisAnchsMesh) + Mesh => y%VisAnchsMesh(ML%i1) + end select +end function + +function MD_OutputMeshName(y, ML) result(Name) + type(MD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (MD_y_CoupledLoads) + Name = "y%CoupledLoads("//trim(Num2LStr(ML%i1))//")" + case (MD_y_VisLinesMesh) + Name = "y%VisLinesMesh("//trim(Num2LStr(ML%i1))//")" + case (MD_y_VisRodsMesh) + Name = "y%VisRodsMesh("//trim(Num2LStr(ML%i1))//")" + case (MD_y_VisBodiesMesh) + Name = "y%VisBodiesMesh("//trim(Num2LStr(ML%i1))//")" + case (MD_y_VisAnchsMesh) + Name = "y%VisAnchsMesh("//trim(Num2LStr(ML%i1))//")" + end select +end function END MODULE MoorDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 0166ced4d9..e88ed5f21c 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -34,28 +34,32 @@ MODULE NWTC_Library_Types USE SysSubs USE ModReg IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Force = 1 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Moment = 2 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Orientation = 3 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransDisp = 4 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularDisp = 5 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransVel = 6 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularVel = 7 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransAcc = 8 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularAcc = 9 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Scalar = 10 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 8 ! Variable for extended linearization [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 16 ! Variable for aeromap [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Any = 4095 ! Enable all flags (used for filtering) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option2 = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Force = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Moment = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Orientation = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransDisp = 4 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularDisp = 5 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransVel = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularVel = 7 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransAcc = 8 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularAcc = 9 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Scalar = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Linearize = 8 ! Variable for linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_ExtLin = 16 ! Variable for extended linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 32 ! Variable for write output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 64 ! Variable for solver [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 128 ! Variable for aeromap [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 256 ! Variable is derivative order 1 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 512 ! Variable is derivative order 2 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option2 = 3 ! [-] ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc CHARACTER(99) :: Name !< Name of the program or module [-] @@ -119,7 +123,7 @@ MODULE NWTC_Library_Types INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] - REAL(R8Ki) :: Perturb = 0 !< perturbation [-] + REAL(R8Ki) :: Perturb = 0 !< perturbation amount for linearization [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType ! ======================= @@ -127,9 +131,13 @@ MODULE NWTC_Library_Types TYPE, PUBLIC :: VarsIdxType INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nxd = 0_IntKi !< [-] + INTEGER(IntKi) :: Nz = 0_IntKi !< [-] INTEGER(IntKi) :: Nu = 0_IntKi !< [-] INTEGER(IntKi) :: Ny = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ix !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ixd !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iz !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: idx !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iu !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iy !< [-] @@ -137,19 +145,43 @@ MODULE NWTC_Library_Types ! ======================= ! ========= ModVarsType ======= TYPE, PUBLIC :: ModVarsType - INTEGER(IntKi) :: Nx = 0_IntKi !< [-] - INTEGER(IntKi) :: Nu = 0_IntKi !< [-] - INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + INTEGER(IntKi) :: Nx = 0 !< Number of x values [-] + INTEGER(IntKi) :: Nxd = 0 !< Number of xd values [-] + INTEGER(IntKi) :: Nz = 0 !< Number of z values [-] + INTEGER(IntKi) :: Nu = 0 !< Number of u values [-] + INTEGER(IntKi) :: Ny = 0 !< Number of y values [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: xd !< Module state variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: z !< Module state variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] - TYPE(VarsIdxType) :: SolverIdx !< [-] + TYPE(VarsIdxType) :: IdxLin !< Variable index array [-] + TYPE(VarsIdxType) :: IdxSolver !< Variable index array [-] + TYPE(VarsIdxType) :: IdxAeroMap !< Variable index array [-] END TYPE ModVarsType ! ======================= +! ========= ModJacType ======= + TYPE, PUBLIC :: ModJacType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] + END TYPE ModJacType +! ======================= ! ========= ModLinType ======= TYPE, PUBLIC :: ModLinType REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] @@ -162,25 +194,38 @@ MODULE NWTC_Library_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] END TYPE ModLinType ! ======================= ! ========= ModDataType ======= TYPE, PUBLIC :: ModDataType - INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] - INTEGER(IntKi) :: ID = 0 !< Module identification number [-] character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] + INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] - LOGICAL :: IsTC = .false. !< Flag indicating module is part of tight coupling [-] REAL(R8Ki) :: DT = 0 !< Module time step [-] INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] + INTEGER(IntKi) :: ixg = 0_IntKi !< starting index for continuous state values in global arrays [-] + INTEGER(IntKi) :: ixdg = 0_IntKi !< starting index for discrete state values in global arrays [-] + INTEGER(IntKi) :: izg = 0_IntKi !< starting index for constraint state values in global arrays [-] + INTEGER(IntKi) :: iug = 0_IntKi !< starting index for input values in global arrays [-] + INTEGER(IntKi) :: iyg = 0_IntKi !< starting index for output values in global arrays [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] + TYPE(ModLinType) :: Lin !< Module linearization data [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] END TYPE ModDataType ! ======================= +! ========= MeshLocType ======= + TYPE, PUBLIC :: MeshLocType + INTEGER(IntKi) :: Num = 0 !< Mesh number in module [-] + INTEGER(IntKi) :: i1 = 0 !< Mesh index 1 [-] + INTEGER(IntKi) :: i2 = 0 !< Mesh index 2 [-] + INTEGER(IntKi) :: i3 = 0 !< Mesh index 3 [-] + END TYPE MeshLocType +! ======================= CONTAINS subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) @@ -704,6 +749,8 @@ subroutine NWTC_Library_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, ErrMsg = '' DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx + DstVarsIdxTypeData%Nxd = SrcVarsIdxTypeData%Nxd + DstVarsIdxTypeData%Nz = SrcVarsIdxTypeData%Nz DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny if (allocated(SrcVarsIdxTypeData%ix)) then @@ -718,6 +765,30 @@ subroutine NWTC_Library_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, end if DstVarsIdxTypeData%ix = SrcVarsIdxTypeData%ix end if + if (allocated(SrcVarsIdxTypeData%ixd)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%ixd, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%ixd, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%ixd)) then + allocate(DstVarsIdxTypeData%ixd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%ixd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarsIdxTypeData%ixd = SrcVarsIdxTypeData%ixd + end if + if (allocated(SrcVarsIdxTypeData%iz)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%iz, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%iz, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%iz)) then + allocate(DstVarsIdxTypeData%iz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarsIdxTypeData%iz = SrcVarsIdxTypeData%iz + end if if (allocated(SrcVarsIdxTypeData%idx)) then LB(1:1) = lbound(SrcVarsIdxTypeData%idx, kind=B8Ki) UB(1:1) = ubound(SrcVarsIdxTypeData%idx, kind=B8Ki) @@ -766,6 +837,12 @@ subroutine NWTC_Library_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) if (allocated(VarsIdxTypeData%ix)) then deallocate(VarsIdxTypeData%ix) end if + if (allocated(VarsIdxTypeData%ixd)) then + deallocate(VarsIdxTypeData%ixd) + end if + if (allocated(VarsIdxTypeData%iz)) then + deallocate(VarsIdxTypeData%iz) + end if if (allocated(VarsIdxTypeData%idx)) then deallocate(VarsIdxTypeData%idx) end if @@ -784,9 +861,13 @@ subroutine NWTC_Library_PackVarsIdxType(RF, Indata) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%FlagFilter) call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nxd) + call RegPack(RF, InData%Nz) call RegPack(RF, InData%Nu) call RegPack(RF, InData%Ny) call RegPackAlloc(RF, InData%ix) + call RegPackAlloc(RF, InData%ixd) + call RegPackAlloc(RF, InData%iz) call RegPackAlloc(RF, InData%idx) call RegPackAlloc(RF, InData%iu) call RegPackAlloc(RF, InData%iy) @@ -803,9 +884,13 @@ subroutine NWTC_Library_UnPackVarsIdxType(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ixd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iz); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%idx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iu); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iy); if (RegCheckErr(RF, RoutineName)) return @@ -825,6 +910,8 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, ErrStat = ErrID_None ErrMsg = '' DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx + DstModVarsTypeData%Nxd = SrcModVarsTypeData%Nxd + DstModVarsTypeData%Nz = SrcModVarsTypeData%Nz DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny if (allocated(SrcModVarsTypeData%x)) then @@ -843,6 +930,38 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (ErrStat >= AbortErrLev) return end do end if + if (allocated(SrcModVarsTypeData%xd)) then + LB(1:1) = lbound(SrcModVarsTypeData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcModVarsTypeData%xd, kind=B8Ki) + if (.not. allocated(DstModVarsTypeData%xd)) then + allocate(DstModVarsTypeData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%xd(i1), DstModVarsTypeData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModVarsTypeData%z)) then + LB(1:1) = lbound(SrcModVarsTypeData%z, kind=B8Ki) + UB(1:1) = ubound(SrcModVarsTypeData%z, kind=B8Ki) + if (.not. allocated(DstModVarsTypeData%z)) then + allocate(DstModVarsTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%z(i1), DstModVarsTypeData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcModVarsTypeData%u)) then LB(1:1) = lbound(SrcModVarsTypeData%u, kind=B8Ki) UB(1:1) = ubound(SrcModVarsTypeData%u, kind=B8Ki) @@ -875,7 +994,13 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (ErrStat >= AbortErrLev) return end do end if - call NWTC_Library_CopyVarsIdxType(SrcModVarsTypeData%SolverIdx, DstModVarsTypeData%SolverIdx, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyVarsIdxType(SrcModVarsTypeData%IdxLin, DstModVarsTypeData%IdxLin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyVarsIdxType(SrcModVarsTypeData%IdxSolver, DstModVarsTypeData%IdxSolver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyVarsIdxType(SrcModVarsTypeData%IdxAeroMap, DstModVarsTypeData%IdxAeroMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -900,6 +1025,24 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) end do deallocate(ModVarsTypeData%x) end if + if (allocated(ModVarsTypeData%xd)) then + LB(1:1) = lbound(ModVarsTypeData%xd, kind=B8Ki) + UB(1:1) = ubound(ModVarsTypeData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%xd) + end if + if (allocated(ModVarsTypeData%z)) then + LB(1:1) = lbound(ModVarsTypeData%z, kind=B8Ki) + UB(1:1) = ubound(ModVarsTypeData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%z) + end if if (allocated(ModVarsTypeData%u)) then LB(1:1) = lbound(ModVarsTypeData%u, kind=B8Ki) UB(1:1) = ubound(ModVarsTypeData%u, kind=B8Ki) @@ -918,7 +1061,11 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) end do deallocate(ModVarsTypeData%y) end if - call NWTC_Library_DestroyVarsIdxType(ModVarsTypeData%SolverIdx, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyVarsIdxType(ModVarsTypeData%IdxLin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyVarsIdxType(ModVarsTypeData%IdxSolver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyVarsIdxType(ModVarsTypeData%IdxAeroMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -930,6 +1077,8 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nxd) + call RegPack(RF, InData%Nz) call RegPack(RF, InData%Nu) call RegPack(RF, InData%Ny) call RegPack(RF, allocated(InData%x)) @@ -941,6 +1090,24 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) call NWTC_Library_PackModVarType(RF, InData%x(i1)) end do end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%z(i1)) + end do + end if call RegPack(RF, allocated(InData%u)) if (allocated(InData%u)) then call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) @@ -959,7 +1126,9 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) call NWTC_Library_PackModVarType(RF, InData%y(i1)) end do end if - call NWTC_Library_PackVarsIdxType(RF, InData%SolverIdx) + call NWTC_Library_PackVarsIdxType(RF, InData%IdxLin) + call NWTC_Library_PackVarsIdxType(RF, InData%IdxSolver) + call NWTC_Library_PackVarsIdxType(RF, InData%IdxAeroMap) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -973,6 +1142,8 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%x)) deallocate(OutData%x) @@ -988,6 +1159,32 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) call NWTC_Library_UnpackModVarType(RF, OutData%x(i1)) ! x end do end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%z(i1)) ! z + end do + end if if (allocated(OutData%u)) deallocate(OutData%u) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -1014,7 +1211,253 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) call NWTC_Library_UnpackModVarType(RF, OutData%y(i1)) ! y end do end if - call NWTC_Library_UnpackVarsIdxType(RF, OutData%SolverIdx) ! SolverIdx + call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxLin) ! IdxLin + call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxSolver) ! IdxSolver + call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxAeroMap) ! IdxAeroMap +end subroutine + +subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModJacType), intent(in) :: SrcModJacTypeData + type(ModJacType), intent(inout) :: DstModJacTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModJacType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModJacTypeData%x)) then + LB(1:1) = lbound(SrcModJacTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%x, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%x)) then + allocate(DstModJacTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%x = SrcModJacTypeData%x + end if + if (allocated(SrcModJacTypeData%dx)) then + LB(1:1) = lbound(SrcModJacTypeData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%dx, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%dx)) then + allocate(DstModJacTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%dx = SrcModJacTypeData%dx + end if + if (allocated(SrcModJacTypeData%xd)) then + LB(1:1) = lbound(SrcModJacTypeData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%xd, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%xd)) then + allocate(DstModJacTypeData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%xd = SrcModJacTypeData%xd + end if + if (allocated(SrcModJacTypeData%z)) then + LB(1:1) = lbound(SrcModJacTypeData%z, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%z, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%z)) then + allocate(DstModJacTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%z = SrcModJacTypeData%z + end if + if (allocated(SrcModJacTypeData%u)) then + LB(1:1) = lbound(SrcModJacTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%u, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%u)) then + allocate(DstModJacTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%u = SrcModJacTypeData%u + end if + if (allocated(SrcModJacTypeData%y)) then + LB(1:1) = lbound(SrcModJacTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%y, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%y)) then + allocate(DstModJacTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%y = SrcModJacTypeData%y + end if + if (allocated(SrcModJacTypeData%u_perturb)) then + LB(1:1) = lbound(SrcModJacTypeData%u_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%u_perturb, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%u_perturb)) then + allocate(DstModJacTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%u_perturb = SrcModJacTypeData%u_perturb + end if + if (allocated(SrcModJacTypeData%x_perturb)) then + LB(1:1) = lbound(SrcModJacTypeData%x_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%x_perturb, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%x_perturb)) then + allocate(DstModJacTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%x_perturb = SrcModJacTypeData%x_perturb + end if + if (allocated(SrcModJacTypeData%x_pos)) then + LB(1:1) = lbound(SrcModJacTypeData%x_pos, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%x_pos, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%x_pos)) then + allocate(DstModJacTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%x_pos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%x_pos = SrcModJacTypeData%x_pos + end if + if (allocated(SrcModJacTypeData%x_neg)) then + LB(1:1) = lbound(SrcModJacTypeData%x_neg, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%x_neg, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%x_neg)) then + allocate(DstModJacTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%x_neg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%x_neg = SrcModJacTypeData%x_neg + end if + if (allocated(SrcModJacTypeData%y_pos)) then + LB(1:1) = lbound(SrcModJacTypeData%y_pos, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%y_pos, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%y_pos)) then + allocate(DstModJacTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%y_pos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%y_pos = SrcModJacTypeData%y_pos + end if + if (allocated(SrcModJacTypeData%y_neg)) then + LB(1:1) = lbound(SrcModJacTypeData%y_neg, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%y_neg, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%y_neg)) then + allocate(DstModJacTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%y_neg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%y_neg = SrcModJacTypeData%y_neg + end if +end subroutine + +subroutine NWTC_Library_DestroyModJacType(ModJacTypeData, ErrStat, ErrMsg) + type(ModJacType), intent(inout) :: ModJacTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModJacType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModJacTypeData%x)) then + deallocate(ModJacTypeData%x) + end if + if (allocated(ModJacTypeData%dx)) then + deallocate(ModJacTypeData%dx) + end if + if (allocated(ModJacTypeData%xd)) then + deallocate(ModJacTypeData%xd) + end if + if (allocated(ModJacTypeData%z)) then + deallocate(ModJacTypeData%z) + end if + if (allocated(ModJacTypeData%u)) then + deallocate(ModJacTypeData%u) + end if + if (allocated(ModJacTypeData%y)) then + deallocate(ModJacTypeData%y) + end if + if (allocated(ModJacTypeData%u_perturb)) then + deallocate(ModJacTypeData%u_perturb) + end if + if (allocated(ModJacTypeData%x_perturb)) then + deallocate(ModJacTypeData%x_perturb) + end if + if (allocated(ModJacTypeData%x_pos)) then + deallocate(ModJacTypeData%x_pos) + end if + if (allocated(ModJacTypeData%x_neg)) then + deallocate(ModJacTypeData%x_neg) + end if + if (allocated(ModJacTypeData%y_pos)) then + deallocate(ModJacTypeData%y_pos) + end if + if (allocated(ModJacTypeData%y_neg)) then + deallocate(ModJacTypeData%y_neg) + end if +end subroutine + +subroutine NWTC_Library_PackModJacType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModJacType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModJacType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%dx) + call RegPackAlloc(RF, InData%xd) + call RegPackAlloc(RF, InData%z) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%u_perturb) + call RegPackAlloc(RF, InData%x_perturb) + call RegPackAlloc(RF, InData%x_pos) + call RegPackAlloc(RF, InData%x_neg) + call RegPackAlloc(RF, InData%y_pos) + call RegPackAlloc(RF, InData%y_neg) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModJacType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModJacType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModJacType' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1052,6 +1495,30 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr end if DstModLinTypeData%dx = SrcModLinTypeData%dx end if + if (allocated(SrcModLinTypeData%xd)) then + LB(1:1) = lbound(SrcModLinTypeData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%xd, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%xd)) then + allocate(DstModLinTypeData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%xd = SrcModLinTypeData%xd + end if + if (allocated(SrcModLinTypeData%z)) then + LB(1:1) = lbound(SrcModLinTypeData%z, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%z, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%z)) then + allocate(DstModLinTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%z = SrcModLinTypeData%z + end if if (allocated(SrcModLinTypeData%u)) then LB(1:1) = lbound(SrcModLinTypeData%u, kind=B8Ki) UB(1:1) = ubound(SrcModLinTypeData%u, kind=B8Ki) @@ -1196,6 +1663,42 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr end if DstModLinTypeData%dXdu = SrcModLinTypeData%dXdu end if + if (allocated(SrcModLinTypeData%dUdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dUdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dUdu, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dUdu)) then + allocate(DstModLinTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dUdu = SrcModLinTypeData%dUdu + end if + if (allocated(SrcModLinTypeData%dUdy)) then + LB(1:2) = lbound(SrcModLinTypeData%dUdy, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dUdy, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dUdy)) then + allocate(DstModLinTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dUdy = SrcModLinTypeData%dUdy + end if + if (allocated(SrcModLinTypeData%StateRotation)) then + LB(1:2) = lbound(SrcModLinTypeData%StateRotation, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%StateRotation, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%StateRotation)) then + allocate(DstModLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%StateRotation = SrcModLinTypeData%StateRotation + end if end subroutine subroutine NWTC_Library_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) @@ -1211,6 +1714,12 @@ subroutine NWTC_Library_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) if (allocated(ModLinTypeData%dx)) then deallocate(ModLinTypeData%dx) end if + if (allocated(ModLinTypeData%xd)) then + deallocate(ModLinTypeData%xd) + end if + if (allocated(ModLinTypeData%z)) then + deallocate(ModLinTypeData%z) + end if if (allocated(ModLinTypeData%u)) then deallocate(ModLinTypeData%u) end if @@ -1247,6 +1756,15 @@ subroutine NWTC_Library_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) if (allocated(ModLinTypeData%dXdu)) then deallocate(ModLinTypeData%dXdu) end if + if (allocated(ModLinTypeData%dUdu)) then + deallocate(ModLinTypeData%dUdu) + end if + if (allocated(ModLinTypeData%dUdy)) then + deallocate(ModLinTypeData%dUdy) + end if + if (allocated(ModLinTypeData%StateRotation)) then + deallocate(ModLinTypeData%StateRotation) + end if end subroutine subroutine NWTC_Library_PackModLinType(RF, Indata) @@ -1256,6 +1774,8 @@ subroutine NWTC_Library_PackModLinType(RF, Indata) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%x) call RegPackAlloc(RF, InData%dx) + call RegPackAlloc(RF, InData%xd) + call RegPackAlloc(RF, InData%z) call RegPackAlloc(RF, InData%u) call RegPackAlloc(RF, InData%y) call RegPackAlloc(RF, InData%u_perturb) @@ -1268,6 +1788,9 @@ subroutine NWTC_Library_PackModLinType(RF, Indata) call RegPackAlloc(RF, InData%dXdx) call RegPackAlloc(RF, InData%dYdu) call RegPackAlloc(RF, InData%dXdu) + call RegPackAlloc(RF, InData%dUdu) + call RegPackAlloc(RF, InData%dUdy) + call RegPackAlloc(RF, InData%StateRotation) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1281,6 +1804,8 @@ subroutine NWTC_Library_UnPackModLinType(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return @@ -1293,6 +1818,9 @@ subroutine NWTC_Library_UnPackModLinType(RF, OutData) call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1301,56 +1829,27 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' ErrStat = ErrID_None ErrMsg = '' - DstModDataTypeData%Idx = SrcModDataTypeData%Idx - DstModDataTypeData%ID = SrcModDataTypeData%ID DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%ID = SrcModDataTypeData%ID + DstModDataTypeData%Idx = SrcModDataTypeData%Idx DstModDataTypeData%Ins = SrcModDataTypeData%Ins - DstModDataTypeData%IsTC = SrcModDataTypeData%IsTC DstModDataTypeData%DT = SrcModDataTypeData%DT DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps - if (allocated(SrcModDataTypeData%ixs)) then - LB(1:2) = lbound(SrcModDataTypeData%ixs, kind=B8Ki) - UB(1:2) = ubound(SrcModDataTypeData%ixs, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%ixs)) then - allocate(DstModDataTypeData%ixs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ixs.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%ixs = SrcModDataTypeData%ixs - end if - if (allocated(SrcModDataTypeData%ius)) then - LB(1:2) = lbound(SrcModDataTypeData%ius, kind=B8Ki) - UB(1:2) = ubound(SrcModDataTypeData%ius, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%ius)) then - allocate(DstModDataTypeData%ius(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ius.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%ius = SrcModDataTypeData%ius - end if - if (allocated(SrcModDataTypeData%iys)) then - LB(1:2) = lbound(SrcModDataTypeData%iys, kind=B8Ki) - UB(1:2) = ubound(SrcModDataTypeData%iys, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%iys)) then - allocate(DstModDataTypeData%iys(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iys.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%iys = SrcModDataTypeData%iys - end if + DstModDataTypeData%ixg = SrcModDataTypeData%ixg + DstModDataTypeData%ixdg = SrcModDataTypeData%ixdg + DstModDataTypeData%izg = SrcModDataTypeData%izg + DstModDataTypeData%iug = SrcModDataTypeData%iug + DstModDataTypeData%iyg = SrcModDataTypeData%iyg DstModDataTypeData%Vars => SrcModDataTypeData%Vars + call NWTC_Library_CopyModLinType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcModDataTypeData%SrcMaps)) then LB(1:1) = lbound(SrcModDataTypeData%SrcMaps, kind=B8Ki) UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) @@ -1386,16 +1885,9 @@ subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModDataTypeData%ixs)) then - deallocate(ModDataTypeData%ixs) - end if - if (allocated(ModDataTypeData%ius)) then - deallocate(ModDataTypeData%ius) - end if - if (allocated(ModDataTypeData%iys)) then - deallocate(ModDataTypeData%iys) - end if nullify(ModDataTypeData%Vars) + call NWTC_Library_DestroyModLinType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModDataTypeData%SrcMaps)) then deallocate(ModDataTypeData%SrcMaps) end if @@ -1410,16 +1902,17 @@ subroutine NWTC_Library_PackModDataType(RF, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Idx) - call RegPack(RF, InData%ID) call RegPack(RF, InData%Abbr) + call RegPack(RF, InData%ID) + call RegPack(RF, InData%Idx) call RegPack(RF, InData%Ins) - call RegPack(RF, InData%IsTC) call RegPack(RF, InData%DT) call RegPack(RF, InData%SubSteps) - call RegPackAlloc(RF, InData%ixs) - call RegPackAlloc(RF, InData%ius) - call RegPackAlloc(RF, InData%iys) + call RegPack(RF, InData%ixg) + call RegPack(RF, InData%ixdg) + call RegPack(RF, InData%izg) + call RegPack(RF, InData%iug) + call RegPack(RF, InData%iyg) call RegPack(RF, associated(InData%Vars)) if (associated(InData%Vars)) then call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) @@ -1427,6 +1920,7 @@ subroutine NWTC_Library_PackModDataType(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if + call NWTC_Library_PackModLinType(RF, InData%Lin) call RegPackAlloc(RF, InData%SrcMaps) call RegPackAlloc(RF, InData%DstMaps) if (RegCheckErr(RF, RoutineName)) return @@ -1436,22 +1930,23 @@ subroutine NWTC_Library_UnPackModDataType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IsTC); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ixs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ius); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ixg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ixdg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%izg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iug); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iyg); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -1470,8 +1965,56 @@ subroutine NWTC_Library_UnPackModDataType(RF, OutData) else OutData%Vars => null() end if + call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine + +subroutine NWTC_Library_CopyMeshLocType(SrcMeshLocTypeData, DstMeshLocTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshLocType), intent(in) :: SrcMeshLocTypeData + type(MeshLocType), intent(inout) :: DstMeshLocTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshLocType' + ErrStat = ErrID_None + ErrMsg = '' + DstMeshLocTypeData%Num = SrcMeshLocTypeData%Num + DstMeshLocTypeData%i1 = SrcMeshLocTypeData%i1 + DstMeshLocTypeData%i2 = SrcMeshLocTypeData%i2 + DstMeshLocTypeData%i3 = SrcMeshLocTypeData%i3 +end subroutine + +subroutine NWTC_Library_DestroyMeshLocType(MeshLocTypeData, ErrStat, ErrMsg) + type(MeshLocType), intent(inout) :: MeshLocTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshLocType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackMeshLocType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshLocType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshLocType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Num) + call RegPack(RF, InData%i1) + call RegPack(RF, InData%i2) + call RegPack(RF, InData%i3) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshLocType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshLocType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshLocType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i3); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 29ccee5fc0..1d02cf644a 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -60,9 +60,13 @@ param ^ - IntKi VF_None - 0 - param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - -param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - -param ^ - IntKi VF_AeroMap - 16 - "Variable for aeromap" - -param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - +param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - +param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - +param ^ - IntKi VF_WriteOut - 32 - "Variable for write output" - +param ^ - IntKi VF_Solve - 64 - "Variable for solver" - +param ^ - IntKi VF_AeroMap - 128 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 256 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 512 - "Variable is derivative order 2 in linearization file" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - @@ -79,28 +83,53 @@ typedef ^ ^ IntKi iLoc 2 - - typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - -typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ VarsIdxType IntKi FlagFilter - - - "" - typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nxd - - - "" - +typedef ^ ^ IntKi Nz - - - "" - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - typedef ^ ^ IntKi ix : - - "" - +typedef ^ ^ IntKi ixd : - - "" - +typedef ^ ^ IntKi iz : - - "" - typedef ^ ^ IntKi idx : - - "" - typedef ^ ^ IntKi iu : - - "" - typedef ^ ^ IntKi iy : - - "" - -typedef ^ ModVarsType IntKi Nx - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" +typedef ^ ^ IntKi Nxd - 0 - "Number of xd values" +typedef ^ ^ IntKi Nz - 0 - "Number of z values" +typedef ^ ^ IntKi Nu - 0 - "Number of u values" +typedef ^ ^ IntKi Ny - 0 - "Number of y values" typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType xd : - - "Module state variable array" - +typedef ^ ^ ModVarType z : - - "Module state variable array" - typedef ^ ^ ModVarType u : - - "Module input variable array" - typedef ^ ^ ModVarType y : - - "Module output variable array" - -typedef ^ ^ VarsIdxType SolverIdx - - - "" - +typedef ^ ^ VarsIdxType IdxLin - - - "Variable index array" - +typedef ^ ^ VarsIdxType IdxSolver - - - "Variable index array" - +typedef ^ ^ VarsIdxType IdxAeroMap - - - "Variable index array" - + +typedef ^ ModJacType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki xd : - - "" - +typedef ^ ^ R8Ki z : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki x_pos : - - "" - +typedef ^ ^ R8Ki x_neg : - - "" - +typedef ^ ^ R8Ki y_pos : - - "" - +typedef ^ ^ R8Ki y_neg : - - "" - typedef ^ ModLinType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki xd : - - "" - +typedef ^ ^ R8Ki z : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - typedef ^ ^ R8Ki u_perturb : - - "" - @@ -113,21 +142,30 @@ typedef ^ ^ R8Ki dYdx :: - - typedef ^ ^ R8Ki dXdx :: - - "" - typedef ^ ^ R8Ki dYdu :: - - "" - typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - -typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Idx - 0 - "Module index in array of modules" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - -typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - typedef ^ ^ R8Ki DT - 0 - "Module time step" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - -typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - -typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ IntKi ixg - - - "starting index for continuous state values in global arrays" - +typedef ^ ^ IntKi ixdg - - - "starting index for discrete state values in global arrays" - +typedef ^ ^ IntKi izg - - - "starting index for constraint state values in global arrays" - +typedef ^ ^ IntKi iug - - - "starting index for input values in global arrays" - +typedef ^ ^ IntKi iyg - - - "starting index for output values in global arrays" - typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ ModLinType Lin - - - "Module linearization data" - typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" +typedef ^ MeshLocType IntKi Num - 0 - "Mesh number in module" +typedef ^ ^ IntKi i1 - 0 - "Mesh index 1" +typedef ^ ^ IntKi i2 - 0 - "Mesh index 2" +typedef ^ ^ IntKi i3 - 0 - "Mesh index 3" # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types # the "usefrom" keyword defines the types for the registry without generating @@ -167,4 +205,3 @@ typedef ^ ^ R8Ki LoadLn2_F typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" typedef ^ ^ MeshMapLinearizationType dM #typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 37bf4fe33f..4969d37e2e 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -60,9 +60,13 @@ param ^ - IntKi VF_None - 0 - param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - -param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - -param ^ - IntKi VF_AeroMap - 16 - "Variable for aeromap" - -param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - +param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - +param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - +param ^ - IntKi VF_WriteOut - 32 - "Variable for write output" - +param ^ - IntKi VF_Solve - 64 - "Variable for solver" - +param ^ - IntKi VF_AeroMap - 128 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 256 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 512 - "Variable is derivative order 2 in linearization file" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - @@ -79,28 +83,53 @@ typedef ^ ^ IntKi iLoc 2 - - typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - -typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ VarsIdxType IntKi FlagFilter - - - "" - typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nxd - - - "" - +typedef ^ ^ IntKi Nz - - - "" - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - typedef ^ ^ IntKi ix : - - "" - +typedef ^ ^ IntKi ixd : - - "" - +typedef ^ ^ IntKi iz : - - "" - typedef ^ ^ IntKi idx : - - "" - typedef ^ ^ IntKi iu : - - "" - typedef ^ ^ IntKi iy : - - "" - -typedef ^ ModVarsType IntKi Nx - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" +typedef ^ ^ IntKi Nxd - 0 - "Number of xd values" +typedef ^ ^ IntKi Nz - 0 - "Number of z values" +typedef ^ ^ IntKi Nu - 0 - "Number of u values" +typedef ^ ^ IntKi Ny - 0 - "Number of y values" typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType xd : - - "Module state variable array" - +typedef ^ ^ ModVarType z : - - "Module state variable array" - typedef ^ ^ ModVarType u : - - "Module input variable array" - typedef ^ ^ ModVarType y : - - "Module output variable array" - -typedef ^ ^ VarsIdxType SolverIdx - - - "" - +typedef ^ ^ VarsIdxType IdxLin - - - "Variable index array" - +typedef ^ ^ VarsIdxType IdxSolver - - - "Variable index array" - +typedef ^ ^ VarsIdxType IdxAeroMap - - - "Variable index array" - + +typedef ^ ModJacType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki xd : - - "" - +typedef ^ ^ R8Ki z : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki x_pos : - - "" - +typedef ^ ^ R8Ki x_neg : - - "" - +typedef ^ ^ R8Ki y_pos : - - "" - +typedef ^ ^ R8Ki y_neg : - - "" - typedef ^ ModLinType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki xd : - - "" - +typedef ^ ^ R8Ki z : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - typedef ^ ^ R8Ki u_perturb : - - "" - @@ -113,17 +142,27 @@ typedef ^ ^ R8Ki dYdx :: - - typedef ^ ^ R8Ki dXdx :: - - "" - typedef ^ ^ R8Ki dYdu :: - - "" - typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - -typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Idx - 0 - "Module index in array of modules" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - -typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - typedef ^ ^ R8Ki DT - 0 - "Module time step" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - -typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - -typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ IntKi ixg - - - "starting index for continuous state values in global arrays" - +typedef ^ ^ IntKi ixdg - - - "starting index for discrete state values in global arrays" - +typedef ^ ^ IntKi izg - - - "starting index for constraint state values in global arrays" - +typedef ^ ^ IntKi iug - - - "starting index for input values in global arrays" - +typedef ^ ^ IntKi iyg - - - "starting index for output values in global arrays" - typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ ModLinType Lin - - - "Module linearization data" - typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" + +typedef ^ MeshLocType IntKi Num - 0 - "Mesh number in module" +typedef ^ ^ IntKi i1 - 0 - "Mesh index 1" +typedef ^ ^ IntKi i2 - 0 - "Mesh index 2" +typedef ^ ^ IntKi i3 - 0 - "Mesh index 3" \ No newline at end of file diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt index e1720a4772..4f85ee8b0d 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt @@ -37,4 +37,3 @@ typedef ^ ^ R8Ki LoadLn2_F typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" typedef ^ ^ MeshMapLinearizationType dM #typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 6cc964c930..b65394d237 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -51,37 +51,38 @@ MODULE FAST_Types USE ExtPtfm_MCKF_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Unknown = -1 ! Unknown [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_None = 0 ! No module selected [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Glue = 1 ! Glue code [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IfW = 2 ! InflowWind [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 ! ExternalInflow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ED = 4 ! ElastoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD14 = 6 ! AeroDyn14 [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! ExternalLoads [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 12 ! SubDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 13 ! External Platform Loading MCKF [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 14 ! MAP (Mooring Analysis Program) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 15 ! FEAMooring [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 16 ! MoorDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 19 ! The number of modules available in FAST [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_TSR = 2 ! TSR [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_WS = 3 ! wind speed [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Unknown = -1 ! Unknown [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_None = 0 ! No module selected [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Glue = 1 ! Glue code [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IfW = 2 ! InflowWind [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 ! ExternalInflow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ED = 4 ! ElastoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD14 = 6 ! AeroDyn14 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 8 ! ServoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 9 ! SeaState [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 10 ! HydroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 11 ! SubDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 12 ! External Platform Loading MCKF [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 13 ! MAP (Mooring Analysis Program) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 14 ! FEAMooring [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 15 ! MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 16 ! OrcaFlex integration (HD/Mooring) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 17 ! IceFloe [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 18 ! IceDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 18 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_TSR = 2 ! TSR [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_WS = 3 ! wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_LoadMesh = 1 ! Load mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_NonMesh = 3 ! Non mesh mapping type [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] @@ -127,6 +128,134 @@ MODULE FAST_Types REAL(ReKi) :: Pitch = 0.0_ReKi !< Pitch angle for this case of the steady-state solve [(rad)] END TYPE FAST_SS_CaseType ! ======================= +! ========= TC_MappingType ======= + TYPE, PUBLIC :: TC_MappingType + INTEGER(IntKi) :: i1 = 0 !< Optional index for specifying transfers [-] + INTEGER(IntKi) :: i2 = 0 !< Optional index for specifying transfers [-] + INTEGER(IntKi) :: SrcModIdx = 0 !< Source module index in ModData array [-] + INTEGER(IntKi) :: DstModIdx = 0 !< Destination module index in ModData array [-] + INTEGER(IntKi) :: SrcModID = 0 !< Source module ID [-] + INTEGER(IntKi) :: DstModID = 0 !< Destination module ID [-] + INTEGER(IntKi) :: SrcIns = 0 !< Source module Instance [-] + INTEGER(IntKi) :: DstIns = 0 !< Destination module Instance [-] + INTEGER(IntKi) :: SrcMeshID = 0 !< Source mesh identifier [-] + INTEGER(IntKi) :: DstMeshID = 0 !< Destination mesh identifier [-] + INTEGER(IntKi) :: SrcDispMeshID = 0 !< Source displacement mesh identifier [-] + INTEGER(IntKi) :: DstDispMeshID = 0 !< Destination displacement mesh identifier [-] + TYPE(MeshLocType) :: SrcMeshLoc !< Source mesh locator (number and indices) [-] + TYPE(MeshLocType) :: DstMeshLoc !< Destination mesh locator (number and indices) [-] + TYPE(MeshLocType) :: SrcDispMeshLoc !< Source displacement mesh locator (number and indices) [-] + TYPE(MeshLocType) :: DstDispMeshLoc !< Destination displacement mesh locator (number and indices) [-] + INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] + INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] + LOGICAL :: Ready = .false. !< Flag indicating Source has been ready to be transferred [-] + TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] + TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransVel = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcOrientation = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcAngularVel = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcAngularAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcForce = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcMoment = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcDispTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstTransVel = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstTransAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstOrientation = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstAngularVel = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstAngularAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstForce = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstMoment = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstDispTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] + END TYPE TC_MappingType +! ======================= +! ========= TC_ParameterType ======= + TYPE, PUBLIC :: TC_ParameterType + REAL(R8Ki) :: DT = 0.0_R8Ki !< solution time step [-] + REAL(R8Ki) :: ConvTol = 0.0_R8Ki !< Solution convergence tolerance [-] + INTEGER(IntKi) :: NumCrctn = 0_IntKi !< [-] + INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< [-] + INTEGER(IntKi) :: NIter_UJac = 0_IntKi !< Number of solution iterations between updating the Jacobian [-] + INTEGER(IntKi) :: NStep_UJac = 0_IntKi !< Number of global time steps between updating the Jacobian [-] + REAL(R8Ki) :: Scale_UJac = 0.0_R8Ki !< [-] + REAL(R8Ki) :: AccBlend = 1 !< [-] + REAL(R8Ki) :: RhoInf = 0.0_R8Ki !< Rho infinity used for calculating Generalized-alpha coefficients [-] + REAL(R8Ki) :: AlphaM = 0.0_R8Ki !< Generalized-alpha alpha_m coefficient [-] + REAL(R8Ki) :: AlphaF = 0.0_R8Ki !< Generalized-alpha alpha_f coefficient [-] + REAL(R8Ki) :: Beta = 0.0_R8Ki !< Generalized-alpha beta coefficient [-] + REAL(R8Ki) :: Gamma = 0.0_R8Ki !< Generalized-alpha gamma coefficient [-] + REAL(R8Ki) , DIMENSION(1:7) :: C = 0.0_R8Ki !< Generalized-alpha coefficient array [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iX1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iX2 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUT = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iU1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iyT = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iy1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJX = 0_IntKi !< Indices of Jacobian q variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJU = 0_IntKi !< Indices of Jacobian input variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJL !< Indices of Jacobian load variables [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModInit !< ModData index order for step 0 initialization [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModBD !< ModData index order for BD modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1US !< ModData index order for option 1 modules to update states [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModPost !< ModData index order for post option 1 modules [-] + END TYPE TC_ParameterType +! ======================= +! ========= ML_ParameterType ======= + TYPE, PUBLIC :: ML_ParameterType + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] + END TYPE ML_ParameterType +! ======================= +! ========= ML_MiscVarType ======= + TYPE, PUBLIC :: ML_MiscVarType + TYPE(TC_MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mesh mapping [-] + END TYPE ML_MiscVarType +! ======================= +! ========= ML_OutputType ======= + TYPE, PUBLIC :: ML_OutputType + TYPE(ModLinType) , DIMENSION(:), ALLOCATABLE :: Lin !< Module linearization type [-] + END TYPE ML_OutputType +! ======================= +! ========= TC_MiscVarType ======= + TYPE, PUBLIC :: TC_MiscVarType + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: q !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: qn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: un !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_tmp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: GinvdUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdyHat !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: G !< Used to merge state matrices [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] + INTEGER(IntKi) :: IterTotal = 0 !< [-] + INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] + INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dq !< Change in q [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< Change in x [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UDiff !< [-] + LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] + TYPE(TC_MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Array of mesh mappings in solver [-] + END TYPE TC_MiscVarType +! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Integration time step [global time] [s] @@ -222,6 +351,7 @@ MODULE FAST_Types INTEGER(IntKi) :: Lin_NumMods = 0_IntKi !< number of modules in the linearization [-] INTEGER(IntKi) , DIMENSION(1:NumModules) :: Lin_ModOrder = 0_IntKi !< indices that determine which order the modules are in the glue-code linearization matrix [-] INTEGER(IntKi) :: LinInterpOrder = 0_IntKi !< Interpolation order for CalcSteady solution [-] + TYPE(ML_ParameterType) :: ModLin !< Module data based linearization [-] LOGICAL :: CompAeroMaps = .false. !< Flag to determine if we are calculating aero maps [-] INTEGER(IntKi) :: N_UJac = 0_IntKi !< Number of iterations between re-calculating Jacobian [(-)] INTEGER(IntKi) :: NumBl_Lin = 0_IntKi !< number of blades in the jacobian [-] @@ -389,6 +519,8 @@ MODULE FAST_Types INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] REAL(ReKi) , DIMENSION(1:6) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: Modules !< module variable and value data [-] + TYPE(ModDataType) :: ModGlue !< module variable and value data [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -410,6 +542,7 @@ MODULE FAST_Types ! ========= BeamDyn_Data ======= TYPE, PUBLIC :: BeamDyn_Data TYPE(BD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(BD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: dxdt !< Continuous state derivatives [-] TYPE(BD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd !< Discrete states [-] TYPE(BD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] TYPE(BD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] @@ -427,10 +560,11 @@ MODULE FAST_Types ! ======================= ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data - TYPE(ED_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(ED_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(ED_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(ED_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] + TYPE(ED_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] TYPE(ED_ParameterType) :: p !< Parameters [-] TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] @@ -545,10 +679,11 @@ MODULE FAST_Types ! ======================= ! ========= SubDyn_Data ======= TYPE, PUBLIC :: SubDyn_Data - TYPE(SD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(SD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(SD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(SD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(SD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(SD_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] + TYPE(SD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] TYPE(SD_ParameterType) :: p !< Parameters [-] TYPE(SD_InputType) :: u !< System inputs [-] TYPE(SD_OutputType) :: y !< System outputs [-] @@ -597,10 +732,11 @@ MODULE FAST_Types ! ======================= ! ========= HydroDyn_Data ======= TYPE, PUBLIC :: HydroDyn_Data - TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(HydroDyn_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(HydroDyn_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] @@ -797,6 +933,7 @@ MODULE FAST_Types LOGICAL :: calcJacobian = .false. !< Should we calculate Jacobians in Option 1? [(flag)] TYPE(FAST_ExternInputType) :: ExternInput !< external input values [-] TYPE(FAST_MiscLinType) :: Lin !< misc data for linearization analysis [-] + TYPE(ML_MiscVarType) :: ModLin !< Module linearization Miscellaneous variables [-] END TYPE FAST_MiscVarType ! ======================= ! ========= FAST_InitData ======= @@ -1174,194 +1311,1418 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes + end if + DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim + DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes + DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale + DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase + if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then + allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio + end if + if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz + end if + if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz + end if + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude + end if + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase + end if +end subroutine + +subroutine FAST_DestroyVTK_ModeShapeType(VTK_ModeShapeTypeData, ErrStat, ErrMsg) + type(FAST_VTK_ModeShapeType), intent(inout) :: VTK_ModeShapeTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_ModeShapeTypeData%VTKModes)) then + deallocate(VTK_ModeShapeTypeData%VTKModes) + end if + if (allocated(VTK_ModeShapeTypeData%DampingRatio)) then + deallocate(VTK_ModeShapeTypeData%DampingRatio) + end if + if (allocated(VTK_ModeShapeTypeData%NaturalFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%NaturalFreq_Hz) + end if + if (allocated(VTK_ModeShapeTypeData%DampedFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%DampedFreq_Hz) + end if + if (allocated(VTK_ModeShapeTypeData%x_eig_magnitude)) then + deallocate(VTK_ModeShapeTypeData%x_eig_magnitude) + end if + if (allocated(VTK_ModeShapeTypeData%x_eig_phase)) then + deallocate(VTK_ModeShapeTypeData%x_eig_phase) + end if +end subroutine + +subroutine FAST_PackVTK_ModeShapeType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_VTK_ModeShapeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CheckpointRoot) + call RegPack(RF, InData%MatlabFileName) + call RegPack(RF, InData%VTKLinModes) + call RegPackAlloc(RF, InData%VTKModes) + call RegPack(RF, InData%VTKLinTim) + call RegPack(RF, InData%VTKNLinTimes) + call RegPack(RF, InData%VTKLinScale) + call RegPack(RF, InData%VTKLinPhase) + call RegPackAlloc(RF, InData%DampingRatio) + call RegPackAlloc(RF, InData%NaturalFreq_Hz) + call RegPackAlloc(RF, InData%DampedFreq_Hz) + call RegPackAlloc(RF, InData%x_eig_magnitude) + call RegPackAlloc(RF, InData%x_eig_phase) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_ModeShapeType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_VTK_ModeShapeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CheckpointRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MatlabFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VTKModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinTim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKNLinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinScale); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinPhase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampingRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NaturalFreq_Hz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampedFreq_Hz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_eig_magnitude); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_eig_phase); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopySS_CaseType(SrcSS_CaseTypeData, DstSS_CaseTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_SS_CaseType), intent(in) :: SrcSS_CaseTypeData + type(FAST_SS_CaseType), intent(inout) :: DstSS_CaseTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_CopySS_CaseType' + ErrStat = ErrID_None + ErrMsg = '' + DstSS_CaseTypeData%RotSpeed = SrcSS_CaseTypeData%RotSpeed + DstSS_CaseTypeData%TSR = SrcSS_CaseTypeData%TSR + DstSS_CaseTypeData%WindSpeed = SrcSS_CaseTypeData%WindSpeed + DstSS_CaseTypeData%Pitch = SrcSS_CaseTypeData%Pitch +end subroutine + +subroutine FAST_DestroySS_CaseType(SS_CaseTypeData, ErrStat, ErrMsg) + type(FAST_SS_CaseType), intent(inout) :: SS_CaseTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroySS_CaseType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FAST_PackSS_CaseType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_SS_CaseType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSS_CaseType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TSR) + call RegPack(RF, InData%WindSpeed) + call RegPack(RF, InData%Pitch) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSS_CaseType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_SS_CaseType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSS_CaseType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, CtrlCode, ErrStat, ErrMsg) + type(TC_MappingType), intent(inout) :: SrcTC_MappingTypeData + type(TC_MappingType), intent(inout) :: DstTC_MappingTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyTC_MappingType' + ErrStat = ErrID_None + ErrMsg = '' + DstTC_MappingTypeData%i1 = SrcTC_MappingTypeData%i1 + DstTC_MappingTypeData%i2 = SrcTC_MappingTypeData%i2 + DstTC_MappingTypeData%SrcModIdx = SrcTC_MappingTypeData%SrcModIdx + DstTC_MappingTypeData%DstModIdx = SrcTC_MappingTypeData%DstModIdx + DstTC_MappingTypeData%SrcModID = SrcTC_MappingTypeData%SrcModID + DstTC_MappingTypeData%DstModID = SrcTC_MappingTypeData%DstModID + DstTC_MappingTypeData%SrcIns = SrcTC_MappingTypeData%SrcIns + DstTC_MappingTypeData%DstIns = SrcTC_MappingTypeData%DstIns + DstTC_MappingTypeData%SrcMeshID = SrcTC_MappingTypeData%SrcMeshID + DstTC_MappingTypeData%DstMeshID = SrcTC_MappingTypeData%DstMeshID + DstTC_MappingTypeData%SrcDispMeshID = SrcTC_MappingTypeData%SrcDispMeshID + DstTC_MappingTypeData%DstDispMeshID = SrcTC_MappingTypeData%DstDispMeshID + call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%SrcMeshLoc, DstTC_MappingTypeData%SrcMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%DstMeshLoc, DstTC_MappingTypeData%DstMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%SrcDispMeshLoc, DstTC_MappingTypeData%SrcDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%DstDispMeshLoc, DstTC_MappingTypeData%DstDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstTC_MappingTypeData%MapType = SrcTC_MappingTypeData%MapType + DstTC_MappingTypeData%XfrType = SrcTC_MappingTypeData%XfrType + DstTC_MappingTypeData%Ready = SrcTC_MappingTypeData%Ready + call MeshCopy(SrcTC_MappingTypeData%MeshTmp, DstTC_MappingTypeData%MeshTmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcTC_MappingTypeData%MeshMap, DstTC_MappingTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstTC_MappingTypeData%iLocSrcTransDisp = SrcTC_MappingTypeData%iLocSrcTransDisp + DstTC_MappingTypeData%iLocSrcTransVel = SrcTC_MappingTypeData%iLocSrcTransVel + DstTC_MappingTypeData%iLocSrcTransAcc = SrcTC_MappingTypeData%iLocSrcTransAcc + DstTC_MappingTypeData%iLocSrcOrientation = SrcTC_MappingTypeData%iLocSrcOrientation + DstTC_MappingTypeData%iLocSrcAngularVel = SrcTC_MappingTypeData%iLocSrcAngularVel + DstTC_MappingTypeData%iLocSrcAngularAcc = SrcTC_MappingTypeData%iLocSrcAngularAcc + DstTC_MappingTypeData%iLocSrcForce = SrcTC_MappingTypeData%iLocSrcForce + DstTC_MappingTypeData%iLocSrcMoment = SrcTC_MappingTypeData%iLocSrcMoment + DstTC_MappingTypeData%iLocSrcDispTransDisp = SrcTC_MappingTypeData%iLocSrcDispTransDisp + DstTC_MappingTypeData%iLocDstTransDisp = SrcTC_MappingTypeData%iLocDstTransDisp + DstTC_MappingTypeData%iLocDstTransVel = SrcTC_MappingTypeData%iLocDstTransVel + DstTC_MappingTypeData%iLocDstTransAcc = SrcTC_MappingTypeData%iLocDstTransAcc + DstTC_MappingTypeData%iLocDstOrientation = SrcTC_MappingTypeData%iLocDstOrientation + DstTC_MappingTypeData%iLocDstAngularVel = SrcTC_MappingTypeData%iLocDstAngularVel + DstTC_MappingTypeData%iLocDstAngularAcc = SrcTC_MappingTypeData%iLocDstAngularAcc + DstTC_MappingTypeData%iLocDstForce = SrcTC_MappingTypeData%iLocDstForce + DstTC_MappingTypeData%iLocDstMoment = SrcTC_MappingTypeData%iLocDstMoment + DstTC_MappingTypeData%iLocDstDispTransDisp = SrcTC_MappingTypeData%iLocDstDispTransDisp +end subroutine + +subroutine FAST_DestroyTC_MappingType(TC_MappingTypeData, ErrStat, ErrMsg) + type(TC_MappingType), intent(inout) :: TC_MappingTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyTC_MappingType' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%SrcMeshLoc, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%DstMeshLoc, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%SrcDispMeshLoc, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%DstDispMeshLoc, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( TC_MappingTypeData%MeshTmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(TC_MappingTypeData%MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackTC_MappingType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TC_MappingType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTC_MappingType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%i1) + call RegPack(RF, InData%i2) + call RegPack(RF, InData%SrcModIdx) + call RegPack(RF, InData%DstModIdx) + call RegPack(RF, InData%SrcModID) + call RegPack(RF, InData%DstModID) + call RegPack(RF, InData%SrcIns) + call RegPack(RF, InData%DstIns) + call RegPack(RF, InData%SrcMeshID) + call RegPack(RF, InData%DstMeshID) + call RegPack(RF, InData%SrcDispMeshID) + call RegPack(RF, InData%DstDispMeshID) + call NWTC_Library_PackMeshLocType(RF, InData%SrcMeshLoc) + call NWTC_Library_PackMeshLocType(RF, InData%DstMeshLoc) + call NWTC_Library_PackMeshLocType(RF, InData%SrcDispMeshLoc) + call NWTC_Library_PackMeshLocType(RF, InData%DstDispMeshLoc) + call RegPack(RF, InData%MapType) + call RegPack(RF, InData%XfrType) + call RegPack(RF, InData%Ready) + call MeshPack(RF, InData%MeshTmp) + call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) + call RegPack(RF, InData%iLocSrcTransDisp) + call RegPack(RF, InData%iLocSrcTransVel) + call RegPack(RF, InData%iLocSrcTransAcc) + call RegPack(RF, InData%iLocSrcOrientation) + call RegPack(RF, InData%iLocSrcAngularVel) + call RegPack(RF, InData%iLocSrcAngularAcc) + call RegPack(RF, InData%iLocSrcForce) + call RegPack(RF, InData%iLocSrcMoment) + call RegPack(RF, InData%iLocSrcDispTransDisp) + call RegPack(RF, InData%iLocDstTransDisp) + call RegPack(RF, InData%iLocDstTransVel) + call RegPack(RF, InData%iLocDstTransAcc) + call RegPack(RF, InData%iLocDstOrientation) + call RegPack(RF, InData%iLocDstAngularVel) + call RegPack(RF, InData%iLocDstAngularAcc) + call RegPack(RF, InData%iLocDstForce) + call RegPack(RF, InData%iLocDstMoment) + call RegPack(RF, InData%iLocDstDispTransDisp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTC_MappingType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TC_MappingType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTC_MappingType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcModIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstModIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcModID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstModID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcIns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstIns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcMeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstMeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcDispMeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstDispMeshID); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcMeshLoc) ! SrcMeshLoc + call NWTC_Library_UnpackMeshLocType(RF, OutData%DstMeshLoc) ! DstMeshLoc + call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcDispMeshLoc) ! SrcDispMeshLoc + call NWTC_Library_UnpackMeshLocType(RF, OutData%DstDispMeshLoc) ! DstDispMeshLoc + call RegUnpack(RF, OutData%MapType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XfrType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ready); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%MeshTmp) ! MeshTmp + call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap + call RegUnpack(RF, OutData%iLocSrcTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocSrcTransVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocSrcTransAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocSrcOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocSrcAngularVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocSrcAngularAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocSrcForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocSrcMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocSrcDispTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstTransVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstTransAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstAngularVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstAngularAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstDispTransDisp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(TC_ParameterType), intent(in) :: SrcTC_ParameterTypeData + type(TC_ParameterType), intent(inout) :: DstTC_ParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyTC_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + DstTC_ParameterTypeData%DT = SrcTC_ParameterTypeData%DT + DstTC_ParameterTypeData%ConvTol = SrcTC_ParameterTypeData%ConvTol + DstTC_ParameterTypeData%NumCrctn = SrcTC_ParameterTypeData%NumCrctn + DstTC_ParameterTypeData%MaxConvIter = SrcTC_ParameterTypeData%MaxConvIter + DstTC_ParameterTypeData%NIter_UJac = SrcTC_ParameterTypeData%NIter_UJac + DstTC_ParameterTypeData%NStep_UJac = SrcTC_ParameterTypeData%NStep_UJac + DstTC_ParameterTypeData%Scale_UJac = SrcTC_ParameterTypeData%Scale_UJac + DstTC_ParameterTypeData%AccBlend = SrcTC_ParameterTypeData%AccBlend + DstTC_ParameterTypeData%RhoInf = SrcTC_ParameterTypeData%RhoInf + DstTC_ParameterTypeData%AlphaM = SrcTC_ParameterTypeData%AlphaM + DstTC_ParameterTypeData%AlphaF = SrcTC_ParameterTypeData%AlphaF + DstTC_ParameterTypeData%Beta = SrcTC_ParameterTypeData%Beta + DstTC_ParameterTypeData%Gamma = SrcTC_ParameterTypeData%Gamma + DstTC_ParameterTypeData%C = SrcTC_ParameterTypeData%C + DstTC_ParameterTypeData%iX1 = SrcTC_ParameterTypeData%iX1 + DstTC_ParameterTypeData%iX2 = SrcTC_ParameterTypeData%iX2 + DstTC_ParameterTypeData%iUT = SrcTC_ParameterTypeData%iUT + DstTC_ParameterTypeData%iU1 = SrcTC_ParameterTypeData%iU1 + DstTC_ParameterTypeData%iyT = SrcTC_ParameterTypeData%iyT + DstTC_ParameterTypeData%iy1 = SrcTC_ParameterTypeData%iy1 + DstTC_ParameterTypeData%iJX = SrcTC_ParameterTypeData%iJX + DstTC_ParameterTypeData%iJU = SrcTC_ParameterTypeData%iJU + DstTC_ParameterTypeData%iJUT = SrcTC_ParameterTypeData%iJUT + if (allocated(SrcTC_ParameterTypeData%iJL)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iJL, kind=B8Ki) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iJL, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%iJL)) then + allocate(DstTC_ParameterTypeData%iJL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iJL = SrcTC_ParameterTypeData%iJL + end if + if (allocated(SrcTC_ParameterTypeData%ixqd)) then + LB(1:2) = lbound(SrcTC_ParameterTypeData%ixqd, kind=B8Ki) + UB(1:2) = ubound(SrcTC_ParameterTypeData%ixqd, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%ixqd)) then + allocate(DstTC_ParameterTypeData%ixqd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%ixqd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%ixqd = SrcTC_ParameterTypeData%ixqd + end if + if (allocated(SrcTC_ParameterTypeData%iModInit)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModInit, kind=B8Ki) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModInit, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%iModInit)) then + allocate(DstTC_ParameterTypeData%iModInit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModInit = SrcTC_ParameterTypeData%iModInit + end if + if (allocated(SrcTC_ParameterTypeData%iModTC)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModTC, kind=B8Ki) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModTC, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%iModTC)) then + allocate(DstTC_ParameterTypeData%iModTC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModTC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModTC = SrcTC_ParameterTypeData%iModTC + end if + if (allocated(SrcTC_ParameterTypeData%iModBD)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModBD, kind=B8Ki) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModBD, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%iModBD)) then + allocate(DstTC_ParameterTypeData%iModBD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModBD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModBD = SrcTC_ParameterTypeData%iModBD + end if + if (allocated(SrcTC_ParameterTypeData%iModOpt1)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt1, kind=B8Ki) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt1, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%iModOpt1)) then + allocate(DstTC_ParameterTypeData%iModOpt1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModOpt1 = SrcTC_ParameterTypeData%iModOpt1 + end if + if (allocated(SrcTC_ParameterTypeData%iModOpt1US)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt1US, kind=B8Ki) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt1US, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%iModOpt1US)) then + allocate(DstTC_ParameterTypeData%iModOpt1US(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt1US.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModOpt1US = SrcTC_ParameterTypeData%iModOpt1US + end if + if (allocated(SrcTC_ParameterTypeData%iModOpt2)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt2, kind=B8Ki) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt2, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%iModOpt2)) then + allocate(DstTC_ParameterTypeData%iModOpt2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModOpt2 = SrcTC_ParameterTypeData%iModOpt2 + end if + if (allocated(SrcTC_ParameterTypeData%iModPost)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModPost, kind=B8Ki) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModPost, kind=B8Ki) + if (.not. allocated(DstTC_ParameterTypeData%iModPost)) then + allocate(DstTC_ParameterTypeData%iModPost(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModPost.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModPost = SrcTC_ParameterTypeData%iModPost + end if +end subroutine + +subroutine FAST_DestroyTC_ParameterType(TC_ParameterTypeData, ErrStat, ErrMsg) + type(TC_ParameterType), intent(inout) :: TC_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyTC_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TC_ParameterTypeData%iJL)) then + deallocate(TC_ParameterTypeData%iJL) + end if + if (allocated(TC_ParameterTypeData%ixqd)) then + deallocate(TC_ParameterTypeData%ixqd) + end if + if (allocated(TC_ParameterTypeData%iModInit)) then + deallocate(TC_ParameterTypeData%iModInit) + end if + if (allocated(TC_ParameterTypeData%iModTC)) then + deallocate(TC_ParameterTypeData%iModTC) + end if + if (allocated(TC_ParameterTypeData%iModBD)) then + deallocate(TC_ParameterTypeData%iModBD) + end if + if (allocated(TC_ParameterTypeData%iModOpt1)) then + deallocate(TC_ParameterTypeData%iModOpt1) + end if + if (allocated(TC_ParameterTypeData%iModOpt1US)) then + deallocate(TC_ParameterTypeData%iModOpt1US) + end if + if (allocated(TC_ParameterTypeData%iModOpt2)) then + deallocate(TC_ParameterTypeData%iModOpt2) + end if + if (allocated(TC_ParameterTypeData%iModPost)) then + deallocate(TC_ParameterTypeData%iModPost) + end if +end subroutine + +subroutine FAST_PackTC_ParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TC_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTC_ParameterType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%ConvTol) + call RegPack(RF, InData%NumCrctn) + call RegPack(RF, InData%MaxConvIter) + call RegPack(RF, InData%NIter_UJac) + call RegPack(RF, InData%NStep_UJac) + call RegPack(RF, InData%Scale_UJac) + call RegPack(RF, InData%AccBlend) + call RegPack(RF, InData%RhoInf) + call RegPack(RF, InData%AlphaM) + call RegPack(RF, InData%AlphaF) + call RegPack(RF, InData%Beta) + call RegPack(RF, InData%Gamma) + call RegPack(RF, InData%C) + call RegPack(RF, InData%iX1) + call RegPack(RF, InData%iX2) + call RegPack(RF, InData%iUT) + call RegPack(RF, InData%iU1) + call RegPack(RF, InData%iyT) + call RegPack(RF, InData%iy1) + call RegPack(RF, InData%iJX) + call RegPack(RF, InData%iJU) + call RegPack(RF, InData%iJUT) + call RegPackAlloc(RF, InData%iJL) + call RegPackAlloc(RF, InData%ixqd) + call RegPackAlloc(RF, InData%iModInit) + call RegPackAlloc(RF, InData%iModTC) + call RegPackAlloc(RF, InData%iModBD) + call RegPackAlloc(RF, InData%iModOpt1) + call RegPackAlloc(RF, InData%iModOpt1US) + call RegPackAlloc(RF, InData%iModOpt2) + call RegPackAlloc(RF, InData%iModPost) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTC_ParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TC_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTC_ParameterType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NIter_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStep_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Scale_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AccBlend); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AlphaM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AlphaF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gamma); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iX1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iX2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iU1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iyT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iy1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJUT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iJL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ixqd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModTC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModBD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModOpt1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModOpt1US); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModOpt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModPost); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyML_ParameterType(SrcML_ParameterTypeData, DstML_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(ML_ParameterType), intent(in) :: SrcML_ParameterTypeData + type(ML_ParameterType), intent(inout) :: DstML_ParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyML_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcML_ParameterTypeData%iMod)) then + LB(1:1) = lbound(SrcML_ParameterTypeData%iMod, kind=B8Ki) + UB(1:1) = ubound(SrcML_ParameterTypeData%iMod, kind=B8Ki) + if (.not. allocated(DstML_ParameterTypeData%iMod)) then + allocate(DstML_ParameterTypeData%iMod(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstML_ParameterTypeData%iMod.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstML_ParameterTypeData%iMod = SrcML_ParameterTypeData%iMod + end if +end subroutine + +subroutine FAST_DestroyML_ParameterType(ML_ParameterTypeData, ErrStat, ErrMsg) + type(ML_ParameterType), intent(inout) :: ML_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyML_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ML_ParameterTypeData%iMod)) then + deallocate(ML_ParameterTypeData%iMod) + end if +end subroutine + +subroutine FAST_PackML_ParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ML_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackML_ParameterType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%iMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackML_ParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ML_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackML_ParameterType' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyML_MiscVarType(SrcML_MiscVarTypeData, DstML_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(ML_MiscVarType), intent(inout) :: SrcML_MiscVarTypeData + type(ML_MiscVarType), intent(inout) :: DstML_MiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyML_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcML_MiscVarTypeData%Mappings)) then + LB(1:1) = lbound(SrcML_MiscVarTypeData%Mappings, kind=B8Ki) + UB(1:1) = ubound(SrcML_MiscVarTypeData%Mappings, kind=B8Ki) + if (.not. allocated(DstML_MiscVarTypeData%Mappings)) then + allocate(DstML_MiscVarTypeData%Mappings(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstML_MiscVarTypeData%Mappings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyTC_MappingType(SrcML_MiscVarTypeData%Mappings(i1), DstML_MiscVarTypeData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FAST_DestroyML_MiscVarType(ML_MiscVarTypeData, ErrStat, ErrMsg) + type(ML_MiscVarType), intent(inout) :: ML_MiscVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyML_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ML_MiscVarTypeData%Mappings)) then + LB(1:1) = lbound(ML_MiscVarTypeData%Mappings, kind=B8Ki) + UB(1:1) = ubound(ML_MiscVarTypeData%Mappings, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_DestroyTC_MappingType(ML_MiscVarTypeData%Mappings(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ML_MiscVarTypeData%Mappings) + end if +end subroutine + +subroutine FAST_PackML_MiscVarType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ML_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackML_MiscVarType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Mappings)) + if (allocated(InData%Mappings)) then + call RegPackBounds(RF, 1, lbound(InData%Mappings, kind=B8Ki), ubound(InData%Mappings, kind=B8Ki)) + LB(1:1) = lbound(InData%Mappings, kind=B8Ki) + UB(1:1) = ubound(InData%Mappings, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_PackTC_MappingType(RF, InData%Mappings(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackML_MiscVarType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ML_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackML_MiscVarType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Mappings(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mappings.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackTC_MappingType(RF, OutData%Mappings(i1)) ! Mappings + end do + end if +end subroutine + +subroutine FAST_CopyML_OutputType(SrcML_OutputTypeData, DstML_OutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(ML_OutputType), intent(in) :: SrcML_OutputTypeData + type(ML_OutputType), intent(inout) :: DstML_OutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyML_OutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcML_OutputTypeData%Lin)) then + LB(1:1) = lbound(SrcML_OutputTypeData%Lin, kind=B8Ki) + UB(1:1) = ubound(SrcML_OutputTypeData%Lin, kind=B8Ki) + if (.not. allocated(DstML_OutputTypeData%Lin)) then + allocate(DstML_OutputTypeData%Lin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstML_OutputTypeData%Lin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModLinType(SrcML_OutputTypeData%Lin(i1), DstML_OutputTypeData%Lin(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FAST_DestroyML_OutputType(ML_OutputTypeData, ErrStat, ErrMsg) + type(ML_OutputType), intent(inout) :: ML_OutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyML_OutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ML_OutputTypeData%Lin)) then + LB(1:1) = lbound(ML_OutputTypeData%Lin, kind=B8Ki) + UB(1:1) = ubound(ML_OutputTypeData%Lin, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModLinType(ML_OutputTypeData%Lin(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ML_OutputTypeData%Lin) + end if +end subroutine + +subroutine FAST_PackML_OutputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ML_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackML_OutputType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Lin)) + if (allocated(InData%Lin)) then + call RegPackBounds(RF, 1, lbound(InData%Lin, kind=B8Ki), ubound(InData%Lin, kind=B8Ki)) + LB(1:1) = lbound(InData%Lin, kind=B8Ki) + UB(1:1) = ubound(InData%Lin, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModLinType(RF, InData%Lin(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackML_OutputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ML_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackML_OutputType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Lin)) deallocate(OutData%Lin) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Lin(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lin.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModLinType(RF, OutData%Lin(i1)) ! Lin + end do + end if +end subroutine + +subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(TC_MiscVarType), intent(inout) :: SrcTC_MiscVarTypeData + type(TC_MiscVarType), intent(inout) :: DstTC_MiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyTC_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcTC_MiscVarTypeData%q)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%q, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%q, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%q)) then + allocate(DstTC_MiscVarTypeData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%q = SrcTC_MiscVarTypeData%q + end if + if (allocated(SrcTC_MiscVarTypeData%qn)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%qn, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%qn, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%qn)) then + allocate(DstTC_MiscVarTypeData%qn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%qn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%qn = SrcTC_MiscVarTypeData%qn + end if + if (allocated(SrcTC_MiscVarTypeData%x)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%x, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%x)) then + allocate(DstTC_MiscVarTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%x = SrcTC_MiscVarTypeData%x + end if + if (allocated(SrcTC_MiscVarTypeData%xn)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%xn, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%xn, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%xn)) then + allocate(DstTC_MiscVarTypeData%xn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%xn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%xn = SrcTC_MiscVarTypeData%xn + end if + if (allocated(SrcTC_MiscVarTypeData%dxdt)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%dxdt, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%dxdt, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dxdt)) then + allocate(DstTC_MiscVarTypeData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dxdt = SrcTC_MiscVarTypeData%dxdt + end if + if (allocated(SrcTC_MiscVarTypeData%u)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%u, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%u)) then + allocate(DstTC_MiscVarTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%u = SrcTC_MiscVarTypeData%u + end if + if (allocated(SrcTC_MiscVarTypeData%un)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%un, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%un, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%un)) then + allocate(DstTC_MiscVarTypeData%un(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%un.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%un = SrcTC_MiscVarTypeData%un + end if + if (allocated(SrcTC_MiscVarTypeData%u_tmp)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%u_tmp, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%u_tmp, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%u_tmp)) then + allocate(DstTC_MiscVarTypeData%u_tmp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%u_tmp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%u_tmp = SrcTC_MiscVarTypeData%u_tmp + end if + if (allocated(SrcTC_MiscVarTypeData%y)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%y, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%y)) then + allocate(DstTC_MiscVarTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%y = SrcTC_MiscVarTypeData%y + end if + if (allocated(SrcTC_MiscVarTypeData%dYdx)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dYdx, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dYdx, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dYdx)) then + allocate(DstTC_MiscVarTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dYdx = SrcTC_MiscVarTypeData%dYdx + end if + if (allocated(SrcTC_MiscVarTypeData%dYdu)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dYdu, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dYdu, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dYdu)) then + allocate(DstTC_MiscVarTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dYdu = SrcTC_MiscVarTypeData%dYdu + end if + if (allocated(SrcTC_MiscVarTypeData%dXdx)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dXdx, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dXdx, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dXdx)) then + allocate(DstTC_MiscVarTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dXdx = SrcTC_MiscVarTypeData%dXdx + end if + if (allocated(SrcTC_MiscVarTypeData%dXdu)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dXdu, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dXdu, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dXdu)) then + allocate(DstTC_MiscVarTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dXdu = SrcTC_MiscVarTypeData%dXdu + end if + if (allocated(SrcTC_MiscVarTypeData%dUdu)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdu, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdu, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dUdu)) then + allocate(DstTC_MiscVarTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dUdu = SrcTC_MiscVarTypeData%dUdu + end if + if (allocated(SrcTC_MiscVarTypeData%dUdy)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdy, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdy, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dUdy)) then + allocate(DstTC_MiscVarTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dUdy = SrcTC_MiscVarTypeData%dUdy + end if + if (allocated(SrcTC_MiscVarTypeData%GinvdUdu)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%GinvdUdu, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%GinvdUdu, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%GinvdUdu)) then + allocate(DstTC_MiscVarTypeData%GinvdUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%GinvdUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%GinvdUdu = SrcTC_MiscVarTypeData%GinvdUdu + end if + if (allocated(SrcTC_MiscVarTypeData%dUdyHat)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdyHat, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdyHat, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dUdyHat)) then + allocate(DstTC_MiscVarTypeData%dUdyHat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdyHat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dUdyHat = SrcTC_MiscVarTypeData%dUdyHat + end if + if (allocated(SrcTC_MiscVarTypeData%XB)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%XB, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%XB, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%XB)) then + allocate(DstTC_MiscVarTypeData%XB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%XB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%XB = SrcTC_MiscVarTypeData%XB + end if + if (allocated(SrcTC_MiscVarTypeData%G)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%G, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%G, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%G)) then + allocate(DstTC_MiscVarTypeData%G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%G.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%G = SrcTC_MiscVarTypeData%G + end if + if (allocated(SrcTC_MiscVarTypeData%Jac)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%Jac, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%Jac, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%Jac)) then + allocate(DstTC_MiscVarTypeData%Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%Jac.', ErrStat, ErrMsg, RoutineName) return end if end if - DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes + DstTC_MiscVarTypeData%Jac = SrcTC_MiscVarTypeData%Jac end if - DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim - DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes - DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale - DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase - if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then - allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcTC_MiscVarTypeData%IPIV)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%IPIV, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%IPIV, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%IPIV)) then + allocate(DstTC_MiscVarTypeData%IPIV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%IPIV.', ErrStat, ErrMsg, RoutineName) return end if end if - DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio + DstTC_MiscVarTypeData%IPIV = SrcTC_MiscVarTypeData%IPIV end if - if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then - allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + DstTC_MiscVarTypeData%IterTotal = SrcTC_MiscVarTypeData%IterTotal + DstTC_MiscVarTypeData%IterUntilUJac = SrcTC_MiscVarTypeData%IterUntilUJac + DstTC_MiscVarTypeData%StepsUntilUJac = SrcTC_MiscVarTypeData%StepsUntilUJac + if (allocated(SrcTC_MiscVarTypeData%dq)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dq, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dq, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dq)) then + allocate(DstTC_MiscVarTypeData%dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dq.', ErrStat, ErrMsg, RoutineName) return end if end if - DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz + DstTC_MiscVarTypeData%dq = SrcTC_MiscVarTypeData%dq end if - if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then - allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcTC_MiscVarTypeData%dx)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%dx, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%dx)) then + allocate(DstTC_MiscVarTypeData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz + DstTC_MiscVarTypeData%dx = SrcTC_MiscVarTypeData%dx end if - if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then - allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (allocated(SrcTC_MiscVarTypeData%du)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%du, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%du, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%du)) then + allocate(DstTC_MiscVarTypeData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude + DstTC_MiscVarTypeData%du = SrcTC_MiscVarTypeData%du end if - if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then - allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (allocated(SrcTC_MiscVarTypeData%UDiff)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%UDiff, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%UDiff, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%UDiff)) then + allocate(DstTC_MiscVarTypeData%UDiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%UDiff.', ErrStat, ErrMsg, RoutineName) return end if end if - DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase + DstTC_MiscVarTypeData%UDiff = SrcTC_MiscVarTypeData%UDiff + end if + DstTC_MiscVarTypeData%ConvWarn = SrcTC_MiscVarTypeData%ConvWarn + if (allocated(SrcTC_MiscVarTypeData%Mappings)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%Mappings, kind=B8Ki) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%Mappings, kind=B8Ki) + if (.not. allocated(DstTC_MiscVarTypeData%Mappings)) then + allocate(DstTC_MiscVarTypeData%Mappings(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%Mappings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyTC_MappingType(SrcTC_MiscVarTypeData%Mappings(i1), DstTC_MiscVarTypeData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if end subroutine -subroutine FAST_DestroyVTK_ModeShapeType(VTK_ModeShapeTypeData, ErrStat, ErrMsg) - type(FAST_VTK_ModeShapeType), intent(inout) :: VTK_ModeShapeTypeData +subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) + type(TC_MiscVarType), intent(inout) :: TC_MiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyTC_MiscVarType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(VTK_ModeShapeTypeData%VTKModes)) then - deallocate(VTK_ModeShapeTypeData%VTKModes) + if (allocated(TC_MiscVarTypeData%q)) then + deallocate(TC_MiscVarTypeData%q) end if - if (allocated(VTK_ModeShapeTypeData%DampingRatio)) then - deallocate(VTK_ModeShapeTypeData%DampingRatio) + if (allocated(TC_MiscVarTypeData%qn)) then + deallocate(TC_MiscVarTypeData%qn) end if - if (allocated(VTK_ModeShapeTypeData%NaturalFreq_Hz)) then - deallocate(VTK_ModeShapeTypeData%NaturalFreq_Hz) + if (allocated(TC_MiscVarTypeData%x)) then + deallocate(TC_MiscVarTypeData%x) end if - if (allocated(VTK_ModeShapeTypeData%DampedFreq_Hz)) then - deallocate(VTK_ModeShapeTypeData%DampedFreq_Hz) + if (allocated(TC_MiscVarTypeData%xn)) then + deallocate(TC_MiscVarTypeData%xn) end if - if (allocated(VTK_ModeShapeTypeData%x_eig_magnitude)) then - deallocate(VTK_ModeShapeTypeData%x_eig_magnitude) + if (allocated(TC_MiscVarTypeData%dxdt)) then + deallocate(TC_MiscVarTypeData%dxdt) end if - if (allocated(VTK_ModeShapeTypeData%x_eig_phase)) then - deallocate(VTK_ModeShapeTypeData%x_eig_phase) + if (allocated(TC_MiscVarTypeData%u)) then + deallocate(TC_MiscVarTypeData%u) + end if + if (allocated(TC_MiscVarTypeData%un)) then + deallocate(TC_MiscVarTypeData%un) + end if + if (allocated(TC_MiscVarTypeData%u_tmp)) then + deallocate(TC_MiscVarTypeData%u_tmp) + end if + if (allocated(TC_MiscVarTypeData%y)) then + deallocate(TC_MiscVarTypeData%y) + end if + if (allocated(TC_MiscVarTypeData%dYdx)) then + deallocate(TC_MiscVarTypeData%dYdx) + end if + if (allocated(TC_MiscVarTypeData%dYdu)) then + deallocate(TC_MiscVarTypeData%dYdu) + end if + if (allocated(TC_MiscVarTypeData%dXdx)) then + deallocate(TC_MiscVarTypeData%dXdx) + end if + if (allocated(TC_MiscVarTypeData%dXdu)) then + deallocate(TC_MiscVarTypeData%dXdu) + end if + if (allocated(TC_MiscVarTypeData%dUdu)) then + deallocate(TC_MiscVarTypeData%dUdu) + end if + if (allocated(TC_MiscVarTypeData%dUdy)) then + deallocate(TC_MiscVarTypeData%dUdy) + end if + if (allocated(TC_MiscVarTypeData%GinvdUdu)) then + deallocate(TC_MiscVarTypeData%GinvdUdu) + end if + if (allocated(TC_MiscVarTypeData%dUdyHat)) then + deallocate(TC_MiscVarTypeData%dUdyHat) + end if + if (allocated(TC_MiscVarTypeData%XB)) then + deallocate(TC_MiscVarTypeData%XB) + end if + if (allocated(TC_MiscVarTypeData%G)) then + deallocate(TC_MiscVarTypeData%G) + end if + if (allocated(TC_MiscVarTypeData%Jac)) then + deallocate(TC_MiscVarTypeData%Jac) + end if + if (allocated(TC_MiscVarTypeData%IPIV)) then + deallocate(TC_MiscVarTypeData%IPIV) + end if + if (allocated(TC_MiscVarTypeData%dq)) then + deallocate(TC_MiscVarTypeData%dq) + end if + if (allocated(TC_MiscVarTypeData%dx)) then + deallocate(TC_MiscVarTypeData%dx) + end if + if (allocated(TC_MiscVarTypeData%du)) then + deallocate(TC_MiscVarTypeData%du) + end if + if (allocated(TC_MiscVarTypeData%UDiff)) then + deallocate(TC_MiscVarTypeData%UDiff) + end if + if (allocated(TC_MiscVarTypeData%Mappings)) then + LB(1:1) = lbound(TC_MiscVarTypeData%Mappings, kind=B8Ki) + UB(1:1) = ubound(TC_MiscVarTypeData%Mappings, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_DestroyTC_MappingType(TC_MiscVarTypeData%Mappings(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(TC_MiscVarTypeData%Mappings) end if end subroutine -subroutine FAST_PackVTK_ModeShapeType(RF, Indata) +subroutine FAST_PackTC_MiscVarType(RF, Indata) type(RegFile), intent(inout) :: RF - type(FAST_VTK_ModeShapeType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' + type(TC_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTC_MiscVarType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%CheckpointRoot) - call RegPack(RF, InData%MatlabFileName) - call RegPack(RF, InData%VTKLinModes) - call RegPackAlloc(RF, InData%VTKModes) - call RegPack(RF, InData%VTKLinTim) - call RegPack(RF, InData%VTKNLinTimes) - call RegPack(RF, InData%VTKLinScale) - call RegPack(RF, InData%VTKLinPhase) - call RegPackAlloc(RF, InData%DampingRatio) - call RegPackAlloc(RF, InData%NaturalFreq_Hz) - call RegPackAlloc(RF, InData%DampedFreq_Hz) - call RegPackAlloc(RF, InData%x_eig_magnitude) - call RegPackAlloc(RF, InData%x_eig_phase) + call RegPackAlloc(RF, InData%q) + call RegPackAlloc(RF, InData%qn) + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%xn) + call RegPackAlloc(RF, InData%dxdt) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%un) + call RegPackAlloc(RF, InData%u_tmp) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%dYdx) + call RegPackAlloc(RF, InData%dYdu) + call RegPackAlloc(RF, InData%dXdx) + call RegPackAlloc(RF, InData%dXdu) + call RegPackAlloc(RF, InData%dUdu) + call RegPackAlloc(RF, InData%dUdy) + call RegPackAlloc(RF, InData%GinvdUdu) + call RegPackAlloc(RF, InData%dUdyHat) + call RegPackAlloc(RF, InData%XB) + call RegPackAlloc(RF, InData%G) + call RegPackAlloc(RF, InData%Jac) + call RegPackAlloc(RF, InData%IPIV) + call RegPack(RF, InData%IterTotal) + call RegPack(RF, InData%IterUntilUJac) + call RegPack(RF, InData%StepsUntilUJac) + call RegPackAlloc(RF, InData%dq) + call RegPackAlloc(RF, InData%dx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%UDiff) + call RegPack(RF, InData%ConvWarn) + call RegPack(RF, allocated(InData%Mappings)) + if (allocated(InData%Mappings)) then + call RegPackBounds(RF, 1, lbound(InData%Mappings, kind=B8Ki), ubound(InData%Mappings, kind=B8Ki)) + LB(1:1) = lbound(InData%Mappings, kind=B8Ki) + UB(1:1) = ubound(InData%Mappings, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_PackTC_MappingType(RF, InData%Mappings(i1)) + end do + end if if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackVTK_ModeShapeType(RF, OutData) +subroutine FAST_UnPackTC_MiscVarType(RF, OutData) type(RegFile), intent(inout) :: RF - type(FAST_VTK_ModeShapeType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' - integer(B8Ki) :: LB(3), UB(3) + type(TC_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTC_MiscVarType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%CheckpointRoot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MatlabFileName); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKLinModes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%VTKModes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKLinTim); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKNLinTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKLinScale); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKLinPhase); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DampingRatio); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NaturalFreq_Hz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DampedFreq_Hz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_eig_magnitude); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_eig_phase); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopySS_CaseType(SrcSS_CaseTypeData, DstSS_CaseTypeData, CtrlCode, ErrStat, ErrMsg) - type(FAST_SS_CaseType), intent(in) :: SrcSS_CaseTypeData - type(FAST_SS_CaseType), intent(inout) :: DstSS_CaseTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_CopySS_CaseType' - ErrStat = ErrID_None - ErrMsg = '' - DstSS_CaseTypeData%RotSpeed = SrcSS_CaseTypeData%RotSpeed - DstSS_CaseTypeData%TSR = SrcSS_CaseTypeData%TSR - DstSS_CaseTypeData%WindSpeed = SrcSS_CaseTypeData%WindSpeed - DstSS_CaseTypeData%Pitch = SrcSS_CaseTypeData%Pitch -end subroutine - -subroutine FAST_DestroySS_CaseType(SS_CaseTypeData, ErrStat, ErrMsg) - type(FAST_SS_CaseType), intent(inout) :: SS_CaseTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_DestroySS_CaseType' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine FAST_PackSS_CaseType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(FAST_SS_CaseType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackSS_CaseType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%RotSpeed) - call RegPack(RF, InData%TSR) - call RegPack(RF, InData%WindSpeed) - call RegPack(RF, InData%Pitch) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackSS_CaseType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(FAST_SS_CaseType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackSS_CaseType' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dxdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%un); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_tmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GinvdUdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdyHat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%XB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%G); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IPIV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IterTotal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IterUntilUJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StepsUntilUJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UDiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Mappings(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mappings.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackTC_MappingType(RF, OutData%Mappings(i1)) ! Mappings + end do + end if end subroutine subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1473,6 +2834,9 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder + call FAST_CopyML_ParameterType(SrcParamData%ModLin, DstParamData%ModLin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps DstParamData%N_UJac = SrcParamData%N_UJac DstParamData%NumBl_Lin = SrcParamData%NumBl_Lin @@ -1532,6 +2896,8 @@ subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyVTK_ModeShapeType(ParamData%VTK_modes, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyML_ParameterType(ParamData%ModLin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%RotSpeed)) then deallocate(ParamData%RotSpeed) end if @@ -1641,6 +3007,7 @@ subroutine FAST_PackParam(RF, Indata) call RegPack(RF, InData%Lin_NumMods) call RegPack(RF, InData%Lin_ModOrder) call RegPack(RF, InData%LinInterpOrder) + call FAST_PackML_ParameterType(RF, InData%ModLin) call RegPack(RF, InData%CompAeroMaps) call RegPack(RF, InData%N_UJac) call RegPack(RF, InData%NumBl_Lin) @@ -1756,6 +3123,7 @@ subroutine FAST_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%Lin_NumMods); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Lin_ModOrder); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LinInterpOrder); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackML_ParameterType(RF, OutData%ModLin) ! ModLin call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%N_UJac); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return @@ -5829,6 +7197,25 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput + if (allocated(SrcOutputFileTypeData%Modules)) then + LB(1:1) = lbound(SrcOutputFileTypeData%Modules, kind=B8Ki) + UB(1:1) = ubound(SrcOutputFileTypeData%Modules, kind=B8Ki) + if (.not. allocated(DstOutputFileTypeData%Modules)) then + allocate(DstOutputFileTypeData%Modules(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%Modules.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModDataType(SrcOutputFileTypeData%Modules(i1), DstOutputFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyModDataType(SrcOutputFileTypeData%ModGlue, DstOutputFileTypeData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) @@ -5864,6 +7251,17 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputFileTypeData%Modules)) then + LB(1:1) = lbound(OutputFileTypeData%Modules, kind=B8Ki) + UB(1:1) = ubound(OutputFileTypeData%Modules, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModDataType(OutputFileTypeData%Modules(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputFileTypeData%Modules) + end if + call NWTC_Library_DestroyModDataType(OutputFileTypeData%ModGlue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackOutputFileType(RF, Indata) @@ -5897,6 +7295,16 @@ subroutine FAST_PackOutputFileType(RF, Indata) call RegPack(RF, InData%ActualChanLen) call FAST_PackLinStateSave(RF, InData%op) call RegPack(RF, InData%DriverWriteOutput) + call RegPack(RF, allocated(InData%Modules)) + if (allocated(InData%Modules)) then + call RegPackBounds(RF, 1, lbound(InData%Modules, kind=B8Ki), ubound(InData%Modules, kind=B8Ki)) + LB(1:1) = lbound(InData%Modules, kind=B8Ki) + UB(1:1) = ubound(InData%Modules, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModDataType(RF, InData%Modules(i1)) + end do + end if + call NWTC_Library_PackModDataType(RF, InData%ModGlue) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -5933,6 +7341,20 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return call FAST_UnpackLinStateSave(RF, OutData%op) ! op call RegUnpack(RF, OutData%DriverWriteOutput); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Modules)) deallocate(OutData%Modules) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Modules(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modules.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModDataType(RF, OutData%Modules(i1)) ! Modules + end do + end if + call NWTC_Library_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue end subroutine subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -6567,6 +7989,22 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end do end if + if (allocated(SrcBeamDyn_DataData%dxdt)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%dxdt, kind=B8Ki) + UB(1:1) = ubound(SrcBeamDyn_DataData%dxdt, kind=B8Ki) + if (.not. allocated(DstBeamDyn_DataData%dxdt)) then + allocate(DstBeamDyn_DataData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyContState(SrcBeamDyn_DataData%dxdt(i1), DstBeamDyn_DataData%dxdt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcBeamDyn_DataData%xd)) then LB(1:2) = lbound(SrcBeamDyn_DataData%xd, kind=B8Ki) UB(1:2) = ubound(SrcBeamDyn_DataData%xd, kind=B8Ki) @@ -6803,6 +8241,15 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%x) end if + if (allocated(BeamDyn_DataData%dxdt)) then + LB(1:1) = lbound(BeamDyn_DataData%dxdt, kind=B8Ki) + UB(1:1) = ubound(BeamDyn_DataData%dxdt, kind=B8Ki) + do i1 = LB(1), UB(1) + call BD_DestroyContState(BeamDyn_DataData%dxdt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%dxdt) + end if if (allocated(BeamDyn_DataData%xd)) then LB(1:2) = lbound(BeamDyn_DataData%xd, kind=B8Ki) UB(1:2) = ubound(BeamDyn_DataData%xd, kind=B8Ki) @@ -6940,6 +8387,15 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end do end do end if + call RegPack(RF, allocated(InData%dxdt)) + if (allocated(InData%dxdt)) then + call RegPackBounds(RF, 1, lbound(InData%dxdt, kind=B8Ki), ubound(InData%dxdt, kind=B8Ki)) + LB(1:1) = lbound(InData%dxdt, kind=B8Ki) + UB(1:1) = ubound(InData%dxdt, kind=B8Ki) + do i1 = LB(1), UB(1) + call BD_PackContState(RF, InData%dxdt(i1)) + end do + end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then call RegPackBounds(RF, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) @@ -7080,6 +8536,19 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) end do end do end if + if (allocated(OutData%dxdt)) deallocate(OutData%dxdt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%dxdt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxdt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackContState(RF, OutData%dxdt(i1)) ! dxdt + end do + end if if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -7259,6 +8728,9 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + call ED_CopyContState(SrcElastoDyn_DataData%dxdt, DstElastoDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return LB(1:1) = lbound(SrcElastoDyn_DataData%xd, kind=B8Ki) UB(1:1) = ubound(SrcElastoDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -7402,6 +8874,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + call ED_DestroyContState(ElastoDyn_DataData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) LB(1:1) = lbound(ElastoDyn_DataData%xd, kind=B8Ki) UB(1:1) = ubound(ElastoDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -7486,6 +8960,7 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) do i1 = LB(1), UB(1) call ED_PackContState(RF, InData%x(i1)) end do + call ED_PackContState(RF, InData%dxdt) LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -7561,6 +9036,7 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) do i1 = LB(1), UB(1) call ED_UnpackContState(RF, OutData%x(i1)) ! x end do + call ED_UnpackContState(RF, OutData%dxdt) ! dxdt LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -9327,6 +10803,9 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + call SD_CopyContState(SrcSubDyn_DataData%dxdt, DstSubDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return LB(1:1) = lbound(SrcSubDyn_DataData%xd, kind=B8Ki) UB(1:1) = ubound(SrcSubDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -9454,6 +10933,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + call SD_DestroyContState(SubDyn_DataData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) LB(1:1) = lbound(SubDyn_DataData%xd, kind=B8Ki) UB(1:1) = ubound(SubDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -9529,6 +11010,7 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) do i1 = LB(1), UB(1) call SD_PackContState(RF, InData%x(i1)) end do + call SD_PackContState(RF, InData%dxdt) LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -9595,6 +11077,7 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) do i1 = LB(1), UB(1) call SD_UnpackContState(RF, OutData%x(i1)) ! x end do + call SD_UnpackContState(RF, OutData%dxdt) ! dxdt LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -10326,6 +11809,9 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + call HydroDyn_CopyContState(SrcHydroDyn_DataData%dxdt, DstHydroDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return LB(1:1) = lbound(SrcHydroDyn_DataData%xd, kind=B8Ki) UB(1:1) = ubound(SrcHydroDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -10453,6 +11939,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + call HydroDyn_DestroyContState(HydroDyn_DataData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) LB(1:1) = lbound(HydroDyn_DataData%xd, kind=B8Ki) UB(1:1) = ubound(HydroDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -10528,6 +12016,7 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) do i1 = LB(1), UB(1) call HydroDyn_PackContState(RF, InData%x(i1)) end do + call HydroDyn_PackContState(RF, InData%dxdt) LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -10594,6 +12083,7 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) do i1 = LB(1), UB(1) call HydroDyn_UnpackContState(RF, OutData%x(i1)) ! x end do + call HydroDyn_UnpackContState(RF, OutData%dxdt) ! dxdt LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) @@ -13984,7 +15474,7 @@ subroutine FAST_UnPackExternInputType(RF, OutData) end subroutine subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(FAST_MiscVarType), intent(in) :: SrcMiscData + type(FAST_MiscVarType), intent(inout) :: SrcMiscData type(FAST_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat @@ -14009,6 +15499,9 @@ subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call FAST_CopyMiscLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call FAST_CopyML_MiscVarType(SrcMiscData%ModLin, DstMiscData%ModLin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -14024,6 +15517,8 @@ subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyMiscLinType(MiscData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyML_MiscVarType(MiscData%ModLin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackMisc(RF, Indata) @@ -14042,6 +15537,7 @@ subroutine FAST_PackMisc(RF, Indata) call RegPack(RF, InData%calcJacobian) call FAST_PackExternInputType(RF, InData%ExternInput) call FAST_PackMiscLinType(RF, InData%Lin) + call FAST_PackML_MiscVarType(RF, InData%ModLin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -14061,6 +15557,7 @@ subroutine FAST_UnPackMisc(RF, OutData) call RegUnpack(RF, OutData%calcJacobian); if (RegCheckErr(RF, RoutineName)) return call FAST_UnpackExternInputType(RF, OutData%ExternInput) ! ExternInput call FAST_UnpackMiscLinType(RF, OutData%Lin) ! Lin + call FAST_UnpackML_MiscVarType(RF, OutData%ModLin) ! ModLin end subroutine subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index f615fb7a15..b67c105018 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -307,6 +307,56 @@ struct DataType // Derived data type and all of its fields only contain reals return true; } + + void get_mesh_names_paths(const std::string &name_prefix, const std::string &path_prefix, int index_num, std::vector &names, std::vector &paths) + { + // Loop through fields + for (const auto &field : this->fields) + { + // Skip fields that aren't derived types or don't contain meshes + if ((field.data_type->tag != Tag::Derived) || !field.data_type->derived.contains_mesh) + { + continue; + } + + auto &ddt = field.data_type->derived; + + // If this field is a mesh, add field name to vector + // otherwise get mesh names within derived type + if (tolower(ddt.name).compare("meshtype") == 0) + { + names.push_back(name_prefix + "_" + field.name); + std::string array_index; + switch (field.rank) + { + case 3: + array_index = ", ML%i" + std::to_string(index_num + 3) + array_index; + case 2: + array_index = ", ML%i" + std::to_string(index_num + 2) + array_index; + case 1: + array_index = "(ML%i" + std::to_string(index_num + 1) + array_index + ")"; + } + paths.push_back(path_prefix + "%" + field.name + array_index); + } + else + { + std::string array_index; + switch (field.rank) + { + case 3: + array_index = ", ML%i" + std::to_string(index_num + 3) + array_index; + case 2: + array_index = ", ML%i" + std::to_string(index_num + 2) + array_index; + case 1: + array_index = "(ML%i" + std::to_string(index_num + 1) + array_index + ")"; + } + field.data_type->derived.get_mesh_names_paths(name_prefix + "_" + field.name, + path_prefix + "%" + field.name + array_index, + index_num + field.rank, + names, paths); + } + } + } }; Derived derived; diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 221448dada..69036e10b7 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -1,5 +1,6 @@ #include #include +#include #include "registry.hpp" #include "templates.hpp" @@ -114,7 +115,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // Write parameters to file for (const auto ¶m : mod.params) { - w << " " << param.type->basic.type_fortran << ", PUBLIC, PARAMETER :: " << param.name; + w << " " << param.type->basic.type_fortran << ", PUBLIC, PARAMETER :: " << std::setw(32) << std::left << param.name; if (!param.value.empty()) w << " = " << param.value; @@ -340,6 +341,71 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) gen_ExtrapInterp(w, mod, "InputType", "DbKi", 1); gen_ExtrapInterp(w, mod, "OutputType", "DbKi", 1); } + + // Loop through input and output types if in module + for (const auto &is_input : std::vector{true, false}) + { + auto it = mod.data_types.find(mod.nickname + (is_input ? "_InputType" : "_OutputType")); + if (it == mod.data_types.end()) + { + continue; + } + auto &ddt = it->second->derived; + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::string u_or_y = is_input ? "u" : "y"; + std::vector mesh_names, mesh_paths; + ddt.get_mesh_names_paths(mod.nickname + "_" + u_or_y, u_or_y, 0, mesh_names, mesh_paths); + std::string routine_name = mod.nickname + (is_input ? "_Input" : "_Output") + "MeshPointer"; + std::string indent("\n"); + + // Mesh pointer routine + w << indent << "function " << routine_name << "(" << u_or_y << ", ML) result(Mesh)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), target, intent(in) :: " << u_or_y; + w << indent << "type(MeshLocType), intent(in) :: ML"; + w << indent << "type(MeshType), pointer :: Mesh"; + w << indent << "nullify(Mesh)"; + w << indent << "select case (ML%Num)"; + for (int i = 0; i < mesh_paths.size(); ++i) + { + w << indent << "case (" << mesh_names[i] << ")"; + w << indent << " Mesh => " << mesh_paths[i]; + } + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end function"; + w << indent; + + // Mesh name routine + indent = "\n"; + routine_name = mod.nickname + (is_input ? "_Input" : "_Output") + "MeshName"; + w << indent << "function " << routine_name << "(" << u_or_y << ", ML) result(Name)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), target, intent(in) :: " << u_or_y; + w << indent << "type(MeshLocType), intent(in) :: ML"; + w << indent << "character(32) :: Name"; + w << indent << "Name = \"\""; + w << indent << "select case (ML%Num)"; + for (int i = 0; i < mesh_paths.size(); ++i) + { + std::string new_path(mesh_paths[i]); + for (int j = 1; j < 5; ++j){ + auto ind_str = "ML%i"+std::to_string(j); + auto ind = new_path.find(ind_str); + if (ind != std::string::npos) + { + new_path = new_path.substr(0, ind) + "\"//trim(Num2LStr(" + ind_str + "))//\"" + new_path.substr(ind+5); + } + } + w << indent << "case (" << mesh_names[i] << ")"; + w << indent << " Name = \"" << new_path << "\""; + } + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end function"; + w << indent; + } } void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, diff --git a/modules/openfast-registry/src/registry_parse.cpp b/modules/openfast-registry/src/registry_parse.cpp index e8ad7cdaf9..4a5d979206 100644 --- a/modules/openfast-registry/src/registry_parse.cpp +++ b/modules/openfast-registry/src/registry_parse.cpp @@ -71,6 +71,45 @@ void Registry::parse(const std::string &file_name, const int recurse_level) auto module_name = has_slash ? fields_prev[1].substr(0, slash_index) : fields_prev[1]; this->use_modules.push_back(module_name); } + + // If this is the root file + if (recurse_level == 0) + { + // Get the root module + std::shared_ptr mod; + for (auto &it : this->modules) + { + if (it.second->is_root) + { + mod = it.second; + break; + } + } + + int mesh_num = 0; + + // Loop through input and output types if in module + for (const auto &is_input : std::vector{true, false}) + { + auto it = mod->data_types.find(mod->nickname + (is_input ? "_InputType" : "_OutputType")); + if (it == mod->data_types.end()) + { + continue; + } + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::string prefix = mod->nickname + (is_input ? "_u" : "_y"); + auto &ddt = it->second->derived; + std::vector mesh_names, mesh_paths; + ddt.get_mesh_names_paths(prefix, "", 0, mesh_names, mesh_paths); + auto param_type = this->find_data_type("integer"); + for (const auto &mesh_name: mesh_names) + { + ++mesh_num; + mod->params.push_back(Parameter(mesh_name, param_type, std::to_string(mesh_num), "Mesh number for " + mod->nickname + " " + mesh_name + " mesh", "")); + } + } + } } int Registry::parse_line(const std::string &line, std::vector &fields_prev, diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 6a6e5abce4..234446d02d 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -33,6 +33,8 @@ MODULE OrcaFlexInterface_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: Orca_u_PtfmMesh = 1 ! Mesh number for Orca Orca_u_PtfmMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Orca_y_PtfmMesh = 2 ! Mesh number for Orca Orca_y_PtfmMesh mesh [-] ! ========= Orca_InitInputType ======= TYPE, PUBLIC :: Orca_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] @@ -1054,5 +1056,49 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function Orca_InputMeshPointer(u, ML) result(Mesh) + type(Orca_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (Orca_u_PtfmMesh) + Mesh => u%PtfmMesh + end select +end function + +function Orca_InputMeshName(u, ML) result(Name) + type(Orca_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (Orca_u_PtfmMesh) + Name = "u%PtfmMesh" + end select +end function + +function Orca_OutputMeshPointer(y, ML) result(Mesh) + type(Orca_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (Orca_y_PtfmMesh) + Mesh => y%PtfmMesh + end select +end function + +function Orca_OutputMeshName(y, ML) result(Name) + type(Orca_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (Orca_y_PtfmMesh) + Name = "y%PtfmMesh" + end select +end function END MODULE OrcaFlexInterface_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 869882a3aa..c510b5c992 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -33,34 +33,17 @@ MODULE SeaSt_WaveField_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_COS2S = 1 ! WaveDirMod = 1 [Directional spreading function is COS2S] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_None = 0 ! WaveMod = 0 [Incident wave kinematics model: NONE (still water)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_Regular = 1 ! WaveMod = 1 [Incident wave kinematics model: Regular (periodic)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_RegularUsrPh = 10 ! WaveMod = 1P# [Incident wave kinematics model: Regular (user specified phase)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_JONSWAP = 2 ! WaveMod = 2 [Incident wave kinematics model: JONSWAP/Pierson-Moskowitz spectrum (irregular)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_WhiteNoise = 3 ! WaveMod = 3 [Incident wave kinematics model: White noise spectrum (irregular)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserSpctrm = 4 ! WaveMod = 4 [Incident wave kinematics model: user-defined spectrum from routine UserWaveSpctrm (irregular)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] -! ========= SeaSt_WaveField_ParameterType ======= - TYPE, PUBLIC :: SeaSt_WaveField_ParameterType - INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] - END TYPE SeaSt_WaveField_ParameterType -! ======================= -! ========= SeaSt_WaveField_MiscVarType ======= - TYPE, PUBLIC :: SeaSt_WaveField_MiscVarType - REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] - REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the weighting function for 4-d velocity field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] - LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] - END TYPE SeaSt_WaveField_MiscVarType -! ======================= + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_COS2S = 1 ! WaveDirMod = 1 [Directional spreading function is COS2S] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_None = 0 ! WaveMod = 0 [Incident wave kinematics model: NONE (still water)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_Regular = 1 ! WaveMod = 1 [Incident wave kinematics model: Regular (periodic)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_RegularUsrPh = 10 ! WaveMod = 1P# [Incident wave kinematics model: Regular (user specified phase)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_JONSWAP = 2 ! WaveMod = 2 [Incident wave kinematics model: JONSWAP/Pierson-Moskowitz spectrum (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_WhiteNoise = 3 ! WaveMod = 3 [Incident wave kinematics model: White noise spectrum (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserSpctrm = 4 ! WaveMod = 4 [Incident wave kinematics model: user-defined spectrum from routine UserWaveSpctrm (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] ! ========= SeaSt_WaveFieldType ======= TYPE, PUBLIC :: SeaSt_WaveFieldType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 8f87fc33c4..87d797330d 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -1274,5 +1274,41 @@ subroutine SeaSt_UnPackOutput(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function SeaSt_InputMeshPointer(u, ML) result(Mesh) + type(SeaSt_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SeaSt_InputMeshName(u, ML) result(Name) + type(SeaSt_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function SeaSt_OutputMeshPointer(y, ML) result(Mesh) + type(SeaSt_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SeaSt_OutputMeshName(y, ML) result(Name) + type(SeaSt_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE SeaState_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 4f3ab877c7..8916d2dede 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -71,6 +71,7 @@ typedef ^ InitInputType ReKi URefLid - - - "Reference average wind spee typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" - typedef ^ InitOutputType IntKi CouplingScheme - - - "Switch that indicates if a particular coupling scheme is required" - typedef ^ InitOutputType Logical UseHSSBrake - - - "flag to determine if high-speed shaft brake is potentially used (true=yes)" - # Linearization @@ -340,27 +341,6 @@ typedef ^ SrvD_ModuleMapType MeshMapType NStC_Frc2_y_NStC {:} - - "Map loads: m% typedef ^ SrvD_ModuleMapType MeshMapType TStC_Frc2_y_TStC {:} - - "Map loads: m%y_TStCLoadMesh to y%TStC%LoadMesh" typedef ^ SrvD_ModuleMapType MeshMapType SStC_Frc2_y_SStC {:} - - "Map loads: m%y_SStCLoadMesh to y%SStC%LoadMesh" -# ..... Misc Variables ................................................................................................................ -typedef ^ MiscVarType DbKi LastTimeCalled - - - "last time the CalcOutput/Bladed DLL was called" s -typedef ^ MiscVarType BladedDLLType dll_data - - - "data used for Bladed DLL" - -typedef ^ MiscVarType logical FirstWarn - - - "Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling." - -typedef ^ MiscVarType DbKi LastTimeFiltered - - - "last time the CalcOutput/Bladed DLL was filtered" s -typedef ^ MiscVarType ReKi xd_BlPitchFilter {:} - - "blade pitch filter" - -typedef ^ MiscVarType StC_MiscVarType BStC {:} - - "StC module misc vars - blade" - -typedef ^ MiscVarType StC_MiscVarType NStC {:} - - "StC module misc vars - nacelle" - -typedef ^ MiscVarType StC_MiscVarType TStC {:} - - "StC module misc vars - tower" - -typedef ^ MiscVarType StC_MiscVarType SStC {:} - - "StC module misc vars - substructure" - -typedef ^ MiscVarType StC_InputType u_BStC {:}{:} - - "StC module inputs - blade size:(interpOrder,NumBStC)" - -typedef ^ MiscVarType StC_InputType u_NStC {:}{:} - - "StC module inputs - nacelle size:(interpOrder,NumNStC)" - -typedef ^ MiscVarType StC_InputType u_TStC {:}{:} - - "StC module inputs - tower size:(interpOrder,NumTStC)" - -typedef ^ MiscVarType StC_InputType u_SStC {:}{:} - - "StC module inputs - substructure size:(interpOrder,NumSStC)" - -typedef ^ MiscVarType StC_OutputType y_BStC {:} - - "StC module outputs - blade" - -typedef ^ MiscVarType StC_OutputType y_NStC {:} - - "StC module outputs - nacelle" - -typedef ^ MiscVarType StC_OutputType y_TStC {:} - - "StC module outputs - tower" - -typedef ^ MiscVarType StC_OutputType y_SStC {:} - - "StC module outputs - substructure" - -typedef ^ MiscVarType SrvD_ModuleMapType SrvD_MeshMap - - - "Mesh mapping from inputs/output meshes to StC input/output meshes" - -typedef ^ MiscVarType IntKi PrevTstepNcall - -1 - "Previous timestep N for tracking when in predictor/corrector loop for setting StC u values" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -493,7 +473,8 @@ typedef ^ ParameterType IntKi NumBeam - - - "Number of beams" - typedef ^ ParameterType IntKi NumPulseGate - - - "Number of pulse gates" - typedef ^ ParameterType ReKi PulseSpacing - - - "Distance between range gates" m typedef ^ ParameterType ReKi URefLid - - - "Reference average wind speed for the lidar" m/s - +# parameters for variables +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - # ..... Inputs .................................................................................................................... @@ -571,3 +552,30 @@ typedef ^ OutputType MeshType NStCLoadMesh {:} - - "StC module nacelle outp typedef ^ OutputType MeshType TStCLoadMesh {:} - - "StC module tower output load mesh" - typedef ^ OutputType MeshType SStCLoadMesh {:} - - "StC module substructure output load mesh" - typedef ^ OutputType SiKi toSC {:} - - "A swap array: used to pass output data from the DLL controller to the supercontroller" - + + +# ..... Misc Variables ................................................................................................................ +typedef ^ MiscVarType DbKi LastTimeCalled - - - "last time the CalcOutput/Bladed DLL was called" s +typedef ^ MiscVarType BladedDLLType dll_data - - - "data used for Bladed DLL" - +typedef ^ MiscVarType logical FirstWarn - - - "Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling." - +typedef ^ MiscVarType DbKi LastTimeFiltered - - - "last time the CalcOutput/Bladed DLL was filtered" s +typedef ^ MiscVarType ReKi xd_BlPitchFilter {:} - - "blade pitch filter" - +typedef ^ MiscVarType StC_MiscVarType BStC {:} - - "StC module misc vars - blade" - +typedef ^ MiscVarType StC_MiscVarType NStC {:} - - "StC module misc vars - nacelle" - +typedef ^ MiscVarType StC_MiscVarType TStC {:} - - "StC module misc vars - tower" - +typedef ^ MiscVarType StC_MiscVarType SStC {:} - - "StC module misc vars - substructure" - +typedef ^ MiscVarType StC_InputType u_BStC {:}{:} - - "StC module inputs - blade size:(interpOrder,NumBStC)" - +typedef ^ MiscVarType StC_InputType u_NStC {:}{:} - - "StC module inputs - nacelle size:(interpOrder,NumNStC)" - +typedef ^ MiscVarType StC_InputType u_TStC {:}{:} - - "StC module inputs - tower size:(interpOrder,NumTStC)" - +typedef ^ MiscVarType StC_InputType u_SStC {:}{:} - - "StC module inputs - substructure size:(interpOrder,NumSStC)" - +typedef ^ MiscVarType StC_OutputType y_BStC {:} - - "StC module outputs - blade" - +typedef ^ MiscVarType StC_OutputType y_NStC {:} - - "StC module outputs - nacelle" - +typedef ^ MiscVarType StC_OutputType y_TStC {:} - - "StC module outputs - tower" - +typedef ^ MiscVarType StC_OutputType y_SStC {:} - - "StC module outputs - substructure" - +typedef ^ MiscVarType SrvD_ModuleMapType SrvD_MeshMap - - - "Mesh mapping from inputs/output meshes to StC input/output meshes" - +typedef ^ MiscVarType IntKi PrevTstepNcall - -1 - "Previous timestep N for tracking when in predictor/corrector loop for setting StC u values" - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" +typedef ^ MiscVarType SrvD_ContinuousStateType x_perturb - - - "Continuous state for perturbation in Jacobian routines" - +typedef ^ MiscVarType SrvD_ContinuousStateType dxdt_lin - - - "Continuous state derivative for output in Jacobian routines" - +typedef ^ MiscVarType SrvD_InputType u_perturb - - - "Input for perturbation in Jacobian routines" - +typedef ^ MiscVarType SrvD_OutputType y_lin - - - "Output for output in Jacobian routines" - diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 9d2f6de448..c89a15e012 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -34,6 +34,15 @@ MODULE ServoDyn_Types USE StrucCtrl_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_PtfmMotionMesh = 1 ! Mesh number for SrvD SrvD_u_PtfmMotionMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_BStCMotionMesh = 2 ! Mesh number for SrvD SrvD_u_BStCMotionMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_NStCMotionMesh = 3 ! Mesh number for SrvD SrvD_u_NStCMotionMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_TStCMotionMesh = 4 ! Mesh number for SrvD SrvD_u_TStCMotionMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_SStCMotionMesh = 5 ! Mesh number for SrvD SrvD_u_SStCMotionMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_y_BStCLoadMesh = 6 ! Mesh number for SrvD SrvD_y_BStCLoadMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_y_NStCLoadMesh = 7 ! Mesh number for SrvD SrvD_y_NStCLoadMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_y_TStCLoadMesh = 8 ! Mesh number for SrvD SrvD_y_TStCLoadMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_y_SStCLoadMesh = 9 ! Mesh number for SrvD SrvD_y_SStCLoadMesh mesh [-] ! ========= SrvD_InitInputType ======= TYPE, PUBLIC :: SrvD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] @@ -90,6 +99,7 @@ MODULE ServoDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] INTEGER(IntKi) :: CouplingScheme = 0_IntKi !< Switch that indicates if a particular coupling scheme is required [-] LOGICAL :: UseHSSBrake = .false. !< flag to determine if high-speed shaft brake is potentially used (true=yes) [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] @@ -351,29 +361,6 @@ MODULE ServoDyn_Types TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SStC_Frc2_y_SStC !< Map loads: m%y_SStCLoadMesh to y%SStC%LoadMesh [-] END TYPE SrvD_ModuleMapType ! ======================= -! ========= SrvD_MiscVarType ======= - TYPE, PUBLIC :: SrvD_MiscVarType - REAL(DbKi) :: LastTimeCalled = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was called [s] - TYPE(BladedDLLType) :: dll_data !< data used for Bladed DLL [-] - LOGICAL :: FirstWarn = .false. !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] - REAL(DbKi) :: LastTimeFiltered = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was filtered [s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xd_BlPitchFilter !< blade pitch filter [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module misc vars - blade [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module misc vars - nacelle [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module misc vars - tower [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module misc vars - substructure [-] - TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_BStC !< StC module inputs - blade size:(interpOrder,NumBStC) [-] - TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_NStC !< StC module inputs - nacelle size:(interpOrder,NumNStC) [-] - TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_TStC !< StC module inputs - tower size:(interpOrder,NumTStC) [-] - TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_SStC !< StC module inputs - substructure size:(interpOrder,NumSStC) [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_BStC !< StC module outputs - blade [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_NStC !< StC module outputs - nacelle [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_TStC !< StC module outputs - tower [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_SStC !< StC module outputs - substructure [-] - TYPE(SrvD_ModuleMapType) :: SrvD_MeshMap !< Mesh mapping from inputs/output meshes to StC input/output meshes [-] - INTEGER(IntKi) :: PrevTstepNcall = -1 !< Previous timestep N for tracking when in predictor/corrector loop for setting StC u values [-] - END TYPE SrvD_MiscVarType -! ======================= ! ========= SrvD_ParameterType ======= TYPE, PUBLIC :: SrvD_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] @@ -499,6 +486,7 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -576,6 +564,34 @@ MODULE ServoDyn_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< A swap array: used to pass output data from the DLL controller to the supercontroller [-] END TYPE SrvD_OutputType ! ======================= +! ========= SrvD_MiscVarType ======= + TYPE, PUBLIC :: SrvD_MiscVarType + REAL(DbKi) :: LastTimeCalled = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was called [s] + TYPE(BladedDLLType) :: dll_data !< data used for Bladed DLL [-] + LOGICAL :: FirstWarn = .false. !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] + REAL(DbKi) :: LastTimeFiltered = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was filtered [s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xd_BlPitchFilter !< blade pitch filter [-] + TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module misc vars - blade [-] + TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module misc vars - nacelle [-] + TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module misc vars - tower [-] + TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module misc vars - substructure [-] + TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_BStC !< StC module inputs - blade size:(interpOrder,NumBStC) [-] + TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_NStC !< StC module inputs - nacelle size:(interpOrder,NumNStC) [-] + TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_TStC !< StC module inputs - tower size:(interpOrder,NumTStC) [-] + TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_SStC !< StC module inputs - substructure size:(interpOrder,NumSStC) [-] + TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_BStC !< StC module outputs - blade [-] + TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_NStC !< StC module outputs - nacelle [-] + TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_TStC !< StC module outputs - tower [-] + TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_SStC !< StC module outputs - substructure [-] + TYPE(SrvD_ModuleMapType) :: SrvD_MeshMap !< Mesh mapping from inputs/output meshes to StC input/output meshes [-] + INTEGER(IntKi) :: PrevTstepNcall = -1 !< Previous timestep N for tracking when in predictor/corrector loop for setting StC u values [-] + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] + TYPE(SrvD_ContinuousStateType) :: x_perturb !< Continuous state for perturbation in Jacobian routines [-] + TYPE(SrvD_ContinuousStateType) :: dxdt_lin !< Continuous state derivative for output in Jacobian routines [-] + TYPE(SrvD_InputType) :: u_perturb !< Input for perturbation in Jacobian routines [-] + TYPE(SrvD_OutputType) :: y_lin !< Output for output in Jacobian routines [-] + END TYPE SrvD_MiscVarType +! ======================= CONTAINS subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -973,6 +989,7 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake if (allocated(SrcInitOutputData%LinNames_y)) then @@ -1090,6 +1107,7 @@ subroutine SrvD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1120,10 +1138,18 @@ subroutine SrvD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPack(RF, InData%CouplingScheme) call RegPack(RF, InData%UseHSSBrake) call RegPackAlloc(RF, InData%LinNames_y) @@ -1144,10 +1170,30 @@ subroutine SrvD_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(RF, OutData%CouplingScheme); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%UseHSSBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return @@ -3791,398 +3837,717 @@ subroutine SrvD_UnPackModuleMapType(RF, OutData) end if end subroutine -subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_MiscVarType), intent(inout) :: SrcMiscData - type(SrvD_MiscVarType), intent(inout) :: DstMiscData +subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(in) :: SrcParamData + type(SrvD_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyMisc' + character(*), parameter :: RoutineName = 'SrvD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled - call SrvD_CopyBladedDLLType(SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstMiscData%FirstWarn = SrcMiscData%FirstWarn - DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered - if (allocated(SrcMiscData%xd_BlPitchFilter)) then - LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) - if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then - allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), stat=ErrStat2) + DstParamData%DT = SrcParamData%DT + DstParamData%HSSBrDT = SrcParamData%HSSBrDT + DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF + DstParamData%SIG_POSl = SrcParamData%SIG_POSl + DstParamData%SIG_POTq = SrcParamData%SIG_POTq + DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc + DstParamData%SIG_Slop = SrcParamData%SIG_Slop + DstParamData%SIG_SySp = SrcParamData%SIG_SySp + DstParamData%TEC_A0 = SrcParamData%TEC_A0 + DstParamData%TEC_C0 = SrcParamData%TEC_C0 + DstParamData%TEC_C1 = SrcParamData%TEC_C1 + DstParamData%TEC_C2 = SrcParamData%TEC_C2 + DstParamData%TEC_K2 = SrcParamData%TEC_K2 + DstParamData%TEC_MR = SrcParamData%TEC_MR + DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 + DstParamData%TEC_RLR = SrcParamData%TEC_RLR + DstParamData%TEC_RRes = SrcParamData%TEC_RRes + DstParamData%TEC_SRes = SrcParamData%TEC_SRes + DstParamData%TEC_SySp = SrcParamData%TEC_SySp + DstParamData%TEC_V1a = SrcParamData%TEC_V1a + DstParamData%TEC_VLL = SrcParamData%TEC_VLL + DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 + DstParamData%GenEff = SrcParamData%GenEff + if (allocated(SrcParamData%BlPitchInit)) then + LB(1:1) = lbound(SrcParamData%BlPitchInit, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BlPitchInit, kind=B8Ki) + if (.not. allocated(DstParamData%BlPitchInit)) then + allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter + DstParamData%BlPitchInit = SrcParamData%BlPitchInit end if - if (allocated(SrcMiscData%BStC)) then - LB(1:1) = lbound(SrcMiscData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BStC, kind=B8Ki) - if (.not. allocated(DstMiscData%BStC)) then - allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%BlPitchF)) then + LB(1:1) = lbound(SrcParamData%BlPitchF, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BlPitchF, kind=B8Ki) + if (.not. allocated(DstParamData%BlPitchF)) then + allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%BlPitchF = SrcParamData%BlPitchF end if - if (allocated(SrcMiscData%NStC)) then - LB(1:1) = lbound(SrcMiscData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%NStC, kind=B8Ki) - if (.not. allocated(DstMiscData%NStC)) then - allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%PitManRat)) then + LB(1:1) = lbound(SrcParamData%PitManRat, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%PitManRat, kind=B8Ki) + if (.not. allocated(DstParamData%PitManRat)) then + allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%PitManRat = SrcParamData%PitManRat end if - if (allocated(SrcMiscData%TStC)) then - LB(1:1) = lbound(SrcMiscData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TStC, kind=B8Ki) - if (.not. allocated(DstMiscData%TStC)) then - allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) + DstParamData%YawManRat = SrcParamData%YawManRat + DstParamData%NacYawF = SrcParamData%NacYawF + DstParamData%SpdGenOn = SrcParamData%SpdGenOn + DstParamData%THSSBrDp = SrcParamData%THSSBrDp + DstParamData%THSSBrFl = SrcParamData%THSSBrFl + DstParamData%TimGenOf = SrcParamData%TimGenOf + DstParamData%TimGenOn = SrcParamData%TimGenOn + DstParamData%TPCOn = SrcParamData%TPCOn + if (allocated(SrcParamData%TPitManS)) then + LB(1:1) = lbound(SrcParamData%TPitManS, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%TPitManS, kind=B8Ki) + if (.not. allocated(DstParamData%TPitManS)) then + allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%TPitManS = SrcParamData%TPitManS end if - if (allocated(SrcMiscData%SStC)) then - LB(1:1) = lbound(SrcMiscData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SStC, kind=B8Ki) - if (.not. allocated(DstMiscData%SStC)) then - allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) + DstParamData%TYawManS = SrcParamData%TYawManS + DstParamData%TYCOn = SrcParamData%TYCOn + DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp + DstParamData%VS_RtTq = SrcParamData%VS_RtTq + DstParamData%VS_Slope = SrcParamData%VS_Slope + DstParamData%VS_SlPc = SrcParamData%VS_SlPc + DstParamData%VS_SySp = SrcParamData%VS_SySp + DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp + DstParamData%YawPosCom = SrcParamData%YawPosCom + DstParamData%YawRateCom = SrcParamData%YawRateCom + DstParamData%GenModel = SrcParamData%GenModel + DstParamData%HSSBrMode = SrcParamData%HSSBrMode + DstParamData%PCMode = SrcParamData%PCMode + DstParamData%VSContrl = SrcParamData%VSContrl + DstParamData%YCMode = SrcParamData%YCMode + DstParamData%GenTiStp = SrcParamData%GenTiStp + DstParamData%GenTiStr = SrcParamData%GenTiStr + DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K + DstParamData%YawNeut = SrcParamData%YawNeut + DstParamData%YawSpr = SrcParamData%YawSpr + DstParamData%YawDamp = SrcParamData%YawDamp + DstParamData%TpBrDT = SrcParamData%TpBrDT + if (allocated(SrcParamData%TBDepISp)) then + LB(1:1) = lbound(SrcParamData%TBDepISp, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%TBDepISp, kind=B8Ki) + if (.not. allocated(DstParamData%TBDepISp)) then + allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%TBDepISp = SrcParamData%TBDepISp end if - if (allocated(SrcMiscData%u_BStC)) then - LB(1:2) = lbound(SrcMiscData%u_BStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_BStC, kind=B8Ki) - if (.not. allocated(DstMiscData%u_BStC)) then - allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%TBDrConN = SrcParamData%TBDrConN + DstParamData%TBDrConD = SrcParamData%TBDrConD + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%NumBStC = SrcParamData%NumBStC + DstParamData%NumNStC = SrcParamData%NumNStC + DstParamData%NumTStC = SrcParamData%NumTStC + DstParamData%NumSStC = SrcParamData%NumSStC + DstParamData%AfCmode = SrcParamData%AfCmode + DstParamData%AfC_Mean = SrcParamData%AfC_Mean + DstParamData%AfC_Amp = SrcParamData%AfC_Amp + DstParamData%AfC_Phase = SrcParamData%AfC_Phase + DstParamData%CCmode = SrcParamData%CCmode + DstParamData%StCCmode = SrcParamData%StCCmode + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%u_NStC)) then - LB(1:2) = lbound(SrcMiscData%u_NStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_NStC, kind=B8Ki) - if (.not. allocated(DstMiscData%u_NStC)) then - allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcMiscData%u_TStC)) then - LB(1:2) = lbound(SrcMiscData%u_TStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_TStC, kind=B8Ki) - if (.not. allocated(DstMiscData%u_TStC)) then - allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%Delim = SrcParamData%Delim + DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface + DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt + DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp + DstParamData%BlAlpha = SrcParamData%BlAlpha + DstParamData%DLL_n = SrcParamData%DLL_n + DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN + DstParamData%NacYaw_North = SrcParamData%NacYaw_North + DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef + if (allocated(SrcParamData%BStC)) then + LB(1:1) = lbound(SrcParamData%BStC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BStC, kind=B8Ki) + if (.not. allocated(DstParamData%BStC)) then + allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%u_SStC)) then - LB(1:2) = lbound(SrcMiscData%u_SStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_SStC, kind=B8Ki) - if (.not. allocated(DstMiscData%u_SStC)) then - allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%NStC)) then + LB(1:1) = lbound(SrcParamData%NStC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NStC, kind=B8Ki) + if (.not. allocated(DstParamData%NStC)) then + allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%y_BStC)) then - LB(1:1) = lbound(SrcMiscData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_BStC, kind=B8Ki) - if (.not. allocated(DstMiscData%y_BStC)) then - allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%TStC)) then + LB(1:1) = lbound(SrcParamData%TStC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%TStC, kind=B8Ki) + if (.not. allocated(DstParamData%TStC)) then + allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call StC_CopyParam(SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%y_NStC)) then - LB(1:1) = lbound(SrcMiscData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_NStC, kind=B8Ki) - if (.not. allocated(DstMiscData%y_NStC)) then - allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%SStC)) then + LB(1:1) = lbound(SrcParamData%SStC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%SStC, kind=B8Ki) + if (.not. allocated(DstParamData%SStC)) then + allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call StC_CopyParam(SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%y_TStC)) then - LB(1:1) = lbound(SrcMiscData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_TStC, kind=B8Ki) - if (.not. allocated(DstMiscData%y_TStC)) then - allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) + DstParamData%InterpOrder = SrcParamData%InterpOrder + DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP + DstParamData%NumCableControl = SrcParamData%NumCableControl + DstParamData%NumStC_Control = SrcParamData%NumStC_Control + if (allocated(SrcParamData%StCMeasNumPerChan)) then + LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) + if (.not. allocated(DstParamData%StCMeasNumPerChan)) then + allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan end if - if (allocated(SrcMiscData%y_SStC)) then - LB(1:1) = lbound(SrcMiscData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_SStC, kind=B8Ki) - if (.not. allocated(DstMiscData%y_SStC)) then - allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) + DstParamData%UseSC = SrcParamData%UseSC + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if - call SrvD_CopyModuleMapType(SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall -end subroutine - -subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SrvD_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - call SrvD_DestroyBladedDLLType(MiscData%dll_data, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%xd_BlPitchFilter)) then - deallocate(MiscData%xd_BlPitchFilter) + if (allocated(SrcParamData%Jac_x_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_x_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_x_indx, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_x_indx)) then + allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx end if - if (allocated(MiscData%BStC)) then - LB(1:1) = lbound(MiscData%BStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%BStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%BStC) + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du end if - if (allocated(MiscData%NStC)) then - LB(1:1) = lbound(MiscData%NStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%NStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%NStC) + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx end if - if (allocated(MiscData%TStC)) then - LB(1:1) = lbound(MiscData%TStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%TStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%TStC) + DstParamData%Jac_nu = SrcParamData%Jac_nu + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%Jac_Idx_BStC_u)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then + allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u end if - if (allocated(MiscData%SStC)) then - LB(1:1) = lbound(MiscData%SStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%SStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%SStC) + if (allocated(SrcParamData%Jac_Idx_NStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then + allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u end if - if (allocated(MiscData%u_BStC)) then - LB(1:2) = lbound(MiscData%u_BStC, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_BStC, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(MiscData%u_BStC) + if (allocated(SrcParamData%Jac_Idx_TStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then + allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u end if - if (allocated(MiscData%u_NStC)) then - LB(1:2) = lbound(MiscData%u_NStC, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_NStC, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(MiscData%u_NStC) + if (allocated(SrcParamData%Jac_Idx_SStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then + allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u end if - if (allocated(MiscData%u_TStC)) then - LB(1:2) = lbound(MiscData%u_TStC, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_TStC, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(MiscData%u_TStC) + if (allocated(SrcParamData%Jac_Idx_BStC_x)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then + allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x end if - if (allocated(MiscData%u_SStC)) then - LB(1:2) = lbound(MiscData%u_SStC, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_SStC, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(MiscData%u_SStC) + if (allocated(SrcParamData%Jac_Idx_NStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then + allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x end if - if (allocated(MiscData%y_BStC)) then - LB(1:1) = lbound(MiscData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_BStC, kind=B8Ki) + if (allocated(SrcParamData%Jac_Idx_TStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then + allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x + end if + if (allocated(SrcParamData%Jac_Idx_SStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then + allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x + end if + if (allocated(SrcParamData%Jac_Idx_BStC_y)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then + allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y + end if + if (allocated(SrcParamData%Jac_Idx_NStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then + allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y + end if + if (allocated(SrcParamData%Jac_Idx_TStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then + allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y + end if + if (allocated(SrcParamData%Jac_Idx_SStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then + allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y + end if + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%NumBeam = SrcParamData%NumBeam + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if +end subroutine + +subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%BlPitchInit)) then + deallocate(ParamData%BlPitchInit) + end if + if (allocated(ParamData%BlPitchF)) then + deallocate(ParamData%BlPitchF) + end if + if (allocated(ParamData%PitManRat)) then + deallocate(ParamData%PitManRat) + end if + if (allocated(ParamData%TPitManS)) then + deallocate(ParamData%TPitManS) + end if + if (allocated(ParamData%TBDepISp)) then + deallocate(ParamData%TBDepISp) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_BStC) + deallocate(ParamData%OutParam) end if - if (allocated(MiscData%y_NStC)) then - LB(1:1) = lbound(MiscData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_NStC, kind=B8Ki) + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%BStC)) then + LB(1:1) = lbound(ParamData%BStC, kind=B8Ki) + UB(1:1) = ubound(ParamData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_NStC) + deallocate(ParamData%BStC) end if - if (allocated(MiscData%y_TStC)) then - LB(1:1) = lbound(MiscData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_TStC, kind=B8Ki) + if (allocated(ParamData%NStC)) then + LB(1:1) = lbound(ParamData%NStC, kind=B8Ki) + UB(1:1) = ubound(ParamData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_TStC) + deallocate(ParamData%NStC) end if - if (allocated(MiscData%y_SStC)) then - LB(1:1) = lbound(MiscData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_SStC, kind=B8Ki) + if (allocated(ParamData%TStC)) then + LB(1:1) = lbound(ParamData%TStC, kind=B8Ki) + UB(1:1) = ubound(ParamData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_SStC) + deallocate(ParamData%TStC) end if - call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine SrvD_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SrvD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%LastTimeCalled) - call SrvD_PackBladedDLLType(RF, InData%dll_data) - call RegPack(RF, InData%FirstWarn) - call RegPack(RF, InData%LastTimeFiltered) - call RegPackAlloc(RF, InData%xd_BlPitchFilter) - call RegPack(RF, allocated(InData%BStC)) - if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + if (allocated(ParamData%SStC)) then + LB(1:1) = lbound(ParamData%SStC, kind=B8Ki) + UB(1:1) = ubound(ParamData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackMisc(RF, InData%BStC(i1)) + call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%SStC) + end if + if (allocated(ParamData%StCMeasNumPerChan)) then + deallocate(ParamData%StCMeasNumPerChan) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%Jac_x_indx)) then + deallocate(ParamData%Jac_x_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + if (allocated(ParamData%Jac_Idx_BStC_u)) then + deallocate(ParamData%Jac_Idx_BStC_u) + end if + if (allocated(ParamData%Jac_Idx_NStC_u)) then + deallocate(ParamData%Jac_Idx_NStC_u) + end if + if (allocated(ParamData%Jac_Idx_TStC_u)) then + deallocate(ParamData%Jac_Idx_TStC_u) + end if + if (allocated(ParamData%Jac_Idx_SStC_u)) then + deallocate(ParamData%Jac_Idx_SStC_u) + end if + if (allocated(ParamData%Jac_Idx_BStC_x)) then + deallocate(ParamData%Jac_Idx_BStC_x) + end if + if (allocated(ParamData%Jac_Idx_NStC_x)) then + deallocate(ParamData%Jac_Idx_NStC_x) + end if + if (allocated(ParamData%Jac_Idx_TStC_x)) then + deallocate(ParamData%Jac_Idx_TStC_x) + end if + if (allocated(ParamData%Jac_Idx_SStC_x)) then + deallocate(ParamData%Jac_Idx_SStC_x) + end if + if (allocated(ParamData%Jac_Idx_BStC_y)) then + deallocate(ParamData%Jac_Idx_BStC_y) + end if + if (allocated(ParamData%Jac_Idx_NStC_y)) then + deallocate(ParamData%Jac_Idx_NStC_y) + end if + if (allocated(ParamData%Jac_Idx_TStC_y)) then + deallocate(ParamData%Jac_Idx_TStC_y) + end if + if (allocated(ParamData%Jac_Idx_SStC_y)) then + deallocate(ParamData%Jac_Idx_SStC_y) + end if + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if +end subroutine + +subroutine SrvD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackParam' + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%HSSBrDT) + call RegPack(RF, InData%HSSBrTqF) + call RegPack(RF, InData%SIG_POSl) + call RegPack(RF, InData%SIG_POTq) + call RegPack(RF, InData%SIG_SlPc) + call RegPack(RF, InData%SIG_Slop) + call RegPack(RF, InData%SIG_SySp) + call RegPack(RF, InData%TEC_A0) + call RegPack(RF, InData%TEC_C0) + call RegPack(RF, InData%TEC_C1) + call RegPack(RF, InData%TEC_C2) + call RegPack(RF, InData%TEC_K2) + call RegPack(RF, InData%TEC_MR) + call RegPack(RF, InData%TEC_Re1) + call RegPack(RF, InData%TEC_RLR) + call RegPack(RF, InData%TEC_RRes) + call RegPack(RF, InData%TEC_SRes) + call RegPack(RF, InData%TEC_SySp) + call RegPack(RF, InData%TEC_V1a) + call RegPack(RF, InData%TEC_VLL) + call RegPack(RF, InData%TEC_Xe1) + call RegPack(RF, InData%GenEff) + call RegPackAlloc(RF, InData%BlPitchInit) + call RegPackAlloc(RF, InData%BlPitchF) + call RegPackAlloc(RF, InData%PitManRat) + call RegPack(RF, InData%YawManRat) + call RegPack(RF, InData%NacYawF) + call RegPack(RF, InData%SpdGenOn) + call RegPack(RF, InData%THSSBrDp) + call RegPack(RF, InData%THSSBrFl) + call RegPack(RF, InData%TimGenOf) + call RegPack(RF, InData%TimGenOn) + call RegPack(RF, InData%TPCOn) + call RegPackAlloc(RF, InData%TPitManS) + call RegPack(RF, InData%TYawManS) + call RegPack(RF, InData%TYCOn) + call RegPack(RF, InData%VS_RtGnSp) + call RegPack(RF, InData%VS_RtTq) + call RegPack(RF, InData%VS_Slope) + call RegPack(RF, InData%VS_SlPc) + call RegPack(RF, InData%VS_SySp) + call RegPack(RF, InData%VS_TrGnSp) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%GenModel) + call RegPack(RF, InData%HSSBrMode) + call RegPack(RF, InData%PCMode) + call RegPack(RF, InData%VSContrl) + call RegPack(RF, InData%YCMode) + call RegPack(RF, InData%GenTiStp) + call RegPack(RF, InData%GenTiStr) + call RegPack(RF, InData%VS_Rgn2K) + call RegPack(RF, InData%YawNeut) + call RegPack(RF, InData%YawSpr) + call RegPack(RF, InData%YawDamp) + call RegPack(RF, InData%TpBrDT) + call RegPackAlloc(RF, InData%TBDepISp) + call RegPack(RF, InData%TBDrConN) + call RegPack(RF, InData%TBDrConD) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%NumBStC) + call RegPack(RF, InData%NumNStC) + call RegPack(RF, InData%NumTStC) + call RegPack(RF, InData%NumSStC) + call RegPack(RF, InData%AfCmode) + call RegPack(RF, InData%AfC_Mean) + call RegPack(RF, InData%AfC_Amp) + call RegPack(RF, InData%AfC_Phase) + call RegPack(RF, InData%CCmode) + call RegPack(RF, InData%StCCmode) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumOuts_DLL) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UseBladedInterface) + call RegPack(RF, InData%UseLegacyInterface) + call DLLTypePack(RF, InData%DLL_Trgt) + call RegPack(RF, InData%DLL_Ramp) + call RegPack(RF, InData%BlAlpha) + call RegPack(RF, InData%DLL_n) + call RegPack(RF, InData%avcOUTNAME_LEN) + call RegPack(RF, InData%NacYaw_North) + call RegPack(RF, InData%AvgWindSpeed) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%RotSpeedRef) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%BStC, kind=B8Ki) + UB(1:1) = ubound(InData%BStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_PackParam(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) @@ -4191,7 +4556,7 @@ subroutine SrvD_PackMisc(RF, Indata) LB(1:1) = lbound(InData%NStC, kind=B8Ki) UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackMisc(RF, InData%NStC(i1)) + call StC_PackParam(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) @@ -4200,7 +4565,7 @@ subroutine SrvD_PackMisc(RF, Indata) LB(1:1) = lbound(InData%TStC, kind=B8Ki) UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackMisc(RF, InData%TStC(i1)) + call StC_PackParam(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) @@ -4209,108 +4574,161 @@ subroutine SrvD_PackMisc(RF, Indata) LB(1:1) = lbound(InData%SStC, kind=B8Ki) UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackMisc(RF, InData%SStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_BStC)) - if (allocated(InData%u_BStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_BStC, kind=B8Ki), ubound(InData%u_BStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_BStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_BStC, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_PackInput(RF, InData%u_BStC(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%u_NStC)) - if (allocated(InData%u_NStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_NStC, kind=B8Ki), ubound(InData%u_NStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_NStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_NStC, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_PackInput(RF, InData%u_NStC(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%u_TStC)) - if (allocated(InData%u_TStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_TStC, kind=B8Ki), ubound(InData%u_TStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_TStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_TStC, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_PackInput(RF, InData%u_TStC(i1,i2)) - end do + call StC_PackParam(RF, InData%SStC(i1)) end do end if - call RegPack(RF, allocated(InData%u_SStC)) - if (allocated(InData%u_SStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_SStC, kind=B8Ki), ubound(InData%u_SStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_SStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_SStC, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_PackInput(RF, InData%u_SStC(i1,i2)) - end do - end do + call RegPack(RF, InData%InterpOrder) + call RegPack(RF, InData%EXavrSWAP) + call RegPack(RF, InData%NumCableControl) + call RegPack(RF, InData%NumStC_Control) + call RegPackAlloc(RF, InData%StCMeasNumPerChan) + call RegPack(RF, InData%UseSC) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%Jac_x_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_nu) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_y) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if end if - call RegPack(RF, allocated(InData%y_BStC)) - if (allocated(InData%y_BStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_BStC, kind=B8Ki), ubound(InData%y_BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_BStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_BStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%y_NStC)) - if (allocated(InData%y_NStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_NStC, kind=B8Ki), ubound(InData%y_NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_NStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_NStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%y_TStC)) - if (allocated(InData%y_TStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_TStC, kind=B8Ki), ubound(InData%y_TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_TStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_TStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%y_SStC)) - if (allocated(InData%y_SStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_SStC, kind=B8Ki), ubound(InData%y_SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_SStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_SStC(i1)) - end do - end if - call SrvD_PackModuleMapType(RF, InData%SrvD_MeshMap) - call RegPack(RF, InData%PrevTstepNcall) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackMisc(RF, OutData) +subroutine SrvD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF - type(SrvD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + type(SrvD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackParam' + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%LastTimeCalled); if (RegCheckErr(RF, RoutineName)) return - call SrvD_UnpackBladedDLLType(RF, OutData%dll_data) ! dll_data - call RegUnpack(RF, OutData%FirstWarn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastTimeFiltered); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xd_BlPitchFilter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTqF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_POSl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_POTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_Slop); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_A0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_K2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_MR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Re1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RLR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_V1a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_VLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Xe1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYawF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrDp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrFl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TPCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TPitManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYawManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Slope); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_TrGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VSContrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Rgn2K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawNeut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TpBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TBDepISp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TBDrConN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TBDrConD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Amp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Phase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StCCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts_DLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseBladedInterface); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseLegacyInterface); if (RegCheckErr(RF, RoutineName)) return + call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt + call RegUnpack(RF, OutData%DLL_Ramp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avcOUTNAME_LEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw_North); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedRef); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -4321,7 +4739,7 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%BStC(i1)) ! BStC + call StC_UnpackParam(RF, OutData%BStC(i1)) ! BStC end do end if if (allocated(OutData%NStC)) deallocate(OutData%NStC) @@ -4334,7 +4752,7 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%NStC(i1)) ! NStC + call StC_UnpackParam(RF, OutData%NStC(i1)) ! NStC end do end if if (allocated(OutData%TStC)) deallocate(OutData%TStC) @@ -4347,7 +4765,7 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%TStC(i1)) ! TStC + call StC_UnpackParam(RF, OutData%TStC(i1)) ! TStC end do end if if (allocated(OutData%SStC)) deallocate(OutData%SStC) @@ -4360,1634 +4778,1013 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%SStC(i1)) ! SStC - end do - end if - if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_UnpackInput(RF, OutData%u_BStC(i1,i2)) ! u_BStC - end do + call StC_UnpackParam(RF, OutData%SStC(i1)) ! SStC end do end if - if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EXavrSWAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCableControl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumStC_Control); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCMeasNumPerChan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_x_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_NStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_UnpackInput(RF, OutData%u_NStC(i1,i2)) ! u_NStC - end do - end do + else + OutData%Vars => null() end if - if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_TStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return +end subroutine + +subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: SrcInputData + type(SrvD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BlPitch)) then + LB(1:1) = lbound(SrcInputData%BlPitch, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%BlPitch, kind=B8Ki) + if (.not. allocated(DstInputData%BlPitch)) then + allocate(DstInputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_UnpackInput(RF, OutData%u_TStC(i1,i2)) ! u_TStC - end do - end do + DstInputData%BlPitch = SrcInputData%BlPitch end if - if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_SStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + DstInputData%Yaw = SrcInputData%Yaw + DstInputData%YawRate = SrcInputData%YawRate + DstInputData%LSS_Spd = SrcInputData%LSS_Spd + DstInputData%HSS_Spd = SrcInputData%HSS_Spd + DstInputData%RotSpeed = SrcInputData%RotSpeed + DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom + DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom + if (allocated(SrcInputData%ExternalBlPitchCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) + if (.not. allocated(DstInputData%ExternalBlPitchCom)) then + allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_UnpackInput(RF, OutData%u_SStC(i1,i2)) ! u_SStC - end do - end do + DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom end if - if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_BStC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq + DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr + DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac + if (allocated(SrcInputData%ExternalBlAirfoilCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) + if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then + allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_BStC(i1)) ! y_BStC - end do + DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom end if - if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_NStC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcInputData%ExternalCableDeltaL)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) + if (.not. allocated(DstInputData%ExternalCableDeltaL)) then + allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_NStC(i1)) ! y_NStC - end do + DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL end if - if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_TStC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcInputData%ExternalCableDeltaLdot)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) + if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then + allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_TStC(i1)) ! y_TStC - end do + DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot end if - if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_SStC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + DstInputData%TwrAccel = SrcInputData%TwrAccel + DstInputData%YawErr = SrcInputData%YawErr + DstInputData%WindDir = SrcInputData%WindDir + DstInputData%RootMyc = SrcInputData%RootMyc + DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp + DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp + DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa + DstInputData%RootMxc = SrcInputData%RootMxc + DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa + DstInputData%LSSTipMya = SrcInputData%LSSTipMya + DstInputData%LSSTipMza = SrcInputData%LSSTipMza + DstInputData%LSSTipMys = SrcInputData%LSSTipMys + DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs + DstInputData%YawBrMyn = SrcInputData%YawBrMyn + DstInputData%YawBrMzn = SrcInputData%YawBrMzn + DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs + DstInputData%NcIMURAys = SrcInputData%NcIMURAys + DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs + DstInputData%RotPwr = SrcInputData%RotPwr + DstInputData%HorWindV = SrcInputData%HorWindV + DstInputData%YawAngle = SrcInputData%YawAngle + DstInputData%LSShftFxa = SrcInputData%LSShftFxa + DstInputData%LSShftFys = SrcInputData%LSShftFys + DstInputData%LSShftFzs = SrcInputData%LSShftFzs + if (allocated(SrcInputData%fromSC)) then + LB(1:1) = lbound(SrcInputData%fromSC, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fromSC, kind=B8Ki) + if (.not. allocated(DstInputData%fromSC)) then + allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_SStC(i1)) ! y_SStC - end do + DstInputData%fromSC = SrcInputData%fromSC end if - call SrvD_UnpackModuleMapType(RF, OutData%SrvD_MeshMap) ! SrvD_MeshMap - call RegUnpack(RF, OutData%PrevTstepNcall); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_ParameterType), intent(in) :: SrcParamData - type(SrvD_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%DT = SrcParamData%DT - DstParamData%HSSBrDT = SrcParamData%HSSBrDT - DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF - DstParamData%SIG_POSl = SrcParamData%SIG_POSl - DstParamData%SIG_POTq = SrcParamData%SIG_POTq - DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc - DstParamData%SIG_Slop = SrcParamData%SIG_Slop - DstParamData%SIG_SySp = SrcParamData%SIG_SySp - DstParamData%TEC_A0 = SrcParamData%TEC_A0 - DstParamData%TEC_C0 = SrcParamData%TEC_C0 - DstParamData%TEC_C1 = SrcParamData%TEC_C1 - DstParamData%TEC_C2 = SrcParamData%TEC_C2 - DstParamData%TEC_K2 = SrcParamData%TEC_K2 - DstParamData%TEC_MR = SrcParamData%TEC_MR - DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 - DstParamData%TEC_RLR = SrcParamData%TEC_RLR - DstParamData%TEC_RRes = SrcParamData%TEC_RRes - DstParamData%TEC_SRes = SrcParamData%TEC_SRes - DstParamData%TEC_SySp = SrcParamData%TEC_SySp - DstParamData%TEC_V1a = SrcParamData%TEC_V1a - DstParamData%TEC_VLL = SrcParamData%TEC_VLL - DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 - DstParamData%GenEff = SrcParamData%GenEff - if (allocated(SrcParamData%BlPitchInit)) then - LB(1:1) = lbound(SrcParamData%BlPitchInit, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BlPitchInit, kind=B8Ki) - if (.not. allocated(DstParamData%BlPitchInit)) then - allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%fromSCglob)) then + LB(1:1) = lbound(SrcInputData%fromSCglob, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fromSCglob, kind=B8Ki) + if (.not. allocated(DstInputData%fromSCglob)) then + allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%BlPitchInit = SrcParamData%BlPitchInit + DstInputData%fromSCglob = SrcInputData%fromSCglob end if - if (allocated(SrcParamData%BlPitchF)) then - LB(1:1) = lbound(SrcParamData%BlPitchF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BlPitchF, kind=B8Ki) - if (.not. allocated(DstParamData%BlPitchF)) then - allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%Lidar)) then + LB(1:1) = lbound(SrcInputData%Lidar, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%Lidar, kind=B8Ki) + if (.not. allocated(DstInputData%Lidar)) then + allocate(DstInputData%Lidar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Lidar.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%BlPitchF = SrcParamData%BlPitchF + DstInputData%Lidar = SrcInputData%Lidar end if - if (allocated(SrcParamData%PitManRat)) then - LB(1:1) = lbound(SrcParamData%PitManRat, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%PitManRat, kind=B8Ki) - if (.not. allocated(DstParamData%PitManRat)) then - allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) + call MeshCopy(SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%BStCMotionMesh)) then + LB(1:2) = lbound(SrcInputData%BStCMotionMesh, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%BStCMotionMesh, kind=B8Ki) + if (.not. allocated(DstInputData%BStCMotionMesh)) then + allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PitManRat = SrcParamData%PitManRat + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do end if - DstParamData%YawManRat = SrcParamData%YawManRat - DstParamData%NacYawF = SrcParamData%NacYawF - DstParamData%SpdGenOn = SrcParamData%SpdGenOn - DstParamData%THSSBrDp = SrcParamData%THSSBrDp - DstParamData%THSSBrFl = SrcParamData%THSSBrFl - DstParamData%TimGenOf = SrcParamData%TimGenOf - DstParamData%TimGenOn = SrcParamData%TimGenOn - DstParamData%TPCOn = SrcParamData%TPCOn - if (allocated(SrcParamData%TPitManS)) then - LB(1:1) = lbound(SrcParamData%TPitManS, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TPitManS, kind=B8Ki) - if (.not. allocated(DstParamData%TPitManS)) then - allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%NStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%NStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%NStCMotionMesh, kind=B8Ki) + if (.not. allocated(DstInputData%NStCMotionMesh)) then + allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%TPitManS = SrcParamData%TPitManS + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%TYawManS = SrcParamData%TYawManS - DstParamData%TYCOn = SrcParamData%TYCOn - DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp - DstParamData%VS_RtTq = SrcParamData%VS_RtTq - DstParamData%VS_Slope = SrcParamData%VS_Slope - DstParamData%VS_SlPc = SrcParamData%VS_SlPc - DstParamData%VS_SySp = SrcParamData%VS_SySp - DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp - DstParamData%YawPosCom = SrcParamData%YawPosCom - DstParamData%YawRateCom = SrcParamData%YawRateCom - DstParamData%GenModel = SrcParamData%GenModel - DstParamData%HSSBrMode = SrcParamData%HSSBrMode - DstParamData%PCMode = SrcParamData%PCMode - DstParamData%VSContrl = SrcParamData%VSContrl - DstParamData%YCMode = SrcParamData%YCMode - DstParamData%GenTiStp = SrcParamData%GenTiStp - DstParamData%GenTiStr = SrcParamData%GenTiStr - DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K - DstParamData%YawNeut = SrcParamData%YawNeut - DstParamData%YawSpr = SrcParamData%YawSpr - DstParamData%YawDamp = SrcParamData%YawDamp - DstParamData%TpBrDT = SrcParamData%TpBrDT - if (allocated(SrcParamData%TBDepISp)) then - LB(1:1) = lbound(SrcParamData%TBDepISp, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TBDepISp, kind=B8Ki) - if (.not. allocated(DstParamData%TBDepISp)) then - allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TBDepISp = SrcParamData%TBDepISp - end if - DstParamData%TBDrConN = SrcParamData%TBDrConN - DstParamData%TBDrConD = SrcParamData%TBDrConD - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%NumBStC = SrcParamData%NumBStC - DstParamData%NumNStC = SrcParamData%NumNStC - DstParamData%NumTStC = SrcParamData%NumTStC - DstParamData%NumSStC = SrcParamData%NumSStC - DstParamData%AfCmode = SrcParamData%AfCmode - DstParamData%AfC_Mean = SrcParamData%AfC_Mean - DstParamData%AfC_Amp = SrcParamData%AfC_Amp - DstParamData%AfC_Phase = SrcParamData%AfC_Phase - DstParamData%CCmode = SrcParamData%CCmode - DstParamData%StCCmode = SrcParamData%StCCmode - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL - DstParamData%RootName = SrcParamData%RootName - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%TStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%TStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%TStCMotionMesh, kind=B8Ki) + if (.not. allocated(DstInputData%TStCMotionMesh)) then + allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - DstParamData%Delim = SrcParamData%Delim - DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface - DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt - DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp - DstParamData%BlAlpha = SrcParamData%BlAlpha - DstParamData%DLL_n = SrcParamData%DLL_n - DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN - DstParamData%NacYaw_North = SrcParamData%NacYaw_North - DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%TrimCase = SrcParamData%TrimCase - DstParamData%TrimGain = SrcParamData%TrimGain - DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef - if (allocated(SrcParamData%BStC)) then - LB(1:1) = lbound(SrcParamData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BStC, kind=B8Ki) - if (.not. allocated(DstParamData%BStC)) then - allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%SStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%SStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%SStCMotionMesh, kind=B8Ki) + if (.not. allocated(DstInputData%SStCMotionMesh)) then + allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcParamData%NStC)) then - LB(1:1) = lbound(SrcParamData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NStC, kind=B8Ki) - if (.not. allocated(DstParamData%NStC)) then - allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%LidSpeed)) then + LB(1:1) = lbound(SrcInputData%LidSpeed, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%LidSpeed, kind=B8Ki) + if (.not. allocated(DstInputData%LidSpeed)) then + allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstInputData%LidSpeed = SrcInputData%LidSpeed end if - if (allocated(SrcParamData%TStC)) then - LB(1:1) = lbound(SrcParamData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TStC, kind=B8Ki) - if (.not. allocated(DstParamData%TStC)) then - allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsX, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%MsrPositionsX, kind=B8Ki) + if (.not. allocated(DstInputData%MsrPositionsX)) then + allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX end if - if (allocated(SrcParamData%SStC)) then - LB(1:1) = lbound(SrcParamData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SStC, kind=B8Ki) - if (.not. allocated(DstParamData%SStC)) then - allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsY, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%MsrPositionsY, kind=B8Ki) + if (.not. allocated(DstInputData%MsrPositionsY)) then + allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY end if - DstParamData%InterpOrder = SrcParamData%InterpOrder - DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP - DstParamData%NumCableControl = SrcParamData%NumCableControl - DstParamData%NumStC_Control = SrcParamData%NumStC_Control - if (allocated(SrcParamData%StCMeasNumPerChan)) then - LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) - if (.not. allocated(DstParamData%StCMeasNumPerChan)) then - allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsZ, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%MsrPositionsZ, kind=B8Ki) + if (.not. allocated(DstInputData%MsrPositionsZ)) then + allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan + DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ end if - DstParamData%UseSC = SrcParamData%UseSC - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx +end subroutine + +subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BlPitch)) then + deallocate(InputData%BlPitch) end if - if (allocated(SrcParamData%Jac_x_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_x_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_x_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_x_indx)) then - allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx + if (allocated(InputData%ExternalBlPitchCom)) then + deallocate(InputData%ExternalBlPitchCom) end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du + if (allocated(InputData%ExternalBlAirfoilCom)) then + deallocate(InputData%ExternalBlAirfoilCom) end if - if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) - if (.not. allocated(DstParamData%dx)) then - allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%dx = SrcParamData%dx + if (allocated(InputData%ExternalCableDeltaL)) then + deallocate(InputData%ExternalCableDeltaL) end if - DstParamData%Jac_nu = SrcParamData%Jac_nu - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - if (allocated(SrcParamData%Jac_Idx_BStC_u)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then - allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u + if (allocated(InputData%ExternalCableDeltaLdot)) then + deallocate(InputData%ExternalCableDeltaLdot) end if - if (allocated(SrcParamData%Jac_Idx_NStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then - allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) end if - if (allocated(SrcParamData%Jac_Idx_TStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then - allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u - end if - if (allocated(SrcParamData%Jac_Idx_SStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then - allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u - end if - if (allocated(SrcParamData%Jac_Idx_BStC_x)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then - allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x - end if - if (allocated(SrcParamData%Jac_Idx_NStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then - allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x - end if - if (allocated(SrcParamData%Jac_Idx_TStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then - allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x - end if - if (allocated(SrcParamData%Jac_Idx_SStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then - allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x - end if - if (allocated(SrcParamData%Jac_Idx_BStC_y)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then - allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y - end if - if (allocated(SrcParamData%Jac_Idx_NStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then - allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y - end if - if (allocated(SrcParamData%Jac_Idx_TStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then - allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y - end if - if (allocated(SrcParamData%Jac_Idx_SStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then - allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y - end if - DstParamData%SensorType = SrcParamData%SensorType - DstParamData%NumBeam = SrcParamData%NumBeam - DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%PulseSpacing = SrcParamData%PulseSpacing - DstParamData%URefLid = SrcParamData%URefLid -end subroutine - -subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(SrvD_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ParamData%BlPitchInit)) then - deallocate(ParamData%BlPitchInit) - end if - if (allocated(ParamData%BlPitchF)) then - deallocate(ParamData%BlPitchF) - end if - if (allocated(ParamData%PitManRat)) then - deallocate(ParamData%PitManRat) - end if - if (allocated(ParamData%TPitManS)) then - deallocate(ParamData%TPitManS) - end if - if (allocated(ParamData%TBDepISp)) then - deallocate(ParamData%TBDepISp) + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) end if - if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%OutParam) + if (allocated(InputData%Lidar)) then + deallocate(InputData%Lidar) end if - call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ParamData%BStC)) then - LB(1:1) = lbound(ParamData%BStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%BStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%BStCMotionMesh)) then + LB(1:2) = lbound(InputData%BStCMotionMesh, kind=B8Ki) + UB(1:2) = ubound(InputData%BStCMotionMesh, kind=B8Ki) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end do - deallocate(ParamData%BStC) + deallocate(InputData%BStCMotionMesh) end if - if (allocated(ParamData%NStC)) then - LB(1:1) = lbound(ParamData%NStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%NStC, kind=B8Ki) + if (allocated(InputData%NStCMotionMesh)) then + LB(1:1) = lbound(InputData%NStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InputData%NStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) + call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%NStC) + deallocate(InputData%NStCMotionMesh) end if - if (allocated(ParamData%TStC)) then - LB(1:1) = lbound(ParamData%TStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%TStC, kind=B8Ki) + if (allocated(InputData%TStCMotionMesh)) then + LB(1:1) = lbound(InputData%TStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InputData%TStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) + call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%TStC) + deallocate(InputData%TStCMotionMesh) end if - if (allocated(ParamData%SStC)) then - LB(1:1) = lbound(ParamData%SStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%SStC, kind=B8Ki) + if (allocated(InputData%SStCMotionMesh)) then + LB(1:1) = lbound(InputData%SStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InputData%SStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) + call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%SStC) - end if - if (allocated(ParamData%StCMeasNumPerChan)) then - deallocate(ParamData%StCMeasNumPerChan) - end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%Jac_x_indx)) then - deallocate(ParamData%Jac_x_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if - if (allocated(ParamData%dx)) then - deallocate(ParamData%dx) - end if - if (allocated(ParamData%Jac_Idx_BStC_u)) then - deallocate(ParamData%Jac_Idx_BStC_u) - end if - if (allocated(ParamData%Jac_Idx_NStC_u)) then - deallocate(ParamData%Jac_Idx_NStC_u) - end if - if (allocated(ParamData%Jac_Idx_TStC_u)) then - deallocate(ParamData%Jac_Idx_TStC_u) - end if - if (allocated(ParamData%Jac_Idx_SStC_u)) then - deallocate(ParamData%Jac_Idx_SStC_u) + deallocate(InputData%SStCMotionMesh) end if - if (allocated(ParamData%Jac_Idx_BStC_x)) then - deallocate(ParamData%Jac_Idx_BStC_x) + if (allocated(InputData%LidSpeed)) then + deallocate(InputData%LidSpeed) end if - if (allocated(ParamData%Jac_Idx_NStC_x)) then - deallocate(ParamData%Jac_Idx_NStC_x) + if (allocated(InputData%MsrPositionsX)) then + deallocate(InputData%MsrPositionsX) end if - if (allocated(ParamData%Jac_Idx_TStC_x)) then - deallocate(ParamData%Jac_Idx_TStC_x) + if (allocated(InputData%MsrPositionsY)) then + deallocate(InputData%MsrPositionsY) end if - if (allocated(ParamData%Jac_Idx_SStC_x)) then - deallocate(ParamData%Jac_Idx_SStC_x) - end if - if (allocated(ParamData%Jac_Idx_BStC_y)) then - deallocate(ParamData%Jac_Idx_BStC_y) - end if - if (allocated(ParamData%Jac_Idx_NStC_y)) then - deallocate(ParamData%Jac_Idx_NStC_y) - end if - if (allocated(ParamData%Jac_Idx_TStC_y)) then - deallocate(ParamData%Jac_Idx_TStC_y) - end if - if (allocated(ParamData%Jac_Idx_SStC_y)) then - deallocate(ParamData%Jac_Idx_SStC_y) + if (allocated(InputData%MsrPositionsZ)) then + deallocate(InputData%MsrPositionsZ) end if end subroutine -subroutine SrvD_PackParam(RF, Indata) +subroutine SrvD_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF - type(SrvD_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + type(SrvD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInput' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DT) - call RegPack(RF, InData%HSSBrDT) - call RegPack(RF, InData%HSSBrTqF) - call RegPack(RF, InData%SIG_POSl) - call RegPack(RF, InData%SIG_POTq) - call RegPack(RF, InData%SIG_SlPc) - call RegPack(RF, InData%SIG_Slop) - call RegPack(RF, InData%SIG_SySp) - call RegPack(RF, InData%TEC_A0) - call RegPack(RF, InData%TEC_C0) - call RegPack(RF, InData%TEC_C1) - call RegPack(RF, InData%TEC_C2) - call RegPack(RF, InData%TEC_K2) - call RegPack(RF, InData%TEC_MR) - call RegPack(RF, InData%TEC_Re1) - call RegPack(RF, InData%TEC_RLR) - call RegPack(RF, InData%TEC_RRes) - call RegPack(RF, InData%TEC_SRes) - call RegPack(RF, InData%TEC_SySp) - call RegPack(RF, InData%TEC_V1a) - call RegPack(RF, InData%TEC_VLL) - call RegPack(RF, InData%TEC_Xe1) - call RegPack(RF, InData%GenEff) - call RegPackAlloc(RF, InData%BlPitchInit) - call RegPackAlloc(RF, InData%BlPitchF) - call RegPackAlloc(RF, InData%PitManRat) - call RegPack(RF, InData%YawManRat) - call RegPack(RF, InData%NacYawF) - call RegPack(RF, InData%SpdGenOn) - call RegPack(RF, InData%THSSBrDp) - call RegPack(RF, InData%THSSBrFl) - call RegPack(RF, InData%TimGenOf) - call RegPack(RF, InData%TimGenOn) - call RegPack(RF, InData%TPCOn) - call RegPackAlloc(RF, InData%TPitManS) - call RegPack(RF, InData%TYawManS) - call RegPack(RF, InData%TYCOn) - call RegPack(RF, InData%VS_RtGnSp) - call RegPack(RF, InData%VS_RtTq) - call RegPack(RF, InData%VS_Slope) - call RegPack(RF, InData%VS_SlPc) - call RegPack(RF, InData%VS_SySp) - call RegPack(RF, InData%VS_TrGnSp) - call RegPack(RF, InData%YawPosCom) - call RegPack(RF, InData%YawRateCom) - call RegPack(RF, InData%GenModel) - call RegPack(RF, InData%HSSBrMode) - call RegPack(RF, InData%PCMode) - call RegPack(RF, InData%VSContrl) - call RegPack(RF, InData%YCMode) - call RegPack(RF, InData%GenTiStp) - call RegPack(RF, InData%GenTiStr) - call RegPack(RF, InData%VS_Rgn2K) - call RegPack(RF, InData%YawNeut) - call RegPack(RF, InData%YawSpr) - call RegPack(RF, InData%YawDamp) - call RegPack(RF, InData%TpBrDT) - call RegPackAlloc(RF, InData%TBDepISp) - call RegPack(RF, InData%TBDrConN) - call RegPack(RF, InData%TBDrConD) - call RegPack(RF, InData%NumBl) - call RegPack(RF, InData%NumBStC) - call RegPack(RF, InData%NumNStC) - call RegPack(RF, InData%NumTStC) - call RegPack(RF, InData%NumSStC) - call RegPack(RF, InData%AfCmode) - call RegPack(RF, InData%AfC_Mean) - call RegPack(RF, InData%AfC_Amp) - call RegPack(RF, InData%AfC_Phase) - call RegPack(RF, InData%CCmode) - call RegPack(RF, InData%StCCmode) - call RegPack(RF, InData%NumOuts) - call RegPack(RF, InData%NumOuts_DLL) - call RegPack(RF, InData%RootName) - call RegPack(RF, allocated(InData%OutParam)) - if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) - end do - end if - call RegPack(RF, InData%Delim) - call RegPack(RF, InData%UseBladedInterface) - call RegPack(RF, InData%UseLegacyInterface) - call DLLTypePack(RF, InData%DLL_Trgt) - call RegPack(RF, InData%DLL_Ramp) - call RegPack(RF, InData%BlAlpha) - call RegPack(RF, InData%DLL_n) - call RegPack(RF, InData%avcOUTNAME_LEN) - call RegPack(RF, InData%NacYaw_North) - call RegPack(RF, InData%AvgWindSpeed) - call RegPack(RF, InData%AirDens) - call RegPack(RF, InData%TrimCase) - call RegPack(RF, InData%TrimGain) - call RegPack(RF, InData%RotSpeedRef) - call RegPack(RF, allocated(InData%BStC)) - if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%BStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%NStC)) - if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%NStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%TStC)) - if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%TStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%SStC)) - if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%SStC(i1)) - end do - end if - call RegPack(RF, InData%InterpOrder) - call RegPack(RF, InData%EXavrSWAP) - call RegPack(RF, InData%NumCableControl) - call RegPack(RF, InData%NumStC_Control) - call RegPackAlloc(RF, InData%StCMeasNumPerChan) - call RegPack(RF, InData%UseSC) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%Jac_x_indx) - call RegPackAlloc(RF, InData%du) - call RegPackAlloc(RF, InData%dx) - call RegPack(RF, InData%Jac_nu) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%Jac_nx) - call RegPackAlloc(RF, InData%Jac_Idx_BStC_u) - call RegPackAlloc(RF, InData%Jac_Idx_NStC_u) - call RegPackAlloc(RF, InData%Jac_Idx_TStC_u) - call RegPackAlloc(RF, InData%Jac_Idx_SStC_u) - call RegPackAlloc(RF, InData%Jac_Idx_BStC_x) - call RegPackAlloc(RF, InData%Jac_Idx_NStC_x) - call RegPackAlloc(RF, InData%Jac_Idx_TStC_x) - call RegPackAlloc(RF, InData%Jac_Idx_SStC_x) - call RegPackAlloc(RF, InData%Jac_Idx_BStC_y) - call RegPackAlloc(RF, InData%Jac_Idx_NStC_y) - call RegPackAlloc(RF, InData%Jac_Idx_TStC_y) - call RegPackAlloc(RF, InData%Jac_Idx_SStC_y) - call RegPack(RF, InData%SensorType) - call RegPack(RF, InData%NumBeam) - call RegPack(RF, InData%NumPulseGate) - call RegPack(RF, InData%PulseSpacing) - call RegPack(RF, InData%URefLid) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SrvD_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SrvD_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrDT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrTqF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_POSl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_POTq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_SlPc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_Slop); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_SySp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_A0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_C0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_C1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_C2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_K2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_MR); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_Re1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_RLR); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_RRes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_SRes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_SySp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_V1a); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_VLL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_Xe1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenEff); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlPitchInit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlPitchF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PitManRat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawManRat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacYawF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SpdGenOn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%THSSBrDp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%THSSBrFl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TimGenOf); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TimGenOn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TPCOn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TPitManS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TYawManS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TYCOn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_RtGnSp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_RtTq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_Slope); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_SlPc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_SySp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_TrGnSp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenModel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrMode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PCMode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VSContrl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YCMode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenTiStp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenTiStr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_Rgn2K); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawNeut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawSpr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawDamp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TpBrDT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TBDepISp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TBDrConN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TBDrConD); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBStC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumNStC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumTStC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumSStC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AfCmode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AfC_Mean); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AfC_Amp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AfC_Phase); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CCmode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%StCCmode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOuts_DLL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%LSS_Spd) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%ExternalYawPosCom) + call RegPack(RF, InData%ExternalYawRateCom) + call RegPackAlloc(RF, InData%ExternalBlPitchCom) + call RegPack(RF, InData%ExternalGenTrq) + call RegPack(RF, InData%ExternalElecPwr) + call RegPack(RF, InData%ExternalHSSBrFrac) + call RegPackAlloc(RF, InData%ExternalBlAirfoilCom) + call RegPackAlloc(RF, InData%ExternalCableDeltaL) + call RegPackAlloc(RF, InData%ExternalCableDeltaLdot) + call RegPack(RF, InData%TwrAccel) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%WindDir) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%HorWindV) + call RegPack(RF, InData%YawAngle) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) + call RegPackAlloc(RF, InData%fromSC) + call RegPackAlloc(RF, InData%fromSCglob) + call RegPackAlloc(RF, InData%Lidar) + call MeshPack(RF, InData%PtfmMotionMesh) + call RegPack(RF, allocated(InData%BStCMotionMesh)) + if (allocated(InData%BStCMotionMesh)) then + call RegPackBounds(RF, 2, lbound(InData%BStCMotionMesh, kind=B8Ki), ubound(InData%BStCMotionMesh, kind=B8Ki)) + LB(1:2) = lbound(InData%BStCMotionMesh, kind=B8Ki) + UB(1:2) = ubound(InData%BStCMotionMesh, kind=B8Ki) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BStCMotionMesh(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%NStCMotionMesh)) + if (allocated(InData%NStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%NStCMotionMesh, kind=B8Ki), ubound(InData%NStCMotionMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%NStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InData%NStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + call MeshPack(RF, InData%NStCMotionMesh(i1)) end do end if - call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UseBladedInterface); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UseLegacyInterface); if (RegCheckErr(RF, RoutineName)) return - call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt - call RegUnpack(RF, OutData%DLL_Ramp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BlAlpha); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DLL_n); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%avcOUTNAME_LEN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacYaw_North); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgWindSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotSpeedRef); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegPack(RF, allocated(InData%TStCMotionMesh)) + if (allocated(InData%TStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%TStCMotionMesh, kind=B8Ki), ubound(InData%TStCMotionMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%TStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InData%TStCMotionMesh, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%TStCMotionMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStCMotionMesh)) + if (allocated(InData%SStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%SStCMotionMesh, kind=B8Ki), ubound(InData%SStCMotionMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%SStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InData%SStCMotionMesh, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%SStCMotionMesh(i1)) + end do + end if + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInput' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalYawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalYawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalBlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalGenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalHSSBrFrac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalBlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalCableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalCableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HorWindV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Lidar); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%PtfmMotionMesh) ! PtfmMotionMesh + if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - do i1 = LB(1), UB(1) - call StC_UnpackParam(RF, OutData%BStC(i1)) ! BStC + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh + end do end do end if - if (allocated(OutData%NStC)) deallocate(OutData%NStC) + if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + allocate(OutData%NStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(RF, OutData%NStC(i1)) ! NStC + call MeshUnpack(RF, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh end do end if - if (allocated(OutData%TStC)) deallocate(OutData%TStC) + if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + allocate(OutData%TStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(RF, OutData%TStC(i1)) ! TStC + call MeshUnpack(RF, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh end do end if - if (allocated(OutData%SStC)) deallocate(OutData%SStC) + if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + allocate(OutData%SStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(RF, OutData%SStC(i1)) ! SStC + call MeshUnpack(RF, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh end do end if - call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%EXavrSWAP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumCableControl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumStC_Control); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StCMeasNumPerChan); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_x_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_InputType), intent(inout) :: SrcInputData - type(SrvD_InputType), intent(inout) :: DstInputData +subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: SrcOutputData + type(SrvD_OutputType), intent(inout) :: DstOutputData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyInput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcInputData%BlPitch)) then - LB(1:1) = lbound(SrcInputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BlPitch, kind=B8Ki) - if (.not. allocated(DstInputData%BlPitch)) then - allocate(DstInputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%BlPitch = SrcInputData%BlPitch - end if - DstInputData%Yaw = SrcInputData%Yaw - DstInputData%YawRate = SrcInputData%YawRate - DstInputData%LSS_Spd = SrcInputData%LSS_Spd - DstInputData%HSS_Spd = SrcInputData%HSS_Spd - DstInputData%RotSpeed = SrcInputData%RotSpeed - DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom - DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom - if (allocated(SrcInputData%ExternalBlPitchCom)) then - LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) - if (.not. allocated(DstInputData%ExternalBlPitchCom)) then - allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), stat=ErrStat2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom + DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if - DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq - DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr - DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac - if (allocated(SrcInputData%ExternalBlAirfoilCom)) then - LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) - if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then - allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%BlPitchCom)) then + LB(1:1) = lbound(SrcOutputData%BlPitchCom, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%BlPitchCom, kind=B8Ki) + if (.not. allocated(DstOutputData%BlPitchCom)) then + allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom + DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom end if - if (allocated(SrcInputData%ExternalCableDeltaL)) then - LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) - if (.not. allocated(DstInputData%ExternalCableDeltaL)) then - allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%BlAirfoilCom)) then + LB(1:1) = lbound(SrcOutputData%BlAirfoilCom, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%BlAirfoilCom, kind=B8Ki) + if (.not. allocated(DstOutputData%BlAirfoilCom)) then + allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL + DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom end if - if (allocated(SrcInputData%ExternalCableDeltaLdot)) then - LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) - if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then - allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + DstOutputData%YawMom = SrcOutputData%YawMom + DstOutputData%GenTrq = SrcOutputData%GenTrq + DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC + DstOutputData%ElecPwr = SrcOutputData%ElecPwr + if (allocated(SrcOutputData%TBDrCon)) then + LB(1:1) = lbound(SrcOutputData%TBDrCon, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%TBDrCon, kind=B8Ki) + if (.not. allocated(DstOutputData%TBDrCon)) then + allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot + DstOutputData%TBDrCon = SrcOutputData%TBDrCon end if - DstInputData%TwrAccel = SrcInputData%TwrAccel - DstInputData%YawErr = SrcInputData%YawErr - DstInputData%WindDir = SrcInputData%WindDir - DstInputData%RootMyc = SrcInputData%RootMyc - DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp - DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp - DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa - DstInputData%RootMxc = SrcInputData%RootMxc - DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa - DstInputData%LSSTipMya = SrcInputData%LSSTipMya - DstInputData%LSSTipMza = SrcInputData%LSSTipMza - DstInputData%LSSTipMys = SrcInputData%LSSTipMys - DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs - DstInputData%YawBrMyn = SrcInputData%YawBrMyn - DstInputData%YawBrMzn = SrcInputData%YawBrMzn - DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs - DstInputData%NcIMURAys = SrcInputData%NcIMURAys - DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs - DstInputData%RotPwr = SrcInputData%RotPwr - DstInputData%HorWindV = SrcInputData%HorWindV - DstInputData%YawAngle = SrcInputData%YawAngle - DstInputData%LSShftFxa = SrcInputData%LSShftFxa - DstInputData%LSShftFys = SrcInputData%LSShftFys - DstInputData%LSShftFzs = SrcInputData%LSShftFzs - if (allocated(SrcInputData%fromSC)) then - LB(1:1) = lbound(SrcInputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSC, kind=B8Ki) - if (.not. allocated(DstInputData%fromSC)) then - allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%Lidar)) then + LB(1:1) = lbound(SrcOutputData%Lidar, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Lidar, kind=B8Ki) + if (.not. allocated(DstOutputData%Lidar)) then + allocate(DstOutputData%Lidar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Lidar.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%fromSC = SrcInputData%fromSC + DstOutputData%Lidar = SrcOutputData%Lidar end if - if (allocated(SrcInputData%fromSCglob)) then - LB(1:1) = lbound(SrcInputData%fromSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSCglob, kind=B8Ki) - if (.not. allocated(DstInputData%fromSCglob)) then - allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%CableDeltaL)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%CableDeltaL, kind=B8Ki) + if (.not. allocated(DstOutputData%CableDeltaL)) then + allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%fromSCglob = SrcInputData%fromSCglob + DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL end if - if (allocated(SrcInputData%Lidar)) then - LB(1:1) = lbound(SrcInputData%Lidar, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Lidar, kind=B8Ki) - if (.not. allocated(DstInputData%Lidar)) then - allocate(DstInputData%Lidar(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%CableDeltaLdot)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaLdot, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%CableDeltaLdot, kind=B8Ki) + if (.not. allocated(DstOutputData%CableDeltaLdot)) then + allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Lidar.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%Lidar = SrcInputData%Lidar + DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot end if - call MeshCopy(SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcInputData%BStCMotionMesh)) then - LB(1:2) = lbound(SrcInputData%BStCMotionMesh, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%BStCMotionMesh, kind=B8Ki) - if (.not. allocated(DstInputData%BStCMotionMesh)) then - allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcOutputData%BStCLoadMesh)) then + LB(1:2) = lbound(SrcOutputData%BStCLoadMesh, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%BStCLoadMesh, kind=B8Ki) + if (.not. allocated(DstOutputData%BStCLoadMesh)) then + allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end do end if - if (allocated(SrcInputData%NStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%NStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%NStCMotionMesh, kind=B8Ki) - if (.not. allocated(DstInputData%NStCMotionMesh)) then - allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%NStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%NStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%NStCLoadMesh, kind=B8Ki) + if (.not. allocated(DstOutputData%NStCLoadMesh)) then + allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInputData%TStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%TStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%TStCMotionMesh, kind=B8Ki) - if (.not. allocated(DstInputData%TStCMotionMesh)) then - allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%TStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%TStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%TStCLoadMesh, kind=B8Ki) + if (.not. allocated(DstOutputData%TStCLoadMesh)) then + allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInputData%SStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%SStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%SStCMotionMesh, kind=B8Ki) - if (.not. allocated(DstInputData%SStCMotionMesh)) then - allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%SStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%SStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%SStCLoadMesh, kind=B8Ki) + if (.not. allocated(DstOutputData%SStCLoadMesh)) then + allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInputData%LidSpeed)) then - LB(1:1) = lbound(SrcInputData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%LidSpeed, kind=B8Ki) - if (.not. allocated(DstInputData%LidSpeed)) then - allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%LidSpeed = SrcInputData%LidSpeed - end if - if (allocated(SrcInputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsX, kind=B8Ki) - if (.not. allocated(DstInputData%MsrPositionsX)) then - allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX - end if - if (allocated(SrcInputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsY, kind=B8Ki) - if (.not. allocated(DstInputData%MsrPositionsY)) then - allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY - end if - if (allocated(SrcInputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsZ, kind=B8Ki) - if (.not. allocated(DstInputData%MsrPositionsZ)) then - allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%toSC)) then + LB(1:1) = lbound(SrcOutputData%toSC, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%toSC, kind=B8Ki) + if (.not. allocated(DstOutputData%toSC)) then + allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ + DstOutputData%toSC = SrcOutputData%toSC end if end subroutine -subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) - type(SrvD_InputType), intent(inout) :: InputData +subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyInput' + character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(InputData%BlPitch)) then - deallocate(InputData%BlPitch) - end if - if (allocated(InputData%ExternalBlPitchCom)) then - deallocate(InputData%ExternalBlPitchCom) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) end if - if (allocated(InputData%ExternalBlAirfoilCom)) then - deallocate(InputData%ExternalBlAirfoilCom) + if (allocated(OutputData%BlPitchCom)) then + deallocate(OutputData%BlPitchCom) end if - if (allocated(InputData%ExternalCableDeltaL)) then - deallocate(InputData%ExternalCableDeltaL) + if (allocated(OutputData%BlAirfoilCom)) then + deallocate(OutputData%BlAirfoilCom) end if - if (allocated(InputData%ExternalCableDeltaLdot)) then - deallocate(InputData%ExternalCableDeltaLdot) + if (allocated(OutputData%TBDrCon)) then + deallocate(OutputData%TBDrCon) end if - if (allocated(InputData%fromSC)) then - deallocate(InputData%fromSC) + if (allocated(OutputData%Lidar)) then + deallocate(OutputData%Lidar) end if - if (allocated(InputData%fromSCglob)) then - deallocate(InputData%fromSCglob) + if (allocated(OutputData%CableDeltaL)) then + deallocate(OutputData%CableDeltaL) end if - if (allocated(InputData%Lidar)) then - deallocate(InputData%Lidar) + if (allocated(OutputData%CableDeltaLdot)) then + deallocate(OutputData%CableDeltaLdot) end if - call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InputData%BStCMotionMesh)) then - LB(1:2) = lbound(InputData%BStCMotionMesh, kind=B8Ki) - UB(1:2) = ubound(InputData%BStCMotionMesh, kind=B8Ki) + if (allocated(OutputData%BStCLoadMesh)) then + LB(1:2) = lbound(OutputData%BStCLoadMesh, kind=B8Ki) + UB(1:2) = ubound(OutputData%BStCLoadMesh, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do - deallocate(InputData%BStCMotionMesh) + deallocate(OutputData%BStCLoadMesh) end if - if (allocated(InputData%NStCMotionMesh)) then - LB(1:1) = lbound(InputData%NStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InputData%NStCMotionMesh, kind=B8Ki) + if (allocated(OutputData%NStCLoadMesh)) then + LB(1:1) = lbound(OutputData%NStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%NStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InputData%NStCMotionMesh) + deallocate(OutputData%NStCLoadMesh) end if - if (allocated(InputData%TStCMotionMesh)) then - LB(1:1) = lbound(InputData%TStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InputData%TStCMotionMesh, kind=B8Ki) + if (allocated(OutputData%TStCLoadMesh)) then + LB(1:1) = lbound(OutputData%TStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%TStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InputData%TStCMotionMesh) + deallocate(OutputData%TStCLoadMesh) end if - if (allocated(InputData%SStCMotionMesh)) then - LB(1:1) = lbound(InputData%SStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InputData%SStCMotionMesh, kind=B8Ki) + if (allocated(OutputData%SStCLoadMesh)) then + LB(1:1) = lbound(OutputData%SStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%SStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InputData%SStCMotionMesh) - end if - if (allocated(InputData%LidSpeed)) then - deallocate(InputData%LidSpeed) - end if - if (allocated(InputData%MsrPositionsX)) then - deallocate(InputData%MsrPositionsX) - end if - if (allocated(InputData%MsrPositionsY)) then - deallocate(InputData%MsrPositionsY) + deallocate(OutputData%SStCLoadMesh) end if - if (allocated(InputData%MsrPositionsZ)) then - deallocate(InputData%MsrPositionsZ) + if (allocated(OutputData%toSC)) then + deallocate(OutputData%toSC) end if end subroutine -subroutine SrvD_PackInput(RF, Indata) +subroutine SrvD_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF - type(SrvD_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackInput' + type(SrvD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackOutput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%BlPitch) - call RegPack(RF, InData%Yaw) - call RegPack(RF, InData%YawRate) - call RegPack(RF, InData%LSS_Spd) - call RegPack(RF, InData%HSS_Spd) - call RegPack(RF, InData%RotSpeed) - call RegPack(RF, InData%ExternalYawPosCom) - call RegPack(RF, InData%ExternalYawRateCom) - call RegPackAlloc(RF, InData%ExternalBlPitchCom) - call RegPack(RF, InData%ExternalGenTrq) - call RegPack(RF, InData%ExternalElecPwr) - call RegPack(RF, InData%ExternalHSSBrFrac) - call RegPackAlloc(RF, InData%ExternalBlAirfoilCom) - call RegPackAlloc(RF, InData%ExternalCableDeltaL) - call RegPackAlloc(RF, InData%ExternalCableDeltaLdot) - call RegPack(RF, InData%TwrAccel) - call RegPack(RF, InData%YawErr) - call RegPack(RF, InData%WindDir) - call RegPack(RF, InData%RootMyc) - call RegPack(RF, InData%YawBrTAxp) - call RegPack(RF, InData%YawBrTAyp) - call RegPack(RF, InData%LSSTipPxa) - call RegPack(RF, InData%RootMxc) - call RegPack(RF, InData%LSSTipMxa) - call RegPack(RF, InData%LSSTipMya) - call RegPack(RF, InData%LSSTipMza) - call RegPack(RF, InData%LSSTipMys) - call RegPack(RF, InData%LSSTipMzs) - call RegPack(RF, InData%YawBrMyn) - call RegPack(RF, InData%YawBrMzn) - call RegPack(RF, InData%NcIMURAxs) - call RegPack(RF, InData%NcIMURAys) - call RegPack(RF, InData%NcIMURAzs) - call RegPack(RF, InData%RotPwr) - call RegPack(RF, InData%HorWindV) - call RegPack(RF, InData%YawAngle) - call RegPack(RF, InData%LSShftFxa) - call RegPack(RF, InData%LSShftFys) - call RegPack(RF, InData%LSShftFzs) - call RegPackAlloc(RF, InData%fromSC) - call RegPackAlloc(RF, InData%fromSCglob) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%BlPitchCom) + call RegPackAlloc(RF, InData%BlAirfoilCom) + call RegPack(RF, InData%YawMom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%HSSBrTrqC) + call RegPack(RF, InData%ElecPwr) + call RegPackAlloc(RF, InData%TBDrCon) call RegPackAlloc(RF, InData%Lidar) - call MeshPack(RF, InData%PtfmMotionMesh) - call RegPack(RF, allocated(InData%BStCMotionMesh)) - if (allocated(InData%BStCMotionMesh)) then - call RegPackBounds(RF, 2, lbound(InData%BStCMotionMesh, kind=B8Ki), ubound(InData%BStCMotionMesh, kind=B8Ki)) - LB(1:2) = lbound(InData%BStCMotionMesh, kind=B8Ki) - UB(1:2) = ubound(InData%BStCMotionMesh, kind=B8Ki) + call RegPackAlloc(RF, InData%CableDeltaL) + call RegPackAlloc(RF, InData%CableDeltaLdot) + call RegPack(RF, allocated(InData%BStCLoadMesh)) + if (allocated(InData%BStCLoadMesh)) then + call RegPackBounds(RF, 2, lbound(InData%BStCLoadMesh, kind=B8Ki), ubound(InData%BStCLoadMesh, kind=B8Ki)) + LB(1:2) = lbound(InData%BStCLoadMesh, kind=B8Ki) + UB(1:2) = ubound(InData%BStCLoadMesh, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BStCMotionMesh(i1,i2)) + call MeshPack(RF, InData%BStCLoadMesh(i1,i2)) end do end do end if - call RegPack(RF, allocated(InData%NStCMotionMesh)) - if (allocated(InData%NStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%NStCMotionMesh, kind=B8Ki), ubound(InData%NStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%NStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%NStCMotionMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%NStCLoadMesh)) + if (allocated(InData%NStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%NStCLoadMesh, kind=B8Ki), ubound(InData%NStCLoadMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%NStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(InData%NStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%NStCMotionMesh(i1)) + call MeshPack(RF, InData%NStCLoadMesh(i1)) end do end if - call RegPack(RF, allocated(InData%TStCMotionMesh)) - if (allocated(InData%TStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%TStCMotionMesh, kind=B8Ki), ubound(InData%TStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%TStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%TStCMotionMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%TStCLoadMesh)) + if (allocated(InData%TStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh, kind=B8Ki), ubound(InData%TStCLoadMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%TStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(InData%TStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%TStCMotionMesh(i1)) + call MeshPack(RF, InData%TStCLoadMesh(i1)) end do end if - call RegPack(RF, allocated(InData%SStCMotionMesh)) - if (allocated(InData%SStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%SStCMotionMesh, kind=B8Ki), ubound(InData%SStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%SStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%SStCMotionMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%SStCLoadMesh)) + if (allocated(InData%SStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh, kind=B8Ki), ubound(InData%SStCLoadMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%SStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(InData%SStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%SStCMotionMesh(i1)) + call MeshPack(RF, InData%SStCLoadMesh(i1)) end do end if - call RegPackAlloc(RF, InData%LidSpeed) - call RegPackAlloc(RF, InData%MsrPositionsX) - call RegPackAlloc(RF, InData%MsrPositionsY) - call RegPackAlloc(RF, InData%MsrPositionsZ) + call RegPackAlloc(RF, InData%toSC) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackInput(RF, OutData) +subroutine SrvD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF - type(SrvD_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackInput' + type(SrvD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalYawPosCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalYawRateCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ExternalBlPitchCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalGenTrq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalElecPwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalHSSBrFrac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ExternalBlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ExternalCableDeltaL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ExternalCableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WindDir); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HorWindV); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TBDrCon); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Lidar); if (RegCheckErr(RF, RoutineName)) return - call MeshUnpack(RF, OutData%PtfmMotionMesh) ! PtfmMotionMesh - if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh + call MeshUnpack(RF, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh end do end do end if - if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) + if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%NStCMotionMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%NStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh + call MeshUnpack(RF, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh end do end if - if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) + if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%TStCMotionMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%TStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh + call MeshUnpack(RF, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh end do end if - if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) + if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%SStCMotionMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%SStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh + call MeshUnpack(RF, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh end do end if - call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_OutputType), intent(inout) :: SrcOutputData - type(SrvD_OutputType), intent(inout) :: DstOutputData +subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: SrcMiscData + type(SrvD_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg @@ -5995,387 +5792,717 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyOutput' + character(*), parameter :: RoutineName = 'SrvD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled + call SrvD_CopyBladedDLLType(SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%FirstWarn = SrcMiscData%FirstWarn + DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered + if (allocated(SrcMiscData%xd_BlPitchFilter)) then + LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) + if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then + allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter end if - if (allocated(SrcOutputData%BlPitchCom)) then - LB(1:1) = lbound(SrcOutputData%BlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlPitchCom, kind=B8Ki) - if (.not. allocated(DstOutputData%BlPitchCom)) then - allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%BStC)) then + LB(1:1) = lbound(SrcMiscData%BStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BStC, kind=B8Ki) + if (.not. allocated(DstMiscData%BStC)) then + allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcOutputData%BlAirfoilCom)) then - LB(1:1) = lbound(SrcOutputData%BlAirfoilCom, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlAirfoilCom, kind=B8Ki) - if (.not. allocated(DstOutputData%BlAirfoilCom)) then - allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%NStC)) then + LB(1:1) = lbound(SrcMiscData%NStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%NStC, kind=B8Ki) + if (.not. allocated(DstMiscData%NStC)) then + allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstOutputData%YawMom = SrcOutputData%YawMom - DstOutputData%GenTrq = SrcOutputData%GenTrq - DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC - DstOutputData%ElecPwr = SrcOutputData%ElecPwr - if (allocated(SrcOutputData%TBDrCon)) then - LB(1:1) = lbound(SrcOutputData%TBDrCon, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%TBDrCon, kind=B8Ki) - if (.not. allocated(DstOutputData%TBDrCon)) then - allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%TStC)) then + LB(1:1) = lbound(SrcMiscData%TStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%TStC, kind=B8Ki) + if (.not. allocated(DstMiscData%TStC)) then + allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%TBDrCon = SrcOutputData%TBDrCon + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcOutputData%Lidar)) then - LB(1:1) = lbound(SrcOutputData%Lidar, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Lidar, kind=B8Ki) - if (.not. allocated(DstOutputData%Lidar)) then - allocate(DstOutputData%Lidar(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%SStC)) then + LB(1:1) = lbound(SrcMiscData%SStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SStC, kind=B8Ki) + if (.not. allocated(DstMiscData%SStC)) then + allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Lidar.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%Lidar = SrcOutputData%Lidar + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcOutputData%CableDeltaL)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CableDeltaL, kind=B8Ki) - if (.not. allocated(DstOutputData%CableDeltaL)) then - allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%u_BStC)) then + LB(1:2) = lbound(SrcMiscData%u_BStC, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%u_BStC, kind=B8Ki) + if (.not. allocated(DstMiscData%u_BStC)) then + allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do end if - if (allocated(SrcOutputData%CableDeltaLdot)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CableDeltaLdot, kind=B8Ki) - if (.not. allocated(DstOutputData%CableDeltaLdot)) then - allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%u_NStC)) then + LB(1:2) = lbound(SrcMiscData%u_NStC, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%u_NStC, kind=B8Ki) + if (.not. allocated(DstMiscData%u_NStC)) then + allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do end if - if (allocated(SrcOutputData%BStCLoadMesh)) then - LB(1:2) = lbound(SrcOutputData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%BStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%BStCLoadMesh)) then - allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcMiscData%u_TStC)) then + LB(1:2) = lbound(SrcMiscData%u_TStC, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%u_TStC, kind=B8Ki) + if (.not. allocated(DstMiscData%u_TStC)) then + allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end do end if - if (allocated(SrcOutputData%NStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%NStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%NStCLoadMesh)) then - allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%u_SStC)) then + LB(1:2) = lbound(SrcMiscData%u_SStC, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%u_SStC, kind=B8Ki) + if (.not. allocated(DstMiscData%u_SStC)) then + allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%y_BStC)) then + LB(1:1) = lbound(SrcMiscData%y_BStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y_BStC, kind=B8Ki) + if (.not. allocated(DstMiscData%y_BStC)) then + allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_CopyOutput(SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcOutputData%TStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%TStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%TStCLoadMesh)) then - allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%y_NStC)) then + LB(1:1) = lbound(SrcMiscData%y_NStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y_NStC, kind=B8Ki) + if (.not. allocated(DstMiscData%y_NStC)) then + allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_CopyOutput(SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcOutputData%SStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%SStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%SStCLoadMesh)) then - allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%y_TStC)) then + LB(1:1) = lbound(SrcMiscData%y_TStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y_TStC, kind=B8Ki) + if (.not. allocated(DstMiscData%y_TStC)) then + allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%y_SStC)) then + LB(1:1) = lbound(SrcMiscData%y_SStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y_SStC, kind=B8Ki) + if (.not. allocated(DstMiscData%y_SStC)) then + allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_CopyOutput(SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcOutputData%toSC)) then - LB(1:1) = lbound(SrcOutputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%toSC, kind=B8Ki) - if (.not. allocated(DstOutputData%toSC)) then - allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%toSC = SrcOutputData%toSC - end if + call SrvD_CopyModuleMapType(SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine -subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(SrvD_OutputType), intent(inout) :: OutputData +subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' + character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + call SrvD_DestroyBladedDLLType(MiscData%dll_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%xd_BlPitchFilter)) then + deallocate(MiscData%xd_BlPitchFilter) end if - if (allocated(OutputData%BlPitchCom)) then - deallocate(OutputData%BlPitchCom) + if (allocated(MiscData%BStC)) then + LB(1:1) = lbound(MiscData%BStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%BStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BStC) end if - if (allocated(OutputData%BlAirfoilCom)) then - deallocate(OutputData%BlAirfoilCom) + if (allocated(MiscData%NStC)) then + LB(1:1) = lbound(MiscData%NStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%NStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%NStC) end if - if (allocated(OutputData%TBDrCon)) then - deallocate(OutputData%TBDrCon) + if (allocated(MiscData%TStC)) then + LB(1:1) = lbound(MiscData%TStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%TStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TStC) end if - if (allocated(OutputData%Lidar)) then - deallocate(OutputData%Lidar) + if (allocated(MiscData%SStC)) then + LB(1:1) = lbound(MiscData%SStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%SStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%SStC) end if - if (allocated(OutputData%CableDeltaL)) then - deallocate(OutputData%CableDeltaL) + if (allocated(MiscData%u_BStC)) then + LB(1:2) = lbound(MiscData%u_BStC, kind=B8Ki) + UB(1:2) = ubound(MiscData%u_BStC, kind=B8Ki) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_BStC) end if - if (allocated(OutputData%CableDeltaLdot)) then - deallocate(OutputData%CableDeltaLdot) + if (allocated(MiscData%u_NStC)) then + LB(1:2) = lbound(MiscData%u_NStC, kind=B8Ki) + UB(1:2) = ubound(MiscData%u_NStC, kind=B8Ki) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_NStC) end if - if (allocated(OutputData%BStCLoadMesh)) then - LB(1:2) = lbound(OutputData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(OutputData%BStCLoadMesh, kind=B8Ki) + if (allocated(MiscData%u_TStC)) then + LB(1:2) = lbound(MiscData%u_TStC, kind=B8Ki) + UB(1:2) = ubound(MiscData%u_TStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) + call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do - deallocate(OutputData%BStCLoadMesh) + deallocate(MiscData%u_TStC) end if - if (allocated(OutputData%NStCLoadMesh)) then - LB(1:1) = lbound(OutputData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%NStCLoadMesh, kind=B8Ki) + if (allocated(MiscData%u_SStC)) then + LB(1:2) = lbound(MiscData%u_SStC, kind=B8Ki) + UB(1:2) = ubound(MiscData%u_SStC, kind=B8Ki) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_SStC) + end if + if (allocated(MiscData%y_BStC)) then + LB(1:1) = lbound(MiscData%y_BStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%y_BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) + call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%NStCLoadMesh) + deallocate(MiscData%y_BStC) end if - if (allocated(OutputData%TStCLoadMesh)) then - LB(1:1) = lbound(OutputData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%TStCLoadMesh, kind=B8Ki) + if (allocated(MiscData%y_NStC)) then + LB(1:1) = lbound(MiscData%y_NStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%y_NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) + call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%TStCLoadMesh) + deallocate(MiscData%y_NStC) end if - if (allocated(OutputData%SStCLoadMesh)) then - LB(1:1) = lbound(OutputData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%SStCLoadMesh, kind=B8Ki) + if (allocated(MiscData%y_TStC)) then + LB(1:1) = lbound(MiscData%y_TStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%y_TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) + call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%SStCLoadMesh) + deallocate(MiscData%y_TStC) end if - if (allocated(OutputData%toSC)) then - deallocate(OutputData%toSC) + if (allocated(MiscData%y_SStC)) then + LB(1:1) = lbound(MiscData%y_SStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%y_SStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_SStC) + end if + call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SrvD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastTimeCalled) + call SrvD_PackBladedDLLType(RF, InData%dll_data) + call RegPack(RF, InData%FirstWarn) + call RegPack(RF, InData%LastTimeFiltered) + call RegPackAlloc(RF, InData%xd_BlPitchFilter) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%BStC, kind=B8Ki) + UB(1:1) = ubound(InData%BStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC, kind=B8Ki) + UB(1:1) = ubound(InData%NStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC, kind=B8Ki) + UB(1:1) = ubound(InData%TStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC, kind=B8Ki) + UB(1:1) = ubound(InData%SStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%SStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_BStC)) + if (allocated(InData%u_BStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_BStC, kind=B8Ki), ubound(InData%u_BStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_BStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_BStC, kind=B8Ki) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_BStC(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%u_NStC)) + if (allocated(InData%u_NStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_NStC, kind=B8Ki), ubound(InData%u_NStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_NStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_NStC, kind=B8Ki) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_NStC(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%u_TStC)) + if (allocated(InData%u_TStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_TStC, kind=B8Ki), ubound(InData%u_TStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_TStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_TStC, kind=B8Ki) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_TStC(i1,i2)) + end do + end do end if -end subroutine - -subroutine SrvD_PackOutput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SrvD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackOutput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%WriteOutput) - call RegPackAlloc(RF, InData%BlPitchCom) - call RegPackAlloc(RF, InData%BlAirfoilCom) - call RegPack(RF, InData%YawMom) - call RegPack(RF, InData%GenTrq) - call RegPack(RF, InData%HSSBrTrqC) - call RegPack(RF, InData%ElecPwr) - call RegPackAlloc(RF, InData%TBDrCon) - call RegPackAlloc(RF, InData%Lidar) - call RegPackAlloc(RF, InData%CableDeltaL) - call RegPackAlloc(RF, InData%CableDeltaLdot) - call RegPack(RF, allocated(InData%BStCLoadMesh)) - if (allocated(InData%BStCLoadMesh)) then - call RegPackBounds(RF, 2, lbound(InData%BStCLoadMesh, kind=B8Ki), ubound(InData%BStCLoadMesh, kind=B8Ki)) - LB(1:2) = lbound(InData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(InData%BStCLoadMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%u_SStC)) + if (allocated(InData%u_SStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_SStC, kind=B8Ki), ubound(InData%u_SStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_SStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_SStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BStCLoadMesh(i1,i2)) + call StC_PackInput(RF, InData%u_SStC(i1,i2)) end do end do end if - call RegPack(RF, allocated(InData%NStCLoadMesh)) - if (allocated(InData%NStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%NStCLoadMesh, kind=B8Ki), ubound(InData%NStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%NStCLoadMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%y_BStC)) + if (allocated(InData%y_BStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_BStC, kind=B8Ki), ubound(InData%y_BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%y_BStC, kind=B8Ki) + UB(1:1) = ubound(InData%y_BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%NStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_BStC(i1)) end do end if - call RegPack(RF, allocated(InData%TStCLoadMesh)) - if (allocated(InData%TStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh, kind=B8Ki), ubound(InData%TStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%TStCLoadMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%y_NStC)) + if (allocated(InData%y_NStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_NStC, kind=B8Ki), ubound(InData%y_NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%y_NStC, kind=B8Ki) + UB(1:1) = ubound(InData%y_NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%TStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_NStC(i1)) end do end if - call RegPack(RF, allocated(InData%SStCLoadMesh)) - if (allocated(InData%SStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh, kind=B8Ki), ubound(InData%SStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%SStCLoadMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%y_TStC)) + if (allocated(InData%y_TStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_TStC, kind=B8Ki), ubound(InData%y_TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%y_TStC, kind=B8Ki) + UB(1:1) = ubound(InData%y_TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%SStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_TStC(i1)) end do end if - call RegPackAlloc(RF, InData%toSC) + call RegPack(RF, allocated(InData%y_SStC)) + if (allocated(InData%y_SStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_SStC, kind=B8Ki), ubound(InData%y_SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%y_SStC, kind=B8Ki) + UB(1:1) = ubound(InData%y_SStC, kind=B8Ki) + do i1 = LB(1), UB(1) + call StC_PackOutput(RF, InData%y_SStC(i1)) + end do + end if + call SrvD_PackModuleMapType(RF, InData%SrvD_MeshMap) + call RegPack(RF, InData%PrevTstepNcall) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SrvD_PackContState(RF, InData%x_perturb) + call SrvD_PackContState(RF, InData%dxdt_lin) + call SrvD_PackInput(RF, InData%u_perturb) + call SrvD_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackOutput(RF, OutData) +subroutine SrvD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(SrvD_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' + type(SrvD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ElecPwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TBDrCon); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Lidar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) + call RegUnpack(RF, OutData%LastTimeCalled); if (RegCheckErr(RF, RoutineName)) return + call SrvD_UnpackBladedDLLType(RF, OutData%dll_data) ! dll_data + call RegUnpack(RF, OutData%FirstWarn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastTimeFiltered); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd_BlPitchFilter); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%SStC(i1)) ! SStC + end do + end if + if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%u_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh + call StC_UnpackInput(RF, OutData%u_BStC(i1,i2)) ! u_BStC end do end do end if - if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) + if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_NStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_NStC(i1,i2)) ! u_NStC + end do + end do + end if + if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_TStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_TStC(i1,i2)) ! u_TStC + end do + end do + end if + if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_SStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_SStC(i1,i2)) ! u_SStC + end do + end do + end if + if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%NStCLoadMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%y_BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh + call StC_UnpackOutput(RF, OutData%y_BStC(i1)) ! y_BStC end do end if - if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) + if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%TStCLoadMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%y_NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh + call StC_UnpackOutput(RF, OutData%y_NStC(i1)) ! y_NStC end do end if - if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) + if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%SStCLoadMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%y_TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh + call StC_UnpackOutput(RF, OutData%y_TStC(i1)) ! y_TStC end do end if - call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(RF, OutData%y_SStC(i1)) ! y_SStC + end do + end if + call SrvD_UnpackModuleMapType(RF, OutData%SrvD_MeshMap) ! SrvD_MeshMap + call RegUnpack(RF, OutData%PrevTstepNcall); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SrvD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call SrvD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call SrvD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SrvD_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine SrvD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -7013,5 +7140,77 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%toSC = a1*y1%toSC + a2*y2%toSC + a3*y3%toSC END IF ! check if allocated END SUBROUTINE + +function SrvD_InputMeshPointer(u, ML) result(Mesh) + type(SrvD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (SrvD_u_PtfmMotionMesh) + Mesh => u%PtfmMotionMesh + case (SrvD_u_BStCMotionMesh) + Mesh => u%BStCMotionMesh(ML%i1, ML%i2) + case (SrvD_u_NStCMotionMesh) + Mesh => u%NStCMotionMesh(ML%i1) + case (SrvD_u_TStCMotionMesh) + Mesh => u%TStCMotionMesh(ML%i1) + case (SrvD_u_SStCMotionMesh) + Mesh => u%SStCMotionMesh(ML%i1) + end select +end function + +function SrvD_InputMeshName(u, ML) result(Name) + type(SrvD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (SrvD_u_PtfmMotionMesh) + Name = "u%PtfmMotionMesh" + case (SrvD_u_BStCMotionMesh) + Name = "u%BStCMotionMesh("//trim(Num2LStr(ML%i1))//", "//trim(Num2LStr(ML%i2))//")" + case (SrvD_u_NStCMotionMesh) + Name = "u%NStCMotionMesh("//trim(Num2LStr(ML%i1))//")" + case (SrvD_u_TStCMotionMesh) + Name = "u%TStCMotionMesh("//trim(Num2LStr(ML%i1))//")" + case (SrvD_u_SStCMotionMesh) + Name = "u%SStCMotionMesh("//trim(Num2LStr(ML%i1))//")" + end select +end function + +function SrvD_OutputMeshPointer(y, ML) result(Mesh) + type(SrvD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (SrvD_y_BStCLoadMesh) + Mesh => y%BStCLoadMesh(ML%i1, ML%i2) + case (SrvD_y_NStCLoadMesh) + Mesh => y%NStCLoadMesh(ML%i1) + case (SrvD_y_TStCLoadMesh) + Mesh => y%TStCLoadMesh(ML%i1) + case (SrvD_y_SStCLoadMesh) + Mesh => y%SStCLoadMesh(ML%i1) + end select +end function + +function SrvD_OutputMeshName(y, ML) result(Name) + type(SrvD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (SrvD_y_BStCLoadMesh) + Name = "y%BStCLoadMesh("//trim(Num2LStr(ML%i1))//", "//trim(Num2LStr(ML%i2))//")" + case (SrvD_y_NStCLoadMesh) + Name = "y%NStCLoadMesh("//trim(Num2LStr(ML%i1))//")" + case (SrvD_y_TStCLoadMesh) + Name = "y%TStCLoadMesh("//trim(Num2LStr(ML%i1))//")" + case (SrvD_y_SStCLoadMesh) + Name = "y%SStCLoadMesh("//trim(Num2LStr(ML%i1))//")" + end select +end function END MODULE ServoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index b11f6b1805..bf995f37da 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -33,6 +33,8 @@ MODULE StrucCtrl_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: StC_u_Mesh = 1 ! Mesh number for StC StC_u_Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: StC_y_Mesh = 2 ! Mesh number for StC StC_y_Mesh mesh [-] ! ========= StC_InputFile ======= TYPE, PUBLIC :: StC_InputFile CHARACTER(1024) :: StCFileName !< Name of the input file; remove if there is no file [-] @@ -2300,5 +2302,49 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er y_out%MeasVel = a1*y1%MeasVel + a2*y2%MeasVel + a3*y3%MeasVel END IF ! check if allocated END SUBROUTINE + +function StC_InputMeshPointer(u, ML) result(Mesh) + type(StC_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (StC_u_Mesh) + Mesh => u%Mesh(ML%i1) + end select +end function + +function StC_InputMeshName(u, ML) result(Name) + type(StC_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (StC_u_Mesh) + Name = "u%Mesh("//trim(Num2LStr(ML%i1))//")" + end select +end function + +function StC_OutputMeshPointer(y, ML) result(Mesh) + type(StC_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (StC_y_Mesh) + Mesh => y%Mesh(ML%i1) + end select +end function + +function StC_OutputMeshName(y, ML) result(Name) + type(StC_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (StC_y_Mesh) + Name = "y%Mesh("//trim(Num2LStr(ML%i1))//")" + end select +end function END MODULE StrucCtrl_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index a84a27d839..2cb3db4c1c 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -33,6 +33,11 @@ MODULE SubDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: SD_u_TPMesh = 1 ! Mesh number for SD SD_u_TPMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SD_u_LMesh = 2 ! Mesh number for SD SD_u_LMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SD_y_Y1Mesh = 3 ! Mesh number for SD SD_y_Y1Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SD_y_Y2Mesh = 4 ! Mesh number for SD SD_y_Y2Mesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SD_y_Y3Mesh = 5 ! Mesh number for SD SD_y_Y3Mesh mesh [-] ! ========= IList ======= TYPE, PUBLIC :: IList INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: List !< List of integers [-] @@ -4401,5 +4406,61 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function SD_InputMeshPointer(u, ML) result(Mesh) + type(SD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (SD_u_TPMesh) + Mesh => u%TPMesh + case (SD_u_LMesh) + Mesh => u%LMesh + end select +end function + +function SD_InputMeshName(u, ML) result(Name) + type(SD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (SD_u_TPMesh) + Name = "u%TPMesh" + case (SD_u_LMesh) + Name = "u%LMesh" + end select +end function + +function SD_OutputMeshPointer(y, ML) result(Mesh) + type(SD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (SD_y_Y1Mesh) + Mesh => y%Y1Mesh + case (SD_y_Y2Mesh) + Mesh => y%Y2Mesh + case (SD_y_Y3Mesh) + Mesh => y%Y3Mesh + end select +end function + +function SD_OutputMeshName(y, ML) result(Name) + type(SD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (SD_y_Y1Mesh) + Name = "y%Y1Mesh" + case (SD_y_Y2Mesh) + Name = "y%Y2Mesh" + case (SD_y_Y3Mesh) + Name = "y%Y3Mesh" + end select +end function END MODULE SubDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 1b5fd5b28e..c8e57f390b 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -644,5 +644,41 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) END IF END IF END SUBROUTINE + +function SC_DX_InputMeshPointer(u, ML) result(Mesh) + type(SC_DX_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SC_DX_InputMeshName(u, ML) result(Name) + type(SC_DX_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function SC_DX_OutputMeshPointer(y, ML) result(Mesh) + type(SC_DX_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SC_DX_OutputMeshName(y, ML) result(Name) + type(SC_DX_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE SCDataEx_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 8da3781664..a892eac222 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -1789,5 +1789,41 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%fromSC = a1*y1%fromSC + a2*y2%fromSC + a3*y3%fromSC END IF ! check if allocated END SUBROUTINE + +function SC_InputMeshPointer(u, ML) result(Mesh) + type(SC_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SC_InputMeshName(u, ML) result(Name) + type(SC_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function SC_OutputMeshPointer(y, ML) result(Mesh) + type(SC_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function SC_OutputMeshName(y, ML) result(Name) + type(SC_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE SuperController_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 54046decbb..8e8b1d12c0 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -33,13 +33,13 @@ MODULE WakeDynamics_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_RotDiam = 1 ! Wake diameter calculation model: rotor diameter [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_Velocity = 2 ! Wake diameter calculation model: velocity-based [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MassFlux = 3 ! Wake diameter calculation model: mass-flux based [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MtmFlux = 4 ! Wake diameter calculation model: momentum-flux based [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Polar = 1 ! Wake model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Curl = 2 ! Wake model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Cartesian = 3 ! Wake model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_RotDiam = 1 ! Wake diameter calculation model: rotor diameter [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_Velocity = 2 ! Wake diameter calculation model: velocity-based [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MassFlux = 3 ! Wake diameter calculation model: mass-flux based [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MtmFlux = 4 ! Wake diameter calculation model: momentum-flux based [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Polar = 1 ! Wake model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Curl = 2 ! Wake model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Cartesian = 3 ! Wake model [-] ! ========= WD_InputFileType ======= TYPE, PUBLIC :: WD_InputFileType REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [>0.0] [m] @@ -1847,5 +1847,41 @@ subroutine WD_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%x_plane); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WAT_k_mt); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function WD_InputMeshPointer(u, ML) result(Mesh) + type(WD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function WD_InputMeshName(u, ML) result(Name) + type(WD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function WD_OutputMeshPointer(y, ML) result(Mesh) + type(WD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function WD_OutputMeshName(y, ML) result(Name) + type(WD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE WakeDynamics_Types !ENDOFREGISTRYGENERATEDFILE From 81dc1d31ab3ce79d2d497ed1de04959afa8bbd96 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 8 Feb 2024 22:38:40 +0000 Subject: [PATCH 049/319] Reworked many routines in ModVar.f90 Most changes to support variable indexing, some to fix rotation handling to match existing code --- modules/nwtc-library/src/ModVar.f90 | 414 ++++++++++++++-------------- 1 file changed, 214 insertions(+), 200 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 9e2d5ee4fe..72a58907a7 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -29,14 +29,14 @@ module ModVar implicit none private -public :: MV_InitVarsLin, MV_Pack, MV_Unpack +public :: MV_InitVarsJac, MV_Pack, MV_Unpack public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff public :: MV_AddVar, MV_AddMeshVar, MV_AddModule -public :: SetFlags, UnsetFlags, MV_NumVars +public :: MV_HasFlags, MV_SetFlags, MV_UnsetFlags, MV_NumVars public :: LoadFields, MotionFields, TransFields, AngularFields public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_rvec, wm_from_rvec public :: MV_FieldString, IdxStr -public :: MV_InitLinArrays, MV_InitVarIdx +public :: MV_InitVarIdx integer(IntKi), parameter :: & LoadFields(*) = [VF_Force, VF_Moment], & @@ -45,14 +45,14 @@ module ModVar MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc] interface MV_Pack - module procedure MV_PackVarR4, MV_PackVarR4Ary - module procedure MV_PackVarR8, MV_PackVarR8Ary + module procedure MV_PackVarRank0R4, MV_PackVarRank1R4, MV_PackVarRank2R4 + module procedure MV_PackVarRank0R8, MV_PackVarRank1R8, MV_PackVarRank2R8 module procedure MV_PackMesh end interface interface MV_Unpack - module procedure MV_UnpackVarR4, MV_UnpackVarR4Ary - module procedure MV_UnpackVarR8, MV_UnpackVarR8Ary + module procedure MV_UnpackVarRank0R4, MV_UnpackVarRank1R4, MV_UnpackVarRank2R4 + module procedure MV_UnpackVarRank0R8, MV_UnpackVarRank1R8, MV_UnpackVarRank2R8 module procedure MV_UnpackMesh end interface @@ -85,29 +85,56 @@ function MV_FieldString(Field) result(str) end select end function -subroutine MV_InitVarsLin(Vars, Lin, Linearize, ErrStat, ErrMsg) - type(ModVarsType), intent(inout) :: Vars - type(ModLinType), intent(inout) :: Lin - logical, intent(in) :: Linearize - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg +subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) + type(ModVarsType), pointer, intent(inout) :: Vars + type(ModJacType), intent(inout) :: Jac + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'MV_InitVarsLin' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, StartIndex + character(*), parameter :: RoutineName = 'MV_InitVarsLin' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, StartIndex + type(VarsIdxType), pointer :: VarIdx ! Initialize error outputs ErrStat = ErrID_None ErrMsg = '' - ! Initialize state variables + ! Initialize number of variables in each group + Vars%Nx = 0 + Vars%Nxd = 0 + Vars%Nz = 0 + Vars%Nu = 0 + Vars%Ny = 0 + + ! Initialize continuous state variables if (.not. allocated(Vars%x)) allocate (Vars%x(0)) StartIndex = 1 do i = 1, size(Vars%x) call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2) if (Failed()) return end do + Vars%Nx = sum(Vars%x%Num) + + ! Initialize discrete state variables + if (.not. allocated(Vars%xd)) allocate (Vars%xd(0)) + StartIndex = 1 + do i = 1, size(Vars%xd) + call ModVarType_Init(Vars%xd(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + end do + Vars%Nxd = sum(Vars%xd%Num) + + ! Initialize constraint state variables + if (.not. allocated(Vars%z)) allocate (Vars%z(0)) + StartIndex = 1 + do i = 1, size(Vars%z) + call ModVarType_Init(Vars%z(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + end do + Vars%Nz = sum(Vars%z%Num) ! Initialize input variables if (.not. allocated(Vars%u)) allocate (Vars%u(0)) @@ -116,6 +143,7 @@ subroutine MV_InitVarsLin(Vars, Lin, Linearize, ErrStat, ErrMsg) call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2) if (Failed()) return end do + Vars%Nu = sum(Vars%u%Num) ! Initialize output variables if (.not. allocated(Vars%y)) allocate (Vars%y(0)) @@ -124,31 +152,34 @@ subroutine MV_InitVarsLin(Vars, Lin, Linearize, ErrStat, ErrMsg) call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2) if (Failed()) return end do - - ! Calculate number of state, input, and output variables - Vars%Nx = sum(Vars%x%Num) - Vars%Nu = sum(Vars%u%Num) Vars%Ny = sum(Vars%y%Num) - ! Allocate state, state derivative, input, and output arrays - call AllocAry(Lin%x, Vars%Nx, "Vals%x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%dx, Vars%Nx, "Vals%dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%u, Vars%Nu, "Vals%u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%y, Vars%Ny, "Vals%y", ErrStat2, ErrMsg2); if (Failed()) return - - ! Allocate perturbation and +/- arrays - call AllocAry(Lin%u_perturb, Vars%Nu, "Vals%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%x_perturb, Vars%Nx, "Vals%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%x_pos, Vars%Nx, "Vals%x_pos", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%x_neg, Vars%Nx, "Vals%x_neg", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%y_pos, Vars%Ny, "Vals%y_pos", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%y_neg, Vars%Ny, "Vals%y_neg", ErrStat2, ErrMsg2); if (Failed()) return - - ! Allocate Jacobian matrices - call AllocAry(Lin%dYdu, Vars%Ny, Vars%Nu, "Lin%dYdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%dXdu, Vars%Nx, Vars%Nu, "Lin%dXdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%dYdx, Vars%Ny, Vars%Nx, "Lin%dYdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Lin%dXdx, Vars%Nx, Vars%Nx, "Lin%dXdx", ErrStat2, ErrMsg2); if (Failed()) return + ! Initialize full linearization variable indexing (all variables) + call MV_InitVarIdx(Vars, Vars%IdxLin, VF_None, ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate arrays + if (Vars%Nx > 0) then + call AllocAry(Jac%x, Vars%Nx, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%dx, Vars%Nx, "Lin%dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_perturb, Vars%Nx, "Lin%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_pos, Vars%Nx, "Lin%x_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_neg, Vars%Nx, "Lin%x_neg", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Vars%Nxd > 0) then + call AllocAry(Jac%xd, Vars%Nxd, "Lin%xd", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Vars%Nz > 0) then + call AllocAry(Jac%z, Vars%Nz, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Vars%Nu > 0) then + call AllocAry(Jac%u, Vars%Nu, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%u_perturb, Vars%Nu, "Lin%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Vars%Ny > 0) then + call AllocAry(Jac%y, Vars%Ny, "Lin%y", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%y_pos, Vars%Ny, "Lin%y_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%y_neg, Vars%Ny, "Lin%y_neg", ErrStat2, ErrMsg2); if (Failed()) return + end if contains @@ -196,7 +227,7 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! If this variable belongs to a mesh - if (iand(Var%Flags, VF_Mesh) > 0) then + if (MV_HasFlags(Var, VF_Mesh)) then ! Size is the number of nodes in a mesh Var%Nodes = Var%Num @@ -209,7 +240,7 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) ! Set unit description for line mesh UnitDesc = '' - if (iand(Var%Flags, VF_Line) > 0) UnitDesc = "/m" + if (MV_HasFlags(Var, VF_Line)) UnitDesc = "/m" ! Switch based on field number select case (Var%Field) @@ -301,43 +332,68 @@ subroutine MV_PackMatrix(RowVarAry, ColVarAry, FlagFilter, M, SubM) end do end subroutine -subroutine MV_PackVarR4(VarAry, iVar, Val, Ary) +subroutine MV_PackVarRank0R4(VarAry, iVar, Val, Ary) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar real(R4Ki), intent(in) :: Val real(R8Ki), intent(inout) :: Ary(:) + if (iVar == 0) return Ary(VarAry(iVar)%iLoc(1)) = real(Val, R8Ki) end subroutine -subroutine MV_PackVarR8(VarAry, iVar, Val, Ary) +subroutine MV_PackVarRank0R8(VarAry, iVar, Val, Ary) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Val real(R8Ki), intent(inout) :: Ary(:) + if (iVar == 0) return Ary(VarAry(iVar)%iLoc(1)) = Val end subroutine -subroutine MV_PackVarR4Ary(VarAry, iVar, Val, Ary) +subroutine MV_PackVarRank1R4(VarAry, iVar, Vals, Ary) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar - real(R4Ki), intent(in) :: Val(:) + real(R4Ki), intent(in) :: Vals(:) real(R8Ki), intent(inout) :: Ary(:) associate (iLoc => VarAry(iVar)%iLoc) - Ary(iLoc(1):iLoc(2)) = real(Val, R8Ki) + Ary(iLoc(1):iLoc(2)) = real(Vals, R8Ki) end associate end subroutine -subroutine MV_PackVarR8Ary(VarAry, iVar, Vals, Ary) +subroutine MV_PackVarRank1R8(VarAry, iVar, Vals, Ary) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Vals(:) real(R8Ki), intent(inout) :: Ary(:) + if (iVar == 0) return associate (iLoc => VarAry(iVar)%iLoc) Ary(iLoc(1):iLoc(2)) = Vals end associate end subroutine -subroutine MV_UnpackVarR4(VarAry, iVar, Ary, Val) +subroutine MV_PackVarRank2R4(VarAry, iVar, Vals, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(in) :: iVar + real(R4Ki), intent(in) :: Vals(:, :) + real(R8Ki), intent(inout) :: Ary(:) + if (iVar == 0) return + associate (iLoc => VarAry(iVar)%iLoc) + Ary(iLoc(1):iLoc(2)) = pack(real(Vals, R8Ki), .true.) + end associate +end subroutine + +subroutine MV_PackVarRank2R8(VarAry, iVar, Vals, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(in) :: iVar + real(R8Ki), intent(in) :: Vals(:, :) + real(R8Ki), intent(inout) :: Ary(:) + if (iVar == 0) return + associate (iLoc => VarAry(iVar)%iLoc) + Ary(iLoc(1):iLoc(2)) = pack(Vals, .true.) + end associate +end subroutine + +subroutine MV_UnpackVarRank0R4(VarAry, iVar, Ary, Val) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Ary(:) @@ -345,31 +401,55 @@ subroutine MV_UnpackVarR4(VarAry, iVar, Ary, Val) Val = Ary(VarAry(iVar)%iLoc(1)) end subroutine -subroutine MV_UnpackVarR4Ary(VarAry, iVar, Ary, Vals) +subroutine MV_UnpackVarRank0R8(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(in) :: iVar + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals + Vals = Ary(VarAry(iVar)%iLoc(1)) +end subroutine + +subroutine MV_UnpackVarRank1R4(VarAry, iVar, Ary, Vals) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Ary(:) real(R4Ki), intent(inout) :: Vals(:) + if (iVar == 0) return associate (iLoc => VarAry(iVar)%iLoc) Vals = real(Ary(iLoc(1):iLoc(2)), R4Ki) end associate end subroutine -subroutine MV_UnpackVarR8(VarAry, iVar, Ary, Vals) +subroutine MV_UnpackVarRank1R8(VarAry, iVar, Ary, Vals) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals - Vals = Ary(VarAry(iVar)%iLoc(1)) + real(R8Ki), intent(inout) :: Vals(:) + if (iVar == 0) return + associate (iLoc => VarAry(iVar)%iLoc) + Vals = Ary(iLoc(1):iLoc(2)) + end associate end subroutine -subroutine MV_UnpackVarR8Ary(VarAry, iVar, Ary, Vals) +subroutine MV_UnpackVarRank2R4(VarAry, iVar, Ary, Vals) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:) + real(R4Ki), intent(inout) :: Vals(:, :) + if (iVar == 0) return associate (iLoc => VarAry(iVar)%iLoc) - Vals = Ary(iLoc(1):iLoc(2)) + Vals = reshape(real(Ary(iLoc(1):iLoc(2)), R4Ki), shape(Vals)) + end associate +end subroutine + +subroutine MV_UnpackVarRank2R8(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(in) :: iVar + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:, :) + if (iVar == 0) return + associate (iLoc => VarAry(iVar)%iLoc) + Vals = reshape(Ary(iLoc(1):iLoc(2)), shape(Vals)) end associate end subroutine @@ -379,6 +459,7 @@ subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) type(MeshType), intent(in) :: Mesh real(R8Ki), intent(inout) :: Values(:) integer(IntKi) :: MeshID, i, j + if (iVar == 0) return MeshID = VarAry(iVar)%MeshID do i = iVar, size(VarAry) if (VarAry(i)%MeshID /= MeshID) exit @@ -460,7 +541,7 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) PerturbAry = BaseAry ! Get variable perturbation and combine with sign - Perturb = Var%Perturb*real(PerturbSign, R8Ki) + Perturb = Var%Perturb*real(PerturbSign, R8Ki) ! Index of perturbation value in array i = Var%iLoc(1) + iLin - 1 @@ -485,7 +566,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) real(R8Ki), intent(in) :: NegAry(:) ! Negative result array real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference integer(IntKi) :: i, j, k - real(R8Ki) :: DeltaWM(3), R(3,3), C1(3), C2(3) + real(R8Ki) :: DeltaWM(3), R(3, 3), C1(3), C2(3) ! Loop through variables do i = 1, size(VarAry) @@ -607,22 +688,22 @@ subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, end subroutine -subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, VarIdx, Flags, Perturbs, Active) +subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs, VarIdx, Active) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Fields(:) type(MeshType), intent(inout) :: Mesh - integer(IntKi), intent(out) :: VarIdx integer(IntKi), optional, intent(in) :: Flags real(R8Ki), optional, intent(in) :: Perturbs(:) + integer(IntKi), optional, intent(out) :: VarIdx logical, optional, intent(in) :: Active integer(IntKi) :: FlagsLocal logical :: ActiveLocal real(R8Ki), allocatable :: PerturbsLocal(:) integer(IntKi) :: i, idx - ! Initialize variable index, in case variable is not active - VarIdx = 0 + ! Initialize variable index (variable is not active or mesh is not commited) + if (present(VarIdx)) VarIdx = 0 ! If active argument specified and not active, return if (present(Active)) then @@ -632,15 +713,15 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, VarIdx, Flags, Perturbs, Ac ! If mesh has not been committed, return if (.not. Mesh%committed) return - ! Set variable index + ! Set mesh ID if (allocated(VarAry)) then - VarIdx = size(VarAry) + 1 + Mesh%ID = size(VarAry) + 1 else - VarIdx = 1 + Mesh%ID = 1 end if - ! Set mesh ID based on variable index - Mesh%ID = VarIdx + ! If present, set variable index from mesh ID + if (present(VarIdx)) VarIdx = Mesh%ID ! Apply flags if specified FlagsLocal = VF_Mesh @@ -664,25 +745,26 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, VarIdx, Flags, Perturbs, Ac end do end subroutine -subroutine MV_AddVar(VarAry, Name, Field, VarIdx, Num, Flags, iUsr, jUsr, DerivOrder, Perturb, LinNames, Active) +subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Perturb, LinNames, VarIdx, Active) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Field - integer(IntKi), intent(out) :: VarIdx integer(IntKi), optional, intent(in) :: Num, Flags, iUsr, jUsr real(R8Ki), optional, intent(in) :: Perturb integer(IntKi), optional, intent(in) :: DerivOrder character(*), optional, intent(in) :: LinNames(:) + integer(IntKi), optional, intent(out) :: VarIdx logical, optional, intent(in) :: Active integer(IntKi) :: i type(ModVarType) :: Var - ! Initialize variable index, in case variable is not active - VarIdx = 0 - ! If active argument specified and not active, return if (present(Active)) then - if (.not. Active) return + if (.not. Active) then + ! Set variable index to zero if present + if (present(VarIdx)) VarIdx = 0 + return + end if end if ! Initialize var with default values @@ -725,75 +807,12 @@ subroutine MV_AddVar(VarAry, Name, Field, VarIdx, Num, Flags, iUsr, jUsr, DerivO end if ! Set variable index if present - VarIdx = size(VarAry) -end subroutine - -subroutine MV_InitLinArrays(Vars, DerivOrder, LinNames_x, RotFrame_x, DerivOrder_x, & - LinNames_u, RotFrame_u, IsLoad_u, & - LinNames_y, RotFrame_y, ErrStat, ErrMsg) - type(ModVarsType), intent(in) :: Vars - integer(IntKi), intent(in) :: DerivOrder - character(LinChanLen), allocatable, intent(inout) :: LinNames_x(:) - logical, allocatable, intent(inout) :: RotFrame_x(:) - integer(IntKi), allocatable, intent(inout) :: DerivOrder_x(:) - character(LinChanLen), allocatable, intent(inout) :: LinNames_u(:) - logical, allocatable, intent(inout) :: RotFrame_u(:) - logical, allocatable, intent(inout) :: IsLoad_u(:) - character(LinChanLen), allocatable, intent(inout) :: LinNames_y(:) - logical, allocatable, intent(inout) :: RotFrame_y(:) - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'PopulateLinArrays' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(ModDataType) :: ModData - integer(IntKi) :: i - - ! State Variables - call AllocAry(LinNames_x, Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(RotFrame_x, Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(DerivOrder_x, Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return - DerivOrder_x = DerivOrder - do i = 1, size(Vars%x) - associate (Var => Vars%x(i), iLoc => Vars%x(i)%iLoc) - LinNames_x(iLoc(1):iLoc(2)) = Var%LinNames - RotFrame_x(iLoc(1):iLoc(2)) = iand(Var%Flags, VF_RotFrame) > 0 - end associate - end do - - ! Input Variables - call AllocAry(LinNames_u, Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(RotFrame_u, Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(IsLoad_u, Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return - do i = 1, size(Vars%u) - associate (Var => Vars%u(i), iLoc => Vars%u(i)%iLoc) - LinNames_u(iLoc(1):iLoc(2)) = Var%LinNames - RotFrame_u(iLoc(1):iLoc(2)) = iand(Var%Flags, VF_RotFrame) > 0 - IsLoad_u(iLoc(1):iLoc(2)) = iand(Var%Field, VF_Force + VF_Moment) > 0 - end associate - end do - - ! Output variables - call AllocAry(LinNames_y, Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(RotFrame_y, Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return - do i = 1, size(Vars%y) - associate (Var => Vars%y(i), iLoc => Vars%y(i)%iLoc) - LinNames_y(iLoc(1):iLoc(2)) = Var%LinNames - RotFrame_y(iLoc(1):iLoc(2)) = iand(Var%Flags, VF_RotFrame) > 0 - end associate - end do - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function + if (present(VarIdx)) VarIdx = size(VarAry) end subroutine -subroutine MV_InitVarIdx(Vars, Idx, FlagFilter, ErrStat, ErrMsg) +subroutine MV_InitVarIdx(Vars, VarIdx, FlagFilter, ErrStat, ErrMsg) type(ModVarsType), intent(in) :: Vars - type(VarsIdxType), intent(out) :: Idx + type(VarsIdxType), intent(out) :: VarIdx integer(IntKi), intent(in) :: FlagFilter integer(IntKi), intent(out) :: ErrStat character(ErrMsgLen), intent(out) :: ErrMsg @@ -802,54 +821,37 @@ subroutine MV_InitVarIdx(Vars, Idx, FlagFilter, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 type(ModDataType) :: ModData - integer(IntKi) :: i, j, k + integer(IntKi) :: ivar, inum + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" ! Save filter in index - Idx%FlagFilter = FlagFilter + VarIdx%FlagFilter = FlagFilter ! Get number of filtered variables - Idx%Nx = MV_NumVars(Vars%x, FlagFilter) - Idx%Nu = MV_NumVars(Vars%u, FlagFilter) - Idx%Ny = MV_NumVars(Vars%y, FlagFilter) + VarIdx%Nx = MV_NumVars(Vars%x, FlagFilter) + VarIdx%Nu = MV_NumVars(Vars%u, FlagFilter) + VarIdx%Ny = MV_NumVars(Vars%y, FlagFilter) ! Allocate index arrays - call AllocAry(Idx%ix, Idx%Nx, "ix", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Idx%idx, Idx%Nx, "idx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Idx%iu, Idx%Nu, "iu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Idx%iy, Idx%Ny, "iy", ErrStat2, ErrMsg2); if (Failed()) return - - ! Get indices for state variables - k = 1 - do i = 1, size(Vars%x) - if ((FlagFilter /= VF_None) .and. (iand(Vars%x(i)%Flags, FlagFilter) == 0)) cycle - do j = 0, Vars%x(i)%Num - 1 - Idx%ix(k + j) = Vars%x(i)%iLoc(1) + j - end do - k = k + Vars%x(i)%Num - end do + call AllocAry(VarIdx%ix, VarIdx%Nx, "ix", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(VarIdx%idx, VarIdx%Nx, "idx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(VarIdx%ixd, VarIdx%Nxd, "ixd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(VarIdx%iz, VarIdx%Nz, "iz", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(VarIdx%iu, VarIdx%Nu, "iu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(VarIdx%iy, VarIdx%Ny, "iy", ErrStat2, ErrMsg2); if (Failed()) return + + ! Get filtered value indices + call GetIndices(Vars%x, VarIdx%ix, FlagFilter) + call GetIndices(Vars%xd, VarIdx%ixd, FlagFilter) + call GetIndices(Vars%z, VarIdx%iz, FlagFilter) + call GetIndices(Vars%u, VarIdx%iu, FlagFilter) + call GetIndices(Vars%y, VarIdx%iy, FlagFilter) ! Copy state variable indices to state variable derivative indices - Idx%idx = Idx%ix - - ! Get indices for input variables - k = 1 - do i = 1, size(Vars%u) - if ((FlagFilter /= VF_None) .and. (iand(Vars%u(i)%Flags, FlagFilter) == 0)) cycle - do j = 0, Vars%u(i)%Num - 1 - Idx%iu(k + j) = Vars%u(i)%iLoc(1) + j - end do - k = k + Vars%u(i)%Num - end do - - ! Get indices for output variables - k = 1 - do i = 1, size(Vars%y) - if ((FlagFilter /= VF_None) .and. (iand(Vars%y(i)%Flags, FlagFilter) == 0)) cycle - do j = 0, Vars%y(i)%Num - 1 - Idx%iy(k + j) = Vars%y(i)%iLoc(1) + j - end do - k = k + Vars%y(i)%Num - end do + VarIdx%idx = VarIdx%ix contains logical function Failed() @@ -858,6 +860,21 @@ logical function Failed() end function end subroutine +subroutine GetIndices(VarAry, Indices, Mask) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(in) :: Mask + integer(IntKi), intent(inout) :: Indices(:) + integer(IntKi) :: i, j, k + k = 1 + do i = 1, size(VarAry) + if (.not. MV_HasFlags(VarAry(i), Mask)) cycle + do j = 0, VarAry(i)%Num - 1 + Indices(k) = VarAry(i)%iLoc(1) + j + k = k + 1 + end do + end do +end subroutine + function MV_NumVars(VarAry, FlagFilter) result(Num) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), optional, intent(in) :: FlagFilter @@ -876,18 +893,24 @@ function MV_NumVars(VarAry, FlagFilter) result(Num) ! Flag Utilities !------------------------------------------------------------------------------- -subroutine SetFlags(Flags, Mask) - integer(IntKi), intent(inout) :: Flags - integer(IntKi), intent(in) :: Mask +pure logical function MV_HasFlags(Var, Flags) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: Flags + MV_HasFlags = iand(Var%Flags, Flags) == Flags +end function + +subroutine MV_SetFlags(Var, Flags) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(in) :: Flags integer(IntKi) :: i - Flags = ior(Flags, Mask) + Var%Flags = ior(Var%Flags, Flags) end subroutine -subroutine UnsetFlags(Flags, Mask) - integer(IntKi), intent(inout) :: Flags - integer(IntKi), intent(in) :: Mask +subroutine MV_UnsetFlags(Var, Flags) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(in) :: Flags integer(IntKi) :: i - Flags = iand(Flags, not(Mask)) + Var%Flags = iand(Var%Flags, not(Flags)) end subroutine !------------------------------------------------------------------------------- @@ -990,16 +1013,7 @@ pure function wm_to_dcm(c) result(R) R(:, 3) = [2.0_R8Ki*(c1*c3 - c0*c2), & 2.0_R8Ki*(c2*c3 + c0*c1), & c0*c0 - c1*c1 - c2*c2 + c3*c3] - R = R / (4.0_R8Ki - c0)**2 - ! ct(1, :) = [0.0_R8Ki, -c(3), c(2)] - ! ct(2, :) = [c(3), 0.0_R8Ki, -c(1)] - ! ct(3, :) = [-c(2), c(1), 0.0_R8Ki] - ! c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki - ! vc = 2.0_R8Ki/(4.0_R8Ki - c0) - ! R = vc*vc*(c0*ct + matmul(ct, ct))/2.0_R8Ki - ! do i = 1, 3 - ! R(i, i) = R(i, i) + 1.0_R8Ki - ! end do + R = R/(4.0_R8Ki - c0)**2 end function pure function wm_from_dcm(dcm) result(c) @@ -1078,9 +1092,9 @@ pure function wm_compose(p, q) result(r) D2 = p0*q0 - dot_product(p, q) r = 4.0_R8Ki*(q0*p + p0*q + cross(p, q)) if (D2 >= 0.0_R8Ki) then - r = r / (D1 + D2) + r = r/(D1 + D2) else - r = -r / (D1 - D2) + r = -r/(D1 - D2) end if end function From 9136147411b17316f0994aae7f232fc431dcb367 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 14:21:16 +0000 Subject: [PATCH 050/319] Modify AeroDyn for module variables --- modules/aerodyn/src/AeroDyn.f90 | 1447 +++++++++++++++++-------------- 1 file changed, 778 insertions(+), 669 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 00e1d954c4..0affb10da0 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -61,6 +61,10 @@ module AeroDyn ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) PUBLIC :: AD_GetOP !< Routine to pack the operating point values (for linearization) into arrays + + PUBLIC :: AD_PackStateValues, AD_UnpackStateValues + PUBLIC :: AD_PackInputValues, AD_UnpackInputValues + PUBLIC :: AD_PackOutputValues contains !---------------------------------------------------------------------------------------------------------------------------------- @@ -499,16 +503,27 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut if (allocated(p%AFI(i)%Y_Coord)) deallocate( p%AFI(i)%Y_Coord) end do end if + + + !............................................................................................ + ! Module Variables + !............................................................................................ + + do iR = 1, nRotors + call AD_InitVars(iR, u%rotors(iR), p%rotors(iR), x%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), InitOut%rotors(iR), & + InputFileData%rotors(iR), InitInp%Linearize, InitInp%CompAeroMaps, ErrStat2, ErrMsg2) + if (Failed()) return; + end do !............................................................................................ ! Initialize Jacobian: !............................................................................................ - if (InitInp%Linearize .or. InitInp%CompAeroMaps) then - do iR = 1, nRotors - call Init_Jacobian(InputFileData%rotors(iR), p%rotors(iR), p, u%rotors(iR), y%rotors(iR), m%rotors(iR), InitOut%rotors(iR), errStat2, errMsg2) - if (Failed()) return; - enddo - end if + ! if (InitInp%Linearize .or. InitInp%CompAeroMaps) then + ! do iR = 1, nRotors + ! call Init_Jacobian(InputFileData%rotors(iR), p%rotors(iR), p, u%rotors(iR), y%rotors(iR), m%rotors(iR), InitOut%rotors(iR), errStat2, errMsg2) + ! if (Failed()) return; + ! enddo + ! end if !............................................................................................ ! Print the summary file if requested: @@ -5190,13 +5205,307 @@ SUBROUTINE TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tow END SUBROUTINE TwrInfl_NearestPoint !---------------------------------------------------------------------------------------------------------------------------------- +subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileData, Linearize, CompAeroMaps, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: Rotnum !< Rotor number + type(RotInputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(RotParameterType), intent(inout) :: p !< Parameters + type(RotContinuousStateType), intent(inout) :: x !< States + type(RotConstraintStateType), intent(inout) :: z !< Constraint state type + type(RotOtherStateType), intent(inout) :: OtherState !< Other state type + type(RotOutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(RotMiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(RotInitOutputType), intent(inout) :: InitOut !< Output for initialization routine + type(RotInputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + logical, intent(in) :: CompAeroMaps !< Flag to compute aero maps + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(4) :: RotorLabel + character(64) :: NodeLabel + character(1), parameter :: UVW(3) = ['U','V','W'] + real(ReKi) :: Perturb, PerturbTower, PerturbBlade(MaxBl) + integer(IntKi) :: i, j, k + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + ! Create rotor label + RotorLabel = 'R'//trim(Num2LStr(RotNum)) + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + allocate(p%Vars%x(0)) + + ! DBEMT + if (p%BEMT%DBEMT%lin_nx/2 > 0) then + p%iVarDBEMT = 1 + do j = 1, p%NumBlades + call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & + Num=p%NumBlNds*2, & + Flags=ior(VF_DerivOrder2, VF_RotFrame), & + Perturb=2.0_ReKi * D2R, & + LinNames=[(['vind (axial) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s', & + 'vind (tangential) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s'], i = 1, p%NumBlNds)]) + end do + do j = 1, p%NumBlades + call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & + Num=p%NumBlNds*2, & + Flags=ior(VF_DerivOrder2, VF_RotFrame), & + Perturb=2.0_ReKi * D2R, & + LinNames=[(['First time derivative of vind (axial) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s/s', & + 'First time derivative of vind (tangential) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s/s'], i = 1, p%NumBlNds)]) + end do + end if + + ! Unsteady Aero + if (p%BEMT%UA%lin_nx > 0) then + p%iVarUA = size(p%Vars%x) + 1 + do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) + do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) + NodeLabel = 'blade '//trim(num2lstr(j))//', node '//trim(num2lstr(i)) + if (p%BEMT%UA%UAMod/=UA_OYE) then + call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & + Flags=ior(VF_DerivOrder1, VF_RotFrame), & + Perturb=2.0_ReKi * D2R, & + LinNames=['x1 '//trim(NodeLabel)//', rad']) + call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & + Flags=ior(VF_DerivOrder1, VF_RotFrame), & + Perturb=2.0_ReKi * D2R, & + LinNames=['x2 '//trim(NodeLabel)//', rad']) + call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & + Flags=ior(VF_DerivOrder1, VF_RotFrame), & + Perturb=2.0_ReKi * D2R, & + LinNames=['x3 '//trim(NodeLabel)//', -']) + endif + + call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & + Flags=ior(VF_DerivOrder1, VF_RotFrame), & + Perturb=0.001_ReKi, & ! x4 is a number between 0 and 1, so we need this to be small + LinNames=['x4 '//trim(NodeLabel)//', -']) + end do + end do + + end if + + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Allocate variable indices + call AllocAry(p%iVarBladeRootMotion, p%NumBlades, "iVarBladeRootMotion", ErrStat2, ErrMsg2); if (Failed()) return + p%iVarBladeRootMotion = 0 + call AllocAry(p%iVarBladeMotion, p%NumBlades, "iVarBladeMotion", ErrStat2, ErrMsg2); if (Failed()) return + p%iVarBladeMotion = 0 + call AllocAry(p%iVarInflowOnBlade, p%NumBlades, "iVarInflowOnBlade", ErrStat2, ErrMsg2); if (Failed()) return + p%iVarInflowOnBlade = 0 + call AllocAry(p%iVarUserProp, p%NumBlades, "iVarUserProp", ErrStat2, ErrMsg2); if (Failed()) return + p%iVarUserProp = 0 + + do k = 1, p%NumBlades + PerturbBlade(k) = 0.2_ReKi * D2R * InputFileData%BladeProps(k)%BlSpn(InputFileData%BladeProps(k)%NumBlNds) + end do + + if (u%TowerMotion%NNodes > 0) then + PerturbTower = 0.2_ReKi*D2R * u%TowerMotion%Position(3, u%TowerMotion%NNodes) + else + PerturbTower = 0.0_ReKi + end if + + ! Add tower motion + call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"TowerMotion", & + VarIdx=p%iVarTowerMotion, & + Mesh=u%TowerMotion, & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel], & + Perturbs=[PerturbTower, & ! VF_TransDisp + 2.0_ReKi * D2R, & ! VF_Orientation + PerturbTower]) ! VF_TransVel + + ! Add hub motion + call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"HubMotion", & + VarIdx=p%iVarHubMotion, & + Mesh=u%HubMotion, & + Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel], & + Perturbs=[PerturbBlade(1), & ! VF_TransDisp + 2.0_ReKi * D2R, & ! VF_Orientation + 2.0_ReKi * D2R]) ! VF_AngularVel + + ! Add blade root motion + do j = 1, p%NumBlades + call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"BladeRootMotion"//IdxStr(j), & + VarIdx=p%iVarBladeRootMotion(j), & + Flags=VF_Linearize, & + Mesh=u%BladeRootMotion(j), & + Fields=[VF_Orientation], & + Perturbs=[2.0_ReKi * D2R]) + end do + + ! Add blade motion + do j = 1, p%NumBlades + call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"BladeMotion"//IdxStr(j), & + VarIdx=p%iVarBladeMotion(j), & + Mesh=u%BladeMotion(j), & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc], & + Perturbs=[PerturbBlade(j), & ! VF_TransDisp + 2.0_ReKi * D2R, & ! VF_Orientation + PerturbBlade(j), & ! VF_TransVel + 2.0_ReKi * D2R, & ! VF_AngularVel + PerturbBlade(j)]) ! VF_TransAcc + ! Set AeroMap flag on subset of first blade fields + if (j == 1) then + do k = p%iVarBladeMotion(j), size(p%Vars%u) + select case (p%Vars%u(k)%Field) + case (VF_TransDisp, VF_Orientation, VF_TransVel) + call MV_SetFlags(p%Vars%u(k), VF_AeroMap) + end select + end do + end if + end do + + ! u%Bld(j)%InflowOnBlade + do j = 1, p%NumBlades + call MV_AddVar(p%Vars%u, trim(RotorLabel)//"InflowOnBlade"//IdxStr(j), VF_Scalar, & + VarIdx=p%iVarInflowOnBlade(j), & + Num=p%NumBlNds*3, & + Perturb=PerturbBlade(j), & + LinNames=[((UVW(i)//'-component inflow on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(k))//', m/s', i = 1, 3), k = 1, p%NumBlNds)]) + end do + + ! u%InflowOnTower + call MV_AddVar(p%Vars%u, trim(RotorLabel)//"InflowOnTower", VF_Scalar, & + VarIdx=p%iVarInflowOnTower, & + Num=p%NumTwrNds*3, & + Perturb=2.0_ReKi * D2R, & + LinNames=[((UVW(i)//'-component inflow on tower node '//trim(Num2LStr(j))//', m/s', i = 1, 3), j = 1, p%NumTwrNds)]) + + ! Add user props + do j = 1, p%NumBlades + call MV_AddVar(p%Vars%u, trim(RotorLabel)//"UserProp Blade"//IdxStr(k), VF_Scalar, & + VarIdx=p%iVarUserProp(j), & + Flags=VF_RotFrame, & + Num=p%NumBlNds, & + Perturb=2.0_ReKi * D2R, & + LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(k))//', -', k = 1, p%NumBlNds)]) + end do + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call AllocAry(p%iVarBladeLoad, p%NumBlades, "iVarBladeLoad", ErrStat2, ErrMsg2); if (Failed()) return + + ! Add tower load + call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"TowerLoad", LoadFields, & + VarIdx=p%iVarTowerLoad, & + Mesh=y%TowerLoad) + + ! Add nacelle load + call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"HubLoad", LoadFields, & + VarIdx=p%iVarHubLoad, & + Mesh=y%HubLoad) + + ! Add nacelle load + call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"NacelleLoad", LoadFields, & + VarIdx=p%iVarNacelleLoad, & + Mesh=y%NacelleLoad) + + ! Loop through blades, add blade loads + do j = 1, p%NumBlades + call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"BladeLoad"//IdxStr(j), LoadFields, & + VarIdx=p%iVarBladeLoad(j), & + Flags=VF_AeroMap, & + Mesh=y%BladeLoad(j)) + end do + + p%iVarWriteOutput = size(p%Vars%y) + 1 + + ! Rotor outputs + do j = 1, p%NumOuts + call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), VF_Scalar, & + Flags=VF_WriteOut + OutParamFlags(p%OutParam(j)%Indx), & + iUsr=j, & + LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) + end do + + ! Blade node outputs + do j = p%NumOuts + 1, p%NumOuts + p%BldNd_TotNumOuts + call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), VF_Scalar, & + Flags=VF_WriteOut + VF_RotFrame, & + iUsr=k, & + LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Linearization data + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(p%Vars, m%Jac, Linearize .or. CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return + + call AD_CopyRotContinuousStateType(x, m%x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotContinuousStateType(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotContinuousStateType(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOutputType(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! AeroMap + !---------------------------------------------------------------------------- + + if (CompAeroMaps) then + + ! Initialize index for variables flagged with VF_AeroMap + call MV_InitVarIdx(p%Vars, p%Vars%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2) + if (Failed()) return + + end if + +contains + + pure integer(IntKi) function OutParamFlags(ind) + integer(IntKi), intent(in) :: ind + integer(IntKi), parameter :: RotFrameInds(*) = [& + BAzimuth, BPitch, & + BNVUndx, BNVUndy, BNVUndz, BNVDisx, BNVDisy, BNVDisz, BNSTVx, BNSTVy, & + BNSTVz, BNVRel, BNDynP, BNRe, BNM, BNVIndx, BNVIndy, BNAxInd, BNTnInd, & + BNAlpha, BNTheta, BNPhi, BNCurve, BNCl, BNCd, BNCm, BNCx, BNCy, BNCn, & + BNCt, BNFl, BNFd, BNMm, BNFx, BNFy, BNFn, BNFt, BNClrnc] + if (any(RotFrameInds == ind)) then + OutParamFlags = VF_RotFrame + else + OutParamFlags = VF_None + end if + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ###### The following four routines are Jacobian routines for linearization capabilities ####### ! If the module does not implement them, set ErrStat = ErrID_Fatal in AD_Init() when InitInp%Linearize is .true. !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -5213,14 +5522,12 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - ! + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number + integer(IntKi), parameter :: iR =1 ! Rotor index if (size(p%rotors)>1) then @@ -5229,14 +5536,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM return endif - call Rot_JacobianPInput( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + call Rot_JacobianPInput( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) END SUBROUTINE AD_JacobianPInput !! respect to the inputs (u) [intent in to avoid deallocation] !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -5256,257 +5563,167 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - !! respect to the inputs (u) [intent in to avoid deallocation] - ! local variables - TYPE(RotOutputType) :: y_p - TYPE(RotOutputType) :: y_m - TYPE(RotContinuousStateType) :: x_p - TYPE(RotContinuousStateType) :: x_m - TYPE(RotContinuousStateType) :: x_init - TYPE(RotConstraintStateType) :: z_copy - TYPE(RotOtherStateType) :: OtherState_copy - TYPE(RotOtherStateType) :: OtherState_init - TYPE(RotInputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input - INTEGER(IntKi) :: i - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPInput' - - - ! Initialize ErrStat + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number + + character(*), parameter :: RoutineName = 'AD_JacobianPInput' + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + TYPE(RotOtherStateType) :: OtherState_copy + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + INTEGER(IntKi) :: i, j, col ErrStat = ErrID_None ErrMsg = '' + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if - ! get OP values here (i.e., set inputs for BEMT): - if ( p%FrozenWake ) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - ! compare m%BEMT_y arguments with call to BEMT_CalcOutput - call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT ) + ! Get OP values here (i.e., set inputs for BEMT): + if (p%FrozenWake) then + call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return + + ! compare m%BEMT_y arguments with call to BEMT_CalcOutput + call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT) m%BEMT%UseFrozenWake = .true. end if + + ! Copy inputs and pack them for perturbation + call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackInputValues(p, u, m%Jac%u) - - call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! initialize x_init so that we get accurrate values for first step - if (.not. OtherState%BEMT%nodesInitialized ) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ) ! changes values only if states haven't been initialized - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Copy continuous and other states for initialization + call AD_CopyRotContinuousStateType(x, m%x_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Initialize x_init so that we get accurrate values for first step + ! changes values only if states haven't been initialized + if (.not. OtherState%BEMT%nodesInitialized) then + call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return + call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, m%x_init%BEMT, xd%BEMT, z%BEMT, & + m%OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2); if (Failed()) return end if - - ! make a copy of the inputs to perturb - call AD_CopyRotInputType( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then - ! allocate dYdu - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! Allocate dYdu if not allocated + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! make a copy of the states to perturb - call AD_CopyRotConstraintStateType( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta_p u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get updated z%phi values: - !call AD_UpdateStates( t, 1, (/u_perturb/), (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - !bjj: this is what we want to do instead of the overkill of calling AD_UpdateStates - call SetInputs(p, p_AD, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - ! compute y at u_op + delta_p u - call RotCalcOutput( t, u_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get u_op - delta_m u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get updated z%phi values: - !call RotUpdateStates( t, 1, (/u_perturb/), (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SetInputs(p, p_AD, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num - ! compute y at u_op - delta_m u - call RotCalcOutput( t, u_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + ! Calculate positive perturbation + call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call SetInputs(p, p_AD, m%u_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return + call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcOutput(t, m%u_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + ! Calculate negative perturbation + call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call SetInputs(p, p_AD, m%u_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return + call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcOutput(t, m%u_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 - ! get central difference: - call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) - + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do + end do - + end if - if (ErrStat>=AbortErrLev) then - call cleanup() - return + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu)) then + + ! Allocate dXdu if not allocated + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if - - END IF - IF ( PRESENT( dXdu ) ) THEN + ! Loop through input variables + do i = 1, size(p%Vars%u) - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle - ! allocate dXdu if necessary - if (.not. allocated(dXdu)) then - call AllocAry(dXdu, size(p%dx), size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - ! compute x at u_op + delta u - ! note that this routine updates z%phi instead of using the actual state value, so we don't need to call UpdateStates/UpdatePhi here to get z_op + delta_z: - call RotCalcContStateDeriv( t, u_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! compute x at u_op - delta u - ! note that this routine updates z%phi instead of using the actual state value, so we don't need to call UpdateStates here to get z_op + delta_z: - call RotCalcContStateDeriv( t, u_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta_p, delta_m, dXdu(:,i) ) + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num - end do + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call RotCalcContStateDeriv(t, m%u_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return + call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - END IF + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call RotCalcContStateDeriv(t, m%u_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return + call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 - IF ( PRESENT( dXddu ) ) THEN + ! Get partial derivative via central difference and store in full linearization array + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + end do + end do + + end if + + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if - IF ( PRESENT( dZdu ) ) THEN + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if call cleanup() contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function subroutine cleanup() m%BEMT%UseFrozenWake = .false. - - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2) - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2) - call AD_DestroyRotConstraintStateType( z_copy, ErrStat2, ErrMsg2) - call AD_DestroyRotOtherStateType( OtherState_copy, ErrStat2, ErrMsg2) - call AD_DestroyRotOtherStateType( OtherState_init, ErrStat2, ErrMsg2) - - call AD_DestroyRotInputType( u_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup - -END SUBROUTINE Rot_JacobianPInput +end subroutine Rot_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -5535,8 +5752,8 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state !! functions (Z) with respect to !! the continuous states (x) [intent in to avoid deallocation] - ! - integer(IntKi), parameter :: iR =1 ! Rotor index + INTEGER, OPTIONAL, INTENT(IN ) :: FlagFilter + integer(IntKi), parameter :: iR = 1 ! Rotor index if (size(p%rotors)>1) then errStat = ErrID_Fatal @@ -5544,15 +5761,14 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, return endif - call RotJacobianPContState( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) - + call RotJacobianPContState( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter ) END SUBROUTINE AD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -5572,233 +5788,154 @@ SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_A INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - - ! local variables - TYPE(RotOutputType) :: y_p - TYPE(RotOutputType) :: y_m - TYPE(RotContinuousStateType) :: x_p - TYPE(RotContinuousStateType) :: x_m - TYPE(RotContinuousStateType) :: x_perturb - TYPE(RotContinuousStateType) :: x_init - TYPE(RotOtherStateType) :: OtherState_init - REAL(R8Ki) :: delta_p, delta_m ! delta change in state - INTEGER(IntKi) :: i - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPContState' - - - ! Initialize ErrStat - + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) [intent in to avoid deallocation] + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags + + character(*), parameter :: RoutineName = 'AD_JacobianPContState' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + integer(IntKi) :: i, j, col + + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if - if ( p%FrozenWake ) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! compare arguments with call to BEMT_CalcOutput - call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT ) + ! Get OP values here (i.e., set inputs for BEMT): + if (p%FrozenWake) then + call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return + + ! compare m%BEMT_y arguments with call to BEMT_CalcOutput + call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT) m%BEMT%UseFrozenWake = .true. end if - - call AD_CopyRotContinuousStateType( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Copy continuous and other states for initialization + call AD_CopyRotContinuousStateType(x, m%x_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! initialize x_init so that we get accurrate values for - if (.not. OtherState%BEMT%nodesInitialized ) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ) ! changes values only if states haven't been initialized - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Initialize x_init so that we get accurrate values for first step + ! changes values only if states haven't been initialized + if (.not. OtherState%BEMT%nodesInitialized) then + call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return + call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, m%x_init%BEMT, xd%BEMT, z%BEMT, & + m%OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2); if (Failed()) return end if - - - IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Copy and pack states for perturbation + call AD_CopyRotContinuousStateType(m%x_init, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackStateValues(p, m%x_init, m%Jac%x) + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then - ! allocate dYdx if necessary + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, size(p%dx), 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! Loop through state variables + do i = 1, size(p%Vars%x) - do i=1,size(p%dx) - - ! get x_op + delta_p x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_x( p, i, 1, x_perturb, delta_p ) + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num - ! compute y at x_op + delta_p x - ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcOutput( t, u, p, p_AD, x_perturb, xd, z, OtherState_init, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get x_op - delta_m x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_x( p, i, -1, x_perturb, delta_m ) - - ! compute y at x_op - delta_m x - ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcOutput( t, u, p, p_AD, x_perturb, xd, z, OtherState_init, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdx(:,i) ) - - end do - + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call RotCalcOutput( t, u, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return + call AD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call RotCalcOutput( t, u, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return + call AD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) - END IF + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 - IF ( PRESENT( dXdx ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - - ! allocate and set dXdx + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + end do + end do + + end if - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx)) then - ! allocate dXdx if necessary + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, size(p%dx), size(p%dx), 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - - - do i=1,size(p%dx,1) - - ! get x_op + delta x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_x( p, i, 1, x_perturb, delta_p ) - - ! compute X at x_op + delta x - ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcContStateDeriv( t, u, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get x_op - delta x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_x( p, i, -1, x_perturb, delta_m ) - - ! compute x at u_op - delta u - ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcContStateDeriv( t, u, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta_p, delta_m, dXdx(:,i) ) - end do + ! Loop through state variables + do i = 1, size(p%Vars%x) - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - END IF - - IF ( PRESENT( dXddx ) ) THEN + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num - ! allocate and set dXddx + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call RotCalcContStateDeriv(t, u, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) - END IF + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call RotCalcContStateDeriv(t, u, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) - IF ( PRESENT( dZdx ) ) THEN + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + end do + end do - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: + end if - ! allocate and set dZdx + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: + if (present(dXddx)) then + end if - END IF + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: + if (present(dZdx)) then + end if call cleanup() contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function subroutine cleanup() m%BEMT%UseFrozenWake = .false. - - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2) - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2) - - call AD_DestroyRotContinuousStateType( x_perturb, ErrStat2, ErrMsg2 ) - call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2 ) - call AD_DestroyRotOtherStateType( OtherState_init, ErrStat2, ErrMsg2 ) end subroutine cleanup - END SUBROUTINE RotJacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -5963,11 +6100,11 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m REAL(R8Ki) :: delta_p, delta_m ! delta change in state INTEGER(IntKi) :: i, j, k, n, k2, j2 - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP + character(*), parameter :: RoutineName = 'AD_JacobianPConstrState' integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPConstrState' + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP ! local variables @@ -6181,7 +6318,7 @@ end subroutine cleanup END SUBROUTINE RotJacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6200,7 +6337,8 @@ SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - ! + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags + integer(IntKi), parameter :: iR =1 ! Rotor index if (size(p%rotors)>1) then @@ -6209,13 +6347,13 @@ SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, return endif - call RotGetOP( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), errStat, errMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) + call RotGetOP(t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), errStat, errMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter) END SUBROUTINE AD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +SUBROUTINE RotGetOP(t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6235,269 +6373,84 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags - INTEGER(IntKi) :: index, i, j, k, n - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - TYPE(RotContinuousStateType) :: dxdt - - - ! Initialize ErrStat + CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + INTEGER(IntKi) :: ind, i, j, k, n ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( u_op ) ) THEN - nu = size(p%Jac_u_indx,1) - do i=1,p%NumBl_Lin - nu = nu + u%BladeMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do - - if (.not. p_AD%CompAeroMaps) then - nu = nu + u%TowerMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%hubMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - do i=1,p%NumBlades - nu = nu + u%BladeRootMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do - end if - - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if - index = 1 - if (.not. p_AD%CompAeroMaps) then - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - call PackMotionMesh(u%TowerMotion, u_op, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - call PackMotionMesh(u%HubMotion, u_op, index, FieldMask=FieldMask) - - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - do k = 1,p%NumBlades - call PackMotionMesh(u%BladeRootMotion(k), u_op, index, FieldMask=FieldMask) - end do - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TRANSLATIONAcc) = .true. - else - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - end if - - do k=1,p%NumBl_Lin - call PackMotionMesh(u%BladeMotion(k), u_op, index, FieldMask=FieldMask) - end do - - if (.not. p_AD%CompAeroMaps) then - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - u_op(index) = u%Bld(k)%InflowOnBlade(j,i) - index = index + 1 - end do - end do - end do + !---------------------------------------------------------------------------- - do i=1,p%NumTwrNds - do j=1,3 - u_op(index) = u%InflowOnTower(j,i) - index = index + 1 - end do - end do - ! UserProp - do k=1,p%NumBlades - do j = 1, size(u%UserProp,1) ! Number of nodes for a blade - u_op(index) = u%UserProp(j,k) - index = index + 1 - end do - end do - - ! AvgDiskVel - !do i=1,3 - ! u_op(index) = u%AvgDiskVel(i) - ! index = index + 1 - !end do - - ! I'm not including this in the linearization yet - !do i=1,u%NacelleMotion%NNodes ! 1 or 0 - ! do j=1,3 - ! u_op(index) = u%InflowOnNacelle(j) - ! index = index + 1 - ! end do - !end do - ! - !do i=1,u%HubMotion%NNodes ! 1 - ! do j=1,3 - ! u_op(index) = u%InflowOnHub(j) - ! index = index + 1 - ! end do - !end do - - end if - END IF + if (present(u_op)) then - IF ( PRESENT( y_op ) ) THEN - - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + if (.not. allocated(u_op)) then + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - - index = 1 - if (.not. p_AD%CompAeroMaps) call PackLoadMesh(y%TowerLoad, y_op, index) - do k=1,p%NumBl_Lin - call PackLoadMesh(y%BladeLoad(k), y_op, index) - end do - - if (.not. p_AD%CompAeroMaps) then - index = index - 1 - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - end if - + call AD_PackInputValues(p, u, u_op) + END IF - IF ( PRESENT( x_op ) ) THEN - - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if + !---------------------------------------------------------------------------- - index = 1 - ! set linearization operating points: - if (p%BEMT%DBEMT%lin_nx>0) then - do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - do k=1,size(x%BEMT%DBEMT%element(i,j)%vind) - x_op(index) = x%BEMT%DBEMT%element(i,j)%vind(k) - index = index + 1 - end do - end do - end do - - do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - do k=1,size(x%BEMT%DBEMT%element(i,j)%vind_1) - x_op(index) = x%BEMT%DBEMT%element(i,j)%vind_1(k) - index = index + 1 - end do - end do - end do - + if (present(y_op)) then + + if (.not. allocated(y_op)) then + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - ! UA states - if (p%BEMT%UA%lin_nx>0) then - do n=1,p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - x_op(index) = x%BEMT%UA%element(i,j)%x(k) - - index = index + 1 - end do + + call AD_PackOutputValues(p, y, y_op, IsFullLin) - end if - ! BEMT states - if (p%BEMT%lin_nx>0) then - !do k = 1,size(x%BEMT%V_w) - ! x_op(index) = x%BEMT%v_w(k) - ! index = index + 1 - !end do - end if - END IF - IF ( PRESENT( dx_op ) ) THEN + !---------------------------------------------------------------------------- + + if (present(x_op)) then - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + if (.not. allocated(x_op)) then + call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call RotCalcContStateDeriv(t, u, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) - return - end if - - index = 1 - ! set linearization operating points: - if (p%BEMT%DBEMT%lin_nx>0) then + call AD_PackStateValues(p, x, x_op) + + end if - do j=1,p%NumBlades ! size(dxdt%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(dxdt%BEMT%DBEMT%element,1) - do k=1,size(dxdt%BEMT%DBEMT%element(i,j)%vind) - dx_op(index) = dxdt%BEMT%DBEMT%element(i,j)%vind(k) - index = index + 1 - end do - end do - end do + !---------------------------------------------------------------------------- + + if (present(dx_op)) then - do j=1,p%NumBlades ! size(dxdt%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(dxdt%BEMT%DBEMT%element,1) - do k=1,size(dxdt%BEMT%DBEMT%element(i,j)%vind_1) - dx_op(index) = dxdt%BEMT%DBEMT%element(i,j)%vind_1(k) - index = index + 1 - end do - end do - end do - + if (.not. allocated(dx_op)) then + call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return end if - ! UA states derivatives - if (p%BEMT%UA%lin_nx>0) then - do n=1,p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - dx_op(index) = dxdt%BEMT%UA%element(i,j)%x(k) - - index = index + 1 - end do - end if - ! BEMT states derivatives - if (p%BEMT%lin_nx>0) then - call SetErrStat(ErrID_Fatal,'Number of lin states for bem should be zero for now.', ErrStat, ErrMsg, RoutineName) - return - !do k = 1,size(x%BEMT%V_w) - ! dx_op(index) = dxdt%BEMT%v_w(k) - ! index = index + 1 - !end do - end if - - call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) + + call RotCalcContStateDeriv(t, u, p, p_AD, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); If (Failed()) return + call AD_PackStateValues(p, m%dxdt_lin, dx_op) END IF - IF ( PRESENT( xd_op ) ) THEN + !---------------------------------------------------------------------------- - END IF + if (present(xd_op)) then + end if - IF ( PRESENT( z_op ) ) THEN + !---------------------------------------------------------------------------- + + if (present(z_op)) then if (.not. allocated(z_op)) then call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2) @@ -6505,17 +6458,21 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, if (ErrStat >= AbortErrLev) return end if - - index = 1 + ind = 1 do k=1,p%NumBlades ! size(z%BEMT%Phi,2) do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) - z_op(index) = z%BEMT%phi(i,k) - index = index + 1 + z_op(ind) = z%BEMT%phi(i,k) + ind = ind + 1 end do end do - END IF + end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE RotGetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) @@ -7400,4 +7357,156 @@ SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) END SUBROUTINE Compute_dX +subroutine AD_PackStateValues(p, x, Ary) + type(RotParameterType), intent(in) :: p + type(RotContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: Ary(:) + integer(IntKi) :: i, j, k, ind + if (p%BEMT%DBEMT%lin_nx > 0) then + do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) + do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) + do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind) + Ary(ind) = x%BEMT%DBEMT%element(i,j)%vind(k) + ind = ind + 1 + end do + end do + end do + do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) + do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) + do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind_1) + Ary(ind) = x%BEMT%DBEMT%element(i,j)%vind_1(k) + ind = ind + 1 + end do + end do + end do + end if + + if (p%BEMT%UA%lin_nx > 0) then + if (p%BEMT%UA%UAMod == UA_OYE) then + do j = 1, p%NumBlades ! size(x%BEMT%UA%element,2) + do i = 1, p%NumBlNds ! size(x%BEMT%UA%element,1) + Ary(ind) = x%BEMT%UA%element(i,j)%x(4) + ind = ind + 1 + end do + end do + else + do j = 1, p%NumBlades ! size(x%BEMT%UA%element,2) + do i = 1, p%NumBlNds ! size(x%BEMT%UA%element,1) + do k = 1, 4 !size(x%BEMT%UA%element(i,j)%x) !linearize only first 4 states (5th is vortex) + Ary(ind) = x%BEMT%UA%element(i,j)%x(k) + ind = ind + 1 + end do + end do + end do + endif + end if +end subroutine + +subroutine AD_UnpackStateValues(p, Ary, x) + type(RotParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(RotContinuousStateType), intent(inout) :: x + integer(IntKi) :: i, j, k, ind + + if (p%BEMT%DBEMT%lin_nx > 0) then + do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) + do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) + do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind) + x%BEMT%DBEMT%element(i,j)%vind(k) = Ary(ind) + ind = ind + 1 + end do + end do + end do + do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) + do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) + do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind_1) + x%BEMT%DBEMT%element(i,j)%vind_1(k) = Ary(ind) + ind = ind + 1 + end do + end do + end do + end if + + if (p%BEMT%UA%lin_nx > 0) then + if (p%BEMT%UA%UAMod == UA_OYE) then + do j = 1, p%NumBlades ! size(x%BEMT%UA%element,2) + do i = 1, p%NumBlNds ! size(x%BEMT%UA%element,1) + x%BEMT%UA%element(i,j)%x(4) = Ary(ind) + ind = ind + 1 + end do + end do + else + do j = 1, p%NumBlades ! size(x%BEMT%UA%element,2) + do i = 1, p%NumBlNds ! size(x%BEMT%UA%element,1) + do k = 1, 4 !size(x%BEMT%UA%element(i,j)%x) !linearize only first 4 states (5th is vortex) + x%BEMT%UA%element(i,j)%x(k) = Ary(ind) + ind = ind + 1 + end do + end do + end do + endif + end if +end subroutine + +subroutine AD_PackInputValues(p, u, Ary) + type(RotParameterType), intent(in) :: p + type(RotInputType), intent(in) :: u + real(R8Ki), intent(out) :: Ary(:) + integer(IntKi) :: k + call MV_Pack(p%Vars%u, p%iVarTowerMotion, u%TowerMotion, Ary) + call MV_Pack(p%Vars%u, p%iVarHubMotion, u%HubMotion, Ary) + do k = 1,p%NumBlades + call MV_Pack(p%Vars%u, p%iVarBladeRootMotion(k), u%BladeRootMotion(k), Ary) + end do + do k = 1,p%NumBlades + call MV_Pack(p%Vars%u, p%iVarBladeMotion(k), u%BladeMotion(k), Ary) + end do + do k = 1,p%NumBlades + call MV_Pack(p%Vars%u, p%iVarInflowOnBlade(k), u%Bld(k)%InflowOnBlade, Ary) + end do + call MV_Pack(p%Vars%u, p%iVarInflowOnTower, u%InflowOnTower, Ary) + do k = 1,p%NumBlades + call MV_Pack(p%Vars%u, p%iVarUserProp(k), u%UserProp(:,k), Ary) + end do +end subroutine + +subroutine AD_UnpackInputValues(p, Ary, u) + type(RotParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Ary(:) + type(RotInputType), intent(inout) :: u + integer(IntKi) :: k + call MV_Unpack(p%Vars%u, p%iVarTowerMotion, Ary, u%TowerMotion) + call MV_Unpack(p%Vars%u, p%iVarHubMotion, Ary, u%HubMotion) + do k = 1,p%NumBlades + call MV_Unpack(p%Vars%u, p%iVarBladeRootMotion(k), Ary, u%BladeRootMotion(k)) + end do + do k = 1,p%NumBlades + call MV_Unpack(p%Vars%u, p%iVarBladeMotion(k), Ary, u%BladeMotion(k)) + end do + do k = 1,p%NumBlades + call MV_Unpack(p%Vars%u, p%iVarInflowOnBlade(k), Ary, u%Bld(k)%InflowOnBlade) + end do + call MV_Unpack(p%Vars%u, p%iVarInflowOnTower, Ary, u%InflowOnTower) + do k = 1,p%NumBlades + call MV_Unpack(p%Vars%u, p%iVarUserProp(k), Ary, u%UserProp(:,k)) + end do +end subroutine + +subroutine AD_PackOutputValues(p, y, Ary, PackWriteOutput) + type(RotParameterType), intent(in) :: p + type(RotOutputType), intent(in) :: y + real(R8Ki), intent(out) :: Ary(:) + logical, intent(in) :: PackWriteOutput + integer(IntKi) :: k + call MV_Pack(p%Vars%y, p%iVarTowerLoad, y%TowerLoad, Ary) + do k = 1, p%NumBlades + call MV_Pack(p%Vars%y, p%iVarBladeLoad(k), y%BladeLoad(k), Ary) + end do + if (PackWriteOutput) then + ! do k = p%iVarWriteOut, size(p%Vars%y) + ! call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) + ! end do + end if +end subroutine + END MODULE AeroDyn From 2f59f57947cb57572a4a640033663140be29d9ad Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 14:21:26 +0000 Subject: [PATCH 051/319] Update ED and BD module variables --- modules/beamdyn/src/BeamDyn.f90 | 499 ++++++++++--------------- modules/elastodyn/src/ElastoDyn.f90 | 548 +++++++++++----------------- 2 files changed, 403 insertions(+), 644 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index b636ee65f6..3e22040e84 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -55,6 +55,7 @@ MODULE BeamDyn PUBLIC :: BD_PackStateValues, BD_UnpackStateValues PUBLIC :: BD_PackInputValues, BD_UnpackInputValues + PUBLIC :: BD_PackOutputValues ! The original formulation kept all states in the inertial reference frame. This has been leading to convergence issues ! when there is a large rotational change from the reference frame (i.e. large turbine yaw, large blade pitch). During @@ -1975,7 +1976,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'BD_CalcOutput' - LOGICAL :: CalcWriteOutput + LOGICAL :: IsFullLin ! Initialize ErrStat @@ -1985,9 +1986,9 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, AllOuts = 0.0_ReKi if (present(NeedWriteOutput)) then - CalcWriteOutput = NeedWriteOutput + IsFullLin = NeedWriteOutput else - CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it + IsFullLin = .true. ! by default, calculate WriteOutput unless told that we do not need it end if ! Since x is passed in, but we need to update it, we must work with a copy. @@ -2088,13 +2089,13 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! compute RootMxr and RootMyr for ServoDyn and ! get values to output to file: !------------------------------------------------------- - call Calc_WriteOutput( p, AllOuts, y, m, ErrStat2, ErrMsg2, CalcWriteOutput ) !uses m%u2 + call Calc_WriteOutput( p, AllOuts, y, m, ErrStat2, ErrMsg2, IsFullLin ) !uses m%u2 CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) y%RootMxr = AllOuts( RootMxr ) y%RootMyr = AllOuts( RootMyr ) - if (CalcWriteOutput) then + if (IsFullLin) then !............................................................................................................................... ! Place the selected output channels into the WriteOutput(:) array with the proper sign: !............................................................................................................................... @@ -5818,9 +5819,9 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Continuous State Variables !---------------------------------------------------------------------------- - ! Set flags to none, if rotating states is true, set flags to rotating states - Flags = VF_AeroMap - if (p%RotStates) call SetFlags(Flags, VF_RotFrame) + ! Set flags to AeroMap, if rotating states is true, set flags to rotating states + Flags = ior(VF_AeroMap, VF_DerivOrder2) + if (p%RotStates) Flags = ior(Flags, VF_RotFrame) ! Add translation displacement and orientation variables at blade nodes ! Note: the first node is not included as it is a constraint state @@ -5828,41 +5829,38 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) label = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransDisp, & - VarIdx=idx, & Num=3, & - Flags=flags, & + Flags=Flags, & iUsr=i, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(label)//' translational displacement in X, m', & trim(label)//' translational displacement in Y, m', & trim(label)//' translational displacement in Z, m']) call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_Orientation, & - VarIdx=idx, & Num=3, & - Flags=flags, & + Flags=Flags, & iUsr=i, & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(label)//' rotational displacement in X, rad', & trim(label)//' rotational displacement in Y, rad', & trim(label)//' rotational displacement in Z, rad']) end do + ! Add translation velocity and angular velocity at blade nodes do i = 2, p%node_total label = 'First time derivative of finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransVel, & - VarIdx=idx, & Num=3, & - Flags=flags, & + Flags=Flags, & iUsr=i, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(label)//' translational displacement in X, m/s', & trim(label)//' translational displacement in Y, m/s', & trim(label)//' translational displacement in Z, m/s']) call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_AngularVel, & - VarIdx=idx, & Num=3, & - Flags=flags, & + Flags=Flags, & iUsr=i, & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(label)//' rotational displacement in X, rad/s', & @@ -5913,7 +5911,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) do i = p%iVarBldMotion, size(p%Vars%y) select case (p%Vars%y(i)%Field) case (VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel) - call SetFlags(p%Vars%y(i)%Flags, VF_AeroMap) + call MV_SetFlags(p%Vars%y(i), VF_AeroMap) end select end do end if @@ -5922,17 +5920,18 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & VarIdx = j, & - Flags=OutParamFlags(p%OutParam(i)%Indx), & + Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & Active=p%OutParam(i)%Indx > 0) end do + idx = p%NumOuts + 1 do i = 1, p%BldNd_NumOuts call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & VarIdx = j, & Num=size(p%BldNd_BlOutNd), & - Flags=BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & + Flags=VF_WriteOut + BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & iUsr=idx, & LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & Active=p%BldNd_OutParam(i)%Indx > 0) @@ -5943,45 +5942,23 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Initialize Variables and Values !---------------------------------------------------------------------------- - CALL MV_InitVarsLin(p%Vars, m%Lin, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return call BD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_CopyContState(x, m%dx_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call BD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_CopyOutput(y, m%y_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - - !---------------------------------------------------------------------------- - ! Linearization - !---------------------------------------------------------------------------- - - ! If linearization is requested, initialize arrays - if (Linearize .or. p%CompAeroMaps) then - call MV_InitLinArrays(p%Vars, 2, & - InitOut%LinNames_x, InitOut%RotFrame_x, InitOut%DerivOrder_x, & - InitOut%LinNames_u, InitOut%RotFrame_u, InitOut%IsLoad_u, & - InitOut%LinNames_y, InitOut%RotFrame_y, ErrStat2, ErrMsg2) - if (Failed()) return - end if + call BD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! AeroMap !---------------------------------------------------------------------------- if (p%CompAeroMaps) then - + ! Initialize index for variables flagged with VF_AeroMap - call MV_InitVarIdx(p%Vars, p%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2) + call MV_InitVarIdx(p%Vars, p%Vars%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2) if (Failed()) return - ! Get subset of linearization arrays - InitOut%LinNames_x = InitOut%LinNames_x(p%IdxAeroMap%ix) - InitOut%RotFrame_x = InitOut%RotFrame_x(p%IdxAeroMap%ix) - InitOut%DerivOrder_x = InitOut%DerivOrder_x(p%IdxAeroMap%ix) - InitOut%LinNames_u = InitOut%LinNames_u(p%IdxAeroMap%iu) - InitOut%RotFrame_u = InitOut%RotFrame_u(p%IdxAeroMap%iu) - InitOut%IsLoad_u = InitOut%IsLoad_u(p%IdxAeroMap%iu) - InitOut%LinNames_y = InitOut%LinNames_y(p%IdxAeroMap%iy) - InitOut%RotFrame_y = InitOut%RotFrame_y(p%IdxAeroMap%iy) end if contains @@ -6103,7 +6080,7 @@ subroutine BD_PackOutputValues(p, y, Ary, PackWriteOutput) !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, ModIdx) +SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6120,156 +6097,137 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] - TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type - character(*), parameter :: RoutineName = 'BD_JacobianPInput' - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - INTEGER(IntKi) :: i, j, col - REAL(R8Ki) :: RotateStates(3,3) - logical :: CalcWriteOutput + character(*), parameter :: RoutineName = 'BD_JacobianPInput' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + REAL(R8Ki) :: RotateStates(3,3) + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + INTEGER(IntKi) :: i, j, col ErrStat = ErrID_None ErrMsg = '' - ! Set flag to pack write outputs - CalcWriteOutput = .not. present(ModIdx) + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if ! Get OP values here call BD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if (Failed()) return ! Make a copy of the inputs to perturb call BD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackInputValues(p, u, m%Lin%u) + call BD_PackInputValues(p, u, m%Jac%u) + + !---------------------------------------------------------------------------- ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - if (present(ModIdx)) then - call AllocAry(dYdu, ModIdx%Ny, ModIdx%Nu, 'dYdu', ErrStat2, ErrMsg2) - else - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - ! If not computing aero maps - if (.not. p%CompAeroMaps) then - - ! Loop through input variables - do i = 1, size(p%Vars%u) + ! Loop through input variables + do i = 1, size(p%Vars%u) - ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle - ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num - ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) - call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=CalcWriteOutput); if (Failed()) return - call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, CalcWriteOutput) + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return + call BD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) - ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) - call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=CalcWriteOutput); if (Failed()) return - call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, CalcWriteOutput) + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return + call BD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) - ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 - ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdu(:,col)) - end do + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do - - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dYdu = m%Lin%dYdu(ModIdx%iy, ModIdx%iu) - else - dYdu = m%Lin%dYdu - end if - else - dYdu = 0.0_R8Ki - end if ! CompAeroMaps - - END IF + end do + + end if + + !---------------------------------------------------------------------------- ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: if (present(dXdu)) then ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - if (present(ModIdx)) then - call AllocAry(dXdu, ModIdx%Nx, ModIdx%Nu, 'dXdu', ErrStat2, ErrMsg2) - else - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables do i = 1, size(p%Vars%u) ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) - call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dx_perturb, m%Lin%x_pos) + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) - call BD_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dx_perturb, m%Lin%x_neg) + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - m%Lin%dXdu(:,col) = (m%Lin%x_pos - m%Lin%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) end do end do ! If rotate states is enabled, modify Jacobian if (p%RotStates) then RotateStates = matmul(u%RootMotion%Orientation(:,:,1), transpose(u%RootMotion%RefOrientation(:,:,1))) - do i=1,size(m%Lin%dXdu,1),3 - m%Lin%dXdu(i:i+2, :) = matmul(RotateStates, m%Lin%dXdu(i:i+2, :)) + do i=1,size(dXdu,1),3 + dXdu(i:i+2, :) = matmul(RotateStates, dXdu(i:i+2, :)) end do end if - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dXdu = m%Lin%dXdu(ModIdx%ix, ModIdx%iu) - else - dXdu = m%Lin%dXdu - end if + end if - end if ! dXdu + !---------------------------------------------------------------------------- if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) end if + !---------------------------------------------------------------------------- + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) end if @@ -6283,7 +6241,7 @@ END SUBROUTINE BD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, ModIdx, StateRotation ) +SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, dXddx, dZdx, StateRotation ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6300,30 +6258,37 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) - TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRotation(:,:) !< Matrix by which the states are optionally rotated - CHARACTER(*), PARAMETER :: RoutineName = 'BD_JacobianPContState' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - INTEGER(IntKi) :: i, j, col - REAL(R8Ki) :: RotateStates(3,3) - REAL(R8Ki) :: RotateStatesTranspose(3,3) - logical :: CalcWriteOutput + CHARACTER(*), PARAMETER :: RoutineName = 'BD_JacobianPContState' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(R8Ki) :: RotateStates(3,3) + REAL(R8Ki) :: RotateStatesTranspose(3,3) + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + INTEGER(IntKi) :: i, j, col ErrStat = ErrID_None ErrMsg = '' - ! Set flag to pack write outputs - CalcWriteOutput = .not. present(ModIdx) + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if ! Copy state values call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, x, m%Lin%x) + call BD_PackStateValues(p, x, m%Jac%x) ! If rotate states is enabled if (p%RotStates) then @@ -6338,139 +6303,121 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, StateRotation = RotateStates end if else - if ( present(StateRotation) ) then + if (present(StateRotation)) then if (allocated(StateRotation)) deallocate(StateRotation) end if end if + !---------------------------------------------------------------------------- + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - if (present(ModIdx)) then - call AllocAry(dYdx, ModIdx%Ny, ModIdx%Nx, 'dYdx', ErrStat2, ErrMsg2) - else - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! Loop through input variables + ! Loop through state variables do i = 1, size(p%Vars%x) ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%x(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) - call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=CalcWriteOutput); if (Failed()) return - call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, CalcWriteOutput) + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return + call BD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) - call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2, NeedWriteOutput=CalcWriteOutput); if (Failed()) return - call BD_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, CalcWriteOutput) + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return + call BD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdx(:,col)) + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do ! If rotate state is enabled, modify Jacobian if (p%RotStates) then - do i=1,size(m%Lin%dYdx,2),3 - m%Lin%dYdx(:, i:i+2) = matmul( m%Lin%dYdx(:, i:i+2), RotateStatesTranspose) + do i=1,size(dYdx,2),3 + dYdx(:, i:i+2) = matmul( dYdx(:, i:i+2), RotateStatesTranspose) end do end if - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dYdx = m%Lin%dYdx(ModIdx%iy, ModIdx%ix) - else - dYdx = m%Lin%dYdx - end if end if + !---------------------------------------------------------------------------- + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: if (present(dXdx)) then ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - if (present(ModIdx)) then - call AllocAry(dXdx, ModIdx%Nx, ModIdx%Nx, 'dXdx', ErrStat2, ErrMsg2) - else - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! Loop through input variables + ! Loop through state variables do i = 1, size(p%Vars%x) ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%x(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) - call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dx_perturb, m%Lin%x_pos) + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) - call BD_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dx_perturb, m%Lin%x_neg) + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - m%Lin%dXdx(:,col) = (m%Lin%x_pos - m%Lin%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) end do end do ! If rotate state is enabled, modify Jacobian if (p%RotStates) then - do i=1,size(m%Lin%dXdx,1),3 - m%Lin%dXdx(i:i+2,:) = matmul(RotateStates, m%Lin%dXdx(i:i+2,:)) + do i=1,size(dXdx,1),3 + dXdx(i:i+2,:) = matmul(RotateStates, dXdx(i:i+2,:)) end do - do i=1,size(m%Lin%dXdx,2),3 - m%Lin%dXdx(:, i:i+2) = matmul(m%Lin%dXdx(:, i:i+2), RotateStatesTranspose) + do i=1,size(dXdx,2),3 + dXdx(:, i:i+2) = matmul(dXdx(:, i:i+2), RotateStatesTranspose) end do end if - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dXdx = m%Lin%dXdx(ModIdx%idx, ModIdx%ix) - else - dXdx = m%Lin%dXdx - end if end if - IF ( PRESENT( dXddx ) ) THEN + !---------------------------------------------------------------------------- + + if (present(dXddx)) then if (allocated(dXddx)) deallocate(dXddx) - END IF + end if - IF ( PRESENT( dZdx ) ) THEN + !---------------------------------------------------------------------------- + + if (present(dZdx)) then if (allocated(dZdx)) deallocate(dZdx) - END IF + end if contains logical function Failed() @@ -6613,7 +6560,7 @@ SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE BD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, ModIdx, NeedTrimOP ) +SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6626,155 +6573,97 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type - INTEGER(IntKi) :: index, i, dof - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny + CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) LOGICAL :: ReturnTrimOP - logical :: CalcWriteOutput + logical :: IsFullLin + INTEGER(IntKi) :: i ErrStat = ErrID_None ErrMsg = '' - ! Set flag to pack write outputs - CalcWriteOutput = .true. + ! Get variable index based on optional argument + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + else + IsFullLin = .true. + end if + + !---------------------------------------------------------------------------- - ! If inputs requested if (present(u_op)) then - ! Allocate array if not allocated if (.not. allocated(u_op)) then - if (present(ModIdx)) then - call AllocAry(u_op, ModIdx%Nu, 'u_op', ErrStat2, ErrMsg2) - else - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) - end if - if (Failed()) return - end if - - ! Pack input type into array - call BD_PackInputValues(p, u, m%Lin%u) - - ! If ModIdx is present - if (present(ModIdx)) then - u_op = m%Lin%u(ModIdx%iu) ! copy subset of array - else - u_op = m%Lin%u ! copy full array + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if + + call BD_PackInputValues(p, u, u_op) + end if - ! If outputs requested + !---------------------------------------------------------------------------- + if (present(y_op)) then - ! Only the y operating points need to potentially return a smaller array than the "normal" call to this return. In the trim solution, we use a smaller array for y. - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .false. - end if - - ! Allocate array if not allocated if (.not. allocated(y_op)) then - if (present(ModIdx)) then - call AllocAry(y_op, ModIdx%Ny, 'y_op', ErrStat2, ErrMsg2) - else - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackOutputValues(p, y, m%Lin%y, CalcWriteOutput) - - ! If ModIdx is present - if (present(ModIdx)) then - y_op = m%Lin%y(ModIdx%iy) ! copy subset of array - else - y_op = m%Lin%y ! copy full array - end if + call BD_PackOutputValues(p, y, y_op, IsFullLin) + end if - ! If continuous states requested + !---------------------------------------------------------------------------- + if (present(x_op)) then - ! Allocate array if not allocated if (.not. allocated(x_op)) then - if (present(ModIdx)) then - call AllocAry(x_op, ModIdx%Nx, 'x_op', ErrStat2, ErrMsg2) - else - call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackStateValues(p, x, m%Lin%x) - - ! If ModIdx is present - if (present(ModIdx)) then - x_op = m%Lin%x(ModIdx%ix) ! copy subset of array - else - x_op = m%Lin%x ! copy full array - end if + call BD_PackStateValues(p, x, x_op) + end if - ! If continuous state derivatives requested + !---------------------------------------------------------------------------- + if (present(dx_op)) then - ! Allocate array if not allocated if (.not. allocated(dx_op)) then - if (present(ModIdx)) then - call AllocAry(dx_op, ModIdx%Nx, 'dx_op', ErrStat2, ErrMsg2) - else - call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2) - if (Failed()) return + call BD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, m%dxdt_lin, dx_op) - call BD_PackStateValues(p, m%dx_perturb, m%Lin%dx) - - ! If ModIdx is present - if (present(ModIdx)) then - dx_op = m%Lin%dx(ModIdx%idx) ! copy subset of array - else - dx_op = m%Lin%dx ! copy full array - end if end if + !---------------------------------------------------------------------------- + if (present(xd_op)) then end if - ! this is a little weird, but seems to be how BD has implemented the first node in the continuous state array. + !---------------------------------------------------------------------------- + if (present(z_op)) then + ! this is a little weird, but seems to be how BD has implemented the first node in the continuous state array. if (.not. allocated(z_op)) then - call AllocAry(z_op, p%dof_node * 2,'z_op',ErrStat2,ErrMsg2) - if (Failed()) return + call AllocAry(z_op, p%dof_node * 2, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return end if - index = 1 - do dof=1,p%dof_node - z_op(index) = x%q( dof, 1 ) - index = index+1 - end do - - do dof=1,p%dof_node - z_op(index) = x%dqdt( dof, 1 ) - index = index+1 - end do + z_op = [x%q(:, 1), x%dqdt(:, 1)] + end if contains diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index b55a1d3da8..2b55110276 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -10358,7 +10358,7 @@ END SUBROUTINE FixHSSBrTq !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, ModIdx ) +SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -10379,152 +10379,119 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] - TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' - integer(IntKi) :: i, j, col - logical :: CalcWriteOutput + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + integer(IntKi) :: i, j, col ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function - ! Set flag to pack write outputs - CalcWriteOutput = .not. present(ModIdx) + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if ! Update copy of the inputs to perturb call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackInputValues(p, u, m%Lin%u) + call ED_PackInputValues(p, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - if (present(ModIdx)) then - call AllocAry(dYdu, ModIdx%Ny, ModIdx%Nu, 'dYdu', ErrStat2, ErrMsg2) - else - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - ! If not computing aero maps - if (.not. p%CompAeroMaps) then - - ! Loop through input variables - do i = 1, size(p%Vars%u) + ! Loop through input variables + do i = 1, size(p%Vars%u) - ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle - ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num - ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) - call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, CalcWriteOutput) + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) - ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) - call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, CalcWriteOutput) + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) - ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 - ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdu(:,col)) - end do + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do - - ! Only include extended variables in full linearization - if (.not. present(ModIdx)) then + end do - ! Extended: BlPitchComC is the sum of BlPitchCom across all blades - associate (Var => p%Vars%u(p%iVarBlPitchCom)) - m%Lin%dYdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(m%Lin%dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) - end associate - end if + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + associate (Var => p%Vars%u(p%iVarBlPitchCom)) + dYdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dYdu = m%Lin%dYdu(ModIdx%iy, ModIdx%iu) - else - dYdu = m%Lin%dYdu - end if - else - dYdu = 0.0_R8Ki - end if end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - if (present(dXdu)) then + if (present(dXdu) .and. (p%Vars%Nx > 0)) then ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - if (present(ModIdx)) then - call AllocAry(dXdu, ModIdx%Nx, ModIdx%Nu, 'dXdu', ErrStat2, ErrMsg2) - else - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables do i = 1, size(p%Vars%u) ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%u(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Lin%u, m%Lin%u_perturb) - call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%x_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%x_perturb, m%Lin%x_pos) + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Lin%u, m%Lin%u_perturb) - call ED_UnpackInputValues(p, m%Lin%u_perturb, m%u_perturb) - call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%x_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%x_perturb, m%Lin%x_neg) + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - m%Lin%dXdu(:,col) = (m%Lin%x_pos - m%Lin%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) end do end do - ! Only include extended variables in full linearization - if (.not. present(ModIdx)) then + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + associate (Var => p%Vars%u(p%iVarBlPitchCom)) + dXdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(dXdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate - ! Extended: BlPitchComC is the sum of BlPitchCom across all blades - associate (Var => p%Vars%u(p%iVarBlPitchCom)) - m%Lin%dXdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(m%Lin%dXdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) - end associate - end if - - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dXdu = m%Lin%dXdu(ModIdx%idx, ModIdx%iu) - else - dXdu = m%Lin%dXdu - end if end if if ( present( dXddu ) ) then @@ -10551,7 +10518,7 @@ END SUBROUTINE ED_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, ModIdx ) +SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, dXddx, dZdx ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -10568,145 +10535,122 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect - !! to the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect - !! to the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect - !! to the continuous states (x) [intent in to avoid deallocation] - TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable indexing number + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) [intent in to avoid deallocation] + CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col - logical :: CalcWriteOutput ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function - ! Set flag to pack write outputs - CalcWriteOutput = .not. present(ModIdx) + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if ! Copy state values call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, x, m%Lin%x) + call ED_PackStateValues(p, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - if (present(ModIdx)) then - call AllocAry(dYdx, ModIdx%Ny, ModIdx%Nx, 'dYdx', ErrStat2, ErrMsg2) - else - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! Loop through input variables + ! Loop through state variables do i = 1, size(p%Vars%x) ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%x(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) - call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_pos, CalcWriteOutput) + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) - call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_perturb, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_perturb, m%Lin%y_neg, CalcWriteOutput) + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Lin%y_pos, m%Lin%y_neg, m%Lin%dYdx(:,col)) + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dYdx = m%Lin%dYdx(ModIdx%iy, ModIdx%ix) - else - dYdx = m%Lin%dYdx - end if end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - if ( present( dXdx ) ) then + if (present(dXdx) .and. (p%Vars%Nx > 0)) then ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - if (present(ModIdx)) then - call AllocAry(dXdx, ModIdx%Nx, ModIdx%Nx, 'dXdx', ErrStat2, ErrMsg2) - else - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! Loop through input variables + ! Loop through state variables do i = 1, size(p%Vars%x) ! If variable flag not in flag filter, skip - if (present(ModIdx)) then - if (iand(p%Vars%x(i)%Flags, ModIdx%FlagFilter) == 0) cycle - end if + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Lin%x, m%Lin%x_perturb) - call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dx_perturb, m%Lin%x_pos) + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Lin%x, m%Lin%x_perturb) - call ED_UnpackStateValues(p, m%Lin%x_perturb, m%x_perturb) - call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dx_perturb, m%Lin%x_neg) + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - m%Lin%dXdx(:,col) = (m%Lin%x_pos - m%Lin%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) end do end do - ! If ModIdx is present, copy subset of Jacobian to output - if (present(ModIdx)) then - dXdx = m%Lin%dXdx(ModIdx%idx, ModIdx%ix) - else - dXdx = m%Lin%dXdx - end if end if - IF ( PRESENT( dXddx ) ) THEN + if (present(dXddx)) then if (allocated(dXddx)) deallocate(dXddx) - END IF + end if - IF ( PRESENT( dZdx ) ) THEN + if (present(dZdx)) then if (allocated(dZdx)) deallocate(dZdx) - END IF + end if call cleanup() @@ -10719,7 +10663,6 @@ logical function Failed() subroutine cleanup() m%IgnoreMod = .false. end subroutine cleanup - END SUBROUTINE ED_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -10868,7 +10811,7 @@ END SUBROUTINE ED_JacobianPConstrState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP, ModIdx ) +SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP, FlagFilter ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -10881,126 +10824,86 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - TYPE(VarsIdxType), OPTIONAL, INTENT(IN ) :: ModIdx !< Module linearization type + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Filter variables by flag - INTEGER(IntKi) :: i, k, index - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' + CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + logical :: IsFullLin + INTEGER(IntKi) :: i, k ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + else + IsFullLin = .true. + end if !.................................. - if ( present( u_op ) ) then + if (present(u_op)) then if (.not. allocated(u_op)) then - if (present(ModIdx)) then - call AllocAry(u_op, ModIdx%Nu, 'u_op', ErrStat2, ErrMsg2) - else - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if ! Pack input type into array - call ED_PackInputValues(p, u, m%Lin%u) + call ED_PackInputValues(p, u, u_op) ! If full linearization, check extended inputs - if (.not. present(ModIdx)) then + if (IsFullLin) then do k = 2,p%NumBl if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then - call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & + call SetErrStat(ErrID_Info, "Operating point of collective pitch extended input is invalid because "// & "the commanded blade pitch angles are not the same for each blade.", ErrStat, ErrMsg, RoutineName) exit end if end do end if - - ! If ModIdx is present - if (present(ModIdx)) then - u_op = m%Lin%u(ModIdx%iu) ! copy subset of array - else - u_op = m%Lin%u ! copy full array - end if end if !.................................. if (present(y_op)) then if (.not. allocated(y_op)) then - if (present(ModIdx)) then - call AllocAry(y_op, ModIdx%Ny, 'y_op', ErrStat2, ErrMsg2) - else - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call ED_PackOutputValues(p, y, m%Lin%y, .not. present(ModIdx)) - - ! If ModIdx is present - if (present(ModIdx)) then - y_op = m%Lin%y(ModIdx%iy) ! copy subset of array - else - y_op = m%Lin%y ! copy full array - end if + call ED_PackOutputValues(p, y, y_op, IsFullLin) + end if !.................................. if (present(x_op)) then if (.not. allocated(x_op)) then - if (present(ModIdx)) then - call AllocAry(x_op, ModIdx%Nx, 'x_op', ErrStat2, ErrMsg2) - else - call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call ED_PackStateValues(p, x, m%Lin%x) - - ! If ModIdx is present - if (present(ModIdx)) then - x_op = m%Lin%x(ModIdx%ix) ! copy subset of array - else - x_op = m%Lin%x ! copy full array - end if + call ED_PackStateValues(p, x, x_op) + end if !.................................. if (present(dx_op)) then if (.not. allocated(dx_op)) then - if (present(ModIdx)) then - call AllocAry(dx_op, ModIdx%Nx, 'dx_op', ErrStat2, ErrMsg2) - else - call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2) - end if - if (Failed()) return + call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call ED_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dx_perturb, ErrStat2, ErrMsg2) - if (Failed()) return - - call ED_PackStateValues(p, m%dx_perturb, m%Lin%dx) - - ! If ModIdx is present - if (present(ModIdx)) then - dx_op = m%Lin%dx(ModIdx%idx) ! copy subset of array - else - dx_op = m%Lin%dx ! copy full array - end if + call ED_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, m%dxdt_lin, dx_op) + end if !.................................. @@ -11038,11 +10941,11 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, j, k, idx + integer(IntKi) :: i, j, k integer(IntKi), allocatable :: BladeMeshFields(:) real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength - type(ModVarType) :: Var - integer(IntKi) :: Flags + integer(IntKi) :: Flags, Field + type(VarsIdxType), pointer :: VarIdx ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) @@ -11052,132 +10955,130 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat return end if + ! Associate pointer in init output + InitOut%Vars => p%Vars + !---------------------------------------------------------------------------- ! Continuous State Variables !---------------------------------------------------------------------------- - allocate(p%Vars%x(0)) - ! Add continuous state variables (translation and rotation) call MV_AddVar(p%Vars%x, 'PlatformSurge', VF_TransDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_Sg, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal surge translation DOF (internal DOF index = DOF_Sg), m'], & Active=InputFileData%PtfmSgDOF) call MV_AddVar(p%Vars%x, 'PlatformSway', VF_TransDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_Sw, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal sway translation DOF (internal DOF index = DOF_Sw), m'], & Active=InputFileData%PtfmSwDOF) call MV_AddVar(p%Vars%x, 'PlatformHeave', VF_TransDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_Hv, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform vertical heave translation DOF (internal DOF index = DOF_Hv), m'], & Active=InputFileData%PtfmHvDOF) call MV_AddVar(p%Vars%x, 'PlatformRoll', VF_AngularDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_R, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform roll tilt rotation DOF (internal DOF index = DOF_R), rad'], & Active=InputFileData%PtfmRDOF) call MV_AddVar(p%Vars%x, 'PlatformPitch', VF_AngularDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_P, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform pitch tilt rotation DOF (internal DOF index = DOF_P), rad'], & Active=InputFileData%PtfmPDOF) call MV_AddVar(p%Vars%x, 'PlatformYaw', VF_AngularDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_Y, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform yaw rotation DOF (internal DOF index = DOF_Y), rad'], & Active=InputFileData%PtfmYDOF) call MV_AddVar(p%Vars%x, 'TowerFA1', VF_TransDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_TFA1, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower fore-aft bending mode DOF (internal DOF index = DOF_TFA1), m'], & Active=InputFileData%TwFADOF1) call MV_AddVar(p%Vars%x, 'TowerSS1', VF_TransDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_TSS1, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower side-to-side bending mode DOF (internal DOF index = DOF_TSS1), m'], & Active=InputFileData%TwSSDOF1) call MV_AddVar(p%Vars%x, 'TowerFA2', VF_TransDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_TFA2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower fore-aft bending mode DOF (internal DOF index = DOF_TFA2), m'], & Active=InputFileData%TwFADOF2) call MV_AddVar(p%Vars%x, 'TowerSS2', VF_TransDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_TSS2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower side-to-side bending mode DOF (internal DOF index = DOF_TSS2), m'], & Active=InputFileData%TwSSDOF2) call MV_AddVar(p%Vars%x, 'NacelleYaw', VF_AngularDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_Yaw, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Nacelle yaw DOF (internal DOF index = DOF_Yaw), rad'], & Active=InputFileData%YawDOF) call MV_AddVar(p%Vars%x, 'RotorFurl', VF_AngularDisp, & - VarIdx=idx, & - Flags=VF_AeroMap, & + Flags=VF_DerivOrder2 + VF_AeroMap, & iUsr=DOF_RFrl, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Rotor-furl DOF (internal DOF index = DOF_RFrl), rad'], & Active=InputFileData%RFrlDOF) call MV_AddVar(p%Vars%x, 'GeneratorAzimuth', VF_AngularDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_GeAz, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Variable speed generator DOF (internal DOF index = DOF_GeAz), rad'], & Active=InputFileData%GenDOF) call MV_AddVar(p%Vars%x, 'DrivetrainFlexibility', VF_AngularDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_DrTr, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Drivetrain rotational-flexibility DOF (internal DOF index = DOF_DrTr), rad'], & Active=InputFileData%DrTrDOF) call MV_AddVar(p%Vars%x, 'TailFurl', VF_AngularDisp, & - VarIdx=idx, & - Flags=VF_AeroMap, & + Flags=VF_DerivOrder2 + VF_AeroMap, & iUsr=DOF_TFrl, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Tail-furl DOF (internal DOF index = DOF_TFrl), rad'], & Active=InputFileData%TFrlDOF) call MV_AddVar(p%Vars%x, 'RotorTeeter', VF_AngularDisp, & - VarIdx=idx, & + Flags=VF_DerivOrder2, & iUsr=DOF_Teet, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Hub teetering DOF (internal DOF index = DOF_Teet), rad'], & Active=InputFileData%TeetDOF) do i = 1, p%NumBl - Flags = VF_RotFrame - if (i == 1) call SetFlags(Flags, VF_AeroMap) + Flags = ior(VF_RotFrame, VF_DerivOrder2) + if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', VF_TransDisp, & - VarIdx=idx, & Flags=Flags, & iUsr=DOF_BF(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & @@ -11187,10 +11088,9 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat end do do i = 1, p%NumBl - Flags = VF_RotFrame - if (i == 1) call SetFlags(Flags, VF_AeroMap) + Flags = ior(VF_RotFrame, VF_DerivOrder2) + if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', VF_TransDisp, & - VarIdx=idx, & Flags=Flags, & iUsr=DOF_BE(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & @@ -11200,10 +11100,9 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat end do do i = 1, p%NumBl - Flags = VF_RotFrame - if (i == 1) call SetFlags(Flags, VF_AeroMap) + Flags = ior(VF_RotFrame, VF_DerivOrder2) + if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', VF_TransDisp, & - VarIdx=idx, & Flags=Flags, & iUsr=DOF_BF(i,2), & Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & @@ -11213,33 +11112,29 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat end do ! Derivatives of continuous state variables - do i = 1, size(p%Vars%x) + if (allocated(p%Vars%x)) then + do i = 1, size(p%Vars%x) - ! Increase variable perturbation if below minimum - p%Vars%x(i)%Perturb = max(p%Vars%x(i)%Perturb, MinPerturb) + ! Increase variable perturbation if below minimum + p%Vars%x(i)%Perturb = max(p%Vars%x(i)%Perturb, MinPerturb) - ! Make a copy of variable - Var = p%Vars%x(i) - - ! Update linearization name - Var%LinNames(1) = 'First time derivative of '//trim(Var%LinNames(1))//'/s' + ! Update from position to velocity + if (p%Vars%x(i)%Field == VF_TransDisp) Field = VF_TransVel + if (p%Vars%x(i)%Field == VF_AngularDisp) Field = VF_AngularVel + + ! Add variable (only active variables are in x) + call MV_AddVar(p%Vars%x, p%Vars%x(i)%Name, Field, & + VarIdx=j, & + Flags=p%Vars%x(i)%Flags, & + iUsr=p%Vars%x(i)%iUsr(1), & + Perturb=p%Vars%x(i)%Perturb, & + LinNames=['First time derivative of '//trim(p%Vars%x(i)%LinNames(1))//'/s']) - ! Update from position to velocity - if (Var%Field == VF_TransDisp) Var%Field = VF_TransVel - if (Var%Field == VF_AngularDisp) Var%Field = VF_AngularVel + ! Remove aero map flag from newly created variable + call MV_UnsetFlags(p%Vars%x(j), VF_AeroMap) - ! Get flags from variable and remove aero map flag - Flags = Var%Flags - call UnsetFlags(Flags, VF_AeroMap) - - ! Add variable (only active variables are in x) - call MV_AddVar(p%Vars%x, Var%Name, Var%Field, & - VarIdx=idx, & - Flags=Flags, & - iUsr=Var%iUsr(1), & - Perturb=Var%Perturb, & - LinNames=Var%LinNames) - end do + end do + end if !---------------------------------------------------------------------------- ! Input variables @@ -11297,20 +11192,22 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat call MV_AddVar(p%Vars%u, "BlPitchCom", VF_Scalar, & VarIdx=p%iVarBlPitchCom, & Num=p%NumBl, & - Flags=VF_RotFrame, & + Flags=VF_RotFrame + VF_Linearize, & Perturb=2.0_R8Ki * D2R_D, & LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) call MV_AddVar(p%Vars%u, "YawMom", VF_Scalar, & VarIdx=p%iVarYawMom, & + Flags=VF_Linearize, & Perturb=MaxTorque / 100.0_R8Ki, & LinNames=['Yaw moment, Nm']) call MV_AddVar(p%Vars%u, "GenTrq", VF_Scalar, & VarIdx=p%iVarGenTrq, & + Flags=VF_Linearize, & Perturb=MaxTorque / (100.0_R8Ki*p%GBRatio), & LinNames=['Generator torque, Nm']) call MV_AddVar(p%Vars%u, "BlPitchComC", VF_Scalar, & VarIdx=p%iVarBlPitchComC, & - Flags=VF_Ext, & + Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: collective blade-pitch command, rad']) ! Set minimum input perturbations @@ -11335,9 +11232,10 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat ! Add aero map flag if first blade and field is translation/angular displacement/velocity if (i == 1) then do j = p%iVarBladeMotion(i), size(p%Vars%y) - if (iand(p%Vars%y(j)%Field, VF_TransDisp+VF_AngularDisp+VF_TransVel+VF_AngularVel) > 0) then - p%Vars%y(j)%Flags = ior(p%Vars%y(j)%Flags, VF_AeroMap) - end if + select case (p%Vars%y(j)%Field) + case (VF_TransDisp, VF_AngularDisp, VF_TransVel, VF_AngularVel) + call MV_SetFlags(p%Vars%y(j), VF_AeroMap) + end select end do end if end do @@ -11379,11 +11277,10 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat LinNames=['HSS_Spd, rad/s']) ! Write output variables - p%iVarOutput = size(p%Vars%y) + 1 + p%iVarWriteOut = size(p%Vars%y) + 1 do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & - VarIdx=idx, & - Flags=OutParamFlags(p%OutParam(i)%Indx), & + Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & Active=(p%OutParam(i)%Indx > 0)) @@ -11393,8 +11290,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do j = 1, p%BldNd_BladesOut call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & Num=p%BldNodes, & - VarIdx=idx, & - Flags=VF_RotFrame, & + Flags=VF_WriteOut + VF_RotFrame, & iUsr=k, & LinNames=[(BldOutLinName(p%BldNd_OutParam(i), j, k), k=1, p%BldNodes)], & Active=(p%BldNd_OutParam(i)%Indx > 0)) @@ -11403,28 +11299,15 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat end do !---------------------------------------------------------------------------- - ! Initialize Variables and Linearization data + ! Initialize Variables and Jacobian data !---------------------------------------------------------------------------- - call MV_InitVarsLin(p%Vars, m%Lin, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return + call MV_InitVarsJac(p%Vars, m%Jac, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return call ED_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_CopyContState(x, m%dx_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call ED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_CopyOutput(y, m%y_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - - !---------------------------------------------------------------------------- - ! Linearization - !---------------------------------------------------------------------------- - - ! If linearization is requested, initialize arrays - if (Linearize .or. p%CompAeroMaps) then - call MV_InitLinArrays(p%Vars, 2, & - InitOut%LinNames_x, InitOut%RotFrame_x, InitOut%DerivOrder_x, & - InitOut%LinNames_u, InitOut%RotFrame_u, InitOut%IsLoad_u, & - InitOut%LinNames_y, InitOut%RotFrame_y, ErrStat2, ErrMsg2) - if (Failed()) return - end if + call ED_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! AeroMap @@ -11433,26 +11316,11 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat if (p%CompAeroMaps) then ! Initialize index for variables flagged with VF_AeroMap - call MV_InitVarIdx(p%Vars, p%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2) - if (Failed()) return + call MV_InitVarIdx(p%Vars, p%Vars%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2); if (Failed()) return ! Update dx indices to select the accelerations - p%IdxAeroMap%idx = p%IdxAeroMap%idx + p%Vars%Nx/2 - - ! Set parameters - p%NActvDOF_Lin = p%DOFs%NActvDOF / p%NumBl ! we have only blade DOFs, and we are going to use only 1 of the blades - p%NActvDOF_Stride = p%NumBl - p%NActvVelDOF_Lin = 0 ! we do NOT have velocity states - - ! Get subset of linearization arrays - InitOut%LinNames_x = InitOut%LinNames_x(p%IdxAeroMap%ix) - InitOut%RotFrame_x = InitOut%RotFrame_x(p%IdxAeroMap%ix) - InitOut%DerivOrder_x = InitOut%DerivOrder_x(p%IdxAeroMap%ix) - InitOut%LinNames_u = InitOut%LinNames_u(p%IdxAeroMap%iu) - InitOut%RotFrame_u = InitOut%RotFrame_u(p%IdxAeroMap%iu) - InitOut%IsLoad_u = InitOut%IsLoad_u(p%IdxAeroMap%iu) - InitOut%LinNames_y = InitOut%LinNames_y(p%IdxAeroMap%iy) - InitOut%RotFrame_y = InitOut%RotFrame_y(p%IdxAeroMap%iy) + p%Vars%IdxAeroMap%idx = p%Vars%IdxAeroMap%idx + size(p%Vars%IdxAeroMap%idx)/2 + end if contains @@ -11497,6 +11365,8 @@ subroutine ED_PackStateValues(p, x, ary) ary(p%Vars%x(i)%iLoc(1)) = x%QT(p%Vars%x(i)%iUsr(1)) case (VF_TransVel, VF_AngularVel) ary(p%Vars%x(i)%iLoc(1)) = x%QDT(p%Vars%x(i)%iUsr(1)) + case default + ary(p%Vars%x(i)%iLoc(1)) = 0.0_R8Ki end select end do end subroutine @@ -11579,7 +11449,7 @@ subroutine ED_PackOutputValues(p, y, Ary, PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarYawRate, y%YawRate, Ary) call MV_Pack(p%Vars%y, p%iVarHSS_Spd, y%HSS_Spd, Ary) if (PackWriteOutput) then - do i = p%iVarOutput, size(p%Vars%y) + do i = p%iVarWriteOut, size(p%Vars%y) call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) end do end if From aad062b878fc717aafd8c60311d779d954c7ebee Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 14:22:00 +0000 Subject: [PATCH 052/319] Add Module variables to ServoDyn --- modules/servodyn/src/ServoDyn.f90 | 278 ++++++++++++++++++++++++++---- 1 file changed, 249 insertions(+), 29 deletions(-) diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index a5e683526f..7b5aba22cd 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -586,6 +586,11 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO InitOut%CouplingScheme = ExplicitLoose END IF + !............................................................................................ + ! Initialize module variables + !............................................................................................ + call SrvD_InitVars( InitInp, u, p, x, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !............................................................................................ ! Close summary file: @@ -616,6 +621,211 @@ subroutine Cleanup() ! Ignore any errors here end subroutine Cleanup END SUBROUTINE SrvD_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes module variables for use by the solver and linearization. +subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(SrvD_InitInputType), intent(in) :: InitInp !< Initialization input + type(SrvD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SrvD_ParameterType), intent(inout) :: p !< Parameters + type(SrvD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(SrvD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SrvD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SrvD_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SrvD_InitVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(ChanLen) :: Desc + integer(IntKi) :: i, j, k, iUser + character(36), parameter :: StCLabels(*) = [& + ' local displacement state X m ', & + ' local displacement state Y m ', & + ' local displacement state Z m ', & + ' local displacement state dX/dt m/s', & + ' local displacement state dY/dt m/s', & + ' local displacement state dZ/dt m/s'] + real(R8Ki) :: xPerturb, uPerturbTrans, uPerturbAng, uPerturbs(6) + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Calculate perturbations + xPerturb = 0.2_R8Ki*Pi/180.0_R8Ki * max(TwoNorm(InitInp%NacRefPos - InitInp%TwrBaseRefPos), 1.0_R8Ki) + + ! Blade Structural Controller + do i = 1, p%NumBStC + do j = 1, p%NumBl + Desc = 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j) + call MV_AddVar(p%Vars%x, Desc, VF_Scalar, Num=6, & + Flags=VF_DerivOrder2+VF_RotFrame, & + LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & + Perturb=xPerturb) + end do + end do + + ! Nacelle Structural Controller + do j = 1, p%NumNStC + Desc = 'Nacelle StC '//Num2LStr(j) + call MV_AddVar(p%Vars%x, Desc, VF_Scalar, Num=6, & + Flags=VF_DerivOrder2, & + LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & + Perturb=xPerturb) + enddo + + ! Tower Structural Controller + do j = 1, p%NumTStC + Desc = 'Tower StC '//Num2LStr(j) + call MV_AddVar(p%Vars%x, Desc, VF_Scalar, Num=6, & + Flags=VF_DerivOrder2, & + LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & + Perturb=xPerturb) + enddo + + ! Substructure Structural Controller + do j = 1, p%NumSStC + Desc = 'Substructure StC '//Num2LStr(j) + call MV_AddVar(p%Vars%x, Desc, VF_Scalar, Num=6, & + Flags=VF_DerivOrder2, & + LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & + Perturb=xPerturb) + enddo + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + uPerturbTrans = 0.2_R8Ki*Pi_R8/180.0_R8Ki * max(real(TwoNorm(InitInp%NacRefPos - InitInp%TwrBaseRefPos),R8Ki), 1.0_R8Ki) + uPerturbAng = 0.2_R8Ki * Pi_R8 / 180.0_R8Ki + uPerturbs = [uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng] + + call MV_AddVar(p%Vars%u, "Yaw", VF_Scalar, LinNames=['Yaw, Nm']) + + call MV_AddVar(p%Vars%u, "YawRate", VF_Scalar, LinNames=['YawRate, Nm']) + + call MV_AddVar(p%Vars%u, "HSS_Spd", VF_Scalar, LinNames=['HSS_Spd, W']) + + ! Structural controllers + do i = 1, p%NumBStC + do j = 1, p%NumBl + call MV_AddMeshVar(p%Vars%u, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), MotionFields, & + Mesh=u%BStCMotionMesh(i, j), & + Perturbs=uPerturbs) + end do + end do + + do j = 1, p%NumNStC + call MV_AddMeshVar(p%Vars%u, 'Nacelle StC '//Num2LStr(j), MotionFields, & + Mesh=u%NStCMotionMesh(j), & + Perturbs=uPerturbs) + enddo + + do j = 1, p%NumTStC + call MV_AddMeshVar(p%Vars%u, 'Tower StC '//Num2LStr(j), MotionFields, & + Mesh=u%TStCMotionMesh(j), & + Perturbs=uPerturbs) + enddo + + do j = 1, p%NumSStC + call MV_AddMeshVar(p%Vars%u, 'Substructure StC '//Num2LStr(j), MotionFields, & + Mesh=u%SStCMotionMesh(j), & + Perturbs=uPerturbs) + enddo + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddVar(p%Vars%y, "BlPitchCom", VF_Scalar, & + Flags=VF_RotFrame, & + Num=size(y%BlPitchCom), & + LinNames=[('BlPitchCom('//trim(Num2LStr(i))//'), rad', i = 1, size(y%BlPitchCom))]) + + call MV_AddVar(p%Vars%y, "YawMom", VF_Scalar, & + LinNames=['YawMom, Nm']) + + call MV_AddVar(p%Vars%y, "GenTrq", VF_Scalar, & + LinNames=['GenTrq, Nm']) + + call MV_AddVar(p%Vars%y, "ElecPwr", VF_Scalar, & + LinNames=['ElecPwr, W']) + + ! Structural controllers + do i = 1, p%NumBStC + do j = 1, p%NumBl + call MV_AddMeshVar(p%Vars%y, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), LoadFields, & + Mesh=y%BStCLoadMesh(i,j)) + end do + end do + + do j = 1, p%NumNStC + call MV_AddMeshVar(p%Vars%y, 'Nacelle StC '//Num2LStr(j), LoadFields, & + Mesh=y%NStCLoadMesh(j)) + enddo + + do j = 1, p%NumTStC + call MV_AddMeshVar(p%Vars%y, 'Tower StC '//Num2LStr(j), LoadFields, & + Mesh=y%TStCLoadMesh(j)) + enddo + + do j = 1, p%NumSStC + call MV_AddMeshVar(p%Vars%y, 'Substructure StC '//Num2LStr(j), LoadFields, & + Mesh=y%SStCLoadMesh(j)) + enddo + + ! Outputs + do i = 1, p%NumOuts + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & + Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & + iUsr=i, & + LinNames=[trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units], & + Active=(p%OutParam(i)%Indx > 0)) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call SrvD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SrvD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SrvD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SrvD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + function OutParamFlags(indx) result(flagsRes) + integer(IntKi), intent(in) :: indx + integer(IntKi) :: flagsRes + integer(IntKi), parameter :: RotatingFrameIndices(*) = [& + BlPitchC, BStC_XQ, BStC_XQD, BStC_YQ, BStC_YQD, BStC_ZQ, BStC_ZQD, & + BStC_Fxl, BStC_Fyl, BStC_Fzl, BStC_Mxl, BStC_Myl, BStC_Mzl] + if (any(indx == RotatingFrameIndices)) then + flagsRes = VF_RotFrame + else + flagsRes = VF_None + end if + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Initialize everything needed for linearization subroutine SrvD_Init_Jacobian( InitInp, p, u, y, InitOut, ErrStat, ErrMsg ) @@ -4252,12 +4462,12 @@ SUBROUTINE SrvD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_o TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None @@ -4301,40 +4511,50 @@ end function Failed !> Get the operating point inputs and pack subroutine Get_u_op() - integer(IntKi) :: nu,i,j,index_next + integer(IntKi) :: i, j, iVar if (.not. allocated(u_op)) then - ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do - nu = p%Jac_nu & - + p%NumBStC * 6 * p%NumBl & ! Jac_nu has 3 for Orientation, but we need 9 at each BStC instance on each blade - + p%NumNStC * 6 & ! Jac_nu has 3 for Orientation, but we need 9 at each NStC instance - + p%NumTStC * 6 & ! Jac_nu has 3 for Orientation, but we need 9 at each TStC instance - + p%NumSStC * 6 ! Jac_nu has 3 for Orientation, but we need 9 at each SStC instance - CALL AllocAry( u_op, nu, 'u_op', ErrStat2, ErrMsg2 ) - if (Failed()) return; + call AllocAry( u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2 ); if (Failed()) return end if - index_next=1 - ! Fixed inputs - u_op(index_next) = u%Yaw; index_next = index_next + 1 - u_op(index_next) = u%YawRate; index_next = index_next + 1 - u_op(index_next) = u%HSS_Spd; index_next = index_next + 1 + iVar = 1 + call MV_Pack(p%Vars%u, iVar, u%Yaw, u_op) + iVar = iVar + 1 + call MV_Pack(p%Vars%u, iVar, u%YawRate, u_op) + iVar = iVar + 1 + call MV_Pack(p%Vars%u, iVar, u%HSS_Spd, u_op) + iVar = iVar + 1 + !--------------------- ! StC related inputs - do j=1,p%NumBStC ! Blade - do i=1,p%NumBl - call PackMotionMesh( u%BStCMotionMesh(i,j), u_op, index_next ) + !--------------------- + + ! Blade + do j = 1, p%NumBStC + do i = 1, p%NumBl + call MV_Pack(p%Vars%u, iVar, u%BStCMotionMesh(i,j), u_op) + iVar = iVar + 6 enddo enddo - do j=1,p%NumNStC ! Nacelle - call PackMotionMesh( u%NStCMotionMesh(j), u_op, index_next ) + + ! Nacelle + do j = 1, p%NumNStC + call MV_Pack(p%Vars%u, iVar, u%NStCMotionMesh(j), u_op) + iVar = iVar + 6 enddo - do j=1,p%NumTStC ! Tower - call PackMotionMesh( u%TStCMotionMesh(j), u_op, index_next ) + + ! Tower + do j = 1, p%NumTStC + call MV_Pack(p%Vars%u, iVar, u%TStCMotionMesh(j), u_op) + iVar = iVar + 6 enddo - do j=1,p%NumSStC ! Sub-structure - call PackMotionMesh( u%SStCMotionMesh(j), u_op, index_next ) + + ! Sub-structure + do j = 1, p%NumSStC + call MV_Pack(p%Vars%u, iVar, u%SStCMotionMesh(j), u_op) + iVar = iVar + 6 enddo + end subroutine Get_u_op !> Get the operating point outputs and pack From be71539bf1ce8cbf6e91c8efac69fe27bbf3757b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 16:22:05 +0000 Subject: [PATCH 053/319] Add Module variables to openfast-library, start replacing FAST_Lin --- modules/openfast-library/CMakeLists.txt | 4 + modules/openfast-library/src/FAST_Funcs.f90 | 875 +++++++++++++++++ modules/openfast-library/src/FAST_ModLin.f90 | 899 ++++++++++++++++++ modules/openfast-library/src/FAST_Mods.f90 | 1 + .../openfast-library/src/FAST_Registry.txt | 131 +++ 5 files changed, 1910 insertions(+) create mode 100644 modules/openfast-library/src/FAST_Funcs.f90 create mode 100644 modules/openfast-library/src/FAST_ModLin.f90 diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 12ea3be9e5..617d8dfc4d 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -71,6 +71,10 @@ add_library(openfast_postlib STATIC src/FAST_Solver.f90 src/FAST_SS_Subs.f90 src/FAST_SS_Solver.f90 + + src/FAST_Funcs.f90 + src/FAST_ModLin.f90 + src/FAST_Mesh.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 new file mode 100644 index 0000000000..78c867ac59 --- /dev/null +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -0,0 +1,875 @@ +!******************************************************************************* +! FAST_Funcs provides the glue code a uniform interface to module functions. +!............................................................................... +! LICENSING +! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!******************************************************************************* +!> This module contains functions for calling module subroutines +module FAST_Funcs + +use FAST_Types +use FAST_ModTypes +use NWTC_LAPACK +use AeroDyn +use BeamDyn +use ElastoDyn +use HydroDyn +use InflowWind +use SeaState +use ServoDyn +use SubDyn + +implicit none + +#define SOLVER_DEBUG + +contains + +subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_ExtrapInterp' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + type(VarsIdxType), pointer :: VarIdx + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + + call AD_Input_ExtrapInterp(T%AD%Input, T%AD%InputTimes, T%AD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call AD_CopyInput(T%AD%Input(j), T%AD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%AD%InputTimes(j + 1) = T%AD%InputTimes(j) + end do + call AD_CopyInput(T%AD%u, T%AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%AD%InputTimes(1) = t_global_next + + case (Module_BD) + + call BD_Input_ExtrapInterp(T%BD%Input(:, ModData%Ins), T%BD%InputTimes(:, ModData%Ins), T%BD%u(ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call BD_CopyInput(T%BD%Input(j, ModData%Ins), T%BD%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%BD%InputTimes(j + 1, ModData%Ins) = T%BD%InputTimes(j, ModData%Ins) + end do + call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input(1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%BD%InputTimes(1, ModData%Ins) = t_global_next + + case (Module_ED) + + call ED_Input_ExtrapInterp(T%ED%Input, T%ED%InputTimes, T%ED%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call ED_CopyInput(T%ED%Input(j), T%ED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%ED%InputTimes(j + 1) = T%ED%InputTimes(j) + end do + call ED_CopyInput(T%ED%u, T%ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%ED%InputTimes(1) = t_global_next + +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + + ! TODO: Fix inconsistent function name (HydroDyn_CopyInput) + call HydroDyn_Input_ExtrapInterp(T%HD%Input, T%HD%InputTimes, T%HD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call HydroDyn_CopyInput(T%HD%Input(j), T%HD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%HD%InputTimes(j + 1) = T%HD%InputTimes(j) + end do + call HydroDyn_CopyInput(T%HD%u, T%HD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%HD%InputTimes(1) = t_global_next + +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) + + call InflowWind_Input_ExtrapInterp(T%IfW%Input, T%IfW%InputTimes, T%IfW%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call InflowWind_CopyInput(T%IfW%Input(j), T%IfW%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%IfW%InputTimes(j + 1) = T%IfW%InputTimes(j) + end do + call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%IfW%InputTimes(1) = t_global_next + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + + call SD_Input_ExtrapInterp(T%SD%Input, T%SD%InputTimes, T%SD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call SD_CopyInput(T%SD%Input(j), T%SD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SD%InputTimes(j + 1) = T%SD%InputTimes(j) + end do + call SD_CopyInput(T%SD%u, T%SD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SD%InputTimes(1) = t_global_next + + case (Module_SeaSt) + + ! call SeaSt_Input_ExtrapInterp(T%SeaSt%Input, T%SeaSt%InputTimes, T%SeaSt%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + ! do j = T%p_FAST%InterpOrder, 1, -1 + ! call SeaSt_CopyInput(T%SeaSt%Input(j), T%SeaSt%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! T%SeaSt%InputTimes(j + 1) = T%SeaSt%InputTimes(j) + ! end do + ! call SeaSt_CopyInput(T%SeaSt%u, T%SeaSt%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! T%SeaSt%InputTimes(1) = t_global_next + + case (Module_SrvD) + + call SrvD_Input_ExtrapInterp(T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call SrvD_CopyInput(T%SrvD%Input(j), T%SrvD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SrvD%InputTimes(j + 1) = T%SrvD%InputTimes(j) + end do + call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SrvD%InputTimes(1) = t_global_next + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + return + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_InitIO(Mods, ThisTime, DT, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) !< Module data + real(DbKi), intent(in) :: ThisTime !< Initial simulation time (almost always 0) + real(DbKi), intent(in) :: DT !< Glue code time step size + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InitIO' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(DbKi) :: t_global_next ! Simulation time for computing outputs + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through modules + do i = 1, size(Mods) + + ! Copy state from current to predicted and initialze meshes + call FAST_CopyStates(Mods(i), T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Select based on module ID + select case (Mods(i)%ID) + + case (Module_AD) + + T%AD%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call AD_CopyInput(T%AD%Input(1), T%AD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call AD_CopyInput(T%AD%Input(1), T%AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_BD) + + T%BD%InputTimes(:, Mods(i)%Ins) = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call BD_CopyInput(T%BD%Input(1, Mods(i)%Ins), T%BD%Input(k, Mods(i)%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call BD_CopyInput(T%BD%Input(1, Mods(i)%Ins), T%BD%u(Mods(i)%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ED) + + T%ED%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call ED_CopyInput(T%ED%Input(1), T%ED%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ED_CopyInput(T%ED%Input(1), T%ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + + T%HD%InputTimes(:) = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call HydroDyn_CopyInput(T%HD%Input(1), T%HD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call HydroDyn_CopyInput(T%HD%Input(1), T%HD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_IceD) +! case (Module_IceF) + + case (Module_IfW) + + ! TODO: Fix inconsistent function name + T%IfW%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + + T%SD%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call SD_CopyInput(T%SD%Input(1), T%SD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call SD_CopyInput(T%SD%Input(1), T%SD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_SeaSt) + case (Module_SrvD) + + T%SrvD%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mods(i)%ID)), ErrStat, ErrMsg, RoutineName) + return + end select + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) + integer(IntKi), intent(in) :: n_t_global !< Integer time step + real(R8Ki), intent(inout) :: x_TC(:) !< Tight coupling state array + real(R8Ki), intent(inout) :: q_TC(:, :) !< Tight coupling state matrix + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_UpdateStates' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + real(DbKi) :: t_module ! Current simulation time for module + + ErrStat = ErrID_None + ErrMsg = '' + + ! Copy from current to predicted state (MESH_UPDATECOPY) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call AD_UpdateStates(t_module, n_t_module, T%AD%Input, T%AD%InputTimes, & + T%AD%p, T%AD%x(STATE_PRED), T%AD%xd(STATE_PRED), & + T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), & + T%AD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_BD) + + associate (p_BD => T%BD%p(ModData%Ins), & + m_BD => T%BD%m(ModData%Ins), & + u_BD => T%BD%Input(1, ModData%Ins), & + x_BD => T%BD%x(ModData%Ins, STATE_PRED), & + os_BD => T%BD%OtherSt(ModData%Ins, STATE_PRED)) + + ! Transfer tight coupling states to module + call BD_PackStateValues(p_BD, x_BD, m_BD%Jac%x) + ! call XferGblToLoc1D(ModData%ixs, x_TC, m_BD%Jac%x) + call BD_UnpackStateValues(p_BD, m_BD%Jac%x, x_BD) + + ! TODO: Fix state reset + ! Set BD accelerations and algorithmic accelerations from q matrix + ! do j = 1, size(p_BD%Vars%x) + ! select case (p_BD%Vars%x(j)%Field) + ! case (VF_TransDisp) + ! os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 3) + ! os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 4) + ! case (VF_Orientation) + ! os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 3) + ! os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 4) + ! end select + ! end do + + ! Update the global reference + call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg) + if (Failed()) return + + ! Update q matrix accelerations and algorithmic accelerations from BD + ! do j = 1, size(p_BD%Vars%x) + ! select case (p_BD%Vars%x(j)%Field) + ! case (VF_TransDisp) + ! q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) + ! q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) + ! case (VF_Orientation) + ! q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) + ! q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) + ! end select + ! end do + + ! Transfer updated states to solver + call BD_PackStateValues(p_BD, x_BD, m_BD%Jac%x) + ! call XferLocToGbl1D(ModData%ixs, m_BD%Jac%x, x_TC) + end associate + + case (Module_ED) + + associate (p_ED => T%ED%p, m_ED => T%ED%m, & + u_ED => T%ED%Input(1), x_ED => T%ED%x(STATE_PRED)) + + ! Transfer tight coupling states to module + call ED_PackStateValues(p_ED, x_ED, m_ED%Jac%x) + ! call XferGblToLoc1D(ModData%ixs, x_TC, m_ED%Jac%x) + call ED_UnpackStateValues(p_ED, m_ED%Jac%x, x_ED) + + ! Update the azimuth angle + call ED_UpdateAzimuth(p_ED, x_ED, T%p_FAST%DT) + + ! Transfer updated states to solver + call ED_PackStateValues(p_ED, x_ED, m_ED%Jac%x) + ! call XferLocToGbl1D(ModData%ixs, m_ED%Jac%x, x_TC) + + end associate + +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call HydroDyn_UpdateStates(t_module, n_t_module, T%HD%Input, T%HD%InputTimes, T%HD%p, & + T%HD%x(STATE_PRED), T%HD%xd(STATE_PRED), & + T%HD%z(STATE_PRED), T%HD%OtherSt(STATE_PRED), & + T%HD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, & + T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & + T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), & + T%IfW%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + + associate (p_SD => T%SD%p, m_SD => T%SD%m, & + u_SD => T%SD%Input(1), x_SD => T%SD%x(STATE_PRED)) + + ! TODO: Add Lin struct to SubDyn + ! Transfer tight coupling states to module + ! call SD_PackStateValues(p_SD, x_SD, m_SD%Lin%x) + ! call XferGblToLoc1D(ModData%ixs, x_TC, m_SD%Lin%x) + ! call SD_UnpackStateValues(p_SD, m_SD%Lin%x, x_SD) + + end associate + +! case (Module_SeaSt) + case (Module_SrvD) + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, & + T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & + T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), & + T%SrvD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + return + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_CalcOutput(ModData, Maps, ThisTime, ThisState, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) !< Output->Input mappings + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: ThisState !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CalcOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + call AD_CalcOutput(ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), T%AD%z(ThisState), & + T%AD%OtherSt(ThisState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep) + + case (Module_BD) + call BD_CalcOutput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), & + T%BD%xd(ModData%Ins, ThisState), T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_ED) + call ED_CalcOutput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2) +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + call HydroDyn_CalcOutput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2) + +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) + call InflowWind_CalcOutput(ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(ThisState), T%IfW%xd(ThisState), T%IfW%z(ThisState), & + T%IfW%OtherSt(ThisState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + call SD_CalcOutput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), T%SD%z(ThisState), & + T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2) + +! case (Module_SeaSt) + case (Module_SrvD) + call SrvD_CalcOutput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), T%SrvD%z(ThisState), & + T%SrvD%OtherSt(ThisState), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + return + end select + + ! Check for errors during calc output call + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Set updated flag in mappings where this module is the source + Maps(ModData%SrcMaps)%Ready = .true. + +end subroutine + +subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilter, & + u_op, y_op, x_op, dx_op, xd_op, z_op) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: ThisState !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + integer(IntKi), optional, intent(in) :: FlagFilter !< Flag to filter variable calculations + real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs + real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states + real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states + + character(*), parameter :: RoutineName = 'FAST_CalcOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + call AD_GetOP(ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), T%AD%z(ThisState), & + T%AD%OtherSt(ThisState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + + case (Module_BD) + call BD_GetOP(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), & + T%BD%xd(ModData%Ins, ThisState), T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + + case (Module_ED) + call ED_GetOP(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + ! call HydroDyn_GetOP(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + ! T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) + call InflowWind_GetOP(ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(ThisState), T%IfW%xd(ThisState), T%IfW%z(ThisState), & + T%IfW%OtherSt(ThisState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + call SD_GetOP(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), T%SD%z(ThisState), & + T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + +! case (Module_SeaSt) + case (Module_SrvD) + call SrvD_GetOP(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), T%SrvD%z(ThisState), & + T%SrvD%OtherSt(ThisState), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + + case default + ! Unknown module + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Unknown module ID "//trim(Num2LStr(ModData%ID)) + end select + + ! Check for errors during calc output call + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +end subroutine + +subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilter, dYdu, dXdu) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: ThisState !< State + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + integer(IntKi), optional, intent(in) :: FlagFilter !< Variable index number + real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :), dXdu(:, :) + + character(*), parameter :: RoutineName = 'FAST_JacobianPInput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + +! case (Module_AD) + case (Module_BD) + call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & + T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + + case (Module_ED) + call ED_JacobianPInput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + ! call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + ! T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + ! FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + + case (Module_SD) + ! call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & + ! T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, & + ! ErrStat2, ErrMsg2, FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + +! case (Module_SeaSt) + + case (Module_SrvD) + call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & + T%SrvD%z(ThisState), T%SrvD%OtherSt(ThisState), T%SrvD%y, T%SrvD%m, & + ErrStat2, ErrMsg2, dYdu=dYdu, dXdu=dXdu) + + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Unknown module ID "//trim(Num2LStr(ModData%ID)) + end select + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +end subroutine + +subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, StateRotation) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: ThisState !< State + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + integer(IntKi), optional :: FlagFilter + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: StateRotation(:, :) + + character(*), parameter :: RoutineName = 'FAST_JacobianPContState' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + +! case (Module_AD) + case (Module_BD) + call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & + T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx, StateRotation=StateRotation) + + case (Module_ED) + call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & + T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), & + T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + ! call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & + ! T%HD%x(ThisState), T%HD%xd(ThisState), & + ! T%HD%z(ThisState), T%HD%OtherSt(ThisState), & + ! T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + ! FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + ! call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & + ! T%SD%x(ThisState), T%SD%xd(ThisState), & + ! T%SD%z(ThisState), T%SD%OtherSt(ThisState), & + ! T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + ! FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + +! case (Module_SeaSt) + case (Module_SrvD) + call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(1), T%SrvD%p, & + T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & + T%SrvD%z(ThisState), T%SrvD%OtherSt(ThisState), & + T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Unknown module ID "//trim(Num2LStr(ModData%ID)) + end select + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +end subroutine + +subroutine FAST_SaveStates(ModData, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + ! Copy state from predicted to current with MESH_UPDATECOPY + call FAST_CopyStates(ModData, T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) +end subroutine + +subroutine XferLocToGbl1D(Inds, Loc, Gbl) + integer(IntKi), intent(in) :: Inds(:, :) + real(R8Ki), intent(in) :: Loc(:) + real(R8Ki), intent(inout) :: Gbl(:) + integer(IntKi) :: i + do i = 1, size(Inds, dim=2) + Gbl(Inds(2, i)) = Loc(Inds(1, i)) + end do +end subroutine + +subroutine XferGblToLoc1D(Inds, Gbl, Loc) + integer(IntKi), intent(in) :: Inds(:, :) + real(R8Ki), intent(in) :: Gbl(:) + real(R8Ki), intent(inout) :: Loc(:) + integer(IntKi) :: i + do i = 1, size(Inds, dim=2) + Loc(Inds(1, i)) = Gbl(Inds(2, i)) + end do +end subroutine + +subroutine XferLocToGbl2D(RowInds, ColInds, Loc, Gbl) + integer(IntKi), intent(in) :: RowInds(:, :), ColInds(:, :) + real(R8Ki), intent(in) :: Loc(:, :) + real(R8Ki), intent(inout) :: Gbl(:, :) + integer(IntKi) :: i, j + do i = 1, size(ColInds, dim=2) + do j = 1, size(RowInds, dim=2) + Gbl(RowInds(2, j), ColInds(2, i)) = Loc(RowInds(1, j), ColInds(1, i)) + end do + end do +end subroutine + +subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(in) :: Src, Dst !< State indices + integer(IntKi), intent(in) :: CtrlCode !< Mesh copy code + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CopyStates' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j + integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + real(DbKi) :: t_module ! Current simulation time for module + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + + call AD_CopyContState(T%AD%x(Src), T%AD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyDiscState(T%AD%xd(Src), T%AD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyConstrState(T%AD%z(Src), T%AD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyOtherState(T%AD%OtherSt(Src), T%AD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_BD) + + call BD_CopyContState(T%BD%x(ModData%Ins, Src), T%BD%x(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyDiscState(T%BD%xd(ModData%Ins, Src), T%BD%xd(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyConstrState(T%BD%z(ModData%Ins, Src), T%BD%z(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyOtherState(T%BD%OtherSt(ModData%Ins, Src), T%BD%OtherSt(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ED) + + call ED_CopyContState(T%ED%x(Src), T%ED%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(Src), T%ED%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(Src), T%ED%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(Src), T%ED%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + + ! TODO: Fix inconsistent function name + call HydroDyn_CopyContState(T%HD%x(Src), T%HD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HydroDyn_CopyDiscState(T%HD%xd(Src), T%HD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HydroDyn_CopyConstrState(T%HD%z(Src), T%HD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HydroDyn_CopyOtherState(T%HD%OtherSt(Src), T%HD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) + + ! call IfW_CopyContState(T%IfW%x(Src), T%IfW%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyDiscState(T%IfW%xd(Src), T%IfW%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyConstrState(T%IfW%z(Src), T%IfW%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyOtherState(T%IfW%OtherSt(Src), T%IfW%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + + call SD_CopyContState(T%SD%x(Src), T%SD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyDiscState(T%SD%xd(Src), T%SD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyConstrState(T%SD%z(Src), T%SD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyOtherState(T%SD%OtherSt(Src), T%SD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_SeaSt) + case (Module_SrvD) + + call SrvD_CopyContState(T%SrvD%x(Src), T%SrvD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyDiscState(T%SrvD%xd(Src), T%SrvD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyConstrState(T%SrvD%z(Src), T%SrvD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyOtherState(T%SrvD%OtherSt(Src), T%SrvD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + return + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModLin.f90 new file mode 100644 index 0000000000..0f5af47446 --- /dev/null +++ b/modules/openfast-library/src/FAST_ModLin.f90 @@ -0,0 +1,899 @@ +!********************************************************************************************************************************** +! FAST_ModLin.f90 performs linearization using the ModVars module. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +module FAST_ModLin + +use NWTC_Library +use NWTC_LAPACK + +use FAST_Types +use FAST_Funcs +use FAST_Mesh + +implicit none + +private +public :: ModLin_Init, ModLin_Linearize_OP + +contains + +subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) + + type(ModDataType), intent(inout) :: ModGlue !< Module data for glue code + type(ModDataType), allocatable, intent(inout) :: Mods(:) !< Data for all modules + type(ML_ParameterType), intent(inout) :: p !< ModLin parameters + type(ML_MiscVarType), intent(inout) :: m !< ModLin miscvars + type(FAST_ParameterType), intent(inout) :: p_FAST + type(FAST_MiscVarType), intent(inout) :: m_FAST + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModLin_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi), allocatable :: modIDs(:), modIdx(:) + integer(IntKi) :: i, j, k + integer(IntKi) :: FlagFilters + character(LinChanLen), allocatable :: xLinNames(:), uLinNames(:), yLinNames(:) + character(20) :: NamePrefix + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! FAST Lin Settings + !---------------------------------------------------------------------------- + + m_FAST%Lin%NextLinTimeIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_NEWCOPY + m_FAST%Lin%n_rot = 0 + m_FAST%Lin%IsConverged = .false. + m_FAST%Lin%FoundSteady = .false. + m_FAST%Lin%ForceLin = .false. + m_FAST%Lin%AzimIndx = 1 + + p_FAST%AzimDelta = TwoPi/p_FAST%NLinTimes + + !---------------------------------------------------------------------------- + ! Module order and indexing + !---------------------------------------------------------------------------- + + ! If no modules were added, return error + if (.not. allocated(Mods)) then + call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Create array of indices for Mods array + modIdx = [(i, i=1, size(Mods))] + + ! Get array of module IDs + modIDs = [(Mods(i)%ID, i=1, size(Mods))] + + ! Establish module index order for linearization + p%iMod = [pack(modIdx, ModIDs == Module_IfW), & ! InflowWind + pack(modIdx, ModIDs == Module_SrvD), & ! ServoDyn + pack(modIdx, ModIDs == Module_ED), & ! ElastoDyn + pack(modIdx, ModIDs == Module_BD), & ! BeamDyn + pack(modIdx, ModIDs == Module_AD), & ! AeroDyn + pack(modIdx, ModIDs == Module_SeaSt), & ! SeaState + pack(modIdx, ModIDs == Module_HD), & ! HydroDyn + pack(modIdx, ModIDs == Module_SD), & ! SubDyn + pack(modIdx, ModIDs == Module_MAP), & ! MAP++ + pack(modIdx, ModIDs == Module_MD)] ! MoorDyn + + ! Loop through modules, if module is not in index, return with error + do i = 1, size(Mods) + if (.not. any(i == p%iMod)) then + call SetErrStat(ErrID_Fatal, "Module "//trim(Mods(i)%Abbr)//" not supported in linearization", & + ErrStat, ErrMsg, RoutineName) + return + end if + end do + + !---------------------------------------------------------------------------- + ! Glue Module Variables + !---------------------------------------------------------------------------- + + ! Allocate variable structure for glue + allocate (ModGlue%Vars) + + ! Initialize number of values in each variable group + ModGlue%Vars%Nx = 0 + ModGlue%Vars%Nxd = 0 + ModGlue%Vars%Nz = 0 + ModGlue%Vars%Nu = 0 + ModGlue%Vars%Ny = 0 + + ! Allocate arrays for glue variables + allocate (ModGlue%Vars%x(0), ModGlue%Vars%xd(0), ModGlue%Vars%z(0), ModGlue%Vars%u(0), ModGlue%Vars%y(0)) + + ! Loop through each module by index + do i = 1, size(p%iMod) + associate (ModData => Mods(p%iMod(i))) + + ! Create variable name prefix for linearization names. Add instance + ! number to module abbreviation if more than 1 instance or the module is BeamDyn + NamePrefix = ModData%Abbr + if ((ModData%ID == Module_BD) .or. (count(modIDs == ModData%ID) > 1)) then + NamePrefix = trim(NamePrefix)//"_"//Num2LStr(ModData%Ins) + end if + + !---------------------------------------------------------------------- + ! Module continuous state variables + !---------------------------------------------------------------------- + + ! Set linearize flag on all variables + do j = 1, size(ModData%Vars%x) + call MV_SetFlags(ModData%Vars%x(j), VF_Linearize) + end do + + ! Set module data start index in global arrays, increment data size + ModData%ixg = ModGlue%Vars%Nx + 1 + ModGlue%Vars%Nx = ModGlue%Vars%Nx + ModData%Vars%Nx + + ! Save start index of module variables and append to glue code variables + k = size(ModGlue%Vars%x) + 1 + ModGlue%Vars%x = [ModGlue%Vars%x, ModData%Vars%x] + + ! Loop through added variables and add name prefix to linearization names + call AddLinNamePrefix(ModGlue%Vars%x(k:), NamePrefix) + + !---------------------------------------------------------------------- + ! Module discrete state variables + !---------------------------------------------------------------------- + + ! Set module data start index in global arrays, increment data size + ModData%ixdg = ModGlue%Vars%Nxd + 1 + ModGlue%Vars%Nxd = ModGlue%Vars%Nxd + ModData%Vars%Nxd + + ! Save start index of module variables and append to glue code variables + k = size(ModGlue%Vars%xd) + 1 + ModGlue%Vars%xd = [ModGlue%Vars%xd, ModData%Vars%xd] + + ! Loop through added variables and add name prefix to linearization names + call AddLinNamePrefix(ModGlue%Vars%xd(k:), NamePrefix) + + !---------------------------------------------------------------------- + ! Module constraint state variables + !---------------------------------------------------------------------- + + ! Set module data start index in global arrays, increment data size + ModData%izg = ModGlue%Vars%Nz + 1 + ModGlue%Vars%Nz = ModGlue%Vars%Nz + ModData%Vars%Nz + + ! Save start index of module variables and append to glue code variables + k = size(ModGlue%Vars%z) + 1 + ModGlue%Vars%z = [ModGlue%Vars%z, ModData%Vars%z] + + ! Loop through added variables and add name prefix to linearization names + call AddLinNamePrefix(ModGlue%Vars%z(k:), NamePrefix) + + !---------------------------------------------------------------------- + ! Module input variables + !---------------------------------------------------------------------- + + ! Add or remove linearize flag based on requested output + select case (p_FAST%LinInputs) + case (LIN_NONE) + do j = 1, size(ModData%Vars%u) + call MV_UnsetFlags(ModData%Vars%u(j), VF_Linearize) + end do + case (LIN_STANDARD) + ! For standard inputs, use VF_Linearize flag set in the module + case (LIN_ALL) + do j = 1, size(ModData%Vars%u) + call MV_SetFlags(ModData%Vars%u(j), VF_Linearize) + end do + end select + + ! Set module data start index in global arrays, increment data size + ModData%iug = ModGlue%Vars%Nu + 1 + ModGlue%Vars%Nu = ModGlue%Vars%Nu + ModData%Vars%Nu + + ! Save start index of module variables and append to glue code variables + k = size(ModGlue%Vars%u) + 1 + ModGlue%Vars%u = [ModGlue%Vars%u, ModData%Vars%u] + + ! Loop through added variables and add name prefix to linearization names + call AddLinNamePrefix(ModGlue%Vars%u(k:), NamePrefix) + + !---------------------------------------------------------------------- + ! Module output variables + !---------------------------------------------------------------------- + + ! Add or remove linearize flag based on requested output + select case (p_FAST%LinOutputs) + case (LIN_NONE) + do j = 1, size(ModData%Vars%y) + call MV_UnsetFlags(ModData%Vars%y(j), VF_Linearize) + end do + case (LIN_STANDARD) ! Set linearize flag for write output variables + do j = 1, size(ModData%Vars%y) + if (MV_HasFlags(ModData%Vars%y(j), VF_WriteOut)) then + call MV_SetFlags(ModData%Vars%y(j), VF_Linearize) + else + call MV_UnsetFlags(ModData%Vars%y(j), VF_Linearize) + end if + end do + case (LIN_ALL) + do j = 1, size(ModData%Vars%y) + call MV_SetFlags(ModData%Vars%y(j), VF_Linearize) + end do + end select + + ! Set module data start index in global arrays, increment data size + ModData%iyg = ModGlue%Vars%Ny + 1 + ModGlue%Vars%Ny = ModGlue%Vars%Ny + ModData%Vars%Ny + + ! Save start index of module variables and append to glue code variables + k = size(ModGlue%Vars%y) + 1 + ModGlue%Vars%y = [ModGlue%Vars%y, ModData%Vars%y] + + ! Loop through added variables and add name prefix to linearization names + call AddLinNamePrefix(ModGlue%Vars%y(k:), NamePrefix) + + end associate + end do + + ! Calculate number of values in each group and set data location index + call CalcVarDataLoc(ModGlue%Vars%x, ModGlue%Vars%Nx) + call CalcVarDataLoc(ModGlue%Vars%xd, ModGlue%Vars%Nxd) + call CalcVarDataLoc(ModGlue%Vars%z, ModGlue%Vars%Nz) + call CalcVarDataLoc(ModGlue%Vars%u, ModGlue%Vars%Nu) + call CalcVarDataLoc(ModGlue%Vars%y, ModGlue%Vars%Ny) + + ! Initialize linearization index filtering + call MV_InitVarIdx(ModGlue%Vars, ModGlue%Vars%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Allocate linearization arrays and matrices + !---------------------------------------------------------------------------- + + ! Allocate linearization arrays + call AllocAry(ModGlue%Lin%x, ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dx, ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%xd, ModGlue%Vars%Nxd, "xd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%z, ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%u, ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%y, ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate full Jacobian matrices + call AllocAry(ModGlue%Lin%dYdu, ModGlue%Vars%Ny, ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dXdu, ModGlue%Vars%Nx, ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dYdx, ModGlue%Vars%Ny, ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dXdx, ModGlue%Vars%Nx, ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dUdu, ModGlue%Vars%Nu, ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dUdy, ModGlue%Vars%Nu, ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Mesh Mapping + !---------------------------------------------------------------------------- + + call FAST_InitMappings(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + subroutine CalcVarDataLoc(VarAry, DataSize) + type(ModVarType), intent(inout) :: VarAry(:) + integer(IntKi), intent(out) :: DataSize + DataSize = 0 + do i = 1, size(VarAry) + VarAry(i)%iLoc = [DataSize + 1, DataSize + VarAry(i)%Num] + DataSize = DataSize + VarAry(i)%Num + end do + end subroutine +end subroutine + +subroutine AddLinNamePrefix(VarAry, Prefix) + type(ModVarType), intent(inout) :: VarAry(:) + character(*), intent(in) :: Prefix + integer(IntKi) :: i, j + do i = 1, size(VarAry) + if (allocated(VarAry(i)%LinNames)) then + do j = 1, size(VarAry(i)%LinNames) + VarAry(i)%LinNames(j) = trim(Prefix)//" "//VarAry(i)%LinNames(j) + end do + end if + end do +end subroutine + +subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_FAST, t_global, ErrStat, ErrMsg) + + type(ModDataType), intent(inout) :: ModGlue !< Module data for glue code + type(ModDataType), intent(inout) :: Mods(:) !< Data for all modules + type(ML_ParameterType), intent(inout) :: p !< ModLin parameters + type(ML_MiscVarType), intent(inout) :: m !< ModLin MiscVars + type(FAST_ParameterType), intent(in) :: p_FAST + type(FAST_MiscVarType), intent(inout) :: m_FAST + type(FAST_OutputFileType), intent(inout) :: y_FAST + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + real(DbKi), intent(IN) :: t_global !< current (global) simulation time + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModLin_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi) :: ix, ixd, iz, iu, iy + integer(IntKi) :: Un + character(200) :: SimStr + character(MaxWrScrLen) :: BlankLine + character(1024) :: LinRootName + character(1024) :: OutFileName + character(*), parameter :: Fmt = 'F10.2' + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + ! Write message to screen + BlankLine = "" + call WrOver(BlankLine) ! BlankLine contains MaxWrScrLen spaces + SimStr = '(RotSpeed='//trim(Num2LStr(Turbine%ED%y%RotSpeed*RPS2RPM, Fmt))//' rpm, BldPitch1='//trim(Num2LStr(Turbine%ED%y%BlPitch(1)*R2D, Fmt))//' deg)' + call WrOver(' Performing linearization '//trim(Num2LStr(Turbine%m_FAST%Lin%NextLinTimeIndx))//' at simulation time '//TRIM(Num2LStr(t_global))//' s. '//trim(SimStr)) + call WrScr('') + + ! Get parameters + ! NumBl = size(T%ED%Input(1)%BlPitchCom) + y_FAST%Lin%RotSpeed = Turbine%ED%y%RotSpeed + y_FAST%Lin%Azimuth = Turbine%ED%y%LSSTipPxa + + ! Assemble linearization root file name + LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(m_FAST%Lin%NextLinTimeIndx)) + + ! Get unit number for writing files + call GetNewUnit(Un, ErrStat2, ErrMsg2); if (Failed()) return + + ! Initialize the index numbers + ix = 1 + ixd = 1 + iz = 1 + iu = 1 + iy = 1 + + ! Initialize data in Jacobian matrices to zero + ModGlue%Lin%dYdu = 0.0_R8Ki + ModGlue%Lin%dXdu = 0.0_R8Ki + ModGlue%Lin%dYdx = 0.0_R8Ki + ModGlue%Lin%dXdx = 0.0_R8Ki + + ! Loop through modules by index + do i = 1, size(p%iMod) + associate (ModData => Mods(p%iMod(i))) + + ! Operating point values + call FAST_GetOP(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, y_op=ModData%Lin%y, & + x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) + if (Failed()) return + + ! Derivatives wrt input + call FAST_JacobianPInput(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dXdu=ModData%Lin%dXdu) + if (Failed()) return + + ! Derivatives wrt continuous state + call FAST_JacobianPContState(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + dYdx=ModData%Lin%dYdx, dXdx=ModData%Lin%dXdx, & + StateRotation=ModData%Lin%StateRotation) + if (Failed()) return + + ! Copy module linearization arrays into glue linearization arrays + if ((size(ModGlue%Lin%x) > 0) .and. allocated(ModData%Lin%x)) ModGlue%Lin%x(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%x + if ((size(ModGlue%Lin%dx) > 0) .and. allocated(ModData%Lin%dx)) ModGlue%Lin%dx(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dx + if ((size(ModGlue%Lin%xd) > 0) .and. allocated(ModData%Lin%xd)) ModGlue%Lin%xd(ixd:ixd + ModData%Vars%Nxd - 1) = ModData%Lin%xd + if ((size(ModGlue%Lin%z) > 0) .and. allocated(ModData%Lin%z)) ModGlue%Lin%z(iz:iz + ModData%Vars%Nz - 1) = ModData%Lin%z + if ((size(ModGlue%Lin%u) > 0) .and. allocated(ModData%Lin%u)) ModGlue%Lin%u(iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%u + if ((size(ModGlue%Lin%y) > 0) .and. allocated(ModData%Lin%y)) ModGlue%Lin%y(iy:iy + ModData%Vars%Ny - 1) = ModData%Lin%y + + ! Copy module Jacobians into glue code Jacobians + if ((size(ModGlue%Lin%dYdu) > 0) .and. allocated(ModData%Lin%dYdu)) ModGlue%Lin%dYdu(iy:iy + ModData%Vars%Ny - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dYdu + if ((size(ModGlue%Lin%dXdu) > 0) .and. allocated(ModData%Lin%dXdu)) ModGlue%Lin%dXdu(ix:ix + ModData%Vars%Nx - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dXdu + if ((size(ModGlue%Lin%dYdx) > 0) .and. allocated(ModData%Lin%dYdx)) ModGlue%Lin%dYdx(iy:iy + ModData%Vars%Ny - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dYdx + if ((size(ModGlue%Lin%dXdx) > 0) .and. allocated(ModData%Lin%dXdx)) ModGlue%Lin%dXdx(ix:ix + ModData%Vars%Nx - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dXdx + + ! Increment starting index for next module + ix = ix + ModData%Vars%Nx + ixd = ixd + ModData%Vars%Nxd + iz = iz + ModData%Vars%Nz + iu = iu + ModData%Vars%Nu + iy = iy + ModData%Vars%Ny + + ! If writing the module matrices was requested + if (p_FAST%LinOutMod) then + + ! Assemble output file name based on module abbreviation + ! If module is BeamDyn or more than one instance, include instance + OutFileName = trim(LinRootName)//'.'//trim(ModData%Abbr)//".lin" + if ((ModData%ID == Module_BD) .or. (count(Mods%ID == ModData%ID) > 1)) then + OutFileName = trim(LinRootName)//'.'//trim(ModData%Abbr)//trim(Num2LStr(ModData%Ins))//".lin" + end if + + ! Write linearization matrices + call WriteModuleLinearMatrices(ModData, ModData%Vars%IdxLin, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat2, ErrMsg2) + if (Failed()) return + + end if + + end associate + end do + + ! Linearize mesh mappings to popoulate dUdy and dUdu + ModGlue%Lin%dUdy = 0.0_R8Ki + call Eye2D(ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_LinearizeMappings(Turbine, Mods, m%Mappings, p%iMod, ErrStat2, ErrMsg2, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy) + if (Failed()) return + + ! Calculate the glue code state matrices (A, B, C, D) + call ModLin_StateMatrices(ModGlue, p_FAST%UJacSclFact, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Write glue code data + OutFileName = trim(LinRootName)//".lin" + call WriteModuleLinearMatrices(ModGlue, ModGlue%Vars%IdxLin, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat2, ErrMsg2, IsGlue=.true.) + if (Failed()) return + + ! Update index for next linearization time + m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +!> ModLin_StateMatrices forms the full-system state matrices for linearization: A, B, C, and D. +!! Note that it uses LAPACK_GEMM instead of MATMUL for matrix multiplications because of stack-space issues (these +!! matrices get large quickly). +subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModGlue !< Glue module data + real(R8Ki), intent(in) :: JacScaleFactor !< Scale factor for conditioning the Jacobians + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ModLin_StateMatrices' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki), allocatable :: G(:, :), tmp(:, :), dUdu(:, :), dUdy(:, :) + integer(IntKi), allocatable :: ipiv(:) + + ! A = dXdx + ! B = dXdu + ! C = dYdx + ! D = dYdu + + ! Create copies of dUdu and dUdy for calculating matrices + call AllocAry(dUdu, size(ModGlue%Lin%dUdu, 1), size(ModGlue%Lin%dUdu, 2), 'dUdu', ErrStat2, ErrMsg2) + call AllocAry(dUdy, size(ModGlue%Lin%dUdy, 1), size(ModGlue%Lin%dUdy, 2), 'dUdy', ErrStat2, ErrMsg2) + dUdu = ModGlue%Lin%dUdu + dUdy = ModGlue%Lin%dUdy + + ! *** get G matrix **** + !---------------------- + if (.not. allocated(G)) then + call AllocAry(G, size(dUdu, 1), size(dUdu, 2), 'G', ErrStat2, ErrMsg2) + if (Failed()) return + + call AllocAry(ipiv, ModGlue%Vars%Nu, 'ipiv', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !G = dUdu + matmul( dUdy, y_FAST%Lin%Glue%D ) + G = dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, dUdy, ModGlue%Lin%dYdu, 1.0_R8Ki, G, ErrStat2, ErrMsg2) + if (Failed()) return + + ! G can be ill-conditioned, so we are going to precondition with G_hat = S^(-1) * G * S + ! we will also multiply the right-hand-side of the equations that need G inverse so that + ! dUdy_hat = S^(-1)*dUdy and dUdu_hat = S^(-1)*dUdu + call Precondition(ModGlue%Vars%u, G, dUdu, dUdy, JacScaleFactor) + + ! Form G_hat^(-1) * (S^-1*dUdy) and G^(-1) * (S^-1*dUdu) + ! factor G for the two solves: + call LAPACK_getrf(M=size(G, 1), N=size(G, 2), A=G, IPIV=ipiv, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! after the this solve, dUdy holds G_hat^(-1) * dUdy_hat: + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! after the this solve, dUdu holds G_hat^(-1) * dUdu_hat: + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Deallocate G and ipiv because the solves are complete + deallocate (G) + deallocate (ipiv) + + ! after this call, dUdu holds G^(-1)*dUdu and dUdy holds G^(-1)*dUdy: + call Postcondition(ModGlue%Vars%u, dUdu, dUdy, JacScaleFactor) + + ! Allocate tmp matrix for A and C calculations + call AllocAry(tmp, ModGlue%Vars%Nu, ModGlue%Vars%Nx, 'G^-1*dUdy*C', ErrStat2, ErrMsg2) + if (Failed()) return + + ! tmp = G^(-1) * dUdy * diag(C) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, dUdy, ModGlue%Lin%dYdx, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2) + if (Failed()) return + + ! A + ! dXdx = dXdx - matmul( dXdu, tmp ) + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, ModGlue%Lin%dXdu, tmp, 1.0_R8Ki, ModGlue%Lin%dXdx, ErrStat2, ErrMsg2) + if (Failed()) return + + ! C + ! dYdx = dYdx - matmul( dYdu, tmp ) + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, ModGlue%Lin%dYdu, tmp, 1.0_R8Ki, ModGlue%Lin%dYdx, ErrStat2, ErrMsg2) + if (Failed()) return + + ! B + if (Failed()) return + tmp = ModGlue%Lin%dXdu + ! dXdu = matmul( dXdu, dUdu ) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, ModGlue%Lin%dXdu, ErrStat2, ErrMsg2) + if (Failed()) return + + ! D + if (Failed()) return + tmp = ModGlue%Lin%dYdu + ! D = matmul( dYdu, dUdu ) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, ModGlue%Lin%dYdu, ErrStat2, ErrMsg2) + if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +!> Precondition returns the preconditioned matrix, hat{G}, such that hat{G} = S^(-1) G S withS^(-1 defined +!! such that loads are scaled by p_FAST%UJacSclFact. It also returns the preconditioned matrices hat{dUdu} and +!! hat{dUdy} such that hat{dUdu} = S^(-1) dUdu and +!! hat{dUdy} = S^(-1) dUdy for the right-hand sides of the equations to be solved. +subroutine Precondition(uVars, G, dUdu, dUdy, JacScaleFactor) + type(ModVarType), intent(in) :: uVars(:) !< Input variables from glue code + real(R8Ki), intent(inout) :: G(:, :) !< variable for glue-code linearization (in is G; out is G_hat) + real(R8Ki), intent(inout) :: dUdu(:, :) !< jacobian in FAST linearization from right-hand-side of equation + real(R8Ki), intent(inout) :: dUdy(:, :) !< jacobian in FAST linearization from right-hand-side of equation + real(R8Ki), intent(in) :: JacScaleFactor !< jacobian scale factor + real(R8Ki), allocatable :: diag(:) !< diagonal elements of G + integer(IntKi) :: i + + ! Copy diagonal of G into temporary array, to be restored after conditioning, + ! this is done to avoid loss of precision in the diagonal terms + allocate (diag(size(G, 1))) + do i = 1, size(diag) + diag(i) = G(i, i) + end do + + ! Loop through glue code input varies + do i = 1, size(uVars) + + ! If variable is not a load (force or moment), continue + if (.not. MV_HasFlags(uVars(i), ior(VF_Force, VF_Moment))) cycle + + ! Otherwise get variable start and end indices in matrix + associate (iLoc => uVars(i)%iLoc) + + ! Multiply columns of G + G(:, iLoc(1):iLoc(2)) = G(:, iLoc(1):iLoc(2))*JacScaleFactor + + ! Divide rows of G + G(iLoc(1):iLoc(2), :) = G(iLoc(1):iLoc(2), :)/JacScaleFactor + + ! Divide rows of dUdu + dUdu(iLoc(1):iLoc(2), :) = dUdu(iLoc(1):iLoc(2), :)/JacScaleFactor + + ! Divide rows of dUdy + dUdy(iLoc(1):iLoc(2), :) = dUdy(iLoc(1):iLoc(2), :)/JacScaleFactor + + end associate + end do + + ! Restore diagonal of G from temporary array + do i = 1, size(diag) + G(i, i) = diag(i) + end do + +end subroutine + +!> This routine returns the matrices tilde{dUdu} and tilde{dUdy} such that +!! tilde{dUdu} = G^(-1) dUdu and +!! tilde{dUdy} = G^(-1) dUdy, which have been solved using the preconditioned system defined in fast_lin::precondition. +subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) + type(ModVarType), intent(in) :: uVars(:) !< Input variables from glue code + real(R8Ki), intent(in) :: JacScaleFactor !< jacobian scale factor + real(R8Ki), intent(inout) :: dUdu(:, :) !< jacobian in FAST linearization from right-hand-side of equation + real(R8Ki), intent(inout) :: dUdy(:, :) !< jacobian in FAST linearization from right-hand-side of equation + integer(IntKi) :: i + + ! Loop through glue code input varies + do i = 1, size(uVars) + + ! If variable is not a load (force or moment), continue + if (.not. MV_HasFlags(uVars(i), ior(VF_Force, VF_Moment))) cycle + + ! Otherwise get variable start and end indices in matrix + associate (iLoc => uVars(i)%iLoc) + + ! Multiply rows of dUdu + dUdu(iLoc(1):iLoc(2), :) = dUdu(iLoc(1):iLoc(2), :)*JacScaleFactor + + ! Multiply rows of dUdy + dUdy(iLoc(1):iLoc(2), :) = dUdy(iLoc(1):iLoc(2), :)*JacScaleFactor + + end associate + end do + +end subroutine + +subroutine WriteModuleLinearMatrices(ModData, VarIdx, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat, ErrMsg, IsGlue) + + type(ModDataType), intent(in) :: ModData !< Module data + type(VarsIdxType), intent(in) :: VarIdx !< Variable index + type(FAST_ParameterType) :: p_FAST !< Parameters + type(FAST_OutputFileType) :: y_FAST !< Output variables + real(DbKi), intent(in) :: t_global !< current time step (written in file) + integer(IntKi), intent(out) :: Un !< Unit number for file + character(*), intent(in) :: OutFileName !< output file name + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + logical, optional :: IsGlue !< Flag indicating this is writing glue code matrices + + character(*), parameter :: RoutineName = 'WriteModuleLinearMatrices' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(32) :: Desc + integer(IntKi) :: i + character(50) :: Fmt + logical, allocatable :: uUse(:), yUse(:) + logical :: IsGlueLoc + + ErrStat = ErrID_None + ErrMsg = "" + + ! Set local flag for if glue code matrices are being written + IsGlueLoc = .false. + if (present(IsGlue)) IsGlueLoc = IsGlue + + ! Open linearization file + call OpenFOutFile(Un, OutFileName, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Header + !---------------------------------------------------------------------------- + + write (Un, '(/,A)') 'Linearized model: '//trim(y_FAST%FileDescLines(1)) + write (Un, '(1X,A,/)') trim(y_FAST%FileDescLines(2)) + write (Un, '(A,/)') trim(y_FAST%FileDescLines(3)) + + write (Un, '(A)') 'Simulation information:' + + fmt = '(3x,A,1x,'//trim(p_FAST%OutFmt_t)//',1x,A)' + Desc = 'Simulation time:'; write (Un, fmt) Desc, t_global, 's' + Desc = 'Rotor Speed: '; write (Un, fmt) Desc, y_FAST%Lin%RotSpeed, 'rad/s' + Desc = 'Azimuth: '; write (Un, fmt) Desc, y_FAST%Lin%Azimuth, 'rad' + Desc = 'Wind Speed: '; write (Un, fmt) Desc, y_FAST%Lin%WindSpeed, 'm/s' + + fmt = '(3x,A,1x,I5)' + Desc = 'Number of continuous states: '; write (Un, fmt) Desc, VarIdx%Nx + Desc = 'Number of discrete states: '; write (Un, fmt) Desc, VarIdx%Nxd + Desc = 'Number of constraint states: '; write (Un, fmt) Desc, VarIdx%Nz + Desc = 'Number of inputs: '; write (Un, fmt) Desc, VarIdx%Nu + Desc = 'Number of outputs: '; write (Un, fmt) Desc, VarIdx%Ny + + Desc = 'Jacobians included in this file?' + fmt = '(3x,A,1x,A5)' + if (p_FAST%LinOutJac) then + write (Un, fmt) Desc, 'Yes' + else + write (Un, fmt) Desc, 'No' + end if + + write (Un, '()') !print a blank line + + if (VarIdx%Nx > 0) then + write (Un, '(A)') 'Order of continuous states:' + call WrLinFile_txt_Table(ModData%Vars%x, VarIdx%FlagFilter, p_FAST, Un, "Row/Column", ModData%Lin%x) + + write (Un, '(A)') 'Order of continuous state derivatives:' + call WrLinFile_txt_Table(ModData%Vars%x, VarIdx%FlagFilter, p_FAST, Un, "Row/Column", ModData%Lin%dx, IsDeriv=.true.) + end if + + if (VarIdx%Nxd > 0) then + write (Un, '(A)') 'Order of discrete states:' + call WrLinFile_txt_Table(ModData%Vars%xd, VarIdx%FlagFilter, p_FAST, Un, "Row/Column", ModData%Lin%xd) + end if + + if (VarIdx%Nz > 0) then + write (Un, '(A)') 'Order of constraint states:' + call WrLinFile_txt_Table(ModData%Vars%z, VarIdx%FlagFilter, p_FAST, Un, "Row/Column", ModData%Lin%z) + end if + + if (VarIdx%Nu > 0) then + write (Un, '(A)') 'Order of inputs:' + call WrLinFile_txt_Table(ModData%Vars%u, VarIdx%FlagFilter, p_FAST, Un, "Column ", ModData%Lin%u, ShowRot=.true.) + end if + + if (VarIdx%Ny > 0) then + write (Un, '(A)') 'Order of outputs:' + call WrLinFile_txt_Table(ModData%Vars%y, VarIdx%FlagFilter, p_FAST, Un, "Row ", ModData%Lin%y, ShowRot=.true.) + end if + + allocate (uUse(ModData%Vars%Nu)) + uUse = .false. + uUse(VarIdx%iu) = .true. + + allocate (yUse(ModData%Vars%Ny)) + yUse = .false. + yUse(VarIdx%iy) = .true. + + if (p_FAST%LinOutJac) then + write (Un, '(/,A,/)') 'Jacobian matrices:' + if (IsGlueLoc) then + call WrPartialMatrix(ModData%Lin%dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=uUse, UseCol=uUse) + call WrPartialMatrix(ModData%Lin%dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=uUse, UseCol=yUse) + else + if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'dXdx') + if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'dXdu', UseCol=uUse) + if (allocated(ModData%Lin%dYdx)) call WrPartialMatrix(ModData%Lin%dYdx, Un, p_FAST%OutFmt, 'dYdx', UseRow=yUse) + if (allocated(ModData%Lin%dYdu)) call WrPartialMatrix(ModData%Lin%dYdu, Un, p_FAST%OutFmt, 'dYdu', UseRow=yUse, UseCol=uUse) + end if + end if + + write (Un, '(/,A,/)') 'Linearized state matrices:' + if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'A') + if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'B', UseCol=uUse) + if (allocated(ModData%Lin%dYdx)) call WrPartialMatrix(ModData%Lin%dYdx, Un, p_FAST%OutFmt, 'C', UseRow=yUse) + if (allocated(ModData%Lin%dYdu)) call WrPartialMatrix(ModData%Lin%dYdu, Un, p_FAST%OutFmt, 'D', UseRow=yUse, UseCol=uUse) + if (allocated(ModData%Lin%StateRotation)) call WrPartialMatrix(ModData%Lin%StateRotation, Un, p_FAST%OutFmt, 'StateRotation') + + ! Close file + close (Un) + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) close (Un) + end function Failed +end subroutine WriteModuleLinearMatrices + +subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDeriv, ShowRot) + + type(ModVarType), intent(in) :: VarAry(:) !< variable array + integer(IntKi), intent(in) :: FlagFilter !< unit number + type(FAST_ParameterType) :: p_FAST !< Parameters + integer(IntKi), intent(in) :: Un !< unit number + character(*), intent(in) :: RowCol !< Row/Column description + real(ReKi), intent(in) :: op(:) !< operating point values (possibly different size that Desc because of orientations) + logical, optional, intent(in) :: IsDeriv !< flag that tells us if we need to modify the channel names for derivatives (xdot) + logical, optional, intent(in) :: ShowRot !< flag to show rotation matrix if field is orientation + + character(*), parameter :: RoutineName = 'WrLinFile_txt_Table' + integer(IntKi) :: TS ! Tab stop column + integer(IntKi) :: i_op ! Index of value in operating piont + logical :: IsDerivLoc ! flag that tells us if we need to modify the channel names for derivatives (xdot) + logical :: VarRotFrame ! flag that tells us if this column is in the rotating frame + integer(IntKi) :: VarDerivOrder ! integer indicating the maximum time-derivative order of a channel (this will be 0 for anything that is not a continuous state) + character(100) :: Fmt, FmtStr, FmtRot + character(25) :: DerivStr, DerivUnitStr + logical :: ShowRotLoc + real(R8Ki) :: DCM(3, 3) + integer(IntKi) :: i, j, RowColIdx + + ShowRotLoc = .false. + if (present(ShowRot)) ShowRotLoc = ShowRot + + IsDerivLoc = .false. + if (present(IsDeriv)) IsDerivLoc = IsDeriv + + if (IsDerivLoc) then + if (p_FAST%CompAeroMaps .and. p_FAST%CompElast /= MODULE_BD) then ! this might not work if we are using some other (not BD, ED) module with states + DerivStr = 'Second time derivative of' + DerivUnitStr = '/s^2' + else + DerivStr = 'First time derivative of' + DerivUnitStr = '/s' + end if + else + DerivStr = '' + DerivUnitStr = '' + end if + + ! tab stop after operating point + TS = 14 + 3*p_FAST%FmtWidth + 7 + + ! Construct write formats + Fmt = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',T'//trim(Num2LStr(TS))//',L8,8x,I8,9x,A)' + FmtRot = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',2(", ",'//trim(p_FAST%OutFmt)//'),T'//trim(Num2LStr(TS))//',L8,8x,I8,9x,A)' + FmtStr = '(3x,A10,1x,A,T'//trim(Num2LStr(TS))//',A15,1x,A16,1x,A)' + + ! Write header + write (Un, FmtStr) RowCol, 'Operating Point', 'Rotating Frame?', 'Derivative Order', 'Description' + write (Un, FmtStr) '----------', '---------------', '---------------', '----------------', '-----------' + + ! Loop through variables in array + RowColIdx = 0 + do i = 1, size(VarAry) + associate (Var => VarAry(i)) + + ! If variable does not have the filter flag, continue + if (.not. MV_HasFlags(Var, FlagFilter)) cycle + + ! Is variable in the rotating frame? + VarRotFrame = MV_HasFlags(Var, VF_RotFrame) + + ! Get variable derivative order + if (MV_HasFlags(Var, VF_DerivOrder2)) then + VarDerivOrder = 2 + else if (MV_HasFlags(Var, VF_DerivOrder1)) then + VarDerivOrder = 1 + else + VarDerivOrder = 0 + end if + + ! Loop through values in variable + do j = 1, Var%Num + + ! Increment value counter + RowColIdx = RowColIdx + 1 + + ! Index in operating point array + i_op = Var%iLoc(1) + j - 1 + + ! If variable is orientation and show rotation matrix flag is true + if (ShowRotLoc .and. (Var%Field == VF_Orientation)) then + + ! Skip writing if not the first value in orientation (3 values) + if (mod(j - 1, 3) /= 0) cycle + + ! Convert WM parameters to DCM + DCM = wm_to_dcm(real(op(i_op:i_op + 2), R8Ki)) + + ! Write 3 rows of data (full dcm) + write (Un, FmtRot) RowColIdx + 0, dcm(1, 1), dcm(1, 2), dcm(1, 3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j + 0)) + write (Un, FmtRot) RowColIdx + 1, dcm(2, 1), dcm(2, 2), dcm(2, 3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j + 1)) + write (Un, FmtRot) RowColIdx + 2, dcm(3, 1), dcm(3, 2), dcm(3, 3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j + 2)) + + else if (IsDerivLoc) then + write (Un, Fmt) RowColIdx, op(i_op), VarRotFrame, VarDerivOrder, trim(DerivStr)//' '//trim(Var%LinNames(j))//trim(DerivUnitStr) + else + write (Un, Fmt) RowColIdx, op(i_op), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + end if + + end do + end associate + end do + + write (Un, '()') !print a blank line + +end subroutine WrLinFile_txt_Table + +end module diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index a09e8f43d5..9f6ab6db42 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -70,6 +70,7 @@ MODULE FAST_ModTypes LOGICAL, PARAMETER :: BD_Solve_Option1 = .TRUE. + INTEGER(IntKi), PARAMETER :: TC_Modules(*) = [Module_ED, Module_BD, Module_SD] !< Tight coupling module IDs END MODULE FAST_ModTypes !======================================================================= diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 90ee44f2af..e59f4c8601 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -107,6 +107,128 @@ typedef ^ FAST_SS_CaseType ReKi TSR - - - "TSR for this case of the steady-state typedef ^ FAST_SS_CaseType ReKi WindSpeed - - - "Windspeed for this case of the steady-state solve [>0]" "(m/s)" typedef ^ FAST_SS_CaseType ReKi Pitch - - - "Pitch angle for this case of the steady-state solve" "(rad)" + +# ..... Tight Coupling Generalized Alpha Solver Data ............. + +# Mapping Type +param ^ - IntKi Map_LoadMesh - 1 - "Load mesh mapping type" - +param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - +param ^ - IntKi Map_NonMesh - 3 - "Non mesh mapping type" - +typedef ^ TC_MappingType IntKi i1 - 0 - "Optional index for specifying transfers" - +typedef ^ ^ IntKi i2 - 0 - "Optional index for specifying transfers" - +typedef ^ ^ IntKi SrcModIdx - 0 - "Source module index in ModData array" - +typedef ^ ^ IntKi DstModIdx - 0 - "Destination module index in ModData array" - +typedef ^ ^ IntKi SrcModID - 0 - "Source module ID" - +typedef ^ ^ IntKi DstModID - 0 - "Destination module ID" - +typedef ^ ^ IntKi SrcIns - 0 - "Source module Instance" - +typedef ^ ^ IntKi DstIns - 0 - "Destination module Instance" - +typedef ^ ^ IntKi SrcMeshID - 0 - "Source mesh identifier" - +typedef ^ ^ IntKi DstMeshID - 0 - "Destination mesh identifier" - +typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - +typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - +typedef ^ ^ MeshLocType SrcMeshLoc - - - "Source mesh locator (number and indices)" - +typedef ^ ^ MeshLocType DstMeshLoc - - - "Destination mesh locator (number and indices)" - +typedef ^ ^ MeshLocType SrcDispMeshLoc - - - "Source displacement mesh locator (number and indices)" - +typedef ^ ^ MeshLocType DstDispMeshLoc - - - "Destination displacement mesh locator (number and indices)" - +typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - +typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - +typedef ^ ^ logical Ready - F - "Flag indicating Source has been ready to be transferred" - +typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - +typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - +typedef ^ ^ IntKi iLocSrcTransDisp 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocSrcTransVel 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocSrcTransAcc 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocSrcOrientation 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocSrcAngularVel 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocSrcAngularAcc 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocSrcForce 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocSrcMoment 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocSrcDispTransDisp 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstTransDisp 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstTransVel 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstTransAcc 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstOrientation 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstAngularVel 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstAngularAcc 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstForce 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstMoment 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iLocDstDispTransDisp 2 - - "Data indices of linearized mesh mapping" +#typedef ^ ^ IntKi SrcVarIdx : - - "Source motion variable index" - +#typedef ^ ^ IntKi DstVarIdx : - - "Destination motion variable index" - +#typedef ^ ^ IntKi SrcDispVarIdx - 0 - "Source displacement var index [if Typ=Map_LoadMesh]" - +#typedef ^ ^ IntKi DstDispVarIdx - 0 - "Destination displacement var index [if Typ=Map_LoadMesh]" - + +# Parameters +typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - +typedef ^ ^ R8Ki ConvTol - - - "Solution convergence tolerance" - +typedef ^ ^ IntKi NumCrctn - - - "" - +typedef ^ ^ IntKi MaxConvIter - - - "" - +typedef ^ ^ IntKi NIter_UJac - - - "Number of solution iterations between updating the Jacobian" - +typedef ^ ^ IntKi NStep_UJac - - - "Number of global time steps between updating the Jacobian" - +typedef ^ ^ R8Ki Scale_UJac - - - "" - +typedef ^ ^ R8Ki AccBlend - 1 - "" - +typedef ^ ^ R8Ki RhoInf - - - "Rho infinity used for calculating Generalized-alpha coefficients" - +typedef ^ ^ R8Ki AlphaM - - - "Generalized-alpha alpha_m coefficient" - +typedef ^ ^ R8Ki AlphaF - - - "Generalized-alpha alpha_f coefficient" - +typedef ^ ^ R8Ki Beta - - - "Generalized-alpha beta coefficient" - +typedef ^ ^ R8Ki Gamma - - - "Generalized-alpha gamma coefficient" - +typedef ^ ^ R8Ki C 7 - - "Generalized-alpha coefficient array" - +typedef ^ ^ IntKi iX1 2 - - "" - +typedef ^ ^ IntKi iX2 2 - - "" - +typedef ^ ^ IntKi iUT 2 - - "" - +typedef ^ ^ IntKi iU1 2 - - "" - +typedef ^ ^ IntKi iyT 2 - - "" - +typedef ^ ^ IntKi iy1 2 - - "" - +typedef ^ ^ IntKi iJX 2 - - "Indices of Jacobian q variables" - +typedef ^ ^ IntKi iJU 2 - - "Indices of Jacobian input variables" - +typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - +typedef ^ ^ IntKi iJL : - - "Indices of Jacobian load variables" - +typedef ^ ^ IntKi ixqd :: - - "" - +typedef ^ ^ IntKi iModInit : - - "ModData index order for step 0 initialization" - +typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - +typedef ^ ^ IntKi iModBD : - - "ModData index order for BD modules" - +typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - +typedef ^ ^ IntKi iModOpt1US : - - "ModData index order for option 1 modules to update states" - +typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - +typedef ^ ^ IntKi iModPost : - - "ModData index order for post option 1 modules" - + +typedef ^ ML_ParameterType IntKi iMod : - - "ModData index order for linearization" - +typedef ^ ML_MiscVarType TC_MappingType Mappings : - - "Module mesh mapping" - +typedef ^ ML_OutputType ModLinType Lin : - - "Module linearization type" - + +# Misc/Optimization variables +typedef ^ TC_MiscVarType R8Ki q :: - - "" - +typedef ^ ^ R8Ki qn :: - - "" - +typedef ^ ^ R8Ki x : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki un : - - "" - +typedef ^ ^ R8Ki u_tmp : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki GinvdUdu :: - - "" - +typedef ^ ^ R8Ki dUdyHat :: - - "" - +typedef ^ ^ R8Ki XB :: - - "" - +typedef ^ ^ R8Ki G :: - - "Used to merge state matrices" - +typedef ^ ^ R8Ki Jac :: - - "" - +typedef ^ ^ IntKi IPIV : - - "" - +typedef ^ ^ IntKi IterTotal - 0 - "" - +typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - +typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - +typedef ^ ^ R8Ki dq :: - - "Change in q" - +typedef ^ ^ R8Ki dx : - - "Change in x" - +typedef ^ ^ R8Ki du : - - "" - +typedef ^ ^ R8Ki UDiff : - - "" - +typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - +typedef ^ ^ TC_MappingType Mappings : - - "Array of mesh mappings in solver" - + + # ..... FAST_ParameterType data ....................................................................................................... # Misc data for coupling: typedef FAST FAST_ParameterType DbKi DT - - - "Integration time step [global time]" s @@ -214,6 +336,8 @@ typedef ^ FAST_ParameterType IntKi Lin_ModOrder {NumModules} - - "indices that d typedef ^ FAST_ParameterType IntKi LinInterpOrder - - - "Interpolation order for CalcSteady solution" - #typedef ^ FAST_ParameterType LOGICAL CheckHSSBrTrqC - - - "Flag to determine if we should check HSSBrTrqC extrapolation to ElastoDyn" - +typedef ^ FAST_ParameterType ML_ParameterType ModLin - - - "Module data based linearization" + # Parameters for steady-state calculations: typedef ^ FAST_ParameterType LOGICAL CompAeroMaps - - - "Flag to determine if we are calculating aero maps" - typedef ^ FAST_ParameterType IntKi N_UJac - - - "Number of iterations between re-calculating Jacobian" "(-)" @@ -393,6 +517,8 @@ typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operat typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {6} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnit {:} - - "units of data output from the driver" +typedef ^ FAST_OutputFileType ModDataType Modules {:} - - "module variable and value data" - +typedef ^ FAST_OutputFileType ModDataType ModGlue - - - "module variable and value data" - # ..... IceDyn data ....................................................................................................... @@ -415,6 +541,7 @@ typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated w # [ the last dimension of each allocatable array is for the instance of BeamDyn being used ] # note that I'm making the allocatable-for-instance-used part INSIDE the data type (as opposed to an array of IceDyn_Data types) because I want to pass arrays of x, xd, z, x_pred, etc) typedef FAST BeamDyn_Data BD_ContinuousStateType x {:}{:} - - "Continuous states" +typedef ^ ^ BD_ContinuousStateType dxdt {:} - - "Continuous state derivatives" typedef ^ ^ BD_DiscreteStateType xd {:}{:} - - "Discrete states" typedef ^ ^ BD_ConstraintStateType z {:}{:} - - "Constraint states" typedef ^ ^ BD_OtherStateType OtherSt {:}{:} - - "Other states" @@ -431,6 +558,7 @@ typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated w # ..... ElastoDyn data ....................................................................................................... typedef FAST ElastoDyn_Data ED_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ ED_ContinuousStateType dxdt - - - "Continuous state derivatives" typedef ^ ^ ED_DiscreteStateType xd {NumStateTimes} - - "Discrete states" typedef ^ ^ ED_ConstraintStateType z {NumStateTimes} - - "Constraint states" typedef ^ ^ ED_OtherStateType OtherSt {NumStateTimes} - - "Other states" @@ -534,6 +662,7 @@ typedef ^ ^ SC_DX_ParameterType p - - - "System parameters" # ..... SubDyn data ....................................................................................................... typedef FAST SubDyn_Data SD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ SD_ContinuousStateType dxdt - - - "Continuous state derivatives" typedef ^ ^ SD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" typedef ^ ^ SD_ConstraintStateType z {NumStateTimes} - - "Constraint states" typedef ^ ^ SD_OtherStateType OtherSt {NumStateTimes} - - "Other states" @@ -580,6 +709,7 @@ typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with # ..... HydroDyn data ....................................................................................................... typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType dxdt - - - "Continuous state derivatives" typedef ^ ^ HydroDyn_DiscreteStateType xd {NumStateTimes} - - "Discrete states" typedef ^ ^ HydroDyn_ConstraintStateType z {NumStateTimes} - - "Constraint states" typedef ^ ^ HydroDyn_OtherStateType OtherSt {NumStateTimes} - - "Other states" @@ -784,6 +914,7 @@ typedef ^ FAST_MiscVarType INTEGER SimStrtTime {8} - - "Start time of simulation typedef ^ FAST_MiscVarType Logical calcJacobian - - - "Should we calculate Jacobians in Option 1?" (flag) typedef ^ FAST_MiscVarType FAST_ExternInputType ExternInput - - - "external input values" - typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearization analysis" - +typedef ^ FAST_MiscVarType ML_MiscVarType ModLin - - - "Module linearization Miscellaneous variables" - # ..... FAST_InitData data ....................................................................................................... From c3b22e6250367d8619ba53028efac7aea4f0b9c0 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 14:23:17 +0000 Subject: [PATCH 054/319] Add module for managing meshes at glue code level --- modules/openfast-library/src/FAST_Mesh.f90 | 1525 ++++++++++++++++++++ 1 file changed, 1525 insertions(+) create mode 100644 modules/openfast-library/src/FAST_Mesh.f90 diff --git a/modules/openfast-library/src/FAST_Mesh.f90 b/modules/openfast-library/src/FAST_Mesh.f90 new file mode 100644 index 0000000000..31ffba9e40 --- /dev/null +++ b/modules/openfast-library/src/FAST_Mesh.f90 @@ -0,0 +1,1525 @@ +module FAST_Mesh + +use FAST_ModTypes + +implicit none + +private +public :: FAST_InitMappings, FAST_LinearizeMappings, FAST_ResetRemapFlags, FAST_InputSolve + +! Input Solve destinations +integer(IntKi), parameter :: IS_DstInput = 1, IS_Dstu = 2, IS_Linearize = 3 + +integer(IntKi), parameter :: AD_rotor = 1 + +integer(IntKi), parameter :: Xfr_Point_to_Point = 1, & + Xfr_Line2_to_Point = 2, & + Xfr_Point_to_Line2 = 3, & + Xfr_Line2_to_Line2 = 4 + +contains + +function FAST_InputMeshPointer(ModData, Turbine, MeshLoc, UseU) result(Mesh) + type(ModDataType), intent(in) :: ModData + type(FAST_TurbineType), target, intent(in) :: Turbine + type(MeshLocType), intent(in) :: MeshLoc + logical, intent(in) :: UseU + type(MeshType), pointer :: Mesh + + select case (ModData%ID) + case (Module_AD) + if (UseU) then + Mesh => AD_InputMeshPointer(Turbine%AD%u, MeshLoc) + else + Mesh => AD_InputMeshPointer(Turbine%AD%Input(1), MeshLoc) + end if + case (Module_BD) + if (UseU) then + Mesh => BD_InputMeshPointer(Turbine%BD%u(ModData%Ins), MeshLoc) + else + Mesh => BD_InputMeshPointer(Turbine%BD%Input(1, ModData%Ins), MeshLoc) + end if + case (Module_ED) + if (UseU) then + Mesh => ED_InputMeshPointer(Turbine%ED%u, MeshLoc) + else + Mesh => ED_InputMeshPointer(Turbine%ED%Input(1), MeshLoc) + end if + case (Module_SD) + if (UseU) then + Mesh => SD_InputMeshPointer(Turbine%SD%u, MeshLoc) + else + Mesh => SD_InputMeshPointer(Turbine%SD%Input(1), MeshLoc) + end if + case (Module_SrvD) + if (UseU) then + Mesh => SrvD_InputMeshPointer(Turbine%SrvD%u, MeshLoc) + else + Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input(1), MeshLoc) + end if + end select +end function + +function FAST_InputMeshName(ModData, Turbine, MeshLoc) result(Name) + type(ModDataType), intent(in) :: ModData + type(FAST_TurbineType), target, intent(in) :: Turbine + type(MeshLocType), intent(in) :: MeshLoc + character(32) :: Name + select case (ModData%ID) + case (Module_AD) + Name = trim(ModData%Abbr)//"%"//AD_InputMeshName(Turbine%AD%u, MeshLoc) + case (Module_BD) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputMeshName(Turbine%BD%u(ModData%Ins), MeshLoc) + case (Module_ED) + Name = trim(ModData%Abbr)//"%"//ED_InputMeshName(Turbine%ED%u, MeshLoc) + case (Module_SD) + Name = trim(ModData%Abbr)//"%"//SD_InputMeshName(Turbine%SD%u, MeshLoc) + case (Module_SrvD) + Name = trim(ModData%Abbr)//"%"//SrvD_InputMeshName(Turbine%SrvD%u, MeshLoc) + end select +end function + +function FAST_OutputMeshPointer(ModData, Turbine, MeshLoc) result(Mesh) + type(ModDataType), intent(in) :: ModData + type(FAST_TurbineType), target, intent(in) :: Turbine + type(MeshLocType), intent(in) :: MeshLoc + type(MeshType), pointer :: Mesh + select case (ModData%ID) + case (Module_AD) + Mesh => AD_OutputMeshPointer(Turbine%AD%y, MeshLoc) + case (Module_BD) + Mesh => BD_OutputMeshPointer(Turbine%BD%y(ModData%Ins), MeshLoc) + case (Module_ED) + Mesh => ED_OutputMeshPointer(Turbine%ED%y, MeshLoc) + case (Module_SD) + Mesh => SD_OutputMeshPointer(Turbine%SD%y, MeshLoc) + case (Module_SrvD) + Mesh => SrvD_OutputMeshPointer(Turbine%SrvD%y, MeshLoc) + end select +end function + +function FAST_OutputMeshName(ModData, Turbine, MeshLoc) result(Name) + type(ModDataType), intent(in) :: ModData + type(FAST_TurbineType), target, intent(in) :: Turbine + type(MeshLocType), intent(in) :: MeshLoc + character(32) :: Name + select case (ModData%ID) + case (Module_AD) + Name = trim(ModData%Abbr)//"%"//AD_OutputMeshName(Turbine%AD%y, MeshLoc) + case (Module_BD) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputMeshName(Turbine%BD%y(ModData%Ins), MeshLoc) + case (Module_ED) + Name = trim(ModData%Abbr)//"%"//ED_OutputMeshName(Turbine%ED%y, MeshLoc) + case (Module_SD) + Name = trim(ModData%Abbr)//"%"//SD_OutputMeshName(Turbine%SD%y, MeshLoc) + case (Module_SrvD) + Name = trim(ModData%Abbr)//"%"//SrvD_OutputMeshName(Turbine%SrvD%y, MeshLoc) + end select +end function + +subroutine FAST_InitMappings(Mods, Mappings, T, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: Mods(:) !< Module data + type(TC_MappingType), allocatable, intent(inout) :: Mappings(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InitMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi) :: iMap, ModIns, iModIn, iModSrc, iModDst + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Define mesh mappings between modules + !---------------------------------------------------------------------------- + + ! Define a list of all possible module mesh mappings between modules + allocate (Mappings(0), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating mappings", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Loop through module pairings + do iModSrc = 1, size(Mods) + do iModDst = 1, size(Mods) + + ! Switch by destination module (inputs) + select case (Mods(IModDst)%ID) + case (Module_AD) + call AD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + case (Module_BD) + call BD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + case (Module_ED) + call ED_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + case (Module_HD) + call HD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + case (Module_IfW) + call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + case (Module_SD) + call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + case (Module_SrvD) + call SrvD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + end select + end do + end do + + !---------------------------------------------------------------------------- + ! Get module indices in ModData and determine which mappings are active + !---------------------------------------------------------------------------- + + ! Reorder the mappings so that motion maps come before the load maps + Mappings = [pack(Mappings, Mappings%MapType == Map_MotionMesh), & + pack(Mappings, Mappings%MapType == Map_LoadMesh), & + pack(Mappings, Mappings%MapType == Map_NonMesh)] + + ! Loop through mappings + do iMap = 1, size(Mappings) + associate (SrcMod => Mods(Mappings(iMap)%SrcModIdx), & + DstMod => Mods(Mappings(iMap)%DstModIdx)) + + ! Add mapping index to sorce and destination module mapping arrays + SrcMod%SrcMaps = [SrcMod%SrcMaps, iMap] + DstMod%DstMaps = [DstMod%DstMaps, iMap] + + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine AD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'AD_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! T%ED%y%TowerLn2Mesh + DstMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, AD_rotor), & ! T%AD%Input(1)%rotors(1)%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%AD%Input(1)%rotors(1)%TowerMotion%Committed) + if (Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! T%ED%y%HubPtMotion + DstMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! T%AD%Input(1)%rotors(1)%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! T%ED%y%NacelleMotion + DstMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, AD_rotor), & ! T%AD%Input(1)%rotors(1)%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%AD%Input(1)%rotors(1)%NacelleMotion%Committed) + if (Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! T%ED%y%TFinCMMotion + DstMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! T%AD%Input(1)%rotors(1)%TFinMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%AD%Input(1)%rotors(1)%TFinMotion%Committed) + if (Failed()) return + + do i = 1, size(Turbine%ED%y%BladeRootMotion) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, i), & ! T%ED%y%BladeRootMotion(i) + DstMeshLoc=MeshLocType(AD_u_rotors_BladeRootMotion, AD_rotor, i), & ! T%AD%Input(1)%rotors(1)%BladeRootMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + if (Turbine%p_FAST%CompElast == Module_ED) then + do i = 1, size(Turbine%ED%y%BladeLn2Mesh) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! T%ED%y%BladeLn2Mesh(i) + DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, i), & ! T%AD%Input(1)%rotors(1)%BladeMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + end if + + case (Module_BD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, SrcMod%Ins), & ! AD%Input(1)%rotors(1)%BladeMotion(SrcMod%Ins) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SrvD) + + call NonMeshMap(Mappings, Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=SrcMod, DstMod=DstMod) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine BD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BD_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, DstMod%Ins), & ! T%ED%y%BladeRootMotion(DstMod%Ins) + DstMod=DstMod, DstMeshLoc=MeshLocType(BD_u_RootMotion), & ! T%BD%Input(1, DstMod%Ins)%RootMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_AD) + + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, AD_rotor, DstMod%Ins), & ! T%AD%y%rotors(1)%BladeLoad(DstMod%Ins) + SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, DstMod%Ins), & ! AD%Input(1)%rotors(1)%BladeMotion(DstMod%Ins) + DstMod=DstMod, DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad + DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SrvD) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ED_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_BD) + + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcMeshLoc=MeshLocType(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce + SrcDispMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%Input(1, SrcMod%Ins)%RootMotion + DstMod=DstMod, & + DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%Input(1)%HubPtLoad + DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_AD) + + if (Turbine%p_FAST%CompElast == Module_ED) then + do i = 1, size(Turbine%ED%Input(1)%BladePtLoads) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(), & ! AD%y%rotors(1)%BladeLoad(i) + SrcDispMeshLoc=MeshLocType(), & ! AD%Input(1)%rotors(1)%BladeMotion(i) + DstMeshLoc=MeshLocType(), & ! ED%Input(1)%BladePtLoads(i) + DstDispMeshLoc=MeshLocType(), & ! ED%y%BladeLn2Mesh(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + end if + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_TowerLoad, AD_Rotor), & ! AD%y%rotors(1)%TowerLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, AD_rotor), & ! AD%u%rotors(1)%TowerMotion + DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerPtLoads + DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%AD%y%rotors(1)%TowerLoad%committed) + if (Failed()) return + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_NacelleLoad, AD_Rotor), & ! AD%y%rotors(1)%NacelleLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, AD_rotor), & ! AD%Input(1)%rotors(1)%NacelleMotion + DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads + DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%AD%Input(1)%rotors(1)%NacelleMotion%committed) + if (Failed()) return + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_HubLoad, AD_Rotor), & ! AD%y%rotors(1)%HubLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! AD%Input(1)%rotors(1)%HubMotion + DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%Input(1)%HubPtLoad + DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_TFinLoad, AD_Rotor), & ! AD%y%rotors(1)%TFinLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! AD%Input(1)%rotors(1)%TFinMotion + DstMeshLoc=MeshLocType(ED_u_TFinCMLoads), & ! ED%Input(1)%TFinCMLoads + DstDispMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%AD%Input(1)%rotors(1)%TFinMotion%committed) + if (Failed()) return + + case (Module_SD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(), & ! SD%y%Y1mesh, & + SrcDispMeshLoc=MeshLocType(), & ! SD%Input(1)%TPMesh + DstMeshLoc=MeshLocType(), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SrvD) + + ! Nacelle Structural Controller + do j = 1, Turbine%SrvD%p%NumNStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads + DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Tower Structural Controller + do j = 1, Turbine%SrvD%p%NumTStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerLoads + DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Blade Structural Controller (if ElastoDyn is used for blades) + if (Turbine%p_FAST%CompElast == Module_ED) then + do i = 1, Turbine%SrvD%p%NumBStC + do j = 1, Turbine%ED%p%NumBl + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + DstMeshLoc=MeshLocType(ED_u_BladePtLoads, j), & ! ED%Input(1)%BladePtLoads(j) + DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + end do + end if + + ! Substructure Structural Controller (if not using SubDyn) + if (Turbine%p_FAST%CompSub /= Module_SD) then + do j = 1, Turbine%SrvD%p%NumSStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + end if + + call NonMeshMap(Mappings, "SrvD Data -> ED Data", SrcMod=SrcMod, DstMod=DstMod) ! TODO + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine HD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'HD_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! T%ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(HydroDyn_u_PRPMesh), & ! T%HD%Input(1)%PRPMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! If SubDyn is not active substructure motion/loads come from ElastoDyn + if (Turbine%p_FAST%CompSub /= Module_SD) then + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%HD%y%WAMITMesh%Committed) + if (Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%HD%Input(1)%Morison%Mesh%Committed) + if (Failed()) return + end if + + case (Module_SD) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%HD%y%WAMITMesh%Committed) + if (Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%HD%Input(1)%Morison%Mesh%Committed) + if (Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine IfW_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BD_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + call NonMeshMap(Mappings, "ED HubMotion -> IfW HubMotion", SrcMod=SrcMod, DstMod=DstMod) + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine SD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BD_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + case (Module_ED) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! T%ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(SD_u_TPMesh), & ! T%SD%Input(1)%TPMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SrvD) + + ! Substructure Structural Controller + do j = 1, Turbine%SrvD%p%NumSStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%Input(1)%LMesh + DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BD_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_BD) + call NonMeshMap(Mappings, "BD Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) + call NonMeshMap(Mappings, "BD RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) + + case (Module_ED) + + call NonMeshMap(Mappings, "ED Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) + if (Turbine%p_FAST%CompElast == Module_ED) then + call NonMeshMap(Mappings, "ED RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) + end if + + ! Nacelle Structural Controller + do j = 1, Turbine%SrvD%p%NumNStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Tower Structural Controller + do j = 1, Turbine%SrvD%p%NumTStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion + DstMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Blade Structural Controller (if ElastoDyn is used for blades) + if (Turbine%p_FAST%CompElast == Module_ED) then + do i = 1, Turbine%SrvD%p%NumBStC + do j = 1, Turbine%ED%p%NumBl + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + end do + end if + + ! Substructure Structural Controller (if not using SubDyn) + if (Turbine%p_FAST%CompSub /= Module_SD) then + do j = 1, Turbine%SrvD%p%NumSStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + end if + + case (Module_IfW) + call NonMeshMap(Mappings, "IfW Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) + + case (Module_SD) + + ! Substructure Structural Controller + do j = 1, Turbine%SrvD%p%NumSStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & + DstMod, DstMeshLoc, DstDispMeshLoc, ErrStat, ErrMsg, Active) + type(FAST_TurbineType), target :: Turbine + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(MeshLocType), intent(in) :: SrcMeshLoc, DstMeshLoc + type(MeshLocType), intent(in) :: SrcDispMeshLoc, DstDispMeshLoc + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional, intent(in) :: Active + + character(*), parameter :: RoutineName = 'MapLoadMesh' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(TC_MappingType) :: Mapping + type(MeshType), pointer :: SrcMesh, SrcDispMesh + type(MeshType), pointer :: DstMesh, DstDispMesh + + ErrStat = ErrID_None + ErrMsg = '' + + ! If active argument is set to false, return + if (present(Active)) then + if (.not. Active) return + end if + + ! Get mesh pointers + SrcMesh => FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc) + SrcDispMesh => FAST_InputMeshPointer(SrcMod, Turbine, SrcDispMeshLoc, UseU=.false.) + DstMesh => FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, UseU=.false.) + DstDispMesh => FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc) + + ! Check that all meshes in mapping have nonzero identifiers + if (SrcMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + else if (SrcDispMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcDispMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + else if (DstMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + else if (DstDispMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstDispMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + end if + + ! Initialize mapping structure + Mapping%MapType = Map_LoadMesh + Mapping%SrcModIdx = SrcMod%Idx + Mapping%SrcModID = SrcMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%DstModIdx = DstMod%Idx + Mapping%DstModID = DstMod%ID + Mapping%DstIns = DstMod%Ins + Mapping%SrcMeshLoc = SrcMeshLoc + Mapping%SrcDispMeshLoc = SrcDispMeshLoc + Mapping%DstMeshLoc = DstMeshLoc + Mapping%DstDispMeshLoc = DstDispMeshLoc + + ! Create mesh mapping + call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + + ! Create a copy of destination mesh in mapping for load summation + call MeshCopy(DstMesh, Mapping%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Get mapping indices for linearized mesh mapping + call InitMeshLinearization(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) + + ! Add mapping to array of mappings + Mappings = [Mappings, Mapping] + +contains + logical function Failed() + Failed = ErrStat2 >= AbortErrLev + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end function +end subroutine + +subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshLoc, ErrStat, ErrMsg, Active) + type(FAST_TurbineType), target :: Turbine + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(MeshLocType), intent(in) :: SrcMeshLoc, DstMeshLoc + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional, intent(in) :: Active + + character(*), parameter :: RoutineName = 'MapMotionMesh' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(TC_MappingType) :: Mapping + type(MeshType), pointer :: SrcMesh, DstMesh + + ErrStat = ErrID_None + ErrMsg = '' + + ! If active argument is set to false, return + if (present(Active)) then + if (.not. Active) return + end if + + ! Get mesh pointers + SrcMesh => FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc) + DstMesh => FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, UseU=.false.) + + ! Check that all meshes in mapping have nonzero identifiers + if (SrcMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + else if (DstMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + end if + + ! Initialize mapping structure + Mapping%MapType = Map_MotionMesh + Mapping%SrcModIdx = SrcMod%Idx + Mapping%SrcModID = SrcMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%DstModIdx = DstMod%Idx + Mapping%DstModID = DstMod%ID + Mapping%DstIns = DstMod%Ins + Mapping%SrcMeshLoc = SrcMeshLoc + Mapping%DstMeshLoc = DstMeshLoc + + ! Create mesh mapping + call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + + ! Get mapping indices for linearized mesh mapping + call InitMeshLinearization(Mapping, SrcMod, DstMod, SrcMesh, DstMesh) + + ! Add mapping to array of mappings + Mappings = [Mappings, Mapping] + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine NonMeshMap(Maps, Key, SrcMod, DstMod, i1, i2, Active) + type(TC_MappingType), allocatable :: Maps(:) + character(*), intent(in) :: Key + type(ModDataType), intent(in) :: SrcMod, DstMod + integer(IntKi), optional, intent(in) :: i1, i2 + logical, optional, intent(in) :: Active + type(TC_MappingType) :: Mapping + + if (present(Active)) then + if (.not. Active) return + end if + + ! Initialize mapping structure + Mapping%MapType = Map_NonMesh + Mapping%SrcModIdx = SrcMod%Idx + Mapping%SrcModID = SrcMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%DstModIdx = DstMod%Idx + Mapping%DstModID = DstMod%ID + Mapping%DstIns = DstMod%Ins + + ! Get optional mapping indicies + if (present(i1)) Mapping%i1 = i1 + if (present(i2)) Mapping%i2 = i2 + + Maps = [Maps, Mapping] +end subroutine + +subroutine InitMeshLinearization(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) + type(TC_MappingType), intent(inout) :: Mapping + type(ModDataType), intent(in) :: SrcMod, DstMod + type(MeshType), intent(in) :: SrcMesh, DstMesh + type(MeshType), optional, intent(in) :: SrcDispMesh, DstDispMesh + + ! Save source and destination mesh ID + Mapping%SrcMeshID = SrcMesh%ID + Mapping%DstMeshID = DstMesh%ID + + ! Determine transfer type + if ((SrcMesh%ElemTable(ELEMENT_POINT)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_POINT)%nelem > 0)) then + Mapping%XfrType = Xfr_Point_to_Point + else if ((SrcMesh%ElemTable(ELEMENT_POINT)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_LINE2)%nelem > 0)) then + Mapping%XfrType = Xfr_Point_to_Line2 + else if ((SrcMesh%ElemTable(ELEMENT_LINE2)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_POINT)%nelem > 0)) then + Mapping%XfrType = Xfr_Line2_to_Point + else if ((SrcMesh%ElemTable(ELEMENT_LINE2)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_LINE2)%nelem > 0)) then + Mapping%XfrType = Xfr_Line2_to_Line2 + end if + + ! Get data locations for variables of source mesh fields + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransDisp, SrcMod%iyg, Mapping%iLocSrcTransDisp) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransVel, SrcMod%iyg, Mapping%iLocSrcTransVel) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransAcc, SrcMod%iyg, Mapping%iLocSrcTransAcc) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Orientation, SrcMod%iyg, Mapping%iLocSrcOrientation) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_AngularVel, SrcMod%iyg, Mapping%iLocSrcAngularVel) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_AngularAcc, SrcMod%iyg, Mapping%iLocSrcAngularAcc) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Force, SrcMod%iyg, Mapping%iLocSrcForce) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Moment, SrcMod%iyg, Mapping%iLocSrcMoment) + + ! Get data locations for variables of destination mesh fields + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransDisp, DstMod%iug, Mapping%iLocDstTransDisp) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransVel, DstMod%iug, Mapping%iLocDstTransVel) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransAcc, DstMod%iug, Mapping%iLocDstTransAcc) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Orientation, DstMod%iug, Mapping%iLocDstOrientation) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_AngularVel, DstMod%iug, Mapping%iLocDstAngularVel) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_AngularAcc, DstMod%iug, Mapping%iLocDstAngularAcc) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Force, DstMod%iug, Mapping%iLocDstForce) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Moment, DstMod%iug, Mapping%iLocDstMoment) + + if (present(SrcDispMesh)) then + Mapping%SrcDispMeshID = SrcDispMesh%ID + call FindVarByMeshAndField(SrcMod%Vars%u, SrcDispMesh%ID, VF_TransDisp, SrcMod%iug, Mapping%iLocSrcDispTransDisp) + end if + + if (present(DstDispMesh)) then + Mapping%DstDispMeshID = DstDispMesh%ID + call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_TransDisp, DstMod%iyg, Mapping%iLocDstDispTransDisp) + end if + +contains + subroutine FindVarByMeshAndField(VarAry, MeshID, Field, iGbl, iLoc) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(in) :: MeshID, Field, iGbl + integer(IntKi), intent(out) :: iLoc(2) + integer(IntKi) :: i + + ! Initialize locations + iLoc = 0 + + ! Loop through variables, if variable's mesh ID and field matches given values, return + do i = 1, size(VarAry) + if ((VarAry(i)%MeshID == MeshID) .and. (VarAry(i)%Field == Field)) then + iLoc = VarAry(i)%iLoc + iGbl - 1 + return + end if + end do + end subroutine +end subroutine + +subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, ErrMsg, dUdu, dUdy) + type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type + type(ModDataType), intent(in) :: Mods(:) !< Module data + type(TC_MappingType), intent(inout) :: Mappings(:) + integer(IntKi), intent(in) :: ModOrder(:) + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), optional, intent(inout) :: dUdu(:, :), dUdy(:, :) + + character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + type(MeshType), pointer :: SrcMesh, DstMesh + type(MeshType), pointer :: SrcDispMesh, DstDispMesh + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through modules in specified order + do i = 1, size(ModOrder) + + ! Loop through mappings where this module is the destination + do j = 1, size(Mods((ModOrder(i)))%DstMaps) + associate (Mapping => Mappings(Mods((ModOrder(i)))%DstMaps(j))) + + ! Select based on type of mapping + select case (Mapping%MapType) + case (Map_NonMesh) + cycle + + case (Map_MotionMesh) + + ! Get source and destination meshes + SrcMesh => FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc) + DstMesh => FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU=.false.) + + ! Perform linearization based on transfer type + select case (Mapping%XfrType) + case (Xfr_Point_to_Point) + call Linearize_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + case (Xfr_Point_to_Line2) + call Linearize_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + case (Xfr_Line2_to_Point) + call Linearize_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + case (Xfr_Line2_to_Line2) + call Linearize_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + end select + + case (Map_LoadMesh) + + ! Get source and destination meshes + SrcMesh => FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc) + DstMesh => FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU=.false.) + + ! Get source and destination displacement meshes + SrcDispMesh => FAST_InputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcDispMeshLoc, UseU=.false.) + DstDispMesh => FAST_OutputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstDispMeshLoc) + + ! Perform linearization based on transfer type + select case (Mapping%XfrType) + case (Xfr_Point_to_Point) + call Linearize_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + case (Xfr_Point_to_Line2) + call Linearize_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + case (Xfr_Line2_to_Point) + call Linearize_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + case (Xfr_Line2_to_Line2) + call Linearize_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + end select + + end select + + write (*, *) trim(FAST_OutputMeshName(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc)), " -> ", & + FAST_InputMeshName(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc) + + ! Check for errors + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Copy linearization matrices to global dUdu matrix + if (present(dUdu)) then + call dUduSetBlocks(Mapping, Mapping%MeshMap%dM) + end if + + ! Copy linearization matrices to global dUdy matrix + if (present(dUdy)) then + call dUdySetBlocks(Mapping, Mapping%MeshMap%dM) + end if + + end associate + end do + end do + +contains + subroutine dUduSetBlocks(Mapping, dM) + type(TC_MappingType), intent(inout) :: Mapping !< Mapping + type(MeshMapLinearizationType), intent(in) :: dM !< Mesh Map Linearization data + + ! Effect of input Translation Velocity on input Translation Displacement + if (allocated(dM%tv_uD)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%tv_uD, dUdu) + call SetBlock(Mapping%iLocDstTransVel, Mapping%iLocDstTransDisp, -dM%tv_uD, dUdU) + end if + + ! Effect of input Translation Acceleration on input Translation Displacement + if (allocated(dM%ta_uD)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%ta_uD, dUdu) + call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocDstTransDisp, -dM%ta_uD, dUdU) + end if + + ! Effect of input Moments on input Translation Displacement + if (allocated(dM%M_uS)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%u([M%SrcDispVarIdx]), VF_TransDisp, -MML%M_uS, dUdu) + call SetBlock(Mapping%iLocDstMoment, Mapping%iLocSrcDispTransDisp, -dM%M_uS, dUdU) + end if + end subroutine + + subroutine dUdySetBlocks(Mapping, dM) + type(TC_MappingType), intent(inout) :: Mapping !< Mapping + type(MeshMapLinearizationType), intent(in) :: dM !< Mesh Map Linearization data + + ! Load identity + if (allocated(dM%li)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Force, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%li, dUdy) + call SetBlock(Mapping%iLocDstForce, Mapping%iLocSrcForce, -dM%li, dUdy) + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Moment, -MML%li, dUdy) + call SetBlock(Mapping%iLocDstMoment, Mapping%iLocSrcMoment, -dM%li, dUdy) + end if + + ! Moment to Force + if (allocated(dM%m_f)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%m_f, dUdy) + call SetBlock(Mapping%iLocDstMoment, Mapping%iLocSrcForce, -dM%m_f, dUdy) + end if + + ! Moment to destination translation displacement + if (allocated(dM%m_uD)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, DstMod%Vars%y([M%DstDispVarIdx]), VF_TransDisp, -MML%m_uD, dUdy) + call SetBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, -dM%m_uD, dUdy) + end if + + ! Motion identity + if (allocated(dM%mi)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%mi, dUdy) + call SetBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcTransDisp, -dM%mi, dUdy) + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Orientation, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%mi, dUdy) + call SetBlock(Mapping%iLocDstOrientation, Mapping%iLocSrcOrientation, -dM%mi, dUdy) + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransVel, -MML%mi, dUdy) + call SetBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransVel, -dM%mi, dUdy) + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%mi, dUdy) + call SetBlock(Mapping%iLocDstAngularVel, Mapping%iLocSrcAngularVel, -dM%mi, dUdy) + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransAcc, -MML%mi, dUdy) + call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransAcc, -dM%mi, dUdy) + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%mi, dUdy) + call SetBlock(Mapping%iLocDstAngularAcc, Mapping%iLocSrcAngularAcc, -dM%mi, dUdy) + end if + + ! Translation to Rotation + if (allocated(dM%fx_p)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%fx_p, dUdy) + call SetBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcOrientation, -dM%fx_p, dUdy) + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%fx_p, dUdy) + call SetBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcAngularVel, -dM%fx_p, dUdy) + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%fx_p, dUdy) + call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularAcc, -dM%fx_p, dUdy) + end if + + ! Translation velocity to translation displacement + if (allocated(dM%tv_us)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%tv_us, dUdy) + call SetBlock(Mapping%iLocDstTransVel, Mapping%iLocDstDispTransDisp, -dM%tv_us, dUdy) + end if + + ! Translation acceleration to translation displacement + if (allocated(dM%ta_us)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%ta_us, dUdy) + call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransDisp, -dM%ta_us, dUdy) + end if + + ! Translation acceleration to angular velocity + if (allocated(dM%ta_rv)) then + ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%ta_rv, dUdy) + call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularVel, -dM%ta_rv, dUdy) + end if + end subroutine + + subroutine SetBlock(iLocRow, iLocCol, SrcM, DstM) + integer(IntKi), intent(in) :: iLocRow(2), iLocCol(2) + real(R8Ki), intent(in) :: SrcM(:, :) + real(R8Ki), intent(inout) :: DstM(:, :) + if (iLocRow(1) > 0 .and. iLocCol(1) > 0) then + associate (DstSubM => DstM(iLocRow(1):iLocRow(1)+size(SrcM,1)-1, iLocCol(1):iLocCol(1)+size(SrcM,2)-1)) + ! associate (DstSubM => DstM(iLocRow(1):iLocRow(2), iLocCol(1):iLocCol(2))) + ! if ((size(SrcM, 1) /= (iLocRow(2) - iLocRow(1) + 1)) .or. (size(SrcM, 2) /= (iLocCol(2) - iLocCol(1)) + 1)) then + ! print *, "hello" + ! end if + DstSubM = DstSubM + SrcM + end associate + end if + end subroutine +end subroutine + +subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + type(ModDataType), intent(in) :: Mods(:) !< Module data + type(TC_MappingType), intent(inout) :: Mappings(:) + integer(IntKi), intent(in) :: iMod !< Index of module in Mods to do input solve + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, intent(in) :: UseU ! Flag to transfer to u instead of Input + + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(MeshType), pointer :: SrcMesh, DstMesh + type(MeshType), pointer :: SrcDispMesh, DstDispMesh + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through mappings where this module is the destination + do i = 1, size(Mods(iMod)%DstMaps) + associate (Mapping => Mappings(Mods(iMod)%DstMaps(i))) + + ! Select based on type of mapping + select case (Mapping%MapType) + case (Map_NonMesh) + call NonMesh_InputSolve(Turbine, Mapping, ErrStat2, ErrMsg2, UseU) + if (Failed()) return + + case (Map_MotionMesh) + + ! Get source and destination meshes + SrcMesh => FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc) + DstMesh => FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU) + + ! Perform linearization based on transfer type + select case (Mapping%XfrType) + case (Xfr_Point_to_Point) + call Linearize_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + case (Xfr_Point_to_Line2) + call Linearize_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + case (Xfr_Line2_to_Point) + call Linearize_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + case (Xfr_Line2_to_Line2) + call Linearize_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + end select + if (Failed()) return + + case (Map_LoadMesh) + + ! Get source and destination meshes + SrcMesh => FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc) + DstMesh => FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU) + + ! Get source and destination displacement meshes + SrcDispMesh => FAST_InputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcDispMeshLoc, UseU) + DstDispMesh => FAST_OutputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstDispMeshLoc) + + ! Perform linearization based on transfer type + select case (Mapping%XfrType) + case (Xfr_Point_to_Point) + call Linearize_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + case (Xfr_Point_to_Line2) + call Linearize_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + case (Xfr_Line2_to_Point) + call Linearize_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + case (Xfr_Line2_to_Line2) + call Linearize_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + end select + if (Failed()) return + + end select + + end associate + end do + +contains + logical function Failed() + Failed = ErrStat2 /= ErrID_None + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, & + RoutineName//':Module='//trim(Mods(iMod)%Abbr)//', Instance='//Num2LStr(Mods(iMod)%Ins)) + end function +end subroutine + +subroutine NonMesh_InputSolve(Turbine, Mapping, ErrStat, ErrMsg, UseU) + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + type(TC_MappingType), intent(in) :: Mapping + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, intent(in) :: UseU ! Flag to transfer to u instead of Input + + character(*), parameter :: RoutineName = 'NonMesh_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + +! case ("BD RootM -> SrvD RootM") + + ! u_SrvD%RootMxc(Maps(i)%SrcIns) = T%BD%y(Maps(i)%SrcIns)%RootMxr*cos(T%ED%y%BlPitch(Maps(i)%SrcIns)) + & + ! T%BD%y(Maps(i)%SrcIns)%RootMyr*sin(T%ED%y%BlPitch(Maps(i)%SrcIns)) + ! u_SrvD%RootMyc(Maps(i)%SrcIns) = -T%BD%y(Maps(i)%SrcIns)%RootMxr*sin(T%ED%y%BlPitch(Maps(i)%SrcIns)) + & + ! T%BD%y(Maps(i)%SrcIns)%RootMyr*cos(T%ED%y%BlPitch(Maps(i)%SrcIns)) + + ! case ("ED RootM -> SrvD RootM") + + ! u_SrvD%RootMxc = T%ED%y%RootMxc ! fixed-size arrays: always size 3 + ! u_SrvD%RootMyc = T%ED%y%RootMyc ! fixed-size arrays: always size 3 + + ! case ("ED Data -> SrvD Data") + + ! u_SrvD%YawAngle = T%ED%y%YawAngle ! nacelle yaw plus platform yaw + + ! u_SrvD%Yaw = T%ED%y%Yaw ! nacelle yaw + ! u_SrvD%YawRate = T%ED%y%YawRate + ! u_SrvD%BlPitch = T%ED%y%BlPitch + ! u_SrvD%LSS_Spd = T%ED%y%LSS_Spd + ! u_SrvD%HSS_Spd = T%ED%y%HSS_Spd + ! u_SrvD%RotSpeed = T%ED%y%RotSpeed + + ! u_SrvD%YawBrTAxp = T%ED%y%YawBrTAxp + ! u_SrvD%YawBrTAyp = T%ED%y%YawBrTAyp + ! u_SrvD%LSSTipPxa = T%ED%y%LSSTipPxa + + ! u_SrvD%LSSTipMxa = T%ED%y%LSSTipMxa + ! u_SrvD%LSSTipMya = T%ED%y%LSSTipMya + ! u_SrvD%LSSTipMza = T%ED%y%LSSTipMza + ! u_SrvD%LSSTipMys = T%ED%y%LSSTipMys + ! u_SrvD%LSSTipMzs = T%ED%y%LSSTipMzs + + ! u_SrvD%YawBrMyn = T%ED%y%YawBrMyn + ! u_SrvD%YawBrMzn = T%ED%y%YawBrMzn + ! u_SrvD%NcIMURAxs = T%ED%y%NcIMURAxs + ! u_SrvD%NcIMURAys = T%ED%y%NcIMURAys + ! u_SrvD%NcIMURAzs = T%ED%y%NcIMURAzs + + ! u_SrvD%RotPwr = T%ED%y%RotPwr + + ! u_SrvD%LSShftFxa = T%ED%y%LSShftFxa + ! u_SrvD%LSShftFys = T%ED%y%LSShftFys + ! u_SrvD%LSShftFzs = T%ED%y%LSShftFzs + + ! case ('ED PlatformMotion -> SrvD PlatformMotion') + ! case ('ED TowerMotion -> SrvD TowerMotion') + ! case ('ED NacelleMotion -> SrvD NacelleMotion') + ! case ('ED BladeMotion -> SrvD BladeMotion') + + ! case ("IfW Data -> SrvD Data") + + ! u_SrvD%WindDir = atan2(T%IfW%y%VelocityUVW(2, 1), T%IfW%y%VelocityUVW(1, 1)) + ! u_SrvD%HorWindV = sqrt(T%IfW%y%VelocityUVW(1, 1)**2 + T%IfW%y%VelocityUVW(2, 1)**2) + ! if (allocated(T%IfW%y%lidar%LidSpeed)) u_SrvD%LidSpeed = T%IfW%y%lidar%LidSpeed + ! if (allocated(T%IfW%y%lidar%MsrPositionsX)) u_SrvD%MsrPositionsX = T%IfW%y%lidar%MsrPositionsX + ! if (allocated(T%IfW%y%lidar%MsrPositionsY)) u_SrvD%MsrPositionsY = T%IfW%y%lidar%MsrPositionsY + ! if (allocated(T%IfW%y%lidar%MsrPositionsZ)) u_SrvD%MsrPositionsZ = T%IfW%y%lidar%MsrPositionsZ + +! ! Zero tower and platform added mass +! ! u_ED%TwrAddedMass = 0.0_ReKi +! ! u_ED%PtfmAddedMass = 0.0_ReKi + +! case ("SrvD Data -> ED Data") +! if (Linearize) then +! else +! u_ED%GenTrq = T%SrvD%y%GenTrq +! u_ED%HSSBrTrqC = T%SrvD%y%HSSBrTrqC +! u_ED%BlPitchCom = T%SrvD%y%BlPitchCom +! u_ED%YawMom = T%SrvD%y%YawMom +! end if + +! case ('SrvD BlAirfoilCom -> AD UserProp') +! ! Set Conrol parameter (i.e. flaps) if using ServoDyn bem: +! ! This takes in flap deflection for each blade (only one flap deflection angle per blade), +! ! from ServoDyn (which comes from Bladed style DLL controller) +! ! Commanded Airfoil UserProp for blade (must be same units as given in AD15 airfoil tables) +! ! This is passed to AD15 to be interpolated with the airfoil table userprop column +! ! (might be used for airfoil flap angles for example) +! ! Must be same units as given in airfoil (no unit conversions handled in code)ß +! ! do k_bl = 1, size(u_AD%rotors(1)%UserProp, dim=2) +! ! do k_bn = 1, size(u_AD%rotors(1)%UserProp, dim=1) +! ! u_AD%rotors(1)%UserProp(k_bn, k_bl) = T%SrvD%y%BlAirfoilCom(k_bl) +! ! end do +! ! end do + +! case ('ED HubMotion -> IfW HubMotion') + +! u_IfW%PositionXYZ(:, 1) = T%ED%y%HubPtMotion%Position(:, 1) +! u_IfW%HubPosition = T%ED%y%HubPtMotion%Position(:, 1) + & +! T%ED%y%HubPtMotion%TranslationDisp(:, 1) +! u_IfW%HubOrientation = T%ED%y%HubPtMotion%Orientation(:, :, 1) + +! ! Set Lidar position directly from hub motion mesh +! u_IfW%lidar%HubDisplacementX = T%ED%y%HubPtMotion%TranslationDisp(1, 1) +! u_IfW%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) +! u_IfW%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) + +end subroutine + +subroutine SumMeshLoads(SrcMesh, DstMesh, DstResetFlag) + type(MeshType), intent(in) :: SrcMesh + type(MeshType), intent(inout) :: DstMesh + logical, intent(inout) :: DstResetFlag + if (DstResetFlag) then + DstResetFlag = .false. + if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = 0.0_ReKi + if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = 0.0_ReKi + end if + if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = DstMesh%Force + SrcMesh%Force + if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = DstMesh%Moment + SrcMesh%Moment +end subroutine + +subroutine FAST_ResetRemapFlags(Mods, Maps, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_ResetRemapFlags' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! Reset remap flags in mapping temporary meshes + do i = 1, size(Maps) + if (associated(Maps(i)%MeshTmp%RemapFlag)) Maps(i)%MeshTmp%RemapFlag = .false. + end do + + do i = 1, size(Mods) + + ! Select based on module ID + select case (Mods(i)%ID) + + case (Module_AD) + + if (T%AD%Input(1)%rotors(1)%HubMotion%Committed) then + T%AD%Input(1)%rotors(1)%HubMotion%RemapFlag = .false. + T%AD%y%rotors(1)%HubLoad%RemapFlag = .false. + end if + + if (T%AD%Input(1)%rotors(1)%TowerMotion%Committed) then + T%AD%Input(1)%rotors(1)%TowerMotion%RemapFlag = .false. + + if (T%AD%y%rotors(1)%TowerLoad%Committed) then + T%AD%y%rotors(1)%TowerLoad%RemapFlag = .false. + end if + end if + + if (T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) then + T%AD%Input(1)%rotors(1)%NacelleMotion%RemapFlag = .false. + T%AD%y%rotors(1)%NacelleLoad%RemapFlag = .false. + end if + + if (T%AD%Input(1)%rotors(1)%TFinMotion%Committed) then + T%AD%Input(1)%rotors(1)%TFinMotion%RemapFlag = .false. + T%AD%y%rotors(1)%TFinLoad%RemapFlag = .false. + end if + + do k = 1, size(T%AD%Input(1)%rotors(1)%BladeMotion) + T%AD%Input(1)%rotors(1)%BladeRootMotion(k)%RemapFlag = .false. + T%AD%Input(1)%rotors(1)%BladeMotion(k)%RemapFlag = .false. + T%AD%y%rotors(1)%BladeLoad(k)%RemapFlag = .false. + end do + + case (Module_BD) + + T%BD%Input(1, Mods(i)%Ins)%RootMotion%RemapFlag = .false. + T%BD%Input(1, Mods(i)%Ins)%PointLoad%RemapFlag = .false. + T%BD%Input(1, Mods(i)%Ins)%DistrLoad%RemapFlag = .false. + T%BD%Input(1, Mods(i)%Ins)%HubMotion%RemapFlag = .false. + + T%BD%y(Mods(i)%Ins)%ReactionForce%RemapFlag = .false. + T%BD%y(Mods(i)%Ins)%BldMotion%RemapFlag = .false. + + case (Module_ED) + + T%ED%Input(1)%PlatformPtMesh%RemapFlag = .false. + T%ED%y%PlatformPtMesh%RemapFlag = .false. + T%ED%Input(1)%TowerPtLoads%RemapFlag = .false. + T%ED%y%TowerLn2Mesh%RemapFlag = .false. + do K = 1, size(T%ED%y%BladeRootMotion) + T%ED%y%BladeRootMotion(K)%RemapFlag = .false. + end do + if (allocated(T%ED%Input(1)%BladePtLoads)) then + do K = 1, size(T%ED%Input(1)%BladePtLoads) + T%ED%Input(1)%BladePtLoads(K)%RemapFlag = .false. + T%ED%y%BladeLn2Mesh(K)%RemapFlag = .false. + end do + end if + T%ED%Input(1)%NacelleLoads%RemapFlag = .false. + T%ED%y%NacelleMotion%RemapFlag = .false. + T%ED%Input(1)%TFinCMLoads%RemapFlag = .false. + T%ED%y%TFinCMMotion%RemapFlag = .false. + T%ED%Input(1)%HubPtLoad%RemapFlag = .false. + T%ED%y%HubPtMotion%RemapFlag = .false. + + case (Module_ExtPtfm) + + if (T%ExtPtfm%Input(1)%PtfmMesh%Committed) then + T%ExtPtfm%Input(1)%PtfmMesh%RemapFlag = .false. + T%ExtPtfm%y%PtfmMesh%RemapFlag = .false. + end if + + case (Module_FEAM) + + T%FEAM%Input(1)%PtFairleadDisplacement%RemapFlag = .false. + T%FEAM%y%PtFairleadLoad%RemapFlag = .false. + + case (Module_HD) + + T%HD%Input(1)%PRPMesh%RemapFlag = .false. + if (T%HD%Input(1)%WAMITMesh%Committed) then + T%HD%Input(1)%WAMITMesh%RemapFlag = .false. + T%HD%y%WAMITMesh%RemapFlag = .false. + end if + if (T%HD%Input(1)%Morison%Mesh%Committed) then + T%HD%Input(1)%Morison%Mesh%RemapFlag = .false. + T%HD%y%Morison%Mesh%RemapFlag = .false. + end if + + case (Module_IceD) + + if (T%IceD%Input(1, Mods(i)%Ins)%PointMesh%Committed) then + T%IceD%Input(1, Mods(i)%Ins)%PointMesh%RemapFlag = .false. + T%IceD%y(Mods(i)%Ins)%PointMesh%RemapFlag = .false. + end if + + case (Module_IceF) + + if (T%IceF%Input(1)%iceMesh%Committed) then + T%IceF%Input(1)%iceMesh%RemapFlag = .false. + T%IceF%y%iceMesh%RemapFlag = .false. + end if + + case (Module_MAP) + + T%MAP%Input(1)%PtFairDisplacement%RemapFlag = .false. + T%MAP%y%PtFairleadLoad%RemapFlag = .false. + + case (Module_MD) + + T%MD%Input(1)%CoupledKinematics(1)%RemapFlag = .false. + T%MD%y%CoupledLoads(1)%RemapFlag = .false. + + case (Module_Orca) + + T%Orca%Input(1)%PtfmMesh%RemapFlag = .false. + T%Orca%y%PtfmMesh%RemapFlag = .false. + + case (Module_SD) + + if (T%SD%Input(1)%TPMesh%Committed) then + T%SD%Input(1)%TPMesh%RemapFlag = .false. + T%SD%y%Y1Mesh%RemapFlag = .false. + end if + + if (T%SD%Input(1)%LMesh%Committed) then + T%SD%Input(1)%LMesh%RemapFlag = .false. + T%SD%y%Y2Mesh%RemapFlag = .false. + T%SD%y%Y3Mesh%RemapFlag = .false. + end if + + end select + + end do + +end subroutine + +end module From 068363e9b8eb2447c471b553872b79d5c818ec28 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 16:25:31 +0000 Subject: [PATCH 055/319] Add modules in FAST_Subs, replace FAST_Linearize_OP --- modules/openfast-library/src/FAST_Subs.f90 | 80 +++++++++++++++------- 1 file changed, 56 insertions(+), 24 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 2248343b26..f14f80a572 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -21,6 +21,7 @@ !********************************************************************************************************************************** MODULE FAST_Subs + USE FAST_ModLin USE FAST_Solver USE FAST_Linear USE SC_DataEx @@ -66,6 +67,11 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) END IF + if(ErrStat >= AbortErrLev) return + + call ModLin_Init(Turbine%y_FAST%ModGlue, Turbine%y_FAST%Modules, & + Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, & + Turbine%p_FAST, Turbine%m_FAST, Turbine, ErrStat, ErrMsg) END SUBROUTINE FAST_InitializeAll_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -292,6 +298,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) end if + ! Add module to array of modules + CALL MV_AddModule(y_FAST%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + Init%OutData_ED%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -427,6 +438,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) end if + ! Add module instance to array of modules + CALL MV_AddModule(y_FAST%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO IF (ErrStat >= AbortErrLev) THEN @@ -566,6 +581,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Initialize a module instance for each rotor + do i = 1, size(Init%OutData_AD%rotors) + CALL MV_AddModule(y_FAST%Modules, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + Init%OutData_AD%rotors(i)%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + allocate( y_FAST%Lin%Modules(MODULE_AD)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) @@ -1527,6 +1549,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_SrvD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL MV_AddModule(y_FAST%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + Init%OutData_SrvD%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !! initialize SrvD%y%ElecPwr and SrvD%y%GenTq because they are one timestep different (used as input for the next step)? allocate( y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1), stat=ErrStat2) @@ -1604,24 +1630,24 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if ( p_FAST%Linearize .or. p_FAST%CompAeroMaps) then ! NOTE: In the following call, we use Init%OutData_AD%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, which ! is consistent with the current AD implementation, but if AD changes this, then it must be handled here, too! - if (p_FAST%CompAero == MODULE_AD) then - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) - else - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) - endif - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - if (p_FAST%CompAeroMaps) then - p_FAST%SizeJac_Opt1(1) = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL) - p_FAST%TolerSquared = p_FAST%TolerSquared * (p_FAST%SizeJac_Opt1(1)**2) ! do this calculation here so we don't have to keep dividing by the size of the array later - p_FAST%NumBl_Lin = 1 - else - p_FAST%NumBl_Lin = NumBl - end if + ! if (p_FAST%CompAero == MODULE_AD) then + ! call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) + ! else + ! call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) + ! endif + ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! if (ErrStat >= AbortErrLev) then + ! call Cleanup() + ! return + ! end if + + ! if (p_FAST%CompAeroMaps) then + ! p_FAST%SizeJac_Opt1(1) = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL) + ! p_FAST%TolerSquared = p_FAST%TolerSquared * (p_FAST%SizeJac_Opt1(1)**2) ! do this calculation here so we don't have to keep dividing by the size of the array later + ! p_FAST%NumBl_Lin = 1 + ! else + ! p_FAST%NumBl_Lin = NumBl + ! end if end if @@ -9302,12 +9328,18 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then - CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + call ModLin_Linearize_OP(Turbine, Turbine%y_FAST%ModGlue, Turbine%y_FAST%Modules, & + Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, Turbine%p_FAST, Turbine%m_FAST, & + Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + ! Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! IF (ErrStat >= AbortErrLev) RETURN if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) then if (Turbine%m_FAST%Lin%NextLinTimeIndx > Turbine%p_FAST%NLinTimes) call WrVTKCheckpoint() From 098296d08f390d626726e987a9339cd923217851 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 17:09:02 +0000 Subject: [PATCH 056/319] Regenerate _Types.f90 files after registry modifications --- modules/extloads/src/ExtLoadsDX_Types.f90 | 36 +++++++++ modules/extloads/src/ExtLoads_Types.f90 | 81 +++++++++++++++++++ modules/openfast-library/src/FAST_Types.f90 | 50 ++++++------ .../seastate/src/SeaSt_WaveField_Types.f90 | 17 ++++ 4 files changed, 160 insertions(+), 24 deletions(-) diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index e0b86c1837..c98778d003 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -1601,5 +1601,41 @@ SUBROUTINE ExtLdDX_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%bldLd = a1*y1%bldLd + a2*y2%bldLd + a3*y3%bldLd END IF ! check if allocated END SUBROUTINE + +function ExtLdDX_InputMeshPointer(u, ML) result(Mesh) + type(ExtLdDX_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function ExtLdDX_InputMeshName(u, ML) result(Name) + type(ExtLdDX_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function ExtLdDX_OutputMeshPointer(y, ML) result(Mesh) + type(ExtLdDX_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function ExtLdDX_OutputMeshName(y, ML) result(Name) + type(ExtLdDX_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE ExtLoadsDX_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 1a7e775232..6ba545db72 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -34,6 +34,15 @@ MODULE ExtLoads_Types USE ExtLoadsDX_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_TowerMotion = 1 ! Mesh number for ExtLd ExtLd_u_TowerMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_HubMotion = 2 ! Mesh number for ExtLd ExtLd_u_HubMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_NacelleMotion = 3 ! Mesh number for ExtLd ExtLd_u_NacelleMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_BladeRootMotion = 4 ! Mesh number for ExtLd ExtLd_u_BladeRootMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_BladeMotion = 5 ! Mesh number for ExtLd ExtLd_u_BladeMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_y_TowerLoad = 6 ! Mesh number for ExtLd ExtLd_y_TowerLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_y_BladeLoad = 7 ! Mesh number for ExtLd ExtLd_y_BladeLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_y_TowerLoadAD = 8 ! Mesh number for ExtLd ExtLd_y_TowerLoadAD mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_y_BladeLoadAD = 9 ! Mesh number for ExtLd ExtLd_y_BladeLoadAD mesh [-] ! ========= ExtLd_InitInputType ======= TYPE, PUBLIC :: ExtLd_InitInputType INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] @@ -1504,5 +1513,77 @@ SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, END DO END IF ! check if allocated END SUBROUTINE + +function ExtLd_InputMeshPointer(u, ML) result(Mesh) + type(ExtLd_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (ExtLd_u_TowerMotion) + Mesh => u%TowerMotion + case (ExtLd_u_HubMotion) + Mesh => u%HubMotion + case (ExtLd_u_NacelleMotion) + Mesh => u%NacelleMotion + case (ExtLd_u_BladeRootMotion) + Mesh => u%BladeRootMotion(ML%i1) + case (ExtLd_u_BladeMotion) + Mesh => u%BladeMotion(ML%i1) + end select +end function + +function ExtLd_InputMeshName(u, ML) result(Name) + type(ExtLd_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (ExtLd_u_TowerMotion) + Name = "u%TowerMotion" + case (ExtLd_u_HubMotion) + Name = "u%HubMotion" + case (ExtLd_u_NacelleMotion) + Name = "u%NacelleMotion" + case (ExtLd_u_BladeRootMotion) + Name = "u%BladeRootMotion("//trim(Num2LStr(ML%i1))//")" + case (ExtLd_u_BladeMotion) + Name = "u%BladeMotion("//trim(Num2LStr(ML%i1))//")" + end select +end function + +function ExtLd_OutputMeshPointer(y, ML) result(Mesh) + type(ExtLd_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + case (ExtLd_y_TowerLoad) + Mesh => y%TowerLoad + case (ExtLd_y_BladeLoad) + Mesh => y%BladeLoad(ML%i1) + case (ExtLd_y_TowerLoadAD) + Mesh => y%TowerLoadAD + case (ExtLd_y_BladeLoadAD) + Mesh => y%BladeLoadAD(ML%i1) + end select +end function + +function ExtLd_OutputMeshName(y, ML) result(Name) + type(ExtLd_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + case (ExtLd_y_TowerLoad) + Name = "y%TowerLoad" + case (ExtLd_y_BladeLoad) + Name = "y%BladeLoad("//trim(Num2LStr(ML%i1))//")" + case (ExtLd_y_TowerLoadAD) + Name = "y%TowerLoadAD" + case (ExtLd_y_BladeLoadAD) + Name = "y%BladeLoadAD("//trim(Num2LStr(ML%i1))//")" + end select +end function END MODULE ExtLoads_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index b65394d237..cbe31bf257 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -60,18 +60,19 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD14 = 6 ! AeroDyn14 [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 8 ! ServoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 9 ! SeaState [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 10 ! HydroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 11 ! SubDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 12 ! External Platform Loading MCKF [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 13 ! MAP (Mooring Analysis Program) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 14 ! FEAMooring [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 15 ! MoorDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 16 ! OrcaFlex integration (HD/Mooring) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 17 ! IceFloe [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 18 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 18 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! ExternalLoads [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 12 ! SubDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 13 ! External Platform Loading MCKF [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 14 ! MAP (Mooring Analysis Program) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 15 ! FEAMooring [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 16 ! MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 19 ! The number of modules available in FAST [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] @@ -80,6 +81,7 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_LoadMesh = 1 ! Load mesh mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_NonMesh = 3 ! Non mesh mapping type [-] @@ -560,11 +562,11 @@ MODULE FAST_Types ! ======================= ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data - TYPE(ED_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(ED_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] TYPE(ED_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] - TYPE(ED_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(ED_ParameterType) :: p !< Parameters [-] TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] @@ -679,11 +681,11 @@ MODULE FAST_Types ! ======================= ! ========= SubDyn_Data ======= TYPE, PUBLIC :: SubDyn_Data - TYPE(SD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(SD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] TYPE(SD_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] - TYPE(SD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(SD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(SD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(SD_ParameterType) :: p !< Parameters [-] TYPE(SD_InputType) :: u !< System inputs [-] TYPE(SD_OutputType) :: y !< System outputs [-] @@ -732,11 +734,11 @@ MODULE FAST_Types ! ======================= ! ========= HydroDyn_Data ======= TYPE, PUBLIC :: HydroDyn_Data - TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] TYPE(HydroDyn_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] - TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(HydroDyn_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index c510b5c992..4cabdafe24 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -44,6 +44,23 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] +! ========= SeaSt_WaveField_ParameterType ======= + TYPE, PUBLIC :: SeaSt_WaveField_ParameterType + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] + END TYPE SeaSt_WaveField_ParameterType +! ======================= +! ========= SeaSt_WaveField_MiscVarType ======= + TYPE, PUBLIC :: SeaSt_WaveField_MiscVarType + REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] + REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the weighting function for 4-d velocity field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] + END TYPE SeaSt_WaveField_MiscVarType +! ======================= ! ========= SeaSt_WaveFieldType ======= TYPE, PUBLIC :: SeaSt_WaveFieldType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] From 9e32e1e278332646b5f5c49427fe396b95ebfc29 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 17:14:03 +0000 Subject: [PATCH 057/319] Use R8Ki in GetOP functions --- modules/aerodyn/src/AeroDyn.f90 | 68 ++++++++++++------------ modules/hydrodyn/src/HydroDyn.f90 | 12 ++--- modules/inflowwind/src/IfW_FlowField.f90 | 6 +-- modules/inflowwind/src/InflowWind.f90 | 12 ++--- modules/map/src/map.f90 | 4 +- modules/moordyn/src/MoorDyn.f90 | 12 ++--- modules/nwtc-library/src/ModMesh.f90 | 4 +- modules/subdyn/src/SubDyn.f90 | 12 ++--- 8 files changed, 66 insertions(+), 64 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 0affb10da0..1c0227aa87 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5227,7 +5227,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD character(4) :: RotorLabel character(64) :: NodeLabel character(1), parameter :: UVW(3) = ['U','V','W'] - real(ReKi) :: Perturb, PerturbTower, PerturbBlade(MaxBl) + real(R8Ki) :: Perturb, PerturbAng, PerturbTower, PerturbBlade(MaxBl) integer(IntKi) :: i, j, k ! Allocate space for variables (deallocate if already allocated) @@ -5257,7 +5257,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Num=p%NumBlNds*2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & - Perturb=2.0_ReKi * D2R, & + Perturb=PerturbAng, & LinNames=[(['vind (axial) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s', & 'vind (tangential) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s'], i = 1, p%NumBlNds)]) end do @@ -5265,7 +5265,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Num=p%NumBlNds*2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & - Perturb=2.0_ReKi * D2R, & + Perturb=PerturbAng, & LinNames=[(['First time derivative of vind (axial) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s/s', & 'First time derivative of vind (tangential) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s/s'], i = 1, p%NumBlNds)]) end do @@ -5280,21 +5280,21 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD if (p%BEMT%UA%UAMod/=UA_OYE) then call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=2.0_ReKi * D2R, & + Perturb=PerturbAng, & LinNames=['x1 '//trim(NodeLabel)//', rad']) call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=2.0_ReKi * D2R, & + Perturb=PerturbAng, & LinNames=['x2 '//trim(NodeLabel)//', rad']) call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=2.0_ReKi * D2R, & + Perturb=PerturbAng, & LinNames=['x3 '//trim(NodeLabel)//', -']) endif call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=0.001_ReKi, & ! x4 is a number between 0 and 1, so we need this to be small + Perturb=0.001_R8Ki, & ! x4 is a number between 0 and 1, so we need this to be small LinNames=['x4 '//trim(NodeLabel)//', -']) end do end do @@ -5316,14 +5316,16 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call AllocAry(p%iVarUserProp, p%NumBlades, "iVarUserProp", ErrStat2, ErrMsg2); if (Failed()) return p%iVarUserProp = 0 + PerturbAng = 2.0_R8Ki * D2R_D + do k = 1, p%NumBlades - PerturbBlade(k) = 0.2_ReKi * D2R * InputFileData%BladeProps(k)%BlSpn(InputFileData%BladeProps(k)%NumBlNds) + PerturbBlade(k) = 0.2_R8Ki * D2R_D * InputFileData%BladeProps(k)%BlSpn(InputFileData%BladeProps(k)%NumBlNds) end do if (u%TowerMotion%NNodes > 0) then - PerturbTower = 0.2_ReKi*D2R * u%TowerMotion%Position(3, u%TowerMotion%NNodes) + PerturbTower = 0.2_R8Ki * D2R_D * u%TowerMotion%Position(3, u%TowerMotion%NNodes) else - PerturbTower = 0.0_ReKi + PerturbTower = 0.0_R8Ki end if ! Add tower motion @@ -5332,7 +5334,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD Mesh=u%TowerMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_TransVel], & Perturbs=[PerturbTower, & ! VF_TransDisp - 2.0_ReKi * D2R, & ! VF_Orientation + PerturbAng, & ! VF_Orientation PerturbTower]) ! VF_TransVel ! Add hub motion @@ -5341,8 +5343,8 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD Mesh=u%HubMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel], & Perturbs=[PerturbBlade(1), & ! VF_TransDisp - 2.0_ReKi * D2R, & ! VF_Orientation - 2.0_ReKi * D2R]) ! VF_AngularVel + PerturbAng, & ! VF_Orientation + PerturbAng]) ! VF_AngularVel ! Add blade root motion do j = 1, p%NumBlades @@ -5351,7 +5353,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD Flags=VF_Linearize, & Mesh=u%BladeRootMotion(j), & Fields=[VF_Orientation], & - Perturbs=[2.0_ReKi * D2R]) + Perturbs=[PerturbAng]) end do ! Add blade motion @@ -5360,11 +5362,11 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD VarIdx=p%iVarBladeMotion(j), & Mesh=u%BladeMotion(j), & Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc], & - Perturbs=[PerturbBlade(j), & ! VF_TransDisp - 2.0_ReKi * D2R, & ! VF_Orientation - PerturbBlade(j), & ! VF_TransVel - 2.0_ReKi * D2R, & ! VF_AngularVel - PerturbBlade(j)]) ! VF_TransAcc + Perturbs=[PerturbBlade(j), & ! VF_TransDisp + PerturbAng, & ! VF_Orientation + PerturbBlade(j), & ! VF_TransVel + PerturbAng, & ! VF_AngularVel + PerturbBlade(j)]) ! VF_TransAcc ! Set AeroMap flag on subset of first blade fields if (j == 1) then do k = p%iVarBladeMotion(j), size(p%Vars%u) @@ -5389,7 +5391,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call MV_AddVar(p%Vars%u, trim(RotorLabel)//"InflowOnTower", VF_Scalar, & VarIdx=p%iVarInflowOnTower, & Num=p%NumTwrNds*3, & - Perturb=2.0_ReKi * D2R, & + Perturb=2.0_R8Ki * D2R_D, & LinNames=[((UVW(i)//'-component inflow on tower node '//trim(Num2LStr(j))//', m/s', i = 1, 3), j = 1, p%NumTwrNds)]) ! Add user props @@ -5398,7 +5400,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD VarIdx=p%iVarUserProp(j), & Flags=VF_RotFrame, & Num=p%NumBlNds, & - Perturb=2.0_ReKi * D2R, & + Perturb=2.0_R8Ki * D2R_D, & LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(k))//', -', k = 1, p%NumBlNds)]) end do @@ -6331,12 +6333,12 @@ SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags integer(IntKi), parameter :: iR =1 ! Rotor index @@ -6367,12 +6369,12 @@ SUBROUTINE RotGetOP(t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 459277e42c..521ea1aade 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -2707,12 +2707,12 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index 4232dca0c2..9260ed6841 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -716,7 +716,7 @@ subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) type(UniformFieldType), intent(IN) :: UF !< Parameters real(DbKi), intent(IN) :: t !< Current simulation time in seconds logical, intent(in) :: InterpCubic !< flag for using cubic interpolation - real(ReKi), intent(OUT) :: OP_out(2) !< operating point (HWindSpeed and PLexp + real(R8Ki), intent(OUT) :: OP_out(2) !< operating point (HWindSpeed and PLexp type(UniformField_Interp) :: op ! interpolated values of InterpParams @@ -727,8 +727,8 @@ subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) op = UniformField_InterpLinear(UF, t) end if - OP_out(1) = op%VelH - OP_out(2) = op%ShrV + OP_out(1) = real(op%VelH, R8Ki) + OP_out(2) = real(op%ShrV, R8Ki) end subroutine diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index d22e13cd9d..f297fc315d 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -1457,12 +1457,12 @@ SUBROUTINE InflowWind_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states INTEGER(IntKi) :: index, i, j diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index d116bdd5cd..c7acb73027 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -1429,8 +1429,8 @@ SUBROUTINE MAP_GetOP( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, u_op, y TYPE(map_OutputType), INTENT(IN ) :: y !< Output at operating point INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index e3304fdd48..e657717ba7 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -3750,12 +3750,12 @@ SUBROUTINE MD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states ! Local INTEGER(IntKi) :: idx, i INTEGER(IntKi) :: nu diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index ec03904704..f4487e033c 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -2713,7 +2713,7 @@ END SUBROUTINE PackLoadMesh_Names SUBROUTINE PackLoadMesh(M, Ary, indx_first) TYPE(MeshType) , INTENT(IN ) :: M !< Load mesh - REAL(ReKi) , INTENT(INOUT) :: Ary(:) !< array to pack this mesh into + REAL(R8Ki) , INTENT(INOUT) :: Ary(:) !< array to pack this mesh into INTEGER(IntKi) , INTENT(INOUT) :: indx_first !< index into Ary; gives location of next array position to fill ! local variables: @@ -2857,7 +2857,7 @@ END SUBROUTINE PackMotionMesh_Names SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask, TrimOP) TYPE(MeshType) , INTENT(IN ) :: M !< Motion mesh - REAL(ReKi) , INTENT(INOUT) :: Ary(:) !< array to pack this mesh into + REAL(R8Ki) , INTENT(INOUT) :: Ary(:) !< array to pack this mesh into INTEGER(IntKi) , INTENT(INOUT) :: indx_first !< index into Ary; gives location of next array position to fill LOGICAL, OPTIONAL , INTENT(IN ) :: FieldMask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing LOGICAL, OPTIONAL , INTENT(IN ) :: TrimOP !< flag to determine if the orientation should be packed as a DCM or a log map diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index d1b576e33d..29e79a6b52 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -2251,12 +2251,12 @@ SUBROUTINE SD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) ! Local From d5704451e34710f20765ebe6f44f292615b68d30 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Feb 2024 17:17:55 +0000 Subject: [PATCH 058/319] Disable FAST_Linear, FAST_CalcSteady, and FAST_RunSteadyStateDriver This functionality will need to be migrated to the new FAST_ModLin module --- glue-codes/openfast/src/FAST_Prog.f90 | 5 +- modules/openfast-library/CMakeLists.txt | 6 +- modules/openfast-library/src/FAST_ModLin.f90 | 4 +- modules/openfast-library/src/FAST_Subs.f90 | 72 +++++++++++--------- 4 files changed, 49 insertions(+), 38 deletions(-) diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index f4e9b2bfe2..022132fc03 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -32,7 +32,7 @@ PROGRAM FAST USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs -USE FAST_SS_Subs, ONLY : FAST_RunSteadyStateDriver +! USE FAST_SS_Subs, ONLY : FAST_RunSteadyStateDriver IMPLICIT NONE @@ -79,8 +79,9 @@ PROGRAM FAST ELSE IF ( TRIM(FlagArg) == 'STEADYSTATE' ) THEN ! Do steady-state analysis, not time-marching -- this works for only 1 turbine (i.e., NumTurbines==1)! + ! TODO: migrate to ModLin ! this runs the steady-state solver driver and ENDS the program: - CALL FAST_RunSteadyStateDriver( Turbine(1) ) + ! CALL FAST_RunSteadyStateDriver( Turbine(1) ) ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 617d8dfc4d..2777a87a54 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -65,12 +65,12 @@ target_link_libraries(openfast_prelib ) add_library(openfast_postlib STATIC - src/FAST_Lin.f90 + # src/FAST_Lin.f90 src/FAST_Mods.f90 src/FAST_Subs.f90 src/FAST_Solver.f90 - src/FAST_SS_Subs.f90 - src/FAST_SS_Solver.f90 + # src/FAST_SS_Subs.f90 + # src/FAST_SS_Solver.f90 src/FAST_Funcs.f90 src/FAST_ModLin.f90 diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModLin.f90 index 0f5af47446..13d1337aab 100644 --- a/modules/openfast-library/src/FAST_ModLin.f90 +++ b/modules/openfast-library/src/FAST_ModLin.f90 @@ -449,7 +449,7 @@ subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_F if (Failed()) return ! Calculate the glue code state matrices (A, B, C, D) - call ModLin_StateMatrices(ModGlue, p_FAST%UJacSclFact, ErrStat2, ErrMsg2) + call ModLin_StateMatrices(ModGlue, real(p_FAST%UJacSclFact, R8Ki), ErrStat2, ErrMsg2) if (Failed()) return ! Write glue code data @@ -792,7 +792,7 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer type(FAST_ParameterType) :: p_FAST !< Parameters integer(IntKi), intent(in) :: Un !< unit number character(*), intent(in) :: RowCol !< Row/Column description - real(ReKi), intent(in) :: op(:) !< operating point values (possibly different size that Desc because of orientations) + real(R8Ki), intent(in) :: op(:) !< operating point values (possibly different size that Desc because of orientations) logical, optional, intent(in) :: IsDeriv !< flag that tells us if we need to modify the channel names for derivatives (xdot) logical, optional, intent(in) :: ShowRot !< flag to show rotation matrix if field is orientation diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index f14f80a572..497edc895e 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -23,7 +23,7 @@ MODULE FAST_Subs USE FAST_ModLin USE FAST_Solver - USE FAST_Linear + ! USE FAST_Linear USE SC_DataEx USE VersionInfo @@ -9353,10 +9353,11 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) t_global = t_initial + n_t_global*Turbine%p_FAST%dt - call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & - Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! TODO: migrate to ModLin + ! call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + ! Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + ! Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (Turbine%m_FAST%Lin%FoundSteady) then if (Turbine%m_FAST%Lin%ForceLin) then @@ -9366,10 +9367,11 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) do iLinTime=1,Turbine%p_FAST%NLinTimes t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) - call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & - Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! TODO: migrate to ModLin + ! call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + ! Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & + ! Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then Turbine%m_FAST%calcJacobian = .true. @@ -9382,12 +9384,18 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + call ModLin_Linearize_OP(Turbine, Turbine%y_FAST%ModGlue, Turbine%y_FAST%Modules, & + Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, Turbine%p_FAST, Turbine%m_FAST, & + Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + ! Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! IF (ErrStat >= AbortErrLev) RETURN end do @@ -10431,15 +10439,16 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) end if - call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! TODO: migrate to ModLin + ! call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + ! MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! set perturbation of states based on x_eig magnitude and phase - call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & - IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! ! set perturbation of states based on x_eig magnitude and phase + ! call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + ! IceF, IceD, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! IF (ErrStat >= AbortErrLev) RETURN CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) @@ -10463,15 +10472,16 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, do it = 1,nt tprime = (it-1)*dt - call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! TODO: migrate to ModLin + ! call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + ! MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! set perturbation of states based on x_eig magnitude and phase - call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & - IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! ! set perturbation of states based on x_eig magnitude and phase + ! call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + ! IceF, IceD, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! IF (ErrStat >= AbortErrLev) RETURN CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) From 964e0f53ad4a0581a0abfaa6a39a1b3497738cdd Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:07:52 +0000 Subject: [PATCH 059/319] Changed function signature of Input/Output Mesh Names function Previously these functions required the whole Turbine structure to be passed in, which was a holdover from the original mesh getting functions --- modules/aerodyn/src/AeroAcoustics_Types.f90 | 6 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 6 +- modules/aerodyn/src/AeroDyn_Types.f90 | 6 +- modules/aerodyn/src/AirfoilInfo_Types.f90 | 6 +- modules/aerodyn/src/BEMT_Types.f90 | 6 +- modules/aerodyn/src/DBEMT_Types.f90 | 6 +- modules/aerodyn/src/FVW_Types.f90 | 6 +- modules/aerodyn/src/UnsteadyAero_Types.f90 | 6 +- modules/aerodyn14/src/AeroDyn14_Types.f90 | 6 +- modules/aerodyn14/src/DWM_Types.f90 | 6 +- modules/awae/src/AWAE_Types.f90 | 6 +- modules/beamdyn/src/BeamDyn_Types.f90 | 6 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 6 +- .../src/ExternalInflow_Types.f90 | 6 +- modules/extloads/src/ExtLoadsDX_Types.f90 | 6 +- modules/extloads/src/ExtLoads_Types.f90 | 6 +- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 6 +- modules/feamooring/src/FEAMooring_Types.f90 | 6 +- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 6 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 1083 ++++++++++------- modules/hydrodyn/src/Morison_Types.f90 | 6 +- modules/hydrodyn/src/SS_Excitation_Types.f90 | 6 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 6 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 3 +- modules/hydrodyn/src/WAMIT_Types.f90 | 6 +- modules/icedyn/src/IceDyn_Types.f90 | 6 +- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 6 +- modules/inflowwind/src/InflowWind_Types.f90 | 6 +- modules/inflowwind/src/Lidar_Types.f90 | 6 +- modules/moordyn/src/MoorDyn_Types.f90 | 6 +- .../src/registry_gen_fortran.cpp | 3 +- .../src/OrcaFlexInterface_Types.f90 | 6 +- modules/seastate/src/SeaState_Types.f90 | 6 +- modules/servodyn/src/ServoDyn_Types.f90 | 6 +- modules/servodyn/src/StrucCtrl_Types.f90 | 6 +- modules/subdyn/src/SubDyn_Types.f90 | 6 +- .../supercontroller/src/SCDataEx_Types.f90 | 6 +- .../src/SuperController_Types.f90 | 6 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 6 +- 39 files changed, 686 insertions(+), 619 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 95bdda109b..722c4b4051 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -2999,8 +2999,7 @@ function AA_InputMeshPointer(u, ML) result(Mesh) end select end function -function AA_InputMeshName(u, ML) result(Name) - type(AA_InputType), target, intent(in) :: u +function AA_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -3017,8 +3016,7 @@ function AA_OutputMeshPointer(y, ML) result(Mesh) end select end function -function AA_OutputMeshName(y, ML) result(Name) - type(AA_OutputType), target, intent(in) :: y +function AA_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 49fdd42ca4..ce7366997d 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -1782,8 +1782,7 @@ function ADI_InputMeshPointer(u, ML) result(Mesh) end select end function -function ADI_InputMeshName(u, ML) result(Name) - type(ADI_InputType), target, intent(in) :: u +function ADI_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1822,8 +1821,7 @@ function ADI_OutputMeshPointer(y, ML) result(Mesh) end select end function -function ADI_OutputMeshName(y, ML) result(Name) - type(ADI_OutputType), target, intent(in) :: y +function ADI_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index b810a50870..d30d1deaf2 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -6397,8 +6397,7 @@ function AD_InputMeshPointer(u, ML) result(Mesh) end select end function -function AD_InputMeshName(u, ML) result(Name) - type(AD_InputType), target, intent(in) :: u +function AD_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -6437,8 +6436,7 @@ function AD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function AD_OutputMeshName(y, ML) result(Name) - type(AD_OutputType), target, intent(in) :: y +function AD_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index ed1af5a35e..59f4c8e4c6 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -1457,8 +1457,7 @@ function AFI_InputMeshPointer(u, ML) result(Mesh) end select end function -function AFI_InputMeshName(u, ML) result(Name) - type(AFI_InputType), target, intent(in) :: u +function AFI_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1475,8 +1474,7 @@ function AFI_OutputMeshPointer(y, ML) result(Mesh) end select end function -function AFI_OutputMeshName(y, ML) result(Name) - type(AFI_OutputType), target, intent(in) :: y +function AFI_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index b6ce060cd9..5b4aeeed24 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -2653,8 +2653,7 @@ function BEMT_InputMeshPointer(u, ML) result(Mesh) end select end function -function BEMT_InputMeshName(u, ML) result(Name) - type(BEMT_InputType), target, intent(in) :: u +function BEMT_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -2671,8 +2670,7 @@ function BEMT_OutputMeshPointer(y, ML) result(Mesh) end select end function -function BEMT_OutputMeshName(y, ML) result(Name) - type(BEMT_OutputType), target, intent(in) :: y +function BEMT_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index ec92ed85e1..312652e8ce 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -1423,8 +1423,7 @@ function DBEMT_InputMeshPointer(u, ML) result(Mesh) end select end function -function DBEMT_InputMeshName(u, ML) result(Name) - type(DBEMT_InputType), target, intent(in) :: u +function DBEMT_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1441,8 +1440,7 @@ function DBEMT_OutputMeshPointer(y, ML) result(Mesh) end select end function -function DBEMT_OutputMeshName(y, ML) result(Name) - type(DBEMT_OutputType), target, intent(in) :: y +function DBEMT_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 8c3d5faa8c..d06a5aebe9 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -4100,8 +4100,7 @@ function FVW_InputMeshPointer(u, ML) result(Mesh) end select end function -function FVW_InputMeshName(u, ML) result(Name) - type(FVW_InputType), target, intent(in) :: u +function FVW_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -4120,8 +4119,7 @@ function FVW_OutputMeshPointer(y, ML) result(Mesh) end select end function -function FVW_OutputMeshName(y, ML) result(Name) - type(FVW_OutputType), target, intent(in) :: y +function FVW_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 8c8474dcfb..ae34047f26 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -2513,8 +2513,7 @@ function UA_InputMeshPointer(u, ML) result(Mesh) end select end function -function UA_InputMeshName(u, ML) result(Name) - type(UA_InputType), target, intent(in) :: u +function UA_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -2531,8 +2530,7 @@ function UA_OutputMeshPointer(y, ML) result(Mesh) end select end function -function UA_OutputMeshName(y, ML) result(Name) - type(UA_OutputType), target, intent(in) :: y +function UA_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index cab2b06c47..8357cef188 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -4913,8 +4913,7 @@ function AD14_InputMeshPointer(u, ML) result(Mesh) end select end function -function AD14_InputMeshName(u, ML) result(Name) - type(AD14_InputType), target, intent(in) :: u +function AD14_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -4939,8 +4938,7 @@ function AD14_OutputMeshPointer(y, ML) result(Mesh) end select end function -function AD14_OutputMeshName(y, ML) result(Name) - type(AD14_OutputType), target, intent(in) :: y +function AD14_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 6d42c26c29..e3a026588a 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -3175,8 +3175,7 @@ function DWM_InputMeshPointer(u, ML) result(Mesh) end select end function -function DWM_InputMeshName(u, ML) result(Name) - type(DWM_InputType), target, intent(in) :: u +function DWM_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -3193,8 +3192,7 @@ function DWM_OutputMeshPointer(y, ML) result(Mesh) end select end function -function DWM_OutputMeshName(y, ML) result(Name) - type(DWM_OutputType), target, intent(in) :: y +function DWM_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 571e594c2f..3baad623fa 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -2504,8 +2504,7 @@ function AWAE_InputMeshPointer(u, ML) result(Mesh) end select end function -function AWAE_InputMeshName(u, ML) result(Name) - type(AWAE_InputType), target, intent(in) :: u +function AWAE_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -2522,8 +2521,7 @@ function AWAE_OutputMeshPointer(y, ML) result(Mesh) end select end function -function AWAE_OutputMeshName(y, ML) result(Name) - type(AWAE_OutputType), target, intent(in) :: y +function AWAE_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 15daf16e5a..a05165c441 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -3833,8 +3833,7 @@ function BD_InputMeshPointer(u, ML) result(Mesh) end select end function -function BD_InputMeshName(u, ML) result(Name) - type(BD_InputType), target, intent(in) :: u +function BD_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -3863,8 +3862,7 @@ function BD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function BD_OutputMeshName(y, ML) result(Name) - type(BD_OutputType), target, intent(in) :: y +function BD_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index b3d61e016d..d5c3e6a99b 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -7790,8 +7790,7 @@ function ED_InputMeshPointer(u, ML) result(Mesh) end select end function -function ED_InputMeshName(u, ML) result(Name) - type(ED_InputType), target, intent(in) :: u +function ED_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -7842,8 +7841,7 @@ function ED_OutputMeshPointer(y, ML) result(Mesh) end select end function -function ED_OutputMeshName(y, ML) result(Name) - type(ED_OutputType), target, intent(in) :: y +function ED_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index c1e25a3d94..22d2c9ee48 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -2642,8 +2642,7 @@ function ExtInfw_InputMeshPointer(u, ML) result(Mesh) end select end function -function ExtInfw_InputMeshName(u, ML) result(Name) - type(ExtInfw_InputType), target, intent(in) :: u +function ExtInfw_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -2660,8 +2659,7 @@ function ExtInfw_OutputMeshPointer(y, ML) result(Mesh) end select end function -function ExtInfw_OutputMeshName(y, ML) result(Name) - type(ExtInfw_OutputType), target, intent(in) :: y +function ExtInfw_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index c98778d003..7d882342a9 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -1611,8 +1611,7 @@ function ExtLdDX_InputMeshPointer(u, ML) result(Mesh) end select end function -function ExtLdDX_InputMeshName(u, ML) result(Name) - type(ExtLdDX_InputType), target, intent(in) :: u +function ExtLdDX_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1629,8 +1628,7 @@ function ExtLdDX_OutputMeshPointer(y, ML) result(Mesh) end select end function -function ExtLdDX_OutputMeshName(y, ML) result(Name) - type(ExtLdDX_OutputType), target, intent(in) :: y +function ExtLdDX_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 6ba545db72..17f1ea4fa0 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -1533,8 +1533,7 @@ function ExtLd_InputMeshPointer(u, ML) result(Mesh) end select end function -function ExtLd_InputMeshName(u, ML) result(Name) - type(ExtLd_InputType), target, intent(in) :: u +function ExtLd_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1569,8 +1568,7 @@ function ExtLd_OutputMeshPointer(y, ML) result(Mesh) end select end function -function ExtLd_OutputMeshName(y, ML) result(Name) - type(ExtLd_OutputType), target, intent(in) :: y +function ExtLd_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 5f921613bb..5e52d7c82b 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -1872,8 +1872,7 @@ function ExtPtfm_InputMeshPointer(u, ML) result(Mesh) end select end function -function ExtPtfm_InputMeshName(u, ML) result(Name) - type(ExtPtfm_InputType), target, intent(in) :: u +function ExtPtfm_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1894,8 +1893,7 @@ function ExtPtfm_OutputMeshPointer(y, ML) result(Mesh) end select end function -function ExtPtfm_OutputMeshName(y, ML) result(Name) - type(ExtPtfm_OutputType), target, intent(in) :: y +function ExtPtfm_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 4a974c7a6a..39e61fc637 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -2428,8 +2428,7 @@ function FEAM_InputMeshPointer(u, ML) result(Mesh) end select end function -function FEAM_InputMeshName(u, ML) result(Name) - type(FEAM_InputType), target, intent(in) :: u +function FEAM_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -2454,8 +2453,7 @@ function FEAM_OutputMeshPointer(y, ML) result(Mesh) end select end function -function FEAM_OutputMeshName(y, ML) result(Name) - type(FEAM_OutputType), target, intent(in) :: y +function FEAM_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 18d23ccde0..03c5e7d0af 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -981,8 +981,7 @@ function Conv_Rdtn_InputMeshPointer(u, ML) result(Mesh) end select end function -function Conv_Rdtn_InputMeshName(u, ML) result(Name) - type(Conv_Rdtn_InputType), target, intent(in) :: u +function Conv_Rdtn_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -999,8 +998,7 @@ function Conv_Rdtn_OutputMeshPointer(y, ML) result(Mesh) end select end function -function Conv_Rdtn_OutputMeshName(y, ML) result(Name) - type(Conv_Rdtn_OutputType), target, intent(in) :: y +function Conv_Rdtn_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 0315ea70f4..fe087c4248 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -103,6 +103,7 @@ MODULE HydroDyn_Types ! ======================= ! ========= HydroDyn_InitOutputType ======= TYPE, PUBLIC :: HydroDyn_InitOutputType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] TYPE(Morison_InitOutputType) :: Morison !< Initialization output from the Morison module [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] @@ -145,23 +146,16 @@ MODULE HydroDyn_Types TYPE(Morison_OtherStateType) :: Morison !< OtherState information from the Morison module [-] END TYPE HydroDyn_OtherStateType ! ======================= -! ========= HydroDyn_MiscVarType ======= - TYPE, PUBLIC :: HydroDyn_MiscVarType - TYPE(MeshType) :: AllHdroOrigin !< An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh [-] - TYPE(HD_ModuleMapType) :: HD_MeshMap - INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_PtfmAdd !< The total forces and moments due to additional pre-load, stiffness, and damping [-] - REAL(ReKi) , DIMENSION(1:6) :: F_Hydro = 0.0_ReKi !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves !< The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules) [-] - TYPE(WAMIT_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< misc var information from the WAMIT module [-] - TYPE(WAMIT2_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< misc var information from the WAMIT2 module [-] - TYPE(Morison_MiscVarType) :: Morison !< misc var information from the Morison module [-] - TYPE(WAMIT_InputType) , DIMENSION(:), ALLOCATABLE :: u_WAMIT !< WAMIT module inputs [-] - END TYPE HydroDyn_MiscVarType -! ======================= ! ========= HydroDyn_ParameterType ======= TYPE, PUBLIC :: HydroDyn_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarMorisonMotionMesh = 0 !< Morison Motion Mesh variable index [-] + INTEGER(IntKi) :: iVarWAMITMotionMesh = 0 !< WAMIT Motion Mesh variable index [-] + INTEGER(IntKi) :: iVarPRPMotionMesh = 0 !< PRP Motion Mesh variable index [-] + INTEGER(IntKi) :: iVarWaveElev0 = 0 !< Wave Elevation variable index [-] + INTEGER(IntKi) :: iVarMorisonLoadMesh = 0 !< Morison Load Mesh variable index [-] + INTEGER(IntKi) :: iVarWAMITLoadMesh = 0 !< WAMIT Load Mesh variable index [-] + INTEGER(IntKi) :: iVarWriteOut = 0 !< Write Output variable index [-] INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] TYPE(WAMIT_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< Parameter data for the WAMIT module [-] @@ -212,6 +206,26 @@ MODULE HydroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Outputs to be written to the output file(s) [-] END TYPE HydroDyn_OutputType ! ======================= +! ========= HydroDyn_MiscVarType ======= + TYPE, PUBLIC :: HydroDyn_MiscVarType + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(HydroDyn_ContinuousStateType) :: x_perturb !< Temporary variables for Jacobian calculations [-] + TYPE(HydroDyn_InputType) :: u_perturb !< Temporary variables for Jacobian calculations [-] + TYPE(HydroDyn_ContinuousStateType) :: dxdt_lin !< Temporary variables for Jacobian calculations [-] + TYPE(HydroDyn_OutputType) :: y_lin !< Temporary variables for Jacobian calculations [-] + TYPE(MeshType) :: AllHdroOrigin !< An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh [-] + TYPE(HD_ModuleMapType) :: HD_MeshMap + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_PtfmAdd !< The total forces and moments due to additional pre-load, stiffness, and damping [-] + REAL(ReKi) , DIMENSION(1:6) :: F_Hydro = 0.0_ReKi !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves !< The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules) [-] + TYPE(WAMIT_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< misc var information from the WAMIT module [-] + TYPE(WAMIT2_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< misc var information from the WAMIT2 module [-] + TYPE(Morison_MiscVarType) :: Morison !< misc var information from the Morison module [-] + TYPE(WAMIT_InputType) , DIMENSION(:), ALLOCATABLE :: u_WAMIT !< WAMIT module inputs [-] + END TYPE HydroDyn_MiscVarType +! ======================= CONTAINS subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -697,6 +711,7 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod character(*), parameter :: RoutineName = 'HydroDyn_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' + DstInitOutputData%Vars => SrcInitOutputData%Vars call Morison_CopyInitOutput(SrcInitOutputData%Morison, DstInitOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -798,6 +813,7 @@ subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + nullify(InitOutputData%Vars) call Morison_DestroyInitOutput(InitOutputData%Morison, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WriteOutputHdr)) then @@ -829,7 +845,15 @@ subroutine HydroDyn_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call Morison_PackInitOutput(RF, InData%Morison) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) @@ -849,7 +873,27 @@ subroutine HydroDyn_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call Morison_UnpackInitOutput(RF, OutData%Morison) ! Morison call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -1283,442 +1327,213 @@ subroutine HydroDyn_UnPackOtherState(RF, OutData) call Morison_UnpackOtherState(RF, OutData%Morison) ! Morison end subroutine -subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(HydroDyn_MiscVarType), intent(inout) :: SrcMiscData - type(HydroDyn_MiscVarType), intent(inout) :: DstMiscData +subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(in) :: SrcParamData + type(HydroDyn_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' + character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' ErrStat = ErrID_None ErrMsg = '' - call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call HydroDyn_CopyHD_ModuleMapType(SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - if (allocated(SrcMiscData%F_PtfmAdd)) then - LB(1:1) = lbound(SrcMiscData%F_PtfmAdd, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_PtfmAdd, kind=B8Ki) - if (.not. allocated(DstMiscData%F_PtfmAdd)) then - allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd - end if - DstMiscData%F_Hydro = SrcMiscData%F_Hydro - if (allocated(SrcMiscData%F_Waves)) then - LB(1:1) = lbound(SrcMiscData%F_Waves, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Waves, kind=B8Ki) - if (.not. allocated(DstMiscData%F_Waves)) then - allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%F_Waves = SrcMiscData%F_Waves - end if - if (allocated(SrcMiscData%WAMIT)) then - LB(1:1) = lbound(SrcMiscData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WAMIT, kind=B8Ki) - if (.not. allocated(DstMiscData%WAMIT)) then - allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + DstParamData%iVarMorisonMotionMesh = SrcParamData%iVarMorisonMotionMesh + DstParamData%iVarWAMITMotionMesh = SrcParamData%iVarWAMITMotionMesh + DstParamData%iVarPRPMotionMesh = SrcParamData%iVarPRPMotionMesh + DstParamData%iVarWaveElev0 = SrcParamData%iVarWaveElev0 + DstParamData%iVarMorisonLoadMesh = SrcParamData%iVarMorisonLoadMesh + DstParamData%iVarWAMITLoadMesh = SrcParamData%iVarWAMITLoadMesh + DstParamData%iVarWriteOut = SrcParamData%iVarWriteOut + DstParamData%nWAMITObj = SrcParamData%nWAMITObj + DstParamData%vecMultiplier = SrcParamData%vecMultiplier + if (allocated(SrcParamData%WAMIT)) then + LB(1:1) = lbound(SrcParamData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WAMIT, kind=B8Ki) + if (.not. allocated(DstParamData%WAMIT)) then + allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call WAMIT_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call WAMIT_CopyParam(SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%WAMIT2)) then - LB(1:1) = lbound(SrcMiscData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WAMIT2, kind=B8Ki) - if (.not. allocated(DstMiscData%WAMIT2)) then - allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%WAMIT2)) then + LB(1:1) = lbound(SrcParamData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WAMIT2, kind=B8Ki) + if (.not. allocated(DstParamData%WAMIT2)) then + allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call WAMIT2_CopyParam(SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) + DstParamData%WAMIT2used = SrcParamData%WAMIT2used + call Morison_CopyParam(SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%u_WAMIT)) then - LB(1:1) = lbound(SrcMiscData%u_WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u_WAMIT, kind=B8Ki) - if (.not. allocated(DstMiscData%u_WAMIT)) then - allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) + DstParamData%PotMod = SrcParamData%PotMod + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + DstParamData%totalStates = SrcParamData%totalStates + DstParamData%totalExctnStates = SrcParamData%totalExctnStates + DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates + if (allocated(SrcParamData%AddF0)) then + LB(1:2) = lbound(SrcParamData%AddF0, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%AddF0, kind=B8Ki) + if (.not. allocated(DstParamData%AddF0)) then + allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddF0 = SrcParamData%AddF0 + end if + if (allocated(SrcParamData%AddCLin)) then + LB(1:3) = lbound(SrcParamData%AddCLin, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AddCLin, kind=B8Ki) + if (.not. allocated(DstParamData%AddCLin)) then + allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddCLin = SrcParamData%AddCLin + end if + if (allocated(SrcParamData%AddBLin)) then + LB(1:3) = lbound(SrcParamData%AddBLin, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AddBLin, kind=B8Ki) + if (.not. allocated(DstParamData%AddBLin)) then + allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddBLin = SrcParamData%AddBLin + end if + if (allocated(SrcParamData%AddBQuad)) then + LB(1:3) = lbound(SrcParamData%AddBQuad, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AddBQuad, kind=B8Ki) + if (.not. allocated(DstParamData%AddBQuad)) then + allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddBQuad = SrcParamData%AddBQuad + end if + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%VisMeshes = SrcParamData%VisMeshes + DstParamData%WaveField => SrcParamData%WaveField end subroutine -subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(HydroDyn_MiscVarType), intent(inout) :: MiscData +subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' + character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyHD_ModuleMapType(MiscData%HD_MeshMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%F_PtfmAdd)) then - deallocate(MiscData%F_PtfmAdd) - end if - if (allocated(MiscData%F_Waves)) then - deallocate(MiscData%F_Waves) + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() end if - if (allocated(MiscData%WAMIT)) then - LB(1:1) = lbound(MiscData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(MiscData%WAMIT, kind=B8Ki) - do i1 = LB(1), UB(1) - call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%WAMIT) - end if - if (allocated(MiscData%WAMIT2)) then - LB(1:1) = lbound(MiscData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(MiscData%WAMIT2, kind=B8Ki) - do i1 = LB(1), UB(1) - call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%WAMIT2) - end if - call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%u_WAMIT)) then - LB(1:1) = lbound(MiscData%u_WAMIT, kind=B8Ki) - UB(1:1) = ubound(MiscData%u_WAMIT, kind=B8Ki) - do i1 = LB(1), UB(1) - call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%u_WAMIT) - end if -end subroutine - -subroutine HydroDyn_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(HydroDyn_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%AllHdroOrigin) - call HydroDyn_PackHD_ModuleMapType(RF, InData%HD_MeshMap) - call RegPack(RF, InData%Decimate) - call RegPack(RF, InData%LastOutTime) - call RegPackAlloc(RF, InData%F_PtfmAdd) - call RegPack(RF, InData%F_Hydro) - call RegPackAlloc(RF, InData%F_Waves) - call RegPack(RF, allocated(InData%WAMIT)) - if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) - do i1 = LB(1), UB(1) - call WAMIT_PackMisc(RF, InData%WAMIT(i1)) - end do - end if - call RegPack(RF, allocated(InData%WAMIT2)) - if (allocated(InData%WAMIT2)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) - do i1 = LB(1), UB(1) - call WAMIT2_PackMisc(RF, InData%WAMIT2(i1)) - end do - end if - call Morison_PackMisc(RF, InData%Morison) - call RegPack(RF, allocated(InData%u_WAMIT)) - if (allocated(InData%u_WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%u_WAMIT, kind=B8Ki), ubound(InData%u_WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%u_WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%u_WAMIT, kind=B8Ki) - do i1 = LB(1), UB(1) - call WAMIT_PackInput(RF, InData%u_WAMIT(i1)) - end do - end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine HydroDyn_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(HydroDyn_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%AllHdroOrigin) ! AllHdroOrigin - call HydroDyn_UnpackHD_ModuleMapType(RF, OutData%HD_MeshMap) ! HD_MeshMap - call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_PtfmAdd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%F_Hydro); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_Waves); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call WAMIT_UnpackMisc(RF, OutData%WAMIT(i1)) ! WAMIT - end do - end if - if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call WAMIT2_UnpackMisc(RF, OutData%WAMIT2(i1)) ! WAMIT2 - end do - end if - call Morison_UnpackMisc(RF, OutData%Morison) ! Morison - if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_WAMIT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call WAMIT_UnpackInput(RF, OutData%u_WAMIT(i1)) ! u_WAMIT - end do - end if -end subroutine - -subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(HydroDyn_ParameterType), intent(in) :: SrcParamData - type(HydroDyn_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%nWAMITObj = SrcParamData%nWAMITObj - DstParamData%vecMultiplier = SrcParamData%vecMultiplier - if (allocated(SrcParamData%WAMIT)) then - LB(1:1) = lbound(SrcParamData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WAMIT, kind=B8Ki) - if (.not. allocated(DstParamData%WAMIT)) then - allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call WAMIT_CopyParam(SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcParamData%WAMIT2)) then - LB(1:1) = lbound(SrcParamData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WAMIT2, kind=B8Ki) - if (.not. allocated(DstParamData%WAMIT2)) then - allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call WAMIT2_CopyParam(SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstParamData%WAMIT2used = SrcParamData%WAMIT2used - call Morison_CopyParam(SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstParamData%PotMod = SrcParamData%PotMod - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod - DstParamData%totalStates = SrcParamData%totalStates - DstParamData%totalExctnStates = SrcParamData%totalExctnStates - DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates - if (allocated(SrcParamData%AddF0)) then - LB(1:2) = lbound(SrcParamData%AddF0, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AddF0, kind=B8Ki) - if (.not. allocated(DstParamData%AddF0)) then - allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AddF0 = SrcParamData%AddF0 - end if - if (allocated(SrcParamData%AddCLin)) then - LB(1:3) = lbound(SrcParamData%AddCLin, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddCLin, kind=B8Ki) - if (.not. allocated(DstParamData%AddCLin)) then - allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AddCLin = SrcParamData%AddCLin - end if - if (allocated(SrcParamData%AddBLin)) then - LB(1:3) = lbound(SrcParamData%AddBLin, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddBLin, kind=B8Ki) - if (.not. allocated(DstParamData%AddBLin)) then - allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AddBLin = SrcParamData%AddBLin - end if - if (allocated(SrcParamData%AddBQuad)) then - LB(1:3) = lbound(SrcParamData%AddBQuad, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddBQuad, kind=B8Ki) - if (.not. allocated(DstParamData%AddBQuad)) then - allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AddBQuad = SrcParamData%AddBQuad - end if - DstParamData%DT = SrcParamData%DT - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%OutDec = SrcParamData%OutDec - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du - end if - if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) - if (.not. allocated(DstParamData%dx)) then - allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%dx = SrcParamData%dx - end if - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%VisMeshes = SrcParamData%VisMeshes - DstParamData%WaveField => SrcParamData%WaveField -end subroutine - -subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) - type(HydroDyn_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' if (allocated(ParamData%WAMIT)) then LB(1:1) = lbound(ParamData%WAMIT, kind=B8Ki) UB(1:1) = ubound(ParamData%WAMIT, kind=B8Ki) @@ -1780,6 +1595,20 @@ subroutine HydroDyn_PackParam(RF, Indata) integer(B8Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarMorisonMotionMesh) + call RegPack(RF, InData%iVarWAMITMotionMesh) + call RegPack(RF, InData%iVarPRPMotionMesh) + call RegPack(RF, InData%iVarWaveElev0) + call RegPack(RF, InData%iVarMorisonLoadMesh) + call RegPack(RF, InData%iVarWAMITLoadMesh) + call RegPack(RF, InData%iVarWriteOut) call RegPack(RF, InData%nWAMITObj) call RegPack(RF, InData%vecMultiplier) call RegPack(RF, allocated(InData%WAMIT)) @@ -1856,6 +1685,31 @@ subroutine HydroDyn_UnPackParam(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarMorisonMotionMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWAMITMotionMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPRPMotionMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWaveElev0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarMorisonLoadMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWAMITLoadMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOut); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nWAMITObj); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%vecMultiplier); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) @@ -1998,14 +1852,188 @@ subroutine HydroDyn_UnPackInput(RF, OutData) type(HydroDyn_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInput' if (RF%ErrStat /= ErrID_None) return - call Morison_UnpackInput(RF, OutData%Morison) ! Morison + call Morison_UnpackInput(RF, OutData%Morison) ! Morison + call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh + call MeshUnpack(RF, OutData%PRPMesh) ! PRPMesh +end subroutine + +subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: SrcOutputData + type(HydroDyn_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WAMIT)) then + LB(1:1) = lbound(SrcOutputData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WAMIT, kind=B8Ki) + if (.not. allocated(DstOutputData%WAMIT)) then + allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyOutput(SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%WAMIT2)) then + LB(1:1) = lbound(SrcOutputData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WAMIT2, kind=B8Ki) + if (.not. allocated(DstOutputData%WAMIT2)) then + allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyOutput(SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyOutput(SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + end if +end subroutine + +subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WAMIT)) then + LB(1:1) = lbound(OutputData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(OutputData%WAMIT, kind=B8Ki) + do i1 = LB(1), UB(1) + call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT) + end if + if (allocated(OutputData%WAMIT2)) then + LB(1:1) = lbound(OutputData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(OutputData%WAMIT2, kind=B8Ki) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT2) + end if + call Morison_DestroyOutput(OutputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine HydroDyn_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + do i1 = LB(1), UB(1) + call WAMIT_PackOutput(RF, InData%WAMIT(i1)) + end do + end if + call RegPack(RF, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) + do i1 = LB(1), UB(1) + call WAMIT2_PackOutput(RF, InData%WAMIT2(i1)) + end do + end if + call Morison_PackOutput(RF, InData%Morison) + call MeshPack(RF, InData%WAMITMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackOutput(RF, OutData%WAMIT(i1)) ! WAMIT + end do + end if + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackOutput(RF, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call Morison_UnpackOutput(RF, OutData%Morison) ! Morison call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh - call MeshUnpack(RF, OutData%PRPMesh) ! PRPMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(HydroDyn_OutputType), intent(inout) :: SrcOutputData - type(HydroDyn_OutputType), intent(inout) :: DstOutputData +subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: SrcMiscData + type(HydroDyn_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg @@ -2013,113 +2041,198 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_CopyOutput' + character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcOutputData%WAMIT)) then - LB(1:1) = lbound(SrcOutputData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WAMIT, kind=B8Ki) - if (.not. allocated(DstOutputData%WAMIT)) then - allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyHD_ModuleMapType(SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + if (allocated(SrcMiscData%F_PtfmAdd)) then + LB(1:1) = lbound(SrcMiscData%F_PtfmAdd, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_PtfmAdd, kind=B8Ki) + if (.not. allocated(DstMiscData%F_PtfmAdd)) then + allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd + end if + DstMiscData%F_Hydro = SrcMiscData%F_Hydro + if (allocated(SrcMiscData%F_Waves)) then + LB(1:1) = lbound(SrcMiscData%F_Waves, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_Waves, kind=B8Ki) + if (.not. allocated(DstMiscData%F_Waves)) then + allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves = SrcMiscData%F_Waves + end if + if (allocated(SrcMiscData%WAMIT)) then + LB(1:1) = lbound(SrcMiscData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%WAMIT, kind=B8Ki) + if (.not. allocated(DstMiscData%WAMIT)) then + allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call WAMIT_CopyOutput(SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call WAMIT_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcOutputData%WAMIT2)) then - LB(1:1) = lbound(SrcOutputData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WAMIT2, kind=B8Ki) - if (.not. allocated(DstOutputData%WAMIT2)) then - allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%WAMIT2)) then + LB(1:1) = lbound(SrcMiscData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%WAMIT2, kind=B8Ki) + if (.not. allocated(DstMiscData%WAMIT2)) then + allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call WAMIT2_CopyOutput(SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call Morison_CopyOutput(SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%u_WAMIT)) then + LB(1:1) = lbound(SrcMiscData%u_WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%u_WAMIT, kind=B8Ki) + if (.not. allocated(DstMiscData%u_WAMIT)) then + allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + do i1 = LB(1), UB(1) + call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if end subroutine -subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(HydroDyn_OutputType), intent(inout) :: OutputData +subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' + character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%WAMIT)) then - LB(1:1) = lbound(OutputData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(OutputData%WAMIT, kind=B8Ki) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyHD_ModuleMapType(MiscData%HD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%F_PtfmAdd)) then + deallocate(MiscData%F_PtfmAdd) + end if + if (allocated(MiscData%F_Waves)) then + deallocate(MiscData%F_Waves) + end if + if (allocated(MiscData%WAMIT)) then + LB(1:1) = lbound(MiscData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(MiscData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) + call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%WAMIT) + deallocate(MiscData%WAMIT) end if - if (allocated(OutputData%WAMIT2)) then - LB(1:1) = lbound(OutputData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(OutputData%WAMIT2, kind=B8Ki) + if (allocated(MiscData%WAMIT2)) then + LB(1:1) = lbound(MiscData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(MiscData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) + call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%WAMIT2) + deallocate(MiscData%WAMIT2) end if - call Morison_DestroyOutput(OutputData%Morison, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2) + call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + if (allocated(MiscData%u_WAMIT)) then + LB(1:1) = lbound(MiscData%u_WAMIT, kind=B8Ki) + UB(1:1) = ubound(MiscData%u_WAMIT, kind=B8Ki) + do i1 = LB(1), UB(1) + call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%u_WAMIT) end if end subroutine -subroutine HydroDyn_PackOutput(RF, Indata) +subroutine HydroDyn_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(HydroDyn_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' + type(HydroDyn_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModJacType(RF, InData%Jac) + call HydroDyn_PackContState(RF, InData%x_perturb) + call HydroDyn_PackInput(RF, InData%u_perturb) + call HydroDyn_PackContState(RF, InData%dxdt_lin) + call HydroDyn_PackOutput(RF, InData%y_lin) + call MeshPack(RF, InData%AllHdroOrigin) + call HydroDyn_PackHD_ModuleMapType(RF, InData%HD_MeshMap) + call RegPack(RF, InData%Decimate) + call RegPack(RF, InData%LastOutTime) + call RegPackAlloc(RF, InData%F_PtfmAdd) + call RegPack(RF, InData%F_Hydro) + call RegPackAlloc(RF, InData%F_Waves) call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_PackOutput(RF, InData%WAMIT(i1)) + call WAMIT_PackMisc(RF, InData%WAMIT(i1)) end do end if call RegPack(RF, allocated(InData%WAMIT2)) @@ -2128,24 +2241,43 @@ subroutine HydroDyn_PackOutput(RF, Indata) LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT2_PackOutput(RF, InData%WAMIT2(i1)) + call WAMIT2_PackMisc(RF, InData%WAMIT2(i1)) + end do + end if + call Morison_PackMisc(RF, InData%Morison) + call RegPack(RF, allocated(InData%u_WAMIT)) + if (allocated(InData%u_WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%u_WAMIT, kind=B8Ki), ubound(InData%u_WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%u_WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%u_WAMIT, kind=B8Ki) + do i1 = LB(1), UB(1) + call WAMIT_PackInput(RF, InData%u_WAMIT(i1)) end do end if - call Morison_PackOutput(RF, InData%Morison) - call MeshPack(RF, InData%WAMITMesh) - call RegPackAlloc(RF, InData%WriteOutput) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackOutput(RF, OutData) +subroutine HydroDyn_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(HydroDyn_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' + type(HydroDyn_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call HydroDyn_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call HydroDyn_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call HydroDyn_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call HydroDyn_UnpackOutput(RF, OutData%y_lin) ! y_lin + call MeshUnpack(RF, OutData%AllHdroOrigin) ! AllHdroOrigin + call HydroDyn_UnpackHD_ModuleMapType(RF, OutData%HD_MeshMap) ! HD_MeshMap + call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_PtfmAdd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F_Hydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Waves); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -2156,7 +2288,7 @@ subroutine HydroDyn_UnPackOutput(RF, OutData) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackOutput(RF, OutData%WAMIT(i1)) ! WAMIT + call WAMIT_UnpackMisc(RF, OutData%WAMIT(i1)) ! WAMIT end do end if if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) @@ -2169,12 +2301,23 @@ subroutine HydroDyn_UnPackOutput(RF, OutData) return end if do i1 = LB(1), UB(1) - call WAMIT2_UnpackOutput(RF, OutData%WAMIT2(i1)) ! WAMIT2 + call WAMIT2_UnpackMisc(RF, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call Morison_UnpackMisc(RF, OutData%Morison) ! Morison + if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackInput(RF, OutData%u_WAMIT(i1)) ! u_WAMIT end do end if - call Morison_UnpackOutput(RF, OutData%Morison) ! Morison - call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine HydroDyn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -2550,8 +2693,7 @@ function HydroDyn_InputMeshPointer(u, ML) result(Mesh) end select end function -function HydroDyn_InputMeshName(u, ML) result(Name) - type(HydroDyn_InputType), target, intent(in) :: u +function HydroDyn_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -2584,8 +2726,7 @@ function HydroDyn_OutputMeshPointer(y, ML) result(Mesh) end select end function -function HydroDyn_OutputMeshName(y, ML) result(Name) - type(HydroDyn_OutputType), target, intent(in) :: y +function HydroDyn_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index fe3c3f0914..5ec8657362 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -4672,8 +4672,7 @@ function Morison_InputMeshPointer(u, ML) result(Mesh) end select end function -function Morison_InputMeshName(u, ML) result(Name) - type(Morison_InputType), target, intent(in) :: u +function Morison_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -4696,8 +4695,7 @@ function Morison_OutputMeshPointer(y, ML) result(Mesh) end select end function -function Morison_OutputMeshName(y, ML) result(Name) - type(Morison_OutputType), target, intent(in) :: y +function Morison_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 059294a612..5389377922 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -1161,8 +1161,7 @@ function SS_Exc_InputMeshPointer(u, ML) result(Mesh) end select end function -function SS_Exc_InputMeshName(u, ML) result(Name) - type(SS_Exc_InputType), target, intent(in) :: u +function SS_Exc_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1179,8 +1178,7 @@ function SS_Exc_OutputMeshPointer(y, ML) result(Mesh) end select end function -function SS_Exc_OutputMeshName(y, ML) result(Name) - type(SS_Exc_OutputType), target, intent(in) :: y +function SS_Exc_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 0022c08c2d..6953cd03ae 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -1082,8 +1082,7 @@ function SS_Rad_InputMeshPointer(u, ML) result(Mesh) end select end function -function SS_Rad_InputMeshName(u, ML) result(Name) - type(SS_Rad_InputType), target, intent(in) :: u +function SS_Rad_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1100,8 +1099,7 @@ function SS_Rad_OutputMeshPointer(y, ML) result(Mesh) end select end function -function SS_Rad_OutputMeshName(y, ML) result(Name) - type(SS_Rad_OutputType), target, intent(in) :: y +function SS_Rad_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 7f57c52b9a..a52406a21f 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -644,8 +644,7 @@ function WAMIT2_OutputMeshPointer(y, ML) result(Mesh) end select end function -function WAMIT2_OutputMeshName(y, ML) result(Name) - type(WAMIT2_OutputType), target, intent(in) :: y +function WAMIT2_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 3bd101eb40..a7d24e9386 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -1438,8 +1438,7 @@ function WAMIT_InputMeshPointer(u, ML) result(Mesh) end select end function -function WAMIT_InputMeshName(u, ML) result(Name) - type(WAMIT_InputType), target, intent(in) :: u +function WAMIT_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1460,8 +1459,7 @@ function WAMIT_OutputMeshPointer(y, ML) result(Mesh) end select end function -function WAMIT_OutputMeshName(y, ML) result(Name) - type(WAMIT_OutputType), target, intent(in) :: y +function WAMIT_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index e3bc43c58d..4c63aa4a9d 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -1753,8 +1753,7 @@ function IceD_InputMeshPointer(u, ML) result(Mesh) end select end function -function IceD_InputMeshName(u, ML) result(Name) - type(IceD_InputType), target, intent(in) :: u +function IceD_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1775,8 +1774,7 @@ function IceD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function IceD_OutputMeshName(y, ML) result(Name) - type(IceD_OutputType), target, intent(in) :: y +function IceD_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index d2d5ea2242..3ffd9095a3 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -1035,8 +1035,7 @@ function IceFloe_InputMeshPointer(u, ML) result(Mesh) end select end function -function IceFloe_InputMeshName(u, ML) result(Name) - type(IceFloe_InputType), target, intent(in) :: u +function IceFloe_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1057,8 +1056,7 @@ function IceFloe_OutputMeshPointer(y, ML) result(Mesh) end select end function -function IceFloe_OutputMeshName(y, ML) result(Name) - type(IceFloe_OutputType), target, intent(in) :: y +function IceFloe_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index e1eb750f1a..24573708d3 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -1858,8 +1858,7 @@ function InflowWind_InputMeshPointer(u, ML) result(Mesh) end select end function -function InflowWind_InputMeshName(u, ML) result(Name) - type(InflowWind_InputType), target, intent(in) :: u +function InflowWind_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1876,8 +1875,7 @@ function InflowWind_OutputMeshPointer(y, ML) result(Mesh) end select end function -function InflowWind_OutputMeshName(y, ML) result(Name) - type(InflowWind_OutputType), target, intent(in) :: y +function InflowWind_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 7fbb97f0a5..689afb1934 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -1106,8 +1106,7 @@ function Lidar_InputMeshPointer(u, ML) result(Mesh) end select end function -function Lidar_InputMeshName(u, ML) result(Name) - type(Lidar_InputType), target, intent(in) :: u +function Lidar_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1124,8 +1123,7 @@ function Lidar_OutputMeshPointer(y, ML) result(Mesh) end select end function -function Lidar_OutputMeshName(y, ML) result(Name) - type(Lidar_OutputType), target, intent(in) :: y +function Lidar_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index f89b8bffa3..65f2483938 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -4967,8 +4967,7 @@ function MD_InputMeshPointer(u, ML) result(Mesh) end select end function -function MD_InputMeshName(u, ML) result(Name) - type(MD_InputType), target, intent(in) :: u +function MD_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -4997,8 +4996,7 @@ function MD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function MD_OutputMeshName(y, ML) result(Name) - type(MD_OutputType), target, intent(in) :: y +function MD_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 69036e10b7..a85321a71e 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -380,9 +380,8 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) // Mesh name routine indent = "\n"; routine_name = mod.nickname + (is_input ? "_Input" : "_Output") + "MeshName"; - w << indent << "function " << routine_name << "(" << u_or_y << ", ML) result(Name)"; + w << indent << "function " << routine_name << "(ML) result(Name)"; indent += " "; - w << indent << "type(" << ddt.type_fortran << "), target, intent(in) :: " << u_or_y; w << indent << "type(MeshLocType), intent(in) :: ML"; w << indent << "character(32) :: Name"; w << indent << "Name = \"\""; diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 234446d02d..bcc4f7269c 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -1068,8 +1068,7 @@ function Orca_InputMeshPointer(u, ML) result(Mesh) end select end function -function Orca_InputMeshName(u, ML) result(Name) - type(Orca_InputType), target, intent(in) :: u +function Orca_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1090,8 +1089,7 @@ function Orca_OutputMeshPointer(y, ML) result(Mesh) end select end function -function Orca_OutputMeshName(y, ML) result(Name) - type(Orca_OutputType), target, intent(in) :: y +function Orca_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 87d797330d..22fc3c84ac 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -1284,8 +1284,7 @@ function SeaSt_InputMeshPointer(u, ML) result(Mesh) end select end function -function SeaSt_InputMeshName(u, ML) result(Name) - type(SeaSt_InputType), target, intent(in) :: u +function SeaSt_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1302,8 +1301,7 @@ function SeaSt_OutputMeshPointer(y, ML) result(Mesh) end select end function -function SeaSt_OutputMeshName(y, ML) result(Name) - type(SeaSt_OutputType), target, intent(in) :: y +function SeaSt_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index c89a15e012..7f595ceaf1 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -7160,8 +7160,7 @@ function SrvD_InputMeshPointer(u, ML) result(Mesh) end select end function -function SrvD_InputMeshName(u, ML) result(Name) - type(SrvD_InputType), target, intent(in) :: u +function SrvD_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -7196,8 +7195,7 @@ function SrvD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function SrvD_OutputMeshName(y, ML) result(Name) - type(SrvD_OutputType), target, intent(in) :: y +function SrvD_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index bf995f37da..4e1ed7170a 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -2314,8 +2314,7 @@ function StC_InputMeshPointer(u, ML) result(Mesh) end select end function -function StC_InputMeshName(u, ML) result(Name) - type(StC_InputType), target, intent(in) :: u +function StC_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -2336,8 +2335,7 @@ function StC_OutputMeshPointer(y, ML) result(Mesh) end select end function -function StC_OutputMeshName(y, ML) result(Name) - type(StC_OutputType), target, intent(in) :: y +function StC_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 2cb3db4c1c..2bdb2c7960 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -4420,8 +4420,7 @@ function SD_InputMeshPointer(u, ML) result(Mesh) end select end function -function SD_InputMeshName(u, ML) result(Name) - type(SD_InputType), target, intent(in) :: u +function SD_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -4448,8 +4447,7 @@ function SD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function SD_OutputMeshName(y, ML) result(Name) - type(SD_OutputType), target, intent(in) :: y +function SD_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index c8e57f390b..50fe607a88 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -654,8 +654,7 @@ function SC_DX_InputMeshPointer(u, ML) result(Mesh) end select end function -function SC_DX_InputMeshName(u, ML) result(Name) - type(SC_DX_InputType), target, intent(in) :: u +function SC_DX_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -672,8 +671,7 @@ function SC_DX_OutputMeshPointer(y, ML) result(Mesh) end select end function -function SC_DX_OutputMeshName(y, ML) result(Name) - type(SC_DX_OutputType), target, intent(in) :: y +function SC_DX_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index a892eac222..d5e260a268 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -1799,8 +1799,7 @@ function SC_InputMeshPointer(u, ML) result(Mesh) end select end function -function SC_InputMeshName(u, ML) result(Name) - type(SC_InputType), target, intent(in) :: u +function SC_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1817,8 +1816,7 @@ function SC_OutputMeshPointer(y, ML) result(Mesh) end select end function -function SC_OutputMeshName(y, ML) result(Name) - type(SC_OutputType), target, intent(in) :: y +function SC_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 8e8b1d12c0..6a43b46ad6 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -1857,8 +1857,7 @@ function WD_InputMeshPointer(u, ML) result(Mesh) end select end function -function WD_InputMeshName(u, ML) result(Name) - type(WD_InputType), target, intent(in) :: u +function WD_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -1875,8 +1874,7 @@ function WD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function WD_OutputMeshName(y, ML) result(Name) - type(WD_OutputType), target, intent(in) :: y +function WD_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" From aacc6c4421f1c552e927224847f601f0505e4904 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:10:36 +0000 Subject: [PATCH 060/319] Add missing error return initialization --- modules/aerodyn/src/AeroDyn.f90 | 3 +++ modules/beamdyn/src/BeamDyn.f90 | 11 ++++++----- modules/elastodyn/src/ElastoDyn.f90 | 4 +++- 3 files changed, 12 insertions(+), 6 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 1c0227aa87..ce815713ee 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5230,6 +5230,9 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD real(R8Ki) :: Perturb, PerturbAng, PerturbTower, PerturbBlade(MaxBl) integer(IntKi) :: i, j, k + ErrStat = ErrID_None + ErrMsg = "" + ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) allocate(p%Vars, stat=ErrStat2) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 3e22040e84..c2243c19c4 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -5804,6 +5804,9 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) REAL(R8Ki) :: MaxThrust, MaxTorque CHARACTER(200) :: label + ErrStat = ErrID_None + ErrMsg = "" + ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) allocate(p%Vars, stat=ErrStat2) @@ -6097,7 +6100,7 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Filter variables by flag value REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] @@ -6129,8 +6132,6 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Make a copy of the inputs to perturb call BD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call BD_PackInputValues(p, u, m%Jac%u) - - !---------------------------------------------------------------------------- ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -6171,8 +6172,6 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end if - !---------------------------------------------------------------------------- - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: if (present(dXdu)) then @@ -6222,12 +6221,14 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM !---------------------------------------------------------------------------- + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here: if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) end if !---------------------------------------------------------------------------- + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) end if diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 2b55110276..d74a750b4d 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -10945,7 +10945,9 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat integer(IntKi), allocatable :: BladeMeshFields(:) real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength integer(IntKi) :: Flags, Field - type(VarsIdxType), pointer :: VarIdx + + ErrStat = ErrID_None + ErrMsg = "" ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) From 46a925961f32f33b03d89d7a55c06495283e1ea1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:15:04 +0000 Subject: [PATCH 061/319] Expand mesh mapping data structure --- .../openfast-library/src/FAST_Registry.txt | 16 ++-- modules/openfast-library/src/FAST_Types.f90 | 80 ++++++++++++++++--- modules/servodyn/src/ServoDyn.f90 | 3 + 3 files changed, 79 insertions(+), 20 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index e59f4c8601..eabe0f0f19 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -114,8 +114,7 @@ typedef ^ FAST_SS_CaseType ReKi Pitch - - - "Pitch angle for this case of the st param ^ - IntKi Map_LoadMesh - 1 - "Load mesh mapping type" - param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - param ^ - IntKi Map_NonMesh - 3 - "Non mesh mapping type" - -typedef ^ TC_MappingType IntKi i1 - 0 - "Optional index for specifying transfers" - -typedef ^ ^ IntKi i2 - 0 - "Optional index for specifying transfers" - +typedef ^ TC_MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - typedef ^ ^ IntKi SrcModIdx - 0 - "Source module index in ModData array" - typedef ^ ^ IntKi DstModIdx - 0 - "Destination module index in ModData array" - typedef ^ ^ IntKi SrcModID - 0 - "Source module ID" - @@ -132,9 +131,14 @@ typedef ^ ^ MeshLocType SrcDispMeshLoc - - - typedef ^ ^ MeshLocType DstDispMeshLoc - - - "Destination displacement mesh locator (number and indices)" - typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - +typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - typedef ^ ^ logical Ready - F - "Flag indicating Source has been ready to be transferred" - -typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - +typedef ^ ^ logical DstUsesSibling - F - "Flag indicating the destination displacement mesh is a sibling of the destination load mesh" - +typedef ^ ^ MeshType TmpLoadMesh - - - "Temporary load mesh for intermediate transfers" - +typedef ^ ^ MeshType TmpMotionMesh - - - "Temporary motion mesh for intermediate transfers" - +typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - +typedef ^ ^ MeshMapType MeshMapAux - - - "Auxiliary mesh mapping for destination load meshes without sibling motion mesh" - typedef ^ ^ IntKi iLocSrcTransDisp 2 - - "Data indices of linearized mesh mapping" typedef ^ ^ IntKi iLocSrcTransVel 2 - - "Data indices of linearized mesh mapping" typedef ^ ^ IntKi iLocSrcTransAcc 2 - - "Data indices of linearized mesh mapping" @@ -153,10 +157,7 @@ typedef ^ ^ IntKi iLocDstAngularAcc 2 - - typedef ^ ^ IntKi iLocDstForce 2 - - "Data indices of linearized mesh mapping" typedef ^ ^ IntKi iLocDstMoment 2 - - "Data indices of linearized mesh mapping" typedef ^ ^ IntKi iLocDstDispTransDisp 2 - - "Data indices of linearized mesh mapping" -#typedef ^ ^ IntKi SrcVarIdx : - - "Source motion variable index" - -#typedef ^ ^ IntKi DstVarIdx : - - "Destination motion variable index" - -#typedef ^ ^ IntKi SrcDispVarIdx - 0 - "Source displacement var index [if Typ=Map_LoadMesh]" - -#typedef ^ ^ IntKi DstDispVarIdx - 0 - "Destination displacement var index [if Typ=Map_LoadMesh]" - +typedef ^ ^ IntKi iLocDstDispOrientation 2 - - "Data indices of linearized mesh mapping" # Parameters typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - @@ -746,6 +747,7 @@ typedef ^ ^ MAP_OtherStateType OtherSt - - - "Other/optimization states" typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_InputType u - - - "System inputs" typedef ^ ^ MAP_OutputType y - - - "System outputs" +typedef ^ ^ MAP_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (copied for the case of subcycling)" typedef ^ ^ MAP_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcSteady" diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index cbe31bf257..48e532ba9b 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -132,8 +132,7 @@ MODULE FAST_Types ! ======================= ! ========= TC_MappingType ======= TYPE, PUBLIC :: TC_MappingType - INTEGER(IntKi) :: i1 = 0 !< Optional index for specifying transfers [-] - INTEGER(IntKi) :: i2 = 0 !< Optional index for specifying transfers [-] + character(128) :: Desc !< Description of mapping (used to lookup non-mesh maps) [-] INTEGER(IntKi) :: SrcModIdx = 0 !< Source module index in ModData array [-] INTEGER(IntKi) :: DstModIdx = 0 !< Destination module index in ModData array [-] INTEGER(IntKi) :: SrcModID = 0 !< Source module ID [-] @@ -150,9 +149,14 @@ MODULE FAST_Types TYPE(MeshLocType) :: DstDispMeshLoc !< Destination displacement mesh locator (number and indices) [-] INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] + INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] LOGICAL :: Ready = .false. !< Flag indicating Source has been ready to be transferred [-] - TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] + LOGICAL :: DstUsesSibling = .false. !< Flag indicating the destination displacement mesh is a sibling of the destination load mesh [-] + TYPE(MeshType) :: TmpLoadMesh !< Temporary load mesh for intermediate transfers [-] + TYPE(MeshType) :: TmpMotionMesh !< Temporary motion mesh for intermediate transfers [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] + TYPE(MeshMapType) :: MeshMapAux !< Auxiliary mesh mapping for destination load meshes without sibling motion mesh [-] INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransVel = 0_IntKi !< Data indices of linearized mesh mapping [-] INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] @@ -171,6 +175,7 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstForce = 0_IntKi !< Data indices of linearized mesh mapping [-] INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstMoment = 0_IntKi !< Data indices of linearized mesh mapping [-] INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstDispTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstDispOrientation = 0_IntKi !< Data indices of linearized mesh mapping [-] END TYPE TC_MappingType ! ======================= ! ========= TC_ParameterType ======= @@ -776,6 +781,7 @@ MODULE FAST_Types TYPE(MAP_ParameterType) :: p !< Parameters [-] TYPE(MAP_InputType) :: u !< System inputs [-] TYPE(MAP_OutputType) :: y !< System outputs [-] + TYPE(MAP_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(MAP_OtherStateType) :: OtherSt_old !< Other/optimization states (copied for the case of subcycling) [-] TYPE(MAP_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MAP_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] @@ -1509,13 +1515,13 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyTC_MappingType' ErrStat = ErrID_None ErrMsg = '' - DstTC_MappingTypeData%i1 = SrcTC_MappingTypeData%i1 - DstTC_MappingTypeData%i2 = SrcTC_MappingTypeData%i2 + DstTC_MappingTypeData%Desc = SrcTC_MappingTypeData%Desc DstTC_MappingTypeData%SrcModIdx = SrcTC_MappingTypeData%SrcModIdx DstTC_MappingTypeData%DstModIdx = SrcTC_MappingTypeData%DstModIdx DstTC_MappingTypeData%SrcModID = SrcTC_MappingTypeData%SrcModID @@ -1540,13 +1546,33 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, if (ErrStat >= AbortErrLev) return DstTC_MappingTypeData%MapType = SrcTC_MappingTypeData%MapType DstTC_MappingTypeData%XfrType = SrcTC_MappingTypeData%XfrType + DstTC_MappingTypeData%XfrTypeAux = SrcTC_MappingTypeData%XfrTypeAux DstTC_MappingTypeData%Ready = SrcTC_MappingTypeData%Ready - call MeshCopy(SrcTC_MappingTypeData%MeshTmp, DstTC_MappingTypeData%MeshTmp, CtrlCode, ErrStat2, ErrMsg2 ) + DstTC_MappingTypeData%DstUsesSibling = SrcTC_MappingTypeData%DstUsesSibling + call MeshCopy(SrcTC_MappingTypeData%TmpLoadMesh, DstTC_MappingTypeData%TmpLoadMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcTC_MappingTypeData%TmpMotionMesh, DstTC_MappingTypeData%TmpMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + if (allocated(SrcTC_MappingTypeData%TmpMatrix)) then + LB(1:2) = lbound(SrcTC_MappingTypeData%TmpMatrix, kind=B8Ki) + UB(1:2) = ubound(SrcTC_MappingTypeData%TmpMatrix, kind=B8Ki) + if (.not. allocated(DstTC_MappingTypeData%TmpMatrix)) then + allocate(DstTC_MappingTypeData%TmpMatrix(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MappingTypeData%TmpMatrix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MappingTypeData%TmpMatrix = SrcTC_MappingTypeData%TmpMatrix + end if call NWTC_Library_CopyMeshMapType(SrcTC_MappingTypeData%MeshMap, DstTC_MappingTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcTC_MappingTypeData%MeshMapAux, DstTC_MappingTypeData%MeshMapAux, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return DstTC_MappingTypeData%iLocSrcTransDisp = SrcTC_MappingTypeData%iLocSrcTransDisp DstTC_MappingTypeData%iLocSrcTransVel = SrcTC_MappingTypeData%iLocSrcTransVel DstTC_MappingTypeData%iLocSrcTransAcc = SrcTC_MappingTypeData%iLocSrcTransAcc @@ -1565,6 +1591,7 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, DstTC_MappingTypeData%iLocDstForce = SrcTC_MappingTypeData%iLocDstForce DstTC_MappingTypeData%iLocDstMoment = SrcTC_MappingTypeData%iLocDstMoment DstTC_MappingTypeData%iLocDstDispTransDisp = SrcTC_MappingTypeData%iLocDstDispTransDisp + DstTC_MappingTypeData%iLocDstDispOrientation = SrcTC_MappingTypeData%iLocDstDispOrientation end subroutine subroutine FAST_DestroyTC_MappingType(TC_MappingTypeData, ErrStat, ErrMsg) @@ -1584,10 +1611,17 @@ subroutine FAST_DestroyTC_MappingType(TC_MappingTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%DstDispMeshLoc, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( TC_MappingTypeData%MeshTmp, ErrStat2, ErrMsg2) + call MeshDestroy( TC_MappingTypeData%TmpLoadMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( TC_MappingTypeData%TmpMotionMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(TC_MappingTypeData%TmpMatrix)) then + deallocate(TC_MappingTypeData%TmpMatrix) + end if call NWTC_Library_DestroyMeshMapType(TC_MappingTypeData%MeshMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(TC_MappingTypeData%MeshMapAux, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackTC_MappingType(RF, Indata) @@ -1595,8 +1629,7 @@ subroutine FAST_PackTC_MappingType(RF, Indata) type(TC_MappingType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackTC_MappingType' if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%i1) - call RegPack(RF, InData%i2) + call RegPack(RF, InData%Desc) call RegPack(RF, InData%SrcModIdx) call RegPack(RF, InData%DstModIdx) call RegPack(RF, InData%SrcModID) @@ -1613,9 +1646,14 @@ subroutine FAST_PackTC_MappingType(RF, Indata) call NWTC_Library_PackMeshLocType(RF, InData%DstDispMeshLoc) call RegPack(RF, InData%MapType) call RegPack(RF, InData%XfrType) + call RegPack(RF, InData%XfrTypeAux) call RegPack(RF, InData%Ready) - call MeshPack(RF, InData%MeshTmp) + call RegPack(RF, InData%DstUsesSibling) + call MeshPack(RF, InData%TmpLoadMesh) + call MeshPack(RF, InData%TmpMotionMesh) + call RegPackAlloc(RF, InData%TmpMatrix) call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) + call NWTC_Library_PackMeshMapType(RF, InData%MeshMapAux) call RegPack(RF, InData%iLocSrcTransDisp) call RegPack(RF, InData%iLocSrcTransVel) call RegPack(RF, InData%iLocSrcTransAcc) @@ -1634,6 +1672,7 @@ subroutine FAST_PackTC_MappingType(RF, Indata) call RegPack(RF, InData%iLocDstForce) call RegPack(RF, InData%iLocDstMoment) call RegPack(RF, InData%iLocDstDispTransDisp) + call RegPack(RF, InData%iLocDstDispOrientation) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1641,9 +1680,11 @@ subroutine FAST_UnPackTC_MappingType(RF, OutData) type(RegFile), intent(inout) :: RF type(TC_MappingType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackTC_MappingType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Desc); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcModIdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstModIdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcModID); if (RegCheckErr(RF, RoutineName)) return @@ -1660,9 +1701,14 @@ subroutine FAST_UnPackTC_MappingType(RF, OutData) call NWTC_Library_UnpackMeshLocType(RF, OutData%DstDispMeshLoc) ! DstDispMeshLoc call RegUnpack(RF, OutData%MapType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%XfrType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XfrTypeAux); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ready); if (RegCheckErr(RF, RoutineName)) return - call MeshUnpack(RF, OutData%MeshTmp) ! MeshTmp + call RegUnpack(RF, OutData%DstUsesSibling); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%TmpLoadMesh) ! TmpLoadMesh + call MeshUnpack(RF, OutData%TmpMotionMesh) ! TmpMotionMesh + call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap + call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMapAux) ! MeshMapAux call RegUnpack(RF, OutData%iLocSrcTransDisp); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iLocSrcTransVel); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iLocSrcTransAcc); if (RegCheckErr(RF, RoutineName)) return @@ -1681,6 +1727,7 @@ subroutine FAST_UnPackTC_MappingType(RF, OutData) call RegUnpack(RF, OutData%iLocDstForce); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iLocDstMoment); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iLocDstDispTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLocDstDispOrientation); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -12492,6 +12539,9 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat call MAP_CopyOutput(SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call MAP_CopyMisc(SrcMAP_DataData%m, DstMAP_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return call MAP_CopyOtherState(SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -12609,6 +12659,8 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyOutput(MAP_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyMisc(MAP_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MAP_DataData%Output)) then @@ -12674,6 +12726,7 @@ subroutine FAST_PackMAP_Data(RF, Indata) call MAP_PackParam(RF, InData%p) call MAP_PackInput(RF, InData%u) call MAP_PackOutput(RF, InData%y) + call MAP_PackMisc(RF, InData%m) call MAP_PackOtherState(RF, InData%OtherSt_old) call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then @@ -12736,6 +12789,7 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) call MAP_UnpackParam(RF, OutData%p) ! p call MAP_UnpackInput(RF, OutData%u) ! u call MAP_UnpackOutput(RF, OutData%y) ! y + call MAP_UnpackMisc(RF, OutData%m) ! m call MAP_UnpackOtherState(RF, OutData%OtherSt_old) ! OtherSt_old if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 7b5aba22cd..07e7b63bd0 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -649,6 +649,9 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ' local displacement state dZ/dt m/s'] real(R8Ki) :: xPerturb, uPerturbTrans, uPerturbAng, uPerturbs(6) + ErrStat = ErrID_None + ErrMsg = "" + ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) allocate(p%Vars, stat=ErrStat2) From d5d9d242544a2b2701846567a30425f14d5424b1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:15:45 +0000 Subject: [PATCH 062/319] Add HydroDyn and MAP to MV_AddModule in FAST_Subs --- modules/openfast-library/src/FAST_Subs.f90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 497edc895e..dd67da1cba 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -959,6 +959,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL MV_AddModule(y_FAST%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & + Init%OutData_HD%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -1167,14 +1171,18 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize - CALL MAP_Init( Init%InData_MAP, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & - MAPp%y, p_FAST%dt_module( MODULE_MAP ), Init%OutData_MAP, ErrStat2, ErrMsg2 ) + CALL MAP_Init(Init%InData_MAP, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y, MAPp%m, p_FAST%dt_module( MODULE_MAP ), Init%OutData_MAP, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_MAP) = .TRUE. CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL MV_AddModule(y_FAST%Modules, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & + Init%OutData_MAP%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + allocate( y_FAST%Lin%Modules(Module_MAP)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MAP).", ErrStat, ErrMsg, RoutineName ) From a7cdf921cdfcf77810819bef4d9dde02bc7c0feb Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:16:02 +0000 Subject: [PATCH 063/319] Initialize variable linearization index in ModLin --- modules/openfast-library/src/FAST_ModLin.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModLin.f90 index 13d1337aab..a32ab7b83f 100644 --- a/modules/openfast-library/src/FAST_ModLin.f90 +++ b/modules/openfast-library/src/FAST_ModLin.f90 @@ -252,6 +252,9 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er ! Loop through added variables and add name prefix to linearization names call AddLinNamePrefix(ModGlue%Vars%y(k:), NamePrefix) + ! Initialize module linearization variable indexing + call MV_InitVarIdx(ModData%Vars, ModData%Vars%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return + end associate end do From 761bbde27f8af0f630770a4a5ac28f1dc602eba4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:16:22 +0000 Subject: [PATCH 064/319] Change how extended linearization variables are handled in ElastoDyn --- modules/elastodyn/src/ElastoDyn.f90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index d74a750b4d..61ef301993 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -10420,6 +10420,14 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! If variable flag not in flag filter, skip if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + ! Extended input: BlPitchComC is the sum of BlPitchCom across all blades + if (i == p%iVarBlPitchComC) then + associate (Var => p%Vars%u(p%iVarBlPitchCom)) + dYdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate + cycle + end if + ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%u(i)%Num @@ -10443,11 +10451,6 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end do end do - ! Extended: BlPitchComC is the sum of BlPitchCom across all blades - associate (Var => p%Vars%u(p%iVarBlPitchCom)) - dYdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) - end associate - end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: From 86c7fca866d2be71466b02b7b9c775cc52e9fcd9 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:16:34 +0000 Subject: [PATCH 065/319] Add Hydrodyn module variables --- modules/hydrodyn/src/HydroDyn.f90 | 1344 ++++++++--------------------- modules/hydrodyn/src/HydroDyn.txt | 47 +- 2 files changed, 411 insertions(+), 980 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 521ea1aade..6c3727c730 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -822,13 +822,20 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InitOut%Ver = HydroDyn_ProgDesc + !............................................................................................ + ! Module Variables: + !............................................................................................ + + call HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !............................................................................................ ! Initialize Jacobian: !............................................................................................ - if (InitInp%Linearize) then - call HD_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + ! if (InitInp%Linearize) then + ! call HD_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! end if IF ( p%OutSwtch == 1 ) THEN ! Only HD-level output writing ! HACK WE can tell FAST not to write any HD outputs by simply deallocating the WriteOutputHdr array! @@ -917,6 +924,147 @@ SUBROUTINE HydroDyn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) END SUBROUTINE HydroDyn_End +subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) + type(HydroDyn_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(HydroDyn_ParameterType), intent(inout) :: p !< Parameters + type(HydroDyn_ContinuousStateType), intent(inout) :: x !< Continuous state + type(HydroDyn_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(HydroDyn_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(HydroDyn_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + type(HydroDyn_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'HydroDyn_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + real(R8Ki) :: PerturbTrans, PerturbRot, Perturbs(6) + character(10) :: BodyDesc + character(10), parameter :: dofLabels(6) = & + ['PtfmSg', 'PtfmSw', 'PtfmHv', 'PtfmR ', 'PtfmP ', 'PtfmY '] + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ErrStat = ErrID_None + ErrMsg = "" + + ! Associate pointer in init output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Need to determine how many wamit body objects there are + p%totalExctnStates = 0 + p%totalRdtnStates = 0 + do j = 1, p%nWAMITObj + p%totalExctnStates = p%totalExctnStates + p%WAMIT(j)%SS_Exctn%numStates ! numStates defaults to zero in the case where ExctnMod = 0 instead of 2 + p%totalRdtnStates = p%totalRdtnStates + p%WAMIT(j)%SS_Rdtn%numStates ! numStates defaults to zero in the case where RdtnMod = 0 instead of 2 + end do + p%totalStates = p%totalExctnStates + p%totalRdtnStates + + ! Initialize body description to empty + BodyDesc = "" + + ! Get excitation + do k = 1, p%nWAMITObj + if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) + call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", VF_Scalar, & + Flags=VF_DerivOrder1, & + Num=p%WAMIT(k)%SS_Exctn%numStates, & + Perturb=20000.0_R8Ki * D2R_D, & + LinNames=[((trim(BodyDesc)//'Exctn'//trim(dofLabels(j))//Num2LStr(i), i = 1, p%WAMIT(k)%SS_Exctn%spDOF(j)), j = 1, 6)]) + end do + + do k = 1, p%nWAMITObj + if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) + call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", VF_Scalar, & + Flags=VF_DerivOrder1, & + Num=p%WAMIT(k)%SS_Rdtn%numStates, & + Perturb=2.0_R8Ki * D2R_D , & + LinNames=[((trim(BodyDesc)//'Rdtn'//trim(dofLabels(j))//Num2LStr(i), i = 1, p%WAMIT(k)%SS_Rdtn%spDOF(j)), j = 1, 6)]) + end do + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Translation and rotation perturbations + PerturbTrans = 0.02_R8Ki*D2R * max(p%WaveField%EffWtrDpth, 1.0_R8Ki) + PerturbRot = 2*D2R + + ! Create perturbation array (order based on MotionFields) + Perturbs = [PerturbTrans, & ! VF_TransDisp + PerturbRot, & ! VF_Orientation + PerturbTrans, & ! VF_TransVel + PerturbRot, & ! VF_AngularVel + PerturbTrans, & ! VF_TransAcc + PerturbRot] ! VF_AngularAcc + + call MV_AddMeshVar(p%Vars%u, "Morison", MotionFields, u%Morison%Mesh, & + VarIdx=p%iVarMorisonMotionMesh, & + Perturbs=Perturbs) + + call MV_AddMeshVar(p%Vars%u, "WAMIT", MotionFields, u%WAMITMesh, & + VarIdx=p%iVarWAMITMotionMesh, & + Perturbs=Perturbs) + + call MV_AddMeshVar(p%Vars%u, "Platform-RefPt", MotionFields, u%PRPMesh, & + VarIdx=p%iVarPRPMotionMesh, & + Perturbs=Perturbs) + + call MV_AddVar(p%Vars%u, "WaveElev0", VF_Scalar, & + VarIdx=p%iVarWaveElev0, & + Flags=VF_ExtLin + VF_Linearize, & + Perturb=1.0_R8Ki, & + LinNames=['Extended input: wave elevation at platform ref point, m']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, "MorisonLoads", LoadFields, y%Morison%Mesh, VarIdx=p%iVarMorisonLoadMesh) + + call MV_AddMeshVar(p%Vars%y, "WAMITLoads", LoadFields, y%WAMITMesh, VarIdx=p%iVarWAMITLoadMesh) + + if (p%NumTotalOuts > 0) then + p%iVarWriteOut = size(p%Vars%y) + 1 + call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + Flags=VF_WriteOut, & + Num=p%NumTotalOuts, & + LinNames=[(trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)), i = 1, p%NumTotalOuts)]) + else + p%iVarWriteOut = 0 + end if + + !---------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call HydroDyn_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Loose coupling routine for solving constraint states, integrating continuous states, and updating discrete states. @@ -1507,7 +1655,7 @@ end function CalcLoadsAtWRP !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -1532,120 +1680,92 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with !! respect to the inputs (u) [intent in to avoid deallocation] + integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation + CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPInput' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + INTEGER(IntKi) :: i, j, k, col + INTEGER(IntKi) :: startingI, startingJ, bOffset, offsetI - ! local variables - TYPE(HydroDyn_OutputType) :: y_p - TYPE(HydroDyn_OutputType) :: y_m - TYPE(HydroDyn_ContinuousStateType) :: x_p - TYPE(HydroDyn_ContinuousStateType) :: x_m - TYPE(HydroDyn_InputType) :: u_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, k, startingI, startingJ, bOffset, offsetI, n_du_plus1 - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPInput' - - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if - n_du_plus1 = size(p%Jac_u_indx,1)+1 - - ! make a copy of the inputs to perturb - call HydroDyn_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + ! make a copy of the inputs to perturb + call HydroDyn_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + ! Pack inputs into array + call HD_PackInputValues(p, u, m%Jac%u) + if (Failed()) return + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, n_du_plus1, 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2) + if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call HydroDyn_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call HydroDyn_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + + ! If this is the Wave elevation extended input + if (i == p%iVarWaveElev0) then + dYdu(:, p%Vars%u(i)%iLoc(1)) = 0 + cycle end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call HD_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute y at u_op + delta u - call HydroDyn_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get u_op - delta u - call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call HD_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute y at u_op - delta u - call HydroDyn_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) - - end do - - ! p%WaveElev0 column - dYdu(:,n_du_plus1) = 0 - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call HD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call HD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do + end do + END IF - + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: IF ( PRESENT( dXdu ) ) THEN ! For the case where either RdtnMod=0 and ExtcnMod=0 and hence %SS_Rdtn data or %SS_Exctn data is not valid then we do not have states, so simply return ! The key here is to never allocate the dXdu and related state Jacobian arrays because then the glue-code will behave properly - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%totalStates, n_du_plus1, 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2) + if (Failed()) return end if offsetI = 0 @@ -1653,13 +1773,13 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM do j = 1,p%nWAMITObj do i = 1,p%WAMIT(j)%SS_Exctn%numStates - dXdu(offsetI+i,n_du_plus1) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 + dXdu(offsetI+i,p%Vars%Nu) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 end do offsetI = offsetI + p%WAMIT(j)%SS_Exctn%numStates end do startingI = p%totalStates - p%totalRdtnStates - startingJ = n_du_plus1 - 1 - 18 - 4*3*p%NBody ! subtract 1 for WaveElev0, then 6*3 for PRPMesh and then 4*3*NBody to place us at the beginning of the velocity inputs + startingJ = p%Vars%Nu - 1 - 18 - 4*3*p%NBody ! subtract 1 for WaveElev0, then 6*3 for PRPMesh and then 4*3*NBody to place us at the beginning of the velocity inputs ! B is numStates by 6*NBody where NBody =1 if NBodyMod=2 or 3, but could be >1 for NBodyMod=1 if ( p%NBodyMod == 1 ) then ! Example for NBodyMod=1 and NBody = 2, @@ -1710,7 +1830,6 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! dXdu(:,startingIndx +11) = p%WAMIT(2)%SS_Rdtn%B(:,5) ! dXdu(:,startingIndx +12) = p%WAMIT(2)%SS_Rdtn%B(:,6) - k=0 offsetI=0 ! First set all translationalVel components @@ -1738,8 +1857,6 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM END IF - - IF ( PRESENT( dXddu ) ) THEN if (allocated(dXddu)) deallocate(dXddu) END IF @@ -1748,22 +1865,16 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM if (allocated(dZdu)) deallocate(dZdu) END IF - call cleanup() - contains - subroutine cleanup() - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE HD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -1788,96 +1899,69 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the continuous states (x) [intent in to avoid deallocation] + integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation - ! local variables - TYPE(HydroDyn_OutputType) :: y_p - TYPE(HydroDyn_OutputType) :: y_m - TYPE(HydroDyn_ContinuousStateType) :: x_p - TYPE(HydroDyn_ContinuousStateType) :: x_m - TYPE(HydroDyn_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, k, sOffset - + CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPContState' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPContState' - - - ! Initialize ErrStat + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + INTEGER(IntKi) :: i, j, k, col, sOffset ErrStat = ErrID_None ErrMsg = '' - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if - - ! make a copy of the continuous states to perturb - call HydroDyn_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - IF ( PRESENT( dYdx ) ) THEN + ! Copy State values to perturb + call HydroDyn_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackStateValues(p, x, m%Jac%x) + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then - ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%totalStates, 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call HydroDyn_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call HydroDyn_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - do i=1,p%totalStates + ! Loop through state variables + do i = 1, size(p%Vars%x) - ! get x_op + delta x - call HydroDyn_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call HD_Perturb_x( p, i, 1, x_perturb, delta ) + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle - ! compute y at x_op + delta x - call HydroDyn_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get x_op - delta x - call HydroDyn_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call HD_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call HydroDyn_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) - + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call HD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call HD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + end do end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF + + end if IF ( PRESENT( dXdx ) ) THEN @@ -1885,13 +1969,9 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! allocate dXdu if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%totalStates, p%totalStates, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if + dXdx = 0.0_R8Ki ! Analytical Jacobians from State-space models @@ -1927,18 +2007,12 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, IF ( PRESENT( dZdx ) ) THEN if (allocated(dZdx)) deallocate(dZdx) END IF - - call cleanup() contains - subroutine cleanup() - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE HD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -1972,47 +2046,29 @@ SUBROUTINE HD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state !! functions (Z) with respect to the !! discrete states (xd) [intent in to avoid deallocation] - - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - + ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - ! allocate and set dYdxd - END IF + ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - ! allocate and set dXdxd - END IF + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - ! allocate and set dXddxd - END IF + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - ! allocate and set dZdxd - END IF - END SUBROUTINE HD_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -2042,655 +2098,33 @@ SUBROUTINE HD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat !! to the constraint states (z) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the constraint states (z) [intent in to avoid deallocation] - - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - ! allocate and set dYdz - END IF + ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: IF ( PRESENT( dXdz ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: - ! allocate and set dXdz - END IF + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: IF ( PRESENT( dXddz ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: - ! allocate and set dXddz - END IF + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: IF ( PRESENT( dZdz ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: - ! allocate and set dZdz - END IF END SUBROUTINE HD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. -SUBROUTINE HD_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables: - INTEGER(IntKi) :: i,index_last, index_next - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian_y' - - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - p%Jac_ny = 0 - if ( y%Morison%Mesh%Committed ) then - p%Jac_ny = p%Jac_ny + y%Morison%Mesh%NNodes * 6 ! 3 Force, Moment, at each node on the morison mesh - end if - if ( y%WAMITMesh%Committed ) then - p%Jac_ny = p%Jac_ny + y%WAMITMesh%NNodes * 6 ! 3 Force, Moment, at the WAMIT reference Point(s) - end if - - p%Jac_ny = p%Jac_ny + p%NumTotalOuts ! WriteOutput values - - - !................. - ! set linearization output names: - !................. - CALL AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! We do not need RotFrame_y for this module and the glue code with handle the fact that we did not allocate the array and hence set all values to false at the glue-code level - ! Same with RotFrame_x - !CALL AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - - - index_next = 1 - if ( y%Morison%Mesh%Committed ) then - index_last = index_next - call PackLoadMesh_Names(y%Morison%Mesh, 'MorisonLoads', InitOut%LinNames_y, index_next) - end if - - if ( y%WAMITMesh%Committed ) then - index_last = index_next - call PackLoadMesh_Names(y%WAMITMesh, 'WAMITLoads', InitOut%LinNames_y, index_next) - end if - - index_last = index_next - - do i=1,p%NumTotalOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do - - - -END SUBROUTINE HD_Init_Jacobian_y - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. -SUBROUTINE HD_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) - - TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian_x' - - ! local variables: - INTEGER(IntKi) :: i, j, k, l, spdof, indx - CHARACTER(10) :: dofLabels(6) - ErrStat = ErrID_None - ErrMsg = "" - indx = 1 - - ! Need to determine how many wamit body objects there are - p%totalExctnStates = 0 - p%totalRdtnStates = 0 - do j = 1, p%nWAMITObj - p%totalExctnStates = p%totalExctnStates + p%WAMIT(j)%SS_Exctn%numStates !numStates defaults to zero in the case where ExctnMod = 0 instead of 2 - p%totalRdtnStates = p%totalRdtnStates + p%WAMIT(j)%SS_Rdtn%numStates !numStates defaults to zero in the case where RdtnMod = 0 instead of 2 - end do - p%totalStates = p%totalExctnStates + p%totalRdtnStates - - if ( p%totalStates == 0 ) return ! No states, so return and do not allocate the following arrays. This lets the glue-code know that the module does not have states - - ! allocate space for the row/column names and for perturbation sizes - call allocAry(p%dx, p%totalStates, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%LinNames_x, p%totalStates, 'LinNames_x' , ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, p%totalStates, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! All Hydrodyn continuous states are max order = 1 - if ( allocated(InitOut%DerivOrder_x) ) InitOut%DerivOrder_x = 1 - - ! set perturbation sizes: p%dx - k = 1 - do j = 1, p%nWAMITObj - do i = 1, p%WAMIT(j)%SS_Exctn%numStates - p%dx(k) = 20000.0_R8Ki * D2R_D - k=k+1 - end do - end do - do j = 1, p%nWAMITObj - do i = 1, p%WAMIT(j)%SS_Rdtn%numStates - p%dx(k) = 2.0_R8Ki * D2R_D - k=k+1 - end do - end do - - !---------------- - ! SS_Exctn states - - dofLabels = (/'PtfmSg ','PtfmSw ','PtfmHv ','PtfmR ','PtfmP ','PtfmY '/) - if (p%totalExctnStates>0) then - do l=1,p%nWAMITObj - ! set linearization state names: - do j = 1, 6 - spdof = p%WAMIT(l)%SS_Exctn%spdof(j) - if ( p%NBodyMod == 1 ) then - do i = 1,spdof - InitOut%LinNames_x(indx) = 'Exctn'//trim(dofLabels(j))//trim(num2lstr(i)) - indx = indx + 1 - end do - else - do i = 1,spdof - InitOut%LinNames_x(indx) = 'B'//trim(num2lstr(l))//'Exctn'//trim(dofLabels(j))//trim(num2lstr(i)) - indx = indx + 1 - end do - end if - end do - end do - endif - - !---------------- - ! SS_Rdtn states - - if (p%totalRdtnStates>0) then - do l=1,p%nWAMITObj - ! set linearization state names: - do j = 1, 6 - spdof = p%WAMIT(l)%SS_Rdtn%spdof(j) - if ( p%NBodyMod == 1 ) then - do i = 1,spdof - InitOut%LinNames_x(indx) = 'Rdtn'//trim(dofLabels(j))//trim(num2lstr(i)) - indx = indx + 1 - end do - else - do i = 1,spdof - InitOut%LinNames_x(indx) = 'B'//trim(num2lstr(l))//'Rdtn'//trim(dofLabels(j))//trim(num2lstr(i)) - indx = indx + 1 - end do - end if - end do - end do - endif -END SUBROUTINE HD_Init_Jacobian_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding linearization routines ! -SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) - - TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(HydroDyn_InputType) , INTENT(IN ) :: u !< inputs - TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, index, nu, i_meshField, m, meshFieldCount - REAL(R8Ki) :: perturb_t, perturb - LOGICAL :: FieldMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - - - ErrStat = ErrID_None - ErrMsg = "" - - - call HD_Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call HD_Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - - ! determine how many inputs there are in the Jacobians - nu = 0; - if ( u%Morison%Mesh%Committed ) then - nu = u%Morison%Mesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - end if - if ( u%WAMITMesh%Committed ) then - nu = nu + u%WAMITMesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - end if - - nu = nu + u%PRPMesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - - ! DO NOT Add the extended input WaveElev0 when computing the size of p%Jac_u_indx - - - ! note: all other inputs are ignored - - !.................... - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see hydrodyn::HD_perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index of the acceleration/load field - ! column 3 is the node - !.................... - - !............... - ! HD input mappings stored in p%Jac_u_indx: - !............... - call AllocAry(p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - index = 1 - meshFieldCount = 0 - - if ( u%Morison%Mesh%Committed ) then - !Module/Mesh/Field: u%Morison%Mesh%TranslationDisp = 1; - !Module/Mesh/Field: u%Morison%Mesh%Orientation = 2; - !Module/Mesh/Field: u%Morison%Mesh%TranslationVel = 3; - !Module/Mesh/Field: u%Morison%Mesh%RotationVel = 4; - !Module/Mesh/Field: u%Morison%Mesh%TranslationAcc = 5; - !Module/Mesh/Field: u%Morison%Mesh%RotationAcc = 6; - - do i_meshField = 1,6 - do i=1,u%Morison%Mesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%Morison%Mesh%{TranslationDisp/Orientation/TranslationVel/RotationVel/TranslationAcc/RotationAcc} = m - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - meshFieldCount = 6 - - end if - - if ( u%WAMITMesh%Committed ) then - !Module/Mesh/Field: u%WAMITMesh%TranslationDisp = 7 or 1; - !Module/Mesh/Field: u%WAMITMesh%Orientation = 8 or 2; - !Module/Mesh/Field: u%WAMITMesh%TranslationVel = 9 or 3; - !Module/Mesh/Field: u%WAMITMesh%RotationVel = 10 or 4; - !Module/Mesh/Field: u%WAMITMesh%TranslationAcc = 11 or 5; - !Module/Mesh/Field: u%WAMITMesh%RotationAcc = 12 or 6; - do i_meshField = 1,6 - do i=1,u%WAMITMesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = meshFieldCount + i_meshField - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !i_meshField - meshFieldCount = meshFieldCount + 6 - end if - - !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 13 or 7 or 1; - !Module/Mesh/Field: u%PRPMesh%Orientation = 14 or 8 or 2; - !Module/Mesh/Field: u%PRPMesh%TranslationVel = 15 or 9 or 3; - !Module/Mesh/Field: u%PRPMesh%RotationVel = 16 or 10 or 4; - !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 17 or 11 or 5; - !Module/Mesh/Field: u%PRPMesh%RotationAcc = 18 or 12 or 6; - do i_meshField = 1,6 - do i=1,u%PRPMesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = meshFieldCount + i_meshField - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !i_meshField - meshFieldCount = meshFieldCount + 6 - - !................ - ! input perturbations, du: - !................ - - call AllocAry(p%du, meshFieldCount, 'p%du', ErrStat2, ErrMsg2) ! number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - perturb_t = 0.02_ReKi*D2R * max(p%WaveField%EffWtrDpth,1.0_ReKi) ! translation input scaling - perturb = 2*D2R ! rotational input scaling - - index = 0 - if ( u%Morison%Mesh%Committed ) then - p%du(1) = perturb_t ! u%Morison%Mesh%TranslationDisp - p%du(2) = perturb ! u%Morison%Mesh%Orientation - p%du(3) = perturb_t ! u%Morison%Mesh%TranslationVel - p%du(4) = perturb ! u%Morison%Mesh%RotationVel - p%du(5) = perturb_t ! u%Morison%Mesh%TranslationAcc - p%du(6) = perturb ! u%Morison%Mesh%RotationAcc - index = 6 - end if - - if ( u%WAMITMesh%Committed ) then - p%du(index + 1) = perturb_t ! u%WAMITMesh%TranslationDisp - p%du(index + 2) = perturb ! u%WAMITMesh%Orientation - p%du(index + 3) = perturb_t ! u%WAMITMesh%TranslationVel - p%du(index + 4) = perturb ! u%WAMITMesh%RotationVel - p%du(index + 5) = perturb_t ! u%WAMITMesh%TranslationAcc - p%du(index + 6) = perturb ! u%WAMITMesh%RotationAcc - index = index + 6 - end if - - p%du(index + 1) = perturb_t ! u%PRPMesh%TranslationDisp - p%du(index + 2) = perturb ! u%PRPMesh%Orientation - p%du(index + 3) = perturb_t ! u%PRPMesh%TranslationVel - p%du(index + 4) = perturb ! u%PRPMesh%RotationVel - p%du(index + 5) = perturb_t ! u%PRPMesh%TranslationAcc - p%du(index + 6) = perturb ! u%PRPMesh%RotationAcc - - !................ - ! names of the columns, InitOut%LinNames_u: - !................ - call AllocAry(InitOut%LinNames_u, nu+1, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! We do not need RotFrame_u for this module and the glue code with handle the fact that we did not allocate the array and hence set all values to false at the glue-code level - !call AllocAry(InitOut%RotFrame_u, nu+1, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call AllocAry(InitOut%IsLoad_u, nu+1, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%IsLoad_u = .false. ! HD's inputs are NOT loads - - index = 1 - if ( u%Morison%Mesh%Committed ) then - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - FieldMask(MASKID_ROTATIONVEL) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - FieldMask(MASKID_ROTATIONACC) = .true. - call PackMotionMesh_Names(u%Morison%Mesh, 'Morison', InitOut%LinNames_u, index, FieldMask=FieldMask) - - end if - - if ( u%WAMITMesh%Committed ) then - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - FieldMask(MASKID_ROTATIONVel) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - FieldMask(MASKID_ROTATIONACC) = .true. - call PackMotionMesh_Names(u%WAMITMesh, 'WAMIT', InitOut%LinNames_u, index, FieldMask=FieldMask) - end if - - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - FieldMask(MASKID_ROTATIONVel) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - FieldMask(MASKID_ROTATIONACC) = .true. - call PackMotionMesh_Names(u%PRPMesh, 'Platform-RefPt', InitOut%LinNames_u, index, FieldMask=FieldMask) - - InitOut%LinNames_u(index) = 'Extended input: wave elevation at platform ref point, m' - -END SUBROUTINE HD_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine hydrodyn::HD_init_jacobian is consistant with this routine! -SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(HydroDyn_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(HydroDyn_InputType) , INTENT(INOUT) :: u !< perturbed HD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - integer :: fieldIndx - integer :: node, index - - index = 0 - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - - ! If we do not have Morison meshes, then the following select cases will vary - if ( u%Morison%Mesh%Committed ) then - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%Morison%Mesh%TranslationDisp = 1 - u%Morison%Mesh%TranslationDisp (fieldIndx,node) = u%Morison%Mesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%Morison%Mesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%Morison%Mesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 3) !Module/Mesh/Field: u%Morison%Mesh%TranslationVel = 3 - u%Morison%Mesh%TranslationVel( fieldIndx,node) = u%Morison%Mesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%Morison%Mesh%RotationVel = 4 - u%Morison%Mesh%RotationVel (fieldIndx,node) = u%Morison%Mesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%Morison%Mesh%TranslationAcc = 5 - u%Morison%Mesh%TranslationAcc( fieldIndx,node) = u%Morison%Mesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%Morison%Mesh%RotationAcc = 6 - u%Morison%Mesh%RotationAcc(fieldIndx,node) = u%Morison%Mesh%RotationAcc(fieldIndx,node) + du * perturb_sign - end select - if ( u%WAMITMesh%Committed ) then - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 7) !Module/Mesh/Field: u%WAMITMesh%TranslationDisp = 7 - u%WAMITMesh%TranslationDisp (fieldIndx,node) = u%WAMITMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%WAMITMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%WAMITMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 9) !Module/Mesh/Field: u%WAMITMesh%TranslationVel = 9 - u%WAMITMesh%TranslationVel( fieldIndx,node) = u%WAMITMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%WAMITMesh%RotationVel = 10 - u%WAMITMesh%RotationVel (fieldIndx,node) = u%WAMITMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%WAMITMesh%TranslationAcc = 11 - u%WAMITMesh%TranslationAcc( fieldIndx,node) = u%WAMITMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%WAMITMesh%RotationAcc = 12 - u%WAMITMesh%RotationAcc(fieldIndx,node) = u%WAMITMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE (13) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 13 - u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%PRPMesh%Orientation = 14 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE (15) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 15 - u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%PRPMesh%RotationVel = 16 - u%PRPMesh%RotationVel (fieldIndx,node) = u%PRPMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (17) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 17 - u%PRPMesh%TranslationAcc( fieldIndx,node) = u%PRPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (18) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 18 - u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - else - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 7) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 7 - u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PRPMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 9) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 9 - u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%PRPMesh%RotationVel = 10 - u%PRPMesh%RotationVel (fieldIndx,node) = u%PRPMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 11 - u%PRPMesh%TranslationAcc( fieldIndx,node) = u%PRPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 12 - u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - end if - else if ( u%WAMITMesh%Committed ) then - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE (1) !Module/Mesh/Field: u%WAMITMesh%TranslationDisp = 1 - u%WAMITMesh%TranslationDisp (fieldIndx,node) = u%WAMITMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE (2) !Module/Mesh/Field: u%WAMITMesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%WAMITMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE (3) !Module/Mesh/Field: u%WAMITMesh%TranslationVel = 3 - u%WAMITMesh%TranslationVel( fieldIndx,node) = u%WAMITMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (4) !Module/Mesh/Field: u%WAMITMesh%RotationVel = 4 - u%WAMITMesh%RotationVel (fieldIndx,node) = u%WAMITMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (5) !Module/Mesh/Field: u%WAMITMesh%TranslationAcc = 5 - u%WAMITMesh%TranslationAcc( fieldIndx,node) = u%WAMITMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (6) !Module/Mesh/Field: u%WAMITMesh%RotationAcc = 6 - u%WAMITMesh%RotationAcc(fieldIndx,node) = u%WAMITMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 7) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 7 - u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PRPMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 9) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 9 - u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%PRPMesh%RotationVel = 10 - u%PRPMesh%RotationVel (fieldIndx,node) = u%PRPMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 11 - u%PRPMesh%TranslationAcc( fieldIndx,node) = u%PRPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 12 - u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - else - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 1 - u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%PRPMesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 3) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 3 - u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%PRPMesh%RotationVel = 4 - u%PRPMesh%RotationVel (fieldIndx,node) = u%PRPMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 5 - u%PRPMesh%TranslationAcc( fieldIndx,node) = u%PRPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 6 - u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - end if - -END SUBROUTINE HD_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the continuous state array. -!! Do not change this without making sure subroutine HD_init_jacobian is consistant with this routine! -SUBROUTINE HD_Perturb_x( p, n, perturb_sign, x, dx ) - - TYPE(HydroDyn_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(HydroDyn_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed ED states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - - ! local variables - integer(intKi) :: i, offset1, offset2, n2 - - if ( p%totalStates == 0 ) return - - !Note: All excitation states for all bodies are stored 1st, then all radiation states - dx = p%dx(n) - offset1 = 1 - if ( n <= p%totalExctnStates ) then - - ! Find body index for exctn states - do i=1,p%nWAMITObj - offset2 = offset1 + p%WAMIT(i)%SS_Exctn%numStates - if ( n >= offset1 .and. n < offset2) then - n2 = n - offset1 + 1 - x%WAMIT(i)%SS_Exctn%x( n2 ) = x%WAMIT(i)%SS_Exctn%x( n2 ) + dx * perturb_sign - exit - end if - offset1 = offset2 - end do - - else - offset1 = p%totalExctnStates + 1 - ! Find body index for rdtn states - do i=1,p%nWAMITObj - offset2 = offset1 + p%WAMIT(i)%SS_Exctn%numStates - if ( n >= offset1 .and. n < offset2) then - n2 = n - offset1 + 1 - x%WAMIT(i)%SS_Rdtn%x( n2 ) = x%WAMIT(i)%SS_Rdtn%x( n2 ) + dx * perturb_sign - exit - end if - offset1 = offset2 - end do - end if - -END SUBROUTINE HD_Perturb_x - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine hydrodyn::HD_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(HydroDyn_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_p !< HD outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) - TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_m !< HD outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - - integer(IntKi) :: indx_first ! index indicating next value of dY to be filled - integer(IntKi) :: k - - - - - indx_first = 1 - if ( y_p%Morison%Mesh%Committed ) then - call PackLoadMesh_dY(y_p%Morison%Mesh, y_m%Morison%Mesh, dY, indx_first) - end if - if ( y_p%WAMITMesh%Committed ) then - call PackLoadMesh_dY(y_p%WAMITMesh, y_m%WAMITMesh, dY, indx_first) - end if - - do k=1,p%NumTotalOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - - - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. @@ -2714,153 +2148,55 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - - INTEGER(IntKi) :: i, j, index, nu + CHARACTER(*), PARAMETER :: RoutineName = 'HD_GetOP' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_GetOP' - TYPE(HydroDyn_ContinuousStateType) :: dx !< derivative of continuous states at operating point - LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing - - - ! Initialize ErrStat + INTEGER(IntKi) :: i, j, index ErrStat = ErrID_None ErrMsg = '' !.................................. IF ( PRESENT( u_op ) ) THEN - - if (.not. allocated(u_op)) then - - nu = size(p%Jac_u_indx,1) - - ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do - if ( u%Morison%Mesh%Committed ) then - nu = nu + u%Morison%Mesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node - end if - if ( u%WAMITMesh%Committed ) then - nu = nu + u%WAMITMesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node - end if - - nu = nu + u%PRPMesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node - nu = nu + 1 ! Extended input - - call AllocAry(u_op, nu,'u_op',ErrStat2,ErrMsg2) ! - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - - end if - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_TRANSLATIONVEL) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - Mask(MASKID_TRANSLATIONACC) = .true. - Mask(MASKID_ROTATIONACC) = .true. - - index = 1 - if ( u%Morison%Mesh%Committed ) then - call PackMotionMesh(u%Morison%Mesh, u_op, index, FieldMask=Mask) + if (.not. allocated(u_op)) then + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) + if (Failed()) return end if - - if ( u%WAMITMesh%Committed ) then - call PackMotionMesh(u%WAMITMesh, u_op, index, FieldMask=Mask) - end if - - call PackMotionMesh(u%PRPMesh, u_op, index, FieldMask=Mask) - - ! extended input: - u_op(index) = 0.0_R8Ki - - + call HD_PackInputValues(p, u, u_op) END IF !.................................. if ( PRESENT( y_op ) ) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - index = 1 - if ( y%Morison%Mesh%Committed ) then - call PackLoadMesh(y%Morison%Mesh, y_op, index) - end if - if ( y%WAMITMesh%Committed ) then - call PackLoadMesh(y%WAMITMesh, y_op, index) + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) + if (Failed()) return end if - - index = index - 1 - do i=1,p%NumTotalOuts - y_op(i+index) = y%WriteOutput(i) - end do - + call HD_PackOutputValues(p, y, y_op, .true.) end if !.................................. IF ( PRESENT( x_op ) ) THEN - - if ( p%totalStates == 0 ) return - + if (p%Vars%Nx == 0) return if ( y%WAMITMesh%Committed ) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%totalStates,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2) + if (Failed()) return end if - index = 1 - do j=1, p%nWAMITObj - do i=1,p%WAMIT(j)%SS_Exctn%numStates ! Loop through all DOFs - x_op(index) = x%WAMIT(j)%SS_Exctn%x(i) - index = index + 1 - end do - end do - do j=1, p%nWAMITObj - do i=1,p%WAMIT(j)%SS_Rdtn%numStates ! Loop through all DOFs - x_op(index) = x%WAMIT(j)%SS_Rdtn%x(i) - index = index + 1 - end do - end do + call HD_PackStateValues(p, x, x_op) end if END IF !.................................. IF ( PRESENT( dx_op ) ) THEN - - if ( p%totalStates == 0 ) return - + if (p%Vars%Nx == 0) return if ( y%WAMITMesh%Committed ) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%totalStates,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2) + if (Failed()) return end if - - call HydroDyn_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call HydroDyn_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - index = 1 - do j=1, p%nWAMITObj - do i=1,p%WAMIT(j)%SS_Exctn%numStates ! Loop through all DOFs - dx_op(index) = dx%WAMIT(j)%SS_Exctn%x(i) - index = index + 1 - end do - end do - do j=1, p%nWAMITObj - do i=1,p%WAMIT(j)%SS_Rdtn%numStates ! Loop through all DOFs - dx_op(index) = dx%WAMIT(j)%SS_Rdtn%x(i) - index = index + 1 - end do - end do - call HydroDyn_DestroyContState( dx, ErrStat2, ErrMsg2) + call HydroDyn_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2 ) + if (Failed()) return + call HD_PackStateValues(p, m%dxdt_lin, dx_op) end if END IF @@ -2872,9 +2208,87 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, IF ( PRESENT( z_op ) ) THEN END IF +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE HD_GetOP +subroutine HD_PackStateValues(p, x, ary) + type(HydroDyn_ParameterType), intent(in) :: p + type(HydroDyn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: i, j, k + k = 1 + do j = 1, p%nWAMITObj + do i = 1,p%WAMIT(j)%SS_Exctn%numStates ! Loop through all DOFs + ary(k) = x%WAMIT(j)%SS_Exctn%x(i) + k = k + 1 + end do + end do + do j = 1, p%nWAMITObj + do i = 1,p%WAMIT(j)%SS_Rdtn%numStates ! Loop through all DOFs + ary(k) = x%WAMIT(j)%SS_Rdtn%x(i) + k = k + 1 + end do + end do +end subroutine + +subroutine HD_UnpackStateValues(p, ary, x) + type(HydroDyn_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(HydroDyn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i, j, k + k = 1 + do j = 1, p%nWAMITObj + do i = 1,p%WAMIT(j)%SS_Exctn%numStates ! Loop through all DOFs + x%WAMIT(j)%SS_Exctn%x(i) = ary(k) + k = k + 1 + end do + end do + do j = 1, p%nWAMITObj + do i = 1,p%WAMIT(j)%SS_Rdtn%numStates ! Loop through all DOFs + x%WAMIT(j)%SS_Rdtn%x(i) = ary(k) + k = k + 1 + end do + end do +end subroutine + +subroutine HD_PackInputValues(p, u, Ary) + type(HydroDyn_ParameterType), intent(in) :: p + type(HydroDyn_InputType), intent(in) :: u + real(R8Ki), intent(out) :: Ary(:) + integer(IntKi) :: i + call MV_Pack(p%Vars%u, p%iVarMorisonMotionMesh, u%Morison%Mesh, Ary) + call MV_Pack(p%Vars%u, p%iVarWAMITMotionMesh, u%WAMITMesh, Ary) + call MV_Pack(p%Vars%u, p%iVarPRPMotionMesh, u%PRPMesh, Ary) + call MV_Pack(p%Vars%u, p%iVarWaveElev0, 0.0_R8Ki, Ary) ! Extended input +end subroutine + +subroutine HD_UnpackInputValues(p, Ary, u) + type(HydroDyn_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Ary(:) + type(HydroDyn_InputType), intent(inout) :: u + integer(IntKi) :: i + call MV_Unpack(p%Vars%u, p%iVarMorisonMotionMesh, Ary, u%Morison%Mesh) + call MV_Unpack(p%Vars%u, p%iVarWAMITMotionMesh, Ary, u%WAMITMesh) + call MV_Unpack(p%Vars%u, p%iVarPRPMotionMesh, Ary, u%PRPMesh) + ! call MV_Unpack(p%Vars%u, p%iVarWaveElev0, Ary, ) ! Extended input +end subroutine + +subroutine HD_PackOutputValues(p, y, Ary, PackWriteOutput) + type(HydroDyn_ParameterType), intent(in) :: p + type(HydroDyn_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: Ary(:) + logical, intent(in) :: PackWriteOutput + integer(IntKi) :: i + call MV_Pack(p%Vars%y, p%iVarMorisonLoadMesh, y%Morison%Mesh, Ary) + call MV_Pack(p%Vars%y, p%iVarWAMITLoadMesh, y%WAMITMesh, Ary) + call MV_Pack(p%Vars%y, p%iVarWriteOut, y%WriteOutput, Ary) +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE HydroDyn !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 00939dcaaa..79fe67c050 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -79,6 +79,7 @@ typedef ^ ^ SeaSt_WaveFieldType # # Define outputs from the initialization routine here: # +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" - typedef ^ InitOutputType Morison_InitOutputType Morison - - - "Initialization output from the Morison module" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - @@ -117,25 +118,20 @@ typedef ^ ConstraintStateType Morison_Con # typedef ^ OtherStateType WAMIT_OtherStateType WAMIT {:} - - "OtherState information from the WAMIT module" - typedef ^ ^ Morison_OtherStateType Morison - - - "OtherState information from the Morison module" - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType MeshType AllHdroOrigin - - - "An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh" - -typedef ^ ^ HD_ModuleMapType HD_MeshMap - - - -typedef ^ ^ INTEGER Decimate - - - "The output decimation counter" - -typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - -typedef ^ ^ ReKi F_PtfmAdd {:} - - "The total forces and moments due to additional pre-load, stiffness, and damping" - -typedef ^ ^ ReKi F_Hydro {6} - - "The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point" - -typedef ^ ^ ReKi F_Waves {:} - - "The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules)" - -typedef ^ ^ WAMIT_MiscVarType WAMIT {:} - - "misc var information from the WAMIT module" - -typedef ^ ^ WAMIT2_MiscVarType WAMIT2 {:} - - "misc var information from the WAMIT2 module" - -typedef ^ ^ Morison_MiscVarType Morison - - - "misc var information from the Morison module" - -typedef ^ ^ WAMIT_InputType u_WAMIT {:} - - "WAMIT module inputs" - +# # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # -typedef ^ ParameterType INTEGER nWAMITObj - - - "number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - +typedef ^ ^ IntKi iVarMorisonMotionMesh - 0 - "Morison Motion Mesh variable index" +typedef ^ ^ IntKi iVarWAMITMotionMesh - 0 - "WAMIT Motion Mesh variable index" +typedef ^ ^ IntKi iVarPRPMotionMesh - 0 - "PRP Motion Mesh variable index" +typedef ^ ^ IntKi iVarWaveElev0 - 0 - "Wave Elevation variable index" +typedef ^ ^ IntKi iVarMorisonLoadMesh - 0 - "Morison Load Mesh variable index" +typedef ^ ^ IntKi iVarWAMITLoadMesh - 0 - "WAMIT Load Mesh variable index" +typedef ^ ^ IntKi iVarWriteOut - 0 - "Write Output variable index" +typedef ^ ^ INTEGER nWAMITObj - - - "number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - typedef ^ ^ INTEGER vecMultiplier - - - "multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1" - typedef ^ ^ WAMIT_ParameterType WAMIT {:} - - "Parameter data for the WAMIT module" - typedef ^ ^ WAMIT2_ParameterType WAMIT2 {:} - - "Parameter data for the WAMIT2 module" - @@ -184,3 +180,24 @@ typedef ^ OutputType WAMIT2_Outpu typedef ^ ^ Morison_OutputType Morison - - - "Morison module outputs" - typedef ^ OutputType MeshType WAMITMesh - - - "Point Loads at the WAMIT reference point(s) in the inertial frame" - typedef ^ ^ ReKi WriteOutput {:} - - "Outputs to be written to the output file(s)" - +# +# +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" - +typedef ^ ^ HydroDyn_ContinuousStateType x_perturb - - - "Temporary variables for Jacobian calculations" - +typedef ^ ^ HydroDyn_InputType u_perturb - - - "Temporary variables for Jacobian calculations" - +typedef ^ ^ HydroDyn_ContinuousStateType dxdt_lin - - - "Temporary variables for Jacobian calculations" - +typedef ^ ^ HydroDyn_OutputType y_lin - - - "Temporary variables for Jacobian calculations" - +typedef ^ ^ MeshType AllHdroOrigin - - - "An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh" - +typedef ^ ^ HD_ModuleMapType HD_MeshMap - - - +typedef ^ ^ INTEGER Decimate - - - "The output decimation counter" - +typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - +typedef ^ ^ ReKi F_PtfmAdd {:} - - "The total forces and moments due to additional pre-load, stiffness, and damping" - +typedef ^ ^ ReKi F_Hydro {6} - - "The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point" - +typedef ^ ^ ReKi F_Waves {:} - - "The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules)" - +typedef ^ ^ WAMIT_MiscVarType WAMIT {:} - - "misc var information from the WAMIT module" - +typedef ^ ^ WAMIT2_MiscVarType WAMIT2 {:} - - "misc var information from the WAMIT2 module" - +typedef ^ ^ Morison_MiscVarType Morison - - - "misc var information from the Morison module" - +typedef ^ ^ WAMIT_InputType u_WAMIT {:} - - "WAMIT module inputs" - \ No newline at end of file From f448bf561e930e2470125464ec2b6bfbd1118faf Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:16:47 +0000 Subject: [PATCH 066/319] Add MAP Module Variables --- modules/map/src/MAP_Registry.txt | 16 +- modules/map/src/MAP_Types.f90 | 224 +++++++++++++++- modules/map/src/MAP_Types.h | 8 + modules/map/src/map.f90 | 440 ++++++++++++++++++------------- 4 files changed, 501 insertions(+), 187 deletions(-) diff --git a/modules/map/src/MAP_Registry.txt b/modules/map/src/MAP_Registry.txt index 316376a55b..a74aa4c316 100644 --- a/modules/map/src/MAP_Registry.txt +++ b/modules/map/src/MAP_Registry.txt @@ -33,7 +33,8 @@ typedef ^ ^ CHARACTER(24) compilingData typedef ^ ^ CHARACTER(15) writeOutputHdr {:} "" - "first line output file contents: output variable names" typedef ^ ^ CHARACTER(15) writeOutputUnt {:} "" - "second line of output file contents: units" typedef ^ ^ ProgDesc Ver - "" - "this module's name, version, and date" -typedef ^ ^ Lin_InitOutputType LinInitOut - - - "Init Output linearization data (fortran-only)" - +typedef ^ ^ Lin_InitOutputType LinInitOut - - - "Init Output linearization data (fortran-only)" - +typedef ^ ^ ModVarsType *Vars - - - "Module Variables" - ## ============================== Define Continuous states here: ===================================================================================================================================== typedef ^ ContinuousStateType R8Ki dummy - - - "Remove this variable if you have continuous states" - @@ -71,7 +72,11 @@ typedef ^ ^ R8Ki z { ## ============================== Parameters ============================================================================================================================================ -typedef ^ ParameterType R8Ki g - - - "gravitational constant" "[kg/m^2]" +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" +typedef ^ ^ IntKi iVarPtFairDisplacement - - - "Variable index for fairlead displacement mesh" +typedef ^ ^ IntKi iVarPtFairleadLoad - - - "Variable index for fairlead loads mesh" +typedef ^ ^ IntKi iVarWriteOutput - - - "Variable index for write outputs" +typedef ^ ^ R8Ki g - - - "gravitational constant" "[kg/m^2]" typedef ^ ^ R8Ki depth - - - "distance to seabed" "[m]" typedef ^ ^ R8Ki rho_sea - - - "density of seawater" "[m]" typedef ^ ^ R8Ki dt - - - "time step coupling interval" "[sec]" @@ -83,7 +88,7 @@ typedef ^ ^ R8Ki dt typedef ^ ^ CHARACTER(255) InputLines {500} - - "input file line for restart" typedef ^ ^ CHARACTER(1) InputLineType {500} - - "input file line type for restart" typedef ^ ^ INTEGER numOuts - 0 - "Number of write outputs" - -typedef ^ ^ Lin_ParamType LinParams - - - "Parameter linearization data (fortran-only)" - +typedef ^ ^ Lin_ParamType LinParams - - - "Parameter linearization data (fortran-only)" # ============================== Inputs ============================================================================================================================================ typedef ^ InputType R8Ki x {:} - - "fairlead x displacement" "[m]" @@ -100,4 +105,7 @@ typedef ^ ^ ReKi WriteOutput typedef ^ ^ R8Ki wrtOutput {:} - - "outpur vector" "" typedef ^ ^ MeshType ptFairleadLoad - - - "point mesh for forces in X,Y,Z" "[N]" - +## ============================== MiscVar ============================================================================================================================================ +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ ^ MAP_InputType u_perturb - - - "Temporary variables for Jacobian calculations" +typedef ^ ^ MAP_ConstraintStateType z_lin - - - "Temporary variables for Jacobian calculations" diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 511b3e3014..f93875a67d 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -83,6 +83,7 @@ MODULE MAP_Types CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] TYPE(Lin_InitOutputType) :: LinInitOut !< Init Output linearization data (fortran-only) [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE MAP_InitOutputType ! ======================= ! ========= MAP_ContinuousStateType_C ======= @@ -187,6 +188,9 @@ MODULE MAP_Types ! ========= MAP_ParameterType_C ======= TYPE, BIND(C) :: MAP_ParameterType_C TYPE(C_PTR) :: object = C_NULL_PTR + INTEGER(KIND=C_INT) :: iVarPtFairDisplacement + INTEGER(KIND=C_INT) :: iVarPtFairleadLoad + INTEGER(KIND=C_INT) :: iVarWriteOutput REAL(KIND=C_DOUBLE) :: g REAL(KIND=C_DOUBLE) :: depth REAL(KIND=C_DOUBLE) :: rho_sea @@ -195,6 +199,10 @@ MODULE MAP_Types END TYPE MAP_ParameterType_C TYPE, PUBLIC :: MAP_ParameterType TYPE( MAP_ParameterType_C ) :: C_obj + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarPtFairDisplacement = 0_IntKi !< Variable index for fairlead displacement mesh [-] + INTEGER(IntKi) :: iVarPtFairleadLoad = 0_IntKi !< Variable index for fairlead loads mesh [-] + INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Variable index for write outputs [-] REAL(R8Ki) :: g = 0.0_R8Ki !< gravitational constant [[kg/m^2]] REAL(R8Ki) :: depth = 0.0_R8Ki !< distance to seabed [[m]] REAL(R8Ki) :: rho_sea = 0.0_R8Ki !< density of seawater [[m]] @@ -247,6 +255,17 @@ MODULE MAP_Types TYPE(MeshType) :: ptFairleadLoad !< point mesh for forces in X,Y,Z [[N]] END TYPE MAP_OutputType ! ======================= +! ========= MAP_MiscVarType_C ======= + TYPE, BIND(C) :: MAP_MiscVarType_C + TYPE(C_PTR) :: object = C_NULL_PTR + END TYPE MAP_MiscVarType_C + TYPE, PUBLIC :: MAP_MiscVarType + TYPE( MAP_MiscVarType_C ) :: C_obj + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(MAP_InputType) :: u_perturb !< Temporary variables for Jacobian calculations [-] + TYPE(MAP_ConstraintStateType) :: z_lin !< Temporary variables for Jacobian calculations [-] + END TYPE MAP_MiscVarType +! ======================= CONTAINS subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -444,6 +463,7 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er call MAP_Fortran_CopyLin_InitOutputType(SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -465,12 +485,14 @@ subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_Fortran_DestroyLin_InitOutputType(InitOutputData%LinInitOut, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) end subroutine subroutine MAP_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(MAP_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) @@ -483,6 +505,13 @@ subroutine MAP_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%writeOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) call MAP_Fortran_PackLin_InitOutputType(RF, InData%LinInitOut) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -493,6 +522,8 @@ subroutine MAP_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%progName); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%progName = transfer(OutData%progName, OutData%C_obj%progName ) @@ -504,6 +535,24 @@ subroutine MAP_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver call MAP_Fortran_UnpackLin_InitOutputType(RF, OutData%LinInitOut) ! LinInitOut + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine SUBROUTINE MAP_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) @@ -1798,11 +1847,30 @@ subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + DstParamData%iVarPtFairDisplacement = SrcParamData%iVarPtFairDisplacement + DstParamData%C_obj%iVarPtFairDisplacement = SrcParamData%C_obj%iVarPtFairDisplacement + DstParamData%iVarPtFairleadLoad = SrcParamData%iVarPtFairleadLoad + DstParamData%C_obj%iVarPtFairleadLoad = SrcParamData%C_obj%iVarPtFairleadLoad + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput + DstParamData%C_obj%iVarWriteOutput = SrcParamData%C_obj%iVarWriteOutput DstParamData%g = SrcParamData%g DstParamData%C_obj%g = SrcParamData%C_obj%g DstParamData%depth = SrcParamData%depth @@ -1829,6 +1897,12 @@ subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'MAP_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if call MAP_Fortran_DestroyLin_ParamType(ParamData%LinParams, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -1837,11 +1911,22 @@ subroutine MAP_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(MAP_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackParam' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarPtFairDisplacement) + call RegPack(RF, InData%iVarPtFairleadLoad) + call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%g) call RegPack(RF, InData%depth) call RegPack(RF, InData%rho_sea) @@ -1857,7 +1942,36 @@ subroutine MAP_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackParam' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarPtFairDisplacement); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%iVarPtFairDisplacement = OutData%iVarPtFairDisplacement + call RegUnpack(RF, OutData%iVarPtFairleadLoad); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%iVarPtFairleadLoad = OutData%iVarPtFairleadLoad + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%iVarWriteOutput = OutData%iVarWriteOutput call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%g = OutData%g call RegUnpack(RF, OutData%depth); if (RegCheckErr(RF, RoutineName)) return @@ -1888,6 +2002,9 @@ SUBROUTINE MAP_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) ELSE SkipPointers_local = .false. END IF + ParamData%iVarPtFairDisplacement = ParamData%C_obj%iVarPtFairDisplacement + ParamData%iVarPtFairleadLoad = ParamData%C_obj%iVarPtFairleadLoad + ParamData%iVarWriteOutput = ParamData%C_obj%iVarWriteOutput ParamData%g = ParamData%C_obj%g ParamData%depth = ParamData%C_obj%depth ParamData%rho_sea = ParamData%C_obj%rho_sea @@ -1910,6 +2027,9 @@ SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE SkipPointers_local = .false. END IF + ParamData%C_obj%iVarPtFairDisplacement = ParamData%iVarPtFairDisplacement + ParamData%C_obj%iVarPtFairleadLoad = ParamData%iVarPtFairleadLoad + ParamData%C_obj%iVarWriteOutput = ParamData%iVarWriteOutput ParamData%C_obj%g = ParamData%g ParamData%C_obj%depth = ParamData%depth ParamData%C_obj%rho_sea = ParamData%rho_sea @@ -2424,6 +2544,104 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE +subroutine MAP_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(MAP_MiscVarType), intent(inout) :: SrcMiscData + type(MAP_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyConstrState(SrcMiscData%z_lin, DstMiscData%z_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(MAP_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyConstrState(MiscData%z_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call NWTC_Library_PackModJacType(RF, InData%Jac) + call MAP_PackInput(RF, InData%u_perturb) + call MAP_PackConstrState(RF, InData%z_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call MAP_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call MAP_UnpackConstrState(RF, OutData%z_lin) ! z_lin +end subroutine + +SUBROUTINE MAP_C2Fary_CopyMisc(MiscData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + subroutine MAP_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time @@ -2803,8 +3021,7 @@ function MAP_InputMeshPointer(u, ML) result(Mesh) end select end function -function MAP_InputMeshName(u, ML) result(Name) - type(MAP_InputType), target, intent(in) :: u +function MAP_InputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" @@ -2825,8 +3042,7 @@ function MAP_OutputMeshPointer(y, ML) result(Mesh) end select end function -function MAP_OutputMeshName(y, ML) result(Name) - type(MAP_OutputType), target, intent(in) :: y +function MAP_OutputMeshName(ML) result(Name) type(MeshLocType), intent(in) :: ML character(32) :: Name Name = "" diff --git a/modules/map/src/MAP_Types.h b/modules/map/src/MAP_Types.h index 9040c07793..e5985fc8c3 100644 --- a/modules/map/src/MAP_Types.h +++ b/modules/map/src/MAP_Types.h @@ -81,6 +81,9 @@ typedef struct MAP_ConstraintStateType { typedef struct MAP_ParameterType { void *object; + int iVarPtFairDisplacement; + int iVarPtFairleadLoad; + int iVarWriteOutput; double g; double depth; double rho_sea; @@ -104,6 +107,10 @@ typedef struct MAP_OutputType { double *wrtOutput; int wrtOutput_Len; } MAP_OutputType_t; +typedef struct MAP_MiscVarType { + void *object; +} MAP_MiscVarType_t; + typedef struct MAP_UserData { MAP_InitInputType_t MAP_InitInput; MAP_InitOutputType_t MAP_InitOutput; @@ -114,6 +121,7 @@ typedef struct MAP_UserData { MAP_ParameterType_t MAP_Param; MAP_InputType_t MAP_Input; MAP_OutputType_t MAP_Output; + MAP_MiscVarType_t MAP_Misc; } MAP_t; #endif // _MAP_TYPES_H diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index c7acb73027..c051dd75fd 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -497,7 +497,7 @@ SUBROUTINE MAP_Restart( u, p, x, xd, z, other, y, ErrStat, ErrMsg ) END SUBROUTINE MAP_Restart !========== MAP_Init ====== <----------------------------------------------------------------------+ - SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrStat, ErrMsg ) + SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, m, Interval, InitOut, ErrStat, ErrMsg ) IMPLICIT NONE TYPE( MAP_InitInputType ), INTENT(INOUT) :: InitInp ! INTENT(IN ) : Input data for initialization routine TYPE( MAP_InputType ), INTENT( OUT) :: u ! INTENT( OUT) : An initial guess for the input; input mesh must be defined @@ -507,6 +507,7 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrSt TYPE( MAP_ConstraintStateType ), INTENT( OUT) :: z ! INTENT( OUT) : Initial guess of the constraint states TYPE( MAP_OtherStateType ), INTENT( OUT) :: other ! INTENT( OUT) : Initial other/optimization states TYPE( MAP_OutputType ), INTENT( OUT) :: y ! INTENT( OUT) : Initial system outputs (outputs are not calculated; only the output mesh is initialized) + TYPE( MAP_MiscVarType ), INTENT( OUT) :: m ! INTENT( OUT) : Initial system mischellaneous vars REAL(DbKi), INTENT(INOUT) :: Interval ! Coupling interval in seconds: the rate that Output is the actual coupling interval TYPE( MAP_InitOutputType ), INTENT(INOUT) :: InitOut ! Output for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation @@ -686,19 +687,109 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrSt allocate( y%WriteOutput(p%numOuts), STAT=N) if (N/=0) call SetErrStat(ErrID_Fatal, 'Failed to allocate y%WriteOutput',ErrStat, ErrMsg, RoutineName) end if + + !............................................................................................ + ! Module Variables + !............................................................................................ + call MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, InitInp%LinInitInp%Linearize, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !............................................................................................ ! Initialize Jacobian information: !............................................................................................ - if (InitInp%LinInitInp%Linearize) then - call map_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + ! if (InitInp%LinInitInp%Linearize) then + ! call map_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! end if END SUBROUTINE MAP_Init ! -------+ !========================================================================================================== + !---------------------------------------------------------------------------------------------------------------------------------- + !> This routine initializes module variables for use by the solver and linearization. + subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(MAP_InitInputType), intent(in) :: InitInp !< Initialization input + type(MAP_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(MAP_ParameterType), intent(inout) :: p !< Parameters + type(MAP_ContinuousStateType), intent(inout) :: x !< Continuous state + type(MAP_ConstraintStateType), intent(inout) :: z !< Constraint state + type(MAP_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(MAP_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(MAP_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'MAP_InitVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + integer(IntKi) :: i + real(R8Ki) :: Perturb + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !------------------------------------------------------------------------- + ! Continuous State Variables + !------------------------------------------------------------------------- + + + !------------------------------------------------------------------------- + ! Input variables + !------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%u, "PtFairDisplacement", [VF_TransDisp], & + VarIdx=p%iVarPtFairDisplacement, & + Mesh=u%PtFairDisplacement, & + Perturbs=[0.2_R8Ki*D2R * max(p%depth,1.0_R8Ki)]) + + !------------------------------------------------------------------------- + ! Output variables + !------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, "FairleadLoads", [VF_Force], & + VarIdx=p%iVarPtFairleadLoad, & + Mesh=y%ptFairleadLoad) + + ! Write outputs + call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + VarIdx=p%iVarWriteOutput, & + Num=p%numOuts,& + Flags=VF_WriteOut, & + LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) + + !------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call MAP_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MAP_CopyConstrState(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine + !========== MAP_UpdateStates ====== <-------------------------------------------------------------+ SUBROUTINE MAP_UpdateStates( t, n, u, utimes, p, x, xd, z, O, ErrStat, ErrMsg) REAL(DbKi) , INTENT(IN ) :: t @@ -1257,7 +1348,7 @@ SUBROUTINE MAP_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) END SUBROUTINE MAP_Init_Jacobian -SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, dYdu ) +SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(map_ParameterType), INTENT(INOUT) :: p !< Parameters @@ -1269,231 +1360,222 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg !! Output fields are not used by this routine, but type is !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. + TYPE(map_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Filter variables by flag value INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - - - ! local variables - INTEGER(KIND=C_INT) :: status_from_MAP - CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: message_from_MAP - REAL(KIND=C_FLOAT) :: time - INTEGER(KIND=C_INT) :: interval - - TYPE(map_OutputType) :: y_p - TYPE(map_OutputType) :: y_m - TYPE(map_ConstraintStateType) :: z_perturb - TYPE(map_InputType) :: u_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, NN, offsetI, offsetJ + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] + CHARACTER(*), PARAMETER :: RoutineName = 'map_JacobianPInput' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'map_JacobianPInput' - + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + INTEGER(KIND=C_INT) :: status_from_MAP + CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: message_from_MAP + REAL(KIND=C_FLOAT) :: time + INTEGER(KIND=C_INT) :: interval + INTEGER(IntKi) :: i, j, NN, offsetI, offsetJ, col - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + time = t interval = t / p%dt + + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if - if ( present( dYdu ) ) then + ! Make a copy of the inputs to perturb + call map_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call MAP_PackInputValues(p, u, m%Jac%u) - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%LinParams%Jac_ny, size(p%LinParams%Jac_u_indx,1), 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - - - do i=1,size(p%LinParams%Jac_u_indx,1) - - ! get u_op + delta u - call map_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call map_Perturb_u( p, i, 1, u_perturb, delta ) - call MAP_CopyConstrState( z, z_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - DO j = 1,u_perturb%PtFairDisplacement%NNodes - u_perturb%X(j) = u_perturb%PtFairDisplacement%Position(1,j) + u_perturb%PtFairDisplacement%TranslationDisp(1,j) - u_perturb%Y(j) = u_perturb%PtFairDisplacement%Position(2,j) + u_perturb%PtFairDisplacement%TranslationDisp(2,j) - u_perturb%Z(j) = u_perturb%PtFairDisplacement%Position(3,j) + u_perturb%PtFairDisplacement%TranslationDisp(3,j) - END DO - - ! compute constraint state for u_op + delta u - call MSQS_UpdateStates( time , & - interval , & - u_perturb%C_obj , & - p%C_obj , & - x%C_obj , & - xd%C_obj , & - z_perturb%C_obj , & - OtherState%C_obj , & - status_from_MAP , & - message_from_MAP ) + ! Loop through input variables + do i = 1, size(p%Vars%u) - call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg, RoutineName) + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle - + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MAP_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call MAP_CopyConstrState(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Calculate absolute position of each node + m%u_perturb%X = m%u_perturb%PtFairDisplacement%Position(1,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(1,:) + m%u_perturb%Y = m%u_perturb%PtFairDisplacement%Position(2,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(2,:) + m%u_perturb%Z = m%u_perturb%PtFairDisplacement%Position(3,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(3,:) + ! Compute constraint state for u_op + delta u + call MSQS_UpdateStates(time, & + interval, & + m%u_perturb%C_obj, & + p%C_obj, & + x%C_obj, & + xd%C_obj, & + m%z_lin%C_obj, & + OtherState%C_obj, & + status_from_MAP, & + message_from_MAP ) + + call MAP_ERROR_CHECKER(message_from_MAP, status_from_MAP, ErrMsg2, ErrStat2); if (Failed()) return + ! compute y at u_op + delta u - call map_CalcOutput( t, u_perturb, p, x, xd, z_perturb, OtherState, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - ! We need to do this copy inside the loop because MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. - call map_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. + call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2); if (Failed()) return + call MAP_PackOutputValues(p, y, m%Jac%y_pos, IsFullLin) - ! get u_op - delta u - call map_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - ! Minus perturbation - call map_Perturb_u( p, i, -1, u_perturb, delta ) - - call MAP_CopyConstrState( z, z_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MAP_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call MAP_CopyConstrState(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - - DO j = 1,u_perturb%PtFairDisplacement%NNodes - u_perturb%X(j) = u_perturb%PtFairDisplacement%Position(1,j) + u_perturb%PtFairDisplacement%TranslationDisp(1,j) - u_perturb%Y(j) = u_perturb%PtFairDisplacement%Position(2,j) + u_perturb%PtFairDisplacement%TranslationDisp(2,j) - u_perturb%Z(j) = u_perturb%PtFairDisplacement%Position(3,j) + u_perturb%PtFairDisplacement%TranslationDisp(3,j) - END DO + ! Calculate absolute position of each node + m%u_perturb%X = m%u_perturb%PtFairDisplacement%Position(1,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(1,:) + m%u_perturb%Y = m%u_perturb%PtFairDisplacement%Position(2,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(2,:) + m%u_perturb%Z = m%u_perturb%PtFairDisplacement%Position(3,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(3,:) - ! compute constraint state for u_op + delta u - call MSQS_UpdateStates( time , & - interval , & - u_perturb%C_obj , & - p%C_obj , & - x%C_obj , & - xd%C_obj , & - z_perturb%C_obj , & - OtherState%C_obj , & - status_from_MAP , & - message_from_MAP ) - - call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg, RoutineName) - - ! compute y at u_op - delta u - call map_CalcOutput( t, u_perturb, p, x, xd, z_perturb, OtherState, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + ! compute constraint state for u_op - delta u + call MSQS_UpdateStates( time, & + interval, & + m%u_perturb%C_obj, & + p%C_obj, & + x%C_obj, & + xd%C_obj, & + m%z_lin%C_obj, & + OtherState%C_obj, & + status_from_MAP, & + message_from_MAP ) + + call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2); if (Failed()) return - ! We need to do this copy inside the loop because MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. - call map_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! compute y at u_op - delta u + ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. + call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2 ); if (Failed()) return + call MAP_PackOutputValues(p, y, m%Jac%y_pos, IsFullLin) - ! get central difference: note: assumes delta is equivalent for both perturb_u calls. - call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) - + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do end do end if - call cleanup() + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu)) then + if (allocated(dXdu)) deallocate(dXdu) + end if + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here: + if (present(dXddu)) then + if (allocated(dXddu)) deallocate(dXddu) + end if + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: + if (present(dZdu)) then + if (allocated(dZdu)) deallocate(dZdu) + end if ! Calling CalcOutput at operating point to ensure that "y" does not have the values of y_m (MAP specific issue) - call map_CalcOutput( t, u, p, x, xd, z, OtherState, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later -contains - subroutine cleanup() - call map_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call map_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call map_DestroyConstrState( z_perturb, ErrStat2, ErrMsg2 ) - call map_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) + call map_CalcOutput(t, u, p, x, xd, z, OtherState, y, ErrStat2, ErrMsg2); if (Failed()) return - end subroutine cleanup +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE MAP_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE MAP_GetOP( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, u_op, y_op) - +SUBROUTINE MAP_GetOP(t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, u_op, y_op) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(map_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(map_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(map_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(map_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(map_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(map_OutputType), INTENT(IN ) :: y !< Output at operating point + TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(map_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(map_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(map_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(map_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(map_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(map_OutputType), INTENT(IN ) :: y !< Output at operating point INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - - - INTEGER(IntKi) :: i, k, index, nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'map_GetOP' - TYPE(map_ContinuousStateType) :: dx !< derivative of continuous states at operating point - LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing - - !LIN-TODO: Need to review and implement this routine per plan. Do not understand how to implement at the moment, GJH. - ! Initialize ErrStat + CHARACTER(*), PARAMETER :: RoutineName = 'map_GetOP' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None ErrMsg = '' - !.................................. - IF ( PRESENT( u_op ) ) THEN - - if (.not. allocated(u_op)) then - - nu = size(p%LinParams%Jac_u_indx,1) - - call AllocAry(u_op, nu,'u_op',ErrStat2,ErrMsg2) ! - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - - end if - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - - index = 1 - if ( u%PtFairDisplacement%Committed ) then - call PackMotionMesh(u%PtFairDisplacement, u_op, index, FieldMask=Mask) + !.................................. + if (present(u_op)) then + if (.not. allocated(u_op)) then + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - END IF + call MAP_PackInputValues(p, u, u_op) + end if !.................................. - if ( PRESENT( y_op ) ) then - - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%LinParams%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + if (present(y_op)) then + if (.not. allocated(y_op)) then + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - index = 1 - if ( y%ptFairleadLoad%Committed ) then - call PackLoadMesh(y%ptFairleadLoad, y_op, index) - end if - - index = index - 1 - do i=1,p%numOuts - y_op(i+index) = y%WriteOutput(i) - end do - + call MAP_PackOutputValues(p, y, y_op, .true.) end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE MAP_GetOP +subroutine MAP_PackInputValues(p, u, Ary) + type(MAP_ParameterType), intent(in) :: p + type(MAP_InputType), intent(in) :: u + real(R8Ki), intent(out) :: Ary(:) + call MV_Pack(p%Vars%u, p%iVarPtFairDisplacement, u%PtFairDisplacement, Ary) +end subroutine + +subroutine MAP_UnpackInputValues(p, Ary, u) + type(MAP_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Ary(:) + type(MAP_InputType), intent(inout) :: u + call MV_Unpack(p%Vars%u, p%iVarPtFairDisplacement, Ary, u%PtFairDisplacement) +end subroutine + +subroutine MAP_PackOutputValues(p, y, Ary, PackWriteOutput) + type(MAP_ParameterType), intent(in) :: p + type(MAP_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: Ary(:) + logical, intent(in) :: PackWriteOutput + call MV_Pack(p%Vars%y, p%iVarPtFairleadLoad, y%ptFairleadLoad, Ary) + if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, Ary) +end subroutine + !========================================================================================================== ! ========== MAP_ERROR_CHECKER ====== <-----------------------------------------------------------+ From 27833494b154fd880dec630deb3f7ad01adcae68 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:17:23 +0000 Subject: [PATCH 067/319] ModVar: don't add variables with zero number --- modules/nwtc-library/src/ModVar.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 72a58907a7..8309f1acf2 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -154,9 +154,6 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) end do Vars%Ny = sum(Vars%y%Num) - ! Initialize full linearization variable indexing (all variables) - call MV_InitVarIdx(Vars, Vars%IdxLin, VF_None, ErrStat2, ErrMsg2); if (Failed()) return - ! Allocate arrays if (Vars%Nx > 0) then call AllocAry(Jac%x, Vars%Nx, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return @@ -770,8 +767,13 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Pe ! Initialize var with default values Var = ModVarType(Name=Name, Field=Field) + ! If number of values is zero, return + if (present(Num)) then + if (Num == 0) return + Var%Num = Num + end if + ! Set optional values - if (present(Num)) Var%Num = Num if (present(Flags)) Var%Flags = Flags if (present(iUsr)) Var%iUsr = [iUsr, iUsr + Var%Num - 1] if (present(jUsr)) Var%jUsr = jUsr From 78a0f55c40331f297298139eb7c48db2107a599d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:17:45 +0000 Subject: [PATCH 068/319] Remove duplicate registry generation in MAP --- modules/map/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/modules/map/CMakeLists.txt b/modules/map/CMakeLists.txt index 43da778252..735d2058df 100644 --- a/modules/map/CMakeLists.txt +++ b/modules/map/CMakeLists.txt @@ -27,7 +27,6 @@ endif() if (GENERATE_TYPES) generate_f90_types(src/MAP_Fortran_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Fortran_Types.f90 -noextrap) generate_f90_types(src/MAP_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Types.f90 -ccode) - generate_f90_types(src/MAP_Fortran_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Fortran_Types.f90 -noextrap) endif() file(GLOB MAP_CLIB_SOURCES src/*.c src/*.cc src/*/*.c src/*/*.cc) From 1d111c41494230faef6615e02cce222cad3324c1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:18:05 +0000 Subject: [PATCH 069/319] Add missing routines to FAST_Funcs --- modules/openfast-library/src/FAST_Funcs.f90 | 126 ++++++++------------ 1 file changed, 52 insertions(+), 74 deletions(-) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 78c867ac59..ca32ebbd35 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -32,6 +32,7 @@ module FAST_Funcs use SeaState use ServoDyn use SubDyn +use MAP implicit none @@ -527,7 +528,7 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt real(R8Ki), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states - character(*), parameter :: RoutineName = 'FAST_CalcOutput' + character(*), parameter :: RoutineName = 'FAST_GetOP' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i @@ -553,12 +554,15 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt call ED_GetOP(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! case (Module_ExtPtfm) + ! case (Module_FEAM) + case (Module_HD) - ! call HydroDyn_GetOP(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & - ! T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + call HD_GetOP(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) ! case (Module_IceD) ! case (Module_IceF) @@ -567,7 +571,11 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt T%IfW%OtherSt(ThisState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) -! case (Module_MAP) + case (Module_MAP) + call MAP_GetOP(ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(ThisState), T%MAP%xd(ThisState), T%MAP%z(ThisState), & + T%MAP%OtherSt, T%MAP%y, ErrStat2, ErrMsg2, & + u_op=u_op, y_op=y_op) !, x_op=x_op, dx_op=dx_op) MAP doesn't have states + ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) @@ -585,7 +593,7 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt case default ! Unknown module ErrStat2 = ErrID_Fatal - ErrMsg2 = "Unknown module ID "//trim(Num2LStr(ModData%ID)) + ErrMsg2 = "Unsupported module: "//trim(ModData%Abbr) end select ! Check for errors during calc output call @@ -600,7 +608,7 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - integer(IntKi), optional, intent(in) :: FlagFilter !< Variable index number + integer(IntKi), optional, intent(in) :: FlagFilter !< Variable index number real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :), dXdu(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPInput' @@ -614,6 +622,7 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, select case (ModData%ID) ! case (Module_AD) + case (Module_BD) call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & @@ -625,26 +634,25 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) ! case (Module_ExtPtfm) -! case (Module_FEAM) + case (Module_HD) - ! call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & - ! T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - ! FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) -! case (Module_IceD) -! case (Module_IceF) ! case (Module_IfW) -! case (Module_MAP) -! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) - case (Module_SD) - ! call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & - ! T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, & - ! ErrStat2, ErrMsg2, FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + case (Module_MAP) + call MAP_JacobianPInput(ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(ThisState), T%MAP%xd(ThisState), & + T%MAP%z(ThisState), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) -! case (Module_SeaSt) +! case (Module_MD) + +! case (Module_SD) +! call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & +! T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, & +! ErrStat2, ErrMsg2, FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) case (Module_SrvD) call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & @@ -653,7 +661,7 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, case default ErrStat2 = ErrID_Fatal - ErrMsg2 = "Unknown module ID "//trim(Num2LStr(ModData%ID)) + ErrMsg2 = "Unsupported module: "//ModData%Abbr end select call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -682,6 +690,7 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err select case (ModData%ID) ! case (Module_AD) + case (Module_BD) call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & @@ -697,29 +706,30 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) ! case (Module_ExtPtfm) -! case (Module_FEAM) + case (Module_HD) - ! call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & - ! T%HD%x(ThisState), T%HD%xd(ThisState), & - ! T%HD%z(ThisState), T%HD%OtherSt(ThisState), & - ! T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - ! FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & + T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) -! case (Module_IceD) -! case (Module_IceF) ! case (Module_IfW) -! case (Module_MAP) + + case (Module_MAP) + ! MAP doesn't have a JacobianPContState subroutine + ErrStat2 = ErrID_None + ErrMsg2 = '' + ! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) - case (Module_SD) - ! call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & - ! T%SD%x(ThisState), T%SD%xd(ThisState), & - ! T%SD%z(ThisState), T%SD%OtherSt(ThisState), & - ! T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - ! FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) -! case (Module_SeaSt) +! case (Module_SD) +! call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & +! T%SD%x(ThisState), T%SD%xd(ThisState), & +! T%SD%z(ThisState), T%SD%OtherSt(ThisState), & +! T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & +! FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + case (Module_SrvD) call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(1), T%SrvD%p, & T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & @@ -729,7 +739,7 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err case default ErrStat2 = ErrID_Fatal - ErrMsg2 = "Unknown module ID "//trim(Num2LStr(ModData%ID)) + ErrMsg2 = "Unsupported module: "//ModData%Abbr end select call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -746,38 +756,6 @@ subroutine FAST_SaveStates(ModData, T, ErrStat, ErrMsg) call FAST_CopyStates(ModData, T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) end subroutine -subroutine XferLocToGbl1D(Inds, Loc, Gbl) - integer(IntKi), intent(in) :: Inds(:, :) - real(R8Ki), intent(in) :: Loc(:) - real(R8Ki), intent(inout) :: Gbl(:) - integer(IntKi) :: i - do i = 1, size(Inds, dim=2) - Gbl(Inds(2, i)) = Loc(Inds(1, i)) - end do -end subroutine - -subroutine XferGblToLoc1D(Inds, Gbl, Loc) - integer(IntKi), intent(in) :: Inds(:, :) - real(R8Ki), intent(in) :: Gbl(:) - real(R8Ki), intent(inout) :: Loc(:) - integer(IntKi) :: i - do i = 1, size(Inds, dim=2) - Loc(Inds(1, i)) = Gbl(Inds(2, i)) - end do -end subroutine - -subroutine XferLocToGbl2D(RowInds, ColInds, Loc, Gbl) - integer(IntKi), intent(in) :: RowInds(:, :), ColInds(:, :) - real(R8Ki), intent(in) :: Loc(:, :) - real(R8Ki), intent(inout) :: Gbl(:, :) - integer(IntKi) :: i, j - do i = 1, size(ColInds, dim=2) - do j = 1, size(RowInds, dim=2) - Gbl(RowInds(2, j), ColInds(2, i)) = Loc(RowInds(1, j), ColInds(1, i)) - end do - end do -end subroutine - subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData !< Module data type(FAST_TurbineType), intent(inout) :: T !< Turbine type From 1f96ede58678e87c5ee9ae94ffb30a3611976536 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:18:24 +0000 Subject: [PATCH 070/319] Completely rework FAST_Mesh --- modules/openfast-library/src/FAST_Mesh.f90 | 1178 +++++++++++++++----- 1 file changed, 871 insertions(+), 307 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mesh.f90 b/modules/openfast-library/src/FAST_Mesh.f90 index 31ffba9e40..7584887a1f 100644 --- a/modules/openfast-library/src/FAST_Mesh.f90 +++ b/modules/openfast-library/src/FAST_Mesh.f90 @@ -12,19 +12,27 @@ module FAST_Mesh integer(IntKi), parameter :: AD_rotor = 1 -integer(IntKi), parameter :: Xfr_Point_to_Point = 1, & +integer(IntKi), parameter :: Xfr_Invalid = 0, & + Xfr_Point_to_Point = 1, & Xfr_Line2_to_Point = 2, & Xfr_Point_to_Line2 = 3, & Xfr_Line2_to_Line2 = 4 contains -function FAST_InputMeshPointer(ModData, Turbine, MeshLoc, UseU) result(Mesh) +subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, UseU, Mesh, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshLocType), intent(in) :: MeshLoc logical, intent(in) :: UseU - type(MeshType), pointer :: Mesh + type(MeshType), pointer, intent(out) :: Mesh + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + ErrStat = ErrID_None + ErrMsg = "" + + nullify (Mesh) select case (ModData%ID) case (Module_AD) @@ -45,82 +53,252 @@ function FAST_InputMeshPointer(ModData, Turbine, MeshLoc, UseU) result(Mesh) else Mesh => ED_InputMeshPointer(Turbine%ED%Input(1), MeshLoc) end if + case (Module_ExtInfw) + if (UseU) then + Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) + else + ! ExtInfw doesn't have the typical input structure, using u for both + ! Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%Input(1), MeshLoc) + Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) + end if + case (Module_ExtPtfm) + if (UseU) then + Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%u, MeshLoc) + else + Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input(1), MeshLoc) + end if + case (Module_FEAM) + if (UseU) then + Mesh => FEAM_InputMeshPointer(Turbine%FEAM%u, MeshLoc) + else + Mesh => FEAM_InputMeshPointer(Turbine%FEAM%Input(1), MeshLoc) + end if + case (Module_HD) + if (UseU) then + Mesh => HydroDyn_InputMeshPointer(Turbine%HD%u, MeshLoc) + else + Mesh => HydroDyn_InputMeshPointer(Turbine%HD%Input(1), MeshLoc) + end if + case (Module_IceD) + if (UseU) then + Mesh => IceD_InputMeshPointer(Turbine%IceD%u(ModData%Ins), MeshLoc) + else + Mesh => IceD_InputMeshPointer(Turbine%IceD%Input(1, ModData%Ins), MeshLoc) + end if + case (Module_IceF) + if (UseU) then + Mesh => IceFloe_InputMeshPointer(Turbine%IceF%u, MeshLoc) + else + Mesh => IceFloe_InputMeshPointer(Turbine%IceF%Input(1), MeshLoc) + end if + case (Module_IfW) + if (UseU) then + Mesh => InflowWind_InputMeshPointer(Turbine%IfW%u, MeshLoc) + else + Mesh => InflowWind_InputMeshPointer(Turbine%IfW%Input(1), MeshLoc) + end if + case (Module_MAP) + if (UseU) then + Mesh => MAP_InputMeshPointer(Turbine%MAP%u, MeshLoc) + else + Mesh => MAP_InputMeshPointer(Turbine%MAP%Input(1), MeshLoc) + end if + case (Module_MD) + if (UseU) then + Mesh => MD_InputMeshPointer(Turbine%MD%u, MeshLoc) + else + Mesh => MD_InputMeshPointer(Turbine%MD%Input(1), MeshLoc) + end if + case (Module_Orca) + if (UseU) then + Mesh => Orca_InputMeshPointer(Turbine%Orca%u, MeshLoc) + else + Mesh => Orca_InputMeshPointer(Turbine%Orca%Input(1), MeshLoc) + end if case (Module_SD) if (UseU) then Mesh => SD_InputMeshPointer(Turbine%SD%u, MeshLoc) else Mesh => SD_InputMeshPointer(Turbine%SD%Input(1), MeshLoc) end if + case (Module_SeaSt) + if (UseU) then + Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%u, MeshLoc) + else + Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input(1), MeshLoc) + end if case (Module_SrvD) if (UseU) then Mesh => SrvD_InputMeshPointer(Turbine%SrvD%u, MeshLoc) else Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input(1), MeshLoc) end if + case default + ErrStat = ErrID_Fatal + ErrMsg = "Unsupported module: "//ModData%Abbr + return end select -end function -function FAST_InputMeshName(ModData, Turbine, MeshLoc) result(Name) + if (.not. associated(Mesh)) then + ErrStat = ErrID_Fatal + ErrMsg = "Mesh not found in module "//ModData%Abbr// & + ", Num="//trim(Num2LStr(MeshLoc%Num))// & + ", i1="//trim(Num2LStr(MeshLoc%i1))// & + ", i2="//trim(Num2LStr(MeshLoc%i2))// & + ", i3="//trim(Num2LStr(MeshLoc%i3)) + return + end if +end subroutine + +subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshLocType), intent(in) :: MeshLoc - character(32) :: Name + type(MeshType), pointer, intent(out) :: Mesh + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + ErrStat = ErrID_None + ErrMsg = "" + + nullify (Mesh) + select case (ModData%ID) case (Module_AD) - Name = trim(ModData%Abbr)//"%"//AD_InputMeshName(Turbine%AD%u, MeshLoc) + Mesh => AD_OutputMeshPointer(Turbine%AD%y, MeshLoc) case (Module_BD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputMeshName(Turbine%BD%u(ModData%Ins), MeshLoc) + Mesh => BD_OutputMeshPointer(Turbine%BD%y(ModData%Ins), MeshLoc) case (Module_ED) - Name = trim(ModData%Abbr)//"%"//ED_InputMeshName(Turbine%ED%u, MeshLoc) + Mesh => ED_OutputMeshPointer(Turbine%ED%y, MeshLoc) + case (Module_ExtInfw) + Mesh => ExtInfw_OutputMeshPointer(Turbine%ExtInfw%y, MeshLoc) + case (Module_ExtPtfm) + Mesh => ExtPtfm_OutputMeshPointer(Turbine%ExtPtfm%y, MeshLoc) + case (Module_FEAM) + Mesh => FEAM_OutputMeshPointer(Turbine%FEAM%y, MeshLoc) + case (Module_HD) + Mesh => HydroDyn_OutputMeshPointer(Turbine%HD%y, MeshLoc) + case (Module_IceD) + Mesh => IceD_OutputMeshPointer(Turbine%IceD%y(ModData%Ins), MeshLoc) + case (Module_IceF) + Mesh => IceFloe_OutputMeshPointer(Turbine%IceF%y, MeshLoc) + case (Module_IfW) + Mesh => InflowWind_OutputMeshPointer(Turbine%IfW%y, MeshLoc) + case (Module_MAP) + Mesh => MAP_OutputMeshPointer(Turbine%MAP%y, MeshLoc) + case (Module_MD) + Mesh => MD_OutputMeshPointer(Turbine%MD%y, MeshLoc) + case (Module_Orca) + Mesh => Orca_OutputMeshPointer(Turbine%Orca%y, MeshLoc) case (Module_SD) - Name = trim(ModData%Abbr)//"%"//SD_InputMeshName(Turbine%SD%u, MeshLoc) + Mesh => SD_OutputMeshPointer(Turbine%SD%y, MeshLoc) + case (Module_SeaSt) + Mesh => SeaSt_OutputMeshPointer(Turbine%SeaSt%y, MeshLoc) case (Module_SrvD) - Name = trim(ModData%Abbr)//"%"//SrvD_InputMeshName(Turbine%SrvD%u, MeshLoc) + Mesh => SrvD_OutputMeshPointer(Turbine%SrvD%y, MeshLoc) + case default + ErrStat = ErrID_Fatal + ErrMsg = "Unsupported module: "//ModData%Abbr + return end select -end function -function FAST_OutputMeshPointer(ModData, Turbine, MeshLoc) result(Mesh) + if (.not. associated(Mesh)) then + ErrStat = ErrID_Fatal + ErrMsg = "Mesh not found in module "//ModData%Abbr// & + ", Num="//trim(Num2LStr(MeshLoc%Num))// & + ", i1="//trim(Num2LStr(MeshLoc%i1))// & + ", i2="//trim(Num2LStr(MeshLoc%i2))// & + ", i3="//trim(Num2LStr(MeshLoc%i3)) + return + end if +end subroutine + +function FAST_InputMeshName(ModData, MeshLoc) result(Name) type(ModDataType), intent(in) :: ModData - type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshLocType), intent(in) :: MeshLoc - type(MeshType), pointer :: Mesh + character(32) :: Name + Name = "Unknown mesh in "//ModData%Abbr select case (ModData%ID) case (Module_AD) - Mesh => AD_OutputMeshPointer(Turbine%AD%y, MeshLoc) + Name = trim(ModData%Abbr)//"%"//AD_InputMeshName(MeshLoc) case (Module_BD) - Mesh => BD_OutputMeshPointer(Turbine%BD%y(ModData%Ins), MeshLoc) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputMeshName(MeshLoc) case (Module_ED) - Mesh => ED_OutputMeshPointer(Turbine%ED%y, MeshLoc) + Name = trim(ModData%Abbr)//"%"//ED_InputMeshName(MeshLoc) + case (Module_ExtInfw) + Name = trim(ModData%Abbr)//"%"//ExtInfw_InputMeshName(MeshLoc) + case (Module_ExtPtfm) + Name = trim(ModData%Abbr)//"%"//ExtPtfm_InputMeshName(MeshLoc) + case (Module_FEAM) + Name = trim(ModData%Abbr)//"%"//FEAM_InputMeshName(MeshLoc) + case (Module_HD) + Name = trim(ModData%Abbr)//"%"//HydroDyn_InputMeshName(MeshLoc) + case (Module_IceD) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_InputMeshName(MeshLoc) + case (Module_IceF) + Name = trim(ModData%Abbr)//"%"//IceFloe_InputMeshName(MeshLoc) + case (Module_IfW) + Name = trim(ModData%Abbr)//"%"//InflowWind_InputMeshName(MeshLoc) + case (Module_MAP) + Name = trim(ModData%Abbr)//"%"//MAP_InputMeshName(MeshLoc) + case (Module_MD) + Name = trim(ModData%Abbr)//"%"//MD_InputMeshName(MeshLoc) + case (Module_Orca) + Name = trim(ModData%Abbr)//"%"//Orca_InputMeshName(MeshLoc) case (Module_SD) - Mesh => SD_OutputMeshPointer(Turbine%SD%y, MeshLoc) + Name = trim(ModData%Abbr)//"%"//SD_InputMeshName(MeshLoc) + case (Module_SeaSt) + Name = trim(ModData%Abbr)//"%"//SeaSt_InputMeshName(MeshLoc) case (Module_SrvD) - Mesh => SrvD_OutputMeshPointer(Turbine%SrvD%y, MeshLoc) + Name = trim(ModData%Abbr)//"%"//SrvD_InputMeshName(MeshLoc) end select end function -function FAST_OutputMeshName(ModData, Turbine, MeshLoc) result(Name) +function FAST_OutputMeshName(ModData, MeshLoc) result(Name) type(ModDataType), intent(in) :: ModData - type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshLocType), intent(in) :: MeshLoc character(32) :: Name + Name = "Unknown mesh in "//ModData%Abbr select case (ModData%ID) case (Module_AD) - Name = trim(ModData%Abbr)//"%"//AD_OutputMeshName(Turbine%AD%y, MeshLoc) + Name = trim(ModData%Abbr)//"%"//AD_OutputMeshName(MeshLoc) case (Module_BD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputMeshName(Turbine%BD%y(ModData%Ins), MeshLoc) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputMeshName(MeshLoc) case (Module_ED) - Name = trim(ModData%Abbr)//"%"//ED_OutputMeshName(Turbine%ED%y, MeshLoc) + Name = trim(ModData%Abbr)//"%"//ED_OutputMeshName(MeshLoc) + case (Module_ExtInfw) + Name = trim(ModData%Abbr)//"%"//ExtInfw_OutputMeshName(MeshLoc) + case (Module_ExtPtfm) + Name = trim(ModData%Abbr)//"%"//ExtPtfm_OutputMeshName(MeshLoc) + case (Module_FEAM) + Name = trim(ModData%Abbr)//"%"//FEAM_OutputMeshName(MeshLoc) + case (Module_HD) + Name = trim(ModData%Abbr)//"%"//HydroDyn_OutputMeshName(MeshLoc) + case (Module_IceD) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_OutputMeshName(MeshLoc) + case (Module_IceF) + Name = trim(ModData%Abbr)//"%"//IceFloe_OutputMeshName(MeshLoc) + case (Module_IfW) + Name = trim(ModData%Abbr)//"%"//InflowWind_OutputMeshName(MeshLoc) + case (Module_MAP) + Name = trim(ModData%Abbr)//"%"//MAP_OutputMeshName(MeshLoc) + case (Module_MD) + Name = trim(ModData%Abbr)//"%"//MD_OutputMeshName(MeshLoc) + case (Module_Orca) + Name = trim(ModData%Abbr)//"%"//Orca_OutputMeshName(MeshLoc) case (Module_SD) - Name = trim(ModData%Abbr)//"%"//SD_OutputMeshName(Turbine%SD%y, MeshLoc) + Name = trim(ModData%Abbr)//"%"//SD_OutputMeshName(MeshLoc) + case (Module_SeaSt) + Name = trim(ModData%Abbr)//"%"//SeaSt_OutputMeshName(MeshLoc) case (Module_SrvD) - Name = trim(ModData%Abbr)//"%"//SrvD_OutputMeshName(Turbine%SrvD%y, MeshLoc) + Name = trim(ModData%Abbr)//"%"//SrvD_OutputMeshName(MeshLoc) end select end function -subroutine FAST_InitMappings(Mods, Mappings, T, ErrStat, ErrMsg) +subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) type(ModDataType), intent(inout) :: Mods(:) !< Module data type(TC_MappingType), allocatable, intent(inout) :: Mappings(:) - type(FAST_TurbineType), intent(inout) :: T !< Turbine type + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -151,19 +329,19 @@ subroutine FAST_InitMappings(Mods, Mappings, T, ErrStat, ErrMsg) ! Switch by destination module (inputs) select case (Mods(IModDst)%ID) case (Module_AD) - call AD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + call AD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_BD) - call BD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + call BD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_ED) - call ED_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + call ED_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_HD) - call HD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + call HD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_IfW) - call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_SD) - call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_SrvD) - call SrvD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), T, ErrStat, ErrMsg) + call SrvD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) end select end do end do @@ -212,60 +390,51 @@ subroutine AD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ErrMsg = '' select case (SrcMod%ID) - case (Module_ED) - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! T%ED%y%TowerLn2Mesh - DstMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, AD_rotor), & ! T%AD%Input(1)%rotors(1)%TowerMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%AD%Input(1)%rotors(1)%TowerMotion%Committed) - if (Failed()) return + case (Module_BD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! T%ED%y%HubPtMotion - DstMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! T%AD%Input(1)%rotors(1)%HubMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, SrcMod%Ins), & ! AD%u%rotors(1)%BladeMotion(SrcMod%Ins) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! T%ED%y%NacelleMotion - DstMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, AD_rotor), & ! T%AD%Input(1)%rotors(1)%NacelleMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%AD%Input(1)%rotors(1)%NacelleMotion%Committed) - if (Failed()) return + case (Module_ED) + + if (Turbine%p_FAST%CompElast == Module_ED) then + do i = 1, size(Turbine%ED%y%BladeLn2Mesh) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, i), & ! AD%u%rotors(1)%BladeMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + end if call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! T%ED%y%TFinCMMotion - DstMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! T%AD%Input(1)%rotors(1)%TFinMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%AD%Input(1)%rotors(1)%TFinMotion%Committed) - if (Failed()) return + SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, AD_rotor), & ! AD%u%rotors(1)%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return do i = 1, size(Turbine%ED%y%BladeRootMotion) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, i), & ! T%ED%y%BladeRootMotion(i) - DstMeshLoc=MeshLocType(AD_u_rotors_BladeRootMotion, AD_rotor, i), & ! T%AD%Input(1)%rotors(1)%BladeRootMotion(i) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstMeshLoc=MeshLocType(AD_u_rotors_BladeRootMotion, AD_rotor, i), & ! AD%u%rotors(1)%BladeRootMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do - if (Turbine%p_FAST%CompElast == Module_ED) then - do i = 1, size(Turbine%ED%y%BladeLn2Mesh) - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! T%ED%y%BladeLn2Mesh(i) - DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, i), & ! T%AD%Input(1)%rotors(1)%BladeMotion(i) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return - end do - end if + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! AD%u%rotors(1)%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - case (Module_BD) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, AD_rotor), & ! AD%u%rotors(1)%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion - DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, SrcMod%Ins), & ! AD%Input(1)%rotors(1)%BladeMotion(SrcMod%Ins) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + SrcMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + DstMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! AD%u%rotors(1)%TFinMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SrvD) @@ -296,26 +465,44 @@ subroutine BD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ErrMsg = '' select case (SrcMod%ID) + + case (Module_AD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, AD_rotor, DstMod%Ins), & ! AD%y%rotors(1)%BladeLoad(DstMod%Ins) + SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, DstMod%Ins), & ! AD%u%rotors(1)%BladeMotion(DstMod%Ins) + DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%u(DstMod%Ins)%DistrLoad + DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_ED) - call MapMotionMesh(Turbine, Mappings, & - SrcMod=SrcMod, SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, DstMod%Ins), & ! T%ED%y%BladeRootMotion(DstMod%Ins) - DstMod=DstMod, DstMeshLoc=MeshLocType(BD_u_RootMotion), & ! T%BD%Input(1, DstMod%Ins)%RootMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, DstMod%Ins), & ! ED%y%BladeRootMotion(DstMod%Ins) + DstMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%u(DstMod%Ins)%RootMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - case (Module_AD) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion + DstMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%Input(1, DstMod%Ins)%RootMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - call MapLoadMesh(Turbine, Mappings, & - SrcMod=SrcMod, SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, AD_rotor, DstMod%Ins), & ! T%AD%y%rotors(1)%BladeLoad(DstMod%Ins) - SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, DstMod%Ins), & ! AD%Input(1)%rotors(1)%BladeMotion(DstMod%Ins) - DstMod=DstMod, DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad - DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + case (Module_ExtLd) + + ! TODO + ! CALL MeshMapCreate( ExtLd%y%BladeLoad(K), BD%Input(1,k)%DistrLoad, MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) case (Module_SrvD) + do i = 1, Turbine%SrvD%p%NumBStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, DstMod%Ins), & ! SrvD%y%BStCLoadMesh(i, DstMod%Ins), & + SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, DstMod%Ins), & ! SrvD%u%BStCMotionMesh(i, DstMod%Ins) + DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad + DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + end select contains @@ -341,79 +528,126 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ErrMsg = '' select case (SrcMod%ID) - case (Module_BD) - - call MapLoadMesh(Turbine, Mappings, & - SrcMod=SrcMod, & - SrcMeshLoc=MeshLocType(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce - SrcDispMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%Input(1, SrcMod%Ins)%RootMotion - DstMod=DstMod, & - DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%Input(1)%HubPtLoad - DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return case (Module_AD) if (Turbine%p_FAST%CompElast == Module_ED) then do i = 1, size(Turbine%ED%Input(1)%BladePtLoads) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(), & ! AD%y%rotors(1)%BladeLoad(i) - SrcDispMeshLoc=MeshLocType(), & ! AD%Input(1)%rotors(1)%BladeMotion(i) - DstMeshLoc=MeshLocType(), & ! ED%Input(1)%BladePtLoads(i) - DstDispMeshLoc=MeshLocType(), & ! ED%y%BladeLn2Mesh(i) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + SrcMeshLoc=MeshLocType(), & ! AD%y%rotors(1)%BladeLoad(i) + SrcDispMeshLoc=MeshLocType(), & ! AD%u%rotors(1)%BladeMotion(i) + DstMeshLoc=MeshLocType(), & ! ED%u%BladePtLoads(i) + DstDispMeshLoc=MeshLocType(), & ! ED%y%BladeLn2Mesh(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do end if + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_HubLoad, AD_Rotor), & ! AD%y%rotors(1)%HubLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! AD%u%rotors(1)%HubMotion + DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_NacelleLoad, AD_Rotor), & ! AD%y%rotors(1)%NacelleLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, AD_rotor), & ! AD%u%rotors(1)%NacelleMotion + DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_TFinLoad, AD_Rotor), & ! AD%y%rotors(1)%TFinLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! AD%u%rotors(1)%TFinMotion + DstMeshLoc=MeshLocType(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads + DstDispMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(AD_y_rotors_TowerLoad, AD_Rotor), & ! AD%y%rotors(1)%TowerLoad SrcDispMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, AD_rotor), & ! AD%u%rotors(1)%TowerMotion DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerPtLoads DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%AD%y%rotors(1)%TowerLoad%committed) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_BD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_NacelleLoad, AD_Rotor), & ! AD%y%rotors(1)%NacelleLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, AD_rotor), & ! AD%Input(1)%rotors(1)%NacelleMotion - DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads - DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%AD%Input(1)%rotors(1)%NacelleMotion%committed) - if (Failed()) return + SrcMeshLoc=MeshLocType(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce + SrcDispMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%Input(1, SrcMod%Ins)%RootMotion + DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%Input(1)%HubPtLoad + DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_ExtLd) + + ! TODO + ! CALL MeshMapCreate( ExtLd%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) + ! CALL MeshMapCreate( ExtLd%y%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2 ) + + case (Module_ExtPtfm) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_HubLoad, AD_Rotor), & ! AD%y%rotors(1)%HubLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! AD%Input(1)%rotors(1)%HubMotion - DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%Input(1)%HubPtLoad - DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + SrcMeshLoc=MeshLocType(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh + SrcDispMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_FEAM) + + ! MeshMapCreate( FEAM%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + + case (Module_HD) + ! MeshMapCreate( HD%y%Morison%Mesh, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( HD%y%WAMITMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) + + case (Module_IceD) + ! MeshMapCreate( IceD%y(i)%PointMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) + + case (Module_IceF) + ! MeshMapCreate( IceF%y%iceMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) + + case (Module_MAP) + ! MeshMapCreate( MAPp%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + + case (Module_MD) + ! MeshMapCreate( MD%y%CoupledLoads(1), ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + + case (Module_Orca) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_TFinLoad, AD_Rotor), & ! AD%y%rotors(1)%TFinLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! AD%Input(1)%rotors(1)%TFinMotion - DstMeshLoc=MeshLocType(ED_u_TFinCMLoads), & ! ED%Input(1)%TFinCMLoads - DstDispMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%AD%Input(1)%rotors(1)%TFinMotion%committed) - if (Failed()) return + SrcMeshLoc=MeshLocType(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh + SrcDispMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(), & ! SD%y%Y1mesh, & - SrcDispMeshLoc=MeshLocType(), & ! SD%Input(1)%TPMesh - DstMeshLoc=MeshLocType(), & ! ED%Input(1)%PlatformPtMesh - DstDispMeshLoc=MeshLocType(), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + SrcMeshLoc=MeshLocType(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & + SrcDispMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%Input(1)%TPMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SrvD) + ! Blade Structural Controller (if ElastoDyn is used for blades) + if (Turbine%p_FAST%CompElast == Module_ED) then + do i = 1, Turbine%SrvD%p%NumBStC + do j = 1, Turbine%ED%p%NumBl + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + DstMeshLoc=MeshLocType(ED_u_BladePtLoads, j), & ! ED%Input(1)%BladePtLoads(j) + DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + end do + end if + ! Nacelle Structural Controller do j = 1, Turbine%SrvD%p%NumNStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -421,8 +655,7 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM SrcDispMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do ! Tower Structural Controller @@ -432,25 +665,9 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM SrcDispMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerLoads DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do - ! Blade Structural Controller (if ElastoDyn is used for blades) - if (Turbine%p_FAST%CompElast == Module_ED) then - do i = 1, Turbine%SrvD%p%NumBStC - do j = 1, Turbine%ED%p%NumBl - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) - DstMeshLoc=MeshLocType(ED_u_BladePtLoads, j), & ! ED%Input(1)%BladePtLoads(j) - DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return - end do - end do - end if - ! Substructure Structural Controller (if not using SubDyn) if (Turbine%p_FAST%CompSub /= Module_SD) then do j = 1, Turbine%SrvD%p%NumSStC @@ -459,8 +676,7 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do end if @@ -475,6 +691,111 @@ logical function Failed() end function end subroutine +subroutine ExtLd_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ExtLd_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! MeshMapCreate( AD%y%rotors(1)%BladeLoad(k), ExtLd%y%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2) + ! MeshMapCreate( AD%y%rotors(1)%TowerLoad, ExtLd%y%TowerLoadAD, MeshMapData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( BD%y(k)%BldMotion, ExtLd%u%BladeMotion(K), MeshMapData%BDED_L_2_ExtLd_P_B(K), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( ED%y%BladeLn2Mesh(K), ExtLd%u%BladeMotion(K), MeshMapData%BDED_L_2_ExtLd_P_B(K), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( ED%y%BladeRootMotion(K), ExtLd%u%BladeRootMotion(K), MeshMapData%ED_P_2_ExtLd_P_R(K), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( ED%y%HubPtMotion, ExtLd%u%HubMotion, MeshMapData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( ED%y%TowerLn2Mesh, ExtLd%u%TowerMotion, MeshMapData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2 ) + + select case (SrcMod%ID) + case (Module_ED) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine ExtPtfm_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ExtPtfm_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + if (Turbine%p_FAST%CompSub /= Module_SD) then + ! CALL MeshMapCreate( PlatformMotion, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + end if + + case (Module_SD) + + ! CALL MeshMapCreate( PlatformMotion, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FEAM_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FEAM_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + if (Turbine%p_FAST%CompSub /= Module_SD) then + ! CALL MeshMapCreate( SubstructureMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + end if + + case (Module_SD) + + ! CALL MeshMapCreate( SubstructureMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + subroutine HD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod @@ -494,44 +815,89 @@ subroutine HD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! T%ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_PRPMesh), & ! T%HD%Input(1)%PRPMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(HydroDyn_u_PRPMesh), & ! HD%Input(1)%PRPMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return ! If SubDyn is not active substructure motion/loads come from ElastoDyn if (Turbine%p_FAST%CompSub /= Module_SD) then call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%HD%y%WAMITMesh%Committed) - if (Failed()) return + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%HD%Input(1)%Morison%Mesh%Committed) - if (Failed()) return + DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end if case (Module_SD) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh - DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%HD%y%WAMITMesh%Committed) - if (Failed()) return + SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh - DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=Turbine%HD%Input(1)%Morison%Mesh%Committed) - if (Failed()) return + SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine IceD_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'IceD_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + select case (SrcMod%ID) + case (Module_ED) + ! TODO + ! CALL MeshMapCreate( SubstructureMotion, IceD%Input(1,i)%PointMesh, MeshMapData%SDy3_P_2_IceD_P(i), ErrStat2, ErrMsg2 ) + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine IceF_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'IceF_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + ! TODO + ! CALL MeshMapCreate( SubstructureMotion, IceF%Input(1)%iceMesh, MeshMapData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) end select contains @@ -548,10 +914,9 @@ subroutine IfW_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'BD_InitInputMappings' + character(*), parameter :: RoutineName = 'IfW_InitInputMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i ErrStat = ErrID_None ErrMsg = '' @@ -568,6 +933,117 @@ logical function Failed() end function end subroutine +subroutine MAP_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MAP_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + if (Turbine%p_FAST%CompSub /= Module_SD) then + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAPp%Input(1)%PtFairDisplacement + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end if + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAPp%Input(1)%PtFairDisplacement + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine MD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MD_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + if (Turbine%p_FAST%CompSub /= Module_SD) then + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%Input(1)%CoupledKinematics(1) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end if + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%Input(1)%CoupledKinematics(1) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine Orca_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Orca_InitInputMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%Input(1)%PtfmMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + subroutine SD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod @@ -586,11 +1062,22 @@ subroutine SD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM select case (SrcMod%ID) case (Module_ED) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! T%ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(SD_u_TPMesh), & ! T%SD%Input(1)%TPMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%Input(1)%TPMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_FEAM) + + ! MeshMapCreate( FEAM%y%PtFairleadLoad, SD%Input(1)%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( HD%y%Morison%Mesh, SD%Input(1)%LMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( HD%y%WAMITMesh, SD%Input(1)%LMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( IceD%y(i)%PointMesh, SD%Input(1)%LMesh, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( IceF%y%iceMesh, SD%Input(1)%LMesh, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( MAPp%y%PtFairleadLoad, SD%Input(1)%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( MD%y%CoupledLoads(1), SD%Input(1)%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( SrvD%y%SStCLoadMesh(j), SD%Input(1)%LMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2 ) case (Module_SrvD) @@ -601,8 +1088,7 @@ subroutine SD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%Input(1)%LMesh DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do end select @@ -629,6 +1115,13 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er ErrStat = ErrID_None ErrMsg = '' + ! MeshMapCreate( BD%y(k)%BldMotion, SrvD%Input(1)%BStCMotionMesh(K,j), MeshMapData%BD_L_2_BStC_P_B(K,j), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( ED%y%BladeLn2Mesh(K), SrvD%Input(1)%BStCMotionMesh(K,j), MeshMapData%ED_L_2_BStC_P_B(K,j), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( ED%y%NacelleMotion, SrvD%Input(1)%NStCMotionMesh(j), MeshMapData%ED_P_2_NStC_P_N(j), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( ED%y%TowerLn2Mesh, SrvD%Input(1)%TStCMotionMesh(j), MeshMapData%ED_L_2_TStC_P_T(j), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( PlatformMotion, SrvD%Input(1)%PtfmMotionMesh, MeshMapData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) + ! MeshMapCreate( SubStructureMotion, SrvD%Input(1)%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) + select case (SrcMod%ID) case (Module_BD) call NonMeshMap(Mappings, "BD Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) @@ -646,8 +1139,7 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion DstMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do ! Tower Structural Controller @@ -655,8 +1147,7 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion DstMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do ! Blade Structural Controller (if ElastoDyn is used for blades) @@ -666,8 +1157,7 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do end do end if @@ -678,8 +1168,7 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh DstMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do end if @@ -693,8 +1182,7 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh DstMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do end select @@ -723,6 +1211,7 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & type(TC_MappingType) :: Mapping type(MeshType), pointer :: SrcMesh, SrcDispMesh type(MeshType), pointer :: DstMesh, DstDispMesh + type(MeshType) :: DstMotionMesh ErrStat = ErrID_None ErrMsg = '' @@ -733,10 +1222,13 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & end if ! Get mesh pointers - SrcMesh => FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc) - SrcDispMesh => FAST_InputMeshPointer(SrcMod, Turbine, SrcDispMeshLoc, UseU=.false.) - DstMesh => FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, UseU=.false.) - DstDispMesh => FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc) + call FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(SrcMod, Turbine, SrcDispMeshLoc, .false., SrcDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + + ! If any meshes aren't commited, return + if (.not. (SrcMesh%committed .and. DstMesh%committed .and. SrcDispMesh%committed .and. DstDispMesh%committed)) return ! Check that all meshes in mapping have nonzero identifiers if (SrcMesh%ID == 0) then @@ -753,6 +1245,15 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & return end if + call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + + ! Create mapping description + Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))// & + " ["//trim(FAST_InputMeshName(SrcMod, SrcDispMeshLoc))//"] -> "// & + trim(FAST_InputMeshName(DstMod, DstMeshLoc))// & + " ["//trim(FAST_OutputMeshName(DstMod, DstDispMeshLoc))//"] (Load)" + ! Initialize mapping structure Mapping%MapType = Map_LoadMesh Mapping%SrcModIdx = SrcMod%Idx @@ -770,10 +1271,41 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return ! Create a copy of destination mesh in mapping for load summation - call MeshCopy(DstMesh, Mapping%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MeshCopy(DstMesh, Mapping%TmpLoadMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Get mapping indices for linearized mesh mapping - call InitMeshLinearization(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) + call InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) + + ! If the destination displacement mesh is not a sibling of the load mesh + Mapping%DstUsesSibling = IsSiblingMesh(DstMesh, DstDispMesh) + if (.not. Mapping%DstUsesSibling) then + + ! Print warning + call WrScr('Warning: load mesh transfer "'//trim(Mapping%Desc)//'" does not use sibling mesh') + + ! Create temporary motion mesh as cousin of load mesh, this will be used for an intermediate transfer + ! of the destination motion to the destination load locations + call MeshCopy(SrcMesh=DstMesh, & + DestMesh=Mapping%TmpMotionMesh, & + CtrlCode=MESH_COUSIN, & + IOS=COMPONENT_OUTPUT, & + TranslationDisp=.true., & + Orientation=.true., & + RotationVel=.true., & + TranslationVel=.true., & + RotationAcc=.true., & + TranslationAcc=.true., & + ErrStat=ErrStat2, & + ErrMess=ErrMsg2) + if (Failed()) return + + ! Determine transfer/linearization type for this auxiliary transfer + Mapping%XfrTypeAux = MeshTransferType(DstDispMesh, Mapping%TmpMotionMesh) + + ! Create motion mapping from destination displacement to temporary motion mesh + call MeshMapCreate(DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux, ErrStat2, ErrMsg2); if (Failed()) return + + end if ! Add mapping to array of mappings Mappings = [Mappings, Mapping] @@ -783,6 +1315,29 @@ logical function Failed() Failed = ErrStat2 >= AbortErrLev if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end function + + ! IsSiblingMesh returns true if MeshB is a sibling of MeshA + ! (can't just check pointers as they won't match after restart, + ! also there can only be one sibling mesh so doesn't work for cousins) + logical function IsSiblingMesh(MeshA, MeshB) + type(MeshType), intent(in) :: MeshA, MeshB + integer(IntKi) :: i, j + IsSiblingMesh = (MeshA%Nnodes == MeshB%Nnodes) + if (.not. IsSiblingMesh) return + IsSiblingMesh = IsSiblingMesh .and. & + all(MeshA%Position == MeshB%Position) .and. & + all(MeshA%RefOrientation == MeshB%RefOrientation) + do i = 1, NELEMKINDS + IsSiblingMesh = IsSiblingMesh .and. & + (MeshA%ElemTable(i)%nelem == MeshB%ElemTable(i)%nelem) .and. & + (MeshA%ElemTable(i)%XElement == MeshB%ElemTable(i)%XElement) + if (.not. IsSiblingMesh) return + do j = 1, MeshA%ElemTable(i)%nelem + IsSiblingMesh = IsSiblingMesh .and. all(MeshA%ElemTable(i)%Elements(j)%ElemNodes == & + MeshB%ElemTable(i)%Elements(j)%ElemNodes) + end do + end do + end function end subroutine subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshLoc, ErrStat, ErrMsg, Active) @@ -809,8 +1364,11 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL end if ! Get mesh pointers - SrcMesh => FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc) - DstMesh => FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, UseU=.false.) + call FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + + ! If source or destination meshes aren't commited, return + if (.not. (SrcMesh%committed .and. DstMesh%committed)) return ! Check that all meshes in mapping have nonzero identifiers if (SrcMesh%ID == 0) then @@ -821,6 +1379,10 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL return end if + ! Create mapping description + Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//" -> "// & + trim(FAST_InputMeshName(DstMod, DstMeshLoc))//" (Motion)" + ! Initialize mapping structure Mapping%MapType = Map_MotionMesh Mapping%SrcModIdx = SrcMod%Idx @@ -836,7 +1398,7 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return ! Get mapping indices for linearized mesh mapping - call InitMeshLinearization(Mapping, SrcMod, DstMod, SrcMesh, DstMesh) + call InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh) ! Add mapping to array of mappings Mappings = [Mappings, Mapping] @@ -848,11 +1410,10 @@ logical function Failed() end function end subroutine -subroutine NonMeshMap(Maps, Key, SrcMod, DstMod, i1, i2, Active) +subroutine NonMeshMap(Maps, Key, SrcMod, DstMod, Active) type(TC_MappingType), allocatable :: Maps(:) character(*), intent(in) :: Key type(ModDataType), intent(in) :: SrcMod, DstMod - integer(IntKi), optional, intent(in) :: i1, i2 logical, optional, intent(in) :: Active type(TC_MappingType) :: Mapping @@ -869,14 +1430,10 @@ subroutine NonMeshMap(Maps, Key, SrcMod, DstMod, i1, i2, Active) Mapping%DstModID = DstMod%ID Mapping%DstIns = DstMod%Ins - ! Get optional mapping indicies - if (present(i1)) Mapping%i1 = i1 - if (present(i2)) Mapping%i2 = i2 - Maps = [Maps, Mapping] end subroutine -subroutine InitMeshLinearization(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) +subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) type(TC_MappingType), intent(inout) :: Mapping type(ModDataType), intent(in) :: SrcMod, DstMod type(MeshType), intent(in) :: SrcMesh, DstMesh @@ -887,15 +1444,7 @@ subroutine InitMeshLinearization(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcD Mapping%DstMeshID = DstMesh%ID ! Determine transfer type - if ((SrcMesh%ElemTable(ELEMENT_POINT)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_POINT)%nelem > 0)) then - Mapping%XfrType = Xfr_Point_to_Point - else if ((SrcMesh%ElemTable(ELEMENT_POINT)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_LINE2)%nelem > 0)) then - Mapping%XfrType = Xfr_Point_to_Line2 - else if ((SrcMesh%ElemTable(ELEMENT_LINE2)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_POINT)%nelem > 0)) then - Mapping%XfrType = Xfr_Line2_to_Point - else if ((SrcMesh%ElemTable(ELEMENT_LINE2)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_LINE2)%nelem > 0)) then - Mapping%XfrType = Xfr_Line2_to_Line2 - end if + Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) ! Get data locations for variables of source mesh fields call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransDisp, SrcMod%iyg, Mapping%iLocSrcTransDisp) @@ -925,6 +1474,7 @@ subroutine InitMeshLinearization(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcD if (present(DstDispMesh)) then Mapping%DstDispMeshID = DstDispMesh%ID call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_TransDisp, DstMod%iyg, Mapping%iLocDstDispTransDisp) + call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_Orientation, DstMod%iyg, Mapping%iLocDstDispOrientation) end if contains @@ -947,6 +1497,22 @@ subroutine FindVarByMeshAndField(VarAry, MeshID, Field, iGbl, iLoc) end subroutine end subroutine +function MeshTransferType(SrcMesh, DstMesh) result(XfrType) + type(MeshType), intent(in) :: SrcMesh, DstMesh + integer(IntKi) :: XfrType + if ((SrcMesh%ElemTable(ELEMENT_POINT)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_POINT)%nelem > 0)) then + XfrType = Xfr_Point_to_Point + else if ((SrcMesh%ElemTable(ELEMENT_POINT)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_LINE2)%nelem > 0)) then + XfrType = Xfr_Point_to_Line2 + else if ((SrcMesh%ElemTable(ELEMENT_LINE2)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_POINT)%nelem > 0)) then + XfrType = Xfr_Line2_to_Point + else if ((SrcMesh%ElemTable(ELEMENT_LINE2)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_LINE2)%nelem > 0)) then + XfrType = Xfr_Line2_to_Line2 + else + XfrType = Xfr_Invalid + end if +end function + subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, ErrMsg, dUdu, dUdy) type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type type(ModDataType), intent(in) :: Mods(:) !< Module data @@ -981,51 +1547,38 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er case (Map_MotionMesh) ! Get source and destination meshes - SrcMesh => FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc) - DstMesh => FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU=.false.) + call FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Perform linearization based on transfer type - select case (Mapping%XfrType) - case (Xfr_Point_to_Point) - call Linearize_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) - case (Xfr_Point_to_Line2) - call Linearize_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) - case (Xfr_Line2_to_Point) - call Linearize_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) - case (Xfr_Line2_to_Line2) - call Linearize_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) - end select + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap); if (Failed()) return case (Map_LoadMesh) ! Get source and destination meshes - SrcMesh => FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc) - DstMesh => FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU=.false.) + call FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Get source and destination displacement meshes - SrcDispMesh => FAST_InputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcDispMeshLoc, UseU=.false.) - DstDispMesh => FAST_OutputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstDispMeshLoc) + call FAST_InputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcDispMeshLoc, .false., SrcDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - ! Perform linearization based on transfer type - select case (Mapping%XfrType) - case (Xfr_Point_to_Point) - call Linearize_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) - case (Xfr_Point_to_Line2) - call Linearize_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) - case (Xfr_Line2_to_Point) - call Linearize_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) - case (Xfr_Line2_to_Line2) - call Linearize_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) - end select + ! If DstDispMesh is a sibling of DstMesh + if (Mapping%DstUsesSibling) then - end select + ! Linearize the load mesh transfer + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh); if (Failed()) return - write (*, *) trim(FAST_OutputMeshName(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc)), " -> ", & - FAST_InputMeshName(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc) + else - ! Check for errors - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + ! Linearize the motion mesh transfer + call LinearizeMeshTransfer(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return + + ! Linearize the load mesh transfer + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh); if (Failed()) return + end if + + end select ! Copy linearization matrices to global dUdu matrix if (present(dUdu)) then @@ -1042,26 +1595,41 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er end do contains + + subroutine LinearizeMeshTransfer(Typ, Src, Dst, MMap, SrcDisp, DstDisp) + integer(IntKi), intent(in) :: Typ + type(MeshType), intent(in) :: Src, Dst + type(MeshMapType), intent(inout) :: MMap + type(MeshType), optional, intent(in) :: SrcDisp, DstDisp + select case (Typ) + case (Xfr_Point_to_Point) + call Linearize_Point_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Point_to_Line2) + call Linearize_Point_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Line2_to_Point) + call Linearize_Line2_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Line2_to_Line2) + call Linearize_Line2_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + end select + end subroutine + subroutine dUduSetBlocks(Mapping, dM) type(TC_MappingType), intent(inout) :: Mapping !< Mapping type(MeshMapLinearizationType), intent(in) :: dM !< Mesh Map Linearization data ! Effect of input Translation Velocity on input Translation Displacement if (allocated(dM%tv_uD)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%tv_uD, dUdu) - call SetBlock(Mapping%iLocDstTransVel, Mapping%iLocDstTransDisp, -dM%tv_uD, dUdU) + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocDstTransDisp, dM%tv_uD, dUdU) end if ! Effect of input Translation Acceleration on input Translation Displacement if (allocated(dM%ta_uD)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%ta_uD, dUdu) - call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocDstTransDisp, -dM%ta_uD, dUdU) + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocDstTransDisp, dM%ta_uD, dUdU) end if ! Effect of input Moments on input Translation Displacement if (allocated(dM%M_uS)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%u([M%SrcDispVarIdx]), VF_TransDisp, -MML%M_uS, dUdu) - call SetBlock(Mapping%iLocDstMoment, Mapping%iLocSrcDispTransDisp, -dM%M_uS, dUdU) + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcDispTransDisp, dM%M_uS, dUdU) end if end subroutine @@ -1071,83 +1639,79 @@ subroutine dUdySetBlocks(Mapping, dM) ! Load identity if (allocated(dM%li)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Force, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%li, dUdy) - call SetBlock(Mapping%iLocDstForce, Mapping%iLocSrcForce, -dM%li, dUdy) - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Moment, -MML%li, dUdy) - call SetBlock(Mapping%iLocDstMoment, Mapping%iLocSrcMoment, -dM%li, dUdy) + call SumBlock(Mapping%iLocDstForce, Mapping%iLocSrcForce, dM%li, dUdy) + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcMoment, dM%li, dUdy) end if ! Moment to Force if (allocated(dM%m_f)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%m_f, dUdy) - call SetBlock(Mapping%iLocDstMoment, Mapping%iLocSrcForce, -dM%m_f, dUdy) + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcForce, dM%m_f, dUdy) end if ! Moment to destination translation displacement if (allocated(dM%m_uD)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, DstMod%Vars%y([M%DstDispVarIdx]), VF_TransDisp, -MML%m_uD, dUdy) - call SetBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, -dM%m_uD, dUdy) + if (Mapping%DstUsesSibling) then + ! Direct transfer + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, dM%m_uD, dUdy) + else + ! Compose linearization of motion and loads + Mapping%TmpMatrix = matmul(dM%m_uD, Mapping%MeshMapAux%dM%mi) + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, Mapping%TmpMatrix, dUdy) + Mapping%TmpMatrix = matmul(dM%m_uD, Mapping%MeshMapAux%dM%fx_p) + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispOrientation, Mapping%TmpMatrix, dUdy) + end if end if ! Motion identity if (allocated(dM%mi)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%mi, dUdy) - call SetBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcTransDisp, -dM%mi, dUdy) - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Orientation, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%mi, dUdy) - call SetBlock(Mapping%iLocDstOrientation, Mapping%iLocSrcOrientation, -dM%mi, dUdy) - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransVel, -MML%mi, dUdy) - call SetBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransVel, -dM%mi, dUdy) - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%mi, dUdy) - call SetBlock(Mapping%iLocDstAngularVel, Mapping%iLocSrcAngularVel, -dM%mi, dUdy) - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransAcc, -MML%mi, dUdy) - call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransAcc, -dM%mi, dUdy) - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%mi, dUdy) - call SetBlock(Mapping%iLocDstAngularAcc, Mapping%iLocSrcAngularAcc, -dM%mi, dUdy) + call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcTransDisp, dM%mi, dUdy) + call SumBlock(Mapping%iLocDstOrientation, Mapping%iLocSrcOrientation, dM%mi, dUdy) + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransVel, dM%mi, dUdy) + call SumBlock(Mapping%iLocDstAngularVel, Mapping%iLocSrcAngularVel, dM%mi, dUdy) + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransAcc, dM%mi, dUdy) + call SumBlock(Mapping%iLocDstAngularAcc, Mapping%iLocSrcAngularAcc, dM%mi, dUdy) end if ! Translation to Rotation if (allocated(dM%fx_p)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%fx_p, dUdy) - call SetBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcOrientation, -dM%fx_p, dUdy) - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%fx_p, dUdy) - call SetBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcAngularVel, -dM%fx_p, dUdy) - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%fx_p, dUdy) - call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularAcc, -dM%fx_p, dUdy) + call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcOrientation, dM%fx_p, dUdy) + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcAngularVel, dM%fx_p, dUdy) + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularAcc, dM%fx_p, dUdy) end if ! Translation velocity to translation displacement if (allocated(dM%tv_us)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%tv_us, dUdy) - call SetBlock(Mapping%iLocDstTransVel, Mapping%iLocDstDispTransDisp, -dM%tv_us, dUdy) + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocDstDispTransDisp, dM%tv_us, dUdy) end if ! Translation acceleration to translation displacement if (allocated(dM%ta_us)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%ta_us, dUdy) - call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransDisp, -dM%ta_us, dUdy) + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransDisp, dM%ta_us, dUdy) end if ! Translation acceleration to angular velocity if (allocated(dM%ta_rv)) then - ! call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%ta_rv, dUdy) - call SetBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularVel, -dM%ta_rv, dUdy) + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularVel, dM%ta_rv, dUdy) end if end subroutine - subroutine SetBlock(iLocRow, iLocCol, SrcM, DstM) + subroutine SumBlock(iLocRow, iLocCol, SrcM, DstM) integer(IntKi), intent(in) :: iLocRow(2), iLocCol(2) real(R8Ki), intent(in) :: SrcM(:, :) real(R8Ki), intent(inout) :: DstM(:, :) if (iLocRow(1) > 0 .and. iLocCol(1) > 0) then - associate (DstSubM => DstM(iLocRow(1):iLocRow(1)+size(SrcM,1)-1, iLocCol(1):iLocCol(1)+size(SrcM,2)-1)) - ! associate (DstSubM => DstM(iLocRow(1):iLocRow(2), iLocCol(1):iLocCol(2))) - ! if ((size(SrcM, 1) /= (iLocRow(2) - iLocRow(1) + 1)) .or. (size(SrcM, 2) /= (iLocCol(2) - iLocCol(1)) + 1)) then - ! print *, "hello" - ! end if - DstSubM = DstSubM + SrcM + ! Subtracts the source matrix from the destination sub-matrix + associate (DstSubM => DstM(iLocRow(1):iLocRow(2), iLocCol(1):iLocCol(2))) + DstSubM = DstSubM - SrcM end associate end if + end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function end subroutine subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) @@ -1182,8 +1746,8 @@ subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) case (Map_MotionMesh) ! Get source and destination meshes - SrcMesh => FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc) - DstMesh => FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU) + call FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU, DstMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Perform linearization based on transfer type select case (Mapping%XfrType) @@ -1201,12 +1765,12 @@ subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) case (Map_LoadMesh) ! Get source and destination meshes - SrcMesh => FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc) - DstMesh => FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU) + call FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU, DstMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Get source and destination displacement meshes - SrcDispMesh => FAST_InputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcDispMeshLoc, UseU) - DstDispMesh => FAST_OutputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstDispMeshLoc) + call FAST_InputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcDispMeshLoc, UseU, SrcDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Perform linearization based on transfer type select case (Mapping%XfrType) @@ -1379,7 +1943,7 @@ subroutine FAST_ResetRemapFlags(Mods, Maps, T, ErrStat, ErrMsg) ! Reset remap flags in mapping temporary meshes do i = 1, size(Maps) - if (associated(Maps(i)%MeshTmp%RemapFlag)) Maps(i)%MeshTmp%RemapFlag = .false. + if (associated(Maps(i)%TmpLoadMesh%RemapFlag)) Maps(i)%TmpLoadMesh%RemapFlag = .false. end do do i = 1, size(Mods) From 69cdcc905c88427e3b223e2e4b277248b4418add Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 21:21:43 +0000 Subject: [PATCH 071/319] Fixing types for single-precision compile --- modules/hydrodyn/src/HydroDyn.f90 | 2 +- modules/servodyn/src/ServoDyn.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 6c3727c730..214ee4488f 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -1000,7 +1000,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E !---------------------------------------------------------------------------- ! Translation and rotation perturbations - PerturbTrans = 0.02_R8Ki*D2R * max(p%WaveField%EffWtrDpth, 1.0_R8Ki) + PerturbTrans = 0.02_R8Ki*D2R * max(real(p%WaveField%EffWtrDpth, R8Ki), 1.0_R8Ki) PerturbRot = 2*D2R ! Create perturbation array (order based on MotionFields) diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 07e7b63bd0..62fe316d6a 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -668,7 +668,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er !---------------------------------------------------------------------------- ! Calculate perturbations - xPerturb = 0.2_R8Ki*Pi/180.0_R8Ki * max(TwoNorm(InitInp%NacRefPos - InitInp%TwrBaseRefPos), 1.0_R8Ki) + xPerturb = 0.2_R8Ki*Pi/180.0_R8Ki * max(real(TwoNorm(InitInp%NacRefPos - InitInp%TwrBaseRefPos), R8Ki), 1.0_R8Ki) ! Blade Structural Controller do i = 1, p%NumBStC From 613c5c0dccb371c5f107303b3214b80b44b17ef5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Feb 2024 22:07:30 +0000 Subject: [PATCH 072/319] Update simulink CMakeLists with new FAST modules --- glue-codes/simulink/CMakeLists.txt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index b2b495ec40..e29d307999 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -54,10 +54,12 @@ matlab_add_mex( SRC src/FAST_SFunc.c ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Subs.f90 - ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Lin.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mods.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Solver.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Library.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Funcs.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModLin.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mesh.f90 LINK_TO ${MEX_LIBS} ${MEX_LIBS} # DO NOT REMOVE (needed to ensure no unresolved symbols) From 69e4fb92fb389f89175421186d045ccdcebb0599 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Feb 2024 22:48:25 +0000 Subject: [PATCH 073/319] Added HD mappings in FAST_Mesh.f90 --- modules/openfast-library/src/FAST_Mesh.f90 | 219 ++++++++++++++------- 1 file changed, 148 insertions(+), 71 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mesh.f90 b/modules/openfast-library/src/FAST_Mesh.f90 index 7584887a1f..7079ed8422 100644 --- a/modules/openfast-library/src/FAST_Mesh.f90 +++ b/modules/openfast-library/src/FAST_Mesh.f90 @@ -334,12 +334,32 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) call BD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_ED) call ED_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_ExtInfw) + ! call ExtInfw_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_ExtLd) + call ExtLd_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_ExtPtfm) + call ExtPtfm_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_FEAM) + call FEAM_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_HD) call HD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_IceD) + call IceD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_IceF) + call IceF_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_IfW) call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_MAP) + call MAP_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_MD) + call MD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_Orca) + call Orca_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_SD) - call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call SD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + case (Module_SeaSt) + ! call SeaSt_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) case (Module_SrvD) call SrvD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) end select @@ -364,6 +384,8 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) SrcMod%SrcMaps = [SrcMod%SrcMaps, iMap] DstMod%DstMaps = [DstMod%DstMaps, iMap] + write (*, *) Mappings(iMap)%Desc + end associate end do @@ -531,17 +553,6 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_AD) - if (Turbine%p_FAST%CompElast == Module_ED) then - do i = 1, size(Turbine%ED%Input(1)%BladePtLoads) - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(), & ! AD%y%rotors(1)%BladeLoad(i) - SrcDispMeshLoc=MeshLocType(), & ! AD%u%rotors(1)%BladeMotion(i) - DstMeshLoc=MeshLocType(), & ! ED%u%BladePtLoads(i) - DstDispMeshLoc=MeshLocType(), & ! ED%y%BladeLn2Mesh(i) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - end if - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(AD_y_rotors_HubLoad, AD_Rotor), & ! AD%y%rotors(1)%HubLoad SrcDispMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! AD%u%rotors(1)%HubMotion @@ -582,60 +593,71 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_ExtLd) ! TODO - ! CALL MeshMapCreate( ExtLd%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) ! CALL MeshMapCreate( ExtLd%y%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2 ) - case (Module_ExtPtfm) + case (Module_SD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh - SrcDispMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + SrcMeshLoc=MeshLocType(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & + SrcDispMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%Input(1)%TPMesh DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - case (Module_FEAM) + case (Module_SrvD) - ! MeshMapCreate( FEAM%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + ! Nacelle Structural Controller + do j = 1, Turbine%SrvD%p%NumNStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads + DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do - case (Module_HD) - ! MeshMapCreate( HD%y%Morison%Mesh, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( HD%y%WAMITMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) + ! Tower Structural Controller + do j = 1, Turbine%SrvD%p%NumTStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerLoads + DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do - case (Module_IceD) - ! MeshMapCreate( IceD%y(i)%PointMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) + call NonMeshMap(Mappings, "SrvD Data -> ED Data", SrcMod=SrcMod, DstMod=DstMod) ! TODO - case (Module_IceF) - ! MeshMapCreate( IceF%y%iceMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) + end select - case (Module_MAP) - ! MeshMapCreate( MAPp%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + !---------------------------------------------------------------------------- + ! ElastoDyn Blades + !---------------------------------------------------------------------------- - case (Module_MD) - ! MeshMapCreate( MD%y%CoupledLoads(1), ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + ! If ElastoDyn is calculating blade motion + if (Turbine%p_FAST%CompElast == Module_ED) then - case (Module_Orca) + select case (SrcMod%ID) - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh - SrcDispMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_AD) - case (Module_SD) + do i = 1, size(Turbine%ED%Input(1)%BladePtLoads) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(), & ! AD%y%rotors(1)%BladeLoad(i) + SrcDispMeshLoc=MeshLocType(), & ! AD%u%rotors(1)%BladeMotion(i) + DstMeshLoc=MeshLocType(), & ! ED%u%BladePtLoads(i) + DstDispMeshLoc=MeshLocType(), & ! ED%y%BladeLn2Mesh(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & - SrcDispMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%Input(1)%TPMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_ExtLd) - case (Module_SrvD) + ! TODO + ! CALL MeshMapCreate( ExtLd%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) - ! Blade Structural Controller (if ElastoDyn is used for blades) - if (Turbine%p_FAST%CompElast == Module_ED) then + case (Module_SrvD) + + ! Blade Structural Controller (if ElastoDyn is used for blades) do i = 1, Turbine%SrvD%p%NumBStC do j = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -646,30 +668,86 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do end do - end if - ! Nacelle Structural Controller - do j = 1, Turbine%SrvD%p%NumNStC + end select + end if + + !---------------------------------------------------------------------------- + ! Substructure and Platform + !---------------------------------------------------------------------------- + + ! If SubDyn is not active map following modules to ElastoDyn + if (Turbine%p_FAST%CompSub /= Module_SD) then + + select case (SrcMod%ID) + + case (Module_ExtPtfm) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads - DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + SrcMeshLoc=MeshLocType(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh + SrcDispMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - ! Tower Structural Controller - do j = 1, Turbine%SrvD%p%NumTStC + case (Module_FEAM) + + ! MeshMapCreate( FEAM%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + + case (Module_HD) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerLoads - DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + SrcMeshLoc=MeshLocType(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - ! Substructure Structural Controller (if not using SubDyn) - if (Turbine%p_FAST%CompSub /= Module_SD) then + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_IceD) + + ! MeshMapCreate( IceD%y(i)%PointMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) + + case (Module_IceF) + + ! MeshMapCreate( IceF%y%iceMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) + + case (Module_MAP) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_MD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_Orca) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh + SrcDispMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SrvD) + + ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & @@ -678,11 +756,9 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do - end if - - call NonMeshMap(Mappings, "SrvD Data -> ED Data", SrcMod=SrcMod, DstMod=DstMod) ! TODO - end select + end select + end if contains logical function Failed() @@ -1249,10 +1325,10 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & call FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Create mapping description - Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))// & - " ["//trim(FAST_InputMeshName(SrcMod, SrcDispMeshLoc))//"] -> "// & + Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//" -> "// & trim(FAST_InputMeshName(DstMod, DstMeshLoc))// & - " ["//trim(FAST_OutputMeshName(DstMod, DstDispMeshLoc))//"] (Load)" + " ["//trim(FAST_InputMeshName(SrcMod, SrcDispMeshLoc))// & + " -> "//trim(FAST_OutputMeshName(DstMod, DstDispMeshLoc))//"]" ! Initialize mapping structure Mapping%MapType = Map_LoadMesh @@ -1381,7 +1457,7 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL ! Create mapping description Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//" -> "// & - trim(FAST_InputMeshName(DstMod, DstMeshLoc))//" (Motion)" + trim(FAST_InputMeshName(DstMod, DstMeshLoc)) ! Initialize mapping structure Mapping%MapType = Map_MotionMesh @@ -1422,6 +1498,7 @@ subroutine NonMeshMap(Maps, Key, SrcMod, DstMod, Active) end if ! Initialize mapping structure + Mapping%Desc = Key Mapping%MapType = Map_NonMesh Mapping%SrcModIdx = SrcMod%Idx Mapping%SrcModID = SrcMod%ID From a11ceb37a5a966a6660e35856756723447540e68 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Feb 2024 22:48:58 +0000 Subject: [PATCH 074/319] Fix bug in map.f90 jacobian routine --- modules/map/src/map.f90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index c051dd75fd..940a91cf56 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -766,8 +766,8 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ! Write outputs call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & VarIdx=p%iVarWriteOutput, & - Num=p%numOuts,& Flags=VF_WriteOut, & + Num=p%numOuts,& LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) !------------------------------------------------------------------------- @@ -1396,7 +1396,7 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err end if ! Make a copy of the inputs to perturb - call map_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call MAP_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2) call MAP_PackInputValues(p, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: @@ -1419,7 +1419,7 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call MAP_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) - call MAP_CopyConstrState(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MAP_CopyConstrState(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate absolute position of each node m%u_perturb%X = m%u_perturb%PtFairDisplacement%Position(1,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(1,:) @@ -1448,7 +1448,7 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call MAP_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) - call MAP_CopyConstrState(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MAP_CopyConstrState(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate absolute position of each node m%u_perturb%X = m%u_perturb%PtFairDisplacement%Position(1,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(1,:) @@ -1457,22 +1457,22 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err ! compute constraint state for u_op - delta u call MSQS_UpdateStates( time, & - interval, & - m%u_perturb%C_obj, & - p%C_obj, & - x%C_obj, & - xd%C_obj, & - m%z_lin%C_obj, & - OtherState%C_obj, & - status_from_MAP, & - message_from_MAP ) + interval, & + m%u_perturb%C_obj, & + p%C_obj, & + x%C_obj, & + xd%C_obj, & + m%z_lin%C_obj, & + OtherState%C_obj, & + status_from_MAP, & + message_from_MAP) call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2); if (Failed()) return ! compute y at u_op - delta u ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2 ); if (Failed()) return - call MAP_PackOutputValues(p, y, m%Jac%y_pos, IsFullLin) + call MAP_PackOutputValues(p, y, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 From 51d77a8c66c490a11e6f802060759a7bc4ca7c8d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Feb 2024 22:49:36 +0000 Subject: [PATCH 075/319] Add guard on HD WAMITObj when creating vars --- modules/hydrodyn/src/HydroDyn.f90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 214ee4488f..3b66859594 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -978,6 +978,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E ! Get excitation do k = 1, p%nWAMITObj + if (p%WAMIT(k)%SS_Exctn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", VF_Scalar, & Flags=VF_DerivOrder1, & @@ -987,6 +988,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E end do do k = 1, p%nWAMITObj + if (p%WAMIT(k)%SS_Rdtn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", VF_Scalar, & Flags=VF_DerivOrder1, & @@ -1037,15 +1039,11 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E call MV_AddMeshVar(p%Vars%y, "WAMITLoads", LoadFields, y%WAMITMesh, VarIdx=p%iVarWAMITLoadMesh) - if (p%NumTotalOuts > 0) then - p%iVarWriteOut = size(p%Vars%y) + 1 - call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & - Flags=VF_WriteOut, & - Num=p%NumTotalOuts, & - LinNames=[(trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)), i = 1, p%NumTotalOuts)]) - else - p%iVarWriteOut = 0 - end if + call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + VarIdx=p%iVarWriteOut, & + Flags=VF_WriteOut, & + Num=p%NumTotalOuts, & + LinNames=[(WriteOutputLinName(i), i = 1, p%NumTotalOuts)]) !---------------------------------------------------------------------------- ! Initialize Variables and Jacobian data @@ -1059,6 +1057,10 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E call HydroDyn_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev From fb9ab9c4017468e5897aa45f3c0007a7ed91c1cb Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Feb 2024 22:54:04 +0000 Subject: [PATCH 076/319] Add iVar guards on ModVar pack/unpack routines --- modules/nwtc-library/src/ModVar.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 8309f1acf2..4563ae34bb 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -352,6 +352,7 @@ subroutine MV_PackVarRank1R4(VarAry, iVar, Vals, Ary) integer(IntKi), intent(in) :: iVar real(R4Ki), intent(in) :: Vals(:) real(R8Ki), intent(inout) :: Ary(:) + if (iVar == 0) return associate (iLoc => VarAry(iVar)%iLoc) Ary(iLoc(1):iLoc(2)) = real(Vals, R8Ki) end associate @@ -395,6 +396,7 @@ subroutine MV_UnpackVarRank0R4(VarAry, iVar, Ary, Val) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Ary(:) real(R4Ki), intent(inout) :: Val + if (iVar == 0) return Val = Ary(VarAry(iVar)%iLoc(1)) end subroutine @@ -403,6 +405,7 @@ subroutine MV_UnpackVarRank0R8(VarAry, iVar, Ary, Vals) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Ary(:) real(R8Ki), intent(inout) :: Vals + if (iVar == 0) return Vals = Ary(VarAry(iVar)%iLoc(1)) end subroutine @@ -493,6 +496,7 @@ subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) real(R8Ki), intent(in) :: Values(:) type(MeshType), intent(inout) :: Mesh integer(IntKi) :: MeshID, i, j + if (iVar == 0) return MeshID = VarAry(iVar)%MeshID do i = iVar, size(VarAry) if (VarAry(i)%MeshID /= MeshID) exit From b0614cb53105712bc04489971ca99b50afd2af22 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Feb 2024 22:54:25 +0000 Subject: [PATCH 077/319] Fix variable linearization names in ServoDyn.f90 --- modules/servodyn/src/ServoDyn.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 62fe316d6a..f75993d7f3 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -716,11 +716,11 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er uPerturbAng = 0.2_R8Ki * Pi_R8 / 180.0_R8Ki uPerturbs = [uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng] - call MV_AddVar(p%Vars%u, "Yaw", VF_Scalar, LinNames=['Yaw, Nm']) + call MV_AddVar(p%Vars%u, "Yaw", VF_Scalar, LinNames=['Yaw, rad']) - call MV_AddVar(p%Vars%u, "YawRate", VF_Scalar, LinNames=['YawRate, Nm']) + call MV_AddVar(p%Vars%u, "YawRate", VF_Scalar, LinNames=['YawRate, rad/s']) - call MV_AddVar(p%Vars%u, "HSS_Spd", VF_Scalar, LinNames=['HSS_Spd, W']) + call MV_AddVar(p%Vars%u, "HSS_Spd", VF_Scalar, LinNames=['HSS_Spd, rad/s']) ! Structural controllers do i = 1, p%NumBStC From 13e641b076e85ea2025c1b79de1547dd12306f24 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 16 Feb 2024 15:41:47 +0000 Subject: [PATCH 078/319] Rename FAST_Mesh.f90 to FAST_Mapping.f90 --- glue-codes/simulink/CMakeLists.txt | 2 +- modules/openfast-library/CMakeLists.txt | 2 +- .../openfast-library/src/{FAST_Mesh.f90 => FAST_Mapping.f90} | 2 +- modules/openfast-library/src/FAST_ModLin.f90 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) rename modules/openfast-library/src/{FAST_Mesh.f90 => FAST_Mapping.f90} (99%) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index e29d307999..737a995450 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -59,7 +59,7 @@ matlab_add_mex( ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Library.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Funcs.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModLin.f90 - ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mesh.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mapping.f90 LINK_TO ${MEX_LIBS} ${MEX_LIBS} # DO NOT REMOVE (needed to ensure no unresolved symbols) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 2777a87a54..1fc6d37923 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -74,7 +74,7 @@ add_library(openfast_postlib STATIC src/FAST_Funcs.f90 src/FAST_ModLin.f90 - src/FAST_Mesh.f90 + src/FAST_Mapping.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC diff --git a/modules/openfast-library/src/FAST_Mesh.f90 b/modules/openfast-library/src/FAST_Mapping.f90 similarity index 99% rename from modules/openfast-library/src/FAST_Mesh.f90 rename to modules/openfast-library/src/FAST_Mapping.f90 index 7079ed8422..9a5d8efd6a 100644 --- a/modules/openfast-library/src/FAST_Mesh.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1,4 +1,4 @@ -module FAST_Mesh +module FAST_Mapping use FAST_ModTypes diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModLin.f90 index a32ab7b83f..3d6620d8cb 100644 --- a/modules/openfast-library/src/FAST_ModLin.f90 +++ b/modules/openfast-library/src/FAST_ModLin.f90 @@ -25,7 +25,7 @@ module FAST_ModLin use FAST_Types use FAST_Funcs -use FAST_Mesh +use FAST_Mapping implicit none From cf7fa65e6b7147ce8d5b649e00f9e2bf22f43cb5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 16 Feb 2024 17:56:32 +0000 Subject: [PATCH 079/319] Added mapping for non-mesh variables in FAST_Mapping This adds the appropriate mappings between ServoDyn and ElastoDyn which were previously missing and applies values in linearization --- modules/openfast-library/src/FAST_Mapping.f90 | 144 ++++++++++++++---- .../openfast-library/src/FAST_Registry.txt | 4 +- modules/openfast-library/src/FAST_Types.f90 | 10 +- modules/servodyn/src/ServoDyn.f90 | 23 +-- modules/servodyn/src/ServoDyn_Registry.txt | 7 + modules/servodyn/src/ServoDyn_Types.f90 | 28 ++++ 6 files changed, 171 insertions(+), 45 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 9a5d8efd6a..edbe4140cb 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1,5 +1,6 @@ module FAST_Mapping +use FAST_Types use FAST_ModTypes implicit none @@ -329,40 +330,41 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) ! Switch by destination module (inputs) select case (Mods(IModDst)%ID) case (Module_AD) - call AD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call AD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_BD) - call BD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call BD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ED) - call ED_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call ED_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtInfw) - ! call ExtInfw_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + ! call ExtInfw_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtLd) - call ExtLd_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call ExtLd_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtPtfm) - call ExtPtfm_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call ExtPtfm_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_FEAM) - call FEAM_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call FEAM_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_HD) - call HD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call HD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IceD) - call IceD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call IceD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IceF) - call IceF_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call IceF_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IfW) - call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_MAP) - call MAP_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call MAP_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_MD) - call MD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call MD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_Orca) - call Orca_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call Orca_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SD) - call SD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call SD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SeaSt) - ! call SeaSt_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + ! call SeaSt_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SrvD) - call SrvD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat, ErrMsg) + call SrvD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) end select + if (Failed()) return end do end do @@ -373,7 +375,7 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) ! Reorder the mappings so that motion maps come before the load maps Mappings = [pack(Mappings, Mappings%MapType == Map_MotionMesh), & pack(Mappings, Mappings%MapType == Map_LoadMesh), & - pack(Mappings, Mappings%MapType == Map_NonMesh)] + pack(Mappings, Mappings%MapType == Map_Variable)] ! Loop through mappings do iMap = 1, size(Mappings) @@ -460,7 +462,7 @@ subroutine AD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_SrvD) - call NonMeshMap(Mappings, Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=SrcMod, DstMod=DstMod) + ! call MapVariable(Mappings, Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=SrcMod, DstMod=DstMod) end select @@ -626,7 +628,20 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do - call NonMeshMap(Mappings, "SrvD Data -> ED Data", SrcMod=SrcMod, DstMod=DstMod) ! TODO + call MapVariable(Mappings, "SrvD BlPitchCom -> ED BlPitchCom", & + SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarBlPitchCom, & + DstMod=DstMod, iVarDst=Turbine%ED%p%iVarBlPitchCom, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapVariable(Mappings, "SrvD YawMom -> ED YawMom", & + SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarYawMom, & + DstMod=DstMod, iVarDst=Turbine%ED%p%iVarYawMom, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapVariable(Mappings, "SrvD GenTrq -> ED GenTrq", & + SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarGenTrq, & + DstMod=DstMod, iVarDst=Turbine%ED%p%iVarGenTrq, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -999,7 +1014,10 @@ subroutine IfW_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) select case (SrcMod%ID) case (Module_ED) - call NonMeshMap(Mappings, "ED HubMotion -> IfW HubMotion", SrcMod=SrcMod, DstMod=DstMod) + + ! TODO + ! call MapVariable(Mappings, "ED HubMotion -> IfW HubMotion", SrcMod=SrcMod, DstMod=DstMod) + end select contains @@ -1200,14 +1218,16 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er select case (SrcMod%ID) case (Module_BD) - call NonMeshMap(Mappings, "BD Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) - call NonMeshMap(Mappings, "BD RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) + + ! TODO + ! call MapVariable(Mappings, "BD Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) + ! call MapVariable(Mappings, "BD RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) case (Module_ED) - call NonMeshMap(Mappings, "ED Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) if (Turbine%p_FAST%CompElast == Module_ED) then - call NonMeshMap(Mappings, "ED RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) + ! TODO + ! call MapVariable(Mappings, "ED RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) end if ! Nacelle Structural Controller @@ -1248,8 +1268,30 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er end do end if + call MapVariable(Mappings, "ED Yaw -> SrvD Yaw", & + SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarYaw, & + DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarYaw, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapVariable(Mappings, "ED YawRate -> SrvD YawRate", & + SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarYawRate, & + DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarYawRate, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & + SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarHSS_Spd, & + DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarHSS_Spd, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & + SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarHSS_Spd, & + DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarHSS_Spd, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_IfW) - call NonMeshMap(Mappings, "IfW Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) + + ! TODO + ! call MapVariable(Mappings, "IfW Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) case (Module_SD) @@ -1486,26 +1528,52 @@ logical function Failed() end function end subroutine -subroutine NonMeshMap(Maps, Key, SrcMod, DstMod, Active) +subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, ErrMsg, Active) type(TC_MappingType), allocatable :: Maps(:) character(*), intent(in) :: Key type(ModDataType), intent(in) :: SrcMod, DstMod + integer(IntKi), intent(in) :: iVarSrc, iVarDst + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg logical, optional, intent(in) :: Active type(TC_MappingType) :: Mapping + ErrStat = ErrID_None + ErrMsg = '' + if (present(Active)) then if (.not. Active) return end if + ! If either variable index is zero, return error + if (iVarSrc == 0) then + ErrStat = ErrID_Fatal + ErrMsg = "Source variable in mapping '"//Key//"' is not active" + return + else if (iVarDst == 0) then + ErrStat = ErrID_Fatal + ErrMsg = "Destination variable in mapping '"//Key//"' is not active" + return + end if + + ! Verify that variables have the same size + if (SrcMod%Vars%y(iVarSrc)%Num /= DstMod%Vars%u(iVarDst)%Num) then + ErrStat = ErrID_Fatal + ErrMsg = "Variables in mapping '"//Key//"' have different sizes" + return + end if + ! Initialize mapping structure Mapping%Desc = Key - Mapping%MapType = Map_NonMesh + Mapping%MapType = Map_Variable Mapping%SrcModIdx = SrcMod%Idx - Mapping%SrcModID = SrcMod%ID - Mapping%SrcIns = SrcMod%Ins Mapping%DstModIdx = DstMod%Idx + Mapping%SrcModID = SrcMod%ID Mapping%DstModID = DstMod%ID + Mapping%SrcIns = SrcMod%Ins Mapping%DstIns = DstMod%Ins + Mapping%iVarSrc = iVarSrc + Mapping%iVarDst = iVarDst Maps = [Maps, Mapping] end subroutine @@ -1618,8 +1686,18 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er ! Select based on type of mapping select case (Mapping%MapType) - case (Map_NonMesh) - cycle + case (Map_Variable) + + if (.not. present(dUdy)) cycle + + associate (SrcMod => Mods(Mapping%SrcModIdx), & + DstMod => Mods(Mapping%DstModIdx), & + SrcVar => Mods(Mapping%SrcModIdx)%Vars%y(Mapping%iVarSrc), & + DstVar => Mods(Mapping%DstModIdx)%Vars%u(Mapping%iVarDst)) + do k = 0, SrcVar%Num - 1 + dUdy(DstMod%iug + DstVar%iLoc(1) + k - 1, SrcMod%iyg + SrcVar%iLoc(1) + k - 1) = -1.0_R8Ki + end do + end associate case (Map_MotionMesh) @@ -1816,7 +1894,7 @@ subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) ! Select based on type of mapping select case (Mapping%MapType) - case (Map_NonMesh) + case (Map_Variable) call NonMesh_InputSolve(Turbine, Mapping, ErrStat2, ErrMsg2, UseU) if (Failed()) return diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index eabe0f0f19..6f731bb60a 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -113,7 +113,7 @@ typedef ^ FAST_SS_CaseType ReKi Pitch - - - "Pitch angle for this case of the st # Mapping Type param ^ - IntKi Map_LoadMesh - 1 - "Load mesh mapping type" - param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - -param ^ - IntKi Map_NonMesh - 3 - "Non mesh mapping type" - +param ^ - IntKi Map_Variable - 3 - "Individual variable mapping type" - typedef ^ TC_MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - typedef ^ ^ IntKi SrcModIdx - 0 - "Source module index in ModData array" - typedef ^ ^ IntKi DstModIdx - 0 - "Destination module index in ModData array" - @@ -123,6 +123,8 @@ typedef ^ ^ IntKi SrcIns - 0 - typedef ^ ^ IntKi DstIns - 0 - "Destination module Instance" - typedef ^ ^ IntKi SrcMeshID - 0 - "Source mesh identifier" - typedef ^ ^ IntKi DstMeshID - 0 - "Destination mesh identifier" - +typedef ^ ^ IntKi iVarSrc - 0 - "Source variable index" - +typedef ^ ^ IntKi iVarDst - 0 - "Destination variable index" - typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - typedef ^ ^ MeshLocType SrcMeshLoc - - - "Source mesh locator (number and indices)" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 48e532ba9b..b9fbfe4ff1 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -84,7 +84,7 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_LoadMesh = 1 ! Load mesh mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Map_NonMesh = 3 ! Non mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Variable = 3 ! Individual variable mapping type [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] @@ -141,6 +141,8 @@ MODULE FAST_Types INTEGER(IntKi) :: DstIns = 0 !< Destination module Instance [-] INTEGER(IntKi) :: SrcMeshID = 0 !< Source mesh identifier [-] INTEGER(IntKi) :: DstMeshID = 0 !< Destination mesh identifier [-] + INTEGER(IntKi) :: iVarSrc = 0 !< Source variable index [-] + INTEGER(IntKi) :: iVarDst = 0 !< Destination variable index [-] INTEGER(IntKi) :: SrcDispMeshID = 0 !< Source displacement mesh identifier [-] INTEGER(IntKi) :: DstDispMeshID = 0 !< Destination displacement mesh identifier [-] TYPE(MeshLocType) :: SrcMeshLoc !< Source mesh locator (number and indices) [-] @@ -1530,6 +1532,8 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, DstTC_MappingTypeData%DstIns = SrcTC_MappingTypeData%DstIns DstTC_MappingTypeData%SrcMeshID = SrcTC_MappingTypeData%SrcMeshID DstTC_MappingTypeData%DstMeshID = SrcTC_MappingTypeData%DstMeshID + DstTC_MappingTypeData%iVarSrc = SrcTC_MappingTypeData%iVarSrc + DstTC_MappingTypeData%iVarDst = SrcTC_MappingTypeData%iVarDst DstTC_MappingTypeData%SrcDispMeshID = SrcTC_MappingTypeData%SrcDispMeshID DstTC_MappingTypeData%DstDispMeshID = SrcTC_MappingTypeData%DstDispMeshID call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%SrcMeshLoc, DstTC_MappingTypeData%SrcMeshLoc, CtrlCode, ErrStat2, ErrMsg2) @@ -1638,6 +1642,8 @@ subroutine FAST_PackTC_MappingType(RF, Indata) call RegPack(RF, InData%DstIns) call RegPack(RF, InData%SrcMeshID) call RegPack(RF, InData%DstMeshID) + call RegPack(RF, InData%iVarSrc) + call RegPack(RF, InData%iVarDst) call RegPack(RF, InData%SrcDispMeshID) call RegPack(RF, InData%DstDispMeshID) call NWTC_Library_PackMeshLocType(RF, InData%SrcMeshLoc) @@ -1693,6 +1699,8 @@ subroutine FAST_UnPackTC_MappingType(RF, OutData) call RegUnpack(RF, OutData%DstIns); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcMeshID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstMeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDst); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcDispMeshID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstDispMeshID); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcMeshLoc) ! SrcMeshLoc diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index f75993d7f3..7fc3eb3a9f 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -716,11 +716,11 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er uPerturbAng = 0.2_R8Ki * Pi_R8 / 180.0_R8Ki uPerturbs = [uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng] - call MV_AddVar(p%Vars%u, "Yaw", VF_Scalar, LinNames=['Yaw, rad']) + call MV_AddVar(p%Vars%u, "Yaw", VF_Scalar, VarIdx=p%iVarYaw, LinNames=['Yaw, rad']) - call MV_AddVar(p%Vars%u, "YawRate", VF_Scalar, LinNames=['YawRate, rad/s']) + call MV_AddVar(p%Vars%u, "YawRate", VF_Scalar, VarIdx=p%iVarYawRate, LinNames=['YawRate, rad/s']) - call MV_AddVar(p%Vars%u, "HSS_Spd", VF_Scalar, LinNames=['HSS_Spd, rad/s']) + call MV_AddVar(p%Vars%u, "HSS_Spd", VF_Scalar, VarIdx=p%iVarHSS_Spd, LinNames=['HSS_Spd, rad/s']) ! Structural controllers do i = 1, p%NumBStC @@ -754,17 +754,21 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er !---------------------------------------------------------------------------- call MV_AddVar(p%Vars%y, "BlPitchCom", VF_Scalar, & + VarIdx=p%iVarBlPitchCom, & Flags=VF_RotFrame, & Num=size(y%BlPitchCom), & LinNames=[('BlPitchCom('//trim(Num2LStr(i))//'), rad', i = 1, size(y%BlPitchCom))]) call MV_AddVar(p%Vars%y, "YawMom", VF_Scalar, & + VarIdx=p%iVarYawMom, & LinNames=['YawMom, Nm']) call MV_AddVar(p%Vars%y, "GenTrq", VF_Scalar, & + VarIdx=p%iVarGenTrq, & LinNames=['GenTrq, Nm']) call MV_AddVar(p%Vars%y, "ElecPwr", VF_Scalar, & + VarIdx=p%iVarElecPwr, & LinNames=['ElecPwr, W']) ! Structural controllers @@ -4520,18 +4524,17 @@ subroutine Get_u_op() call AllocAry( u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2 ); if (Failed()) return end if - iVar = 1 - call MV_Pack(p%Vars%u, iVar, u%Yaw, u_op) - iVar = iVar + 1 - call MV_Pack(p%Vars%u, iVar, u%YawRate, u_op) - iVar = iVar + 1 - call MV_Pack(p%Vars%u, iVar, u%HSS_Spd, u_op) - iVar = iVar + 1 + call MV_Pack(p%Vars%u, p%iVarYaw, u%Yaw, u_op) + call MV_Pack(p%Vars%u, p%iVarYawRate, u%YawRate, u_op) + call MV_Pack(p%Vars%u, p%iVarHSS_Spd, u%HSS_Spd, u_op) !--------------------- ! StC related inputs !--------------------- + ! TODO: add variable indices for these meshes instead of manually counting + iVar = p%iVarHSS_Spd + 1 + ! Blade do j = 1, p%NumBStC do i = 1, p%NumBl diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 8916d2dede..c4a59182c7 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -475,6 +475,13 @@ typedef ^ ParameterType ReKi PulseSpacing - - - "Distance between range gates typedef ^ ParameterType ReKi URefLid - - - "Reference average wind speed for the lidar" m/s # parameters for variables typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - +typedef ^ ParameterType IntKi iVarYaw - - - "Yaw Variable Index" - +typedef ^ ParameterType IntKi iVarYawRate - - - "YawRate Variable Index" - +typedef ^ ParameterType IntKi iVarHSS_Spd - - - "HSS_Spd Variable Index" - +typedef ^ ParameterType IntKi iVarBlPitchCom - - - "BlPitchCom Variable Index" - +typedef ^ ParameterType IntKi iVarYawMom - - - "YawMom Variable Index" - +typedef ^ ParameterType IntKi iVarGenTrq - - - "GenTrq Variable Index" - +typedef ^ ParameterType IntKi iVarElecPwr - - - "ElecPwr Variable Index" - # ..... Inputs .................................................................................................................... diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 7f595ceaf1..7f1043c08c 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -487,6 +487,13 @@ MODULE ServoDyn_Types REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarYaw = 0_IntKi !< Yaw Variable Index [-] + INTEGER(IntKi) :: iVarYawRate = 0_IntKi !< YawRate Variable Index [-] + INTEGER(IntKi) :: iVarHSS_Spd = 0_IntKi !< HSS_Spd Variable Index [-] + INTEGER(IntKi) :: iVarBlPitchCom = 0_IntKi !< BlPitchCom Variable Index [-] + INTEGER(IntKi) :: iVarYawMom = 0_IntKi !< YawMom Variable Index [-] + INTEGER(IntKi) :: iVarGenTrq = 0_IntKi !< GenTrq Variable Index [-] + INTEGER(IntKi) :: iVarElecPwr = 0_IntKi !< ElecPwr Variable Index [-] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -4302,6 +4309,13 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if + DstParamData%iVarYaw = SrcParamData%iVarYaw + DstParamData%iVarYawRate = SrcParamData%iVarYawRate + DstParamData%iVarHSS_Spd = SrcParamData%iVarHSS_Spd + DstParamData%iVarBlPitchCom = SrcParamData%iVarBlPitchCom + DstParamData%iVarYawMom = SrcParamData%iVarYawMom + DstParamData%iVarGenTrq = SrcParamData%iVarGenTrq + DstParamData%iVarElecPwr = SrcParamData%iVarElecPwr end subroutine subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -4614,6 +4628,13 @@ subroutine SrvD_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if + call RegPack(RF, InData%iVarYaw) + call RegPack(RF, InData%iVarYawRate) + call RegPack(RF, InData%iVarHSS_Spd) + call RegPack(RF, InData%iVarBlPitchCom) + call RegPack(RF, InData%iVarYawMom) + call RegPack(RF, InData%iVarGenTrq) + call RegPack(RF, InData%iVarElecPwr) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -4829,6 +4850,13 @@ subroutine SrvD_UnPackParam(RF, OutData) else OutData%Vars => null() end if + call RegUnpack(RF, OutData%iVarYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarYawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarBlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarYawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarGenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarElecPwr); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) From 9c82411a1fab3a83671e1afd614ec0afc61cebd2 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Feb 2024 00:22:47 +0000 Subject: [PATCH 080/319] Updating AeroDyn Linearization --- modules/aerodyn/src/AeroDyn.f90 | 1113 ++++------------------ modules/aerodyn/src/AeroDyn_Registry.txt | 13 +- modules/aerodyn/src/AeroDyn_Types.f90 | 66 +- 3 files changed, 214 insertions(+), 978 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index ce815713ee..52a7016a62 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5227,7 +5227,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD character(4) :: RotorLabel character(64) :: NodeLabel character(1), parameter :: UVW(3) = ['U','V','W'] - real(R8Ki) :: Perturb, PerturbAng, PerturbTower, PerturbBlade(MaxBl) + real(R8Ki) :: PerturbAng, PerturbTower, PerturbBlade(MaxBl) integer(IntKi) :: i, j, k ErrStat = ErrID_None @@ -5255,23 +5255,25 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD ! DBEMT if (p%BEMT%DBEMT%lin_nx/2 > 0) then - p%iVarDBEMT = 1 + p%iVarDBEMT = size(p%Vars%x) + 1 do j = 1, p%NumBlades call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Num=p%NumBlNds*2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & Perturb=PerturbAng, & - LinNames=[(['vind (axial) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s', & - 'vind (tangential) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s'], i = 1, p%NumBlNds)]) + LinNames=[([DBEMTLinName(j, i, "axial"), & + DBEMTLinName(j, i, "tangential")], i = 1, p%NumBlNds)]) end do do j = 1, p%NumBlades call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Num=p%NumBlNds*2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & Perturb=PerturbAng, & - LinNames=[(['First time derivative of vind (axial) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s/s', & - 'First time derivative of vind (tangential) at blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', m/s/s'], i = 1, p%NumBlNds)]) + LinNames=[(['First time derivative of '//DBEMTLinName(j, i, "axial"), & + 'First time derivative of '//DBEMTLinName(j, i, "axial")], i = 1, p%NumBlNds)]) end do + else + p%iVarDBEMT = 0 end if ! Unsteady Aero @@ -5301,24 +5303,20 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD LinNames=['x4 '//trim(NodeLabel)//', -']) end do end do - + else + p%iVarUA = 0 end if + ! BEMT states + if (p%BEMT%lin_nx>0) then + call SetErrStat(ErrID_Fatal, 'Number of lin states for bem should be zero', ErrStat, ErrMsg, RoutineName) + return + end if !---------------------------------------------------------------------------- ! Input variables !---------------------------------------------------------------------------- - ! Allocate variable indices - call AllocAry(p%iVarBladeRootMotion, p%NumBlades, "iVarBladeRootMotion", ErrStat2, ErrMsg2); if (Failed()) return - p%iVarBladeRootMotion = 0 - call AllocAry(p%iVarBladeMotion, p%NumBlades, "iVarBladeMotion", ErrStat2, ErrMsg2); if (Failed()) return - p%iVarBladeMotion = 0 - call AllocAry(p%iVarInflowOnBlade, p%NumBlades, "iVarInflowOnBlade", ErrStat2, ErrMsg2); if (Failed()) return - p%iVarInflowOnBlade = 0 - call AllocAry(p%iVarUserProp, p%NumBlades, "iVarUserProp", ErrStat2, ErrMsg2); if (Failed()) return - p%iVarUserProp = 0 - PerturbAng = 2.0_R8Ki * D2R_D do k = 1, p%NumBlades @@ -5331,25 +5329,37 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD PerturbTower = 0.0_R8Ki end if - ! Add tower motion - call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"TowerMotion", & - VarIdx=p%iVarTowerMotion, & - Mesh=u%TowerMotion, & - Fields=[VF_TransDisp, VF_Orientation, VF_TransVel], & - Perturbs=[PerturbTower, & ! VF_TransDisp - PerturbAng, & ! VF_Orientation - PerturbTower]) ! VF_TransVel - + ! Add Nacelle motion + call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"NacelleMotion", & + VarIdx=p%iVarNacelleMotion, & + Mesh=u%NacelleMotion, & + Fields=[VF_TransDisp, VF_Orientation], & + Perturbs=[PerturbBlade(1), PerturbAng]) + ! Add hub motion call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"HubMotion", & VarIdx=p%iVarHubMotion, & Mesh=u%HubMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel], & - Perturbs=[PerturbBlade(1), & ! VF_TransDisp - PerturbAng, & ! VF_Orientation - PerturbAng]) ! VF_AngularVel + Perturbs=[PerturbBlade(1), PerturbAng, PerturbAng]) + + ! Add tail fin motion + call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"TFinMotion", & + VarIdx=p%iVarTFinMotion, & + Mesh=u%TFinMotion, & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel], & + Perturbs=[PerturbAng, PerturbAng, PerturbAng]) + + ! Add tower motion + call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"TowerMotion", & + VarIdx=p%iVarTowerMotion, & + Mesh=u%TowerMotion, & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_TransAcc], & + Perturbs=[PerturbTower, PerturbAng, PerturbTower, PerturbTower]) ! Add blade root motion + call AllocAry(p%iVarBladeRootMotion, p%NumBlades, "iVarBladeRootMotion", ErrStat2, ErrMsg2); if (Failed()) return + p%iVarBladeRootMotion = 0 do j = 1, p%NumBlades call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"BladeRootMotion"//IdxStr(j), & VarIdx=p%iVarBladeRootMotion(j), & @@ -5360,17 +5370,15 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD end do ! Add blade motion + call AllocAry(p%iVarBladeMotion, p%NumBlades, "iVarBladeMotion", ErrStat2, ErrMsg2); if (Failed()) return + p%iVarBladeMotion = 0 do j = 1, p%NumBlades call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"BladeMotion"//IdxStr(j), & VarIdx=p%iVarBladeMotion(j), & Mesh=u%BladeMotion(j), & - Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc], & - Perturbs=[PerturbBlade(j), & ! VF_TransDisp - PerturbAng, & ! VF_Orientation - PerturbBlade(j), & ! VF_TransVel - PerturbAng, & ! VF_AngularVel - PerturbBlade(j)]) ! VF_TransAcc - ! Set AeroMap flag on subset of first blade fields + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc], & + Perturbs=[PerturbBlade(j), PerturbAng, PerturbBlade(j), PerturbAng, PerturbBlade(j), PerturbAng]) + ! Set AeroMap flag on subset of fields for first blade if (j == 1) then do k = p%iVarBladeMotion(j), size(p%Vars%u) select case (p%Vars%u(k)%Field) @@ -5381,54 +5389,64 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD end if end do - ! u%Bld(j)%InflowOnBlade - do j = 1, p%NumBlades - call MV_AddVar(p%Vars%u, trim(RotorLabel)//"InflowOnBlade"//IdxStr(j), VF_Scalar, & - VarIdx=p%iVarInflowOnBlade(j), & - Num=p%NumBlNds*3, & - Perturb=PerturbBlade(j), & - LinNames=[((UVW(i)//'-component inflow on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(k))//', m/s', i = 1, 3), k = 1, p%NumBlNds)]) - end do - - ! u%InflowOnTower - call MV_AddVar(p%Vars%u, trim(RotorLabel)//"InflowOnTower", VF_Scalar, & - VarIdx=p%iVarInflowOnTower, & - Num=p%NumTwrNds*3, & - Perturb=2.0_R8Ki * D2R_D, & - LinNames=[((UVW(i)//'-component inflow on tower node '//trim(Num2LStr(j))//', m/s', i = 1, 3), j = 1, p%NumTwrNds)]) - ! Add user props + call AllocAry(p%iVarUserProp, p%NumBlades, "iVarUserProp", ErrStat2, ErrMsg2); if (Failed()) return + p%iVarUserProp = 0 do j = 1, p%NumBlades call MV_AddVar(p%Vars%u, trim(RotorLabel)//"UserProp Blade"//IdxStr(k), VF_Scalar, & VarIdx=p%iVarUserProp(j), & Flags=VF_RotFrame, & Num=p%NumBlNds, & - Perturb=2.0_R8Ki * D2R_D, & + Perturb=2.0_R8Ki*D2R_D, & LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(k))//', -', k = 1, p%NumBlNds)]) end do + ! Extended inputs + call MV_AddVar(p%Vars%u, "HWindSpeed", VF_Scalar, & + VarIdx=p%iVarHWindSpeed, & + Flags=VF_ExtLin, & + Perturb=2.0_R8Ki*D2R_D, & + LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) + + call MV_AddVar(p%Vars%u, "PLExp", VF_Scalar, & + VarIdx=p%iVarPLexp, & + Flags=VF_ExtLin, & + Perturb=2.0_R8Ki*D2R_D, & + LinNames=['Extended input: vertical power-law shear exponent, -']) + + call MV_AddVar(p%Vars%u, "PropagationDir", VF_Scalar, & + VarIdx=p%iVarPropagationDir, & + Flags=VF_ExtLin, & + Perturb=2.0_R8Ki*D2R_D, & + LinNames=['Extended input: propagation direction, rad']) + !---------------------------------------------------------------------------- ! Output variables !---------------------------------------------------------------------------- - call AllocAry(p%iVarBladeLoad, p%NumBlades, "iVarBladeLoad", ErrStat2, ErrMsg2); if (Failed()) return + ! Add nacelle load + call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"NacelleLoad", LoadFields, & + VarIdx=p%iVarNacelleLoad, & + Mesh=y%NacelleLoad) + + ! Add hub load + call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"HubLoad", LoadFields, & + VarIdx=p%iVarHubLoad, & + Mesh=y%HubLoad) + + ! Add tail fin load + call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"TFinLoad", LoadFields, & + VarIdx=p%iVarTFinLoad, & + Mesh=y%TFinLoad) ! Add tower load call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"TowerLoad", LoadFields, & VarIdx=p%iVarTowerLoad, & Mesh=y%TowerLoad) - ! Add nacelle load - call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"HubLoad", LoadFields, & - VarIdx=p%iVarHubLoad, & - Mesh=y%HubLoad) - - ! Add nacelle load - call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"NacelleLoad", LoadFields, & - VarIdx=p%iVarNacelleLoad, & - Mesh=y%NacelleLoad) - ! Loop through blades, add blade loads + call AllocAry(p%iVarBladeLoad, p%NumBlades, "iVarBladeLoad", ErrStat2, ErrMsg2); if (Failed()) return + p%iVarBladeLoad = 0 do j = 1, p%NumBlades call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"BladeLoad"//IdxStr(j), LoadFields, & VarIdx=p%iVarBladeLoad(j), & @@ -5481,7 +5499,13 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD end if -contains +contains + + character(LinChanLen) function DBEMTLinName(BladeNum, NodeNum, Direction) + integer(IntKi), intent(in) :: BladeNum, NodeNum + character(*), intent(in) :: Direction + DBEMTLinName = 'vind ('//trim(Direction)//') at blade '//trim(Num2LStr(BladeNum))//', node '//trim(Num2LStr(NodeNum))//', m/s' + end function pure integer(IntKi) function OutParamFlags(ind) integer(IntKi), intent(in) :: ind @@ -5515,7 +5539,7 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point @@ -5550,11 +5574,11 @@ END SUBROUTINE AD_JacobianPInput !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter ) !.................................................................................................................................. - + use IfW_FlowField, only: FlowFieldType, Uniform_FieldType, UniformField_InterpLinear REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters + TYPE(AD_ParameterType), INTENT(INOUT) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point TYPE(RotDiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point @@ -5582,6 +5606,9 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, logical :: IsFullLin integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col + type(UniformField_Interp) :: UF_op + type(FlowFieldType), target :: FF + type(FlowFieldType), pointer :: FF_original ErrStat = ErrID_None ErrMsg = '' @@ -5595,6 +5622,28 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, FlagFilterLoc = VF_None end if + ! Associate temporary pointer to FlowField in parameters, will be restored at end of routine + FF_original => p_AD%FlowField + + ! Associate parameters flow field pointer with temporary structure + p_AD%FlowField => FF + + ! Get extended input values from uniform flow field + UF_op = UniformField_InterpLinear(p_AD%FlowField%Uniform, t) + + ! Make a copy of the flowfield to perturb + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FF, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + FF%Uniform%DataSize = 1 + FF%Uniform%Time(1) = t + FF%Uniform%VelH(1) = UF_op%VelH + FF%Uniform%VelV(1) = UF_op%VelV + FF%Uniform%VelGust(1) = UF_op%VelGust + FF%Uniform%AngleH(1) = UF_op%AngleH + FF%Uniform%AngleV(1) = UF_op%AngleV + FF%Uniform%ShrH(1) = UF_op%ShrH + FF%Uniform%ShrV(1) = UF_op%ShrV + FF%Uniform%LinShrV(1) = UF_op%LinShrV + ! Get OP values here (i.e., set inputs for BEMT): if (p%FrozenWake) then call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return @@ -5607,6 +5656,11 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ! Copy inputs and pack them for perturbation call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_PackInputValues(p, u, m%Jac%u) + + ! Pack extended inputs for perturbation + call MV_Pack(p%Vars%u, p%iVarHWindSpeed, UF_op%VelH, m%Jac%u) + call MV_Pack(p%Vars%u, p%iVarPLexp, UF_op%ShrV, m%Jac%u) + call MV_Pack(p%Vars%u, p%iVarPropagationDir, UF_op%AngleH + p_AD%FlowField%PropagationDir, m%Jac%u) ! Copy continuous and other states for initialization call AD_CopyRotContinuousStateType(x, m%x_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -5642,6 +5696,7 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call AD_UnpackExtendedInputValues(p, m%Jac%u_perturb, FF) call SetInputs(p, p_AD, m%u_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return @@ -5652,6 +5707,7 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call AD_UnpackExtendedInputValues(p, m%Jac%u_perturb, FF) call SetInputs(p, p_AD, m%u_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return @@ -5723,6 +5779,7 @@ logical function Failed() end function subroutine cleanup() m%BEMT%UseFrozenWake = .false. + p_AD%FlowField => FF_original end subroutine cleanup end subroutine Rot_JacobianPInput @@ -6359,7 +6416,7 @@ END SUBROUTINE AD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. SUBROUTINE RotGetOP(t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter) - + use IfW_FlowField, only: FlowFieldType, Uniform_FieldType, UniformField_InterpLinear REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters @@ -6386,6 +6443,7 @@ SUBROUTINE RotGetOP(t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, logical :: IsFullLin integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: ind, i, j, k, n + type(UniformField_Interp) :: op ErrStat = ErrID_None ErrMsg = '' @@ -6409,6 +6467,15 @@ SUBROUTINE RotGetOP(t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, call AD_PackInputValues(p, u, u_op) + if (associated(p_AD%FlowField)) then + if (p_AD%FlowField%FieldType == Uniform_FieldType) then + op = UniformField_InterpLinear(p_AD%FlowField%Uniform, t) + call MV_Pack(p%Vars%u, p%iVarHWindSpeed, op%VelH, u_op) + call MV_Pack(p%Vars%u, p%iVarPLexp, op%ShrV, u_op) + call MV_Pack(p%Vars%u, p%iVarPropagationDir, op%AngleH + p_AD%FlowField%PropagationDir, u_op) + end if + end if + END IF !---------------------------------------------------------------------------- @@ -6458,9 +6525,7 @@ SUBROUTINE RotGetOP(t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, if (present(z_op)) then if (.not. allocated(z_op)) then - call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return end if ind = 1 @@ -6479,797 +6544,12 @@ logical function Failed() Failed = ErrStat >= AbortErrLev end function END SUBROUTINE RotGetOP -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters - TYPE(RotOutputType) , INTENT(IN ) :: y !< outputs - TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables: - INTEGER(IntKi) :: i, j, k, indx_next, indx_last - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_y' - logical, allocatable :: AllOut(:) - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - if (p_AD%CompAeroMaps) then - p%Jac_ny = 0 ! we skip tower and writeOutput values in the solve (note: y%TowerLoad%NNodes=0) - else - p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values - end if - - do k=1,p%NumBl_Lin - p%Jac_ny = p%Jac_ny + y%BladeLoad(k)%NNodes * 6 ! 3 forces + 3 moments at each node - end do - - - ! get the names of the linearized outputs: - call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'RotFrame_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - - InitOut%RotFrame_y = .false. ! default all to false, then set the true ones below - indx_next = 1 - if (.not. p_AD%CompAeroMaps) call PackLoadMesh_Names(y%TowerLoad, 'Tower', InitOut%LinNames_y, indx_next) ! note: y%TowerLoad%NNodes=0 for aeroMaps - - indx_last = indx_next - do k=1,p%NumBl_Lin - call PackLoadMesh_Names(y%BladeLoad(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_y, indx_next) - end do - ! InitOut%RotFrame_y(indx_last:indx_next-1) = .true. ! The mesh fields are in the global frame, so are not in the rotating frame - if (.not. p_AD%CompAeroMaps) then - - do i=1,p%NumOuts + p%BldNd_TotNumOuts - InitOut%LinNames_y(i+indx_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do - - ! check for all the WriteOutput values that are functions of blade number: - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; - end if - - AllOut = .false. - do k=1,3 - AllOut( BAzimuth(k)) = .true. - AllOut( BPitch (k)) = .true. - - AllOut( BAeroFx( k)) = .true. - AllOut( BAeroFy( k)) = .true. - AllOut( BAeroFz( k)) = .true. - AllOut( BAeroMx( k)) = .true. - AllOut( BAeroMy( k)) = .true. - AllOut( BAeroMz( k)) = .true. - !AllOut( TipClrnc(k)) = .true. - - do j=1,9 - AllOut(BNVUndx(j,k)) = .true. - AllOut(BNVUndy(j,k)) = .true. - AllOut(BNVUndz(j,k)) = .true. - AllOut(BNVDisx(j,k)) = .true. - AllOut(BNVDisy(j,k)) = .true. - AllOut(BNVDisz(j,k)) = .true. - AllOut(BNSTVx (j,k)) = .true. - AllOut(BNSTVy (j,k)) = .true. - AllOut(BNSTVz (j,k)) = .true. - AllOut(BNVRel (j,k)) = .true. - AllOut(BNDynP (j,k)) = .true. - AllOut(BNRe (j,k)) = .true. - AllOut(BNM (j,k)) = .true. - AllOut(BNVIndx(j,k)) = .true. - AllOut(BNVIndy(j,k)) = .true. - AllOut(BNAxInd(j,k)) = .true. - AllOut(BNTnInd(j,k)) = .true. - AllOut(BNAlpha(j,k)) = .true. - AllOut(BNTheta(j,k)) = .true. - AllOut(BNPhi (j,k)) = .true. - AllOut(BNCurve(j,k)) = .true. - AllOut(BNCl (j,k)) = .true. - AllOut(BNCd (j,k)) = .true. - AllOut(BNCm (j,k)) = .true. - AllOut(BNCx (j,k)) = .true. - AllOut(BNCy (j,k)) = .true. - AllOut(BNCn (j,k)) = .true. - AllOut(BNCt (j,k)) = .true. - AllOut(BNFl (j,k)) = .true. - AllOut(BNFd (j,k)) = .true. - AllOut(BNMm (j,k)) = .true. - AllOut(BNFx (j,k)) = .true. - AllOut(BNFy (j,k)) = .true. - AllOut(BNFn (j,k)) = .true. - AllOut(BNFt (j,k)) = .true. - AllOut(BNClrnc(j,k)) = .true. - end do - end do - - - do i=1,p%NumOuts - InitOut%RotFrame_y(i+indx_next-1) = AllOut( p%OutParam(i)%Indx ) - end do - - do i=1,p%BldNd_TotNumOuts - InitOut%RotFrame_y(i+p%NumOuts+indx_next-1) = .true. - !AbsCant, AbsToe, AbsTwist should probably be set to .false. - end do - - - deallocate(AllOut) - - end if - -END SUBROUTINE Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat, ErrMsg) - - TYPE(RotInputFile) , INTENT(IN ) :: InputFileData !< input file data (for default blade perturbation) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters - TYPE(RotInputType) , INTENT(IN ) :: u !< inputs - TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField - INTEGER(IntKi) :: NumFieldsForLinearization - REAL(ReKi) :: perturb, perturb_t, perturb_b(MaxBl) - LOGICAL :: FieldMask(FIELDMASK_SIZE) - CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_u' - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many inputs there are in the Jacobians - if (p_AD%CompAeroMaps) then - nu = 0 - - NumFieldsForLinearization = 3 ! Translation Displacements + orientations + Translation velocities at each node on the blade mesh - else - nu = u%TowerMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities at each node - + u%hubMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Rotation velocities at each node - ! + size( u%InflowOnBlade) & - + size( u%InflowOnTower) & !note that we are not passing the inflow on nacelle or hub here - + size( u%UserProp) - !+ 3 ! 3 velocity components in AvgDiskVel; note that we are not passing the inflow on nacelle or hub here - - do k=1,size(u%Bld) ! hopefully this is allocated - nu = nu + size(u%Bld(k)%InflowOnBlade) - end do - - NumFieldsForLinearization = 5 ! Translation Displacements + orientations + Translation velocities + Rotation velocities + TranslationAcc at each node on the blade mesh - do i=1,p%NumBlades - nu = nu + u%BladeRootMotion(i)%NNodes * 3 ! 3 orientations at each node - end do - end if - - do i=1,p%NumBl_Lin - nu = nu + u%BladeMotion(i)%NNodes * 3*NumFieldsForLinearization ! 3 components per field - end do - - ! all other inputs ignored - - - !............................ - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see aerodyn::perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - !............................ - - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !............... - ! AD input mappings stored in p%Jac_u_indx: - !............... - index = 1 - - if (.not. p_AD%CompAeroMaps) then - - !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - do i_meshField = 1,3 - do i=1,u%TowerMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - !Module/Mesh/Field: u%HubMotion%Orientation = 5; - !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - do i_meshField = 4,6 - do i=1,u%HubMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - do k=1,p%NumBlades - do i_meshField = 6,6 - do i=1,u%BladeRootMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - end if ! .not. compAeroMaps - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - !Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 13; - !Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 14; - - !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 15; - !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 16; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 17; - !Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 18; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 19; - - !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 20; - !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 21; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 22; - !Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 23; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 24; - do k=1,p%NumBl_Lin - do i_meshField = 1,NumFieldsForLinearization - do i=1,u%BladeMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = 9 + i_meshField + (k-1)*5 ! this should use the MAX possible NumFieldsForLinearization = 5 (so that it's consistent for all cases) - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - if (.not. p_AD%CompAeroMaps) then - - !Module/Mesh/Field: u%InflowOnBlade(:,:,1) = 25; - !Module/Mesh/Field: u%InflowOnBlade(:,:,2) = 26; - !Module/Mesh/Field: u%InflowOnBlade(:,:,3) = 27; - do k=1,size(u%Bld) ! p%NumBlades - do i=1,size(u%Bld(k)%InflowOnBlade,2) ! numNodes - do j=1,3 - p%Jac_u_indx(index,1) = 24 + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !k - - !Module/Mesh/Field: u%InflowOnTower(:,:) = 28; - do i=1,size(u%InflowOnTower,2) ! numNodes - do j=1,3 - p%Jac_u_indx(index,1) = 28 - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - !Module/Mesh/Field: u%UserProp(:,:) = 29,30,31; - do k=1,size(u%UserProp,2) ! p%NumBlades - do i=1,size(u%UserProp,1) ! numNodes - p%Jac_u_indx(index,1) = 28 + k - p%Jac_u_indx(index,2) = 1 !component index: this is a scalar, so 1, but is never used - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !i - end do !k - - !Module/Mesh/Field: u%AvgDiskVel(:,:) = 32; - !do j=1,3 - ! p%Jac_u_indx(index,1) = 32 - ! p%Jac_u_indx(index,2) = j !component index: j - ! p%Jac_u_indx(index,3) = 1 !Node: 1 (not really necessary here, since we have only a 1 dimensional array) - ! index = index + 1 - !end do !j - - - end if ! .not. compAeroMaps - - !...................................... - ! default perturbations, p%du: - !...................................... - call allocAry( p%du, 31, 'p%du', ErrStat2, ErrMsg2) ! 31 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - perturb = 2*D2R - - do k=1,p%NumBlades - perturb_b(k) = 0.2_ReKi*D2R * InputFileData%BladeProps(k)%BlSpn( InputFileData%BladeProps(k)%NumBlNds ) - end do - - if ( u%TowerMotion%NNodes > 0) then - perturb_t = 0.2_ReKi*D2R * u%TowerMotion%Position( 3, u%TowerMotion%NNodes ) - else - perturb_t = 0.0_ReKi - end if - - p%du(1) = perturb_t ! u%TowerMotion%TranslationDisp = 1 - p%du(2) = perturb ! u%TowerMotion%Orientation = 2 - p%du(3) = perturb_t ! u%TowerMotion%TranslationVel = 3 - p%du(4) = perturb_b(1) ! u%HubMotion%TranslationDisp = 4 - p%du(5) = perturb ! u%HubMotion%Orientation = 5 - p%du(6) = perturb ! u%HubMotion%RotationVel = 6 - do i_meshField = 7,9 - p%du(i_meshField) = perturb ! u%BladeRootMotion(k)%Orientation = 6+k, for k in [1, 3] - end do - do k=1,p%NumBlades - p%du(10 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationDisp = 10 + (k-1)*5 - p%du(11 + (k-1)*5) = perturb ! u%BladeMotion(k)%Orientation = 11 + (k-1)*5 - p%du(12 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationVel = 12 + (k-1)*5 - p%du(13 + (k-1)*5) = perturb ! u%BladeMotion(k)%RotationVel = 13 + (k-1)*5 - p%du(14 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationAcc = 14 + (k-1)*5 !bjj: is the correct???? - end do - do k=1,p%NumBlades - p%du(24 + k) = perturb_b(k) ! u%InflowOnBlade(:,:,k) = 24 + k - end do - p%du(28) = perturb_t ! u%InflowOnTower(:,:) = 28 - do k=1,p%NumBl_Lin - p%du(28+k) = perturb ! u%UserProp(:,:) = 29,30,31 - end do - !p%du(32) = minval(perturb_b(1:p%numBlades)) ! u%AvgDiskVel(:) = 32 - - - !..................... - ! get names of linearized inputs - !..................... - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%IsLoad_u = .false. ! None of AeroDyn's inputs are loads - InitOut%RotFrame_u = .false. - if (.not. p_AD%CompAeroMaps) then - do k=0,p%NumBl_Lin*p%NumBlNds-1 - InitOut%RotFrame_u(nu - k ) = .true. ! UserProp(:,:) ! TODO TODO TODO add -3 due to DiskAvgVel - end do - endif - - index = 1 - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - if (.not. p_AD%CompAeroMaps) call PackMotionMesh_Names(u%TowerMotion, 'Tower', InitOut%LinNames_u, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - if (.not. p_AD%CompAeroMaps) call PackMotionMesh_Names(u%HubMotion, 'Hub', InitOut%LinNames_u, index, FieldMask=FieldMask) - - index_last = index - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - if (.not. p_AD%CompAeroMaps) then - do k = 1,p%NumBlades - call PackMotionMesh_Names(u%BladeRootMotion(k), 'Blade root '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TRANSLATIONAcc) = .true. - end if - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - do k=1,p%NumBl_Lin - call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - if (.not. p_AD%CompAeroMaps) then - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do - end do - end do - !InitOut%RotFrame_u(index_last:index-1) = .true. ! values on the mesh (and from IfW) are in global coordinates, thus not in the rotating frame - - do i=1,p%NumTwrNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on tower node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do - end do - - ! UserProp - do k=1,p%NumBl_Lin - do i=1,p%NumBlNds - InitOut%LinNames_u(index) = 'User property on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', -' - index = index + 1 - end do - end do - - ! AvgDiskVel - !do j=1,3 - ! InitOut%LinNames_u(index) = UVW(j)//'-component inflow of average disk velocity, m/s' - ! index = index + 1 - !end do - - end if - -END SUBROUTINE Init_Jacobian_u -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) - - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_x' - - ! local variables: - INTEGER(IntKi) :: i, j, k, n, state - INTEGER(IntKi) :: nx - INTEGER(IntKi) :: nx1 - CHARACTER(25) :: NodeTxt - - ErrStat = ErrID_None - ErrMsg = "" - - - nx = p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx - - ! allocate space for the row/column names and for perturbation sizes - ! always allocate this in case it is size zero ... (we use size(p%dx) for many calculations) - CALL AllocAry(p%dx, nx, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (nx==0) return - - CALL AllocAry(InitOut%LinNames_x, nx, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, nx, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, nx, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! All DBEMT continuous states are order = 2; UA states are order 1 - - ! set default perturbation sizes: p%dx - p%dx = 2.0_R8Ki * D2R_D - - ! set linearization output names: - nx1 = p%BEMT%DBEMT%lin_nx/2 - if (nx1>0) then - InitOut%DerivOrder_x(1:p%BEMT%DBEMT%lin_nx) = 2 - InitOut%RotFrame_x( 1:p%BEMT%DBEMT%lin_nx) = .true. - - k = 1 - do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - NodeTxt = 'blade '//trim(num2lstr(j))//', node '//trim(num2lstr(i)) - InitOut%LinNames_x(k) = 'vind (axial) at '//trim(NodeTxt)//', m/s' - k = k + 1 - - InitOut%LinNames_x(k) = 'vind (tangential) at '//trim(NodeTxt)//', m/s' - k = k + 1 - end do - end do - - do i=1,nx1 - InitOut%LinNames_x(i+nx1) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+nx1) = InitOut%RotFrame_x(i) - end do - end if - ! UA states - if (p%BEMT%UA%lin_nx>0) then - InitOut%DerivOrder_x(1+p%BEMT%DBEMT%lin_nx:nx) = 1 - InitOut%RotFrame_x( 1+p%BEMT%DBEMT%lin_nx:nx) = .true. - - k = 1 + p%BEMT%DBEMT%lin_nx - do n=1,p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - state = p%BEMT%UA%lin_xIndx(n,3) - - p%dx(k) = p%BEMT%UA%dx(state) - - NodeTxt = 'x'//trim(num2lstr(state))//' blade '//trim(num2lstr(j))//', node '//trim(num2lstr(i)) - if (state<3) then - InitOut%LinNames_x(k) = trim(NodeTxt)//', rad' ! x1 and x2 are radians - else - InitOut%LinNames_x(k) = trim(NodeTxt)//', -' ! x3, x4 (and x5) are units of cl or cn - end if - InitOut%DerivOrder_x(k) = 1 - InitOut%RotFrame_x(k) = .true. - - k = k + 1 - end do - - end if - ! BEMT states - if (p%BEMT%lin_nx>0) then - call SetErrStat(ErrID_Fatal,'Number of lin states for bem should be zero for now.', ErrStat, ErrMsg, RoutineName) - return - !k = 1 + p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx - - !InitOut%DerivOrder_x(k:nx) = 1 - !InitOut%RotFrame_x( k:nx) = .false. - ! - !InitOut%LinNames_x(k ) = 'X-component of wake velocity, m/s' - !InitOut%LinNames_x(k+1) = 'Y-component of wake velocity, m/s' - !InitOut%LinNames_x(k+2) = 'Z-component of wake velocity, m/s' - end if - - -END SUBROUTINE Init_Jacobian_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding parts of AD linearization ! -SUBROUTINE Init_Jacobian( InputFileData, p, p_AD, u, y, m, InitOut, ErrStat, ErrMsg) - - type(RotInputFile) , intent(in ) :: InputFileData !< input file data (for default blade perturbation) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters - TYPE(RotInputType) , INTENT(IN ) :: u !< inputs - TYPE(RotOutputType) , INTENT(IN ) :: y !< outputs - TYPE(RotMiscVarType) , INTENT(INOUT) :: m !< miscellaneous variable - TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian' - - - ErrStat = ErrID_None - ErrMsg = "" - - if (p_AD%CompAeroMaps) then - p%NumBl_Lin = 1 - else - p%NumBl_Lin = p%NumBlades - end if - - call Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) - - ! these matrices will be needed for linearization with frozen wake feature - if (p%FrozenWake) then - call AllocAry(m%BEMT%AxInd_op,p%NumBlNds,p%numBlades,'m%BEMT%AxInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(m%BEMT%TnInd_op,p%NumBlNds,p%numBlades,'m%BEMT%TnInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - call Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - -END SUBROUTINE Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(RotInputType) , INTENT(INOUT) :: u !< perturbed AD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - CASE ( 1) !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - u%TowerMotion%TranslationDisp( fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - CALL PerturbOrientationMatrix( u%TowerMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 3) !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - u%TowerMotion%TranslationVel( fieldIndx,node ) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign - - CASE ( 4) !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%HubMotion%Orientation = 5; - CALL PerturbOrientationMatrix( u%HubMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE ( 6) !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - u%HubMotion%RotationVel(fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - CALL PerturbOrientationMatrix( u%BladeRootMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE ( 8) !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - CALL PerturbOrientationMatrix( u%BladeRootMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE ( 9) !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - CALL PerturbOrientationMatrix( u%BladeRootMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE (10) !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - CALL PerturbOrientationMatrix( u%BladeMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (12) !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - u%BladeMotion(1)%TranslationVel(fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (13) !Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 13; - u%BladeMotion(1)%RotationVel(fieldIndx,node) = u%BladeMotion(1)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 14; - u%BladeMotion(1)%TranslationAcc(fieldIndx,node) = u%BladeMotion(1)%TranslationAcc(fieldIndx,node) + du * perturb_sign - - CASE (15) !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 15; - u%BladeMotion(2)%TranslationDisp( fieldIndx,node) = u%BladeMotion(2)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 16; - CALL PerturbOrientationMatrix( u%BladeMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (17) !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 17; - u%BladeMotion(2)%TranslationVel(fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (18) !Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 18; - u%BladeMotion(2)%RotationVel(fieldIndx,node) = u%BladeMotion(2)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (19) !Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 19; - u%BladeMotion(2)%TranslationAcc(fieldIndx,node) = u%BladeMotion(2)%TranslationAcc(fieldIndx,node) + du * perturb_sign - - CASE (20) !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 20; - u%BladeMotion(3)%TranslationDisp( fieldIndx,node) = u%BladeMotion(3)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (21) !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 21; - CALL PerturbOrientationMatrix( u%BladeMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (22) !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 22; - u%BladeMotion(3)%TranslationVel(fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (23) !Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 23; - u%BladeMotion(3)%RotationVel(fieldIndx,node) = u%BladeMotion(3)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (24) !Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 24; - u%BladeMotion(3)%TranslationAcc(fieldIndx,node) = u%BladeMotion(3)%TranslationAcc(fieldIndx,node) + du * perturb_sign - - CASE (25) !Module/Mesh/Field: u%Bld(1)%InflowOnBlade(:,:) = 25; - u%Bld(1)%InflowOnBlade(fieldIndx,node) = u%Bld(1)%InflowOnBlade(fieldIndx,node) + du * perturb_sign - CASE (26) !Module/Mesh/Field: u%Bld(2)%InflowOnBlade(:,:) = 26; - u%Bld(2)%InflowOnBlade(fieldIndx,node) = u%Bld(2)%InflowOnBlade(fieldIndx,node) + du * perturb_sign - CASE (27) !Module/Mesh/Field: u%Bld(3)%InflowOnBlade(:,:) = 27; - u%Bld(3)%InflowOnBlade(fieldIndx,node) = u%Bld(3)%InflowOnBlade(fieldIndx,node) + du * perturb_sign - - CASE (28) !Module/Mesh/Field: u%InflowOnTower(:,:) = 28; - u%InflowOnTower(fieldIndx,node) = u%InflowOnTower(fieldIndx,node) + du * perturb_sign - - CASE (29) !Module/Mesh/Field: u%UserProp(:,1) = 29; - u%UserProp(node,1) = u%UserProp(node,1) + du * perturb_sign - CASE (30) !Module/Mesh/Field: u%UserProp(:,2) = 30; - u%UserProp(node,2) = u%UserProp(node,2) + du * perturb_sign - CASE (31) !Module/Mesh/Field: u%UserProp(:,3) = 31; - u%UserProp(node,3) = u%UserProp(node,3) + du * perturb_sign - - !CASE (32) !Module/Mesh/Field: u%AvgDiskVel(:) = 32; - ! u%AvgDiskVel(fieldIndx) = u%AvgDiskVel(fieldIndx) + du * perturb_sign - - END SELECT - -END SUBROUTINE Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_x( p, n, perturb_sign, x, dx ) - - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(RotContinuousStateType) , INTENT(INOUT) :: x !< perturbed AD continuous states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific input was perturbed - - - ! local variables - INTEGER(IntKi) :: Blade ! loop over blade nodes - INTEGER(IntKi) :: BladeNode ! loop over blades - INTEGER(IntKi) :: StateIndex ! which state we are perturbing - INTEGER(IntKi) :: n_tmp ! - - - dx = p%dx( n ) - - if (n <= p%BEMT%DBEMT%lin_nx) then - - if (n <= p%BEMT%DBEMT%lin_nx/2) then ! x_p%BEMT%DBEMT%element(i,j)%vind, else x_p%BEMT%DBEMT%element(i,j)%vind_1 - call GetStateIndices( n, size(x%BEMT%DBEMT%element,2), size(x%BEMT%DBEMT%element,1), size(x%BEMT%DBEMT%element(1,1)%vind), Blade, BladeNode, StateIndex ) - x%BEMT%DBEMT%element(BladeNode,Blade)%vind(StateIndex) = x%BEMT%DBEMT%element(BladeNode,Blade)%vind(StateIndex) + dx * perturb_sign - else - call GetStateIndices( n - p%BEMT%DBEMT%lin_nx/2, size(x%BEMT%DBEMT%element,2), size(x%BEMT%DBEMT%element,1), size(x%BEMT%DBEMT%element(1,1)%vind_1), Blade, BladeNode, StateIndex ) - x%BEMT%DBEMT%element(BladeNode,Blade)%vind_1(StateIndex) = x%BEMT%DBEMT%element(BladeNode,Blade)%vind_1(StateIndex) + dx * perturb_sign - endif - - else - - n_tmp = n - p%BEMT%DBEMT%lin_nx - - if (n_tmp <= p%BEMT%UA%lin_nx) then - BladeNode = p%BEMT%UA%lin_xIndx(n_tmp,1) ! node - Blade = p%BEMT%UA%lin_xIndx(n_tmp,2) ! blade - StateIndex = p%BEMT%UA%lin_xIndx(n_tmp,3) ! state - - x%BEMT%UA%element(BladeNode,Blade)%x(StateIndex) = x%BEMT%UA%element(BladeNode,Blade)%x(StateIndex) + dx * perturb_sign - else - StateIndex = n_tmp - p%BEMT%UA%lin_nx - x%BEMT%V_w(StateIndex) = x%BEMT%V_w(StateIndex) + dx * perturb_sign - end if - end if - -contains - subroutine GetStateIndices( Indx, NumberOfBlades, NumberOfElementsPerBlade, NumberOfStatesPerElement, Blade, BladeNode, StateIndex ) - - integer(IntKi), intent(in ) :: Indx - integer(IntKi), intent(in ) :: NumberOfBlades !< how many blades (size of array) - integer(IntKi), intent(in ) :: NumberOfElementsPerBlade !< how many nodes per blades (size of array) - integer(IntKi), intent(in ) :: NumberOfStatesPerElement !< how many states at each blade element - - integer(IntKi), intent( out) :: Blade - integer(IntKi), intent( out) :: BladeNode - integer(IntKi), intent( out) :: StateIndex - - integer(IntKi) :: CheckNum - - - StateIndex = mod(Indx-1, NumberOfStatesPerElement ) + 1 ! returns a number in [1,NumberOfStatesPerElement] - - CheckNum = (Indx - StateIndex)/NumberOfStatesPerElement - BladeNode = mod(CheckNum, NumberOfElementsPerBlade ) + 1 ! returns a number in [1,NumberOfElementsPerBlade] - - Blade = (CheckNum - BladeNode + 1)/NumberOfElementsPerBlade + 1 - - end subroutine GetStateIndices -END SUBROUTINE Perturb_x !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. !! Do not change this packing without making sure subroutine aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters TYPE(AD_ParameterType) , INTENT(IN ) :: p_AD !< parameters TYPE(RotOutputType) , INTENT(IN ) :: y_p !< AD outputs at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) @@ -7281,11 +6561,15 @@ SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) ! local variables: INTEGER(IntKi) :: k ! loop over blades INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - indx_first = 1 - if (.not. p_AD%CompAeroMaps) call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) + if (.not. p_AD%CompAeroMaps) then + call PackLoadMesh_dY(y_p%NacelleLoad, y_m%NacelleLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%HubLoad, y_m%HubLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%TFinLoad, y_m%TFinLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) + endif do k=1,p%NumBl_Lin call PackLoadMesh_dY(y_p%BladeLoad(k), y_m%BladeLoad(k), dY, indx_first) @@ -7300,67 +6584,6 @@ SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) dY = dY / (delta_p + delta_m) END SUBROUTINE Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two continuous state types to compute an array of differences. -!! Do not change this packing without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) - - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters - TYPE(RotContinuousStateType) , INTENT(IN ) :: x_p !< AD continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(RotContinuousStateType) , INTENT(IN ) :: x_m !< AD continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta_p !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(IN ) :: delta_m !< difference in inputs or states \f$ delta_m = \Delta_m u \f$ or \f$ delta_m = \Delta_m x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: i ! loop over blade nodes - INTEGER(IntKi) :: j ! loop over blades - INTEGER(IntKi) :: k ! loop over states - INTEGER(IntKi) :: n ! loop over active UA states - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - - - indx_first = 1 - - if (p%BEMT%DBEMT%lin_nx > 0) then - - do j=1,size(x_p%BEMT%DBEMT%element,2) ! number of blades - do i=1,size(x_p%BEMT%DBEMT%element,1) ! number of nodes per blade - dX(indx_first:indx_first+1) = x_p%BEMT%DBEMT%element(i,j)%vind - x_m%BEMT%DBEMT%element(i,j)%vind - indx_first = indx_first + size(x_p%BEMT%DBEMT%element(i,j)%vind) !+= 2 - end do - end do - - do j=1,size(x_p%BEMT%DBEMT%element,2) ! number of blades - do i=1,size(x_p%BEMT%DBEMT%element,1) ! number of nodes per blade - dX(indx_first:indx_first+1) = x_p%BEMT%DBEMT%element(i,j)%vind_1 - x_m%BEMT%DBEMT%element(i,j)%vind_1 - indx_first = indx_first + size(x_p%BEMT%DBEMT%element(i,j)%vind_1) !+=2 - end do - end do - - end if - - if (p%BEMT%UA%lin_nx>0) then - do n=1,p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - dX(indx_first) = x_p%BEMT%UA%element(i,j)%x(k) - x_m%BEMT%UA%element(i,j)%x(k) - - indx_first = indx_first + 1 - end do - - end if - - if (p%BEMT%lin_nx>0) then ! skewWake - !do j=1,size(x_p%BEMT%v_w) - ! dX(indx_first) = x_p%BEMT%v_w(j) - x_m%BEMT%v_w(j) - ! indx_first = indx_first + 1 - !end do - end if - dX = dX / (delta_p + delta_m) - -END SUBROUTINE Compute_dX subroutine AD_PackStateValues(p, x, Ary) type(RotParameterType), intent(in) :: p @@ -7458,21 +6681,22 @@ subroutine AD_PackInputValues(p, u, Ary) type(RotInputType), intent(in) :: u real(R8Ki), intent(out) :: Ary(:) integer(IntKi) :: k - call MV_Pack(p%Vars%u, p%iVarTowerMotion, u%TowerMotion, Ary) + call MV_Pack(p%Vars%u, p%iVarNacelleMotion, u%NacelleMotion, Ary) call MV_Pack(p%Vars%u, p%iVarHubMotion, u%HubMotion, Ary) - do k = 1,p%NumBlades + call MV_Pack(p%Vars%u, p%iVarTFinMotion, u%TFinMotion, Ary) + call MV_Pack(p%Vars%u, p%iVarTowerMotion, u%TowerMotion, Ary) + do k = 1, p%NumBlades call MV_Pack(p%Vars%u, p%iVarBladeRootMotion(k), u%BladeRootMotion(k), Ary) end do - do k = 1,p%NumBlades + do k = 1, p%NumBlades call MV_Pack(p%Vars%u, p%iVarBladeMotion(k), u%BladeMotion(k), Ary) end do - do k = 1,p%NumBlades - call MV_Pack(p%Vars%u, p%iVarInflowOnBlade(k), u%Bld(k)%InflowOnBlade, Ary) - end do - call MV_Pack(p%Vars%u, p%iVarInflowOnTower, u%InflowOnTower, Ary) - do k = 1,p%NumBlades + do k = 1, p%NumBlades call MV_Pack(p%Vars%u, p%iVarUserProp(k), u%UserProp(:,k), Ary) end do + call MV_Pack(p%Vars%u, p%iVarHWindSpeed, 0.0_R8Ki, Ary) + call MV_Pack(p%Vars%u, p%iVarPLexp, 0.0_R8Ki, Ary) + call MV_Pack(p%Vars%u, p%iVarPropagationDir, 0.0_R8Ki, Ary) end subroutine subroutine AD_UnpackInputValues(p, Ary, u) @@ -7480,37 +6704,48 @@ subroutine AD_UnpackInputValues(p, Ary, u) real(R8Ki), intent(in) :: Ary(:) type(RotInputType), intent(inout) :: u integer(IntKi) :: k - call MV_Unpack(p%Vars%u, p%iVarTowerMotion, Ary, u%TowerMotion) + call MV_Unpack(p%Vars%u, p%iVarNacelleMotion, Ary, u%NacelleMotion) call MV_Unpack(p%Vars%u, p%iVarHubMotion, Ary, u%HubMotion) - do k = 1,p%NumBlades + call MV_Unpack(p%Vars%u, p%iVarTFinMotion, Ary, u%TFinMotion) + call MV_Unpack(p%Vars%u, p%iVarTowerMotion, Ary, u%TowerMotion) + do k = 1, p%NumBlades call MV_Unpack(p%Vars%u, p%iVarBladeRootMotion(k), Ary, u%BladeRootMotion(k)) end do - do k = 1,p%NumBlades + do k = 1, p%NumBlades call MV_Unpack(p%Vars%u, p%iVarBladeMotion(k), Ary, u%BladeMotion(k)) end do - do k = 1,p%NumBlades - call MV_Unpack(p%Vars%u, p%iVarInflowOnBlade(k), Ary, u%Bld(k)%InflowOnBlade) - end do - call MV_Unpack(p%Vars%u, p%iVarInflowOnTower, Ary, u%InflowOnTower) - do k = 1,p%NumBlades + do k = 1, p%NumBlades call MV_Unpack(p%Vars%u, p%iVarUserProp(k), Ary, u%UserProp(:,k)) end do end subroutine +subroutine AD_UnpackExtendedInputValues(p, Ary, FF) + type(RotParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Ary(:) + type(FlowFieldType), intent(inout) :: FF + FF%Uniform%DataSize = 1 + call MV_Unpack(p%Vars%u, p%iVarHWindSpeed, Ary, FF%Uniform%VelH(1)) + call MV_Unpack(p%Vars%u, p%iVarPLexp, Ary, FF%Uniform%ShrV(1)) + call MV_Unpack(p%Vars%u, p%iVarPropagationDir, Ary, FF%Uniform%AngleH(1)) +end subroutine + subroutine AD_PackOutputValues(p, y, Ary, PackWriteOutput) type(RotParameterType), intent(in) :: p type(RotOutputType), intent(in) :: y real(R8Ki), intent(out) :: Ary(:) logical, intent(in) :: PackWriteOutput integer(IntKi) :: k + call MV_Pack(p%Vars%y, p%iVarNacelleLoad, y%NacelleLoad, Ary) + call MV_Pack(p%Vars%y, p%iVarHubLoad, y%HubLoad, Ary) + call MV_Pack(p%Vars%y, p%iVarTFinLoad, y%TFinLoad, Ary) call MV_Pack(p%Vars%y, p%iVarTowerLoad, y%TowerLoad, Ary) do k = 1, p%NumBlades call MV_Pack(p%Vars%y, p%iVarBladeLoad(k), y%BladeLoad(k), Ary) end do if (PackWriteOutput) then - ! do k = p%iVarWriteOut, size(p%Vars%y) - ! call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) - ! end do + do k = p%iVarWriteOutput, size(p%Vars%y) + call MV_Pack(p%Vars%y, k, y%WriteOutput(p%Vars%y(k)%iUsr(1)), Ary) + end do end if end subroutine diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 633bbba3f5..bd112c19f4 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -266,17 +266,20 @@ typedef ^ OtherStateType ReKi WakeLocationPoints {:}{:} - - "wake points velocit typedef ^ RotParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ RotParameterType IntKi iVarDBEMT - 0 - "" - typedef ^ RotParameterType IntKi iVarUA - 0 - "" - -typedef ^ RotParameterType IntKi iVarTowerMotion - 0 - "" - typedef ^ RotParameterType IntKi iVarNacelleMotion - 0 - "" - typedef ^ RotParameterType IntKi iVarHubMotion - 0 - "" - +typedef ^ RotParameterType IntKi iVarTFinMotion - 0 - "" - +typedef ^ RotParameterType IntKi iVarTowerMotion - 0 - "" - typedef ^ RotParameterType IntKi iVarBladeRootMotion {:} - - "" - typedef ^ RotParameterType IntKi iVarBladeMotion {:} - - "" - -typedef ^ RotParameterType IntKi iVarInflowOnBlade {:} - - "" - -typedef ^ RotParameterType IntKi iVarInflowOnTower - 0 - "" - typedef ^ RotParameterType IntKi iVarUserProp {:} - - "" - -typedef ^ RotParameterType IntKi iVarTowerLoad - 0 - "" - -typedef ^ RotParameterType IntKi iVarHubLoad - 0 - "" - +typedef ^ RotParameterType IntKi iVarHWindSpeed - - - "" - +typedef ^ RotParameterType IntKi iVarPLexp - - - "" - +typedef ^ RotParameterType IntKi iVarPropagationDir - - - "" - typedef ^ RotParameterType IntKi iVarNacelleLoad - 0 - "" - +typedef ^ RotParameterType IntKi iVarHubLoad - 0 - "" - +typedef ^ RotParameterType IntKi iVarTFinLoad - 0 - "" - +typedef ^ RotParameterType IntKi iVarTowerLoad - 0 - "" - typedef ^ RotParameterType IntKi iVarBladeLoad {:} - - "" - typedef ^ RotParameterType IntKi iVarWriteOutput - 0 - "" - typedef ^ RotParameterType IntKi NumBlades - - - "Number of blades on the turbine" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index d30d1deaf2..7d29156508 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -314,17 +314,20 @@ MODULE AeroDyn_Types TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] INTEGER(IntKi) :: iVarDBEMT = 0 !< [-] INTEGER(IntKi) :: iVarUA = 0 !< [-] - INTEGER(IntKi) :: iVarTowerMotion = 0 !< [-] INTEGER(IntKi) :: iVarNacelleMotion = 0 !< [-] INTEGER(IntKi) :: iVarHubMotion = 0 !< [-] + INTEGER(IntKi) :: iVarTFinMotion = 0 !< [-] + INTEGER(IntKi) :: iVarTowerMotion = 0 !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeRootMotion !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeMotion !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarInflowOnBlade !< [-] - INTEGER(IntKi) :: iVarInflowOnTower = 0 !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarUserProp !< [-] - INTEGER(IntKi) :: iVarTowerLoad = 0 !< [-] - INTEGER(IntKi) :: iVarHubLoad = 0 !< [-] + INTEGER(IntKi) :: iVarHWindSpeed = 0_IntKi !< [-] + INTEGER(IntKi) :: iVarPLexp = 0_IntKi !< [-] + INTEGER(IntKi) :: iVarPropagationDir = 0_IntKi !< [-] INTEGER(IntKi) :: iVarNacelleLoad = 0 !< [-] + INTEGER(IntKi) :: iVarHubLoad = 0 !< [-] + INTEGER(IntKi) :: iVarTFinLoad = 0 !< [-] + INTEGER(IntKi) :: iVarTowerLoad = 0 !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeLoad !< [-] INTEGER(IntKi) :: iVarWriteOutput = 0 !< [-] INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] @@ -3002,9 +3005,10 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if DstRotParameterTypeData%iVarDBEMT = SrcRotParameterTypeData%iVarDBEMT DstRotParameterTypeData%iVarUA = SrcRotParameterTypeData%iVarUA - DstRotParameterTypeData%iVarTowerMotion = SrcRotParameterTypeData%iVarTowerMotion DstRotParameterTypeData%iVarNacelleMotion = SrcRotParameterTypeData%iVarNacelleMotion DstRotParameterTypeData%iVarHubMotion = SrcRotParameterTypeData%iVarHubMotion + DstRotParameterTypeData%iVarTFinMotion = SrcRotParameterTypeData%iVarTFinMotion + DstRotParameterTypeData%iVarTowerMotion = SrcRotParameterTypeData%iVarTowerMotion if (allocated(SrcRotParameterTypeData%iVarBladeRootMotion)) then LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) @@ -3029,19 +3033,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if DstRotParameterTypeData%iVarBladeMotion = SrcRotParameterTypeData%iVarBladeMotion end if - if (allocated(SrcRotParameterTypeData%iVarInflowOnBlade)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarInflowOnBlade, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarInflowOnBlade, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarInflowOnBlade)) then - allocate(DstRotParameterTypeData%iVarInflowOnBlade(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarInflowOnBlade.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%iVarInflowOnBlade = SrcRotParameterTypeData%iVarInflowOnBlade - end if - DstRotParameterTypeData%iVarInflowOnTower = SrcRotParameterTypeData%iVarInflowOnTower if (allocated(SrcRotParameterTypeData%iVarUserProp)) then LB(1:1) = lbound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) UB(1:1) = ubound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) @@ -3054,9 +3045,13 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if DstRotParameterTypeData%iVarUserProp = SrcRotParameterTypeData%iVarUserProp end if - DstRotParameterTypeData%iVarTowerLoad = SrcRotParameterTypeData%iVarTowerLoad - DstRotParameterTypeData%iVarHubLoad = SrcRotParameterTypeData%iVarHubLoad + DstRotParameterTypeData%iVarHWindSpeed = SrcRotParameterTypeData%iVarHWindSpeed + DstRotParameterTypeData%iVarPLexp = SrcRotParameterTypeData%iVarPLexp + DstRotParameterTypeData%iVarPropagationDir = SrcRotParameterTypeData%iVarPropagationDir DstRotParameterTypeData%iVarNacelleLoad = SrcRotParameterTypeData%iVarNacelleLoad + DstRotParameterTypeData%iVarHubLoad = SrcRotParameterTypeData%iVarHubLoad + DstRotParameterTypeData%iVarTFinLoad = SrcRotParameterTypeData%iVarTFinLoad + DstRotParameterTypeData%iVarTowerLoad = SrcRotParameterTypeData%iVarTowerLoad if (allocated(SrcRotParameterTypeData%iVarBladeLoad)) then LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) @@ -3403,9 +3398,6 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) if (allocated(RotParameterTypeData%iVarBladeMotion)) then deallocate(RotParameterTypeData%iVarBladeMotion) end if - if (allocated(RotParameterTypeData%iVarInflowOnBlade)) then - deallocate(RotParameterTypeData%iVarInflowOnBlade) - end if if (allocated(RotParameterTypeData%iVarUserProp)) then deallocate(RotParameterTypeData%iVarUserProp) end if @@ -3512,17 +3504,20 @@ subroutine AD_PackRotParameterType(RF, Indata) end if call RegPack(RF, InData%iVarDBEMT) call RegPack(RF, InData%iVarUA) - call RegPack(RF, InData%iVarTowerMotion) call RegPack(RF, InData%iVarNacelleMotion) call RegPack(RF, InData%iVarHubMotion) + call RegPack(RF, InData%iVarTFinMotion) + call RegPack(RF, InData%iVarTowerMotion) call RegPackAlloc(RF, InData%iVarBladeRootMotion) call RegPackAlloc(RF, InData%iVarBladeMotion) - call RegPackAlloc(RF, InData%iVarInflowOnBlade) - call RegPack(RF, InData%iVarInflowOnTower) call RegPackAlloc(RF, InData%iVarUserProp) - call RegPack(RF, InData%iVarTowerLoad) - call RegPack(RF, InData%iVarHubLoad) + call RegPack(RF, InData%iVarHWindSpeed) + call RegPack(RF, InData%iVarPLexp) + call RegPack(RF, InData%iVarPropagationDir) call RegPack(RF, InData%iVarNacelleLoad) + call RegPack(RF, InData%iVarHubLoad) + call RegPack(RF, InData%iVarTFinLoad) + call RegPack(RF, InData%iVarTowerLoad) call RegPackAlloc(RF, InData%iVarBladeLoad) call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%NumBlades) @@ -3638,17 +3633,20 @@ subroutine AD_UnPackRotParameterType(RF, OutData) end if call RegUnpack(RF, OutData%iVarDBEMT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarUA); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTowerMotion); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarNacelleMotion); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarHubMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTFinMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTowerMotion); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iVarBladeRootMotion); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iVarBladeMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarInflowOnBlade); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarInflowOnTower); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iVarUserProp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTowerLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHubLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPLexp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPropagationDir); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarNacelleLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHubLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTFinLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTowerLoad); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iVarBladeLoad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return From b9853c55693aeaa0a3018573f540fdbfdde636f3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Feb 2024 00:23:27 +0000 Subject: [PATCH 081/319] Update test list and r-test pointer --- reg_tests/CTestList.cmake | 3 +++ reg_tests/r-test | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 84117dc328..b15eb0d8fa 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -348,9 +348,12 @@ of_regression_linear("WP_Stationary_Linear" "" "openfas of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "-highpass=0.05" "openfast;linear;beamdyn") of_regression_linear("Ideal_Beam_Free_Free_Linear" "-highpass=0.05" "openfast;linear;beamdyn") of_regression_linear("5MW_Land_BD_Linear" "" "openfast;linear;beamdyn;servodyn") +of_regression_linear("5MW_Land_BD_Linear_Aero" "" "openfast;linear;beamdyn;servodyn") +of_regression_linear("5MW_Land_Linear_Aero" "" "openfast;linear;beamdyn;servodyn") of_regression_linear("5MW_OC4Semi_Linear" "" "openfast;linear;hydrodyn;servodyn") of_regression_linear("StC_test_OC4Semi_Linear_Nac" "" "openfast;linear;servodyn;stc") of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfast;linear;servodyn;stc") +of_regression_linear("5MW_OC3Spar_Linear" "" "openfast;linear;servodyn;stc") # FAST Farm regression tests if(BUILD_FASTFARM) diff --git a/reg_tests/r-test b/reg_tests/r-test index ae1afd59f3..96697bf743 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit ae1afd59f3d82971c5e53bbe9960a8c588d64fb1 +Subproject commit 96697bf7436d6583e62f34eedc09578c16a3c669 From c8a94feb8e746f6eea88eb197ced4d2d73f599aa Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Feb 2024 02:08:58 +0000 Subject: [PATCH 082/319] 5MW_Land_Linear_Aero mostly working --- modules/aerodyn/src/AeroDyn.f90 | 262 +-- modules/aerodyn/src/AeroDyn_Registry.txt | 73 - modules/aerodyn/src/AeroDyn_Types.f90 | 1472 ++++++++++++----- modules/elastodyn/src/ElastoDyn.f90 | 22 +- modules/elastodyn/src/ElastoDyn_Registry.txt | 2 + modules/elastodyn/src/ElastoDyn_Types.f90 | 8 + modules/inflowwind/src/IfW_FlowField.f90 | 4 +- modules/inflowwind/src/InflowWind.f90 | 174 +- modules/inflowwind/src/InflowWind.txt | 14 +- modules/inflowwind/src/InflowWind_Types.f90 | 108 ++ modules/openfast-library/src/FAST_Funcs.f90 | 57 +- modules/openfast-library/src/FAST_Mapping.f90 | 121 +- modules/openfast-library/src/FAST_ModLin.f90 | 31 + modules/openfast-library/src/FAST_Subs.f90 | 5 + 14 files changed, 1639 insertions(+), 714 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 3b3d244a1f..07cc0705d2 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -31,7 +31,8 @@ module AeroDyn use UnsteadyAero use FVW use FVW_Subs, only: FVW_AeroOuts - use IfW_FlowField, only: IfW_FlowField_GetVelAcc, IfW_UniformWind_GetOP, IfW_UniformWind_Perturb, IfW_FlowField_CopyFlowFieldType + use IfW_FlowField_Types + use IfW_FlowField, only: IfW_FlowField_GetVelAcc implicit none private @@ -3607,7 +3608,6 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) real(ReKi) :: Cx, Cy real(ReKi) :: Cl_Static, Cd_Static, Cm_Static, Cpmin real(ReKi) :: Cl_dyn, Cd_dyn, Cm_dyn - type(UA_InputType), pointer :: u_UA ! Alias to shorten notations integer(IntKi), parameter :: InputIndex=1 ! we will always use values at t in this routine integer(intKi) :: iR, iW integer(intKi) :: ErrStat2 @@ -3647,21 +3647,22 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) Cm_dyn = AFI_interp%Cm if (p%UA_Flag) then - u_UA => m%FVW%W(iW)%u_UA(j,InputIndex) ! Alias - ! ....... compute inputs to UA ........... - u_UA%alpha = alpha - u_UA%U = Vrel - u_UA%Re = Re - ! calculated in m%FVW%u_UA??? :u_UA%UserProp = 0.0_ReKi ! FIX ME - - u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U - u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U - ! calculated in m%FVW%u_UA??? : u_UA%omega = dot_product( u%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade - call UA_CalcOutput(j, 1, t, u_UA, m%FVW%W(iW)%p_UA, x%FVW%UA(iW), xd%FVW%UA(iW), OtherState%FVW%UA(iW), p%AFI(p%FVW%W(iW)%AFindx(j,1)), m%FVW%W(iW)%y_UA, m%FVW%W(iW)%m_UA, errStat2, errMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetOutputsFromFVW') - Cl_dyn = m%FVW%W(iW)%y_UA%Cl - Cd_dyn = m%FVW%W(iW)%y_UA%Cd - Cm_dyn = m%FVW%W(iW)%y_UA%Cm + associate(u_UA => m%FVW%W(iW)%u_UA(j,InputIndex)) + ! ....... compute inputs to UA ........... + u_UA%alpha = alpha + u_UA%U = Vrel + u_UA%Re = Re + ! calculated in m%FVW%u_UA??? :u_UA%UserProp = 0.0_ReKi ! FIX ME + + u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U + u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U + ! calculated in m%FVW%u_UA??? : u_UA%omega = dot_product( u%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade + call UA_CalcOutput(j, 1, t, u_UA, m%FVW%W(iW)%p_UA, x%FVW%UA(iW), xd%FVW%UA(iW), OtherState%FVW%UA(iW), p%AFI(p%FVW%W(iW)%AFindx(j,1)), m%FVW%W(iW)%y_UA, m%FVW%W(iW)%m_UA, errStat2, errMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetOutputsFromFVW') + Cl_dyn = m%FVW%W(iW)%y_UA%Cl + Cd_dyn = m%FVW%W(iW)%y_UA%Cd + Cm_dyn = m%FVW%W(iW)%y_UA%Cm + end associate end if cp = cos(phi) sp = sin(phi) @@ -5333,7 +5334,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD character(4) :: RotorLabel character(64) :: NodeLabel character(1), parameter :: UVW(3) = ['U','V','W'] - real(R8Ki) :: PerturbAng, PerturbTower, PerturbBlade(MaxBl) + real(R8Ki) :: Perturb, PerturbTower, PerturbBlade(MaxBl) integer(IntKi) :: i, j, k ErrStat = ErrID_None @@ -5353,6 +5354,22 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD ! Create rotor label RotorLabel = 'R'//trim(Num2LStr(RotNum)) + !---------------------------------------------------------------------------- + ! Perturbation values + !---------------------------------------------------------------------------- + + Perturb = 2.0_R8Ki * D2R_D + + do k = 1, p%NumBlades + PerturbBlade(k) = 0.2_R8Ki * D2R_D * InputFileData%BladeProps(k)%BlSpn(InputFileData%BladeProps(k)%NumBlNds) + end do + + if (u%TowerMotion%NNodes > 0) then + PerturbTower = 0.2_R8Ki * D2R_D * u%TowerMotion%Position(3, u%TowerMotion%NNodes) + else + PerturbTower = 0.0_R8Ki + end if + !---------------------------------------------------------------------------- ! Continuous State Variables !---------------------------------------------------------------------------- @@ -5366,17 +5383,17 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Num=p%NumBlNds*2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & - Perturb=PerturbAng, & - LinNames=[([DBEMTLinName(j, i, "axial"), & - DBEMTLinName(j, i, "tangential")], i = 1, p%NumBlNds)]) + Perturb=Perturb, & + LinNames=[([DBEMTLinName(j, i, "axial", .false.), & + DBEMTLinName(j, i, "tangential", .false.)], i = 1, p%NumBlNds)]) end do do j = 1, p%NumBlades call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Num=p%NumBlNds*2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & - Perturb=PerturbAng, & - LinNames=[(['First time derivative of '//DBEMTLinName(j, i, "axial"), & - 'First time derivative of '//DBEMTLinName(j, i, "axial")], i = 1, p%NumBlNds)]) + Perturb=Perturb, & + LinNames=[([DBEMTLinName(j, i, "axial", .true.), & + DBEMTLinName(j, i, "tangential", .true.)], i = 1, p%NumBlNds)]) end do else p%iVarDBEMT = 0 @@ -5391,15 +5408,15 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD if (p%BEMT%UA%UAMod/=UA_OYE) then call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=PerturbAng, & + Perturb=Perturb, & LinNames=['x1 '//trim(NodeLabel)//', rad']) call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=PerturbAng, & + Perturb=Perturb, & LinNames=['x2 '//trim(NodeLabel)//', rad']) call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=PerturbAng, & + Perturb=Perturb, & LinNames=['x3 '//trim(NodeLabel)//', -']) endif @@ -5423,67 +5440,54 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD ! Input variables !---------------------------------------------------------------------------- - PerturbAng = 2.0_R8Ki * D2R_D - - do k = 1, p%NumBlades - PerturbBlade(k) = 0.2_R8Ki * D2R_D * InputFileData%BladeProps(k)%BlSpn(InputFileData%BladeProps(k)%NumBlNds) - end do - - if (u%TowerMotion%NNodes > 0) then - PerturbTower = 0.2_R8Ki * D2R_D * u%TowerMotion%Position(3, u%TowerMotion%NNodes) - else - PerturbTower = 0.0_R8Ki - end if - ! Add Nacelle motion - call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"NacelleMotion", & + call MV_AddMeshVar(p%Vars%u, "Nacelle", & VarIdx=p%iVarNacelleMotion, & Mesh=u%NacelleMotion, & Fields=[VF_TransDisp, VF_Orientation], & - Perturbs=[PerturbBlade(1), PerturbAng]) + Perturbs=[PerturbBlade(1), Perturb]) ! Add hub motion - call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"HubMotion", & + call MV_AddMeshVar(p%Vars%u, "Hub", & VarIdx=p%iVarHubMotion, & Mesh=u%HubMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel], & - Perturbs=[PerturbBlade(1), PerturbAng, PerturbAng]) + Perturbs=[PerturbBlade(1), Perturb, Perturb]) ! Add tail fin motion - call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"TFinMotion", & + call MV_AddMeshVar(p%Vars%u, "TFin", & VarIdx=p%iVarTFinMotion, & Mesh=u%TFinMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_TransVel], & - Perturbs=[PerturbAng, PerturbAng, PerturbAng]) + Perturbs=[Perturb, Perturb, Perturb]) ! Add tower motion - call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"TowerMotion", & + call MV_AddMeshVar(p%Vars%u, "Tower", & VarIdx=p%iVarTowerMotion, & Mesh=u%TowerMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_TransAcc], & - Perturbs=[PerturbTower, PerturbAng, PerturbTower, PerturbTower]) + Perturbs=[PerturbTower, Perturb, PerturbTower, PerturbTower]) ! Add blade root motion call AllocAry(p%iVarBladeRootMotion, p%NumBlades, "iVarBladeRootMotion", ErrStat2, ErrMsg2); if (Failed()) return p%iVarBladeRootMotion = 0 do j = 1, p%NumBlades - call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"BladeRootMotion"//IdxStr(j), & + call MV_AddMeshVar(p%Vars%u, "Blade root "//Num2LStr(j), & VarIdx=p%iVarBladeRootMotion(j), & - Flags=VF_Linearize, & Mesh=u%BladeRootMotion(j), & Fields=[VF_Orientation], & - Perturbs=[PerturbAng]) + Perturbs=[Perturb]) end do ! Add blade motion call AllocAry(p%iVarBladeMotion, p%NumBlades, "iVarBladeMotion", ErrStat2, ErrMsg2); if (Failed()) return p%iVarBladeMotion = 0 do j = 1, p%NumBlades - call MV_AddMeshVar(p%Vars%u, trim(RotorLabel)//"BladeMotion"//IdxStr(j), & + call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(j), & VarIdx=p%iVarBladeMotion(j), & Mesh=u%BladeMotion(j), & Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc], & - Perturbs=[PerturbBlade(j), PerturbAng, PerturbBlade(j), PerturbAng, PerturbBlade(j), PerturbAng]) + Perturbs=[PerturbBlade(j), Perturb, PerturbBlade(j), Perturb, PerturbBlade(j), Perturb]) ! Set AeroMap flag on subset of fields for first blade if (j == 1) then do k = p%iVarBladeMotion(j), size(p%Vars%u) @@ -5499,9 +5503,9 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call AllocAry(p%iVarUserProp, p%NumBlades, "iVarUserProp", ErrStat2, ErrMsg2); if (Failed()) return p%iVarUserProp = 0 do j = 1, p%NumBlades - call MV_AddVar(p%Vars%u, trim(RotorLabel)//"UserProp Blade"//IdxStr(k), VF_Scalar, & + call MV_AddVar(p%Vars%u, "UserProp Blade"//IdxStr(k), VF_Scalar, & VarIdx=p%iVarUserProp(j), & - Flags=VF_RotFrame, & + Flags=ior(VF_Linearize, VF_RotFrame), & Num=p%NumBlNds, & Perturb=2.0_R8Ki*D2R_D, & LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(k))//', -', k = 1, p%NumBlNds)]) @@ -5531,22 +5535,22 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD !---------------------------------------------------------------------------- ! Add nacelle load - call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"NacelleLoad", LoadFields, & + call MV_AddMeshVar(p%Vars%y, "Nacelle", LoadFields, & VarIdx=p%iVarNacelleLoad, & Mesh=y%NacelleLoad) ! Add hub load - call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"HubLoad", LoadFields, & + call MV_AddMeshVar(p%Vars%y, "Hub", LoadFields, & VarIdx=p%iVarHubLoad, & Mesh=y%HubLoad) ! Add tail fin load - call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"TFinLoad", LoadFields, & + call MV_AddMeshVar(p%Vars%y, "TFin", LoadFields, & VarIdx=p%iVarTFinLoad, & Mesh=y%TFinLoad) ! Add tower load - call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"TowerLoad", LoadFields, & + call MV_AddMeshVar(p%Vars%y, "Tower", LoadFields, & VarIdx=p%iVarTowerLoad, & Mesh=y%TowerLoad) @@ -5554,9 +5558,9 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call AllocAry(p%iVarBladeLoad, p%NumBlades, "iVarBladeLoad", ErrStat2, ErrMsg2); if (Failed()) return p%iVarBladeLoad = 0 do j = 1, p%NumBlades - call MV_AddMeshVar(p%Vars%y, trim(RotorLabel)//"BladeLoad"//IdxStr(j), LoadFields, & + call MV_AddMeshVar(p%Vars%y, "Blade "//Num2LStr(j), LoadFields, & VarIdx=p%iVarBladeLoad(j), & - Flags=VF_AeroMap, & + Flags=ior(VF_AeroMap, VF_Line), & Mesh=y%BladeLoad(j)) end do @@ -5607,10 +5611,12 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD contains - character(LinChanLen) function DBEMTLinName(BladeNum, NodeNum, Direction) + character(LinChanLen) function DBEMTLinName(BladeNum, NodeNum, Direction, Deriv) integer(IntKi), intent(in) :: BladeNum, NodeNum character(*), intent(in) :: Direction + logical, intent(in) :: Deriv DBEMTLinName = 'vind ('//trim(Direction)//') at blade '//trim(Num2LStr(BladeNum))//', node '//trim(Num2LStr(NodeNum))//', m/s' + if (Deriv) DBEMTLinName = 'First time derivative of '//trim(DBEMTLinName)//"/s" end function pure integer(IntKi) function OutParamFlags(ind) @@ -5645,7 +5651,7 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point @@ -5677,12 +5683,12 @@ END SUBROUTINE AD_JacobianPInput !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter ) !.................................................................................................................................. - use IfW_FlowField, only: FlowFieldType, Uniform_FieldType, UniformField_InterpLinea + use IfW_FlowField, only: FlowFieldType, UniformField_InterpLinear REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ParameterType), INTENT(INOUT) :: p_AD !< Parameters + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point TYPE(RotDiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point @@ -5708,9 +5714,9 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col type(UniformField_Interp) :: UF_op - type(FLowFieldType),target :: FlowField_perturb - type(FLowFieldType),pointer :: FlowField_perturb_p ! need a pointer in the CalcWind_Rotor routine - type(RotInflowType) + type(FlowFieldType),target :: FF_perturb + type(FlowFieldType),pointer :: FF_ptr ! need a pointer in the CalcWind_Rotor routine + type(RotInflowType) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs ErrStat = ErrID_None ErrMsg = '' @@ -5724,58 +5730,32 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y FlagFilterLoc = VF_None end if - ! Associate temporary pointer to FlowField in parameters, will be restored at end of routine - FF_original => p_AD%FlowField - - ! Associate parameters flow field pointer with temporary structure - p_AD%FlowField => FF - - ! Get extended input values from uniform flow field - UF_op = UniformField_InterpLinear(p_AD%FlowField%Uniform, t) - - ! Make a copy of the flowfield to perturb - call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FF, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - FF%Uniform%DataSize = 1 - FF%Uniform%Time(1) = t - FF%Uniform%VelH(1) = UF_op%VelH - FF%Uniform%VelV(1) = UF_op%VelV - FF%Uniform%VelGust(1) = UF_op%VelGust - FF%Uniform%AngleH(1) = UF_op%AngleH - FF%Uniform%AngleV(1) = UF_op%AngleV - FF%Uniform%ShrH(1) = UF_op%ShrH - FF%Uniform%ShrV(1) = UF_op%ShrV - FF%Uniform%LinShrV(1) = UF_op%LinShrV - ! Get OP values here (i.e., set inputs for BEMT): if (p%FrozenWake) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return + call SetInputs(p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return ! compare m%BEMT_y arguments with call to BEMT_CalcOutput call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT) m%BEMT%UseFrozenWake = .true. end if - ! Copy inputs and pack them for perturbation - call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackInputValues(p, u, m%Jac%u) - - ! Pack extended inputs for perturbation - call MV_Pack(p%Vars%u, p%iVarHWindSpeed, UF_op%VelH, m%Jac%u) - call MV_Pack(p%Vars%u, p%iVarPLexp, UF_op%ShrV, m%Jac%u) - call MV_Pack(p%Vars%u, p%iVarPropagationDir, UF_op%AngleH + p_AD%FlowField%PropagationDir, m%Jac%u) - ! Copy continuous and other states for initialization call AD_CopyRotContinuousStateType(x, m%x_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Initialize x_init so that we get accurrate values for first step ! changes values only if states haven't been initialized if (.not. OtherState%BEMT%nodesInitialized) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return + call SetInputs(p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, m%x_init%BEMT, xd%BEMT, z%BEMT, & m%OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2); if (Failed()) return end if + ! Copy inputs and pack them for perturbation + call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackInputValues(p, u, m%Jac%u) + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -5783,6 +5763,20 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y if (.not. allocated(dYdu)) then call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if + + ! Copy rotor inflow type for perturbation + call AD_CopyRotInflowType(RotInflow, RotInflow_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! If performing full linearization + if (IsFullLin) then + ! Copy the flow field so it can be perturbed + ! In full linearization, flow field will be Uniform type, which as minimal data + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FF_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + FF_ptr => FF_perturb + else + ! Associate flowfield pointer to flowfield in parameters + FF_ptr => p_AD%FlowField + end if ! Loop through input variables do i = 1, size(p%Vars%u) @@ -5798,22 +5792,24 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) - call AD_UnpackExtendedInputValues(p, m%Jac%u_perturb, FF) - call SetInputs(p, p_AD, m%u_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(p, i, FF_perturb, p_AD%FlowField, 1) + call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call SetInputs(p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return - call RotCalcOutput(t, m%u_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return call AD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) - call AD_UnpackExtendedInputValues(p, m%Jac%u_perturb, FF) - call SetInputs(p, p_AD, m%u_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(p, i, FF_perturb, p_AD%FlowField, -1) + call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return + call SetInputs(p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return - call RotCalcOutput(t, m%u_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -5845,13 +5841,13 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) - call RotCalcContStateDeriv(t, m%u_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return + call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) - call RotCalcContStateDeriv(t, m%u_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return + call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index @@ -5874,6 +5870,23 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y call cleanup() contains + subroutine PerturbFlowField(p, iVar, PerturbFF, BaseFF, PerturbSign) + type(RotParameterType), intent(in) :: p + integer(IntKi), intent(in) :: iVar + type(FlowFieldType), intent(inout) :: PerturbFF + type(FlowFieldType), intent(in) :: BaseFF + integer(IntKi), intent(in) :: PerturbSign + PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH + PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV + PerturbFF%PropagationDir = BaseFF%PropagationDir + if (iVar == p%iVarHWindSpeed) then + PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH - p%Vars%u(iVar)%Perturb + else if (iVar == p%iVarPLexp) then + PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV - p%Vars%u(iVar)%Perturb + else if (iVar == p%iVarPropagationDir) then + PerturbFF%PropagationDir = BaseFF%PropagationDir - p%Vars%u(iVar)%Perturb + end if + end subroutine logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev @@ -5881,7 +5894,6 @@ logical function Failed() end function subroutine cleanup() m%BEMT%UseFrozenWake = .false. - p_AD%FlowField => FF_original end subroutine cleanup end subroutine Rot_JacobianPInput @@ -5982,7 +5994,7 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Get OP values here (i.e., set inputs for BEMT): if (p%FrozenWake) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return + call SetInputs(p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return ! compare m%BEMT_y arguments with call to BEMT_CalcOutput call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT) @@ -5996,7 +6008,7 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Initialize x_init so that we get accurrate values for first step ! changes values only if states haven't been initialized if (.not. OtherState%BEMT%nodesInitialized) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2); if (Failed()) return + call SetInputs(p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, m%x_init%BEMT, xd%BEMT, z%BEMT, & m%OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2); if (Failed()) return end if @@ -6025,13 +6037,13 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) - call RotCalcOutput( t, u, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return + call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return call AD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) - call RotCalcOutput( t, u, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return + call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return call AD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index @@ -6064,13 +6076,13 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) - call RotCalcContStateDeriv(t, u, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) - call RotCalcContStateDeriv(t, u, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index @@ -6506,7 +6518,7 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call RotCalcContStateDeriv(t, u, p, p_AD, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); If (Failed()) return + call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); If (Failed()) return call AD_PackStateValues(p, m%dxdt_lin, dx_op) END IF @@ -6586,6 +6598,7 @@ subroutine AD_PackStateValues(p, x, Ary) type(RotContinuousStateType), intent(in) :: x real(R8Ki), intent(out) :: Ary(:) integer(IntKi) :: i, j, k, ind + ind = 1 if (p%BEMT%DBEMT%lin_nx > 0) then do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) @@ -6631,7 +6644,7 @@ subroutine AD_UnpackStateValues(p, Ary, x) real(R8Ki), intent(in) :: ary(:) type(RotContinuousStateType), intent(inout) :: x integer(IntKi) :: i, j, k, ind - + ind = 1 if (p%BEMT%DBEMT%lin_nx > 0) then do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) @@ -6719,10 +6732,13 @@ subroutine AD_UnpackExtendedInputValues(p, Ary, FF) type(RotParameterType), intent(in) :: p real(R8Ki), intent(in) :: Ary(:) type(FlowFieldType), intent(inout) :: FF - FF%Uniform%DataSize = 1 - call MV_Unpack(p%Vars%u, p%iVarHWindSpeed, Ary, FF%Uniform%VelH(1)) - call MV_Unpack(p%Vars%u, p%iVarPLexp, Ary, FF%Uniform%ShrV(1)) - call MV_Unpack(p%Vars%u, p%iVarPropagationDir, Ary, FF%Uniform%AngleH(1)) + real(ReKi) :: VelH, ShrV, AngleH + call MV_Unpack(p%Vars%u, p%iVarHWindSpeed, Ary, VelH) + call MV_Unpack(p%Vars%u, p%iVarPLexp, Ary, ShrV) + call MV_Unpack(p%Vars%u, p%iVarPropagationDir, Ary, AngleH) + FF%Uniform%VelH = VelH + FF%Uniform%ShrV = ShrV + FF%Uniform%AngleH = AngleH end subroutine subroutine AD_PackOutputValues(p, y, Ary, PackWriteOutput) diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 6e680914b2..77fb40e88c 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -259,77 +259,6 @@ typedef ^ OtherStateType FVW_OtherStateType FVW - - - "OtherStates from the FVW typedef ^ OtherStateType ReKi WakeLocationPoints {:}{:} - - "wake points velocity" m/s -# Define misc/optimization variables (any data that are not considered actual states) here: -typedef ^ RotMiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - -typedef ^ RotMiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - -typedef ^ RotMiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - -typedef ^ RotMiscVarType AA_MiscVarType AA - - - "MiscVars from the AA module" - -typedef ^ RotMiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - -typedef ^ RotMiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - - -typedef ^ RotMiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ RotMiscVarType R8Ki orientationAnnulus {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - -typedef ^ RotMiscVarType R8Ki R_li {:}{:}{:}{:} - - "Transformation matrix from inertial system to the staggered polar coordinate system of a given section" - -typedef ^ RotMiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - -typedef ^ RotMiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s -typedef ^ RotMiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s -typedef ^ RotMiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s -typedef ^ RotMiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possible output to file" rad -typedef ^ RotMiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m -typedef ^ RotMiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi Z {:}{:} - - "axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m -typedef ^ RotMiscVarType ReKi Mx {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in x direction)" Nm/m -typedef ^ RotMiscVarType ReKi My {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in y direction)" Nm/m -typedef ^ RotMiscVarType ReKi Mz {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in z direction)" Nm/m -typedef ^ RotMiscVarType ReKi Vind_i {:}{:}{:} - - "Induced velocities at jth node and kth blade (3xnSpanxnB)" m/s -typedef ^ RotMiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s -typedef ^ RotMiscVarType ReKi yaw - - - "Yaw calculated in SetInputsForBEMT" rad -typedef ^ RotMiscVarType ReKi tilt - - - "tilt calculated in SetInputsForBEMT" rad -typedef ^ RotMiscVarType ReKi hub_theta_x_root {:} - - "angles saved for FAST.Farm" rad -typedef ^ RotMiscVarType ReKi V_dot_x - - - -typedef ^ RotMiscVarType MeshType HubLoad - - - "mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only)" - -typedef ^ RotMiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" -typedef ^ RotMiscVarType ReKi SigmaCavitCrit {:}{:} - - "critical cavitation number- inception value (above which cavit will occur)" - -typedef ^ RotMiscVarType ReKi SigmaCavit {:}{:} - - "cavitation number at node " - -typedef ^ RotMiscVarType Logical CavitWarnSet {:}{:} - - "cavitation warning issued " - -typedef ^ RotMiscVarType ReKi TwrFB {:}{:} - - "buoyant force per unit length at tower node" N/m -typedef ^ RotMiscVarType ReKi TwrMB {:}{:} - - "buoyant moment per unit length at tower node" Nm/m -typedef ^ RotMiscVarType ReKi HubFB {:} - - "buoyant force at hub node" N -typedef ^ RotMiscVarType ReKi HubMB {:} - - "buoyant moment at hub node" Nm -typedef ^ RotMiscVarType ReKi NacFB {:} - - "buoyant force at nacelle (tower top) node" N -typedef ^ RotMiscVarType ReKi NacMB {:} - - "buoyant moment at nacelle (tower top) node" Nm -typedef ^ RotMiscVarType MeshType BladeRootLoad {:} - - "meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only)" - -typedef ^ RotMiscVarType MeshMapType B_L_2_R_P {:} - - "mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh" -typedef ^ RotMiscVarType MeshType BladeBuoyLoadPoint {:} - - "point mesh for lumped buoyant blade loads" - -typedef ^ RotMiscVarType MeshType BladeBuoyLoad {:} - - "line mesh for per unit length buoyant blade loads" - -typedef ^ RotMiscVarType MeshMapType B_P_2_B_L {:} - - "mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad)" -typedef ^ RotMiscVarType MeshType TwrBuoyLoadPoint - - - "point mesh for lumped buoyant tower loads" - -typedef ^ RotMiscVarType MeshType TwrBuoyLoad - - - "line mesh for per unit length buoyant tower loads" - -typedef ^ RotMiscVarType MeshMapType T_P_2_T_L - - - "mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad)" -typedef ^ RotMiscVarType Logical FirstWarn_TowerStrike - - - "flag to avoid printing tower strike multiple times" - -typedef ^ RotMiscVarType ReKi AvgDiskVel {3} - - "disk-averaged U,V,W (undisturbed)" m/s -typedef ^ RotMiscVarType ReKi AvgDiskVelDist {3} - - "disk-averaged U,V,W (disturbed)" m/s -# TailFin -typedef ^ RotMiscVarType ReKi TFinAlpha - - - "Angle of attack for tailfin" -typedef ^ RotMiscVarType ReKi TFinRe - - - "Reynolds number for tailfin" -typedef ^ RotMiscVarType ReKi TFinVrel - - - "Orthogonal relative velocity nrom at the reference point" -typedef ^ RotMiscVarType ReKi TFinVund_i 3 - - "Undisturbed wind velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinVind_i 3 - - "Induced velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinVrel_i 3 - - "Relative velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinSTV_i 3 - - "Structural velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinF_i 3 - - "Forces at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinM_i 3 - - "Moments at the reference point of the fin in the inertial system" - -typedef ^ MiscVarType RotMiscVarType rotors {:} - - "MiscVars for each rotor" - -typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - -typedef ^ MiscVarType FVW_OutputType FVW_y - - - "Outputs from the FVW module" - -typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - -typedef ^ MiscVarType ReKi WindPos {:}{:} - - "XYZ coordinates to query for wind velocity/acceleration" - -typedef ^ MiscVarType ReKi WindVel {:}{:} - - "XYZ components of wind velocity" - -typedef ^ MiscVarType ReKi WindAcc {:}{:} - - "XYZ components of wind acceleration" - - # Inflow data storage typedef ^ BldInflowType ReKi InflowOnBlade {:}{:} - - "U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s typedef ^ BldInflowType ReKi AccelOnBlade {:}{:} - - "Wind acceleration at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s @@ -396,8 +325,6 @@ typedef ^ RotParameterType ReKi TwrAxCent {:} - - "Array of tower element typedef ^ RotParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" typedef ^ RotParameterType AA_ParameterType AA - - - "Parameters for AA module" typedef ^ RotParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ RotParameterType Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u compenents" - -typedef ^ RotParameterType Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_u compenents" - typedef ^ RotParameterType Integer NumExtendedInputs - - - "number of extended inputs" - typedef ^ RotParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ RotParameterType ReKi dx {:} - - "vector that determines size of perturbation for x (continuous states)" diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index b544f56082..1ddcba3227 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -310,6 +310,41 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WakeLocationPoints !< wake points velocity [m/s] END TYPE AD_OtherStateType ! ======================= +! ========= BldInflowType ======= + TYPE, PUBLIC :: BldInflowType + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowOnBlade !< U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AccelOnBlade !< Wind acceleration at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] + END TYPE BldInflowType +! ======================= +! ========= RotInflowType ======= + TYPE, PUBLIC :: RotInflowType + TYPE(BldInflowType) , DIMENSION(:), ALLOCATABLE :: Bld !< Blade Inputs [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowOnTower !< U,V,W at nodes on the tower [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AccelOnTower !< Wind acceleration at nodes on the tower [m/s] + REAL(ReKi) , DIMENSION(1:3,1:1) :: InflowOnHub = 0.0_ReKi !< U,V,W at hub [m/s] + REAL(ReKi) , DIMENSION(1:3,1:1) :: InflowOnNacelle = 0.0_ReKi !< U,V,W at nacelle [m/s] + REAL(ReKi) , DIMENSION(1:3,1:1) :: InflowOnTailFin = 0.0_ReKi !< U,V,W at tailfin [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W [m/s] + END TYPE RotInflowType +! ======================= +! ========= AD_InflowType ======= + TYPE, PUBLIC :: AD_InflowType + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowWakeVel !< U,V,W at wake points [m/s] + TYPE(RotInflowType) , DIMENSION(:), ALLOCATABLE :: RotInflow !< Inflow on rotor [-] + END TYPE AD_InflowType +! ======================= +! ========= AD_MiscVarType ======= + TYPE, PUBLIC :: AD_MiscVarType + TYPE(AD_InflowType) , DIMENSION(:), ALLOCATABLE :: Inflow !< Inflow storage (size of u for history of inputs) [-] + TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< MiscVars for each rotor [-] + TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] + TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] + TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] + END TYPE AD_MiscVarType +! ======================= ! ========= RotParameterType ======= TYPE, PUBLIC :: RotParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] @@ -358,8 +393,6 @@ MODULE AeroDyn_Types TYPE(BEMT_ParameterType) :: BEMT !< Parameters for BEMT module [-] TYPE(AA_ParameterType) :: AA !< Parameters for AA module [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] - TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u compenents [-] - TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_u compenents [-] INTEGER(IntKi) :: NumExtendedInputs = 0_IntKi !< number of extended inputs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] @@ -516,17 +549,6 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(1:3) :: TFinM_i = 0.0_ReKi !< Moments at the reference point of the fin in the inertial system [-] END TYPE RotMiscVarType ! ======================= -! ========= AD_MiscVarType ======= - TYPE, PUBLIC :: AD_MiscVarType - TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< MiscVars for each rotor [-] - TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] - TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] - TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] - END TYPE AD_MiscVarType -! ======================= CONTAINS subroutine AD_CopyTFinParameterType(SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -2998,197 +3020,781 @@ subroutine AD_UnPackOtherState(RF, OutData) call RegUnpackAlloc(RF, OutData%WakeLocationPoints); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotParameterType), intent(in) :: SrcRotParameterTypeData - type(RotParameterType), intent(inout) :: DstRotParameterTypeData +subroutine AD_CopyBldInflowType(SrcBldInflowTypeData, DstBldInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(BldInflowType), intent(in) :: SrcBldInflowTypeData + type(BldInflowType), intent(inout) :: DstBldInflowTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' + character(*), parameter :: RoutineName = 'AD_CopyBldInflowType' ErrStat = ErrID_None ErrMsg = '' - if (associated(SrcRotParameterTypeData%Vars)) then - if (.not. associated(DstRotParameterTypeData%Vars)) then - allocate(DstRotParameterTypeData%Vars, stat=ErrStat2) + if (allocated(SrcBldInflowTypeData%InflowOnBlade)) then + LB(1:2) = lbound(SrcBldInflowTypeData%InflowOnBlade, kind=B8Ki) + UB(1:2) = ubound(SrcBldInflowTypeData%InflowOnBlade, kind=B8Ki) + if (.not. allocated(DstBldInflowTypeData%InflowOnBlade)) then + allocate(DstBldInflowTypeData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Vars.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstBldInflowTypeData%InflowOnBlade.', ErrStat, ErrMsg, RoutineName) return end if end if - call NWTC_Library_CopyModVarsType(SrcRotParameterTypeData%Vars, DstRotParameterTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + DstBldInflowTypeData%InflowOnBlade = SrcBldInflowTypeData%InflowOnBlade end if - DstRotParameterTypeData%iVarDBEMT = SrcRotParameterTypeData%iVarDBEMT - DstRotParameterTypeData%iVarUA = SrcRotParameterTypeData%iVarUA - DstRotParameterTypeData%iVarNacelleMotion = SrcRotParameterTypeData%iVarNacelleMotion - DstRotParameterTypeData%iVarHubMotion = SrcRotParameterTypeData%iVarHubMotion - DstRotParameterTypeData%iVarTFinMotion = SrcRotParameterTypeData%iVarTFinMotion - DstRotParameterTypeData%iVarTowerMotion = SrcRotParameterTypeData%iVarTowerMotion - if (allocated(SrcRotParameterTypeData%iVarBladeRootMotion)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarBladeRootMotion)) then - allocate(DstRotParameterTypeData%iVarBladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcBldInflowTypeData%AccelOnBlade)) then + LB(1:2) = lbound(SrcBldInflowTypeData%AccelOnBlade, kind=B8Ki) + UB(1:2) = ubound(SrcBldInflowTypeData%AccelOnBlade, kind=B8Ki) + if (.not. allocated(DstBldInflowTypeData%AccelOnBlade)) then + allocate(DstBldInflowTypeData%AccelOnBlade(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeRootMotion.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstBldInflowTypeData%AccelOnBlade.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%iVarBladeRootMotion = SrcRotParameterTypeData%iVarBladeRootMotion + DstBldInflowTypeData%AccelOnBlade = SrcBldInflowTypeData%AccelOnBlade end if - if (allocated(SrcRotParameterTypeData%iVarBladeMotion)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeMotion, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarBladeMotion)) then - allocate(DstRotParameterTypeData%iVarBladeMotion(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeMotion.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%iVarBladeMotion = SrcRotParameterTypeData%iVarBladeMotion +end subroutine + +subroutine AD_DestroyBldInflowType(BldInflowTypeData, ErrStat, ErrMsg) + type(BldInflowType), intent(inout) :: BldInflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyBldInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BldInflowTypeData%InflowOnBlade)) then + deallocate(BldInflowTypeData%InflowOnBlade) end if - if (allocated(SrcRotParameterTypeData%iVarUserProp)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarUserProp)) then - allocate(DstRotParameterTypeData%iVarUserProp(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarUserProp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%iVarUserProp = SrcRotParameterTypeData%iVarUserProp + if (allocated(BldInflowTypeData%AccelOnBlade)) then + deallocate(BldInflowTypeData%AccelOnBlade) end if - DstRotParameterTypeData%iVarHWindSpeed = SrcRotParameterTypeData%iVarHWindSpeed - DstRotParameterTypeData%iVarPLexp = SrcRotParameterTypeData%iVarPLexp - DstRotParameterTypeData%iVarPropagationDir = SrcRotParameterTypeData%iVarPropagationDir - DstRotParameterTypeData%iVarNacelleLoad = SrcRotParameterTypeData%iVarNacelleLoad - DstRotParameterTypeData%iVarHubLoad = SrcRotParameterTypeData%iVarHubLoad - DstRotParameterTypeData%iVarTFinLoad = SrcRotParameterTypeData%iVarTFinLoad - DstRotParameterTypeData%iVarTowerLoad = SrcRotParameterTypeData%iVarTowerLoad - if (allocated(SrcRotParameterTypeData%iVarBladeLoad)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarBladeLoad)) then - allocate(DstRotParameterTypeData%iVarBladeLoad(LB(1):UB(1)), stat=ErrStat2) +end subroutine + +subroutine AD_PackBldInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BldInflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackBldInflowType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%InflowOnBlade) + call RegPackAlloc(RF, InData%AccelOnBlade) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackBldInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BldInflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackBldInflowType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%InflowOnBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccelOnBlade); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotInflowType(SrcRotInflowTypeData, DstRotInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInflowType), intent(in) :: SrcRotInflowTypeData + type(RotInflowType), intent(inout) :: DstRotInflowTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcRotInflowTypeData%Bld)) then + LB(1:1) = lbound(SrcRotInflowTypeData%Bld, kind=B8Ki) + UB(1:1) = ubound(SrcRotInflowTypeData%Bld, kind=B8Ki) + if (.not. allocated(DstRotInflowTypeData%Bld)) then + allocate(DstRotInflowTypeData%Bld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeLoad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInflowTypeData%Bld.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%iVarBladeLoad = SrcRotParameterTypeData%iVarBladeLoad + do i1 = LB(1), UB(1) + call AD_CopyBldInflowType(SrcRotInflowTypeData%Bld(i1), DstRotInflowTypeData%Bld(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstRotParameterTypeData%iVarWriteOutput = SrcRotParameterTypeData%iVarWriteOutput - DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades - DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds - DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds - if (allocated(SrcRotParameterTypeData%TwrDiam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then - allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotInflowTypeData%InflowOnTower)) then + LB(1:2) = lbound(SrcRotInflowTypeData%InflowOnTower, kind=B8Ki) + UB(1:2) = ubound(SrcRotInflowTypeData%InflowOnTower, kind=B8Ki) + if (.not. allocated(DstRotInflowTypeData%InflowOnTower)) then + allocate(DstRotInflowTypeData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInflowTypeData%InflowOnTower.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam + DstRotInflowTypeData%InflowOnTower = SrcRotInflowTypeData%InflowOnTower end if - if (allocated(SrcRotParameterTypeData%TwrCd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrCd)) then - allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotInflowTypeData%AccelOnTower)) then + LB(1:2) = lbound(SrcRotInflowTypeData%AccelOnTower, kind=B8Ki) + UB(1:2) = ubound(SrcRotInflowTypeData%AccelOnTower, kind=B8Ki) + if (.not. allocated(DstRotInflowTypeData%AccelOnTower)) then + allocate(DstRotInflowTypeData%AccelOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInflowTypeData%AccelOnTower.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd + DstRotInflowTypeData%AccelOnTower = SrcRotInflowTypeData%AccelOnTower end if - if (allocated(SrcRotParameterTypeData%TwrTI)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrTI)) then - allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI + DstRotInflowTypeData%InflowOnHub = SrcRotInflowTypeData%InflowOnHub + DstRotInflowTypeData%InflowOnNacelle = SrcRotInflowTypeData%InflowOnNacelle + DstRotInflowTypeData%InflowOnTailFin = SrcRotInflowTypeData%InflowOnTailFin + DstRotInflowTypeData%AvgDiskVel = SrcRotInflowTypeData%AvgDiskVel +end subroutine + +subroutine AD_DestroyRotInflowType(RotInflowTypeData, ErrStat, ErrMsg) + type(RotInflowType), intent(inout) :: RotInflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInflowTypeData%Bld)) then + LB(1:1) = lbound(RotInflowTypeData%Bld, kind=B8Ki) + UB(1:1) = ubound(RotInflowTypeData%Bld, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyBldInflowType(RotInflowTypeData%Bld(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInflowTypeData%Bld) end if - if (allocated(SrcRotParameterTypeData%BlTwist)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlTwist)) then - allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist + if (allocated(RotInflowTypeData%InflowOnTower)) then + deallocate(RotInflowTypeData%InflowOnTower) end if - if (allocated(SrcRotParameterTypeData%TwrCb)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrCb)) then - allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb + if (allocated(RotInflowTypeData%AccelOnTower)) then + deallocate(RotInflowTypeData%AccelOnTower) end if - if (allocated(SrcRotParameterTypeData%BlCenBn)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then - allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) - return - end if +end subroutine + +subroutine AD_PackRotInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotInflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInflowType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Bld)) + if (allocated(InData%Bld)) then + call RegPackBounds(RF, 1, lbound(InData%Bld, kind=B8Ki), ubound(InData%Bld, kind=B8Ki)) + LB(1:1) = lbound(InData%Bld, kind=B8Ki) + UB(1:1) = ubound(InData%Bld, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackBldInflowType(RF, InData%Bld(i1)) + end do + end if + call RegPackAlloc(RF, InData%InflowOnTower) + call RegPackAlloc(RF, InData%AccelOnTower) + call RegPack(RF, InData%InflowOnHub) + call RegPack(RF, InData%InflowOnNacelle) + call RegPack(RF, InData%InflowOnTailFin) + call RegPack(RF, InData%AvgDiskVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotInflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInflowType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Bld)) deallocate(OutData%Bld) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Bld(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld.', RF%ErrStat, RF%ErrMsg, RoutineName) + return end if - DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn + do i1 = LB(1), UB(1) + call AD_UnpackBldInflowType(RF, OutData%Bld(i1)) ! Bld + end do end if - if (allocated(SrcRotParameterTypeData%BlCenBt)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then - allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + call RegUnpackAlloc(RF, OutData%InflowOnTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccelOnTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnNacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnTailFin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyInflowType(SrcInflowTypeData, DstInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_InflowType), intent(in) :: SrcInflowTypeData + type(AD_InflowType), intent(inout) :: DstInflowTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInflowTypeData%InflowWakeVel)) then + LB(1:2) = lbound(SrcInflowTypeData%InflowWakeVel, kind=B8Ki) + UB(1:2) = ubound(SrcInflowTypeData%InflowWakeVel, kind=B8Ki) + if (.not. allocated(DstInflowTypeData%InflowWakeVel)) then + allocate(DstInflowTypeData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt + DstInflowTypeData%InflowWakeVel = SrcInflowTypeData%InflowWakeVel end if - DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub - DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx - DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac - DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB - DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl - DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr - if (allocated(SrcRotParameterTypeData%BlRad)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlRad, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlRad, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%BlRad)) then - allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcInflowTypeData%RotInflow)) then + LB(1:1) = lbound(SrcInflowTypeData%RotInflow, kind=B8Ki) + UB(1:1) = ubound(SrcInflowTypeData%RotInflow, kind=B8Ki) + if (.not. allocated(DstInflowTypeData%RotInflow)) then + allocate(DstInflowTypeData%RotInflow(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%RotInflow.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad + do i1 = LB(1), UB(1) + call AD_CopyRotInflowType(SrcInflowTypeData%RotInflow(i1), DstInflowTypeData%RotInflow(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyInflowType(InflowTypeData, ErrStat, ErrMsg) + type(AD_InflowType), intent(inout) :: InflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InflowTypeData%InflowWakeVel)) then + deallocate(InflowTypeData%InflowWakeVel) + end if + if (allocated(InflowTypeData%RotInflow)) then + LB(1:1) = lbound(InflowTypeData%RotInflow, kind=B8Ki) + UB(1:1) = ubound(InflowTypeData%RotInflow, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyRotInflowType(InflowTypeData%RotInflow(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowTypeData%RotInflow) + end if +end subroutine + +subroutine AD_PackInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInflowType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%InflowWakeVel) + call RegPack(RF, allocated(InData%RotInflow)) + if (allocated(InData%RotInflow)) then + call RegPackBounds(RF, 1, lbound(InData%RotInflow, kind=B8Ki), ubound(InData%RotInflow, kind=B8Ki)) + LB(1:1) = lbound(InData%RotInflow, kind=B8Ki) + UB(1:1) = ubound(InData%RotInflow, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackRotInflowType(RF, InData%RotInflow(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInflowType' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%InflowWakeVel); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%RotInflow)) deallocate(OutData%RotInflow) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%RotInflow(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotInflow.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInflowType(RF, OutData%RotInflow(i1)) ! RotInflow + end do + end if +end subroutine + +subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: SrcMiscData + type(AD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%Inflow)) then + LB(1:1) = lbound(SrcMiscData%Inflow, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Inflow, kind=B8Ki) + if (.not. allocated(DstMiscData%Inflow)) then + allocate(DstMiscData%Inflow(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Inflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInflowType(SrcMiscData%Inflow(i1), DstMiscData%Inflow(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%rotors)) then + LB(1:1) = lbound(SrcMiscData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%rotors, kind=B8Ki) + if (.not. allocated(DstMiscData%rotors)) then + allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%FVW_u)) then + LB(1:1) = lbound(SrcMiscData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FVW_u, kind=B8Ki) + if (.not. allocated(DstMiscData%FVW_u)) then + allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%WindPos)) then + LB(1:2) = lbound(SrcMiscData%WindPos, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindPos, kind=B8Ki) + if (.not. allocated(DstMiscData%WindPos)) then + allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindPos = SrcMiscData%WindPos + end if + if (allocated(SrcMiscData%WindVel)) then + LB(1:2) = lbound(SrcMiscData%WindVel, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindVel, kind=B8Ki) + if (.not. allocated(DstMiscData%WindVel)) then + allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindVel = SrcMiscData%WindVel + end if + if (allocated(SrcMiscData%WindAcc)) then + LB(1:2) = lbound(SrcMiscData%WindAcc, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindAcc, kind=B8Ki) + if (.not. allocated(DstMiscData%WindAcc)) then + allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAcc = SrcMiscData%WindAcc + end if +end subroutine + +subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%Inflow)) then + LB(1:1) = lbound(MiscData%Inflow, kind=B8Ki) + UB(1:1) = ubound(MiscData%Inflow, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyInflowType(MiscData%Inflow(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Inflow) + end if + if (allocated(MiscData%rotors)) then + LB(1:1) = lbound(MiscData%rotors, kind=B8Ki) + UB(1:1) = ubound(MiscData%rotors, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%rotors) + end if + if (allocated(MiscData%FVW_u)) then + LB(1:1) = lbound(MiscData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(MiscData%FVW_u, kind=B8Ki) + do i1 = LB(1), UB(1) + call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FVW_u) + end if + call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%WindPos)) then + deallocate(MiscData%WindPos) + end if + if (allocated(MiscData%WindVel)) then + deallocate(MiscData%WindVel) + end if + if (allocated(MiscData%WindAcc)) then + deallocate(MiscData%WindAcc) + end if +end subroutine + +subroutine AD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Inflow)) + if (allocated(InData%Inflow)) then + call RegPackBounds(RF, 1, lbound(InData%Inflow, kind=B8Ki), ubound(InData%Inflow, kind=B8Ki)) + LB(1:1) = lbound(InData%Inflow, kind=B8Ki) + UB(1:1) = ubound(InData%Inflow, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackInflowType(RF, InData%Inflow(i1)) + end do + end if + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackRotMiscVarType(RF, InData%rotors(i1)) + end do + end if + call RegPack(RF, allocated(InData%FVW_u)) + if (allocated(InData%FVW_u)) then + call RegPackBounds(RF, 1, lbound(InData%FVW_u, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) + LB(1:1) = lbound(InData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(InData%FVW_u, kind=B8Ki) + do i1 = LB(1), UB(1) + call FVW_PackInput(RF, InData%FVW_u(i1)) + end do + end if + call FVW_PackOutput(RF, InData%FVW_y) + call FVW_PackMisc(RF, InData%FVW) + call RegPackAlloc(RF, InData%WindPos) + call RegPackAlloc(RF, InData%WindVel) + call RegPackAlloc(RF, InData%WindAcc) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Inflow)) deallocate(OutData%Inflow) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Inflow(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInflowType(RF, OutData%Inflow(i1)) ! Inflow + end do + end if + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors + end do + end if + if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u + end do + end if + call FVW_UnpackOutput(RF, OutData%FVW_y) ! FVW_y + call FVW_UnpackMisc(RF, OutData%FVW) ! FVW + call RegUnpackAlloc(RF, OutData%WindPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindAcc); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotParameterType), intent(in) :: SrcRotParameterTypeData + type(RotParameterType), intent(inout) :: DstRotParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcRotParameterTypeData%Vars)) then + if (.not. associated(DstRotParameterTypeData%Vars)) then + allocate(DstRotParameterTypeData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcRotParameterTypeData%Vars, DstRotParameterTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + DstRotParameterTypeData%iVarDBEMT = SrcRotParameterTypeData%iVarDBEMT + DstRotParameterTypeData%iVarUA = SrcRotParameterTypeData%iVarUA + DstRotParameterTypeData%iVarNacelleMotion = SrcRotParameterTypeData%iVarNacelleMotion + DstRotParameterTypeData%iVarHubMotion = SrcRotParameterTypeData%iVarHubMotion + DstRotParameterTypeData%iVarTFinMotion = SrcRotParameterTypeData%iVarTFinMotion + DstRotParameterTypeData%iVarTowerMotion = SrcRotParameterTypeData%iVarTowerMotion + if (allocated(SrcRotParameterTypeData%iVarBladeRootMotion)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarBladeRootMotion)) then + allocate(DstRotParameterTypeData%iVarBladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%iVarBladeRootMotion = SrcRotParameterTypeData%iVarBladeRootMotion + end if + if (allocated(SrcRotParameterTypeData%iVarBladeMotion)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeMotion, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarBladeMotion)) then + allocate(DstRotParameterTypeData%iVarBladeMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%iVarBladeMotion = SrcRotParameterTypeData%iVarBladeMotion + end if + if (allocated(SrcRotParameterTypeData%iVarUserProp)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarUserProp)) then + allocate(DstRotParameterTypeData%iVarUserProp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarUserProp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%iVarUserProp = SrcRotParameterTypeData%iVarUserProp + end if + DstRotParameterTypeData%iVarHWindSpeed = SrcRotParameterTypeData%iVarHWindSpeed + DstRotParameterTypeData%iVarPLexp = SrcRotParameterTypeData%iVarPLexp + DstRotParameterTypeData%iVarPropagationDir = SrcRotParameterTypeData%iVarPropagationDir + DstRotParameterTypeData%iVarNacelleLoad = SrcRotParameterTypeData%iVarNacelleLoad + DstRotParameterTypeData%iVarHubLoad = SrcRotParameterTypeData%iVarHubLoad + DstRotParameterTypeData%iVarTFinLoad = SrcRotParameterTypeData%iVarTFinLoad + DstRotParameterTypeData%iVarTowerLoad = SrcRotParameterTypeData%iVarTowerLoad + if (allocated(SrcRotParameterTypeData%iVarBladeLoad)) then + LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%iVarBladeLoad)) then + allocate(DstRotParameterTypeData%iVarBladeLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%iVarBladeLoad = SrcRotParameterTypeData%iVarBladeLoad + end if + DstRotParameterTypeData%iVarWriteOutput = SrcRotParameterTypeData%iVarWriteOutput + DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades + DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds + DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds + if (allocated(SrcRotParameterTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then + allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam + end if + if (allocated(SrcRotParameterTypeData%TwrCd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrCd)) then + allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd + end if + if (allocated(SrcRotParameterTypeData%TwrTI)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrTI)) then + allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI + end if + if (allocated(SrcRotParameterTypeData%BlTwist)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlTwist)) then + allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist + end if + if (allocated(SrcRotParameterTypeData%TwrCb)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%TwrCb)) then + allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb + end if + if (allocated(SrcRotParameterTypeData%BlCenBn)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then + allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn + end if + if (allocated(SrcRotParameterTypeData%BlCenBt)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then + allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt + end if + DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub + DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx + DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac + DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB + DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl + DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr + if (allocated(SrcRotParameterTypeData%BlRad)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlRad, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlRad, kind=B8Ki) + if (.not. allocated(DstRotParameterTypeData%BlRad)) then + allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad end if if (allocated(SrcRotParameterTypeData%BlDL)) then LB(1:2) = lbound(SrcRotParameterTypeData%BlDL, kind=B8Ki) @@ -3292,12 +3898,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx end if - call AD_CopyJac_u_idxStarts(SrcRotParameterTypeData%Jac_u_idxStartList, DstRotParameterTypeData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AD_CopyJac_y_idxStarts(SrcRotParameterTypeData%Jac_y_idxStartList, DstRotParameterTypeData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstRotParameterTypeData%NumExtendedInputs = SrcRotParameterTypeData%NumExtendedInputs if (allocated(SrcRotParameterTypeData%du)) then LB(1:1) = lbound(SrcRotParameterTypeData%du, kind=B8Ki) @@ -3483,10 +4083,6 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) if (allocated(RotParameterTypeData%Jac_u_indx)) then deallocate(RotParameterTypeData%Jac_u_indx) end if - call AD_DestroyJac_u_idxStarts(RotParameterTypeData%Jac_u_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AD_DestroyJac_y_idxStarts(RotParameterTypeData%Jac_y_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotParameterTypeData%du)) then deallocate(RotParameterTypeData%du) end if @@ -3578,8 +4174,6 @@ subroutine AD_PackRotParameterType(RF, Indata) call BEMT_PackParam(RF, InData%BEMT) call AA_PackParam(RF, InData%AA) call RegPackAlloc(RF, InData%Jac_u_indx) - call AD_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) - call AD_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) call RegPack(RF, InData%NumExtendedInputs) call RegPackAlloc(RF, InData%du) call RegPackAlloc(RF, InData%dx) @@ -3710,8 +4304,6 @@ subroutine AD_UnPackRotParameterType(RF, OutData) call BEMT_UnpackParam(RF, OutData%BEMT) ! BEMT call AA_UnpackParam(RF, OutData%AA) ! AA call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call AD_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList - call AD_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return @@ -5412,281 +6004,73 @@ subroutine AD_UnPackRotMiscVarType(RF, OutData) call MeshUnpack(RF, OutData%BladeRootLoad(i1)) ! BladeRootLoad end do end if - if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P - end do - end if - if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint - end do - end if - if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad - end do - end if - if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(RF, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L - end do - end if - call MeshUnpack(RF, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint - call MeshUnpack(RF, OutData%TwrBuoyLoad) ! TwrBuoyLoad - call NWTC_Library_UnpackMeshMapType(RF, OutData%T_P_2_T_L) ! T_P_2_T_L - call RegUnpack(RF, OutData%FirstWarn_TowerStrike); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgDiskVelDist); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinAlpha); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinRe); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVrel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVund_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVind_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVrel_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinSTV_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinF_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinM_i); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(AD_MiscVarType), intent(inout) :: SrcMiscData - type(AD_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcMiscData%rotors)) then - LB(1:1) = lbound(SrcMiscData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%rotors, kind=B8Ki) - if (.not. allocated(DstMiscData%rotors)) then - allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcMiscData%FVW_u)) then - LB(1:1) = lbound(SrcMiscData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FVW_u, kind=B8Ki) - if (.not. allocated(DstMiscData%FVW_u)) then - allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%WindPos)) then - LB(1:2) = lbound(SrcMiscData%WindPos, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindPos, kind=B8Ki) - if (.not. allocated(DstMiscData%WindPos)) then - allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%WindPos = SrcMiscData%WindPos - end if - if (allocated(SrcMiscData%WindVel)) then - LB(1:2) = lbound(SrcMiscData%WindVel, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindVel, kind=B8Ki) - if (.not. allocated(DstMiscData%WindVel)) then - allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%WindVel = SrcMiscData%WindVel - end if - if (allocated(SrcMiscData%WindAcc)) then - LB(1:2) = lbound(SrcMiscData%WindAcc, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindAcc, kind=B8Ki) - if (.not. allocated(DstMiscData%WindAcc)) then - allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%WindAcc = SrcMiscData%WindAcc - end if -end subroutine - -subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(AD_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(MiscData%rotors)) then - LB(1:1) = lbound(MiscData%rotors, kind=B8Ki) - UB(1:1) = ubound(MiscData%rotors, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%rotors) - end if - if (allocated(MiscData%FVW_u)) then - LB(1:1) = lbound(MiscData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(MiscData%FVW_u, kind=B8Ki) - do i1 = LB(1), UB(1) - call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%FVW_u) - end if - call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%WindPos)) then - deallocate(MiscData%WindPos) - end if - if (allocated(MiscData%WindVel)) then - deallocate(MiscData%WindVel) - end if - if (allocated(MiscData%WindAcc)) then - deallocate(MiscData%WindAcc) - end if -end subroutine - -subroutine AD_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%rotors)) - if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call AD_PackRotMiscVarType(RF, InData%rotors(i1)) + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P end do end if - call RegPack(RF, allocated(InData%FVW_u)) - if (allocated(InData%FVW_u)) then - call RegPackBounds(RF, 1, lbound(InData%FVW_u, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) - LB(1:1) = lbound(InData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(InData%FVW_u, kind=B8Ki) + if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call FVW_PackInput(RF, InData%FVW_u(i1)) + call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint end do end if - call FVW_PackOutput(RF, InData%FVW_y) - call FVW_PackMisc(RF, InData%FVW) - call RegPackAlloc(RF, InData%WindPos) - call RegPackAlloc(RF, InData%WindVel) - call RegPackAlloc(RF, InData%WindAcc) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(AD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%rotors)) deallocate(OutData%rotors) + if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors + call MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad end do end if - if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) + allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L end do end if - call FVW_UnpackOutput(RF, OutData%FVW_y) ! FVW_y - call FVW_UnpackMisc(RF, OutData%FVW) ! FVW - call RegUnpackAlloc(RF, OutData%WindPos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WindVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WindAcc); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint + call MeshUnpack(RF, OutData%TwrBuoyLoad) ! TwrBuoyLoad + call NWTC_Library_UnpackMeshMapType(RF, OutData%T_P_2_T_L) ! T_P_2_T_L + call RegUnpack(RF, OutData%FirstWarn_TowerStrike); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVelDist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinRe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVund_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinSTV_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinF_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinM_i); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -6145,6 +6529,252 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ! check if allocated END SUBROUTINE +subroutine AD_InflowType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) InflowType u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(AD_InflowType), intent(in) :: u(:) ! InflowType at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the InflowTypes + type(AD_InflowType), intent(inout) :: u_out ! InflowType at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD_InflowType_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AD_CopyInflowType(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD_InflowType_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD_InflowType_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD_InflowType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) InflowType u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(AD_InflowType), INTENT(IN) :: u1 ! InflowType at t1 > t2 + TYPE(AD_InflowType), INTENT(IN) :: u2 ! InflowType at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the InflowTypes + TYPE(AD_InflowType), INTENT(INOUT) :: u_out ! InflowType at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the InflowTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD_InflowType_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN + END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + END IF ! check if allocated + IF (ALLOCATED(u_out%RotInflow) .AND. ALLOCATED(u1%RotInflow)) THEN + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%Bld) .AND. ALLOCATED(u1%RotInflow(i01)%Bld)) THEN + DO i11 = LBOUND(u_out%RotInflow(i01)%Bld,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Bld,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%Bld(i11)%InflowOnBlade) .AND. ALLOCATED(u1%RotInflow(i01)%Bld(i11)%InflowOnBlade)) THEN + u_out%RotInflow(i01)%Bld(i11)%InflowOnBlade = a1*u1%RotInflow(i01)%Bld(i11)%InflowOnBlade + a2*u2%RotInflow(i01)%Bld(i11)%InflowOnBlade + END IF ! check if allocated + END DO + DO i11 = LBOUND(u_out%RotInflow(i01)%Bld,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Bld,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%Bld(i11)%AccelOnBlade) .AND. ALLOCATED(u1%RotInflow(i01)%Bld(i11)%AccelOnBlade)) THEN + u_out%RotInflow(i01)%Bld(i11)%AccelOnBlade = a1*u1%RotInflow(i01)%Bld(i11)%AccelOnBlade + a2*u2%RotInflow(i01)%Bld(i11)%AccelOnBlade + END IF ! check if allocated + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%InflowOnTower) .AND. ALLOCATED(u1%RotInflow(i01)%InflowOnTower)) THEN + u_out%RotInflow(i01)%InflowOnTower = a1*u1%RotInflow(i01)%InflowOnTower + a2*u2%RotInflow(i01)%InflowOnTower + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%AccelOnTower) .AND. ALLOCATED(u1%RotInflow(i01)%AccelOnTower)) THEN + u_out%RotInflow(i01)%AccelOnTower = a1*u1%RotInflow(i01)%AccelOnTower + a2*u2%RotInflow(i01)%AccelOnTower + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + u_out%RotInflow(i01)%InflowOnHub = a1*u1%RotInflow(i01)%InflowOnHub + a2*u2%RotInflow(i01)%InflowOnHub + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + u_out%RotInflow(i01)%InflowOnNacelle = a1*u1%RotInflow(i01)%InflowOnNacelle + a2*u2%RotInflow(i01)%InflowOnNacelle + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + u_out%RotInflow(i01)%InflowOnTailFin = a1*u1%RotInflow(i01)%InflowOnTailFin + a2*u2%RotInflow(i01)%InflowOnTailFin + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + u_out%RotInflow(i01)%AvgDiskVel = a1*u1%RotInflow(i01)%AvgDiskVel + a2*u2%RotInflow(i01)%AvgDiskVel + END DO + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE AD_InflowType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) InflowType u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(AD_InflowType), INTENT(IN) :: u1 ! InflowType at t1 > t2 > t3 + TYPE(AD_InflowType), INTENT(IN) :: u2 ! InflowType at t2 > t3 + TYPE(AD_InflowType), INTENT(IN) :: u3 ! InflowType at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the InflowTypes + TYPE(AD_InflowType), INTENT(INOUT) :: u_out ! InflowType at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the InflowTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD_InflowType_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + a3*u3%InflowWakeVel + END IF ! check if allocated + IF (ALLOCATED(u_out%RotInflow) .AND. ALLOCATED(u1%RotInflow)) THEN + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%Bld) .AND. ALLOCATED(u1%RotInflow(i01)%Bld)) THEN + DO i11 = LBOUND(u_out%RotInflow(i01)%Bld,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Bld,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%Bld(i11)%InflowOnBlade) .AND. ALLOCATED(u1%RotInflow(i01)%Bld(i11)%InflowOnBlade)) THEN + u_out%RotInflow(i01)%Bld(i11)%InflowOnBlade = a1*u1%RotInflow(i01)%Bld(i11)%InflowOnBlade + a2*u2%RotInflow(i01)%Bld(i11)%InflowOnBlade + a3*u3%RotInflow(i01)%Bld(i11)%InflowOnBlade + END IF ! check if allocated + END DO + DO i11 = LBOUND(u_out%RotInflow(i01)%Bld,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Bld,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%Bld(i11)%AccelOnBlade) .AND. ALLOCATED(u1%RotInflow(i01)%Bld(i11)%AccelOnBlade)) THEN + u_out%RotInflow(i01)%Bld(i11)%AccelOnBlade = a1*u1%RotInflow(i01)%Bld(i11)%AccelOnBlade + a2*u2%RotInflow(i01)%Bld(i11)%AccelOnBlade + a3*u3%RotInflow(i01)%Bld(i11)%AccelOnBlade + END IF ! check if allocated + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%InflowOnTower) .AND. ALLOCATED(u1%RotInflow(i01)%InflowOnTower)) THEN + u_out%RotInflow(i01)%InflowOnTower = a1*u1%RotInflow(i01)%InflowOnTower + a2*u2%RotInflow(i01)%InflowOnTower + a3*u3%RotInflow(i01)%InflowOnTower + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + IF (ALLOCATED(u_out%RotInflow(i01)%AccelOnTower) .AND. ALLOCATED(u1%RotInflow(i01)%AccelOnTower)) THEN + u_out%RotInflow(i01)%AccelOnTower = a1*u1%RotInflow(i01)%AccelOnTower + a2*u2%RotInflow(i01)%AccelOnTower + a3*u3%RotInflow(i01)%AccelOnTower + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + u_out%RotInflow(i01)%InflowOnHub = a1*u1%RotInflow(i01)%InflowOnHub + a2*u2%RotInflow(i01)%InflowOnHub + a3*u3%RotInflow(i01)%InflowOnHub + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + u_out%RotInflow(i01)%InflowOnNacelle = a1*u1%RotInflow(i01)%InflowOnNacelle + a2*u2%RotInflow(i01)%InflowOnNacelle + a3*u3%RotInflow(i01)%InflowOnNacelle + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + u_out%RotInflow(i01)%InflowOnTailFin = a1*u1%RotInflow(i01)%InflowOnTailFin + a2*u2%RotInflow(i01)%InflowOnTailFin + a3*u3%RotInflow(i01)%InflowOnTailFin + END DO + DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + u_out%RotInflow(i01)%AvgDiskVel = a1*u1%RotInflow(i01)%AvgDiskVel + a2*u2%RotInflow(i01)%AvgDiskVel + a3*u3%RotInflow(i01)%AvgDiskVel + END DO + END IF ! check if allocated +END SUBROUTINE + function AD_InputMeshPointer(u, ML) result(Mesh) type(AD_InputType), target, intent(in) :: u type(MeshLocType), intent(in) :: ML diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 6cce8727cf..a5a32541d8 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -11193,6 +11193,14 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat Mesh=u%NacelleLoads, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) + + ! TFinCM point loads + call MV_AddMeshVar(p%Vars%u, "Tailfin", LoadFields, & + VarIdx=p%iVarTFinCMLoads, & + Mesh=u%TFinCMLoads, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Non-mesh input variables call MV_AddVar(p%Vars%u, "BlPitchCom", VF_Scalar, & VarIdx=p%iVarBlPitchCom, & @@ -11200,16 +11208,19 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat Flags=VF_RotFrame + VF_Linearize, & Perturb=2.0_R8Ki * D2R_D, & LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) + call MV_AddVar(p%Vars%u, "YawMom", VF_Scalar, & VarIdx=p%iVarYawMom, & Flags=VF_Linearize, & Perturb=MaxTorque / 100.0_R8Ki, & LinNames=['Yaw moment, Nm']) + call MV_AddVar(p%Vars%u, "GenTrq", VF_Scalar, & VarIdx=p%iVarGenTrq, & Flags=VF_Linearize, & Perturb=MaxTorque / (100.0_R8Ki*p%GBRatio), & LinNames=['Generator torque, Nm']) + call MV_AddVar(p%Vars%u, "BlPitchComC", VF_Scalar, & VarIdx=p%iVarBlPitchComC, & Flags=VF_ExtLin + VF_Linearize, & @@ -11255,7 +11266,8 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat Mesh=y%TowerLn2Mesh, & Flags=VF_Line) - call MV_AddMeshVar(p%Vars%y, 'Hub', [VF_TransDisp, VF_Orientation, VF_AngularVel], & + call MV_AddMeshVar(p%Vars%y, 'Hub', & + Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel], & VarIdx=p%iVarHubMotion, & Mesh=y%HubPtMotion) @@ -11269,6 +11281,11 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat VarIdx=p%iVarNacelleMotion, & Mesh=y%NacelleMotion) + call MV_AddMeshVar(p%Vars%y, 'TailFin', & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel], & + VarIdx=p%iVarTFinCMMotion, & + Mesh=y%TFinCMMotion) + call MV_AddVar(p%Vars%y, 'Yaw', VF_AngularDisp, & VarIdx=p%iVarYaw, & LinNames=['Yaw, rad']) @@ -11405,6 +11422,7 @@ subroutine ED_PackInputValues(p, u, Ary) call MV_Pack(p%Vars%u, p%iVarTowerPtLoads, u%TowerPtLoads, Ary) call MV_Pack(p%Vars%u, p%iVarHubPtLoad, u%HubPtLoad, Ary) call MV_Pack(p%Vars%u, p%iVarNacelleLoads, u%NacelleLoads, Ary) + call MV_Pack(p%Vars%u, p%iVarTFinCMLoads, u%TFinCMLoads, Ary) call MV_Pack(p%Vars%u, p%iVarBlPitchCom, u%BlPitchCom, Ary) call MV_Pack(p%Vars%u, p%iVarYawMom, u%YawMom, Ary) call MV_Pack(p%Vars%u, p%iVarGenTrq, u%GenTrq, Ary) @@ -11425,6 +11443,7 @@ subroutine ED_UnpackInputValues(p, Ary, u) call MV_Unpack(p%Vars%u, p%iVarTowerPtLoads, Ary, u%TowerPtLoads) call MV_Unpack(p%Vars%u, p%iVarHubPtLoad, Ary, u%HubPtLoad) call MV_Unpack(p%Vars%u, p%iVarNacelleLoads, Ary, u%NacelleLoads) + call MV_Unpack(p%Vars%u, p%iVarTFinCMLoads, Ary, u%TFinCMLoads) call MV_Unpack(p%Vars%u, p%iVarBlPitchCom, Ary, u%BlPitchCom) call MV_Unpack(p%Vars%u, p%iVarYawMom, Ary, u%YawMom) call MV_Unpack(p%Vars%u, p%iVarGenTrq, Ary, u%GenTrq) @@ -11450,6 +11469,7 @@ subroutine ED_PackOutputValues(p, y, Ary, PackWriteOutput) end do end if call MV_Pack(p%Vars%y, p%iVarNacelleMotion, y%NacelleMotion, Ary) + call MV_Pack(p%Vars%y, p%iVarTFinCMMotion, y%TFinCMMotion, Ary) call MV_Pack(p%Vars%y, p%iVarYaw, y%Yaw, Ary) call MV_Pack(p%Vars%y, p%iVarYawRate, y%YawRate, Ary) call MV_Pack(p%Vars%y, p%iVarHSS_Spd, y%HSS_Spd, Ary) diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 78df5702f7..dcbcd33246 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -753,6 +753,7 @@ typedef ^ ParameterType IntKi iVarPlatformPtMesh - - - "Index of platform point typedef ^ ParameterType IntKi iVarTowerPtLoads - - - "Index of tower point loads mesh variable" - typedef ^ ParameterType IntKi iVarHubPtLoad - - - "Index of hub point load mesh variable" - typedef ^ ParameterType IntKi iVarNacelleLoads - - - "Index of nacelle loads mesh variable" - +typedef ^ ParameterType IntKi iVarTFinCMLoads - - - "Index of tail fin CM loads mesh variable" - typedef ^ ParameterType IntKi iVarBlPitchCom - - - "Index of blade pitch command variable" - typedef ^ ParameterType IntKi iVarYawMom - - - "Index of yaw moment variable" - typedef ^ ParameterType IntKi iVarGenTrq - - - "Index of generator torque variable" - @@ -764,6 +765,7 @@ typedef ^ ParameterType IntKi iVarTowerMotion - - - "Index of variable" - typedef ^ ParameterType IntKi iVarHubMotion - - - "Index of variable" - typedef ^ ParameterType IntKi iVarBladeRootMotion {:} - - "Indices of variable" - typedef ^ ParameterType IntKi iVarNacelleMotion - - - "Index of variable" - +typedef ^ ParameterType IntKi iVarTFinCMMotion - - - "Index of variable" - typedef ^ ParameterType IntKi iVarYaw - - - "Index of variable" - typedef ^ ParameterType IntKi iVarYawRate - - - "Index of variable" - typedef ^ ParameterType IntKi iVarHSS_Spd - - - "Index of variable" - diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index d5c3e6a99b..dd8cde2e64 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -771,6 +771,7 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: iVarTowerPtLoads = 0_IntKi !< Index of tower point loads mesh variable [-] INTEGER(IntKi) :: iVarHubPtLoad = 0_IntKi !< Index of hub point load mesh variable [-] INTEGER(IntKi) :: iVarNacelleLoads = 0_IntKi !< Index of nacelle loads mesh variable [-] + INTEGER(IntKi) :: iVarTFinCMLoads = 0_IntKi !< Index of tail fin CM loads mesh variable [-] INTEGER(IntKi) :: iVarBlPitchCom = 0_IntKi !< Index of blade pitch command variable [-] INTEGER(IntKi) :: iVarYawMom = 0_IntKi !< Index of yaw moment variable [-] INTEGER(IntKi) :: iVarGenTrq = 0_IntKi !< Index of generator torque variable [-] @@ -781,6 +782,7 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: iVarHubMotion = 0_IntKi !< Index of variable [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeRootMotion !< Indices of variable [-] INTEGER(IntKi) :: iVarNacelleMotion = 0_IntKi !< Index of variable [-] + INTEGER(IntKi) :: iVarTFinCMMotion = 0_IntKi !< Index of variable [-] INTEGER(IntKi) :: iVarYaw = 0_IntKi !< Index of variable [-] INTEGER(IntKi) :: iVarYawRate = 0_IntKi !< Index of variable [-] INTEGER(IntKi) :: iVarHSS_Spd = 0_IntKi !< Index of variable [-] @@ -5727,6 +5729,7 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%iVarTowerPtLoads = SrcParamData%iVarTowerPtLoads DstParamData%iVarHubPtLoad = SrcParamData%iVarHubPtLoad DstParamData%iVarNacelleLoads = SrcParamData%iVarNacelleLoads + DstParamData%iVarTFinCMLoads = SrcParamData%iVarTFinCMLoads DstParamData%iVarBlPitchCom = SrcParamData%iVarBlPitchCom DstParamData%iVarYawMom = SrcParamData%iVarYawMom DstParamData%iVarGenTrq = SrcParamData%iVarGenTrq @@ -5759,6 +5762,7 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%iVarBladeRootMotion = SrcParamData%iVarBladeRootMotion end if DstParamData%iVarNacelleMotion = SrcParamData%iVarNacelleMotion + DstParamData%iVarTFinCMMotion = SrcParamData%iVarTFinCMMotion DstParamData%iVarYaw = SrcParamData%iVarYaw DstParamData%iVarYawRate = SrcParamData%iVarYawRate DstParamData%iVarHSS_Spd = SrcParamData%iVarHSS_Spd @@ -6241,6 +6245,7 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%iVarTowerPtLoads) call RegPack(RF, InData%iVarHubPtLoad) call RegPack(RF, InData%iVarNacelleLoads) + call RegPack(RF, InData%iVarTFinCMLoads) call RegPack(RF, InData%iVarBlPitchCom) call RegPack(RF, InData%iVarYawMom) call RegPack(RF, InData%iVarGenTrq) @@ -6251,6 +6256,7 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%iVarHubMotion) call RegPackAlloc(RF, InData%iVarBladeRootMotion) call RegPack(RF, InData%iVarNacelleMotion) + call RegPack(RF, InData%iVarTFinCMMotion) call RegPack(RF, InData%iVarYaw) call RegPack(RF, InData%iVarYawRate) call RegPack(RF, InData%iVarHSS_Spd) @@ -6540,6 +6546,7 @@ subroutine ED_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%iVarTowerPtLoads); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarHubPtLoad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarNacelleLoads); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTFinCMLoads); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarBlPitchCom); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarYawMom); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarGenTrq); if (RegCheckErr(RF, RoutineName)) return @@ -6550,6 +6557,7 @@ subroutine ED_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%iVarHubMotion); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iVarBladeRootMotion); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarNacelleMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarTFinCMMotion); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarYaw); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarYawRate); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarHSS_Spd); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index 0a89426a56..51310ed24e 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -26,7 +26,7 @@ module IfW_FlowField public IfW_FlowField_GetVelAcc public IfW_UniformField_CalcAccel, IfW_Grid3DField_CalcAccel -public IfW_UniformWind_GetOP, IfW_UniformWind_Perturb ! for linearization +public IfW_UniformWind_GetOP ! for linearization public Grid3D_to_Uniform, Uniform_to_Grid3D integer(IntKi), parameter :: WindProfileType_None = -1 !< don't add wind profile; already included in input @@ -716,7 +716,7 @@ subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) type(UniformFieldType), intent(IN) :: UF !< Parameters real(DbKi), intent(IN) :: t !< Current simulation time in seconds logical, intent(in) :: InterpCubic !< flag for using cubic interpolation - real(R8Ki), intent(OUT) :: OP_out(2) !< operating point (HWindSpeed and PLexp + real(R8Ki), intent(OUT) :: OP_out(3) !< operating point (HWindSpeed and PLexp type(UniformField_Interp) :: op ! interpolated values of InterpParams diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index b7dd4461af..8f75659adb 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -548,6 +548,13 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons InitOutData%WriteOutputHdr = p%OutParam(1:p%NumOuts)%Name InitOutData%WriteOutputUnt = p%OutParam(1:p%NumOuts)%Units + !---------------------------------------------------------------------------- + ! Module Variables + !---------------------------------------------------------------------------- + + call IfW_InitVars(InitInp, p, y, m, InitOutData, InitInp%Linearize, TmpErrStat, TmpErrMsg) + call SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- ! Linearization !---------------------------------------------------------------------------- @@ -632,6 +639,101 @@ END SUBROUTINE CleanUp END SUBROUTINE InflowWind_Init +subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(InflowWind_InitInputType), intent(in) :: InitInp !< Initialization input + type(InflowWind_ParameterType), intent(inout) :: p !< Parameters + type(InflowWind_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(InflowWind_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(InflowWind_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'MAP_InitVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + integer(IntKi) :: i + real(R8Ki) :: Perturb + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddVar(p%Vars%u, "HWindSpeed", VF_Scalar, & + VarIdx=p%iVarHWindSpeed, & + Flags=ior(VF_ExtLin, VF_Linearize), & + LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) + + call MV_AddVar(p%Vars%u, "PLExp", VF_Scalar, & + VarIdx=p%iVarPLExp, & + Flags=ior(VF_ExtLin, VF_Linearize), & + LinNames=['Extended input: vertical power-law shear exponent, -']) + + call MV_AddVar(p%Vars%u, "PropagationDir", VF_Scalar, & + VarIdx=p%iVarPropagationDir, & + Flags=ior(VF_ExtLin, VF_Linearize), & + LinNames=['Extended input: propagation direction, rad']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddVar(p%Vars%y, "HWindSpeed", VF_Scalar, & + VarIdx=p%iVarHWindSpeedY, & + Flags=VF_ExtLin, & + LinNames=['Extended output: horizontal wind speed (steady/uniform wind), m/s']) + + call MV_AddVar(p%Vars%y, "PLExp", VF_Scalar, & + VarIdx=p%iVarPLExpY, & + Flags=VF_ExtLin, & + LinNames=['Extended output: vertical power-law shear exponent, -']) + + call MV_AddVar(p%Vars%y, "PropagationDir", VF_Scalar, & + VarIdx=p%iVarPropagationDirY, & + Flags=VF_ExtLin, & + LinNames=['Extended output: propagation direction, rad']) + + call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + VarIdx=p%iVarWriteOutput, & + Flags=VF_WriteOut, & + Num=p%NumOuts, & + LinNames=[(WriteOutputLinName(i), i = 1, p%NumOuts)]) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + +contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !==================================================================================================== !> This routine takes an input dataset of type InputType which contains a position array of dimensions 3*n. It then calculates @@ -798,20 +900,21 @@ SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrSt REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) - ! local variables: - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_JacobianPInput' - REAL(R8Ki) :: local_dYdu(3,NumExtendedIO) - integer :: i,j, n - integer :: i_start, i_end ! indices for input/output start and end - integer :: node, comp + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_JacobianPInput' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message + REAL(R8Ki) :: local_dYdu(3, NumExtendedIO) + integer :: i, j, n + integer :: i_start, i_end ! indices for input/output start and end + integer :: node, comp - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdu ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! - inputs are extended inputs only + ! - outputs are the extended outputs and the WriteOutput values + if (present(dYdu)) then ! If dYdu is allocated, make sure it is the correct size if (allocated(dYdu)) then @@ -819,54 +922,59 @@ SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrSt if (size(dYdu,2) /= NumExtendedIO) deallocate (dYdu) endif - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - ! - inputs are extended inputs only - ! - outputs are the extended outputs and the WriteOutput values - if (.not. ALLOCATED(dYdu)) then - CALL AllocAry( dYdu, NumExtendedIO + p%NumOuts, NumExtendedIO, 'dYdu', ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, NumExtendedIO + p%NumOuts, NumExtendedIO, 'dYdu', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - - SELECT CASE ( p%FlowField%FieldType ) - CASE (Uniform_FieldType) - dYdu = 0.0_R8Ki ! initialize all non-diagonal entries to zero (position of node effects the output of only that node) + ! Switch based on type of flowfield + select case (p%FlowField%FieldType) + case (Uniform_FieldType) + + ! Initialize all non-diagonal entries to zero (position of node effects the output of only that node) + dYdu = 0.0_R8Ki ! Extended inputs to extended outputs (direct pass-through) - do i=1,NumExtendedIO + do i = 1, NumExtendedIO dYdu(i,i) = 1.0_R8Ki enddo ! WriteOutput velocities (note: may not have all of the components of each point) - do i=1, p%NumOuts + do i = 1, p%NumOuts + node = p%OutParamLinIndx(1,i) ! output node comp = p%OutParamLinIndx(2,i) ! component of output node if (node > 0) then - call IfW_UniformWind_JacobianPInput( p%FlowField%Uniform, t, p%WindViXYZ(:,node), p%FlowField%RotToWind(1,1), p%FlowField%RotToWind(2,1), local_dYdu ) + call IfW_UniformWind_JacobianPInput(p%FlowField%Uniform, t, p%WindViXYZ(:,node), & + p%FlowField%RotToWind(1,1), & + p%FlowField%RotToWind(2,1), & + local_dYdu) else local_dYdu = 0.0_R8Ki comp = 1 end if - dYdu(NumExtendedIO+i, 1:NumExtendedIO) = p%OutParam(i)%SignM * local_dYdu( comp , 1:NumExtendedIO) + + dYdu(NumExtendedIO+i, 1:NumExtendedIO) = p%OutParam(i)%SignM * local_dYdu(comp, 1:NumExtendedIO) + end do - CASE DEFAULT - END SELECT - END IF + end select + end if - IF ( PRESENT( dXdu ) ) THEN + if (present(dXdu)) then if (allocated(dXdu)) deallocate(dXdu) - END IF + end if - IF ( PRESENT( dXddu ) ) THEN + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if - IF ( PRESENT( dZdu ) ) THEN + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if + END SUBROUTINE InflowWind_JacobianPInput diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index e744f710bf..7653754837 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -112,13 +112,22 @@ typedef ^ ^ CHARACTER(LinChanLen) LinNam typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - -typedef ^ ^ FlowFieldType *FlowField - - - "Flow field data to represent all wind types" - +typedef ^ ^ FlowFieldType *FlowField - - - "Flow field data to represent all wind types" - +typedef ^ ^ ModVarsType *Vars - - - "Module Variables" # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType CHARACTER(1024) RootFileName - - - "Root of the InflowWind input filename" - +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" +typedef ^ ^ IntKi iVarHWindSpeed - - - "Horizontal wind speed variable index" - +typedef ^ ^ IntKi iVarPLExp - - - "Vertical power-law shear exponent variable index" - +typedef ^ ^ IntKi iVarPropagationDir - - - "Propagation direction variable index" - +typedef ^ ^ IntKi iVarHWindSpeedY - - - "Horizontal wind speed variable index" - +typedef ^ ^ IntKi iVarPLExpY - - - "Vertical power-law shear exponent variable index" - +typedef ^ ^ IntKi iVarPropagationDirY - - - "Propagation direction variable index" - +typedef ^ ^ IntKi iVarWriteOutput - - - "Write output variable index" - +typedef ^ ^ CHARACTER(1024) RootFileName - - - "Root of the InflowWind input filename" - typedef ^ ^ DbKi DT - - - "Time step for cont. state integration & disc. state update" seconds typedef ^ ^ ReKi WindViXYZprime :: - - "List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ )" meters typedef ^ ^ ReKi WindViXYZ :: - - "List of XYZ coordinates for wind velocity measurements, 3xNWindVel" meters @@ -166,3 +175,4 @@ typedef ^ ^ InflowWind_InputType u_Avg typedef ^ ^ InflowWind_OutputType y_Avg - - - "outputs for computing rotor-averaged values" - typedef ^ ^ InflowWind_InputType u_Hub - - - "inputs for computing hub values" - typedef ^ ^ InflowWind_OutputType y_Hub - - - "outputs for computing hub values" - +typedef ^ ^ ModJacType Jac - - - "Values corresponding to module variables" - diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 24573708d3..9dd6593a0e 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -133,10 +133,19 @@ MODULE InflowWind_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data to represent all wind types [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE InflowWind_InitOutputType ! ======================= ! ========= InflowWind_ParameterType ======= TYPE, PUBLIC :: InflowWind_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarHWindSpeed = 0_IntKi !< Horizontal wind speed variable index [-] + INTEGER(IntKi) :: iVarPLExp = 0_IntKi !< Vertical power-law shear exponent variable index [-] + INTEGER(IntKi) :: iVarPropagationDir = 0_IntKi !< Propagation direction variable index [-] + INTEGER(IntKi) :: iVarHWindSpeedY = 0_IntKi !< Horizontal wind speed variable index [-] + INTEGER(IntKi) :: iVarPLExpY = 0_IntKi !< Vertical power-law shear exponent variable index [-] + INTEGER(IntKi) :: iVarPropagationDirY = 0_IntKi !< Propagation direction variable index [-] + INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Write output variable index [-] CHARACTER(1024) :: RootFileName !< Root of the InflowWind input filename [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZprime !< List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ ) [meters] @@ -198,6 +207,7 @@ MODULE InflowWind_Types TYPE(InflowWind_OutputType) :: y_Avg !< outputs for computing rotor-averaged values [-] TYPE(InflowWind_InputType) :: u_Hub !< inputs for computing hub values [-] TYPE(InflowWind_OutputType) :: y_Hub !< outputs for computing hub values [-] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] END TYPE InflowWind_MiscVarType ! ======================= CONTAINS @@ -700,6 +710,7 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if DstInitOutputData%FlowField => SrcInitOutputData%FlowField + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -737,6 +748,7 @@ subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%IsLoad_u) end if nullify(InitOutputData%FlowField) + nullify(InitOutputData%Vars) end subroutine subroutine InflowWind_PackInitOutput(RF, Indata) @@ -761,6 +773,13 @@ subroutine InflowWind_PackInitOutput(RF, Indata) call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -801,6 +820,24 @@ subroutine InflowWind_UnPackInitOutput(RF, OutData) else OutData%FlowField => null() end if + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -816,6 +853,25 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E character(*), parameter :: RoutineName = 'InflowWind_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + DstParamData%iVarHWindSpeed = SrcParamData%iVarHWindSpeed + DstParamData%iVarPLExp = SrcParamData%iVarPLExp + DstParamData%iVarPropagationDir = SrcParamData%iVarPropagationDir + DstParamData%iVarHWindSpeedY = SrcParamData%iVarHWindSpeedY + DstParamData%iVarPLExpY = SrcParamData%iVarPLExpY + DstParamData%iVarPropagationDirY = SrcParamData%iVarPropagationDirY + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput DstParamData%RootFileName = SrcParamData%RootFileName DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%WindViXYZprime)) then @@ -913,6 +969,12 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'InflowWind_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%WindViXYZprime)) then deallocate(ParamData%WindViXYZprime) end if @@ -952,6 +1014,20 @@ subroutine InflowWind_PackParam(RF, Indata) integer(B8Ki) :: LB(2), UB(2) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarHWindSpeed) + call RegPack(RF, InData%iVarPLExp) + call RegPack(RF, InData%iVarPropagationDir) + call RegPack(RF, InData%iVarHWindSpeedY) + call RegPack(RF, InData%iVarPLExpY) + call RegPack(RF, InData%iVarPropagationDirY) + call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%RootFileName) call RegPack(RF, InData%DT) call RegPackAlloc(RF, InData%WindViXYZprime) @@ -992,6 +1068,31 @@ subroutine InflowWind_UnPackParam(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarHWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarHWindSpeedY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPLExpY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPropagationDirY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RootFileName); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WindViXYZprime); if (RegCheckErr(RF, RoutineName)) return @@ -1427,6 +1528,9 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM call InflowWind_CopyOutput(SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -1455,6 +1559,8 @@ subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyOutput(MiscData%y_Hub, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackMisc(RF, Indata) @@ -1469,6 +1575,7 @@ subroutine InflowWind_PackMisc(RF, Indata) call InflowWind_PackOutput(RF, InData%y_Avg) call InflowWind_PackInput(RF, InData%u_Hub) call InflowWind_PackOutput(RF, InData%y_Hub) + call NWTC_Library_PackModJacType(RF, InData%Jac) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1487,6 +1594,7 @@ subroutine InflowWind_UnPackMisc(RF, OutData) call InflowWind_UnpackOutput(RF, OutData%y_Avg) ! y_Avg call InflowWind_UnpackInput(RF, OutData%u_Hub) ! u_Hub call InflowWind_UnpackOutput(RF, OutData%y_Hub) ! y_Hub + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac end subroutine subroutine InflowWind_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index ca32ebbd35..81a0e4b246 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -29,10 +29,11 @@ module FAST_Funcs use ElastoDyn use HydroDyn use InflowWind +use MAP +use MoorDyn use SeaState use ServoDyn use SubDyn -use MAP implicit none @@ -389,15 +390,15 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! case (Module_IceF) case (Module_IfW) - do j_ss = 1, ModData%SubSteps - n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 - t_module = n_t_module*ModData%DT + t_initial - call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, & - T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & - T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), & - T%IfW%m, ErrStat2, ErrMsg2) - if (Failed()) return - end do + ! do j_ss = 1, ModData%SubSteps + ! n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + ! t_module = n_t_module*ModData%DT + t_initial + ! call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, & + ! T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & + ! T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), & + ! T%IfW%m, ErrStat2, ErrMsg2) + ! if (Failed()) return + ! end do ! case (Module_MAP) ! case (Module_MD) @@ -621,7 +622,10 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, ! Select based on module ID select case (ModData%ID) -! case (Module_AD) + case (Module_AD) + call AD_JacobianPInput(ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), & + T%AD%z(ThisState), T%AD%OtherSt(ThisState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) case (Module_BD) call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & @@ -640,14 +644,20 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) -! case (Module_IfW) + case (Module_IfW) + call InflowWind_JacobianPInput(ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(ThisState), T%IfW%xd(ThisState), & + T%IfW%z(ThisState), T%IfW%OtherSt(ThisState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) case (Module_MAP) call MAP_JacobianPInput(ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(ThisState), T%MAP%xd(ThisState), & T%MAP%z(ThisState), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) -! case (Module_MD) + case (Module_MD) + call MD_JacobianPInput(ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(ThisState), T%MD%xd(ThisState), & + T%MD%z(ThisState), T%MD%OtherSt(ThisState), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) ! case (Module_SD) ! call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & @@ -689,7 +699,12 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err ! Select based on module ID select case (ModData%ID) -! case (Module_AD) + case (Module_AD) + call AD_JacobianPContState(ThisTime, T%AD%Input(1), T%AD%p, & + T%AD%x(ThisState), T%AD%xd(ThisState), & + T%AD%z(ThisState), T%AD%OtherSt(ThisState), & + T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) case (Module_BD) call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & @@ -714,14 +729,24 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) -! case (Module_IfW) + case (Module_IfW) + call InflowWind_JacobianPContState(ThisTime, T%IfW%Input(1), T%IfW%p, & + T%IfW%x(ThisState), T%IfW%xd(ThisState), & + T%IfW%z(ThisState), T%IfW%OtherSt(ThisState), & + T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) case (Module_MAP) ! MAP doesn't have a JacobianPContState subroutine ErrStat2 = ErrID_None ErrMsg2 = '' -! case (Module_MD) + case (Module_MD) + call MD_JacobianPContState(ThisTime, T%MD%Input(1), T%MD%p, & + T%MD%x(ThisState), T%MD%xd(ThisState), & + T%MD%z(ThisState), T%MD%OtherSt(ThisState), & + T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) ! case (Module_SD) ! call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index edbe4140cb..3a3b06d609 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -460,6 +460,26 @@ subroutine AD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM DstMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! AD%u%rotors(1)%TFinMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_IfW) + + call MapVariable(Mappings, "IfW HWindSpeed -> AD HWindSpeed", & + SrcMod=SrcMod, DstMod=DstMod, & + iVarSrc=Turbine%IfW%p%iVarHWindSpeed, & + iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarHWindSpeed, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + call MapVariable(Mappings, "IfW PLExp -> AD PLExp", & + SrcMod=SrcMod, DstMod=DstMod, & + iVarSrc=Turbine%IfW%p%iVarPLExp, & + iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarPLExp, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + call MapVariable(Mappings, "IfW PropagationDir -> AD PropagationDir", & + SrcMod=SrcMod, DstMod=DstMod, & + iVarSrc=Turbine%IfW%p%iVarPropagationDir, & + iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarPropagationDir, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + case (Module_SrvD) ! call MapVariable(Mappings, Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=SrcMod, DstMod=DstMod) @@ -597,6 +617,30 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ! TODO ! CALL MeshMapCreate( ExtLd%y%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2 ) + case (Module_HD) + + ! Coupling with HydroDyn if no substructure module is used + if (Turbine%p_FAST%CompSub == Module_None) then + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end if + + case (Module_MAP) + + + case (Module_SD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -631,17 +675,17 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM call MapVariable(Mappings, "SrvD BlPitchCom -> ED BlPitchCom", & SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarBlPitchCom, & DstMod=DstMod, iVarDst=Turbine%ED%p%iVarBlPitchCom, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "SrvD YawMom -> ED YawMom", & SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarYawMom, & DstMod=DstMod, iVarDst=Turbine%ED%p%iVarYawMom, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "SrvD GenTrq -> ED GenTrq", & SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarGenTrq, & DstMod=DstMod, iVarDst=Turbine%ED%p%iVarGenTrq, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return end select @@ -658,10 +702,10 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM do i = 1, size(Turbine%ED%Input(1)%BladePtLoads) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(), & ! AD%y%rotors(1)%BladeLoad(i) - SrcDispMeshLoc=MeshLocType(), & ! AD%u%rotors(1)%BladeMotion(i) - DstMeshLoc=MeshLocType(), & ! ED%u%BladePtLoads(i) - DstDispMeshLoc=MeshLocType(), & ! ED%y%BladeLn2Mesh(i) + SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, AD_rotor, i), & ! AD%y%rotors(iR)%BladeLoad(i) + SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, i), & ! AD%u%rotors(iR)%BladeMotion(i) + DstMeshLoc=MeshLocType(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -709,22 +753,6 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ! MeshMapCreate( FEAM%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) - case (Module_HD) - - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh - SrcDispMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh - SrcDispMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - case (Module_IceD) ! MeshMapCreate( IceD%y(i)%PointMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) @@ -1209,16 +1237,24 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er ErrStat = ErrID_None ErrMsg = '' - ! MeshMapCreate( BD%y(k)%BldMotion, SrvD%Input(1)%BStCMotionMesh(K,j), MeshMapData%BD_L_2_BStC_P_B(K,j), ErrStat2, ErrMsg2 ) - ! MeshMapCreate( ED%y%BladeLn2Mesh(K), SrvD%Input(1)%BStCMotionMesh(K,j), MeshMapData%ED_L_2_BStC_P_B(K,j), ErrStat2, ErrMsg2 ) - ! MeshMapCreate( ED%y%NacelleMotion, SrvD%Input(1)%NStCMotionMesh(j), MeshMapData%ED_P_2_NStC_P_N(j), ErrStat2, ErrMsg2 ) - ! MeshMapCreate( ED%y%TowerLn2Mesh, SrvD%Input(1)%TStCMotionMesh(j), MeshMapData%ED_L_2_TStC_P_T(j), ErrStat2, ErrMsg2 ) + + + ! MeshMapCreate( PlatformMotion, SrvD%Input(1)%PtfmMotionMesh, MeshMapData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) ! MeshMapCreate( SubStructureMotion, SrvD%Input(1)%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) select case (SrcMod%ID) + case (Module_BD) + ! Blade Structural Controller + do i = 1, Turbine%SrvD%p%NumBStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y%BldMotion + DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, DstMod%Ins), & ! SrvD%u%BStCMotionMesh(i, j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + ! TODO ! call MapVariable(Mappings, "BD Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) ! call MapVariable(Mappings, "BD RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) @@ -1271,22 +1307,22 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er call MapVariable(Mappings, "ED Yaw -> SrvD Yaw", & SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarYaw, & DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarYaw, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED YawRate -> SrvD YawRate", & SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarYawRate, & DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarYawRate, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarHSS_Spd, & DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarHSS_Spd, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarHSS_Spd, & DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarHSS_Spd, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return case (Module_IfW) @@ -1687,7 +1723,7 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er ! Select based on type of mapping select case (Mapping%MapType) case (Map_Variable) - + if (.not. present(dUdy)) cycle associate (SrcMod => Mods(Mapping%SrcModIdx), & @@ -1772,17 +1808,17 @@ subroutine dUduSetBlocks(Mapping, dM) type(TC_MappingType), intent(inout) :: Mapping !< Mapping type(MeshMapLinearizationType), intent(in) :: dM !< Mesh Map Linearization data - ! Effect of input Translation Velocity on input Translation Displacement + ! Effect of input Translation Displacement on input Translation Velocity if (allocated(dM%tv_uD)) then call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocDstTransDisp, dM%tv_uD, dUdU) end if - ! Effect of input Translation Acceleration on input Translation Displacement + ! Effect of input Translation Displacement on input Translation Acceleration if (allocated(dM%ta_uD)) then call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocDstTransDisp, dM%ta_uD, dUdU) end if - ! Effect of input Moments on input Translation Displacement + ! Effect of input Translation Displacement on input Moments if (allocated(dM%M_uS)) then call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcDispTransDisp, dM%M_uS, dUdU) end if @@ -1798,12 +1834,12 @@ subroutine dUdySetBlocks(Mapping, dM) call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcMoment, dM%li, dUdy) end if - ! Moment to Force + ! Force to Moment if (allocated(dM%m_f)) then call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcForce, dM%m_f, dUdy) end if - ! Moment to destination translation displacement + ! Destination translation displacement to Moment if (allocated(dM%m_uD)) then if (Mapping%DstUsesSibling) then ! Direct transfer @@ -1827,24 +1863,24 @@ subroutine dUdySetBlocks(Mapping, dM) call SumBlock(Mapping%iLocDstAngularAcc, Mapping%iLocSrcAngularAcc, dM%mi, dUdy) end if - ! Translation to Rotation + ! Rotation to Translation if (allocated(dM%fx_p)) then call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcOrientation, dM%fx_p, dUdy) call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcAngularVel, dM%fx_p, dUdy) call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularAcc, dM%fx_p, dUdy) end if - ! Translation velocity to translation displacement + ! Translation displacement to Translation velocity if (allocated(dM%tv_us)) then - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocDstDispTransDisp, dM%tv_us, dUdy) + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransDisp, dM%tv_us, dUdy) end if - ! Translation acceleration to translation displacement + ! Translation displacement to Translation acceleration if (allocated(dM%ta_us)) then call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransDisp, dM%ta_us, dUdy) end if - ! Translation acceleration to angular velocity + ! Angular velocity to Translation acceleration if (allocated(dM%ta_rv)) then call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularVel, dM%ta_rv, dUdy) end if @@ -1860,7 +1896,6 @@ subroutine SumBlock(iLocRow, iLocCol, SrcM, DstM) DstSubM = DstSubM - SrcM end associate end if - end subroutine logical function Failed() diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModLin.f90 index 3d6620d8cb..c41444988e 100644 --- a/modules/openfast-library/src/FAST_ModLin.f90 +++ b/modules/openfast-library/src/FAST_ModLin.f90 @@ -399,6 +399,7 @@ subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_F dYdu=ModData%Lin%dYdu, dXdu=ModData%Lin%dXdu) if (Failed()) return + ! Derivatives wrt continuous state call FAST_JacobianPContState(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & dYdx=ModData%Lin%dYdx, dXdx=ModData%Lin%dXdx, & @@ -441,6 +442,36 @@ subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_F if (Failed()) return end if + + ! Check for NaNs or infinity in module Jacobian matrices + if (allocated(ModData%Lin%dYdu)) then + if (any(isnan(ModData%Lin%dYdu))) then + ErrStat = ErrID_Fatal + ErrMsg = 'NaNs detected in dYdu for module '//ModData%Abbr + return + end if + end if + if (allocated(ModData%Lin%dXdu)) then + if (any(isnan(ModData%Lin%dXdu))) then + ErrStat = ErrID_Fatal + ErrMsg = 'NaNs detected in dXdu for module '//ModData%Abbr + return + end if + end if + if (allocated(ModData%Lin%dYdx)) then + if (any(isnan(ModData%Lin%dYdx))) then + ErrStat = ErrID_Fatal + ErrMsg = 'NaNs detected in dYdx for module '//ModData%Abbr + return + end if + end if + if (allocated(ModData%Lin%dXdx)) then + if (any(isnan(ModData%Lin%dXdx))) then + ErrStat = ErrID_Fatal + ErrMsg = 'NaNs detected in dXdx for module '//ModData%Abbr + return + end if + end if end associate end do diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index dc57104ae4..41c1005d06 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -584,6 +584,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS end if + CALL MV_AddModule(y_FAST%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + Init%OutData_IfW%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN From a8bea4ae8a28725d707ba2d0a7851740e50fd0f8 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Feb 2024 03:30:33 +0000 Subject: [PATCH 083/319] Add AD extended inputs as standard inputs --- modules/aerodyn/src/AeroDyn.f90 | 6 +++--- modules/openfast-library/src/FAST_Mapping.f90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 07cc0705d2..25ca0634b2 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5514,19 +5514,19 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD ! Extended inputs call MV_AddVar(p%Vars%u, "HWindSpeed", VF_Scalar, & VarIdx=p%iVarHWindSpeed, & - Flags=VF_ExtLin, & + Flags=VF_ExtLin + VF_Linearize, & Perturb=2.0_R8Ki*D2R_D, & LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) call MV_AddVar(p%Vars%u, "PLExp", VF_Scalar, & VarIdx=p%iVarPLexp, & - Flags=VF_ExtLin, & + Flags=VF_ExtLin + VF_Linearize, & Perturb=2.0_R8Ki*D2R_D, & LinNames=['Extended input: vertical power-law shear exponent, -']) call MV_AddVar(p%Vars%u, "PropagationDir", VF_Scalar, & VarIdx=p%iVarPropagationDir, & - Flags=VF_ExtLin, & + Flags=VF_ExtLin + VF_Linearize, & Perturb=2.0_R8Ki*D2R_D, & LinNames=['Extended input: propagation direction, rad']) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 3a3b06d609..b40302f128 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1839,7 +1839,7 @@ subroutine dUdySetBlocks(Mapping, dM) call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcForce, dM%m_f, dUdy) end if - ! Destination translation displacement to Moment + ! Destination Translation Displacement to Moment if (allocated(dM%m_uD)) then if (Mapping%DstUsesSibling) then ! Direct transfer From d7c3d598665687950d1c0a1173046c5000875b3c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Feb 2024 13:53:48 +0000 Subject: [PATCH 084/319] Change OP type in InflowWind_GetOP to R8Ki --- modules/inflowwind/src/InflowWind.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index 8f75659adb..42dc658aa7 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -1188,7 +1188,7 @@ SUBROUTINE InflowWind_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states INTEGER(IntKi) :: i - real(ReKi) :: tmp_op(NumExtendedIO) + real(R8Ki) :: tmp_op(NumExtendedIO) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_GetOP' From a40ed6082a5236e18c1d199427fe2532231eb1c5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Feb 2024 14:50:09 +0000 Subject: [PATCH 085/319] Fix bug in AD WriteOutput Variable creation --- modules/aerodyn/src/AeroDyn.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 25ca0634b2..c928dd5d3f 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5335,7 +5335,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD character(64) :: NodeLabel character(1), parameter :: UVW(3) = ['U','V','W'] real(R8Ki) :: Perturb, PerturbTower, PerturbBlade(MaxBl) - integer(IntKi) :: i, j, k + integer(IntKi) :: i, j ErrStat = ErrID_None ErrMsg = "" @@ -5360,8 +5360,8 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD Perturb = 2.0_R8Ki * D2R_D - do k = 1, p%NumBlades - PerturbBlade(k) = 0.2_R8Ki * D2R_D * InputFileData%BladeProps(k)%BlSpn(InputFileData%BladeProps(k)%NumBlNds) + do i = 1, p%NumBlades + PerturbBlade(i) = 0.2_R8Ki * D2R_D * InputFileData%BladeProps(i)%BlSpn(InputFileData%BladeProps(i)%NumBlNds) end do if (u%TowerMotion%NNodes > 0) then @@ -5490,10 +5490,10 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD Perturbs=[PerturbBlade(j), Perturb, PerturbBlade(j), Perturb, PerturbBlade(j), Perturb]) ! Set AeroMap flag on subset of fields for first blade if (j == 1) then - do k = p%iVarBladeMotion(j), size(p%Vars%u) - select case (p%Vars%u(k)%Field) + do i = p%iVarBladeMotion(j), size(p%Vars%u) + select case (p%Vars%u(i)%Field) case (VF_TransDisp, VF_Orientation, VF_TransVel) - call MV_SetFlags(p%Vars%u(k), VF_AeroMap) + call MV_SetFlags(p%Vars%u(i), VF_AeroMap) end select end do end if @@ -5503,12 +5503,12 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call AllocAry(p%iVarUserProp, p%NumBlades, "iVarUserProp", ErrStat2, ErrMsg2); if (Failed()) return p%iVarUserProp = 0 do j = 1, p%NumBlades - call MV_AddVar(p%Vars%u, "UserProp Blade"//IdxStr(k), VF_Scalar, & + call MV_AddVar(p%Vars%u, "UserProp Blade"//IdxStr(j), VF_Scalar, & VarIdx=p%iVarUserProp(j), & Flags=ior(VF_Linearize, VF_RotFrame), & Num=p%NumBlNds, & Perturb=2.0_R8Ki*D2R_D, & - LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(k))//', -', k = 1, p%NumBlNds)]) + LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', -', i = 1, p%NumBlNds)]) end do ! Extended inputs @@ -5578,7 +5578,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD do j = p%NumOuts + 1, p%NumOuts + p%BldNd_TotNumOuts call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), VF_Scalar, & Flags=VF_WriteOut + VF_RotFrame, & - iUsr=k, & + iUsr=j, & LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) end do From d9ed81568faaf1c3252ca352b7ffccca8e97fd73 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Feb 2024 14:50:32 +0000 Subject: [PATCH 086/319] Add docs to FAST_LinearizeMappings, minor cleanup --- modules/openfast-library/src/FAST_Mapping.f90 | 228 ++++++++++-------- 1 file changed, 126 insertions(+), 102 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index b40302f128..a837e85578 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -639,8 +639,6 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_MAP) - - case (Module_SD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -1237,9 +1235,6 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er ErrStat = ErrID_None ErrMsg = '' - - - ! MeshMapCreate( PlatformMotion, SrvD%Input(1)%PtfmMotionMesh, MeshMapData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) ! MeshMapCreate( SubStructureMotion, SrvD%Input(1)%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) @@ -1254,7 +1249,7 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, DstMod%Ins), & ! SrvD%u%BStCMotionMesh(i, j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do - + ! TODO ! call MapVariable(Mappings, "BD Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) ! call MapVariable(Mappings, "BD RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) @@ -1701,7 +1696,7 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er integer(IntKi), intent(in) :: ModOrder(:) integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - real(R8Ki), optional, intent(inout) :: dUdu(:, :), dUdy(:, :) + real(R8Ki), intent(inout) :: dUdu(:, :), dUdy(:, :) character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' integer(IntKi) :: ErrStat2 @@ -1722,9 +1717,8 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er ! Select based on type of mapping select case (Mapping%MapType) - case (Map_Variable) - if (.not. present(dUdy)) cycle + case (Map_Variable) associate (SrcMod => Mods(Mapping%SrcModIdx), & DstMod => Mods(Mapping%DstModIdx), & @@ -1744,6 +1738,12 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er ! Perform linearization based on transfer type call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap); if (Failed()) return + ! Copy linearization matrices to global dUdy matrix + call Assemble_dUdy_Motions(Mapping, dUdy) + + ! Copy linearization matrices to global dUdu matrix + call Assemble_dUdu(Mapping, dUdu) + case (Map_LoadMesh) ! Get source and destination meshes @@ -1769,17 +1769,13 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh); if (Failed()) return end if - end select + ! Copy linearization matrices to global dUdy matrix + call Assemble_dUdy_Loads(Mapping, dUdy) - ! Copy linearization matrices to global dUdu matrix - if (present(dUdu)) then - call dUduSetBlocks(Mapping, Mapping%MeshMap%dM) - end if + ! Copy linearization matrices to global dUdu matrix + call Assemble_dUdu(Mapping, dUdu) - ! Copy linearization matrices to global dUdy matrix - if (present(dUdy)) then - call dUdySetBlocks(Mapping, Mapping%MeshMap%dM) - end if + end select end associate end do @@ -1787,6 +1783,8 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er contains + ! LinearizeMeshTransfer calls the specific linearization function based on + ! transfer type (Point_to_Point, Point_to_Line2, etc.) subroutine LinearizeMeshTransfer(Typ, Src, Dst, MMap, SrcDisp, DstDisp) integer(IntKi), intent(in) :: Typ type(MeshType), intent(in) :: Src, Dst @@ -1801,107 +1799,133 @@ subroutine LinearizeMeshTransfer(Typ, Src, Dst, MMap, SrcDisp, DstDisp) call Linearize_Line2_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case (Xfr_Line2_to_Line2) call Linearize_Line2_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "LinearizeMeshTransfer: unknown transfer type: "//Num2LStr(Typ) end select end subroutine - subroutine dUduSetBlocks(Mapping, dM) - type(TC_MappingType), intent(inout) :: Mapping !< Mapping - type(MeshMapLinearizationType), intent(in) :: dM !< Mesh Map Linearization data - - ! Effect of input Translation Displacement on input Translation Velocity - if (allocated(dM%tv_uD)) then - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocDstTransDisp, dM%tv_uD, dUdU) - end if + logical function Failed() + Failed = ErrStat2 >= AbortErrLev + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end function +end subroutine - ! Effect of input Translation Displacement on input Translation Acceleration - if (allocated(dM%ta_uD)) then - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocDstTransDisp, dM%ta_uD, dUdU) - end if +subroutine Assemble_dUdu(Mapping, dUdu) + type(TC_MappingType), intent(in) :: Mapping + real(R8Ki), intent(inout) :: dUdu(:, :) - ! Effect of input Translation Displacement on input Moments - if (allocated(dM%M_uS)) then - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcDispTransDisp, dM%M_uS, dUdU) - end if - end subroutine + ! Effect of input Translation Displacement on input Translation Velocity + if (allocated(Mapping%MeshMap%dM%tv_uD)) then + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocDstTransDisp, Mapping%MeshMap%dM%tv_uD, dUdu) + end if - subroutine dUdySetBlocks(Mapping, dM) - type(TC_MappingType), intent(inout) :: Mapping !< Mapping - type(MeshMapLinearizationType), intent(in) :: dM !< Mesh Map Linearization data + ! Effect of input Translation Displacement on input Translation Acceleration + if (allocated(Mapping%MeshMap%dM%ta_uD)) then + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocDstTransDisp, Mapping%MeshMap%dM%ta_uD, dUdu) + end if - ! Load identity - if (allocated(dM%li)) then - call SumBlock(Mapping%iLocDstForce, Mapping%iLocSrcForce, dM%li, dUdy) - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcMoment, dM%li, dUdy) - end if + ! Effect of input Translation Displacement on input Moments + if (allocated(Mapping%MeshMap%dM%M_uS)) then + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcDispTransDisp, Mapping%MeshMap%dM%M_uS, dUdu) + end if +end subroutine - ! Force to Moment - if (allocated(dM%m_f)) then - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcForce, dM%m_f, dUdy) - end if +!> Assemble_dUdy_Loads assembles the linearization matrices for transfer of +!! load fields between two meshes. It sets the following block matrix, which +!! is the dUdy block for transfering output (source) mesh to the input +!! (destination) mesh : +!! M = -| M_li 0 | * M_mi | F^S | +!! | M_fm M_li | | M^S | +subroutine Assemble_dUdy_Loads(Mapping, dUdy) + type(TC_MappingType), intent(inout) :: Mapping + real(R8Ki), intent(inout) :: dUdy(:, :) + + ! Load identity + if (allocated(Mapping%MeshMap%dM%li)) then + call SumBlock(Mapping%iLocDstForce, Mapping%iLocSrcForce, Mapping%MeshMap%dM%li, dUdy) + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcMoment, Mapping%MeshMap%dM%li, dUdy) + end if - ! Destination Translation Displacement to Moment - if (allocated(dM%m_uD)) then - if (Mapping%DstUsesSibling) then - ! Direct transfer - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, dM%m_uD, dUdy) - else - ! Compose linearization of motion and loads - Mapping%TmpMatrix = matmul(dM%m_uD, Mapping%MeshMapAux%dM%mi) - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, Mapping%TmpMatrix, dUdy) - Mapping%TmpMatrix = matmul(dM%m_uD, Mapping%MeshMapAux%dM%fx_p) - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispOrientation, Mapping%TmpMatrix, dUdy) - end if - end if + ! Force to Moment + if (allocated(Mapping%MeshMap%dM%m_f)) then + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcForce, Mapping%MeshMap%dM%m_f, dUdy) + end if - ! Motion identity - if (allocated(dM%mi)) then - call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcTransDisp, dM%mi, dUdy) - call SumBlock(Mapping%iLocDstOrientation, Mapping%iLocSrcOrientation, dM%mi, dUdy) - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransVel, dM%mi, dUdy) - call SumBlock(Mapping%iLocDstAngularVel, Mapping%iLocSrcAngularVel, dM%mi, dUdy) - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransAcc, dM%mi, dUdy) - call SumBlock(Mapping%iLocDstAngularAcc, Mapping%iLocSrcAngularAcc, dM%mi, dUdy) + ! Destination Translation Displacement to Moment + if (allocated(Mapping%MeshMap%dM%m_uD)) then + if (Mapping%DstUsesSibling) then + ! Direct transfer + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, Mapping%MeshMap%dM%m_uD, dUdy) + else + ! Compose linearization of motion and loads + Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%mi) + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, Mapping%TmpMatrix, dUdy) + Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%fx_p) + call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispOrientation, Mapping%TmpMatrix, dUdy) end if + end if +end subroutine - ! Rotation to Translation - if (allocated(dM%fx_p)) then - call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcOrientation, dM%fx_p, dUdy) - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcAngularVel, dM%fx_p, dUdy) - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularAcc, dM%fx_p, dUdy) - end if +!> Assemble_dUdy_Motions assembles the linearization matrices for transfer of +!! motion fields between two meshes. It set the following block matrix, which +!! is the dUdy block for transfering output (source) mesh to the input +!! (destination) mesh : +!! M = -| M_mi M_f_p 0 0 0 0 | +!! | 0 M_mi 0 0 0 0 | +!! | M_tv_uS 0 M_mi M_f_p 0 0 | +!! | 0 0 0 M_mi 0 0 | +!! | M_ta_uS 0 0 M_ta_rv M_mi M_f_p | +!! | 0 0 0 0 0 M_mi | +!! where the matrices correspond to +!! u^S, theta^S, v^S, omega^S, a^S, alpha^S +subroutine Assemble_dUdy_Motions(Mapping, dUdy) + type(TC_MappingType), intent(inout) :: Mapping + real(R8Ki), intent(inout) :: dUdy(:, :) + + ! Motion identity + if (allocated(Mapping%MeshMap%dM%mi)) then + call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcTransDisp, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Mapping%iLocDstOrientation, Mapping%iLocSrcOrientation, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransVel, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Mapping%iLocDstAngularVel, Mapping%iLocSrcAngularVel, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransAcc, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Mapping%iLocDstAngularAcc, Mapping%iLocSrcAngularAcc, Mapping%MeshMap%dM%mi, dUdy) + end if - ! Translation displacement to Translation velocity - if (allocated(dM%tv_us)) then - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransDisp, dM%tv_us, dUdy) - end if + ! Rotation to Translation + if (allocated(Mapping%MeshMap%dM%fx_p)) then + call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcOrientation, Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcAngularVel, Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularAcc, Mapping%MeshMap%dM%fx_p, dUdy) + end if - ! Translation displacement to Translation acceleration - if (allocated(dM%ta_us)) then - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransDisp, dM%ta_us, dUdy) - end if + ! Translation displacement to Translation velocity + if (allocated(Mapping%MeshMap%dM%tv_us)) then + call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransDisp, Mapping%MeshMap%dM%tv_us, dUdy) + end if - ! Angular velocity to Translation acceleration - if (allocated(dM%ta_rv)) then - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularVel, dM%ta_rv, dUdy) - end if - end subroutine + ! Translation displacement to Translation acceleration + if (allocated(Mapping%MeshMap%dM%ta_us)) then + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransDisp, Mapping%MeshMap%dM%ta_us, dUdy) + end if - subroutine SumBlock(iLocRow, iLocCol, SrcM, DstM) - integer(IntKi), intent(in) :: iLocRow(2), iLocCol(2) - real(R8Ki), intent(in) :: SrcM(:, :) - real(R8Ki), intent(inout) :: DstM(:, :) - if (iLocRow(1) > 0 .and. iLocCol(1) > 0) then - ! Subtracts the source matrix from the destination sub-matrix - associate (DstSubM => DstM(iLocRow(1):iLocRow(2), iLocCol(1):iLocCol(2))) - DstSubM = DstSubM - SrcM - end associate - end if - end subroutine + ! Angular velocity to Translation acceleration + if (allocated(Mapping%MeshMap%dM%ta_rv)) then + call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularVel, Mapping%MeshMap%dM%ta_rv, dUdy) + end if +end subroutine - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function +subroutine SumBlock(iLocRow, iLocCol, SrcM, DstM) + integer(IntKi), intent(in) :: iLocRow(2), iLocCol(2) + real(R8Ki), intent(in) :: SrcM(:, :) + real(R8Ki), intent(inout) :: DstM(:, :) + if (iLocRow(1) > 0 .and. iLocCol(1) > 0) then + ! Subtracts the source matrix from the destination sub-matrix + associate (DstSubM => DstM(iLocRow(1):iLocRow(2), iLocCol(1):iLocCol(2))) + DstSubM = DstSubM - SrcM + end associate + end if end subroutine subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) From 04ac77a248cfcf8275f01ad6496c28ca542e6e3b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Feb 2024 14:50:48 +0000 Subject: [PATCH 087/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 96697bf743..9e4c9f8412 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 96697bf7436d6583e62f34eedc09578c16a3c669 +Subproject commit 9e4c9f841278b77a35623baa96ba819077074f93 From a2e9cb7b1b848715dfa109d83a44a6893a0f1498 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Feb 2024 21:32:05 +0000 Subject: [PATCH 088/319] Fixed UA State variables and packing, use RotInflow_perturb in functions --- modules/aerodyn/src/AeroDyn.f90 | 129 ++++++++++++++------------------ 1 file changed, 55 insertions(+), 74 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index c928dd5d3f..287de8a2bd 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5335,7 +5335,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD character(64) :: NodeLabel character(1), parameter :: UVW(3) = ['U','V','W'] real(R8Ki) :: Perturb, PerturbTower, PerturbBlade(MaxBl) - integer(IntKi) :: i, j + integer(IntKi) :: i, j, n, state ErrStat = ErrID_None ErrMsg = "" @@ -5400,34 +5400,30 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD end if ! Unsteady Aero - if (p%BEMT%UA%lin_nx > 0) then + if (p%BEMT%UA%lin_nx == 0) then + p%iVarUA = 0 + else p%iVarUA = size(p%Vars%x) + 1 - do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - NodeLabel = 'blade '//trim(num2lstr(j))//', node '//trim(num2lstr(i)) - if (p%BEMT%UA%UAMod/=UA_OYE) then - call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & - Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=Perturb, & - LinNames=['x1 '//trim(NodeLabel)//', rad']) - call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & - Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=Perturb, & - LinNames=['x2 '//trim(NodeLabel)//', rad']) - call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & - Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=Perturb, & - LinNames=['x3 '//trim(NodeLabel)//', -']) - endif - call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & - Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=0.001_R8Ki, & ! x4 is a number between 0 and 1, so we need this to be small - LinNames=['x4 '//trim(NodeLabel)//', -']) - end do + ! Loop through UA elements + do n = 1, p%BEMT%UA%lin_nx + + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + state = p%BEMT%UA%lin_xIndx(n,3) + + select case (state) + case (1, 2) ! x1 and x2 are radians + NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', rad' + case (3, 4, 5) ! x3, x4 (and x5) are units of cl or cn + NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', -' + end select + + call MV_AddVar(p%Vars%x, NodeLabel, VF_Scalar, & + Flags=ior(VF_DerivOrder1, VF_RotFrame), & + Perturb=p%BEMT%UA%dx(state), & + LinNames=[NodeLabel]) end do - else - p%iVarUA = 0 end if ! BEMT states @@ -5507,7 +5503,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD VarIdx=p%iVarUserProp(j), & Flags=ior(VF_Linearize, VF_RotFrame), & Num=p%NumBlNds, & - Perturb=2.0_R8Ki*D2R_D, & + Perturb=Perturb, & LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', -', i = 1, p%NumBlNds)]) end do @@ -5515,19 +5511,19 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call MV_AddVar(p%Vars%u, "HWindSpeed", VF_Scalar, & VarIdx=p%iVarHWindSpeed, & Flags=VF_ExtLin + VF_Linearize, & - Perturb=2.0_R8Ki*D2R_D, & + Perturb=Perturb, & LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) call MV_AddVar(p%Vars%u, "PLExp", VF_Scalar, & VarIdx=p%iVarPLexp, & Flags=VF_ExtLin + VF_Linearize, & - Perturb=2.0_R8Ki*D2R_D, & + Perturb=Perturb, & LinNames=['Extended input: vertical power-law shear exponent, -']) call MV_AddVar(p%Vars%u, "PropagationDir", VF_Scalar, & VarIdx=p%iVarPropagationDir, & Flags=VF_ExtLin + VF_Linearize, & - Perturb=2.0_R8Ki*D2R_D, & + Perturb=Perturb, & LinNames=['Extended input: propagation direction, rad']) !---------------------------------------------------------------------------- @@ -5674,6 +5670,8 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM return endif + call AD_CalcWind_Rotor(t, u%rotors(iR), p%FlowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return call Rot_JacobianPInput( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) END SUBROUTINE AD_JacobianPInput @@ -5792,7 +5790,7 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(p, i, FF_perturb, p_AD%FlowField, 1) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, 1, FF_ptr) call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return @@ -5804,7 +5802,7 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(p, i, FF_perturb, p_AD%FlowField, -1) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, -1, FF_ptr) call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return @@ -5841,12 +5839,16 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, 1, FF_ptr) + call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, -1, FF_ptr) + call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) @@ -5870,21 +5872,20 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y call cleanup() contains - subroutine PerturbFlowField(p, iVar, PerturbFF, BaseFF, PerturbSign) - type(RotParameterType), intent(in) :: p + subroutine PerturbFlowField(iVar, BaseFF, PerturbSign, PerturbFF) integer(IntKi), intent(in) :: iVar - type(FlowFieldType), intent(inout) :: PerturbFF type(FlowFieldType), intent(in) :: BaseFF integer(IntKi), intent(in) :: PerturbSign + type(FlowFieldType), intent(inout) :: PerturbFF PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV PerturbFF%PropagationDir = BaseFF%PropagationDir if (iVar == p%iVarHWindSpeed) then - PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH - p%Vars%u(iVar)%Perturb + PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH + p%Vars%u(iVar)%Perturb*PerturbSign else if (iVar == p%iVarPLexp) then - PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV - p%Vars%u(iVar)%Perturb + PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV + p%Vars%u(iVar)%Perturb*PerturbSign else if (iVar == p%iVarPropagationDir) then - PerturbFF%PropagationDir = BaseFF%PropagationDir - p%Vars%u(iVar)%Perturb + PerturbFF%PropagationDir = BaseFF%PropagationDir + p%Vars%u(iVar)%Perturb*PerturbSign end if end subroutine logical function Failed() @@ -6597,7 +6598,7 @@ subroutine AD_PackStateValues(p, x, Ary) type(RotParameterType), intent(in) :: p type(RotContinuousStateType), intent(in) :: x real(R8Ki), intent(out) :: Ary(:) - integer(IntKi) :: i, j, k, ind + integer(IntKi) :: i, j, k, n, ind ind = 1 if (p%BEMT%DBEMT%lin_nx > 0) then do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) @@ -6619,23 +6620,13 @@ subroutine AD_PackStateValues(p, x, Ary) end if if (p%BEMT%UA%lin_nx > 0) then - if (p%BEMT%UA%UAMod == UA_OYE) then - do j = 1, p%NumBlades ! size(x%BEMT%UA%element,2) - do i = 1, p%NumBlNds ! size(x%BEMT%UA%element,1) - Ary(ind) = x%BEMT%UA%element(i,j)%x(4) - ind = ind + 1 - end do - end do - else - do j = 1, p%NumBlades ! size(x%BEMT%UA%element,2) - do i = 1, p%NumBlNds ! size(x%BEMT%UA%element,1) - do k = 1, 4 !size(x%BEMT%UA%element(i,j)%x) !linearize only first 4 states (5th is vortex) - Ary(ind) = x%BEMT%UA%element(i,j)%x(k) - ind = ind + 1 - end do - end do - end do - endif + do n = 1, p%BEMT%UA%lin_nx + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + k = p%BEMT%UA%lin_xIndx(n,3) + Ary(ind) = x%BEMT%UA%element(i,j)%x(k) + ind = ind + 1 + end do end if end subroutine @@ -6643,7 +6634,7 @@ subroutine AD_UnpackStateValues(p, Ary, x) type(RotParameterType), intent(in) :: p real(R8Ki), intent(in) :: ary(:) type(RotContinuousStateType), intent(inout) :: x - integer(IntKi) :: i, j, k, ind + integer(IntKi) :: i, j, k, n, ind ind = 1 if (p%BEMT%DBEMT%lin_nx > 0) then do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) @@ -6665,23 +6656,13 @@ subroutine AD_UnpackStateValues(p, Ary, x) end if if (p%BEMT%UA%lin_nx > 0) then - if (p%BEMT%UA%UAMod == UA_OYE) then - do j = 1, p%NumBlades ! size(x%BEMT%UA%element,2) - do i = 1, p%NumBlNds ! size(x%BEMT%UA%element,1) - x%BEMT%UA%element(i,j)%x(4) = Ary(ind) - ind = ind + 1 - end do - end do - else - do j = 1, p%NumBlades ! size(x%BEMT%UA%element,2) - do i = 1, p%NumBlNds ! size(x%BEMT%UA%element,1) - do k = 1, 4 !size(x%BEMT%UA%element(i,j)%x) !linearize only first 4 states (5th is vortex) - x%BEMT%UA%element(i,j)%x(k) = Ary(ind) - ind = ind + 1 - end do - end do - end do - endif + do n = 1, p%BEMT%UA%lin_nx + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + k = p%BEMT%UA%lin_xIndx(n,3) + x%BEMT%UA%element(i,j)%x(k) = Ary(ind) + ind = ind + 1 + end do end if end subroutine From febda0d5f8f30a45cd579d3ea19dcce76898d7b8 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Feb 2024 21:47:06 +0000 Subject: [PATCH 089/319] FAST_Mapping: added comments, fixed load mesh linearization for non-sibling meshes --- modules/openfast-library/src/FAST_Mapping.f90 | 54 +++++++++++++++---- 1 file changed, 44 insertions(+), 10 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index a837e85578..f1ee35556e 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -526,10 +526,11 @@ subroutine BD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM DstMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%u(DstMod%Ins)%RootMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion - DstMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%Input(1, DstMod%Ins)%RootMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ! Hub motion not used + ! call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + ! SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion + ! DstMeshLoc=MeshLocType(BD_u_HubMotion), & ! BD%Input(1, DstMod%Ins)%HubMotion + ! ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_ExtLd) @@ -1381,16 +1382,20 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & ! Check that all meshes in mapping have nonzero identifiers if (SrcMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcMesh not in module variable', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) return else if (SrcDispMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcDispMesh not in module variable', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'SrcDispMesh "'//trim(FAST_InputMeshName(SrcMod, SrcDispMeshLoc))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) return else if (DstMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstMesh not in module variable', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputMeshName(DstMod, DstMeshLoc))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) return else if (DstDispMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstDispMesh not in module variable', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'DstDispMesh "'//trim(FAST_OutputMeshName(DstMod, DstDispMeshLoc))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) return end if @@ -1521,10 +1526,12 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL ! Check that all meshes in mapping have nonzero identifiers if (SrcMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcMesh not in module variable', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) return else if (DstMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstMesh not in module variable', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputMeshName(DstMod, DstMeshLoc))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) return end if @@ -1762,6 +1769,9 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er else + ! Transfer destination displacement mesh to temporary motion mesh (cousin of destionation load mesh) + call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return + ! Linearize the motion mesh transfer call LinearizeMeshTransfer(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return @@ -1805,6 +1815,29 @@ subroutine LinearizeMeshTransfer(Typ, Src, Dst, MMap, SrcDisp, DstDisp) end select end subroutine + ! MeshTransfer calls the specific transfer function based on + ! transfer type (Point_to_Point, Point_to_Line2, etc.) + subroutine TransferMesh(Typ, Src, Dst, MMap, SrcDisp, DstDisp) + integer(IntKi), intent(in) :: Typ + type(MeshType), intent(in) :: Src + type(MeshType), intent(inout) :: Dst + type(MeshMapType), intent(inout) :: MMap + type(MeshType), optional, intent(in) :: SrcDisp, DstDisp + select case (Typ) + case (Xfr_Point_to_Point) + call Transfer_Point_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Point_to_Line2) + call Transfer_Point_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Line2_to_Point) + call Transfer_Line2_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Line2_to_Line2) + call Transfer_Line2_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "TransferMeshTransfer: unknown transfer type: "//Num2LStr(Typ) + end select + end subroutine + logical function Failed() Failed = ErrStat2 >= AbortErrLev if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1858,6 +1891,7 @@ subroutine Assemble_dUdy_Loads(Mapping, dUdy) ! Direct transfer call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, Mapping%MeshMap%dM%m_uD, dUdy) else + ! call SumBlock(Mapping%iLocDstMoment, [Mapping%iLocDstDispTransDisp(1), Mapping%iLocDstDispTransDisp(1) + size(Mapping%MeshMap%dM%m_uD,2) - 1], Mapping%MeshMap%dM%m_uD, dUdy) ! Compose linearization of motion and loads Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%mi) call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, Mapping%TmpMatrix, dUdy) From 6cdf30ce5a1e94f80fac8f9066e8949fc4a613cd Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 23 Feb 2024 15:00:45 +0000 Subject: [PATCH 090/319] Create AD_SetOP routine, standardize OP pack/unpack routines --- modules/aerodyn/src/AeroDyn.f90 | 408 ++++++++++++++++++-------------- 1 file changed, 228 insertions(+), 180 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 287de8a2bd..aa8e586e38 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -60,11 +60,8 @@ module AeroDyn PUBLIC :: AD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - PUBLIC :: AD_GetOP !< Routine to pack the operating point values (for linearization) into arrays - - PUBLIC :: AD_PackStateValues, AD_UnpackStateValues - PUBLIC :: AD_PackInputValues, AD_UnpackInputValues - PUBLIC :: AD_PackOutputValues + PUBLIC :: AD_GetOP !< Routine to pack the operating point values into arrays + PUBLIC :: AD_SetOP !< Routine to unpack the operating point arrays into data structures contains !---------------------------------------------------------------------------------------------------------------------------------- @@ -5752,7 +5749,7 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y ! Copy inputs and pack them for perturbation call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackInputValues(p, u, m%Jac%u) + call AD_PackInputOP(p, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -5789,25 +5786,25 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call AD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, 1, FF_ptr) call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call AD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call AD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, -1, FF_ptr) call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call AD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -5838,19 +5835,19 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call AD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, 1, FF_ptr) call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) + call AD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call AD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, -1, FF_ptr) call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) + call AD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -5938,7 +5935,9 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, return endif - call RotJacobianPContState( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter ) + call AD_CalcWind_Rotor(t, u%rotors(iR), p%FlowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call RotJacobianPContState(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter) END SUBROUTINE AD_JacobianPContState @@ -6016,7 +6015,7 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Copy and pack states for perturbation call AD_CopyRotContinuousStateType(m%x_init, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackStateValues(p, m%x_init, m%Jac%x) + call AD_PackContStateOP(p, m%x_init, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then @@ -6037,15 +6036,15 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call AD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call AD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call AD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call AD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -6076,15 +6075,15 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call AD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) + call AD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call AD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) + call AD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -6185,7 +6184,9 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat return endif - call RotJacobianPConstrState( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, errStat, errMsg, dYdz, dXdz, dXddz, dZdz ) + call AD_CalcWind_Rotor(t, u%rotors(iR), p%FlowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call RotJacobianPConstrState(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, errStat, errMsg, dYdz, dXdz, dXddz, dZdz) END SUBROUTINE AD_JacobianPConstrState @@ -6389,7 +6390,8 @@ END SUBROUTINE RotJacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter ) +SUBROUTINE AD_GetOP(iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter ) + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6409,15 +6411,17 @@ SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags - integer(IntKi), parameter :: iR =1 ! Rotor index - - if (size(p%rotors)>1) then - errStat = ErrID_Fatal - errMsg = 'Linearization with more than one rotor not supported' + if (iRotor < 1 .or. iRotor > size(p%rotors)) then + ErrStat = ErrID_Fatal + ErrMsg = "AD_GetOP: Invalid rotor index: "//trim(Num2LStr(iRotor))//", must be between 1 and "//Num2LStr(size(p%rotors)) return - endif + end if - call RotGetOP(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), errStat, errMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter) + call AD_CalcWind_Rotor(t, u%rotors(iRotor), p%FlowField, p%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call RotGetOP(t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), & + xd%rotors(iRotor), z%rotors(iRotor), OtherState%rotors(iRotor), y%rotors(iRotor), m%rotors(iRotor), & + ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter) END SUBROUTINE AD_GetOP @@ -6452,7 +6456,7 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta logical :: IsFullLin integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: ind, i, j, k, n - type(UniformField_Interp) :: op + type(UniformField_Interp) :: UF_op ErrStat = ErrID_None ErrMsg = '' @@ -6466,85 +6470,63 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta FlagFilterLoc = VF_None end if - !---------------------------------------------------------------------------- - + ! Inputs if (present(u_op)) then - if (.not. allocated(u_op)) then call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call AD_PackInputValues(p, u, u_op) + call AD_PackInputOP(p, u, u_op) if (associated(p_AD%FlowField)) then if (p_AD%FlowField%FieldType == Uniform_FieldType) then - op = UniformField_InterpLinear(p_AD%FlowField%Uniform, t) - call MV_Pack(p%Vars%u, p%iVarHWindSpeed, op%VelH, u_op) - call MV_Pack(p%Vars%u, p%iVarPLexp, op%ShrV, u_op) - call MV_Pack(p%Vars%u, p%iVarPropagationDir, op%AngleH + p_AD%FlowField%PropagationDir, u_op) + UF_op = UniformField_InterpLinear(p_AD%FlowField%Uniform, t) + call MV_Pack(p%Vars%u, p%iVarHWindSpeed, UF_op%VelH, u_op) + call MV_Pack(p%Vars%u, p%iVarPLexp, UF_op%ShrV, u_op) + call MV_Pack(p%Vars%u, p%iVarPropagationDir, UF_op%AngleH + p_AD%FlowField%PropagationDir, u_op) end if end if + end if - END IF - - !---------------------------------------------------------------------------- - + ! Outputs if (present(y_op)) then - if (.not. allocated(y_op)) then call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call AD_PackOutputValues(p, y, y_op, IsFullLin) - - END IF - - !---------------------------------------------------------------------------- + call AD_PackOutputOP(p, y, y_op, IsFullLin) + end if + ! Continuous States if (present(x_op)) then - if (.not. allocated(x_op)) then call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call AD_PackStateValues(p, x, x_op) - + call AD_PackContStateOP(p, x, x_op) end if - !---------------------------------------------------------------------------- - + ! Continous State Derivatives if (present(dx_op)) then - if (.not. allocated(dx_op)) then call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return end if call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); If (Failed()) return - call AD_PackStateValues(p, m%dxdt_lin, dx_op) - - END IF - - !---------------------------------------------------------------------------- + call AD_PackContStateOP(p, m%dxdt_lin, dx_op) + end if + ! Discrete States if (present(xd_op)) then end if - - !---------------------------------------------------------------------------- + ! Constraint States if (present(z_op)) then - if (.not. allocated(z_op)) then call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - ind = 1 - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) - z_op(ind) = z%BEMT%phi(i,k) - ind = ind + 1 - end do - end do - + + call AD_PackConstrStateOP(p, z, z_op) end if contains @@ -6552,59 +6534,82 @@ logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function -END SUBROUTINE RotGetOP +end subroutine RotGetOP +!> AD_SetOP populates the data structures from the operating point arrays. (Extended inputs are not used) +subroutine AD_SetOP(iRotor, u, p, x, xd, z, y, ErrStat, ErrMsg, u_op, y_op, x_op, xd_op, z_op) + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index + TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point + TYPE(AD_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states at operating point + TYPE(AD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point + TYPE(AD_OutputType), INTENT(INOUT) :: y !< Output at operating point + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: z_op(:) !< values of linearized constraint states -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters - TYPE(AD_ParameterType) , INTENT(IN ) :: p_AD !< parameters - TYPE(RotOutputType) , INTENT(IN ) :: y_p !< AD outputs at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(RotOutputType) , INTENT(IN ) :: y_m !< AD outputs at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta_p !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(IN ) :: delta_m !< difference in inputs or states \f$ delta_m = \Delta_m u \f$ or \f$ delta_m = \Delta_m x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: k ! loop over blades - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - - - indx_first = 1 - if (.not. p_AD%CompAeroMaps) then - call PackLoadMesh_dY(y_p%NacelleLoad, y_m%NacelleLoad, dY, indx_first) - call PackLoadMesh_dY(y_p%HubLoad, y_m%HubLoad, dY, indx_first) - call PackLoadMesh_dY(y_p%TFinLoad, y_m%TFinLoad, dY, indx_first) - call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) - endif - - do k=1,p%NumBl_Lin - call PackLoadMesh_dY(y_p%BladeLoad(k), y_m%BladeLoad(k), dY, indx_first) - end do - - if (.not. p_AD%CompAeroMaps) then - do k=1,p%NumOuts + p%BldNd_TotNumOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do + if (iRotor < 1 .or. iRotor > size(p%rotors)) then + ErrStat = ErrID_Fatal + ErrMsg = "AD_SetOP: Invalid rotor index: "//trim(Num2LStr(iRotor))//", must be between 1 and "//Num2LStr(size(p%rotors)) + return end if - - dY = dY / (delta_p + delta_m) - -END SUBROUTINE Compute_dY -subroutine AD_PackStateValues(p, x, Ary) + call RotSetOP(u%rotors(iRotor), p%rotors(iRotor), x%rotors(iRotor), xd%rotors(iRotor), z%rotors(iRotor), y%rotors(iRotor), ErrStat, ErrMsg, u_op, y_op, x_op, xd_op, z_op) + +end subroutine + +!> RotSetOP populates the data structures from the operating point arrays. (Extended inputs are not used) +subroutine RotSetOP(u, p, x, xd, z, y, ErrStat, ErrMsg, u_op, x_op, xd_op, z_op, y_op) + type(RotInputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(RotParameterType), intent(in ) :: p !< Parameters + type(RotContinuousStateType), intent(inout) :: x !< Continuous states at operating point + type(RotDiscreteStateType), intent(inout) :: xd !< Discrete states at operating point + type(RotConstraintStateType), intent(inout) :: z !< Constraint states at operating point + type(RotOutputType), intent(inout) :: y !< Output at operating point + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(R8Ki), allocatable, optional, intent(in ) :: u_op(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(in ) :: x_op(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(in ) :: xd_op(:) !< values of linearized discrete states + real(R8Ki), allocatable, optional, intent(in ) :: z_op(:) !< values of linearized constraint states + real(R8Ki), allocatable, optional, intent(in ) :: y_op(:) !< values of linearized outputs + + character(*), parameter :: RoutineName = 'AD_SetOP' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + if (present(u_op)) call AD_UnpackInputOP(p, u_op, u) + if (present(y_op)) call AD_UnpackOutputOP(p, y_op, y) + if (present(x_op)) call AD_UnpackContStateOP(p, x_op, x) + if (present(xd_op)) call AD_UnpackDiscStateOP(p, xd_op, xd) + if (present(z_op)) call AD_UnpackConstrStateOP(p, z_op, z) + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine AD_PackContStateOP(p, x, op) type(RotParameterType), intent(in) :: p type(RotContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: Ary(:) + real(R8Ki), intent(out) :: op(:) integer(IntKi) :: i, j, k, n, ind ind = 1 if (p%BEMT%DBEMT%lin_nx > 0) then do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) + do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind) - Ary(ind) = x%BEMT%DBEMT%element(i,j)%vind(k) + op(ind) = x%BEMT%DBEMT%element(i,j)%vind(k) ind = ind + 1 end do end do @@ -6612,35 +6617,34 @@ subroutine AD_PackStateValues(p, x, Ary) do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind_1) - Ary(ind) = x%BEMT%DBEMT%element(i,j)%vind_1(k) + op(ind) = x%BEMT%DBEMT%element(i,j)%vind_1(k) ind = ind + 1 end do end do end do end if - if (p%BEMT%UA%lin_nx > 0) then - do n = 1, p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - Ary(ind) = x%BEMT%UA%element(i,j)%x(k) - ind = ind + 1 - end do - end if + do n = 1, p%BEMT%UA%lin_nx + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + k = p%BEMT%UA%lin_xIndx(n,3) + op(ind) = x%BEMT%UA%element(i,j)%x(k) + ind = ind + 1 + end do end subroutine -subroutine AD_UnpackStateValues(p, Ary, x) +subroutine AD_UnpackContStateOP(p, op, x) type(RotParameterType), intent(in) :: p - real(R8Ki), intent(in) :: ary(:) + real(R8Ki), intent(in) :: op(:) type(RotContinuousStateType), intent(inout) :: x integer(IntKi) :: i, j, k, n, ind ind = 1 + if (p%BEMT%DBEMT%lin_nx > 0) then do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind) - x%BEMT%DBEMT%element(i,j)%vind(k) = Ary(ind) + x%BEMT%DBEMT%element(i,j)%vind(k) = op(ind) ind = ind + 1 end do end do @@ -6648,98 +6652,142 @@ subroutine AD_UnpackStateValues(p, Ary, x) do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind_1) - x%BEMT%DBEMT%element(i,j)%vind_1(k) = Ary(ind) + x%BEMT%DBEMT%element(i,j)%vind_1(k) = op(ind) ind = ind + 1 end do end do end do end if - if (p%BEMT%UA%lin_nx > 0) then - do n = 1, p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - x%BEMT%UA%element(i,j)%x(k) = Ary(ind) + do n = 1, p%BEMT%UA%lin_nx + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + k = p%BEMT%UA%lin_xIndx(n,3) + x%BEMT%UA%element(i,j)%x(k) = op(ind) + ind = ind + 1 + end do +end subroutine + +subroutine AD_PackDiscStateOP(p, xd, op) + type(RotParameterType), intent(in) :: p + type(RotDiscreteStateType), intent(in) :: xd + real(R8Ki), intent(out) :: op(:) + integer(IntKi) :: i, j, k +end subroutine + +subroutine AD_UnpackDiscStateOP(p, op, xd) + type(RotParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(RotDiscreteStateType), intent(inout) :: xd + integer(IntKi) :: i, j, k +end subroutine + +subroutine AD_PackConstrStateOP(p, z, op) + type(RotParameterType), intent(in) :: p + type(RotConstraintStateType), intent(in) :: z + real(R8Ki), intent(out) :: op(:) + integer(IntKi) :: i, k, ind + ind = 1 + do k = 1, p%NumBlades ! size(z%BEMT%Phi,2) + do i = 1, p%NumBlNds ! size(z%BEMT%Phi,1) + op(ind) = z%BEMT%phi(i,k) ind = ind + 1 end do - end if + end do end subroutine -subroutine AD_PackInputValues(p, u, Ary) +subroutine AD_UnpackConstrStateOP(p, op, z) + type(RotParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(RotConstraintStateType), intent(inout) :: z + integer(IntKi) :: i, k, ind + ind = 1 + do k = 1, p%NumBlades ! size(z%BEMT%Phi,2) + do i = 1, p%NumBlNds ! size(z%BEMT%Phi,1) + z%BEMT%phi(i,k) = op(ind) + ind = ind + 1 + end do + end do +end subroutine + +subroutine AD_PackInputOP(p, u, op) type(RotParameterType), intent(in) :: p type(RotInputType), intent(in) :: u - real(R8Ki), intent(out) :: Ary(:) + real(R8Ki), intent(out) :: op(:) integer(IntKi) :: k - call MV_Pack(p%Vars%u, p%iVarNacelleMotion, u%NacelleMotion, Ary) - call MV_Pack(p%Vars%u, p%iVarHubMotion, u%HubMotion, Ary) - call MV_Pack(p%Vars%u, p%iVarTFinMotion, u%TFinMotion, Ary) - call MV_Pack(p%Vars%u, p%iVarTowerMotion, u%TowerMotion, Ary) + call MV_Pack(p%Vars%u, p%iVarNacelleMotion, u%NacelleMotion, op) + call MV_Pack(p%Vars%u, p%iVarHubMotion, u%HubMotion, op) + call MV_Pack(p%Vars%u, p%iVarTFinMotion, u%TFinMotion, op) + call MV_Pack(p%Vars%u, p%iVarTowerMotion, u%TowerMotion, op) do k = 1, p%NumBlades - call MV_Pack(p%Vars%u, p%iVarBladeRootMotion(k), u%BladeRootMotion(k), Ary) + call MV_Pack(p%Vars%u, p%iVarBladeRootMotion(k), u%BladeRootMotion(k), op) end do do k = 1, p%NumBlades - call MV_Pack(p%Vars%u, p%iVarBladeMotion(k), u%BladeMotion(k), Ary) + call MV_Pack(p%Vars%u, p%iVarBladeMotion(k), u%BladeMotion(k), op) end do do k = 1, p%NumBlades - call MV_Pack(p%Vars%u, p%iVarUserProp(k), u%UserProp(:,k), Ary) + call MV_Pack(p%Vars%u, p%iVarUserProp(k), u%UserProp(:,k), op) end do - call MV_Pack(p%Vars%u, p%iVarHWindSpeed, 0.0_R8Ki, Ary) - call MV_Pack(p%Vars%u, p%iVarPLexp, 0.0_R8Ki, Ary) - call MV_Pack(p%Vars%u, p%iVarPropagationDir, 0.0_R8Ki, Ary) + call MV_Pack(p%Vars%u, p%iVarHWindSpeed, 0.0_R8Ki, op) + call MV_Pack(p%Vars%u, p%iVarPLexp, 0.0_R8Ki, op) + call MV_Pack(p%Vars%u, p%iVarPropagationDir, 0.0_R8Ki, op) end subroutine -subroutine AD_UnpackInputValues(p, Ary, u) +subroutine AD_UnpackInputOP(p, op, u) type(RotParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(in) :: op(:) type(RotInputType), intent(inout) :: u integer(IntKi) :: k - call MV_Unpack(p%Vars%u, p%iVarNacelleMotion, Ary, u%NacelleMotion) - call MV_Unpack(p%Vars%u, p%iVarHubMotion, Ary, u%HubMotion) - call MV_Unpack(p%Vars%u, p%iVarTFinMotion, Ary, u%TFinMotion) - call MV_Unpack(p%Vars%u, p%iVarTowerMotion, Ary, u%TowerMotion) + call MV_Unpack(p%Vars%u, p%iVarNacelleMotion, op, u%NacelleMotion) + call MV_Unpack(p%Vars%u, p%iVarHubMotion, op, u%HubMotion) + call MV_Unpack(p%Vars%u, p%iVarTFinMotion, op, u%TFinMotion) + call MV_Unpack(p%Vars%u, p%iVarTowerMotion, op, u%TowerMotion) do k = 1, p%NumBlades - call MV_Unpack(p%Vars%u, p%iVarBladeRootMotion(k), Ary, u%BladeRootMotion(k)) + call MV_Unpack(p%Vars%u, p%iVarBladeRootMotion(k), op, u%BladeRootMotion(k)) end do do k = 1, p%NumBlades - call MV_Unpack(p%Vars%u, p%iVarBladeMotion(k), Ary, u%BladeMotion(k)) + call MV_Unpack(p%Vars%u, p%iVarBladeMotion(k), op, u%BladeMotion(k)) end do do k = 1, p%NumBlades - call MV_Unpack(p%Vars%u, p%iVarUserProp(k), Ary, u%UserProp(:,k)) + call MV_Unpack(p%Vars%u, p%iVarUserProp(k), op, u%UserProp(:,k)) end do end subroutine -subroutine AD_UnpackExtendedInputValues(p, Ary, FF) - type(RotParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Ary(:) - type(FlowFieldType), intent(inout) :: FF - real(ReKi) :: VelH, ShrV, AngleH - call MV_Unpack(p%Vars%u, p%iVarHWindSpeed, Ary, VelH) - call MV_Unpack(p%Vars%u, p%iVarPLexp, Ary, ShrV) - call MV_Unpack(p%Vars%u, p%iVarPropagationDir, Ary, AngleH) - FF%Uniform%VelH = VelH - FF%Uniform%ShrV = ShrV - FF%Uniform%AngleH = AngleH -end subroutine - -subroutine AD_PackOutputValues(p, y, Ary, PackWriteOutput) +subroutine AD_PackOutputOP(p, y, op, PackWriteOutput) type(RotParameterType), intent(in) :: p type(RotOutputType), intent(in) :: y - real(R8Ki), intent(out) :: Ary(:) + real(R8Ki), intent(out) :: op(:) logical, intent(in) :: PackWriteOutput integer(IntKi) :: k - call MV_Pack(p%Vars%y, p%iVarNacelleLoad, y%NacelleLoad, Ary) - call MV_Pack(p%Vars%y, p%iVarHubLoad, y%HubLoad, Ary) - call MV_Pack(p%Vars%y, p%iVarTFinLoad, y%TFinLoad, Ary) - call MV_Pack(p%Vars%y, p%iVarTowerLoad, y%TowerLoad, Ary) + call MV_Pack(p%Vars%y, p%iVarNacelleLoad, y%NacelleLoad, op) + call MV_Pack(p%Vars%y, p%iVarHubLoad, y%HubLoad, op) + call MV_Pack(p%Vars%y, p%iVarTFinLoad, y%TFinLoad, op) + call MV_Pack(p%Vars%y, p%iVarTowerLoad, y%TowerLoad, op) do k = 1, p%NumBlades - call MV_Pack(p%Vars%y, p%iVarBladeLoad(k), y%BladeLoad(k), Ary) + call MV_Pack(p%Vars%y, p%iVarBladeLoad(k), y%BladeLoad(k), op) end do if (PackWriteOutput) then do k = p%iVarWriteOutput, size(p%Vars%y) - call MV_Pack(p%Vars%y, k, y%WriteOutput(p%Vars%y(k)%iUsr(1)), Ary) + call MV_Pack(p%Vars%y, k, y%WriteOutput(p%Vars%y(k)%iUsr(1)), op) end do end if end subroutine +subroutine AD_UnpackOutputOP(p, op, y) + type(RotParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(RotOutputType), intent(out) :: y + integer(IntKi) :: k + call MV_Unpack(p%Vars%y, p%iVarNacelleLoad, op, y%NacelleLoad) + call MV_Unpack(p%Vars%y, p%iVarHubLoad, op, y%HubLoad) + call MV_Unpack(p%Vars%y, p%iVarTFinLoad, op, y%TFinLoad) + call MV_Unpack(p%Vars%y, p%iVarTowerLoad, op, y%TowerLoad) + do k = 1, p%NumBlades + call MV_Unpack(p%Vars%y, p%iVarBladeLoad(k), op, y%BladeLoad(k)) + end do + do k = p%iVarWriteOutput, size(p%Vars%y) + call MV_Unpack(p%Vars%y, k, op, y%WriteOutput(p%Vars%y(k)%iUsr(1))) + end do +end subroutine + END MODULE AeroDyn From 4e62b3fe024b285907323ce9b4e300872c8bc1e9 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 23 Feb 2024 15:12:40 +0000 Subject: [PATCH 091/319] Restore AD Compute_dY which is used by JacobianPConstrState --- modules/aerodyn/src/AeroDyn.f90 | 40 +++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index aa8e586e38..5fdd282afa 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -6599,6 +6599,46 @@ logical function Failed() end function end subroutine + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine uses values of two output types to compute an array of differences. +!! Do not change this packing without making sure subroutine aerodyn::init_jacobian is consistant with this routine! +SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) + TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters + TYPE(AD_ParameterType) , INTENT(IN ) :: p_AD !< parameters + TYPE(RotOutputType) , INTENT(IN ) :: y_p !< AD outputs at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) + TYPE(RotOutputType) , INTENT(IN ) :: y_m !< AD outputs at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) + REAL(R8Ki) , INTENT(IN ) :: delta_p !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ + REAL(R8Ki) , INTENT(IN ) :: delta_m !< difference in inputs or states \f$ delta_m = \Delta_m u \f$ or \f$ delta_m = \Delta_m x \f$ + REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ + + ! local variables: + INTEGER(IntKi) :: k ! loop over blades + INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled + + + indx_first = 1 + if (.not. p_AD%CompAeroMaps) then + call PackLoadMesh_dY(y_p%NacelleLoad, y_m%NacelleLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%HubLoad, y_m%HubLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%TFinLoad, y_m%TFinLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) + endif + + do k=1,p%NumBl_Lin + call PackLoadMesh_dY(y_p%BladeLoad(k), y_m%BladeLoad(k), dY, indx_first) + end do + + if (.not. p_AD%CompAeroMaps) then + do k=1,p%NumOuts + p%BldNd_TotNumOuts + dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) + end do + end if + + dY = dY / (delta_p + delta_m) + +END SUBROUTINE Compute_dY + subroutine AD_PackContStateOP(p, x, op) type(RotParameterType), intent(in) :: p type(RotContinuousStateType), intent(in) :: x From 93e06bebbf5168d78a00372f0d8bc438b20048b1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 23 Feb 2024 15:13:01 +0000 Subject: [PATCH 092/319] Add module instance to AD_GetOP as the rotor index --- modules/openfast-library/src/FAST_Funcs.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 81a0e4b246..b165502c79 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -541,7 +541,7 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt select case (ModData%ID) case (Module_AD) - call AD_GetOP(ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), T%AD%z(ThisState), & + call AD_GetOP(ModData%Ins, ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), T%AD%z(ThisState), & T%AD%OtherSt(ThisState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) From 63f9d2b79d5b1e50eb5244496a3af11d770c4b51 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 15:36:22 +0000 Subject: [PATCH 093/319] FAST_Mapping: Added more mesh and variable mappings --- modules/openfast-library/src/FAST_Mapping.f90 | 1117 +++++++++++------ 1 file changed, 708 insertions(+), 409 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index f1ee35556e..b00d54c6ad 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -8,9 +8,6 @@ module FAST_Mapping private public :: FAST_InitMappings, FAST_LinearizeMappings, FAST_ResetRemapFlags, FAST_InputSolve -! Input Solve destinations -integer(IntKi), parameter :: IS_DstInput = 1, IS_Dstu = 2, IS_Linearize = 3 - integer(IntKi), parameter :: AD_rotor = 1 integer(IntKi), parameter :: Xfr_Invalid = 0, & @@ -19,6 +16,19 @@ module FAST_Mapping Xfr_Point_to_Line2 = 3, & Xfr_Line2_to_Line2 = 4 +character(24), parameter :: Custom_ED_to_ExtLd = 'ED -> ExtLd', & + Custom_AD_to_ExtLd = 'AD -> ExtLd', & + Custom_SrvD_to_AD = 'SrvD -> AD', & + Custom_ED_to_IfW = 'ED -> IfW', & + Custom_SrvD_to_IfW = 'SrvD -> IfW', & + Custom_BD_to_SrvD = 'BD -> SrvD', & + Custom_ED_to_SrvD = 'ED -> SrvD', & + Custom_IfW_to_SrvD = 'IfW -> SrvD', & + Custom_ExtInfw_to_SrvD = 'ExtInfw -> SrvD', & + Custom_SrvD_to_SD = 'SrvD -> SD', & + Custom_SrvD_to_MD = 'SrvD -> MD', & + Custom_ExtLd_to_SrvD = 'ExtLd -> SrvD' + contains subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, UseU, Mesh, ErrStat, ErrMsg) @@ -330,39 +340,39 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) ! Switch by destination module (inputs) select case (Mods(IModDst)%ID) case (Module_AD) - call AD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_AD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_BD) - call BD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_BD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ED) - call ED_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_ED(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtInfw) - ! call ExtInfw_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + ! call InitMappings_ExtInfw(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtLd) - call ExtLd_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_ExtLd(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtPtfm) - call ExtPtfm_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_ExtPtfm(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_FEAM) - call FEAM_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_FEAM(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_HD) - call HD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_HD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IceD) - call IceD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_IceD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IceF) - call IceF_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_IceF(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IfW) - call IfW_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_IfW(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_MAP) - call MAP_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_MAP(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_MD) - call MD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_MD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_Orca) - call Orca_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_Orca(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SD) - call SD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_SD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SeaSt) - ! call SeaSt_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + ! call InitMappings_SeaSt(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SrvD) - call SrvD_InitInputMappings(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_SrvD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) end select if (Failed()) return end do @@ -398,14 +408,14 @@ logical function Failed() end function end subroutine -subroutine AD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_AD' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i @@ -482,7 +492,7 @@ subroutine AD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_SrvD) - ! call MapVariable(Mappings, Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=SrcMod, DstMod=DstMod) + call MapCustom(Mappings, Custom_SrvD_to_AD, SrcMod, DstMod) end select @@ -493,14 +503,14 @@ logical function Failed() end function end subroutine -subroutine BD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'BD_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_BD' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i @@ -557,14 +567,14 @@ logical function Failed() end function end subroutine -subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'ED_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_ED' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j @@ -576,6 +586,16 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_AD) + do i = 1, Turbine%ED%p%NumBl + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, AD_rotor, i), & ! AD%y%rotors(iR)%BladeLoad(i) + SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, i), & ! AD%u%rotors(iR)%BladeMotion(i) + DstMeshLoc=MeshLocType(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + Active=Turbine%p_FAST%CompElast == Module_ED, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(AD_y_rotors_HubLoad, AD_Rotor), & ! AD%y%rotors(1)%HubLoad SrcDispMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! AD%u%rotors(1)%HubMotion @@ -618,28 +638,101 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ! TODO ! CALL MeshMapCreate( ExtLd%y%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2 ) + case (Module_ExtPtfm) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh + SrcDispMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_FEAM) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & + SrcDispMeshLoc=MeshLocType(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_HD) - ! Coupling with HydroDyn if no substructure module is used - if (Turbine%p_FAST%CompSub == Module_None) then + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub == Module_None, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh - SrcDispMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub == Module_None, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh - SrcDispMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end if + case (Module_IceD) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(IceD_y_PointMesh), & ! IceD%y%PointMesh + SrcDispMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_IceF) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh + SrcDispMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_MAP) + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_MD) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_Orca) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh + SrcDispMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_SD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -651,26 +744,6 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_SrvD) - ! Nacelle Structural Controller - do j = 1, Turbine%SrvD%p%NumNStC - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads - DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - - ! Tower Structural Controller - do j = 1, Turbine%SrvD%p%NumTStC - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerLoads - DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - call MapVariable(Mappings, "SrvD BlPitchCom -> ED BlPitchCom", & SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarBlPitchCom, & DstMod=DstMod, iVarDst=Turbine%ED%p%iVarBlPitchCom, & @@ -686,121 +759,51 @@ subroutine ED_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM DstMod=DstMod, iVarDst=Turbine%ED%p%iVarGenTrq, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - end select - - !---------------------------------------------------------------------------- - ! ElastoDyn Blades - !---------------------------------------------------------------------------- - - ! If ElastoDyn is calculating blade motion - if (Turbine%p_FAST%CompElast == Module_ED) then - - select case (SrcMod%ID) - - case (Module_AD) - - do i = 1, size(Turbine%ED%Input(1)%BladePtLoads) + ! Blade Structural Controller (if ElastoDyn is used for blades) + do i = 1, Turbine%SrvD%p%NumBStC + do j = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, AD_rotor, i), & ! AD%y%rotors(iR)%BladeLoad(i) - SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, i), & ! AD%u%rotors(iR)%BladeMotion(i) - DstMeshLoc=MeshLocType(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) - DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + DstMeshLoc=MeshLocType(ED_u_BladePtLoads, j), & ! ED%Input(1)%BladePtLoads(j) + DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do + end do - case (Module_ExtLd) - - ! TODO - ! CALL MeshMapCreate( ExtLd%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) - - case (Module_SrvD) - - ! Blade Structural Controller (if ElastoDyn is used for blades) - do i = 1, Turbine%SrvD%p%NumBStC - do j = 1, Turbine%ED%p%NumBl - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) - DstMeshLoc=MeshLocType(ED_u_BladePtLoads, j), & ! ED%Input(1)%BladePtLoads(j) - DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - end do - - end select - end if - - !---------------------------------------------------------------------------- - ! Substructure and Platform - !---------------------------------------------------------------------------- - - ! If SubDyn is not active map following modules to ElastoDyn - if (Turbine%p_FAST%CompSub /= Module_SD) then - - select case (SrcMod%ID) - - case (Module_ExtPtfm) - - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh - SrcDispMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - - case (Module_FEAM) - - ! MeshMapCreate( FEAM%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) - - case (Module_IceD) - - ! MeshMapCreate( IceD%y(i)%PointMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) - - case (Module_IceF) - - ! MeshMapCreate( IceF%y%iceMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) - - case (Module_MAP) - + ! Nacelle Structural Controller + do j = 1, Turbine%SrvD%p%NumNStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad - SrcDispMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=MeshLocType(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads + DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do - case (Module_MD) - + ! Tower Structural Controller + do j = 1, Turbine%SrvD%p%NumTStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) - SrcDispMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=MeshLocType(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerLoads + DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do - case (Module_Orca) - + ! Substructure Structural Controller + do j = 1, Turbine%SrvD%p%NumSStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh - SrcDispMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do - case (Module_SrvD) - - ! Substructure Structural Controller - do j = 1, Turbine%SrvD%p%NumSStC - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - - end select - end if + end select contains logical function Failed() @@ -809,14 +812,14 @@ logical function Failed() end function end subroutine -subroutine ExtLd_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'ExtLd_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_ExtLd' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i @@ -824,17 +827,56 @@ subroutine ExtLd_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, E ErrStat = ErrID_None ErrMsg = '' - ! MeshMapCreate( AD%y%rotors(1)%BladeLoad(k), ExtLd%y%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2) - ! MeshMapCreate( AD%y%rotors(1)%TowerLoad, ExtLd%y%TowerLoadAD, MeshMapData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( BD%y(k)%BldMotion, ExtLd%u%BladeMotion(K), MeshMapData%BDED_L_2_ExtLd_P_B(K), ErrStat2, ErrMsg2 ) - ! MeshMapCreate( ED%y%BladeLn2Mesh(K), ExtLd%u%BladeMotion(K), MeshMapData%BDED_L_2_ExtLd_P_B(K), ErrStat2, ErrMsg2 ) - ! MeshMapCreate( ED%y%BladeRootMotion(K), ExtLd%u%BladeRootMotion(K), MeshMapData%ED_P_2_ExtLd_P_R(K), ErrStat2, ErrMsg2 ) - ! MeshMapCreate( ED%y%HubPtMotion, ExtLd%u%HubMotion, MeshMapData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( ED%y%TowerLn2Mesh, ExtLd%u%TowerMotion, MeshMapData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2 ) - select case (SrcMod%ID) + case (Module_AD) + + ! call MapCustom(Mappings, Custom_AD_to_ExtLd, SrcMod, DstMod, ErrStat2, ErrMsg2); if (Failed()) return + + ! TODO Add mapping from aerodyn blade and tower to new input meshes + ! MeshMapCreate( AD%y%rotors(1)%BladeLoad(k), ExtLd%y%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2) + ! MeshMapCreate( AD%y%rotors(1)%TowerLoad, ExtLd%y%TowerLoadAD, MeshMapData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2 ) + + case (Module_BD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMeshLoc=MeshLocType(ExtLd_u_BladeMotion, SrcMod%Ins), & ! ExtLd%u%BladeMotion(SrcMod%Ins) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_ED) + call MapCustom(Mappings, Custom_ED_to_ExtLd, SrcMod, DstMod) + + do i = 1, Turbine%ED%p%NumBl + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstMeshLoc=MeshLocType(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) + Active=Turbine%p_FAST%CompElast == Module_ED, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + do i = 1, Turbine%ED%p%NumBl + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstMeshLoc=MeshLocType(ExtLd_u_BladeRootMotion, i), & ! ExtLd%u%BladeRootMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstMeshLoc=MeshLocType(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMeshLoc=MeshLocType(ExtLd_u_HubMotion), & ! ExtLd%u%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMeshLoc=MeshLocType(ExtLd_u_NacelleMotion), & ! ExtLd%u%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end select contains @@ -844,14 +886,14 @@ logical function Failed() end function end subroutine -subroutine ExtPtfm_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_ExtPtfm(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'ExtPtfm_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_ExtPtfm' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i @@ -860,15 +902,22 @@ subroutine ExtPtfm_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg = '' select case (SrcMod%ID) + case (Module_ED) if (Turbine%p_FAST%CompSub /= Module_SD) then - ! CALL MeshMapCreate( PlatformMotion, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end if case (Module_SD) - ! CALL MeshMapCreate( PlatformMotion, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%u%TPMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -879,14 +928,14 @@ logical function Failed() end function end subroutine -subroutine FEAM_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_FEAM(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'FEAM_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_FEAM' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i @@ -894,6 +943,25 @@ subroutine FEAM_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er ErrStat = ErrID_None ErrMsg = '' + select case (SrcMod%ID) + + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=MeshLocType(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + select case (SrcMod%ID) case (Module_ED) @@ -914,14 +982,14 @@ logical function Failed() end function end subroutine -subroutine HD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'HD_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_HD' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i @@ -930,6 +998,7 @@ subroutine HD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ErrMsg = '' select case (SrcMod%ID) + case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -937,19 +1006,17 @@ subroutine HD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM DstMeshLoc=MeshLocType(HydroDyn_u_PRPMesh), & ! HD%Input(1)%PRPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - ! If SubDyn is not active substructure motion/loads come from ElastoDyn - if (Turbine%p_FAST%CompSub /= Module_SD) then - - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end if + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return case (Module_SD) @@ -971,14 +1038,14 @@ logical function Failed() end function end subroutine -subroutine IceD_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) +subroutine InitMappings_IceD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod - type(FAST_TurbineType), intent(inout) :: T !< Turbine type + type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceD_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_IceD' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -987,8 +1054,20 @@ subroutine IceD_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) select case (SrcMod%ID) case (Module_ED) - ! TODO - ! CALL MeshMapCreate( SubstructureMotion, IceD%Input(1,i)%PointMesh, MeshMapData%SDy3_P_2_IceD_P(i), ErrStat2, ErrMsg2 ) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end select contains @@ -998,14 +1077,14 @@ logical function Failed() end function end subroutine -subroutine IceF_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) +subroutine InitMappings_IceF(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod - type(FAST_TurbineType), intent(inout) :: T !< Turbine type + type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceF_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_IceF' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1014,8 +1093,20 @@ subroutine IceF_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) select case (SrcMod%ID) case (Module_ED) - ! TODO - ! CALL MeshMapCreate( SubstructureMotion, IceF%Input(1)%iceMesh, MeshMapData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end select contains @@ -1025,14 +1116,14 @@ logical function Failed() end function end subroutine -subroutine IfW_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) +subroutine InitMappings_IfW(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'IfW_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_IfW' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1041,10 +1132,9 @@ subroutine IfW_InitInputMappings(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) select case (SrcMod%ID) case (Module_ED) - - ! TODO - ! call MapVariable(Mappings, "ED HubMotion -> IfW HubMotion", SrcMod=SrcMod, DstMod=DstMod) - + call MapCustom(Mappings, Custom_ED_to_IfW, SrcMod, DstMod) + case (Module_SrvD) + call MapCustom(Mappings, Custom_SrvD_to_IfW, SrcMod=SrcMod, DstMod=DstMod) end select contains @@ -1054,14 +1144,14 @@ logical function Failed() end function end subroutine -subroutine MAP_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_MAP(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'MAP_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_MAP' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1071,18 +1161,17 @@ subroutine MAP_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Err select case (SrcMod%ID) case (Module_ED) - if (Turbine%p_FAST%CompSub /= Module_SD) then - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAPp%Input(1)%PtFairDisplacement - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end if + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAPp%Input(1)%PtFairDisplacement + DstMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1094,14 +1183,14 @@ logical function Failed() end function end subroutine -subroutine MD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_MD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'MD_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_MD' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1109,22 +1198,26 @@ subroutine MD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM ErrMsg = '' select case (SrcMod%ID) + case (Module_ED) - if (Turbine%p_FAST%CompSub /= Module_SD) then - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%Input(1)%CoupledKinematics(1) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end if + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%Input(1)%CoupledKinematics(1) + DstMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_SrvD) + + call MapCustom(Mappings, Custom_SrvD_to_MD, SrcMod, DstMod) + end select contains @@ -1134,14 +1227,14 @@ logical function Failed() end function end subroutine -subroutine Orca_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_Orca(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'Orca_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_Orca' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1153,7 +1246,7 @@ subroutine Orca_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%Input(1)%PtfmMesh + DstMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1165,14 +1258,14 @@ logical function Failed() end function end subroutine -subroutine SD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'BD_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_BD' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j @@ -1186,28 +1279,80 @@ subroutine SD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%Input(1)%TPMesh + DstMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%u%TPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_FEAM) - ! MeshMapCreate( FEAM%y%PtFairleadLoad, SD%Input(1)%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( HD%y%Morison%Mesh, SD%Input(1)%LMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( HD%y%WAMITMesh, SD%Input(1)%LMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( IceD%y(i)%PointMesh, SD%Input(1)%LMesh, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) - ! MeshMapCreate( IceF%y%iceMesh, SD%Input(1)%LMesh, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( MAPp%y%PtFairleadLoad, SD%Input(1)%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( MD%y%CoupledLoads(1), SD%Input(1)%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( SrvD%y%SStCLoadMesh(j), SD%Input(1)%LMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2 ) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & + SrcDispMeshLoc=MeshLocType(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_HD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_IceD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(IceD_y_PointMesh), & ! IceD%y%PointMesh + SrcDispMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_IceF) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh + SrcDispMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_MAP) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_MD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SrvD) + call MapCustom(Mappings, Custom_SrvD_to_SD, SrcMod, DstMod) + ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%Input(1)%LMesh + DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1221,14 +1366,14 @@ logical function Failed() end function end subroutine -subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) +subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'BD_InitInputMappings' + character(*), parameter :: RoutineName = 'InitMappings_BD' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j @@ -1236,13 +1381,15 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er ErrStat = ErrID_None ErrMsg = '' - ! MeshMapCreate( PlatformMotion, SrvD%Input(1)%PtfmMotionMesh, MeshMapData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) - ! MeshMapCreate( SubStructureMotion, SrvD%Input(1)%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) + ! MeshMapCreate( PlatformMotion, SrvD%u%PtfmMotionMesh, MeshMapData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) + select case (SrcMod%ID) case (Module_BD) + call MapCustom(Mappings, Custom_BD_to_SrvD, SrcMod, DstMod) + ! Blade Structural Controller do i = 1, Turbine%SrvD%p%NumBStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -1251,54 +1398,9 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do - ! TODO - ! call MapVariable(Mappings, "BD Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) - ! call MapVariable(Mappings, "BD RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) - case (Module_ED) - if (Turbine%p_FAST%CompElast == Module_ED) then - ! TODO - ! call MapVariable(Mappings, "ED RootM -> SrvD RootM", SrcMod=SrcMod, DstMod=DstMod) - end if - - ! Nacelle Structural Controller - do j = 1, Turbine%SrvD%p%NumNStC - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - - ! Tower Structural Controller - do j = 1, Turbine%SrvD%p%NumTStC - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion - DstMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - - ! Blade Structural Controller (if ElastoDyn is used for blades) - if (Turbine%p_FAST%CompElast == Module_ED) then - do i = 1, Turbine%SrvD%p%NumBStC - do j = 1, Turbine%ED%p%NumBl - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) - DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - end do - end if - - ! Substructure Structural Controller (if not using SubDyn) - if (Turbine%p_FAST%CompSub /= Module_SD) then - do j = 1, Turbine%SrvD%p%NumSStC - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end do - end if + call MapCustom(Mappings, Custom_ED_to_SrvD, SrcMod, DstMod) call MapVariable(Mappings, "ED Yaw -> SrvD Yaw", & SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarYaw, & @@ -1320,10 +1422,50 @@ subroutine SrvD_InitInputMappings(Mappings, SrcMod, DstMod, Turbine, ErrStat, Er DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarHSS_Spd, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(SrvD_u_PtfmMotionMesh, 1), & ! SrvD%u%PtfmMotionMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + ! Nacelle Structural Controller + do j = 1, Turbine%SrvD%p%NumNStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + ! Tower Structural Controller + do j = 1, Turbine%SrvD%p%NumTStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion + DstMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + ! Blade Structural Controller (if ElastoDyn blades) + do i = 1, Turbine%SrvD%p%NumBStC + do j = 1, Turbine%ED%p%NumBl + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + Active=Turbine%p_FAST%CompElast == Module_ED, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + end do + + ! Substructure Structural Controller (if not using SubDyn) + do j = 1, Turbine%SrvD%p%NumSStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + case (Module_IfW) - ! TODO - ! call MapVariable(Mappings, "IfW Data -> SrvD Data", SrcMod=SrcMod, DstMod=DstMod) + call MapCustom(Mappings, Custom_IfW_to_SrvD, SrcMod=SrcMod, DstMod=DstMod) case (Module_SD) @@ -1594,8 +1736,10 @@ subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, Err return end if - ! Verify that variables have the same size - if (SrcMod%Vars%y(iVarSrc)%Num /= DstMod%Vars%u(iVarDst)%Num) then + ! Verify that variables have compatible sizes + ! If source variable has size 1, it can be mapped to multiple destination variables + if ((SrcMod%Vars%y(iVarSrc)%Num > 1) .and. & + (SrcMod%Vars%y(iVarSrc)%Num /= DstMod%Vars%u(iVarDst)%Num)) then ErrStat = ErrID_Fatal ErrMsg = "Variables in mapping '"//Key//"' have different sizes" return @@ -1616,6 +1760,32 @@ subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, Err Maps = [Maps, Mapping] end subroutine +!> MapCustom creates a custom mapping that is not included in linearization. +!! Each custom mapping needs an entry in FAST_InputSolve to actually perform the transfer. +subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) + type(TC_MappingType), allocatable :: Maps(:) + character(*), intent(in) :: Desc + type(ModDataType), intent(in) :: SrcMod, DstMod + logical, optional, intent(in) :: Active + type(TC_MappingType) :: Mapping + + if (present(Active)) then + if (.not. Active) return + end if + + ! Initialize mapping structure + Mapping%Desc = Desc + Mapping%MapType = Map_Custom + Mapping%SrcModIdx = SrcMod%Idx + Mapping%DstModIdx = DstMod%Idx + Mapping%SrcModID = SrcMod%ID + Mapping%DstModID = DstMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%DstIns = DstMod%Ins + + Maps = [Maps, Mapping] +end subroutine + subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) type(TC_MappingType), intent(inout) :: Mapping type(ModDataType), intent(in) :: SrcMod, DstMod @@ -1731,9 +1901,17 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er DstMod => Mods(Mapping%DstModIdx), & SrcVar => Mods(Mapping%SrcModIdx)%Vars%y(Mapping%iVarSrc), & DstVar => Mods(Mapping%DstModIdx)%Vars%u(Mapping%iVarDst)) - do k = 0, SrcVar%Num - 1 - dUdy(DstMod%iug + DstVar%iLoc(1) + k - 1, SrcMod%iyg + SrcVar%iLoc(1) + k - 1) = -1.0_R8Ki - end do + if (SrcVar%Num == 1) then + ! Map rank 0 source var to rank 1 destination var + do k = 0, DstVar%Num - 1 + dUdy(DstMod%iug + DstVar%iLoc(1) + k - 1, SrcMod%iyg + SrcVar%iLoc(1) - 1) = -1.0_R8Ki + end do + else + ! Map rank 1 source var to rank 1 destination var + do k = 0, SrcVar%Num - 1 + dUdy(DstMod%iug + DstVar%iLoc(1) + k - 1, SrcMod%iyg + SrcVar%iLoc(1) + k - 1) = -1.0_R8Ki + end do + end if end associate case (Map_MotionMesh) @@ -1793,7 +1971,7 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er contains - ! LinearizeMeshTransfer calls the specific linearization function based on + ! LinearizeMeshTransfer calls the specific linearization function based on ! transfer type (Point_to_Point, Point_to_Line2, etc.) subroutine LinearizeMeshTransfer(Typ, Src, Dst, MMap, SrcDisp, DstDisp) integer(IntKi), intent(in) :: Typ @@ -1815,7 +1993,7 @@ subroutine LinearizeMeshTransfer(Typ, Src, Dst, MMap, SrcDisp, DstDisp) end select end subroutine - ! MeshTransfer calls the specific transfer function based on + ! MeshTransfer calls the specific transfer function based on ! transfer type (Point_to_Point, Point_to_Line2, etc.) subroutine TransferMesh(Typ, Src, Dst, MMap, SrcDisp, DstDisp) integer(IntKi), intent(in) :: Typ @@ -1987,10 +2165,14 @@ subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) ! Select based on type of mapping select case (Mapping%MapType) - case (Map_Variable) - call NonMesh_InputSolve(Turbine, Mapping, ErrStat2, ErrMsg2, UseU) + + case (Map_Custom) + + call Custom_InputSolve(Turbine, Mapping, ErrStat2, ErrMsg2, UseU) if (Failed()) return + case (Map_Variable) + case (Map_MotionMesh) ! Get source and destination meshes @@ -2046,118 +2228,235 @@ logical function Failed() end function end subroutine -subroutine NonMesh_InputSolve(Turbine, Mapping, ErrStat, ErrMsg, UseU) - type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type - type(TC_MappingType), intent(in) :: Mapping - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - logical, intent(in) :: UseU ! Flag to transfer to u instead of Input +subroutine Custom_InputSolve(T, Mapping, ErrStat, ErrMsg, UseU) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + type(TC_MappingType), intent(in) :: Mapping + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, intent(in) :: UseU ! Flag to transfer to u instead of Input - character(*), parameter :: RoutineName = 'NonMesh_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, j, k + character(*), parameter :: RoutineName = 'Custom_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + real(ReKi) :: z, u, v, mean_vel + type(AD_InputType), pointer :: u_AD + type(ED_InputType), pointer :: u_ED + type(ExtLd_InputType), pointer :: u_ExtLd + type(InflowWind_InputType), pointer :: u_IfW + type(MD_InputType), pointer :: u_MD + type(SD_InputType), pointer :: u_SD + type(SrvD_InputType), pointer :: u_SrvD ErrStat = ErrID_None ErrMsg = '' -! case ("BD RootM -> SrvD RootM") - - ! u_SrvD%RootMxc(Maps(i)%SrcIns) = T%BD%y(Maps(i)%SrcIns)%RootMxr*cos(T%ED%y%BlPitch(Maps(i)%SrcIns)) + & - ! T%BD%y(Maps(i)%SrcIns)%RootMyr*sin(T%ED%y%BlPitch(Maps(i)%SrcIns)) - ! u_SrvD%RootMyc(Maps(i)%SrcIns) = -T%BD%y(Maps(i)%SrcIns)%RootMxr*sin(T%ED%y%BlPitch(Maps(i)%SrcIns)) + & - ! T%BD%y(Maps(i)%SrcIns)%RootMyr*cos(T%ED%y%BlPitch(Maps(i)%SrcIns)) - - ! case ("ED RootM -> SrvD RootM") - - ! u_SrvD%RootMxc = T%ED%y%RootMxc ! fixed-size arrays: always size 3 - ! u_SrvD%RootMyc = T%ED%y%RootMyc ! fixed-size arrays: always size 3 - - ! case ("ED Data -> SrvD Data") - - ! u_SrvD%YawAngle = T%ED%y%YawAngle ! nacelle yaw plus platform yaw - - ! u_SrvD%Yaw = T%ED%y%Yaw ! nacelle yaw - ! u_SrvD%YawRate = T%ED%y%YawRate - ! u_SrvD%BlPitch = T%ED%y%BlPitch - ! u_SrvD%LSS_Spd = T%ED%y%LSS_Spd - ! u_SrvD%HSS_Spd = T%ED%y%HSS_Spd - ! u_SrvD%RotSpeed = T%ED%y%RotSpeed - - ! u_SrvD%YawBrTAxp = T%ED%y%YawBrTAxp - ! u_SrvD%YawBrTAyp = T%ED%y%YawBrTAyp - ! u_SrvD%LSSTipPxa = T%ED%y%LSSTipPxa - - ! u_SrvD%LSSTipMxa = T%ED%y%LSSTipMxa - ! u_SrvD%LSSTipMya = T%ED%y%LSSTipMya - ! u_SrvD%LSSTipMza = T%ED%y%LSSTipMza - ! u_SrvD%LSSTipMys = T%ED%y%LSSTipMys - ! u_SrvD%LSSTipMzs = T%ED%y%LSSTipMzs - - ! u_SrvD%YawBrMyn = T%ED%y%YawBrMyn - ! u_SrvD%YawBrMzn = T%ED%y%YawBrMzn - ! u_SrvD%NcIMURAxs = T%ED%y%NcIMURAxs - ! u_SrvD%NcIMURAys = T%ED%y%NcIMURAys - ! u_SrvD%NcIMURAzs = T%ED%y%NcIMURAzs - - ! u_SrvD%RotPwr = T%ED%y%RotPwr - - ! u_SrvD%LSShftFxa = T%ED%y%LSShftFxa - ! u_SrvD%LSShftFys = T%ED%y%LSShftFys - ! u_SrvD%LSShftFzs = T%ED%y%LSShftFzs - - ! case ('ED PlatformMotion -> SrvD PlatformMotion') - ! case ('ED TowerMotion -> SrvD TowerMotion') - ! case ('ED NacelleMotion -> SrvD NacelleMotion') - ! case ('ED BladeMotion -> SrvD BladeMotion') - - ! case ("IfW Data -> SrvD Data") - - ! u_SrvD%WindDir = atan2(T%IfW%y%VelocityUVW(2, 1), T%IfW%y%VelocityUVW(1, 1)) - ! u_SrvD%HorWindV = sqrt(T%IfW%y%VelocityUVW(1, 1)**2 + T%IfW%y%VelocityUVW(2, 1)**2) - ! if (allocated(T%IfW%y%lidar%LidSpeed)) u_SrvD%LidSpeed = T%IfW%y%lidar%LidSpeed - ! if (allocated(T%IfW%y%lidar%MsrPositionsX)) u_SrvD%MsrPositionsX = T%IfW%y%lidar%MsrPositionsX - ! if (allocated(T%IfW%y%lidar%MsrPositionsY)) u_SrvD%MsrPositionsY = T%IfW%y%lidar%MsrPositionsY - ! if (allocated(T%IfW%y%lidar%MsrPositionsZ)) u_SrvD%MsrPositionsZ = T%IfW%y%lidar%MsrPositionsZ - -! ! Zero tower and platform added mass -! ! u_ED%TwrAddedMass = 0.0_ReKi -! ! u_ED%PtfmAddedMass = 0.0_ReKi - -! case ("SrvD Data -> ED Data") -! if (Linearize) then -! else -! u_ED%GenTrq = T%SrvD%y%GenTrq -! u_ED%HSSBrTrqC = T%SrvD%y%HSSBrTrqC -! u_ED%BlPitchCom = T%SrvD%y%BlPitchCom -! u_ED%YawMom = T%SrvD%y%YawMom -! end if - -! case ('SrvD BlAirfoilCom -> AD UserProp') -! ! Set Conrol parameter (i.e. flaps) if using ServoDyn bem: -! ! This takes in flap deflection for each blade (only one flap deflection angle per blade), -! ! from ServoDyn (which comes from Bladed style DLL controller) -! ! Commanded Airfoil UserProp for blade (must be same units as given in AD15 airfoil tables) -! ! This is passed to AD15 to be interpolated with the airfoil table userprop column -! ! (might be used for airfoil flap angles for example) -! ! Must be same units as given in airfoil (no unit conversions handled in code)ß -! ! do k_bl = 1, size(u_AD%rotors(1)%UserProp, dim=2) -! ! do k_bn = 1, size(u_AD%rotors(1)%UserProp, dim=1) -! ! u_AD%rotors(1)%UserProp(k_bn, k_bl) = T%SrvD%y%BlAirfoilCom(k_bl) -! ! end do -! ! end do - -! case ('ED HubMotion -> IfW HubMotion') - -! u_IfW%PositionXYZ(:, 1) = T%ED%y%HubPtMotion%Position(:, 1) -! u_IfW%HubPosition = T%ED%y%HubPtMotion%Position(:, 1) + & -! T%ED%y%HubPtMotion%TranslationDisp(:, 1) -! u_IfW%HubOrientation = T%ED%y%HubPtMotion%Orientation(:, :, 1) - -! ! Set Lidar position directly from hub motion mesh -! u_IfW%lidar%HubDisplacementX = T%ED%y%HubPtMotion%TranslationDisp(1, 1) -! u_IfW%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) -! u_IfW%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) + select case (Mapping%DstModID) + + case (Module_AD) + if (UseU) then + u_AD => T%AD%u + else + u_AD => T%AD%Input(1) + end if + case (Module_ED) + if (UseU) then + u_ED => T%ED%u + else + u_ED => T%ED%Input(1) + end if + case (Module_ExtLd) + u_ExtLd => T%ExtLd%u + case (Module_IfW) + if (UseU) then + u_IfW => T%IfW%u + else + u_IfW => T%IfW%Input(1) + end if + case (Module_SD) + if (UseU) then + u_SD => T%SD%u + else + u_SD => T%SD%Input(1) + end if + case (Module_SrvD) + if (UseU) then + u_SrvD => T%SrvD%u + else + u_SrvD => T%SrvD%Input(1) + end if + end select + + ! Select based on mapping description + select case (Mapping%Desc) + +!------------------------------------------------------------------------------- +! AeroDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_AD) + + ! Set Conrol parameter (i.e. flaps) if using ServoDyn bem: + ! This takes in flap deflection for each blade (only one flap deflection angle per blade), + ! from ServoDyn (which comes from Bladed style DLL controller) + ! Commanded Airfoil UserProp for blade (must be same units as given in AD15 airfoil tables) + ! This is passed to AD15 to be interpolated with the airfoil table userprop column + ! (might be used for airfoil flap angles for example) + ! Must be same units as given in airfoil (no unit conversions handled in code)ß + do i = 1, size(T%AD%u%rotors(1)%UserProp, dim=2) ! Blade + u_AD%rotors(1)%UserProp(:, i) = T%SrvD%y%BlAirfoilCom(i) + end do + +!------------------------------------------------------------------------------- +! ExtLoads Inputs +!------------------------------------------------------------------------------- + + case (Custom_ED_to_ExtLd) + + u_ExtLd%az = T%ED%y%LSSTipPxa + u_ExtLd%DX_u%bldPitch(:) = T%ED%y%BlPitch + +!------------------------------------------------------------------------------- +! InflowWind Inputs +!------------------------------------------------------------------------------- + + case (Custom_ED_to_IfW) + + ! This section should be refactored so that IfW uses a hub point mesh + u_IfW%HubPosition = T%ED%y%HubPtMotion%Position(:, 1) + & + T%ED%y%HubPtMotion%TranslationDisp(:, 1) + u_IfW%HubOrientation = T%ED%y%HubPtMotion%Orientation(:, :, 1) + + ! Set Lidar position directly from hub motion mesh + u_IfW%lidar%HubDisplacementX = T%ED%y%HubPtMotion%TranslationDisp(1, 1) + u_IfW%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) + u_IfW%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) + + case (Custom_SrvD_to_IfW) + + ! Set hub position so ServoDyn can get hub wind speed + u_IfW%PositionXYZ(:,1) = T%ED%y%HubPtMotion%Position(:, 1) + +!------------------------------------------------------------------------------- +! MoorDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_MD) + + if (allocated(u_MD%DeltaL) .and. allocated(T%SrvD%y%CableDeltaL)) then + u_MD%DeltaL = T%SrvD%y%CableDeltaL ! these should be sized identically during init + end if + + if (allocated(u_MD%DeltaLdot) .and. allocated(T%SrvD%y%CableDeltaLdot)) then + u_MD%DeltaLdot = T%SrvD%y%CableDeltaLdot ! these should be sized identically during init + end if + +!------------------------------------------------------------------------------- +! SubDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_SD) + + if (allocated(u_SD%CableDeltaL) .and. allocated(T%SrvD%y%CableDeltaL)) then + u_SD%CableDeltaL = T%SrvD%y%CableDeltaL ! these should be sized identically during init + end if + +!------------------------------------------------------------------------------- +! ServoDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_BD_to_SrvD) + + u_SrvD%RootMxc(Mapping%SrcIns) = T%BD%y(Mapping%SrcIns)%RootMxr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) + u_SrvD%RootMyc(Mapping%SrcIns) = -T%BD%y(Mapping%SrcIns)%RootMxr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) + + case (Custom_ED_to_SrvD) + + ! Blade root moment if not using BeamDyn + if (T%p_FAST%CompElast /= Module_BD) then + u_SrvD%RootMxc = T%ED%y%RootMxc ! fixed-size arrays: always size 3 + u_SrvD%RootMyc = T%ED%y%RootMyc ! fixed-size arrays: always size 3 + end if + + u_SrvD%YawAngle = T%ED%y%YawAngle ! nacelle yaw plus platform yaw + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + u_SrvD%Yaw = T%ED%y%Yaw ! nacelle yaw + u_SrvD%YawRate = T%ED%y%YawRate + u_SrvD%BlPitch = T%ED%y%BlPitch + u_SrvD%LSS_Spd = T%ED%y%LSS_Spd + u_SrvD%HSS_Spd = T%ED%y%HSS_Spd + u_SrvD%RotSpeed = T%ED%y%RotSpeed + + u_SrvD%YawBrTAxp = T%ED%y%YawBrTAxp + u_SrvD%YawBrTAyp = T%ED%y%YawBrTAyp + u_SrvD%LSSTipPxa = T%ED%y%LSSTipPxa + + u_SrvD%LSSTipMxa = T%ED%y%LSSTipMxa + u_SrvD%LSSTipMya = T%ED%y%LSSTipMya + u_SrvD%LSSTipMza = T%ED%y%LSSTipMza + u_SrvD%LSSTipMys = T%ED%y%LSSTipMys + u_SrvD%LSSTipMzs = T%ED%y%LSSTipMzs + + u_SrvD%YawBrMyn = T%ED%y%YawBrMyn + u_SrvD%YawBrMzn = T%ED%y%YawBrMzn + u_SrvD%NcIMURAxs = T%ED%y%NcIMURAxs + u_SrvD%NcIMURAys = T%ED%y%NcIMURAys + u_SrvD%NcIMURAzs = T%ED%y%NcIMURAzs + + u_SrvD%RotPwr = T%ED%y%RotPwr + + u_SrvD%LSShftFxa = T%ED%y%LSShftFxa + u_SrvD%LSShftFys = T%ED%y%LSShftFys + u_SrvD%LSShftFzs = T%ED%y%LSShftFzs + + case (Custom_IfW_to_SrvD) + + u_SrvD%WindDir = atan2(T%IfW%y%VelocityUVW(2, 1), T%IfW%y%VelocityUVW(1, 1)) + u_SrvD%HorWindV = sqrt(T%IfW%y%VelocityUVW(1, 1)**2 + T%IfW%y%VelocityUVW(2, 1)**2) + if (allocated(T%IfW%y%lidar%LidSpeed)) u_SrvD%LidSpeed = T%IfW%y%lidar%LidSpeed + if (allocated(T%IfW%y%lidar%MsrPositionsX)) u_SrvD%MsrPositionsX = T%IfW%y%lidar%MsrPositionsX + if (allocated(T%IfW%y%lidar%MsrPositionsY)) u_SrvD%MsrPositionsY = T%IfW%y%lidar%MsrPositionsY + if (allocated(T%IfW%y%lidar%MsrPositionsZ)) u_SrvD%MsrPositionsZ = T%IfW%y%lidar%MsrPositionsZ + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + case (Custom_ExtInfw_to_SrvD) + + u_SrvD%WindDir = ATAN2(T%ExtInfw%y%v(1), T%ExtInfw%y%u(1)) + u_SrvD%HorWindV = SQRT(T%ExtInfw%y%u(1)**2 + T%ExtInfw%y%v(1)**2) + if (allocated(u_SrvD%LidSpeed)) u_SrvD%LidSpeed = 0.0 + if (allocated(u_SrvD%MsrPositionsX)) u_SrvD%MsrPositionsX = 0.0 + if (allocated(u_SrvD%MsrPositionsY)) u_SrvD%MsrPositionsY = 0.0 + if (allocated(u_SrvD%MsrPositionsz)) u_SrvD%MsrPositionsz = 0.0 + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + case (Custom_ExtLd_to_SrvD) + + pi = acos(-1.0) + z = T%ED%y%HubPtMotion%Position(3, 1) + mean_vel = T%ExtLd%p%vel_mean*((z/T%ExtLd%p%z_ref)**T%ExtLd%p%shear_exp) + u = -mean_vel*sin(T%ExtLd%p%wind_dir*pi/180.0) + v = -mean_vel*cos(T%ExtLd%p%wind_dir*pi/180.0) + u_SrvD%HorWindV = mean_vel + u_SrvD%WindDir = atan2(v, u) + if (allocated(u_SrvD%LidSpeed)) u_SrvD%LidSpeed = 0.0 + if (allocated(u_SrvD%MsrPositionsX)) u_SrvD%MsrPositionsX = 0.0 + if (allocated(u_SrvD%MsrPositionsY)) u_SrvD%MsrPositionsY = 0.0 + if (allocated(u_SrvD%MsrPositionsz)) u_SrvD%MsrPositionsz = 0.0 + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + +!------------------------------------------------------------------------------- +! Unknown Mapping +!------------------------------------------------------------------------------- + + case default + + ErrStat = ErrID_Fatal + ErrMsg = "Custom_InputSolve: unknown mapping '"//trim(Mapping%Desc)//"'" + + end select end subroutine From b269c584ae6b9ffe50d29df4710bdb687769462f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 15:41:29 +0000 Subject: [PATCH 094/319] Added Custom mapping type for direct transfers not used in linearization --- modules/openfast-library/src/FAST_Registry.txt | 1 + modules/openfast-library/src/FAST_Types.f90 | 1 + 2 files changed, 2 insertions(+) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 6f731bb60a..9b467754cc 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -114,6 +114,7 @@ typedef ^ FAST_SS_CaseType ReKi Pitch - - - "Pitch angle for this case of the st param ^ - IntKi Map_LoadMesh - 1 - "Load mesh mapping type" - param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - param ^ - IntKi Map_Variable - 3 - "Individual variable mapping type" - +param ^ - IntKi Map_Custom - 4 - "Custom mapping not used for linearization" - typedef ^ TC_MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - typedef ^ ^ IntKi SrcModIdx - 0 - "Source module index in ModData array" - typedef ^ ^ IntKi DstModIdx - 0 - "Destination module index in ModData array" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index b9fbfe4ff1..ba215f4e26 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -85,6 +85,7 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Map_LoadMesh = 1 ! Load mesh mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Variable = 3 ! Individual variable mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Custom = 4 ! Custom mapping not used for linearization [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] From 205b412dad5354e207ebfd3dfe2eb08d7130038e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 15:42:18 +0000 Subject: [PATCH 095/319] Use MV_Pack in SrvD GetOP, add variables indices --- modules/servodyn/src/ServoDyn.f90 | 95 ++++++++++++---------- modules/servodyn/src/ServoDyn_Registry.txt | 5 ++ modules/servodyn/src/ServoDyn_Types.f90 | 76 +++++++++++++++++ 3 files changed, 135 insertions(+), 41 deletions(-) diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 7fc3eb3a9f..4168ad415a 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -772,29 +772,49 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er LinNames=['ElecPwr, W']) ! Structural controllers - do i = 1, p%NumBStC - do j = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), LoadFields, & - Mesh=y%BStCLoadMesh(i,j)) + if (p%NumBStC > 0) then + call AllocAry(p%iVarBStCLoadMesh, p%NumBStC, p%NumBl, "iVarBStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; + do i = 1, p%NumBStC + do j = 1, p%NumBl + call MV_AddMeshVar(p%Vars%y, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), LoadFields, & + Mesh=y%BStCLoadMesh(i,j)) + end do end do - end do + end if - do j = 1, p%NumNStC - call MV_AddMeshVar(p%Vars%y, 'Nacelle StC '//Num2LStr(j), LoadFields, & - Mesh=y%NStCLoadMesh(j)) - enddo + if (p%NumNStC > 0) then + call AllocAry(p%iVarNStCLoadMesh, p%NumNStC, "iVarNStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; + p%iVarNStCLoadMesh = 0 + do j = 1, p%NumNStC + call MV_AddMeshVar(p%Vars%y, 'Nacelle StC '//Num2LStr(j), LoadFields, & + Mesh=y%NStCLoadMesh(j)) + enddo + end if - do j = 1, p%NumTStC - call MV_AddMeshVar(p%Vars%y, 'Tower StC '//Num2LStr(j), LoadFields, & - Mesh=y%TStCLoadMesh(j)) - enddo + if (p%NumTStC > 0) then + call AllocAry(p%iVarTStCLoadMesh, p%NumTStC, "iVarTStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; + p%iVarTStCLoadMesh = 0 + do j = 1, p%NumTStC + call MV_AddMeshVar(p%Vars%y, 'Tower StC '//Num2LStr(j), LoadFields, & + Mesh=y%TStCLoadMesh(j)) + enddo + end if - do j = 1, p%NumSStC - call MV_AddMeshVar(p%Vars%y, 'Substructure StC '//Num2LStr(j), LoadFields, & - Mesh=y%SStCLoadMesh(j)) - enddo + if (p%NumSStC > 0) then + call AllocAry(p%iVarSStCLoadMesh, p%NumSStC, "iVarSStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; + p%iVarSStCLoadMesh = 0 + do j = 1, p%NumSStC + call MV_AddMeshVar(p%Vars%y, 'Substructure StC '//Num2LStr(j), LoadFields, & + Mesh=y%SStCLoadMesh(j)) + enddo + end if - ! Outputs + ! Write Outputs + if (p%NumOuts > 0) then + p%iVarWriteOutput = size(p%Vars%y) + 1 + else + p%iVarWriteOutput = 0 + end if do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & @@ -4568,40 +4588,33 @@ subroutine Get_y_op() integer(IntKi) :: i,j,index_next if (.not. allocated(y_op)) then - CALL AllocAry( y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2 ) - if (Failed()) return; + CALL AllocAry(y_op, p%Vars%ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - index_next=1 - do i=1,size(y%BlPitchCom) - y_op(index_next) = y%BlPitchCom(i) - index_next = index_next + 1 - end do - - y_op(index_next) = y%YawMom; index_next = index_next + 1 - y_op(index_next) = y%GenTrq; index_next = index_next + 1 - y_op(index_next) = y%ElecPwr; index_next = index_next + 1 + call MV_Pack(p%Vars%y, p%iVarBlPitchCom, y%BlPitchCom, y_op) + call MV_Pack(p%Vars%y, p%iVarYawMom, y%YawMom, y_op) + call MV_Pack(p%Vars%y, p%iVarGenTrq, y%GenTrq, y_op) + call MV_Pack(p%Vars%y, p%iVarElecPwr, y%ElecPwr, y_op) ! StC related outputs - do j=1,p%NumBStC ! Blade - do i=1,p%NumBl - call PackLoadMesh( y%BStCLoadMesh(i,j), y_op, index_next ) + do j = 1, p%NumBStC ! Blade + do i = 1, p%NumBl + call MV_Pack(p%Vars%y, p%iVarBStCLoadMesh(i,j), y%BStCLoadMesh(i,j), y_op) enddo enddo - do j=1,p%NumNStC ! Nacelle - call PackLoadMesh( y%NStCLoadMesh(j), y_op, index_next ) + do j = 1, p%NumNStC ! Nacelle + call MV_Pack(p%Vars%y, p%iVarNStCLoadMesh(j), y%NStCLoadMesh(j), y_op) enddo - do j=1,p%NumTStC ! Tower - call PackLoadMesh( y%TStCLoadMesh(j), y_op, index_next ) + do j = 1, p%NumTStC ! Tower + call MV_Pack(p%Vars%y, p%iVarTStCLoadMesh(j), y%TStCLoadMesh(j), y_op) enddo - do j=1,p%NumSStC ! Sub-structure - call PackLoadMesh( y%SStCLoadMesh(j), y_op, index_next ) + do j = 1, p%NumSStC ! Sub-structure + call MV_Pack(p%Vars%y, p%iVarSStCLoadMesh(j), y%SStCLoadMesh(j), y_op) enddo ! y%outputs - do i=1,p%NumOuts - y_op(index_next) = y%WriteOutput(i) - index_next = index_next + 1 + do i = p%iVarWriteOutput, size(p%Vars%y) + call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1)), y_op) end do end subroutine Get_y_op diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index c4a59182c7..6e08afc46b 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -482,6 +482,11 @@ typedef ^ ParameterType IntKi iVarBlPitchCom - - - "BlPitchCom Variable Index" - typedef ^ ParameterType IntKi iVarYawMom - - - "YawMom Variable Index" - typedef ^ ParameterType IntKi iVarGenTrq - - - "GenTrq Variable Index" - typedef ^ ParameterType IntKi iVarElecPwr - - - "ElecPwr Variable Index" - +typedef ^ ParameterType IntKi iVarBStCLoadMesh :: - - "BStCLoadMesh Variable Index" - +typedef ^ ParameterType IntKi iVarNStCLoadMesh : - - "NStCLoadMesh Variable Index" - +typedef ^ ParameterType IntKi iVarTStCLoadMesh : - - "TStCLoadMesh Variable Index" - +typedef ^ ParameterType IntKi iVarSStCLoadMesh : - - "SStCLoadMesh Variable Index" - +typedef ^ ParameterType IntKi iVarWriteOutput - - - "WriteOutput Variable Index" - # ..... Inputs .................................................................................................................... diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 7f1043c08c..d31d13ef5b 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -494,6 +494,11 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: iVarYawMom = 0_IntKi !< YawMom Variable Index [-] INTEGER(IntKi) :: iVarGenTrq = 0_IntKi !< GenTrq Variable Index [-] INTEGER(IntKi) :: iVarElecPwr = 0_IntKi !< ElecPwr Variable Index [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iVarBStCLoadMesh !< BStCLoadMesh Variable Index [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarNStCLoadMesh !< NStCLoadMesh Variable Index [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarTStCLoadMesh !< TStCLoadMesh Variable Index [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarSStCLoadMesh !< SStCLoadMesh Variable Index [-] + INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< WriteOutput Variable Index [-] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -4316,6 +4321,55 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%iVarYawMom = SrcParamData%iVarYawMom DstParamData%iVarGenTrq = SrcParamData%iVarGenTrq DstParamData%iVarElecPwr = SrcParamData%iVarElecPwr + if (allocated(SrcParamData%iVarBStCLoadMesh)) then + LB(1:2) = lbound(SrcParamData%iVarBStCLoadMesh, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%iVarBStCLoadMesh, kind=B8Ki) + if (.not. allocated(DstParamData%iVarBStCLoadMesh)) then + allocate(DstParamData%iVarBStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarBStCLoadMesh = SrcParamData%iVarBStCLoadMesh + end if + if (allocated(SrcParamData%iVarNStCLoadMesh)) then + LB(1:1) = lbound(SrcParamData%iVarNStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarNStCLoadMesh, kind=B8Ki) + if (.not. allocated(DstParamData%iVarNStCLoadMesh)) then + allocate(DstParamData%iVarNStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarNStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarNStCLoadMesh = SrcParamData%iVarNStCLoadMesh + end if + if (allocated(SrcParamData%iVarTStCLoadMesh)) then + LB(1:1) = lbound(SrcParamData%iVarTStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarTStCLoadMesh, kind=B8Ki) + if (.not. allocated(DstParamData%iVarTStCLoadMesh)) then + allocate(DstParamData%iVarTStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarTStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarTStCLoadMesh = SrcParamData%iVarTStCLoadMesh + end if + if (allocated(SrcParamData%iVarSStCLoadMesh)) then + LB(1:1) = lbound(SrcParamData%iVarSStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarSStCLoadMesh, kind=B8Ki) + if (.not. allocated(DstParamData%iVarSStCLoadMesh)) then + allocate(DstParamData%iVarSStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarSStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarSStCLoadMesh = SrcParamData%iVarSStCLoadMesh + end if + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput end subroutine subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -4448,6 +4502,18 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Vars) ParamData%Vars => null() end if + if (allocated(ParamData%iVarBStCLoadMesh)) then + deallocate(ParamData%iVarBStCLoadMesh) + end if + if (allocated(ParamData%iVarNStCLoadMesh)) then + deallocate(ParamData%iVarNStCLoadMesh) + end if + if (allocated(ParamData%iVarTStCLoadMesh)) then + deallocate(ParamData%iVarTStCLoadMesh) + end if + if (allocated(ParamData%iVarSStCLoadMesh)) then + deallocate(ParamData%iVarSStCLoadMesh) + end if end subroutine subroutine SrvD_PackParam(RF, Indata) @@ -4635,6 +4701,11 @@ subroutine SrvD_PackParam(RF, Indata) call RegPack(RF, InData%iVarYawMom) call RegPack(RF, InData%iVarGenTrq) call RegPack(RF, InData%iVarElecPwr) + call RegPackAlloc(RF, InData%iVarBStCLoadMesh) + call RegPackAlloc(RF, InData%iVarNStCLoadMesh) + call RegPackAlloc(RF, InData%iVarTStCLoadMesh) + call RegPackAlloc(RF, InData%iVarSStCLoadMesh) + call RegPack(RF, InData%iVarWriteOutput) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -4857,6 +4928,11 @@ subroutine SrvD_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%iVarYawMom); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarGenTrq); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBStCLoadMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarNStCLoadMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarTStCLoadMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarSStCLoadMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) From 9e688d8d8462cc24a60e74619263aa1bd3f146de Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 15:42:43 +0000 Subject: [PATCH 096/319] Add MD to modules list in FAST_Subs --- modules/openfast-library/src/FAST_Subs.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 41c1005d06..5837ad66fe 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1268,6 +1268,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_MD%DerivOrder_x)) call move_alloc(Init%OutData_MD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%DerivOrder_x) end if + CALL MV_AddModule(y_FAST%Modules, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & + Init%OutData_MD%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN From 70328c21da8c5a49dbe64bbc3c62e08ae5a84b91 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 15:43:03 +0000 Subject: [PATCH 097/319] Change GetOP order in FAST_ModLin --- modules/openfast-library/src/FAST_ModLin.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModLin.f90 index c41444988e..d3b9ddc32b 100644 --- a/modules/openfast-library/src/FAST_ModLin.f90 +++ b/modules/openfast-library/src/FAST_ModLin.f90 @@ -388,24 +388,24 @@ subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_F do i = 1, size(p%iMod) associate (ModData => Mods(p%iMod(i))) - ! Operating point values - call FAST_GetOP(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - u_op=ModData%Lin%u, y_op=ModData%Lin%y, & - x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) - if (Failed()) return - ! Derivatives wrt input call FAST_JacobianPInput(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & dYdu=ModData%Lin%dYdu, dXdu=ModData%Lin%dXdu) if (Failed()) return - ! Derivatives wrt continuous state call FAST_JacobianPContState(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & dYdx=ModData%Lin%dYdx, dXdx=ModData%Lin%dXdx, & StateRotation=ModData%Lin%StateRotation) if (Failed()) return + ! Operating point values (must come after Jacobian routines because + ! some modules calculate OP in those routines [MD]) + call FAST_GetOP(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, y_op=ModData%Lin%y, & + x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) + if (Failed()) return + ! Copy module linearization arrays into glue linearization arrays if ((size(ModGlue%Lin%x) > 0) .and. allocated(ModData%Lin%x)) ModGlue%Lin%x(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%x if ((size(ModGlue%Lin%dx) > 0) .and. allocated(ModData%Lin%dx)) ModGlue%Lin%dx(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dx From 4482c5e1b85f85216a02aef7badc5b920246ecae Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 15:43:42 +0000 Subject: [PATCH 098/319] Modify MoorDyn to use module variables --- modules/moordyn/src/MoorDyn.f90 | 1375 +++++----- modules/moordyn/src/MoorDyn_Registry.txt | 89 +- modules/moordyn/src/MoorDyn_Types.f90 | 2902 +++++++++++----------- 3 files changed, 2232 insertions(+), 2134 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index e657717ba7..0d59f5b68c 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -2375,9 +2375,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er xd%dummy = 0 z%dummy = 0 - if (InitInp%Linearize) then - call MD_Init_Jacobian(InitInp, p, u, y, m, InitOut, ErrStat2, ErrMsg2); if(Failed()) return - endif + ! Initialize module variables + call MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2); if(Failed()) return CALL WrScr(' MoorDyn initialization completed.') if (p%writeLog > 0) then @@ -2488,8 +2487,325 @@ end function NextLine END SUBROUTINE MD_Init !----------------------------------------------------------------------------------------====== + !----------------------------------------------------------------------------------------------------------------------- + !> This routine initializes module variables for use by the solver and linearization. + subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(MD_InitInputType), intent(in) :: InitInp !< Initialization input + type(MD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(MD_ParameterType), intent(inout) :: p !< Parameters + type(MD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(MD_ConstraintStateType), intent(inout) :: z !< Constraint state + type(MD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(MD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(MD_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'MD_InitVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + integer(IntKi) :: i, j, l, N + real(R8Ki) :: Perturb + real(ReKi) :: dl_slack ! how much a given line segment is stretched [m] + real(ReKi) :: dl_slack_min ! minimum change in a node position for the least-strained segment in the simulation to go slack [m] + character(32) :: LinStr ! Used for constructing linearization variable names + logical :: LinCtrl ! Is the current DeltaL channel associated with a line? + type(ModVarType) :: VarTmp ! Temporary variable for velocity states + character(20), parameter :: TransDispSuffix(*) = [' Px, m', ' Py, m', ' Pz, m'] + character(20), parameter :: TransVelSuffix(*) = [' Vx, m/s', ' Vy, m/s', ' Vz, m/s'] + character(20), parameter :: AngularDispSuffix(*) = [' rot_x, rad', ' rot_y, rad', ' rot_z, rad'] + character(20), parameter :: AngularVelSuffix(*) = [' omega_x, rad/s', ' omega_y, rad/s', ' omega_z, rad/s'] + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !------------------------------------------------------------------------- + ! Perturbation sizes + !------------------------------------------------------------------------- + + ! Figure out appropriate transverse perturbation size to avoid slack segments + dl_slack_min = 0.1_ReKi ! start at 0.1 m + + do l = 1,p%nLines + do I = 1, m%LineList(l)%N + dl_slack = m%LineList(l)%lstr(I) - m%LineList(l)%l(I) + + ! store the smallest positive length margin to a segment going slack + if (( dl_slack > 0.0_ReKi) .and. (dl_slack < dl_slack_min)) then + dl_slack_min = dl_slack + end if + end do + end do + + dl_slack_min = 0.5*dl_slack_min ! apply 0.5 safety factor + + !------------------------------------------------------------------------- + ! Continuous State Variables + !------------------------------------------------------------------------- + + ! NOTE: the order is different than the order of the internal states. This is to + ! match what the OpenFAST framework is expecting: all positions first, then all + ! derviatives of positions (velocity terms) second. This adds slight complexity + ! here, but considerably simplifies post processing of the full OpenFAST results + ! for linearization. + ! The p%dxIdx_map2_xStateIdx array holds the index for the x%states array + ! corresponding to the current jacobian index. + + !----------------- + ! position states + !----------------- + + ! Free bodies + DO l = 1, p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) + LinStr = 'Body '//Num2LStr(m%FreeBodyIs(l)) + + ! If coupled pinned body + if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then + ! Add angular displacement + call MV_AddVar(p%Vars%x, LinStr, VF_AngularDisp, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%BodyStateIs1(l)+3, & ! x%state index + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) + else + ! Add translation displacement + call MV_AddVar(p%Vars%x, LinStr, VF_TransDisp, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%BodyStateIs1(l)+6, & ! x%state index + Perturb=dl_slack_min, & + LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) + ! Add angular displacement + call MV_AddVar(p%Vars%x, LinStr, VF_AngularDisp, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%BodyStateIs1(l)+9, & ! x%state index + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) + end if + end do + + ! Rods + DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) + LinStr = 'Rod '//Num2LStr(m%FreeRodIs(l)) + + ! If pinned rod + if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then + ! Add angular displacement + call MV_AddVar(p%Vars%x, LinStr, VF_AngularDisp, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%RodStateIs1(l)+3, & ! x%state index + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) + else + ! Add translation displacement + call MV_AddVar(p%Vars%x, LinStr, VF_TransDisp, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%RodStateIs1(l)+6, & ! x%state index + Perturb=dl_slack_min, & + LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) + ! Add angular displacement + call MV_AddVar(p%Vars%x, LinStr, VF_AngularDisp, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%RodStateIs1(l)+9, & ! x%state index + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) + end if + end do + + ! Free Points + do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) + ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) + LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) + call MV_AddVar(p%Vars%x, LinStr, VF_TransDisp, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%PointStateIs1(l)+3, & ! x%state index + Perturb=dl_slack_min, & + LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) + end do + + ! Lines + do l = 1, p%nLines ! Line m%LineList(l) + ! corresponds to state indices: (m%LineStateIs1(l)+3*N-3:m%LineStateIs1(l)+6*N-7) -- NOTE: end nodes not included + N = m%LineList(l)%N ! number of segments in the line + do i = 0, N-2 + LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) + call MV_AddVar(p%Vars%x, LinStr, VF_TransDisp, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%LineStateIs1(l) + 3*N + 3*i - 3, & ! x%state index + Perturb=dl_slack_min, & + LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) + end do + end do + + !----------------- + ! velocity states + !----------------- + + ! Free bodies + DO l = 1, p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) + LinStr = 'Body '//Num2LStr(m%FreeBodyIs(l)) + + ! If coupled pinned body + if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then + ! Add angular displacement + call MV_AddVar(p%Vars%x, LinStr, VF_AngularVel, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%BodyStateIs1(l)+0, & ! x%state index + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) + else + ! Add translation displacement + call MV_AddVar(p%Vars%x, LinStr, VF_TransVel, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%BodyStateIs1(l)+0, & ! x%state index + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) + ! Add angular displacement + call MV_AddVar(p%Vars%x, LinStr, VF_AngularVel, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%BodyStateIs1(l)+3, & ! x%state index + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) + end if + end do + + ! Rods + DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) + LinStr = 'Rod '//Num2LStr(m%FreeRodIs(l)) + + ! If pinned rod + if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then + ! Add angular displacement + call MV_AddVar(p%Vars%x, LinStr, VF_AngularVel, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%RodStateIs1(l)+0, & ! x%state index + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) + else + ! Add translation displacement + call MV_AddVar(p%Vars%x, LinStr, VF_TransVel, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%RodStateIs1(l)+0, & ! x%state index + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) + ! Add angular displacement + call MV_AddVar(p%Vars%x, LinStr, VF_AngularVel, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%RodStateIs1(l)+3, & ! x%state index + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) + end if + end do + + ! Free Points + do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) + ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) + LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) + call MV_AddVar(p%Vars%x, LinStr, VF_TransVel, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%PointStateIs1(l)+0, & ! x%state index + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) + end do + + ! Lines + do l = 1, p%nLines ! Line m%LineList(l) + ! corresponds to state indices: (m%LineStateIs1(l)+3*N-3:m%LineStateIs1(l)+6*N-7) -- NOTE: end nodes not included + N = m%LineList(l)%N ! number of segments in the line + do i = 0, N-2 + LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) + call MV_AddVar(p%Vars%x, LinStr, VF_TransVel, Num=3, Flags=VF_DerivOrder2, & + iUsr=m%LineStateIs1(l) + 3*i + 0, & ! x%state index + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) + end do + end do + !------------------------------------------------------------------------- + ! Input variables + !------------------------------------------------------------------------- + + allocate(p%Vars%u(0)) + + call MV_AddMeshVar(p%Vars%u, "CoupledKinematics", MotionFields, & + VarIdx=p%iVarCoupledKinematics, & + Mesh=u%CoupledKinematics(1), & + Perturbs=[dl_slack_min, & ! VF_TransDisp + 0.1_R8Ki, & ! VF_Orientation + 0.1_R8Ki, & ! VF_TransVel + 0.1_R8Ki, & ! VF_AngularVel + 0.1_R8Ki, & ! VF_TransAcc + 0.1_R8Ki]) ! VF_AngularAcc + + ! This could be stored more efficiently, but maintains order compatible with previous implementation. + if (.not. allocated(u%DeltaL)) then + p%iVarDeltaL = 0 + else + p%iVarDeltaL = size(p%Vars%u) + 1 + ! Signals may be passed in without being requested for control + do i = 1,size(u%DeltaL) + + ! Figure out if this DeltaL control channel is associated with a line or multiple or none and label + LinCtrl = .FALSE. + LinStr = '(lines: ' + do j = 1, p%NLines + if (m%LineList(j)%CtrlChan == i) then + LinCtrl = .TRUE. + LinStr = LinStr//trim(num2lstr(i))//' ' + endif + enddo + + if (LinCtrl) then + LinStr = LinStr//' )' + else + LinStr = '(lines: none)' + end if + + call MV_AddVar(p%Vars%u, "DeltaL "//trim(num2lstr(i)), VF_TransDisp, & + iUsr=i, & + Perturb=dl_slack_min, & + LinNames=['CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr)]) + + call MV_AddVar(p%Vars%u, "DeltaLdot "//trim(num2lstr(i)), VF_TransVel, & + iUsr=i, & + Perturb=0.2_R8Ki, & + LinNames=['CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr)]) + end do + endif + + !------------------------------------------------------------------------- + ! Output variables + !------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, "LinNames_y", LoadFields, & + VarIdx=p%iVarCoupledLoads, & + Mesh=y%CoupledLoads(1)) + + ! Write outputs + call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + VarIdx=p%iVarWriteOutput, & + Flags=VF_WriteOut, & + Num=p%numOuts,& + LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) + + !------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call MD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_CopyContState(x, m%dxdt_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_CopyOutput(y, m%y_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine !----------------------------------------------------------------------------------------====== SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg) @@ -3450,7 +3766,7 @@ END SUBROUTINE TimeStep !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -3466,101 +3782,131 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] + integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation ! local variables - TYPE(MD_OutputType) :: y_m, y_p - TYPE(MD_ContinuousStateType) :: x_m, x_p - TYPE(MD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_JacobianPInput' + character(*), parameter :: RoutineName = 'MD_JacobianPInput' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + INTEGER(IntKi) :: i, j, col ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if - ! get OP values here: - call MD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return + ! Get OP values here + call MD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if(Failed()) return - ! make a copy of the inputs to perturb - call MD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + ! Copy inputs to perturb + call MD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackInputOP(p, u, m%Jac%u) - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then + + ! Allocate dYdu if not allocated + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call MD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - call MD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta_p u - call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute y at u_op + delta_p u - call MD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta_m u - call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute y at u_op - delta_m u - call MD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call MD_Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackOutputOP(p, m%y_jac, m%Jac%y_pos, IsFullLin) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackOutputOP(p, m%y_jac, m%Jac%y_neg, IsFullLin) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do end do - if(Failed()) return END IF - IF ( PRESENT( dXdu ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu)) then + + ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return - endif - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta u - call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute x at u_op + delta u - call MD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta u - call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute x at u_op - delta u - call MD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - ! we may have had an error allocating memory, so we'll check - if(Failed()) return - ! get central difference (state entries are mapped the the dXdu column in routine): - call MD_Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateOP(p, m%dxdt_jac, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateOP(p, m%dxdt_jac, m%Jac%x_neg) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + end do end do - END IF ! dXdu - IF ( PRESENT( dXddu ) ) THEN - if (allocated(dXddu)) deallocate(dXddu) - END IF - IF ( PRESENT( dZdu ) ) THEN - if (allocated(dZdu)) deallocate(dZdu) - END IF - call CleanUp() -contains + end if ! dXdu + + if (present(dxddu)) then + if (allocated(dxddu)) deallocate(dxddu) + end if + + if (present(dzdu)) then + if (allocated(dzdu)) deallocate(dzdu) + end if + +contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() end function Failed - - subroutine CleanUp() - call MD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call MD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - call MD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call MD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call MD_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - END SUBROUTINE MD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, dXddx, dZdx) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -3572,102 +3918,127 @@ SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable flag filter REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) wrt the continuous states (x) [intent in to avoid deallocation] + ! local variables - TYPE(MD_OutputType) :: y_p, y_m - TYPE(MD_ContinuousStateType) :: x_p, x_m - TYPE(MD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_JacobianPContState' + character(*), parameter :: RoutineName = 'MD_JacobianPContState' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + integer(IntKi) :: i, j, col ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if - ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY - call MD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + ! Copy state values + call MD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateOP(p, x, m%Jac%x) - IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then + + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%Jac_nx, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call MD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - ! Loop over the dx dimension of the dYdx array. Perturb the corresponding state (note difference in ordering of dYdx and x%states). - ! The p%dxIdx_map2_xStateIdx(i) is the index to the state array for the given dx index - do i=1,p%Jac_nx ! index into dx dimension - ! get x_op + delta x - call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), 1, x_perturb, delta ) - ! compute y at x_op + delta x - call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), -1, x_perturb, delta ) - ! compute y at x_op - delta x - call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call MD_Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) + + ! Loop through state variables + do i = 1, size(p%Vars%x) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackOutputOP(p, m%y_jac, m%Jac%y_pos, IsFullLin) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackOutputOP(p, m%y_jac, m%Jac%y_neg, IsFullLin) + + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + end do end do - if(Failed()) return - END IF - - IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx)) then + + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Jac_nx, p%Jac_nx, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! Loop over the dx dimension of the array. Perturb the corresponding state (note difference in ordering of dXdx and x%states). - ! The resulting x_p and x_m are used to calculate the column for dXdx (mapping of state entry to dXdx row entry occurs in MD_Compute_dX) - ! The p%dxIdx_map2_xStateIdx(i) is the index to the state array for the given dx index - do i=1,p%Jac_nx ! index into dx dimension - ! get x_op + delta x - call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), 1, x_perturb, delta ) - ! compute x at x_op + delta x - call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), -1, x_perturb, delta ) - ! compute x at x_op - delta x - call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if(Failed()) return - ! get central difference: - call MD_Compute_dX( p, x_p, x_m, delta, dXdx(:,i) ) + + ! Loop through state variables + do i = 1, size(p%Vars%x) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateOP(p, m%dxdt_jac, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateOP(p, m%dxdt_jac, m%Jac%x_neg) + + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + end do end do - END IF - IF ( PRESENT( dXddx ) ) THEN + end if + + if (present(dXddx)) then if (allocated(dXddx)) deallocate(dXddx) - END IF - IF ( PRESENT( dZdx ) ) THEN + end if + + if (present(dZdx)) then if (allocated(dZdx)) deallocate(dZdx) - END IF - call CleanUp() + end if contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_JacobianPContState') + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() end function Failed - - subroutine CleanUp() - call MD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call MD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call MD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call MD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call MD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - END SUBROUTINE MD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- @@ -3738,7 +4109,7 @@ SUBROUTINE MD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE MD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE MD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +SUBROUTINE MD_GetOP(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, u_op, y_op, x_op, dx_op, xd_op, z_op) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -3750,594 +4121,172 @@ SUBROUTINE MD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Filter variables by flag REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - ! Local - INTEGER(IntKi) :: idx, i - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - TYPE(MD_ContinuousStateType) :: dx ! derivative of continuous states at operating point + + CHARACTER(*), PARAMETER :: RoutineName = 'MD_GetOP' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + logical :: IsFullLin + ErrStat = ErrID_None ErrMsg = '' - ! inputs - IF ( PRESENT( u_op ) ) THEN - nu = size(p%Jac_u_indx,1) + u%CoupledKinematics(1)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + + ! Set full linearization flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + else + IsFullLin = .true. + end if + + ! Inputs + if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return end if - idx = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - ! fill in the u_op values from the input mesh - call PackMotionMesh(u%CoupledKinematics(1), u_op, idx, FieldMask=FieldMask) - - ! now do the active tensioning commands if there are any - if (allocated(u%DeltaL)) then - do i=1,size(u%DeltaL) - u_op(idx) = u%DeltaL(i) - idx = idx + 1 - u_op(idx) = u%DeltaLdot(i) - idx = idx + 1 - end do - endif - END IF - ! outputs - IF ( PRESENT( y_op ) ) THEN - ny = p%Jac_ny + y%CoupledLoads(1)%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + call MD_PackInputOP(p, u, u_op) + end if + + ! Outputs + if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return end if - idx = 1 - call PackLoadMesh(y%CoupledLoads(1), y_op, idx) - do i=1,p%NumOuts - y_op(idx) = y%WriteOutput(i) - idx = idx + 1 - end do - END IF - ! states - IF ( PRESENT( x_op ) ) THEN + call MD_PackOutputOP(p, y, y_op, IsFullLin) + end if + + ! Continuous states + if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx,'x_op',ErrStat2,ErrMsg2); if (Failed()) return + call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - do i=1, p%Jac_nx - x_op(i) = x%states(p%dxIdx_map2_xStateIdx(i)) ! x for lin is different order, so use mapping - end do - END IF - ! state derivatives? - IF ( PRESENT( dx_op ) ) THEN + call MD_PackContStateOP(p, x, x_op) + end if + + ! Continuous state derivatives + if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return + call AllocAry(dx_op, p%Vars%Nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return end if - call MD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) ; if(Failed()) return - do i=1, p%Jac_nx - dx_op(i) = dx%states(p%dxIdx_map2_xStateIdx(i)) ! x for lin is different order, so use mapping - end do - END IF - IF ( PRESENT( xd_op ) ) THEN - ! pass - END IF - IF ( PRESENT( z_op ) ) THEN - ! pass - END IF - call CleanUp() + call MD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if(Failed()) return + call MD_PackContStateOP(p, m%dxdt_jac, dx_op) + end if + + ! Discrete states + if (present(xd_op)) then + end if + + ! Constraint states + if (present(z_op)) then + end if + contains logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_GetOP') + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() end function Failed - - subroutine CleanUp() - call MD_DestroyContState(dx, ErrStat2, ErrMsg2); - end subroutine END SUBROUTINE MD_GetOP - - -!==================================================================================================== -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutines calculating dXdx etc (MD_Compute_dX) -SUBROUTINE MD_Init_Jacobian(Init, p, u, y, m, InitOut, ErrStat, ErrMsg) - TYPE(MD_InitInputType) , INTENT(IN ) :: Init !< Init - TYPE(MD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(MD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(MD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(MD_MiscVarType) , INTENT(INOUT) :: m !< misc variables <<<<<<<< - TYPE(MD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Init_Jacobian' -! real(ReKi) :: dx, dy, dz, maxDim - - INTEGER(IntKi) :: l, I - real(ReKi) :: dl_slack ! how much a given line segment is stretched [m] - real(ReKi) :: dl_slack_min ! minimum change in a node position for the least-strained segment in the simulation to go slack [m] - - - ! local variables: - ErrStat = ErrID_None - ErrMsg = "" - - !! --- System dimension - !dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) - !dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) - !dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) - !maxDim = max(dx, dy, dz) - - - ! Figure out appropriate transverse perturbation size to avoid slack segments - dl_slack_min = 0.1_ReKi ! start at 0.1 m - - do l = 1,p%nLines - do I = 1, m%LineList(l)%N - dl_slack = m%LineList(l)%lstr(I) - m%LineList(l)%l(I) - - ! store the smallest positive length margin to a segment going slack - if (( dl_slack > 0.0_ReKi) .and. (dl_slack < dl_slack_min)) then - dl_slack_min = dl_slack - end if - end do +subroutine MD_PackContStateOP(p, x, op) + type(MD_ParameterType), intent(in) :: p + type(MD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: op(:) + integer(IntKi) :: i, j, k, n, ind + do i = 1, size(p%Vars%x) + associate(iUsr => p%Vars%x(i)%iUsr) + call MV_Pack(p%Vars%x, i, x%states(iUsr(1):iUsr(2)), op) + end associate end do - - dl_slack_min = 0.5*dl_slack_min ! apply 0.5 safety factor - - !TODO: consider attachment radii to also produce a rotational perturbation size from the above - - - ! --- System dimension - call Init_Jacobian_y(); if (Failed()) return - call Init_Jacobian_x(); if (Failed()) return - call Init_Jacobian_u(); if (Failed()) return - -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Init_Jacobian') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. - SUBROUTINE Init_Jacobian_y() - INTEGER(IntKi) :: index_next, i - - ! Number of outputs - p%Jac_ny = y%CoupledLoads(1)%nNodes * 6 & ! 3 forces + 3 moments at each node (moments may be zero) - + p%NumOuts ! WriteOutput values - ! Storage info for each output (names, rotframe) - call AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - ! Names - index_next = 1 - call PackLoadMesh_Names( y%CoupledLoads(1), 'LinNames_y', InitOut%LinNames_y, index_next) ! <<< should a specific name be provided here? - do i=1,p%NumOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) +end subroutine + +subroutine MD_UnpackContStateOP(p, op, x) + type(MD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(MD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i, j, k, n, ind + do i = 1, size(p%Vars%x) + associate(iUsr => p%Vars%x(i)%iUsr) + call MV_Unpack(p%Vars%x, i, op, x%states(iUsr(1):iUsr(2))) + end associate + end do +end subroutine + +subroutine MD_PackDiscStateOP(p, xd, op) + type(MD_ParameterType), intent(in) :: p + type(MD_DiscreteStateType), intent(in) :: xd + real(R8Ki), intent(out) :: op(:) + integer(IntKi) :: i, j, k +end subroutine + +subroutine MD_UnpackDiscStateOP(p, op, xd) + type(MD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(MD_DiscreteStateType), intent(inout) :: xd + integer(IntKi) :: i, j, k +end subroutine + +subroutine MD_PackConstrStateOP(p, z, op) + type(MD_ParameterType), intent(in) :: p + type(MD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(out) :: op(:) + integer(IntKi) :: i, k, ind +end subroutine + +subroutine MD_UnpackConstrStateOP(p, op, z) + type(MD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(MD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i, k, ind +end subroutine + +subroutine MD_PackInputOP(p, u, op) + type(MD_ParameterType), intent(in) :: p + type(MD_InputType), intent(in) :: u + real(R8Ki), intent(out) :: op(:) + integer(IntKi) :: i + call MV_Pack(p%Vars%u, p%iVarCoupledKinematics, u%CoupledKinematics(1), op) + if (p%iVarDeltaL > 0) then + do i = p%iVarDeltaL, size(p%Vars%u), 2 + call MV_Pack(p%Vars%u, i, u%DeltaL(p%Vars%u(i)%iUsr(1)), op) + call MV_Pack(p%Vars%u, i + 1, u%DeltaLdot(p%Vars%u(i+1)%iUsr(1)), op) end do - - InitOut%RotFrame_y(:) = .false. - END SUBROUTINE Init_Jacobian_y - - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. - SUBROUTINE Init_Jacobian_x() - INTEGER(IntKi) :: idx ! index into the LinNames_x array - INTEGER(IntKi) :: i - INTEGER(IntKi) :: l - INTEGER(IntKi) :: N - - - p%Jac_nx = m%Nx ! size of (continuous) state vector (includes the first derivatives) - - ! allocate space for the row/column names and for perturbation sizes - CALL AllocAry(InitOut%LinNames_x , p%Jac_nx, 'LinNames_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%RotFrame_x , p%Jac_nx, 'RotFrame_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%DerivOrder_x , p%Jac_nx, 'DerivOrder_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(p%dx , p%Jac_nx, 'p%dx' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(p%dxIdx_map2_xStateIdx, p%Jac_nx, 'p%dxIdx_map2_xStateIdx', ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - - p%dxIdx_map2_xStateIdx = 0_IntKi ! all values should be overwritten by logic below - - ! set linearization output names and default perturbations, p%dx: - ! NOTE: the order is different than the order of the internal states. This is to - ! match what the OpenFAST framework is expecting: all positions first, then all - ! derviatives of positions (velocity terms) second. This adds slight complexity - ! here, but considerably simplifies post processing of the full OpenFAST results - ! for linearization. - ! The p%dxIdx_map2_xStateIdx array holds the index for the x%states array - ! corresponding to the current jacobian index. - - !----------------- - ! position states - !----------------- - idx = 0 - ! Free bodies - DO l = 1,p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) - if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Coupled pinned body - p%dx(idx+4:idx+6) = 0.02 ! body rotation [rad] - ! corresponds to state indices: (m%BodyStateIs1(l)+6:m%BodyStateIs1(l)+8) - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+3 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+4 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+5 ! x%state index for rot_z - idx = idx + 3 - else ! free body - p%dx(idx+1:idx+3) = dl_slack_min ! body displacement [m] - p%dx(idx+4:idx+6) = 0.02 ! body rotation [rad] - ! corresponds to state indices: (m%BodyStateIs1(l)+6:m%BodyStateIs1(l)+11) - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Pz, m' - InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+6 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+7 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+8 ! x%state index for Pz - p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+9 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+10 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+11 ! x%state index for rot_z - idx = idx + 6 - endif - END DO - - ! Rods - DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) - if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! pinned rod - p%dx(idx+1:idx+3) = 0.02 ! rod rotation [rad] - ! corresponds to state indices: (m%RodStateIs1(l)+3:m%RodStateIs1(l)+5) - InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+3 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+4 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+5 ! x%state index for rot_z - idx = idx + 3 - else ! free rod - p%dx(idx+1:idx+3) = dl_slack_min ! rod displacement [m] - p%dx(idx+4:idx+6) = 0.02 ! rod rotation [rad] - ! corresponds to state indices: (m%RodStateIs1(l)+6:m%RodStateIs1(l)+11) - InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Pz, m' - InitOut%LinNames_x(idx+4) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+5) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+6) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+6 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+7 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+8 ! x%state index for Pz - p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+9 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+10 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+11 ! x%state index for rot_z - idx = idx + 6 - end if - END DO - - ! Free Points - DO l = 1,p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) - ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) - p%dx(idx+1:idx+3) = dl_slack_min ! point displacement [m] - InitOut%LinNames_x(idx+1) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Pz, m' - p%dxIdx_map2_xStateIdx(idx+1) = m%PointStateIs1(l)+3 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%PointStateIs1(l)+4 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%PointStateIs1(l)+5 ! x%state index for Pz - idx = idx + 3 - END DO - - ! Lines - DO l = 1,p%nLines ! Line m%LineList(l) - ! corresponds to state indices: (m%LineStateIs1(l)+3*N-3:m%LineStateIs1(l)+6*N-7) -- NOTE: end nodes not included - N = m%LineList(l)%N ! number of segments in the line - DO i = 0,N-2 - p%dx(idx+1:idx+3) = dl_slack_min ! line internal node displacement [m] - InitOut%LinNames_x(idx+1) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Pz, m' - p%dxIdx_map2_xStateIdx(idx+1) = m%LineStateIs1(l)+3*N+3*i-3 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%LineStateIs1(l)+3*N+3*i-2 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%LineStateIs1(l)+3*N+3*i-1 ! x%state index for Pz - idx = idx + 3 - END DO - END DO - - !----------------- - ! velocity states - !----------------- - ! Free bodies - DO l = 1,p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) - if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Coupled pinned body - ! corresponds to state indices: (m%BodyStateIs1(l):m%BodyStateIs1(l)+5) - p%dx(idx+1:idx+3) = 0.1 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+0 ! x%state index for omega_x - p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+1 ! x%state index for omega_y - p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+2 ! x%state index for omega_z - idx = idx + 3 - else !Free body - ! corresponds to state indices: (m%BodyStateIs1(l):m%BodyStateIs1(l)+5) - p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] - p%dx(idx+4:idx+6) = 0.1 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vz, m/s' - InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+0 ! x%state index for Rx - p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+1 ! x%state index for Ry - p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+2 ! x%state index for Rz - p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+3 ! x%state index for omega_x - p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+4 ! x%state index for omega_y - p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+5 ! x%state index for omega_z - idx = idx + 6 - endif - END DO - - ! Rods - DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) - if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! pinned rod - ! corresponds to state indices: (m%RodStateIs1(l):m%RodStateIs1(l)+2) - p%dx(idx+1:idx+3) = 0.1 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+0 ! x%state index for Vx - p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+1 ! x%state index for Vy - p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+2 ! x%state index for Vz - idx = idx + 3 - else ! free rod - ! corresponds to state indices: (m%RodStateIs1(l):m%RodStateIs1(l)+5) - p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] - p%dx(idx+4:idx+6) = 0.02 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vz, m/s' - InitOut%LinNames_x(idx+4) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+5) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+6) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+0 ! x%state index for Vx - p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+1 ! x%state index for Vy - p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+2 ! x%state index for Vz - p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+3 ! x%state index for omega_x - p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+4 ! x%state index for omega_y - p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+5 ! x%state index for omega_z - idx = idx + 6 - end if - END DO - - ! Free Points - DO l = 1,p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) - ! corresponds to state indices: (m%PointStateIs1(l):m%PointStateIs1(l)+2) - p%dx(idx+1:idx+3) = 0.1 ! point translational velocity [m/s] - InitOut%LinNames_x(idx+1) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Vz, m/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%PointStateIs1(l)+0 ! x%state index for Vx - p%dxIdx_map2_xStateIdx(idx+2) = m%PointStateIs1(l)+1 ! x%state index for Vy - p%dxIdx_map2_xStateIdx(idx+3) = m%PointStateIs1(l)+2 ! x%state index for Vz - idx = idx + 3 - END DO - - ! Lines - DO l = 1,p%nLines ! Line m%LineList(l) - ! corresponds to state indices: (m%LineStateIs1(l):m%LineStateIs1(l)+3*N-4) -- NOTE: end nodes not included - N = m%LineList(l)%N ! number of segments in the line - DO i = 0,N-2 - p%dx(idx+1:idx+3) = 0.1 ! line internal node translational velocity [m/s] - InitOut%LinNames_x(idx+1) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vz, m/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%LineStateIs1(l)+3*i+0 ! x%state index for Vx - p%dxIdx_map2_xStateIdx(idx+2) = m%LineStateIs1(l)+3*i+1 ! x%state index for Vy - p%dxIdx_map2_xStateIdx(idx+3) = m%LineStateIs1(l)+3*i+2 ! x%state index for Vz - idx = idx + 3 - END DO - END DO - - ! If a summary file is ever made... - ! !Formatting may be needed to make it pretty - ! if(UnSum > 0) then - ! write(UnSum,*) ' Lin_Jac_x idx x%state idx' - ! do i=1,p%Jac_nx - ! write(UnSum,*) InitOut%LinNames_x(i),' ',i,' ',p%dxIdx_map2_xStateIdx(i) - ! enddo - ! endif - - InitOut%RotFrame_x = .false. - InitOut%DerivOrder_x = 2 - END SUBROUTINE Init_Jacobian_x - - SUBROUTINE Init_Jacobian_u() - INTEGER(IntKi) :: i, j, idx, nu, i_meshField - character(10) :: LinStr ! for noting which line a DeltaL control is attached to - logical :: LinCtrl ! Is the current DeltaL channel associated with a line? - ! Number of inputs - i = 0 - if (allocated(u%DeltaL)) i=size(u%DeltaL) - nu = u%CoupledKinematics(1)%nNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities + 6 accelerations at each node <<<<<<< - + i*2 ! a deltaL and rate of change for each active tension control channel - - ! --- Info of linearized inputs (Names, RotFrame, IsLoad) - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%IsLoad_u , nu, 'IsLoad_u' , ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - - InitOut%IsLoad_u = .false. ! None of MoorDyn's inputs are loads - InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame - - idx = 1 - call PackMotionMesh_Names(u%CoupledKinematics(1), 'CoupledKinematics', InitOut%LinNames_u, idx) ! all 6 motion fields - - ! --- Jac_u_indx: matrix to store index to help us figure out what the ith value of the u vector really means - ! (see perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - p%Jac_u_indx = 0 ! initialize to zero - idx = 1 - !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationDisp = 1; - !Module/Mesh/Field: u%CoupledKinematics(1)%Orientation = 2; - !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationVel = 3; - !Module/Mesh/Field: u%CoupledKinematics(1)%RotationVel = 4; - !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationAcc = 5; - !Module/Mesh/Field: u%CoupledKinematics(1)%RotationAcc = 6; - do i_meshField = 1,6 - do i=1,u%CoupledKinematics(1)%nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField ! mesh field type (indicated by 1-6) - p%Jac_u_indx(idx,2) = j ! x, y, or z - p%Jac_u_indx(idx,3) = i ! node - idx = idx + 1 - end do !j - end do !i + end if +end subroutine + +subroutine MD_UnpackInputOP(p, op, u) + type(MD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(MD_InputType), intent(inout) :: u + integer(IntKi) :: i + call MV_Unpack(p%Vars%u, p%iVarCoupledKinematics, op, u%CoupledKinematics(1)) + if (p%iVarDeltaL > 0) then + do i = p%iVarDeltaL, size(p%Vars%u), 2 + call MV_Unpack(p%Vars%u, i, op, u%DeltaL(p%Vars%u(i+1)%iUsr(1))) + call MV_Unpack(p%Vars%u, i + 1, op, u%DeltaLdot(p%Vars%u(i+1)%iUsr(1))) end do - ! now do the active tensioning commands if there are any - if (allocated(u%DeltaL)) then - do i=1,size(u%DeltaL) ! Signals may be passed in without being requested for control - ! Figure out if this DeltaL control channel is associated with a line or multiple or none and label - LinCtrl = .FALSE. - LinStr = '(lines: ' - do J=1,p%NLines - if (m%LineList(J)%CtrlChan == i) then - LinCtrl = .TRUE. - LinStr = LinStr//trim(num2lstr(i))//' ' - endif - enddo - if ( LinCtrl) LinStr = LinStr//' )' - if (.not. LinCtrl) LinStr = '(lines: none)' - - p%Jac_u_indx(idx,1) = 10 ! 10-11 mean active tension changes (10: deltaL; 11: deltaLdot) - p%Jac_u_indx(idx,2) = 0 ! not used - p%Jac_u_indx(idx,3) = i ! indicates DeltaL entry number - InitOut%LinNames_u(idx) = 'CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr) - idx = idx + 1 - - p%Jac_u_indx(idx,1) = 11 - p%Jac_u_indx(idx,2) = 0 - p%Jac_u_indx(idx,3) = i - InitOut%LinNames_u(idx) = 'CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr) - idx = idx + 1 - end do - endif - - ! --- Default perturbations, p%du: - call allocAry( p%du, 11, 'p%du', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - p%du( 1) = dl_slack_min ! u%CoupledKinematics(1)%TranslationDisp = 1; - p%du( 2) = 0.1_ReKi ! u%CoupledKinematics(1)%Orientation = 2; - p%du( 3) = 0.1_ReKi ! u%CoupledKinematics(1)%TranslationVel = 3; - p%du( 4) = 0.1_ReKi ! u%CoupledKinematics(1)%RotationVel = 4; - p%du( 5) = 0.1_ReKi ! u%CoupledKinematics(1)%TranslationAcc = 5; - p%du( 6) = 0.1_ReKi ! u%CoupledKinematics(1)%RotationAcc = 6; - p%du(10) = dl_slack_min ! deltaL [m] - p%du(11) = 0.2_ReKi ! deltaLdot [m/s] - END SUBROUTINE Init_Jacobian_u - -END SUBROUTINE MD_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine MD_init_jacobian is consistant with this routine! -SUBROUTINE MD_Perturb_u( p, n, perturb_sign, u, du ) - TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(MD_InputType) , INTENT(INOUT) :: u !< perturbed MD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - du = p%du( p%Jac_u_indx(n,1) ) - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) - u%CoupledKinematics(1)%TranslationDisp( fieldIndx,node) = u%CoupledKinematics(1)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) - CALL PerturbOrientationMatrix( u%CoupledKinematics(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 3) - u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) = u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) - u%CoupledKinematics(1)%RotationVel(fieldIndx,node) = u%CoupledKinematics(1)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE ( 5) - u%CoupledKinematics(1)%TranslationAcc( fieldIndx,node) = u%CoupledKinematics(1)%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) - u%CoupledKinematics(1)%RotationAcc(fieldIndx,node) = u%CoupledKinematics(1)%RotationAcc(fieldIndx,node) + du * perturb_sign - CASE (10) - u%deltaL(node) = u%deltaL(node) + du * perturb_sign - CASE (11) - u%deltaLdot(node) = u%deltaLdot(node) + du * perturb_sign - END SELECT -END SUBROUTINE MD_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine MD_init_jacobian is consistant with this routine! -SUBROUTINE MD_Compute_dY(p, y_p, y_m, delta, dY) - TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(MD_OutputType) , INTENT(IN ) :: y_p !< MD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(MD_OutputType) , INTENT(IN ) :: y_m !< MD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - ! local variables: - INTEGER(IntKi) :: i ! loop over outputs - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - indx_first = 1 - call PackLoadMesh_dY( y_p%CoupledLoads(1), y_m%CoupledLoads(1), dY, indx_first) - !call PackMotionMesh_dY(y_p%Y2Mesh, y_m%Y2Mesh, dY, indx_first) ! all 6 motion fields - do i=1,p%NumOuts - dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) - end do - dY = dY / (2.0_R8Ki*delta) -END SUBROUTINE MD_Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine MD_init_jacobian is consistant with this routine! -SUBROUTINE MD_Perturb_x( p, i, perturb_sign, x, dx ) - TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: i !< state array index number - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: x !< perturbed MD states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - dx=p%dx(i) - x%states(i) = x%states(i) + dx * perturb_sign -END SUBROUTINE MD_Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine MD_init_jacobian is consistant with this routine! -SUBROUTINE MD_Compute_dX(p, x_p, x_m, delta, dX) - TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(MD_ContinuousStateType), INTENT(IN ) :: x_p !< NULL() !< Module Variables [-] END TYPE MD_InitOutputType ! ======================= ! ========= MD_ContinuousStateType ======= @@ -349,46 +350,14 @@ MODULE MoorDyn_Types REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have other states [-] END TYPE MD_OtherStateType ! ======================= -! ========= MD_MiscVarType ======= - TYPE, PUBLIC :: MD_MiscVarType - TYPE(MD_LineProp) , DIMENSION(:), ALLOCATABLE :: LineTypeList !< array of properties for each line type [-] - TYPE(MD_RodProp) , DIMENSION(:), ALLOCATABLE :: RodTypeList !< array of properties for each rod type [-] - TYPE(MD_Body) :: GroundBody !< the single ground body which is the parent of all stationary points [-] - TYPE(MD_Body) , DIMENSION(:), ALLOCATABLE :: BodyList !< array of body objects [-] - TYPE(MD_Rod) , DIMENSION(:), ALLOCATABLE :: RodList !< array of rod objects [-] - TYPE(MD_Point) , DIMENSION(:), ALLOCATABLE :: PointList !< array of point objects [-] - TYPE(MD_Line) , DIMENSION(:), ALLOCATABLE :: LineList !< array of line objects [-] - TYPE(MD_Fail) , DIMENSION(:), ALLOCATABLE :: FailList !< array of line objects [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreePointIs !< array of free point indices in PointList vector [] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldPointIs !< array of coupled/fairlead point indices in PointList vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeRodIs !< array of free rod indices in RodList vector [] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldRodIs !< array of coupled/fairlead rod indices in RodList vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeBodyIs !< array of free body indices in BodyList vector [] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldBodyIs !< array of coupled body indices in BodyList vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIs1 !< starting index of each line's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIsN !< ending index of each line's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PointStateIs1 !< starting index of each point's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PointStateIsN !< ending index of each point's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIs1 !< starting index of each rod's states in state vector [] - 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 = 0_IntKi !< number of states and size of state vector [] - INTEGER(IntKi) :: WaveTi = 0_IntKi !< current interpolation index for wave time series data [] - TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] - TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] - REAL(DbKi) , DIMENSION(1:6) :: zeros6 = 0.0_R8Ki !< array of zeros for convenience [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Time of last writing to MD output files [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< initial position of platform for an individual (non-farm) MD instance [-] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: BathymetryGrid !< matrix describing the bathymetry in a grid of x's and y's [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_npoints !< number of grid points to describe the bathymetry grid [-] - END TYPE MD_MiscVarType -! ======================= ! ========= MD_ParameterType ======= TYPE, PUBLIC :: MD_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [] + INTEGER(IntKi) :: iVarWriteOutput = 0 !< Variable index of WriteOutput [] + INTEGER(IntKi) :: iVarCoupledLoads = 0 !< Variable index of CoupledLoads Mesh [] + INTEGER(IntKi) :: iVarCoupledKinematics = 0 !< Variable index of CoupledKinematics Mesh [] + INTEGER(IntKi) :: iVarDeltaL = 0 !< Variable index of DeltaL [] + INTEGER(IntKi) :: iVarDeltaLdot = 0 !< Variable index of DeltaLdot [] INTEGER(IntKi) :: nLineTypes = 0 !< number of line types [] INTEGER(IntKi) :: nRodTypes = 0 !< number of rod types [] INTEGER(IntKi) :: nPoints = 0 !< number of Point objects [] @@ -480,6 +449,49 @@ MODULE MoorDyn_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: VisAnchsMesh !< Point mesh for visualizing mooring anchors [-] END TYPE MD_OutputType ! ======================= +! ========= MD_MiscVarType ======= + TYPE, PUBLIC :: MD_MiscVarType + TYPE(ModJacType) :: Jac !< Jacobian values corresponding to module variables [-] + TYPE(MD_ContinuousStateType) :: x_perturb !< States for calculating Jacobians [-] + TYPE(MD_ContinuousStateType) :: dxdt_jac !< States for calculating Jacobians [-] + TYPE(MD_InputType) :: u_perturb !< Inputs for calculating Jacobians [-] + TYPE(MD_OutputType) :: y_jac !< Outputs for calculating Jacobians [-] + TYPE(MD_LineProp) , DIMENSION(:), ALLOCATABLE :: LineTypeList !< array of properties for each line type [-] + TYPE(MD_RodProp) , DIMENSION(:), ALLOCATABLE :: RodTypeList !< array of properties for each rod type [-] + TYPE(MD_Body) :: GroundBody !< the single ground body which is the parent of all stationary points [-] + TYPE(MD_Body) , DIMENSION(:), ALLOCATABLE :: BodyList !< array of body objects [-] + TYPE(MD_Rod) , DIMENSION(:), ALLOCATABLE :: RodList !< array of rod objects [-] + TYPE(MD_Point) , DIMENSION(:), ALLOCATABLE :: PointList !< array of point objects [-] + TYPE(MD_Line) , DIMENSION(:), ALLOCATABLE :: LineList !< array of line objects [-] + TYPE(MD_Fail) , DIMENSION(:), ALLOCATABLE :: FailList !< array of line objects [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreePointIs !< array of free point indices in PointList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldPointIs !< array of coupled/fairlead point indices in PointList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeRodIs !< array of free rod indices in RodList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldRodIs !< array of coupled/fairlead rod indices in RodList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeBodyIs !< array of free body indices in BodyList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldBodyIs !< array of coupled body indices in BodyList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIs1 !< starting index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIsN !< ending index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PointStateIs1 !< starting index of each point's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PointStateIsN !< ending index of each point's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIs1 !< starting index of each rod's states in state vector [] + 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 = 0_IntKi !< number of states and size of state vector [] + INTEGER(IntKi) :: WaveTi = 0_IntKi !< current interpolation index for wave time series data [] + TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] + TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] + REAL(DbKi) , DIMENSION(1:6) :: zeros6 = 0.0_R8Ki !< array of zeros for convenience [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Time of last writing to MD output files [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< initial position of platform for an individual (non-farm) MD instance [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: BathymetryGrid !< matrix describing the bathymetry in a grid of x's and y's [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_npoints !< number of grid points to describe the bathymetry grid [-] + END TYPE MD_MiscVarType +! ======================= CONTAINS subroutine MD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) @@ -2464,6 +2476,7 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -2510,12 +2523,14 @@ subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%DerivOrder_x)) then deallocate(InitOutputData%DerivOrder_x) end if + nullify(InitOutputData%Vars) end subroutine subroutine MD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(MD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%writeOutputHdr) call RegPackAlloc(RF, InData%writeOutputUnt) @@ -2529,6 +2544,13 @@ subroutine MD_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%IsLoad_u) call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2539,6 +2561,8 @@ subroutine MD_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -2552,6 +2576,24 @@ subroutine MD_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -2725,1833 +2767,1929 @@ subroutine MD_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(MD_MiscVarType), intent(in) :: SrcMiscData - type(MD_MiscVarType), intent(inout) :: DstMiscData +subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(MD_ParameterType), intent(in) :: SrcParamData + type(MD_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_CopyMisc' + character(*), parameter :: RoutineName = 'MD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%LineTypeList)) then - LB(1:1) = lbound(SrcMiscData%LineTypeList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineTypeList, kind=B8Ki) - if (.not. allocated(DstMiscData%LineTypeList)) then - allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyLineProp(SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end if - if (allocated(SrcMiscData%RodTypeList)) then - LB(1:1) = lbound(SrcMiscData%RodTypeList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodTypeList, kind=B8Ki) - if (.not. allocated(DstMiscData%RodTypeList)) then - allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput + DstParamData%iVarCoupledLoads = SrcParamData%iVarCoupledLoads + DstParamData%iVarCoupledKinematics = SrcParamData%iVarCoupledKinematics + DstParamData%iVarDeltaL = SrcParamData%iVarDeltaL + DstParamData%iVarDeltaLdot = SrcParamData%iVarDeltaLdot + DstParamData%nLineTypes = SrcParamData%nLineTypes + DstParamData%nRodTypes = SrcParamData%nRodTypes + DstParamData%nPoints = SrcParamData%nPoints + DstParamData%nPointsExtra = SrcParamData%nPointsExtra + DstParamData%nBodies = SrcParamData%nBodies + DstParamData%nRods = SrcParamData%nRods + DstParamData%nLines = SrcParamData%nLines + DstParamData%nCtrlChans = SrcParamData%nCtrlChans + DstParamData%nFails = SrcParamData%nFails + DstParamData%nFreeBodies = SrcParamData%nFreeBodies + DstParamData%nFreeRods = SrcParamData%nFreeRods + DstParamData%nFreePoints = SrcParamData%nFreePoints + if (allocated(SrcParamData%nCpldBodies)) then + LB(1:1) = lbound(SrcParamData%nCpldBodies, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%nCpldBodies, kind=B8Ki) + if (.not. allocated(DstParamData%nCpldBodies)) then + allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyRodProp(SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%nCpldBodies = SrcParamData%nCpldBodies end if - call MD_CopyBody(SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%BodyList)) then - LB(1:1) = lbound(SrcMiscData%BodyList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyList, kind=B8Ki) - if (.not. allocated(DstMiscData%BodyList)) then - allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%nCpldRods)) then + LB(1:1) = lbound(SrcParamData%nCpldRods, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%nCpldRods, kind=B8Ki) + if (.not. allocated(DstParamData%nCpldRods)) then + allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyBody(SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%nCpldRods = SrcParamData%nCpldRods end if - if (allocated(SrcMiscData%RodList)) then - LB(1:1) = lbound(SrcMiscData%RodList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodList, kind=B8Ki) - if (.not. allocated(DstMiscData%RodList)) then - allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%nCpldPoints)) then + LB(1:1) = lbound(SrcParamData%nCpldPoints, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%nCpldPoints, kind=B8Ki) + if (.not. allocated(DstParamData%nCpldPoints)) then + allocate(DstParamData%nCpldPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldPoints.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyRod(SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%nCpldPoints = SrcParamData%nCpldPoints end if - if (allocated(SrcMiscData%PointList)) then - LB(1:1) = lbound(SrcMiscData%PointList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointList, kind=B8Ki) - if (.not. allocated(DstMiscData%PointList)) then - allocate(DstMiscData%PointList(LB(1):UB(1)), stat=ErrStat2) + DstParamData%NConns = SrcParamData%NConns + DstParamData%NAnchs = SrcParamData%NAnchs + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%g = SrcParamData%g + DstParamData%rhoW = SrcParamData%rhoW + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%kBot = SrcParamData%kBot + DstParamData%cBot = SrcParamData%cBot + DstParamData%dtM0 = SrcParamData%dtM0 + DstParamData%dtCoupling = SrcParamData%dtCoupling + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%dtOut = SrcParamData%dtOut + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyPoint(SrcMiscData%PointList(i1), DstMiscData%PointList(i1), CtrlCode, ErrStat2, ErrMsg2) + call MD_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%LineList)) then - LB(1:1) = lbound(SrcMiscData%LineList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineList, kind=B8Ki) - if (.not. allocated(DstMiscData%LineList)) then - allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) + DstParamData%Delim = SrcParamData%Delim + DstParamData%MDUnOut = SrcParamData%MDUnOut + DstParamData%PriPath = SrcParamData%PriPath + DstParamData%writeLog = SrcParamData%writeLog + DstParamData%UnLog = SrcParamData%UnLog + DstParamData%WaveKin = SrcParamData%WaveKin + DstParamData%Current = SrcParamData%Current + DstParamData%nTurbines = SrcParamData%nTurbines + if (allocated(SrcParamData%TurbineRefPos)) then + LB(1:2) = lbound(SrcParamData%TurbineRefPos, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TurbineRefPos, kind=B8Ki) + if (.not. allocated(DstParamData%TurbineRefPos)) then + allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyLine(SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos end if - if (allocated(SrcMiscData%FailList)) then - LB(1:1) = lbound(SrcMiscData%FailList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FailList, kind=B8Ki) - if (.not. allocated(DstMiscData%FailList)) then - allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) + DstParamData%mu_kT = SrcParamData%mu_kT + DstParamData%mu_kA = SrcParamData%mu_kA + DstParamData%mc = SrcParamData%mc + DstParamData%cv = SrcParamData%cv + DstParamData%inertialF = SrcParamData%inertialF + DstParamData%nxWave = SrcParamData%nxWave + DstParamData%nyWave = SrcParamData%nyWave + DstParamData%nzWave = SrcParamData%nzWave + DstParamData%ntWave = SrcParamData%ntWave + if (allocated(SrcParamData%pxWave)) then + LB(1:1) = lbound(SrcParamData%pxWave, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%pxWave, kind=B8Ki) + if (.not. allocated(DstParamData%pxWave)) then + allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyFail(SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%pxWave = SrcParamData%pxWave end if - if (allocated(SrcMiscData%FreePointIs)) then - LB(1:1) = lbound(SrcMiscData%FreePointIs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreePointIs, kind=B8Ki) - if (.not. allocated(DstMiscData%FreePointIs)) then - allocate(DstMiscData%FreePointIs(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%pyWave)) then + LB(1:1) = lbound(SrcParamData%pyWave, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%pyWave, kind=B8Ki) + if (.not. allocated(DstParamData%pyWave)) then + allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreePointIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FreePointIs = SrcMiscData%FreePointIs + DstParamData%pyWave = SrcParamData%pyWave end if - if (allocated(SrcMiscData%CpldPointIs)) then - LB(1:2) = lbound(SrcMiscData%CpldPointIs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldPointIs, kind=B8Ki) - if (.not. allocated(DstMiscData%CpldPointIs)) then - allocate(DstMiscData%CpldPointIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%pzWave)) then + LB(1:1) = lbound(SrcParamData%pzWave, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%pzWave, kind=B8Ki) + if (.not. allocated(DstParamData%pzWave)) then + allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldPointIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs + DstParamData%pzWave = SrcParamData%pzWave end if - if (allocated(SrcMiscData%FreeRodIs)) then - LB(1:1) = lbound(SrcMiscData%FreeRodIs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreeRodIs, kind=B8Ki) - if (.not. allocated(DstMiscData%FreeRodIs)) then - allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) + DstParamData%dtWave = SrcParamData%dtWave + if (allocated(SrcParamData%uxWave)) then + LB(1:4) = lbound(SrcParamData%uxWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%uxWave, kind=B8Ki) + if (.not. allocated(DstParamData%uxWave)) then + allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs + DstParamData%uxWave = SrcParamData%uxWave end if - if (allocated(SrcMiscData%CpldRodIs)) then - LB(1:2) = lbound(SrcMiscData%CpldRodIs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldRodIs, kind=B8Ki) - if (.not. allocated(DstMiscData%CpldRodIs)) then - allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%uyWave)) then + LB(1:4) = lbound(SrcParamData%uyWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%uyWave, kind=B8Ki) + if (.not. allocated(DstParamData%uyWave)) then + allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs + DstParamData%uyWave = SrcParamData%uyWave end if - if (allocated(SrcMiscData%FreeBodyIs)) then - LB(1:1) = lbound(SrcMiscData%FreeBodyIs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreeBodyIs, kind=B8Ki) - if (.not. allocated(DstMiscData%FreeBodyIs)) then - allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%uzWave)) then + LB(1:4) = lbound(SrcParamData%uzWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%uzWave, kind=B8Ki) + if (.not. allocated(DstParamData%uzWave)) then + allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs + DstParamData%uzWave = SrcParamData%uzWave end if - if (allocated(SrcMiscData%CpldBodyIs)) then - LB(1:2) = lbound(SrcMiscData%CpldBodyIs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldBodyIs, kind=B8Ki) - if (.not. allocated(DstMiscData%CpldBodyIs)) then - allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%axWave)) then + LB(1:4) = lbound(SrcParamData%axWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%axWave, kind=B8Ki) + if (.not. allocated(DstParamData%axWave)) then + allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs + DstParamData%axWave = SrcParamData%axWave end if - if (allocated(SrcMiscData%LineStateIs1)) then - LB(1:1) = lbound(SrcMiscData%LineStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineStateIs1, kind=B8Ki) - if (.not. allocated(DstMiscData%LineStateIs1)) then - allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%ayWave)) then + LB(1:4) = lbound(SrcParamData%ayWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%ayWave, kind=B8Ki) + if (.not. allocated(DstParamData%ayWave)) then + allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 + DstParamData%ayWave = SrcParamData%ayWave end if - if (allocated(SrcMiscData%LineStateIsN)) then - LB(1:1) = lbound(SrcMiscData%LineStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineStateIsN, kind=B8Ki) - if (.not. allocated(DstMiscData%LineStateIsN)) then - allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%azWave)) then + LB(1:4) = lbound(SrcParamData%azWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%azWave, kind=B8Ki) + if (.not. allocated(DstParamData%azWave)) then + allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN + DstParamData%azWave = SrcParamData%azWave end if - if (allocated(SrcMiscData%PointStateIs1)) then - LB(1:1) = lbound(SrcMiscData%PointStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointStateIs1, kind=B8Ki) - if (.not. allocated(DstMiscData%PointStateIs1)) then - allocate(DstMiscData%PointStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%PDyn)) then + LB(1:4) = lbound(SrcParamData%PDyn, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%PDyn, kind=B8Ki) + if (.not. allocated(DstParamData%PDyn)) then + allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 + DstParamData%PDyn = SrcParamData%PDyn end if - if (allocated(SrcMiscData%PointStateIsN)) then - LB(1:1) = lbound(SrcMiscData%PointStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointStateIsN, kind=B8Ki) - if (.not. allocated(DstMiscData%PointStateIsN)) then - allocate(DstMiscData%PointStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%zeta)) then + LB(1:3) = lbound(SrcParamData%zeta, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%zeta, kind=B8Ki) + if (.not. allocated(DstParamData%zeta)) then + allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN + DstParamData%zeta = SrcParamData%zeta end if - if (allocated(SrcMiscData%RodStateIs1)) then - LB(1:1) = lbound(SrcMiscData%RodStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodStateIs1, kind=B8Ki) - if (.not. allocated(DstMiscData%RodStateIs1)) then - allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) + DstParamData%nzCurrent = SrcParamData%nzCurrent + if (allocated(SrcParamData%pzCurrent)) then + LB(1:1) = lbound(SrcParamData%pzCurrent, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%pzCurrent, kind=B8Ki) + if (.not. allocated(DstParamData%pzCurrent)) then + allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 + DstParamData%pzCurrent = SrcParamData%pzCurrent end if - if (allocated(SrcMiscData%RodStateIsN)) then - LB(1:1) = lbound(SrcMiscData%RodStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodStateIsN, kind=B8Ki) - if (.not. allocated(DstMiscData%RodStateIsN)) then - allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%uxCurrent)) then + LB(1:1) = lbound(SrcParamData%uxCurrent, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%uxCurrent, kind=B8Ki) + if (.not. allocated(DstParamData%uxCurrent)) then + allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN + DstParamData%uxCurrent = SrcParamData%uxCurrent end if - if (allocated(SrcMiscData%BodyStateIs1)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyStateIs1, kind=B8Ki) - if (.not. allocated(DstMiscData%BodyStateIs1)) then - allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%uyCurrent)) then + LB(1:1) = lbound(SrcParamData%uyCurrent, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%uyCurrent, kind=B8Ki) + if (.not. allocated(DstParamData%uyCurrent)) then + allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 + DstParamData%uyCurrent = SrcParamData%uyCurrent end if - if (allocated(SrcMiscData%BodyStateIsN)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyStateIsN, kind=B8Ki) - if (.not. allocated(DstMiscData%BodyStateIsN)) then - allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) + DstParamData%Nx0 = SrcParamData%Nx0 + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if - DstMiscData%Nx = SrcMiscData%Nx - DstMiscData%WaveTi = SrcMiscData%WaveTi - call MD_CopyContState(SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MD_CopyContState(SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstMiscData%zeros6 = SrcMiscData%zeros6 - if (allocated(SrcMiscData%MDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%MDWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%MDWrOutput, kind=B8Ki) - if (.not. allocated(DstMiscData%MDWrOutput)) then - allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput + DstParamData%du = SrcParamData%du end if - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%PtfmInit = SrcMiscData%PtfmInit - if (allocated(SrcMiscData%BathymetryGrid)) then - LB(1:2) = lbound(SrcMiscData%BathymetryGrid, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BathymetryGrid, kind=B8Ki) - if (.not. allocated(DstMiscData%BathymetryGrid)) then - allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid + DstParamData%dx = SrcParamData%dx end if - if (allocated(SrcMiscData%BathGrid_Xs)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Xs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_Xs, kind=B8Ki) - if (.not. allocated(DstMiscData%BathGrid_Xs)) then - allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then + LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) + if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then + allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs + DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx end if - if (allocated(SrcMiscData%BathGrid_Ys)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Ys, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_Ys, kind=B8Ki) - if (.not. allocated(DstMiscData%BathGrid_Ys)) then - allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys - end if - if (allocated(SrcMiscData%BathGrid_npoints)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_npoints, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_npoints, kind=B8Ki) - if (.not. allocated(DstMiscData%BathGrid_npoints)) then - allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) + DstParamData%VisMeshes = SrcParamData%VisMeshes + if (allocated(SrcParamData%VisRodsDiam)) then + LB(1:1) = lbound(SrcParamData%VisRodsDiam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%VisRodsDiam, kind=B8Ki) + if (.not. allocated(DstParamData%VisRodsDiam)) then + allocate(DstParamData%VisRodsDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VisRodsDiam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints + do i1 = LB(1), UB(1) + call MD_CopyVisDiam(SrcParamData%VisRodsDiam(i1), DstParamData%VisRodsDiam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if end subroutine -subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(MD_MiscVarType), intent(inout) :: MiscData +subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(MD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyMisc' + character(*), parameter :: RoutineName = 'MD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%LineTypeList)) then - LB(1:1) = lbound(MiscData%LineTypeList, kind=B8Ki) - UB(1:1) = ubound(MiscData%LineTypeList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%LineTypeList) - end if - if (allocated(MiscData%RodTypeList)) then - LB(1:1) = lbound(MiscData%RodTypeList, kind=B8Ki) - UB(1:1) = ubound(MiscData%RodTypeList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%RodTypeList) + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() end if - call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%BodyList)) then - LB(1:1) = lbound(MiscData%BodyList, kind=B8Ki) - UB(1:1) = ubound(MiscData%BodyList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%BodyList) + if (allocated(ParamData%nCpldBodies)) then + deallocate(ParamData%nCpldBodies) end if - if (allocated(MiscData%RodList)) then - LB(1:1) = lbound(MiscData%RodList, kind=B8Ki) - UB(1:1) = ubound(MiscData%RodList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%RodList) + if (allocated(ParamData%nCpldRods)) then + deallocate(ParamData%nCpldRods) end if - if (allocated(MiscData%PointList)) then - LB(1:1) = lbound(MiscData%PointList, kind=B8Ki) - UB(1:1) = ubound(MiscData%PointList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%PointList) + if (allocated(ParamData%nCpldPoints)) then + deallocate(ParamData%nCpldPoints) end if - if (allocated(MiscData%LineList)) then - LB(1:1) = lbound(MiscData%LineList, kind=B8Ki) - UB(1:1) = ubound(MiscData%LineList, kind=B8Ki) + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) + call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%LineList) + deallocate(ParamData%OutParam) end if - if (allocated(MiscData%FailList)) then - LB(1:1) = lbound(MiscData%FailList, kind=B8Ki) - UB(1:1) = ubound(MiscData%FailList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%FailList) + if (allocated(ParamData%TurbineRefPos)) then + deallocate(ParamData%TurbineRefPos) end if - if (allocated(MiscData%FreePointIs)) then - deallocate(MiscData%FreePointIs) + if (allocated(ParamData%pxWave)) then + deallocate(ParamData%pxWave) end if - if (allocated(MiscData%CpldPointIs)) then - deallocate(MiscData%CpldPointIs) + if (allocated(ParamData%pyWave)) then + deallocate(ParamData%pyWave) end if - if (allocated(MiscData%FreeRodIs)) then - deallocate(MiscData%FreeRodIs) + if (allocated(ParamData%pzWave)) then + deallocate(ParamData%pzWave) end if - if (allocated(MiscData%CpldRodIs)) then - deallocate(MiscData%CpldRodIs) + if (allocated(ParamData%uxWave)) then + deallocate(ParamData%uxWave) end if - if (allocated(MiscData%FreeBodyIs)) then - deallocate(MiscData%FreeBodyIs) + if (allocated(ParamData%uyWave)) then + deallocate(ParamData%uyWave) end if - if (allocated(MiscData%CpldBodyIs)) then - deallocate(MiscData%CpldBodyIs) + if (allocated(ParamData%uzWave)) then + deallocate(ParamData%uzWave) end if - if (allocated(MiscData%LineStateIs1)) then - deallocate(MiscData%LineStateIs1) + if (allocated(ParamData%axWave)) then + deallocate(ParamData%axWave) end if - if (allocated(MiscData%LineStateIsN)) then - deallocate(MiscData%LineStateIsN) + if (allocated(ParamData%ayWave)) then + deallocate(ParamData%ayWave) end if - if (allocated(MiscData%PointStateIs1)) then - deallocate(MiscData%PointStateIs1) + if (allocated(ParamData%azWave)) then + deallocate(ParamData%azWave) end if - if (allocated(MiscData%PointStateIsN)) then - deallocate(MiscData%PointStateIsN) + if (allocated(ParamData%PDyn)) then + deallocate(ParamData%PDyn) end if - if (allocated(MiscData%RodStateIs1)) then - deallocate(MiscData%RodStateIs1) + if (allocated(ParamData%zeta)) then + deallocate(ParamData%zeta) end if - if (allocated(MiscData%RodStateIsN)) then - deallocate(MiscData%RodStateIsN) + if (allocated(ParamData%pzCurrent)) then + deallocate(ParamData%pzCurrent) end if - if (allocated(MiscData%BodyStateIs1)) then - deallocate(MiscData%BodyStateIs1) + if (allocated(ParamData%uxCurrent)) then + deallocate(ParamData%uxCurrent) end if - if (allocated(MiscData%BodyStateIsN)) then - deallocate(MiscData%BodyStateIsN) + if (allocated(ParamData%uyCurrent)) then + deallocate(ParamData%uyCurrent) end if - call MD_DestroyContState(MiscData%xTemp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MD_DestroyContState(MiscData%xdTemp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%MDWrOutput)) then - deallocate(MiscData%MDWrOutput) + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) end if - if (allocated(MiscData%BathymetryGrid)) then - deallocate(MiscData%BathymetryGrid) + if (allocated(ParamData%du)) then + deallocate(ParamData%du) end if - if (allocated(MiscData%BathGrid_Xs)) then - deallocate(MiscData%BathGrid_Xs) + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) end if - if (allocated(MiscData%BathGrid_Ys)) then - deallocate(MiscData%BathGrid_Ys) + if (allocated(ParamData%dxIdx_map2_xStateIdx)) then + deallocate(ParamData%dxIdx_map2_xStateIdx) end if - if (allocated(MiscData%BathGrid_npoints)) then - deallocate(MiscData%BathGrid_npoints) + if (allocated(ParamData%VisRodsDiam)) then + LB(1:1) = lbound(ParamData%VisRodsDiam, kind=B8Ki) + UB(1:1) = ubound(ParamData%VisRodsDiam, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyVisDiam(ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%VisRodsDiam) end if end subroutine -subroutine MD_PackMisc(RF, Indata) +subroutine MD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF - type(MD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + type(MD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackParam' + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%LineTypeList)) - if (allocated(InData%LineTypeList)) then - call RegPackBounds(RF, 1, lbound(InData%LineTypeList, kind=B8Ki), ubound(InData%LineTypeList, kind=B8Ki)) - LB(1:1) = lbound(InData%LineTypeList, kind=B8Ki) - UB(1:1) = ubound(InData%LineTypeList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackLineProp(RF, InData%LineTypeList(i1)) - end do - end if - call RegPack(RF, allocated(InData%RodTypeList)) - if (allocated(InData%RodTypeList)) then - call RegPackBounds(RF, 1, lbound(InData%RodTypeList, kind=B8Ki), ubound(InData%RodTypeList, kind=B8Ki)) - LB(1:1) = lbound(InData%RodTypeList, kind=B8Ki) - UB(1:1) = ubound(InData%RodTypeList, kind=B8Ki) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarWriteOutput) + call RegPack(RF, InData%iVarCoupledLoads) + call RegPack(RF, InData%iVarCoupledKinematics) + call RegPack(RF, InData%iVarDeltaL) + call RegPack(RF, InData%iVarDeltaLdot) + call RegPack(RF, InData%nLineTypes) + call RegPack(RF, InData%nRodTypes) + call RegPack(RF, InData%nPoints) + call RegPack(RF, InData%nPointsExtra) + call RegPack(RF, InData%nBodies) + call RegPack(RF, InData%nRods) + call RegPack(RF, InData%nLines) + call RegPack(RF, InData%nCtrlChans) + call RegPack(RF, InData%nFails) + call RegPack(RF, InData%nFreeBodies) + call RegPack(RF, InData%nFreeRods) + call RegPack(RF, InData%nFreePoints) + call RegPackAlloc(RF, InData%nCpldBodies) + call RegPackAlloc(RF, InData%nCpldRods) + call RegPackAlloc(RF, InData%nCpldPoints) + call RegPack(RF, InData%NConns) + call RegPack(RF, InData%NAnchs) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%g) + call RegPack(RF, InData%rhoW) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%kBot) + call RegPack(RF, InData%cBot) + call RegPack(RF, InData%dtM0) + call RegPack(RF, InData%dtCoupling) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%dtOut) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackRodProp(RF, InData%RodTypeList(i1)) + call MD_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call MD_PackBody(RF, InData%GroundBody) - call RegPack(RF, allocated(InData%BodyList)) - if (allocated(InData%BodyList)) then - call RegPackBounds(RF, 1, lbound(InData%BodyList, kind=B8Ki), ubound(InData%BodyList, kind=B8Ki)) - LB(1:1) = lbound(InData%BodyList, kind=B8Ki) - UB(1:1) = ubound(InData%BodyList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackBody(RF, InData%BodyList(i1)) - end do - end if - call RegPack(RF, allocated(InData%RodList)) - if (allocated(InData%RodList)) then - call RegPackBounds(RF, 1, lbound(InData%RodList, kind=B8Ki), ubound(InData%RodList, kind=B8Ki)) - LB(1:1) = lbound(InData%RodList, kind=B8Ki) - UB(1:1) = ubound(InData%RodList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackRod(RF, InData%RodList(i1)) - end do - end if - call RegPack(RF, allocated(InData%PointList)) - if (allocated(InData%PointList)) then - call RegPackBounds(RF, 1, lbound(InData%PointList, kind=B8Ki), ubound(InData%PointList, kind=B8Ki)) - LB(1:1) = lbound(InData%PointList, kind=B8Ki) - UB(1:1) = ubound(InData%PointList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackPoint(RF, InData%PointList(i1)) - end do - end if - call RegPack(RF, allocated(InData%LineList)) - if (allocated(InData%LineList)) then - call RegPackBounds(RF, 1, lbound(InData%LineList, kind=B8Ki), ubound(InData%LineList, kind=B8Ki)) - LB(1:1) = lbound(InData%LineList, kind=B8Ki) - UB(1:1) = ubound(InData%LineList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackLine(RF, InData%LineList(i1)) - end do - end if - call RegPack(RF, allocated(InData%FailList)) - if (allocated(InData%FailList)) then - call RegPackBounds(RF, 1, lbound(InData%FailList, kind=B8Ki), ubound(InData%FailList, kind=B8Ki)) - LB(1:1) = lbound(InData%FailList, kind=B8Ki) - UB(1:1) = ubound(InData%FailList, kind=B8Ki) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%MDUnOut) + call RegPack(RF, InData%PriPath) + call RegPack(RF, InData%writeLog) + call RegPack(RF, InData%UnLog) + call RegPack(RF, InData%WaveKin) + call RegPack(RF, InData%Current) + call RegPack(RF, InData%nTurbines) + call RegPackAlloc(RF, InData%TurbineRefPos) + call RegPack(RF, InData%mu_kT) + call RegPack(RF, InData%mu_kA) + call RegPack(RF, InData%mc) + call RegPack(RF, InData%cv) + call RegPack(RF, InData%inertialF) + call RegPack(RF, InData%nxWave) + call RegPack(RF, InData%nyWave) + call RegPack(RF, InData%nzWave) + call RegPack(RF, InData%ntWave) + call RegPackAlloc(RF, InData%pxWave) + call RegPackAlloc(RF, InData%pyWave) + call RegPackAlloc(RF, InData%pzWave) + call RegPack(RF, InData%dtWave) + call RegPackAlloc(RF, InData%uxWave) + call RegPackAlloc(RF, InData%uyWave) + call RegPackAlloc(RF, InData%uzWave) + call RegPackAlloc(RF, InData%axWave) + call RegPackAlloc(RF, InData%ayWave) + call RegPackAlloc(RF, InData%azWave) + call RegPackAlloc(RF, InData%PDyn) + call RegPackAlloc(RF, InData%zeta) + call RegPack(RF, InData%nzCurrent) + call RegPackAlloc(RF, InData%pzCurrent) + call RegPackAlloc(RF, InData%uxCurrent) + call RegPackAlloc(RF, InData%uyCurrent) + call RegPack(RF, InData%Nx0) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPackAlloc(RF, InData%dxIdx_map2_xStateIdx) + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, allocated(InData%VisRodsDiam)) + if (allocated(InData%VisRodsDiam)) then + call RegPackBounds(RF, 1, lbound(InData%VisRodsDiam, kind=B8Ki), ubound(InData%VisRodsDiam, kind=B8Ki)) + LB(1:1) = lbound(InData%VisRodsDiam, kind=B8Ki) + UB(1:1) = ubound(InData%VisRodsDiam, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackFail(RF, InData%FailList(i1)) + call MD_PackVisDiam(RF, InData%VisRodsDiam(i1)) end do end if - call RegPackAlloc(RF, InData%FreePointIs) - call RegPackAlloc(RF, InData%CpldPointIs) - call RegPackAlloc(RF, InData%FreeRodIs) - call RegPackAlloc(RF, InData%CpldRodIs) - call RegPackAlloc(RF, InData%FreeBodyIs) - call RegPackAlloc(RF, InData%CpldBodyIs) - call RegPackAlloc(RF, InData%LineStateIs1) - call RegPackAlloc(RF, InData%LineStateIsN) - call RegPackAlloc(RF, InData%PointStateIs1) - call RegPackAlloc(RF, InData%PointStateIsN) - call RegPackAlloc(RF, InData%RodStateIs1) - call RegPackAlloc(RF, InData%RodStateIsN) - call RegPackAlloc(RF, InData%BodyStateIs1) - call RegPackAlloc(RF, InData%BodyStateIsN) - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%WaveTi) - call MD_PackContState(RF, InData%xTemp) - call MD_PackContState(RF, InData%xdTemp) - call RegPack(RF, InData%zeros6) - call RegPackAlloc(RF, InData%MDWrOutput) - call RegPack(RF, InData%LastOutTime) - call RegPack(RF, InData%PtfmInit) - call RegPackAlloc(RF, InData%BathymetryGrid) - call RegPackAlloc(RF, InData%BathGrid_Xs) - call RegPackAlloc(RF, InData%BathGrid_Ys) - call RegPackAlloc(RF, InData%BathGrid_npoints) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackMisc(RF, OutData) +subroutine MD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF - type(MD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + type(MD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackParam' + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) + if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%LineTypeList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end if - do i1 = LB(1), UB(1) - call MD_UnpackLineProp(RF, OutData%LineTypeList(i1)) ! LineTypeList - end do + else + OutData%Vars => null() end if - if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarCoupledLoads); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarCoupledKinematics); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nLineTypes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nRodTypes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPointsExtra); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nCtrlChans); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFails); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreeBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreeRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreePoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NConns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NAnchs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kBot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cBot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtM0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtCoupling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%RodTypeList(LB(1):UB(1)),stat=stat) + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackRodProp(RF, OutData%RodTypeList(i1)) ! RodTypeList + call MD_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call MD_UnpackBody(RF, OutData%GroundBody) ! GroundBody - if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MDUnOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%writeLog); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnLog); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveKin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Current); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TurbineRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu_kT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu_kA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%inertialF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ntWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%axWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ayWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%azWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nzCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pzCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uxCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uyCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dxIdx_map2_xStateIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%VisRodsDiam)) deallocate(OutData%VisRodsDiam) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BodyList(LB(1):UB(1)),stat=stat) + allocate(OutData%VisRodsDiam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackBody(RF, OutData%BodyList(i1)) ! BodyList + call MD_UnpackVisDiam(RF, OutData%VisRodsDiam(i1)) ! VisRodsDiam end do end if - if (allocated(OutData%RodList)) deallocate(OutData%RodList) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%RodList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return +end subroutine + +subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: SrcInputData + type(MD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%CoupledKinematics)) then + LB(1:1) = lbound(SrcInputData%CoupledKinematics, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%CoupledKinematics, kind=B8Ki) + if (.not. allocated(DstInputData%CoupledKinematics)) then + allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call MD_UnpackRod(RF, OutData%RodList(i1)) ! RodList - end do - end if - if (allocated(OutData%PointList)) deallocate(OutData%PointList) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%PointList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + call MeshCopy(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%DeltaL)) then + LB(1:1) = lbound(SrcInputData%DeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%DeltaL, kind=B8Ki) + if (.not. allocated(DstInputData%DeltaL)) then + allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%DeltaL = SrcInputData%DeltaL + end if + if (allocated(SrcInputData%DeltaLdot)) then + LB(1:1) = lbound(SrcInputData%DeltaLdot, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%DeltaLdot, kind=B8Ki) + if (.not. allocated(DstInputData%DeltaLdot)) then + allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if end if + DstInputData%DeltaLdot = SrcInputData%DeltaLdot + end if +end subroutine + +subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%CoupledKinematics)) then + LB(1:1) = lbound(InputData%CoupledKinematics, kind=B8Ki) + UB(1:1) = ubound(InputData%CoupledKinematics, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_UnpackPoint(RF, OutData%PointList(i1)) ! PointList + call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(InputData%CoupledKinematics) end if - if (allocated(OutData%LineList)) deallocate(OutData%LineList) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%LineList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if + if (allocated(InputData%DeltaL)) then + deallocate(InputData%DeltaL) + end if + if (allocated(InputData%DeltaLdot)) then + deallocate(InputData%DeltaLdot) + end if +end subroutine + +subroutine MD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInput' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%CoupledKinematics)) + if (allocated(InData%CoupledKinematics)) then + call RegPackBounds(RF, 1, lbound(InData%CoupledKinematics, kind=B8Ki), ubound(InData%CoupledKinematics, kind=B8Ki)) + LB(1:1) = lbound(InData%CoupledKinematics, kind=B8Ki) + UB(1:1) = ubound(InData%CoupledKinematics, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_UnpackLine(RF, OutData%LineList(i1)) ! LineList + call MeshPack(RF, InData%CoupledKinematics(i1)) end do end if - if (allocated(OutData%FailList)) deallocate(OutData%FailList) + call RegPackAlloc(RF, InData%DeltaL) + call RegPackAlloc(RF, InData%DeltaLdot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInput' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%FailList(LB(1):UB(1)),stat=stat) + allocate(OutData%CoupledKinematics(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackFail(RF, OutData%FailList(i1)) ! FailList + call MeshUnpack(RF, OutData%CoupledKinematics(i1)) ! CoupledKinematics end do end if - call RegUnpackAlloc(RF, OutData%FreePointIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CpldPointIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FreeRodIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CpldRodIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FreeBodyIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CpldBodyIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%LineStateIs1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%LineStateIsN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PointStateIs1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PointStateIsN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RodStateIs1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RodStateIsN); if (RegCheckErr(RF, RoutineName)) return - 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%WaveTi); if (RegCheckErr(RF, RoutineName)) return - call MD_UnpackContState(RF, OutData%xTemp) ! xTemp - call MD_UnpackContState(RF, OutData%xdTemp) ! xdTemp - call RegUnpack(RF, OutData%zeros6); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MDWrOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BathymetryGrid); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BathGrid_Xs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BathGrid_Ys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BathGrid_npoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DeltaLdot); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(MD_ParameterType), intent(in) :: SrcParamData - type(MD_ParameterType), intent(inout) :: DstParamData +subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: SrcOutputData + type(MD_OutputType), intent(inout) :: DstOutputData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_CopyParam' + character(*), parameter :: RoutineName = 'MD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' - DstParamData%nLineTypes = SrcParamData%nLineTypes - DstParamData%nRodTypes = SrcParamData%nRodTypes - DstParamData%nPoints = SrcParamData%nPoints - DstParamData%nPointsExtra = SrcParamData%nPointsExtra - DstParamData%nBodies = SrcParamData%nBodies - DstParamData%nRods = SrcParamData%nRods - DstParamData%nLines = SrcParamData%nLines - DstParamData%nCtrlChans = SrcParamData%nCtrlChans - DstParamData%nFails = SrcParamData%nFails - DstParamData%nFreeBodies = SrcParamData%nFreeBodies - DstParamData%nFreeRods = SrcParamData%nFreeRods - DstParamData%nFreePoints = SrcParamData%nFreePoints - if (allocated(SrcParamData%nCpldBodies)) then - LB(1:1) = lbound(SrcParamData%nCpldBodies, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldBodies, kind=B8Ki) - if (.not. allocated(DstParamData%nCpldBodies)) then - allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%CoupledLoads)) then + LB(1:1) = lbound(SrcOutputData%CoupledLoads, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%CoupledLoads, kind=B8Ki) + if (.not. allocated(DstOutputData%CoupledLoads)) then + allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldBodies = SrcParamData%nCpldBodies + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%nCpldRods)) then - LB(1:1) = lbound(SrcParamData%nCpldRods, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldRods, kind=B8Ki) - if (.not. allocated(DstParamData%nCpldRods)) then - allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldRods = SrcParamData%nCpldRods + DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if - if (allocated(SrcParamData%nCpldPoints)) then - LB(1:1) = lbound(SrcParamData%nCpldPoints, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldPoints, kind=B8Ki) - if (.not. allocated(DstParamData%nCpldPoints)) then - allocate(DstParamData%nCpldPoints(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%VisLinesMesh)) then + LB(1:1) = lbound(SrcOutputData%VisLinesMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%VisLinesMesh, kind=B8Ki) + if (.not. allocated(DstOutputData%VisLinesMesh)) then + allocate(DstOutputData%VisLinesMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldPoints.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisLinesMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldPoints = SrcParamData%nCpldPoints + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisLinesMesh(i1), DstOutputData%VisLinesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%NConns = SrcParamData%NConns - DstParamData%NAnchs = SrcParamData%NAnchs - DstParamData%Tmax = SrcParamData%Tmax - DstParamData%g = SrcParamData%g - DstParamData%rhoW = SrcParamData%rhoW - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%kBot = SrcParamData%kBot - DstParamData%cBot = SrcParamData%cBot - DstParamData%dtM0 = SrcParamData%dtM0 - DstParamData%dtCoupling = SrcParamData%dtCoupling - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%dtOut = SrcParamData%dtOut - DstParamData%RootName = SrcParamData%RootName - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%VisRodsMesh)) then + LB(1:1) = lbound(SrcOutputData%VisRodsMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%VisRodsMesh, kind=B8Ki) + if (.not. allocated(DstOutputData%VisRodsMesh)) then + allocate(DstOutputData%VisRodsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisRodsMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcOutputData%VisRodsMesh(i1), DstOutputData%VisRodsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - DstParamData%Delim = SrcParamData%Delim - DstParamData%MDUnOut = SrcParamData%MDUnOut - DstParamData%PriPath = SrcParamData%PriPath - DstParamData%writeLog = SrcParamData%writeLog - DstParamData%UnLog = SrcParamData%UnLog - DstParamData%WaveKin = SrcParamData%WaveKin - DstParamData%Current = SrcParamData%Current - DstParamData%nTurbines = SrcParamData%nTurbines - if (allocated(SrcParamData%TurbineRefPos)) then - LB(1:2) = lbound(SrcParamData%TurbineRefPos, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TurbineRefPos, kind=B8Ki) - if (.not. allocated(DstParamData%TurbineRefPos)) then - allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcOutputData%VisBodiesMesh)) then + LB(1:1) = lbound(SrcOutputData%VisBodiesMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%VisBodiesMesh, kind=B8Ki) + if (.not. allocated(DstOutputData%VisBodiesMesh)) then + allocate(DstOutputData%VisBodiesMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos - end if - DstParamData%mu_kT = SrcParamData%mu_kT - DstParamData%mu_kA = SrcParamData%mu_kA - DstParamData%mc = SrcParamData%mc - DstParamData%cv = SrcParamData%cv - DstParamData%inertialF = SrcParamData%inertialF - DstParamData%nxWave = SrcParamData%nxWave - DstParamData%nyWave = SrcParamData%nyWave - DstParamData%nzWave = SrcParamData%nzWave - DstParamData%ntWave = SrcParamData%ntWave - if (allocated(SrcParamData%pxWave)) then - LB(1:1) = lbound(SrcParamData%pxWave, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pxWave, kind=B8Ki) - if (.not. allocated(DstParamData%pxWave)) then - allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%pxWave = SrcParamData%pxWave - end if - if (allocated(SrcParamData%pyWave)) then - LB(1:1) = lbound(SrcParamData%pyWave, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pyWave, kind=B8Ki) - if (.not. allocated(DstParamData%pyWave)) then - allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%pyWave = SrcParamData%pyWave - end if - if (allocated(SrcParamData%pzWave)) then - LB(1:1) = lbound(SrcParamData%pzWave, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pzWave, kind=B8Ki) - if (.not. allocated(DstParamData%pzWave)) then - allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%pzWave = SrcParamData%pzWave - end if - DstParamData%dtWave = SrcParamData%dtWave - if (allocated(SrcParamData%uxWave)) then - LB(1:4) = lbound(SrcParamData%uxWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uxWave, kind=B8Ki) - if (.not. allocated(DstParamData%uxWave)) then - allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uxWave = SrcParamData%uxWave - end if - if (allocated(SrcParamData%uyWave)) then - LB(1:4) = lbound(SrcParamData%uyWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uyWave, kind=B8Ki) - if (.not. allocated(DstParamData%uyWave)) then - allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uyWave = SrcParamData%uyWave - end if - if (allocated(SrcParamData%uzWave)) then - LB(1:4) = lbound(SrcParamData%uzWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uzWave, kind=B8Ki) - if (.not. allocated(DstParamData%uzWave)) then - allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uzWave = SrcParamData%uzWave - end if - if (allocated(SrcParamData%axWave)) then - LB(1:4) = lbound(SrcParamData%axWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%axWave, kind=B8Ki) - if (.not. allocated(DstParamData%axWave)) then - allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%axWave = SrcParamData%axWave - end if - if (allocated(SrcParamData%ayWave)) then - LB(1:4) = lbound(SrcParamData%ayWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%ayWave, kind=B8Ki) - if (.not. allocated(DstParamData%ayWave)) then - allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ayWave = SrcParamData%ayWave - end if - if (allocated(SrcParamData%azWave)) then - LB(1:4) = lbound(SrcParamData%azWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%azWave, kind=B8Ki) - if (.not. allocated(DstParamData%azWave)) then - allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%azWave = SrcParamData%azWave - end if - if (allocated(SrcParamData%PDyn)) then - LB(1:4) = lbound(SrcParamData%PDyn, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%PDyn, kind=B8Ki) - if (.not. allocated(DstParamData%PDyn)) then - allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%PDyn = SrcParamData%PDyn - end if - if (allocated(SrcParamData%zeta)) then - LB(1:3) = lbound(SrcParamData%zeta, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%zeta, kind=B8Ki) - if (.not. allocated(DstParamData%zeta)) then - allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%zeta = SrcParamData%zeta - end if - DstParamData%nzCurrent = SrcParamData%nzCurrent - if (allocated(SrcParamData%pzCurrent)) then - LB(1:1) = lbound(SrcParamData%pzCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pzCurrent, kind=B8Ki) - if (.not. allocated(DstParamData%pzCurrent)) then - allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%pzCurrent = SrcParamData%pzCurrent - end if - if (allocated(SrcParamData%uxCurrent)) then - LB(1:1) = lbound(SrcParamData%uxCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%uxCurrent, kind=B8Ki) - if (.not. allocated(DstParamData%uxCurrent)) then - allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uxCurrent = SrcParamData%uxCurrent - end if - if (allocated(SrcParamData%uyCurrent)) then - LB(1:1) = lbound(SrcParamData%uyCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%uyCurrent, kind=B8Ki) - if (.not. allocated(DstParamData%uyCurrent)) then - allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uyCurrent = SrcParamData%uyCurrent - end if - DstParamData%Nx0 = SrcParamData%Nx0 - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du - end if - if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) - if (.not. allocated(DstParamData%dx)) then - allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%dx = SrcParamData%dx - end if - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then - LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) - if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then - allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisBodiesMesh(i1), DstOutputData%VisBodiesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%VisMeshes = SrcParamData%VisMeshes - if (allocated(SrcParamData%VisRodsDiam)) then - LB(1:1) = lbound(SrcParamData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%VisRodsDiam, kind=B8Ki) - if (.not. allocated(DstParamData%VisRodsDiam)) then - allocate(DstParamData%VisRodsDiam(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%VisAnchsMesh)) then + LB(1:1) = lbound(SrcOutputData%VisAnchsMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%VisAnchsMesh, kind=B8Ki) + if (.not. allocated(DstOutputData%VisAnchsMesh)) then + allocate(DstOutputData%VisAnchsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VisRodsDiam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyVisDiam(SrcParamData%VisRodsDiam(i1), DstParamData%VisRodsDiam(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcOutputData%VisAnchsMesh(i1), DstOutputData%VisAnchsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if end subroutine -subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(MD_ParameterType), intent(inout) :: ParamData +subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyParam' + character(*), parameter :: RoutineName = 'MD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ParamData%nCpldBodies)) then - deallocate(ParamData%nCpldBodies) - end if - if (allocated(ParamData%nCpldRods)) then - deallocate(ParamData%nCpldRods) - end if - if (allocated(ParamData%nCpldPoints)) then - deallocate(ParamData%nCpldPoints) - end if - if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + if (allocated(OutputData%CoupledLoads)) then + LB(1:1) = lbound(OutputData%CoupledLoads, kind=B8Ki) + UB(1:1) = ubound(OutputData%CoupledLoads, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%OutParam) - end if - if (allocated(ParamData%TurbineRefPos)) then - deallocate(ParamData%TurbineRefPos) - end if - if (allocated(ParamData%pxWave)) then - deallocate(ParamData%pxWave) - end if - if (allocated(ParamData%pyWave)) then - deallocate(ParamData%pyWave) - end if - if (allocated(ParamData%pzWave)) then - deallocate(ParamData%pzWave) - end if - if (allocated(ParamData%uxWave)) then - deallocate(ParamData%uxWave) - end if - if (allocated(ParamData%uyWave)) then - deallocate(ParamData%uyWave) - end if - if (allocated(ParamData%uzWave)) then - deallocate(ParamData%uzWave) - end if - if (allocated(ParamData%axWave)) then - deallocate(ParamData%axWave) - end if - if (allocated(ParamData%ayWave)) then - deallocate(ParamData%ayWave) - end if - if (allocated(ParamData%azWave)) then - deallocate(ParamData%azWave) - end if - if (allocated(ParamData%PDyn)) then - deallocate(ParamData%PDyn) - end if - if (allocated(ParamData%zeta)) then - deallocate(ParamData%zeta) - end if - if (allocated(ParamData%pzCurrent)) then - deallocate(ParamData%pzCurrent) - end if - if (allocated(ParamData%uxCurrent)) then - deallocate(ParamData%uxCurrent) - end if - if (allocated(ParamData%uyCurrent)) then - deallocate(ParamData%uyCurrent) + deallocate(OutputData%CoupledLoads) end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) + if (allocated(OutputData%VisLinesMesh)) then + LB(1:1) = lbound(OutputData%VisLinesMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%VisLinesMesh, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisLinesMesh) end if - if (allocated(ParamData%dx)) then - deallocate(ParamData%dx) + if (allocated(OutputData%VisRodsMesh)) then + LB(1:1) = lbound(OutputData%VisRodsMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%VisRodsMesh, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisRodsMesh) end if - if (allocated(ParamData%dxIdx_map2_xStateIdx)) then - deallocate(ParamData%dxIdx_map2_xStateIdx) + if (allocated(OutputData%VisBodiesMesh)) then + LB(1:1) = lbound(OutputData%VisBodiesMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%VisBodiesMesh, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisBodiesMesh) end if - if (allocated(ParamData%VisRodsDiam)) then - LB(1:1) = lbound(ParamData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(ParamData%VisRodsDiam, kind=B8Ki) + if (allocated(OutputData%VisAnchsMesh)) then + LB(1:1) = lbound(OutputData%VisAnchsMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%VisAnchsMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_DestroyVisDiam(ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%VisRodsDiam) + deallocate(OutputData%VisAnchsMesh) end if end subroutine -subroutine MD_PackParam(RF, Indata) +subroutine MD_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF - type(MD_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + type(MD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOutput' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%nLineTypes) - call RegPack(RF, InData%nRodTypes) - call RegPack(RF, InData%nPoints) - call RegPack(RF, InData%nPointsExtra) - call RegPack(RF, InData%nBodies) - call RegPack(RF, InData%nRods) - call RegPack(RF, InData%nLines) - call RegPack(RF, InData%nCtrlChans) - call RegPack(RF, InData%nFails) - call RegPack(RF, InData%nFreeBodies) - call RegPack(RF, InData%nFreeRods) - call RegPack(RF, InData%nFreePoints) - call RegPackAlloc(RF, InData%nCpldBodies) - call RegPackAlloc(RF, InData%nCpldRods) - call RegPackAlloc(RF, InData%nCpldPoints) - call RegPack(RF, InData%NConns) - call RegPack(RF, InData%NAnchs) - call RegPack(RF, InData%Tmax) - call RegPack(RF, InData%g) - call RegPack(RF, InData%rhoW) - call RegPack(RF, InData%WtrDpth) - call RegPack(RF, InData%kBot) - call RegPack(RF, InData%cBot) - call RegPack(RF, InData%dtM0) - call RegPack(RF, InData%dtCoupling) - call RegPack(RF, InData%NumOuts) - call RegPack(RF, InData%dtOut) - call RegPack(RF, InData%RootName) - call RegPack(RF, allocated(InData%OutParam)) - if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPack(RF, allocated(InData%CoupledLoads)) + if (allocated(InData%CoupledLoads)) then + call RegPackBounds(RF, 1, lbound(InData%CoupledLoads, kind=B8Ki), ubound(InData%CoupledLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%CoupledLoads, kind=B8Ki) + UB(1:1) = ubound(InData%CoupledLoads, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackOutParmType(RF, InData%OutParam(i1)) + call MeshPack(RF, InData%CoupledLoads(i1)) end do end if - call RegPack(RF, InData%Delim) - call RegPack(RF, InData%MDUnOut) - call RegPack(RF, InData%PriPath) - call RegPack(RF, InData%writeLog) - call RegPack(RF, InData%UnLog) - call RegPack(RF, InData%WaveKin) - call RegPack(RF, InData%Current) - call RegPack(RF, InData%nTurbines) - call RegPackAlloc(RF, InData%TurbineRefPos) - call RegPack(RF, InData%mu_kT) - call RegPack(RF, InData%mu_kA) - call RegPack(RF, InData%mc) - call RegPack(RF, InData%cv) - call RegPack(RF, InData%inertialF) - call RegPack(RF, InData%nxWave) - call RegPack(RF, InData%nyWave) - call RegPack(RF, InData%nzWave) - call RegPack(RF, InData%ntWave) - call RegPackAlloc(RF, InData%pxWave) - call RegPackAlloc(RF, InData%pyWave) - call RegPackAlloc(RF, InData%pzWave) - call RegPack(RF, InData%dtWave) - call RegPackAlloc(RF, InData%uxWave) - call RegPackAlloc(RF, InData%uyWave) - call RegPackAlloc(RF, InData%uzWave) - call RegPackAlloc(RF, InData%axWave) - call RegPackAlloc(RF, InData%ayWave) - call RegPackAlloc(RF, InData%azWave) - call RegPackAlloc(RF, InData%PDyn) - call RegPackAlloc(RF, InData%zeta) - call RegPack(RF, InData%nzCurrent) - call RegPackAlloc(RF, InData%pzCurrent) - call RegPackAlloc(RF, InData%uxCurrent) - call RegPackAlloc(RF, InData%uyCurrent) - call RegPack(RF, InData%Nx0) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%du) - call RegPackAlloc(RF, InData%dx) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%Jac_nx) - call RegPackAlloc(RF, InData%dxIdx_map2_xStateIdx) - call RegPack(RF, InData%VisMeshes) - call RegPack(RF, allocated(InData%VisRodsDiam)) - if (allocated(InData%VisRodsDiam)) then - call RegPackBounds(RF, 1, lbound(InData%VisRodsDiam, kind=B8Ki), ubound(InData%VisRodsDiam, kind=B8Ki)) - LB(1:1) = lbound(InData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(InData%VisRodsDiam, kind=B8Ki) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPack(RF, allocated(InData%VisLinesMesh)) + if (allocated(InData%VisLinesMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisLinesMesh, kind=B8Ki), ubound(InData%VisLinesMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%VisLinesMesh, kind=B8Ki) + UB(1:1) = ubound(InData%VisLinesMesh, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisLinesMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%VisRodsMesh)) + if (allocated(InData%VisRodsMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisRodsMesh, kind=B8Ki), ubound(InData%VisRodsMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%VisRodsMesh, kind=B8Ki) + UB(1:1) = ubound(InData%VisRodsMesh, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisRodsMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%VisBodiesMesh)) + if (allocated(InData%VisBodiesMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisBodiesMesh, kind=B8Ki), ubound(InData%VisBodiesMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%VisBodiesMesh, kind=B8Ki) + UB(1:1) = ubound(InData%VisBodiesMesh, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisBodiesMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%VisAnchsMesh)) + if (allocated(InData%VisAnchsMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisAnchsMesh, kind=B8Ki), ubound(InData%VisAnchsMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%VisAnchsMesh, kind=B8Ki) + UB(1:1) = ubound(InData%VisAnchsMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackVisDiam(RF, InData%VisRodsDiam(i1)) + call MeshPack(RF, InData%VisAnchsMesh(i1)) end do end if if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackParam(RF, OutData) +subroutine MD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF - type(MD_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + type(MD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOutput' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%nLineTypes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nRodTypes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nPoints); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nPointsExtra); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nBodies); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nRods); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nLines); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nCtrlChans); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nFails); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nFreeBodies); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nFreeRods); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nFreePoints); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%nCpldBodies); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%nCpldRods); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%nCpldPoints); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NConns); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NAnchs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%rhoW); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%kBot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%cBot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dtM0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dtCoupling); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dtOut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + allocate(OutData%CoupledLoads(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + call MeshUnpack(RF, OutData%CoupledLoads(i1)) ! CoupledLoads end do end if - call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MDUnOut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%writeLog); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UnLog); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WaveKin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Current); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TurbineRefPos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%mu_kT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%mu_kA); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%mc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%cv); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%inertialF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nxWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nyWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nzWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ntWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%pxWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%pyWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%pzWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dtWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uxWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uyWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uzWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%axWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ayWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%azWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nzCurrent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%pzCurrent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uxCurrent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uyCurrent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nx0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dxIdx_map2_xStateIdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%VisRodsDiam)) deallocate(OutData%VisRodsDiam) + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%VisLinesMesh)) deallocate(OutData%VisLinesMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisRodsDiam(LB(1):UB(1)),stat=stat) + allocate(OutData%VisLinesMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackVisDiam(RF, OutData%VisRodsDiam(i1)) ! VisRodsDiam + call MeshUnpack(RF, OutData%VisLinesMesh(i1)) ! VisLinesMesh + end do + end if + if (allocated(OutData%VisRodsMesh)) deallocate(OutData%VisRodsMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisRodsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisRodsMesh(i1)) ! VisRodsMesh + end do + end if + if (allocated(OutData%VisBodiesMesh)) deallocate(OutData%VisBodiesMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisBodiesMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisBodiesMesh(i1)) ! VisBodiesMesh + end do + end if + if (allocated(OutData%VisAnchsMesh)) deallocate(OutData%VisAnchsMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisAnchsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisAnchsMesh(i1)) ! VisAnchsMesh end do end if end subroutine -subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) - type(MD_InputType), intent(inout) :: SrcInputData - type(MD_InputType), intent(inout) :: DstInputData +subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(inout) :: SrcMiscData + type(MD_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_CopyInput' + character(*), parameter :: RoutineName = 'MD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcInputData%CoupledKinematics)) then - LB(1:1) = lbound(SrcInputData%CoupledKinematics, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%CoupledKinematics, kind=B8Ki) - if (.not. allocated(DstInputData%CoupledKinematics)) then - allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%dxdt_jac, DstMiscData%dxdt_jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyOutput(SrcMiscData%y_jac, DstMiscData%y_jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%LineTypeList)) then + LB(1:1) = lbound(SrcMiscData%LineTypeList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LineTypeList, kind=B8Ki) + if (.not. allocated(DstMiscData%LineTypeList)) then + allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyLineProp(SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%RodTypeList)) then + LB(1:1) = lbound(SrcMiscData%RodTypeList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%RodTypeList, kind=B8Ki) + if (.not. allocated(DstMiscData%RodTypeList)) then + allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyRodProp(SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MD_CopyBody(SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%BodyList)) then + LB(1:1) = lbound(SrcMiscData%BodyList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BodyList, kind=B8Ki) + if (.not. allocated(DstMiscData%BodyList)) then + allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyBody(SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%RodList)) then + LB(1:1) = lbound(SrcMiscData%RodList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%RodList, kind=B8Ki) + if (.not. allocated(DstMiscData%RodList)) then + allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyRod(SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%PointList)) then + LB(1:1) = lbound(SrcMiscData%PointList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%PointList, kind=B8Ki) + if (.not. allocated(DstMiscData%PointList)) then + allocate(DstMiscData%PointList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyPoint(SrcMiscData%PointList(i1), DstMiscData%PointList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%LineList)) then + LB(1:1) = lbound(SrcMiscData%LineList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LineList, kind=B8Ki) + if (.not. allocated(DstMiscData%LineList)) then + allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MD_CopyLine(SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInputData%DeltaL)) then - LB(1:1) = lbound(SrcInputData%DeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%DeltaL, kind=B8Ki) - if (.not. allocated(DstInputData%DeltaL)) then - allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%FailList)) then + LB(1:1) = lbound(SrcMiscData%FailList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FailList, kind=B8Ki) + if (.not. allocated(DstMiscData%FailList)) then + allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%DeltaL = SrcInputData%DeltaL + do i1 = LB(1), UB(1) + call MD_CopyFail(SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcInputData%DeltaLdot)) then - LB(1:1) = lbound(SrcInputData%DeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%DeltaLdot, kind=B8Ki) - if (.not. allocated(DstInputData%DeltaLdot)) then - allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%FreePointIs)) then + LB(1:1) = lbound(SrcMiscData%FreePointIs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FreePointIs, kind=B8Ki) + if (.not. allocated(DstMiscData%FreePointIs)) then + allocate(DstMiscData%FreePointIs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreePointIs.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%DeltaLdot = SrcInputData%DeltaLdot + DstMiscData%FreePointIs = SrcMiscData%FreePointIs end if -end subroutine - -subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) - type(MD_InputType), intent(inout) :: InputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyInput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(InputData%CoupledKinematics)) then - LB(1:1) = lbound(InputData%CoupledKinematics, kind=B8Ki) - UB(1:1) = ubound(InputData%CoupledKinematics, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InputData%CoupledKinematics) + if (allocated(SrcMiscData%CpldPointIs)) then + LB(1:2) = lbound(SrcMiscData%CpldPointIs, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%CpldPointIs, kind=B8Ki) + if (.not. allocated(DstMiscData%CpldPointIs)) then + allocate(DstMiscData%CpldPointIs(LB(1):UB(1),LB(2):UB(2)), 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 end if - if (allocated(InputData%DeltaL)) then - deallocate(InputData%DeltaL) + if (allocated(SrcMiscData%FreeRodIs)) then + LB(1:1) = lbound(SrcMiscData%FreeRodIs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FreeRodIs, kind=B8Ki) + if (.not. allocated(DstMiscData%FreeRodIs)) then + allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs end if - if (allocated(InputData%DeltaLdot)) then - deallocate(InputData%DeltaLdot) + if (allocated(SrcMiscData%CpldRodIs)) then + LB(1:2) = lbound(SrcMiscData%CpldRodIs, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%CpldRodIs, kind=B8Ki) + if (.not. allocated(DstMiscData%CpldRodIs)) then + allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs end if -end subroutine - -subroutine MD_PackInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(MD_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%CoupledKinematics)) - if (allocated(InData%CoupledKinematics)) then - call RegPackBounds(RF, 1, lbound(InData%CoupledKinematics, kind=B8Ki), ubound(InData%CoupledKinematics, kind=B8Ki)) - LB(1:1) = lbound(InData%CoupledKinematics, kind=B8Ki) - UB(1:1) = ubound(InData%CoupledKinematics, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%CoupledKinematics(i1)) - end do + if (allocated(SrcMiscData%FreeBodyIs)) then + LB(1:1) = lbound(SrcMiscData%FreeBodyIs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FreeBodyIs, kind=B8Ki) + if (.not. allocated(DstMiscData%FreeBodyIs)) then + allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs end if - call RegPackAlloc(RF, InData%DeltaL) - call RegPackAlloc(RF, InData%DeltaLdot) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MD_UnPackInput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(MD_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%CoupledKinematics(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcMiscData%CpldBodyIs)) then + LB(1:2) = lbound(SrcMiscData%CpldBodyIs, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%CpldBodyIs, kind=B8Ki) + if (.not. allocated(DstMiscData%CpldBodyIs)) then + allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%CoupledKinematics(i1)) ! CoupledKinematics - end do + DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs end if - call RegUnpackAlloc(RF, OutData%DeltaL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DeltaLdot); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(MD_OutputType), intent(inout) :: SrcOutputData - type(MD_OutputType), intent(inout) :: DstOutputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_CopyOutput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcOutputData%CoupledLoads)) then - LB(1:1) = lbound(SrcOutputData%CoupledLoads, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CoupledLoads, kind=B8Ki) - if (.not. allocated(DstOutputData%CoupledLoads)) then - allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%LineStateIs1)) then + LB(1:1) = lbound(SrcMiscData%LineStateIs1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LineStateIs1, kind=B8Ki) + if (.not. allocated(DstMiscData%LineStateIs1)) then + allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 + end if + if (allocated(SrcMiscData%LineStateIsN)) then + LB(1:1) = lbound(SrcMiscData%LineStateIsN, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LineStateIsN, kind=B8Ki) + if (.not. allocated(DstMiscData%LineStateIsN)) then + allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN + end if + if (allocated(SrcMiscData%PointStateIs1)) then + LB(1:1) = lbound(SrcMiscData%PointStateIs1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%PointStateIs1, kind=B8Ki) + if (.not. allocated(DstMiscData%PointStateIs1)) then + allocate(DstMiscData%PointStateIs1(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%PointStateIsN)) then + LB(1:1) = lbound(SrcMiscData%PointStateIsN, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%PointStateIsN, kind=B8Ki) + if (.not. allocated(DstMiscData%PointStateIsN)) then + allocate(DstMiscData%PointStateIsN(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%RodStateIs1)) then + LB(1:1) = lbound(SrcMiscData%RodStateIs1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%RodStateIs1, kind=B8Ki) + if (.not. allocated(DstMiscData%RodStateIs1)) then + allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 + end if + if (allocated(SrcMiscData%RodStateIsN)) then + LB(1:1) = lbound(SrcMiscData%RodStateIsN, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%RodStateIsN, kind=B8Ki) + if (.not. allocated(DstMiscData%RodStateIsN)) then + allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN + end if + if (allocated(SrcMiscData%BodyStateIs1)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIs1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BodyStateIs1, kind=B8Ki) + if (.not. allocated(DstMiscData%BodyStateIs1)) then + allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 end if - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%BodyStateIsN)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIsN, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BodyStateIsN, kind=B8Ki) + if (.not. allocated(DstMiscData%BodyStateIsN)) then + allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN end if - if (allocated(SrcOutputData%VisLinesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisLinesMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%VisLinesMesh)) then - allocate(DstOutputData%VisLinesMesh(LB(1):UB(1)), stat=ErrStat2) + DstMiscData%Nx = SrcMiscData%Nx + DstMiscData%WaveTi = SrcMiscData%WaveTi + call MD_CopyContState(SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%zeros6 = SrcMiscData%zeros6 + if (allocated(SrcMiscData%MDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%MDWrOutput, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%MDWrOutput, kind=B8Ki) + if (.not. allocated(DstMiscData%MDWrOutput)) then + allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisLinesMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisLinesMesh(i1), DstOutputData%VisLinesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput end if - if (allocated(SrcOutputData%VisRodsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisRodsMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%VisRodsMesh)) then - allocate(DstOutputData%VisRodsMesh(LB(1):UB(1)), stat=ErrStat2) + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%PtfmInit = SrcMiscData%PtfmInit + if (allocated(SrcMiscData%BathymetryGrid)) then + LB(1:2) = lbound(SrcMiscData%BathymetryGrid, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%BathymetryGrid, kind=B8Ki) + if (.not. allocated(DstMiscData%BathymetryGrid)) then + allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisRodsMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisRodsMesh(i1), DstOutputData%VisRodsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid end if - if (allocated(SrcOutputData%VisBodiesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisBodiesMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%VisBodiesMesh)) then - allocate(DstOutputData%VisBodiesMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%BathGrid_Xs)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Xs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BathGrid_Xs, kind=B8Ki) + if (.not. allocated(DstMiscData%BathGrid_Xs)) then + allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisBodiesMesh(i1), DstOutputData%VisBodiesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs end if - if (allocated(SrcOutputData%VisAnchsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisAnchsMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%VisAnchsMesh)) then - allocate(DstOutputData%VisAnchsMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%BathGrid_Ys)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Ys, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BathGrid_Ys, kind=B8Ki) + if (.not. allocated(DstMiscData%BathGrid_Ys)) then + allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisAnchsMesh(i1), DstOutputData%VisAnchsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys + end if + if (allocated(SrcMiscData%BathGrid_npoints)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_npoints, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BathGrid_npoints, kind=B8Ki) + if (.not. allocated(DstMiscData%BathGrid_npoints)) then + allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints end if end subroutine -subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(MD_OutputType), intent(inout) :: OutputData +subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyOutput' + character(*), parameter :: RoutineName = 'MD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%CoupledLoads)) then - LB(1:1) = lbound(OutputData%CoupledLoads, kind=B8Ki) - UB(1:1) = ubound(OutputData%CoupledLoads, kind=B8Ki) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%dxdt_jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyOutput(MiscData%y_jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%LineTypeList)) then + LB(1:1) = lbound(MiscData%LineTypeList, kind=B8Ki) + UB(1:1) = ubound(MiscData%LineTypeList, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) + call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%CoupledLoads) + deallocate(MiscData%LineTypeList) end if - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + if (allocated(MiscData%RodTypeList)) then + LB(1:1) = lbound(MiscData%RodTypeList, kind=B8Ki) + UB(1:1) = ubound(MiscData%RodTypeList, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodTypeList) + end if + call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%BodyList)) then + LB(1:1) = lbound(MiscData%BodyList, kind=B8Ki) + UB(1:1) = ubound(MiscData%BodyList, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BodyList) + end if + if (allocated(MiscData%RodList)) then + LB(1:1) = lbound(MiscData%RodList, kind=B8Ki) + UB(1:1) = ubound(MiscData%RodList, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodList) + end if + if (allocated(MiscData%PointList)) then + LB(1:1) = lbound(MiscData%PointList, kind=B8Ki) + UB(1:1) = ubound(MiscData%PointList, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%PointList) + end if + if (allocated(MiscData%LineList)) then + LB(1:1) = lbound(MiscData%LineList, kind=B8Ki) + UB(1:1) = ubound(MiscData%LineList, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%LineList) + end if + if (allocated(MiscData%FailList)) then + LB(1:1) = lbound(MiscData%FailList, kind=B8Ki) + UB(1:1) = ubound(MiscData%FailList, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FailList) + end if + if (allocated(MiscData%FreePointIs)) then + deallocate(MiscData%FreePointIs) + end if + if (allocated(MiscData%CpldPointIs)) then + deallocate(MiscData%CpldPointIs) + end if + if (allocated(MiscData%FreeRodIs)) then + deallocate(MiscData%FreeRodIs) + end if + if (allocated(MiscData%CpldRodIs)) then + deallocate(MiscData%CpldRodIs) + end if + if (allocated(MiscData%FreeBodyIs)) then + deallocate(MiscData%FreeBodyIs) + end if + if (allocated(MiscData%CpldBodyIs)) then + deallocate(MiscData%CpldBodyIs) + end if + if (allocated(MiscData%LineStateIs1)) then + deallocate(MiscData%LineStateIs1) + end if + if (allocated(MiscData%LineStateIsN)) then + deallocate(MiscData%LineStateIsN) + end if + if (allocated(MiscData%PointStateIs1)) then + deallocate(MiscData%PointStateIs1) + end if + if (allocated(MiscData%PointStateIsN)) then + deallocate(MiscData%PointStateIsN) + end if + if (allocated(MiscData%RodStateIs1)) then + deallocate(MiscData%RodStateIs1) + end if + if (allocated(MiscData%RodStateIsN)) then + deallocate(MiscData%RodStateIsN) + end if + if (allocated(MiscData%BodyStateIs1)) then + deallocate(MiscData%BodyStateIs1) + end if + if (allocated(MiscData%BodyStateIsN)) then + deallocate(MiscData%BodyStateIsN) + end if + call MD_DestroyContState(MiscData%xTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%xdTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%MDWrOutput)) then + deallocate(MiscData%MDWrOutput) + end if + if (allocated(MiscData%BathymetryGrid)) then + deallocate(MiscData%BathymetryGrid) + end if + if (allocated(MiscData%BathGrid_Xs)) then + deallocate(MiscData%BathGrid_Xs) end if - if (allocated(OutputData%VisLinesMesh)) then - LB(1:1) = lbound(OutputData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisLinesMesh, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OutputData%VisLinesMesh) + if (allocated(MiscData%BathGrid_Ys)) then + deallocate(MiscData%BathGrid_Ys) end if - if (allocated(OutputData%VisRodsMesh)) then - LB(1:1) = lbound(OutputData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisRodsMesh, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OutputData%VisRodsMesh) + if (allocated(MiscData%BathGrid_npoints)) then + deallocate(MiscData%BathGrid_npoints) end if - if (allocated(OutputData%VisBodiesMesh)) then - LB(1:1) = lbound(OutputData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisBodiesMesh, kind=B8Ki) +end subroutine + +subroutine MD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModJacType(RF, InData%Jac) + call MD_PackContState(RF, InData%x_perturb) + call MD_PackContState(RF, InData%dxdt_jac) + call MD_PackInput(RF, InData%u_perturb) + call MD_PackOutput(RF, InData%y_jac) + call RegPack(RF, allocated(InData%LineTypeList)) + if (allocated(InData%LineTypeList)) then + call RegPackBounds(RF, 1, lbound(InData%LineTypeList, kind=B8Ki), ubound(InData%LineTypeList, kind=B8Ki)) + LB(1:1) = lbound(InData%LineTypeList, kind=B8Ki) + UB(1:1) = ubound(InData%LineTypeList, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_PackLineProp(RF, InData%LineTypeList(i1)) end do - deallocate(OutputData%VisBodiesMesh) end if - if (allocated(OutputData%VisAnchsMesh)) then - LB(1:1) = lbound(OutputData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisAnchsMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%RodTypeList)) + if (allocated(InData%RodTypeList)) then + call RegPackBounds(RF, 1, lbound(InData%RodTypeList, kind=B8Ki), ubound(InData%RodTypeList, kind=B8Ki)) + LB(1:1) = lbound(InData%RodTypeList, kind=B8Ki) + UB(1:1) = ubound(InData%RodTypeList, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_PackRodProp(RF, InData%RodTypeList(i1)) end do - deallocate(OutputData%VisAnchsMesh) end if -end subroutine - -subroutine MD_PackOutput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(MD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%CoupledLoads)) - if (allocated(InData%CoupledLoads)) then - call RegPackBounds(RF, 1, lbound(InData%CoupledLoads, kind=B8Ki), ubound(InData%CoupledLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%CoupledLoads, kind=B8Ki) - UB(1:1) = ubound(InData%CoupledLoads, kind=B8Ki) + call MD_PackBody(RF, InData%GroundBody) + call RegPack(RF, allocated(InData%BodyList)) + if (allocated(InData%BodyList)) then + call RegPackBounds(RF, 1, lbound(InData%BodyList, kind=B8Ki), ubound(InData%BodyList, kind=B8Ki)) + LB(1:1) = lbound(InData%BodyList, kind=B8Ki) + UB(1:1) = ubound(InData%BodyList, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%CoupledLoads(i1)) + call MD_PackBody(RF, InData%BodyList(i1)) end do end if - call RegPackAlloc(RF, InData%WriteOutput) - call RegPack(RF, allocated(InData%VisLinesMesh)) - if (allocated(InData%VisLinesMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisLinesMesh, kind=B8Ki), ubound(InData%VisLinesMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisLinesMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%RodList)) + if (allocated(InData%RodList)) then + call RegPackBounds(RF, 1, lbound(InData%RodList, kind=B8Ki), ubound(InData%RodList, kind=B8Ki)) + LB(1:1) = lbound(InData%RodList, kind=B8Ki) + UB(1:1) = ubound(InData%RodList, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%VisLinesMesh(i1)) + call MD_PackRod(RF, InData%RodList(i1)) end do end if - call RegPack(RF, allocated(InData%VisRodsMesh)) - if (allocated(InData%VisRodsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisRodsMesh, kind=B8Ki), ubound(InData%VisRodsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisRodsMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%PointList)) + if (allocated(InData%PointList)) then + call RegPackBounds(RF, 1, lbound(InData%PointList, kind=B8Ki), ubound(InData%PointList, kind=B8Ki)) + LB(1:1) = lbound(InData%PointList, kind=B8Ki) + UB(1:1) = ubound(InData%PointList, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%VisRodsMesh(i1)) + call MD_PackPoint(RF, InData%PointList(i1)) end do end if - call RegPack(RF, allocated(InData%VisBodiesMesh)) - if (allocated(InData%VisBodiesMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisBodiesMesh, kind=B8Ki), ubound(InData%VisBodiesMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisBodiesMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%LineList)) + if (allocated(InData%LineList)) then + call RegPackBounds(RF, 1, lbound(InData%LineList, kind=B8Ki), ubound(InData%LineList, kind=B8Ki)) + LB(1:1) = lbound(InData%LineList, kind=B8Ki) + UB(1:1) = ubound(InData%LineList, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%VisBodiesMesh(i1)) + call MD_PackLine(RF, InData%LineList(i1)) end do end if - call RegPack(RF, allocated(InData%VisAnchsMesh)) - if (allocated(InData%VisAnchsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisAnchsMesh, kind=B8Ki), ubound(InData%VisAnchsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisAnchsMesh, kind=B8Ki) + call RegPack(RF, allocated(InData%FailList)) + if (allocated(InData%FailList)) then + call RegPackBounds(RF, 1, lbound(InData%FailList, kind=B8Ki), ubound(InData%FailList, kind=B8Ki)) + LB(1:1) = lbound(InData%FailList, kind=B8Ki) + UB(1:1) = ubound(InData%FailList, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%VisAnchsMesh(i1)) + call MD_PackFail(RF, InData%FailList(i1)) end do end if + call RegPackAlloc(RF, InData%FreePointIs) + call RegPackAlloc(RF, InData%CpldPointIs) + call RegPackAlloc(RF, InData%FreeRodIs) + call RegPackAlloc(RF, InData%CpldRodIs) + call RegPackAlloc(RF, InData%FreeBodyIs) + call RegPackAlloc(RF, InData%CpldBodyIs) + call RegPackAlloc(RF, InData%LineStateIs1) + call RegPackAlloc(RF, InData%LineStateIsN) + call RegPackAlloc(RF, InData%PointStateIs1) + call RegPackAlloc(RF, InData%PointStateIsN) + call RegPackAlloc(RF, InData%RodStateIs1) + call RegPackAlloc(RF, InData%RodStateIsN) + call RegPackAlloc(RF, InData%BodyStateIs1) + call RegPackAlloc(RF, InData%BodyStateIsN) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%WaveTi) + call MD_PackContState(RF, InData%xTemp) + call MD_PackContState(RF, InData%xdTemp) + call RegPack(RF, InData%zeros6) + call RegPackAlloc(RF, InData%MDWrOutput) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%PtfmInit) + call RegPackAlloc(RF, InData%BathymetryGrid) + call RegPackAlloc(RF, InData%BathGrid_Xs) + call RegPackAlloc(RF, InData%BathGrid_Ys) + call RegPackAlloc(RF, InData%BathGrid_npoints) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackOutput(RF, OutData) +subroutine MD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(MD_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + type(MD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call MD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call MD_UnpackContState(RF, OutData%dxdt_jac) ! dxdt_jac + call MD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call MD_UnpackOutput(RF, OutData%y_jac) ! y_jac + if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%CoupledLoads(LB(1):UB(1)),stat=stat) + allocate(OutData%LineTypeList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%CoupledLoads(i1)) ! CoupledLoads + call MD_UnpackLineProp(RF, OutData%LineTypeList(i1)) ! LineTypeList end do end if - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%VisLinesMesh)) deallocate(OutData%VisLinesMesh) + if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisLinesMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%RodTypeList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%VisLinesMesh(i1)) ! VisLinesMesh + call MD_UnpackRodProp(RF, OutData%RodTypeList(i1)) ! RodTypeList end do end if - if (allocated(OutData%VisRodsMesh)) deallocate(OutData%VisRodsMesh) + call MD_UnpackBody(RF, OutData%GroundBody) ! GroundBody + if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisRodsMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%BodyList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%VisRodsMesh(i1)) ! VisRodsMesh + call MD_UnpackBody(RF, OutData%BodyList(i1)) ! BodyList end do end if - if (allocated(OutData%VisBodiesMesh)) deallocate(OutData%VisBodiesMesh) + if (allocated(OutData%RodList)) deallocate(OutData%RodList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisBodiesMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%RodList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%VisBodiesMesh(i1)) ! VisBodiesMesh + call MD_UnpackRod(RF, OutData%RodList(i1)) ! RodList end do end if - if (allocated(OutData%VisAnchsMesh)) deallocate(OutData%VisAnchsMesh) + if (allocated(OutData%PointList)) deallocate(OutData%PointList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisAnchsMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%PointList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%VisAnchsMesh(i1)) ! VisAnchsMesh + call MD_UnpackPoint(RF, OutData%PointList(i1)) ! PointList + end do + end if + if (allocated(OutData%LineList)) deallocate(OutData%LineList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%LineList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackLine(RF, OutData%LineList(i1)) ! LineList + end do + end if + if (allocated(OutData%FailList)) deallocate(OutData%FailList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FailList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackFail(RF, OutData%FailList(i1)) ! FailList end do end if + call RegUnpackAlloc(RF, OutData%FreePointIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldPointIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreeRodIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldRodIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreeBodyIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldBodyIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodStateIsN); if (RegCheckErr(RF, RoutineName)) return + 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%WaveTi); if (RegCheckErr(RF, RoutineName)) return + call MD_UnpackContState(RF, OutData%xTemp) ! xTemp + call MD_UnpackContState(RF, OutData%xdTemp) ! xdTemp + call RegUnpack(RF, OutData%zeros6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MDWrOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathymetryGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_Xs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_Ys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_npoints); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) From 7a022ed847a7787f3da0c84d5cdac46013952211 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 15:49:33 +0000 Subject: [PATCH 099/319] Standardize names of module pack/unpack routines --- modules/beamdyn/src/BeamDyn.f90 | 60 +++++++++---------- modules/elastodyn/src/ElastoDyn.f90 | 64 ++++++++++----------- modules/openfast-library/src/FAST_Funcs.f90 | 18 +++--- 3 files changed, 73 insertions(+), 69 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index c2243c19c4..b234d5cb62 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -53,9 +53,9 @@ MODULE BeamDyn PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT - PUBLIC :: BD_PackStateValues, BD_UnpackStateValues - PUBLIC :: BD_PackInputValues, BD_UnpackInputValues - PUBLIC :: BD_PackOutputValues + PUBLIC :: BD_PackStateOP, BD_UnpackStateOP + PUBLIC :: BD_PackInputOP, BD_UnpackInputOP + PUBLIC :: BD_PackOutputOP ! The original formulation kept all states in the inertial reference frame. This has been leading to convergence issues ! when there is a large rotational change from the reference frame (i.e. large turbine yaw, large blade pitch). During @@ -6002,7 +6002,7 @@ logical function Failed() end function Failed end subroutine -subroutine BD_PackStateValues(p, x, Values) +subroutine BD_PackStateOP(p, x, Values) type(BD_ParameterType), intent(in) :: p type(BD_ContinuousStateType), intent(in) :: x real(R8Ki), intent(out) :: Values(:) @@ -6023,7 +6023,7 @@ subroutine BD_PackStateValues(p, x, Values) end do end subroutine -subroutine BD_UnpackStateValues(p, Values, x) +subroutine BD_UnpackStateOP(p, Values, x) type(BD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Values(:) type(BD_ContinuousStateType), intent(inout) :: x @@ -6044,7 +6044,7 @@ subroutine BD_UnpackStateValues(p, Values, x) end do end subroutine -subroutine BD_PackInputValues(p, u, Values) +subroutine BD_PackInputOP(p, u, Values) type(BD_ParameterType), intent(in) :: p type(BD_InputType), intent(in) :: u real(R8Ki), intent(out) :: Values(:) @@ -6053,7 +6053,7 @@ subroutine BD_PackInputValues(p, u, Values) call MV_Pack(p%Vars%u, p%iVarDistrLoad, u%DistrLoad, Values) end subroutine -subroutine BD_UnpackInputValues(p, Ary, u) +subroutine BD_UnpackInputOP(p, Ary, u) type(BD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Ary(:) type(BD_InputType), intent(inout) :: u @@ -6062,7 +6062,7 @@ subroutine BD_UnpackInputValues(p, Ary, u) call MV_Unpack(p%Vars%u, p%iVarDistrLoad, Ary, u%DistrLoad) end subroutine -subroutine BD_PackOutputValues(p, y, Ary, PackWriteOutput) +subroutine BD_PackOutputOP(p, y, Ary, PackWriteOutput) type(BD_ParameterType), intent(in) :: p type(BD_OutputType), intent(in) :: y real(R8Ki), intent(out) :: Ary(:) @@ -6131,7 +6131,7 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Make a copy of the inputs to perturb call BD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackInputValues(p, u, m%Jac%u) + call BD_PackInputOP(p, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -6152,15 +6152,15 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call BD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call BD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -6191,15 +6191,15 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) + call BD_PackStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) + call BD_PackStateOP(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -6289,7 +6289,7 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Copy state values call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, x, m%Jac%x) + call BD_PackStateOP(p, x, m%Jac%x) ! If rotate states is enabled if (p%RotStates) then @@ -6330,15 +6330,15 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call BD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call BD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call BD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call BD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -6378,15 +6378,15 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call BD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) + call BD_PackStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call BD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) + call BD_PackStateOP(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -6608,7 +6608,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackInputValues(p, u, u_op) + call BD_PackInputOP(p, u, u_op) end if @@ -6620,7 +6620,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackOutputValues(p, y, y_op, IsFullLin) + call BD_PackOutputOP(p, y, y_op, IsFullLin) end if @@ -6632,7 +6632,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackStateValues(p, x, x_op) + call BD_PackStateOP(p, x, x_op) end if @@ -6645,7 +6645,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF end if call BD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateValues(p, m%dxdt_lin, dx_op) + call BD_PackStateOP(p, m%dxdt_lin, dx_op) end if diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index a5a32541d8..5169cd1e30 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -64,9 +64,9 @@ MODULE ElastoDyn PUBLIC :: ED_GetOP ! Routine to pack the operating point values (for linearization) into arrays - PUBLIC :: ED_PackStateValues, ED_UnpackStateValues - PUBLIC :: ED_PackInputValues, ED_UnpackInputValues - PUBLIC :: ED_PackOutputValues + PUBLIC :: ED_PackContStateOP, ED_UnpackStateOP + PUBLIC :: ED_PackInputOP, ED_UnpackInputOP + PUBLIC :: ED_PackOutputOP PUBLIC :: ED_UpdateAzimuth @@ -10404,7 +10404,7 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Update copy of the inputs to perturb call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackInputValues(p, u, m%Jac%u) + call ED_PackInputOP(p, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -10433,15 +10433,15 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call ED_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call ED_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call ED_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call ED_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -10472,15 +10472,15 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call ED_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) + call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call ED_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) + call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -10538,7 +10538,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable indexing number + INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable flag filter REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] @@ -10548,7 +10548,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc + integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col ! Initialize ErrStat @@ -10567,7 +10567,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Copy state values call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, x, m%Jac%x) + call ED_PackContStateOP(p, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then @@ -10588,15 +10588,15 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call ED_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call ED_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -10627,15 +10627,15 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dxdt_lin, m%Jac%x_pos) + call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dxdt_lin, m%Jac%x_neg) + call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -10861,7 +10861,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, end if ! Pack input type into array - call ED_PackInputValues(p, u, u_op) + call ED_PackInputOP(p, u, u_op) ! If full linearization, check extended inputs if (IsFullLin) then @@ -10882,7 +10882,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call ED_PackOutputValues(p, y, y_op, IsFullLin) + call ED_PackOutputOP(p, y, y_op, IsFullLin) end if @@ -10893,7 +10893,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call ED_PackStateValues(p, x, x_op) + call ED_PackContStateOP(p, x, x_op) end if @@ -10905,7 +10905,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, end if call ED_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackStateValues(p, m%dxdt_lin, dx_op) + call ED_PackContStateOP(p, m%dxdt_lin, dx_op) end if @@ -11376,7 +11376,7 @@ logical function Failed() end function Failed end subroutine -subroutine ED_PackStateValues(p, x, ary) +subroutine ED_PackContStateOP(p, x, ary) type(ED_ParameterType), intent(in) :: p type(ED_ContinuousStateType), intent(in) :: x real(R8Ki), intent(out) :: ary(:) @@ -11393,7 +11393,7 @@ subroutine ED_PackStateValues(p, x, ary) end do end subroutine -subroutine ED_UnpackStateValues(p, ary, x) +subroutine ED_UnpackStateOP(p, ary, x) type(ED_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: ary(:) type(ED_ContinuousStateType), intent(inout) :: x @@ -11408,7 +11408,7 @@ subroutine ED_UnpackStateValues(p, ary, x) end do end subroutine -subroutine ED_PackInputValues(p, u, Ary) +subroutine ED_PackInputOP(p, u, Ary) type(ED_ParameterType), intent(in) :: p type(ED_InputType), intent(in) :: u real(R8Ki), intent(out) :: Ary(:) @@ -11429,7 +11429,7 @@ subroutine ED_PackInputValues(p, u, Ary) call MV_Pack(p%Vars%u, p%iVarBlPitchComC, u%BlPitchCom(1), Ary) end subroutine -subroutine ED_UnpackInputValues(p, Ary, u) +subroutine ED_UnpackInputOP(p, Ary, u) type(ED_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Ary(:) type(ED_InputType), intent(inout) :: u @@ -11449,7 +11449,7 @@ subroutine ED_UnpackInputValues(p, Ary, u) call MV_Unpack(p%Vars%u, p%iVarGenTrq, Ary, u%GenTrq) end subroutine -subroutine ED_PackOutputValues(p, y, Ary, PackWriteOutput) +subroutine ED_PackOutputOP(p, y, Ary, PackWriteOutput) type(ED_ParameterType), intent(in) :: p type(ED_OutputType), intent(in) :: y real(R8Ki), intent(out) :: Ary(:) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index b165502c79..1b7756f282 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -315,9 +315,9 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS os_BD => T%BD%OtherSt(ModData%Ins, STATE_PRED)) ! Transfer tight coupling states to module - call BD_PackStateValues(p_BD, x_BD, m_BD%Jac%x) + call BD_PackStateOP(p_BD, x_BD, m_BD%Jac%x) ! call XferGblToLoc1D(ModData%ixs, x_TC, m_BD%Jac%x) - call BD_UnpackStateValues(p_BD, m_BD%Jac%x, x_BD) + call BD_UnpackStateOP(p_BD, m_BD%Jac%x, x_BD) ! TODO: Fix state reset ! Set BD accelerations and algorithmic accelerations from q matrix @@ -349,7 +349,7 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! end do ! Transfer updated states to solver - call BD_PackStateValues(p_BD, x_BD, m_BD%Jac%x) + call BD_PackStateOP(p_BD, x_BD, m_BD%Jac%x) ! call XferLocToGbl1D(ModData%ixs, m_BD%Jac%x, x_TC) end associate @@ -359,15 +359,15 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS u_ED => T%ED%Input(1), x_ED => T%ED%x(STATE_PRED)) ! Transfer tight coupling states to module - call ED_PackStateValues(p_ED, x_ED, m_ED%Jac%x) + call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) ! call XferGblToLoc1D(ModData%ixs, x_TC, m_ED%Jac%x) - call ED_UnpackStateValues(p_ED, m_ED%Jac%x, x_ED) + call ED_UnpackStateOP(p_ED, m_ED%Jac%x, x_ED) ! Update the azimuth angle call ED_UpdateAzimuth(p_ED, x_ED, T%p_FAST%DT) ! Transfer updated states to solver - call ED_PackStateValues(p_ED, x_ED, m_ED%Jac%x) + call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) ! call XferLocToGbl1D(ModData%ixs, m_ED%Jac%x, x_TC) end associate @@ -577,7 +577,11 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt T%MAP%OtherSt, T%MAP%y, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op) !, x_op=x_op, dx_op=dx_op) MAP doesn't have states -! case (Module_MD) + case (Module_MD) + call MD_GetOP(ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(ThisState), T%MD%xd(ThisState), T%MD%z(ThisState), & + T%MD%OtherSt(ThisState), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! case (Module_OpFM) ! case (Module_Orca) case (Module_SD) From d881246c06cae4f38a64a3ad9dc9c2194b0814d3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 21:06:36 +0000 Subject: [PATCH 100/319] Added SubDyn Linearization --- modules/openfast-library/src/FAST_Funcs.f90 | 20 +- modules/openfast-library/src/FAST_Mapping.f90 | 23 +- modules/openfast-library/src/FAST_Subs.f90 | 4 + modules/subdyn/src/SubDyn.f90 | 673 +++-- modules/subdyn/src/SubDyn_Registry.txt | 83 +- modules/subdyn/src/SubDyn_Types.f90 | 2477 +++++++++-------- 6 files changed, 1821 insertions(+), 1459 deletions(-) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 1b7756f282..93131b7ca0 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -663,10 +663,10 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, T%MD%z(ThisState), T%MD%OtherSt(ThisState), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) -! case (Module_SD) -! call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & -! T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, & -! ErrStat2, ErrMsg2, FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + case (Module_SD) + call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) case (Module_SrvD) call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & @@ -752,12 +752,12 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) -! case (Module_SD) -! call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & -! T%SD%x(ThisState), T%SD%xd(ThisState), & -! T%SD%z(ThisState), T%SD%OtherSt(ThisState), & -! T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & -! FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + case (Module_SD) + call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & + T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) case (Module_SrvD) call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(1), T%SrvD%p, & diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index b00d54c6ad..ecaf84f972 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -396,7 +396,28 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) SrcMod%SrcMaps = [SrcMod%SrcMaps, iMap] DstMod%DstMaps = [DstMod%DstMaps, iMap] - write (*, *) Mappings(iMap)%Desc + write (*, *) "Mapping: ", Mappings(iMap)%Desc + ! write (*, *) " Src: ", trim(SrcMod%Abbr), SrcMod%Ins + ! if (Mappings(iMap)%iLocSrcTransDisp(1) > 0) write (*, *) " iLocTransDisp ", Mappings(iMap)%iLocSrcTransDisp + SrcMod%iyg - 1 + ! if (Mappings(iMap)%iLocSrcTransVel(1) > 0) write (*, *) " iLocTransVel ", Mappings(iMap)%iLocSrcTransVel + SrcMod%iyg - 1 + ! if (Mappings(iMap)%iLocSrcTransAcc(1) > 0) write (*, *) " iLocTransAcc ", Mappings(iMap)%iLocSrcTransAcc + SrcMod%iyg - 1 + ! if (Mappings(iMap)%iLocSrcOrientation(1) > 0) write (*, *) " iLocOrientation ", Mappings(iMap)%iLocSrcOrientation + SrcMod%iyg - 1 + ! if (Mappings(iMap)%iLocSrcAngularVel(1) > 0) write (*, *) " iLocAngularVel ", Mappings(iMap)%iLocSrcAngularVel + SrcMod%iyg - 1 + ! if (Mappings(iMap)%iLocSrcAngularAcc(1) > 0) write (*, *) " iLocAngularAcc ", Mappings(iMap)%iLocSrcAngularAcc + SrcMod%iyg - 1 + ! if (Mappings(iMap)%iLocSrcForce(1) > 0) write (*, *) " iLocForce ", Mappings(iMap)%iLocSrcForce + SrcMod%iyg - 1 + ! if (Mappings(iMap)%iLocSrcMoment(1) > 0) write (*, *) " iLocMoment ", Mappings(iMap)%iLocSrcMoment + SrcMod%iyg - 1 + ! if (Mappings(iMap)%iLocSrcDispTransDisp(1) > 0) write (*, *) " iLocDispTransDisp ", Mappings(iMap)%iLocSrcDispTransDisp + SrcMod%iyg - 1 + ! write (*, *) " Dst: ", trim(DstMod%Abbr), DstMod%Ins + ! if (Mappings(iMap)%iLocDstTransDisp(1) > 0) write (*, *) " iLocTransDisp ", Mappings(iMap)%iLocDstTransDisp + ! if (Mappings(iMap)%iLocDstTransVel(1) > 0) write (*, *) " iLocTransVel ", Mappings(iMap)%iLocDstTransVel + ! if (Mappings(iMap)%iLocDstTransAcc(1) > 0) write (*, *) " iLocTransAcc ", Mappings(iMap)%iLocDstTransAcc + ! if (Mappings(iMap)%iLocDstOrientation(1) > 0) write (*, *) " iLocOrientation ", Mappings(iMap)%iLocDstOrientation + ! if (Mappings(iMap)%iLocDstAngularVel(1) > 0) write (*, *) " iLocAngularVel ", Mappings(iMap)%iLocDstAngularVel + ! if (Mappings(iMap)%iLocDstAngularAcc(1) > 0) write (*, *) " iLocAngularAcc ", Mappings(iMap)%iLocDstAngularAcc + ! if (Mappings(iMap)%iLocDstForce(1) > 0) write (*, *) " iLocForce ", Mappings(iMap)%iLocDstForce + ! if (Mappings(iMap)%iLocDstMoment(1) > 0) write (*, *) " iLocMoment ", Mappings(iMap)%iLocDstMoment + ! if (Mappings(iMap)%iLocDstDispTransDisp(1) > 0) write (*, *) " iLocDispTransDisp ", Mappings(iMap)%iLocDstDispTransDisp + ! if (Mappings(iMap)%iLocDstDispOrientation(1) > 0) write (*, *) " iLocDispOrientation ", Mappings(iMap)%iLocDstDispOrientation end associate end do diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 5837ad66fe..9e46a25978 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1078,6 +1078,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_SD%DerivOrder_x)) call move_alloc(Init%OutData_SD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%DerivOrder_x) end if + CALL MV_AddModule(y_FAST%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & + Init%OutData_SD%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 29e79a6b52..b745ee98cc 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -48,6 +48,8 @@ Module SubDyn PUBLIC :: SD_JacobianPConstrState ! PUBLIC :: SD_GetOP ! PUBLIC :: SD_ProgDesc + PUBLIC :: SD_PackStateOP, SD_PackInputOP, SD_PackOutputOP + PUBLIC :: SD_UnpackStateOP, SD_UnpackInputOP CONTAINS @@ -386,9 +388,8 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO CALL SDOUT_OpenOutput( SD_ProgDesc, Init%RootName, p, InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return END IF - if (InitInput%Linearize) then - call SD_Init_Jacobian(Init, p, u, y, InitOut, ErrStat2, ErrMsg2); if(Failed()) return - endif + ! Initialize module variables + call SD_InitVars(Init, u, p, x, y, m, InitOut, InitInput%Linearize, ErrStat2, ErrMsg2); if(Failed()) return ! Tell GLUECODE the SubDyn timestep interval Interval = p%SDdeltaT @@ -413,6 +414,184 @@ END SUBROUTINE CleanUp END SUBROUTINE SD_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> SD_InitVars initializes the variables for this module for use by the solver and linearization +subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(SD_InitType), intent(in) :: Init !< Input data for initialization routine + type(SD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SD_ParameterType), intent(inout) :: p !< Parameters + type(SD_ContinuousStateType), intent(inout) :: x !< Continuous State + type(SD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SD_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + integer(IntKi) :: i, j + real(ReKi) :: dx, dy, dz, maxDim + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + call MV_AddVar(p%Vars%x, "Modes", VF_Scalar, p%nDOFM, jUsr=1, DerivOrder=0, & + Perturb=2.0_ReKi*D2R_D, & + LinNames=[('Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -', i=1, p%nDOFM)]) + + call MV_AddVar(p%Vars%x, "Modes", VF_Scalar, p%nDOFM, jUsr=2, DerivOrder=1, & + Perturb=2.0_ReKi*D2R_D, & + LinNames=[('First time derivative of Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -/s', i=1, p%nDOFM)]) + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) + dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) + dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) + maxDim = max(dx, dy, dz) + + call MV_AddMeshVar(p%Vars%u, "TPMesh", MotionFields, Mesh=u%TPMesh, & + VarIdx=p%iVarTPMesh, & + Perturbs=[2.0_R8Ki*D2R_D, & ! TranslationDisp + 2.0_R8Ki*D2R_D, & ! Orientation + 2.0_R8Ki*D2R_D, & ! TranslationVel + 2.0_R8Ki*D2R_D, & ! RotationVel + 2.0_R8Ki*D2R_D, & ! TranslationAcc + 2.0_R8Ki*D2R_D]) ! RotationAcc + call MV_AddMeshVar(p%Vars%u, "LMesh", LoadFields, Mesh=u%LMesh, & + VarIdx=p%iVarLMesh, & + Perturbs=[170*maxDim**2, 14*maxDim**3]) ! Force, Moment + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! Mesh variables + call MV_AddMeshVar(p%Vars%y, 'Y1Mesh', LoadFields, & + VarIdx=p%iVarY1Mesh, & + Mesh=y%Y1Mesh) + call MV_AddMeshVar(p%Vars%y, 'Y2Mesh', MotionFields, & + VarIdx=p%iVarY2Mesh, & + Mesh=y%Y2Mesh) + call MV_AddMeshVar(p%Vars%y, 'Y3Mesh', MotionFields, & + VarIdx=p%iVarY3Mesh, & + Mesh=y%Y3Mesh) + + ! Output variables + call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, Num=p%NumOuts, & + VarIdx=p%iVarWriteOutput, & + LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call SD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SD_CopyContState(x, m%dxdt_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SD_CopyOutput(y, m%y_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +subroutine SD_PackStateOP(p, x, op) + type(SD_ParameterType), intent(in) :: p + type(SD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: op(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + associate(Var => p%Vars%x(i)) + select case(Var%jUsr) + case (1) + op(Var%iLoc(1):Var%iLoc(2)) = x%qm + case (2) + op(Var%iLoc(1):Var%iLoc(2)) = x%qmdot + end select + end associate + end do +end subroutine + +subroutine SD_UnpackStateOP(p, op, x) + type(SD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(SD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + associate(Var => p%Vars%x(i)) + select case(Var%jUsr) + case (1) + x%qm = op(Var%iLoc(1):Var%iLoc(2)) + case (2) + x%qmdot = op(Var%iLoc(1):Var%iLoc(2)) + end select + end associate + end do +end subroutine + +subroutine SD_PackInputOP(p, u, op) + type(SD_ParameterType), intent(in) :: p + type(SD_InputType), intent(in) :: u + real(R8Ki), intent(out) :: op(:) + call MV_Pack(p%Vars%u, p%iVarTPMesh, u%TPMesh, op) + call MV_Pack(p%Vars%u, p%iVarLMesh, u%LMesh, op) +end subroutine + +subroutine SD_UnpackInputOP(p, op, u) + type(SD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(SD_InputType), intent(inout) :: u + call MV_Unpack(p%Vars%u, p%iVarTPMesh, op, u%TPMesh) + call MV_Unpack(p%Vars%u, p%iVarLMesh, op, u%LMesh) +end subroutine + +subroutine SD_PackOutputOP(p, y, op, PackWriteOutput) + type(SD_ParameterType), intent(in) :: p + type(SD_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: op(:) + logical, intent(in) :: PackWriteOutput + call MV_Pack(p%Vars%y, p%iVarY1Mesh, y%Y1Mesh, op) + call MV_Pack(p%Vars%y, p%iVarY2Mesh, y%Y2Mesh, op) + call MV_Pack(p%Vars%y, p%iVarY3Mesh, y%Y3Mesh, op) + if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, op) +end subroutine + +subroutine SD_UnpackOutputOP(p, op, y) + type(SD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: op(:) + type(SD_OutputType), intent(out) :: y + call MV_Unpack(p%Vars%y, p%iVarY1Mesh, op, y%Y1Mesh) + call MV_Unpack(p%Vars%y, p%iVarY2Mesh, op, y%Y2Mesh) + call MV_Unpack(p%Vars%y, p%iVarY3Mesh, op, y%Y3Mesh) + call MV_Unpack(p%Vars%y, p%iVarWriteOutput, op, y%WriteOutput) +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. !! Continuous, discrete, constraint, and other states are updated for t + Interval. @@ -1944,7 +2123,7 @@ END SUBROUTINE SD_AM2 !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdu, dXdu, dXddu, dZdu) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1956,107 +2135,130 @@ SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] - ! local variables - TYPE(SD_OutputType) :: y_m, y_p - TYPE(SD_ContinuousStateType) :: x_m, x_p - TYPE(SD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_JacobianPInput' - ! Initialize ErrStat + + character(*), parameter :: RoutineName = 'SD_JacobianPInput' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + integer(IntKi) :: i, j, k, col + ErrStat = ErrID_None ErrMsg = '' - ! get OP values here: - call SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return - ! make a copy of the inputs to perturb - call SD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if + + ! Calculate OP values here + call SD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return + + ! Make a copy of the inputs to perturb + call SD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if(Failed()) return + call SD_PackInputOP(p, u, m%Jac%u) + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then + + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call SD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - call SD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta_p u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute y at u_op + delta_p u - call SD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta_m u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute y at u_op - delta_m u - call SD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call SD_Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputOP(p, m%y_jac, m%Jac%y_pos, IsFullLin) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputOP(p, m%y_jac, m%Jac%y_neg, IsFullLin) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do end do - if(Failed()) return - END IF - IF ( PRESENT( dXdu ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! TODO: dXdu should be constant, in theory we dont' need to recompute it - !if(ANALYTICAL_LIN) then - ! Analytical lin cannot be used anymore with extra mom - ! call StateMatrices(p, ErrStat2, ErrMsg2, BB=dXdu); if(Failed()) return ! Allocation occurs in function - !else - if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return - endif - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute x at u_op + delta u - call SD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute x at u_op - delta u - call SD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - ! we may have had an error allocating memory, so we'll check - if(Failed()) return - ! get central difference: - call SD_Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu) .and. (p%Vars%Nx > 0)) then + + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + endif + + ! Loop through input variables + do i = 1,size(p%Vars%u) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%Num + + ! Calculate positive perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackStateOP(p, m%dxdt_jac, m%Jac%x_pos) + + ! Calculate negative perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackStateOP(p, m%dxdt_jac, m%Jac%x_neg) + + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) end do - !endif ! analytical or numerical - END IF ! dXdu - IF ( PRESENT( dXddu ) ) THEN + end do + end if + + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF - IF ( PRESENT( dZdu ) ) THEN + end if + + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF - call CleanUp() -contains + end if +contains logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev end function Failed - - subroutine CleanUp() - call SD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call SD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - call SD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call SD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call SD_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - END SUBROUTINE SD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE SD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE SD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, dXddx, dZdx) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -2068,107 +2270,138 @@ SUBROUTINE SD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) wrt the continuous states (x) [intent in to avoid deallocation] - ! local variables - TYPE(SD_OutputType) :: y_p, y_m - TYPE(SD_ContinuousStateType) :: x_p, x_m - TYPE(SD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k - INTEGER(IntKi) :: idx - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_JacobianPContState' + + character(*), parameter :: RoutineName = 'SD_JacobianPContState' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + logical :: IsFullLin + integer(IntKi) :: FlagFilterLoc + integer(IntKi) :: i, j, k, col + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + + ! If no state variables, return + if (p%Vars%Nx == 0) return + + ! Set full linearization flag and local filter flag + if (present(FlagFilter)) then + IsFullLin = FlagFilter == VF_None + FlagFilterLoc = FlagFilter + else + IsFullLin = .true. + FlagFilterLoc = VF_None + end if + ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY - call SD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + call SD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if(Failed()) return + call SD_PackStateOP(p, x, m%Jac%x) + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then + + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%Jac_nx*2, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call SD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - idx = 1 - do k=1,2 ! 1=disp, 2=veloc - do i=1,p%Jac_nx ! CB mode - ! get x_op + delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, 1, x_perturb, delta ) - ! compute y at x_op + delta x - call SD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, -1, x_perturb, delta ) - ! compute y at x_op - delta x - call SD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call SD_Compute_dY( p, y_p, y_m, delta, dYdx(:,idx) ) - idx = idx+1 + + ! Loop through state variables + do i = 1,size(p%Vars%x) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputOP(p, m%y_jac, m%Jac%y_pos, IsFullLin) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputOP(p, m%y_jac, m%Jac%y_neg, IsFullLin) + + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do - if(Failed()) return - END IF - IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - ! TODO: dXdx should be constant, in theory we don't need to recompute it - if(ANALYTICAL_LIN) then - call StateMatrices(p, ErrStat2, ErrMsg2, AA=dXdx); if(Failed()) return ! Allocation occurs in function + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! TODO: dXdx should be constant, in theory we don't need to recompute it + if (present(dXdx)) then + + ! If analytical linearization is enabled + if (ANALYTICAL_LIN) then + + ! Calculate dXdx as state matrix, allocation occurs in function + call StateMatrices(p, ErrStat2, ErrMsg2, AA=dXdx); if(Failed()) return + else + + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Jac_nx * 2, p%Jac_nx * 2, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return end if - idx = 1 ! counter into dXdx - do k=1,2 ! 1=positions (x_perturb%q); 2=velocities (x_perturb%dqdt) - do i=1,p%Jac_nx - ! get x_op + delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, 1, x_perturb, delta ) - ! compute x at x_op + delta x - call SD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, -1, x_perturb, delta ) - ! compute x at x_op - delta x - call SD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if(Failed()) return - ! get central difference: - call SD_Compute_dX( p, x_p, x_m, delta, dXdx(:,idx) ) - idx = idx+1 + + ! Loop through state variables + do i = 1,size(p%Vars%x) + + ! If variable flag not in flag filter, skip + if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1, p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackContStateOP(p, m%dxdt_jac, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackContStateOP(p, m%dxdt_jac, m%Jac%x_neg) + + ! Calculate column index + col = p%Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) end do end do endif ! analytical or numerical - END IF - IF ( PRESENT( dXddx ) ) THEN + end if + + if (present(dXddx)) then if (allocated(dXddx)) deallocate(dXddx) - END IF - IF ( PRESENT( dZdx ) ) THEN + end if + + if (present(dZdx)) then if (allocated(dZdx)) deallocate(dZdx) - END IF - call CleanUp() + end if contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_JacobianPContState') + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() end function Failed - - subroutine CleanUp() - call SD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call SD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call SD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call SD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call SD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - END SUBROUTINE SD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- @@ -2259,107 +2492,53 @@ SUBROUTINE SD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - ! Local - INTEGER(IntKi) :: idx, i - LOGICAL :: ReturnTrimOP - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - TYPE(SD_ContinuousStateType) :: dx ! derivative of continuous states at operating point + CHARACTER(*), PARAMETER :: RoutineName = 'SD_GetOP' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( u_op ) ) THEN - nu = size(p%Jac_u_indx,1) + u%TPMesh%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + + if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return end if - idx = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(u%TPMesh, u_op, idx, FieldMask=FieldMask) - call PackLoadMesh(u%LMesh, u_op, idx) - END IF + call SD_PackInputOP(p, u, u_op) + end if - IF ( PRESENT( y_op ) ) THEN - ny = p%Jac_ny + y%Y2Mesh%NNodes * 6 + y%Y3Mesh%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .false. + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return end if - - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array - - idx = 1 - call PackLoadMesh(y%Y1Mesh, y_op, idx) - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(y%Y2Mesh, y_op, idx, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%Y3Mesh, y_op, idx, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - idx = idx - 1 - do i=1,p%NumOuts - y_op(i+idx) = y%WriteOutput(i) - end do - END IF + call SD_PackOutputOP(p, y, y_op, .true.) + end if - IF ( PRESENT( x_op ) ) THEN + if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx*2,'x_op',ErrStat2,ErrMsg2); if (Failed()) return + call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - do i=1, p%Jac_nx - x_op(i) = x%qm(i) - end do - do i=1, p%Jac_nx - x_op(i+p%nDOFM) = x%qmdot(i) - end do - END IF - IF ( PRESENT( dx_op ) ) THEN + call SD_PackStateOP(p, x, x_op) + end if + + if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx * 2,'dx_op',ErrStat2,ErrMsg2); if(failed()) return + call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if(failed()) return end if - call SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) ; if(Failed()) return - idx = 1 - do i=1, p%Jac_nx - dx_op(i) = dx%qm(i) - end do - do i=1, p%Jac_nx - dx_op(i+p%nDOFM) = dx%qmdot(i) - end do - END IF - IF ( PRESENT( xd_op ) ) THEN - ! pass - END IF - IF ( PRESENT( z_op ) ) THEN - ! pass - END IF - call CleanUp() + call SD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if(Failed()) return + call SD_PackStateOP(p, m%dxdt_jac, dx_op) + end if + + if (present(xd_op)) then + end if + + if (present(z_op)) then + end if + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() end function Failed - - subroutine CleanUp() - call SD_DestroyContState(dx, ErrStat2, ErrMsg2); - end subroutine END SUBROUTINE SD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !------------------------------------------------------------------------------------------------------ diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index ecc7a0f1bd..3caf46913e 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -80,6 +80,7 @@ typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # Linearization typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - @@ -159,42 +160,14 @@ typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variab typedef ^ OtherStateType SD_ContinuousStateType xdot {:} - - "previous state derivs for m-step time integrator" typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated last" -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" -typedef ^ MiscVarType ReKi u_TP 6 - - -typedef ^ MiscVarType ReKi udot_TP 6 - - -typedef ^ MiscVarType ReKi udotdot_TP 6 - - -typedef ^ MiscVarType ReKi F_L {:} - - "Loads on internal DOF, size nL" -typedef ^ MiscVarType ReKi F_L2 {:} - - "Loads on internal DOF, size nL, used for SIM and ADM4" -typedef ^ MiscVarType ReKi UR_bar {:} - - -typedef ^ MiscVarType ReKi UR_bar_dot {:} - - -typedef ^ MiscVarType ReKi UR_bar_dotdot {:} - - -typedef ^ MiscVarType ReKi UL {:} - - "Internal DOFs (L) displacements " -typedef ^ MiscVarType ReKi UL_NS {:} - - "Internal DOFs (L) displacements, No SIM (NS)" -typedef ^ MiscVarType ReKi UL_dot {:} - - -typedef ^ MiscVarType ReKi UL_dotdot {:} - - -typedef ^ MiscVarType ReKi DU_full {:} - - "Delta U used for extra moment, size nDOF" -typedef ^ MiscVarType ReKi U_full {:} - - "Displacement of all DOFs (full system) with SIM" -typedef ^ MiscVarType ReKi U_full_NS {:} - - "Displacement of all DOFs (full system), No SIM (NS)" -typedef ^ MiscVarType ReKi U_full_dot {:} - - -typedef ^ MiscVarType ReKi U_full_dotdot {:} - - -typedef ^ MiscVarType ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM" -typedef ^ MiscVarType ReKi U_red {:} - - -typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N -typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" -typedef ^ MiscVarType ReKi AllOuts {:} - - "Data for output file" -typedef ^ MiscVarType DbKi LastOutTime - - - "The time of the most recent stored output data" "s" -typedef ^ MiscVarType IntKi Decimat - - - "Current output decimation counter" "-" -typedef ^ MiscVarType ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" -typedef ^ MiscVarType ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" -# SIM -typedef ^ MiscVarType ReKi UL_SIM {:} - - "UL for SIM = PhiL qL0- PhiM qm0, size nL" -typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermediate UL term for SIM = PhiM qm0, size nL" -### data for writing to an output file (this data is associated with time, but saved/written in CalcOutput so not stored as an other state) ### - # ============================== Parameters ============================================================================================================================================ +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" +typedef ^ ParameterType IntKi iVarTPMesh - 0 - "Variable index for TPMesh" +typedef ^ ParameterType IntKi iVarLMesh - 0 - "Variable index for LMesh" +typedef ^ ParameterType IntKi iVarY1Mesh - 0 - "Variable index for Y1Mesh" +typedef ^ ParameterType IntKi iVarY2Mesh - 0 - "Variable index for Y2Mesh" +typedef ^ ParameterType IntKi iVarY3Mesh - 0 - "Variable index for Y3Mesh" +typedef ^ ParameterType IntKi iVarWriteOutput - 0 - "Variable index for WriteOutput" # --- Parameters - Algo typedef ^ ParameterType DbKi SDDeltaT - - - "Time step (for integration of continuous states)" seconds typedef ^ ParameterType IntKi IntMethod - - - "Integration Method (1/2/3)Length of y2 array" @@ -317,3 +290,43 @@ typedef ^ OutputType MeshType Y1Mesh - - - "Transition piece outp typedef ^ OutputType MeshType Y2Mesh - - - "Interior+Interface nodes rigid body displacements + elastic velocities and accelerations on a point mesh" typedef ^ OutputType MeshType Y3Mesh - - - "Interior+Interface nodes full elastic displacements/velocities and accelerations on a point mesh" typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file" + +# ============================== Misc/Optimization variables ======================================================================================================================== +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ MiscVarType SD_ContinuousStateType x_perturb - - - "" +typedef ^ MiscVarType SD_ContinuousStateType dxdt_jac - - - "" +typedef ^ MiscVarType SD_InputType u_perturb - - - "" +typedef ^ MiscVarType SD_OutputType y_jac - - - "" +typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" +typedef ^ MiscVarType ReKi u_TP 6 - - +typedef ^ MiscVarType ReKi udot_TP 6 - - +typedef ^ MiscVarType ReKi udotdot_TP 6 - - +typedef ^ MiscVarType ReKi F_L {:} - - "Loads on internal DOF, size nL" +typedef ^ MiscVarType ReKi F_L2 {:} - - "Loads on internal DOF, size nL, used for SIM and ADM4" +typedef ^ MiscVarType ReKi UR_bar {:} - - +typedef ^ MiscVarType ReKi UR_bar_dot {:} - - +typedef ^ MiscVarType ReKi UR_bar_dotdot {:} - - +typedef ^ MiscVarType ReKi UL {:} - - "Internal DOFs (L) displacements " +typedef ^ MiscVarType ReKi UL_NS {:} - - "Internal DOFs (L) displacements, No SIM (NS)" +typedef ^ MiscVarType ReKi UL_dot {:} - - +typedef ^ MiscVarType ReKi UL_dotdot {:} - - +typedef ^ MiscVarType ReKi DU_full {:} - - "Delta U used for extra moment, size nDOF" +typedef ^ MiscVarType ReKi U_full {:} - - "Displacement of all DOFs (full system) with SIM" +typedef ^ MiscVarType ReKi U_full_NS {:} - - "Displacement of all DOFs (full system), No SIM (NS)" +typedef ^ MiscVarType ReKi U_full_dot {:} - - +typedef ^ MiscVarType ReKi U_full_dotdot {:} - - +typedef ^ MiscVarType ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM" +typedef ^ MiscVarType ReKi U_red {:} - - +typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N +typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" +typedef ^ MiscVarType ReKi AllOuts {:} - - "Data for output file" +typedef ^ MiscVarType DbKi LastOutTime - - - "The time of the most recent stored output data" "s" +typedef ^ MiscVarType IntKi Decimat - - - "Current output decimation counter" "-" +typedef ^ MiscVarType ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" +typedef ^ MiscVarType ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" +# SIM +typedef ^ MiscVarType ReKi UL_SIM {:} - - "UL for SIM = PhiL qL0- PhiM qm0, size nL" +typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermediate UL term for SIM = PhiM qm0, size nL" +### data for writing to an output file (this data is associated with time, but saved/written in CalcOutput so not stored as an other state) ### diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 2bdb2c7960..5bcfe8a312 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -124,6 +124,7 @@ MODULE SubDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -216,41 +217,15 @@ MODULE SubDyn_Types INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated last [-] END TYPE SD_OtherStateType ! ======================= -! ========= SD_MiscVarType ======= - TYPE, PUBLIC :: SD_MiscVarType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] - REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL !< Internal DOFs (L) displacements [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_NS !< Internal DOFs (L) displacements, No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< The time of the most recent stored output data [s] - INTEGER(IntKi) :: Decimat = 0_IntKi !< Current output decimation counter [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] - END TYPE SD_MiscVarType -! ======================= ! ========= SD_ParameterType ======= TYPE, PUBLIC :: SD_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarTPMesh = 0 !< Variable index for TPMesh [-] + INTEGER(IntKi) :: iVarLMesh = 0 !< Variable index for LMesh [-] + INTEGER(IntKi) :: iVarY1Mesh = 0 !< Variable index for Y1Mesh [-] + INTEGER(IntKi) :: iVarY2Mesh = 0 !< Variable index for Y2Mesh [-] + INTEGER(IntKi) :: iVarY3Mesh = 0 !< Variable index for Y3Mesh [-] + INTEGER(IntKi) :: iVarWriteOutput = 0 !< Variable index for WriteOutput [-] REAL(DbKi) :: SDDeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1/2/3)Length of y2 array [-] INTEGER(IntKi) :: nDOF = 0_IntKi !< Total degree of freedom [-] @@ -371,6 +346,44 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file [-] END TYPE SD_OutputType ! ======================= +! ========= SD_MiscVarType ======= + TYPE, PUBLIC :: SD_MiscVarType + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(SD_ContinuousStateType) :: x_perturb !< [-] + TYPE(SD_ContinuousStateType) :: dxdt_jac !< [-] + TYPE(SD_InputType) :: u_perturb !< [-] + TYPE(SD_OutputType) :: y_jac !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] + REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL !< Internal DOFs (L) displacements [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_NS !< Internal DOFs (L) displacements, No SIM (NS) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< The time of the most recent stored output data [s] + INTEGER(IntKi) :: Decimat = 0_IntKi !< Current output decimation counter [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] + END TYPE SD_MiscVarType +! ======================= CONTAINS subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) @@ -1007,6 +1020,7 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) @@ -1134,6 +1148,7 @@ subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1167,10 +1182,18 @@ subroutine SD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(SD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPackAlloc(RF, InData%LinNames_y) call RegPackAlloc(RF, InData%LinNames_x) call RegPackAlloc(RF, InData%LinNames_u) @@ -1190,10 +1213,30 @@ subroutine SD_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return @@ -2051,1355 +2094,916 @@ subroutine SD_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SD_MiscVarType), intent(in) :: SrcMiscData - type(SD_MiscVarType), intent(inout) :: DstMiscData +subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SD_ParameterType), intent(in) :: SrcParamData + type(SD_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'SD_CopyMisc' + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%qmdotdot)) then - LB(1:1) = lbound(SrcMiscData%qmdotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%qmdotdot, kind=B8Ki) - if (.not. allocated(DstMiscData%qmdotdot)) then - allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%qmdotdot = SrcMiscData%qmdotdot + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end if - DstMiscData%u_TP = SrcMiscData%u_TP - DstMiscData%udot_TP = SrcMiscData%udot_TP - DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP - if (allocated(SrcMiscData%F_L)) then - LB(1:1) = lbound(SrcMiscData%F_L, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_L, kind=B8Ki) - if (.not. allocated(DstMiscData%F_L)) then - allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) + DstParamData%iVarTPMesh = SrcParamData%iVarTPMesh + DstParamData%iVarLMesh = SrcParamData%iVarLMesh + DstParamData%iVarY1Mesh = SrcParamData%iVarY1Mesh + DstParamData%iVarY2Mesh = SrcParamData%iVarY2Mesh + DstParamData%iVarY3Mesh = SrcParamData%iVarY3Mesh + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput + DstParamData%SDDeltaT = SrcParamData%SDDeltaT + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%nDOF = SrcParamData%nDOF + DstParamData%nDOF_red = SrcParamData%nDOF_red + DstParamData%Nmembers = SrcParamData%Nmembers + if (allocated(SrcParamData%Elems)) then + LB(1:2) = lbound(SrcParamData%Elems, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Elems, kind=B8Ki) + if (.not. allocated(DstParamData%Elems)) then + allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%F_L = SrcMiscData%F_L + DstParamData%Elems = SrcParamData%Elems end if - if (allocated(SrcMiscData%F_L2)) then - LB(1:1) = lbound(SrcMiscData%F_L2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_L2, kind=B8Ki) - if (.not. allocated(DstMiscData%F_L2)) then - allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%ElemProps)) then + LB(1:1) = lbound(SrcParamData%ElemProps, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ElemProps, kind=B8Ki) + if (.not. allocated(DstParamData%ElemProps)) then + allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%F_L2 = SrcMiscData%F_L2 + do i1 = LB(1), UB(1) + call SD_CopyElemPropType(SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMiscData%UR_bar)) then - LB(1:1) = lbound(SrcMiscData%UR_bar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar, kind=B8Ki) - if (.not. allocated(DstMiscData%UR_bar)) then - allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%FG)) then + LB(1:1) = lbound(SrcParamData%FG, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FG, kind=B8Ki) + if (.not. allocated(DstParamData%FG)) then + allocate(DstParamData%FG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UR_bar = SrcMiscData%UR_bar + DstParamData%FG = SrcParamData%FG end if - if (allocated(SrcMiscData%UR_bar_dot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar_dot, kind=B8Ki) - if (.not. allocated(DstMiscData%UR_bar_dot)) then - allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%DP0)) then + LB(1:2) = lbound(SrcParamData%DP0, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%DP0, kind=B8Ki) + if (.not. allocated(DstParamData%DP0)) then + allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot + DstParamData%DP0 = SrcParamData%DP0 end if - if (allocated(SrcMiscData%UR_bar_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) - if (.not. allocated(DstMiscData%UR_bar_dotdot)) then - allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%NodeID2JointID)) then + LB(1:1) = lbound(SrcParamData%NodeID2JointID, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NodeID2JointID, kind=B8Ki) + if (.not. allocated(DstParamData%NodeID2JointID)) then + allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot + DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID end if - if (allocated(SrcMiscData%UL)) then - LB(1:1) = lbound(SrcMiscData%UL, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL, kind=B8Ki) - if (.not. allocated(DstMiscData%UL)) then - allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) + DstParamData%reduced = SrcParamData%reduced + if (allocated(SrcParamData%T_red)) then + LB(1:2) = lbound(SrcParamData%T_red, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%T_red, kind=B8Ki) + if (.not. allocated(DstParamData%T_red)) then + allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL = SrcMiscData%UL + DstParamData%T_red = SrcParamData%T_red end if - if (allocated(SrcMiscData%UL_NS)) then - LB(1:1) = lbound(SrcMiscData%UL_NS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_NS, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_NS)) then - allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%T_red_T)) then + LB(1:2) = lbound(SrcParamData%T_red_T, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%T_red_T, kind=B8Ki) + if (.not. allocated(DstParamData%T_red_T)) then + allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_NS = SrcMiscData%UL_NS + DstParamData%T_red_T = SrcParamData%T_red_T end if - if (allocated(SrcMiscData%UL_dot)) then - LB(1:1) = lbound(SrcMiscData%UL_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_dot, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_dot)) then - allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%NodesDOF)) then + LB(1:1) = lbound(SrcParamData%NodesDOF, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NodesDOF, kind=B8Ki) + if (.not. allocated(DstParamData%NodesDOF)) then + allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_dot = SrcMiscData%UL_dot + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMiscData%UL_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UL_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_dotdot, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_dotdot)) then - allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%NodesDOFred)) then + LB(1:1) = lbound(SrcParamData%NodesDOFred, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NodesDOFred, kind=B8Ki) + if (.not. allocated(DstParamData%NodesDOFred)) then + allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMiscData%DU_full)) then - LB(1:1) = lbound(SrcMiscData%DU_full, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%DU_full, kind=B8Ki) - if (.not. allocated(DstMiscData%DU_full)) then - allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%ElemsDOF)) then + LB(1:2) = lbound(SrcParamData%ElemsDOF, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%ElemsDOF, kind=B8Ki) + if (.not. allocated(DstParamData%ElemsDOF)) then + allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%DU_full = SrcMiscData%DU_full + DstParamData%ElemsDOF = SrcParamData%ElemsDOF end if - if (allocated(SrcMiscData%U_full)) then - LB(1:1) = lbound(SrcMiscData%U_full, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full)) then - allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%DOFred2Nodes)) then + LB(1:2) = lbound(SrcParamData%DOFred2Nodes, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%DOFred2Nodes, kind=B8Ki) + if (.not. allocated(DstParamData%DOFred2Nodes)) then + allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full = SrcMiscData%U_full + DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes end if - if (allocated(SrcMiscData%U_full_NS)) then - LB(1:1) = lbound(SrcMiscData%U_full_NS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_NS, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full_NS)) then - allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CtrlElem2Channel)) then + LB(1:2) = lbound(SrcParamData%CtrlElem2Channel, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%CtrlElem2Channel, kind=B8Ki) + if (.not. allocated(DstParamData%CtrlElem2Channel)) then + allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full_NS = SrcMiscData%U_full_NS + DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel end if - if (allocated(SrcMiscData%U_full_dot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_dot, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full_dot)) then - allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) + DstParamData%nDOFM = SrcParamData%nDOFM + DstParamData%SttcSolve = SrcParamData%SttcSolve + DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection + DstParamData%Floating = SrcParamData%Floating + if (allocated(SrcParamData%KMMDiag)) then + LB(1:1) = lbound(SrcParamData%KMMDiag, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%KMMDiag, kind=B8Ki) + if (.not. allocated(DstParamData%KMMDiag)) then + allocate(DstParamData%KMMDiag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full_dot = SrcMiscData%U_full_dot + DstParamData%KMMDiag = SrcParamData%KMMDiag end if - if (allocated(SrcMiscData%U_full_dotdot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_dotdot, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full_dotdot)) then - allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CMMDiag)) then + LB(1:1) = lbound(SrcParamData%CMMDiag, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%CMMDiag, kind=B8Ki) + if (.not. allocated(DstParamData%CMMDiag)) then + allocate(DstParamData%CMMDiag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot + DstParamData%CMMDiag = SrcParamData%CMMDiag end if - if (allocated(SrcMiscData%U_full_elast)) then - LB(1:1) = lbound(SrcMiscData%U_full_elast, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_elast, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full_elast)) then - allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%MMB)) then + LB(1:2) = lbound(SrcParamData%MMB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MMB, kind=B8Ki) + if (.not. allocated(DstParamData%MMB)) then + allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full_elast = SrcMiscData%U_full_elast + DstParamData%MMB = SrcParamData%MMB end if - if (allocated(SrcMiscData%U_red)) then - LB(1:1) = lbound(SrcMiscData%U_red, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_red, kind=B8Ki) - if (.not. allocated(DstMiscData%U_red)) then - allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%MBmmB)) then + LB(1:2) = lbound(SrcParamData%MBmmB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MBmmB, kind=B8Ki) + if (.not. allocated(DstParamData%MBmmB)) then + allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_red = SrcMiscData%U_red + DstParamData%MBmmB = SrcParamData%MBmmB end if - if (allocated(SrcMiscData%FC_unit)) then - LB(1:1) = lbound(SrcMiscData%FC_unit, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FC_unit, kind=B8Ki) - if (.not. allocated(DstMiscData%FC_unit)) then - allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%C1_11)) then + LB(1:2) = lbound(SrcParamData%C1_11, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C1_11, kind=B8Ki) + if (.not. allocated(DstParamData%C1_11)) then + allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FC_unit = SrcMiscData%FC_unit + DstParamData%C1_11 = SrcParamData%C1_11 end if - if (allocated(SrcMiscData%SDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%SDWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SDWrOutput, kind=B8Ki) - if (.not. allocated(DstMiscData%SDWrOutput)) then - allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%C1_12)) then + LB(1:2) = lbound(SrcParamData%C1_12, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C1_12, kind=B8Ki) + if (.not. allocated(DstParamData%C1_12)) then + allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput + DstParamData%C1_12 = SrcParamData%C1_12 end if - if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) - if (.not. allocated(DstMiscData%AllOuts)) then - allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%D1_141)) then + LB(1:2) = lbound(SrcParamData%D1_141, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%D1_141, kind=B8Ki) + if (.not. allocated(DstParamData%D1_141)) then + allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AllOuts = SrcMiscData%AllOuts + DstParamData%D1_141 = SrcParamData%D1_141 end if - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%Decimat = SrcMiscData%Decimat - if (allocated(SrcMiscData%Fext)) then - LB(1:1) = lbound(SrcMiscData%Fext, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Fext, kind=B8Ki) - if (.not. allocated(DstMiscData%Fext)) then - allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%D1_142)) then + LB(1:2) = lbound(SrcParamData%D1_142, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%D1_142, kind=B8Ki) + if (.not. allocated(DstParamData%D1_142)) then + allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%Fext = SrcMiscData%Fext + DstParamData%D1_142 = SrcParamData%D1_142 end if - if (allocated(SrcMiscData%Fext_red)) then - LB(1:1) = lbound(SrcMiscData%Fext_red, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Fext_red, kind=B8Ki) - if (.not. allocated(DstMiscData%Fext_red)) then - allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%PhiM)) then + LB(1:2) = lbound(SrcParamData%PhiM, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PhiM, kind=B8Ki) + if (.not. allocated(DstParamData%PhiM)) then + allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%Fext_red = SrcMiscData%Fext_red + DstParamData%PhiM = SrcParamData%PhiM end if - if (allocated(SrcMiscData%UL_SIM)) then - LB(1:1) = lbound(SrcMiscData%UL_SIM, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_SIM, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_SIM)) then - allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%C2_61)) then + LB(1:2) = lbound(SrcParamData%C2_61, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C2_61, kind=B8Ki) + if (.not. allocated(DstParamData%C2_61)) then + allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_SIM = SrcMiscData%UL_SIM + DstParamData%C2_61 = SrcParamData%C2_61 end if - if (allocated(SrcMiscData%UL_0m)) then - LB(1:1) = lbound(SrcMiscData%UL_0m, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_0m, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_0m)) then - allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%C2_62)) then + LB(1:2) = lbound(SrcParamData%C2_62, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C2_62, kind=B8Ki) + if (.not. allocated(DstParamData%C2_62)) then + allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_0m = SrcMiscData%UL_0m - end if -end subroutine - -subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SD_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(MiscData%qmdotdot)) then - deallocate(MiscData%qmdotdot) - end if - if (allocated(MiscData%F_L)) then - deallocate(MiscData%F_L) - end if - if (allocated(MiscData%F_L2)) then - deallocate(MiscData%F_L2) + DstParamData%C2_62 = SrcParamData%C2_62 end if - if (allocated(MiscData%UR_bar)) then - deallocate(MiscData%UR_bar) + if (allocated(SrcParamData%PhiRb_TI)) then + LB(1:2) = lbound(SrcParamData%PhiRb_TI, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PhiRb_TI, kind=B8Ki) + if (.not. allocated(DstParamData%PhiRb_TI)) then + allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI end if - if (allocated(MiscData%UR_bar_dot)) then - deallocate(MiscData%UR_bar_dot) + if (allocated(SrcParamData%D2_63)) then + LB(1:2) = lbound(SrcParamData%D2_63, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%D2_63, kind=B8Ki) + if (.not. allocated(DstParamData%D2_63)) then + allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D2_63 = SrcParamData%D2_63 end if - if (allocated(MiscData%UR_bar_dotdot)) then - deallocate(MiscData%UR_bar_dotdot) + if (allocated(SrcParamData%D2_64)) then + LB(1:2) = lbound(SrcParamData%D2_64, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%D2_64, kind=B8Ki) + if (.not. allocated(DstParamData%D2_64)) then + allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D2_64 = SrcParamData%D2_64 end if - if (allocated(MiscData%UL)) then - deallocate(MiscData%UL) + if (allocated(SrcParamData%MBB)) then + LB(1:2) = lbound(SrcParamData%MBB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MBB, kind=B8Ki) + if (.not. allocated(DstParamData%MBB)) then + allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBB = SrcParamData%MBB end if - if (allocated(MiscData%UL_NS)) then - deallocate(MiscData%UL_NS) - end if - if (allocated(MiscData%UL_dot)) then - deallocate(MiscData%UL_dot) - end if - if (allocated(MiscData%UL_dotdot)) then - deallocate(MiscData%UL_dotdot) - end if - if (allocated(MiscData%DU_full)) then - deallocate(MiscData%DU_full) - end if - if (allocated(MiscData%U_full)) then - deallocate(MiscData%U_full) - end if - if (allocated(MiscData%U_full_NS)) then - deallocate(MiscData%U_full_NS) - end if - if (allocated(MiscData%U_full_dot)) then - deallocate(MiscData%U_full_dot) - end if - if (allocated(MiscData%U_full_dotdot)) then - deallocate(MiscData%U_full_dotdot) - end if - if (allocated(MiscData%U_full_elast)) then - deallocate(MiscData%U_full_elast) - end if - if (allocated(MiscData%U_red)) then - deallocate(MiscData%U_red) - end if - if (allocated(MiscData%FC_unit)) then - deallocate(MiscData%FC_unit) - end if - if (allocated(MiscData%SDWrOutput)) then - deallocate(MiscData%SDWrOutput) - end if - if (allocated(MiscData%AllOuts)) then - deallocate(MiscData%AllOuts) - end if - if (allocated(MiscData%Fext)) then - deallocate(MiscData%Fext) - end if - if (allocated(MiscData%Fext_red)) then - deallocate(MiscData%Fext_red) - end if - if (allocated(MiscData%UL_SIM)) then - deallocate(MiscData%UL_SIM) - end if - if (allocated(MiscData%UL_0m)) then - deallocate(MiscData%UL_0m) - end if -end subroutine - -subroutine SD_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SD_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%qmdotdot) - call RegPack(RF, InData%u_TP) - call RegPack(RF, InData%udot_TP) - call RegPack(RF, InData%udotdot_TP) - call RegPackAlloc(RF, InData%F_L) - call RegPackAlloc(RF, InData%F_L2) - call RegPackAlloc(RF, InData%UR_bar) - call RegPackAlloc(RF, InData%UR_bar_dot) - call RegPackAlloc(RF, InData%UR_bar_dotdot) - call RegPackAlloc(RF, InData%UL) - call RegPackAlloc(RF, InData%UL_NS) - call RegPackAlloc(RF, InData%UL_dot) - call RegPackAlloc(RF, InData%UL_dotdot) - call RegPackAlloc(RF, InData%DU_full) - call RegPackAlloc(RF, InData%U_full) - call RegPackAlloc(RF, InData%U_full_NS) - call RegPackAlloc(RF, InData%U_full_dot) - call RegPackAlloc(RF, InData%U_full_dotdot) - call RegPackAlloc(RF, InData%U_full_elast) - call RegPackAlloc(RF, InData%U_red) - call RegPackAlloc(RF, InData%FC_unit) - call RegPackAlloc(RF, InData%SDWrOutput) - call RegPackAlloc(RF, InData%AllOuts) - call RegPack(RF, InData%LastOutTime) - call RegPack(RF, InData%Decimat) - call RegPackAlloc(RF, InData%Fext) - call RegPackAlloc(RF, InData%Fext_red) - call RegPackAlloc(RF, InData%UL_SIM) - call RegPackAlloc(RF, InData%UL_0m) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%qmdotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%u_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%udot_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%udotdot_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_L); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_L2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_NS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DU_full); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_NS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_elast); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_red); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FC_unit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SDWrOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Decimat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Fext_red); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_SIM); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_0m); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(SD_ParameterType), intent(in) :: SrcParamData - type(SD_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%SDDeltaT = SrcParamData%SDDeltaT - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%nDOF = SrcParamData%nDOF - DstParamData%nDOF_red = SrcParamData%nDOF_red - DstParamData%Nmembers = SrcParamData%Nmembers - if (allocated(SrcParamData%Elems)) then - LB(1:2) = lbound(SrcParamData%Elems, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Elems, kind=B8Ki) - if (.not. allocated(DstParamData%Elems)) then - allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%KBB)) then + LB(1:2) = lbound(SrcParamData%KBB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%KBB, kind=B8Ki) + if (.not. allocated(DstParamData%KBB)) then + allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Elems = SrcParamData%Elems + DstParamData%KBB = SrcParamData%KBB end if - if (allocated(SrcParamData%ElemProps)) then - LB(1:1) = lbound(SrcParamData%ElemProps, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ElemProps, kind=B8Ki) - if (.not. allocated(DstParamData%ElemProps)) then - allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CBB)) then + LB(1:2) = lbound(SrcParamData%CBB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%CBB, kind=B8Ki) + if (.not. allocated(DstParamData%CBB)) then + allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SD_CopyElemPropType(SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%CBB = SrcParamData%CBB end if - if (allocated(SrcParamData%FG)) then - LB(1:1) = lbound(SrcParamData%FG, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FG, kind=B8Ki) - if (.not. allocated(DstParamData%FG)) then - allocate(DstParamData%FG(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CMM)) then + LB(1:2) = lbound(SrcParamData%CMM, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%CMM, kind=B8Ki) + if (.not. allocated(DstParamData%CMM)) then + allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%FG = SrcParamData%FG + DstParamData%CMM = SrcParamData%CMM end if - if (allocated(SrcParamData%DP0)) then - LB(1:2) = lbound(SrcParamData%DP0, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DP0, kind=B8Ki) - if (.not. allocated(DstParamData%DP0)) then - allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%MBM)) then + LB(1:2) = lbound(SrcParamData%MBM, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MBM, kind=B8Ki) + if (.not. allocated(DstParamData%MBM)) then + allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%DP0 = SrcParamData%DP0 + DstParamData%MBM = SrcParamData%MBM end if - if (allocated(SrcParamData%NodeID2JointID)) then - LB(1:1) = lbound(SrcParamData%NodeID2JointID, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodeID2JointID, kind=B8Ki) - if (.not. allocated(DstParamData%NodeID2JointID)) then - allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%PhiL_T)) then + LB(1:2) = lbound(SrcParamData%PhiL_T, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PhiL_T, kind=B8Ki) + if (.not. allocated(DstParamData%PhiL_T)) then + allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID + DstParamData%PhiL_T = SrcParamData%PhiL_T end if - DstParamData%reduced = SrcParamData%reduced - if (allocated(SrcParamData%T_red)) then - LB(1:2) = lbound(SrcParamData%T_red, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%T_red, kind=B8Ki) - if (.not. allocated(DstParamData%T_red)) then - allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%PhiLInvOmgL2)) then + LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) + if (.not. allocated(DstParamData%PhiLInvOmgL2)) then + allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%T_red = SrcParamData%T_red + DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 end if - if (allocated(SrcParamData%T_red_T)) then - LB(1:2) = lbound(SrcParamData%T_red_T, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%T_red_T, kind=B8Ki) - if (.not. allocated(DstParamData%T_red_T)) then - allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%KLLm1)) then + LB(1:2) = lbound(SrcParamData%KLLm1, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%KLLm1, kind=B8Ki) + if (.not. allocated(DstParamData%KLLm1)) then + allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%T_red_T = SrcParamData%T_red_T + DstParamData%KLLm1 = SrcParamData%KLLm1 end if - if (allocated(SrcParamData%NodesDOF)) then - LB(1:1) = lbound(SrcParamData%NodesDOF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodesDOF, kind=B8Ki) - if (.not. allocated(DstParamData%NodesDOF)) then - allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyIList(SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcParamData%NodesDOFred)) then - LB(1:1) = lbound(SrcParamData%NodesDOFred, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodesDOFred, kind=B8Ki) - if (.not. allocated(DstParamData%NodesDOFred)) then - allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%AM2Jac)) then + LB(1:2) = lbound(SrcParamData%AM2Jac, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%AM2Jac, kind=B8Ki) + if (.not. allocated(DstParamData%AM2Jac)) then + allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SD_CopyIList(SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%AM2Jac = SrcParamData%AM2Jac end if - if (allocated(SrcParamData%ElemsDOF)) then - LB(1:2) = lbound(SrcParamData%ElemsDOF, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%ElemsDOF, kind=B8Ki) - if (.not. allocated(DstParamData%ElemsDOF)) then - allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%AM2JacPiv)) then + LB(1:1) = lbound(SrcParamData%AM2JacPiv, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%AM2JacPiv, kind=B8Ki) + if (.not. allocated(DstParamData%AM2JacPiv)) then + allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%ElemsDOF = SrcParamData%ElemsDOF + DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv end if - if (allocated(SrcParamData%DOFred2Nodes)) then - LB(1:2) = lbound(SrcParamData%DOFred2Nodes, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DOFred2Nodes, kind=B8Ki) - if (.not. allocated(DstParamData%DOFred2Nodes)) then - allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%TI)) then + LB(1:2) = lbound(SrcParamData%TI, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TI, kind=B8Ki) + if (.not. allocated(DstParamData%TI)) then + allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes + DstParamData%TI = SrcParamData%TI end if - if (allocated(SrcParamData%CtrlElem2Channel)) then - LB(1:2) = lbound(SrcParamData%CtrlElem2Channel, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CtrlElem2Channel, kind=B8Ki) - if (.not. allocated(DstParamData%CtrlElem2Channel)) then - allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%TIreact)) then + LB(1:2) = lbound(SrcParamData%TIreact, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TIreact, kind=B8Ki) + if (.not. allocated(DstParamData%TIreact)) then + allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel + DstParamData%TIreact = SrcParamData%TIreact end if - DstParamData%nDOFM = SrcParamData%nDOFM - DstParamData%SttcSolve = SrcParamData%SttcSolve - DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection - DstParamData%Floating = SrcParamData%Floating - if (allocated(SrcParamData%KMMDiag)) then - LB(1:1) = lbound(SrcParamData%KMMDiag, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%KMMDiag, kind=B8Ki) - if (.not. allocated(DstParamData%KMMDiag)) then - allocate(DstParamData%KMMDiag(LB(1):UB(1)), stat=ErrStat2) + DstParamData%nNodes = SrcParamData%nNodes + DstParamData%nNodes_I = SrcParamData%nNodes_I + DstParamData%nNodes_L = SrcParamData%nNodes_L + DstParamData%nNodes_C = SrcParamData%nNodes_C + if (allocated(SrcParamData%Nodes_I)) then + LB(1:2) = lbound(SrcParamData%Nodes_I, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Nodes_I, kind=B8Ki) + if (.not. allocated(DstParamData%Nodes_I)) then + allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%KMMDiag = SrcParamData%KMMDiag + DstParamData%Nodes_I = SrcParamData%Nodes_I end if - if (allocated(SrcParamData%CMMDiag)) then - LB(1:1) = lbound(SrcParamData%CMMDiag, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%CMMDiag, kind=B8Ki) - if (.not. allocated(DstParamData%CMMDiag)) then - allocate(DstParamData%CMMDiag(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%Nodes_L)) then + LB(1:2) = lbound(SrcParamData%Nodes_L, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Nodes_L, kind=B8Ki) + if (.not. allocated(DstParamData%Nodes_L)) then + allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CMMDiag = SrcParamData%CMMDiag + DstParamData%Nodes_L = SrcParamData%Nodes_L end if - if (allocated(SrcParamData%MMB)) then - LB(1:2) = lbound(SrcParamData%MMB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MMB, kind=B8Ki) - if (.not. allocated(DstParamData%MMB)) then - allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%Nodes_C)) then + LB(1:2) = lbound(SrcParamData%Nodes_C, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Nodes_C, kind=B8Ki) + if (.not. allocated(DstParamData%Nodes_C)) then + allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MMB = SrcParamData%MMB + DstParamData%Nodes_C = SrcParamData%Nodes_C end if - if (allocated(SrcParamData%MBmmB)) then - LB(1:2) = lbound(SrcParamData%MBmmB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBmmB, kind=B8Ki) - if (.not. allocated(DstParamData%MBmmB)) then - allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%nDOFI__ = SrcParamData%nDOFI__ + DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb + DstParamData%nDOFI_F = SrcParamData%nDOFI_F + DstParamData%nDOFL_L = SrcParamData%nDOFL_L + DstParamData%nDOFC__ = SrcParamData%nDOFC__ + DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb + DstParamData%nDOFC_L = SrcParamData%nDOFC_L + DstParamData%nDOFC_F = SrcParamData%nDOFC_F + DstParamData%nDOFR__ = SrcParamData%nDOFR__ + DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb + DstParamData%nDOF__L = SrcParamData%nDOF__L + DstParamData%nDOF__F = SrcParamData%nDOF__F + if (allocated(SrcParamData%IDI__)) then + LB(1:1) = lbound(SrcParamData%IDI__, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDI__, kind=B8Ki) + if (.not. allocated(DstParamData%IDI__)) then + allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MBmmB = SrcParamData%MBmmB + DstParamData%IDI__ = SrcParamData%IDI__ end if - if (allocated(SrcParamData%C1_11)) then - LB(1:2) = lbound(SrcParamData%C1_11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C1_11, kind=B8Ki) - if (.not. allocated(DstParamData%C1_11)) then - allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDI_Rb)) then + LB(1:1) = lbound(SrcParamData%IDI_Rb, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDI_Rb, kind=B8Ki) + if (.not. allocated(DstParamData%IDI_Rb)) then + allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C1_11 = SrcParamData%C1_11 + DstParamData%IDI_Rb = SrcParamData%IDI_Rb end if - if (allocated(SrcParamData%C1_12)) then - LB(1:2) = lbound(SrcParamData%C1_12, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C1_12, kind=B8Ki) - if (.not. allocated(DstParamData%C1_12)) then - allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDI_F)) then + LB(1:1) = lbound(SrcParamData%IDI_F, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDI_F, kind=B8Ki) + if (.not. allocated(DstParamData%IDI_F)) then + allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C1_12 = SrcParamData%C1_12 + DstParamData%IDI_F = SrcParamData%IDI_F end if - if (allocated(SrcParamData%D1_141)) then - LB(1:2) = lbound(SrcParamData%D1_141, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D1_141, kind=B8Ki) - if (.not. allocated(DstParamData%D1_141)) then - allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDL_L)) then + LB(1:1) = lbound(SrcParamData%IDL_L, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDL_L, kind=B8Ki) + if (.not. allocated(DstParamData%IDL_L)) then + allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D1_141 = SrcParamData%D1_141 + DstParamData%IDL_L = SrcParamData%IDL_L end if - if (allocated(SrcParamData%D1_142)) then - LB(1:2) = lbound(SrcParamData%D1_142, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D1_142, kind=B8Ki) - if (.not. allocated(DstParamData%D1_142)) then - allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDC__)) then + LB(1:1) = lbound(SrcParamData%IDC__, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDC__, kind=B8Ki) + if (.not. allocated(DstParamData%IDC__)) then + allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D1_142 = SrcParamData%D1_142 + DstParamData%IDC__ = SrcParamData%IDC__ end if - if (allocated(SrcParamData%PhiM)) then - LB(1:2) = lbound(SrcParamData%PhiM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiM, kind=B8Ki) - if (.not. allocated(DstParamData%PhiM)) then - allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDC_Rb)) then + LB(1:1) = lbound(SrcParamData%IDC_Rb, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDC_Rb, kind=B8Ki) + if (.not. allocated(DstParamData%IDC_Rb)) then + allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PhiM = SrcParamData%PhiM + DstParamData%IDC_Rb = SrcParamData%IDC_Rb end if - if (allocated(SrcParamData%C2_61)) then - LB(1:2) = lbound(SrcParamData%C2_61, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C2_61, kind=B8Ki) - if (.not. allocated(DstParamData%C2_61)) then - allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDC_L)) then + LB(1:1) = lbound(SrcParamData%IDC_L, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDC_L, kind=B8Ki) + if (.not. allocated(DstParamData%IDC_L)) then + allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C2_61 = SrcParamData%C2_61 + DstParamData%IDC_L = SrcParamData%IDC_L end if - if (allocated(SrcParamData%C2_62)) then - LB(1:2) = lbound(SrcParamData%C2_62, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C2_62, kind=B8Ki) - if (.not. allocated(DstParamData%C2_62)) then - allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDC_F)) then + LB(1:1) = lbound(SrcParamData%IDC_F, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDC_F, kind=B8Ki) + if (.not. allocated(DstParamData%IDC_F)) then + allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C2_62 = SrcParamData%C2_62 + DstParamData%IDC_F = SrcParamData%IDC_F end if - if (allocated(SrcParamData%PhiRb_TI)) then - LB(1:2) = lbound(SrcParamData%PhiRb_TI, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiRb_TI, kind=B8Ki) - if (.not. allocated(DstParamData%PhiRb_TI)) then - allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDR__)) then + LB(1:1) = lbound(SrcParamData%IDR__, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDR__, kind=B8Ki) + if (.not. allocated(DstParamData%IDR__)) then + allocate(DstParamData%IDR__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI + DstParamData%IDR__ = SrcParamData%IDR__ end if - if (allocated(SrcParamData%D2_63)) then - LB(1:2) = lbound(SrcParamData%D2_63, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D2_63, kind=B8Ki) - if (.not. allocated(DstParamData%D2_63)) then - allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%ID__Rb)) then + LB(1:1) = lbound(SrcParamData%ID__Rb, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ID__Rb, kind=B8Ki) + if (.not. allocated(DstParamData%ID__Rb)) then + allocate(DstParamData%ID__Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D2_63 = SrcParamData%D2_63 + DstParamData%ID__Rb = SrcParamData%ID__Rb end if - if (allocated(SrcParamData%D2_64)) then - LB(1:2) = lbound(SrcParamData%D2_64, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D2_64, kind=B8Ki) - if (.not. allocated(DstParamData%D2_64)) then - allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%ID__L)) then + LB(1:1) = lbound(SrcParamData%ID__L, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ID__L, kind=B8Ki) + if (.not. allocated(DstParamData%ID__L)) then + allocate(DstParamData%ID__L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D2_64 = SrcParamData%D2_64 + DstParamData%ID__L = SrcParamData%ID__L end if - if (allocated(SrcParamData%MBB)) then - LB(1:2) = lbound(SrcParamData%MBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBB, kind=B8Ki) - if (.not. allocated(DstParamData%MBB)) then - allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%ID__F)) then + LB(1:1) = lbound(SrcParamData%ID__F, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ID__F, kind=B8Ki) + if (.not. allocated(DstParamData%ID__F)) then + allocate(DstParamData%ID__F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MBB = SrcParamData%MBB + DstParamData%ID__F = SrcParamData%ID__F end if - if (allocated(SrcParamData%KBB)) then - LB(1:2) = lbound(SrcParamData%KBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%KBB, kind=B8Ki) - if (.not. allocated(DstParamData%KBB)) then - allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%NMOutputs = SrcParamData%NMOutputs + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%UnJckF = SrcParamData%UnJckF + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + if (allocated(SrcParamData%MoutLst)) then + LB(1:1) = lbound(SrcParamData%MoutLst, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%MoutLst, kind=B8Ki) + if (.not. allocated(DstParamData%MoutLst)) then + allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%KBB = SrcParamData%KBB + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%CBB)) then - LB(1:2) = lbound(SrcParamData%CBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CBB, kind=B8Ki) - if (.not. allocated(DstParamData%CBB)) then - allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%MoutLst2)) then + LB(1:1) = lbound(SrcParamData%MoutLst2, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%MoutLst2, kind=B8Ki) + if (.not. allocated(DstParamData%MoutLst2)) then + allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CBB = SrcParamData%CBB + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%CMM)) then - LB(1:2) = lbound(SrcParamData%CMM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CMM, kind=B8Ki) - if (.not. allocated(DstParamData%CMM)) then - allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%MoutLst3)) then + LB(1:1) = lbound(SrcParamData%MoutLst3, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%MoutLst3, kind=B8Ki) + if (.not. allocated(DstParamData%MoutLst3)) then + allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CMM = SrcParamData%CMM + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%MBM)) then - LB(1:2) = lbound(SrcParamData%MBM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBM, kind=B8Ki) - if (.not. allocated(DstParamData%MBM)) then - allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MBM = SrcParamData%MBM + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%PhiL_T)) then - LB(1:2) = lbound(SrcParamData%PhiL_T, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiL_T, kind=B8Ki) - if (.not. allocated(DstParamData%PhiL_T)) then - allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%OutAll = SrcParamData%OutAll + DstParamData%OutCBModes = SrcParamData%OutCBModes + DstParamData%OutFEMModes = SrcParamData%OutFEMModes + DstParamData%OutReact = SrcParamData%OutReact + DstParamData%OutAllInt = SrcParamData%OutAllInt + DstParamData%OutAllDims = SrcParamData%OutAllDims + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PhiL_T = SrcParamData%PhiL_T + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if - if (allocated(SrcParamData%PhiLInvOmgL2)) then - LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) - if (.not. allocated(DstParamData%PhiLInvOmgL2)) then - allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 + DstParamData%du = SrcParamData%du end if - if (allocated(SrcParamData%KLLm1)) then - LB(1:2) = lbound(SrcParamData%KLLm1, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%KLLm1, kind=B8Ki) - if (.not. allocated(DstParamData%KLLm1)) then - allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%KLLm1 = SrcParamData%KLLm1 + DstParamData%dx = SrcParamData%dx + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + DstParamData%RotStates = SrcParamData%RotStates +end subroutine + +subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() end if - if (allocated(SrcParamData%AM2Jac)) then - LB(1:2) = lbound(SrcParamData%AM2Jac, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AM2Jac, kind=B8Ki) - if (.not. allocated(DstParamData%AM2Jac)) then - allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AM2Jac = SrcParamData%AM2Jac + if (allocated(ParamData%Elems)) then + deallocate(ParamData%Elems) end if - if (allocated(SrcParamData%AM2JacPiv)) then - LB(1:1) = lbound(SrcParamData%AM2JacPiv, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AM2JacPiv, kind=B8Ki) - if (.not. allocated(DstParamData%AM2JacPiv)) then - allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv + if (allocated(ParamData%ElemProps)) then + LB(1:1) = lbound(ParamData%ElemProps, kind=B8Ki) + UB(1:1) = ubound(ParamData%ElemProps, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%ElemProps) end if - if (allocated(SrcParamData%TI)) then - LB(1:2) = lbound(SrcParamData%TI, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TI, kind=B8Ki) - if (.not. allocated(DstParamData%TI)) then - allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TI = SrcParamData%TI + if (allocated(ParamData%FG)) then + deallocate(ParamData%FG) end if - if (allocated(SrcParamData%TIreact)) then - LB(1:2) = lbound(SrcParamData%TIreact, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TIreact, kind=B8Ki) - if (.not. allocated(DstParamData%TIreact)) then - allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TIreact = SrcParamData%TIreact + if (allocated(ParamData%DP0)) then + deallocate(ParamData%DP0) end if - DstParamData%nNodes = SrcParamData%nNodes - DstParamData%nNodes_I = SrcParamData%nNodes_I - DstParamData%nNodes_L = SrcParamData%nNodes_L - DstParamData%nNodes_C = SrcParamData%nNodes_C - if (allocated(SrcParamData%Nodes_I)) then - LB(1:2) = lbound(SrcParamData%Nodes_I, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_I, kind=B8Ki) - if (.not. allocated(DstParamData%Nodes_I)) then - allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_I = SrcParamData%Nodes_I + if (allocated(ParamData%NodeID2JointID)) then + deallocate(ParamData%NodeID2JointID) end if - if (allocated(SrcParamData%Nodes_L)) then - LB(1:2) = lbound(SrcParamData%Nodes_L, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_L, kind=B8Ki) - if (.not. allocated(DstParamData%Nodes_L)) then - allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_L = SrcParamData%Nodes_L + if (allocated(ParamData%T_red)) then + deallocate(ParamData%T_red) end if - if (allocated(SrcParamData%Nodes_C)) then - LB(1:2) = lbound(SrcParamData%Nodes_C, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_C, kind=B8Ki) - if (.not. allocated(DstParamData%Nodes_C)) then - allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_C = SrcParamData%Nodes_C + if (allocated(ParamData%T_red_T)) then + deallocate(ParamData%T_red_T) end if - DstParamData%nDOFI__ = SrcParamData%nDOFI__ - DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb - DstParamData%nDOFI_F = SrcParamData%nDOFI_F - DstParamData%nDOFL_L = SrcParamData%nDOFL_L - DstParamData%nDOFC__ = SrcParamData%nDOFC__ - DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb - DstParamData%nDOFC_L = SrcParamData%nDOFC_L - DstParamData%nDOFC_F = SrcParamData%nDOFC_F - DstParamData%nDOFR__ = SrcParamData%nDOFR__ - DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb - DstParamData%nDOF__L = SrcParamData%nDOF__L - DstParamData%nDOF__F = SrcParamData%nDOF__F - if (allocated(SrcParamData%IDI__)) then - LB(1:1) = lbound(SrcParamData%IDI__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI__, kind=B8Ki) - if (.not. allocated(DstParamData%IDI__)) then - allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI__ = SrcParamData%IDI__ + if (allocated(ParamData%NodesDOF)) then + LB(1:1) = lbound(ParamData%NodesDOF, kind=B8Ki) + UB(1:1) = ubound(ParamData%NodesDOF, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOF) end if - if (allocated(SrcParamData%IDI_Rb)) then - LB(1:1) = lbound(SrcParamData%IDI_Rb, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI_Rb, kind=B8Ki) - if (.not. allocated(DstParamData%IDI_Rb)) then - allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI_Rb = SrcParamData%IDI_Rb + if (allocated(ParamData%NodesDOFred)) then + LB(1:1) = lbound(ParamData%NodesDOFred, kind=B8Ki) + UB(1:1) = ubound(ParamData%NodesDOFred, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOFred) end if - if (allocated(SrcParamData%IDI_F)) then - LB(1:1) = lbound(SrcParamData%IDI_F, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI_F, kind=B8Ki) - if (.not. allocated(DstParamData%IDI_F)) then - allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI_F = SrcParamData%IDI_F + if (allocated(ParamData%ElemsDOF)) then + deallocate(ParamData%ElemsDOF) end if - if (allocated(SrcParamData%IDL_L)) then - LB(1:1) = lbound(SrcParamData%IDL_L, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDL_L, kind=B8Ki) - if (.not. allocated(DstParamData%IDL_L)) then - allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDL_L = SrcParamData%IDL_L + if (allocated(ParamData%DOFred2Nodes)) then + deallocate(ParamData%DOFred2Nodes) end if - if (allocated(SrcParamData%IDC__)) then - LB(1:1) = lbound(SrcParamData%IDC__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC__, kind=B8Ki) - if (.not. allocated(DstParamData%IDC__)) then - allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC__ = SrcParamData%IDC__ + if (allocated(ParamData%CtrlElem2Channel)) then + deallocate(ParamData%CtrlElem2Channel) end if - if (allocated(SrcParamData%IDC_Rb)) then - LB(1:1) = lbound(SrcParamData%IDC_Rb, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_Rb, kind=B8Ki) - if (.not. allocated(DstParamData%IDC_Rb)) then - allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_Rb = SrcParamData%IDC_Rb + if (allocated(ParamData%KMMDiag)) then + deallocate(ParamData%KMMDiag) end if - if (allocated(SrcParamData%IDC_L)) then - LB(1:1) = lbound(SrcParamData%IDC_L, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_L, kind=B8Ki) - if (.not. allocated(DstParamData%IDC_L)) then - allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_L = SrcParamData%IDC_L + if (allocated(ParamData%CMMDiag)) then + deallocate(ParamData%CMMDiag) end if - if (allocated(SrcParamData%IDC_F)) then - LB(1:1) = lbound(SrcParamData%IDC_F, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_F, kind=B8Ki) - if (.not. allocated(DstParamData%IDC_F)) then - allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_F = SrcParamData%IDC_F + if (allocated(ParamData%MMB)) then + deallocate(ParamData%MMB) end if - if (allocated(SrcParamData%IDR__)) then - LB(1:1) = lbound(SrcParamData%IDR__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDR__, kind=B8Ki) - if (.not. allocated(DstParamData%IDR__)) then - allocate(DstParamData%IDR__(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDR__ = SrcParamData%IDR__ + if (allocated(ParamData%MBmmB)) then + deallocate(ParamData%MBmmB) end if - if (allocated(SrcParamData%ID__Rb)) then - LB(1:1) = lbound(SrcParamData%ID__Rb, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__Rb, kind=B8Ki) - if (.not. allocated(DstParamData%ID__Rb)) then - allocate(DstParamData%ID__Rb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ID__Rb = SrcParamData%ID__Rb + if (allocated(ParamData%C1_11)) then + deallocate(ParamData%C1_11) end if - if (allocated(SrcParamData%ID__L)) then - LB(1:1) = lbound(SrcParamData%ID__L, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__L, kind=B8Ki) - if (.not. allocated(DstParamData%ID__L)) then - allocate(DstParamData%ID__L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ID__L = SrcParamData%ID__L + if (allocated(ParamData%C1_12)) then + deallocate(ParamData%C1_12) end if - if (allocated(SrcParamData%ID__F)) then - LB(1:1) = lbound(SrcParamData%ID__F, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__F, kind=B8Ki) - if (.not. allocated(DstParamData%ID__F)) then - allocate(DstParamData%ID__F(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ID__F = SrcParamData%ID__F + if (allocated(ParamData%D1_141)) then + deallocate(ParamData%D1_141) end if - DstParamData%NMOutputs = SrcParamData%NMOutputs - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%UnJckF = SrcParamData%UnJckF - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - if (allocated(SrcParamData%MoutLst)) then - LB(1:1) = lbound(SrcParamData%MoutLst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst, kind=B8Ki) - if (.not. allocated(DstParamData%MoutLst)) then - allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyMeshAuxDataType(SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(ParamData%D1_142)) then + deallocate(ParamData%D1_142) end if - if (allocated(SrcParamData%MoutLst2)) then - LB(1:1) = lbound(SrcParamData%MoutLst2, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst2, kind=B8Ki) - if (.not. allocated(DstParamData%MoutLst2)) then - allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyMeshAuxDataType(SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcParamData%MoutLst3)) then - LB(1:1) = lbound(SrcParamData%MoutLst3, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst3, kind=B8Ki) - if (.not. allocated(DstParamData%MoutLst3)) then - allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyMeshAuxDataType(SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstParamData%OutAll = SrcParamData%OutAll - DstParamData%OutCBModes = SrcParamData%OutCBModes - DstParamData%OutFEMModes = SrcParamData%OutFEMModes - DstParamData%OutReact = SrcParamData%OutReact - DstParamData%OutAllInt = SrcParamData%OutAllInt - DstParamData%OutAllDims = SrcParamData%OutAllDims - DstParamData%OutDec = SrcParamData%OutDec - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du - end if - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates -end subroutine - -subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(SD_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ParamData%Elems)) then - deallocate(ParamData%Elems) - end if - if (allocated(ParamData%ElemProps)) then - LB(1:1) = lbound(ParamData%ElemProps, kind=B8Ki) - UB(1:1) = ubound(ParamData%ElemProps, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%ElemProps) - end if - if (allocated(ParamData%FG)) then - deallocate(ParamData%FG) - end if - if (allocated(ParamData%DP0)) then - deallocate(ParamData%DP0) - end if - if (allocated(ParamData%NodeID2JointID)) then - deallocate(ParamData%NodeID2JointID) - end if - if (allocated(ParamData%T_red)) then - deallocate(ParamData%T_red) - end if - if (allocated(ParamData%T_red_T)) then - deallocate(ParamData%T_red_T) - end if - if (allocated(ParamData%NodesDOF)) then - LB(1:1) = lbound(ParamData%NodesDOF, kind=B8Ki) - UB(1:1) = ubound(ParamData%NodesDOF, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%NodesDOF) - end if - if (allocated(ParamData%NodesDOFred)) then - LB(1:1) = lbound(ParamData%NodesDOFred, kind=B8Ki) - UB(1:1) = ubound(ParamData%NodesDOFred, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%NodesDOFred) - end if - if (allocated(ParamData%ElemsDOF)) then - deallocate(ParamData%ElemsDOF) - end if - if (allocated(ParamData%DOFred2Nodes)) then - deallocate(ParamData%DOFred2Nodes) - end if - if (allocated(ParamData%CtrlElem2Channel)) then - deallocate(ParamData%CtrlElem2Channel) - end if - if (allocated(ParamData%KMMDiag)) then - deallocate(ParamData%KMMDiag) - end if - if (allocated(ParamData%CMMDiag)) then - deallocate(ParamData%CMMDiag) - end if - if (allocated(ParamData%MMB)) then - deallocate(ParamData%MMB) - end if - if (allocated(ParamData%MBmmB)) then - deallocate(ParamData%MBmmB) - end if - if (allocated(ParamData%C1_11)) then - deallocate(ParamData%C1_11) - end if - if (allocated(ParamData%C1_12)) then - deallocate(ParamData%C1_12) - end if - if (allocated(ParamData%D1_141)) then - deallocate(ParamData%D1_141) - end if - if (allocated(ParamData%D1_142)) then - deallocate(ParamData%D1_142) - end if - if (allocated(ParamData%PhiM)) then - deallocate(ParamData%PhiM) + if (allocated(ParamData%PhiM)) then + deallocate(ParamData%PhiM) end if if (allocated(ParamData%C2_61)) then deallocate(ParamData%C2_61) @@ -3547,7 +3151,21 @@ subroutine SD_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'SD_PackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarTPMesh) + call RegPack(RF, InData%iVarLMesh) + call RegPack(RF, InData%iVarY1Mesh) + call RegPack(RF, InData%iVarY2Mesh) + call RegPack(RF, InData%iVarY3Mesh) + call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%SDDeltaT) call RegPack(RF, InData%IntMethod) call RegPack(RF, InData%nDOF) @@ -3718,7 +3336,33 @@ subroutine SD_UnPackParam(RF, OutData) integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarTPMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarLMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY1Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY2Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY3Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SDDeltaT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nDOF); if (RegCheckErr(RF, RoutineName)) return @@ -3932,135 +3576,636 @@ subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) if (.not. allocated(DstInputData%CableDeltaL)) then allocate(DstInputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CableDeltaL = SrcInputData%CableDeltaL + end if +end subroutine + +subroutine SD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%CableDeltaL)) then + deallocate(InputData%CableDeltaL) + end if +end subroutine + +subroutine SD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%TPMesh) + call MeshPack(RF, InData%LMesh) + call RegPackAlloc(RF, InData%CableDeltaL) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInput' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%TPMesh) ! TPMesh + call MeshUnpack(RF, OutData%LMesh) ! LMesh + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: SrcOutputData + type(SD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + end if +end subroutine + +subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Y1Mesh) + call MeshPack(RF, InData%Y2Mesh) + call MeshPack(RF, InData%Y3Mesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOutput' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Y1Mesh) ! Y1Mesh + call MeshUnpack(RF, OutData%Y2Mesh) ! Y2Mesh + call MeshUnpack(RF, OutData%Y3Mesh) ! Y3Mesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SD_MiscVarType), intent(inout) :: SrcMiscData + type(SD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyContState(SrcMiscData%dxdt_jac, DstMiscData%dxdt_jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyOutput(SrcMiscData%y_jac, DstMiscData%y_jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%qmdotdot)) then + LB(1:1) = lbound(SrcMiscData%qmdotdot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%qmdotdot, kind=B8Ki) + if (.not. allocated(DstMiscData%qmdotdot)) then + allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%qmdotdot = SrcMiscData%qmdotdot + end if + DstMiscData%u_TP = SrcMiscData%u_TP + DstMiscData%udot_TP = SrcMiscData%udot_TP + DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP + if (allocated(SrcMiscData%F_L)) then + LB(1:1) = lbound(SrcMiscData%F_L, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_L, kind=B8Ki) + if (.not. allocated(DstMiscData%F_L)) then + allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L = SrcMiscData%F_L + end if + if (allocated(SrcMiscData%F_L2)) then + LB(1:1) = lbound(SrcMiscData%F_L2, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_L2, kind=B8Ki) + if (.not. allocated(DstMiscData%F_L2)) then + allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L2 = SrcMiscData%F_L2 + end if + if (allocated(SrcMiscData%UR_bar)) then + LB(1:1) = lbound(SrcMiscData%UR_bar, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UR_bar, kind=B8Ki) + if (.not. allocated(DstMiscData%UR_bar)) then + allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar = SrcMiscData%UR_bar + end if + if (allocated(SrcMiscData%UR_bar_dot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UR_bar_dot, kind=B8Ki) + if (.not. allocated(DstMiscData%UR_bar_dot)) then + allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot + end if + if (allocated(SrcMiscData%UR_bar_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) + if (.not. allocated(DstMiscData%UR_bar_dotdot)) then + allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot + end if + if (allocated(SrcMiscData%UL)) then + LB(1:1) = lbound(SrcMiscData%UL, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL, kind=B8Ki) + if (.not. allocated(DstMiscData%UL)) then + allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL = SrcMiscData%UL + end if + if (allocated(SrcMiscData%UL_NS)) then + LB(1:1) = lbound(SrcMiscData%UL_NS, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_NS, kind=B8Ki) + if (.not. allocated(DstMiscData%UL_NS)) then + allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_NS = SrcMiscData%UL_NS + end if + if (allocated(SrcMiscData%UL_dot)) then + LB(1:1) = lbound(SrcMiscData%UL_dot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_dot, kind=B8Ki) + if (.not. allocated(DstMiscData%UL_dot)) then + allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_dot = SrcMiscData%UL_dot + end if + if (allocated(SrcMiscData%UL_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UL_dotdot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_dotdot, kind=B8Ki) + if (.not. allocated(DstMiscData%UL_dotdot)) then + allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot + end if + if (allocated(SrcMiscData%DU_full)) then + LB(1:1) = lbound(SrcMiscData%DU_full, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%DU_full, kind=B8Ki) + if (.not. allocated(DstMiscData%DU_full)) then + allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DU_full = SrcMiscData%DU_full + end if + if (allocated(SrcMiscData%U_full)) then + LB(1:1) = lbound(SrcMiscData%U_full, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full, kind=B8Ki) + if (.not. allocated(DstMiscData%U_full)) then + allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full = SrcMiscData%U_full + end if + if (allocated(SrcMiscData%U_full_NS)) then + LB(1:1) = lbound(SrcMiscData%U_full_NS, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full_NS, kind=B8Ki) + if (.not. allocated(DstMiscData%U_full_NS)) then + allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_NS = SrcMiscData%U_full_NS + end if + if (allocated(SrcMiscData%U_full_dot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full_dot, kind=B8Ki) + if (.not. allocated(DstMiscData%U_full_dot)) then + allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_dot = SrcMiscData%U_full_dot + end if + if (allocated(SrcMiscData%U_full_dotdot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dotdot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full_dotdot, kind=B8Ki) + if (.not. allocated(DstMiscData%U_full_dotdot)) then + allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot + end if + if (allocated(SrcMiscData%U_full_elast)) then + LB(1:1) = lbound(SrcMiscData%U_full_elast, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full_elast, kind=B8Ki) + if (.not. allocated(DstMiscData%U_full_elast)) then + allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_elast = SrcMiscData%U_full_elast + end if + if (allocated(SrcMiscData%U_red)) then + LB(1:1) = lbound(SrcMiscData%U_red, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_red, kind=B8Ki) + if (.not. allocated(DstMiscData%U_red)) then + allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_red = SrcMiscData%U_red + end if + if (allocated(SrcMiscData%FC_unit)) then + LB(1:1) = lbound(SrcMiscData%FC_unit, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FC_unit, kind=B8Ki) + if (.not. allocated(DstMiscData%FC_unit)) then + allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FC_unit = SrcMiscData%FC_unit + end if + if (allocated(SrcMiscData%SDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%SDWrOutput, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SDWrOutput, kind=B8Ki) + if (.not. allocated(DstMiscData%SDWrOutput)) then + allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput + end if + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%Decimat = SrcMiscData%Decimat + if (allocated(SrcMiscData%Fext)) then + LB(1:1) = lbound(SrcMiscData%Fext, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Fext, kind=B8Ki) + if (.not. allocated(DstMiscData%Fext)) then + allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Fext = SrcMiscData%Fext + end if + if (allocated(SrcMiscData%Fext_red)) then + LB(1:1) = lbound(SrcMiscData%Fext_red, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Fext_red, kind=B8Ki) + if (.not. allocated(DstMiscData%Fext_red)) then + allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%CableDeltaL = SrcInputData%CableDeltaL + DstMiscData%Fext_red = SrcMiscData%Fext_red end if -end subroutine - -subroutine SD_DestroyInput(InputData, ErrStat, ErrMsg) - type(SD_InputType), intent(inout) :: InputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_DestroyInput' - ErrStat = ErrID_None - ErrMsg = '' - call MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InputData%CableDeltaL)) then - deallocate(InputData%CableDeltaL) + if (allocated(SrcMiscData%UL_SIM)) then + LB(1:1) = lbound(SrcMiscData%UL_SIM, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_SIM, kind=B8Ki) + if (.not. allocated(DstMiscData%UL_SIM)) then + allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_SIM = SrcMiscData%UL_SIM end if -end subroutine - -subroutine SD_PackInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SD_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SD_PackInput' - if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%TPMesh) - call MeshPack(RF, InData%LMesh) - call RegPackAlloc(RF, InData%CableDeltaL) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_UnPackInput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SD_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%TPMesh) ! TPMesh - call MeshUnpack(RF, OutData%LMesh) ! LMesh - call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(SD_OutputType), intent(inout) :: SrcOutputData - type(SD_OutputType), intent(inout) :: DstOutputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_CopyOutput' - ErrStat = ErrID_None - ErrMsg = '' - call MeshCopy(SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%UL_0m)) then + LB(1:1) = lbound(SrcMiscData%UL_0m, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_0m, kind=B8Ki) + if (.not. allocated(DstMiscData%UL_0m)) then + allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + DstMiscData%UL_0m = SrcMiscData%UL_0m end if end subroutine -subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(SD_OutputType), intent(inout) :: OutputData +subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_DestroyOutput' + character(*), parameter :: RoutineName = 'SD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - call MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2) + call SD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2) + call SD_DestroyContState(MiscData%dxdt_jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + call SD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyOutput(MiscData%y_jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%qmdotdot)) then + deallocate(MiscData%qmdotdot) + end if + if (allocated(MiscData%F_L)) then + deallocate(MiscData%F_L) + end if + if (allocated(MiscData%F_L2)) then + deallocate(MiscData%F_L2) + end if + if (allocated(MiscData%UR_bar)) then + deallocate(MiscData%UR_bar) + end if + if (allocated(MiscData%UR_bar_dot)) then + deallocate(MiscData%UR_bar_dot) + end if + if (allocated(MiscData%UR_bar_dotdot)) then + deallocate(MiscData%UR_bar_dotdot) + end if + if (allocated(MiscData%UL)) then + deallocate(MiscData%UL) + end if + if (allocated(MiscData%UL_NS)) then + deallocate(MiscData%UL_NS) + end if + if (allocated(MiscData%UL_dot)) then + deallocate(MiscData%UL_dot) + end if + if (allocated(MiscData%UL_dotdot)) then + deallocate(MiscData%UL_dotdot) + end if + if (allocated(MiscData%DU_full)) then + deallocate(MiscData%DU_full) + end if + if (allocated(MiscData%U_full)) then + deallocate(MiscData%U_full) + end if + if (allocated(MiscData%U_full_NS)) then + deallocate(MiscData%U_full_NS) + end if + if (allocated(MiscData%U_full_dot)) then + deallocate(MiscData%U_full_dot) + end if + if (allocated(MiscData%U_full_dotdot)) then + deallocate(MiscData%U_full_dotdot) + end if + if (allocated(MiscData%U_full_elast)) then + deallocate(MiscData%U_full_elast) + end if + if (allocated(MiscData%U_red)) then + deallocate(MiscData%U_red) + end if + if (allocated(MiscData%FC_unit)) then + deallocate(MiscData%FC_unit) + end if + if (allocated(MiscData%SDWrOutput)) then + deallocate(MiscData%SDWrOutput) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%Fext)) then + deallocate(MiscData%Fext) + end if + if (allocated(MiscData%Fext_red)) then + deallocate(MiscData%Fext_red) + end if + if (allocated(MiscData%UL_SIM)) then + deallocate(MiscData%UL_SIM) + end if + if (allocated(MiscData%UL_0m)) then + deallocate(MiscData%UL_0m) end if end subroutine -subroutine SD_PackOutput(RF, Indata) +subroutine SD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(SD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SD_PackOutput' + type(SD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackMisc' if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%Y1Mesh) - call MeshPack(RF, InData%Y2Mesh) - call MeshPack(RF, InData%Y3Mesh) - call RegPackAlloc(RF, InData%WriteOutput) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SD_PackContState(RF, InData%x_perturb) + call SD_PackContState(RF, InData%dxdt_jac) + call SD_PackInput(RF, InData%u_perturb) + call SD_PackOutput(RF, InData%y_jac) + call RegPackAlloc(RF, InData%qmdotdot) + call RegPack(RF, InData%u_TP) + call RegPack(RF, InData%udot_TP) + call RegPack(RF, InData%udotdot_TP) + call RegPackAlloc(RF, InData%F_L) + call RegPackAlloc(RF, InData%F_L2) + call RegPackAlloc(RF, InData%UR_bar) + call RegPackAlloc(RF, InData%UR_bar_dot) + call RegPackAlloc(RF, InData%UR_bar_dotdot) + call RegPackAlloc(RF, InData%UL) + call RegPackAlloc(RF, InData%UL_NS) + call RegPackAlloc(RF, InData%UL_dot) + call RegPackAlloc(RF, InData%UL_dotdot) + call RegPackAlloc(RF, InData%DU_full) + call RegPackAlloc(RF, InData%U_full) + call RegPackAlloc(RF, InData%U_full_NS) + call RegPackAlloc(RF, InData%U_full_dot) + call RegPackAlloc(RF, InData%U_full_dotdot) + call RegPackAlloc(RF, InData%U_full_elast) + call RegPackAlloc(RF, InData%U_red) + call RegPackAlloc(RF, InData%FC_unit) + call RegPackAlloc(RF, InData%SDWrOutput) + call RegPackAlloc(RF, InData%AllOuts) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%Decimat) + call RegPackAlloc(RF, InData%Fext) + call RegPackAlloc(RF, InData%Fext_red) + call RegPackAlloc(RF, InData%UL_SIM) + call RegPackAlloc(RF, InData%UL_0m) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackOutput(RF, OutData) +subroutine SD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(SD_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackOutput' + type(SD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackMisc' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%Y1Mesh) ! Y1Mesh - call MeshUnpack(RF, OutData%Y2Mesh) ! Y2Mesh - call MeshUnpack(RF, OutData%Y3Mesh) ! Y3Mesh - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call SD_UnpackContState(RF, OutData%dxdt_jac) ! dxdt_jac + call SD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SD_UnpackOutput(RF, OutData%y_jac) ! y_jac + call RegUnpackAlloc(RF, OutData%qmdotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%u_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%udot_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%udotdot_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_L2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DU_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_elast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FC_unit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SDWrOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Decimat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fext_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_SIM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_0m); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) From 8c78841b8c9498cc671173c7845ddec55ebd9dfb Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 21:21:48 +0000 Subject: [PATCH 101/319] Fix single precision compilation --- modules/moordyn/src/MoorDyn.f90 | 4 ++-- modules/subdyn/src/SubDyn.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 0d59f5b68c..f3cfedbfb2 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -2507,8 +2507,8 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message integer(IntKi) :: i, j, l, N real(R8Ki) :: Perturb - real(ReKi) :: dl_slack ! how much a given line segment is stretched [m] - real(ReKi) :: dl_slack_min ! minimum change in a node position for the least-strained segment in the simulation to go slack [m] + real(R8Ki) :: dl_slack ! how much a given line segment is stretched [m] + real(R8Ki) :: dl_slack_min ! minimum change in a node position for the least-strained segment in the simulation to go slack [m] character(32) :: LinStr ! Used for constructing linearization variable names logical :: LinCtrl ! Is the current DeltaL channel associated with a line? type(ModVarType) :: VarTmp ! Temporary variable for velocity states diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index b745ee98cc..d778d4e721 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -433,7 +433,7 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message integer(IntKi) :: i, j - real(ReKi) :: dx, dy, dz, maxDim + real(R8Ki) :: dx, dy, dz, maxDim ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) From 956eccbdaf3dd0defb8f9ae09ffd191888b78266 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 21:47:04 +0000 Subject: [PATCH 102/319] Remove mapping to unused SrvD%u%PtfmMotionMesh --- modules/openfast-library/src/FAST_Mapping.f90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index ecaf84f972..41c6246cd3 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1443,11 +1443,6 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarHSS_Spd, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(SrvD_u_PtfmMotionMesh, 1), & ! SrvD%u%PtfmMotionMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - ! Nacelle Structural Controller do j = 1, Turbine%SrvD%p%NumNStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & From af70cf263a7cf13a47547d014b7b100cee546fd3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 22:26:18 +0000 Subject: [PATCH 103/319] Fix blade structural controller indexing --- modules/openfast-library/src/FAST_Mapping.f90 | 16 ++++++++-------- modules/servodyn/src/ServoDyn.f90 | 18 +++++++++++------- 2 files changed, 19 insertions(+), 15 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 41c6246cd3..3c0bb06311 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -572,8 +572,8 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do i = 1, Turbine%SrvD%p%NumBStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, DstMod%Ins), & ! SrvD%y%BStCLoadMesh(i, DstMod%Ins), & - SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, DstMod%Ins), & ! SrvD%u%BStCMotionMesh(i, DstMod%Ins) + SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, DstMod%Ins, i), & ! SrvD%y%BStCLoadMesh(DstMod%Ins, i), & + SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(DstMod%Ins, i) DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return @@ -781,8 +781,8 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Blade Structural Controller (if ElastoDyn is used for blades) - do i = 1, Turbine%SrvD%p%NumBStC - do j = 1, Turbine%ED%p%NumBl + do j = 1, Turbine%SrvD%p%NumBStC + do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) @@ -1415,7 +1415,7 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do i = 1, Turbine%SrvD%p%NumBStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y%BldMotion - DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, DstMod%Ins), & ! SrvD%u%BStCMotionMesh(i, j) + DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(i, j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1460,10 +1460,10 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) end do ! Blade Structural Controller (if ElastoDyn blades) - do i = 1, Turbine%SrvD%p%NumBStC - do j = 1, Turbine%ED%p%NumBl + do j = 1, Turbine%SrvD%p%NumBStC + do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 4168ad415a..adb8c8d105 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -723,8 +723,8 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er call MV_AddVar(p%Vars%u, "HSS_Spd", VF_Scalar, VarIdx=p%iVarHSS_Spd, LinNames=['HSS_Spd, rad/s']) ! Structural controllers - do i = 1, p%NumBStC - do j = 1, p%NumBl + do j = 1, p%NumBStC + do i = 1, p%NumBl call MV_AddMeshVar(p%Vars%u, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), MotionFields, & Mesh=u%BStCMotionMesh(i, j), & Perturbs=uPerturbs) @@ -773,11 +773,12 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ! Structural controllers if (p%NumBStC > 0) then - call AllocAry(p%iVarBStCLoadMesh, p%NumBStC, p%NumBl, "iVarBStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; - do i = 1, p%NumBStC - do j = 1, p%NumBl + call AllocAry(p%iVarBStCLoadMesh, p%NumBl, p%NumBStC, "iVarBStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; + do j = 1, p%NumBStC + do i = 1, p%NumBl call MV_AddMeshVar(p%Vars%y, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), LoadFields, & - Mesh=y%BStCLoadMesh(i,j)) + VarIdx=p%iVarBStCLoadMesh(i,j), & + Mesh=y%BStCLoadMesh(i,j)) end do end do end if @@ -787,7 +788,8 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er p%iVarNStCLoadMesh = 0 do j = 1, p%NumNStC call MV_AddMeshVar(p%Vars%y, 'Nacelle StC '//Num2LStr(j), LoadFields, & - Mesh=y%NStCLoadMesh(j)) + VarIdx=p%iVarNStCLoadMesh(j), & + Mesh=y%NStCLoadMesh(j)) enddo end if @@ -796,6 +798,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er p%iVarTStCLoadMesh = 0 do j = 1, p%NumTStC call MV_AddMeshVar(p%Vars%y, 'Tower StC '//Num2LStr(j), LoadFields, & + VarIdx=p%iVarTStCLoadMesh(j), & Mesh=y%TStCLoadMesh(j)) enddo end if @@ -805,6 +808,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er p%iVarSStCLoadMesh = 0 do j = 1, p%NumSStC call MV_AddMeshVar(p%Vars%y, 'Substructure StC '//Num2LStr(j), LoadFields, & + VarIdx=p%iVarSStCLoadMesh(j), & Mesh=y%SStCLoadMesh(j)) enddo end if From 1a1e4c62bfa4d14227ea9e5f306a7f329b3bd17d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Feb 2024 23:07:34 +0000 Subject: [PATCH 104/319] Disable AeroMap --- glue-codes/openfast/src/FAST_Prog.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index 022132fc03..0c7f86d04e 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -82,6 +82,8 @@ PROGRAM FAST ! TODO: migrate to ModLin ! this runs the steady-state solver driver and ENDS the program: ! CALL FAST_RunSteadyStateDriver( Turbine(1) ) + + CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true. ) ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() From bd9b91431a8bf5ad4253982ad85e954755f799c2 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Feb 2024 16:25:38 +0000 Subject: [PATCH 105/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 9e4c9f8412..b968b10492 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 9e4c9f841278b77a35623baa96ba819077074f93 +Subproject commit b968b104924a7eec4e4444d0c0fd6c37d90d4fe8 From f6bdbd326ba56c505b852988bb61372d5148f7aa Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Feb 2024 16:37:45 +0000 Subject: [PATCH 106/319] Fix bad merge of ElastoDyn_Registry.txt --- modules/elastodyn/src/ElastoDyn_Registry.txt | 2 -- modules/elastodyn/src/ElastoDyn_Types.f90 | 16 ---------------- 2 files changed, 18 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 604ebb944e..dcbcd33246 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -737,8 +737,6 @@ typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and unit #typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - -typedef ^ ParameterType Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u compenents" - -typedef ^ ParameterType Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_u compenents" - typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ ParameterType R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 70c1ee7fa6..dd8cde2e64 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -756,8 +756,6 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] - TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u compenents [-] - TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_u compenents [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] @@ -5672,12 +5670,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut - call ED_CopyJac_u_idxStarts(SrcParamData%Jac_u_idxStartList, DstParamData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyJac_y_idxStarts(SrcParamData%Jac_y_idxStartList, DstParamData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcParamData%Jac_u_indx)) then LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) @@ -5973,10 +5965,6 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%BldNd_OutParam) end if - call ED_DestroyJac_u_idxStarts(ParamData%Jac_u_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyJac_y_idxStarts(ParamData%Jac_y_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%Jac_u_indx)) then deallocate(ParamData%Jac_u_indx) end if @@ -6242,8 +6230,6 @@ subroutine ED_PackParam(RF, Indata) end do end if call RegPack(RF, InData%BldNd_BladesOut) - call ED_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) - call ED_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) call RegPackAlloc(RF, InData%Jac_u_indx) call RegPackAlloc(RF, InData%du) call RegPackAlloc(RF, InData%dx) @@ -6545,8 +6531,6 @@ subroutine ED_UnPackParam(RF, OutData) end do end if call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return - call ED_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList - call ED_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return From 2487ea70c2af73f470a8332eb5fd55bdf46574ac Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Feb 2024 17:46:04 +0000 Subject: [PATCH 107/319] Specify linearization modules in FAST_Mods.f90 --- modules/openfast-library/src/FAST_ModLin.f90 | 15 +++++---------- modules/openfast-library/src/FAST_Mods.f90 | 9 ++++++++- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModLin.f90 index d3b9ddc32b..11799e7bd8 100644 --- a/modules/openfast-library/src/FAST_ModLin.f90 +++ b/modules/openfast-library/src/FAST_ModLin.f90 @@ -23,6 +23,7 @@ module FAST_ModLin use NWTC_Library use NWTC_LAPACK +use FAST_ModTypes use FAST_Types use FAST_Funcs use FAST_Mapping @@ -90,16 +91,10 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er modIDs = [(Mods(i)%ID, i=1, size(Mods))] ! Establish module index order for linearization - p%iMod = [pack(modIdx, ModIDs == Module_IfW), & ! InflowWind - pack(modIdx, ModIDs == Module_SrvD), & ! ServoDyn - pack(modIdx, ModIDs == Module_ED), & ! ElastoDyn - pack(modIdx, ModIDs == Module_BD), & ! BeamDyn - pack(modIdx, ModIDs == Module_AD), & ! AeroDyn - pack(modIdx, ModIDs == Module_SeaSt), & ! SeaState - pack(modIdx, ModIDs == Module_HD), & ! HydroDyn - pack(modIdx, ModIDs == Module_SD), & ! SubDyn - pack(modIdx, ModIDs == Module_MAP), & ! MAP++ - pack(modIdx, ModIDs == Module_MD)] ! MoorDyn + allocate(p%iMod(0)) + do i = 1, size(LinMods) + p%iMod = [p%iMod, pack(modIdx, ModIDs == LinMods(i))] + end do ! Loop through modules, if module is not in index, return with error do i = 1, size(Mods) diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 9f6ab6db42..20aca8a274 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -70,7 +70,14 @@ MODULE FAST_ModTypes LOGICAL, PARAMETER :: BD_Solve_Option1 = .TRUE. - INTEGER(IntKi), PARAMETER :: TC_Modules(*) = [Module_ED, Module_BD, Module_SD] !< Tight coupling module IDs + !< Tight coupling module IDs + INTEGER(IntKi), PARAMETER :: TC_Modules(*) = & + [Module_ED, Module_BD, Module_SD] + + !< Linearization module ID array (order determines Jacobian layout) + integer(IntKi), parameter :: LinMods(*) = & + [Module_IfW, Module_SrvD, Module_ED, Module_BD, Module_AD, & + Module_HD, Module_SD, Module_MAP, Module_MD] END MODULE FAST_ModTypes !======================================================================= From f2c0f5a1cc33eabff9d9006c3246c23d59af3a27 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Feb 2024 17:46:13 +0000 Subject: [PATCH 108/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index b968b10492..a75fa937f2 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit b968b104924a7eec4e4444d0c0fd6c37d90d4fe8 +Subproject commit a75fa937f213c667c8670881294533f9ab436a50 From 6cd6258e0ace69dc46440669fb5e8684fee1d17a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Feb 2024 19:07:38 +0000 Subject: [PATCH 109/319] Disable allocation of ModGlue linearization matrices unless linearization is being performed --- modules/openfast-library/src/FAST_ModLin.f90 | 39 +++++++++++--------- 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModLin.f90 index 11799e7bd8..5b222c5afc 100644 --- a/modules/openfast-library/src/FAST_ModLin.f90 +++ b/modules/openfast-library/src/FAST_ModLin.f90 @@ -264,30 +264,33 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er call MV_InitVarIdx(ModGlue%Vars, ModGlue%Vars%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- - ! Allocate linearization arrays and matrices + ! Mesh Mapping !---------------------------------------------------------------------------- - ! Allocate linearization arrays - call AllocAry(ModGlue%Lin%x, ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dx, ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%xd, ModGlue%Vars%Nxd, "xd", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%z, ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%u, ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%y, ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return - - ! Allocate full Jacobian matrices - call AllocAry(ModGlue%Lin%dYdu, ModGlue%Vars%Ny, ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dXdu, ModGlue%Vars%Nx, ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dYdx, ModGlue%Vars%Ny, ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dXdx, ModGlue%Vars%Nx, ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dUdu, ModGlue%Vars%Nu, ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dUdy, ModGlue%Vars%Nu, ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InitMappings(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- - ! Mesh Mapping + ! Allocate linearization arrays and matrices !---------------------------------------------------------------------------- - call FAST_InitMappings(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + if (p_FAST%Linearize) then + + ! Allocate linearization arrays + call AllocAry(ModGlue%Lin%x, ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dx, ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%xd, ModGlue%Vars%Nxd, "xd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%z, ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%u, ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%y, ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate full Jacobian matrices + call AllocAry(ModGlue%Lin%dYdu, ModGlue%Vars%Ny, ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dXdu, ModGlue%Vars%Nx, ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dYdx, ModGlue%Vars%Ny, ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dXdx, ModGlue%Vars%Nx, ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dUdu, ModGlue%Vars%Nu, ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModGlue%Lin%dUdy, ModGlue%Vars%Nu, ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return + end if contains logical function Failed() From eb206a65075ed4e6a9f9ea431fc3100262e3185f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 1 Mar 2024 15:34:56 +0000 Subject: [PATCH 110/319] Fix rotate states in BD --- modules/beamdyn/src/BeamDyn.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index b234d5cb62..a04efadca1 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -935,6 +935,7 @@ subroutine SetParameters(InitInp, InputFileData, p, OtherState, ErrStat, ErrMsg) p%RotStates = InputFileData%RotStates ! Rotate states in linearization? + if (ChangeRefFrame) p%RotStates = .true. p%rhoinf = InputFileData%rhoinf ! Numerical damping coefficient: [0,1]. No numerical damping if rhoinf = 1; maximum numerical damping if rhoinf = 0. p%dt = InputFileData%DTBeam ! Time step size @@ -6211,7 +6212,8 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! If rotate states is enabled, modify Jacobian if (p%RotStates) then - RotateStates = matmul(u%RootMotion%Orientation(:,:,1), transpose(u%RootMotion%RefOrientation(:,:,1))) + ! Calculate difference between input root orientation and root reference orientation + RotateStates = matmul(u%RootMotion%Orientation(:,:,1), OtherState%GlbRot) do i=1,size(dXdu,1),3 dXdu(i:i+2, :) = matmul(RotateStates, dXdu(i:i+2, :)) end do @@ -6293,8 +6295,8 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! If rotate states is enabled if (p%RotStates) then - - RotateStates = matmul(u%RootMotion%Orientation(:,:,1), transpose(u%RootMotion%RefOrientation(:,:,1))) + ! Calculate difference between input root orientation and root reference orientation + RotateStates = matmul(u%RootMotion%Orientation(:,:,1), OtherState%GlbRot) RotateStatesTranspose = transpose( RotateStates ) if (present(StateRotation)) then From bca175827cf43359a46b584844059618cf6955a0 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:00:27 +0000 Subject: [PATCH 111/319] Remove AeroMap from AD, BD, ED --- modules/aerodyn/src/AeroDyn.f90 | 12 ------------ modules/beamdyn/src/BeamDyn.f90 | 12 ------------ modules/elastodyn/src/ElastoDyn.f90 | 14 -------------- 3 files changed, 38 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 5fdd282afa..8b688a6b7b 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5590,18 +5590,6 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call AD_CopyRotOtherStateType(OtherState, m%OtherState_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - !---------------------------------------------------------------------------- - ! AeroMap - !---------------------------------------------------------------------------- - - if (CompAeroMaps) then - - ! Initialize index for variables flagged with VF_AeroMap - call MV_InitVarIdx(p%Vars, p%Vars%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2) - if (Failed()) return - - end if - contains character(LinChanLen) function DBEMTLinName(BladeNum, NodeNum, Direction, Deriv) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index a04efadca1..a4fabaad1b 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -5953,18 +5953,6 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) call BD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call BD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - !---------------------------------------------------------------------------- - ! AeroMap - !---------------------------------------------------------------------------- - - if (p%CompAeroMaps) then - - ! Initialize index for variables flagged with VF_AeroMap - call MV_InitVarIdx(p%Vars, p%Vars%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2) - if (Failed()) return - - end if - contains pure integer(IntKi) function OutParamFlags(indx) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 5169cd1e30..1d4f652461 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -11331,20 +11331,6 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat call ED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call ED_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - !---------------------------------------------------------------------------- - ! AeroMap - !---------------------------------------------------------------------------- - - if (p%CompAeroMaps) then - - ! Initialize index for variables flagged with VF_AeroMap - call MV_InitVarIdx(p%Vars, p%Vars%IdxAeroMap, VF_AeroMap, ErrStat2, ErrMsg2); if (Failed()) return - - ! Update dx indices to select the accelerations - p%Vars%IdxAeroMap%idx = p%Vars%IdxAeroMap%idx + size(p%Vars%IdxAeroMap%idx)/2 - - end if - contains function BldOutLinName(OutParam, iBlade, iNode) result(Name) integer(IntKi), intent(in) :: iBlade, iNode From cb5b25ebd75161b58d79cf6516be351a41ba3027 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:01:09 +0000 Subject: [PATCH 112/319] InflowWind_IO: Add function to init SteadyFlowField from RefHt, HWindSpeed, and PLExp --- modules/inflowwind/src/InflowWind_IO.f90 | 62 +++++++++++++++++++++++- 1 file changed, 61 insertions(+), 1 deletion(-) diff --git a/modules/inflowwind/src/InflowWind_IO.f90 b/modules/inflowwind/src/InflowWind_IO.f90 index 31b6fd1f7e..62c6f7639b 100644 --- a/modules/inflowwind/src/InflowWind_IO.f90 +++ b/modules/inflowwind/src/InflowWind_IO.f90 @@ -34,7 +34,8 @@ module InflowWind_IO IfW_HAWC_Init, & IfW_User_Init, & IfW_Grid4D_Init, & - IfW_Points_Init + IfW_Points_Init, & + IfW_SteadyFlowField_Init public :: Uniform_WriteHH, & Grid3D_WriteBladed, & @@ -151,6 +152,65 @@ subroutine IfW_SteadyWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrMs end subroutine +subroutine IfW_SteadyFlowField_Init(FF, RefHt, HWindSpeed, PLExp, ErrStat, ErrMsg) + use InflowWind_IO_Types, only: Steady_InitInputType, WindFileDat + type(FlowFieldType), pointer, intent(inout) :: FF !< FlowField + real(ReKi), intent(in) :: RefHt !< Hub reference height + real(ReKi), intent(in) :: HWindSpeed !< Horizontal wind speed at reference height + real(ReKi), intent(in) :: PLExp !< Power law shear coefficient + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message + + character(*), parameter :: RoutineName = 'IfW_SteadyFlowField_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(Steady_InitInputType) :: InitInp + type(WindFileDat) :: WFileDat + + ErrStat = ErrID_None + ErrMsg = "" + + ! If FlowField pointer is already associated, destroy existing flow field; + ! otherwise, allocate a new flow field for pointer + if (associated(FF)) then + call IfW_FlowField_DestroyFlowFieldType(FF, ErrStat2, ErrMsg2); if (Failed()) return + else + allocate(FF, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating flow field', ErrStat, ErrMsg, RoutineName) + return + end if + end if + + ! Set flow-field type to uniform + FF%FieldType = Uniform_FieldType + + ! Set parameters from inititialization input + FF%Uniform%DataSize = 1 + FF%Uniform%RefHeight = RefHt + FF%Uniform%RefLength = 1.0_ReKi + + ! Allocate uniform wind data arrays + call UniformWind_AllocArrays(FF%Uniform, ErrStat2, ErrMsg2); if (Failed()) return + + ! Set data values + FF%Uniform%Time = 0.0_ReKi + FF%Uniform%VelH = HWindSpeed + FF%Uniform%VelV = 0.0_ReKi + FF%Uniform%VelGust = 0.0_ReKi + FF%Uniform%AngleH = 0.0_ReKi + FF%Uniform%AngleV = 0.0_ReKi + FF%Uniform%ShrH = 0.0_ReKi + FF%Uniform%ShrV = PLExp + FF%Uniform%LinShrV = 0.0_ReKi + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + !> IfW_UniformWind_Init initializes a Uniform field from file. subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrMsg) type(Uniform_InitInputType), intent(in) :: InitInp From ff89859b33bfb64acc8d143fa1e0526280b484e7 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:01:42 +0000 Subject: [PATCH 113/319] Rename FAST_ModLin to FAST_ModGlue This seemed like a more appropriate name given its role --- .../src/{FAST_ModLin.f90 => FAST_ModGlue.f90} | 301 ++++++++++++++++-- 1 file changed, 268 insertions(+), 33 deletions(-) rename modules/openfast-library/src/{FAST_ModLin.f90 => FAST_ModGlue.f90} (77%) diff --git a/modules/openfast-library/src/FAST_ModLin.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 similarity index 77% rename from modules/openfast-library/src/FAST_ModLin.f90 rename to modules/openfast-library/src/FAST_ModGlue.f90 index 5b222c5afc..8b476dea00 100644 --- a/modules/openfast-library/src/FAST_ModLin.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -18,7 +18,7 @@ ! See the License for the specific language governing permissions and ! limitations under the License. !********************************************************************************************************************************** -module FAST_ModLin +module FAST_ModGlue use NWTC_Library use NWTC_LAPACK @@ -31,11 +31,11 @@ module FAST_ModLin implicit none private -public :: ModLin_Init, ModLin_Linearize_OP +public :: ModGlue_Init, ModLin_Linearize_OP, MV_AddModule contains -subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) +subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) type(ModDataType), intent(inout) :: ModGlue !< Module data for glue code type(ModDataType), allocatable, intent(inout) :: Mods(:) !< Data for all modules @@ -53,7 +53,6 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er integer(IntKi), allocatable :: modIDs(:), modIdx(:) integer(IntKi) :: i, j, k integer(IntKi) :: FlagFilters - character(LinChanLen), allocatable :: xLinNames(:), uLinNames(:), yLinNames(:) character(20) :: NamePrefix ! Initialize error return @@ -91,7 +90,7 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er modIDs = [(Mods(i)%ID, i=1, size(Mods))] ! Establish module index order for linearization - allocate(p%iMod(0)) + allocate (p%iMod(0)) do i = 1, size(LinMods) p%iMod = [p%iMod, pack(modIdx, ModIDs == LinMods(i))] end do @@ -194,7 +193,7 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er call MV_UnsetFlags(ModData%Vars%u(j), VF_Linearize) end do case (LIN_STANDARD) - ! For standard inputs, use VF_Linearize flag set in the module + ! For standard inputs, use VF_Linearize flag as set in the module case (LIN_ALL) do j = 1, size(ModData%Vars%u) call MV_SetFlags(ModData%Vars%u(j), VF_Linearize) @@ -247,8 +246,12 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er ! Loop through added variables and add name prefix to linearization names call AddLinNamePrefix(ModGlue%Vars%y(k:), NamePrefix) + !---------------------------------------------------------------------- + ! Linearization index + !---------------------------------------------------------------------- + ! Initialize module linearization variable indexing - call MV_InitVarIdx(ModData%Vars, ModData%Vars%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return + call MV_InitModuleVarIdx(ModData, ModData%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return end associate end do @@ -261,7 +264,7 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er call CalcVarDataLoc(ModGlue%Vars%y, ModGlue%Vars%Ny) ! Initialize linearization index filtering - call MV_InitVarIdx(ModGlue%Vars, ModGlue%Vars%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return + call MV_InitModuleVarIdx(ModGlue, ModGlue%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Mesh Mapping @@ -273,7 +276,7 @@ subroutine ModLin_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, Er ! Allocate linearization arrays and matrices !---------------------------------------------------------------------------- - if (p_FAST%Linearize) then + if (p_FAST%Linearize .or. p_FAST%CompAeroMaps) then ! Allocate linearization arrays call AllocAry(ModGlue%Lin%x, ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return @@ -397,7 +400,7 @@ subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_F StateRotation=ModData%Lin%StateRotation) if (Failed()) return - ! Operating point values (must come after Jacobian routines because + ! Operating point values (must come after Jacobian routines because ! some modules calculate OP in those routines [MD]) call FAST_GetOP(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & u_op=ModData%Lin%u, y_op=ModData%Lin%y, & @@ -436,11 +439,11 @@ subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_F end if ! Write linearization matrices - call WriteModuleLinearMatrices(ModData, ModData%Vars%IdxLin, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat2, ErrMsg2) + call WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat2, ErrMsg2) if (Failed()) return end if - + ! Check for NaNs or infinity in module Jacobian matrices if (allocated(ModData%Lin%dYdu)) then if (any(isnan(ModData%Lin%dYdu))) then @@ -486,7 +489,7 @@ subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_F ! Write glue code data OutFileName = trim(LinRootName)//".lin" - call WriteModuleLinearMatrices(ModGlue, ModGlue%Vars%IdxLin, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat2, ErrMsg2, IsGlue=.true.) + call WriteModuleLinearMatrices(ModGlue, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat2, ErrMsg2, IsGlue=.true.) if (Failed()) return ! Update index for next linearization time @@ -685,10 +688,9 @@ subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) end subroutine -subroutine WriteModuleLinearMatrices(ModData, VarIdx, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat, ErrMsg, IsGlue) +subroutine WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat, ErrMsg, IsGlue) type(ModDataType), intent(in) :: ModData !< Module data - type(VarsIdxType), intent(in) :: VarIdx !< Variable index type(FAST_ParameterType) :: p_FAST !< Parameters type(FAST_OutputFileType) :: y_FAST !< Output variables real(DbKi), intent(in) :: t_global !< current time step (written in file) @@ -703,6 +705,7 @@ subroutine WriteModuleLinearMatrices(ModData, VarIdx, p_FAST, y_FAST, t_global, character(ErrMsgLen) :: ErrMsg2 character(32) :: Desc integer(IntKi) :: i + integer(IntKi) :: Nx, Nxd, Nz, Nu, Ny character(50) :: Fmt logical, allocatable :: uUse(:), yUse(:) logical :: IsGlueLoc @@ -717,6 +720,13 @@ subroutine WriteModuleLinearMatrices(ModData, VarIdx, p_FAST, y_FAST, t_global, ! Open linearization file call OpenFOutFile(Un, OutFileName, ErrStat2, ErrMsg2); if (Failed()) return + ! Calculate number of values in variable after applying filter + Nx = MV_NumVars(ModData%Vars%x, VF_Linearize) + Nxd = MV_NumVars(ModData%Vars%xd, VF_Linearize) + Nz = MV_NumVars(ModData%Vars%z, VF_Linearize) + Nu = MV_NumVars(ModData%Vars%u, VF_Linearize) + Ny = MV_NumVars(ModData%Vars%y, VF_Linearize) + !---------------------------------------------------------------------------- ! Header !---------------------------------------------------------------------------- @@ -734,11 +744,11 @@ subroutine WriteModuleLinearMatrices(ModData, VarIdx, p_FAST, y_FAST, t_global, Desc = 'Wind Speed: '; write (Un, fmt) Desc, y_FAST%Lin%WindSpeed, 'm/s' fmt = '(3x,A,1x,I5)' - Desc = 'Number of continuous states: '; write (Un, fmt) Desc, VarIdx%Nx - Desc = 'Number of discrete states: '; write (Un, fmt) Desc, VarIdx%Nxd - Desc = 'Number of constraint states: '; write (Un, fmt) Desc, VarIdx%Nz - Desc = 'Number of inputs: '; write (Un, fmt) Desc, VarIdx%Nu - Desc = 'Number of outputs: '; write (Un, fmt) Desc, VarIdx%Ny + Desc = 'Number of continuous states: '; write (Un, fmt) Desc, Nx + Desc = 'Number of discrete states: '; write (Un, fmt) Desc, Nxd + Desc = 'Number of constraint states: '; write (Un, fmt) Desc, Nz + Desc = 'Number of inputs: '; write (Un, fmt) Desc, Nu + Desc = 'Number of outputs: '; write (Un, fmt) Desc, Ny Desc = 'Jacobians included in this file?' fmt = '(3x,A,1x,A5)' @@ -750,41 +760,52 @@ subroutine WriteModuleLinearMatrices(ModData, VarIdx, p_FAST, y_FAST, t_global, write (Un, '()') !print a blank line - if (VarIdx%Nx > 0) then + if (Nx > 0) then write (Un, '(A)') 'Order of continuous states:' - call WrLinFile_txt_Table(ModData%Vars%x, VarIdx%FlagFilter, p_FAST, Un, "Row/Column", ModData%Lin%x) + call WrLinFile_txt_Table(ModData%Vars%x, VF_Linearize, p_FAST, Un, "Row/Column", ModData%Lin%x) write (Un, '(A)') 'Order of continuous state derivatives:' - call WrLinFile_txt_Table(ModData%Vars%x, VarIdx%FlagFilter, p_FAST, Un, "Row/Column", ModData%Lin%dx, IsDeriv=.true.) + call WrLinFile_txt_Table(ModData%Vars%x, VF_Linearize, p_FAST, Un, "Row/Column", ModData%Lin%dx, IsDeriv=.true.) end if - if (VarIdx%Nxd > 0) then + if (Nxd > 0) then write (Un, '(A)') 'Order of discrete states:' - call WrLinFile_txt_Table(ModData%Vars%xd, VarIdx%FlagFilter, p_FAST, Un, "Row/Column", ModData%Lin%xd) + call WrLinFile_txt_Table(ModData%Vars%xd, VF_Linearize, p_FAST, Un, "Row/Column", ModData%Lin%xd) end if - if (VarIdx%Nz > 0) then + if (Nz > 0) then write (Un, '(A)') 'Order of constraint states:' - call WrLinFile_txt_Table(ModData%Vars%z, VarIdx%FlagFilter, p_FAST, Un, "Row/Column", ModData%Lin%z) + call WrLinFile_txt_Table(ModData%Vars%z, VF_Linearize, p_FAST, Un, "Row/Column", ModData%Lin%z) end if - if (VarIdx%Nu > 0) then + if (Nu > 0) then write (Un, '(A)') 'Order of inputs:' - call WrLinFile_txt_Table(ModData%Vars%u, VarIdx%FlagFilter, p_FAST, Un, "Column ", ModData%Lin%u, ShowRot=.true.) + call WrLinFile_txt_Table(ModData%Vars%u, VF_Linearize, p_FAST, Un, "Column ", ModData%Lin%u, ShowRot=.true.) end if - if (VarIdx%Ny > 0) then + if (Ny > 0) then write (Un, '(A)') 'Order of outputs:' - call WrLinFile_txt_Table(ModData%Vars%y, VarIdx%FlagFilter, p_FAST, Un, "Row ", ModData%Lin%y, ShowRot=.true.) + call WrLinFile_txt_Table(ModData%Vars%y, VF_Linearize, p_FAST, Un, "Row ", ModData%Lin%y, ShowRot=.true.) end if + ! Create boolean array indicating which input values to write + ! (iLoc is used here because) allocate (uUse(ModData%Vars%Nu)) uUse = .false. - uUse(VarIdx%iu) = .true. + do i = 1, size(ModData%Vars%u) + associate (Var => ModData%Vars%u(i)) + if (MV_HasFlags(Var, VF_Linearize)) uUse(Var%iLoc(1):Var%iLoc(2)) = .true. + end associate + end do + ! Create boolean array indicating which output values to write allocate (yUse(ModData%Vars%Ny)) yUse = .false. - yUse(VarIdx%iy) = .true. + do i = 1, size(ModData%Vars%y) + associate (Var => ModData%Vars%y(i)) + if (MV_HasFlags(Var, VF_Linearize)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. + end associate + end do if (p_FAST%LinOutJac) then write (Un, '(/,A,/)') 'Jacobian matrices:' @@ -928,4 +949,218 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer end subroutine WrLinFile_txt_Table +subroutine MV_InitModuleVarIdx(ModData, VarIdx, FlagFilter, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData + type(VarsIdxType), intent(out) :: VarIdx + integer(IntKi), intent(in) :: FlagFilter + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_InitModuleVarIdx' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: xNumVar, xdNumVar, zNumVar, uNumVar, yNumVar + integer(IntKi) :: IndCol + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + ! Destroy VarIdx in case it has been previously used + call FAST_DestroyVarsIdxType(VarIdx, ErrStat2, ErrMsg2); if (Failed()) return + + ! Save filter in index + VarIdx%FlagFilter = FlagFilter + + ! Populate variable index arrays + call GetModVarLocs(ModData%Idx, ModData%Vars%x, VarIdx%ix, VarIdx%Nx, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return + call GetModVarLocs(ModData%Idx, ModData%Vars%xd, VarIdx%ixd, VarIdx%Nxd, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return + call GetModVarLocs(ModData%Idx, ModData%Vars%z, VarIdx%iz, VarIdx%Nz, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return + call GetModVarLocs(ModData%Idx, ModData%Vars%u, VarIdx%iu, VarIdx%Nu, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return + call GetModVarLocs(ModData%Idx, ModData%Vars%y, VarIdx%iy, VarIdx%Ny, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine MV_InitGlueVarIdx(Mods, ModOrder, VarIdx, FlagFilter, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) + integer(IntKi), intent(in) :: ModOrder(:) + type(VarsIdxType), intent(out) :: VarIdx + integer(IntKi), intent(in) :: FlagFilter + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_InitVarIdx' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + integer(IntKi) :: ivar, inum + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine GetModVarLocs(ModIdx, VarAry, Idx, NumVals, FlagFilter, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: ModIdx + type(ModVarType), intent(in) :: VarAry(:) + type(VarIdxType), allocatable, intent(inout) :: Idx(:) + integer(IntKi), intent(inout) :: NumVals + integer(IntKi), intent(in) :: FlagFilter + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'GetModIdx' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, iGbl(2), NumVarsOld, NumVarsNew + type(VarIdxType), allocatable :: IdxTmp(:) + + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate number of vars to keep in VarAry + NumVarsNew = 0 + do i = 1, size(VarAry) + if (MV_HasFlags(VarAry(i), FlagFilter)) NumVarsNew = NumVarsNew + 1 + end do + + ! If variable locations array currently has data + if (allocated(Idx)) then + + ! Get number of variables currently in index + NumVarsOld = size(Idx) + + ! Move Idx allocation to temporary so new array can be allocated with correct size + call move_alloc(Idx, IdxTmp) + + ! Allocate new array to store previous and new variable data + allocate(Idx(NumVarsOld + NumVarsNew), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Unable to allocate index", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Move old variables to new array + Idx(1:NumVarsOld) = IdxTmp + + ! Deallocate temporary array + deallocate(IdxTmp) + + else + + ! No old variables + NumVarsOld = 0 + + ! Initialize number of values + NumVals = 0 + + ! Allocate new array to store previous and new variable data + allocate(Idx(NumVarsNew), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Unable to allocate index", ErrStat, ErrMsg, RoutineName) + return + end if + + end if + + ! Determine starting index of variable in index array + if (NumVarsOld == 0) then + iGbl = 0 + else + iGbl = Idx(NumVarsOld)%iGbl + end if + + ! Store variable index data in array + j = NumVarsOld + do i = 1, size(VarAry) + if (MV_HasFlags(VarAry(i), FlagFilter)) then + j = j + 1 + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + VarAry(i)%Num - 1 + Idx(j) = VarIdxType(ModIdx=ModIdx, iVar=i, iLoc=VarAry(i)%iLoc, iGbl=iGbl) + NumVals = NumVals + VarAry(i)%Num + end if + end do + +end subroutine + +subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: ModAry(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: ModDT + real(R8Ki), intent(in) :: SolverDT + type(ModVarsType), pointer, intent(in) :: Vars + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_AddModule' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + + ErrStat = ErrID_None + ErrMsg = '' + + ! If module array hasn't been allocated, allocate with zero size + if (.not. allocated(ModAry)) allocate (ModAry(0)) + + ! Populate ModuleDataType derived type + ModData = ModDataType(Idx=size(ModAry) + 1, ID=ModID, Abbr=ModAbbr, & + Ins=Instance, DT=ModDT, Vars=Vars) + + ! Allocate source and destination mapping arrays + call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Calculate Module Substepping + !---------------------------------------------------------------------------- + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData%DT, SolverDT)) then + ModData%SubSteps = 1 + else + ! If the module time step is greater than the global time step, set error + if (ModData%DT > SolverDT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate the number of substeps + ModData%SubSteps = nint(SolverDT/ModData%DT) + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Add module data to array + !---------------------------------------------------------------------------- + + ModAry = [ModAry, ModData] + +end subroutine + end module From f27e629a209a20096287e17ce39165df76ee5654 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:02:11 +0000 Subject: [PATCH 114/319] Move some types/funcs out of ModVar and into glue code --- modules/nwtc-library/src/ModVar.f90 | 143 +-- .../nwtc-library/src/NWTC_Library_Types.f90 | 752 -------------- .../src/Registry_NWTC_Library.txt | 52 - .../src/Registry_NWTC_Library_base.txt | 52 - modules/openfast-library/CMakeLists.txt | 2 +- .../openfast-library/src/FAST_Registry.txt | 56 +- modules/openfast-library/src/FAST_Types.f90 | 958 +++++++++++++++++- 7 files changed, 1003 insertions(+), 1012 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 4563ae34bb..30be0bbb9c 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -31,12 +31,11 @@ module ModVar private public :: MV_InitVarsJac, MV_Pack, MV_Unpack public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff -public :: MV_AddVar, MV_AddMeshVar, MV_AddModule +public :: MV_AddVar, MV_AddMeshVar public :: MV_HasFlags, MV_SetFlags, MV_UnsetFlags, MV_NumVars public :: LoadFields, MotionFields, TransFields, AngularFields public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_rvec, wm_from_rvec public :: MV_FieldString, IdxStr -public :: MV_InitVarIdx integer(IntKi), parameter :: & LoadFields(*) = [VF_Force, VF_Moment], & @@ -96,7 +95,6 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, StartIndex - type(VarsIdxType), pointer :: VarIdx ! Initialize error outputs ErrStat = ErrID_None @@ -614,81 +612,9 @@ subroutine MV_ComputeCentralDiff(VarAry, Delta, PosAry, NegAry, DerivAry) end subroutine !------------------------------------------------------------------------------- -! Functions for adding Variables an Modules +! Functions for adding Variables !------------------------------------------------------------------------------- -subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) - type(ModDataType), allocatable, intent(inout) :: ModAry(:) - integer(IntKi), intent(in) :: ModID - character(*), intent(in) :: ModAbbr - integer(IntKi), intent(in) :: Instance - real(R8Ki), intent(in) :: ModDT - real(R8Ki), intent(in) :: SolverDT - type(ModVarsType), pointer, intent(in) :: Vars - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'MV_AddModule' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(ModDataType) :: ModData - - ErrStat = ErrID_None - ErrMsg = '' - - ! If module array hasn't been allocated, allocate with zero size - if (.not. allocated(ModAry)) allocate (ModAry(0)) - - ! Populate ModuleDataType derived type - ModData = ModDataType(Idx=size(ModAry) + 1, ID=ModID, Abbr=ModAbbr, & - Ins=Instance, DT=ModDT, Vars=Vars) - - ! Allocate source and destination mapping arrays - call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !---------------------------------------------------------------------------- - ! Calculate Module Substepping - !---------------------------------------------------------------------------- - - ! If module time step is same as global time step, set substeps to 1 - if (EqualRealNos(ModData%DT, SolverDT)) then - ModData%SubSteps = 1 - else - ! If the module time step is greater than the global time step, set error - if (ModData%DT > SolverDT) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & - " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & - "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - - ! Calculate the number of substeps - ModData%SubSteps = nint(SolverDT/ModData%DT) - - ! If the module DT is not an exact integer divisor of the global time step, set error - if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & - " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & - "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - end if - - !---------------------------------------------------------------------------- - ! Add module data to array - !---------------------------------------------------------------------------- - - ModAry = [ModAry, ModData] - -end subroutine - subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs, VarIdx, Active) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name @@ -816,71 +742,6 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Pe if (present(VarIdx)) VarIdx = size(VarAry) end subroutine -subroutine MV_InitVarIdx(Vars, VarIdx, FlagFilter, ErrStat, ErrMsg) - type(ModVarsType), intent(in) :: Vars - type(VarsIdxType), intent(out) :: VarIdx - integer(IntKi), intent(in) :: FlagFilter - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'MV_InitVarIdx' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(ModDataType) :: ModData - integer(IntKi) :: ivar, inum - - ! Initialize error return - ErrStat = ErrID_None - ErrMsg = "" - - ! Save filter in index - VarIdx%FlagFilter = FlagFilter - - ! Get number of filtered variables - VarIdx%Nx = MV_NumVars(Vars%x, FlagFilter) - VarIdx%Nu = MV_NumVars(Vars%u, FlagFilter) - VarIdx%Ny = MV_NumVars(Vars%y, FlagFilter) - - ! Allocate index arrays - call AllocAry(VarIdx%ix, VarIdx%Nx, "ix", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(VarIdx%idx, VarIdx%Nx, "idx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(VarIdx%ixd, VarIdx%Nxd, "ixd", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(VarIdx%iz, VarIdx%Nz, "iz", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(VarIdx%iu, VarIdx%Nu, "iu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(VarIdx%iy, VarIdx%Ny, "iy", ErrStat2, ErrMsg2); if (Failed()) return - - ! Get filtered value indices - call GetIndices(Vars%x, VarIdx%ix, FlagFilter) - call GetIndices(Vars%xd, VarIdx%ixd, FlagFilter) - call GetIndices(Vars%z, VarIdx%iz, FlagFilter) - call GetIndices(Vars%u, VarIdx%iu, FlagFilter) - call GetIndices(Vars%y, VarIdx%iy, FlagFilter) - - ! Copy state variable indices to state variable derivative indices - VarIdx%idx = VarIdx%ix - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine - -subroutine GetIndices(VarAry, Indices, Mask) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: Mask - integer(IntKi), intent(inout) :: Indices(:) - integer(IntKi) :: i, j, k - k = 1 - do i = 1, size(VarAry) - if (.not. MV_HasFlags(VarAry(i), Mask)) cycle - do j = 0, VarAry(i)%Num - 1 - Indices(k) = VarAry(i)%iLoc(1) + j - k = k + 1 - end do - end do -end subroutine - function MV_NumVars(VarAry, FlagFilter) result(Num) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), optional, intent(in) :: FlagFilter diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index e88ed5f21c..04e0c69138 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -127,22 +127,6 @@ MODULE NWTC_Library_Types character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType ! ======================= -! ========= VarsIdxType ======= - TYPE, PUBLIC :: VarsIdxType - INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] - INTEGER(IntKi) :: Nx = 0_IntKi !< [-] - INTEGER(IntKi) :: Nxd = 0_IntKi !< [-] - INTEGER(IntKi) :: Nz = 0_IntKi !< [-] - INTEGER(IntKi) :: Nu = 0_IntKi !< [-] - INTEGER(IntKi) :: Ny = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ix !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ixd !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iz !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: idx !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iu !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iy !< [-] - END TYPE VarsIdxType -! ======================= ! ========= ModVarsType ======= TYPE, PUBLIC :: ModVarsType INTEGER(IntKi) :: Nx = 0 !< Number of x values [-] @@ -155,9 +139,6 @@ MODULE NWTC_Library_Types TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: z !< Module state variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] - TYPE(VarsIdxType) :: IdxLin !< Variable index array [-] - TYPE(VarsIdxType) :: IdxSolver !< Variable index array [-] - TYPE(VarsIdxType) :: IdxAeroMap !< Variable index array [-] END TYPE ModVarsType ! ======================= ! ========= ModJacType ======= @@ -176,48 +157,6 @@ MODULE NWTC_Library_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] END TYPE ModJacType ! ======================= -! ========= ModLinType ======= - TYPE, PUBLIC :: ModLinType - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] - END TYPE ModLinType -! ======================= -! ========= ModDataType ======= - TYPE, PUBLIC :: ModDataType - character(ChanLen) :: Abbr !< Module name abbreviation [-] - INTEGER(IntKi) :: ID = 0 !< Module identification number [-] - INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] - INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] - REAL(R8Ki) :: DT = 0 !< Module time step [-] - INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] - INTEGER(IntKi) :: ixg = 0_IntKi !< starting index for continuous state values in global arrays [-] - INTEGER(IntKi) :: ixdg = 0_IntKi !< starting index for discrete state values in global arrays [-] - INTEGER(IntKi) :: izg = 0_IntKi !< starting index for constraint state values in global arrays [-] - INTEGER(IntKi) :: iug = 0_IntKi !< starting index for input values in global arrays [-] - INTEGER(IntKi) :: iyg = 0_IntKi !< starting index for output values in global arrays [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] - TYPE(ModLinType) :: Lin !< Module linearization data [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] - END TYPE ModDataType -! ======================= ! ========= MeshLocType ======= TYPE, PUBLIC :: MeshLocType INTEGER(IntKi) :: Num = 0 !< Mesh number in module [-] @@ -736,166 +675,6 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) call RegUnpackAlloc(RF, OutData%LinNames); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarsIdxType), intent(in) :: SrcVarsIdxTypeData - type(VarsIdxType), intent(inout) :: DstVarsIdxTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyVarsIdxType' - ErrStat = ErrID_None - ErrMsg = '' - DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter - DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx - DstVarsIdxTypeData%Nxd = SrcVarsIdxTypeData%Nxd - DstVarsIdxTypeData%Nz = SrcVarsIdxTypeData%Nz - DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu - DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny - if (allocated(SrcVarsIdxTypeData%ix)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%ix, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%ix, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%ix)) then - allocate(DstVarsIdxTypeData%ix(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%ix.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarsIdxTypeData%ix = SrcVarsIdxTypeData%ix - end if - if (allocated(SrcVarsIdxTypeData%ixd)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%ixd, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%ixd, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%ixd)) then - allocate(DstVarsIdxTypeData%ixd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%ixd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarsIdxTypeData%ixd = SrcVarsIdxTypeData%ixd - end if - if (allocated(SrcVarsIdxTypeData%iz)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%iz, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%iz, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%iz)) then - allocate(DstVarsIdxTypeData%iz(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarsIdxTypeData%iz = SrcVarsIdxTypeData%iz - end if - if (allocated(SrcVarsIdxTypeData%idx)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%idx, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%idx, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%idx)) then - allocate(DstVarsIdxTypeData%idx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%idx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarsIdxTypeData%idx = SrcVarsIdxTypeData%idx - end if - if (allocated(SrcVarsIdxTypeData%iu)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%iu, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%iu, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%iu)) then - allocate(DstVarsIdxTypeData%iu(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarsIdxTypeData%iu = SrcVarsIdxTypeData%iu - end if - if (allocated(SrcVarsIdxTypeData%iy)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%iy, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%iy, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%iy)) then - allocate(DstVarsIdxTypeData%iy(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarsIdxTypeData%iy = SrcVarsIdxTypeData%iy - end if -end subroutine - -subroutine NWTC_Library_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) - type(VarsIdxType), intent(inout) :: VarsIdxTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyVarsIdxType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(VarsIdxTypeData%ix)) then - deallocate(VarsIdxTypeData%ix) - end if - if (allocated(VarsIdxTypeData%ixd)) then - deallocate(VarsIdxTypeData%ixd) - end if - if (allocated(VarsIdxTypeData%iz)) then - deallocate(VarsIdxTypeData%iz) - end if - if (allocated(VarsIdxTypeData%idx)) then - deallocate(VarsIdxTypeData%idx) - end if - if (allocated(VarsIdxTypeData%iu)) then - deallocate(VarsIdxTypeData%iu) - end if - if (allocated(VarsIdxTypeData%iy)) then - deallocate(VarsIdxTypeData%iy) - end if -end subroutine - -subroutine NWTC_Library_PackVarsIdxType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(VarsIdxType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackVarsIdxType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%FlagFilter) - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nxd) - call RegPack(RF, InData%Nz) - call RegPack(RF, InData%Nu) - call RegPack(RF, InData%Ny) - call RegPackAlloc(RF, InData%ix) - call RegPackAlloc(RF, InData%ixd) - call RegPackAlloc(RF, InData%iz) - call RegPackAlloc(RF, InData%idx) - call RegPackAlloc(RF, InData%iu) - call RegPackAlloc(RF, InData%iy) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackVarsIdxType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(VarsIdxType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackVarsIdxType' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ix); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ixd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%idx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iy); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, CtrlCode, ErrStat, ErrMsg) type(ModVarsType), intent(in) :: SrcModVarsTypeData type(ModVarsType), intent(inout) :: DstModVarsTypeData @@ -994,15 +773,6 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (ErrStat >= AbortErrLev) return end do end if - call NWTC_Library_CopyVarsIdxType(SrcModVarsTypeData%IdxLin, DstModVarsTypeData%IdxLin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyVarsIdxType(SrcModVarsTypeData%IdxSolver, DstModVarsTypeData%IdxSolver, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyVarsIdxType(SrcModVarsTypeData%IdxAeroMap, DstModVarsTypeData%IdxAeroMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) @@ -1061,12 +831,6 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) end do deallocate(ModVarsTypeData%y) end if - call NWTC_Library_DestroyVarsIdxType(ModVarsTypeData%IdxLin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyVarsIdxType(ModVarsTypeData%IdxSolver, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyVarsIdxType(ModVarsTypeData%IdxAeroMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine NWTC_Library_PackModVarsType(RF, Indata) @@ -1126,9 +890,6 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) call NWTC_Library_PackModVarType(RF, InData%y(i1)) end do end if - call NWTC_Library_PackVarsIdxType(RF, InData%IdxLin) - call NWTC_Library_PackVarsIdxType(RF, InData%IdxSolver) - call NWTC_Library_PackVarsIdxType(RF, InData%IdxAeroMap) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1211,9 +972,6 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) call NWTC_Library_UnpackModVarType(RF, OutData%y(i1)) ! y end do end if - call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxLin) ! IdxLin - call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxSolver) ! IdxSolver - call NWTC_Library_UnpackVarsIdxType(RF, OutData%IdxAeroMap) ! IdxAeroMap end subroutine subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1460,516 +1218,6 @@ subroutine NWTC_Library_UnPackModJacType(RF, OutData) call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModLinType), intent(in) :: SrcModLinTypeData - type(ModLinType), intent(inout) :: DstModLinTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyModLinType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcModLinTypeData%x)) then - LB(1:1) = lbound(SrcModLinTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%x, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%x)) then - allocate(DstModLinTypeData%x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%x = SrcModLinTypeData%x - end if - if (allocated(SrcModLinTypeData%dx)) then - LB(1:1) = lbound(SrcModLinTypeData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%dx, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%dx)) then - allocate(DstModLinTypeData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%dx = SrcModLinTypeData%dx - end if - if (allocated(SrcModLinTypeData%xd)) then - LB(1:1) = lbound(SrcModLinTypeData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%xd, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%xd)) then - allocate(DstModLinTypeData%xd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%xd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%xd = SrcModLinTypeData%xd - end if - if (allocated(SrcModLinTypeData%z)) then - LB(1:1) = lbound(SrcModLinTypeData%z, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%z, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%z)) then - allocate(DstModLinTypeData%z(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%z.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%z = SrcModLinTypeData%z - end if - if (allocated(SrcModLinTypeData%u)) then - LB(1:1) = lbound(SrcModLinTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%u, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%u)) then - allocate(DstModLinTypeData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%u = SrcModLinTypeData%u - end if - if (allocated(SrcModLinTypeData%y)) then - LB(1:1) = lbound(SrcModLinTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%y, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%y)) then - allocate(DstModLinTypeData%y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%y = SrcModLinTypeData%y - end if - if (allocated(SrcModLinTypeData%u_perturb)) then - LB(1:1) = lbound(SrcModLinTypeData%u_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%u_perturb, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%u_perturb)) then - allocate(DstModLinTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%u_perturb = SrcModLinTypeData%u_perturb - end if - if (allocated(SrcModLinTypeData%x_perturb)) then - LB(1:1) = lbound(SrcModLinTypeData%x_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%x_perturb, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%x_perturb)) then - allocate(DstModLinTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%x_perturb = SrcModLinTypeData%x_perturb - end if - if (allocated(SrcModLinTypeData%x_pos)) then - LB(1:1) = lbound(SrcModLinTypeData%x_pos, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%x_pos, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%x_pos)) then - allocate(DstModLinTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x_pos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%x_pos = SrcModLinTypeData%x_pos - end if - if (allocated(SrcModLinTypeData%x_neg)) then - LB(1:1) = lbound(SrcModLinTypeData%x_neg, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%x_neg, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%x_neg)) then - allocate(DstModLinTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x_neg.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%x_neg = SrcModLinTypeData%x_neg - end if - if (allocated(SrcModLinTypeData%y_pos)) then - LB(1:1) = lbound(SrcModLinTypeData%y_pos, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%y_pos, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%y_pos)) then - allocate(DstModLinTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%y_pos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%y_pos = SrcModLinTypeData%y_pos - end if - if (allocated(SrcModLinTypeData%y_neg)) then - LB(1:1) = lbound(SrcModLinTypeData%y_neg, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%y_neg, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%y_neg)) then - allocate(DstModLinTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%y_neg.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%y_neg = SrcModLinTypeData%y_neg - end if - if (allocated(SrcModLinTypeData%dYdx)) then - LB(1:2) = lbound(SrcModLinTypeData%dYdx, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dYdx, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%dYdx)) then - allocate(DstModLinTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%dYdx = SrcModLinTypeData%dYdx - end if - if (allocated(SrcModLinTypeData%dXdx)) then - LB(1:2) = lbound(SrcModLinTypeData%dXdx, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dXdx, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%dXdx)) then - allocate(DstModLinTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%dXdx = SrcModLinTypeData%dXdx - end if - if (allocated(SrcModLinTypeData%dYdu)) then - LB(1:2) = lbound(SrcModLinTypeData%dYdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dYdu, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%dYdu)) then - allocate(DstModLinTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%dYdu = SrcModLinTypeData%dYdu - end if - if (allocated(SrcModLinTypeData%dXdu)) then - LB(1:2) = lbound(SrcModLinTypeData%dXdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dXdu, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%dXdu)) then - allocate(DstModLinTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%dXdu = SrcModLinTypeData%dXdu - end if - if (allocated(SrcModLinTypeData%dUdu)) then - LB(1:2) = lbound(SrcModLinTypeData%dUdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dUdu, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%dUdu)) then - allocate(DstModLinTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%dUdu = SrcModLinTypeData%dUdu - end if - if (allocated(SrcModLinTypeData%dUdy)) then - LB(1:2) = lbound(SrcModLinTypeData%dUdy, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dUdy, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%dUdy)) then - allocate(DstModLinTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%dUdy = SrcModLinTypeData%dUdy - end if - if (allocated(SrcModLinTypeData%StateRotation)) then - LB(1:2) = lbound(SrcModLinTypeData%StateRotation, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%StateRotation, kind=B8Ki) - if (.not. allocated(DstModLinTypeData%StateRotation)) then - allocate(DstModLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTypeData%StateRotation = SrcModLinTypeData%StateRotation - end if -end subroutine - -subroutine NWTC_Library_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) - type(ModLinType), intent(inout) :: ModLinTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModLinType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ModLinTypeData%x)) then - deallocate(ModLinTypeData%x) - end if - if (allocated(ModLinTypeData%dx)) then - deallocate(ModLinTypeData%dx) - end if - if (allocated(ModLinTypeData%xd)) then - deallocate(ModLinTypeData%xd) - end if - if (allocated(ModLinTypeData%z)) then - deallocate(ModLinTypeData%z) - end if - if (allocated(ModLinTypeData%u)) then - deallocate(ModLinTypeData%u) - end if - if (allocated(ModLinTypeData%y)) then - deallocate(ModLinTypeData%y) - end if - if (allocated(ModLinTypeData%u_perturb)) then - deallocate(ModLinTypeData%u_perturb) - end if - if (allocated(ModLinTypeData%x_perturb)) then - deallocate(ModLinTypeData%x_perturb) - end if - if (allocated(ModLinTypeData%x_pos)) then - deallocate(ModLinTypeData%x_pos) - end if - if (allocated(ModLinTypeData%x_neg)) then - deallocate(ModLinTypeData%x_neg) - end if - if (allocated(ModLinTypeData%y_pos)) then - deallocate(ModLinTypeData%y_pos) - end if - if (allocated(ModLinTypeData%y_neg)) then - deallocate(ModLinTypeData%y_neg) - end if - if (allocated(ModLinTypeData%dYdx)) then - deallocate(ModLinTypeData%dYdx) - end if - if (allocated(ModLinTypeData%dXdx)) then - deallocate(ModLinTypeData%dXdx) - end if - if (allocated(ModLinTypeData%dYdu)) then - deallocate(ModLinTypeData%dYdu) - end if - if (allocated(ModLinTypeData%dXdu)) then - deallocate(ModLinTypeData%dXdu) - end if - if (allocated(ModLinTypeData%dUdu)) then - deallocate(ModLinTypeData%dUdu) - end if - if (allocated(ModLinTypeData%dUdy)) then - deallocate(ModLinTypeData%dUdy) - end if - if (allocated(ModLinTypeData%StateRotation)) then - deallocate(ModLinTypeData%StateRotation) - end if -end subroutine - -subroutine NWTC_Library_PackModLinType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ModLinType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackModLinType' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%x) - call RegPackAlloc(RF, InData%dx) - call RegPackAlloc(RF, InData%xd) - call RegPackAlloc(RF, InData%z) - call RegPackAlloc(RF, InData%u) - call RegPackAlloc(RF, InData%y) - call RegPackAlloc(RF, InData%u_perturb) - call RegPackAlloc(RF, InData%x_perturb) - call RegPackAlloc(RF, InData%x_pos) - call RegPackAlloc(RF, InData%x_neg) - call RegPackAlloc(RF, InData%y_pos) - call RegPackAlloc(RF, InData%y_neg) - call RegPackAlloc(RF, InData%dYdx) - call RegPackAlloc(RF, InData%dXdx) - call RegPackAlloc(RF, InData%dYdu) - call RegPackAlloc(RF, InData%dXdu) - call RegPackAlloc(RF, InData%dUdu) - call RegPackAlloc(RF, InData%dUdy) - call RegPackAlloc(RF, InData%StateRotation) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackModLinType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ModLinType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModLinType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: SrcModDataTypeData - type(ModDataType), intent(inout) :: DstModDataTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' - ErrStat = ErrID_None - ErrMsg = '' - DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr - DstModDataTypeData%ID = SrcModDataTypeData%ID - DstModDataTypeData%Idx = SrcModDataTypeData%Idx - DstModDataTypeData%Ins = SrcModDataTypeData%Ins - DstModDataTypeData%DT = SrcModDataTypeData%DT - DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps - DstModDataTypeData%ixg = SrcModDataTypeData%ixg - DstModDataTypeData%ixdg = SrcModDataTypeData%ixdg - DstModDataTypeData%izg = SrcModDataTypeData%izg - DstModDataTypeData%iug = SrcModDataTypeData%iug - DstModDataTypeData%iyg = SrcModDataTypeData%iyg - DstModDataTypeData%Vars => SrcModDataTypeData%Vars - call NWTC_Library_CopyModLinType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcModDataTypeData%SrcMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%SrcMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%SrcMaps)) then - allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps - end if - if (allocated(SrcModDataTypeData%DstMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%DstMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%DstMaps, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%DstMaps)) then - allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps - end if -end subroutine - -subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: ModDataTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' - ErrStat = ErrID_None - ErrMsg = '' - nullify(ModDataTypeData%Vars) - call NWTC_Library_DestroyModLinType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ModDataTypeData%SrcMaps)) then - deallocate(ModDataTypeData%SrcMaps) - end if - if (allocated(ModDataTypeData%DstMaps)) then - deallocate(ModDataTypeData%DstMaps) - end if -end subroutine - -subroutine NWTC_Library_PackModDataType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ModDataType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' - logical :: PtrInIndex - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Abbr) - call RegPack(RF, InData%ID) - call RegPack(RF, InData%Idx) - call RegPack(RF, InData%Ins) - call RegPack(RF, InData%DT) - call RegPack(RF, InData%SubSteps) - call RegPack(RF, InData%ixg) - call RegPack(RF, InData%ixdg) - call RegPack(RF, InData%izg) - call RegPack(RF, InData%iug) - call RegPack(RF, InData%iyg) - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if - call NWTC_Library_PackModLinType(RF, InData%Lin) - call RegPackAlloc(RF, InData%SrcMaps) - call RegPackAlloc(RF, InData%DstMaps) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackModDataType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ModDataType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ixg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ixdg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%izg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iug); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iyg); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if - call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin - call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine NWTC_Library_CopyMeshLocType(SrcMeshLocTypeData, DstMeshLocTypeData, CtrlCode, ErrStat, ErrMsg) type(MeshLocType), intent(in) :: SrcMeshLocTypeData type(MeshLocType), intent(inout) :: DstMeshLocTypeData diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 1d02cf644a..9477f27dc3 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -86,19 +86,6 @@ typedef ^ ^ IntKi MeshID - 0 - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - -typedef ^ VarsIdxType IntKi FlagFilter - - - "" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nxd - - - "" - -typedef ^ ^ IntKi Nz - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ^ IntKi ix : - - "" - -typedef ^ ^ IntKi ixd : - - "" - -typedef ^ ^ IntKi iz : - - "" - -typedef ^ ^ IntKi idx : - - "" - -typedef ^ ^ IntKi iu : - - "" - -typedef ^ ^ IntKi iy : - - "" - - typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" typedef ^ ^ IntKi Nxd - 0 - "Number of xd values" typedef ^ ^ IntKi Nz - 0 - "Number of z values" @@ -109,9 +96,6 @@ typedef ^ ^ ModVarType xd : - - typedef ^ ^ ModVarType z : - - "Module state variable array" - typedef ^ ^ ModVarType u : - - "Module input variable array" - typedef ^ ^ ModVarType y : - - "Module output variable array" - -typedef ^ ^ VarsIdxType IdxLin - - - "Variable index array" - -typedef ^ ^ VarsIdxType IdxSolver - - - "Variable index array" - -typedef ^ ^ VarsIdxType IdxAeroMap - - - "Variable index array" - typedef ^ ModJacType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - @@ -126,42 +110,6 @@ typedef ^ ^ R8Ki x_neg : - - typedef ^ ^ R8Ki y_pos : - - "" - typedef ^ ^ R8Ki y_neg : - - "" - -typedef ^ ModLinType R8Ki x : - - "" - -typedef ^ ^ R8Ki dx : - - "" - -typedef ^ ^ R8Ki xd : - - "" - -typedef ^ ^ R8Ki z : - - "" - -typedef ^ ^ R8Ki u : - - "" - -typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "" - -typedef ^ ^ R8Ki x_perturb : - - "" - -typedef ^ ^ R8Ki x_pos : - - "" - -typedef ^ ^ R8Ki x_neg : - - "" - -typedef ^ ^ R8Ki y_pos : - - "" - -typedef ^ ^ R8Ki y_neg : - - "" - -typedef ^ ^ R8Ki dYdx :: - - "" - -typedef ^ ^ R8Ki dXdx :: - - "" - -typedef ^ ^ R8Ki dYdu :: - - "" - -typedef ^ ^ R8Ki dXdu :: - - "" - -typedef ^ ^ R8Ki dUdu :: - - "" - -typedef ^ ^ R8Ki dUdy :: - - "" - -typedef ^ ^ R8Ki StateRotation :: - - "" - - -typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - -typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ IntKi Idx - 0 - "Module index in array of modules" - -typedef ^ ^ IntKi Ins - 0 - "Module instance number" - -typedef ^ ^ R8Ki DT - 0 - "Module time step" - -typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ IntKi ixg - - - "starting index for continuous state values in global arrays" - -typedef ^ ^ IntKi ixdg - - - "starting index for discrete state values in global arrays" - -typedef ^ ^ IntKi izg - - - "starting index for constraint state values in global arrays" - -typedef ^ ^ IntKi iug - - - "starting index for input values in global arrays" - -typedef ^ ^ IntKi iyg - - - "starting index for output values in global arrays" - -typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - -typedef ^ ^ ModLinType Lin - - - "Module linearization data" - -typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" -typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" - typedef ^ MeshLocType IntKi Num - 0 - "Mesh number in module" typedef ^ ^ IntKi i1 - 0 - "Mesh index 1" typedef ^ ^ IntKi i2 - 0 - "Mesh index 2" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 4969d37e2e..1b154043fe 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -86,19 +86,6 @@ typedef ^ ^ IntKi MeshID - 0 - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - -typedef ^ VarsIdxType IntKi FlagFilter - - - "" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nxd - - - "" - -typedef ^ ^ IntKi Nz - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ^ IntKi ix : - - "" - -typedef ^ ^ IntKi ixd : - - "" - -typedef ^ ^ IntKi iz : - - "" - -typedef ^ ^ IntKi idx : - - "" - -typedef ^ ^ IntKi iu : - - "" - -typedef ^ ^ IntKi iy : - - "" - - typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" typedef ^ ^ IntKi Nxd - 0 - "Number of xd values" typedef ^ ^ IntKi Nz - 0 - "Number of z values" @@ -109,9 +96,6 @@ typedef ^ ^ ModVarType xd : - - typedef ^ ^ ModVarType z : - - "Module state variable array" - typedef ^ ^ ModVarType u : - - "Module input variable array" - typedef ^ ^ ModVarType y : - - "Module output variable array" - -typedef ^ ^ VarsIdxType IdxLin - - - "Variable index array" - -typedef ^ ^ VarsIdxType IdxSolver - - - "Variable index array" - -typedef ^ ^ VarsIdxType IdxAeroMap - - - "Variable index array" - typedef ^ ModJacType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - @@ -126,42 +110,6 @@ typedef ^ ^ R8Ki x_neg : - - typedef ^ ^ R8Ki y_pos : - - "" - typedef ^ ^ R8Ki y_neg : - - "" - -typedef ^ ModLinType R8Ki x : - - "" - -typedef ^ ^ R8Ki dx : - - "" - -typedef ^ ^ R8Ki xd : - - "" - -typedef ^ ^ R8Ki z : - - "" - -typedef ^ ^ R8Ki u : - - "" - -typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "" - -typedef ^ ^ R8Ki x_perturb : - - "" - -typedef ^ ^ R8Ki x_pos : - - "" - -typedef ^ ^ R8Ki x_neg : - - "" - -typedef ^ ^ R8Ki y_pos : - - "" - -typedef ^ ^ R8Ki y_neg : - - "" - -typedef ^ ^ R8Ki dYdx :: - - "" - -typedef ^ ^ R8Ki dXdx :: - - "" - -typedef ^ ^ R8Ki dYdu :: - - "" - -typedef ^ ^ R8Ki dXdu :: - - "" - -typedef ^ ^ R8Ki dUdu :: - - "" - -typedef ^ ^ R8Ki dUdy :: - - "" - -typedef ^ ^ R8Ki StateRotation :: - - "" - - -typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - -typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ IntKi Idx - 0 - "Module index in array of modules" - -typedef ^ ^ IntKi Ins - 0 - "Module instance number" - -typedef ^ ^ R8Ki DT - 0 - "Module time step" - -typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ IntKi ixg - - - "starting index for continuous state values in global arrays" - -typedef ^ ^ IntKi ixdg - - - "starting index for discrete state values in global arrays" - -typedef ^ ^ IntKi izg - - - "starting index for constraint state values in global arrays" - -typedef ^ ^ IntKi iug - - - "starting index for input values in global arrays" - -typedef ^ ^ IntKi iyg - - - "starting index for output values in global arrays" - -typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - -typedef ^ ^ ModLinType Lin - - - "Module linearization data" - -typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" -typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" - typedef ^ MeshLocType IntKi Num - 0 - "Mesh number in module" typedef ^ ^ IntKi i1 - 0 - "Mesh index 1" typedef ^ ^ IntKi i2 - 0 - "Mesh index 2" diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 1fc6d37923..41bd88a368 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -73,7 +73,7 @@ add_library(openfast_postlib STATIC # src/FAST_SS_Solver.f90 src/FAST_Funcs.f90 - src/FAST_ModLin.f90 + src/FAST_ModGlue.f90 src/FAST_Mapping.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 9b467754cc..89507f4ef6 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -196,9 +196,63 @@ typedef ^ ^ IntKi iModOpt1US : - - typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - typedef ^ ^ IntKi iModPost : - - "ModData index order for post option 1 modules" - +# Variable indexing +typedef ^ VarIdxType IntKi ModIdx - - - "" - +typedef ^ ^ IntKi iVar - - - "" - +typedef ^ ^ IntKi iLoc 2 - - "" - +typedef ^ ^ IntKi iGbl 2 - - "" - + +typedef ^ VarsIdxType IntKi FlagFilter - - - "" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nxd - - - "" - +typedef ^ ^ IntKi Nz - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ VarIdxType ix : - - "" - +typedef ^ ^ VarIdxType ixd : - - "" - +typedef ^ ^ VarIdxType iz : - - "" - +typedef ^ ^ VarIdxType iu : - - "" - +typedef ^ ^ VarIdxType iy : - - "" - + +typedef ^ ModLinTCType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki xd : - - "" - +typedef ^ ^ R8Ki z : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki x_pos : - - "" - +typedef ^ ^ R8Ki x_neg : - - "" - +typedef ^ ^ R8Ki y_pos : - - "" - +typedef ^ ^ R8Ki y_neg : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - + +typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ IntKi ixg - - - "starting index for continuous state values in global arrays" - +typedef ^ ^ IntKi ixdg - - - "starting index for discrete state values in global arrays" - +typedef ^ ^ IntKi izg - - - "starting index for constraint state values in global arrays" - +typedef ^ ^ IntKi iug - - - "starting index for input values in global arrays" - +typedef ^ ^ IntKi iyg - - - "starting index for output values in global arrays" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ ModLinTCType Lin - - - "Module linearization data" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" + typedef ^ ML_ParameterType IntKi iMod : - - "ModData index order for linearization" - typedef ^ ML_MiscVarType TC_MappingType Mappings : - - "Module mesh mapping" - -typedef ^ ML_OutputType ModLinType Lin : - - "Module linearization type" - +typedef ^ ML_OutputType ModLinTCType Lin : - - "Module linearization type" - # Misc/Optimization variables typedef ^ TC_MiscVarType R8Ki q :: - - "" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index ba215f4e26..5debb5786f 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -217,6 +217,72 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModPost !< ModData index order for post option 1 modules [-] END TYPE TC_ParameterType ! ======================= +! ========= VarIdxType ======= + TYPE, PUBLIC :: VarIdxType + INTEGER(IntKi) :: ModIdx = 0_IntKi !< [-] + INTEGER(IntKi) :: iVar = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iGbl = 0_IntKi !< [-] + END TYPE VarIdxType +! ======================= +! ========= VarsIdxType ======= + TYPE, PUBLIC :: VarsIdxType + INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nxd = 0_IntKi !< [-] + INTEGER(IntKi) :: Nz = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: ix !< [-] + TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: ixd !< [-] + TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: iz !< [-] + TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: iu !< [-] + TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: iy !< [-] + END TYPE VarsIdxType +! ======================= +! ========= ModLinTCType ======= + TYPE, PUBLIC :: ModLinTCType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] + END TYPE ModLinTCType +! ======================= +! ========= ModDataType ======= + TYPE, PUBLIC :: ModDataType + character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] + INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] + REAL(R8Ki) :: DT = 0 !< Module time step [-] + INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] + INTEGER(IntKi) :: ixg = 0_IntKi !< starting index for continuous state values in global arrays [-] + INTEGER(IntKi) :: ixdg = 0_IntKi !< starting index for discrete state values in global arrays [-] + INTEGER(IntKi) :: izg = 0_IntKi !< starting index for constraint state values in global arrays [-] + INTEGER(IntKi) :: iug = 0_IntKi !< starting index for input values in global arrays [-] + INTEGER(IntKi) :: iyg = 0_IntKi !< starting index for output values in global arrays [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] + TYPE(ModLinTCType) :: Lin !< Module linearization data [-] + TYPE(VarsIdxType) :: IdxLin !< Module linearization index [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] + END TYPE ModDataType +! ======================= ! ========= ML_ParameterType ======= TYPE, PUBLIC :: ML_ParameterType INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] @@ -229,7 +295,7 @@ MODULE FAST_Types ! ======================= ! ========= ML_OutputType ======= TYPE, PUBLIC :: ML_OutputType - TYPE(ModLinType) , DIMENSION(:), ALLOCATABLE :: Lin !< Module linearization type [-] + TYPE(ModLinTCType) , DIMENSION(:), ALLOCATABLE :: Lin !< Module linearization type [-] END TYPE ML_OutputType ! ======================= ! ========= TC_MiscVarType ======= @@ -2001,6 +2067,872 @@ subroutine FAST_UnPackTC_ParameterType(RF, OutData) call RegUnpackAlloc(RF, OutData%iModPost); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine FAST_CopyVarIdxType(SrcVarIdxTypeData, DstVarIdxTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarIdxType), intent(in) :: SrcVarIdxTypeData + type(VarIdxType), intent(inout) :: DstVarIdxTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_CopyVarIdxType' + ErrStat = ErrID_None + ErrMsg = '' + DstVarIdxTypeData%ModIdx = SrcVarIdxTypeData%ModIdx + DstVarIdxTypeData%iVar = SrcVarIdxTypeData%iVar + DstVarIdxTypeData%iLoc = SrcVarIdxTypeData%iLoc + DstVarIdxTypeData%iGbl = SrcVarIdxTypeData%iGbl +end subroutine + +subroutine FAST_DestroyVarIdxType(VarIdxTypeData, ErrStat, ErrMsg) + type(VarIdxType), intent(inout) :: VarIdxTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyVarIdxType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FAST_PackVarIdxType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarIdxType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVarIdxType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%ModIdx) + call RegPack(RF, InData%iVar) + call RegPack(RF, InData%iLoc) + call RegPack(RF, InData%iGbl) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVarIdxType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarIdxType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVarIdxType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%ModIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iGbl); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarsIdxType), intent(in) :: SrcVarsIdxTypeData + type(VarsIdxType), intent(inout) :: DstVarsIdxTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyVarsIdxType' + ErrStat = ErrID_None + ErrMsg = '' + DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter + DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx + DstVarsIdxTypeData%Nxd = SrcVarsIdxTypeData%Nxd + DstVarsIdxTypeData%Nz = SrcVarsIdxTypeData%Nz + DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu + DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny + if (allocated(SrcVarsIdxTypeData%ix)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%ix, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%ix, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%ix)) then + allocate(DstVarsIdxTypeData%ix(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%ix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%ix(i1), DstVarsIdxTypeData%ix(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcVarsIdxTypeData%ixd)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%ixd, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%ixd, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%ixd)) then + allocate(DstVarsIdxTypeData%ixd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%ixd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%ixd(i1), DstVarsIdxTypeData%ixd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcVarsIdxTypeData%iz)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%iz, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%iz, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%iz)) then + allocate(DstVarsIdxTypeData%iz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%iz(i1), DstVarsIdxTypeData%iz(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcVarsIdxTypeData%iu)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%iu, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%iu, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%iu)) then + allocate(DstVarsIdxTypeData%iu(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%iu(i1), DstVarsIdxTypeData%iu(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcVarsIdxTypeData%iy)) then + LB(1:1) = lbound(SrcVarsIdxTypeData%iy, kind=B8Ki) + UB(1:1) = ubound(SrcVarsIdxTypeData%iy, kind=B8Ki) + if (.not. allocated(DstVarsIdxTypeData%iy)) then + allocate(DstVarsIdxTypeData%iy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%iy(i1), DstVarsIdxTypeData%iy(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FAST_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) + type(VarsIdxType), intent(inout) :: VarsIdxTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyVarsIdxType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VarsIdxTypeData%ix)) then + LB(1:1) = lbound(VarsIdxTypeData%ix, kind=B8Ki) + UB(1:1) = ubound(VarsIdxTypeData%ix, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_DestroyVarIdxType(VarsIdxTypeData%ix(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VarsIdxTypeData%ix) + end if + if (allocated(VarsIdxTypeData%ixd)) then + LB(1:1) = lbound(VarsIdxTypeData%ixd, kind=B8Ki) + UB(1:1) = ubound(VarsIdxTypeData%ixd, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_DestroyVarIdxType(VarsIdxTypeData%ixd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VarsIdxTypeData%ixd) + end if + if (allocated(VarsIdxTypeData%iz)) then + LB(1:1) = lbound(VarsIdxTypeData%iz, kind=B8Ki) + UB(1:1) = ubound(VarsIdxTypeData%iz, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_DestroyVarIdxType(VarsIdxTypeData%iz(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VarsIdxTypeData%iz) + end if + if (allocated(VarsIdxTypeData%iu)) then + LB(1:1) = lbound(VarsIdxTypeData%iu, kind=B8Ki) + UB(1:1) = ubound(VarsIdxTypeData%iu, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_DestroyVarIdxType(VarsIdxTypeData%iu(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VarsIdxTypeData%iu) + end if + if (allocated(VarsIdxTypeData%iy)) then + LB(1:1) = lbound(VarsIdxTypeData%iy, kind=B8Ki) + UB(1:1) = ubound(VarsIdxTypeData%iy, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_DestroyVarIdxType(VarsIdxTypeData%iy(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VarsIdxTypeData%iy) + end if +end subroutine + +subroutine FAST_PackVarsIdxType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarsIdxType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVarsIdxType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FlagFilter) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nxd) + call RegPack(RF, InData%Nz) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) + call RegPack(RF, allocated(InData%ix)) + if (allocated(InData%ix)) then + call RegPackBounds(RF, 1, lbound(InData%ix, kind=B8Ki), ubound(InData%ix, kind=B8Ki)) + LB(1:1) = lbound(InData%ix, kind=B8Ki) + UB(1:1) = ubound(InData%ix, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_PackVarIdxType(RF, InData%ix(i1)) + end do + end if + call RegPack(RF, allocated(InData%ixd)) + if (allocated(InData%ixd)) then + call RegPackBounds(RF, 1, lbound(InData%ixd, kind=B8Ki), ubound(InData%ixd, kind=B8Ki)) + LB(1:1) = lbound(InData%ixd, kind=B8Ki) + UB(1:1) = ubound(InData%ixd, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_PackVarIdxType(RF, InData%ixd(i1)) + end do + end if + call RegPack(RF, allocated(InData%iz)) + if (allocated(InData%iz)) then + call RegPackBounds(RF, 1, lbound(InData%iz, kind=B8Ki), ubound(InData%iz, kind=B8Ki)) + LB(1:1) = lbound(InData%iz, kind=B8Ki) + UB(1:1) = ubound(InData%iz, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_PackVarIdxType(RF, InData%iz(i1)) + end do + end if + call RegPack(RF, allocated(InData%iu)) + if (allocated(InData%iu)) then + call RegPackBounds(RF, 1, lbound(InData%iu, kind=B8Ki), ubound(InData%iu, kind=B8Ki)) + LB(1:1) = lbound(InData%iu, kind=B8Ki) + UB(1:1) = ubound(InData%iu, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_PackVarIdxType(RF, InData%iu(i1)) + end do + end if + call RegPack(RF, allocated(InData%iy)) + if (allocated(InData%iy)) then + call RegPackBounds(RF, 1, lbound(InData%iy, kind=B8Ki), ubound(InData%iy, kind=B8Ki)) + LB(1:1) = lbound(InData%iy, kind=B8Ki) + UB(1:1) = ubound(InData%iy, kind=B8Ki) + do i1 = LB(1), UB(1) + call FAST_PackVarIdxType(RF, InData%iy(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVarsIdxType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarsIdxType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVarsIdxType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%ix)) deallocate(OutData%ix) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ix(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ix.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackVarIdxType(RF, OutData%ix(i1)) ! ix + end do + end if + if (allocated(OutData%ixd)) deallocate(OutData%ixd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ixd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ixd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackVarIdxType(RF, OutData%ixd(i1)) ! ixd + end do + end if + if (allocated(OutData%iz)) deallocate(OutData%iz) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%iz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iz.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackVarIdxType(RF, OutData%iz(i1)) ! iz + end do + end if + if (allocated(OutData%iu)) deallocate(OutData%iu) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%iu(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iu.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackVarIdxType(RF, OutData%iu(i1)) ! iu + end do + end if + if (allocated(OutData%iy)) deallocate(OutData%iy) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%iy(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iy.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackVarIdxType(RF, OutData%iy(i1)) ! iy + end do + end if +end subroutine + +subroutine FAST_CopyModLinTCType(SrcModLinTCTypeData, DstModLinTCTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModLinTCType), intent(in) :: SrcModLinTCTypeData + type(ModLinTCType), intent(inout) :: DstModLinTCTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyModLinTCType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModLinTCTypeData%x)) then + LB(1:1) = lbound(SrcModLinTCTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%x, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%x)) then + allocate(DstModLinTCTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%x = SrcModLinTCTypeData%x + end if + if (allocated(SrcModLinTCTypeData%dx)) then + LB(1:1) = lbound(SrcModLinTCTypeData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%dx, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%dx)) then + allocate(DstModLinTCTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%dx = SrcModLinTCTypeData%dx + end if + if (allocated(SrcModLinTCTypeData%xd)) then + LB(1:1) = lbound(SrcModLinTCTypeData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%xd, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%xd)) then + allocate(DstModLinTCTypeData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%xd = SrcModLinTCTypeData%xd + end if + if (allocated(SrcModLinTCTypeData%z)) then + LB(1:1) = lbound(SrcModLinTCTypeData%z, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%z, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%z)) then + allocate(DstModLinTCTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%z = SrcModLinTCTypeData%z + end if + if (allocated(SrcModLinTCTypeData%u)) then + LB(1:1) = lbound(SrcModLinTCTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%u, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%u)) then + allocate(DstModLinTCTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%u = SrcModLinTCTypeData%u + end if + if (allocated(SrcModLinTCTypeData%y)) then + LB(1:1) = lbound(SrcModLinTCTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%y, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%y)) then + allocate(DstModLinTCTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%y = SrcModLinTCTypeData%y + end if + if (allocated(SrcModLinTCTypeData%u_perturb)) then + LB(1:1) = lbound(SrcModLinTCTypeData%u_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%u_perturb, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%u_perturb)) then + allocate(DstModLinTCTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%u_perturb = SrcModLinTCTypeData%u_perturb + end if + if (allocated(SrcModLinTCTypeData%x_perturb)) then + LB(1:1) = lbound(SrcModLinTCTypeData%x_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%x_perturb, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%x_perturb)) then + allocate(DstModLinTCTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%x_perturb = SrcModLinTCTypeData%x_perturb + end if + if (allocated(SrcModLinTCTypeData%x_pos)) then + LB(1:1) = lbound(SrcModLinTCTypeData%x_pos, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%x_pos, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%x_pos)) then + allocate(DstModLinTCTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%x_pos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%x_pos = SrcModLinTCTypeData%x_pos + end if + if (allocated(SrcModLinTCTypeData%x_neg)) then + LB(1:1) = lbound(SrcModLinTCTypeData%x_neg, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%x_neg, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%x_neg)) then + allocate(DstModLinTCTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%x_neg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%x_neg = SrcModLinTCTypeData%x_neg + end if + if (allocated(SrcModLinTCTypeData%y_pos)) then + LB(1:1) = lbound(SrcModLinTCTypeData%y_pos, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%y_pos, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%y_pos)) then + allocate(DstModLinTCTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%y_pos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%y_pos = SrcModLinTCTypeData%y_pos + end if + if (allocated(SrcModLinTCTypeData%y_neg)) then + LB(1:1) = lbound(SrcModLinTCTypeData%y_neg, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTCTypeData%y_neg, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%y_neg)) then + allocate(DstModLinTCTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%y_neg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%y_neg = SrcModLinTCTypeData%y_neg + end if + if (allocated(SrcModLinTCTypeData%dYdx)) then + LB(1:2) = lbound(SrcModLinTCTypeData%dYdx, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTCTypeData%dYdx, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%dYdx)) then + allocate(DstModLinTCTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%dYdx = SrcModLinTCTypeData%dYdx + end if + if (allocated(SrcModLinTCTypeData%dXdx)) then + LB(1:2) = lbound(SrcModLinTCTypeData%dXdx, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTCTypeData%dXdx, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%dXdx)) then + allocate(DstModLinTCTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%dXdx = SrcModLinTCTypeData%dXdx + end if + if (allocated(SrcModLinTCTypeData%dYdu)) then + LB(1:2) = lbound(SrcModLinTCTypeData%dYdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTCTypeData%dYdu, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%dYdu)) then + allocate(DstModLinTCTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%dYdu = SrcModLinTCTypeData%dYdu + end if + if (allocated(SrcModLinTCTypeData%dXdu)) then + LB(1:2) = lbound(SrcModLinTCTypeData%dXdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTCTypeData%dXdu, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%dXdu)) then + allocate(DstModLinTCTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%dXdu = SrcModLinTCTypeData%dXdu + end if + if (allocated(SrcModLinTCTypeData%dUdu)) then + LB(1:2) = lbound(SrcModLinTCTypeData%dUdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTCTypeData%dUdu, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%dUdu)) then + allocate(DstModLinTCTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%dUdu = SrcModLinTCTypeData%dUdu + end if + if (allocated(SrcModLinTCTypeData%dUdy)) then + LB(1:2) = lbound(SrcModLinTCTypeData%dUdy, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTCTypeData%dUdy, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%dUdy)) then + allocate(DstModLinTCTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%dUdy = SrcModLinTCTypeData%dUdy + end if + if (allocated(SrcModLinTCTypeData%StateRotation)) then + LB(1:2) = lbound(SrcModLinTCTypeData%StateRotation, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTCTypeData%StateRotation, kind=B8Ki) + if (.not. allocated(DstModLinTCTypeData%StateRotation)) then + allocate(DstModLinTCTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTCTypeData%StateRotation = SrcModLinTCTypeData%StateRotation + end if +end subroutine + +subroutine FAST_DestroyModLinTCType(ModLinTCTypeData, ErrStat, ErrMsg) + type(ModLinTCType), intent(inout) :: ModLinTCTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyModLinTCType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModLinTCTypeData%x)) then + deallocate(ModLinTCTypeData%x) + end if + if (allocated(ModLinTCTypeData%dx)) then + deallocate(ModLinTCTypeData%dx) + end if + if (allocated(ModLinTCTypeData%xd)) then + deallocate(ModLinTCTypeData%xd) + end if + if (allocated(ModLinTCTypeData%z)) then + deallocate(ModLinTCTypeData%z) + end if + if (allocated(ModLinTCTypeData%u)) then + deallocate(ModLinTCTypeData%u) + end if + if (allocated(ModLinTCTypeData%y)) then + deallocate(ModLinTCTypeData%y) + end if + if (allocated(ModLinTCTypeData%u_perturb)) then + deallocate(ModLinTCTypeData%u_perturb) + end if + if (allocated(ModLinTCTypeData%x_perturb)) then + deallocate(ModLinTCTypeData%x_perturb) + end if + if (allocated(ModLinTCTypeData%x_pos)) then + deallocate(ModLinTCTypeData%x_pos) + end if + if (allocated(ModLinTCTypeData%x_neg)) then + deallocate(ModLinTCTypeData%x_neg) + end if + if (allocated(ModLinTCTypeData%y_pos)) then + deallocate(ModLinTCTypeData%y_pos) + end if + if (allocated(ModLinTCTypeData%y_neg)) then + deallocate(ModLinTCTypeData%y_neg) + end if + if (allocated(ModLinTCTypeData%dYdx)) then + deallocate(ModLinTCTypeData%dYdx) + end if + if (allocated(ModLinTCTypeData%dXdx)) then + deallocate(ModLinTCTypeData%dXdx) + end if + if (allocated(ModLinTCTypeData%dYdu)) then + deallocate(ModLinTCTypeData%dYdu) + end if + if (allocated(ModLinTCTypeData%dXdu)) then + deallocate(ModLinTCTypeData%dXdu) + end if + if (allocated(ModLinTCTypeData%dUdu)) then + deallocate(ModLinTCTypeData%dUdu) + end if + if (allocated(ModLinTCTypeData%dUdy)) then + deallocate(ModLinTCTypeData%dUdy) + end if + if (allocated(ModLinTCTypeData%StateRotation)) then + deallocate(ModLinTCTypeData%StateRotation) + end if +end subroutine + +subroutine FAST_PackModLinTCType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModLinTCType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModLinTCType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%dx) + call RegPackAlloc(RF, InData%xd) + call RegPackAlloc(RF, InData%z) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%u_perturb) + call RegPackAlloc(RF, InData%x_perturb) + call RegPackAlloc(RF, InData%x_pos) + call RegPackAlloc(RF, InData%x_neg) + call RegPackAlloc(RF, InData%y_pos) + call RegPackAlloc(RF, InData%y_neg) + call RegPackAlloc(RF, InData%dYdx) + call RegPackAlloc(RF, InData%dXdx) + call RegPackAlloc(RF, InData%dYdu) + call RegPackAlloc(RF, InData%dXdu) + call RegPackAlloc(RF, InData%dUdu) + call RegPackAlloc(RF, InData%dUdy) + call RegPackAlloc(RF, InData%StateRotation) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModLinTCType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModLinTCType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModLinTCType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: SrcModDataTypeData + type(ModDataType), intent(inout) :: DstModDataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%ID = SrcModDataTypeData%ID + DstModDataTypeData%Idx = SrcModDataTypeData%Idx + DstModDataTypeData%Ins = SrcModDataTypeData%Ins + DstModDataTypeData%DT = SrcModDataTypeData%DT + DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps + DstModDataTypeData%ixg = SrcModDataTypeData%ixg + DstModDataTypeData%ixdg = SrcModDataTypeData%ixdg + DstModDataTypeData%izg = SrcModDataTypeData%izg + DstModDataTypeData%iug = SrcModDataTypeData%iug + DstModDataTypeData%iyg = SrcModDataTypeData%iyg + DstModDataTypeData%Vars => SrcModDataTypeData%Vars + call FAST_CopyModLinTCType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyVarsIdxType(SrcModDataTypeData%IdxLin, DstModDataTypeData%IdxLin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModDataTypeData%SrcMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%SrcMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%SrcMaps)) then + allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps + end if + if (allocated(SrcModDataTypeData%DstMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%DstMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%DstMaps, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%DstMaps)) then + allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps + end if +end subroutine + +subroutine FAST_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(ModDataTypeData%Vars) + call FAST_DestroyModLinTCType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyVarsIdxType(ModDataTypeData%IdxLin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModDataTypeData%SrcMaps)) then + deallocate(ModDataTypeData%SrcMaps) + end if + if (allocated(ModDataTypeData%DstMaps)) then + deallocate(ModDataTypeData%DstMaps) + end if +end subroutine + +subroutine FAST_PackModDataType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModDataType' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Abbr) + call RegPack(RF, InData%ID) + call RegPack(RF, InData%Idx) + call RegPack(RF, InData%Ins) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%SubSteps) + call RegPack(RF, InData%ixg) + call RegPack(RF, InData%ixdg) + call RegPack(RF, InData%izg) + call RegPack(RF, InData%iug) + call RegPack(RF, InData%iyg) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call FAST_PackModLinTCType(RF, InData%Lin) + call FAST_PackVarsIdxType(RF, InData%IdxLin) + call RegPackAlloc(RF, InData%SrcMaps) + call RegPackAlloc(RF, InData%DstMaps) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModDataType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModDataType' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ixg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ixdg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%izg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iug); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iyg); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call FAST_UnpackModLinTCType(RF, OutData%Lin) ! Lin + call FAST_UnpackVarsIdxType(RF, OutData%IdxLin) ! IdxLin + call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine FAST_CopyML_ParameterType(SrcML_ParameterTypeData, DstML_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) type(ML_ParameterType), intent(in) :: SrcML_ParameterTypeData type(ML_ParameterType), intent(inout) :: DstML_ParameterTypeData @@ -2178,7 +3110,7 @@ subroutine FAST_CopyML_OutputType(SrcML_OutputTypeData, DstML_OutputTypeData, Ct end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyModLinType(SrcML_OutputTypeData%Lin(i1), DstML_OutputTypeData%Lin(i1), CtrlCode, ErrStat2, ErrMsg2) + call FAST_CopyModLinTCType(SrcML_OutputTypeData%Lin(i1), DstML_OutputTypeData%Lin(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -2200,7 +3132,7 @@ subroutine FAST_DestroyML_OutputType(ML_OutputTypeData, ErrStat, ErrMsg) LB(1:1) = lbound(ML_OutputTypeData%Lin, kind=B8Ki) UB(1:1) = ubound(ML_OutputTypeData%Lin, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_DestroyModLinType(ML_OutputTypeData%Lin(i1), ErrStat2, ErrMsg2) + call FAST_DestroyModLinTCType(ML_OutputTypeData%Lin(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ML_OutputTypeData%Lin) @@ -2220,7 +3152,7 @@ subroutine FAST_PackML_OutputType(RF, Indata) LB(1:1) = lbound(InData%Lin, kind=B8Ki) UB(1:1) = ubound(InData%Lin, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackModLinType(RF, InData%Lin(i1)) + call FAST_PackModLinTCType(RF, InData%Lin(i1)) end do end if if (RegCheckErr(RF, RoutineName)) return @@ -2245,7 +3177,7 @@ subroutine FAST_UnPackML_OutputType(RF, OutData) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackModLinType(RF, OutData%Lin(i1)) ! Lin + call FAST_UnpackModLinTCType(RF, OutData%Lin(i1)) ! Lin end do end if end subroutine @@ -7266,12 +8198,12 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyModDataType(SrcOutputFileTypeData%Modules(i1), DstOutputFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) + call FAST_CopyModDataType(SrcOutputFileTypeData%Modules(i1), DstOutputFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call NWTC_Library_CopyModDataType(SrcOutputFileTypeData%ModGlue, DstOutputFileTypeData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) + call FAST_CopyModDataType(SrcOutputFileTypeData%ModGlue, DstOutputFileTypeData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -7313,12 +8245,12 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) LB(1:1) = lbound(OutputFileTypeData%Modules, kind=B8Ki) UB(1:1) = ubound(OutputFileTypeData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_DestroyModDataType(OutputFileTypeData%Modules(i1), ErrStat2, ErrMsg2) + call FAST_DestroyModDataType(OutputFileTypeData%Modules(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(OutputFileTypeData%Modules) end if - call NWTC_Library_DestroyModDataType(OutputFileTypeData%ModGlue, ErrStat2, ErrMsg2) + call FAST_DestroyModDataType(OutputFileTypeData%ModGlue, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -7359,10 +8291,10 @@ subroutine FAST_PackOutputFileType(RF, Indata) LB(1:1) = lbound(InData%Modules, kind=B8Ki) UB(1:1) = ubound(InData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackModDataType(RF, InData%Modules(i1)) + call FAST_PackModDataType(RF, InData%Modules(i1)) end do end if - call NWTC_Library_PackModDataType(RF, InData%ModGlue) + call FAST_PackModDataType(RF, InData%ModGlue) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7409,10 +8341,10 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackModDataType(RF, OutData%Modules(i1)) ! Modules + call FAST_UnpackModDataType(RF, OutData%Modules(i1)) ! Modules end do end if - call NWTC_Library_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue + call FAST_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue end subroutine subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) From 0cd04a2de0944901fbf790899a25636537d7cd1d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:03:16 +0000 Subject: [PATCH 115/319] FAST_Funcs add subroutine for copying inputs --- modules/openfast-library/src/FAST_Funcs.f90 | 120 +++++++++++++++++++- 1 file changed, 118 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 93131b7ca0..db5eb9dd27 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -52,7 +52,6 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j - type(VarsIdxType), pointer :: VarIdx ErrStat = ErrID_None ErrMsg = '' @@ -833,7 +832,6 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) ! case (Module_FEAM) case (Module_HD) - ! TODO: Fix inconsistent function name call HydroDyn_CopyContState(T%HD%x(Src), T%HD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return ! call HydroDyn_CopyDiscState(T%HD%xd(Src), T%HD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return ! call HydroDyn_CopyConstrState(T%HD%z(Src), T%HD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return @@ -879,4 +877,122 @@ logical function Failed() end function end subroutine +subroutine FAST_CopyInputs(ModData, T, DstInputTime, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(DbKi), intent(in) :: DstInputTime !< Destination input time + integer(IntKi), intent(in) :: iSrc, iDst !< Input indices + integer(IntKi), intent(in) :: CtrlCode !< Mesh copy code + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CopyInputs' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + + if (iDst > 0) T%AD%InputTimes(iDst) = DstInputTime + if (iSrc > 0 .and. iDst > 0) then + call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + else if (iSrc > 0) then + call AD_CopyInput(T%AD%Input(iSrc), T%AD%u, CtrlCode, Errstat2, ErrMsg2) + else + call AD_CopyInput(T%AD%u, T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end if + + case (Module_BD) + + if (iDst > 0) T%BD%InputTimes(iDst, ModData%Ins) = DstInputTime + if (iSrc > 0 .and. iDst > 0) then + call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + else if (iSrc > 0) then + call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + else + call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + end if + + case (Module_ED) + + if (iDst > 0) T%ED%InputTimes(iDst) = DstInputTime + if (iSrc > 0 .and. iDst > 0) then + call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + else if (iSrc > 0) then + call ED_CopyInput(T%ED%Input(iSrc), T%ED%u, CtrlCode, Errstat2, ErrMsg2) + else + call ED_CopyInput(T%ED%u, T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end if + +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + + if (iDst > 0) T%HD%InputTimes(iDst) = DstInputTime + if (iSrc > 0 .and. iDst > 0) then + call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + else if (iSrc > 0) then + call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%u, CtrlCode, Errstat2, ErrMsg2) + else + call HydroDyn_CopyInput(T%HD%u, T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end if + +! case (Module_IceD) +! case (Module_IceF) + + case (Module_IfW) + + if (iDst > 0) T%IfW%InputTimes(iDst) = DstInputTime + if (iSrc > 0 .and. iDst > 0) then + call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + else if (iSrc > 0) then + call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%u, CtrlCode, Errstat2, ErrMsg2) + else + call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end if + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + + if (iDst > 0) T%SD%InputTimes(iDst) = DstInputTime + if (iSrc > 0 .and. iDst > 0) then + call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + else if (iSrc > 0) then + call SD_CopyInput(T%SD%Input(iSrc), T%SD%u, CtrlCode, Errstat2, ErrMsg2) + else + call SD_CopyInput(T%SD%u, T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end if + +! case (Module_SeaSt) + case (Module_SrvD) + + if (iDst > 0) T%SrvD%InputTimes(iDst) = DstInputTime + if (iSrc > 0 .and. iDst > 0) then + call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + else if (iSrc > 0) then + call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%u, CtrlCode, Errstat2, ErrMsg2) + else + call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end if + + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Unknown module ID "//trim(Num2LStr(ModData%ID)) + end select + + ! Set error + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +end subroutine + end module From 446b0c1b0db3a7868fa36c9afcce3a9579c2b63e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:03:28 +0000 Subject: [PATCH 116/319] Add header to FAST_Mapping --- modules/openfast-library/src/FAST_Mapping.f90 | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 3c0bb06311..ba038f5b33 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1,3 +1,23 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +!> This module contains routines used by FAST to map meshes and values between modules for transfering data and doing linearization. + module FAST_Mapping use FAST_Types From 933ff11962074eb2bb392e66f14dfbaa2c538f4c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:03:51 +0000 Subject: [PATCH 117/319] Change FAST_ModLin to FAST_ModGlue in FAST_Subs --- modules/openfast-library/src/FAST_Subs.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 9e46a25978..64eeffc8e6 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -21,7 +21,7 @@ !********************************************************************************************************************************** MODULE FAST_Subs - USE FAST_ModLin + USE FAST_ModGlue USE FAST_Solver ! USE FAST_Linear USE SC_DataEx @@ -69,7 +69,7 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In if(ErrStat >= AbortErrLev) return - call ModLin_Init(Turbine%y_FAST%ModGlue, Turbine%y_FAST%Modules, & + call ModGlue_Init(Turbine%y_FAST%ModGlue, Turbine%y_FAST%Modules, & Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, & Turbine%p_FAST, Turbine%m_FAST, Turbine, ErrStat, ErrMsg) From 0a5433d2899a263ff0591ec14f131fdaf3cac008 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:04:13 +0000 Subject: [PATCH 118/319] Add guard around WriteOutput in Servodyn in GetOP function --- modules/servodyn/src/ServoDyn.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index adb8c8d105..7288b28d77 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -4617,9 +4617,11 @@ subroutine Get_y_op() enddo ! y%outputs - do i = p%iVarWriteOutput, size(p%Vars%y) - call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1)), y_op) - end do + if (p%iVarWriteOutput > 0) then + do i = p%iVarWriteOutput, size(p%Vars%y) + call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1)), y_op) + end do + end if end subroutine Get_y_op !> Get the operating point continuous states and pack From 3d477df99f2a5b6e4503993587089fa56b065296 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 19:05:19 +0000 Subject: [PATCH 119/319] Remove indexing for linearization, handle it inline --- modules/openfast-library/src/FAST_ModGlue.f90 | 10 ---------- modules/openfast-library/src/FAST_Types.f90 | 8 -------- 2 files changed, 18 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 8b476dea00..79f6f99aae 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -246,13 +246,6 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E ! Loop through added variables and add name prefix to linearization names call AddLinNamePrefix(ModGlue%Vars%y(k:), NamePrefix) - !---------------------------------------------------------------------- - ! Linearization index - !---------------------------------------------------------------------- - - ! Initialize module linearization variable indexing - call MV_InitModuleVarIdx(ModData, ModData%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return - end associate end do @@ -263,9 +256,6 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E call CalcVarDataLoc(ModGlue%Vars%u, ModGlue%Vars%Nu) call CalcVarDataLoc(ModGlue%Vars%y, ModGlue%Vars%Ny) - ! Initialize linearization index filtering - call MV_InitModuleVarIdx(ModGlue, ModGlue%IdxLin, VF_Linearize, ErrStat2, ErrMsg2); if (Failed()) return - !---------------------------------------------------------------------------- ! Mesh Mapping !---------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 5debb5786f..1bd432403c 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -278,7 +278,6 @@ MODULE FAST_Types INTEGER(IntKi) :: iyg = 0_IntKi !< starting index for output values in global arrays [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] TYPE(ModLinTCType) :: Lin !< Module linearization data [-] - TYPE(VarsIdxType) :: IdxLin !< Module linearization index [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] END TYPE ModDataType @@ -2806,9 +2805,6 @@ subroutine FAST_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode call FAST_CopyModLinTCType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call FAST_CopyVarsIdxType(SrcModDataTypeData%IdxLin, DstModDataTypeData%IdxLin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcModDataTypeData%SrcMaps)) then LB(1:1) = lbound(SrcModDataTypeData%SrcMaps, kind=B8Ki) UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) @@ -2847,8 +2843,6 @@ subroutine FAST_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) nullify(ModDataTypeData%Vars) call FAST_DestroyModLinTCType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyVarsIdxType(ModDataTypeData%IdxLin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModDataTypeData%SrcMaps)) then deallocate(ModDataTypeData%SrcMaps) end if @@ -2882,7 +2876,6 @@ subroutine FAST_PackModDataType(RF, Indata) end if end if call FAST_PackModLinTCType(RF, InData%Lin) - call FAST_PackVarsIdxType(RF, InData%IdxLin) call RegPackAlloc(RF, InData%SrcMaps) call RegPackAlloc(RF, InData%DstMaps) if (RegCheckErr(RF, RoutineName)) return @@ -2928,7 +2921,6 @@ subroutine FAST_UnPackModDataType(RF, OutData) OutData%Vars => null() end if call FAST_UnpackModLinTCType(RF, OutData%Lin) ! Lin - call FAST_UnpackVarsIdxType(RF, OutData%IdxLin) ! IdxLin call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine From df1bc2aead02e5ce3d7c71ae07f1b19f526c9e97 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 23:15:02 +0000 Subject: [PATCH 120/319] Change FAST_ModLin to FAST_ModGlue in Simulink CMakeLists.txt --- glue-codes/simulink/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index 737a995450..7a195869b2 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -58,7 +58,7 @@ matlab_add_mex( ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Solver.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Library.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Funcs.f90 - ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModLin.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModGlue.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mapping.f90 LINK_TO ${MEX_LIBS} From 878ee64aeee1bfe87b1fadabf4639d14ffb98c34 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Mar 2024 23:58:05 +0000 Subject: [PATCH 121/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index a75fa937f2..8a12a2f833 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit a75fa937f213c667c8670881294533f9ab436a50 +Subproject commit 8a12a2f833bdeb80c804ef33d816816a2966b420 From 98801a49202f857433a9f2e34e816ce597e2987b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 6 Mar 2024 01:16:55 +0000 Subject: [PATCH 122/319] Update r-test pointer for reg_test changes --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 8a12a2f833..e9752a3d4b 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 8a12a2f833bdeb80c804ef33d816816a2966b420 +Subproject commit e9752a3d4b43cdf7b7dea7929702490947baed35 From e7dc2a7a21cc967d21680dd37c3d02a94692286e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 17 May 2024 17:36:50 +0000 Subject: [PATCH 123/319] Started re-adding AeroMap --- glue-codes/openfast/src/FAST_Prog.f90 | 5 +- modules/openfast-library/CMakeLists.txt | 2 + modules/openfast-library/src/FAST_AeroMap.f90 | 624 +++++++++++++++ modules/openfast-library/src/FAST_Idx.f90 | 385 +++++++++ modules/openfast-library/src/FAST_Mapping.f90 | 393 +++++---- modules/openfast-library/src/FAST_ModGlue.f90 | 410 ++++++---- .../openfast-library/src/FAST_Registry.txt | 78 +- modules/openfast-library/src/FAST_Subs.f90 | 4 +- modules/openfast-library/src/FAST_Types.f90 | 750 +++++++----------- 9 files changed, 1774 insertions(+), 877 deletions(-) create mode 100644 modules/openfast-library/src/FAST_AeroMap.f90 create mode 100644 modules/openfast-library/src/FAST_Idx.f90 diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index 0c7f86d04e..4c9e6b2cb0 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -32,7 +32,7 @@ PROGRAM FAST USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs -! USE FAST_SS_Subs, ONLY : FAST_RunSteadyStateDriver +! USE FAST_AeroMap, ONLY : FAST_RunSteadyStateDriver IMPLICIT NONE @@ -79,11 +79,8 @@ PROGRAM FAST ELSE IF ( TRIM(FlagArg) == 'STEADYSTATE' ) THEN ! Do steady-state analysis, not time-marching -- this works for only 1 turbine (i.e., NumTurbines==1)! - ! TODO: migrate to ModLin ! this runs the steady-state solver driver and ENDS the program: ! CALL FAST_RunSteadyStateDriver( Turbine(1) ) - - CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true. ) ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 41bd88a368..0c0592df40 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -75,6 +75,8 @@ add_library(openfast_postlib STATIC src/FAST_Funcs.f90 src/FAST_ModGlue.f90 src/FAST_Mapping.f90 + src/FAST_Idx.f90 + # src/FAST_AeroMap.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 new file mode 100644 index 0000000000..101e4a6b25 --- /dev/null +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -0,0 +1,624 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 Envision Energy USA, National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +!> This module contains the routines used by FAST to solve input-output equations and to advance states. + +module FAST_AeroMap + +use FAST_Types +use FAST_ModTypes +use FAST_Funcs +use FAST_Idx + +use FAST_Subs + +implicit none + +! Define array of module IDs used in AeroMap +integer(IntKi), parameter :: AeroMapModIDs(*) = [Module_ED, Module_BD, Module_AD] + +real(DbKi), parameter :: SS_t_global = 0.0_DbKi +real(DbKi), parameter :: UJacSclFact_x = 1.0d3 + +logical, parameter :: output_debugging = .false. + +contains + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! DRIVER ROUTINE (runs + ends simulation) +! Put here so that we can call from either stand-alone code or from the ENFAST executable. +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +subroutine FAST_RunSteadyStateDriver(Turbine) + type(FAST_TurbineType), intent(inout) :: Turbine !< all data for one instance of a turbine + + integer(IntKi) :: ErrStat !< Error status of the operation + character(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ProgName = TRIM(FAST_Ver%Name)//' Aero Map' + FAST_Ver%Name = ProgName + + call FAST_AeroMapDriver(Turbine, ErrStat, ErrMsg) + call CheckError(ErrStat, ErrMsg, 'FAST_AeroMapDriver') + + call ExitThisProgram_T(Turbine, ErrID_None, .true.) + +contains + subroutine CheckError(ErrID, Msg, SimMsg) + integer(IntKi), intent(in) :: ErrID ! The error identifier (ErrStat) + character(*), intent(in) :: Msg ! The error message (ErrMsg) + character(*), intent(in) :: SimMsg ! a message describing the location of the error + if (ErrID /= ErrID_None) then + call WrScr(NewLine//TRIM(Msg)//NewLine) + if (ErrID >= AbortErrLev) then + call ExitThisProgram_T(Turbine, ErrID, .true., SimMsg) + end if + end if + end subroutine CheckError +end subroutine + +subroutine FAST_AeroMapDriver(Turbine, ErrStat, ErrMsg) + use InflowWind_IO, only: IfW_SteadyFlowField_Init + type(FAST_TurbineType), intent(inout) :: Turbine !< all data for one instance of a turbine + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + + character(*), parameter :: RoutineName = 'FAST_AeroMapDriver' + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: ErrStat2 + logical, parameter :: CompAeroMaps = .true. + real(DbKi), parameter :: t_initial = 0.0_DbKi + integer(IntKi), allocatable :: modIDs(:), modIdx(:), iModOrder(:) + integer(IntKi) :: i + integer(IntKi) :: JacSize + real(R8Ki), allocatable :: Jmat(:, :) + integer(IntKi), allocatable :: JacPivot(:) + type(VarsIdxType) :: AeroMapIdx + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Initialization + !---------------------------------------------------------------------------- + + Turbine%TurbID = 1 + + ! Standard Turbine initialization + call FAST_InitializeAll(t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, & + Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, & + Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, & + Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg) + + ! Initialize steady flow field in AeroDyn + call IfW_SteadyFlowField_Init(Turbine%AD%p%FlowField, & + RefHt=100.0_ReKi, HWindSpeed=8.0_ReKi, PLExp=0.0_ReKi, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + ! Get indices of Mods that are used by Aero Mapping + call GetModuleOrder(Turbine%y_FAST%Modules, AeroMapModIDs, iModOrder) + + ! Loop through module data indices + do i = 1, size(iModOrder) + + ! Copy current state to predicted state + call FAST_CopyStates(Turbine%y_FAST%Modules(iModOrder(i)), Turbine, STATE_CURR, STATE_PRED, MESH_NEWCOPY, & + ErrStat2, ErrMsg2); if (Failed()) return + + ! Copy inputs to second index + call FAST_CopyInputs(Turbine%y_FAST%Modules(iModOrder(i)), Turbine, 0.0_DbKi, iSrc=1, iDst=2, CtrlCode=MESH_NEWCOPY, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + end do + + ! Generate index for variables with AeroMap flag + call Idx_Init(Turbine%y_FAST%Modules, iModOrder, AeroMapIdx, VF_AeroMap, ErrStat2, ErrMsg2); if (Failed()) return + + ! Jacobian size is number of states plus number of inputs + JacSize = AeroMapIdx%Nx + AeroMapIdx%Nu + + ! Allocate Jacobian matrix + call AllocAry(Jmat, JacSize, JacSize, 'Jmat', ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate Jacobian pivot vector + call AllocAry(JacPivot, JacSize, 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Calculate steady-state solutions: + !---------------------------------------------------------------------------- + + call FAST_SteadyState(Turbine%y_FAST%Modules, iModOrder, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +subroutine FAST_SteadyState(Mods, ModOrder, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: Mods(:) + integer(IntKi), intent(in) :: ModOrder(:) + type(FAST_ParameterType), intent(IN) :: p_FAST !< Parameters for the glue code + type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Output variables for the glue code + type(FAST_MiscVarType), intent(INOUT) :: m_FAST + type(FAST_TurbineType), intent(inout) :: T !< all data for one instance of a turbine + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + integer(IntKi) :: n_case !< loop counter + real(DbKi) :: n_global + real(ReKi), allocatable :: UnusedAry(:) + real(R8Ki), allocatable :: Jmat(:, :) + type(FAST_SS_CaseType) :: CaseData ! tsr, windSpeed, pitch, and rotor speed for this case + type(FAST_SS_CaseType) :: caseData_try2 ! tsr, windSpeed, pitch, and rotor speed for this case (to try a different operating point first) + + character(*), parameter :: RoutineName = 'FAST_SteadyState' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMSg2 + integer(IntKi) :: NStatus + character(MaxWrScrLen), parameter :: BlankLine = " " + + ErrStat = ErrID_None + ErrMsg = "" + + ! how often do we inform the user which case we are on? + NStatus = min(100, p_FAST%NumSSCases/100 + 1) ! at least 100 every 100 cases or 100 times per simulation + call WrScr(NewLine) + + ! Loop through Aero Map cases + do n_case = 1, p_FAST%NumSSCases + + ! If status should be written to screen + if (n_case == 1 .or. n_case == p_FAST%NumSSCases .or. mod(n_case, NStatus) == 0) then + call WrOver(' Case '//trim(Num2LStr(n_case))//' of '//trim(Num2LStr(p_FAST%NumSSCases))) + end if + + ! Populate case data + if (p_FAST%WindSpeedOrTSR == 1) then + CaseData%WindSpeed = p_FAST%WS_TSR(n_case) + CaseData%TSR = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/CaseData%WindSpeed + else + CaseData%TSR = p_FAST%WS_TSR(n_case) + CaseData%WindSpeed = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/CaseData%TSR + end if + CaseData%Pitch = p_FAST%Pitch(n_case) + CaseData%RotSpeed = p_FAST%RotSpeed(n_case) + + ! Call steady-state solve for this pitch and rotor speed + call SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + + ! we didn't converge; let's try a different operating point and see if that helps: + if (ErrStat2 >= ErrID_Severe) then + + ! Create copy of case data for second attempt + caseData_try2 = CaseData + + ! Modify pitch, TSR, and WindSpeed + caseData_try2%Pitch = caseData_try2%Pitch*0.5_ReKi + caseData_try2%TSR = caseData_try2%TSR*0.5_ReKi + caseData_try2%WindSpeed = caseData_try2%WindSpeed*0.5_ReKi + + ! Write message about retrying case + call WrScr('Retrying case '//trim(Num2LStr(n_case))//', first trying to get a better initial guess. Average error is '// & + trim(Num2LStr(y_FAST%DriverWriteOutput(SS_Indx_Err)))//'.') + + call SolveSteadyState(Mods, ModOrder, caseData_try2, Jmat, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + + ! if that worked, try the real case again: + if (ErrStat2 < AbortErrLev) then + call SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + call WrOver(BlankLine) + end if + + end if + + if (ErrStat2 > ErrID_None) then + ErrMsg2 = trim(ErrMsg2)//" case "//trim(Num2LStr(n_case))// & + ' (tsr='//trim(Num2LStr(CaseData%tsr))// & + ', wind speed='//trim(Num2LStr(CaseData%windSpeed))//' m/s'// & + ', pitch='//trim(num2lstr(CaseData%pitch*R2D))//' deg'// & + ', rotor speed='//trim(num2lstr(CaseData%RotSpeed*RPS2RPM))//' rpm)' + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + !------------------------------------------------------------------------- + ! Write results to file + !------------------------------------------------------------------------- + + n_global = real(n_case, DbKi) ! n_global is double-precision so that we can reuse existing code. + + call WrOutputLine(n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, T%ED%y%WriteOutput, & + T%AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & + UnusedAry, UnusedAry, UnusedAry, UnusedAry, T%IceD%y, T%BD%y, ErrStat2, ErrMsg2) + if (Failed()) return + + !------------------------------------------------------------------------- + ! Write errors to screen + !------------------------------------------------------------------------- + + if (ErrStat > ErrID_None) then + call WrScr(trim(ErrMsg)) + call WrScr("") + ErrStat = ErrID_None + ErrMsg = "" + end if + + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine FAST_SteadyState + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine performs the Input-Output solve for the steady-state solver. +!! Note that this has been customized for the physics in the problems and is not a general solution. +subroutine SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, Turbine, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: Mods(:) + integer(IntKi), intent(in) :: ModOrder(:) + type(FAST_SS_CaseType), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + real(R8Ki), intent(INOUT) :: Jmat(:, :) !< temporary storage space for jacobian matrix + type(FAST_ParameterType), intent(IN) :: p_FAST !< Glue-code simulation parameters + type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Glue-code output file values + type(FAST_MiscVarType), intent(INOUT) :: m_FAST !< Miscellaneous variables + type(ElastoDyn_Data), intent(INOUT) :: ED !< ElastoDyn data + type(BeamDyn_Data), intent(INOUT) :: BD !< BeamDyn data + type(AeroDyn_Data), intent(INOUT) :: AD !< AeroDyn data + type(FAST_TurbineType), intent(inout) :: Turbine + type(FAST_ModuleMapType), intent(INOUT) :: MeshMapData !< data for mapping meshes between modules + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SolveSteadyState' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + !bjj: store these so that we don't reallocate every time? + real(R8Ki) :: u(p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules + real(R8Ki) :: u_delta(p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules + real(R8Ki) :: Fn_U_Resid(p_FAST%SizeJac_Opt1(1)) ! Residual of U + real(R8Ki) :: err + real(R8Ki) :: err_prev + real(R8Ki), parameter :: reduction_factor = 0.1_R8Ki + + integer(IntKi) :: nb ! loop counter (blade number) + integer(IntKi) :: MaxIter ! maximum number of iterations + integer(IntKi) :: K ! Input-output-solve iteration counter + integer(IntKi) :: i, j + + logical :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput + + ! Note: p_FAST%UJacSclFact is a scaling factor that gets us similar magnitudes between loads and accelerations... + + !bjj: note, that this routine may have a problem if there is remapping done + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Some record keeping stuff: + !---------------------------------------------------------------------------- + + ! Set the rotor speed in ElastoDyn + ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed + + call SteadyStatePrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) + call CopyStatesInputs(p_FAST, ED, BD, AD, ErrStat2, ErrMsg2, MESH_UPDATECOPY) ! COPY the inputs to the temp copy (so we get updated input values) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + K = 0 + err = 1.0E3 + err_prev = err + + y_FAST%DriverWriteOutput(SS_Indx_Err) = -1 + y_FAST%DriverWriteOutput(SS_Indx_Iter) = 0 + y_FAST%DriverWriteOutput(SS_Indx_TSR) = caseData%tsr + y_FAST%DriverWriteOutput(SS_Indx_WS) = caseData%windSpeed + y_FAST%DriverWriteOutput(SS_Indx_Pitch) = caseData%Pitch*R2D + y_FAST%DriverWriteOutput(SS_Indx_RotSpeed) = caseData%RotSpeed*RPS2RPM + + MaxIter = p_FAST%KMax + 1 ! adding 1 here so that we get the error calculated correctly when we hit the max iteration + do + + !------------------------------------------------------------------------- + ! Calculate outputs, based on inputs at this time + !------------------------------------------------------------------------- + + ! Set GetWriteOutput flag true if not the first iteration + GetWriteOutput = K > 0 + + ! Loop through modules in order + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + + !------------------------------------------------------------------- + ! ElastoDyn / BeamDyn CalcOutput + !------------------------------------------------------------------- + + ! If ElastoDyn blades and module is ED or BeamDyn Blades and module is BD and 1st blade, calculate output + if (((p_FAST%CompElast == Module_ED) .and. (ModData%ID == Module_ED)) .or. & + ((p_FAST%CompElast == Module_BD) .and. (ModData%ID == Module_BD) .and. (ModData%Ins == 1))) then + + call FAST_CalcOutput(ModData, m_FAST%ModLin%Mappings, SS_t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + !------------------------------------------------------------------- + ! AeroDyn InputSolve + !------------------------------------------------------------------- + + ! If module is AD (assumes AD comes after ED/BD in ModOrder) + if (ModData%ID == Module_AD) then + + ! If first iteration + if (K == 0) then + + ! Perform AeroDyn input solve to get initial guess from structural module + ! (this ensures that the pitch is accounted for in the fixed aero-map solve:): + call FAST_InputSolve(ModData, Mods, m_FAST%ModLin%Mappings, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Prescribe AeroDyn blade motion inputs on first blade: + Turbine%AD%u%rotors(1)%BladeMotion(1)%RotationVel = 0.0_ReKi + Turbine%AD%u%rotors(1)%BladeMotion(1)%TranslationAcc = 0.0_ReKi + + ! Initialize AeroDyn blade motion from blade 1 to remaining blades + ! adjusting for hub orientation + do k = 2, size(Turbine%AD%u%rotors(1)%BladeMotion) + do j = 1, Turbine%AD%u%rotors(1)%BladeMotion(k)%NNodes + Turbine%AD%u%rotors(1)%BladeMotion(k)%TranslationDisp(:, j) = matmul(Turbine%AD%u%rotors(1)%BladeMotion(1)%TranslationDisp(:, j), MeshMapData%HubOrient(:, :, k)) + Turbine%AD%u%rotors(1)%BladeMotion(k)%Orientation(:, :, j) = matmul(Turbine%AD%u%rotors(1)%BladeMotion(1)%Orientation(:, :, j), MeshMapData%HubOrient(:, :, k)) + Turbine%AD%u%rotors(1)%BladeMotion(k)%TranslationVel(:, j) = matmul(Turbine%AD%u%rotors(1)%BladeMotion(1)%TranslationVel(:, j), MeshMapData%HubOrient(:, :, k)) + end do + end do + + !---------------------------------------------------------------------------------------------------- + ! set up x-u vector, using local initial guesses: + !---------------------------------------------------------------------------------------------------- + call Create_SS_Vector(p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR) + + end if ! K == 0 + + ! Calculate AeroDyn Output + call FAST_CalcOutput(ModData, m_FAST%ModLin%Mappings, SS_t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call ResetInputsAndStates() + return + end if + + end if ! ModData%ID == Module_AD + + end associate + end do + + ! If iteration is at or above maximum iteration, exit loop + if (K >= MaxIter) exit + + !------------------------------------------------------------------------------------------------- + ! Calculate residual and the Jacobian: + ! (note that we don't want to change module%Input(1), here) + ! Also, the residual uses values from y_FAST, so do this before calculating the jacobian + !------------------------------------------------------------------------------------------------- + + call SteadyStateSolve_Residual(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, u, Fn_U_Resid, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call ResetInputsAndStates() + return + end if + + ! If Jacobian needs to be recalculated + if (mod(K, p_FAST%N_UJac) == 0) then + + + call FormSteadyStateJacobian(caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call Precondition_Jmat(p_FAST, y_FAST, Jmat) + + ! Get the LU decomposition of this matrix using a LAPACK routine: + ! The result is of the form Jmat = P * L * U + + call LAPACK_getrf(M=size(Jmat, 1), N=size(Jmat, 2), & + A=Jmat, IPIV=MeshMapData%Jacobian_pivot, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call ResetInputsAndStates() + return + end if + + end if + + !------------------------------------------------------------------------- + ! Solve for delta u: Jac*u_delta = - Fn_U_Resid + ! using the LAPACK routine + !------------------------------------------------------------------------- + + u_delta = -Fn_U_Resid + call LAPACK_getrs(TRANS="N", N=SIZE(Jmat, 1), A=Jmat, & + IPIV=MeshMapData%Jacobian_pivot, B=u_delta, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !------------------------------------------------------------------------- + ! check for error, update inputs if necessary, and iterate again + !------------------------------------------------------------------------- + err_prev = err + err = DOT_PRODUCT(u_delta, u_delta) + y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/p_FAST%SizeJac_Opt1(1) + + if (err <= p_FAST%TolerSquared) then + if (K == 0) then ! the error will be incorrect in this instance, but the outputs will be better + MaxIter = K + else + exit + end if + end if + + if (K >= p_FAST%KMax) exit + if (K > 5 .and. err > 1.0E35) exit ! this is obviously not converging. Let's try something else. + + !------------------------------------------------------------------------- + ! modify inputs and states for next iteration + !------------------------------------------------------------------------- + if (err > err_prev) then + u_delta = u_delta*reduction_factor ! don't take a full step if we're getting farther from the solution! + err_prev = err_prev*reduction_factor + end if + + call Add_SteadyState_delta(p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData) + + !u = u + u_delta + call Create_SS_Vector(p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR) + + K = K + 1 + y_FAST%DriverWriteOutput(SS_Indx_Iter) = k + + end do ! K + + if (p_FAST%CompElast == Module_BD) then + ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: + call ED_CalcOutput(SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + call ResetInputsAndStates() + +contains + subroutine ResetInputsAndStates() + + if (err > p_FAST%TolerSquared) then + + call SetErrStat(ErrID_Severe, 'Steady-state solver did not converge.', ErrStat, ErrMsg, RoutineName) + + if (err > 100.0) then + ! if we didn't get close on the solution, we should reset the states and inputs because they very well could + ! lead to numerical issues on the next iteration. Here, set the initial values to 0: + + ! because loads occasionally get very large when it fails, manually set these to zero (otherwise + ! roundoff can lead to non-zero values with the method below, which is most useful for states) + if (p_FAST%CompElast == Module_BD) then + do K = 1, p_FAST%nBeams + BD%Input(1, k)%DistrLoad%Force = 0.0_ReKi + BD%Input(1, k)%DistrLoad%Moment = 0.0_ReKi + end do + + end if + + call Create_SS_Vector(p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR) ! find the values we have been modifying (in u... continuous states and inputs) + call Add_SteadyState_delta(p_FAST, y_FAST, -u, AD, ED, BD, MeshMapData) ! and reset them to 0 (by adding -u) + + end if + end if + end subroutine ResetInputsAndStates + +end subroutine SolveSteadyState + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine SteadyStatePrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) + type(FAST_SS_CaseType), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + type(FAST_ParameterType), intent(IN) :: p_FAST !< Parameters for the glue code + type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Output variables for the glue code + type(FAST_MiscVarType), intent(INOUT) :: m_FAST !< Miscellaneous variables + + type(ElastoDyn_Data), intent(INOUT) :: ED !< ElastoDyn data + type(BeamDyn_Data), intent(INOUT) :: BD !< BeamDyn data + type(AeroDyn_Data), intent(INOUT) :: AD !< AeroDyn data + + integer(IntKi) :: k + real(R8Ki) :: theta(3) + + ! Set prescribed inputs for all of the modules in the steady-state solve + + ED%Input(1)%TwrAddedMass = 0.0_ReKi + ED%Input(1)%PtfmAddedMass = 0.0_ReKi + + ED%Input(1)%TowerPtLoads%Force = 0.0 + ED%Input(1)%TowerPtLoads%Moment = 0.0 + ED%Input(1)%NacelleLoads%Force = 0.0 + ED%Input(1)%NacelleLoads%Moment = 0.0 + ED%Input(1)%HubPtLoad%Force = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 + ED%Input(1)%HubPtLoad%Moment = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 + + ED%Input(1)%BlPitchCom = caseData%Pitch + ED%Input(1)%YawMom = 0.0 + ED%Input(1)%HSSBrTrqC = 0.0 + ED%Input(1)%GenTrq = 0.0 + + ! BeamDyn + if (p_FAST%CompElast == Module_BD) then + + !CALL ED_CalcOutput( 0.0_DbKi, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + do k = 1, p_FAST%nBeams + BD%Input(1, k)%RootMotion%TranslationDisp = 0.0_ReKi + + theta = EulerExtract(BD%Input(1, k)%RootMotion%RefOrientation(:, :, 1)) + theta(3) = -caseData%Pitch + BD%Input(1, k)%RootMotion%Orientation(:, :, 1) = EulerConstruct(theta) + + BD%Input(1, k)%RootMotion%RotationVel(1, 1) = caseData%RotSpeed !BD%Input(1,k)%RootMotion%RotationVel = ED%y_interp%BladeRootMotion(k)%RotationVel + BD%Input(1, k)%RootMotion%RotationVel(2:3, 1) = 0.0_ReKi + + BD%Input(1, k)%RootMotion%TranslationVel(:, 1) = cross_product(BD%Input(1, k)%RootMotion%RotationVel(:, 1), BD%Input(1, k)%RootMotion%Position(:, 1) - AD%Input(1)%rotors(1)%HubMotion%Position(:, 1)) ! ED%y_interp%BladeRootMotion(k)%TranslationVel + BD%Input(1, k)%RootMotion%TranslationAcc(:, 1) = cross_product(BD%Input(1, k)%RootMotion%RotationVel(:, 1), BD%Input(1, k)%RootMotion%TranslationVel(:, 1)) ! ED%y_interp%BladeRootMotion(k)%TranslationAcc + + BD%Input(1, k)%RootMotion%RotationAcc = 0.0_ReKi + end do ! k=p_FAST%nBeams + + end if ! BeamDyn + !BeamDyn's first "state" is not actually the state. So, do we need to do something with that????? + + !AeroDyn + !note: i'm skipping the (unused) TowerMotion mesh + AD%Input(1)%rotors(1)%HubMotion%TranslationDisp = 0.0 + AD%Input(1)%rotors(1)%HubMotion%Orientation = AD%Input(1)%rotors(1)%HubMotion%RefOrientation + AD%Input(1)%rotors(1)%HubMotion%RotationVel(1, :) = caseData%RotSpeed + AD%Input(1)%rotors(1)%HubMotion%RotationVel(2:3, :) = 0.0_ReKi + + do k = 1, size(AD%Input(1)%rotors(1)%BladeRootMotion, 1) + theta = EulerExtract(AD%Input(1)%rotors(1)%BladeRootMotion(k)%RefOrientation(:, :, 1)) + theta(3) = -caseData%Pitch + AD%Input(1)%rotors(1)%BladeRootMotion(k)%Orientation(:, :, 1) = EulerConstruct(theta) !AD%Input(1)%BladeRootMotion(k)%RefOrientation + + AD%Input(1)%rotors(1)%BladeMotion(k)%RotationVel = 0.0_ReKi + !AD%Input(1)%rotors(1)%BladeMotion(k)%RotationAcc = 0.0_ReKi + AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi + end do + + ! Set FlowField information -- AD calculates everything from the data stored in the FlowField pointer + AD%p%FlowField%Uniform%VelH(:) = caseData%WindSpeed + AD%p%FlowField%Uniform%LinShrV(:) = 0.0_ReKi + AD%p%FlowField%Uniform%AngleH(:) = 0.0_ReKi + AD%p%FlowField%PropagationDir = 0.0_ReKi + + AD%Input(1)%rotors(1)%UserProp = 0.0_ReKi + +end subroutine SteadyStatePrescribedInputs + +end module diff --git a/modules/openfast-library/src/FAST_Idx.f90 b/modules/openfast-library/src/FAST_Idx.f90 new file mode 100644 index 0000000000..fb4cace35f --- /dev/null +++ b/modules/openfast-library/src/FAST_Idx.f90 @@ -0,0 +1,385 @@ +!********************************************************************************************************************************** +! FAST_ModLin.f90 performs linearization using the ModVars module. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +module FAST_Idx + +use NWTC_Library +use NWTC_LAPACK + +use FAST_Types + +implicit none + +private +public :: Idx_Init, Idx_GetValLoc, GetModuleOrder + +contains + +subroutine GetModuleOrder(Mods, ModIDs, ModOrder) + type(ModDataType), intent(in) :: Mods(:) !< Array of module data structures + integer(IntKi), intent(in) :: ModIDs(:) !< List of module IDs to keep in order + integer(IntKi), allocatable, intent(out) :: ModOrder(:) !< Module data indices in order of ModIDs + integer(IntKi), allocatable :: ModIDAry(:), indices(:) + integer(IntKi) :: i + + ! Create array 1 to size(Mod) representing the index of each module data + indices = [(i, i = 1, size(Mods))] + + ! Get array of module IDs from array of module data + ModIDAry = [(Mods(i)%ID, i = 1, size(Mods))] + + ! Initialize module order array with no size + allocate (ModOrder(0)) + + ! Loop through module IDs to keep, add module data indices that match module ID to order array + do i = 1, size(ModIDs) + ModOrder = [ModOrder, pack(indices, ModIDAry == ModIDs(i))] + end do + +end subroutine + +subroutine Idx_Init(Mods, ModOrder, Idx, FlagFilter, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) + integer(IntKi), intent(in) :: ModOrder(:) + type(VarsIdxType), intent(out) :: Idx + integer(IntKi), intent(in) :: FlagFilter + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Idx_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: NumVars + integer(IntKi) :: iGbl(2) + integer(IntKi) :: i, j + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + ! Destroy VarIdx in case it has been previously used + call FAST_DestroyVarsIdxType(Idx, ErrStat2, ErrMsg2); if (Failed()) return + + ! Save filter in index + Idx%FlagFilter = FlagFilter + + !---------------------------------------------------------------------------- + ! Indexing Data Description + !---------------------------------------------------------------------------- + + ! For each variable (x, u, y, etc.) there are two arrays: + ! 1) Variable local and global value indices (ValLocGbl) + ! 2) Module variable start index (ModVarStart) + ! ValLocGbl has 4 rows and N columns where N is the total number of variables + ! for all modules in Mods. The columns are as follows: + ! 1) Values start index inside module arrays/matrices (iLoc(1)) + ! 2) Values end index inside module arrays/matrices (iLoc(2)) + ! 3) Values start index in global arrays/matrices (iGbl(1)) + ! 4) Values end index in global arrays/matrices (iLoc(2)) + ! ModVarStart contains N rows where N is the total number of modules in Mods. + ! The values in this array contain the variable start index offset for each + ! module into ValLocGbl so value indices can be looked up given module index + ! and variable index. Keeping all value indices in one matrix makes data + ! storage much simpler at the cost of of having to maintain the array of + ! module offsets. + + !---------------------------------------------------------------------------- + ! Build index for continuous state variables + !---------------------------------------------------------------------------- + + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%x%ModVarStart, size(Mods) + 1, "VarIdx%x%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%x%ModVarStart(1) = 0 + + ! Populate ModVarStart with variable offsets and calculate total number of variables + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%x) + Idx%x%ModVarStart(i + 1) = NumVars + end do + + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%x%ValLocGbl, 4, NumVars, "VarIdx%x%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%x%ValLocGbl = 0 + + ! Initialize global index to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%x) + if (MV_HasFlags(ModData%Vars%x(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%x(j)%Num - 1 + Idx%x%ValLocGbl(:, Idx%x%ModVarStart(ModData%Idx) + j) = [ModData%Vars%x(j)%iLoc, iGbl] + end if + end do + end associate + end do + + ! Save total number of values + Idx%Nx = iGbl(2) + + !---------------------------------------------------------------------------- + ! Build index for discrete state variables + !---------------------------------------------------------------------------- + + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%xd%ModVarStart, size(Mods) + 1, "VarIdx%xd%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%xd%ModVarStart(1) = 0 + + ! Populate ModVarStart with variable offsets and calculate total number of variables and values + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%xd) + Idx%xd%ModVarStart(i + 1) = NumVars + end do + + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%xd%ValLocGbl, 4, NumVars, "VarIdx%xd%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%xd%ValLocGbl = 0 + + ! Initialize global index and number of values to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%xd) + if (MV_HasFlags(ModData%Vars%xd(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%xd(j)%Num - 1 + Idx%xd%ValLocGbl(:, Idx%xd%ModVarStart(ModData%Idx) + j) = [ModData%Vars%xd(j)%iLoc, iGbl] + end if + end do + end associate + end do + + ! Save total number of values + Idx%Nxd = iGbl(2) + + !---------------------------------------------------------------------------- + ! Build index for constraint state variables + !---------------------------------------------------------------------------- + + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%z%ModVarStart, size(Mods) + 1, "VarIdx%z%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%z%ModVarStart(1) = 0 + + ! Populate ModVarStart with variable offsets and calculate total number of variables + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%z) + Idx%z%ModVarStart(i + 1) = NumVars + end do + + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%z%ValLocGbl, 4, NumVars, "VarIdx%z%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%z%ValLocGbl = 0 + + ! Initialize global index to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%z) + if (MV_HasFlags(ModData%Vars%z(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%z(j)%Num - 1 + Idx%z%ValLocGbl(:, Idx%z%ModVarStart(ModData%Idx) + j) = [ModData%Vars%z(j)%iLoc, iGbl] + end if + end do + end associate + end do + + ! Save total number of values + Idx%Nz = iGbl(2) + + !---------------------------------------------------------------------------- + ! Build index for input variables + !---------------------------------------------------------------------------- + + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%u%ModVarStart, size(Mods) + 1, "VarIdx%u%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%u%ModVarStart(1) = 0 + + ! Populate ModVarStart with variable offsets and calculate total number of variables + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%u) + Idx%u%ModVarStart(i + 1) = NumVars + end do + + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%u%ValLocGbl, 4, NumVars, "VarIdx%u%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%u%ValLocGbl = 0 + + ! Initialize global index to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%u) + if (MV_HasFlags(ModData%Vars%u(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%u(j)%Num - 1 + Idx%u%ValLocGbl(:, Idx%u%ModVarStart(ModData%Idx) + j) = [ModData%Vars%u(j)%iLoc, iGbl] + end if + end do + end associate + end do + + ! Save total number of values + Idx%Nu = iGbl(2) + + !---------------------------------------------------------------------------- + ! Build index for output variables + !---------------------------------------------------------------------------- + + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%y%ModVarStart, size(Mods) + 1, "VarIdx%y%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%y%ModVarStart(1) = 0 + + ! Populate ModVarStart with variable offsets and calculate total number of variables + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%y) + Idx%y%ModVarStart(i + 1) = NumVars + end do + + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%y%ValLocGbl, 4, NumVars, "VarIdx%y%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%y%ValLocGbl = 0 + + ! Initialize global index to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%y) + if (MV_HasFlags(ModData%Vars%y(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%y(j)%Num - 1 + Idx%y%ValLocGbl(:, Idx%y%ModVarStart(ModData%Idx) + j) = [ModData%Vars%y(j)%iLoc, iGbl] + end if + end do + end associate + end do + + ! Save total number of values + Idx%Ny = iGbl(2) + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +! Idx_GetValLoc is used to get the global or module value indices based on module index and variable index. +! iMod is the start and end indices of the values in the module data +! iGbl is teh start and end indices of the values in the global data +subroutine Idx_GetValLoc(Idx, ModIdx, VarIdx, iMod, iGbl) + type(VarIdxType), intent(in) :: Idx + integer(IntKi), intent(in) :: ModIdx, VarIdx + integer(IntKi), optional, intent(out) :: iMod(2), iGbl(2) + integer(IntKi) :: col + col = Idx%ModVarStart(ModIdx) + VarIdx + if (present(iMod)) iMod = Idx%ValLocGbl(1:2, col) + if (present(iGbl)) iGbl = Idx%ValLocGbl(3:4, col) +end subroutine + +subroutine MV_AddModule(Mods, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: Mods(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: ModDT + real(R8Ki), intent(in) :: SolverDT + type(ModVarsType), pointer, intent(in) :: Vars + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_AddModule' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + + ErrStat = ErrID_None + ErrMsg = '' + + ! If module array hasn't been allocated, allocate with zero size + if (.not. allocated(Mods)) allocate (Mods(0)) + + ! Populate ModuleDataType derived type + ModData = ModDataType(Idx=size(Mods) + 1, ID=ModID, Abbr=ModAbbr, & + Ins=Instance, DT=ModDT, Vars=Vars) + + ! Allocate source and destination mapping arrays + call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Calculate Module Substepping + !---------------------------------------------------------------------------- + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData%DT, SolverDT)) then + ModData%SubSteps = 1 + else + ! If the module time step is greater than the global time step, set error + if (ModData%DT > SolverDT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate the number of substeps + ModData%SubSteps = nint(SolverDT/ModData%DT) + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Add module data to array + !---------------------------------------------------------------------------- + + Mods = [Mods, ModData] + +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index ba038f5b33..a62a1d193b 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -22,6 +22,7 @@ module FAST_Mapping use FAST_Types use FAST_ModTypes +use FAST_Idx implicit none @@ -417,27 +418,6 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) DstMod%DstMaps = [DstMod%DstMaps, iMap] write (*, *) "Mapping: ", Mappings(iMap)%Desc - ! write (*, *) " Src: ", trim(SrcMod%Abbr), SrcMod%Ins - ! if (Mappings(iMap)%iLocSrcTransDisp(1) > 0) write (*, *) " iLocTransDisp ", Mappings(iMap)%iLocSrcTransDisp + SrcMod%iyg - 1 - ! if (Mappings(iMap)%iLocSrcTransVel(1) > 0) write (*, *) " iLocTransVel ", Mappings(iMap)%iLocSrcTransVel + SrcMod%iyg - 1 - ! if (Mappings(iMap)%iLocSrcTransAcc(1) > 0) write (*, *) " iLocTransAcc ", Mappings(iMap)%iLocSrcTransAcc + SrcMod%iyg - 1 - ! if (Mappings(iMap)%iLocSrcOrientation(1) > 0) write (*, *) " iLocOrientation ", Mappings(iMap)%iLocSrcOrientation + SrcMod%iyg - 1 - ! if (Mappings(iMap)%iLocSrcAngularVel(1) > 0) write (*, *) " iLocAngularVel ", Mappings(iMap)%iLocSrcAngularVel + SrcMod%iyg - 1 - ! if (Mappings(iMap)%iLocSrcAngularAcc(1) > 0) write (*, *) " iLocAngularAcc ", Mappings(iMap)%iLocSrcAngularAcc + SrcMod%iyg - 1 - ! if (Mappings(iMap)%iLocSrcForce(1) > 0) write (*, *) " iLocForce ", Mappings(iMap)%iLocSrcForce + SrcMod%iyg - 1 - ! if (Mappings(iMap)%iLocSrcMoment(1) > 0) write (*, *) " iLocMoment ", Mappings(iMap)%iLocSrcMoment + SrcMod%iyg - 1 - ! if (Mappings(iMap)%iLocSrcDispTransDisp(1) > 0) write (*, *) " iLocDispTransDisp ", Mappings(iMap)%iLocSrcDispTransDisp + SrcMod%iyg - 1 - ! write (*, *) " Dst: ", trim(DstMod%Abbr), DstMod%Ins - ! if (Mappings(iMap)%iLocDstTransDisp(1) > 0) write (*, *) " iLocTransDisp ", Mappings(iMap)%iLocDstTransDisp - ! if (Mappings(iMap)%iLocDstTransVel(1) > 0) write (*, *) " iLocTransVel ", Mappings(iMap)%iLocDstTransVel - ! if (Mappings(iMap)%iLocDstTransAcc(1) > 0) write (*, *) " iLocTransAcc ", Mappings(iMap)%iLocDstTransAcc - ! if (Mappings(iMap)%iLocDstOrientation(1) > 0) write (*, *) " iLocOrientation ", Mappings(iMap)%iLocDstOrientation - ! if (Mappings(iMap)%iLocDstAngularVel(1) > 0) write (*, *) " iLocAngularVel ", Mappings(iMap)%iLocDstAngularVel - ! if (Mappings(iMap)%iLocDstAngularAcc(1) > 0) write (*, *) " iLocAngularAcc ", Mappings(iMap)%iLocDstAngularAcc - ! if (Mappings(iMap)%iLocDstForce(1) > 0) write (*, *) " iLocForce ", Mappings(iMap)%iLocDstForce - ! if (Mappings(iMap)%iLocDstMoment(1) > 0) write (*, *) " iLocMoment ", Mappings(iMap)%iLocDstMoment - ! if (Mappings(iMap)%iLocDstDispTransDisp(1) > 0) write (*, *) " iLocDispTransDisp ", Mappings(iMap)%iLocDstDispTransDisp - ! if (Mappings(iMap)%iLocDstDispOrientation(1) > 0) write (*, *) " iLocDispOrientation ", Mappings(iMap)%iLocDstDispOrientation end associate end do @@ -1836,50 +1816,50 @@ subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMes Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) ! Get data locations for variables of source mesh fields - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransDisp, SrcMod%iyg, Mapping%iLocSrcTransDisp) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransVel, SrcMod%iyg, Mapping%iLocSrcTransVel) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransAcc, SrcMod%iyg, Mapping%iLocSrcTransAcc) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Orientation, SrcMod%iyg, Mapping%iLocSrcOrientation) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_AngularVel, SrcMod%iyg, Mapping%iLocSrcAngularVel) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_AngularAcc, SrcMod%iyg, Mapping%iLocSrcAngularAcc) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Force, SrcMod%iyg, Mapping%iLocSrcForce) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Moment, SrcMod%iyg, Mapping%iLocSrcMoment) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransDisp, Mapping%iVarSrcTransDisp) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransVel, Mapping%iVarSrcTransVel) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransAcc, Mapping%iVarSrcTransAcc) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Orientation, Mapping%iVarSrcOrientation) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_AngularVel, Mapping%iVarSrcAngularVel) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_AngularAcc, Mapping%iVarSrcAngularAcc) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Force, Mapping%iVarSrcForce) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Moment, Mapping%iVarSrcMoment) ! Get data locations for variables of destination mesh fields - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransDisp, DstMod%iug, Mapping%iLocDstTransDisp) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransVel, DstMod%iug, Mapping%iLocDstTransVel) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransAcc, DstMod%iug, Mapping%iLocDstTransAcc) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Orientation, DstMod%iug, Mapping%iLocDstOrientation) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_AngularVel, DstMod%iug, Mapping%iLocDstAngularVel) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_AngularAcc, DstMod%iug, Mapping%iLocDstAngularAcc) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Force, DstMod%iug, Mapping%iLocDstForce) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Moment, DstMod%iug, Mapping%iLocDstMoment) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransDisp, Mapping%iVarDstTransDisp) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransVel, Mapping%iVarDstTransVel) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransAcc, Mapping%iVarDstTransAcc) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Orientation, Mapping%iVarDstOrientation) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_AngularVel, Mapping%iVarDstAngularVel) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_AngularAcc, Mapping%iVarDstAngularAcc) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Force, Mapping%iVarDstForce) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Moment, Mapping%iVarDstMoment) if (present(SrcDispMesh)) then Mapping%SrcDispMeshID = SrcDispMesh%ID - call FindVarByMeshAndField(SrcMod%Vars%u, SrcDispMesh%ID, VF_TransDisp, SrcMod%iug, Mapping%iLocSrcDispTransDisp) + call FindVarByMeshAndField(SrcMod%Vars%u, SrcDispMesh%ID, VF_TransDisp, Mapping%iVarSrcDispTransDisp) end if if (present(DstDispMesh)) then Mapping%DstDispMeshID = DstDispMesh%ID - call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_TransDisp, DstMod%iyg, Mapping%iLocDstDispTransDisp) - call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_Orientation, DstMod%iyg, Mapping%iLocDstDispOrientation) + call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_TransDisp, Mapping%iVarDstDispTransDisp) + call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_Orientation, Mapping%iVarDstDispOrientation) end if contains - subroutine FindVarByMeshAndField(VarAry, MeshID, Field, iGbl, iLoc) + subroutine FindVarByMeshAndField(VarAry, MeshID, Field, iVar) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: MeshID, Field, iGbl - integer(IntKi), intent(out) :: iLoc(2) + integer(IntKi), intent(in) :: MeshID, Field + integer(IntKi), intent(out) :: iVar integer(IntKi) :: i - ! Initialize locations - iLoc = 0 + ! Initialize variable index to invalid value (not used) + iVar = 0 ! Loop through variables, if variable's mesh ID and field matches given values, return do i = 1, size(VarAry) if ((VarAry(i)%MeshID == MeshID) .and. (VarAry(i)%Field == Field)) then - iLoc = VarAry(i)%iLoc + iGbl - 1 + iVar = i return end if end do @@ -1902,11 +1882,12 @@ function MeshTransferType(SrcMesh, DstMesh) result(XfrType) end if end function -subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, ErrMsg, dUdu, dUdy) +subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrStat, ErrMsg, dUdu, dUdy) type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type type(ModDataType), intent(in) :: Mods(:) !< Module data type(TC_MappingType), intent(inout) :: Mappings(:) integer(IntKi), intent(in) :: ModOrder(:) + type(VarsIdxType), intent(in) :: Idx integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg real(R8Ki), intent(inout) :: dUdu(:, :), dUdy(:, :) @@ -1914,6 +1895,7 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: iLocSrc(2), iLocDst(2) integer(IntKi) :: i, j, k type(MeshType), pointer :: SrcMesh, DstMesh type(MeshType), pointer :: SrcDispMesh, DstDispMesh @@ -1933,22 +1915,13 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er case (Map_Variable) - associate (SrcMod => Mods(Mapping%SrcModIdx), & - DstMod => Mods(Mapping%DstModIdx), & - SrcVar => Mods(Mapping%SrcModIdx)%Vars%y(Mapping%iVarSrc), & - DstVar => Mods(Mapping%DstModIdx)%Vars%u(Mapping%iVarDst)) - if (SrcVar%Num == 1) then - ! Map rank 0 source var to rank 1 destination var - do k = 0, DstVar%Num - 1 - dUdy(DstMod%iug + DstVar%iLoc(1) + k - 1, SrcMod%iyg + SrcVar%iLoc(1) - 1) = -1.0_R8Ki - end do - else - ! Map rank 1 source var to rank 1 destination var - do k = 0, SrcVar%Num - 1 - dUdy(DstMod%iug + DstVar%iLoc(1) + k - 1, SrcMod%iyg + SrcVar%iLoc(1) + k - 1) = -1.0_R8Ki - end do - end if - end associate + ! Get source and destination global value indices, skip if no global index for either + call Idx_GetValLoc(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrc, iGbl=iLocSrc) + call Idx_GetValLoc(Idx%u, Mapping%DstModIdx, Mapping%iVarDst, iGbl=iLocDst) + if (iLocSrc(1) == 0 .or. iLocDst(1) == 0) cycle + + ! Set coupling terms in dUdy to -1 + dUdy(iLocDst(1):iLocDst(2), iLocSrc(1):iLocSrc(2)) = -1.0_R8Ki case (Map_MotionMesh) @@ -1960,10 +1933,10 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap); if (Failed()) return ! Copy linearization matrices to global dUdy matrix - call Assemble_dUdy_Motions(Mapping, dUdy) + call Assemble_dUdy_Motions(Mapping) ! Copy linearization matrices to global dUdu matrix - call Assemble_dUdu(Mapping, dUdu) + call Assemble_dUdu(Mapping) case (Map_LoadMesh) @@ -1983,7 +1956,7 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er else - ! Transfer destination displacement mesh to temporary motion mesh (cousin of destionation load mesh) + ! Transfer destination displacement mesh to temporary motion mesh (cousin of destination load mesh) call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return ! Linearize the motion mesh transfer @@ -1991,13 +1964,14 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er ! Linearize the load mesh transfer call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh); if (Failed()) return + end if ! Copy linearization matrices to global dUdy matrix - call Assemble_dUdy_Loads(Mapping, dUdy) + call Assemble_dUdy_Loads(Mapping) ! Copy linearization matrices to global dUdu matrix - call Assemble_dUdu(Mapping, dUdu) + call Assemble_dUdu(Mapping) end select @@ -2009,20 +1983,20 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ErrStat, Er ! LinearizeMeshTransfer calls the specific linearization function based on ! transfer type (Point_to_Point, Point_to_Line2, etc.) - subroutine LinearizeMeshTransfer(Typ, Src, Dst, MMap, SrcDisp, DstDisp) + subroutine LinearizeMeshTransfer(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp) integer(IntKi), intent(in) :: Typ type(MeshType), intent(in) :: Src, Dst - type(MeshMapType), intent(inout) :: MMap + type(MeshMapType), intent(inout) :: MeshMap type(MeshType), optional, intent(in) :: SrcDisp, DstDisp select case (Typ) case (Xfr_Point_to_Point) - call Linearize_Point_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + call Linearize_Point_to_Point(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case (Xfr_Point_to_Line2) - call Linearize_Point_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + call Linearize_Point_to_Line2(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case (Xfr_Line2_to_Point) - call Linearize_Line2_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + call Linearize_Line2_to_Point(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case (Xfr_Line2_to_Line2) - call Linearize_Line2_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + call Linearize_Line2_to_Line2(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case default ErrStat2 = ErrID_Fatal ErrMsg2 = "LinearizeMeshTransfer: unknown transfer type: "//Num2LStr(Typ) @@ -2031,156 +2005,165 @@ subroutine LinearizeMeshTransfer(Typ, Src, Dst, MMap, SrcDisp, DstDisp) ! MeshTransfer calls the specific transfer function based on ! transfer type (Point_to_Point, Point_to_Line2, etc.) - subroutine TransferMesh(Typ, Src, Dst, MMap, SrcDisp, DstDisp) + subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp) integer(IntKi), intent(in) :: Typ type(MeshType), intent(in) :: Src type(MeshType), intent(inout) :: Dst - type(MeshMapType), intent(inout) :: MMap + type(MeshMapType), intent(inout) :: MeshMap type(MeshType), optional, intent(in) :: SrcDisp, DstDisp select case (Typ) case (Xfr_Point_to_Point) - call Transfer_Point_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + call Transfer_Point_to_Point(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case (Xfr_Point_to_Line2) - call Transfer_Point_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + call Transfer_Point_to_Line2(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case (Xfr_Line2_to_Point) - call Transfer_Line2_to_Point(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + call Transfer_Line2_to_Point(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case (Xfr_Line2_to_Line2) - call Transfer_Line2_to_Line2(Src, Dst, MMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + call Transfer_Line2_to_Line2(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) case default ErrStat2 = ErrID_Fatal ErrMsg2 = "TransferMeshTransfer: unknown transfer type: "//Num2LStr(Typ) end select end subroutine + subroutine Assemble_dUdu(Mapping) + type(TC_MappingType), intent(in) :: Mapping + + ! Effect of input Translation Displacement on input Translation Velocity + if (allocated(Mapping%MeshMap%dM%tv_uD)) then + call SumBlock(Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_uD, dUdu) + end if + + ! Effect of input Translation Displacement on input Translation Acceleration + if (allocated(Mapping%MeshMap%dM%ta_uD)) then + call SumBlock(Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_uD, dUdu) + end if + + ! Effect of input Translation Displacement on input Moments + if (allocated(Mapping%MeshMap%dM%M_uS)) then + call SumBlock(Idx%u, Mapping%SrcModIdx, Mapping%iVarSrcDispTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%M_uS, dUdu) + end if + end subroutine + + !> Assemble_dUdy_Loads assembles the linearization matrices for transfer of + !! load fields between two meshes. It sets the following block matrix, which + !! is the dUdy block for transfering output (source) mesh to the input + !! (destination) mesh : + !! M = -| M_li 0 | * M_mi | F^S | + !! | M_fm M_li | | M^S | + subroutine Assemble_dUdy_Loads(Mapping) + type(TC_MappingType), intent(inout) :: Mapping + + ! Load identity + if (allocated(Mapping%MeshMap%dM%li)) then + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcForce, Idx%u, Mapping%DstModIdx, Mapping%iVarDstForce, Mapping%MeshMap%dM%li, dUdy) + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcMoment, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%li, dUdy) + end if + + ! Force to Moment + if (allocated(Mapping%MeshMap%dM%m_f)) then + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcForce, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_f, dUdy) + end if + + ! Destination Translation Displacement to Moment + if (allocated(Mapping%MeshMap%dM%m_uD)) then + if (Mapping%DstUsesSibling) then + ! Direct transfer + call SumBlock(Idx%y, Mapping%DstModIdx, Mapping%iVarDstDispTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_uD, dUdy) + else + ! Compose linearization of motion and loads + Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%mi) + call SumBlock(Idx%y, Mapping%DstModIdx, Mapping%iVarDstDispTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%TmpMatrix, dUdy) + Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%fx_p) + call SumBlock(Idx%y, Mapping%DstModIdx, Mapping%iVarDstDispOrientation, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%TmpMatrix, dUdy) + end if + end if + end subroutine + + !> Assemble_dUdy_Motions assembles the linearization matrices for transfer of + !! motion fields between two meshes. It set the following block matrix, which + !! is the dUdy block for transfering output (source) mesh to the input + !! (destination) mesh : + !! M = -| M_mi M_f_p 0 0 0 0 | + !! | 0 M_mi 0 0 0 0 | + !! | M_tv_uS 0 M_mi M_f_p 0 0 | + !! | 0 0 0 M_mi 0 0 | + !! | M_ta_uS 0 0 M_ta_rv M_mi M_f_p | + !! | 0 0 0 0 0 M_mi | + !! where the matrices correspond to + !! u^S, theta^S, v^S, omega^S, a^S, alpha^S + subroutine Assemble_dUdy_Motions(Mapping) + type(TC_MappingType), intent(inout) :: Mapping + + ! Motion identity + if (allocated(Mapping%MeshMap%dM%mi)) then + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcOrientation, Idx%u, Mapping%DstModIdx, Mapping%iVarDstOrientation, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstAngularVel, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstAngularAcc, Mapping%MeshMap%dM%mi, dUdy) + end if + + ! Rotation to Translation + if (allocated(Mapping%MeshMap%dM%fx_p)) then + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcOrientation, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%fx_p, dUdy) + end if + + ! Translation displacement to Translation velocity + if (allocated(Mapping%MeshMap%dM%tv_us)) then + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_us, dUdy) + end if + + ! Translation displacement to Translation acceleration + if (allocated(Mapping%MeshMap%dM%ta_us)) then + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_us, dUdy) + end if + + ! Angular velocity to Translation acceleration + if (allocated(Mapping%MeshMap%dM%ta_rv)) then + call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_rv, dUdy) + end if + end subroutine + + subroutine SumBlock(IdxSrc, iModSrc, iVarSrc, IdxDst, iModDst, iVarDst, SrcM, DstM) + type(VarIdxType), intent(in) :: IdxDst, IdxSrc + integer(IntKi), intent(in) :: iModDst, iModSrc + integer(IntKi), intent(in) :: iVarDst, iVarSrc + real(R8Ki), intent(in) :: SrcM(:, :) + real(R8Ki), intent(inout) :: DstM(:, :) + integer(IntKi) :: iLocSrc(2), iLocDst(2) + + ! If no variable index for source or destination, return + if (iVarDst == 0 .or. iVarSrc == 0) return + + ! Get global indices for source/destination modules/variables + call Idx_GetValLoc(IdxSrc, iModSrc, iVarSrc, iGbl=iLocSrc) + call Idx_GetValLoc(IdxDst, iModDst, iVarDst, iGbl=iLocDst) + + ! If no global indices for source or destination, return + if (iLocDst(1) == 0 .or. iLocSrc(1) == 0) return + + ! Subtracts the source matrix from the destination sub-matrix + associate (DstSubM => DstM(iLocDst(1):iLocDst(2), iLocSrc(1):iLocSrc(2))) + DstSubM = DstSubM - SrcM + end associate + end subroutine + logical function Failed() Failed = ErrStat2 >= AbortErrLev if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end function end subroutine -subroutine Assemble_dUdu(Mapping, dUdu) - type(TC_MappingType), intent(in) :: Mapping - real(R8Ki), intent(inout) :: dUdu(:, :) - - ! Effect of input Translation Displacement on input Translation Velocity - if (allocated(Mapping%MeshMap%dM%tv_uD)) then - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocDstTransDisp, Mapping%MeshMap%dM%tv_uD, dUdu) - end if - - ! Effect of input Translation Displacement on input Translation Acceleration - if (allocated(Mapping%MeshMap%dM%ta_uD)) then - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocDstTransDisp, Mapping%MeshMap%dM%ta_uD, dUdu) - end if - - ! Effect of input Translation Displacement on input Moments - if (allocated(Mapping%MeshMap%dM%M_uS)) then - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcDispTransDisp, Mapping%MeshMap%dM%M_uS, dUdu) - end if -end subroutine -!> Assemble_dUdy_Loads assembles the linearization matrices for transfer of -!! load fields between two meshes. It sets the following block matrix, which -!! is the dUdy block for transfering output (source) mesh to the input -!! (destination) mesh : -!! M = -| M_li 0 | * M_mi | F^S | -!! | M_fm M_li | | M^S | -subroutine Assemble_dUdy_Loads(Mapping, dUdy) - type(TC_MappingType), intent(inout) :: Mapping - real(R8Ki), intent(inout) :: dUdy(:, :) - - ! Load identity - if (allocated(Mapping%MeshMap%dM%li)) then - call SumBlock(Mapping%iLocDstForce, Mapping%iLocSrcForce, Mapping%MeshMap%dM%li, dUdy) - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcMoment, Mapping%MeshMap%dM%li, dUdy) - end if - - ! Force to Moment - if (allocated(Mapping%MeshMap%dM%m_f)) then - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocSrcForce, Mapping%MeshMap%dM%m_f, dUdy) - end if - - ! Destination Translation Displacement to Moment - if (allocated(Mapping%MeshMap%dM%m_uD)) then - if (Mapping%DstUsesSibling) then - ! Direct transfer - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, Mapping%MeshMap%dM%m_uD, dUdy) - else - ! call SumBlock(Mapping%iLocDstMoment, [Mapping%iLocDstDispTransDisp(1), Mapping%iLocDstDispTransDisp(1) + size(Mapping%MeshMap%dM%m_uD,2) - 1], Mapping%MeshMap%dM%m_uD, dUdy) - ! Compose linearization of motion and loads - Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%mi) - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispTransDisp, Mapping%TmpMatrix, dUdy) - Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%fx_p) - call SumBlock(Mapping%iLocDstMoment, Mapping%iLocDstDispOrientation, Mapping%TmpMatrix, dUdy) - end if - end if -end subroutine - -!> Assemble_dUdy_Motions assembles the linearization matrices for transfer of -!! motion fields between two meshes. It set the following block matrix, which -!! is the dUdy block for transfering output (source) mesh to the input -!! (destination) mesh : -!! M = -| M_mi M_f_p 0 0 0 0 | -!! | 0 M_mi 0 0 0 0 | -!! | M_tv_uS 0 M_mi M_f_p 0 0 | -!! | 0 0 0 M_mi 0 0 | -!! | M_ta_uS 0 0 M_ta_rv M_mi M_f_p | -!! | 0 0 0 0 0 M_mi | -!! where the matrices correspond to -!! u^S, theta^S, v^S, omega^S, a^S, alpha^S -subroutine Assemble_dUdy_Motions(Mapping, dUdy) - type(TC_MappingType), intent(inout) :: Mapping - real(R8Ki), intent(inout) :: dUdy(:, :) - - ! Motion identity - if (allocated(Mapping%MeshMap%dM%mi)) then - call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcTransDisp, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Mapping%iLocDstOrientation, Mapping%iLocSrcOrientation, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransVel, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Mapping%iLocDstAngularVel, Mapping%iLocSrcAngularVel, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransAcc, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Mapping%iLocDstAngularAcc, Mapping%iLocSrcAngularAcc, Mapping%MeshMap%dM%mi, dUdy) - end if - - ! Rotation to Translation - if (allocated(Mapping%MeshMap%dM%fx_p)) then - call SumBlock(Mapping%iLocDstTransDisp, Mapping%iLocSrcOrientation, Mapping%MeshMap%dM%fx_p, dUdy) - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcAngularVel, Mapping%MeshMap%dM%fx_p, dUdy) - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularAcc, Mapping%MeshMap%dM%fx_p, dUdy) - end if - - ! Translation displacement to Translation velocity - if (allocated(Mapping%MeshMap%dM%tv_us)) then - call SumBlock(Mapping%iLocDstTransVel, Mapping%iLocSrcTransDisp, Mapping%MeshMap%dM%tv_us, dUdy) - end if - - ! Translation displacement to Translation acceleration - if (allocated(Mapping%MeshMap%dM%ta_us)) then - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcTransDisp, Mapping%MeshMap%dM%ta_us, dUdy) - end if - - ! Angular velocity to Translation acceleration - if (allocated(Mapping%MeshMap%dM%ta_rv)) then - call SumBlock(Mapping%iLocDstTransAcc, Mapping%iLocSrcAngularVel, Mapping%MeshMap%dM%ta_rv, dUdy) - end if -end subroutine - -subroutine SumBlock(iLocRow, iLocCol, SrcM, DstM) - integer(IntKi), intent(in) :: iLocRow(2), iLocCol(2) - real(R8Ki), intent(in) :: SrcM(:, :) - real(R8Ki), intent(inout) :: DstM(:, :) - if (iLocRow(1) > 0 .and. iLocCol(1) > 0) then - ! Subtracts the source matrix from the destination sub-matrix - associate (DstSubM => DstM(iLocRow(1):iLocRow(2), iLocCol(1):iLocCol(2))) - DstSubM = DstSubM - SrcM - end associate - end if -end subroutine - -subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) - type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type +subroutine FAST_InputSolve(ModData, Mods, Mappings, Turbine, ErrStat, ErrMsg, UseU) + type(ModDataType), intent(in) :: ModData !< Module data type(ModDataType), intent(in) :: Mods(:) !< Module data - type(TC_MappingType), intent(inout) :: Mappings(:) - integer(IntKi), intent(in) :: iMod !< Index of module in Mods to do input solve + type(TC_MappingType), intent(inout) :: Mappings(:) !< Mesh and variable mappings + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, intent(in) :: UseU ! Flag to transfer to u instead of Input @@ -2195,9 +2178,9 @@ subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) ErrStat = ErrID_None ErrMsg = '' - ! Loop through mappings where this module is the destination - do i = 1, size(Mods(iMod)%DstMaps) - associate (Mapping => Mappings(Mods(iMod)%DstMaps(i))) + ! Loop through mappings where the ModData module is the destination + do i = 1, size(ModData%DstMaps) + associate (Mapping => Mappings(ModData%DstMaps(i))) ! Select based on type of mapping select case (Mapping%MapType) @@ -2260,7 +2243,7 @@ subroutine FAST_InputSolve(Turbine, Mods, Mappings, iMod, ErrStat, ErrMsg, UseU) logical function Failed() Failed = ErrStat2 /= ErrID_None if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, & - RoutineName//':Module='//trim(Mods(iMod)%Abbr)//', Instance='//Num2LStr(Mods(iMod)%Ins)) + RoutineName//':Module='//trim(ModData%Abbr)//', Instance='//Num2LStr(ModData%Ins)) end function end subroutine diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 79f6f99aae..d2b4b76afd 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -31,7 +31,7 @@ module FAST_ModGlue implicit none private -public :: ModGlue_Init, ModLin_Linearize_OP, MV_AddModule +public :: ModGlue_Init, ModGlue_Linearize_OP, MV_AddModule contains @@ -142,7 +142,6 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E end do ! Set module data start index in global arrays, increment data size - ModData%ixg = ModGlue%Vars%Nx + 1 ModGlue%Vars%Nx = ModGlue%Vars%Nx + ModData%Vars%Nx ! Save start index of module variables and append to glue code variables @@ -157,7 +156,6 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E !---------------------------------------------------------------------- ! Set module data start index in global arrays, increment data size - ModData%ixdg = ModGlue%Vars%Nxd + 1 ModGlue%Vars%Nxd = ModGlue%Vars%Nxd + ModData%Vars%Nxd ! Save start index of module variables and append to glue code variables @@ -172,7 +170,6 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E !---------------------------------------------------------------------- ! Set module data start index in global arrays, increment data size - ModData%izg = ModGlue%Vars%Nz + 1 ModGlue%Vars%Nz = ModGlue%Vars%Nz + ModData%Vars%Nz ! Save start index of module variables and append to glue code variables @@ -201,7 +198,6 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E end select ! Set module data start index in global arrays, increment data size - ModData%iug = ModGlue%Vars%Nu + 1 ModGlue%Vars%Nu = ModGlue%Vars%Nu + ModData%Vars%Nu ! Save start index of module variables and append to glue code variables @@ -236,7 +232,6 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E end select ! Set module data start index in global arrays, increment data size - ModData%iyg = ModGlue%Vars%Ny + 1 ModGlue%Vars%Ny = ModGlue%Vars%Ny + ModData%Vars%Ny ! Save start index of module variables and append to glue code variables @@ -266,7 +261,11 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E ! Allocate linearization arrays and matrices !---------------------------------------------------------------------------- - if (p_FAST%Linearize .or. p_FAST%CompAeroMaps) then + ! If linearization is enabled + if (p_FAST%Linearize) then + + ! Initialize linearization index + call Idx_Init(Mods, p%iMod, p%IdxLin, VF_None, ErrStat2, ErrMsg2); if (Failed()) return ! Allocate linearization arrays call AllocAry(ModGlue%Lin%x, ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return @@ -286,10 +285,7 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E end if contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function Failed + subroutine CalcVarDataLoc(VarAry, DataSize) type(ModVarType), intent(inout) :: VarAry(:) integer(IntKi), intent(out) :: DataSize @@ -299,6 +295,12 @@ subroutine CalcVarDataLoc(VarAry, DataSize) DataSize = DataSize + VarAry(i)%Num end do end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine subroutine AddLinNamePrefix(VarAry, Prefix) @@ -314,10 +316,10 @@ subroutine AddLinNamePrefix(VarAry, Prefix) end do end subroutine -subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_FAST, t_global, ErrStat, ErrMsg) +subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_FAST, t_global, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: ModGlue !< Module data for glue code type(ModDataType), intent(inout) :: Mods(:) !< Data for all modules + type(ModDataType), intent(inout) :: ModGlue !< Module data for glue code type(ML_ParameterType), intent(inout) :: p !< ModLin parameters type(ML_MiscVarType), intent(inout) :: m !< ModLin MiscVars type(FAST_ParameterType), intent(in) :: p_FAST @@ -470,7 +472,7 @@ subroutine ModLin_Linearize_OP(Turbine, ModGlue, Mods, p, m, p_FAST, m_FAST, y_F ! Linearize mesh mappings to popoulate dUdy and dUdu ModGlue%Lin%dUdy = 0.0_R8Ki call Eye2D(ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_LinearizeMappings(Turbine, Mods, m%Mappings, p%iMod, ErrStat2, ErrMsg2, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy) + call FAST_LinearizeMappings(Turbine, Mods, m%Mappings, p%iMod, p%IdxLin, ErrStat2, ErrMsg2, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy) if (Failed()) return ! Calculate the glue code state matrices (A, B, C, D) @@ -513,25 +515,21 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) ! D = dYdu ! Create copies of dUdu and dUdy for calculating matrices - call AllocAry(dUdu, size(ModGlue%Lin%dUdu, 1), size(ModGlue%Lin%dUdu, 2), 'dUdu', ErrStat2, ErrMsg2) - call AllocAry(dUdy, size(ModGlue%Lin%dUdy, 1), size(ModGlue%Lin%dUdy, 2), 'dUdy', ErrStat2, ErrMsg2) + call AllocAry(dUdu, size(ModGlue%Lin%dUdu, 1), size(ModGlue%Lin%dUdu, 2), 'dUdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dUdy, size(ModGlue%Lin%dUdy, 1), size(ModGlue%Lin%dUdy, 2), 'dUdy', ErrStat2, ErrMsg2); if (Failed()) return dUdu = ModGlue%Lin%dUdu dUdy = ModGlue%Lin%dUdy ! *** get G matrix **** !---------------------- if (.not. allocated(G)) then - call AllocAry(G, size(dUdu, 1), size(dUdu, 2), 'G', ErrStat2, ErrMsg2) - if (Failed()) return - - call AllocAry(ipiv, ModGlue%Vars%Nu, 'ipiv', ErrStat2, ErrMsg2) - if (Failed()) return + call AllocAry(G, size(dUdu, 1), size(dUdu, 2), 'G', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ipiv, ModGlue%Vars%Nu, 'ipiv', ErrStat2, ErrMsg2); if (Failed()) return end if - !G = dUdu + matmul( dUdy, y_FAST%Lin%Glue%D ) + !G = dUdu + matmul(dUdy, y_FAST%Lin%Glue%D) G = dUdu - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, dUdy, ModGlue%Lin%dYdu, 1.0_R8Ki, G, ErrStat2, ErrMsg2) - if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, dUdy, ModGlue%Lin%dYdu, 1.0_R8Ki, G, ErrStat2, ErrMsg2); if (Failed()) return ! G can be ill-conditioned, so we are going to precondition with G_hat = S^(-1) * G * S ! we will also multiply the right-hand-side of the equations that need G inverse so that @@ -540,16 +538,13 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) ! Form G_hat^(-1) * (S^-1*dUdy) and G^(-1) * (S^-1*dUdu) ! factor G for the two solves: - call LAPACK_getrf(M=size(G, 1), N=size(G, 2), A=G, IPIV=ipiv, ErrStat=ErrStat2, ErrMsg=ErrMsg2) - if (Failed()) return + call LAPACK_getrf(M=size(G, 1), N=size(G, 2), A=G, IPIV=ipiv, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! after the this solve, dUdy holds G_hat^(-1) * dUdy_hat: - call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! after the this solve, dUdu holds G_hat^(-1) * dUdu_hat: - call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Deallocate G and ipiv because the solves are complete deallocate (G) @@ -559,36 +554,28 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) call Postcondition(ModGlue%Vars%u, dUdu, dUdy, JacScaleFactor) ! Allocate tmp matrix for A and C calculations - call AllocAry(tmp, ModGlue%Vars%Nu, ModGlue%Vars%Nx, 'G^-1*dUdy*C', ErrStat2, ErrMsg2) - if (Failed()) return + call AllocAry(tmp, ModGlue%Vars%Nu, ModGlue%Vars%Nx, 'G^-1*dUdy*C', ErrStat2, ErrMsg2); if (Failed()) return ! tmp = G^(-1) * dUdy * diag(C) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, dUdy, ModGlue%Lin%dYdx, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2) - if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, dUdy, ModGlue%Lin%dYdx, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2); if (Failed()) return ! A - ! dXdx = dXdx - matmul( dXdu, tmp ) - call LAPACK_GEMM('N', 'N', -1.0_R8Ki, ModGlue%Lin%dXdu, tmp, 1.0_R8Ki, ModGlue%Lin%dXdx, ErrStat2, ErrMsg2) - if (Failed()) return + ! dXdx = dXdx - matmul(dXdu, tmp) + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, ModGlue%Lin%dXdu, tmp, 1.0_R8Ki, ModGlue%Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return ! C - ! dYdx = dYdx - matmul( dYdu, tmp ) - call LAPACK_GEMM('N', 'N', -1.0_R8Ki, ModGlue%Lin%dYdu, tmp, 1.0_R8Ki, ModGlue%Lin%dYdx, ErrStat2, ErrMsg2) - if (Failed()) return + ! dYdx = dYdx - matmul(dYdu, tmp) + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, ModGlue%Lin%dYdu, tmp, 1.0_R8Ki, ModGlue%Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return ! B - if (Failed()) return tmp = ModGlue%Lin%dXdu - ! dXdu = matmul( dXdu, dUdu ) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, ModGlue%Lin%dXdu, ErrStat2, ErrMsg2) - if (Failed()) return + ! dXdu = matmul(dXdu, dUdu) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, ModGlue%Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return ! D - if (Failed()) return tmp = ModGlue%Lin%dYdu - ! D = matmul( dYdu, dUdu ) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, ModGlue%Lin%dYdu, ErrStat2, ErrMsg2) - if (Failed()) return + ! D = matmul(dYdu, dUdu) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, ModGlue%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return contains logical function Failed() @@ -793,7 +780,7 @@ subroutine WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutF yUse = .false. do i = 1, size(ModData%Vars%y) associate (Var => ModData%Vars%y(i)) - if (MV_HasFlags(Var, VF_Linearize)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. + if (MV_HasFlags(Var, VF_Linearize)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do @@ -939,150 +926,261 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer end subroutine WrLinFile_txt_Table -subroutine MV_InitModuleVarIdx(ModData, VarIdx, FlagFilter, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData - type(VarsIdxType), intent(out) :: VarIdx +subroutine Idx_Init(Mods, ModOrder, Idx, FlagFilter, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) + integer(IntKi), intent(in) :: ModOrder(:) + type(VarsIdxType), intent(out) :: Idx integer(IntKi), intent(in) :: FlagFilter integer(IntKi), intent(out) :: ErrStat character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'MV_InitModuleVarIdx' + character(*), parameter :: RoutineName = 'Idx_Init' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: xNumVar, xdNumVar, zNumVar, uNumVar, yNumVar - integer(IntKi) :: IndCol + integer(IntKi) :: NumVars + integer(IntKi) :: iGbl(2) + integer(IntKi) :: i, j ! Initialize error return ErrStat = ErrID_None ErrMsg = "" ! Destroy VarIdx in case it has been previously used - call FAST_DestroyVarsIdxType(VarIdx, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_DestroyVarsIdxType(Idx, ErrStat2, ErrMsg2); if (Failed()) return ! Save filter in index - VarIdx%FlagFilter = FlagFilter + Idx%FlagFilter = FlagFilter - ! Populate variable index arrays - call GetModVarLocs(ModData%Idx, ModData%Vars%x, VarIdx%ix, VarIdx%Nx, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return - call GetModVarLocs(ModData%Idx, ModData%Vars%xd, VarIdx%ixd, VarIdx%Nxd, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return - call GetModVarLocs(ModData%Idx, ModData%Vars%z, VarIdx%iz, VarIdx%Nz, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return - call GetModVarLocs(ModData%Idx, ModData%Vars%u, VarIdx%iu, VarIdx%Nu, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return - call GetModVarLocs(ModData%Idx, ModData%Vars%y, VarIdx%iy, VarIdx%Ny, FlagFilter, ErrStat2, ErrMsg2); if (Failed()) return + !---------------------------------------------------------------------------- + ! Indexing Data Description + !---------------------------------------------------------------------------- -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine + ! For each variable (x, u, y, etc.) there are two arrays: + ! 1) Variable local and global value indices (ValLocGbl) + ! 2) Module variable start index (ModVarStart) + ! ValLocGbl has 4 rows and N columns where N is the total number of variables + ! for all modules in Mods. The columns are as follows: + ! 1) Values start index inside module arrays/matrices (iLoc(1)) + ! 2) Values end index inside module arrays/matrices (iLoc(2)) + ! 3) Values start index in global arrays/matrices (iGbl(1)) + ! 4) Values end index in global arrays/matrices (iLoc(2)) + ! ModVarStart contains N rows where N is the total number of modules in Mods. + ! The values in this array contain the variable start index offset for each + ! module into ValLocGbl so value indices can be looked up given module index + ! and variable index. Keeping all value indices in one matrix makes data + ! storage much simpler at the cost of of having to maintain the array of + ! module offsets. -subroutine MV_InitGlueVarIdx(Mods, ModOrder, VarIdx, FlagFilter, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mods(:) - integer(IntKi), intent(in) :: ModOrder(:) - type(VarsIdxType), intent(out) :: VarIdx - integer(IntKi), intent(in) :: FlagFilter - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg + !---------------------------------------------------------------------------- + ! Build index for continuous state variables + !---------------------------------------------------------------------------- - character(*), parameter :: RoutineName = 'MV_InitVarIdx' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(ModDataType) :: ModData - integer(IntKi) :: ivar, inum + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%x%ModVarStart, size(Mods) + 1, "VarIdx%x%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%x%ModVarStart(1) = 0 -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine + ! Populate ModVarStart with variable offsets and calculate total number of variables + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%x) + Idx%x%ModVarStart(i + 1) = NumVars + end do -subroutine GetModVarLocs(ModIdx, VarAry, Idx, NumVals, FlagFilter, ErrStat, ErrMsg) - integer(IntKi), intent(in) :: ModIdx - type(ModVarType), intent(in) :: VarAry(:) - type(VarIdxType), allocatable, intent(inout) :: Idx(:) - integer(IntKi), intent(inout) :: NumVals - integer(IntKi), intent(in) :: FlagFilter - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'GetModIdx' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, j, iGbl(2), NumVarsOld, NumVarsNew - type(VarIdxType), allocatable :: IdxTmp(:) + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%x%ValLocGbl, 4, NumVars, "VarIdx%x%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%x%ValLocGbl = 0 - ErrStat = ErrID_None - ErrMsg = '' + ! Initialize global index to zero + iGbl = 0 - ! Calculate number of vars to keep in VarAry - NumVarsNew = 0 - do i = 1, size(VarAry) - if (MV_HasFlags(VarAry(i), FlagFilter)) NumVarsNew = NumVarsNew + 1 + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%x) + if (MV_HasFlags(ModData%Vars%x(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%x(j)%Num - 1 + Idx%x%ValLocGbl(:, Idx%x%ModVarStart(ModData%Idx) + j) = [ModData%Vars%x(j)%iLoc, iGbl] + end if + end do + end associate end do - ! If variable locations array currently has data - if (allocated(Idx)) then + ! Save total number of values + Idx%Nx = iGbl(2) - ! Get number of variables currently in index - NumVarsOld = size(Idx) + !---------------------------------------------------------------------------- + ! Build index for discrete state variables + !---------------------------------------------------------------------------- - ! Move Idx allocation to temporary so new array can be allocated with correct size - call move_alloc(Idx, IdxTmp) + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%xd%ModVarStart, size(Mods) + 1, "VarIdx%xd%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%xd%ModVarStart(1) = 0 - ! Allocate new array to store previous and new variable data - allocate(Idx(NumVarsOld + NumVarsNew), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Unable to allocate index", ErrStat, ErrMsg, RoutineName) - return - end if + ! Populate ModVarStart with variable offsets and calculate total number of variables and values + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%xd) + Idx%xd%ModVarStart(i + 1) = NumVars + end do - ! Move old variables to new array - Idx(1:NumVarsOld) = IdxTmp + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%xd%ValLocGbl, 4, NumVars, "VarIdx%xd%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%xd%ValLocGbl = 0 + + ! Initialize global index and number of values to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%xd) + if (MV_HasFlags(ModData%Vars%xd(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%xd(j)%Num - 1 + Idx%xd%ValLocGbl(:, Idx%xd%ModVarStart(ModData%Idx) + j) = [ModData%Vars%xd(j)%iLoc, iGbl] + end if + end do + end associate + end do - ! Deallocate temporary array - deallocate(IdxTmp) + ! Save total number of values + Idx%Nxd = iGbl(2) - else + !---------------------------------------------------------------------------- + ! Build index for constraint state variables + !---------------------------------------------------------------------------- - ! No old variables - NumVarsOld = 0 + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%z%ModVarStart, size(Mods) + 1, "VarIdx%z%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%z%ModVarStart(1) = 0 - ! Initialize number of values - NumVals = 0 + ! Populate ModVarStart with variable offsets and calculate total number of variables + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%z) + Idx%z%ModVarStart(i + 1) = NumVars + end do - ! Allocate new array to store previous and new variable data - allocate(Idx(NumVarsNew), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Unable to allocate index", ErrStat, ErrMsg, RoutineName) - return - end if + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%z%ValLocGbl, 4, NumVars, "VarIdx%z%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%z%ValLocGbl = 0 + + ! Initialize global index to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%z) + if (MV_HasFlags(ModData%Vars%z(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%z(j)%Num - 1 + Idx%z%ValLocGbl(:, Idx%z%ModVarStart(ModData%Idx) + j) = [ModData%Vars%z(j)%iLoc, iGbl] + end if + end do + end associate + end do - end if + ! Save total number of values + Idx%Nz = iGbl(2) - ! Determine starting index of variable in index array - if (NumVarsOld == 0) then - iGbl = 0 - else - iGbl = Idx(NumVarsOld)%iGbl - end if + !---------------------------------------------------------------------------- + ! Build index for input variables + !---------------------------------------------------------------------------- - ! Store variable index data in array - j = NumVarsOld - do i = 1, size(VarAry) - if (MV_HasFlags(VarAry(i), FlagFilter)) then - j = j + 1 - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + VarAry(i)%Num - 1 - Idx(j) = VarIdxType(ModIdx=ModIdx, iVar=i, iLoc=VarAry(i)%iLoc, iGbl=iGbl) - NumVals = NumVals + VarAry(i)%Num - end if + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%u%ModVarStart, size(Mods) + 1, "VarIdx%u%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%u%ModVarStart(1) = 0 + + ! Populate ModVarStart with variable offsets and calculate total number of variables + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%u) + Idx%u%ModVarStart(i + 1) = NumVars + end do + + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%u%ValLocGbl, 4, NumVars, "VarIdx%u%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%u%ValLocGbl = 0 + + ! Initialize global index to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%u) + if (MV_HasFlags(ModData%Vars%u(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%u(j)%Num - 1 + Idx%u%ValLocGbl(:, Idx%u%ModVarStart(ModData%Idx) + j) = [ModData%Vars%u(j)%iLoc, iGbl] + end if + end do + end associate + end do + + ! Save total number of values + Idx%Nu = iGbl(2) + + !---------------------------------------------------------------------------- + ! Build index for output variables + !---------------------------------------------------------------------------- + + ! Allocate array of module variable start indices for each module, init to 0 + call AllocAry(Idx%y%ModVarStart, size(Mods) + 1, "VarIdx%y%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return + Idx%y%ModVarStart(1) = 0 + + ! Populate ModVarStart with variable offsets and calculate total number of variables + NumVars = 0 + do i = 1, size(Mods) + NumVars = NumVars + size(Mods(i)%Vars%y) + Idx%y%ModVarStart(i + 1) = NumVars + end do + + ! Allocate variable value index matrix and initialize to zero + call AllocAry(Idx%y%ValLocGbl, 4, NumVars, "VarIdx%y%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return + Idx%y%ValLocGbl = 0 + + ! Initialize global index to zero + iGbl = 0 + + ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices + do i = 1, size(ModOrder) + associate (ModData => Mods(ModOrder(i))) + do j = 1, size(ModData%Vars%y) + if (MV_HasFlags(ModData%Vars%y(j), FlagFilter)) then + iGbl(1) = iGbl(2) + 1 + iGbl(2) = iGbl(1) + ModData%Vars%y(j)%Num - 1 + Idx%y%ValLocGbl(:, Idx%y%ModVarStart(ModData%Idx) + j) = [ModData%Vars%y(j)%iLoc, iGbl] + end if + end do + end associate end do + ! Save total number of values + Idx%Ny = iGbl(2) + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function end subroutine -subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) - type(ModDataType), allocatable, intent(inout) :: ModAry(:) +logical function Idx_GetLocGbl(Idx, ModIdx, VarIdx, iLoc, iGbl) + type(VarIdxType), intent(in) :: Idx + integer(IntKi), intent(in) :: ModIdx, VarIdx + integer(IntKi), intent(out) :: iLoc(2), iGbl(2) + integer(IntKi) :: iLocGbl(4) + iLocGbl = Idx%ValLocGbl(:, Idx%ModVarStart(ModIdx) + VarIdx) + iLoc = iLocGbl(1:2) + iGbl = iLocGbl(3:4) + Idx_GetLocGbl = iLocGbl(3) /= 0 ! Variable has global index +end function + +subroutine MV_AddModule(Mods, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: Mods(:) integer(IntKi), intent(in) :: ModID character(*), intent(in) :: ModAbbr integer(IntKi), intent(in) :: Instance @@ -1101,10 +1199,10 @@ subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrMsg = '' ! If module array hasn't been allocated, allocate with zero size - if (.not. allocated(ModAry)) allocate (ModAry(0)) + if (.not. allocated(Mods)) allocate (Mods(0)) ! Populate ModuleDataType derived type - ModData = ModDataType(Idx=size(ModAry) + 1, ID=ModID, Abbr=ModAbbr, & + ModData = ModDataType(Idx=size(Mods) + 1, ID=ModID, Abbr=ModAbbr, & Ins=Instance, DT=ModDT, Vars=Vars) ! Allocate source and destination mapping arrays @@ -1149,7 +1247,7 @@ subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ! Add module data to array !---------------------------------------------------------------------------- - ModAry = [ModAry, ModData] + Mods = [Mods, ModData] end subroutine diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 89507f4ef6..a2946775fe 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -142,25 +142,25 @@ typedef ^ ^ MeshType TmpMotionMesh - - - typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - typedef ^ ^ MeshMapType MeshMapAux - - - "Auxiliary mesh mapping for destination load meshes without sibling motion mesh" - -typedef ^ ^ IntKi iLocSrcTransDisp 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocSrcTransVel 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocSrcTransAcc 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocSrcOrientation 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocSrcAngularVel 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocSrcAngularAcc 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocSrcForce 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocSrcMoment 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocSrcDispTransDisp 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstTransDisp 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstTransVel 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstTransAcc 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstOrientation 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstAngularVel 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstAngularAcc 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstForce 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstMoment 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstDispTransDisp 2 - - "Data indices of linearized mesh mapping" -typedef ^ ^ IntKi iLocDstDispOrientation 2 - - "Data indices of linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcTransDisp - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcTransVel - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcTransAcc - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcOrientation - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcAngularVel - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcAngularAcc - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcForce - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcMoment - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcDispTransDisp - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstTransDisp - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstTransVel - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstTransAcc - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstOrientation - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstAngularVel - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstAngularAcc - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstForce - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstMoment - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstDispTransDisp - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstDispOrientation - - - "Var index for linearized mesh mapping" # Parameters typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - @@ -196,24 +196,6 @@ typedef ^ ^ IntKi iModOpt1US : - - typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - typedef ^ ^ IntKi iModPost : - - "ModData index order for post option 1 modules" - -# Variable indexing -typedef ^ VarIdxType IntKi ModIdx - - - "" - -typedef ^ ^ IntKi iVar - - - "" - -typedef ^ ^ IntKi iLoc 2 - - "" - -typedef ^ ^ IntKi iGbl 2 - - "" - - -typedef ^ VarsIdxType IntKi FlagFilter - - - "" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nxd - - - "" - -typedef ^ ^ IntKi Nz - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ^ VarIdxType ix : - - "" - -typedef ^ ^ VarIdxType ixd : - - "" - -typedef ^ ^ VarIdxType iz : - - "" - -typedef ^ ^ VarIdxType iu : - - "" - -typedef ^ ^ VarIdxType iy : - - "" - - typedef ^ ModLinTCType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - typedef ^ ^ R8Ki xd : - - "" - @@ -240,17 +222,29 @@ typedef ^ ^ IntKi Idx - 0 - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - typedef ^ ^ R8Ki DT - 0 - "Module time step" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ IntKi ixg - - - "starting index for continuous state values in global arrays" - -typedef ^ ^ IntKi ixdg - - - "starting index for discrete state values in global arrays" - -typedef ^ ^ IntKi izg - - - "starting index for constraint state values in global arrays" - -typedef ^ ^ IntKi iug - - - "starting index for input values in global arrays" - -typedef ^ ^ IntKi iyg - - - "starting index for output values in global arrays" - typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - typedef ^ ^ ModLinTCType Lin - - - "Module linearization data" - typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" +# Variable indexing +typedef ^ VarIdxType IntKi ModVarStart : - - "Variable start index from module index" - +typedef ^ ^ IntKi ValLocGbl :: - - "Variable local and global value indices" - +typedef ^ VarsIdxType IntKi FlagFilter - - - "" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nxd - - - "" - +typedef ^ ^ IntKi Nz - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ VarIdxType x - - - "" - +typedef ^ ^ VarIdxType xd - - - "" - +typedef ^ ^ VarIdxType z - - - "" - +typedef ^ ^ VarIdxType u - - - "" - +typedef ^ ^ VarIdxType y - - - "" - +typedef ^ ^ ModLinTCType Lin - - - "Linearization matrices" - + typedef ^ ML_ParameterType IntKi iMod : - - "ModData index order for linearization" - +typedef ^ ^ VarsIdxType IdxLin - - - "Variable index for linearization data" - typedef ^ ML_MiscVarType TC_MappingType Mappings : - - "Module mesh mapping" - typedef ^ ML_OutputType ModLinTCType Lin : - - "Module linearization type" - diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 64eeffc8e6..c9a7858e99 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -9364,7 +9364,7 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then - call ModLin_Linearize_OP(Turbine, Turbine%y_FAST%ModGlue, Turbine%y_FAST%Modules, & + call ModGlue_Linearize_OP(Turbine, Turbine%y_FAST%Modules, Turbine%y_FAST%ModGlue, & Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, Turbine%p_FAST, Turbine%m_FAST, & Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9420,7 +9420,7 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - call ModLin_Linearize_OP(Turbine, Turbine%y_FAST%ModGlue, Turbine%y_FAST%Modules, & + call ModGlue_Linearize_OP(Turbine, Turbine%y_FAST%Modules, Turbine%y_FAST%ModGlue, & Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, Turbine%p_FAST, Turbine%m_FAST, & Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 1bd432403c..947380149d 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -160,25 +160,25 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] TYPE(MeshMapType) :: MeshMapAux !< Auxiliary mesh mapping for destination load meshes without sibling motion mesh [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransVel = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcTransAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcOrientation = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcAngularVel = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcAngularAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcForce = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcMoment = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocSrcDispTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstTransVel = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstTransAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstOrientation = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstAngularVel = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstAngularAcc = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstForce = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstMoment = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstDispTransDisp = 0_IntKi !< Data indices of linearized mesh mapping [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLocDstDispOrientation = 0_IntKi !< Data indices of linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcTransVel = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcTransAcc = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcAngularVel = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcAngularAcc = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcForce = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcMoment = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcDispTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstTransVel = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstTransAcc = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstAngularVel = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstAngularAcc = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstForce = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstMoment = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstDispTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstDispOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] END TYPE TC_MappingType ! ======================= ! ========= TC_ParameterType ======= @@ -217,29 +217,6 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModPost !< ModData index order for post option 1 modules [-] END TYPE TC_ParameterType ! ======================= -! ========= VarIdxType ======= - TYPE, PUBLIC :: VarIdxType - INTEGER(IntKi) :: ModIdx = 0_IntKi !< [-] - INTEGER(IntKi) :: iVar = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iGbl = 0_IntKi !< [-] - END TYPE VarIdxType -! ======================= -! ========= VarsIdxType ======= - TYPE, PUBLIC :: VarsIdxType - INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] - INTEGER(IntKi) :: Nx = 0_IntKi !< [-] - INTEGER(IntKi) :: Nxd = 0_IntKi !< [-] - INTEGER(IntKi) :: Nz = 0_IntKi !< [-] - INTEGER(IntKi) :: Nu = 0_IntKi !< [-] - INTEGER(IntKi) :: Ny = 0_IntKi !< [-] - TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: ix !< [-] - TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: ixd !< [-] - TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: iz !< [-] - TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: iu !< [-] - TYPE(VarIdxType) , DIMENSION(:), ALLOCATABLE :: iy !< [-] - END TYPE VarsIdxType -! ======================= ! ========= ModLinTCType ======= TYPE, PUBLIC :: ModLinTCType REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] @@ -271,20 +248,38 @@ MODULE FAST_Types INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] REAL(R8Ki) :: DT = 0 !< Module time step [-] INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] - INTEGER(IntKi) :: ixg = 0_IntKi !< starting index for continuous state values in global arrays [-] - INTEGER(IntKi) :: ixdg = 0_IntKi !< starting index for discrete state values in global arrays [-] - INTEGER(IntKi) :: izg = 0_IntKi !< starting index for constraint state values in global arrays [-] - INTEGER(IntKi) :: iug = 0_IntKi !< starting index for input values in global arrays [-] - INTEGER(IntKi) :: iyg = 0_IntKi !< starting index for output values in global arrays [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] TYPE(ModLinTCType) :: Lin !< Module linearization data [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] END TYPE ModDataType ! ======================= +! ========= VarIdxType ======= + TYPE, PUBLIC :: VarIdxType + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ModVarStart !< Variable start index from module index [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ValLocGbl !< Variable local and global value indices [-] + END TYPE VarIdxType +! ======================= +! ========= VarsIdxType ======= + TYPE, PUBLIC :: VarsIdxType + INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nxd = 0_IntKi !< [-] + INTEGER(IntKi) :: Nz = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + TYPE(VarIdxType) :: x !< [-] + TYPE(VarIdxType) :: xd !< [-] + TYPE(VarIdxType) :: z !< [-] + TYPE(VarIdxType) :: u !< [-] + TYPE(VarIdxType) :: y !< [-] + TYPE(ModLinTCType) :: Lin !< Linearization matrices [-] + END TYPE VarsIdxType +! ======================= ! ========= ML_ParameterType ======= TYPE, PUBLIC :: ML_ParameterType INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] + TYPE(VarsIdxType) :: IdxLin !< Variable index for linearization data [-] END TYPE ML_ParameterType ! ======================= ! ========= ML_MiscVarType ======= @@ -1643,25 +1638,25 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, call NWTC_Library_CopyMeshMapType(SrcTC_MappingTypeData%MeshMapAux, DstTC_MappingTypeData%MeshMapAux, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstTC_MappingTypeData%iLocSrcTransDisp = SrcTC_MappingTypeData%iLocSrcTransDisp - DstTC_MappingTypeData%iLocSrcTransVel = SrcTC_MappingTypeData%iLocSrcTransVel - DstTC_MappingTypeData%iLocSrcTransAcc = SrcTC_MappingTypeData%iLocSrcTransAcc - DstTC_MappingTypeData%iLocSrcOrientation = SrcTC_MappingTypeData%iLocSrcOrientation - DstTC_MappingTypeData%iLocSrcAngularVel = SrcTC_MappingTypeData%iLocSrcAngularVel - DstTC_MappingTypeData%iLocSrcAngularAcc = SrcTC_MappingTypeData%iLocSrcAngularAcc - DstTC_MappingTypeData%iLocSrcForce = SrcTC_MappingTypeData%iLocSrcForce - DstTC_MappingTypeData%iLocSrcMoment = SrcTC_MappingTypeData%iLocSrcMoment - DstTC_MappingTypeData%iLocSrcDispTransDisp = SrcTC_MappingTypeData%iLocSrcDispTransDisp - DstTC_MappingTypeData%iLocDstTransDisp = SrcTC_MappingTypeData%iLocDstTransDisp - DstTC_MappingTypeData%iLocDstTransVel = SrcTC_MappingTypeData%iLocDstTransVel - DstTC_MappingTypeData%iLocDstTransAcc = SrcTC_MappingTypeData%iLocDstTransAcc - DstTC_MappingTypeData%iLocDstOrientation = SrcTC_MappingTypeData%iLocDstOrientation - DstTC_MappingTypeData%iLocDstAngularVel = SrcTC_MappingTypeData%iLocDstAngularVel - DstTC_MappingTypeData%iLocDstAngularAcc = SrcTC_MappingTypeData%iLocDstAngularAcc - DstTC_MappingTypeData%iLocDstForce = SrcTC_MappingTypeData%iLocDstForce - DstTC_MappingTypeData%iLocDstMoment = SrcTC_MappingTypeData%iLocDstMoment - DstTC_MappingTypeData%iLocDstDispTransDisp = SrcTC_MappingTypeData%iLocDstDispTransDisp - DstTC_MappingTypeData%iLocDstDispOrientation = SrcTC_MappingTypeData%iLocDstDispOrientation + DstTC_MappingTypeData%iVarSrcTransDisp = SrcTC_MappingTypeData%iVarSrcTransDisp + DstTC_MappingTypeData%iVarSrcTransVel = SrcTC_MappingTypeData%iVarSrcTransVel + DstTC_MappingTypeData%iVarSrcTransAcc = SrcTC_MappingTypeData%iVarSrcTransAcc + DstTC_MappingTypeData%iVarSrcOrientation = SrcTC_MappingTypeData%iVarSrcOrientation + DstTC_MappingTypeData%iVarSrcAngularVel = SrcTC_MappingTypeData%iVarSrcAngularVel + DstTC_MappingTypeData%iVarSrcAngularAcc = SrcTC_MappingTypeData%iVarSrcAngularAcc + DstTC_MappingTypeData%iVarSrcForce = SrcTC_MappingTypeData%iVarSrcForce + DstTC_MappingTypeData%iVarSrcMoment = SrcTC_MappingTypeData%iVarSrcMoment + DstTC_MappingTypeData%iVarSrcDispTransDisp = SrcTC_MappingTypeData%iVarSrcDispTransDisp + DstTC_MappingTypeData%iVarDstTransDisp = SrcTC_MappingTypeData%iVarDstTransDisp + DstTC_MappingTypeData%iVarDstTransVel = SrcTC_MappingTypeData%iVarDstTransVel + DstTC_MappingTypeData%iVarDstTransAcc = SrcTC_MappingTypeData%iVarDstTransAcc + DstTC_MappingTypeData%iVarDstOrientation = SrcTC_MappingTypeData%iVarDstOrientation + DstTC_MappingTypeData%iVarDstAngularVel = SrcTC_MappingTypeData%iVarDstAngularVel + DstTC_MappingTypeData%iVarDstAngularAcc = SrcTC_MappingTypeData%iVarDstAngularAcc + DstTC_MappingTypeData%iVarDstForce = SrcTC_MappingTypeData%iVarDstForce + DstTC_MappingTypeData%iVarDstMoment = SrcTC_MappingTypeData%iVarDstMoment + DstTC_MappingTypeData%iVarDstDispTransDisp = SrcTC_MappingTypeData%iVarDstDispTransDisp + DstTC_MappingTypeData%iVarDstDispOrientation = SrcTC_MappingTypeData%iVarDstDispOrientation end subroutine subroutine FAST_DestroyTC_MappingType(TC_MappingTypeData, ErrStat, ErrMsg) @@ -1726,25 +1721,25 @@ subroutine FAST_PackTC_MappingType(RF, Indata) call RegPackAlloc(RF, InData%TmpMatrix) call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) call NWTC_Library_PackMeshMapType(RF, InData%MeshMapAux) - call RegPack(RF, InData%iLocSrcTransDisp) - call RegPack(RF, InData%iLocSrcTransVel) - call RegPack(RF, InData%iLocSrcTransAcc) - call RegPack(RF, InData%iLocSrcOrientation) - call RegPack(RF, InData%iLocSrcAngularVel) - call RegPack(RF, InData%iLocSrcAngularAcc) - call RegPack(RF, InData%iLocSrcForce) - call RegPack(RF, InData%iLocSrcMoment) - call RegPack(RF, InData%iLocSrcDispTransDisp) - call RegPack(RF, InData%iLocDstTransDisp) - call RegPack(RF, InData%iLocDstTransVel) - call RegPack(RF, InData%iLocDstTransAcc) - call RegPack(RF, InData%iLocDstOrientation) - call RegPack(RF, InData%iLocDstAngularVel) - call RegPack(RF, InData%iLocDstAngularAcc) - call RegPack(RF, InData%iLocDstForce) - call RegPack(RF, InData%iLocDstMoment) - call RegPack(RF, InData%iLocDstDispTransDisp) - call RegPack(RF, InData%iLocDstDispOrientation) + call RegPack(RF, InData%iVarSrcTransDisp) + call RegPack(RF, InData%iVarSrcTransVel) + call RegPack(RF, InData%iVarSrcTransAcc) + call RegPack(RF, InData%iVarSrcOrientation) + call RegPack(RF, InData%iVarSrcAngularVel) + call RegPack(RF, InData%iVarSrcAngularAcc) + call RegPack(RF, InData%iVarSrcForce) + call RegPack(RF, InData%iVarSrcMoment) + call RegPack(RF, InData%iVarSrcDispTransDisp) + call RegPack(RF, InData%iVarDstTransDisp) + call RegPack(RF, InData%iVarDstTransVel) + call RegPack(RF, InData%iVarDstTransAcc) + call RegPack(RF, InData%iVarDstOrientation) + call RegPack(RF, InData%iVarDstAngularVel) + call RegPack(RF, InData%iVarDstAngularAcc) + call RegPack(RF, InData%iVarDstForce) + call RegPack(RF, InData%iVarDstMoment) + call RegPack(RF, InData%iVarDstDispTransDisp) + call RegPack(RF, InData%iVarDstDispOrientation) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1783,25 +1778,25 @@ subroutine FAST_UnPackTC_MappingType(RF, OutData) call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMapAux) ! MeshMapAux - call RegUnpack(RF, OutData%iLocSrcTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocSrcTransVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocSrcTransAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocSrcOrientation); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocSrcAngularVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocSrcAngularAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocSrcForce); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocSrcMoment); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocSrcDispTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstTransVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstTransAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstOrientation); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstAngularVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstAngularAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstForce); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstMoment); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstDispTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLocDstDispOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcTransVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcTransAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcAngularVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcAngularAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcDispTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstTransVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstTransAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstAngularVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstAngularAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstDispTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstDispOrientation); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -2066,355 +2061,6 @@ subroutine FAST_UnPackTC_ParameterType(RF, OutData) call RegUnpackAlloc(RF, OutData%iModPost); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_CopyVarIdxType(SrcVarIdxTypeData, DstVarIdxTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarIdxType), intent(in) :: SrcVarIdxTypeData - type(VarIdxType), intent(inout) :: DstVarIdxTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_CopyVarIdxType' - ErrStat = ErrID_None - ErrMsg = '' - DstVarIdxTypeData%ModIdx = SrcVarIdxTypeData%ModIdx - DstVarIdxTypeData%iVar = SrcVarIdxTypeData%iVar - DstVarIdxTypeData%iLoc = SrcVarIdxTypeData%iLoc - DstVarIdxTypeData%iGbl = SrcVarIdxTypeData%iGbl -end subroutine - -subroutine FAST_DestroyVarIdxType(VarIdxTypeData, ErrStat, ErrMsg) - type(VarIdxType), intent(inout) :: VarIdxTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_DestroyVarIdxType' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine FAST_PackVarIdxType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(VarIdxType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackVarIdxType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%ModIdx) - call RegPack(RF, InData%iVar) - call RegPack(RF, InData%iLoc) - call RegPack(RF, InData%iGbl) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackVarIdxType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(VarIdxType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackVarIdxType' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%ModIdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iGbl); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarsIdxType), intent(in) :: SrcVarsIdxTypeData - type(VarsIdxType), intent(inout) :: DstVarsIdxTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyVarsIdxType' - ErrStat = ErrID_None - ErrMsg = '' - DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter - DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx - DstVarsIdxTypeData%Nxd = SrcVarsIdxTypeData%Nxd - DstVarsIdxTypeData%Nz = SrcVarsIdxTypeData%Nz - DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu - DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny - if (allocated(SrcVarsIdxTypeData%ix)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%ix, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%ix, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%ix)) then - allocate(DstVarsIdxTypeData%ix(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%ix.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%ix(i1), DstVarsIdxTypeData%ix(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcVarsIdxTypeData%ixd)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%ixd, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%ixd, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%ixd)) then - allocate(DstVarsIdxTypeData%ixd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%ixd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%ixd(i1), DstVarsIdxTypeData%ixd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcVarsIdxTypeData%iz)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%iz, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%iz, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%iz)) then - allocate(DstVarsIdxTypeData%iz(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%iz(i1), DstVarsIdxTypeData%iz(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcVarsIdxTypeData%iu)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%iu, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%iu, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%iu)) then - allocate(DstVarsIdxTypeData%iu(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%iu(i1), DstVarsIdxTypeData%iu(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcVarsIdxTypeData%iy)) then - LB(1:1) = lbound(SrcVarsIdxTypeData%iy, kind=B8Ki) - UB(1:1) = ubound(SrcVarsIdxTypeData%iy, kind=B8Ki) - if (.not. allocated(DstVarsIdxTypeData%iy)) then - allocate(DstVarsIdxTypeData%iy(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarsIdxTypeData%iy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%iy(i1), DstVarsIdxTypeData%iy(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if -end subroutine - -subroutine FAST_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) - type(VarsIdxType), intent(inout) :: VarsIdxTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyVarsIdxType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(VarsIdxTypeData%ix)) then - LB(1:1) = lbound(VarsIdxTypeData%ix, kind=B8Ki) - UB(1:1) = ubound(VarsIdxTypeData%ix, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyVarIdxType(VarsIdxTypeData%ix(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(VarsIdxTypeData%ix) - end if - if (allocated(VarsIdxTypeData%ixd)) then - LB(1:1) = lbound(VarsIdxTypeData%ixd, kind=B8Ki) - UB(1:1) = ubound(VarsIdxTypeData%ixd, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyVarIdxType(VarsIdxTypeData%ixd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(VarsIdxTypeData%ixd) - end if - if (allocated(VarsIdxTypeData%iz)) then - LB(1:1) = lbound(VarsIdxTypeData%iz, kind=B8Ki) - UB(1:1) = ubound(VarsIdxTypeData%iz, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyVarIdxType(VarsIdxTypeData%iz(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(VarsIdxTypeData%iz) - end if - if (allocated(VarsIdxTypeData%iu)) then - LB(1:1) = lbound(VarsIdxTypeData%iu, kind=B8Ki) - UB(1:1) = ubound(VarsIdxTypeData%iu, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyVarIdxType(VarsIdxTypeData%iu(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(VarsIdxTypeData%iu) - end if - if (allocated(VarsIdxTypeData%iy)) then - LB(1:1) = lbound(VarsIdxTypeData%iy, kind=B8Ki) - UB(1:1) = ubound(VarsIdxTypeData%iy, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyVarIdxType(VarsIdxTypeData%iy(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(VarsIdxTypeData%iy) - end if -end subroutine - -subroutine FAST_PackVarsIdxType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(VarsIdxType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackVarsIdxType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%FlagFilter) - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nxd) - call RegPack(RF, InData%Nz) - call RegPack(RF, InData%Nu) - call RegPack(RF, InData%Ny) - call RegPack(RF, allocated(InData%ix)) - if (allocated(InData%ix)) then - call RegPackBounds(RF, 1, lbound(InData%ix, kind=B8Ki), ubound(InData%ix, kind=B8Ki)) - LB(1:1) = lbound(InData%ix, kind=B8Ki) - UB(1:1) = ubound(InData%ix, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackVarIdxType(RF, InData%ix(i1)) - end do - end if - call RegPack(RF, allocated(InData%ixd)) - if (allocated(InData%ixd)) then - call RegPackBounds(RF, 1, lbound(InData%ixd, kind=B8Ki), ubound(InData%ixd, kind=B8Ki)) - LB(1:1) = lbound(InData%ixd, kind=B8Ki) - UB(1:1) = ubound(InData%ixd, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackVarIdxType(RF, InData%ixd(i1)) - end do - end if - call RegPack(RF, allocated(InData%iz)) - if (allocated(InData%iz)) then - call RegPackBounds(RF, 1, lbound(InData%iz, kind=B8Ki), ubound(InData%iz, kind=B8Ki)) - LB(1:1) = lbound(InData%iz, kind=B8Ki) - UB(1:1) = ubound(InData%iz, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackVarIdxType(RF, InData%iz(i1)) - end do - end if - call RegPack(RF, allocated(InData%iu)) - if (allocated(InData%iu)) then - call RegPackBounds(RF, 1, lbound(InData%iu, kind=B8Ki), ubound(InData%iu, kind=B8Ki)) - LB(1:1) = lbound(InData%iu, kind=B8Ki) - UB(1:1) = ubound(InData%iu, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackVarIdxType(RF, InData%iu(i1)) - end do - end if - call RegPack(RF, allocated(InData%iy)) - if (allocated(InData%iy)) then - call RegPackBounds(RF, 1, lbound(InData%iy, kind=B8Ki), ubound(InData%iy, kind=B8Ki)) - LB(1:1) = lbound(InData%iy, kind=B8Ki) - UB(1:1) = ubound(InData%iy, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackVarIdxType(RF, InData%iy(i1)) - end do - end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackVarsIdxType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(VarsIdxType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackVarsIdxType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%ix)) deallocate(OutData%ix) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%ix(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ix.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackVarIdxType(RF, OutData%ix(i1)) ! ix - end do - end if - if (allocated(OutData%ixd)) deallocate(OutData%ixd) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%ixd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ixd.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackVarIdxType(RF, OutData%ixd(i1)) ! ixd - end do - end if - if (allocated(OutData%iz)) deallocate(OutData%iz) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%iz(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iz.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackVarIdxType(RF, OutData%iz(i1)) ! iz - end do - end if - if (allocated(OutData%iu)) deallocate(OutData%iu) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%iu(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iu.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackVarIdxType(RF, OutData%iu(i1)) ! iu - end do - end if - if (allocated(OutData%iy)) deallocate(OutData%iy) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%iy(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iy.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackVarIdxType(RF, OutData%iy(i1)) ! iy - end do - end if -end subroutine - subroutine FAST_CopyModLinTCType(SrcModLinTCTypeData, DstModLinTCTypeData, CtrlCode, ErrStat, ErrMsg) type(ModLinTCType), intent(in) :: SrcModLinTCTypeData type(ModLinTCType), intent(inout) :: DstModLinTCTypeData @@ -2796,11 +2442,6 @@ subroutine FAST_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode DstModDataTypeData%Ins = SrcModDataTypeData%Ins DstModDataTypeData%DT = SrcModDataTypeData%DT DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps - DstModDataTypeData%ixg = SrcModDataTypeData%ixg - DstModDataTypeData%ixdg = SrcModDataTypeData%ixdg - DstModDataTypeData%izg = SrcModDataTypeData%izg - DstModDataTypeData%iug = SrcModDataTypeData%iug - DstModDataTypeData%iyg = SrcModDataTypeData%iyg DstModDataTypeData%Vars => SrcModDataTypeData%Vars call FAST_CopyModLinTCType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2863,11 +2504,6 @@ subroutine FAST_PackModDataType(RF, Indata) call RegPack(RF, InData%Ins) call RegPack(RF, InData%DT) call RegPack(RF, InData%SubSteps) - call RegPack(RF, InData%ixg) - call RegPack(RF, InData%ixdg) - call RegPack(RF, InData%izg) - call RegPack(RF, InData%iug) - call RegPack(RF, InData%iyg) call RegPack(RF, associated(InData%Vars)) if (associated(InData%Vars)) then call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) @@ -2897,11 +2533,6 @@ subroutine FAST_UnPackModDataType(RF, OutData) call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ixg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ixdg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%izg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iug); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iyg); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -2925,6 +2556,179 @@ subroutine FAST_UnPackModDataType(RF, OutData) call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine FAST_CopyVarIdxType(SrcVarIdxTypeData, DstVarIdxTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarIdxType), intent(in) :: SrcVarIdxTypeData + type(VarIdxType), intent(inout) :: DstVarIdxTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyVarIdxType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcVarIdxTypeData%ModVarStart)) then + LB(1:1) = lbound(SrcVarIdxTypeData%ModVarStart, kind=B8Ki) + UB(1:1) = ubound(SrcVarIdxTypeData%ModVarStart, kind=B8Ki) + if (.not. allocated(DstVarIdxTypeData%ModVarStart)) then + allocate(DstVarIdxTypeData%ModVarStart(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarIdxTypeData%ModVarStart.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarIdxTypeData%ModVarStart = SrcVarIdxTypeData%ModVarStart + end if + if (allocated(SrcVarIdxTypeData%ValLocGbl)) then + LB(1:2) = lbound(SrcVarIdxTypeData%ValLocGbl, kind=B8Ki) + UB(1:2) = ubound(SrcVarIdxTypeData%ValLocGbl, kind=B8Ki) + if (.not. allocated(DstVarIdxTypeData%ValLocGbl)) then + allocate(DstVarIdxTypeData%ValLocGbl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarIdxTypeData%ValLocGbl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarIdxTypeData%ValLocGbl = SrcVarIdxTypeData%ValLocGbl + end if +end subroutine + +subroutine FAST_DestroyVarIdxType(VarIdxTypeData, ErrStat, ErrMsg) + type(VarIdxType), intent(inout) :: VarIdxTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyVarIdxType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VarIdxTypeData%ModVarStart)) then + deallocate(VarIdxTypeData%ModVarStart) + end if + if (allocated(VarIdxTypeData%ValLocGbl)) then + deallocate(VarIdxTypeData%ValLocGbl) + end if +end subroutine + +subroutine FAST_PackVarIdxType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarIdxType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVarIdxType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%ModVarStart) + call RegPackAlloc(RF, InData%ValLocGbl) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVarIdxType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarIdxType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVarIdxType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%ModVarStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ValLocGbl); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarsIdxType), intent(in) :: SrcVarsIdxTypeData + type(VarsIdxType), intent(inout) :: DstVarsIdxTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyVarsIdxType' + ErrStat = ErrID_None + ErrMsg = '' + DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter + DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx + DstVarsIdxTypeData%Nxd = SrcVarsIdxTypeData%Nxd + DstVarsIdxTypeData%Nz = SrcVarsIdxTypeData%Nz + DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu + DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%x, DstVarsIdxTypeData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%xd, DstVarsIdxTypeData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%z, DstVarsIdxTypeData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%u, DstVarsIdxTypeData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyVarIdxType(SrcVarsIdxTypeData%y, DstVarsIdxTypeData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyModLinTCType(SrcVarsIdxTypeData%Lin, DstVarsIdxTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) + type(VarsIdxType), intent(inout) :: VarsIdxTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyVarsIdxType' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_DestroyVarIdxType(VarsIdxTypeData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyVarIdxType(VarsIdxTypeData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyVarIdxType(VarsIdxTypeData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyVarIdxType(VarsIdxTypeData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyVarIdxType(VarsIdxTypeData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyModLinTCType(VarsIdxTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackVarsIdxType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarsIdxType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVarsIdxType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FlagFilter) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nxd) + call RegPack(RF, InData%Nz) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) + call FAST_PackVarIdxType(RF, InData%x) + call FAST_PackVarIdxType(RF, InData%xd) + call FAST_PackVarIdxType(RF, InData%z) + call FAST_PackVarIdxType(RF, InData%u) + call FAST_PackVarIdxType(RF, InData%y) + call FAST_PackModLinTCType(RF, InData%Lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVarsIdxType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarsIdxType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVarsIdxType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackVarIdxType(RF, OutData%x) ! x + call FAST_UnpackVarIdxType(RF, OutData%xd) ! xd + call FAST_UnpackVarIdxType(RF, OutData%z) ! z + call FAST_UnpackVarIdxType(RF, OutData%u) ! u + call FAST_UnpackVarIdxType(RF, OutData%y) ! y + call FAST_UnpackModLinTCType(RF, OutData%Lin) ! Lin +end subroutine + subroutine FAST_CopyML_ParameterType(SrcML_ParameterTypeData, DstML_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) type(ML_ParameterType), intent(in) :: SrcML_ParameterTypeData type(ML_ParameterType), intent(inout) :: DstML_ParameterTypeData @@ -2933,6 +2737,7 @@ subroutine FAST_CopyML_ParameterType(SrcML_ParameterTypeData, DstML_ParameterTyp character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyML_ParameterType' ErrStat = ErrID_None ErrMsg = '' @@ -2948,18 +2753,25 @@ subroutine FAST_CopyML_ParameterType(SrcML_ParameterTypeData, DstML_ParameterTyp end if DstML_ParameterTypeData%iMod = SrcML_ParameterTypeData%iMod end if + call FAST_CopyVarsIdxType(SrcML_ParameterTypeData%IdxLin, DstML_ParameterTypeData%IdxLin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine FAST_DestroyML_ParameterType(ML_ParameterTypeData, ErrStat, ErrMsg) type(ML_ParameterType), intent(inout) :: ML_ParameterTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyML_ParameterType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ML_ParameterTypeData%iMod)) then deallocate(ML_ParameterTypeData%iMod) end if + call FAST_DestroyVarsIdxType(ML_ParameterTypeData%IdxLin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackML_ParameterType(RF, Indata) @@ -2968,6 +2780,7 @@ subroutine FAST_PackML_ParameterType(RF, Indata) character(*), parameter :: RoutineName = 'FAST_PackML_ParameterType' if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%iMod) + call FAST_PackVarsIdxType(RF, InData%IdxLin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2980,6 +2793,7 @@ subroutine FAST_UnPackML_ParameterType(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackVarsIdxType(RF, OutData%IdxLin) ! IdxLin end subroutine subroutine FAST_CopyML_MiscVarType(SrcML_MiscVarTypeData, DstML_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) From 31f68dd46786606b7539f21e433685ec270d1cf7 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 17 May 2024 19:10:33 +0000 Subject: [PATCH 124/319] Switch to dev r-test branch --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index e9752a3d4b..c2c1f07c99 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit e9752a3d4b43cdf7b7dea7929702490947baed35 +Subproject commit c2c1f07c99eaeb4572c9a51579514302f3212a5b From a5dd7b3d615f2a8c0dd2a2c64a94604a835819f4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 17 May 2024 19:55:48 +0000 Subject: [PATCH 125/319] Add FAST_Idx.f90 to simulink/CMakeLists.txt --- glue-codes/simulink/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index 1c7dd7b68c..9840eed67a 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -61,6 +61,7 @@ matlab_add_mex( ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Funcs.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModGlue.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mapping.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Idx.f90 LINK_TO ${MEX_LIBS} ${MEX_LIBS} # DO NOT REMOVE (needed to ensure no unresolved symbols) From da4e4d8955b242fd6dca25f386773a6bb503d54f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 17 May 2024 19:57:55 +0000 Subject: [PATCH 126/319] Disable 5MW_Land_AeroMap test temporarily --- reg_tests/CTestList.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 769810a590..f778adbf27 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -316,7 +316,7 @@ of_regression("MHK_RM1_Floating" "openfast;elastodyn;aerod of_regression("Tailfin_FreeYaw1DOF_PolarBased" "openfast;elastodyn;aerodyn15") of_regression("Tailfin_FreeYaw1DOF_Unsteady" "openfast;elastodyn;aerodyn15") -of_aeromap_regression("5MW_Land_AeroMap" "aeromap;elastodyn;aerodyn15") +# of_aeromap_regression("5MW_Land_AeroMap" "aeromap;elastodyn;aerodyn15") # OpenFAST C++ API test if(BUILD_OPENFAST_CPP_API) From 8cf4a36593e17755cbe6ee4a2caf88c087c51ed5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 21 May 2024 22:32:33 +0000 Subject: [PATCH 127/319] Switch to quaternions from WM params in ModVar --- modules/nwtc-library/src/ModVar.f90 | 343 +++++++++++++++------------- 1 file changed, 189 insertions(+), 154 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 30be0bbb9c..26f62404a8 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -25,6 +25,7 @@ module ModVar use NWTC_Library_Types use NWTC_IO +use NWTC_Num use ModMesh implicit none @@ -34,7 +35,7 @@ module ModVar public :: MV_AddVar, MV_AddMeshVar public :: MV_HasFlags, MV_SetFlags, MV_UnsetFlags, MV_NumVars public :: LoadFields, MotionFields, TransFields, AngularFields -public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_rvec, wm_from_rvec +public :: quat_to_dcm, quat_compose, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm public :: MV_FieldString, IdxStr integer(IntKi), parameter :: & @@ -471,7 +472,7 @@ subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationDisp, .true.) case (VF_Orientation) do j = 1, VarAry(i)%Nodes - Values(iLoc(1) + 3*(j - 1):iLoc(1) + 3*j) = wm_from_dcm(Mesh%Orientation(:, :, j)) + Values(iLoc(1) + 3*(j - 1):iLoc(1) + 3*j) = dcm_to_quat(Mesh%Orientation(:, :, j)) end do case (VF_TransVel) Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationVel, .true.) @@ -508,7 +509,7 @@ subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) Mesh%TranslationDisp = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationDisp)) case (VF_Orientation) do j = 1, VarAry(i)%Nodes - Mesh%Orientation(:, :, j) = wm_to_dcm(Values(iLoc(1) + 3*(j - 1):iLoc(1) + 3*j)) + Mesh%Orientation(:, :, j) = quat_to_dcm(Values(iLoc(1) + 3*(j - 1):iLoc(1) + 3*j)) end do case (VF_TransVel) Mesh%TranslationVel = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationVel)) @@ -533,7 +534,7 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) real(R8Ki), intent(inout) :: PerturbAry(:) real(R8Ki) :: Perturb - real(R8Ki) :: WM(3), rotvec(3) + real(R8Ki) :: quat(3), quat_p(3), rotvec(3) integer(IntKi) :: i, j ! Copy base array to perturbed array @@ -545,16 +546,15 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) ! Index of perturbation value in array i = Var%iLoc(1) + iLin - 1 - ! If variable field is orientation, perturbation is in WM parameters + ! If variable field is orientation, perturbation is in radians if (Var%Field == VF_Orientation) then - j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) - rotvec = 0.0_R8Ki ! Init WM perturbation to zero - rotvec(j + 1) = Perturb ! WM perturbation around X,Y,Z axis - i = i - j ! index of start of WM parameters (3) - WM = PerturbAry(i:i + 2) ! Current WM parameters value - PerturbAry(i:i + 2) = wm_compose(wm_from_rvec(rotvec), WM) ! Compose value and perturbation + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + quat_p = perturb_quat(Perturb, j + 1) ! Quaternion of perturbed angle + i = i - j ! index of start of quaternion parameters (3) + quat = BaseAry(i:i + 2) ! Current quat parameters value + PerturbAry(i:i + 2) = quat_compose(quat_p, quat) ! Compose perturbation and current rotation else - PerturbAry(i) = PerturbAry(i) + Perturb ! Add perturbation + PerturbAry(i) = PerturbAry(i) + Perturb ! Add perturbation directly end if end subroutine @@ -565,7 +565,10 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) real(R8Ki), intent(in) :: NegAry(:) ! Negative result array real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference integer(IntKi) :: i, j, k - real(R8Ki) :: DeltaWM(3), R(3, 3), C1(3), C2(3) + real(R8Ki) :: delta(3), R(3, 3), quat_pos(3), quat_neg(3) + real(R8Ki) :: ang_pos(3), ang_neg(3) + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg ! Loop through variables do i = 1, size(VarAry) @@ -576,14 +579,31 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) ! Loop through nodes do j = 1, VarAry(i)%Nodes - ! Get vector of indicies of WM rotation parameters in array + ! Get vector of indices of rotation parameters in array k = VarAry(i)%iLoc(1) + 3*(j - 1) - ! Compose WM parameters to go from negative to positive array - DeltaWM = wm_compose((PosAry(k:k + 2)), wm_inv(NegAry(k:k + 2))) + ! Quaternions from negative and positive perturbations + quat_neg = NegAry(k:k + 2) + quat_pos = PosAry(k:k + 2) + + ! If variable has flag to use small angles when computing difference + if (MV_HasFlags(VarAry(i), VF_SmallAngle)) then + + ang_pos = GetSmllRotAngs(quat_to_dcm(quat_pos), ErrStat, ErrMsg) + ang_neg = GetSmllRotAngs(quat_to_dcm(quat_neg), ErrStat, ErrMsg) + + DiffAry(k:k + 2) = ang_pos - ang_neg + else + + ! Calculate relative rotation from negative to positive perturbation + delta = quat_compose(quat_pos, quat_inv(quat_neg)) + + ! Convert relative rotation from quaternion to rotation vector + DiffAry(k:k + 2) = GetSmllRotAngs(quat_to_dcm(delta), ErrStat, ErrMsg) + + ! DiffAry(k:k + 2) = quat_to_rvec(delta) + end if - ! Calculate change in rotation in XYZ in radians - DiffAry(k:k + 2) = wm_to_rvec(DeltaWM) end do else @@ -698,7 +718,7 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Pe Var = ModVarType(Name=Name, Field=Field) ! If number of values is zero, return - if (present(Num)) then + if (present(Num)) then if (Num == 0) return Var%Num = Num end if @@ -805,164 +825,179 @@ function IdxStr(i1, i2, i3, i4, i5) result(s) ! Rotation Utilities !------------------------------------------------------------------------------- -pure function quat_from_dcm(R) result(q) - real(R8Ki), intent(in) :: R(3, 3) - real(R8Ki) :: q(4), C - integer(IntKi) :: j - - q = [(1.0_R8Ki + R(1, 1) - R(2, 2) - R(3, 3)), & - (1.0_R8Ki - R(1, 1) + R(2, 2) - R(3, 3)), & - (1.0_R8Ki - R(1, 1) - R(2, 2) + R(3, 3)), & - (1.0_R8Ki + R(1, 1) + R(2, 2) + R(3, 3))] - - ! Get index of max value in q - j = maxloc(q, dim=1) - - ! Calculate quaternion from direction cosine matrix - C = q(j) - select case (j) +function perturb_quat(theta, idir) result(q) + real(R8Ki), intent(in) :: theta + integer(IntKi), intent(in) :: idir + real(R8Ki) :: rvec(3), q(3), dcm(3, 3) + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + select case (idir) case (1) - q = [C, (R(1, 2) + R(2, 1)), (R(3, 1) + R(1, 3)), (R(2, 3) - R(3, 2))] + ! q = rvec_to_quat([theta, 0.0_R8Ki, 0.0_R8Ki]) + call SmllRotTrans('linearization perturbation', theta, 0.0_R8Ki, 0.0_R8Ki, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + q = dcm_to_quat(dcm) case (2) - q = [(R(1, 2) + R(2, 1)), C, (R(2, 3) + R(3, 2)), (R(3, 1) - R(1, 3))] + ! q = rvec_to_quat([0.0_R8Ki, theta, 0.0_R8Ki]) + call SmllRotTrans('linearization perturbation', 0.0_R8Ki, theta, 0.0_R8Ki, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + q = dcm_to_quat(dcm) case (3) - q = [(R(3, 1) + R(1, 3)), (R(2, 3) + R(3, 2)), C, (R(1, 2) - R(2, 1))] - case (4) - q = [(R(2, 3) - R(3, 2)), (R(3, 1) - R(1, 3)), (R(1, 2) - R(2, 1)), C] + ! q = rvec_to_quat([0.0_R8Ki, 0.0_R8Ki, theta]) + call SmllRotTrans('linearization perturbation', 0.0_R8Ki, 0.0_R8Ki, theta, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + q = dcm_to_quat(dcm) end select - q = q/(2.0_R8Ki*sqrt(C)) - if (q(4) < 0.0_R8Ki) q = -q end function -pure function quat_to_dcm(q) result(R) - real(R8Ki), intent(in) :: q(4) - real(R8Ki) :: R(3, 3) - real(R8Ki) :: q1, q2, q3, q4 - q1 = q(1); q2 = q(2); q3 = q(3); q4 = q(4) - R(1, :) = [q4*q4 + q1*q1 - q2*q2 - q3*q3, 2*(q1*q2 + q3*q4), 2*(q1*q3 - q2*q4)] - R(2, :) = [2*(q1*q2 - q3*q4), q4*q4 - q1*q1 + q2*q2 - q3*q3, 2*(q2*q3 + q1*q4)] - R(3, :) = [2*(q1*q3 + q2*q4), 2*(q2*q3 - q1*q4), q4*q4 - q1*q1 - q2*q2 + q3*q3] +pure function quat_canonical(q0, q) result(qc) + real(R8Ki), intent(in) :: q0, q(3) + real(R8Ki) :: qc(3) + integer(IntKi) :: i + qc = q + if (q0 > 0.0_R8Ki) return + if (q0 < 0.0_R8Ki) then + qc = -q + return + end if + do i = 1, 3 + if (q(i) > 0.0_R8Ki) return + if (q(i) < 0.0_R8Ki) then + qc = -q + return + end if + end do end function -pure function wm_to_quat(c) result(q) - real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: q(4) - real(R8Ki) :: c0, e0, e(3) - c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki - e0 = c0/(4.0_R8Ki - c0) - e = c/(4.0_R8Ki - c0) - q = [e, e0] +pure function dcm_to_quat(dcm) result(q) + real(R8Ki), intent(in) :: dcm(3, 3) + real(R8Ki) :: q(3), R(3, 3), C, s, tr, q0 + + R = transpose(dcm) + + tr = R(1, 1) + R(2, 2) + R(3, 3) + + if (tr > 0.0_R8Ki) then + s = 0.5_R8Ki/sqrt(tr + 1.0_R8Ki) + q0 = 0.25_R8Ki/s + q(1) = (R(3, 2) - R(2, 3))*s + q(2) = (R(1, 3) - R(3, 1))*s + q(3) = (R(2, 1) - R(1, 2))*s + else if (R(1, 1) > R(2, 2) .and. R(1, 1) > R(3, 3)) then + s = 2.0_R8Ki*sqrt(1.0_R8Ki + R(1, 1) - R(2, 2) - R(3, 3)) + q0 = (R(3, 2) - R(2, 3))/s + q(1) = 0.25_R8Ki*s + q(2) = (R(1, 2) + R(2, 1))/s + q(3) = (R(1, 3) + R(3, 1))/s + elseif (R(2, 2) > R(3, 3)) then + s = 2.0_R8Ki*sqrt(1.0_R8Ki + R(2, 2) - R(1, 1) - R(3, 3)) + q0 = (R(1, 3) - R(3, 1))/s + q(1) = (R(1, 2) + R(2, 1))/s + q(2) = 0.25_R8Ki*s + q(3) = (R(2, 3) + R(3, 2))/s + else + s = 2.0_R8Ki*sqrt(1.0_R8Ki + R(3, 3) - R(1, 1) - R(2, 2)) + q0 = (R(2, 1) - R(1, 2))/s + q(1) = (R(1, 3) + R(3, 1))/s + q(2) = (R(2, 3) + R(3, 2))/s + q(3) = 0.25_R8Ki*s + end if + q = quat_canonical(q0, q) end function -pure function wm_from_quat(q) result(c) - real(R8Ki), intent(in) :: q(4) - real(R8Ki) :: c(3) - real(R8Ki) :: e0, e(3) - e0 = q(4) - e = q(1:3) - c = 4.0_R8Ki*e/(1.0_R8Ki + e0) +pure function quat_compose(q1, q2) result(q) + real(R8Ki), intent(in) :: q1(3), q2(3) + real(R8Ki) :: q(3), q0 + real(R8Ki) :: w1, x1, y1, z1 + real(R8Ki) :: w2, x2, y2, z2 + w1 = sqrt(1.0_R8Ki - dot_product(q1, q1)) + x1 = q1(1); y1 = q1(2); z1 = q1(3) + w2 = sqrt(1.0_R8Ki - dot_product(q2, q2)) + x2 = q2(1); y2 = q2(2); z2 = q2(3) + q0 = w1*w2 - x1*x2 - y1*y2 - z1*z2 + q(1) = w1*x2 + x1*w2 + y1*z2 - z1*y2 + q(2) = w1*y2 - x1*z2 + y1*w2 + z1*x2 + q(3) = w1*z2 + x1*y2 - y1*x2 + z1*w2 + q = quat_canonical(q0, q) end function -pure function wm_to_dcm(c) result(R) - real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: R(3, 3), c0, c1, c2, c3 - integer(IntKi) :: i, j - c1 = c(1) - c2 = c(2) - c3 = c(3) - c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki - R(:, 1) = [c0*c0 + c1*c1 - c2*c2 - c3*c3, & - 2.0_R8Ki*(c1*c2 - c0*c3), & - 2.0_R8Ki*(c1*c3 + c0*c2)] - R(:, 2) = [2.0_R8Ki*(c1*c2 + c0*c3), & - c0*c0 - c1*c1 + c2*c2 - c3*c3, & - 2.0_R8Ki*(c2*c3 - c0*c1)] - R(:, 3) = [2.0_R8Ki*(c1*c3 - c0*c2), & - 2.0_R8Ki*(c2*c3 + c0*c1), & - c0*c0 - c1*c1 - c2*c2 + c3*c3] - R = R/(4.0_R8Ki - c0)**2 +pure function quat_inv(q) result(qi) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: qi(3) + qi = -q end function -pure function wm_from_dcm(dcm) result(c) - real(R8Ki), intent(in) :: dcm(3, 3) - real(R8Ki) :: pivot(4) ! Trace of the rotation matrix and diagonal elements - real(R8Ki) :: sm(0:3) - real(R8Ki) :: em - real(R8Ki) :: Rr(3, 3), c(3) - integer :: i ! case indicator +pure function quat_to_rvec(q) result(rvec) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: q0, theta, tmp, rvec(3) + q0 = sqrt(1.0_R8Ki - dot_product(q, q)) + theta = 2.0_R8Ki*acos(q0) + tmp = sqrt(1.0_R8Ki - q0*q0) + if (tmp < epsilon(tmp)) then + rvec = 0.0_R8Ki + else + rvec(1) = theta*q(1)/tmp + rvec(2) = theta*q(2)/tmp + rvec(3) = theta*q(3)/tmp + end if +end function - Rr = transpose(dcm) +pure function rvec_to_quat(rvec) result(q) + real(R8Ki), intent(in) :: rvec(3) + real(R8Ki) :: theta, q0, q(3) + theta = sqrt(dot_product(rvec, rvec)) + q0 = cos(theta/2.0_R8Ki) + q = rvec/theta*sin(theta/2.0_R8Ki) + q = quat_canonical(q0, q) +end function - ! mjs--find max value of T := Tr(Rr) and diagonal elements of Rr - ! This tells us which denominator is largest (and less likely to produce numerical noise) - pivot = [Rr(1, 1) + Rr(2, 2) + Rr(3, 3), Rr(1, 1), Rr(2, 2), Rr(3, 3)] - i = maxloc(pivot, 1) - 1 ! our sm array starts at 0, so we need to subtract 1 here to get the correct index +pure function quat_to_dcm(q) result(dcm) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: dcm(3, 3) + real(R8Ki) :: q0, q0q0, q1q1, q2q2, q3q3 + real(R8Ki) :: q1q2, q2q3, q1q3, q0q1, q0q2, q0q3 - select case (i) - case (3) - sm(0) = Rr(2, 1) - Rr(1, 2) ! 4 c_0 c_3 t_{r0} - sm(1) = Rr(1, 3) + Rr(3, 1) ! 4 c_1 c_3 t_{r0} - sm(2) = Rr(2, 3) + Rr(3, 2) ! 4 c_2 c_3 t_{r0} - sm(3) = 1.0_R8Ki - Rr(1, 1) - Rr(2, 2) + Rr(3, 3) ! 4 c_3 c_3 t_{r0} - case (2) - sm(0) = Rr(1, 3) - Rr(3, 1) ! 4 c_0 c_2 t_{r0} - sm(1) = Rr(1, 2) + Rr(2, 1) ! 4 c_1 c_2 t_{r0} - sm(2) = 1.0_R8Ki - Rr(1, 1) + Rr(2, 2) - Rr(3, 3) ! 4 c_2 c_2 t_{r0} - sm(3) = Rr(2, 3) + Rr(3, 2) ! 4 c_3 c_2 t_{r0} - case (1) - sm(0) = Rr(3, 2) - Rr(2, 3) ! 4 c_0 c_1 t_{r0} - sm(1) = 1.0_R8Ki + Rr(1, 1) - Rr(2, 2) - Rr(3, 3) ! 4 c_1 c_1 t_{r0} - sm(2) = Rr(1, 2) + Rr(2, 1) ! 4 c_2 c_1 t_{r0} - sm(3) = Rr(1, 3) + Rr(3, 1) ! 4 c_3 c_1 t_{r0} - case (0) - sm(0) = 1.0_R8Ki + Rr(1, 1) + Rr(2, 2) + Rr(3, 3) ! 4 c_0 c_0 t_{r0} - sm(1) = Rr(3, 2) - Rr(2, 3) ! 4 c_1 c_0 t_{r0} - sm(2) = Rr(1, 3) - Rr(3, 1) ! 4 c_2 c_0 t_{r0} - sm(3) = Rr(2, 1) - Rr(1, 2) ! 4 c_3 c_0 t_{r0} - end select + ! q is assumed to be a unit quaternion + q0 = sqrt(1.0_R8Ki - dot_product(q, q)) - em = sm(0) + SIGN(2.0_R8Ki*SQRT(sm(i)), sm(0)) - em = 4.0_R8Ki/em ! 1 / ( 4 t_{r0} c_{i} ), assuming 0 <= c_0 < 4 and c_{i} > 0 - c = em*sm(1:3) -end function + q0q0 = q0*q0 + q1q1 = q(1)*q(1) + q2q2 = q(2)*q(2) + q3q3 = q(3)*q(3) -pure function wm_to_rvec(c) result(rvec) - real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: phi, m, rvec(3) - m = sqrt(dot_product(c, c)) - if (m == 0.0_R8Ki) then - rvec = 0.0_R8Ki - return - end if - phi = 4.0_R8Ki*atan(m/4.0_R8Ki) - rvec = phi*c/m + q1q2 = q(1)*q(2) + q2q3 = q(2)*q(3) + q1q3 = q(1)*q(3) + + q0q1 = q0*q(1) + q0q2 = q0*q(2) + q0q3 = q0*q(3) + + dcm(1, 1) = q0q0 + q1q1 - q2q2 - q3q3 + dcm(2, 1) = 2.0_R8Ki*(q1q2 - q0q3) + dcm(3, 1) = 2.0_R8Ki*(q1q3 + q0q2) + + dcm(1, 2) = 2.0_R8Ki*(q1q2 + q0q3) + dcm(2, 2) = q0q0 - q1q1 + q2q2 - q3q3 + dcm(3, 2) = 2.0_R8Ki*(q2q3 - q0q1) + + dcm(1, 3) = 2.0_R8Ki*(q1q3 - q0q2) + dcm(2, 3) = 2.0_R8Ki*(q2q3 + q0q1) + dcm(3, 3) = q0q0 - q1q1 - q2q2 + q3q3 end function -pure function wm_from_rvec(rvec) result(c) - real(R8Ki), intent(in) :: rvec(3) - real(R8Ki) :: phi, c(3) - phi = sqrt(dot_product(rvec, rvec)) - if (phi == 0.0_R8Ki) then - c = 0.0_R8Ki - return - end if - c = 4.0_R8Ki*tan(phi/4.0_R8Ki)*rvec/phi +pure function wm_to_quat(c) result(q) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: c0, q0, q(3) + c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + q0 = c0/(4.0_R8Ki - c0) + q = c/(4.0_R8Ki - c0) + q = quat_canonical(q0, q) end function -pure function wm_compose(p, q) result(r) - real(R8Ki), intent(in) :: p(3), q(3) - real(R8Ki) :: r(3) - real(R8Ki) :: p0, q0, D1, D2 - p0 = 2.0_R8Ki - dot_product(p, p)/8.0_R8Ki - q0 = 2.0_R8Ki - dot_product(q, q)/8.0_R8Ki - D1 = (4.0_R8Ki - p0)*(4.0_R8Ki - q0) - D2 = p0*q0 - dot_product(p, q) - r = 4.0_R8Ki*(q0*p + p0*q + cross(p, q)) - if (D2 >= 0.0_R8Ki) then - r = r/(D1 + D2) - else - r = -r/(D1 - D2) - end if +pure function quat_to_wm(q) result(c) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: c(3) + real(R8Ki) :: q0 + q0 = sqrt(1.0_R8Ki - dot_product(q, q)) + c = 4.0_R8Ki*q/(1.0_R8Ki + q0) end function pure function wm_inv(c) result(cinv) From bc3da89d159329c1e893e93694665762a5588d4d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 21 May 2024 22:33:15 +0000 Subject: [PATCH 128/319] Attempt to get linearization test cases to work again --- modules/beamdyn/src/BeamDyn.f90 | 67 ++++++++----- modules/elastodyn/src/ElastoDyn.f90 | 5 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 11 ++- .../src/Registry_NWTC_Library.txt | 24 ++--- .../src/Registry_NWTC_Library_base.txt | 25 ++--- modules/openfast-library/src/FAST_Funcs.f90 | 6 +- modules/openfast-library/src/FAST_Mapping.f90 | 57 ++++++----- modules/openfast-library/src/FAST_ModGlue.f90 | 94 +++++++++++-------- 8 files changed, 172 insertions(+), 117 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index da46f03c42..cf1e3f35b1 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -53,7 +53,7 @@ MODULE BeamDyn PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT - PUBLIC :: BD_PackStateOP, BD_UnpackStateOP + PUBLIC :: BD_PackContStateQuatOP, BD_UnpackContStateQuatOP PUBLIC :: BD_PackInputOP, BD_UnpackInputOP PUBLIC :: BD_PackOutputOP @@ -62,7 +62,7 @@ MODULE BeamDyn ! the development of the tight coupling algorithm for OpenFAST, we decided to try changing all the states in BeamDyn to ! follow the moving BladeRootMotion mesh. This requires changing the states after an UpdateStates call to be relative to ! the new BladeRootMotion mesh orientation and position. - ! Upadate the reference frame after each State update (or use the old method)? + ! Update the reference frame after each State update (or use the old method)? LOGICAL, PARAMETER :: ChangeRefFrame = .false. CONTAINS @@ -6009,7 +6009,7 @@ logical function Failed() end function Failed end subroutine -subroutine BD_PackStateOP(p, x, Values) +subroutine BD_PackContStateQuatOP(p, x, Values) type(BD_ParameterType), intent(in) :: p type(BD_ContinuousStateType), intent(in) :: x real(R8Ki), intent(out) :: Values(:) @@ -6018,19 +6018,19 @@ subroutine BD_PackStateOP(p, x, Values) associate (Var => p%Vars%x(i)) select case(Var%Field) case (VF_TransDisp) - Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ displacement + Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ displacement case (VF_Orientation) - Values(Var%iLoc(1):Var%iLoc(2)) = x%q(4:6,Var%iUsr(1)) ! WM Parameters + Values(Var%iLoc(1):Var%iLoc(2)) = wm_to_quat(x%q(4:6,Var%iUsr(1))) ! WM to quaternion case (VF_TransVel) - Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ velocity + Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ velocity case (VF_AngularVel) - Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular velocity + Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular velocity end select end associate end do end subroutine -subroutine BD_UnpackStateOP(p, Values, x) +subroutine BD_UnpackContStateQuatOP(p, Values, x) type(BD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Values(:) type(BD_ContinuousStateType), intent(inout) :: x @@ -6039,13 +6039,34 @@ subroutine BD_UnpackStateOP(p, Values, x) associate (Var => p%Vars%x(i)) select case(Var%Field) case (VF_TransDisp) - x%q(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ displacement + x%q(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ displacement case (VF_Orientation) - x%q(4:6,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! WM parameters + x%q(4:6,Var%iUsr(1)) = quat_to_wm(Values(Var%iLoc(1):Var%iLoc(2))) ! Quaternion to WM case (VF_TransVel) - x%dqdt(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ velocity + x%dqdt(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ velocity case (VF_AngularVel) - x%dqdt(4:6,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! Angular velocity + x%dqdt(4:6,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! Angular velocity + end select + end associate + end do +end subroutine + +subroutine BD_PackContStateOP(p, x, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: Values(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + associate (Var => p%Vars%x(i)) + select case(Var%Field) + case (VF_TransDisp) + Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ velocity + case (VF_Orientation) + Values(Var%iLoc(1):Var%iLoc(2)) = x%q(4:6,Var%iUsr(1)) ! Angular velocity + case (VF_TransVel) + Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ acceleration + case (VF_AngularVel) + Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular acceleration end select end associate end do @@ -6200,13 +6221,13 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateOP(p, m%dxdt_lin, m%Jac%x_pos) + call BD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateOP(p, m%dxdt_lin, m%Jac%x_neg) + call BD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%u(i)%iLoc(1) + j - 1 @@ -6297,7 +6318,7 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Copy state values call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateOP(p, x, m%Jac%x) + call BD_PackContStateQuatOP(p, x, m%Jac%x) ! If rotate states is enabled if (p%RotStates) then @@ -6338,13 +6359,13 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call BD_UnpackContStateQuatOP(p, m%Jac%x_perturb, m%x_perturb) call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return call BD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call BD_UnpackContStateQuatOP(p, m%Jac%x_perturb, m%x_perturb) call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return call BD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) @@ -6386,15 +6407,15 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call BD_UnpackContStateQuatOP(p, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateOP(p, m%dxdt_lin, m%Jac%x_pos) + call BD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call BD_UnpackContStateQuatOP(p, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateOP(p, m%dxdt_lin, m%Jac%x_neg) + call BD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -6640,7 +6661,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackStateOP(p, x, x_op) + call BD_PackContStateOP(p, x, x_op) end if @@ -6653,7 +6674,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF end if call BD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackStateOP(p, m%dxdt_lin, dx_op) + call BD_PackContStateOP(p, m%dxdt_lin, dx_op) end if diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index b193720e4e..74e4914e21 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -11547,12 +11547,13 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat call MV_AddMeshVar(p%Vars%y, 'Platform', MotionFields, & VarIdx=p%iVarPlatformMotion, & - Mesh=y%PlatformPtMesh) + Mesh=y%PlatformPtMesh, & + Flags=VF_SmallAngle) call MV_AddMeshVar(p%Vars%y, 'Tower', MotionFields, & VarIdx=p%iVarTowerMotion, & Mesh=y%TowerLn2Mesh, & - Flags=VF_Line) + Flags=ior(VF_Line, VF_SmallAngle)) call MV_AddMeshVar(p%Vars%y, 'Hub', & Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel], & diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 04e0c69138..cf2792c2ef 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -51,11 +51,12 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Linearize = 8 ! Variable for linearization [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_ExtLin = 16 ! Variable for extended linearization [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 32 ! Variable for write output [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 64 ! Variable for solver [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 128 ! Variable for aeromap [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 256 ! Variable is derivative order 1 in linearization file [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 512 ! Variable is derivative order 2 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_SmallAngle = 32 ! Use small angles to calculate difference in linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 64 ! Variable for write output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 128 ! Variable for solver [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 256 ! Variable for aeromap [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 512 ! Variable is derivative order 1 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 1024 ! Variable is derivative order 2 in linearization file [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 9477f27dc3..e1dddf105e 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -56,17 +56,18 @@ param ^ - IntKi VF_TransAcc - 8 - param ^ - IntKi VF_AngularAcc - 9 - "" - param ^ - IntKi VF_Scalar - 10 - "" - -param ^ - IntKi VF_None - 0 - "Variable with no flags" - -param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - -param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - -param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - -param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - -param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - -param ^ - IntKi VF_WriteOut - 32 - "Variable for write output" - -param ^ - IntKi VF_Solve - 64 - "Variable for solver" - -param ^ - IntKi VF_AeroMap - 128 - "Variable for aeromap" - -param ^ - IntKi VF_DerivOrder1 - 256 - "Variable is derivative order 1 in linearization file" - -param ^ - IntKi VF_DerivOrder2 - 512 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - +param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - +param ^ - IntKi VF_SmallAngle - 32 - "Use small angles to calculate difference in linearization" - +param ^ - IntKi VF_WriteOut - 64 - "Variable for write output" - +param ^ - IntKi VF_Solve - 128 - "Variable for solver" - +param ^ - IntKi VF_AeroMap - 256 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 512 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 1024 - "Variable is derivative order 2 in linearization file" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - @@ -114,6 +115,7 @@ typedef ^ MeshLocType IntKi Num - 0 - typedef ^ ^ IntKi i1 - 0 - "Mesh index 1" typedef ^ ^ IntKi i2 - 0 - "Mesh index 2" typedef ^ ^ IntKi i3 - 0 - "Mesh index 3" + # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types # the "usefrom" keyword defines the types for the registry without generating diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 1b154043fe..f31f8b4cac 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -56,17 +56,18 @@ param ^ - IntKi VF_TransAcc - 8 - param ^ - IntKi VF_AngularAcc - 9 - "" - param ^ - IntKi VF_Scalar - 10 - "" - -param ^ - IntKi VF_None - 0 - "Variable with no flags" - -param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - -param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - -param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - -param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - -param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - -param ^ - IntKi VF_WriteOut - 32 - "Variable for write output" - -param ^ - IntKi VF_Solve - 64 - "Variable for solver" - -param ^ - IntKi VF_AeroMap - 128 - "Variable for aeromap" - -param ^ - IntKi VF_DerivOrder1 - 256 - "Variable is derivative order 1 in linearization file" - -param ^ - IntKi VF_DerivOrder2 - 512 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - +param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - +param ^ - IntKi VF_SmallAngle - 32 - "Use small angles to calculate difference in linearization" - +param ^ - IntKi VF_WriteOut - 64 - "Variable for write output" - +param ^ - IntKi VF_Solve - 128 - "Variable for solver" - +param ^ - IntKi VF_AeroMap - 256 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 512 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 1024 - "Variable is derivative order 2 in linearization file" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - @@ -113,4 +114,4 @@ typedef ^ ^ R8Ki y_neg : - - typedef ^ MeshLocType IntKi Num - 0 - "Mesh number in module" typedef ^ ^ IntKi i1 - 0 - "Mesh index 1" typedef ^ ^ IntKi i2 - 0 - "Mesh index 2" -typedef ^ ^ IntKi i3 - 0 - "Mesh index 3" \ No newline at end of file +typedef ^ ^ IntKi i3 - 0 - "Mesh index 3" diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index db5eb9dd27..47e98d99a9 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -314,9 +314,9 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS os_BD => T%BD%OtherSt(ModData%Ins, STATE_PRED)) ! Transfer tight coupling states to module - call BD_PackStateOP(p_BD, x_BD, m_BD%Jac%x) + call BD_PackContStateQuatOP(p_BD, x_BD, m_BD%Jac%x) ! call XferGblToLoc1D(ModData%ixs, x_TC, m_BD%Jac%x) - call BD_UnpackStateOP(p_BD, m_BD%Jac%x, x_BD) + call BD_UnpackContStateQuatOP(p_BD, m_BD%Jac%x, x_BD) ! TODO: Fix state reset ! Set BD accelerations and algorithmic accelerations from q matrix @@ -348,7 +348,7 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! end do ! Transfer updated states to solver - call BD_PackStateOP(p_BD, x_BD, m_BD%Jac%x) + call BD_PackContStateQuatOP(p_BD, x_BD, m_BD%Jac%x) ! call XferLocToGbl1D(ModData%ixs, m_BD%Jac%x, x_TC) end associate diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index a62a1d193b..2864040440 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1404,7 +1404,6 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! MeshMapCreate( PlatformMotion, SrvD%u%PtfmMotionMesh, MeshMapData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) - select case (SrcMod%ID) case (Module_BD) @@ -1895,7 +1894,7 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrSta character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: iLocSrc(2), iLocDst(2) + integer(IntKi) :: iLocSrc(2), iLocDst(2), nLocSrc, nLocDst integer(IntKi) :: i, j, k type(MeshType), pointer :: SrcMesh, DstMesh type(MeshType), pointer :: SrcDispMesh, DstDispMesh @@ -1920,8 +1919,23 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrSta call Idx_GetValLoc(Idx%u, Mapping%DstModIdx, Mapping%iVarDst, iGbl=iLocDst) if (iLocSrc(1) == 0 .or. iLocDst(1) == 0) cycle - ! Set coupling terms in dUdy to -1 - dUdy(iLocDst(1):iLocDst(2), iLocSrc(1):iLocSrc(2)) = -1.0_R8Ki + ! Get number of source and destination locations + nLocSrc = iLocSrc(2) - iLocSrc(1) + 1 + nLocDst = iLocDst(2) - iLocDst(1) + 1 + + ! If source has multiple locations, destination must have same number, connect 1-to-1 + ! MapVariable checks that variables have same number if nLocSrc > 1 + if (nLocSrc > 1) then + do k = 0, nLocDst - 1 + dUdy(iLocDst(1) + k, iLocSrc(1) + k) = -1.0_R8Ki + end do + else if (nLocDst == 1) then + ! Source and destination have one location + dUdy(iLocDst(1), iLocSrc(1)) = -1.0_R8Ki + else + ! One source location to many destination locations + dUdy(iLocDst(1):iLocDst(2), iLocSrc(1)) = -1.0_R8Ki + end if case (Map_MotionMesh) @@ -2028,23 +2042,23 @@ subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp) subroutine Assemble_dUdu(Mapping) type(TC_MappingType), intent(in) :: Mapping - + ! Effect of input Translation Displacement on input Translation Velocity if (allocated(Mapping%MeshMap%dM%tv_uD)) then call SumBlock(Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_uD, dUdu) end if - + ! Effect of input Translation Displacement on input Translation Acceleration if (allocated(Mapping%MeshMap%dM%ta_uD)) then call SumBlock(Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_uD, dUdu) end if - + ! Effect of input Translation Displacement on input Moments if (allocated(Mapping%MeshMap%dM%M_uS)) then call SumBlock(Idx%u, Mapping%SrcModIdx, Mapping%iVarSrcDispTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%M_uS, dUdu) end if end subroutine - + !> Assemble_dUdy_Loads assembles the linearization matrices for transfer of !! load fields between two meshes. It sets the following block matrix, which !! is the dUdy block for transfering output (source) mesh to the input @@ -2053,18 +2067,18 @@ subroutine Assemble_dUdu(Mapping) !! | M_fm M_li | | M^S | subroutine Assemble_dUdy_Loads(Mapping) type(TC_MappingType), intent(inout) :: Mapping - + ! Load identity if (allocated(Mapping%MeshMap%dM%li)) then call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcForce, Idx%u, Mapping%DstModIdx, Mapping%iVarDstForce, Mapping%MeshMap%dM%li, dUdy) call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcMoment, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%li, dUdy) end if - + ! Force to Moment if (allocated(Mapping%MeshMap%dM%m_f)) then call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcForce, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_f, dUdy) end if - + ! Destination Translation Displacement to Moment if (allocated(Mapping%MeshMap%dM%m_uD)) then if (Mapping%DstUsesSibling) then @@ -2079,7 +2093,7 @@ subroutine Assemble_dUdy_Loads(Mapping) end if end if end subroutine - + !> Assemble_dUdy_Motions assembles the linearization matrices for transfer of !! motion fields between two meshes. It set the following block matrix, which !! is the dUdy block for transfering output (source) mesh to the input @@ -2094,7 +2108,7 @@ subroutine Assemble_dUdy_Loads(Mapping) !! u^S, theta^S, v^S, omega^S, a^S, alpha^S subroutine Assemble_dUdy_Motions(Mapping) type(TC_MappingType), intent(inout) :: Mapping - + ! Motion identity if (allocated(Mapping%MeshMap%dM%mi)) then call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%mi, dUdy) @@ -2104,30 +2118,30 @@ subroutine Assemble_dUdy_Motions(Mapping) call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%mi, dUdy) call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstAngularAcc, Mapping%MeshMap%dM%mi, dUdy) end if - + ! Rotation to Translation if (allocated(Mapping%MeshMap%dM%fx_p)) then call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcOrientation, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%fx_p, dUdy) call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%fx_p, dUdy) call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%fx_p, dUdy) end if - + ! Translation displacement to Translation velocity if (allocated(Mapping%MeshMap%dM%tv_us)) then call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_us, dUdy) end if - + ! Translation displacement to Translation acceleration if (allocated(Mapping%MeshMap%dM%ta_us)) then call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_us, dUdy) end if - + ! Angular velocity to Translation acceleration if (allocated(Mapping%MeshMap%dM%ta_rv)) then call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_rv, dUdy) end if end subroutine - + subroutine SumBlock(IdxSrc, iModSrc, iVarSrc, IdxDst, iModDst, iVarDst, SrcM, DstM) type(VarIdxType), intent(in) :: IdxDst, IdxSrc integer(IntKi), intent(in) :: iModDst, iModSrc @@ -2142,10 +2156,10 @@ subroutine SumBlock(IdxSrc, iModSrc, iVarSrc, IdxDst, iModDst, iVarDst, SrcM, Ds ! Get global indices for source/destination modules/variables call Idx_GetValLoc(IdxSrc, iModSrc, iVarSrc, iGbl=iLocSrc) call Idx_GetValLoc(IdxDst, iModDst, iVarDst, iGbl=iLocDst) - + ! If no global indices for source or destination, return if (iLocDst(1) == 0 .or. iLocSrc(1) == 0) return - + ! Subtracts the source matrix from the destination sub-matrix associate (DstSubM => DstM(iLocDst(1):iLocDst(2), iLocSrc(1):iLocSrc(2))) DstSubM = DstSubM - SrcM @@ -2158,7 +2172,6 @@ logical function Failed() end function end subroutine - subroutine FAST_InputSolve(ModData, Mods, Mappings, Turbine, ErrStat, ErrMsg, UseU) type(ModDataType), intent(in) :: ModData !< Module data type(ModDataType), intent(in) :: Mods(:) !< Module data @@ -2354,7 +2367,7 @@ subroutine Custom_InputSolve(T, Mapping, ErrStat, ErrMsg, UseU) case (Custom_SrvD_to_IfW) ! Set hub position so ServoDyn can get hub wind speed - u_IfW%PositionXYZ(:,1) = T%ED%y%HubPtMotion%Position(:, 1) + u_IfW%PositionXYZ(:, 1) = T%ED%y%HubPtMotion%Position(:, 1) !------------------------------------------------------------------------------- ! MoorDyn Inputs diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index d2b4b76afd..25ca9562c4 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -469,7 +469,7 @@ subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_ end associate end do - ! Linearize mesh mappings to popoulate dUdy and dUdu + ! Linearize mesh mappings to populate dUdy and dUdu ModGlue%Lin%dUdy = 0.0_R8Ki call Eye2D(ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return call FAST_LinearizeMappings(Turbine, Mods, m%Mappings, p%iMod, p%IdxLin, ErrStat2, ErrMsg2, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy) @@ -522,10 +522,8 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) ! *** get G matrix **** !---------------------- - if (.not. allocated(G)) then - call AllocAry(G, size(dUdu, 1), size(dUdu, 2), 'G', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ipiv, ModGlue%Vars%Nu, 'ipiv', ErrStat2, ErrMsg2); if (Failed()) return - end if + call AllocAry(G, size(dUdu, 1), size(dUdu, 2), 'G', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ipiv, ModGlue%Vars%Nu, 'ipiv', ErrStat2, ErrMsg2); if (Failed()) return !G = dUdu + matmul(dUdy, y_FAST%Lin%Glue%D) G = dUdu @@ -595,42 +593,58 @@ subroutine Precondition(uVars, G, dUdu, dUdy, JacScaleFactor) real(R8Ki), intent(inout) :: dUdy(:, :) !< jacobian in FAST linearization from right-hand-side of equation real(R8Ki), intent(in) :: JacScaleFactor !< jacobian scale factor real(R8Ki), allocatable :: diag(:) !< diagonal elements of G - integer(IntKi) :: i + integer(IntKi) :: LoadFlags + integer(IntKi) :: i, j, k + logical :: isRowLoad, isColLoad + logical, allocatable :: isLoad(:) - ! Copy diagonal of G into temporary array, to be restored after conditioning, - ! this is done to avoid loss of precision in the diagonal terms - allocate (diag(size(G, 1))) - do i = 1, size(diag) - diag(i) = G(i, i) - end do + allocate(isLoad(size(dUdu,1))) + isLoad=.false. - ! Loop through glue code input varies + ! Loop through glue code input variables (cols) do i = 1, size(uVars) - ! If variable is not a load (force or moment), continue - if (.not. MV_HasFlags(uVars(i), ior(VF_Force, VF_Moment))) cycle + ! Get if col variable is a load + isColLoad = uVars(i)%Field == VF_Force .or. uVars(i)%Field == VF_Moment - ! Otherwise get variable start and end indices in matrix + ! Get col variable start and end indices in matrix associate (iLoc => uVars(i)%iLoc) - ! Multiply columns of G - G(:, iLoc(1):iLoc(2)) = G(:, iLoc(1):iLoc(2))*JacScaleFactor + isLoad(iLoc(1):iLoc(2)) = isColLoad + + ! Loop through glue code input variables (rows) + do j = 1, size(uVars) + + ! Get if row variable is a load + isRowLoad = uVars(j)%Field == VF_Force .or. uVars(j)%Field == VF_Moment + + ! Get row variable start and end indices in matrix + associate (jLoc => uVars(j)%iLoc) + + if (isColLoad .and. (.not. isRowLoad)) then + + ! Multiply columns of G + G(jLoc(1):jLoc(2), iLoc(1):iLoc(2)) = G(jLoc(1):jLoc(2), iLoc(1):iLoc(2))*JacScaleFactor + + else if (isRowLoad .and. (.not. isColLoad)) then - ! Divide rows of G - G(iLoc(1):iLoc(2), :) = G(iLoc(1):iLoc(2), :)/JacScaleFactor + ! Divide rows of G + G(jLoc(1):jLoc(2), iLoc(1):iLoc(2)) = G(jLoc(1):jLoc(2), iLoc(1):iLoc(2))/JacScaleFactor - ! Divide rows of dUdu - dUdu(iLoc(1):iLoc(2), :) = dUdu(iLoc(1):iLoc(2), :)/JacScaleFactor + end if + + end associate - ! Divide rows of dUdy - dUdy(iLoc(1):iLoc(2), :) = dUdy(iLoc(1):iLoc(2), :)/JacScaleFactor + end do + + ! Divide rows of dUdu and dUdy by scale factor + if (isColLoad) then + dUdu(iLoc(1):iLoc(2), :) = dUdu(iLoc(1):iLoc(2), :)/JacScaleFactor + dUdy(iLoc(1):iLoc(2), :) = dUdy(iLoc(1):iLoc(2), :)/JacScaleFactor + end if end associate - end do - ! Restore diagonal of G from temporary array - do i = 1, size(diag) - G(i, i) = diag(i) end do end subroutine @@ -648,19 +662,21 @@ subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) ! Loop through glue code input varies do i = 1, size(uVars) - ! If variable is not a load (force or moment), continue - if (.not. MV_HasFlags(uVars(i), ior(VF_Force, VF_Moment))) cycle + ! If variable is a (force or moment), apply post-conditioner + if (uVars(i)%Field == VF_Force .or. uVars(i)%Field == VF_Moment) then - ! Otherwise get variable start and end indices in matrix - associate (iLoc => uVars(i)%iLoc) + ! Otherwise get variable start and end indices in matrix + associate (iLoc => uVars(i)%iLoc) - ! Multiply rows of dUdu - dUdu(iLoc(1):iLoc(2), :) = dUdu(iLoc(1):iLoc(2), :)*JacScaleFactor + ! Multiply rows of dUdu + dUdu(iLoc(1):iLoc(2), :) = dUdu(iLoc(1):iLoc(2), :)*JacScaleFactor - ! Multiply rows of dUdy - dUdy(iLoc(1):iLoc(2), :) = dUdy(iLoc(1):iLoc(2), :)*JacScaleFactor + ! Multiply rows of dUdy + dUdy(iLoc(1):iLoc(2), :) = dUdy(iLoc(1):iLoc(2), :)*JacScaleFactor - end associate + end associate + + end if end do end subroutine @@ -904,8 +920,8 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer ! Skip writing if not the first value in orientation (3 values) if (mod(j - 1, 3) /= 0) cycle - ! Convert WM parameters to DCM - DCM = wm_to_dcm(real(op(i_op:i_op + 2), R8Ki)) + ! Convert quaternion parameters to DCM + DCM = quat_to_dcm(real(op(i_op:i_op + 2), R8Ki)) ! Write 3 rows of data (full dcm) write (Un, FmtRot) RowColIdx + 0, dcm(1, 1), dcm(1, 2), dcm(1, 3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j + 0)) From f906d9b08f4077e5f44a5363820a98ff2b5c4cb9 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 23 May 2024 17:33:38 +0000 Subject: [PATCH 129/319] Add missing flag on SubDyn WriteOutput variable --- modules/subdyn/src/SubDyn.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index d778d4e721..53cadc6b46 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -496,6 +496,7 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Output variables call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, Num=p%NumOuts, & + Flags=VF_WriteOut, & VarIdx=p%iVarWriteOutput, & LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) From d20489eee0edd113beae16803895cff68e271fbf Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 23 May 2024 22:18:54 +0000 Subject: [PATCH 130/319] Added SeaState to module system --- modules/openfast-library/src/FAST_Funcs.f90 | 18 +- modules/openfast-library/src/FAST_ModGlue.f90 | 9 +- modules/openfast-library/src/FAST_Mods.f90 | 2 +- modules/openfast-library/src/FAST_Subs.f90 | 10 +- modules/seastate/src/SeaState.f90 | 248 ++++----- modules/seastate/src/SeaState.txt | 49 +- modules/seastate/src/SeaState_Types.f90 | 519 ++++++------------ 7 files changed, 330 insertions(+), 525 deletions(-) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 47e98d99a9..02e6cfcabf 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -588,7 +588,11 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) -! case (Module_SeaSt) + case (Module_SeaSt) + call SeaSt_GetOP(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), T%SeaSt%z(ThisState), & + T%SeaSt%OtherSt(ThisState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + case (Module_SrvD) call SrvD_GetOP(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), T%SrvD%z(ThisState), & T%SrvD%OtherSt(ThisState), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & @@ -667,6 +671,11 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + case (Module_SeaSt) + call SeaSt_JacobianPInput(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), & + T%SeaSt%z(ThisState), T%SeaSt%OtherSt(ThisState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + case (Module_SrvD) call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & T%SrvD%z(ThisState), T%SrvD%OtherSt(ThisState), T%SrvD%y, T%SrvD%m, & @@ -758,6 +767,13 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + case (Module_SeaSt) + call SeaSt_JacobianPContState(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, & + T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), & + T%SeaSt%z(ThisState), T%SeaSt%OtherSt(ThisState), & + T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + case (Module_SrvD) call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(1), T%SrvD%p, & T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 25ca9562c4..8fdca6b100 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -514,6 +514,13 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) ! C = dYdx ! D = dYdu + ! call DumpMatrix(1000, "dUdu.bin", ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "dUdy.bin", ModGlue%Lin%dUdy, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "A.bin", ModGlue%Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "B.bin", ModGlue%Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "C.bin", ModGlue%Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "D.bin", ModGlue%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! Create copies of dUdu and dUdy for calculating matrices call AllocAry(dUdu, size(ModGlue%Lin%dUdu, 1), size(ModGlue%Lin%dUdu, 2), 'dUdu', ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(dUdy, size(ModGlue%Lin%dUdy, 1), size(ModGlue%Lin%dUdy, 2), 'dUdy', ErrStat2, ErrMsg2); if (Failed()) return @@ -548,7 +555,7 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) deallocate (G) deallocate (ipiv) - ! after this call, dUdu holds G^(-1)*dUdu and dUdy holds G^(-1)*dUdy: + ! After this call, dUdu holds G^(-1)*dUdu and dUdy holds G^(-1)*dUdy call Postcondition(ModGlue%Vars%u, dUdu, dUdy, JacScaleFactor) ! Allocate tmp matrix for A and C calculations diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 20aca8a274..7b182b686d 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -76,7 +76,7 @@ MODULE FAST_ModTypes !< Linearization module ID array (order determines Jacobian layout) integer(IntKi), parameter :: LinMods(*) = & - [Module_IfW, Module_SrvD, Module_ED, Module_BD, Module_AD, & + [Module_IfW, Module_SeaSt, Module_SrvD, Module_ED, Module_BD, Module_AD, & Module_HD, Module_SD, Module_MAP, Module_MD] END MODULE FAST_ModTypes diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 29afa59c36..73680118bf 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -735,16 +735,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%VTK_surface%NWaveElevPts(2) = 0 endif + CALL MV_AddModule(y_FAST%Modules, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & + Init%OutData_SeaSt%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + allocate( y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SeaSt).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(Init%OutData_SeaSt%LinNames_y)) call move_alloc(Init%OutData_SeaSt%LinNames_y,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%Names_y ) - if (allocated(Init%OutData_SeaSt%LinNames_u)) call move_alloc(Init%OutData_SeaSt%LinNames_u,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%Names_u ) - if (allocated(Init%OutData_SeaSt%RotFrame_y)) call move_alloc(Init%OutData_SeaSt%RotFrame_y,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_SeaSt%RotFrame_u)) call move_alloc(Init%OutData_SeaSt%RotFrame_u,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_SeaSt%IsLoad_u )) call move_alloc(Init%OutData_SeaSt%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_SeaSt%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%NumOutputs = size(Init%OutData_SeaSt%WriteOutputHdr) end if diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 10dca7ab7d..ea845d0ccc 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -336,7 +336,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! set the Jacobian info if we don't have a fatal error if (ErrStat < AbortErrLev) then - call SeaSt_Init_Jacobian(p, InitOut, ErrStat2, ErrMsg2) + call SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) if (Failed()) return endif end if @@ -447,6 +447,94 @@ subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) end subroutine SurfaceVisGenerate END SUBROUTINE SeaSt_Init + +subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) + type(SeaSt_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SeaSt_ParameterType), intent(inout) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(inout) :: x !< Continuous state + type(SeaSt_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SeaSt_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SeaSt_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + type(SeaSt_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ED_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + integer(IntKi), allocatable :: BladeMeshFields(:) + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: Flags, Field + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Associate pointer in init output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Extended input + call MV_AddVar(p%Vars%u, "Wave1Elev", VF_Scalar, & + VarIdx=p%iVarWave1ElevU, & + Flags=VF_ExtLin, & + Perturb=0.02_ReKi * Pi / 180.0_ReKi * max(1.0_ReKi, p%WaveField%WtrDpth), & + LinNames=['Extended input: wave elevation at platform ref point, m']) + + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! Extended output + call MV_AddVar(p%Vars%y, "Wave1Elev", VF_Scalar, & + VarIdx=p%iVarWave1ElevY, & + Flags=VF_ExtLin, & + LinNames=['Extended output: wave elevation at platform ref point, m']) + + + ! Output variables + call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, Num=p%NumOuts, & + Flags=VF_WriteOut, & + VarIdx=p%iVarWriteOutput, & + LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call SeaSt_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:) @@ -735,98 +823,6 @@ END SUBROUTINE SeaSt_CalcConstrStateResidual -!---------------------------------------------------------------------------------------------------------------------------------- -! Linearization routines -!---------------------------------------------------------------------------------------------------------------------------------- -!> Initialize Jacobian info for linearization (only u and y) -subroutine SeaSt_Init_Jacobian(p, InitOut, ErrStat, ErrMsg) - type(SeaSt_ParameterType), intent(inout) :: p !< Parameters - type(SeaSt_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - integer(IntKi) :: nu, ny ! counters for number of u and y linearization terms - integer(IntKi) :: i, idx ! generic indexing - integer(IntKi) :: ExtStart ! start of Extended input/output - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_Init_Jacobian' - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - - !-------------------------- - ! Init Jacobians for u - !-------------------------- - - ! One extended input (WaveElev0), and no regular inputs. Starts at first index. - nu = 1 - p%LinParams%NumExtendedInputs = 1 - ! Total number of inputs (including regular and extended inputs) - p%LinParams%Jac_nu = nu - - ! Allocate storage for names, indexing, and perturbations - call AllocAry(InitOut%LinNames_u, nu, "LinNames_u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(InitOut%RotFrame_u, nu, "RotFrame_u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(InitOut%IsLoad_u, nu, "IsLoad_u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(p%LinParams%du, nu, "LinParams%du", ErrStat2, ErrMsg2); if (Failed()) return - - ! Step through list of inputs and save names. No regular inputs, so we skip directly to the Extended input - ! WaveElev0 - extended input - ExtStart = 1 - InitOut%LinNames_u(ExtStart) = 'Extended input: wave elevation at platform ref point, m' - InitOut%RotFrame_u(ExtStart) = .false. - InitOut%IsLoad_u( ExtStart) = .false. - - p%LinParams%Jac_u_idxStartList%Extended = ExtStart - p%LinParams%du(ExtStart) = 0.02_ReKi * Pi / 180.0_ReKi * max(1.0_ReKi, p%WaveField%WtrDpth) ! TODO: check that this is the correct perturbation to use - - - !-------------------------- - ! Init Jacobians for y - !-------------------------- - - ! No regular outputs, only the extended outputs and the WrOuts - p%LinParams%NumExtendedOutputs = 1 - ExtStart = 1 ! Extended output is the first output - ny = 1 ! one extended output - p%LinParams%Jac_y_idxStartList%Extended = 1 - - ! Nunber of WrOuts (only if output to OpenFAST) - if ( p%OutSwtch /= 1 .and. allocated(InitOut%WriteOutputHdr) ) then - ny = ny + size(InitOut%WriteOutputHdr) - endif - - ! start position for WrOuts (may be beyond ny) - p%LinParams%Jac_y_idxStartList%WrOuts = p%LinParams%Jac_y_idxStartList%Extended + p%LinParams%NumExtendedOutputs - - ! Total number of outs (including regular outs and extended outs) - p%LinParams%Jac_ny = ny - - ! allocate some things - call AllocAry(InitOut%LinNames_y, ny, "LinNames_y", ErrStat2, ErrMsg2); if (Failed()) return; - call AllocAry(InitOut%RotFrame_y, ny, "RotFrame_y", ErrStat2, ErrMsg2); if (Failed()) return; - InitOut%RotFrame_y = .false. ! No outputs in rotating frame - - ! Set names: no regular output, so start at extended output - InitOut%LinNames_y(ExtStart) = 'Extended output: wave elevation at platform ref point, m' - - ! WrOuts names (only if output to OpenFAST) - if ( p%OutSwtch > 1 .and. allocated(InitOut%WriteOutputHdr) ) then - do i = 1,size(InitOut%WriteOutputHdr) - idx = p%LinParams%Jac_y_idxStartList%WrOuts - 1 + i ! current index - InitOut%LinNames_y(idx) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - enddo - endif - - -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine SeaSt_Init_Jacobian !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/du, dX/du, dXd/du, and dZ/du @@ -856,45 +852,33 @@ subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ErrStat = ErrID_None ErrMsg = '' - if ( present( dYdu ) ) then - - ! If dYdu is allocated, make sure it is the correct size - if (allocated(dYdu)) then - if (size(dYdu,1) /= p%LinParams%Jac_ny .or. size(dYdu,2) /= p%LinParams%Jac_nu) deallocate (dYdu) + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) + if (present(dYdu)) then + + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return endif - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - ! - inputs are extended inputs only - ! - outputs are the extended outputs and the WriteOutput values - if (.not. ALLOCATED(dYdu)) then - call AllocAry( dYdu, p%LinParams%Jac_ny, p%LinParams%Jac_nu, 'dYdu', ErrStat2, ErrMsg2 ) - if (Failed()) return - end if - + ! Initialize Jacobian to zero dYdu = 0.0_R8Ki - ! Extended inputs to extended outputs (direct pass-through) - do i=1,min(p%LinParams%NumExtendedInputs,p%LinParams%NumExtendedOutputs) - idx_du = p%LinParams%Jac_u_idxStartList%Extended + i - 1 - idx_dY = p%LinParams%Jac_y_idxStartList%Extended + i - 1 - dYdu(idx_dY,idx_du) = 1.0_R8Ki - enddo - + ! Extended input to extended output (direct pass-through) + dYdu(p%Vars%y(p%iVarWave1ElevY)%iLoc(1), p%Vars%u(p%iVarWave1ElevU)%iLoc(1)) = 1.0_R8Ki + ! It isn't possible to determine the relationship between the extended input and the WrOuts. So we leave them all zero. endif - ! No states or constraints, so deallocate any such matrices - if ( present( dXdu ) ) then + if (present(dXdu)) then if (allocated(dXdu)) deallocate(dXdu) endif - if ( present( dXddu ) ) then + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) endif - if ( present( dZdu ) ) then + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) endif @@ -1058,43 +1042,31 @@ subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_ ErrStat = ErrID_None ErrMsg = '' - - if ( present( u_op ) ) then + if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, p%LinParams%Jac_nu, 'u_op', ErrStat2, ErrMsg2) + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) if (Failed()) return end if ! no regular inputs, only extended input - u_op(p%LinParams%Jac_u_idxStartList%Extended) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + u_op(p%Vars%u(p%iVarWave1ElevU)%iLoc(1)) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + ! NOTE: if more extended inputs are added, place them here end if - if ( present( y_op ) ) then + if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, p%LinParams%Jac_ny, 'y_op', ErrStat2, ErrMsg2) + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) if (Failed()) return end if ! no regular outputs, only extended output and WrOuts - y_op(p%LinParams%Jac_y_idxStartList%Extended) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements - ! NOTE: if more extended inputs are added, place them here + y_op(p%Vars%y(p%iVarWave1ElevY)%iLoc(1)) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + + call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, y_op) - ! WrOuts may not be sent to OpenFAST (y_op sized smaller if WrOuts not sent to OpenFAST) - if (p%LinParams%Jac_y_idxStartList%WrOuts <= p%LinParams%Jac_ny) then - idxStart = p%LinParams%Jac_y_idxStartList%WrOuts - idxEnd = p%LinParams%Jac_y_idxStartList%WrOuts + p%NumOuts - 1 - ! unnecessary array check to make me feel better about the potentially sloppy indexing - if (idxEnd > p%LinParams%Jac_ny) then - ErrStat2 = ErrID_Fatal; ErrMsg2 = "Error in the y_op sizing -- u_op not large enough for WrOuts" - if (Failed()) return - endif - ! copy over the returned outputs - y_op(idxStart:idxEnd) = y%WriteOutput(1:p%NumOuts) - endif end if - contains logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index f38dfdf231..9948d78d58 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -94,11 +94,7 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveElevVisY {:} - - "Y locations of grid output" "m,-" typedef ^ ^ SiKi WaveElevVisGrid {:}{:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points." (m) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" -typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - -typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ ^ ModVarsType *Vars - - - "Module Variables" @@ -120,35 +116,16 @@ typedef ^ ConstraintStateType R8Ki # Define any other states, including integer or logical states here: typedef ^ OtherStateType R8Ki UnusedStates - - - "placeholder for states" - # -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - -typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - -typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - - -# .... Linearization params ....................................................................................................... -# NOTE: This is overkill given how limited linearization is. For completeness and similarity to other modules, keeping all this here. Also note some -# values are set here, but will be overwritten in the code. -typedef ^ Jac_u_idxStarts IntKi Extended - 1 - "Index to first point in u jacobian for Extended" - -typedef ^ Jac_y_idxStarts IntKi Extended - 1 - "Index to first point in y jacobian for Extended" - -typedef ^ Jac_y_idxStarts IntKi WrOuts - 2 - "Index to first point in y jacobian for WrOuts" - -typedef ^ SeaSt_LinParams IntKi NumExtendedInputs - 1 - "number of extended inputs" - -typedef ^ ^ IntKi NumExtendedOutputs - 1 - "number of extended outputs" - -typedef ^ ^ Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u components" - -typedef ^ ^ Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_y components" - -typedef ^ ^ ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ^ IntKi Jac_nu - - - "number of inputs in jacobian matrix" - -typedef ^ ^ IntKi Jac_ny - - - "number of outputs in jacobian matrix" - - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # -typedef ^ ParameterType DbKi WaveDT - - - "Wave DT" sec +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" +typedef ^ ^ IntKi iVarWave1ElevU - - - "Index of Wave1Elev input variable" - +typedef ^ ^ IntKi iVarWave1ElevY - - - "Index of Wave1Elev output variable" - +typedef ^ ^ IntKi iVarWriteOutput - - - "Index of WriteOutput variable" - +typedef ^ ^ DbKi WaveDT - - - "Wave DT" sec typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - typedef ^ ^ INTEGER NGrid 3 - - "Number of grid entries in x, y, and z" typedef ^ ^ ReKi deltaGrid 3 - - "delta between grid points in x, y, and theta (for z)" m,m,rad @@ -168,7 +145,6 @@ typedef ^ ^ CHARACTER(1) Del typedef ^ ^ INTEGER UnOutFile - - - "File unit for the SeaState outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - typedef ^ ^ SeaSt_WaveFieldType &WaveField - - - "Wave field" - -typedef ^ ^ SeaSt_LinParams LinParams - - - "Linearization parameters" - # # @@ -181,3 +157,16 @@ typedef ^ InputType SiKi Dum # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: typedef ^ OutputType ReKi WriteOutput {:} - - "Outputs to be written to the output file(s)" - + +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - +typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - +typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - + +# .... Linearization ....................................................................................................... +typedef ^ ^ ModJacType Jac - - - "Values corresponding to module variables" - +typedef ^ ^ SeaSt_InputType u_perturb - - - "Input type for linearization perturbation" - +typedef ^ ^ SeaSt_OutputType y_lin - - - "Output type for linearization perturbation" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index f5758ed009..1460c577fc 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -114,11 +114,7 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< Y locations of grid output [m,-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points. [(m)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE SeaSt_InitOutputType ! ======================= ! ========= SeaSt_ContinuousStateType ======= @@ -141,38 +137,12 @@ MODULE SeaState_Types REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_OtherStateType ! ======================= -! ========= SeaSt_MiscVarType ======= - TYPE, PUBLIC :: SeaSt_MiscVarType - INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] - INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] - END TYPE SeaSt_MiscVarType -! ======================= -! ========= Jac_u_idxStarts ======= - TYPE, PUBLIC :: Jac_u_idxStarts - INTEGER(IntKi) :: Extended = 1 !< Index to first point in u jacobian for Extended [-] - END TYPE Jac_u_idxStarts -! ======================= -! ========= Jac_y_idxStarts ======= - TYPE, PUBLIC :: Jac_y_idxStarts - INTEGER(IntKi) :: Extended = 1 !< Index to first point in y jacobian for Extended [-] - INTEGER(IntKi) :: WrOuts = 2 !< Index to first point in y jacobian for WrOuts [-] - END TYPE Jac_y_idxStarts -! ======================= -! ========= SeaSt_LinParams ======= - TYPE, PUBLIC :: SeaSt_LinParams - INTEGER(IntKi) :: NumExtendedInputs = 1 !< number of extended inputs [-] - INTEGER(IntKi) :: NumExtendedOutputs = 1 !< number of extended outputs [-] - TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u components [-] - TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_y components [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - INTEGER(IntKi) :: Jac_nu = 0_IntKi !< number of inputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] - END TYPE SeaSt_LinParams -! ======================= ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarWave1ElevU = 0_IntKi !< Index of Wave1Elev input variable [-] + INTEGER(IntKi) :: iVarWave1ElevY = 0_IntKi !< Index of Wave1Elev output variable [-] + INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Index of WriteOutput variable [-] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] @@ -193,7 +163,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the SeaState outputs [-] INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Wave field [-] - TYPE(SeaSt_LinParams) :: LinParams !< Linearization parameters [-] END TYPE SeaSt_ParameterType ! ======================= ! ========= SeaSt_InputType ======= @@ -206,6 +175,17 @@ MODULE SeaState_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Outputs to be written to the output file(s) [-] END TYPE SeaSt_OutputType ! ======================= +! ========= SeaSt_MiscVarType ======= + TYPE, PUBLIC :: SeaSt_MiscVarType + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(SeaSt_InputType) :: u_perturb !< Input type for linearization perturbation [-] + TYPE(SeaSt_OutputType) :: y_lin !< Output type for linearization perturbation [-] + END TYPE SeaSt_MiscVarType +! ======================= CONTAINS subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -644,66 +624,7 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElevVisGrid = SrcInitOutputData%WaveElevVisGrid end if DstInitOutputData%WaveField => SrcInitOutputData%WaveField - if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) - if (.not. allocated(DstInitOutputData%LinNames_y)) then - allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - end if - if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) - if (.not. allocated(DstInitOutputData%LinNames_u)) then - allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - end if - if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - if (.not. allocated(DstInitOutputData%RotFrame_u)) then - allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - end if - if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - if (.not. allocated(DstInitOutputData%RotFrame_y)) then - allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - end if - if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - if (.not. allocated(DstInitOutputData%IsLoad_u)) then - allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - end if + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -733,21 +654,7 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%WaveElevVisGrid) end if nullify(InitOutputData%WaveField) - if (allocated(InitOutputData%LinNames_y)) then - deallocate(InitOutputData%LinNames_y) - end if - if (allocated(InitOutputData%LinNames_u)) then - deallocate(InitOutputData%LinNames_u) - end if - if (allocated(InitOutputData%RotFrame_u)) then - deallocate(InitOutputData%RotFrame_u) - end if - if (allocated(InitOutputData%RotFrame_y)) then - deallocate(InitOutputData%RotFrame_y) - end if - if (allocated(InitOutputData%IsLoad_u)) then - deallocate(InitOutputData%IsLoad_u) - end if + nullify(InitOutputData%Vars) end subroutine subroutine SeaSt_PackInitOutput(RF, Indata) @@ -770,11 +677,13 @@ subroutine SeaSt_PackInitOutput(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - call RegPackAlloc(RF, InData%LinNames_y) - call RegPackAlloc(RF, InData%LinNames_u) - call RegPackAlloc(RF, InData%RotFrame_u) - call RegPackAlloc(RF, InData%RotFrame_y) - call RegPackAlloc(RF, InData%IsLoad_u) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -813,11 +722,24 @@ subroutine SeaSt_UnPackInitOutput(RF, OutData) else OutData%WaveField => null() end if - call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine SeaSt_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -972,226 +894,6 @@ subroutine SeaSt_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_MiscVarType), intent(in) :: SrcMiscData - type(SeaSt_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SeaSt_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine SeaSt_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Decimate) - call RegPack(RF, InData%LastOutTime) - call RegPack(RF, InData%LastIndWave) - call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m -end subroutine - -subroutine SeaSt_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) - type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData - type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_CopyJac_u_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' - DstJac_u_idxStartsData%Extended = SrcJac_u_idxStartsData%Extended -end subroutine - -subroutine SeaSt_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) - type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_DestroyJac_u_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_PackJac_u_idxStarts(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_PackJac_u_idxStarts' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Extended) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_UnPackJac_u_idxStarts(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_UnPackJac_u_idxStarts' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData - type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_CopyJac_y_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' - DstJac_y_idxStartsData%Extended = SrcJac_y_idxStartsData%Extended - DstJac_y_idxStartsData%WrOuts = SrcJac_y_idxStartsData%WrOuts -end subroutine - -subroutine SeaSt_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_DestroyJac_y_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_PackJac_y_idxStarts(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_PackJac_y_idxStarts' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Extended) - call RegPack(RF, InData%WrOuts) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_UnPackJac_y_idxStarts(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_UnPackJac_y_idxStarts' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WrOuts); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_CopyLinParams(SrcLinParamsData, DstLinParamsData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_LinParams), intent(in) :: SrcLinParamsData - type(SeaSt_LinParams), intent(inout) :: DstLinParamsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_CopyLinParams' - ErrStat = ErrID_None - ErrMsg = '' - DstLinParamsData%NumExtendedInputs = SrcLinParamsData%NumExtendedInputs - DstLinParamsData%NumExtendedOutputs = SrcLinParamsData%NumExtendedOutputs - call SeaSt_CopyJac_u_idxStarts(SrcLinParamsData%Jac_u_idxStartList, DstLinParamsData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyJac_y_idxStarts(SrcLinParamsData%Jac_y_idxStartList, DstLinParamsData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcLinParamsData%du)) then - LB(1:1) = lbound(SrcLinParamsData%du, kind=B8Ki) - UB(1:1) = ubound(SrcLinParamsData%du, kind=B8Ki) - if (.not. allocated(DstLinParamsData%du)) then - allocate(DstLinParamsData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinParamsData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinParamsData%du = SrcLinParamsData%du - end if - DstLinParamsData%Jac_nu = SrcLinParamsData%Jac_nu - DstLinParamsData%Jac_ny = SrcLinParamsData%Jac_ny -end subroutine - -subroutine SeaSt_DestroyLinParams(LinParamsData, ErrStat, ErrMsg) - type(SeaSt_LinParams), intent(inout) :: LinParamsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_DestroyLinParams' - ErrStat = ErrID_None - ErrMsg = '' - call SeaSt_DestroyJac_u_idxStarts(LinParamsData%Jac_u_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyJac_y_idxStarts(LinParamsData%Jac_y_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(LinParamsData%du)) then - deallocate(LinParamsData%du) - end if -end subroutine - -subroutine SeaSt_PackLinParams(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_LinParams), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_PackLinParams' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%NumExtendedInputs) - call RegPack(RF, InData%NumExtendedOutputs) - call SeaSt_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) - call SeaSt_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) - call RegPackAlloc(RF, InData%du) - call RegPack(RF, InData%Jac_nu) - call RegPack(RF, InData%Jac_ny) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_UnPackLinParams(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_LinParams), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_UnPackLinParams' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumExtendedOutputs); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList - call SeaSt_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_ParameterType), intent(in) :: SrcParamData type(SeaSt_ParameterType), intent(inout) :: DstParamData @@ -1205,6 +907,21 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'SeaSt_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + DstParamData%iVarWave1ElevU = SrcParamData%iVarWave1ElevU + DstParamData%iVarWave1ElevY = SrcParamData%iVarWave1ElevY + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput DstParamData%WaveDT = SrcParamData%WaveDT DstParamData%NGridPts = SrcParamData%NGridPts DstParamData%NGrid = SrcParamData%NGrid @@ -1306,9 +1023,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - call SeaSt_CopyLinParams(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -1322,6 +1036,12 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%WaveElevxi)) then deallocate(ParamData%WaveElevxi) end if @@ -1352,8 +1072,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveField) ParamData%WaveField => null() end if - call SeaSt_DestroyLinParams(ParamData%LinParams, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SeaSt_PackParam(RF, Indata) @@ -1364,6 +1082,16 @@ subroutine SeaSt_PackParam(RF, Indata) integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarWave1ElevU) + call RegPack(RF, InData%iVarWave1ElevY) + call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%WaveDT) call RegPack(RF, InData%NGridPts) call RegPack(RF, InData%NGrid) @@ -1398,7 +1126,6 @@ subroutine SeaSt_PackParam(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - call SeaSt_PackLinParams(RF, InData%LinParams) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1413,6 +1140,27 @@ subroutine SeaSt_UnPackParam(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarWave1ElevU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWave1ElevY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveDT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NGridPts); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NGrid); if (RegCheckErr(RF, RoutineName)) return @@ -1462,7 +1210,6 @@ subroutine SeaSt_UnPackParam(RF, OutData) else OutData%WaveField => null() end if - call SeaSt_UnpackLinParams(RF, OutData%LinParams) ! LinParams end subroutine subroutine SeaSt_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1560,6 +1307,82 @@ subroutine SeaSt_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SeaSt_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Decimate) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%LastIndWave) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SeaSt_PackInput(RF, InData%u_perturb) + call SeaSt_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SeaSt_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SeaSt_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + function SeaSt_InputMeshPointer(u, ML) result(Mesh) type(SeaSt_InputType), target, intent(in) :: u type(MeshLocType), intent(in) :: ML From ecc860535f2cae8c284d3eaf5e3c02f8cb795c9d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 23 May 2024 22:20:21 +0000 Subject: [PATCH 131/319] Revised quaternion handling in BeamDyn --- modules/beamdyn/src/BeamDyn.f90 | 14 +- modules/nwtc-library/src/ModVar.f90 | 273 ++++++++++++++++++---------- 2 files changed, 190 insertions(+), 97 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index cf1e3f35b1..90b89bc8f7 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -6013,6 +6013,7 @@ subroutine BD_PackContStateQuatOP(p, x, Values) type(BD_ParameterType), intent(in) :: p type(BD_ContinuousStateType), intent(in) :: x real(R8Ki), intent(out) :: Values(:) + real(R8Ki) :: quat(3) integer(IntKi) :: i do i = 1, size(p%Vars%x) associate (Var => p%Vars%x(i)) @@ -6020,7 +6021,8 @@ subroutine BD_PackContStateQuatOP(p, x, Values) case (VF_TransDisp) Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ displacement case (VF_Orientation) - Values(Var%iLoc(1):Var%iLoc(2)) = wm_to_quat(x%q(4:6,Var%iUsr(1))) ! WM to quaternion + quat = wm_to_quat(wm_inv(x%q(4:6,Var%iUsr(1)))) + Values(Var%iLoc(1):Var%iLoc(2)) = quat ! WM to quaternion case (VF_TransVel) Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ velocity case (VF_AngularVel) @@ -6034,6 +6036,7 @@ subroutine BD_UnpackContStateQuatOP(p, Values, x) type(BD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Values(:) type(BD_ContinuousStateType), intent(inout) :: x + real(R8Ki) :: wm(3) integer(IntKi) :: i do i = 1, size(p%Vars%x) associate (Var => p%Vars%x(i)) @@ -6041,7 +6044,8 @@ subroutine BD_UnpackContStateQuatOP(p, Values, x) case (VF_TransDisp) x%q(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ displacement case (VF_Orientation) - x%q(4:6,Var%iUsr(1)) = quat_to_wm(Values(Var%iLoc(1):Var%iLoc(2))) ! Quaternion to WM + wm = wm_inv(quat_to_wm(Values(Var%iLoc(1):Var%iLoc(2)))) + x%q(4:6,Var%iUsr(1)) = wm ! Quaternion to WM case (VF_TransVel) x%dqdt(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ velocity case (VF_AngularVel) @@ -6178,6 +6182,9 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%u(i)%Num + ! Calculate column index + col = p%Vars%u(i)%iLoc(1) + j - 1 + ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) @@ -6190,9 +6197,6 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return call BD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) - ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 - ! Get partial derivative via central difference and store in full linearization array call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 26f62404a8..26a6ca8cef 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -35,8 +35,9 @@ module ModVar public :: MV_AddVar, MV_AddMeshVar public :: MV_HasFlags, MV_SetFlags, MV_UnsetFlags, MV_NumVars public :: LoadFields, MotionFields, TransFields, AngularFields -public :: quat_to_dcm, quat_compose, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm +public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv public :: MV_FieldString, IdxStr +public :: DumpMatrix integer(IntKi), parameter :: & LoadFields(*) = [VF_Force, VF_Moment], & @@ -457,7 +458,7 @@ subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) integer(IntKi), intent(in) :: iVar type(MeshType), intent(in) :: Mesh real(R8Ki), intent(inout) :: Values(:) - integer(IntKi) :: MeshID, i, j + integer(IntKi) :: MeshID, i, j, k if (iVar == 0) return MeshID = VarAry(iVar)%MeshID do i = iVar, size(VarAry) @@ -471,8 +472,10 @@ subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) case (VF_TransDisp) Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationDisp, .true.) case (VF_Orientation) + k = iLoc(1) do j = 1, VarAry(i)%Nodes - Values(iLoc(1) + 3*(j - 1):iLoc(1) + 3*j) = dcm_to_quat(Mesh%Orientation(:, :, j)) + Values(k:k + 2) = dcm_to_quat(Mesh%Orientation(:, :, j)) + k = k + 3 end do case (VF_TransVel) Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationVel, .true.) @@ -494,7 +497,7 @@ subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) integer(IntKi), intent(in) :: iVar real(R8Ki), intent(in) :: Values(:) type(MeshType), intent(inout) :: Mesh - integer(IntKi) :: MeshID, i, j + integer(IntKi) :: MeshID, i, j, k if (iVar == 0) return MeshID = VarAry(iVar)%MeshID do i = iVar, size(VarAry) @@ -508,8 +511,10 @@ subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) case (VF_TransDisp) Mesh%TranslationDisp = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationDisp)) case (VF_Orientation) + k = iLoc(1) do j = 1, VarAry(i)%Nodes - Mesh%Orientation(:, :, j) = quat_to_dcm(Values(iLoc(1) + 3*(j - 1):iLoc(1) + 3*j)) + Mesh%Orientation(:, :, j) = quat_to_dcm(Values(k:k + 2)) + k = k + 3 end do case (VF_TransVel) Mesh%TranslationVel = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationVel)) @@ -534,7 +539,7 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) real(R8Ki), intent(inout) :: PerturbAry(:) real(R8Ki) :: Perturb - real(R8Ki) :: quat(3), quat_p(3), rotvec(3) + real(R8Ki) :: quat(3), quat_p(3) integer(IntKi) :: i, j ! Copy base array to perturbed array @@ -548,13 +553,14 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) ! If variable field is orientation, perturbation is in radians if (Var%Field == VF_Orientation) then - j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) - quat_p = perturb_quat(Perturb, j + 1) ! Quaternion of perturbed angle - i = i - j ! index of start of quaternion parameters (3) - quat = BaseAry(i:i + 2) ! Current quat parameters value - PerturbAry(i:i + 2) = quat_compose(quat_p, quat) ! Compose perturbation and current rotation + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + quat_p = perturb_quat(Perturb, j + 1) ! Quaternion of perturbed angle + i = i - j ! index of start of quaternion parameters (3) + quat = BaseAry(i:i + 2) ! Current quat parameters value + quat = quat_compose(quat, quat_p) ! Compose perturbation and current rotation + PerturbAry(i:i + 2) = quat ! Save perturbed quaternion in array else - PerturbAry(i) = PerturbAry(i) + Perturb ! Add perturbation directly + PerturbAry(i) = PerturbAry(i) + Perturb ! Add perturbation directly end if end subroutine @@ -576,12 +582,12 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) ! If variable field is orientation if (VarAry(i)%Field == VF_Orientation) then + ! Starting index into arrays + k = VarAry(i)%iLoc(1) + ! Loop through nodes do j = 1, VarAry(i)%Nodes - ! Get vector of indices of rotation parameters in array - k = VarAry(i)%iLoc(1) + 3*(j - 1) - ! Quaternions from negative and positive perturbations quat_neg = NegAry(k:k + 2) quat_pos = PosAry(k:k + 2) @@ -596,14 +602,17 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) else ! Calculate relative rotation from negative to positive perturbation - delta = quat_compose(quat_pos, quat_inv(quat_neg)) + delta = quat_compose(-quat_neg, quat_pos) ! Convert relative rotation from quaternion to rotation vector - DiffAry(k:k + 2) = GetSmllRotAngs(quat_to_dcm(delta), ErrStat, ErrMsg) - + DiffAry(k:k + 2) = GetSmllRotAngs(quat_to_dcm(delta), ErrStat, ErrMsg) + ! DiffAry(k:k + 2) = quat_to_rvec(delta) end if + ! Increment starting index + k = k + 3 + end do else @@ -866,40 +875,128 @@ pure function quat_canonical(q0, q) result(qc) end do end function -pure function dcm_to_quat(dcm) result(q) +function dcm_to_quat(dcm) result(q) real(R8Ki), intent(in) :: dcm(3, 3) - real(R8Ki) :: q(3), R(3, 3), C, s, tr, q0 - - R = transpose(dcm) - - tr = R(1, 1) + R(2, 2) + R(3, 3) - - if (tr > 0.0_R8Ki) then - s = 0.5_R8Ki/sqrt(tr + 1.0_R8Ki) - q0 = 0.25_R8Ki/s - q(1) = (R(3, 2) - R(2, 3))*s - q(2) = (R(1, 3) - R(3, 1))*s - q(3) = (R(2, 1) - R(1, 2))*s - else if (R(1, 1) > R(2, 2) .and. R(1, 1) > R(3, 3)) then - s = 2.0_R8Ki*sqrt(1.0_R8Ki + R(1, 1) - R(2, 2) - R(3, 3)) - q0 = (R(3, 2) - R(2, 3))/s - q(1) = 0.25_R8Ki*s - q(2) = (R(1, 2) + R(2, 1))/s - q(3) = (R(1, 3) + R(3, 1))/s - elseif (R(2, 2) > R(3, 3)) then - s = 2.0_R8Ki*sqrt(1.0_R8Ki + R(2, 2) - R(1, 1) - R(3, 3)) - q0 = (R(1, 3) - R(3, 1))/s - q(1) = (R(1, 2) + R(2, 1))/s - q(2) = 0.25_R8Ki*s - q(3) = (R(2, 3) + R(3, 2))/s + real(R8Ki) :: q(3) + real(R8Ki) :: t, s, qw + + ! Trace of matrix + t = dcm(1, 1) + dcm(2, 2) + dcm(3, 3) + + if (t > 0.0) then + s = 0.5/sqrt(t + 1.0) + qw = 0.25/s + q(1) = (dcm(3, 2) - dcm(2, 3))*s + q(2) = (dcm(1, 3) - dcm(3, 1))*s + q(3) = (dcm(2, 1) - dcm(1, 2))*s + else if (dcm(1, 1) > dcm(2, 2) .and. dcm(1, 1) > dcm(3, 3)) then + s = 2.0*sqrt(1.0 + dcm(1, 1) - dcm(2, 2) - dcm(3, 3)) + qw = (dcm(3, 2) - dcm(2, 3))/s + q(1) = 0.25*s + q(2) = (dcm(1, 2) + dcm(2, 1))/s + q(3) = (dcm(1, 3) + dcm(3, 1))/s + else if (dcm(2, 2) > dcm(3, 3)) then + s = 2.0*sqrt(1.0 + dcm(2, 2) - dcm(1, 1) - dcm(3, 3)) + qw = (dcm(1, 3) - dcm(3, 1))/s + q(1) = (dcm(1, 2) + dcm(2, 1))/s + q(2) = 0.25*s + q(3) = (dcm(2, 3) + dcm(3, 2))/s else - s = 2.0_R8Ki*sqrt(1.0_R8Ki + R(3, 3) - R(1, 1) - R(2, 2)) - q0 = (R(2, 1) - R(1, 2))/s - q(1) = (R(1, 3) + R(3, 1))/s - q(2) = (R(2, 3) + R(3, 2))/s - q(3) = 0.25_R8Ki*s + s = 2.0*sqrt(1.0 + dcm(3, 3) - dcm(1, 1) - dcm(2, 2)) + qw = (dcm(2, 1) - dcm(1, 2))/s + q(1) = (dcm(1, 3) + dcm(3, 1))/s + q(2) = (dcm(2, 3) + dcm(3, 2))/s + q(3) = 0.25*s end if - q = quat_canonical(q0, q) + + q = quat_canonical(qw, q) +end function + +! dcm_to_quat2 returns a quaternion from a DCM based on eigenanalysis +! https://en.wikipedia.org/wiki/Rotation_matrix#Quaternion +function dcm_to_quat2(dcm) result(q) + real(R8Ki), intent(in) :: dcm(3, 3) + real(R8Ki) :: q(3) + integer(IntKi), parameter :: n = 4 + real(R8Ki) :: Qxx, Qxy, Qxz, Qyx, Qyy, Qyz, Qzx, Qzy, Qzz + real(R8Ki) :: A(n, n), wr(n), wi(n), vl(n, n), vr(n, n), work(4*n) + integer(IntKi) :: info, lwork, i + + Qxx = dcm(1, 1) + Qyx = dcm(2, 1) + Qzx = dcm(3, 1) + Qxy = dcm(1, 2) + Qyy = dcm(2, 2) + Qzy = dcm(3, 2) + Qxz = dcm(1, 3) + Qyz = dcm(2, 3) + Qzz = dcm(3, 3) + + A(:,1) = [Qxx - Qyy - Qzz, Qyx + Qxy, Qzx + Qxz, Qzy - Qyz]/ 3.0_R8Ki + A(:,2) = [Qyx + Qxy, Qyy - Qxx - Qzz, Qzy + Qyz, Qxz - Qzx]/ 3.0_R8Ki + A(:,3) = [Qzx + Qxz, Qzy + Qyz, Qzz - Qxx - Qyy, Qyx - Qxy]/ 3.0_R8Ki + A(:,4) = [Qzy - Qyz, Qxz - Qzx, Qyx - Qxy, Qxx + Qyy + Qzz]/ 3.0_R8Ki + + lwork = 4*n + + call dgeev('N', 'V', n, A, n, wr, wi, vl, n, vr, n, work, lwork, info) + + ! If error calculating eigenvector/eigenvalues + if (info /= 0) then + q = 0.0_R8Ki + return + end if + + ! Get index of maximum real eigenvalue + i = maxloc(wr, dim=1) + + ! Canonical form of quaternion + q = quat_canonical(vr(4,i), vr(1:3,i)) +end function + +! quat_to_dcm returns a dcm based on the quaternion where q is a unit quaternion with a positive scalar component +! https://en.wikipedia.org/wiki/Quaternions_and_spatial_rotation#Quaternion-derived_rotation_matrix +pure function quat_to_dcm(q) result(dcm) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: dcm(3, 3) + real(R8Ki) :: w, ww, xx, yy, zz, n, s + real(R8Ki) :: xy, yz, xz, wx, wy, wz + + ! Calculate scalar component + w = sqrt(1.0_R8Ki - dot_product(q, q)) + + ww = w*w + xx = q(1)*q(1) + yy = q(2)*q(2) + zz = q(3)*q(3) + + xy = q(1)*q(2) + yz = q(2)*q(3) + xz = q(1)*q(3) + + wx = q(1)*w + wy = q(2)*w + wz = q(3)*w + + n = ww + xx + yy + zz + if (n < epsilon(n)) then + s = 0.0_R8Ki + else + s = 2.0_R8Ki/n + end if + + dcm(1, 1) = 1.0_R8Ki - s*(yy + zz) + dcm(2, 1) = s*(xy + wz) + dcm(3, 1) = s*(xz - wy) + + dcm(1, 2) = s*(xy - wz) + dcm(2, 2) = 1.0_R8Ki - s*(xx + zz) + dcm(3, 2) = s*(yz + wx) + + dcm(1, 3) = s*(xz + wy) + dcm(2, 3) = s*(yz - wx) + dcm(3, 3) = 1.0_R8Ki - s*(xx + yy) + end function pure function quat_compose(q1, q2) result(q) @@ -924,18 +1021,21 @@ pure function quat_inv(q) result(qi) qi = -q end function +! https://en.wikipedia.org/wiki/Quaternions_and_spatial_rotation#Recovering_the_axis-angle_representation pure function quat_to_rvec(q) result(rvec) real(R8Ki), intent(in) :: q(3) - real(R8Ki) :: q0, theta, tmp, rvec(3) - q0 = sqrt(1.0_R8Ki - dot_product(q, q)) - theta = 2.0_R8Ki*acos(q0) - tmp = sqrt(1.0_R8Ki - q0*q0) - if (tmp < epsilon(tmp)) then + real(R8Ki) :: qr, theta, tmp, rvec(3), m + + ! Magnitude of imaginary part + m = sqrt(dot_product(q, q)) + + ! If this is an identity quaternion, qr == 1, rotation vector is zero + if (m < epsilon(m)) then rvec = 0.0_R8Ki else - rvec(1) = theta*q(1)/tmp - rvec(2) = theta*q(2)/tmp - rvec(3) = theta*q(3)/tmp + qr = sqrt(1.0_R8Ki - m*m) ! Scalar part + theta = 2.0_R8Ki*atan2(m, qr) ! Angle + rvec = theta*q/m end if end function @@ -948,41 +1048,6 @@ pure function rvec_to_quat(rvec) result(q) q = quat_canonical(q0, q) end function -pure function quat_to_dcm(q) result(dcm) - real(R8Ki), intent(in) :: q(3) - real(R8Ki) :: dcm(3, 3) - real(R8Ki) :: q0, q0q0, q1q1, q2q2, q3q3 - real(R8Ki) :: q1q2, q2q3, q1q3, q0q1, q0q2, q0q3 - - ! q is assumed to be a unit quaternion - q0 = sqrt(1.0_R8Ki - dot_product(q, q)) - - q0q0 = q0*q0 - q1q1 = q(1)*q(1) - q2q2 = q(2)*q(2) - q3q3 = q(3)*q(3) - - q1q2 = q(1)*q(2) - q2q3 = q(2)*q(3) - q1q3 = q(1)*q(3) - - q0q1 = q0*q(1) - q0q2 = q0*q(2) - q0q3 = q0*q(3) - - dcm(1, 1) = q0q0 + q1q1 - q2q2 - q3q3 - dcm(2, 1) = 2.0_R8Ki*(q1q2 - q0q3) - dcm(3, 1) = 2.0_R8Ki*(q1q3 + q0q2) - - dcm(1, 2) = 2.0_R8Ki*(q1q2 + q0q3) - dcm(2, 2) = q0q0 - q1q1 + q2q2 - q3q3 - dcm(3, 2) = 2.0_R8Ki*(q2q3 - q0q1) - - dcm(1, 3) = 2.0_R8Ki*(q1q3 - q0q2) - dcm(2, 3) = 2.0_R8Ki*(q2q3 + q0q1) - dcm(3, 3) = q0q0 - q1q1 - q2q2 + q3q3 -end function - pure function wm_to_quat(c) result(q) real(R8Ki), intent(in) :: c(3) real(R8Ki) :: c0, q0, q(3) @@ -1012,4 +1077,28 @@ pure function cross(a, b) result(c) c = [a(2)*b(3) - a(3)*b(2), a(3)*b(1) - a(1)*b(3), a(1)*b(2) - b(1)*a(2)] end function +!------------------------------------------------------------------------------- +! Debugging +!------------------------------------------------------------------------------- + +subroutine DumpMatrix(unit, filename, A, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: unit + character(*), intent(in) :: filename + real(R8Ki), intent(in) :: A(:, :) + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'DumpMatrix' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + call OpenBOutFile(unit, filename, ErrStat2, ErrMsg2) + write (unit) int(shape(A), B4Ki) + write (unit) pack(A, .true.) + close (unit) +end subroutine + end module From c232ec4a40f34bc1d1944e01ca7e64bb8ffdb7a5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 23 May 2024 23:24:22 +0000 Subject: [PATCH 132/319] Fix bug where SeaState variables weren't being initialized --- modules/seastate/src/SeaState.f90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index ea845d0ccc..0b169ee079 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -334,13 +334,13 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init call SetErrStat( ErrID_Fatal, 'Constrained wave conditions cannot be used for linearization. Set ConstWaveMod=0.', ErrStat, ErrMsg, RoutineName ) end if - ! set the Jacobian info if we don't have a fatal error - if (ErrStat < AbortErrLev) then - call SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) - if (Failed()) return - endif end if + ! Initialize module variables if we don't have a fatal error + if (ErrStat < AbortErrLev) then + call SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + endif ! Destroy the local initialization data CALL CleanUp() @@ -1026,12 +1026,12 @@ subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_ type(SeaSt_MiscVarType), intent(inout) :: m !< Misc/optimization variables integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(ReKi), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs - real(ReKi), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs - real(ReKi), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states - real(ReKi), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states - real(ReKi), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states - real(ReKi), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states + real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs + real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states + real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states integer(IntKi) :: idxStart, idxEnd integer(IntKi) :: ErrStat2 From 48d7df1002fd955dfdedd681544da1b3f98a54ba Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 23 May 2024 23:29:35 +0000 Subject: [PATCH 133/319] Variable Perturb was wrong type in SeaState --- modules/seastate/src/SeaState.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 0b169ee079..0a54ee831f 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -495,7 +495,7 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS call MV_AddVar(p%Vars%u, "Wave1Elev", VF_Scalar, & VarIdx=p%iVarWave1ElevU, & Flags=VF_ExtLin, & - Perturb=0.02_ReKi * Pi / 180.0_ReKi * max(1.0_ReKi, p%WaveField%WtrDpth), & + Perturb=0.02_R8Ki * Pi / 180.0_R8Ki * max(1.0_R8Ki, p%WaveField%WtrDpth), & LinNames=['Extended input: wave elevation at platform ref point, m']) From c32d196172e88803f1dfbf5accb80ec4745a5828 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 23 May 2024 23:30:07 +0000 Subject: [PATCH 134/319] Attempt to remove uninitialized variables from FAST_Mapping and FAST_ModGlue --- modules/openfast-library/src/FAST_Mapping.f90 | 23 +++++----- modules/openfast-library/src/FAST_ModGlue.f90 | 43 +++++++------------ 2 files changed, 25 insertions(+), 41 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 2864040440..3080a04b01 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1630,24 +1630,21 @@ logical function Failed() ! IsSiblingMesh returns true if MeshB is a sibling of MeshA ! (can't just check pointers as they won't match after restart, ! also there can only be one sibling mesh so doesn't work for cousins) - logical function IsSiblingMesh(MeshA, MeshB) + pure logical function IsSiblingMesh(MeshA, MeshB) type(MeshType), intent(in) :: MeshA, MeshB integer(IntKi) :: i, j - IsSiblingMesh = (MeshA%Nnodes == MeshB%Nnodes) - if (.not. IsSiblingMesh) return - IsSiblingMesh = IsSiblingMesh .and. & - all(MeshA%Position == MeshB%Position) .and. & - all(MeshA%RefOrientation == MeshB%RefOrientation) + IsSiblingMesh = .false. + if (MeshA%Nnodes /= MeshB%Nnodes) return + if (any(MeshA%Position /= MeshB%Position)) return + if (any(MeshA%RefOrientation /= MeshB%RefOrientation)) return do i = 1, NELEMKINDS - IsSiblingMesh = IsSiblingMesh .and. & - (MeshA%ElemTable(i)%nelem == MeshB%ElemTable(i)%nelem) .and. & - (MeshA%ElemTable(i)%XElement == MeshB%ElemTable(i)%XElement) - if (.not. IsSiblingMesh) return + if (MeshA%ElemTable(i)%nelem /= MeshB%ElemTable(i)%nelem) return + if (MeshA%ElemTable(i)%XElement /= MeshB%ElemTable(i)%XElement) return do j = 1, MeshA%ElemTable(i)%nelem - IsSiblingMesh = IsSiblingMesh .and. all(MeshA%ElemTable(i)%Elements(j)%ElemNodes == & - MeshB%ElemTable(i)%Elements(j)%ElemNodes) + if (any(MeshA%ElemTable(i)%Elements(j)%ElemNodes /= MeshB%ElemTable(i)%Elements(j)%ElemNodes)) return end do end do + IsSiblingMesh = .true. end function end subroutine @@ -1932,7 +1929,7 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrSta else if (nLocDst == 1) then ! Source and destination have one location dUdy(iLocDst(1), iLocSrc(1)) = -1.0_R8Ki - else + else ! One source location to many destination locations dUdy(iLocDst(1):iLocDst(2), iLocSrc(1)) = -1.0_R8Ki end if diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 8fdca6b100..4d234afc9d 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -437,34 +437,10 @@ subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_ end if ! Check for NaNs or infinity in module Jacobian matrices - if (allocated(ModData%Lin%dYdu)) then - if (any(isnan(ModData%Lin%dYdu))) then - ErrStat = ErrID_Fatal - ErrMsg = 'NaNs detected in dYdu for module '//ModData%Abbr - return - end if - end if - if (allocated(ModData%Lin%dXdu)) then - if (any(isnan(ModData%Lin%dXdu))) then - ErrStat = ErrID_Fatal - ErrMsg = 'NaNs detected in dXdu for module '//ModData%Abbr - return - end if - end if - if (allocated(ModData%Lin%dYdx)) then - if (any(isnan(ModData%Lin%dYdx))) then - ErrStat = ErrID_Fatal - ErrMsg = 'NaNs detected in dYdx for module '//ModData%Abbr - return - end if - end if - if (allocated(ModData%Lin%dXdx)) then - if (any(isnan(ModData%Lin%dXdx))) then - ErrStat = ErrID_Fatal - ErrMsg = 'NaNs detected in dXdx for module '//ModData%Abbr - return - end if - end if + if (JacobianHasNaNs(ModData%Lin%dYdu, "dYdu", ModData%Abbr)) return + if (JacobianHasNaNs(ModData%Lin%dXdu, "dXdu", ModData%Abbr)) return + if (JacobianHasNaNs(ModData%Lin%dYdx, "dYdx", ModData%Abbr)) return + if (JacobianHasNaNs(ModData%Lin%dXdx, "dXdx", ModData%Abbr)) return end associate end do @@ -488,6 +464,17 @@ subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_ m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 contains + logical function JacobianHasNaNs(Jac, label, abbr) + real(R8Ki), allocatable, intent(in) :: Jac(:,:) + character(*), intent(in) :: label, abbr + JacobianHasNaNs = .false. + if (.not. allocated(Jac)) return + if (size(Jac) == 0) return + if (.not. any(isnan(Jac))) return + ErrStat = ErrID_Fatal + ErrMsg = 'NaNs detected in dXdx for module '//abbr + JacobianHasNaNs = .true. + end function logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev From 76a0bba0f2232fccacb8e9b07117c669afaaa738 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 24 May 2024 14:57:59 +0000 Subject: [PATCH 135/319] Fix extending WaveElev0 input/output name in SeaState --- modules/openfast-library/src/FAST_Mapping.f90 | 39 ++++++++++++++++++- modules/seastate/src/SeaState.f90 | 15 ++++--- modules/seastate/src/SeaState.txt | 4 +- modules/seastate/src/SeaState_Types.f90 | 16 ++++---- 4 files changed, 54 insertions(+), 20 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 3080a04b01..9c2dfe5102 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -391,7 +391,7 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) case (Module_SD) call InitMappings_SD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SeaSt) - ! call InitMappings_SeaSt(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_SeaSt(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SrvD) call InitMappings_SrvD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) end select @@ -1039,6 +1039,13 @@ subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return + case (Module_SeaSt) + + call MapVariable(Mappings, "SEA WaveElev0 -> HD WaveElev0", & + SrcMod=SrcMod, iVarSrc=Turbine%SeaSt%p%iVarWaveElev0Y, & + DstMod=DstMod, iVarDst=Turbine%HD%p%iVarWaveElev0, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -1286,7 +1293,7 @@ subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'InitMappings_BD' + character(*), parameter :: RoutineName = 'InitMappings_SD' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j @@ -1387,6 +1394,34 @@ logical function Failed() end function end subroutine +subroutine InitMappings_SeaSt(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(TC_MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(in) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_SeaSt' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + ! No inputs to SeaState currently + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(TC_MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 0a54ee831f..67ec7cb012 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -492,20 +492,19 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS !---------------------------------------------------------------------------- ! Extended input - call MV_AddVar(p%Vars%u, "Wave1Elev", VF_Scalar, & - VarIdx=p%iVarWave1ElevU, & + call MV_AddVar(p%Vars%u, "WaveElev0", VF_Scalar, & + VarIdx=p%iVarWaveElev0U, & Flags=VF_ExtLin, & Perturb=0.02_R8Ki * Pi / 180.0_R8Ki * max(1.0_R8Ki, p%WaveField%WtrDpth), & LinNames=['Extended input: wave elevation at platform ref point, m']) - !---------------------------------------------------------------------------- ! Output variables !---------------------------------------------------------------------------- ! Extended output - call MV_AddVar(p%Vars%y, "Wave1Elev", VF_Scalar, & - VarIdx=p%iVarWave1ElevY, & + call MV_AddVar(p%Vars%y, "WaveElev0", VF_Scalar, & + VarIdx=p%iVarWaveElev0Y, & Flags=VF_ExtLin, & LinNames=['Extended output: wave elevation at platform ref point, m']) @@ -863,7 +862,7 @@ subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, E dYdu = 0.0_R8Ki ! Extended input to extended output (direct pass-through) - dYdu(p%Vars%y(p%iVarWave1ElevY)%iLoc(1), p%Vars%u(p%iVarWave1ElevU)%iLoc(1)) = 1.0_R8Ki + dYdu(p%Vars%y(p%iVarWaveElev0Y)%iLoc(1), p%Vars%u(p%iVarWaveElev0U)%iLoc(1)) = 1.0_R8Ki ! It isn't possible to determine the relationship between the extended input and the WrOuts. So we leave them all zero. @@ -1049,7 +1048,7 @@ subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_ end if ! no regular inputs, only extended input - u_op(p%Vars%u(p%iVarWave1ElevU)%iLoc(1)) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + u_op(p%Vars%u(p%iVarWaveElev0U)%iLoc(1)) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements ! NOTE: if more extended inputs are added, place them here end if @@ -1061,7 +1060,7 @@ subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_ end if ! no regular outputs, only extended output and WrOuts - y_op(p%Vars%y(p%iVarWave1ElevY)%iLoc(1)) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + y_op(p%Vars%y(p%iVarWaveElev0Y)%iLoc(1)) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, y_op) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 9948d78d58..7702df698c 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -122,8 +122,8 @@ typedef ^ OtherStateType R8Ki Unu # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ^ IntKi iVarWave1ElevU - - - "Index of Wave1Elev input variable" - -typedef ^ ^ IntKi iVarWave1ElevY - - - "Index of Wave1Elev output variable" - +typedef ^ ^ IntKi iVarWaveElev0U - - - "Index of WaveElev0 input variable" - +typedef ^ ^ IntKi iVarWaveElev0Y - - - "Index of WaveElev0 output variable" - typedef ^ ^ IntKi iVarWriteOutput - - - "Index of WriteOutput variable" - typedef ^ ^ DbKi WaveDT - - - "Wave DT" sec typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 1460c577fc..d98278538b 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -140,8 +140,8 @@ MODULE SeaState_Types ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarWave1ElevU = 0_IntKi !< Index of Wave1Elev input variable [-] - INTEGER(IntKi) :: iVarWave1ElevY = 0_IntKi !< Index of Wave1Elev output variable [-] + INTEGER(IntKi) :: iVarWaveElev0U = 0_IntKi !< Index of WaveElev0 input variable [-] + INTEGER(IntKi) :: iVarWaveElev0Y = 0_IntKi !< Index of WaveElev0 output variable [-] INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Index of WriteOutput variable [-] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] @@ -919,8 +919,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarWave1ElevU = SrcParamData%iVarWave1ElevU - DstParamData%iVarWave1ElevY = SrcParamData%iVarWave1ElevY + DstParamData%iVarWaveElev0U = SrcParamData%iVarWaveElev0U + DstParamData%iVarWaveElev0Y = SrcParamData%iVarWaveElev0Y DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput DstParamData%WaveDT = SrcParamData%WaveDT DstParamData%NGridPts = SrcParamData%NGridPts @@ -1089,8 +1089,8 @@ subroutine SeaSt_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarWave1ElevU) - call RegPack(RF, InData%iVarWave1ElevY) + call RegPack(RF, InData%iVarWaveElev0U) + call RegPack(RF, InData%iVarWaveElev0Y) call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%WaveDT) call RegPack(RF, InData%NGridPts) @@ -1158,8 +1158,8 @@ subroutine SeaSt_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarWave1ElevU); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWave1ElevY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWaveElev0U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWaveElev0Y); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveDT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NGridPts); if (RegCheckErr(RF, RoutineName)) return From ab1ad26113c04101d84175abf499e0800d892f28 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 24 May 2024 14:58:56 +0000 Subject: [PATCH 136/319] Fix indexing in dXdu in HydroDyn for new extended inputs --- modules/hydrodyn/src/HydroDyn.f90 | 28 ++++++++++------------------ 1 file changed, 10 insertions(+), 18 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 0cffb8e483..ba7e4feae0 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -1741,12 +1741,8 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! If variable flag not in flag filter, skip if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle - ! If this index is extended input - if (i == p%iVarWaveElev0 .or. i == p%iVarHWindSpeed .or. & - i == p%iVarPLexp .or. i == p%iVarPropagationDir) then - dYdu(:, p%Vars%u(i)%iLoc(1)) = 0 - cycle - end if + ! If variable is extended input, skip + if (MV_HasFlags(p%Vars%u(i), VF_ExtLin)) cycle ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%u(i)%Num @@ -1771,13 +1767,11 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end do end do - !------------------- - ! extended inputs - ! WaveElev0 column -- from SeaState - ! dYdu(:,n_du_norm+1) = 0.0_ReKi - - ! HWindSpeed / PLexp / PropagationDir -- from Ifw/FlowField for turbulent sea current - ! dYdu(:,n_du_norm+2:n_du_norm+4) = 0.0_ReKi + ! Set extended inputs + dYdu(:, p%Vars%u(p%iVarWaveElev0)%iLoc(1)) = 0.0_R8Ki + dYdu(:, p%Vars%u(p%iVarHWindSpeed)%iLoc(1)) = 0.0_R8Ki + dYdu(:, p%Vars%u(p%iVarPLexp)%iLoc(1)) = 0.0_R8Ki + dYdu(:, p%Vars%u(p%iVarPropagationDir)%iLoc(1)) = 0.0_R8Ki END IF @@ -1804,7 +1798,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end do startingI = p%totalStates - p%totalRdtnStates - startingJ = p%Vars%Nu - 1 - 18 - 4*3*p%NBody ! subtract 1 for WaveElev0, then 6*3 for PRPMesh and then 4*3*NBody to place us at the beginning of the velocity inputs + startingJ = p%Vars%Nu - 4 - 18 - 4*3*p%NBody ! subtract 4 for extended inputs and 4*3*NBody to place us at the beginning of the velocity inputs ! B is numStates by 6*NBody where NBody =1 if NBodyMod=2 or 3, but could be >1 for NBodyMod=1 if ( p%NBodyMod == 1 ) then ! Example for NBodyMod=1 and NBody = 2, @@ -1988,9 +1982,8 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if - IF ( PRESENT( dXdx ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + IF (present(dXdx)) then ! allocate dXdu if necessary if (.not. allocated(dXdx)) then @@ -2240,7 +2233,6 @@ logical function Failed() end function Failed END SUBROUTINE HD_GetOP - subroutine HD_PackStateValues(p, x, ary) type(HydroDyn_ParameterType), intent(in) :: p type(HydroDyn_ContinuousStateType), intent(in) :: x From b8f2c6b253252d974d19f7069872df653f3c9b38 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 24 May 2024 16:54:17 +0000 Subject: [PATCH 137/319] Reduce memory usage in fast_linearization_file.py when reading matrices --- reg_tests/lib/fast_linearization_file.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/reg_tests/lib/fast_linearization_file.py b/reg_tests/lib/fast_linearization_file.py index bda25b1ba2..7613f4dbf7 100644 --- a/reg_tests/lib/fast_linearization_file.py +++ b/reg_tests/lib/fast_linearization_file.py @@ -112,7 +112,9 @@ def readMat(fid, n, m, name=''): # Read rows from file, raise exception on failure try: - vals = np.genfromtxt(fid, dtype=np.float64, max_rows=n) + vals = np.empty([n,m], np.float64) + for i in range(n): + vals[i,:] = f.readline().split() except: raise Exception('Failed to convert into an array of float the matrix `{}`\n\tin linfile: {}'.format(name, self.filename)) From f9d9241edbbdaf32a0389595fa9233acd0f0629f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 28 May 2024 14:26:14 +0000 Subject: [PATCH 138/319] Add Glue_Registry.txt to store new glue code structures, change FAST to use new structures --- modules/nwtc-library/src/ModVar.f90 | 66 +- modules/openfast-library/CMakeLists.txt | 2 + modules/openfast-library/src/FAST_Funcs.f90 | 2 +- modules/openfast-library/src/FAST_Idx.f90 | 2 +- modules/openfast-library/src/FAST_Mapping.f90 | 66 +- modules/openfast-library/src/FAST_ModGlue.f90 | 250 +- .../openfast-library/src/FAST_Registry.txt | 183 +- modules/openfast-library/src/FAST_Subs.f90 | 42 +- modules/openfast-library/src/FAST_Types.f90 | 2581 ++--------------- .../openfast-library/src/Glue_Registry.txt | 214 ++ modules/openfast-library/src/Glue_Types.f90 | 2163 ++++++++++++++ 11 files changed, 2802 insertions(+), 2769 deletions(-) create mode 100644 modules/openfast-library/src/Glue_Registry.txt create mode 100644 modules/openfast-library/src/Glue_Types.f90 diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 26a6ca8cef..fb76ea4517 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -57,6 +57,8 @@ module ModVar module procedure MV_UnpackMesh end interface +logical, parameter :: UseSmallRotAngs = .true. + contains function MV_FieldString(Field) result(str) @@ -592,22 +594,33 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) quat_neg = NegAry(k:k + 2) quat_pos = PosAry(k:k + 2) - ! If variable has flag to use small angles when computing difference - if (MV_HasFlags(VarAry(i), VF_SmallAngle)) then + ! If flag set to use small angle rotations + if (UseSmallRotAngs) then + + ! If variable has flag to use small angles when computing difference + if (MV_HasFlags(VarAry(i), VF_SmallAngle)) then + + ang_pos = GetSmllRotAngs(quat_to_dcm(quat_pos), ErrStat, ErrMsg) + ang_neg = GetSmllRotAngs(quat_to_dcm(quat_neg), ErrStat, ErrMsg) - ang_pos = GetSmllRotAngs(quat_to_dcm(quat_pos), ErrStat, ErrMsg) - ang_neg = GetSmllRotAngs(quat_to_dcm(quat_neg), ErrStat, ErrMsg) + DiffAry(k:k + 2) = ang_pos - ang_neg + else + + ! Calculate relative rotation from negative to positive perturbation + delta = quat_compose(-quat_neg, quat_pos) + + ! Convert relative rotation from quaternion to rotation vector + DiffAry(k:k + 2) = GetSmllRotAngs(quat_to_dcm(delta), ErrStat, ErrMsg) + end if - DiffAry(k:k + 2) = ang_pos - ang_neg else ! Calculate relative rotation from negative to positive perturbation delta = quat_compose(-quat_neg, quat_pos) - ! Convert relative rotation from quaternion to rotation vector - DiffAry(k:k + 2) = GetSmllRotAngs(quat_to_dcm(delta), ErrStat, ErrMsg) + ! Convert delta quaternion to rotation vector and store in diff array + DiffAry(k:k + 2) = quat_to_rvec(delta) - ! DiffAry(k:k + 2) = quat_to_rvec(delta) end if ! Increment starting index @@ -840,20 +853,29 @@ function perturb_quat(theta, idir) result(q) real(R8Ki) :: rvec(3), q(3), dcm(3, 3) integer(IntKi) :: ErrStat character(ErrMsgLen) :: ErrMsg - select case (idir) - case (1) - ! q = rvec_to_quat([theta, 0.0_R8Ki, 0.0_R8Ki]) - call SmllRotTrans('linearization perturbation', theta, 0.0_R8Ki, 0.0_R8Ki, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) - q = dcm_to_quat(dcm) - case (2) - ! q = rvec_to_quat([0.0_R8Ki, theta, 0.0_R8Ki]) - call SmllRotTrans('linearization perturbation', 0.0_R8Ki, theta, 0.0_R8Ki, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) - q = dcm_to_quat(dcm) - case (3) - ! q = rvec_to_quat([0.0_R8Ki, 0.0_R8Ki, theta]) - call SmllRotTrans('linearization perturbation', 0.0_R8Ki, 0.0_R8Ki, theta, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) - q = dcm_to_quat(dcm) - end select + + if (UseSmallRotAngs) then + select case (idir) + case (1) + call SmllRotTrans('linearization perturbation', theta, 0.0_R8Ki, 0.0_R8Ki, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + q = dcm_to_quat(dcm) + case (2) + call SmllRotTrans('linearization perturbation', 0.0_R8Ki, theta, 0.0_R8Ki, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + q = dcm_to_quat(dcm) + case (3) + call SmllRotTrans('linearization perturbation', 0.0_R8Ki, 0.0_R8Ki, theta, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + q = dcm_to_quat(dcm) + end select + else + select case (idir) + case (1) + q = rvec_to_quat([theta, 0.0_R8Ki, 0.0_R8Ki]) + case (2) + q = rvec_to_quat([0.0_R8Ki, theta, 0.0_R8Ki]) + case (3) + q = rvec_to_quat([0.0_R8Ki, 0.0_R8Ki, theta]) + end select + end if end function pure function quat_canonical(q0, q) result(qc) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 0c0592df40..0ac4b5a079 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -15,6 +15,7 @@ # if (GENERATE_TYPES) + generate_f90_types(src/Glue_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/Glue_Types.f90 -noextrap) generate_f90_types(src/FAST_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/FAST_Types.f90 -noextrap) endif() @@ -38,6 +39,7 @@ elseif (${_compiler_id} MATCHES "^INTEL" AND ${_build_type} STREQUAL "RELEASE" A endif() add_library(openfast_prelib STATIC + src/Glue_Types.f90 src/FAST_Types.f90 ) target_link_libraries(openfast_prelib diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 02e6cfcabf..4f84421360 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -443,7 +443,7 @@ logical function Failed() subroutine FAST_CalcOutput(ModData, Maps, ThisTime, ThisState, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) !< Output->Input mappings + type(MappingType), intent(inout) :: Maps(:) !< Output->Input mappings real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: ThisState !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type diff --git a/modules/openfast-library/src/FAST_Idx.f90 b/modules/openfast-library/src/FAST_Idx.f90 index fb4cace35f..55624c6810 100644 --- a/modules/openfast-library/src/FAST_Idx.f90 +++ b/modules/openfast-library/src/FAST_Idx.f90 @@ -75,7 +75,7 @@ subroutine Idx_Init(Mods, ModOrder, Idx, FlagFilter, ErrStat, ErrMsg) ErrMsg = "" ! Destroy VarIdx in case it has been previously used - call FAST_DestroyVarsIdxType(Idx, ErrStat2, ErrMsg2); if (Failed()) return + call Glue_DestroyVarsIdxType(Idx, ErrStat2, ErrMsg2); if (Failed()) return ! Save filter in index Idx%FlagFilter = FlagFilter diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 9c2dfe5102..c452a7fc27 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -329,7 +329,7 @@ function FAST_OutputMeshName(ModData, MeshLoc) result(Name) subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) type(ModDataType), intent(inout) :: Mods(:) !< Module data - type(TC_MappingType), allocatable, intent(inout) :: Mappings(:) + type(MappingType), allocatable, intent(inout) :: Mappings(:) type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -430,7 +430,7 @@ logical function Failed() end subroutine subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat @@ -525,7 +525,7 @@ logical function Failed() end subroutine subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -589,7 +589,7 @@ logical function Failed() end subroutine subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -834,7 +834,7 @@ logical function Failed() end subroutine subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -908,7 +908,7 @@ logical function Failed() end subroutine subroutine InitMappings_ExtPtfm(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -950,7 +950,7 @@ logical function Failed() end subroutine subroutine InitMappings_FEAM(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1004,7 +1004,7 @@ logical function Failed() end subroutine subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1067,7 +1067,7 @@ logical function Failed() end subroutine subroutine InitMappings_IceD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat @@ -1106,7 +1106,7 @@ logical function Failed() end subroutine subroutine InitMappings_IceF(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat @@ -1145,7 +1145,7 @@ logical function Failed() end subroutine subroutine InitMappings_IfW(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1173,7 +1173,7 @@ logical function Failed() end subroutine subroutine InitMappings_MAP(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1212,7 +1212,7 @@ logical function Failed() end subroutine subroutine InitMappings_MD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1256,7 +1256,7 @@ logical function Failed() end subroutine subroutine InitMappings_Orca(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1287,7 +1287,7 @@ logical function Failed() end subroutine subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1395,7 +1395,7 @@ logical function Failed() end subroutine subroutine InitMappings_SeaSt(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1423,7 +1423,7 @@ logical function Failed() end subroutine subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -1539,7 +1539,7 @@ logical function Failed() subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & DstMod, DstMeshLoc, DstDispMeshLoc, ErrStat, ErrMsg, Active) type(FAST_TurbineType), target :: Turbine - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(MeshLocType), intent(in) :: SrcMeshLoc, DstMeshLoc type(MeshLocType), intent(in) :: SrcDispMeshLoc, DstDispMeshLoc @@ -1550,7 +1550,7 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & character(*), parameter :: RoutineName = 'MapLoadMesh' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - type(TC_MappingType) :: Mapping + type(MappingType) :: Mapping type(MeshType), pointer :: SrcMesh, SrcDispMesh type(MeshType), pointer :: DstMesh, DstDispMesh type(MeshType) :: DstMotionMesh @@ -1685,7 +1685,7 @@ pure logical function IsSiblingMesh(MeshA, MeshB) subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshLoc, ErrStat, ErrMsg, Active) type(FAST_TurbineType), target :: Turbine - type(TC_MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(MeshLocType), intent(in) :: SrcMeshLoc, DstMeshLoc integer(IntKi), intent(out) :: ErrStat @@ -1695,7 +1695,7 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL character(*), parameter :: RoutineName = 'MapMotionMesh' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - type(TC_MappingType) :: Mapping + type(MappingType) :: Mapping type(MeshType), pointer :: SrcMesh, DstMesh ErrStat = ErrID_None @@ -1756,14 +1756,14 @@ logical function Failed() end subroutine subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, ErrMsg, Active) - type(TC_MappingType), allocatable :: Maps(:) + type(MappingType), allocatable :: Maps(:) character(*), intent(in) :: Key type(ModDataType), intent(in) :: SrcMod, DstMod integer(IntKi), intent(in) :: iVarSrc, iVarDst integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, optional, intent(in) :: Active - type(TC_MappingType) :: Mapping + type(MappingType) :: Mapping ErrStat = ErrID_None ErrMsg = '' @@ -1810,11 +1810,11 @@ subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, Err !> MapCustom creates a custom mapping that is not included in linearization. !! Each custom mapping needs an entry in FAST_InputSolve to actually perform the transfer. subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) - type(TC_MappingType), allocatable :: Maps(:) + type(MappingType), allocatable :: Maps(:) character(*), intent(in) :: Desc type(ModDataType), intent(in) :: SrcMod, DstMod logical, optional, intent(in) :: Active - type(TC_MappingType) :: Mapping + type(MappingType) :: Mapping if (present(Active)) then if (.not. Active) return @@ -1834,7 +1834,7 @@ subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) end subroutine subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) - type(TC_MappingType), intent(inout) :: Mapping + type(MappingType), intent(inout) :: Mapping type(ModDataType), intent(in) :: SrcMod, DstMod type(MeshType), intent(in) :: SrcMesh, DstMesh type(MeshType), optional, intent(in) :: SrcDispMesh, DstDispMesh @@ -1916,7 +1916,7 @@ function MeshTransferType(SrcMesh, DstMesh) result(XfrType) subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrStat, ErrMsg, dUdu, dUdy) type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type type(ModDataType), intent(in) :: Mods(:) !< Module data - type(TC_MappingType), intent(inout) :: Mappings(:) + type(MappingType), intent(inout) :: Mappings(:) integer(IntKi), intent(in) :: ModOrder(:) type(VarsIdxType), intent(in) :: Idx integer(IntKi), intent(out) :: ErrStat @@ -2073,7 +2073,7 @@ subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp) end subroutine subroutine Assemble_dUdu(Mapping) - type(TC_MappingType), intent(in) :: Mapping + type(MappingType), intent(in) :: Mapping ! Effect of input Translation Displacement on input Translation Velocity if (allocated(Mapping%MeshMap%dM%tv_uD)) then @@ -2098,7 +2098,7 @@ subroutine Assemble_dUdu(Mapping) !! M = -| M_li 0 | * M_mi | F^S | !! | M_fm M_li | | M^S | subroutine Assemble_dUdy_Loads(Mapping) - type(TC_MappingType), intent(inout) :: Mapping + type(MappingType), intent(inout) :: Mapping ! Load identity if (allocated(Mapping%MeshMap%dM%li)) then @@ -2139,7 +2139,7 @@ subroutine Assemble_dUdy_Loads(Mapping) !! where the matrices correspond to !! u^S, theta^S, v^S, omega^S, a^S, alpha^S subroutine Assemble_dUdy_Motions(Mapping) - type(TC_MappingType), intent(inout) :: Mapping + type(MappingType), intent(inout) :: Mapping ! Motion identity if (allocated(Mapping%MeshMap%dM%mi)) then @@ -2207,7 +2207,7 @@ logical function Failed() subroutine FAST_InputSolve(ModData, Mods, Mappings, Turbine, ErrStat, ErrMsg, UseU) type(ModDataType), intent(in) :: ModData !< Module data type(ModDataType), intent(in) :: Mods(:) !< Module data - type(TC_MappingType), intent(inout) :: Mappings(:) !< Mesh and variable mappings + type(MappingType), intent(inout) :: Mappings(:) !< Mesh and variable mappings type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -2294,7 +2294,7 @@ logical function Failed() subroutine Custom_InputSolve(T, Mapping, ErrStat, ErrMsg, UseU) type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - type(TC_MappingType), intent(in) :: Mapping + type(MappingType), intent(in) :: Mapping integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, intent(in) :: UseU ! Flag to transfer to u instead of Input @@ -2539,7 +2539,7 @@ subroutine SumMeshLoads(SrcMesh, DstMesh, DstResetFlag) subroutine FAST_ResetRemapFlags(Mods, Maps, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: Mods(:) !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) + type(MappingType), intent(inout) :: Maps(:) type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 4d234afc9d..b9a3cbb6a3 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -35,14 +35,13 @@ module FAST_ModGlue contains -subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) - - type(ModDataType), intent(inout) :: ModGlue !< Module data for glue code - type(ModDataType), allocatable, intent(inout) :: Mods(:) !< Data for all modules - type(ML_ParameterType), intent(inout) :: p !< ModLin parameters - type(ML_MiscVarType), intent(inout) :: m !< ModLin miscvars - type(FAST_ParameterType), intent(inout) :: p_FAST - type(FAST_MiscVarType), intent(inout) :: m_FAST +subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) + + type(Glue_ParameterType), intent(inout) :: p !< Glue Parameters + type(Glue_MiscVarType), intent(inout) :: m !< Glue MiscVars + type(Glue_OutputFileType), intent(inout) :: y !< Glue Output + type(FAST_ParameterType), intent(inout) :: p_FAST !< FAST Parameters + type(FAST_MiscVarType), intent(inout) :: m_FAST !< FAST MiscVars type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -78,16 +77,16 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E !---------------------------------------------------------------------------- ! If no modules were added, return error - if (.not. allocated(Mods)) then + if (.not. allocated(m%ModData)) then call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) return end if ! Create array of indices for Mods array - modIdx = [(i, i=1, size(Mods))] + modIdx = [(i, i=1, size(m%ModData))] ! Get array of module IDs - modIDs = [(Mods(i)%ID, i=1, size(Mods))] + modIDs = [(m%ModData(i)%ID, i=1, size(m%ModData))] ! Establish module index order for linearization allocate (p%iMod(0)) @@ -96,9 +95,9 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E end do ! Loop through modules, if module is not in index, return with error - do i = 1, size(Mods) + do i = 1, size(m%ModData) if (.not. any(i == p%iMod)) then - call SetErrStat(ErrID_Fatal, "Module "//trim(Mods(i)%Abbr)//" not supported in linearization", & + call SetErrStat(ErrID_Fatal, "Module "//trim(m%ModData(i)%Abbr)//" not supported in linearization", & ErrStat, ErrMsg, RoutineName) return end if @@ -109,21 +108,21 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E !---------------------------------------------------------------------------- ! Allocate variable structure for glue - allocate (ModGlue%Vars) + allocate (y%ModGlue%Vars) ! Initialize number of values in each variable group - ModGlue%Vars%Nx = 0 - ModGlue%Vars%Nxd = 0 - ModGlue%Vars%Nz = 0 - ModGlue%Vars%Nu = 0 - ModGlue%Vars%Ny = 0 + y%ModGlue%Vars%Nx = 0 + y%ModGlue%Vars%Nxd = 0 + y%ModGlue%Vars%Nz = 0 + y%ModGlue%Vars%Nu = 0 + y%ModGlue%Vars%Ny = 0 ! Allocate arrays for glue variables - allocate (ModGlue%Vars%x(0), ModGlue%Vars%xd(0), ModGlue%Vars%z(0), ModGlue%Vars%u(0), ModGlue%Vars%y(0)) + allocate (y%ModGlue%Vars%x(0), y%ModGlue%Vars%xd(0), y%ModGlue%Vars%z(0), y%ModGlue%Vars%u(0), y%ModGlue%Vars%y(0)) ! Loop through each module by index do i = 1, size(p%iMod) - associate (ModData => Mods(p%iMod(i))) + associate (ModData => m%ModData(p%iMod(i))) ! Create variable name prefix for linearization names. Add instance ! number to module abbreviation if more than 1 instance or the module is BeamDyn @@ -142,42 +141,42 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E end do ! Set module data start index in global arrays, increment data size - ModGlue%Vars%Nx = ModGlue%Vars%Nx + ModData%Vars%Nx + y%ModGlue%Vars%Nx = y%ModGlue%Vars%Nx + ModData%Vars%Nx ! Save start index of module variables and append to glue code variables - k = size(ModGlue%Vars%x) + 1 - ModGlue%Vars%x = [ModGlue%Vars%x, ModData%Vars%x] + k = size(y%ModGlue%Vars%x) + 1 + y%ModGlue%Vars%x = [y%ModGlue%Vars%x, ModData%Vars%x] ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(ModGlue%Vars%x(k:), NamePrefix) + call AddLinNamePrefix(y%ModGlue%Vars%x(k:), NamePrefix) !---------------------------------------------------------------------- ! Module discrete state variables !---------------------------------------------------------------------- ! Set module data start index in global arrays, increment data size - ModGlue%Vars%Nxd = ModGlue%Vars%Nxd + ModData%Vars%Nxd + y%ModGlue%Vars%Nxd = y%ModGlue%Vars%Nxd + ModData%Vars%Nxd ! Save start index of module variables and append to glue code variables - k = size(ModGlue%Vars%xd) + 1 - ModGlue%Vars%xd = [ModGlue%Vars%xd, ModData%Vars%xd] + k = size(y%ModGlue%Vars%xd) + 1 + y%ModGlue%Vars%xd = [y%ModGlue%Vars%xd, ModData%Vars%xd] ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(ModGlue%Vars%xd(k:), NamePrefix) + call AddLinNamePrefix(y%ModGlue%Vars%xd(k:), NamePrefix) !---------------------------------------------------------------------- ! Module constraint state variables !---------------------------------------------------------------------- ! Set module data start index in global arrays, increment data size - ModGlue%Vars%Nz = ModGlue%Vars%Nz + ModData%Vars%Nz + y%ModGlue%Vars%Nz = y%ModGlue%Vars%Nz + ModData%Vars%Nz ! Save start index of module variables and append to glue code variables - k = size(ModGlue%Vars%z) + 1 - ModGlue%Vars%z = [ModGlue%Vars%z, ModData%Vars%z] + k = size(y%ModGlue%Vars%z) + 1 + y%ModGlue%Vars%z = [y%ModGlue%Vars%z, ModData%Vars%z] ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(ModGlue%Vars%z(k:), NamePrefix) + call AddLinNamePrefix(y%ModGlue%Vars%z(k:), NamePrefix) !---------------------------------------------------------------------- ! Module input variables @@ -198,14 +197,14 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E end select ! Set module data start index in global arrays, increment data size - ModGlue%Vars%Nu = ModGlue%Vars%Nu + ModData%Vars%Nu + y%ModGlue%Vars%Nu = y%ModGlue%Vars%Nu + ModData%Vars%Nu ! Save start index of module variables and append to glue code variables - k = size(ModGlue%Vars%u) + 1 - ModGlue%Vars%u = [ModGlue%Vars%u, ModData%Vars%u] + k = size(y%ModGlue%Vars%u) + 1 + y%ModGlue%Vars%u = [y%ModGlue%Vars%u, ModData%Vars%u] ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(ModGlue%Vars%u(k:), NamePrefix) + call AddLinNamePrefix(y%ModGlue%Vars%u(k:), NamePrefix) !---------------------------------------------------------------------- ! Module output variables @@ -232,30 +231,30 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E end select ! Set module data start index in global arrays, increment data size - ModGlue%Vars%Ny = ModGlue%Vars%Ny + ModData%Vars%Ny + y%ModGlue%Vars%Ny = y%ModGlue%Vars%Ny + ModData%Vars%Ny ! Save start index of module variables and append to glue code variables - k = size(ModGlue%Vars%y) + 1 - ModGlue%Vars%y = [ModGlue%Vars%y, ModData%Vars%y] + k = size(y%ModGlue%Vars%y) + 1 + y%ModGlue%Vars%y = [y%ModGlue%Vars%y, ModData%Vars%y] ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(ModGlue%Vars%y(k:), NamePrefix) + call AddLinNamePrefix(y%ModGlue%Vars%y(k:), NamePrefix) end associate end do ! Calculate number of values in each group and set data location index - call CalcVarDataLoc(ModGlue%Vars%x, ModGlue%Vars%Nx) - call CalcVarDataLoc(ModGlue%Vars%xd, ModGlue%Vars%Nxd) - call CalcVarDataLoc(ModGlue%Vars%z, ModGlue%Vars%Nz) - call CalcVarDataLoc(ModGlue%Vars%u, ModGlue%Vars%Nu) - call CalcVarDataLoc(ModGlue%Vars%y, ModGlue%Vars%Ny) + call CalcVarDataLoc(y%ModGlue%Vars%x, y%ModGlue%Vars%Nx) + call CalcVarDataLoc(y%ModGlue%Vars%xd, y%ModGlue%Vars%Nxd) + call CalcVarDataLoc(y%ModGlue%Vars%z, y%ModGlue%Vars%Nz) + call CalcVarDataLoc(y%ModGlue%Vars%u, y%ModGlue%Vars%Nu) + call CalcVarDataLoc(y%ModGlue%Vars%y, y%ModGlue%Vars%Ny) !---------------------------------------------------------------------------- ! Mesh Mapping !---------------------------------------------------------------------------- - call FAST_InitMappings(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InitMappings(m%ModData, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Allocate linearization arrays and matrices @@ -265,23 +264,29 @@ subroutine ModGlue_Init(ModGlue, Mods, p, m, p_FAST, m_FAST, Turbine, ErrStat, E if (p_FAST%Linearize) then ! Initialize linearization index - call Idx_Init(Mods, p%iMod, p%IdxLin, VF_None, ErrStat2, ErrMsg2); if (Failed()) return + call Idx_Init(m%ModData, p%iMod, p%IdxLin, VF_None, ErrStat2, ErrMsg2); if (Failed()) return ! Allocate linearization arrays - call AllocAry(ModGlue%Lin%x, ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dx, ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%xd, ModGlue%Vars%Nxd, "xd", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%z, ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%u, ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%y, ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%x, y%ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%dx, y%ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%xd, y%ModGlue%Vars%Nxd, "xd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%z, y%ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%u, y%ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%y, y%ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return ! Allocate full Jacobian matrices - call AllocAry(ModGlue%Lin%dYdu, ModGlue%Vars%Ny, ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dXdu, ModGlue%Vars%Nx, ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dYdx, ModGlue%Vars%Ny, ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dXdx, ModGlue%Vars%Nx, ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dUdu, ModGlue%Vars%Nu, ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModGlue%Lin%dUdy, ModGlue%Vars%Nu, ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%dYdu, y%ModGlue%Vars%Ny, y%ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%dXdu, y%ModGlue%Vars%Nx, y%ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%dYdx, y%ModGlue%Vars%Ny, y%ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%dXdx, y%ModGlue%Vars%Nx, y%ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%dUdu, y%ModGlue%Vars%Nu, y%ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%ModGlue%Lin%dUdy, y%ModGlue%Vars%Nu, y%ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return + + ! Initialize arrays to store operating point states and input + call AllocAry(y%OP%x, y%ModGlue%Vars%Nx, p_FAST%NLinTimes, "x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%OP%xd, y%ModGlue%Vars%Nxd, p_FAST%NLinTimes, "xd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%OP%z, y%ModGlue%Vars%Nz, p_FAST%NLinTimes, "z", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%OP%u, y%ModGlue%Vars%Nu, p_FAST%NLinTimes, "u", ErrStat2, ErrMsg2); if (Failed()) return end if contains @@ -316,12 +321,11 @@ subroutine AddLinNamePrefix(VarAry, Prefix) end do end subroutine -subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_FAST, t_global, ErrStat, ErrMsg) +subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_global, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: Mods(:) !< Data for all modules - type(ModDataType), intent(inout) :: ModGlue !< Module data for glue code - type(ML_ParameterType), intent(inout) :: p !< ModLin parameters - type(ML_MiscVarType), intent(inout) :: m !< ModLin MiscVars + type(Glue_ParameterType), intent(inout) :: p !< Glue parameters + type(Glue_MiscVarType), intent(inout) :: m !< Glue MiscVars + type(Glue_OutputFileType), intent(inout) :: y !< Glue Output type(FAST_ParameterType), intent(in) :: p_FAST type(FAST_MiscVarType), intent(inout) :: m_FAST type(FAST_OutputFileType), intent(inout) :: y_FAST @@ -372,14 +376,14 @@ subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_ iy = 1 ! Initialize data in Jacobian matrices to zero - ModGlue%Lin%dYdu = 0.0_R8Ki - ModGlue%Lin%dXdu = 0.0_R8Ki - ModGlue%Lin%dYdx = 0.0_R8Ki - ModGlue%Lin%dXdx = 0.0_R8Ki + y%ModGlue%Lin%dYdu = 0.0_R8Ki + y%ModGlue%Lin%dXdu = 0.0_R8Ki + y%ModGlue%Lin%dYdx = 0.0_R8Ki + y%ModGlue%Lin%dXdx = 0.0_R8Ki ! Loop through modules by index do i = 1, size(p%iMod) - associate (ModData => Mods(p%iMod(i))) + associate (ModData => m%ModData(p%iMod(i))) ! Derivatives wrt input call FAST_JacobianPInput(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & @@ -400,18 +404,18 @@ subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_ if (Failed()) return ! Copy module linearization arrays into glue linearization arrays - if ((size(ModGlue%Lin%x) > 0) .and. allocated(ModData%Lin%x)) ModGlue%Lin%x(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%x - if ((size(ModGlue%Lin%dx) > 0) .and. allocated(ModData%Lin%dx)) ModGlue%Lin%dx(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dx - if ((size(ModGlue%Lin%xd) > 0) .and. allocated(ModData%Lin%xd)) ModGlue%Lin%xd(ixd:ixd + ModData%Vars%Nxd - 1) = ModData%Lin%xd - if ((size(ModGlue%Lin%z) > 0) .and. allocated(ModData%Lin%z)) ModGlue%Lin%z(iz:iz + ModData%Vars%Nz - 1) = ModData%Lin%z - if ((size(ModGlue%Lin%u) > 0) .and. allocated(ModData%Lin%u)) ModGlue%Lin%u(iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%u - if ((size(ModGlue%Lin%y) > 0) .and. allocated(ModData%Lin%y)) ModGlue%Lin%y(iy:iy + ModData%Vars%Ny - 1) = ModData%Lin%y - - ! Copy module Jacobians into glue code Jacobians - if ((size(ModGlue%Lin%dYdu) > 0) .and. allocated(ModData%Lin%dYdu)) ModGlue%Lin%dYdu(iy:iy + ModData%Vars%Ny - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dYdu - if ((size(ModGlue%Lin%dXdu) > 0) .and. allocated(ModData%Lin%dXdu)) ModGlue%Lin%dXdu(ix:ix + ModData%Vars%Nx - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dXdu - if ((size(ModGlue%Lin%dYdx) > 0) .and. allocated(ModData%Lin%dYdx)) ModGlue%Lin%dYdx(iy:iy + ModData%Vars%Ny - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dYdx - if ((size(ModGlue%Lin%dXdx) > 0) .and. allocated(ModData%Lin%dXdx)) ModGlue%Lin%dXdx(ix:ix + ModData%Vars%Nx - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dXdx + if ((size(y%ModGlue%Lin%x) > 0) .and. allocated(ModData%Lin%x)) y%ModGlue%Lin%x(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%x + if ((size(y%ModGlue%Lin%dx) > 0) .and. allocated(ModData%Lin%dx)) y%ModGlue%Lin%dx(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dx + if ((size(y%ModGlue%Lin%xd) > 0) .and. allocated(ModData%Lin%xd)) y%ModGlue%Lin%xd(ixd:ixd + ModData%Vars%Nxd - 1) = ModData%Lin%xd + if ((size(y%ModGlue%Lin%z) > 0) .and. allocated(ModData%Lin%z)) y%ModGlue%Lin%z(iz:iz + ModData%Vars%Nz - 1) = ModData%Lin%z + if ((size(y%ModGlue%Lin%u) > 0) .and. allocated(ModData%Lin%u)) y%ModGlue%Lin%u(iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%u + if ((size(y%ModGlue%Lin%y) > 0) .and. allocated(ModData%Lin%y)) y%ModGlue%Lin%y(iy:iy + ModData%Vars%Ny - 1) = ModData%Lin%y + + ! Copy module Jacobians into glue code Jacobian + if ((size(y%ModGlue%Lin%dYdu) > 0) .and. allocated(ModData%Lin%dYdu)) y%ModGlue%Lin%dYdu(iy:iy + ModData%Vars%Ny - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dYdu + if ((size(y%ModGlue%Lin%dXdu) > 0) .and. allocated(ModData%Lin%dXdu)) y%ModGlue%Lin%dXdu(ix:ix + ModData%Vars%Nx - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dXdu + if ((size(y%ModGlue%Lin%dYdx) > 0) .and. allocated(ModData%Lin%dYdx)) y%ModGlue%Lin%dYdx(iy:iy + ModData%Vars%Ny - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dYdx + if ((size(y%ModGlue%Lin%dXdx) > 0) .and. allocated(ModData%Lin%dXdx)) y%ModGlue%Lin%dXdx(ix:ix + ModData%Vars%Nx - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dXdx ! Increment starting index for next module ix = ix + ModData%Vars%Nx @@ -426,12 +430,12 @@ subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_ ! Assemble output file name based on module abbreviation ! If module is BeamDyn or more than one instance, include instance OutFileName = trim(LinRootName)//'.'//trim(ModData%Abbr)//".lin" - if ((ModData%ID == Module_BD) .or. (count(Mods%ID == ModData%ID) > 1)) then + if ((ModData%ID == Module_BD) .or. (count(m%ModData%ID == ModData%ID) > 1)) then OutFileName = trim(LinRootName)//'.'//trim(ModData%Abbr)//trim(Num2LStr(ModData%Ins))//".lin" end if ! Write linearization matrices - call WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat2, ErrMsg2) + call CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFileName, .false., ErrStat2, ErrMsg2) if (Failed()) return end if @@ -442,22 +446,24 @@ subroutine ModGlue_Linearize_OP(Turbine, Mods, ModGlue, p, m, p_FAST, m_FAST, y_ if (JacobianHasNaNs(ModData%Lin%dYdx, "dYdx", ModData%Abbr)) return if (JacobianHasNaNs(ModData%Lin%dXdx, "dXdx", ModData%Abbr)) return + ! Copy arrays into linearization operating points + if (size(y%ModGlue%Lin%x) > 0) y%OP%x(:,m_FAST%Lin%NextLinTimeIndx) = y%ModGlue%Lin%x + if (size(y%ModGlue%Lin%xd) > 0) y%OP%xd(:,m_FAST%Lin%NextLinTimeIndx) = y%ModGlue%Lin%xd + if (size(y%ModGlue%Lin%z) > 0) y%OP%z(:,m_FAST%Lin%NextLinTimeIndx) = y%ModGlue%Lin%z + if (size(y%ModGlue%Lin%u) > 0) y%OP%u(:,m_FAST%Lin%NextLinTimeIndx) = y%ModGlue%Lin%u + end associate end do ! Linearize mesh mappings to populate dUdy and dUdu - ModGlue%Lin%dUdy = 0.0_R8Ki - call Eye2D(ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_LinearizeMappings(Turbine, Mods, m%Mappings, p%iMod, p%IdxLin, ErrStat2, ErrMsg2, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy) - if (Failed()) return - - ! Calculate the glue code state matrices (A, B, C, D) - call ModLin_StateMatrices(ModGlue, real(p_FAST%UJacSclFact, R8Ki), ErrStat2, ErrMsg2) + y%ModGlue%Lin%dUdy = 0.0_R8Ki + call Eye2D(y%ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_LinearizeMappings(Turbine, m%ModData, m%Mappings, p%iMod, p%IdxLin, ErrStat2, ErrMsg2, y%ModGlue%Lin%dUdu, y%ModGlue%Lin%dUdy) if (Failed()) return - ! Write glue code data + ! Write glue code matrices to file OutFileName = trim(LinRootName)//".lin" - call WriteModuleLinearMatrices(ModGlue, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat2, ErrMsg2, IsGlue=.true.) + call CalcWriteLinearMatrices(y%ModGlue, p_FAST, y_FAST, t_global, Un, OutFileName, .true., ErrStat2, ErrMsg2) if (Failed()) return ! Update index for next linearization time @@ -484,7 +490,7 @@ end function Failed !> ModLin_StateMatrices forms the full-system state matrices for linearization: A, B, C, and D. !! Note that it uses LAPACK_GEMM instead of MATMUL for matrix multiplications because of stack-space issues (these !! matrices get large quickly). -subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) +subroutine CalcGlueStateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) type(ModDataType), intent(inout) :: ModGlue !< Glue module data real(R8Ki), intent(in) :: JacScaleFactor !< Scale factor for conditioning the Jacobians integer(IntKi), intent(out) :: ErrStat !< Error status of the operation @@ -493,7 +499,7 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ModLin_StateMatrices' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - real(R8Ki), allocatable :: G(:, :), tmp(:, :), dUdu(:, :), dUdy(:, :) + real(R8Ki), allocatable :: G(:, :), tmp(:, :) integer(IntKi), allocatable :: ipiv(:) ! A = dXdx @@ -508,48 +514,42 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) ! call DumpMatrix(1000, "C.bin", ModGlue%Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return ! call DumpMatrix(1000, "D.bin", ModGlue%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return - ! Create copies of dUdu and dUdy for calculating matrices - call AllocAry(dUdu, size(ModGlue%Lin%dUdu, 1), size(ModGlue%Lin%dUdu, 2), 'dUdu', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(dUdy, size(ModGlue%Lin%dUdy, 1), size(ModGlue%Lin%dUdy, 2), 'dUdy', ErrStat2, ErrMsg2); if (Failed()) return - dUdu = ModGlue%Lin%dUdu - dUdy = ModGlue%Lin%dUdy - ! *** get G matrix **** !---------------------- - call AllocAry(G, size(dUdu, 1), size(dUdu, 2), 'G', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(G, size(ModGlue%Lin%dUdu, 1), size(ModGlue%Lin%dUdu, 2), 'G', ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(ipiv, ModGlue%Vars%Nu, 'ipiv', ErrStat2, ErrMsg2); if (Failed()) return !G = dUdu + matmul(dUdy, y_FAST%Lin%Glue%D) - G = dUdu - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, dUdy, ModGlue%Lin%dYdu, 1.0_R8Ki, G, ErrStat2, ErrMsg2); if (Failed()) return + G = ModGlue%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, ModGlue%Lin%dUdy, ModGlue%Lin%dYdu, 1.0_R8Ki, G, ErrStat2, ErrMsg2); if (Failed()) return ! G can be ill-conditioned, so we are going to precondition with G_hat = S^(-1) * G * S ! we will also multiply the right-hand-side of the equations that need G inverse so that ! dUdy_hat = S^(-1)*dUdy and dUdu_hat = S^(-1)*dUdu - call Precondition(ModGlue%Vars%u, G, dUdu, dUdy, JacScaleFactor) + call Precondition(ModGlue%Vars%u, G, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy, JacScaleFactor) ! Form G_hat^(-1) * (S^-1*dUdy) and G^(-1) * (S^-1*dUdu) ! factor G for the two solves: call LAPACK_getrf(M=size(G, 1), N=size(G, 2), A=G, IPIV=ipiv, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! after the this solve, dUdy holds G_hat^(-1) * dUdy_hat: - call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=ModGlue%Lin%dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! after the this solve, dUdu holds G_hat^(-1) * dUdu_hat: - call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=ModGlue%Lin%dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Deallocate G and ipiv because the solves are complete deallocate (G) deallocate (ipiv) ! After this call, dUdu holds G^(-1)*dUdu and dUdy holds G^(-1)*dUdy - call Postcondition(ModGlue%Vars%u, dUdu, dUdy, JacScaleFactor) + call Postcondition(ModGlue%Vars%u, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy, JacScaleFactor) ! Allocate tmp matrix for A and C calculations call AllocAry(tmp, ModGlue%Vars%Nu, ModGlue%Vars%Nx, 'G^-1*dUdy*C', ErrStat2, ErrMsg2); if (Failed()) return ! tmp = G^(-1) * dUdy * diag(C) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, dUdy, ModGlue%Lin%dYdx, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, ModGlue%Lin%dUdy, ModGlue%Lin%dYdx, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2); if (Failed()) return ! A ! dXdx = dXdx - matmul(dXdu, tmp) @@ -562,12 +562,12 @@ subroutine ModLin_StateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) ! B tmp = ModGlue%Lin%dXdu ! dXdu = matmul(dXdu, dUdu) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, ModGlue%Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, ModGlue%Lin%dUdu, 0.0_R8Ki, ModGlue%Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return ! D tmp = ModGlue%Lin%dYdu ! D = matmul(dYdu, dUdu) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, ModGlue%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, ModGlue%Lin%dUdu, 0.0_R8Ki, ModGlue%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return contains logical function Failed() @@ -675,17 +675,17 @@ subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) end subroutine -subroutine WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFileName, ErrStat, ErrMsg, IsGlue) +subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFileName, IsGlue, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData !< Module data + type(ModDataType), intent(inout) :: ModData !< Module data type(FAST_ParameterType) :: p_FAST !< Parameters type(FAST_OutputFileType) :: y_FAST !< Output variables real(DbKi), intent(in) :: t_global !< current time step (written in file) integer(IntKi), intent(out) :: Un !< Unit number for file character(*), intent(in) :: OutFileName !< output file name + logical :: IsGlue !< Flag indicating this is writing glue code matrices integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - logical, optional :: IsGlue !< Flag indicating this is writing glue code matrices character(*), parameter :: RoutineName = 'WriteModuleLinearMatrices' integer(IntKi) :: ErrStat2 @@ -695,15 +695,10 @@ subroutine WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutF integer(IntKi) :: Nx, Nxd, Nz, Nu, Ny character(50) :: Fmt logical, allocatable :: uUse(:), yUse(:) - logical :: IsGlueLoc ErrStat = ErrID_None ErrMsg = "" - ! Set local flag for if glue code matrices are being written - IsGlueLoc = .false. - if (present(IsGlue)) IsGlueLoc = IsGlue - ! Open linearization file call OpenFOutFile(Un, OutFileName, ErrStat2, ErrMsg2); if (Failed()) return @@ -776,7 +771,6 @@ subroutine WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutF end if ! Create boolean array indicating which input values to write - ! (iLoc is used here because) allocate (uUse(ModData%Vars%Nu)) uUse = .false. do i = 1, size(ModData%Vars%u) @@ -794,9 +788,10 @@ subroutine WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutF end associate end do + ! If Jacobian matrix output is requested if (p_FAST%LinOutJac) then write (Un, '(/,A,/)') 'Jacobian matrices:' - if (IsGlueLoc) then + if (IsGlue) then call WrPartialMatrix(ModData%Lin%dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=uUse, UseCol=uUse) call WrPartialMatrix(ModData%Lin%dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=uUse, UseCol=yUse) else @@ -807,6 +802,15 @@ subroutine WriteModuleLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutF end if end if + ! If this is glue code module, calculate the glue code state matrices (A, B, C, D) + ! Called here, after writing dUdu and dUdy, because those matrices are overwritten + ! in the process of calculating the other state matrices + if (IsGlue) then + call CalcGlueStateMatrices(ModData, real(p_FAST%UJacSclFact, R8Ki), ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Write the linearized state matrices write (Un, '(/,A,/)') 'Linearized state matrices:' if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'A') if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'B', UseCol=uUse) @@ -823,7 +827,7 @@ logical function Failed() Failed = ErrStat >= AbortErrLev if (Failed) close (Un) end function Failed -end subroutine WriteModuleLinearMatrices +end subroutine CalcWriteLinearMatrices subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDeriv, ShowRot) @@ -956,7 +960,7 @@ subroutine Idx_Init(Mods, ModOrder, Idx, FlagFilter, ErrStat, ErrMsg) ErrMsg = "" ! Destroy VarIdx in case it has been previously used - call FAST_DestroyVarsIdxType(Idx, ErrStat2, ErrMsg2); if (Failed()) return + call Glue_DestroyVarsIdxType(Idx, ErrStat2, ErrMsg2); if (Failed()) return ! Save filter in index Idx%FlagFilter = FlagFilter diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index b3efc9bde8..1c048b04b8 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -11,6 +11,7 @@ ################################################################################################################################### # ...... Include files (definitions from NWTC Library and module components) ............................................................................ include Registry_NWTC_Library.txt +usefrom Glue_Registry.txt usefrom ElastoDyn_Registry.txt usefrom Registry_BeamDyn.txt usefrom ServoDyn_Registry.txt @@ -107,180 +108,6 @@ typedef ^ FAST_SS_CaseType ReKi TSR - - - "TSR for this case of the steady-state typedef ^ FAST_SS_CaseType ReKi WindSpeed - - - "Windspeed for this case of the steady-state solve [>0]" "(m/s)" typedef ^ FAST_SS_CaseType ReKi Pitch - - - "Pitch angle for this case of the steady-state solve" "(rad)" - -# ..... Tight Coupling Generalized Alpha Solver Data ............. - -# Mapping Type -param ^ - IntKi Map_LoadMesh - 1 - "Load mesh mapping type" - -param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - -param ^ - IntKi Map_Variable - 3 - "Individual variable mapping type" - -param ^ - IntKi Map_Custom - 4 - "Custom mapping not used for linearization" - -typedef ^ TC_MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - -typedef ^ ^ IntKi SrcModIdx - 0 - "Source module index in ModData array" - -typedef ^ ^ IntKi DstModIdx - 0 - "Destination module index in ModData array" - -typedef ^ ^ IntKi SrcModID - 0 - "Source module ID" - -typedef ^ ^ IntKi DstModID - 0 - "Destination module ID" - -typedef ^ ^ IntKi SrcIns - 0 - "Source module Instance" - -typedef ^ ^ IntKi DstIns - 0 - "Destination module Instance" - -typedef ^ ^ IntKi SrcMeshID - 0 - "Source mesh identifier" - -typedef ^ ^ IntKi DstMeshID - 0 - "Destination mesh identifier" - -typedef ^ ^ IntKi iVarSrc - 0 - "Source variable index" - -typedef ^ ^ IntKi iVarDst - 0 - "Destination variable index" - -typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - -typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - -typedef ^ ^ MeshLocType SrcMeshLoc - - - "Source mesh locator (number and indices)" - -typedef ^ ^ MeshLocType DstMeshLoc - - - "Destination mesh locator (number and indices)" - -typedef ^ ^ MeshLocType SrcDispMeshLoc - - - "Source displacement mesh locator (number and indices)" - -typedef ^ ^ MeshLocType DstDispMeshLoc - - - "Destination displacement mesh locator (number and indices)" - -typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - -typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - -typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - -typedef ^ ^ logical Ready - F - "Flag indicating Source has been ready to be transferred" - -typedef ^ ^ logical DstUsesSibling - F - "Flag indicating the destination displacement mesh is a sibling of the destination load mesh" - -typedef ^ ^ MeshType TmpLoadMesh - - - "Temporary load mesh for intermediate transfers" - -typedef ^ ^ MeshType TmpMotionMesh - - - "Temporary motion mesh for intermediate transfers" - -typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - -typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - -typedef ^ ^ MeshMapType MeshMapAux - - - "Auxiliary mesh mapping for destination load meshes without sibling motion mesh" - -typedef ^ ^ IntKi iVarSrcTransDisp - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcTransVel - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcTransAcc - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcOrientation - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcAngularVel - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcAngularAcc - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcForce - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcMoment - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcDispTransDisp - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstTransDisp - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstTransVel - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstTransAcc - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstOrientation - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstAngularVel - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstAngularAcc - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstForce - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstMoment - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstDispTransDisp - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstDispOrientation - - - "Var index for linearized mesh mapping" - -# Parameters -typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - -typedef ^ ^ R8Ki ConvTol - - - "Solution convergence tolerance" - -typedef ^ ^ IntKi NumCrctn - - - "" - -typedef ^ ^ IntKi MaxConvIter - - - "" - -typedef ^ ^ IntKi NIter_UJac - - - "Number of solution iterations between updating the Jacobian" - -typedef ^ ^ IntKi NStep_UJac - - - "Number of global time steps between updating the Jacobian" - -typedef ^ ^ R8Ki Scale_UJac - - - "" - -typedef ^ ^ R8Ki AccBlend - 1 - "" - -typedef ^ ^ R8Ki RhoInf - - - "Rho infinity used for calculating Generalized-alpha coefficients" - -typedef ^ ^ R8Ki AlphaM - - - "Generalized-alpha alpha_m coefficient" - -typedef ^ ^ R8Ki AlphaF - - - "Generalized-alpha alpha_f coefficient" - -typedef ^ ^ R8Ki Beta - - - "Generalized-alpha beta coefficient" - -typedef ^ ^ R8Ki Gamma - - - "Generalized-alpha gamma coefficient" - -typedef ^ ^ R8Ki C 7 - - "Generalized-alpha coefficient array" - -typedef ^ ^ IntKi iX1 2 - - "" - -typedef ^ ^ IntKi iX2 2 - - "" - -typedef ^ ^ IntKi iUT 2 - - "" - -typedef ^ ^ IntKi iU1 2 - - "" - -typedef ^ ^ IntKi iyT 2 - - "" - -typedef ^ ^ IntKi iy1 2 - - "" - -typedef ^ ^ IntKi iJX 2 - - "Indices of Jacobian q variables" - -typedef ^ ^ IntKi iJU 2 - - "Indices of Jacobian input variables" - -typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - -typedef ^ ^ IntKi iJL : - - "Indices of Jacobian load variables" - -typedef ^ ^ IntKi ixqd :: - - "" - -typedef ^ ^ IntKi iModInit : - - "ModData index order for step 0 initialization" - -typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - -typedef ^ ^ IntKi iModBD : - - "ModData index order for BD modules" - -typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - -typedef ^ ^ IntKi iModOpt1US : - - "ModData index order for option 1 modules to update states" - -typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - -typedef ^ ^ IntKi iModPost : - - "ModData index order for post option 1 modules" - - -typedef ^ ModLinTCType R8Ki x : - - "" - -typedef ^ ^ R8Ki dx : - - "" - -typedef ^ ^ R8Ki xd : - - "" - -typedef ^ ^ R8Ki z : - - "" - -typedef ^ ^ R8Ki u : - - "" - -typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "" - -typedef ^ ^ R8Ki x_perturb : - - "" - -typedef ^ ^ R8Ki x_pos : - - "" - -typedef ^ ^ R8Ki x_neg : - - "" - -typedef ^ ^ R8Ki y_pos : - - "" - -typedef ^ ^ R8Ki y_neg : - - "" - -typedef ^ ^ R8Ki dYdx :: - - "" - -typedef ^ ^ R8Ki dXdx :: - - "" - -typedef ^ ^ R8Ki dYdu :: - - "" - -typedef ^ ^ R8Ki dXdu :: - - "" - -typedef ^ ^ R8Ki dUdu :: - - "" - -typedef ^ ^ R8Ki dUdy :: - - "" - -typedef ^ ^ R8Ki StateRotation :: - - "" - - -typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - -typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ IntKi Idx - 0 - "Module index in array of modules" - -typedef ^ ^ IntKi Ins - 0 - "Module instance number" - -typedef ^ ^ R8Ki DT - 0 - "Module time step" - -typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - -typedef ^ ^ ModLinTCType Lin - - - "Module linearization data" - -typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" -typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" - -# Variable indexing -typedef ^ VarIdxType IntKi ModVarStart : - - "Variable start index from module index" - -typedef ^ ^ IntKi ValLocGbl :: - - "Variable local and global value indices" - -typedef ^ VarsIdxType IntKi FlagFilter - - - "" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nxd - - - "" - -typedef ^ ^ IntKi Nz - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ^ VarIdxType x - - - "" - -typedef ^ ^ VarIdxType xd - - - "" - -typedef ^ ^ VarIdxType z - - - "" - -typedef ^ ^ VarIdxType u - - - "" - -typedef ^ ^ VarIdxType y - - - "" - -typedef ^ ^ ModLinTCType Lin - - - "Linearization matrices" - - -typedef ^ ML_ParameterType IntKi iMod : - - "ModData index order for linearization" - -typedef ^ ^ VarsIdxType IdxLin - - - "Variable index for linearization data" - -typedef ^ ML_MiscVarType TC_MappingType Mappings : - - "Module mesh mapping" - -typedef ^ ML_OutputType ModLinTCType Lin : - - "Module linearization type" - - -# Misc/Optimization variables -typedef ^ TC_MiscVarType R8Ki q :: - - "" - -typedef ^ ^ R8Ki qn :: - - "" - -typedef ^ ^ R8Ki x : - - "" - -typedef ^ ^ R8Ki xn : - - "" - -typedef ^ ^ R8Ki dxdt : - - "" - -typedef ^ ^ R8Ki u : - - "" - -typedef ^ ^ R8Ki un : - - "" - -typedef ^ ^ R8Ki u_tmp : - - "" - -typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki dYdx :: - - "" - -typedef ^ ^ R8Ki dYdu :: - - "" - -typedef ^ ^ R8Ki dXdx :: - - "" - -typedef ^ ^ R8Ki dXdu :: - - "" - -typedef ^ ^ R8Ki dUdu :: - - "" - -typedef ^ ^ R8Ki dUdy :: - - "" - -typedef ^ ^ R8Ki GinvdUdu :: - - "" - -typedef ^ ^ R8Ki dUdyHat :: - - "" - -typedef ^ ^ R8Ki XB :: - - "" - -typedef ^ ^ R8Ki G :: - - "Used to merge state matrices" - -typedef ^ ^ R8Ki Jac :: - - "" - -typedef ^ ^ IntKi IPIV : - - "" - -typedef ^ ^ IntKi IterTotal - 0 - "" - -typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - -typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - -typedef ^ ^ R8Ki dq :: - - "Change in q" - -typedef ^ ^ R8Ki dx : - - "Change in x" - -typedef ^ ^ R8Ki du : - - "" - -typedef ^ ^ R8Ki UDiff : - - "" - -typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - -typedef ^ ^ TC_MappingType Mappings : - - "Array of mesh mappings in solver" - - - # ..... FAST_ParameterType data ....................................................................................................... # Misc data for coupling: typedef FAST FAST_ParameterType DbKi DT - - - "Integration time step [global time]" s @@ -388,8 +215,6 @@ typedef ^ FAST_ParameterType IntKi Lin_ModOrder {NumModules} - - "indices that d typedef ^ FAST_ParameterType IntKi LinInterpOrder - - - "Interpolation order for CalcSteady solution" - #typedef ^ FAST_ParameterType LOGICAL CheckHSSBrTrqC - - - "Flag to determine if we should check HSSBrTrqC extrapolation to ElastoDyn" - -typedef ^ FAST_ParameterType ML_ParameterType ModLin - - - "Module data based linearization" - # Parameters for steady-state calculations: typedef ^ FAST_ParameterType LOGICAL CompAeroMaps - - - "Flag to determine if we are calculating aero maps" - typedef ^ FAST_ParameterType IntKi N_UJac - - - "Number of iterations between re-calculating Jacobian" "(-)" @@ -575,8 +400,6 @@ typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operat typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {6} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnit {:} - - "units of data output from the driver" -typedef ^ FAST_OutputFileType ModDataType Modules {:} - - "module variable and value data" - -typedef ^ FAST_OutputFileType ModDataType ModGlue - - - "module variable and value data" - # ..... IceDyn data ....................................................................................................... @@ -973,7 +796,6 @@ typedef ^ FAST_MiscVarType INTEGER SimStrtTime {8} - - "Start time of simulation typedef ^ FAST_MiscVarType Logical calcJacobian - - - "Should we calculate Jacobians in Option 1?" (flag) typedef ^ FAST_MiscVarType FAST_ExternInputType ExternInput - - - "external input values" - typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearization analysis" - -typedef ^ FAST_MiscVarType ML_MiscVarType ModLin - - - "Module linearization Miscellaneous variables" - # ..... FAST_InitData data ....................................................................................................... @@ -1050,6 +872,9 @@ typedef ^ FAST_TurbineType IntKi TurbID - 1 - "Turbine ID Number" - typedef ^ FAST_TurbineType FAST_ParameterType p_FAST - - - "Parameters for the glue code" - typedef ^ FAST_TurbineType FAST_OutputFileType y_FAST - - - "Output variables for the glue code" - typedef ^ FAST_TurbineType FAST_MiscVarType m_FAST - - - "Miscellaneous variables" - +typedef ^ FAST_TurbineType Glue_ParameterType p_Glue - - - "Parameters for the glue code" - +typedef ^ FAST_TurbineType Glue_OutputFileType y_Glue - - - "Output variables for the glue code" - +typedef ^ FAST_TurbineType Glue_MiscVarType m_Glue - - - "Miscellaneous variables" - typedef ^ FAST_TurbineType FAST_ModuleMapType MeshMapData - - - "Data for mapping between modules" - typedef ^ FAST_TurbineType ElastoDyn_Data ED - - - "Data for the ElastoDyn module" - typedef ^ FAST_TurbineType BeamDyn_Data BD - - - "Data for the BeamDyn module" - diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 73680118bf..62821b43a6 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -50,18 +50,18 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In IF (PRESENT(InFile)) THEN IF (PRESENT(ExternInitData)) THEN - CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) ELSE - CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile ) END IF ELSE - CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) @@ -69,19 +69,19 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In if(ErrStat >= AbortErrLev) return - call ModGlue_Init(Turbine%y_FAST%ModGlue, Turbine%y_FAST%Modules, & - Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, & + call ModGlue_Init(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & Turbine%p_FAST, Turbine%m_FAST, Turbine, ErrStat, ErrMsg) END SUBROUTINE FAST_InitializeAll_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to call Init routine for each module. This routine sets all of the init input data for each module. -SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & +SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) use ElastoDyn_Parameters, only: Method_RK4 REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + TYPE(Glue_MiscVarType), INTENT(INOUT) :: m_Glue !< Miscellaneous variables glue code TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables @@ -298,7 +298,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, end if ! Add module to array of modules - CALL MV_AddModule(y_FAST%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & Init%OutData_ED%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -438,7 +438,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, end if ! Add module instance to array of modules - CALL MV_AddModule(y_FAST%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%ModData, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END DO @@ -576,7 +576,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS end if - CALL MV_AddModule(y_FAST%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & Init%OutData_IfW%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -735,7 +735,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%VTK_surface%NWaveElevPts(2) = 0 endif - CALL MV_AddModule(y_FAST%Modules, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & Init%OutData_SeaSt%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -869,7 +869,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize a module instance for each rotor do i = 1, size(Init%OutData_AD%rotors) - CALL MV_AddModule(y_FAST%Modules, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & Init%OutData_AD%rotors(i)%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do @@ -982,7 +982,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MV_AddModule(y_FAST%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & Init%OutData_HD%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1081,7 +1081,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_SD%DerivOrder_x)) call move_alloc(Init%OutData_SD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%DerivOrder_x) end if - CALL MV_AddModule(y_FAST%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & Init%OutData_SD%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1206,7 +1206,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MV_AddModule(y_FAST%Modules, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & Init%OutData_MAP%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1275,7 +1275,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_MD%DerivOrder_x)) call move_alloc(Init%OutData_MD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%DerivOrder_x) end if - CALL MV_AddModule(y_FAST%Modules, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & Init%OutData_MD%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1588,7 +1588,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_SrvD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MV_AddModule(y_FAST%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & Init%OutData_SrvD%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9343,9 +9343,8 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then - call ModGlue_Linearize_OP(Turbine, Turbine%y_FAST%Modules, Turbine%y_FAST%ModGlue, & - Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, Turbine%p_FAST, Turbine%m_FAST, & - Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) + call ModGlue_Linearize_OP(Turbine, Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -9399,9 +9398,8 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - call ModGlue_Linearize_OP(Turbine, Turbine%y_FAST%Modules, Turbine%y_FAST%ModGlue, & - Turbine%p_FAST%ModLin, Turbine%m_FAST%ModLin, Turbine%p_FAST, Turbine%m_FAST, & - Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) + call ModGlue_Linearize_OP(Turbine, Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 0bf920a20c..53ec49a9b2 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE FAST_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE Glue_Types USE ElastoDyn_Types USE BeamDyn_Types USE ServoDyn_Types @@ -82,10 +83,6 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Map_LoadMesh = 1 ! Load mesh mapping type [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Variable = 3 ! Individual variable mapping type [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Custom = 4 ! Custom mapping not used for linearization [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] @@ -131,201 +128,6 @@ MODULE FAST_Types REAL(ReKi) :: Pitch = 0.0_ReKi !< Pitch angle for this case of the steady-state solve [(rad)] END TYPE FAST_SS_CaseType ! ======================= -! ========= TC_MappingType ======= - TYPE, PUBLIC :: TC_MappingType - character(128) :: Desc !< Description of mapping (used to lookup non-mesh maps) [-] - INTEGER(IntKi) :: SrcModIdx = 0 !< Source module index in ModData array [-] - INTEGER(IntKi) :: DstModIdx = 0 !< Destination module index in ModData array [-] - INTEGER(IntKi) :: SrcModID = 0 !< Source module ID [-] - INTEGER(IntKi) :: DstModID = 0 !< Destination module ID [-] - INTEGER(IntKi) :: SrcIns = 0 !< Source module Instance [-] - INTEGER(IntKi) :: DstIns = 0 !< Destination module Instance [-] - INTEGER(IntKi) :: SrcMeshID = 0 !< Source mesh identifier [-] - INTEGER(IntKi) :: DstMeshID = 0 !< Destination mesh identifier [-] - INTEGER(IntKi) :: iVarSrc = 0 !< Source variable index [-] - INTEGER(IntKi) :: iVarDst = 0 !< Destination variable index [-] - INTEGER(IntKi) :: SrcDispMeshID = 0 !< Source displacement mesh identifier [-] - INTEGER(IntKi) :: DstDispMeshID = 0 !< Destination displacement mesh identifier [-] - TYPE(MeshLocType) :: SrcMeshLoc !< Source mesh locator (number and indices) [-] - TYPE(MeshLocType) :: DstMeshLoc !< Destination mesh locator (number and indices) [-] - TYPE(MeshLocType) :: SrcDispMeshLoc !< Source displacement mesh locator (number and indices) [-] - TYPE(MeshLocType) :: DstDispMeshLoc !< Destination displacement mesh locator (number and indices) [-] - INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] - INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] - INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] - LOGICAL :: Ready = .false. !< Flag indicating Source has been ready to be transferred [-] - LOGICAL :: DstUsesSibling = .false. !< Flag indicating the destination displacement mesh is a sibling of the destination load mesh [-] - TYPE(MeshType) :: TmpLoadMesh !< Temporary load mesh for intermediate transfers [-] - TYPE(MeshType) :: TmpMotionMesh !< Temporary motion mesh for intermediate transfers [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] - TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] - TYPE(MeshMapType) :: MeshMapAux !< Auxiliary mesh mapping for destination load meshes without sibling motion mesh [-] - INTEGER(IntKi) :: iVarSrcTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcTransVel = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcTransAcc = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcAngularVel = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcAngularAcc = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcForce = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcMoment = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcDispTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstTransVel = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstTransAcc = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstAngularVel = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstAngularAcc = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstForce = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstMoment = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstDispTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstDispOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] - END TYPE TC_MappingType -! ======================= -! ========= TC_ParameterType ======= - TYPE, PUBLIC :: TC_ParameterType - REAL(R8Ki) :: DT = 0.0_R8Ki !< solution time step [-] - REAL(R8Ki) :: ConvTol = 0.0_R8Ki !< Solution convergence tolerance [-] - INTEGER(IntKi) :: NumCrctn = 0_IntKi !< [-] - INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< [-] - INTEGER(IntKi) :: NIter_UJac = 0_IntKi !< Number of solution iterations between updating the Jacobian [-] - INTEGER(IntKi) :: NStep_UJac = 0_IntKi !< Number of global time steps between updating the Jacobian [-] - REAL(R8Ki) :: Scale_UJac = 0.0_R8Ki !< [-] - REAL(R8Ki) :: AccBlend = 1 !< [-] - REAL(R8Ki) :: RhoInf = 0.0_R8Ki !< Rho infinity used for calculating Generalized-alpha coefficients [-] - REAL(R8Ki) :: AlphaM = 0.0_R8Ki !< Generalized-alpha alpha_m coefficient [-] - REAL(R8Ki) :: AlphaF = 0.0_R8Ki !< Generalized-alpha alpha_f coefficient [-] - REAL(R8Ki) :: Beta = 0.0_R8Ki !< Generalized-alpha beta coefficient [-] - REAL(R8Ki) :: Gamma = 0.0_R8Ki !< Generalized-alpha gamma coefficient [-] - REAL(R8Ki) , DIMENSION(1:7) :: C = 0.0_R8Ki !< Generalized-alpha coefficient array [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iX1 = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iX2 = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iUT = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iU1 = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iyT = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iy1 = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iJX = 0_IntKi !< Indices of Jacobian q variables [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iJU = 0_IntKi !< Indices of Jacobian input variables [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJL !< Indices of Jacobian load variables [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModInit !< ModData index order for step 0 initialization [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModBD !< ModData index order for BD modules [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1US !< ModData index order for option 1 modules to update states [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModPost !< ModData index order for post option 1 modules [-] - END TYPE TC_ParameterType -! ======================= -! ========= ModLinTCType ======= - TYPE, PUBLIC :: ModLinTCType - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] - END TYPE ModLinTCType -! ======================= -! ========= ModDataType ======= - TYPE, PUBLIC :: ModDataType - character(ChanLen) :: Abbr !< Module name abbreviation [-] - INTEGER(IntKi) :: ID = 0 !< Module identification number [-] - INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] - INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] - REAL(R8Ki) :: DT = 0 !< Module time step [-] - INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] - TYPE(ModLinTCType) :: Lin !< Module linearization data [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] - END TYPE ModDataType -! ======================= -! ========= VarIdxType ======= - TYPE, PUBLIC :: VarIdxType - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ModVarStart !< Variable start index from module index [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ValLocGbl !< Variable local and global value indices [-] - END TYPE VarIdxType -! ======================= -! ========= VarsIdxType ======= - TYPE, PUBLIC :: VarsIdxType - INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] - INTEGER(IntKi) :: Nx = 0_IntKi !< [-] - INTEGER(IntKi) :: Nxd = 0_IntKi !< [-] - INTEGER(IntKi) :: Nz = 0_IntKi !< [-] - INTEGER(IntKi) :: Nu = 0_IntKi !< [-] - INTEGER(IntKi) :: Ny = 0_IntKi !< [-] - TYPE(VarIdxType) :: x !< [-] - TYPE(VarIdxType) :: xd !< [-] - TYPE(VarIdxType) :: z !< [-] - TYPE(VarIdxType) :: u !< [-] - TYPE(VarIdxType) :: y !< [-] - TYPE(ModLinTCType) :: Lin !< Linearization matrices [-] - END TYPE VarsIdxType -! ======================= -! ========= ML_ParameterType ======= - TYPE, PUBLIC :: ML_ParameterType - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] - TYPE(VarsIdxType) :: IdxLin !< Variable index for linearization data [-] - END TYPE ML_ParameterType -! ======================= -! ========= ML_MiscVarType ======= - TYPE, PUBLIC :: ML_MiscVarType - TYPE(TC_MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mesh mapping [-] - END TYPE ML_MiscVarType -! ======================= -! ========= ML_OutputType ======= - TYPE, PUBLIC :: ML_OutputType - TYPE(ModLinTCType) , DIMENSION(:), ALLOCATABLE :: Lin !< Module linearization type [-] - END TYPE ML_OutputType -! ======================= -! ========= TC_MiscVarType ======= - TYPE, PUBLIC :: TC_MiscVarType - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: q !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: qn !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: un !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_tmp !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: GinvdUdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdyHat !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: G !< Used to merge state matrices [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] - INTEGER(IntKi) :: IterTotal = 0 !< [-] - INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] - INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dq !< Change in q [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< Change in x [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UDiff !< [-] - LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] - TYPE(TC_MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Array of mesh mappings in solver [-] - END TYPE TC_MiscVarType -! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Integration time step [global time] [s] @@ -421,7 +223,6 @@ MODULE FAST_Types INTEGER(IntKi) :: Lin_NumMods = 0_IntKi !< number of modules in the linearization [-] INTEGER(IntKi) , DIMENSION(1:NumModules) :: Lin_ModOrder = 0_IntKi !< indices that determine which order the modules are in the glue-code linearization matrix [-] INTEGER(IntKi) :: LinInterpOrder = 0_IntKi !< Interpolation order for CalcSteady solution [-] - TYPE(ML_ParameterType) :: ModLin !< Module data based linearization [-] LOGICAL :: CompAeroMaps = .false. !< Flag to determine if we are calculating aero maps [-] INTEGER(IntKi) :: N_UJac = 0_IntKi !< Number of iterations between re-calculating Jacobian [(-)] INTEGER(IntKi) :: NumBl_Lin = 0_IntKi !< number of blades in the jacobian [-] @@ -594,8 +395,6 @@ MODULE FAST_Types INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] REAL(ReKi) , DIMENSION(1:6) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed [-] - TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: Modules !< module variable and value data [-] - TYPE(ModDataType) :: ModGlue !< module variable and value data [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -1009,7 +808,6 @@ MODULE FAST_Types LOGICAL :: calcJacobian = .false. !< Should we calculate Jacobians in Option 1? [(flag)] TYPE(FAST_ExternInputType) :: ExternInput !< external input values [-] TYPE(FAST_MiscLinType) :: Lin !< misc data for linearization analysis [-] - TYPE(ML_MiscVarType) :: ModLin !< Module linearization Miscellaneous variables [-] END TYPE FAST_MiscVarType ! ======================= ! ========= FAST_InitData ======= @@ -1090,6 +888,9 @@ MODULE FAST_Types TYPE(FAST_ParameterType) :: p_FAST !< Parameters for the glue code [-] TYPE(FAST_OutputFileType) :: y_FAST !< Output variables for the glue code [-] TYPE(FAST_MiscVarType) :: m_FAST !< Miscellaneous variables [-] + TYPE(Glue_ParameterType) :: p_Glue !< Parameters for the glue code [-] + TYPE(Glue_OutputFileType) :: y_Glue !< Output variables for the glue code [-] + TYPE(Glue_MiscVarType) :: m_Glue !< Miscellaneous variables [-] TYPE(FAST_ModuleMapType) :: MeshMapData !< Data for mapping between modules [-] TYPE(ElastoDyn_Data) :: ED !< Data for the ElastoDyn module [-] TYPE(BeamDyn_Data) :: BD !< Data for the BeamDyn module [-] @@ -1353,2177 +1154,228 @@ subroutine FAST_UnPackVTK_SurfaceType(RF, OutData) call RegUnpackAlloc(RF, OutData%WaveElevVisGrid); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackVTK_BLSurfaceType(RF, OutData%BladeShape(i1)) ! BladeShape - end do - end if - call RegUnpackAlloc(RF, OutData%MorisonVisRad); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg) - type(FAST_VTK_ModeShapeType), intent(in) :: SrcVTK_ModeShapeTypeData - type(FAST_VTK_ModeShapeType), intent(inout) :: DstVTK_ModeShapeTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'FAST_CopyVTK_ModeShapeType' - ErrStat = ErrID_None - ErrMsg = '' - DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot - DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName - DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes - if (allocated(SrcVTK_ModeShapeTypeData%VTKModes)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then - allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes - end if - DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim - DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes - DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale - DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase - if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then - allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio - end if - if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then - allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz - end if - if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then - allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz - end if - if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then - allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude - end if - if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) - if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then - allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase - end if -end subroutine - -subroutine FAST_DestroyVTK_ModeShapeType(VTK_ModeShapeTypeData, ErrStat, ErrMsg) - type(FAST_VTK_ModeShapeType), intent(inout) :: VTK_ModeShapeTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(VTK_ModeShapeTypeData%VTKModes)) then - deallocate(VTK_ModeShapeTypeData%VTKModes) - end if - if (allocated(VTK_ModeShapeTypeData%DampingRatio)) then - deallocate(VTK_ModeShapeTypeData%DampingRatio) - end if - if (allocated(VTK_ModeShapeTypeData%NaturalFreq_Hz)) then - deallocate(VTK_ModeShapeTypeData%NaturalFreq_Hz) - end if - if (allocated(VTK_ModeShapeTypeData%DampedFreq_Hz)) then - deallocate(VTK_ModeShapeTypeData%DampedFreq_Hz) - end if - if (allocated(VTK_ModeShapeTypeData%x_eig_magnitude)) then - deallocate(VTK_ModeShapeTypeData%x_eig_magnitude) - end if - if (allocated(VTK_ModeShapeTypeData%x_eig_phase)) then - deallocate(VTK_ModeShapeTypeData%x_eig_phase) - end if -end subroutine - -subroutine FAST_PackVTK_ModeShapeType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(FAST_VTK_ModeShapeType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%CheckpointRoot) - call RegPack(RF, InData%MatlabFileName) - call RegPack(RF, InData%VTKLinModes) - call RegPackAlloc(RF, InData%VTKModes) - call RegPack(RF, InData%VTKLinTim) - call RegPack(RF, InData%VTKNLinTimes) - call RegPack(RF, InData%VTKLinScale) - call RegPack(RF, InData%VTKLinPhase) - call RegPackAlloc(RF, InData%DampingRatio) - call RegPackAlloc(RF, InData%NaturalFreq_Hz) - call RegPackAlloc(RF, InData%DampedFreq_Hz) - call RegPackAlloc(RF, InData%x_eig_magnitude) - call RegPackAlloc(RF, InData%x_eig_phase) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackVTK_ModeShapeType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(FAST_VTK_ModeShapeType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%CheckpointRoot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MatlabFileName); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKLinModes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%VTKModes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKLinTim); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKNLinTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKLinScale); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTKLinPhase); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DampingRatio); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NaturalFreq_Hz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DampedFreq_Hz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_eig_magnitude); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_eig_phase); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopySS_CaseType(SrcSS_CaseTypeData, DstSS_CaseTypeData, CtrlCode, ErrStat, ErrMsg) - type(FAST_SS_CaseType), intent(in) :: SrcSS_CaseTypeData - type(FAST_SS_CaseType), intent(inout) :: DstSS_CaseTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_CopySS_CaseType' - ErrStat = ErrID_None - ErrMsg = '' - DstSS_CaseTypeData%RotSpeed = SrcSS_CaseTypeData%RotSpeed - DstSS_CaseTypeData%TSR = SrcSS_CaseTypeData%TSR - DstSS_CaseTypeData%WindSpeed = SrcSS_CaseTypeData%WindSpeed - DstSS_CaseTypeData%Pitch = SrcSS_CaseTypeData%Pitch -end subroutine - -subroutine FAST_DestroySS_CaseType(SS_CaseTypeData, ErrStat, ErrMsg) - type(FAST_SS_CaseType), intent(inout) :: SS_CaseTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_DestroySS_CaseType' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine FAST_PackSS_CaseType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(FAST_SS_CaseType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackSS_CaseType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%RotSpeed) - call RegPack(RF, InData%TSR) - call RegPack(RF, InData%WindSpeed) - call RegPack(RF, InData%Pitch) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackSS_CaseType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(FAST_SS_CaseType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackSS_CaseType' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, CtrlCode, ErrStat, ErrMsg) - type(TC_MappingType), intent(inout) :: SrcTC_MappingTypeData - type(TC_MappingType), intent(inout) :: DstTC_MappingTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyTC_MappingType' - ErrStat = ErrID_None - ErrMsg = '' - DstTC_MappingTypeData%Desc = SrcTC_MappingTypeData%Desc - DstTC_MappingTypeData%SrcModIdx = SrcTC_MappingTypeData%SrcModIdx - DstTC_MappingTypeData%DstModIdx = SrcTC_MappingTypeData%DstModIdx - DstTC_MappingTypeData%SrcModID = SrcTC_MappingTypeData%SrcModID - DstTC_MappingTypeData%DstModID = SrcTC_MappingTypeData%DstModID - DstTC_MappingTypeData%SrcIns = SrcTC_MappingTypeData%SrcIns - DstTC_MappingTypeData%DstIns = SrcTC_MappingTypeData%DstIns - DstTC_MappingTypeData%SrcMeshID = SrcTC_MappingTypeData%SrcMeshID - DstTC_MappingTypeData%DstMeshID = SrcTC_MappingTypeData%DstMeshID - DstTC_MappingTypeData%iVarSrc = SrcTC_MappingTypeData%iVarSrc - DstTC_MappingTypeData%iVarDst = SrcTC_MappingTypeData%iVarDst - DstTC_MappingTypeData%SrcDispMeshID = SrcTC_MappingTypeData%SrcDispMeshID - DstTC_MappingTypeData%DstDispMeshID = SrcTC_MappingTypeData%DstDispMeshID - call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%SrcMeshLoc, DstTC_MappingTypeData%SrcMeshLoc, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%DstMeshLoc, DstTC_MappingTypeData%DstMeshLoc, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%SrcDispMeshLoc, DstTC_MappingTypeData%SrcDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshLocType(SrcTC_MappingTypeData%DstDispMeshLoc, DstTC_MappingTypeData%DstDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstTC_MappingTypeData%MapType = SrcTC_MappingTypeData%MapType - DstTC_MappingTypeData%XfrType = SrcTC_MappingTypeData%XfrType - DstTC_MappingTypeData%XfrTypeAux = SrcTC_MappingTypeData%XfrTypeAux - DstTC_MappingTypeData%Ready = SrcTC_MappingTypeData%Ready - DstTC_MappingTypeData%DstUsesSibling = SrcTC_MappingTypeData%DstUsesSibling - call MeshCopy(SrcTC_MappingTypeData%TmpLoadMesh, DstTC_MappingTypeData%TmpLoadMesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcTC_MappingTypeData%TmpMotionMesh, DstTC_MappingTypeData%TmpMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcTC_MappingTypeData%TmpMatrix)) then - LB(1:2) = lbound(SrcTC_MappingTypeData%TmpMatrix, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MappingTypeData%TmpMatrix, kind=B8Ki) - if (.not. allocated(DstTC_MappingTypeData%TmpMatrix)) then - allocate(DstTC_MappingTypeData%TmpMatrix(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MappingTypeData%TmpMatrix.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MappingTypeData%TmpMatrix = SrcTC_MappingTypeData%TmpMatrix - end if - call NWTC_Library_CopyMeshMapType(SrcTC_MappingTypeData%MeshMap, DstTC_MappingTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshMapType(SrcTC_MappingTypeData%MeshMapAux, DstTC_MappingTypeData%MeshMapAux, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstTC_MappingTypeData%iVarSrcTransDisp = SrcTC_MappingTypeData%iVarSrcTransDisp - DstTC_MappingTypeData%iVarSrcTransVel = SrcTC_MappingTypeData%iVarSrcTransVel - DstTC_MappingTypeData%iVarSrcTransAcc = SrcTC_MappingTypeData%iVarSrcTransAcc - DstTC_MappingTypeData%iVarSrcOrientation = SrcTC_MappingTypeData%iVarSrcOrientation - DstTC_MappingTypeData%iVarSrcAngularVel = SrcTC_MappingTypeData%iVarSrcAngularVel - DstTC_MappingTypeData%iVarSrcAngularAcc = SrcTC_MappingTypeData%iVarSrcAngularAcc - DstTC_MappingTypeData%iVarSrcForce = SrcTC_MappingTypeData%iVarSrcForce - DstTC_MappingTypeData%iVarSrcMoment = SrcTC_MappingTypeData%iVarSrcMoment - DstTC_MappingTypeData%iVarSrcDispTransDisp = SrcTC_MappingTypeData%iVarSrcDispTransDisp - DstTC_MappingTypeData%iVarDstTransDisp = SrcTC_MappingTypeData%iVarDstTransDisp - DstTC_MappingTypeData%iVarDstTransVel = SrcTC_MappingTypeData%iVarDstTransVel - DstTC_MappingTypeData%iVarDstTransAcc = SrcTC_MappingTypeData%iVarDstTransAcc - DstTC_MappingTypeData%iVarDstOrientation = SrcTC_MappingTypeData%iVarDstOrientation - DstTC_MappingTypeData%iVarDstAngularVel = SrcTC_MappingTypeData%iVarDstAngularVel - DstTC_MappingTypeData%iVarDstAngularAcc = SrcTC_MappingTypeData%iVarDstAngularAcc - DstTC_MappingTypeData%iVarDstForce = SrcTC_MappingTypeData%iVarDstForce - DstTC_MappingTypeData%iVarDstMoment = SrcTC_MappingTypeData%iVarDstMoment - DstTC_MappingTypeData%iVarDstDispTransDisp = SrcTC_MappingTypeData%iVarDstDispTransDisp - DstTC_MappingTypeData%iVarDstDispOrientation = SrcTC_MappingTypeData%iVarDstDispOrientation -end subroutine - -subroutine FAST_DestroyTC_MappingType(TC_MappingTypeData, ErrStat, ErrMsg) - type(TC_MappingType), intent(inout) :: TC_MappingTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyTC_MappingType' - ErrStat = ErrID_None - ErrMsg = '' - call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%SrcMeshLoc, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%DstMeshLoc, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%SrcDispMeshLoc, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshLocType(TC_MappingTypeData%DstDispMeshLoc, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( TC_MappingTypeData%TmpLoadMesh, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( TC_MappingTypeData%TmpMotionMesh, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(TC_MappingTypeData%TmpMatrix)) then - deallocate(TC_MappingTypeData%TmpMatrix) - end if - call NWTC_Library_DestroyMeshMapType(TC_MappingTypeData%MeshMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshMapType(TC_MappingTypeData%MeshMapAux, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine FAST_PackTC_MappingType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(TC_MappingType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackTC_MappingType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Desc) - call RegPack(RF, InData%SrcModIdx) - call RegPack(RF, InData%DstModIdx) - call RegPack(RF, InData%SrcModID) - call RegPack(RF, InData%DstModID) - call RegPack(RF, InData%SrcIns) - call RegPack(RF, InData%DstIns) - call RegPack(RF, InData%SrcMeshID) - call RegPack(RF, InData%DstMeshID) - call RegPack(RF, InData%iVarSrc) - call RegPack(RF, InData%iVarDst) - call RegPack(RF, InData%SrcDispMeshID) - call RegPack(RF, InData%DstDispMeshID) - call NWTC_Library_PackMeshLocType(RF, InData%SrcMeshLoc) - call NWTC_Library_PackMeshLocType(RF, InData%DstMeshLoc) - call NWTC_Library_PackMeshLocType(RF, InData%SrcDispMeshLoc) - call NWTC_Library_PackMeshLocType(RF, InData%DstDispMeshLoc) - call RegPack(RF, InData%MapType) - call RegPack(RF, InData%XfrType) - call RegPack(RF, InData%XfrTypeAux) - call RegPack(RF, InData%Ready) - call RegPack(RF, InData%DstUsesSibling) - call MeshPack(RF, InData%TmpLoadMesh) - call MeshPack(RF, InData%TmpMotionMesh) - call RegPackAlloc(RF, InData%TmpMatrix) - call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) - call NWTC_Library_PackMeshMapType(RF, InData%MeshMapAux) - call RegPack(RF, InData%iVarSrcTransDisp) - call RegPack(RF, InData%iVarSrcTransVel) - call RegPack(RF, InData%iVarSrcTransAcc) - call RegPack(RF, InData%iVarSrcOrientation) - call RegPack(RF, InData%iVarSrcAngularVel) - call RegPack(RF, InData%iVarSrcAngularAcc) - call RegPack(RF, InData%iVarSrcForce) - call RegPack(RF, InData%iVarSrcMoment) - call RegPack(RF, InData%iVarSrcDispTransDisp) - call RegPack(RF, InData%iVarDstTransDisp) - call RegPack(RF, InData%iVarDstTransVel) - call RegPack(RF, InData%iVarDstTransAcc) - call RegPack(RF, InData%iVarDstOrientation) - call RegPack(RF, InData%iVarDstAngularVel) - call RegPack(RF, InData%iVarDstAngularAcc) - call RegPack(RF, InData%iVarDstForce) - call RegPack(RF, InData%iVarDstMoment) - call RegPack(RF, InData%iVarDstDispTransDisp) - call RegPack(RF, InData%iVarDstDispOrientation) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackTC_MappingType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(TC_MappingType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackTC_MappingType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Desc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SrcModIdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstModIdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SrcModID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstModID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SrcIns); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstIns); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SrcMeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstMeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDst); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SrcDispMeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstDispMeshID); if (RegCheckErr(RF, RoutineName)) return - call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcMeshLoc) ! SrcMeshLoc - call NWTC_Library_UnpackMeshLocType(RF, OutData%DstMeshLoc) ! DstMeshLoc - call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcDispMeshLoc) ! SrcDispMeshLoc - call NWTC_Library_UnpackMeshLocType(RF, OutData%DstDispMeshLoc) ! DstDispMeshLoc - call RegUnpack(RF, OutData%MapType); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%XfrType); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%XfrTypeAux); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ready); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstUsesSibling); if (RegCheckErr(RF, RoutineName)) return - call MeshUnpack(RF, OutData%TmpLoadMesh) ! TmpLoadMesh - call MeshUnpack(RF, OutData%TmpMotionMesh) ! TmpMotionMesh - call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return - call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap - call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMapAux) ! MeshMapAux - call RegUnpack(RF, OutData%iVarSrcTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcTransVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcTransAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcOrientation); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcAngularVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcAngularAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcForce); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcMoment); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcDispTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstTransVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstTransAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstOrientation); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstAngularVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstAngularAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstForce); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstMoment); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstDispTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstDispOrientation); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) - type(TC_ParameterType), intent(in) :: SrcTC_ParameterTypeData - type(TC_ParameterType), intent(inout) :: DstTC_ParameterTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'FAST_CopyTC_ParameterType' - ErrStat = ErrID_None - ErrMsg = '' - DstTC_ParameterTypeData%DT = SrcTC_ParameterTypeData%DT - DstTC_ParameterTypeData%ConvTol = SrcTC_ParameterTypeData%ConvTol - DstTC_ParameterTypeData%NumCrctn = SrcTC_ParameterTypeData%NumCrctn - DstTC_ParameterTypeData%MaxConvIter = SrcTC_ParameterTypeData%MaxConvIter - DstTC_ParameterTypeData%NIter_UJac = SrcTC_ParameterTypeData%NIter_UJac - DstTC_ParameterTypeData%NStep_UJac = SrcTC_ParameterTypeData%NStep_UJac - DstTC_ParameterTypeData%Scale_UJac = SrcTC_ParameterTypeData%Scale_UJac - DstTC_ParameterTypeData%AccBlend = SrcTC_ParameterTypeData%AccBlend - DstTC_ParameterTypeData%RhoInf = SrcTC_ParameterTypeData%RhoInf - DstTC_ParameterTypeData%AlphaM = SrcTC_ParameterTypeData%AlphaM - DstTC_ParameterTypeData%AlphaF = SrcTC_ParameterTypeData%AlphaF - DstTC_ParameterTypeData%Beta = SrcTC_ParameterTypeData%Beta - DstTC_ParameterTypeData%Gamma = SrcTC_ParameterTypeData%Gamma - DstTC_ParameterTypeData%C = SrcTC_ParameterTypeData%C - DstTC_ParameterTypeData%iX1 = SrcTC_ParameterTypeData%iX1 - DstTC_ParameterTypeData%iX2 = SrcTC_ParameterTypeData%iX2 - DstTC_ParameterTypeData%iUT = SrcTC_ParameterTypeData%iUT - DstTC_ParameterTypeData%iU1 = SrcTC_ParameterTypeData%iU1 - DstTC_ParameterTypeData%iyT = SrcTC_ParameterTypeData%iyT - DstTC_ParameterTypeData%iy1 = SrcTC_ParameterTypeData%iy1 - DstTC_ParameterTypeData%iJX = SrcTC_ParameterTypeData%iJX - DstTC_ParameterTypeData%iJU = SrcTC_ParameterTypeData%iJU - DstTC_ParameterTypeData%iJUT = SrcTC_ParameterTypeData%iJUT - if (allocated(SrcTC_ParameterTypeData%iJL)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iJL, kind=B8Ki) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iJL, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%iJL)) then - allocate(DstTC_ParameterTypeData%iJL(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJL.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iJL = SrcTC_ParameterTypeData%iJL - end if - if (allocated(SrcTC_ParameterTypeData%ixqd)) then - LB(1:2) = lbound(SrcTC_ParameterTypeData%ixqd, kind=B8Ki) - UB(1:2) = ubound(SrcTC_ParameterTypeData%ixqd, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%ixqd)) then - allocate(DstTC_ParameterTypeData%ixqd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%ixqd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%ixqd = SrcTC_ParameterTypeData%ixqd - end if - if (allocated(SrcTC_ParameterTypeData%iModInit)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iModInit, kind=B8Ki) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iModInit, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%iModInit)) then - allocate(DstTC_ParameterTypeData%iModInit(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModInit.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iModInit = SrcTC_ParameterTypeData%iModInit - end if - if (allocated(SrcTC_ParameterTypeData%iModTC)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iModTC, kind=B8Ki) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iModTC, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%iModTC)) then - allocate(DstTC_ParameterTypeData%iModTC(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModTC.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iModTC = SrcTC_ParameterTypeData%iModTC - end if - if (allocated(SrcTC_ParameterTypeData%iModBD)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iModBD, kind=B8Ki) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iModBD, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%iModBD)) then - allocate(DstTC_ParameterTypeData%iModBD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModBD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iModBD = SrcTC_ParameterTypeData%iModBD - end if - if (allocated(SrcTC_ParameterTypeData%iModOpt1)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt1, kind=B8Ki) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt1, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%iModOpt1)) then - allocate(DstTC_ParameterTypeData%iModOpt1(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iModOpt1 = SrcTC_ParameterTypeData%iModOpt1 - end if - if (allocated(SrcTC_ParameterTypeData%iModOpt1US)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt1US, kind=B8Ki) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt1US, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%iModOpt1US)) then - allocate(DstTC_ParameterTypeData%iModOpt1US(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt1US.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iModOpt1US = SrcTC_ParameterTypeData%iModOpt1US - end if - if (allocated(SrcTC_ParameterTypeData%iModOpt2)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt2, kind=B8Ki) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt2, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%iModOpt2)) then - allocate(DstTC_ParameterTypeData%iModOpt2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iModOpt2 = SrcTC_ParameterTypeData%iModOpt2 - end if - if (allocated(SrcTC_ParameterTypeData%iModPost)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iModPost, kind=B8Ki) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iModPost, kind=B8Ki) - if (.not. allocated(DstTC_ParameterTypeData%iModPost)) then - allocate(DstTC_ParameterTypeData%iModPost(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModPost.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iModPost = SrcTC_ParameterTypeData%iModPost - end if -end subroutine - -subroutine FAST_DestroyTC_ParameterType(TC_ParameterTypeData, ErrStat, ErrMsg) - type(TC_ParameterType), intent(inout) :: TC_ParameterTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_DestroyTC_ParameterType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(TC_ParameterTypeData%iJL)) then - deallocate(TC_ParameterTypeData%iJL) - end if - if (allocated(TC_ParameterTypeData%ixqd)) then - deallocate(TC_ParameterTypeData%ixqd) - end if - if (allocated(TC_ParameterTypeData%iModInit)) then - deallocate(TC_ParameterTypeData%iModInit) - end if - if (allocated(TC_ParameterTypeData%iModTC)) then - deallocate(TC_ParameterTypeData%iModTC) - end if - if (allocated(TC_ParameterTypeData%iModBD)) then - deallocate(TC_ParameterTypeData%iModBD) - end if - if (allocated(TC_ParameterTypeData%iModOpt1)) then - deallocate(TC_ParameterTypeData%iModOpt1) - end if - if (allocated(TC_ParameterTypeData%iModOpt1US)) then - deallocate(TC_ParameterTypeData%iModOpt1US) - end if - if (allocated(TC_ParameterTypeData%iModOpt2)) then - deallocate(TC_ParameterTypeData%iModOpt2) - end if - if (allocated(TC_ParameterTypeData%iModPost)) then - deallocate(TC_ParameterTypeData%iModPost) - end if -end subroutine - -subroutine FAST_PackTC_ParameterType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(TC_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackTC_ParameterType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DT) - call RegPack(RF, InData%ConvTol) - call RegPack(RF, InData%NumCrctn) - call RegPack(RF, InData%MaxConvIter) - call RegPack(RF, InData%NIter_UJac) - call RegPack(RF, InData%NStep_UJac) - call RegPack(RF, InData%Scale_UJac) - call RegPack(RF, InData%AccBlend) - call RegPack(RF, InData%RhoInf) - call RegPack(RF, InData%AlphaM) - call RegPack(RF, InData%AlphaF) - call RegPack(RF, InData%Beta) - call RegPack(RF, InData%Gamma) - call RegPack(RF, InData%C) - call RegPack(RF, InData%iX1) - call RegPack(RF, InData%iX2) - call RegPack(RF, InData%iUT) - call RegPack(RF, InData%iU1) - call RegPack(RF, InData%iyT) - call RegPack(RF, InData%iy1) - call RegPack(RF, InData%iJX) - call RegPack(RF, InData%iJU) - call RegPack(RF, InData%iJUT) - call RegPackAlloc(RF, InData%iJL) - call RegPackAlloc(RF, InData%ixqd) - call RegPackAlloc(RF, InData%iModInit) - call RegPackAlloc(RF, InData%iModTC) - call RegPackAlloc(RF, InData%iModBD) - call RegPackAlloc(RF, InData%iModOpt1) - call RegPackAlloc(RF, InData%iModOpt1US) - call RegPackAlloc(RF, InData%iModOpt2) - call RegPackAlloc(RF, InData%iModPost) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackTC_ParameterType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(TC_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackTC_ParameterType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NIter_UJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NStep_UJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Scale_UJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AccBlend); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AlphaM); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AlphaF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Beta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Gamma); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iX1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iX2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iUT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iU1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iyT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iy1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iJX); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iJU); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iJUT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iJL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ixqd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModInit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModTC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModBD); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModOpt1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModOpt1US); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModOpt2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModPost); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyModLinTCType(SrcModLinTCTypeData, DstModLinTCTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModLinTCType), intent(in) :: SrcModLinTCTypeData - type(ModLinTCType), intent(inout) :: DstModLinTCTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'FAST_CopyModLinTCType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcModLinTCTypeData%x)) then - LB(1:1) = lbound(SrcModLinTCTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%x, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%x)) then - allocate(DstModLinTCTypeData%x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%x = SrcModLinTCTypeData%x - end if - if (allocated(SrcModLinTCTypeData%dx)) then - LB(1:1) = lbound(SrcModLinTCTypeData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%dx, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%dx)) then - allocate(DstModLinTCTypeData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%dx = SrcModLinTCTypeData%dx - end if - if (allocated(SrcModLinTCTypeData%xd)) then - LB(1:1) = lbound(SrcModLinTCTypeData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%xd, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%xd)) then - allocate(DstModLinTCTypeData%xd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%xd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%xd = SrcModLinTCTypeData%xd - end if - if (allocated(SrcModLinTCTypeData%z)) then - LB(1:1) = lbound(SrcModLinTCTypeData%z, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%z, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%z)) then - allocate(DstModLinTCTypeData%z(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%z.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%z = SrcModLinTCTypeData%z - end if - if (allocated(SrcModLinTCTypeData%u)) then - LB(1:1) = lbound(SrcModLinTCTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%u, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%u)) then - allocate(DstModLinTCTypeData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%u = SrcModLinTCTypeData%u - end if - if (allocated(SrcModLinTCTypeData%y)) then - LB(1:1) = lbound(SrcModLinTCTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%y, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%y)) then - allocate(DstModLinTCTypeData%y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%y = SrcModLinTCTypeData%y - end if - if (allocated(SrcModLinTCTypeData%u_perturb)) then - LB(1:1) = lbound(SrcModLinTCTypeData%u_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%u_perturb, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%u_perturb)) then - allocate(DstModLinTCTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%u_perturb = SrcModLinTCTypeData%u_perturb - end if - if (allocated(SrcModLinTCTypeData%x_perturb)) then - LB(1:1) = lbound(SrcModLinTCTypeData%x_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%x_perturb, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%x_perturb)) then - allocate(DstModLinTCTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%x_perturb = SrcModLinTCTypeData%x_perturb - end if - if (allocated(SrcModLinTCTypeData%x_pos)) then - LB(1:1) = lbound(SrcModLinTCTypeData%x_pos, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%x_pos, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%x_pos)) then - allocate(DstModLinTCTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%x_pos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%x_pos = SrcModLinTCTypeData%x_pos - end if - if (allocated(SrcModLinTCTypeData%x_neg)) then - LB(1:1) = lbound(SrcModLinTCTypeData%x_neg, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%x_neg, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%x_neg)) then - allocate(DstModLinTCTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%x_neg.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%x_neg = SrcModLinTCTypeData%x_neg - end if - if (allocated(SrcModLinTCTypeData%y_pos)) then - LB(1:1) = lbound(SrcModLinTCTypeData%y_pos, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%y_pos, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%y_pos)) then - allocate(DstModLinTCTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%y_pos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%y_pos = SrcModLinTCTypeData%y_pos - end if - if (allocated(SrcModLinTCTypeData%y_neg)) then - LB(1:1) = lbound(SrcModLinTCTypeData%y_neg, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTCTypeData%y_neg, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%y_neg)) then - allocate(DstModLinTCTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%y_neg.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%y_neg = SrcModLinTCTypeData%y_neg - end if - if (allocated(SrcModLinTCTypeData%dYdx)) then - LB(1:2) = lbound(SrcModLinTCTypeData%dYdx, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTCTypeData%dYdx, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%dYdx)) then - allocate(DstModLinTCTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%dYdx = SrcModLinTCTypeData%dYdx - end if - if (allocated(SrcModLinTCTypeData%dXdx)) then - LB(1:2) = lbound(SrcModLinTCTypeData%dXdx, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTCTypeData%dXdx, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%dXdx)) then - allocate(DstModLinTCTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%dXdx = SrcModLinTCTypeData%dXdx - end if - if (allocated(SrcModLinTCTypeData%dYdu)) then - LB(1:2) = lbound(SrcModLinTCTypeData%dYdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTCTypeData%dYdu, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%dYdu)) then - allocate(DstModLinTCTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%dYdu = SrcModLinTCTypeData%dYdu - end if - if (allocated(SrcModLinTCTypeData%dXdu)) then - LB(1:2) = lbound(SrcModLinTCTypeData%dXdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTCTypeData%dXdu, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%dXdu)) then - allocate(DstModLinTCTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%dXdu = SrcModLinTCTypeData%dXdu - end if - if (allocated(SrcModLinTCTypeData%dUdu)) then - LB(1:2) = lbound(SrcModLinTCTypeData%dUdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTCTypeData%dUdu, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%dUdu)) then - allocate(DstModLinTCTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%dUdu = SrcModLinTCTypeData%dUdu - end if - if (allocated(SrcModLinTCTypeData%dUdy)) then - LB(1:2) = lbound(SrcModLinTCTypeData%dUdy, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTCTypeData%dUdy, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%dUdy)) then - allocate(DstModLinTCTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%dUdy = SrcModLinTCTypeData%dUdy - end if - if (allocated(SrcModLinTCTypeData%StateRotation)) then - LB(1:2) = lbound(SrcModLinTCTypeData%StateRotation, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTCTypeData%StateRotation, kind=B8Ki) - if (.not. allocated(DstModLinTCTypeData%StateRotation)) then - allocate(DstModLinTCTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTCTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModLinTCTypeData%StateRotation = SrcModLinTCTypeData%StateRotation - end if -end subroutine - -subroutine FAST_DestroyModLinTCType(ModLinTCTypeData, ErrStat, ErrMsg) - type(ModLinTCType), intent(inout) :: ModLinTCTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_DestroyModLinTCType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ModLinTCTypeData%x)) then - deallocate(ModLinTCTypeData%x) - end if - if (allocated(ModLinTCTypeData%dx)) then - deallocate(ModLinTCTypeData%dx) - end if - if (allocated(ModLinTCTypeData%xd)) then - deallocate(ModLinTCTypeData%xd) - end if - if (allocated(ModLinTCTypeData%z)) then - deallocate(ModLinTCTypeData%z) - end if - if (allocated(ModLinTCTypeData%u)) then - deallocate(ModLinTCTypeData%u) - end if - if (allocated(ModLinTCTypeData%y)) then - deallocate(ModLinTCTypeData%y) - end if - if (allocated(ModLinTCTypeData%u_perturb)) then - deallocate(ModLinTCTypeData%u_perturb) - end if - if (allocated(ModLinTCTypeData%x_perturb)) then - deallocate(ModLinTCTypeData%x_perturb) - end if - if (allocated(ModLinTCTypeData%x_pos)) then - deallocate(ModLinTCTypeData%x_pos) - end if - if (allocated(ModLinTCTypeData%x_neg)) then - deallocate(ModLinTCTypeData%x_neg) - end if - if (allocated(ModLinTCTypeData%y_pos)) then - deallocate(ModLinTCTypeData%y_pos) - end if - if (allocated(ModLinTCTypeData%y_neg)) then - deallocate(ModLinTCTypeData%y_neg) - end if - if (allocated(ModLinTCTypeData%dYdx)) then - deallocate(ModLinTCTypeData%dYdx) - end if - if (allocated(ModLinTCTypeData%dXdx)) then - deallocate(ModLinTCTypeData%dXdx) - end if - if (allocated(ModLinTCTypeData%dYdu)) then - deallocate(ModLinTCTypeData%dYdu) - end if - if (allocated(ModLinTCTypeData%dXdu)) then - deallocate(ModLinTCTypeData%dXdu) - end if - if (allocated(ModLinTCTypeData%dUdu)) then - deallocate(ModLinTCTypeData%dUdu) - end if - if (allocated(ModLinTCTypeData%dUdy)) then - deallocate(ModLinTCTypeData%dUdy) - end if - if (allocated(ModLinTCTypeData%StateRotation)) then - deallocate(ModLinTCTypeData%StateRotation) - end if -end subroutine - -subroutine FAST_PackModLinTCType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ModLinTCType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackModLinTCType' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%x) - call RegPackAlloc(RF, InData%dx) - call RegPackAlloc(RF, InData%xd) - call RegPackAlloc(RF, InData%z) - call RegPackAlloc(RF, InData%u) - call RegPackAlloc(RF, InData%y) - call RegPackAlloc(RF, InData%u_perturb) - call RegPackAlloc(RF, InData%x_perturb) - call RegPackAlloc(RF, InData%x_pos) - call RegPackAlloc(RF, InData%x_neg) - call RegPackAlloc(RF, InData%y_pos) - call RegPackAlloc(RF, InData%y_neg) - call RegPackAlloc(RF, InData%dYdx) - call RegPackAlloc(RF, InData%dXdx) - call RegPackAlloc(RF, InData%dYdu) - call RegPackAlloc(RF, InData%dXdu) - call RegPackAlloc(RF, InData%dUdu) - call RegPackAlloc(RF, InData%dUdy) - call RegPackAlloc(RF, InData%StateRotation) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackModLinTCType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ModLinTCType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackModLinTCType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: SrcModDataTypeData - type(ModDataType), intent(inout) :: DstModDataTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyModDataType' - ErrStat = ErrID_None - ErrMsg = '' - DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr - DstModDataTypeData%ID = SrcModDataTypeData%ID - DstModDataTypeData%Idx = SrcModDataTypeData%Idx - DstModDataTypeData%Ins = SrcModDataTypeData%Ins - DstModDataTypeData%DT = SrcModDataTypeData%DT - DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps - DstModDataTypeData%Vars => SrcModDataTypeData%Vars - call FAST_CopyModLinTCType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcModDataTypeData%SrcMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%SrcMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%SrcMaps)) then - allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps - end if - if (allocated(SrcModDataTypeData%DstMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%DstMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%DstMaps, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%DstMaps)) then - allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps - end if -end subroutine - -subroutine FAST_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: ModDataTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyModDataType' - ErrStat = ErrID_None - ErrMsg = '' - nullify(ModDataTypeData%Vars) - call FAST_DestroyModLinTCType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ModDataTypeData%SrcMaps)) then - deallocate(ModDataTypeData%SrcMaps) - end if - if (allocated(ModDataTypeData%DstMaps)) then - deallocate(ModDataTypeData%DstMaps) - end if -end subroutine - -subroutine FAST_PackModDataType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ModDataType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackModDataType' - logical :: PtrInIndex - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Abbr) - call RegPack(RF, InData%ID) - call RegPack(RF, InData%Idx) - call RegPack(RF, InData%Ins) - call RegPack(RF, InData%DT) - call RegPack(RF, InData%SubSteps) - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if - call FAST_PackModLinTCType(RF, InData%Lin) - call RegPackAlloc(RF, InData%SrcMaps) - call RegPackAlloc(RF, InData%DstMaps) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackModDataType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ModDataType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackModDataType' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if - call FAST_UnpackModLinTCType(RF, OutData%Lin) ! Lin - call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyVarIdxType(SrcVarIdxTypeData, DstVarIdxTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarIdxType), intent(in) :: SrcVarIdxTypeData - type(VarIdxType), intent(inout) :: DstVarIdxTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'FAST_CopyVarIdxType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcVarIdxTypeData%ModVarStart)) then - LB(1:1) = lbound(SrcVarIdxTypeData%ModVarStart, kind=B8Ki) - UB(1:1) = ubound(SrcVarIdxTypeData%ModVarStart, kind=B8Ki) - if (.not. allocated(DstVarIdxTypeData%ModVarStart)) then - allocate(DstVarIdxTypeData%ModVarStart(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarIdxTypeData%ModVarStart.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarIdxTypeData%ModVarStart = SrcVarIdxTypeData%ModVarStart - end if - if (allocated(SrcVarIdxTypeData%ValLocGbl)) then - LB(1:2) = lbound(SrcVarIdxTypeData%ValLocGbl, kind=B8Ki) - UB(1:2) = ubound(SrcVarIdxTypeData%ValLocGbl, kind=B8Ki) - if (.not. allocated(DstVarIdxTypeData%ValLocGbl)) then - allocate(DstVarIdxTypeData%ValLocGbl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarIdxTypeData%ValLocGbl.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarIdxTypeData%ValLocGbl = SrcVarIdxTypeData%ValLocGbl - end if -end subroutine - -subroutine FAST_DestroyVarIdxType(VarIdxTypeData, ErrStat, ErrMsg) - type(VarIdxType), intent(inout) :: VarIdxTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_DestroyVarIdxType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(VarIdxTypeData%ModVarStart)) then - deallocate(VarIdxTypeData%ModVarStart) - end if - if (allocated(VarIdxTypeData%ValLocGbl)) then - deallocate(VarIdxTypeData%ValLocGbl) - end if -end subroutine - -subroutine FAST_PackVarIdxType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(VarIdxType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackVarIdxType' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%ModVarStart) - call RegPackAlloc(RF, InData%ValLocGbl) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackVarIdxType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(VarIdxType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackVarIdxType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%ModVarStart); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ValLocGbl); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarsIdxType), intent(in) :: SrcVarsIdxTypeData - type(VarsIdxType), intent(inout) :: DstVarsIdxTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyVarsIdxType' - ErrStat = ErrID_None - ErrMsg = '' - DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter - DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx - DstVarsIdxTypeData%Nxd = SrcVarsIdxTypeData%Nxd - DstVarsIdxTypeData%Nz = SrcVarsIdxTypeData%Nz - DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu - DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%x, DstVarsIdxTypeData%x, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%xd, DstVarsIdxTypeData%xd, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%z, DstVarsIdxTypeData%z, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%u, DstVarsIdxTypeData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FAST_CopyVarIdxType(SrcVarsIdxTypeData%y, DstVarsIdxTypeData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FAST_CopyModLinTCType(SrcVarsIdxTypeData%Lin, DstVarsIdxTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine FAST_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) - type(VarsIdxType), intent(inout) :: VarsIdxTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyVarsIdxType' - ErrStat = ErrID_None - ErrMsg = '' - call FAST_DestroyVarIdxType(VarsIdxTypeData%x, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyVarIdxType(VarsIdxTypeData%xd, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyVarIdxType(VarsIdxTypeData%z, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyVarIdxType(VarsIdxTypeData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyVarIdxType(VarsIdxTypeData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyModLinTCType(VarsIdxTypeData%Lin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine FAST_PackVarsIdxType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(VarsIdxType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackVarsIdxType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%FlagFilter) - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nxd) - call RegPack(RF, InData%Nz) - call RegPack(RF, InData%Nu) - call RegPack(RF, InData%Ny) - call FAST_PackVarIdxType(RF, InData%x) - call FAST_PackVarIdxType(RF, InData%xd) - call FAST_PackVarIdxType(RF, InData%z) - call FAST_PackVarIdxType(RF, InData%u) - call FAST_PackVarIdxType(RF, InData%y) - call FAST_PackModLinTCType(RF, InData%Lin) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackVarsIdxType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(VarsIdxType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackVarsIdxType' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return - call FAST_UnpackVarIdxType(RF, OutData%x) ! x - call FAST_UnpackVarIdxType(RF, OutData%xd) ! xd - call FAST_UnpackVarIdxType(RF, OutData%z) ! z - call FAST_UnpackVarIdxType(RF, OutData%u) ! u - call FAST_UnpackVarIdxType(RF, OutData%y) ! y - call FAST_UnpackModLinTCType(RF, OutData%Lin) ! Lin -end subroutine - -subroutine FAST_CopyML_ParameterType(SrcML_ParameterTypeData, DstML_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) - type(ML_ParameterType), intent(in) :: SrcML_ParameterTypeData - type(ML_ParameterType), intent(inout) :: DstML_ParameterTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyML_ParameterType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcML_ParameterTypeData%iMod)) then - LB(1:1) = lbound(SrcML_ParameterTypeData%iMod, kind=B8Ki) - UB(1:1) = ubound(SrcML_ParameterTypeData%iMod, kind=B8Ki) - if (.not. allocated(DstML_ParameterTypeData%iMod)) then - allocate(DstML_ParameterTypeData%iMod(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstML_ParameterTypeData%iMod.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstML_ParameterTypeData%iMod = SrcML_ParameterTypeData%iMod - end if - call FAST_CopyVarsIdxType(SrcML_ParameterTypeData%IdxLin, DstML_ParameterTypeData%IdxLin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine FAST_DestroyML_ParameterType(ML_ParameterTypeData, ErrStat, ErrMsg) - type(ML_ParameterType), intent(inout) :: ML_ParameterTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyML_ParameterType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ML_ParameterTypeData%iMod)) then - deallocate(ML_ParameterTypeData%iMod) - end if - call FAST_DestroyVarsIdxType(ML_ParameterTypeData%IdxLin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine FAST_PackML_ParameterType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ML_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackML_ParameterType' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%iMod) - call FAST_PackVarsIdxType(RF, InData%IdxLin) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackML_ParameterType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ML_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackML_ParameterType' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return - call FAST_UnpackVarsIdxType(RF, OutData%IdxLin) ! IdxLin -end subroutine - -subroutine FAST_CopyML_MiscVarType(SrcML_MiscVarTypeData, DstML_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) - type(ML_MiscVarType), intent(inout) :: SrcML_MiscVarTypeData - type(ML_MiscVarType), intent(inout) :: DstML_MiscVarTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyML_MiscVarType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcML_MiscVarTypeData%Mappings)) then - LB(1:1) = lbound(SrcML_MiscVarTypeData%Mappings, kind=B8Ki) - UB(1:1) = ubound(SrcML_MiscVarTypeData%Mappings, kind=B8Ki) - if (.not. allocated(DstML_MiscVarTypeData%Mappings)) then - allocate(DstML_MiscVarTypeData%Mappings(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstML_MiscVarTypeData%Mappings.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FAST_CopyTC_MappingType(SrcML_MiscVarTypeData%Mappings(i1), DstML_MiscVarTypeData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if -end subroutine - -subroutine FAST_DestroyML_MiscVarType(ML_MiscVarTypeData, ErrStat, ErrMsg) - type(ML_MiscVarType), intent(inout) :: ML_MiscVarTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyML_MiscVarType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ML_MiscVarTypeData%Mappings)) then - LB(1:1) = lbound(ML_MiscVarTypeData%Mappings, kind=B8Ki) - UB(1:1) = ubound(ML_MiscVarTypeData%Mappings, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyTC_MappingType(ML_MiscVarTypeData%Mappings(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ML_MiscVarTypeData%Mappings) - end if -end subroutine - -subroutine FAST_PackML_MiscVarType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ML_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackML_MiscVarType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%Mappings)) - if (allocated(InData%Mappings)) then - call RegPackBounds(RF, 1, lbound(InData%Mappings, kind=B8Ki), ubound(InData%Mappings, kind=B8Ki)) - LB(1:1) = lbound(InData%Mappings, kind=B8Ki) - UB(1:1) = ubound(InData%Mappings, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackTC_MappingType(RF, InData%Mappings(i1)) - end do - end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackML_MiscVarType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ML_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackML_MiscVarType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Mappings(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mappings.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackTC_MappingType(RF, OutData%Mappings(i1)) ! Mappings - end do - end if -end subroutine - -subroutine FAST_CopyML_OutputType(SrcML_OutputTypeData, DstML_OutputTypeData, CtrlCode, ErrStat, ErrMsg) - type(ML_OutputType), intent(in) :: SrcML_OutputTypeData - type(ML_OutputType), intent(inout) :: DstML_OutputTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyML_OutputType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcML_OutputTypeData%Lin)) then - LB(1:1) = lbound(SrcML_OutputTypeData%Lin, kind=B8Ki) - UB(1:1) = ubound(SrcML_OutputTypeData%Lin, kind=B8Ki) - if (.not. allocated(DstML_OutputTypeData%Lin)) then - allocate(DstML_OutputTypeData%Lin(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstML_OutputTypeData%Lin.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FAST_CopyModLinTCType(SrcML_OutputTypeData%Lin(i1), DstML_OutputTypeData%Lin(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if -end subroutine - -subroutine FAST_DestroyML_OutputType(ML_OutputTypeData, ErrStat, ErrMsg) - type(ML_OutputType), intent(inout) :: ML_OutputTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyML_OutputType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ML_OutputTypeData%Lin)) then - LB(1:1) = lbound(ML_OutputTypeData%Lin, kind=B8Ki) - UB(1:1) = ubound(ML_OutputTypeData%Lin, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyModLinTCType(ML_OutputTypeData%Lin(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ML_OutputTypeData%Lin) - end if -end subroutine - -subroutine FAST_PackML_OutputType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ML_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackML_OutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%Lin)) - if (allocated(InData%Lin)) then - call RegPackBounds(RF, 1, lbound(InData%Lin, kind=B8Ki), ubound(InData%Lin, kind=B8Ki)) - LB(1:1) = lbound(InData%Lin, kind=B8Ki) - UB(1:1) = ubound(InData%Lin, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackModLinTCType(RF, InData%Lin(i1)) - end do - end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackML_OutputType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ML_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackML_OutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%Lin)) deallocate(OutData%Lin) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Lin(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lin.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackModLinTCType(RF, OutData%Lin(i1)) ! Lin - end do - end if -end subroutine - -subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) - type(TC_MiscVarType), intent(inout) :: SrcTC_MiscVarTypeData - type(TC_MiscVarType), intent(inout) :: DstTC_MiscVarTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyTC_MiscVarType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcTC_MiscVarTypeData%q)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%q, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%q, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%q)) then - allocate(DstTC_MiscVarTypeData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%q.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%q = SrcTC_MiscVarTypeData%q - end if - if (allocated(SrcTC_MiscVarTypeData%qn)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%qn, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%qn, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%qn)) then - allocate(DstTC_MiscVarTypeData%qn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%qn.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%qn = SrcTC_MiscVarTypeData%qn - end if - if (allocated(SrcTC_MiscVarTypeData%x)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%x, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%x)) then - allocate(DstTC_MiscVarTypeData%x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%x = SrcTC_MiscVarTypeData%x - end if - if (allocated(SrcTC_MiscVarTypeData%xn)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%xn, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%xn, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%xn)) then - allocate(DstTC_MiscVarTypeData%xn(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%xn.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%xn = SrcTC_MiscVarTypeData%xn - end if - if (allocated(SrcTC_MiscVarTypeData%dxdt)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%dxdt, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%dxdt, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dxdt)) then - allocate(DstTC_MiscVarTypeData%dxdt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dxdt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%dxdt = SrcTC_MiscVarTypeData%dxdt - end if - if (allocated(SrcTC_MiscVarTypeData%u)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%u, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%u)) then - allocate(DstTC_MiscVarTypeData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%u = SrcTC_MiscVarTypeData%u - end if - if (allocated(SrcTC_MiscVarTypeData%un)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%un, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%un, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%un)) then - allocate(DstTC_MiscVarTypeData%un(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%un.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%un = SrcTC_MiscVarTypeData%un - end if - if (allocated(SrcTC_MiscVarTypeData%u_tmp)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%u_tmp, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%u_tmp, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%u_tmp)) then - allocate(DstTC_MiscVarTypeData%u_tmp(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%u_tmp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%u_tmp = SrcTC_MiscVarTypeData%u_tmp - end if - if (allocated(SrcTC_MiscVarTypeData%y)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%y, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%y)) then - allocate(DstTC_MiscVarTypeData%y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%y = SrcTC_MiscVarTypeData%y - end if - if (allocated(SrcTC_MiscVarTypeData%dYdx)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%dYdx, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%dYdx, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dYdx)) then - allocate(DstTC_MiscVarTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%dYdx = SrcTC_MiscVarTypeData%dYdx - end if - if (allocated(SrcTC_MiscVarTypeData%dYdu)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%dYdu, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%dYdu, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dYdu)) then - allocate(DstTC_MiscVarTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%dYdu = SrcTC_MiscVarTypeData%dYdu - end if - if (allocated(SrcTC_MiscVarTypeData%dXdx)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%dXdx, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%dXdx, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dXdx)) then - allocate(DstTC_MiscVarTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%dXdx = SrcTC_MiscVarTypeData%dXdx - end if - if (allocated(SrcTC_MiscVarTypeData%dXdu)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%dXdu, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%dXdu, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dXdu)) then - allocate(DstTC_MiscVarTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%dXdu = SrcTC_MiscVarTypeData%dXdu - end if - if (allocated(SrcTC_MiscVarTypeData%dUdu)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdu, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdu, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dUdu)) then - allocate(DstTC_MiscVarTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%dUdu = SrcTC_MiscVarTypeData%dUdu - end if - if (allocated(SrcTC_MiscVarTypeData%dUdy)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdy, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdy, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dUdy)) then - allocate(DstTC_MiscVarTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%dUdy = SrcTC_MiscVarTypeData%dUdy - end if - if (allocated(SrcTC_MiscVarTypeData%GinvdUdu)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%GinvdUdu, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%GinvdUdu, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%GinvdUdu)) then - allocate(DstTC_MiscVarTypeData%GinvdUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%GinvdUdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%GinvdUdu = SrcTC_MiscVarTypeData%GinvdUdu - end if - if (allocated(SrcTC_MiscVarTypeData%dUdyHat)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdyHat, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdyHat, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dUdyHat)) then - allocate(DstTC_MiscVarTypeData%dUdyHat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdyHat.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%dUdyHat = SrcTC_MiscVarTypeData%dUdyHat - end if - if (allocated(SrcTC_MiscVarTypeData%XB)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%XB, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%XB, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%XB)) then - allocate(DstTC_MiscVarTypeData%XB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%XB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%XB = SrcTC_MiscVarTypeData%XB - end if - if (allocated(SrcTC_MiscVarTypeData%G)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%G, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%G, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%G)) then - allocate(DstTC_MiscVarTypeData%G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%G.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%G = SrcTC_MiscVarTypeData%G - end if - if (allocated(SrcTC_MiscVarTypeData%Jac)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%Jac, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%Jac, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%Jac)) then - allocate(DstTC_MiscVarTypeData%Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%Jac.', ErrStat, ErrMsg, RoutineName) - return - end if + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', RF%ErrStat, RF%ErrMsg, RoutineName) + return end if - DstTC_MiscVarTypeData%Jac = SrcTC_MiscVarTypeData%Jac + do i1 = LB(1), UB(1) + call FAST_UnpackVTK_BLSurfaceType(RF, OutData%BladeShape(i1)) ! BladeShape + end do end if - if (allocated(SrcTC_MiscVarTypeData%IPIV)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%IPIV, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%IPIV, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%IPIV)) then - allocate(DstTC_MiscVarTypeData%IPIV(LB(1):UB(1)), stat=ErrStat2) + call RegUnpackAlloc(RF, OutData%MorisonVisRad); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_ModeShapeType), intent(in) :: SrcVTK_ModeShapeTypeData + type(FAST_VTK_ModeShapeType), intent(inout) :: DstVTK_ModeShapeTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_ModeShapeType' + ErrStat = ErrID_None + ErrMsg = '' + DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot + DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName + DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes + if (allocated(SrcVTK_ModeShapeTypeData%VTKModes)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then + allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%IPIV.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_MiscVarTypeData%IPIV = SrcTC_MiscVarTypeData%IPIV + DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes end if - DstTC_MiscVarTypeData%IterTotal = SrcTC_MiscVarTypeData%IterTotal - DstTC_MiscVarTypeData%IterUntilUJac = SrcTC_MiscVarTypeData%IterUntilUJac - DstTC_MiscVarTypeData%StepsUntilUJac = SrcTC_MiscVarTypeData%StepsUntilUJac - if (allocated(SrcTC_MiscVarTypeData%dq)) then - LB(1:2) = lbound(SrcTC_MiscVarTypeData%dq, kind=B8Ki) - UB(1:2) = ubound(SrcTC_MiscVarTypeData%dq, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dq)) then - allocate(DstTC_MiscVarTypeData%dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim + DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes + DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale + DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase + if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then + allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dq.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_MiscVarTypeData%dq = SrcTC_MiscVarTypeData%dq + DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio end if - if (allocated(SrcTC_MiscVarTypeData%dx)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%dx, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%dx)) then - allocate(DstTC_MiscVarTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_MiscVarTypeData%dx = SrcTC_MiscVarTypeData%dx + DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz end if - if (allocated(SrcTC_MiscVarTypeData%du)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%du, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%du, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%du)) then - allocate(DstTC_MiscVarTypeData%du(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%du.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_MiscVarTypeData%du = SrcTC_MiscVarTypeData%du + DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz end if - if (allocated(SrcTC_MiscVarTypeData%UDiff)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%UDiff, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%UDiff, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%UDiff)) then - allocate(DstTC_MiscVarTypeData%UDiff(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%UDiff.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_MiscVarTypeData%UDiff = SrcTC_MiscVarTypeData%UDiff + DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude end if - DstTC_MiscVarTypeData%ConvWarn = SrcTC_MiscVarTypeData%ConvWarn - if (allocated(SrcTC_MiscVarTypeData%Mappings)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%Mappings, kind=B8Ki) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%Mappings, kind=B8Ki) - if (.not. allocated(DstTC_MiscVarTypeData%Mappings)) then - allocate(DstTC_MiscVarTypeData%Mappings(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%Mappings.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call FAST_CopyTC_MappingType(SrcTC_MiscVarTypeData%Mappings(i1), DstTC_MiscVarTypeData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase end if end subroutine -subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) - type(TC_MiscVarType), intent(inout) :: TC_MiscVarTypeData +subroutine FAST_DestroyVTK_ModeShapeType(VTK_ModeShapeTypeData, ErrStat, ErrMsg) + type(FAST_VTK_ModeShapeType), intent(inout) :: VTK_ModeShapeTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyTC_MiscVarType' + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(TC_MiscVarTypeData%q)) then - deallocate(TC_MiscVarTypeData%q) - end if - if (allocated(TC_MiscVarTypeData%qn)) then - deallocate(TC_MiscVarTypeData%qn) - end if - if (allocated(TC_MiscVarTypeData%x)) then - deallocate(TC_MiscVarTypeData%x) - end if - if (allocated(TC_MiscVarTypeData%xn)) then - deallocate(TC_MiscVarTypeData%xn) - end if - if (allocated(TC_MiscVarTypeData%dxdt)) then - deallocate(TC_MiscVarTypeData%dxdt) - end if - if (allocated(TC_MiscVarTypeData%u)) then - deallocate(TC_MiscVarTypeData%u) - end if - if (allocated(TC_MiscVarTypeData%un)) then - deallocate(TC_MiscVarTypeData%un) - end if - if (allocated(TC_MiscVarTypeData%u_tmp)) then - deallocate(TC_MiscVarTypeData%u_tmp) - end if - if (allocated(TC_MiscVarTypeData%y)) then - deallocate(TC_MiscVarTypeData%y) - end if - if (allocated(TC_MiscVarTypeData%dYdx)) then - deallocate(TC_MiscVarTypeData%dYdx) - end if - if (allocated(TC_MiscVarTypeData%dYdu)) then - deallocate(TC_MiscVarTypeData%dYdu) - end if - if (allocated(TC_MiscVarTypeData%dXdx)) then - deallocate(TC_MiscVarTypeData%dXdx) - end if - if (allocated(TC_MiscVarTypeData%dXdu)) then - deallocate(TC_MiscVarTypeData%dXdu) - end if - if (allocated(TC_MiscVarTypeData%dUdu)) then - deallocate(TC_MiscVarTypeData%dUdu) - end if - if (allocated(TC_MiscVarTypeData%dUdy)) then - deallocate(TC_MiscVarTypeData%dUdy) - end if - if (allocated(TC_MiscVarTypeData%GinvdUdu)) then - deallocate(TC_MiscVarTypeData%GinvdUdu) - end if - if (allocated(TC_MiscVarTypeData%dUdyHat)) then - deallocate(TC_MiscVarTypeData%dUdyHat) - end if - if (allocated(TC_MiscVarTypeData%XB)) then - deallocate(TC_MiscVarTypeData%XB) - end if - if (allocated(TC_MiscVarTypeData%G)) then - deallocate(TC_MiscVarTypeData%G) - end if - if (allocated(TC_MiscVarTypeData%Jac)) then - deallocate(TC_MiscVarTypeData%Jac) - end if - if (allocated(TC_MiscVarTypeData%IPIV)) then - deallocate(TC_MiscVarTypeData%IPIV) + if (allocated(VTK_ModeShapeTypeData%VTKModes)) then + deallocate(VTK_ModeShapeTypeData%VTKModes) end if - if (allocated(TC_MiscVarTypeData%dq)) then - deallocate(TC_MiscVarTypeData%dq) + if (allocated(VTK_ModeShapeTypeData%DampingRatio)) then + deallocate(VTK_ModeShapeTypeData%DampingRatio) end if - if (allocated(TC_MiscVarTypeData%dx)) then - deallocate(TC_MiscVarTypeData%dx) + if (allocated(VTK_ModeShapeTypeData%NaturalFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%NaturalFreq_Hz) end if - if (allocated(TC_MiscVarTypeData%du)) then - deallocate(TC_MiscVarTypeData%du) + if (allocated(VTK_ModeShapeTypeData%DampedFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%DampedFreq_Hz) end if - if (allocated(TC_MiscVarTypeData%UDiff)) then - deallocate(TC_MiscVarTypeData%UDiff) + if (allocated(VTK_ModeShapeTypeData%x_eig_magnitude)) then + deallocate(VTK_ModeShapeTypeData%x_eig_magnitude) end if - if (allocated(TC_MiscVarTypeData%Mappings)) then - LB(1:1) = lbound(TC_MiscVarTypeData%Mappings, kind=B8Ki) - UB(1:1) = ubound(TC_MiscVarTypeData%Mappings, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyTC_MappingType(TC_MiscVarTypeData%Mappings(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(TC_MiscVarTypeData%Mappings) + if (allocated(VTK_ModeShapeTypeData%x_eig_phase)) then + deallocate(VTK_ModeShapeTypeData%x_eig_phase) end if end subroutine -subroutine FAST_PackTC_MiscVarType(RF, Indata) +subroutine FAST_PackVTK_ModeShapeType(RF, Indata) type(RegFile), intent(inout) :: RF - type(TC_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackTC_MiscVarType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + type(FAST_VTK_ModeShapeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%q) - call RegPackAlloc(RF, InData%qn) - call RegPackAlloc(RF, InData%x) - call RegPackAlloc(RF, InData%xn) - call RegPackAlloc(RF, InData%dxdt) - call RegPackAlloc(RF, InData%u) - call RegPackAlloc(RF, InData%un) - call RegPackAlloc(RF, InData%u_tmp) - call RegPackAlloc(RF, InData%y) - call RegPackAlloc(RF, InData%dYdx) - call RegPackAlloc(RF, InData%dYdu) - call RegPackAlloc(RF, InData%dXdx) - call RegPackAlloc(RF, InData%dXdu) - call RegPackAlloc(RF, InData%dUdu) - call RegPackAlloc(RF, InData%dUdy) - call RegPackAlloc(RF, InData%GinvdUdu) - call RegPackAlloc(RF, InData%dUdyHat) - call RegPackAlloc(RF, InData%XB) - call RegPackAlloc(RF, InData%G) - call RegPackAlloc(RF, InData%Jac) - call RegPackAlloc(RF, InData%IPIV) - call RegPack(RF, InData%IterTotal) - call RegPack(RF, InData%IterUntilUJac) - call RegPack(RF, InData%StepsUntilUJac) - call RegPackAlloc(RF, InData%dq) - call RegPackAlloc(RF, InData%dx) - call RegPackAlloc(RF, InData%du) - call RegPackAlloc(RF, InData%UDiff) - call RegPack(RF, InData%ConvWarn) - call RegPack(RF, allocated(InData%Mappings)) - if (allocated(InData%Mappings)) then - call RegPackBounds(RF, 1, lbound(InData%Mappings, kind=B8Ki), ubound(InData%Mappings, kind=B8Ki)) - LB(1:1) = lbound(InData%Mappings, kind=B8Ki) - UB(1:1) = ubound(InData%Mappings, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackTC_MappingType(RF, InData%Mappings(i1)) - end do - end if + call RegPack(RF, InData%CheckpointRoot) + call RegPack(RF, InData%MatlabFileName) + call RegPack(RF, InData%VTKLinModes) + call RegPackAlloc(RF, InData%VTKModes) + call RegPack(RF, InData%VTKLinTim) + call RegPack(RF, InData%VTKNLinTimes) + call RegPack(RF, InData%VTKLinScale) + call RegPack(RF, InData%VTKLinPhase) + call RegPackAlloc(RF, InData%DampingRatio) + call RegPackAlloc(RF, InData%NaturalFreq_Hz) + call RegPackAlloc(RF, InData%DampedFreq_Hz) + call RegPackAlloc(RF, InData%x_eig_magnitude) + call RegPackAlloc(RF, InData%x_eig_phase) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackTC_MiscVarType(RF, OutData) +subroutine FAST_UnPackVTK_ModeShapeType(RF, OutData) type(RegFile), intent(inout) :: RF - type(TC_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackTC_MiscVarType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + type(FAST_VTK_ModeShapeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%qn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dxdt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%un); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u_tmp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%GinvdUdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdyHat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%XB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%G); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%IPIV); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IterTotal); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IterUntilUJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%StepsUntilUJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UDiff); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Mappings(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mappings.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackTC_MappingType(RF, OutData%Mappings(i1)) ! Mappings - end do - end if + call RegUnpack(RF, OutData%CheckpointRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MatlabFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VTKModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinTim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKNLinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinScale); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinPhase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampingRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NaturalFreq_Hz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampedFreq_Hz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_eig_magnitude); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_eig_phase); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopySS_CaseType(SrcSS_CaseTypeData, DstSS_CaseTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_SS_CaseType), intent(in) :: SrcSS_CaseTypeData + type(FAST_SS_CaseType), intent(inout) :: DstSS_CaseTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_CopySS_CaseType' + ErrStat = ErrID_None + ErrMsg = '' + DstSS_CaseTypeData%RotSpeed = SrcSS_CaseTypeData%RotSpeed + DstSS_CaseTypeData%TSR = SrcSS_CaseTypeData%TSR + DstSS_CaseTypeData%WindSpeed = SrcSS_CaseTypeData%WindSpeed + DstSS_CaseTypeData%Pitch = SrcSS_CaseTypeData%Pitch +end subroutine + +subroutine FAST_DestroySS_CaseType(SS_CaseTypeData, ErrStat, ErrMsg) + type(FAST_SS_CaseType), intent(inout) :: SS_CaseTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroySS_CaseType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FAST_PackSS_CaseType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_SS_CaseType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSS_CaseType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TSR) + call RegPack(RF, InData%WindSpeed) + call RegPack(RF, InData%Pitch) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSS_CaseType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_SS_CaseType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSS_CaseType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -3635,9 +1487,6 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder - call FAST_CopyML_ParameterType(SrcParamData%ModLin, DstParamData%ModLin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps DstParamData%N_UJac = SrcParamData%N_UJac DstParamData%NumBl_Lin = SrcParamData%NumBl_Lin @@ -3697,8 +1546,6 @@ subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyVTK_ModeShapeType(ParamData%VTK_modes, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyML_ParameterType(ParamData%ModLin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%RotSpeed)) then deallocate(ParamData%RotSpeed) end if @@ -3808,7 +1655,6 @@ subroutine FAST_PackParam(RF, Indata) call RegPack(RF, InData%Lin_NumMods) call RegPack(RF, InData%Lin_ModOrder) call RegPack(RF, InData%LinInterpOrder) - call FAST_PackML_ParameterType(RF, InData%ModLin) call RegPack(RF, InData%CompAeroMaps) call RegPack(RF, InData%N_UJac) call RegPack(RF, InData%NumBl_Lin) @@ -3924,7 +1770,6 @@ subroutine FAST_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%Lin_NumMods); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Lin_ModOrder); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LinInterpOrder); if (RegCheckErr(RF, RoutineName)) return - call FAST_UnpackML_ParameterType(RF, OutData%ModLin) ! ModLin call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%N_UJac); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return @@ -8233,25 +6078,6 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput - if (allocated(SrcOutputFileTypeData%Modules)) then - LB(1:1) = lbound(SrcOutputFileTypeData%Modules, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%Modules, kind=B8Ki) - if (.not. allocated(DstOutputFileTypeData%Modules)) then - allocate(DstOutputFileTypeData%Modules(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%Modules.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FAST_CopyModDataType(SrcOutputFileTypeData%Modules(i1), DstOutputFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call FAST_CopyModDataType(SrcOutputFileTypeData%ModGlue, DstOutputFileTypeData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) @@ -8287,17 +6113,6 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputFileTypeData%Modules)) then - LB(1:1) = lbound(OutputFileTypeData%Modules, kind=B8Ki) - UB(1:1) = ubound(OutputFileTypeData%Modules, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_DestroyModDataType(OutputFileTypeData%Modules(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OutputFileTypeData%Modules) - end if - call FAST_DestroyModDataType(OutputFileTypeData%ModGlue, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackOutputFileType(RF, Indata) @@ -8331,16 +6146,6 @@ subroutine FAST_PackOutputFileType(RF, Indata) call RegPack(RF, InData%ActualChanLen) call FAST_PackLinStateSave(RF, InData%op) call RegPack(RF, InData%DriverWriteOutput) - call RegPack(RF, allocated(InData%Modules)) - if (allocated(InData%Modules)) then - call RegPackBounds(RF, 1, lbound(InData%Modules, kind=B8Ki), ubound(InData%Modules, kind=B8Ki)) - LB(1:1) = lbound(InData%Modules, kind=B8Ki) - UB(1:1) = ubound(InData%Modules, kind=B8Ki) - do i1 = LB(1), UB(1) - call FAST_PackModDataType(RF, InData%Modules(i1)) - end do - end if - call FAST_PackModDataType(RF, InData%ModGlue) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8377,20 +6182,6 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return call FAST_UnpackLinStateSave(RF, OutData%op) ! op call RegUnpack(RF, OutData%DriverWriteOutput); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%Modules)) deallocate(OutData%Modules) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Modules(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modules.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FAST_UnpackModDataType(RF, OutData%Modules(i1)) ! Modules - end do - end if - call FAST_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue end subroutine subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -16517,7 +14308,7 @@ subroutine FAST_UnPackExternInputType(RF, OutData) end subroutine subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(FAST_MiscVarType), intent(inout) :: SrcMiscData + type(FAST_MiscVarType), intent(in) :: SrcMiscData type(FAST_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat @@ -16542,9 +14333,6 @@ subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call FAST_CopyMiscLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call FAST_CopyML_MiscVarType(SrcMiscData%ModLin, DstMiscData%ModLin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -16560,8 +14348,6 @@ subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyMiscLinType(MiscData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyML_MiscVarType(MiscData%ModLin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackMisc(RF, Indata) @@ -16580,7 +14366,6 @@ subroutine FAST_PackMisc(RF, Indata) call RegPack(RF, InData%calcJacobian) call FAST_PackExternInputType(RF, InData%ExternInput) call FAST_PackMiscLinType(RF, InData%Lin) - call FAST_PackML_MiscVarType(RF, InData%ModLin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -16600,7 +14385,6 @@ subroutine FAST_UnPackMisc(RF, OutData) call RegUnpack(RF, OutData%calcJacobian); if (RegCheckErr(RF, RoutineName)) return call FAST_UnpackExternInputType(RF, OutData%ExternInput) ! ExternInput call FAST_UnpackMiscLinType(RF, OutData%Lin) ! Lin - call FAST_UnpackML_MiscVarType(RF, OutData%ModLin) ! ModLin end subroutine subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg) @@ -17121,6 +14905,15 @@ subroutine FAST_CopyTurbineType(SrcTurbineTypeData, DstTurbineTypeData, CtrlCode call FAST_CopyMisc(SrcTurbineTypeData%m_FAST, DstTurbineTypeData%m_FAST, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call Glue_CopyParam(SrcTurbineTypeData%p_Glue, DstTurbineTypeData%p_Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyOutputFileType(SrcTurbineTypeData%y_Glue, DstTurbineTypeData%y_Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyMisc(SrcTurbineTypeData%m_Glue, DstTurbineTypeData%m_Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return call FAST_CopyModuleMapType(SrcTurbineTypeData%MeshMapData, DstTurbineTypeData%MeshMapData, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -17198,6 +14991,12 @@ subroutine FAST_DestroyTurbineType(TurbineTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyMisc(TurbineTypeData%m_FAST, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyParam(TurbineTypeData%p_Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyOutputFileType(TurbineTypeData%y_Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyMisc(TurbineTypeData%m_Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyModuleMapType(TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyElastoDyn_Data(TurbineTypeData%ED, ErrStat2, ErrMsg2) @@ -17249,6 +15048,9 @@ subroutine FAST_PackTurbineType(RF, Indata) call FAST_PackParam(RF, InData%p_FAST) call FAST_PackOutputFileType(RF, InData%y_FAST) call FAST_PackMisc(RF, InData%m_FAST) + call Glue_PackParam(RF, InData%p_Glue) + call Glue_PackOutputFileType(RF, InData%y_Glue) + call Glue_PackMisc(RF, InData%m_Glue) call FAST_PackModuleMapType(RF, InData%MeshMapData) call FAST_PackElastoDyn_Data(RF, InData%ED) call FAST_PackBeamDyn_Data(RF, InData%BD) @@ -17281,6 +15083,9 @@ subroutine FAST_UnPackTurbineType(RF, OutData) call FAST_UnpackParam(RF, OutData%p_FAST) ! p_FAST call FAST_UnpackOutputFileType(RF, OutData%y_FAST) ! y_FAST call FAST_UnpackMisc(RF, OutData%m_FAST) ! m_FAST + call Glue_UnpackParam(RF, OutData%p_Glue) ! p_Glue + call Glue_UnpackOutputFileType(RF, OutData%y_Glue) ! y_Glue + call Glue_UnpackMisc(RF, OutData%m_Glue) ! m_Glue call FAST_UnpackModuleMapType(RF, OutData%MeshMapData) ! MeshMapData call FAST_UnpackElastoDyn_Data(RF, OutData%ED) ! ED call FAST_UnpackBeamDyn_Data(RF, OutData%BD) ! BD diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt new file mode 100644 index 0000000000..ed39280b5e --- /dev/null +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -0,0 +1,214 @@ +#---------------------------------------------------------------------------------------------------------------------------------- +# Registry for FAST v8 in the FAST Modularization Framework +# This Registry file is used to create FAST_Types which contains data used in the FAST glue code. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +# +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +#---------------------------------------------------------------------------------------------------------------------------------- +include Registry_NWTC_Library.txt + +#---------------------------------------------------------------------------------------------------------------------------------- +# Module Mapping Type (Variable, Load Mesh, Motion Mesh) +#---------------------------------------------------------------------------------------------------------------------------------- + +param Glue - IntKi Map_LoadMesh - 1 - "Load mesh mapping type" - +param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - +param ^ - IntKi Map_Variable - 3 - "Individual variable mapping type" - +param ^ - IntKi Map_Custom - 4 - "Custom mapping not used for linearization" - + +typedef ^ MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - +typedef ^ ^ IntKi SrcModIdx - 0 - "Source module index in ModData array" - +typedef ^ ^ IntKi DstModIdx - 0 - "Destination module index in ModData array" - +typedef ^ ^ IntKi SrcModID - 0 - "Source module ID" - +typedef ^ ^ IntKi DstModID - 0 - "Destination module ID" - +typedef ^ ^ IntKi SrcIns - 0 - "Source module Instance" - +typedef ^ ^ IntKi DstIns - 0 - "Destination module Instance" - +typedef ^ ^ IntKi SrcMeshID - 0 - "Source mesh identifier" - +typedef ^ ^ IntKi DstMeshID - 0 - "Destination mesh identifier" - +typedef ^ ^ IntKi iVarSrc - 0 - "Source variable index" - +typedef ^ ^ IntKi iVarDst - 0 - "Destination variable index" - +typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - +typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - +typedef ^ ^ MeshLocType SrcMeshLoc - - - "Source mesh locator (number and indices)" - +typedef ^ ^ MeshLocType DstMeshLoc - - - "Destination mesh locator (number and indices)" - +typedef ^ ^ MeshLocType SrcDispMeshLoc - - - "Source displacement mesh locator (number and indices)" - +typedef ^ ^ MeshLocType DstDispMeshLoc - - - "Destination displacement mesh locator (number and indices)" - +typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - +typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - +typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - +typedef ^ ^ logical Ready - F - "Flag indicating Source has been ready to be transferred" - +typedef ^ ^ logical DstUsesSibling - F - "Flag indicating the destination displacement mesh is a sibling of the destination load mesh" - +typedef ^ ^ MeshType TmpLoadMesh - - - "Temporary load mesh for intermediate transfers" - +typedef ^ ^ MeshType TmpMotionMesh - - - "Temporary motion mesh for intermediate transfers" - +typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - +typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - +typedef ^ ^ MeshMapType MeshMapAux - - - "Auxiliary mesh mapping for destination load meshes without sibling motion mesh" - +typedef ^ ^ IntKi iVarSrcTransDisp - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcTransVel - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcTransAcc - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcOrientation - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcAngularVel - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcAngularAcc - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcForce - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcMoment - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarSrcDispTransDisp - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstTransDisp - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstTransVel - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstTransAcc - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstOrientation - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstAngularVel - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstAngularAcc - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstForce - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstMoment - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstDispTransDisp - - - "Var index for linearized mesh mapping" +typedef ^ ^ IntKi iVarDstDispOrientation - - - "Var index for linearized mesh mapping" + +#---------------------------------------------------------------------------------------------------------------------------------- +# Glue Linearization +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ Glue_LinType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki xd : - - "" - +typedef ^ ^ R8Ki z : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki x_pos : - - "" - +typedef ^ ^ R8Ki x_neg : - - "" - +typedef ^ ^ R8Ki y_pos : - - "" - +typedef ^ ^ R8Ki y_neg : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - + +#---------------------------------------------------------------------------------------------------------------------------------- +# Module Data +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ Glue_LinType Lin - - - "Module linearization data" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" + +#---------------------------------------------------------------------------------------------------------------------------------- +# Variable Indexing +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ VarIdxType IntKi ModVarStart : - - "Variable start index from module index" - +typedef ^ ^ IntKi ValLocGbl :: - - "Variable local and global value indices" - + +typedef ^ VarsIdxType IntKi FlagFilter - - - "" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nxd - - - "" - +typedef ^ ^ IntKi Nz - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ VarIdxType x - - - "" - +typedef ^ ^ VarIdxType xd - - - "" - +typedef ^ ^ VarIdxType z - - - "" - +typedef ^ ^ VarIdxType u - - - "" - +typedef ^ ^ VarIdxType y - - - "" - +typedef ^ ^ Glue_LinType Lin - - - "Linearization matrices" - + +#---------------------------------------------------------------------------------------------------------------------------------- +# Glue Parameters +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ Glue_ParameterType IntKi iMod : - - "ModData index order for linearization" - +typedef ^ ^ VarsIdxType IdxLin - - - "Variable index for linearization data" - +typedef ^ ^ R8Ki DT - - - "solution time step" - +typedef ^ ^ R8Ki ConvTol - - - "Solution convergence tolerance" - +typedef ^ ^ IntKi NumCrctn - - - "" - +typedef ^ ^ IntKi MaxConvIter - - - "" - +typedef ^ ^ IntKi NIter_UJac - - - "Number of solution iterations between updating the Jacobian" - +typedef ^ ^ IntKi NStep_UJac - - - "Number of global time steps between updating the Jacobian" - +typedef ^ ^ R8Ki Scale_UJac - - - "" - +typedef ^ ^ R8Ki AccBlend - 1 - "" - +typedef ^ ^ R8Ki RhoInf - - - "Rho infinity used for calculating Generalized-alpha coefficients" - +typedef ^ ^ R8Ki AlphaM - - - "Generalized-alpha alpha_m coefficient" - +typedef ^ ^ R8Ki AlphaF - - - "Generalized-alpha alpha_f coefficient" - +typedef ^ ^ R8Ki Beta - - - "Generalized-alpha beta coefficient" - +typedef ^ ^ R8Ki Gamma - - - "Generalized-alpha gamma coefficient" - +typedef ^ ^ R8Ki C 7 - - "Generalized-alpha coefficient array" - +typedef ^ ^ IntKi iX1 2 - - "" - +typedef ^ ^ IntKi iX2 2 - - "" - +typedef ^ ^ IntKi iUT 2 - - "" - +typedef ^ ^ IntKi iU1 2 - - "" - +typedef ^ ^ IntKi iyT 2 - - "" - +typedef ^ ^ IntKi iy1 2 - - "" - +typedef ^ ^ IntKi iJX 2 - - "Indices of Jacobian q variables" - +typedef ^ ^ IntKi iJU 2 - - "Indices of Jacobian input variables" - +typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - +typedef ^ ^ IntKi iJL : - - "Indices of Jacobian load variables" - +typedef ^ ^ IntKi ixqd :: - - "" - +typedef ^ ^ IntKi iModInit : - - "ModData index order for step 0 initialization" - +typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - +typedef ^ ^ IntKi iModBD : - - "ModData index order for BD modules" - +typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - +typedef ^ ^ IntKi iModOpt1US : - - "ModData index order for option 1 modules to update states" - +typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - +typedef ^ ^ IntKi iModPost : - - "ModData index order for post option 1 modules" - + +#---------------------------------------------------------------------------------------------------------------------------------- +# Output Data +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ Glue_LinSave R8Ki x :: - - "linearization operating point continuous state" - +typedef ^ ^ R8Ki xd :: - - "linearization operating point discrete state" - +typedef ^ ^ R8Ki z :: - - "linearization operating point constraint state" - +typedef ^ ^ R8Ki OtherSt :: - - "linearization operating point other state" - +typedef ^ ^ R8Ki u :: - - "linearization operating point input" - + +typedef ^ Glue_OutputFileType ModDataType ModGlue - - - "glue module data" - +typedef ^ ^ Glue_LinSave OP - - - "Operating point data for linearization + +#---------------------------------------------------------------------------------------------------------------------------------- +# Miscellaneous Data +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ Glue_MiscVarType ModDataType ModData : - - "module variable and value data" - +typedef ^ ^ MappingType Mappings : - - "Module mapping" - +typedef ^ ^ R8Ki q :: - - "" - +typedef ^ ^ R8Ki qn :: - - "" - +typedef ^ ^ R8Ki x : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki un : - - "" - +typedef ^ ^ R8Ki u_tmp : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki dUdyHat :: - - "" - +typedef ^ ^ R8Ki XB :: - - "" - +typedef ^ ^ R8Ki G :: - - "Used to merge state matrices" - +typedef ^ ^ R8Ki Jac :: - - "" - +typedef ^ ^ IntKi IPIV : - - "" - +typedef ^ ^ IntKi IterTotal - 0 - "" - +typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - +typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - +typedef ^ ^ R8Ki dq :: - - "Change in q" - +typedef ^ ^ R8Ki dx : - - "Change in x" - +typedef ^ ^ R8Ki du : - - "" - +typedef ^ ^ R8Ki UDiff : - - "" - +typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 new file mode 100644 index 0000000000..23c3a9c1f3 --- /dev/null +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -0,0 +1,2163 @@ +!STARTOFREGISTRYGENERATEDFILE 'Glue_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! Glue_Types +!................................................................................................................................. +! This file is part of Glue. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in Glue. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE Glue_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_LoadMesh = 1 ! Load mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Variable = 3 ! Individual variable mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Custom = 4 ! Custom mapping not used for linearization [-] +! ========= MappingType ======= + TYPE, PUBLIC :: MappingType + character(128) :: Desc !< Description of mapping (used to lookup non-mesh maps) [-] + INTEGER(IntKi) :: SrcModIdx = 0 !< Source module index in ModData array [-] + INTEGER(IntKi) :: DstModIdx = 0 !< Destination module index in ModData array [-] + INTEGER(IntKi) :: SrcModID = 0 !< Source module ID [-] + INTEGER(IntKi) :: DstModID = 0 !< Destination module ID [-] + INTEGER(IntKi) :: SrcIns = 0 !< Source module Instance [-] + INTEGER(IntKi) :: DstIns = 0 !< Destination module Instance [-] + INTEGER(IntKi) :: SrcMeshID = 0 !< Source mesh identifier [-] + INTEGER(IntKi) :: DstMeshID = 0 !< Destination mesh identifier [-] + INTEGER(IntKi) :: iVarSrc = 0 !< Source variable index [-] + INTEGER(IntKi) :: iVarDst = 0 !< Destination variable index [-] + INTEGER(IntKi) :: SrcDispMeshID = 0 !< Source displacement mesh identifier [-] + INTEGER(IntKi) :: DstDispMeshID = 0 !< Destination displacement mesh identifier [-] + TYPE(MeshLocType) :: SrcMeshLoc !< Source mesh locator (number and indices) [-] + TYPE(MeshLocType) :: DstMeshLoc !< Destination mesh locator (number and indices) [-] + TYPE(MeshLocType) :: SrcDispMeshLoc !< Source displacement mesh locator (number and indices) [-] + TYPE(MeshLocType) :: DstDispMeshLoc !< Destination displacement mesh locator (number and indices) [-] + INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] + INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] + INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] + LOGICAL :: Ready = .false. !< Flag indicating Source has been ready to be transferred [-] + LOGICAL :: DstUsesSibling = .false. !< Flag indicating the destination displacement mesh is a sibling of the destination load mesh [-] + TYPE(MeshType) :: TmpLoadMesh !< Temporary load mesh for intermediate transfers [-] + TYPE(MeshType) :: TmpMotionMesh !< Temporary motion mesh for intermediate transfers [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] + TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] + TYPE(MeshMapType) :: MeshMapAux !< Auxiliary mesh mapping for destination load meshes without sibling motion mesh [-] + INTEGER(IntKi) :: iVarSrcTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcTransVel = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcTransAcc = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcAngularVel = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcAngularAcc = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcForce = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcMoment = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarSrcDispTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstTransVel = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstTransAcc = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstAngularVel = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstAngularAcc = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstForce = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstMoment = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstDispTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] + INTEGER(IntKi) :: iVarDstDispOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] + END TYPE MappingType +! ======================= +! ========= Glue_LinType ======= + TYPE, PUBLIC :: Glue_LinType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] + END TYPE Glue_LinType +! ======================= +! ========= ModDataType ======= + TYPE, PUBLIC :: ModDataType + character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] + INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] + REAL(R8Ki) :: DT = 0 !< Module time step [-] + INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] + TYPE(Glue_LinType) :: Lin !< Module linearization data [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] + END TYPE ModDataType +! ======================= +! ========= VarIdxType ======= + TYPE, PUBLIC :: VarIdxType + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ModVarStart !< Variable start index from module index [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ValLocGbl !< Variable local and global value indices [-] + END TYPE VarIdxType +! ======================= +! ========= VarsIdxType ======= + TYPE, PUBLIC :: VarsIdxType + INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nxd = 0_IntKi !< [-] + INTEGER(IntKi) :: Nz = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + TYPE(VarIdxType) :: x !< [-] + TYPE(VarIdxType) :: xd !< [-] + TYPE(VarIdxType) :: z !< [-] + TYPE(VarIdxType) :: u !< [-] + TYPE(VarIdxType) :: y !< [-] + TYPE(Glue_LinType) :: Lin !< Linearization matrices [-] + END TYPE VarsIdxType +! ======================= +! ========= Glue_ParameterType ======= + TYPE, PUBLIC :: Glue_ParameterType + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] + TYPE(VarsIdxType) :: IdxLin !< Variable index for linearization data [-] + REAL(R8Ki) :: DT = 0.0_R8Ki !< solution time step [-] + REAL(R8Ki) :: ConvTol = 0.0_R8Ki !< Solution convergence tolerance [-] + INTEGER(IntKi) :: NumCrctn = 0_IntKi !< [-] + INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< [-] + INTEGER(IntKi) :: NIter_UJac = 0_IntKi !< Number of solution iterations between updating the Jacobian [-] + INTEGER(IntKi) :: NStep_UJac = 0_IntKi !< Number of global time steps between updating the Jacobian [-] + REAL(R8Ki) :: Scale_UJac = 0.0_R8Ki !< [-] + REAL(R8Ki) :: AccBlend = 1 !< [-] + REAL(R8Ki) :: RhoInf = 0.0_R8Ki !< Rho infinity used for calculating Generalized-alpha coefficients [-] + REAL(R8Ki) :: AlphaM = 0.0_R8Ki !< Generalized-alpha alpha_m coefficient [-] + REAL(R8Ki) :: AlphaF = 0.0_R8Ki !< Generalized-alpha alpha_f coefficient [-] + REAL(R8Ki) :: Beta = 0.0_R8Ki !< Generalized-alpha beta coefficient [-] + REAL(R8Ki) :: Gamma = 0.0_R8Ki !< Generalized-alpha gamma coefficient [-] + REAL(R8Ki) , DIMENSION(1:7) :: C = 0.0_R8Ki !< Generalized-alpha coefficient array [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iX1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iX2 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUT = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iU1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iyT = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iy1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJX = 0_IntKi !< Indices of Jacobian q variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJU = 0_IntKi !< Indices of Jacobian input variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJL !< Indices of Jacobian load variables [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModInit !< ModData index order for step 0 initialization [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModBD !< ModData index order for BD modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1US !< ModData index order for option 1 modules to update states [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModPost !< ModData index order for post option 1 modules [-] + END TYPE Glue_ParameterType +! ======================= +! ========= Glue_LinSave ======= + TYPE, PUBLIC :: Glue_LinSave + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: x !< linearization operating point continuous state [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: xd !< linearization operating point discrete state [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: z !< linearization operating point constraint state [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< linearization operating point other state [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: u !< linearization operating point input [-] + END TYPE Glue_LinSave +! ======================= +! ========= Glue_OutputFileType ======= + TYPE, PUBLIC :: Glue_OutputFileType + TYPE(ModDataType) :: ModGlue !< glue module data [-] + TYPE(Glue_LinSave) :: OP + END TYPE Glue_OutputFileType +! ======================= +! ========= Glue_MiscVarType ======= + TYPE, PUBLIC :: Glue_MiscVarType + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModData !< module variable and value data [-] + TYPE(MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mapping [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: q !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: qn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: un !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_tmp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdyHat !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: G !< Used to merge state matrices [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] + INTEGER(IntKi) :: IterTotal = 0 !< [-] + INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] + INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dq !< Change in q [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< Change in x [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UDiff !< [-] + LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] + END TYPE Glue_MiscVarType +! ======================= +CONTAINS + +subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode, ErrStat, ErrMsg) + type(MappingType), intent(inout) :: SrcMappingTypeData + type(MappingType), intent(inout) :: DstMappingTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyMappingType' + ErrStat = ErrID_None + ErrMsg = '' + DstMappingTypeData%Desc = SrcMappingTypeData%Desc + DstMappingTypeData%SrcModIdx = SrcMappingTypeData%SrcModIdx + DstMappingTypeData%DstModIdx = SrcMappingTypeData%DstModIdx + DstMappingTypeData%SrcModID = SrcMappingTypeData%SrcModID + DstMappingTypeData%DstModID = SrcMappingTypeData%DstModID + DstMappingTypeData%SrcIns = SrcMappingTypeData%SrcIns + DstMappingTypeData%DstIns = SrcMappingTypeData%DstIns + DstMappingTypeData%SrcMeshID = SrcMappingTypeData%SrcMeshID + DstMappingTypeData%DstMeshID = SrcMappingTypeData%DstMeshID + DstMappingTypeData%iVarSrc = SrcMappingTypeData%iVarSrc + DstMappingTypeData%iVarDst = SrcMappingTypeData%iVarDst + DstMappingTypeData%SrcDispMeshID = SrcMappingTypeData%SrcDispMeshID + DstMappingTypeData%DstDispMeshID = SrcMappingTypeData%DstDispMeshID + call NWTC_Library_CopyMeshLocType(SrcMappingTypeData%SrcMeshLoc, DstMappingTypeData%SrcMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshLocType(SrcMappingTypeData%DstMeshLoc, DstMappingTypeData%DstMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshLocType(SrcMappingTypeData%SrcDispMeshLoc, DstMappingTypeData%SrcDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshLocType(SrcMappingTypeData%DstDispMeshLoc, DstMappingTypeData%DstDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMappingTypeData%MapType = SrcMappingTypeData%MapType + DstMappingTypeData%XfrType = SrcMappingTypeData%XfrType + DstMappingTypeData%XfrTypeAux = SrcMappingTypeData%XfrTypeAux + DstMappingTypeData%Ready = SrcMappingTypeData%Ready + DstMappingTypeData%DstUsesSibling = SrcMappingTypeData%DstUsesSibling + call MeshCopy(SrcMappingTypeData%TmpLoadMesh, DstMappingTypeData%TmpLoadMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMappingTypeData%TmpMotionMesh, DstMappingTypeData%TmpMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMappingTypeData%TmpMatrix)) then + LB(1:2) = lbound(SrcMappingTypeData%TmpMatrix, kind=B8Ki) + UB(1:2) = ubound(SrcMappingTypeData%TmpMatrix, kind=B8Ki) + if (.not. allocated(DstMappingTypeData%TmpMatrix)) then + allocate(DstMappingTypeData%TmpMatrix(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMappingTypeData%TmpMatrix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMappingTypeData%TmpMatrix = SrcMappingTypeData%TmpMatrix + end if + call NWTC_Library_CopyMeshMapType(SrcMappingTypeData%MeshMap, DstMappingTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMappingTypeData%MeshMapAux, DstMappingTypeData%MeshMapAux, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMappingTypeData%iVarSrcTransDisp = SrcMappingTypeData%iVarSrcTransDisp + DstMappingTypeData%iVarSrcTransVel = SrcMappingTypeData%iVarSrcTransVel + DstMappingTypeData%iVarSrcTransAcc = SrcMappingTypeData%iVarSrcTransAcc + DstMappingTypeData%iVarSrcOrientation = SrcMappingTypeData%iVarSrcOrientation + DstMappingTypeData%iVarSrcAngularVel = SrcMappingTypeData%iVarSrcAngularVel + DstMappingTypeData%iVarSrcAngularAcc = SrcMappingTypeData%iVarSrcAngularAcc + DstMappingTypeData%iVarSrcForce = SrcMappingTypeData%iVarSrcForce + DstMappingTypeData%iVarSrcMoment = SrcMappingTypeData%iVarSrcMoment + DstMappingTypeData%iVarSrcDispTransDisp = SrcMappingTypeData%iVarSrcDispTransDisp + DstMappingTypeData%iVarDstTransDisp = SrcMappingTypeData%iVarDstTransDisp + DstMappingTypeData%iVarDstTransVel = SrcMappingTypeData%iVarDstTransVel + DstMappingTypeData%iVarDstTransAcc = SrcMappingTypeData%iVarDstTransAcc + DstMappingTypeData%iVarDstOrientation = SrcMappingTypeData%iVarDstOrientation + DstMappingTypeData%iVarDstAngularVel = SrcMappingTypeData%iVarDstAngularVel + DstMappingTypeData%iVarDstAngularAcc = SrcMappingTypeData%iVarDstAngularAcc + DstMappingTypeData%iVarDstForce = SrcMappingTypeData%iVarDstForce + DstMappingTypeData%iVarDstMoment = SrcMappingTypeData%iVarDstMoment + DstMappingTypeData%iVarDstDispTransDisp = SrcMappingTypeData%iVarDstDispTransDisp + DstMappingTypeData%iVarDstDispOrientation = SrcMappingTypeData%iVarDstDispOrientation +end subroutine + +subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) + type(MappingType), intent(inout) :: MappingTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyMappingType' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyMeshLocType(MappingTypeData%SrcMeshLoc, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshLocType(MappingTypeData%DstMeshLoc, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshLocType(MappingTypeData%SrcDispMeshLoc, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshLocType(MappingTypeData%DstDispMeshLoc, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MappingTypeData%TmpLoadMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MappingTypeData%TmpMotionMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MappingTypeData%TmpMatrix)) then + deallocate(MappingTypeData%TmpMatrix) + end if + call NWTC_Library_DestroyMeshMapType(MappingTypeData%MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MappingTypeData%MeshMapAux, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Glue_PackMappingType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MappingType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackMappingType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Desc) + call RegPack(RF, InData%SrcModIdx) + call RegPack(RF, InData%DstModIdx) + call RegPack(RF, InData%SrcModID) + call RegPack(RF, InData%DstModID) + call RegPack(RF, InData%SrcIns) + call RegPack(RF, InData%DstIns) + call RegPack(RF, InData%SrcMeshID) + call RegPack(RF, InData%DstMeshID) + call RegPack(RF, InData%iVarSrc) + call RegPack(RF, InData%iVarDst) + call RegPack(RF, InData%SrcDispMeshID) + call RegPack(RF, InData%DstDispMeshID) + call NWTC_Library_PackMeshLocType(RF, InData%SrcMeshLoc) + call NWTC_Library_PackMeshLocType(RF, InData%DstMeshLoc) + call NWTC_Library_PackMeshLocType(RF, InData%SrcDispMeshLoc) + call NWTC_Library_PackMeshLocType(RF, InData%DstDispMeshLoc) + call RegPack(RF, InData%MapType) + call RegPack(RF, InData%XfrType) + call RegPack(RF, InData%XfrTypeAux) + call RegPack(RF, InData%Ready) + call RegPack(RF, InData%DstUsesSibling) + call MeshPack(RF, InData%TmpLoadMesh) + call MeshPack(RF, InData%TmpMotionMesh) + call RegPackAlloc(RF, InData%TmpMatrix) + call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) + call NWTC_Library_PackMeshMapType(RF, InData%MeshMapAux) + call RegPack(RF, InData%iVarSrcTransDisp) + call RegPack(RF, InData%iVarSrcTransVel) + call RegPack(RF, InData%iVarSrcTransAcc) + call RegPack(RF, InData%iVarSrcOrientation) + call RegPack(RF, InData%iVarSrcAngularVel) + call RegPack(RF, InData%iVarSrcAngularAcc) + call RegPack(RF, InData%iVarSrcForce) + call RegPack(RF, InData%iVarSrcMoment) + call RegPack(RF, InData%iVarSrcDispTransDisp) + call RegPack(RF, InData%iVarDstTransDisp) + call RegPack(RF, InData%iVarDstTransVel) + call RegPack(RF, InData%iVarDstTransAcc) + call RegPack(RF, InData%iVarDstOrientation) + call RegPack(RF, InData%iVarDstAngularVel) + call RegPack(RF, InData%iVarDstAngularAcc) + call RegPack(RF, InData%iVarDstForce) + call RegPack(RF, InData%iVarDstMoment) + call RegPack(RF, InData%iVarDstDispTransDisp) + call RegPack(RF, InData%iVarDstDispOrientation) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackMappingType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MappingType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackMappingType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Desc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcModIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstModIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcModID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstModID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcIns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstIns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcMeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstMeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcDispMeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstDispMeshID); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcMeshLoc) ! SrcMeshLoc + call NWTC_Library_UnpackMeshLocType(RF, OutData%DstMeshLoc) ! DstMeshLoc + call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcDispMeshLoc) ! SrcDispMeshLoc + call NWTC_Library_UnpackMeshLocType(RF, OutData%DstDispMeshLoc) ! DstDispMeshLoc + call RegUnpack(RF, OutData%MapType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XfrType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XfrTypeAux); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ready); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstUsesSibling); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%TmpLoadMesh) ! TmpLoadMesh + call MeshUnpack(RF, OutData%TmpMotionMesh) ! TmpMotionMesh + call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap + call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMapAux) ! MeshMapAux + call RegUnpack(RF, OutData%iVarSrcTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcTransVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcTransAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcAngularVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcAngularAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcDispTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstTransVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstTransAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstAngularVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstAngularAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstDispTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstDispOrientation); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(Glue_LinType), intent(in) :: SrcLinTypeData + type(Glue_LinType), intent(inout) :: DstLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyLinType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLinTypeData%x)) then + LB(1:1) = lbound(SrcLinTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%x, kind=B8Ki) + if (.not. allocated(DstLinTypeData%x)) then + allocate(DstLinTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%x = SrcLinTypeData%x + end if + if (allocated(SrcLinTypeData%dx)) then + LB(1:1) = lbound(SrcLinTypeData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%dx, kind=B8Ki) + if (.not. allocated(DstLinTypeData%dx)) then + allocate(DstLinTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%dx = SrcLinTypeData%dx + end if + if (allocated(SrcLinTypeData%xd)) then + LB(1:1) = lbound(SrcLinTypeData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%xd, kind=B8Ki) + if (.not. allocated(DstLinTypeData%xd)) then + allocate(DstLinTypeData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%xd = SrcLinTypeData%xd + end if + if (allocated(SrcLinTypeData%z)) then + LB(1:1) = lbound(SrcLinTypeData%z, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%z, kind=B8Ki) + if (.not. allocated(DstLinTypeData%z)) then + allocate(DstLinTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%z = SrcLinTypeData%z + end if + if (allocated(SrcLinTypeData%u)) then + LB(1:1) = lbound(SrcLinTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%u, kind=B8Ki) + if (.not. allocated(DstLinTypeData%u)) then + allocate(DstLinTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%u = SrcLinTypeData%u + end if + if (allocated(SrcLinTypeData%y)) then + LB(1:1) = lbound(SrcLinTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%y, kind=B8Ki) + if (.not. allocated(DstLinTypeData%y)) then + allocate(DstLinTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%y = SrcLinTypeData%y + end if + if (allocated(SrcLinTypeData%u_perturb)) then + LB(1:1) = lbound(SrcLinTypeData%u_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%u_perturb, kind=B8Ki) + if (.not. allocated(DstLinTypeData%u_perturb)) then + allocate(DstLinTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%u_perturb = SrcLinTypeData%u_perturb + end if + if (allocated(SrcLinTypeData%x_perturb)) then + LB(1:1) = lbound(SrcLinTypeData%x_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%x_perturb, kind=B8Ki) + if (.not. allocated(DstLinTypeData%x_perturb)) then + allocate(DstLinTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%x_perturb = SrcLinTypeData%x_perturb + end if + if (allocated(SrcLinTypeData%x_pos)) then + LB(1:1) = lbound(SrcLinTypeData%x_pos, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%x_pos, kind=B8Ki) + if (.not. allocated(DstLinTypeData%x_pos)) then + allocate(DstLinTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%x_pos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%x_pos = SrcLinTypeData%x_pos + end if + if (allocated(SrcLinTypeData%x_neg)) then + LB(1:1) = lbound(SrcLinTypeData%x_neg, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%x_neg, kind=B8Ki) + if (.not. allocated(DstLinTypeData%x_neg)) then + allocate(DstLinTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%x_neg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%x_neg = SrcLinTypeData%x_neg + end if + if (allocated(SrcLinTypeData%y_pos)) then + LB(1:1) = lbound(SrcLinTypeData%y_pos, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%y_pos, kind=B8Ki) + if (.not. allocated(DstLinTypeData%y_pos)) then + allocate(DstLinTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%y_pos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%y_pos = SrcLinTypeData%y_pos + end if + if (allocated(SrcLinTypeData%y_neg)) then + LB(1:1) = lbound(SrcLinTypeData%y_neg, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%y_neg, kind=B8Ki) + if (.not. allocated(DstLinTypeData%y_neg)) then + allocate(DstLinTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%y_neg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%y_neg = SrcLinTypeData%y_neg + end if + if (allocated(SrcLinTypeData%dYdx)) then + LB(1:2) = lbound(SrcLinTypeData%dYdx, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%dYdx, kind=B8Ki) + if (.not. allocated(DstLinTypeData%dYdx)) then + allocate(DstLinTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%dYdx = SrcLinTypeData%dYdx + end if + if (allocated(SrcLinTypeData%dXdx)) then + LB(1:2) = lbound(SrcLinTypeData%dXdx, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%dXdx, kind=B8Ki) + if (.not. allocated(DstLinTypeData%dXdx)) then + allocate(DstLinTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%dXdx = SrcLinTypeData%dXdx + end if + if (allocated(SrcLinTypeData%dYdu)) then + LB(1:2) = lbound(SrcLinTypeData%dYdu, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%dYdu, kind=B8Ki) + if (.not. allocated(DstLinTypeData%dYdu)) then + allocate(DstLinTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%dYdu = SrcLinTypeData%dYdu + end if + if (allocated(SrcLinTypeData%dXdu)) then + LB(1:2) = lbound(SrcLinTypeData%dXdu, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%dXdu, kind=B8Ki) + if (.not. allocated(DstLinTypeData%dXdu)) then + allocate(DstLinTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%dXdu = SrcLinTypeData%dXdu + end if + if (allocated(SrcLinTypeData%dUdu)) then + LB(1:2) = lbound(SrcLinTypeData%dUdu, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%dUdu, kind=B8Ki) + if (.not. allocated(DstLinTypeData%dUdu)) then + allocate(DstLinTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%dUdu = SrcLinTypeData%dUdu + end if + if (allocated(SrcLinTypeData%dUdy)) then + LB(1:2) = lbound(SrcLinTypeData%dUdy, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%dUdy, kind=B8Ki) + if (.not. allocated(DstLinTypeData%dUdy)) then + allocate(DstLinTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%dUdy = SrcLinTypeData%dUdy + end if + if (allocated(SrcLinTypeData%StateRotation)) then + LB(1:2) = lbound(SrcLinTypeData%StateRotation, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%StateRotation, kind=B8Ki) + if (.not. allocated(DstLinTypeData%StateRotation)) then + allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation + end if +end subroutine + +subroutine Glue_DestroyLinType(LinTypeData, ErrStat, ErrMsg) + type(Glue_LinType), intent(inout) :: LinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyLinType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LinTypeData%x)) then + deallocate(LinTypeData%x) + end if + if (allocated(LinTypeData%dx)) then + deallocate(LinTypeData%dx) + end if + if (allocated(LinTypeData%xd)) then + deallocate(LinTypeData%xd) + end if + if (allocated(LinTypeData%z)) then + deallocate(LinTypeData%z) + end if + if (allocated(LinTypeData%u)) then + deallocate(LinTypeData%u) + end if + if (allocated(LinTypeData%y)) then + deallocate(LinTypeData%y) + end if + if (allocated(LinTypeData%u_perturb)) then + deallocate(LinTypeData%u_perturb) + end if + if (allocated(LinTypeData%x_perturb)) then + deallocate(LinTypeData%x_perturb) + end if + if (allocated(LinTypeData%x_pos)) then + deallocate(LinTypeData%x_pos) + end if + if (allocated(LinTypeData%x_neg)) then + deallocate(LinTypeData%x_neg) + end if + if (allocated(LinTypeData%y_pos)) then + deallocate(LinTypeData%y_pos) + end if + if (allocated(LinTypeData%y_neg)) then + deallocate(LinTypeData%y_neg) + end if + if (allocated(LinTypeData%dYdx)) then + deallocate(LinTypeData%dYdx) + end if + if (allocated(LinTypeData%dXdx)) then + deallocate(LinTypeData%dXdx) + end if + if (allocated(LinTypeData%dYdu)) then + deallocate(LinTypeData%dYdu) + end if + if (allocated(LinTypeData%dXdu)) then + deallocate(LinTypeData%dXdu) + end if + if (allocated(LinTypeData%dUdu)) then + deallocate(LinTypeData%dUdu) + end if + if (allocated(LinTypeData%dUdy)) then + deallocate(LinTypeData%dUdy) + end if + if (allocated(LinTypeData%StateRotation)) then + deallocate(LinTypeData%StateRotation) + end if +end subroutine + +subroutine Glue_PackLinType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_LinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackLinType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%dx) + call RegPackAlloc(RF, InData%xd) + call RegPackAlloc(RF, InData%z) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%u_perturb) + call RegPackAlloc(RF, InData%x_perturb) + call RegPackAlloc(RF, InData%x_pos) + call RegPackAlloc(RF, InData%x_neg) + call RegPackAlloc(RF, InData%y_pos) + call RegPackAlloc(RF, InData%y_neg) + call RegPackAlloc(RF, InData%dYdx) + call RegPackAlloc(RF, InData%dXdx) + call RegPackAlloc(RF, InData%dYdu) + call RegPackAlloc(RF, InData%dXdu) + call RegPackAlloc(RF, InData%dUdu) + call RegPackAlloc(RF, InData%dUdy) + call RegPackAlloc(RF, InData%StateRotation) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackLinType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_LinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackLinType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: SrcModDataTypeData + type(ModDataType), intent(inout) :: DstModDataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%ID = SrcModDataTypeData%ID + DstModDataTypeData%Idx = SrcModDataTypeData%Idx + DstModDataTypeData%Ins = SrcModDataTypeData%Ins + DstModDataTypeData%DT = SrcModDataTypeData%DT + DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps + DstModDataTypeData%Vars => SrcModDataTypeData%Vars + call Glue_CopyLinType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModDataTypeData%SrcMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%SrcMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%SrcMaps)) then + allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps + end if + if (allocated(SrcModDataTypeData%DstMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%DstMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%DstMaps, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%DstMaps)) then + allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps + end if +end subroutine + +subroutine Glue_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(ModDataTypeData%Vars) + call Glue_DestroyLinType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModDataTypeData%SrcMaps)) then + deallocate(ModDataTypeData%SrcMaps) + end if + if (allocated(ModDataTypeData%DstMaps)) then + deallocate(ModDataTypeData%DstMaps) + end if +end subroutine + +subroutine Glue_PackModDataType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackModDataType' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Abbr) + call RegPack(RF, InData%ID) + call RegPack(RF, InData%Idx) + call RegPack(RF, InData%Ins) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%SubSteps) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call Glue_PackLinType(RF, InData%Lin) + call RegPackAlloc(RF, InData%SrcMaps) + call RegPackAlloc(RF, InData%DstMaps) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackModDataType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackModDataType' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call Glue_UnpackLinType(RF, OutData%Lin) ! Lin + call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyVarIdxType(SrcVarIdxTypeData, DstVarIdxTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarIdxType), intent(in) :: SrcVarIdxTypeData + type(VarIdxType), intent(inout) :: DstVarIdxTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyVarIdxType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcVarIdxTypeData%ModVarStart)) then + LB(1:1) = lbound(SrcVarIdxTypeData%ModVarStart, kind=B8Ki) + UB(1:1) = ubound(SrcVarIdxTypeData%ModVarStart, kind=B8Ki) + if (.not. allocated(DstVarIdxTypeData%ModVarStart)) then + allocate(DstVarIdxTypeData%ModVarStart(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarIdxTypeData%ModVarStart.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarIdxTypeData%ModVarStart = SrcVarIdxTypeData%ModVarStart + end if + if (allocated(SrcVarIdxTypeData%ValLocGbl)) then + LB(1:2) = lbound(SrcVarIdxTypeData%ValLocGbl, kind=B8Ki) + UB(1:2) = ubound(SrcVarIdxTypeData%ValLocGbl, kind=B8Ki) + if (.not. allocated(DstVarIdxTypeData%ValLocGbl)) then + allocate(DstVarIdxTypeData%ValLocGbl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVarIdxTypeData%ValLocGbl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVarIdxTypeData%ValLocGbl = SrcVarIdxTypeData%ValLocGbl + end if +end subroutine + +subroutine Glue_DestroyVarIdxType(VarIdxTypeData, ErrStat, ErrMsg) + type(VarIdxType), intent(inout) :: VarIdxTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyVarIdxType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VarIdxTypeData%ModVarStart)) then + deallocate(VarIdxTypeData%ModVarStart) + end if + if (allocated(VarIdxTypeData%ValLocGbl)) then + deallocate(VarIdxTypeData%ValLocGbl) + end if +end subroutine + +subroutine Glue_PackVarIdxType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarIdxType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackVarIdxType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%ModVarStart) + call RegPackAlloc(RF, InData%ValLocGbl) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackVarIdxType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarIdxType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackVarIdxType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%ModVarStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ValLocGbl); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarsIdxType), intent(in) :: SrcVarsIdxTypeData + type(VarsIdxType), intent(inout) :: DstVarsIdxTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyVarsIdxType' + ErrStat = ErrID_None + ErrMsg = '' + DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter + DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx + DstVarsIdxTypeData%Nxd = SrcVarsIdxTypeData%Nxd + DstVarsIdxTypeData%Nz = SrcVarsIdxTypeData%Nz + DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu + DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny + call Glue_CopyVarIdxType(SrcVarsIdxTypeData%x, DstVarsIdxTypeData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyVarIdxType(SrcVarsIdxTypeData%xd, DstVarsIdxTypeData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyVarIdxType(SrcVarsIdxTypeData%z, DstVarsIdxTypeData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyVarIdxType(SrcVarsIdxTypeData%u, DstVarsIdxTypeData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyVarIdxType(SrcVarsIdxTypeData%y, DstVarsIdxTypeData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyLinType(SrcVarsIdxTypeData%Lin, DstVarsIdxTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Glue_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) + type(VarsIdxType), intent(inout) :: VarsIdxTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyVarsIdxType' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyVarIdxType(VarsIdxTypeData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyVarIdxType(VarsIdxTypeData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyVarIdxType(VarsIdxTypeData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyVarIdxType(VarsIdxTypeData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyVarIdxType(VarsIdxTypeData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyLinType(VarsIdxTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Glue_PackVarsIdxType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarsIdxType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackVarsIdxType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FlagFilter) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nxd) + call RegPack(RF, InData%Nz) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) + call Glue_PackVarIdxType(RF, InData%x) + call Glue_PackVarIdxType(RF, InData%xd) + call Glue_PackVarIdxType(RF, InData%z) + call Glue_PackVarIdxType(RF, InData%u) + call Glue_PackVarIdxType(RF, InData%y) + call Glue_PackLinType(RF, InData%Lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackVarsIdxType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarsIdxType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackVarsIdxType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return + call Glue_UnpackVarIdxType(RF, OutData%x) ! x + call Glue_UnpackVarIdxType(RF, OutData%xd) ! xd + call Glue_UnpackVarIdxType(RF, OutData%z) ! z + call Glue_UnpackVarIdxType(RF, OutData%u) ! u + call Glue_UnpackVarIdxType(RF, OutData%y) ! y + call Glue_UnpackLinType(RF, OutData%Lin) ! Lin +end subroutine + +subroutine Glue_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(in) :: SrcParamData + type(Glue_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%iMod)) then + LB(1:1) = lbound(SrcParamData%iMod, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iMod, kind=B8Ki) + if (.not. allocated(DstParamData%iMod)) then + allocate(DstParamData%iMod(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iMod.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iMod = SrcParamData%iMod + end if + call Glue_CopyVarsIdxType(SrcParamData%IdxLin, DstParamData%IdxLin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%DT = SrcParamData%DT + DstParamData%ConvTol = SrcParamData%ConvTol + DstParamData%NumCrctn = SrcParamData%NumCrctn + DstParamData%MaxConvIter = SrcParamData%MaxConvIter + DstParamData%NIter_UJac = SrcParamData%NIter_UJac + DstParamData%NStep_UJac = SrcParamData%NStep_UJac + DstParamData%Scale_UJac = SrcParamData%Scale_UJac + DstParamData%AccBlend = SrcParamData%AccBlend + DstParamData%RhoInf = SrcParamData%RhoInf + DstParamData%AlphaM = SrcParamData%AlphaM + DstParamData%AlphaF = SrcParamData%AlphaF + DstParamData%Beta = SrcParamData%Beta + DstParamData%Gamma = SrcParamData%Gamma + DstParamData%C = SrcParamData%C + DstParamData%iX1 = SrcParamData%iX1 + DstParamData%iX2 = SrcParamData%iX2 + DstParamData%iUT = SrcParamData%iUT + DstParamData%iU1 = SrcParamData%iU1 + DstParamData%iyT = SrcParamData%iyT + DstParamData%iy1 = SrcParamData%iy1 + DstParamData%iJX = SrcParamData%iJX + DstParamData%iJU = SrcParamData%iJU + DstParamData%iJUT = SrcParamData%iJUT + if (allocated(SrcParamData%iJL)) then + LB(1:1) = lbound(SrcParamData%iJL, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iJL, kind=B8Ki) + if (.not. allocated(DstParamData%iJL)) then + allocate(DstParamData%iJL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iJL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iJL = SrcParamData%iJL + end if + if (allocated(SrcParamData%ixqd)) then + LB(1:2) = lbound(SrcParamData%ixqd, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%ixqd, kind=B8Ki) + if (.not. allocated(DstParamData%ixqd)) then + allocate(DstParamData%ixqd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ixqd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ixqd = SrcParamData%ixqd + end if + if (allocated(SrcParamData%iModInit)) then + LB(1:1) = lbound(SrcParamData%iModInit, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iModInit, kind=B8Ki) + if (.not. allocated(DstParamData%iModInit)) then + allocate(DstParamData%iModInit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iModInit = SrcParamData%iModInit + end if + if (allocated(SrcParamData%iModTC)) then + LB(1:1) = lbound(SrcParamData%iModTC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iModTC, kind=B8Ki) + if (.not. allocated(DstParamData%iModTC)) then + allocate(DstParamData%iModTC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModTC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iModTC = SrcParamData%iModTC + end if + if (allocated(SrcParamData%iModBD)) then + LB(1:1) = lbound(SrcParamData%iModBD, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iModBD, kind=B8Ki) + if (.not. allocated(DstParamData%iModBD)) then + allocate(DstParamData%iModBD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModBD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iModBD = SrcParamData%iModBD + end if + if (allocated(SrcParamData%iModOpt1)) then + LB(1:1) = lbound(SrcParamData%iModOpt1, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iModOpt1, kind=B8Ki) + if (.not. allocated(DstParamData%iModOpt1)) then + allocate(DstParamData%iModOpt1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModOpt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iModOpt1 = SrcParamData%iModOpt1 + end if + if (allocated(SrcParamData%iModOpt1US)) then + LB(1:1) = lbound(SrcParamData%iModOpt1US, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iModOpt1US, kind=B8Ki) + if (.not. allocated(DstParamData%iModOpt1US)) then + allocate(DstParamData%iModOpt1US(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModOpt1US.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iModOpt1US = SrcParamData%iModOpt1US + end if + if (allocated(SrcParamData%iModOpt2)) then + LB(1:1) = lbound(SrcParamData%iModOpt2, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iModOpt2, kind=B8Ki) + if (.not. allocated(DstParamData%iModOpt2)) then + allocate(DstParamData%iModOpt2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModOpt2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iModOpt2 = SrcParamData%iModOpt2 + end if + if (allocated(SrcParamData%iModPost)) then + LB(1:1) = lbound(SrcParamData%iModPost, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iModPost, kind=B8Ki) + if (.not. allocated(DstParamData%iModPost)) then + allocate(DstParamData%iModPost(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModPost.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iModPost = SrcParamData%iModPost + end if +end subroutine + +subroutine Glue_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%iMod)) then + deallocate(ParamData%iMod) + end if + call Glue_DestroyVarsIdxType(ParamData%IdxLin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%iJL)) then + deallocate(ParamData%iJL) + end if + if (allocated(ParamData%ixqd)) then + deallocate(ParamData%ixqd) + end if + if (allocated(ParamData%iModInit)) then + deallocate(ParamData%iModInit) + end if + if (allocated(ParamData%iModTC)) then + deallocate(ParamData%iModTC) + end if + if (allocated(ParamData%iModBD)) then + deallocate(ParamData%iModBD) + end if + if (allocated(ParamData%iModOpt1)) then + deallocate(ParamData%iModOpt1) + end if + if (allocated(ParamData%iModOpt1US)) then + deallocate(ParamData%iModOpt1US) + end if + if (allocated(ParamData%iModOpt2)) then + deallocate(ParamData%iModOpt2) + end if + if (allocated(ParamData%iModPost)) then + deallocate(ParamData%iModPost) + end if +end subroutine + +subroutine Glue_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%iMod) + call Glue_PackVarsIdxType(RF, InData%IdxLin) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%ConvTol) + call RegPack(RF, InData%NumCrctn) + call RegPack(RF, InData%MaxConvIter) + call RegPack(RF, InData%NIter_UJac) + call RegPack(RF, InData%NStep_UJac) + call RegPack(RF, InData%Scale_UJac) + call RegPack(RF, InData%AccBlend) + call RegPack(RF, InData%RhoInf) + call RegPack(RF, InData%AlphaM) + call RegPack(RF, InData%AlphaF) + call RegPack(RF, InData%Beta) + call RegPack(RF, InData%Gamma) + call RegPack(RF, InData%C) + call RegPack(RF, InData%iX1) + call RegPack(RF, InData%iX2) + call RegPack(RF, InData%iUT) + call RegPack(RF, InData%iU1) + call RegPack(RF, InData%iyT) + call RegPack(RF, InData%iy1) + call RegPack(RF, InData%iJX) + call RegPack(RF, InData%iJU) + call RegPack(RF, InData%iJUT) + call RegPackAlloc(RF, InData%iJL) + call RegPackAlloc(RF, InData%ixqd) + call RegPackAlloc(RF, InData%iModInit) + call RegPackAlloc(RF, InData%iModTC) + call RegPackAlloc(RF, InData%iModBD) + call RegPackAlloc(RF, InData%iModOpt1) + call RegPackAlloc(RF, InData%iModOpt1US) + call RegPackAlloc(RF, InData%iModOpt2) + call RegPackAlloc(RF, InData%iModPost) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackParam' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return + call Glue_UnpackVarsIdxType(RF, OutData%IdxLin) ! IdxLin + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NIter_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStep_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Scale_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AccBlend); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AlphaM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AlphaF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gamma); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iX1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iX2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iU1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iyT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iy1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJUT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iJL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ixqd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModTC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModBD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModOpt1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModOpt1US); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModOpt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModPost); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, ErrMsg) + type(Glue_LinSave), intent(in) :: SrcLinSaveData + type(Glue_LinSave), intent(inout) :: DstLinSaveData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyLinSave' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLinSaveData%x)) then + LB(1:2) = lbound(SrcLinSaveData%x, kind=B8Ki) + UB(1:2) = ubound(SrcLinSaveData%x, kind=B8Ki) + if (.not. allocated(DstLinSaveData%x)) then + allocate(DstLinSaveData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%x = SrcLinSaveData%x + end if + if (allocated(SrcLinSaveData%xd)) then + LB(1:2) = lbound(SrcLinSaveData%xd, kind=B8Ki) + UB(1:2) = ubound(SrcLinSaveData%xd, kind=B8Ki) + if (.not. allocated(DstLinSaveData%xd)) then + allocate(DstLinSaveData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%xd = SrcLinSaveData%xd + end if + if (allocated(SrcLinSaveData%z)) then + LB(1:2) = lbound(SrcLinSaveData%z, kind=B8Ki) + UB(1:2) = ubound(SrcLinSaveData%z, kind=B8Ki) + if (.not. allocated(DstLinSaveData%z)) then + allocate(DstLinSaveData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%z = SrcLinSaveData%z + end if + if (allocated(SrcLinSaveData%OtherSt)) then + LB(1:2) = lbound(SrcLinSaveData%OtherSt, kind=B8Ki) + UB(1:2) = ubound(SrcLinSaveData%OtherSt, kind=B8Ki) + if (.not. allocated(DstLinSaveData%OtherSt)) then + allocate(DstLinSaveData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%OtherSt = SrcLinSaveData%OtherSt + end if + if (allocated(SrcLinSaveData%u)) then + LB(1:2) = lbound(SrcLinSaveData%u, kind=B8Ki) + UB(1:2) = ubound(SrcLinSaveData%u, kind=B8Ki) + if (.not. allocated(DstLinSaveData%u)) then + allocate(DstLinSaveData%u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%u = SrcLinSaveData%u + end if +end subroutine + +subroutine Glue_DestroyLinSave(LinSaveData, ErrStat, ErrMsg) + type(Glue_LinSave), intent(inout) :: LinSaveData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyLinSave' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LinSaveData%x)) then + deallocate(LinSaveData%x) + end if + if (allocated(LinSaveData%xd)) then + deallocate(LinSaveData%xd) + end if + if (allocated(LinSaveData%z)) then + deallocate(LinSaveData%z) + end if + if (allocated(LinSaveData%OtherSt)) then + deallocate(LinSaveData%OtherSt) + end if + if (allocated(LinSaveData%u)) then + deallocate(LinSaveData%u) + end if +end subroutine + +subroutine Glue_PackLinSave(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_LinSave), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackLinSave' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%xd) + call RegPackAlloc(RF, InData%z) + call RegPackAlloc(RF, InData%OtherSt) + call RegPackAlloc(RF, InData%u) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackLinSave(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_LinSave), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackLinSave' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OtherSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(Glue_OutputFileType), intent(in) :: SrcOutputFileTypeData + type(Glue_OutputFileType), intent(inout) :: DstOutputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyOutputFileType' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_CopyModDataType(SrcOutputFileTypeData%ModGlue, DstOutputFileTypeData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyLinSave(SrcOutputFileTypeData%OP, DstOutputFileTypeData%OP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Glue_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) + type(Glue_OutputFileType), intent(inout) :: OutputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyOutputFileType' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyModDataType(OutputFileTypeData%ModGlue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyLinSave(OutputFileTypeData%OP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Glue_PackOutputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_OutputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackOutputFileType' + if (RF%ErrStat >= AbortErrLev) return + call Glue_PackModDataType(RF, InData%ModGlue) + call Glue_PackLinSave(RF, InData%OP) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackOutputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_OutputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackOutputFileType' + if (RF%ErrStat /= ErrID_None) return + call Glue_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue + call Glue_UnpackLinSave(RF, OutData%OP) ! OP +end subroutine + +subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: SrcMiscData + type(Glue_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%ModData)) then + LB(1:1) = lbound(SrcMiscData%ModData, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%ModData, kind=B8Ki) + if (.not. allocated(DstMiscData%ModData)) then + allocate(DstMiscData%ModData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ModData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyModDataType(SrcMiscData%ModData(i1), DstMiscData%ModData(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%Mappings)) then + LB(1:1) = lbound(SrcMiscData%Mappings, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Mappings, kind=B8Ki) + if (.not. allocated(DstMiscData%Mappings)) then + allocate(DstMiscData%Mappings(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Mappings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyMappingType(SrcMiscData%Mappings(i1), DstMiscData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%q)) then + LB(1:2) = lbound(SrcMiscData%q, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%q, kind=B8Ki) + if (.not. allocated(DstMiscData%q)) then + allocate(DstMiscData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%q = SrcMiscData%q + end if + if (allocated(SrcMiscData%qn)) then + LB(1:2) = lbound(SrcMiscData%qn, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%qn, kind=B8Ki) + if (.not. allocated(DstMiscData%qn)) then + allocate(DstMiscData%qn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%qn = SrcMiscData%qn + end if + if (allocated(SrcMiscData%x)) then + LB(1:1) = lbound(SrcMiscData%x, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%x, kind=B8Ki) + if (.not. allocated(DstMiscData%x)) then + allocate(DstMiscData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%x = SrcMiscData%x + end if + if (allocated(SrcMiscData%xn)) then + LB(1:1) = lbound(SrcMiscData%xn, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%xn, kind=B8Ki) + if (.not. allocated(DstMiscData%xn)) then + allocate(DstMiscData%xn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xn = SrcMiscData%xn + end if + if (allocated(SrcMiscData%dxdt)) then + LB(1:1) = lbound(SrcMiscData%dxdt, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%dxdt, kind=B8Ki) + if (.not. allocated(DstMiscData%dxdt)) then + allocate(DstMiscData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dxdt = SrcMiscData%dxdt + end if + if (allocated(SrcMiscData%u)) then + LB(1:1) = lbound(SrcMiscData%u, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%u, kind=B8Ki) + if (.not. allocated(DstMiscData%u)) then + allocate(DstMiscData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%u = SrcMiscData%u + end if + if (allocated(SrcMiscData%un)) then + LB(1:1) = lbound(SrcMiscData%un, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%un, kind=B8Ki) + if (.not. allocated(DstMiscData%un)) then + allocate(DstMiscData%un(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%un.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%un = SrcMiscData%un + end if + if (allocated(SrcMiscData%u_tmp)) then + LB(1:1) = lbound(SrcMiscData%u_tmp, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%u_tmp, kind=B8Ki) + if (.not. allocated(DstMiscData%u_tmp)) then + allocate(DstMiscData%u_tmp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_tmp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%u_tmp = SrcMiscData%u_tmp + end if + if (allocated(SrcMiscData%y)) then + LB(1:1) = lbound(SrcMiscData%y, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y, kind=B8Ki) + if (.not. allocated(DstMiscData%y)) then + allocate(DstMiscData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%y = SrcMiscData%y + end if + if (allocated(SrcMiscData%dYdx)) then + LB(1:2) = lbound(SrcMiscData%dYdx, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dYdx, kind=B8Ki) + if (.not. allocated(DstMiscData%dYdx)) then + allocate(DstMiscData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dYdx = SrcMiscData%dYdx + end if + if (allocated(SrcMiscData%dYdu)) then + LB(1:2) = lbound(SrcMiscData%dYdu, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dYdu, kind=B8Ki) + if (.not. allocated(DstMiscData%dYdu)) then + allocate(DstMiscData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dYdu = SrcMiscData%dYdu + end if + if (allocated(SrcMiscData%dXdx)) then + LB(1:2) = lbound(SrcMiscData%dXdx, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dXdx, kind=B8Ki) + if (.not. allocated(DstMiscData%dXdx)) then + allocate(DstMiscData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dXdx = SrcMiscData%dXdx + end if + if (allocated(SrcMiscData%dXdu)) then + LB(1:2) = lbound(SrcMiscData%dXdu, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dXdu, kind=B8Ki) + if (.not. allocated(DstMiscData%dXdu)) then + allocate(DstMiscData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dXdu = SrcMiscData%dXdu + end if + if (allocated(SrcMiscData%dUdu)) then + LB(1:2) = lbound(SrcMiscData%dUdu, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dUdu, kind=B8Ki) + if (.not. allocated(DstMiscData%dUdu)) then + allocate(DstMiscData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dUdu = SrcMiscData%dUdu + end if + if (allocated(SrcMiscData%dUdy)) then + LB(1:2) = lbound(SrcMiscData%dUdy, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dUdy, kind=B8Ki) + if (.not. allocated(DstMiscData%dUdy)) then + allocate(DstMiscData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dUdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dUdy = SrcMiscData%dUdy + end if + if (allocated(SrcMiscData%dUdyHat)) then + LB(1:2) = lbound(SrcMiscData%dUdyHat, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dUdyHat, kind=B8Ki) + if (.not. allocated(DstMiscData%dUdyHat)) then + allocate(DstMiscData%dUdyHat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dUdyHat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dUdyHat = SrcMiscData%dUdyHat + end if + if (allocated(SrcMiscData%XB)) then + LB(1:2) = lbound(SrcMiscData%XB, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%XB, kind=B8Ki) + if (.not. allocated(DstMiscData%XB)) then + allocate(DstMiscData%XB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%XB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%XB = SrcMiscData%XB + end if + if (allocated(SrcMiscData%G)) then + LB(1:2) = lbound(SrcMiscData%G, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%G, kind=B8Ki) + if (.not. allocated(DstMiscData%G)) then + allocate(DstMiscData%G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%G.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%G = SrcMiscData%G + end if + if (allocated(SrcMiscData%Jac)) then + LB(1:2) = lbound(SrcMiscData%Jac, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%Jac, kind=B8Ki) + if (.not. allocated(DstMiscData%Jac)) then + allocate(DstMiscData%Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Jac = SrcMiscData%Jac + end if + if (allocated(SrcMiscData%IPIV)) then + LB(1:1) = lbound(SrcMiscData%IPIV, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%IPIV, kind=B8Ki) + if (.not. allocated(DstMiscData%IPIV)) then + allocate(DstMiscData%IPIV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%IPIV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%IPIV = SrcMiscData%IPIV + end if + DstMiscData%IterTotal = SrcMiscData%IterTotal + DstMiscData%IterUntilUJac = SrcMiscData%IterUntilUJac + DstMiscData%StepsUntilUJac = SrcMiscData%StepsUntilUJac + if (allocated(SrcMiscData%dq)) then + LB(1:2) = lbound(SrcMiscData%dq, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dq, kind=B8Ki) + if (.not. allocated(DstMiscData%dq)) then + allocate(DstMiscData%dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dq = SrcMiscData%dq + end if + if (allocated(SrcMiscData%dx)) then + LB(1:1) = lbound(SrcMiscData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%dx, kind=B8Ki) + if (.not. allocated(DstMiscData%dx)) then + allocate(DstMiscData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dx = SrcMiscData%dx + end if + if (allocated(SrcMiscData%du)) then + LB(1:1) = lbound(SrcMiscData%du, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%du, kind=B8Ki) + if (.not. allocated(DstMiscData%du)) then + allocate(DstMiscData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%du = SrcMiscData%du + end if + if (allocated(SrcMiscData%UDiff)) then + LB(1:1) = lbound(SrcMiscData%UDiff, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UDiff, kind=B8Ki) + if (.not. allocated(DstMiscData%UDiff)) then + allocate(DstMiscData%UDiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UDiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UDiff = SrcMiscData%UDiff + end if + DstMiscData%ConvWarn = SrcMiscData%ConvWarn +end subroutine + +subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%ModData)) then + LB(1:1) = lbound(MiscData%ModData, kind=B8Ki) + UB(1:1) = ubound(MiscData%ModData, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyModDataType(MiscData%ModData(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ModData) + end if + if (allocated(MiscData%Mappings)) then + LB(1:1) = lbound(MiscData%Mappings, kind=B8Ki) + UB(1:1) = ubound(MiscData%Mappings, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyMappingType(MiscData%Mappings(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Mappings) + end if + if (allocated(MiscData%q)) then + deallocate(MiscData%q) + end if + if (allocated(MiscData%qn)) then + deallocate(MiscData%qn) + end if + if (allocated(MiscData%x)) then + deallocate(MiscData%x) + end if + if (allocated(MiscData%xn)) then + deallocate(MiscData%xn) + end if + if (allocated(MiscData%dxdt)) then + deallocate(MiscData%dxdt) + end if + if (allocated(MiscData%u)) then + deallocate(MiscData%u) + end if + if (allocated(MiscData%un)) then + deallocate(MiscData%un) + end if + if (allocated(MiscData%u_tmp)) then + deallocate(MiscData%u_tmp) + end if + if (allocated(MiscData%y)) then + deallocate(MiscData%y) + end if + if (allocated(MiscData%dYdx)) then + deallocate(MiscData%dYdx) + end if + if (allocated(MiscData%dYdu)) then + deallocate(MiscData%dYdu) + end if + if (allocated(MiscData%dXdx)) then + deallocate(MiscData%dXdx) + end if + if (allocated(MiscData%dXdu)) then + deallocate(MiscData%dXdu) + end if + if (allocated(MiscData%dUdu)) then + deallocate(MiscData%dUdu) + end if + if (allocated(MiscData%dUdy)) then + deallocate(MiscData%dUdy) + end if + if (allocated(MiscData%dUdyHat)) then + deallocate(MiscData%dUdyHat) + end if + if (allocated(MiscData%XB)) then + deallocate(MiscData%XB) + end if + if (allocated(MiscData%G)) then + deallocate(MiscData%G) + end if + if (allocated(MiscData%Jac)) then + deallocate(MiscData%Jac) + end if + if (allocated(MiscData%IPIV)) then + deallocate(MiscData%IPIV) + end if + if (allocated(MiscData%dq)) then + deallocate(MiscData%dq) + end if + if (allocated(MiscData%dx)) then + deallocate(MiscData%dx) + end if + if (allocated(MiscData%du)) then + deallocate(MiscData%du) + end if + if (allocated(MiscData%UDiff)) then + deallocate(MiscData%UDiff) + end if +end subroutine + +subroutine Glue_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%ModData)) + if (allocated(InData%ModData)) then + call RegPackBounds(RF, 1, lbound(InData%ModData, kind=B8Ki), ubound(InData%ModData, kind=B8Ki)) + LB(1:1) = lbound(InData%ModData, kind=B8Ki) + UB(1:1) = ubound(InData%ModData, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackModDataType(RF, InData%ModData(i1)) + end do + end if + call RegPack(RF, allocated(InData%Mappings)) + if (allocated(InData%Mappings)) then + call RegPackBounds(RF, 1, lbound(InData%Mappings, kind=B8Ki), ubound(InData%Mappings, kind=B8Ki)) + LB(1:1) = lbound(InData%Mappings, kind=B8Ki) + UB(1:1) = ubound(InData%Mappings, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackMappingType(RF, InData%Mappings(i1)) + end do + end if + call RegPackAlloc(RF, InData%q) + call RegPackAlloc(RF, InData%qn) + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%xn) + call RegPackAlloc(RF, InData%dxdt) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%un) + call RegPackAlloc(RF, InData%u_tmp) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%dYdx) + call RegPackAlloc(RF, InData%dYdu) + call RegPackAlloc(RF, InData%dXdx) + call RegPackAlloc(RF, InData%dXdu) + call RegPackAlloc(RF, InData%dUdu) + call RegPackAlloc(RF, InData%dUdy) + call RegPackAlloc(RF, InData%dUdyHat) + call RegPackAlloc(RF, InData%XB) + call RegPackAlloc(RF, InData%G) + call RegPackAlloc(RF, InData%Jac) + call RegPackAlloc(RF, InData%IPIV) + call RegPack(RF, InData%IterTotal) + call RegPack(RF, InData%IterUntilUJac) + call RegPack(RF, InData%StepsUntilUJac) + call RegPackAlloc(RF, InData%dq) + call RegPackAlloc(RF, InData%dx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%UDiff) + call RegPack(RF, InData%ConvWarn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackMisc' + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%ModData)) deallocate(OutData%ModData) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ModData(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModData.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackModDataType(RF, OutData%ModData(i1)) ! ModData + end do + end if + if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Mappings(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mappings.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackMappingType(RF, OutData%Mappings(i1)) ! Mappings + end do + end if + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dxdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%un); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_tmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdyHat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%XB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%G); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IPIV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IterTotal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IterUntilUJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StepsUntilUJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UDiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE Glue_Types +!ENDOFREGISTRYGENERATEDFILE From a0c46c776a20f8b82abf607b5f440c857aa7f360 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 31 May 2024 17:45:10 +0000 Subject: [PATCH 139/319] Add ModGlue_CalcSteady --- glue-codes/openfast/src/FAST_Prog.f90 | 6 +- modules/nwtc-library/src/ModVar.f90 | 91 +- modules/openfast-library/src/FAST_AeroMap.f90 | 2 +- modules/openfast-library/src/FAST_Funcs.f90 | 601 ++- modules/openfast-library/src/FAST_Library.f90 | 2 +- modules/openfast-library/src/FAST_ModGlue.f90 | 586 ++- modules/openfast-library/src/FAST_Mods.f90 | 4 + .../openfast-library/src/FAST_Registry.txt | 126 +- modules/openfast-library/src/FAST_Subs.f90 | 1822 +++---- modules/openfast-library/src/FAST_Types.f90 | 4334 ++++++++++------- .../openfast-library/src/Glue_Registry.txt | 38 +- modules/openfast-library/src/Glue_Types.f90 | 484 +- 12 files changed, 4961 insertions(+), 3135 deletions(-) diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index 4c9e6b2cb0..ca53a9e917 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -131,7 +131,7 @@ PROGRAM FAST ! write checkpoint file if requested - IF (mod(n_t_global, Turbine(1)%p_FAST%n_ChkptTime) == 0 .AND. Restart_step /= n_t_global .and. .not. Turbine(1)%m_FAST%Lin%FoundSteady) then + IF (mod(n_t_global, Turbine(1)%p_FAST%n_ChkptTime) == 0 .AND. Restart_step /= n_t_global .and. .not. Turbine(1)%m_Glue%CS%FoundSteady) then CheckpointRoot = TRIM(Turbine(1)%p_FAST%OutFileRoot)//'.'//TRIM(Num2LStr(n_t_global)) CALL FAST_CreateCheckpoint_Tary(t_initial, n_t_global, Turbine, CheckpointRoot, ErrStat, ErrMsg) @@ -155,13 +155,13 @@ PROGRAM FAST CALL FAST_Linearize_T(t_initial, n_t_global+1, Turbine(i_turb), ErrStat, ErrMsg) CALL CheckError( ErrStat, ErrMsg ) - IF ( Turbine(i_turb)%m_FAST%Lin%FoundSteady) EXIT TIME_STEP_LOOP + IF ( Turbine(i_turb)%m_Glue%CS%FoundSteady) EXIT TIME_STEP_LOOP END DO END DO TIME_STEP_LOOP ! n_t_global DO i_turb = 1,NumTurbines - if ( Turbine(i_turb)%p_FAST%CalcSteady .and. .not. Turbine(i_turb)%m_FAST%Lin%FoundSteady) then + if ( Turbine(i_turb)%p_FAST%CalcSteady .and. .not. Turbine(i_turb)%m_Glue%CS%FoundSteady) then CALL CheckError( ErrID_Fatal, "Unable to find steady-state solution." ) end if END DO diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index fb76ea4517..f4eafbb90a 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -35,7 +35,7 @@ module ModVar public :: MV_AddVar, MV_AddMeshVar public :: MV_HasFlags, MV_SetFlags, MV_UnsetFlags, MV_NumVars public :: LoadFields, MotionFields, TransFields, AngularFields -public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv +public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv, quat_scalar, quat_canonical public :: MV_FieldString, IdxStr public :: DumpMatrix @@ -878,20 +878,35 @@ function perturb_quat(theta, idir) result(q) end if end function +pure function quat_scalar(q) result(w) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: im, w + ! Calculate magnitude of imaginary part of quaternion + im = dot_product(q, q) + if (im < 1.0_R8Ki) then + w = sqrt(1.0_R8Ki - im) + else if (im > 1.0_R8Ki) then + w = 0.0_R8Ki + else + w = 0.0_R8Ki + end if +end function + pure function quat_canonical(q0, q) result(qc) real(R8Ki), intent(in) :: q0, q(3) - real(R8Ki) :: qc(3) + real(R8Ki) :: qc(3), m integer(IntKi) :: i - qc = q + m = q0*q0 + dot_product(q, q) + qc = q / m if (q0 > 0.0_R8Ki) return if (q0 < 0.0_R8Ki) then - qc = -q + qc = -qc return end if do i = 1, 3 if (q(i) > 0.0_R8Ki) return if (q(i) < 0.0_R8Ki) then - qc = -q + qc = -qc return end if end do @@ -905,30 +920,30 @@ function dcm_to_quat(dcm) result(q) ! Trace of matrix t = dcm(1, 1) + dcm(2, 2) + dcm(3, 3) - if (t > 0.0) then - s = 0.5/sqrt(t + 1.0) - qw = 0.25/s - q(1) = (dcm(3, 2) - dcm(2, 3))*s - q(2) = (dcm(1, 3) - dcm(3, 1))*s - q(3) = (dcm(2, 1) - dcm(1, 2))*s - else if (dcm(1, 1) > dcm(2, 2) .and. dcm(1, 1) > dcm(3, 3)) then - s = 2.0*sqrt(1.0 + dcm(1, 1) - dcm(2, 2) - dcm(3, 3)) - qw = (dcm(3, 2) - dcm(2, 3))/s - q(1) = 0.25*s - q(2) = (dcm(1, 2) + dcm(2, 1))/s - q(3) = (dcm(1, 3) + dcm(3, 1))/s - else if (dcm(2, 2) > dcm(3, 3)) then - s = 2.0*sqrt(1.0 + dcm(2, 2) - dcm(1, 1) - dcm(3, 3)) - qw = (dcm(1, 3) - dcm(3, 1))/s - q(1) = (dcm(1, 2) + dcm(2, 1))/s - q(2) = 0.25*s - q(3) = (dcm(2, 3) + dcm(3, 2))/s + if (t > 0.0_R8Ki) then + S = sqrt(t + 1.0_R8Ki)*2.0_R8Ki ! S=4*qw + qw = 0.25_R8Ki*S + q(1) = (dcm(3, 2) - dcm(2, 3))/S + q(2) = (dcm(1, 3) - dcm(3, 1))/S + q(3) = (dcm(2, 1) - dcm(1, 2))/S + elseif ((dcm(1, 1) > dcm(2, 2)) .and. (dcm(1, 1) > dcm(3, 3))) then + S = sqrt(1.0_R8Ki + dcm(1, 1) - dcm(2, 2) - dcm(3, 3))*2.0_R8Ki ! S=4*qx + qw = (dcm(3, 2) - dcm(2, 3))/S + q(1) = 0.25_R8Ki*S + q(2) = (dcm(1, 2) + dcm(2, 1))/S + q(3) = (dcm(1, 3) + dcm(3, 1))/S + elseif (dcm(2, 2) > dcm(3, 3)) then + S = sqrt(1.0_R8Ki + dcm(2, 2) - dcm(1, 1) - dcm(3, 3))*2.0_R8Ki ! S=4*qy + qw = (dcm(1, 3) - dcm(3, 1))/S + q(1) = (dcm(1, 2) + dcm(2, 1))/S + q(2) = 0.25_R8Ki*S + q(3) = (dcm(2, 3) + dcm(3, 2))/S else - s = 2.0*sqrt(1.0 + dcm(3, 3) - dcm(1, 1) - dcm(2, 2)) - qw = (dcm(2, 1) - dcm(1, 2))/s - q(1) = (dcm(1, 3) + dcm(3, 1))/s - q(2) = (dcm(2, 3) + dcm(3, 2))/s - q(3) = 0.25*s + S = sqrt(1.0_R8Ki + dcm(3, 3) - dcm(1, 1) - dcm(2, 2))*2.0_R8Ki ! S=4*qz + qw = (dcm(2, 1) - dcm(1, 2))/S + q(1) = (dcm(1, 3) + dcm(3, 1))/S + q(2) = (dcm(2, 3) + dcm(3, 2))/S + q(3) = 0.25_R8Ki*S end if q = quat_canonical(qw, q) @@ -954,10 +969,10 @@ function dcm_to_quat2(dcm) result(q) Qyz = dcm(2, 3) Qzz = dcm(3, 3) - A(:,1) = [Qxx - Qyy - Qzz, Qyx + Qxy, Qzx + Qxz, Qzy - Qyz]/ 3.0_R8Ki - A(:,2) = [Qyx + Qxy, Qyy - Qxx - Qzz, Qzy + Qyz, Qxz - Qzx]/ 3.0_R8Ki - A(:,3) = [Qzx + Qxz, Qzy + Qyz, Qzz - Qxx - Qyy, Qyx - Qxy]/ 3.0_R8Ki - A(:,4) = [Qzy - Qyz, Qxz - Qzx, Qyx - Qxy, Qxx + Qyy + Qzz]/ 3.0_R8Ki + A(:, 1) = [Qxx - Qyy - Qzz, Qyx + Qxy, Qzx + Qxz, Qzy - Qyz]/3.0_R8Ki + A(:, 2) = [Qyx + Qxy, Qyy - Qxx - Qzz, Qzy + Qyz, Qxz - Qzx]/3.0_R8Ki + A(:, 3) = [Qzx + Qxz, Qzy + Qyz, Qzz - Qxx - Qyy, Qyx - Qxy]/3.0_R8Ki + A(:, 4) = [Qzy - Qyz, Qxz - Qzx, Qyx - Qxy, Qxx + Qyy + Qzz]/3.0_R8Ki lwork = 4*n @@ -968,12 +983,12 @@ function dcm_to_quat2(dcm) result(q) q = 0.0_R8Ki return end if - + ! Get index of maximum real eigenvalue i = maxloc(wr, dim=1) ! Canonical form of quaternion - q = quat_canonical(vr(4,i), vr(1:3,i)) + q = quat_canonical(vr(4, i), vr(1:3, i)) end function ! quat_to_dcm returns a dcm based on the quaternion where q is a unit quaternion with a positive scalar component @@ -985,7 +1000,7 @@ pure function quat_to_dcm(q) result(dcm) real(R8Ki) :: xy, yz, xz, wx, wy, wz ! Calculate scalar component - w = sqrt(1.0_R8Ki - dot_product(q, q)) + w = quat_scalar(q) ww = w*w xx = q(1)*q(1) @@ -1026,9 +1041,9 @@ pure function quat_compose(q1, q2) result(q) real(R8Ki) :: q(3), q0 real(R8Ki) :: w1, x1, y1, z1 real(R8Ki) :: w2, x2, y2, z2 - w1 = sqrt(1.0_R8Ki - dot_product(q1, q1)) + w1 = quat_scalar(q1) x1 = q1(1); y1 = q1(2); z1 = q1(3) - w2 = sqrt(1.0_R8Ki - dot_product(q2, q2)) + w2 = quat_scalar(q2) x2 = q2(1); y2 = q2(2); z2 = q2(3) q0 = w1*w2 - x1*x2 - y1*y2 - z1*z2 q(1) = w1*x2 + x1*w2 + y1*z2 - z1*y2 @@ -1083,7 +1098,7 @@ pure function quat_to_wm(q) result(c) real(R8Ki), intent(in) :: q(3) real(R8Ki) :: c(3) real(R8Ki) :: q0 - q0 = sqrt(1.0_R8Ki - dot_product(q, q)) + q0 = quat_scalar(q) c = 4.0_R8Ki*q/(1.0_R8Ki + q0) end function diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 101e4a6b25..1934b64ed5 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -122,7 +122,7 @@ subroutine FAST_AeroMapDriver(Turbine, ErrStat, ErrMsg) ErrStat2, ErrMsg2); if (Failed()) return ! Copy inputs to second index - call FAST_CopyInputs(Turbine%y_FAST%Modules(iModOrder(i)), Turbine, 0.0_DbKi, iSrc=1, iDst=2, CtrlCode=MESH_NEWCOPY, & + call FAST_CopyInput(Turbine%y_FAST%Modules(iModOrder(i)), Turbine, 0.0_DbKi, iSrc=1, iDst=2, CtrlCode=MESH_NEWCOPY, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return end do diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 4f84421360..f59833d286 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -590,8 +590,8 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt case (Module_SeaSt) call SeaSt_GetOP(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), T%SeaSt%z(ThisState), & - T%SeaSt%OtherSt(ThisState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + T%SeaSt%OtherSt(ThisState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case (Module_SrvD) call SrvD_GetOP(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), T%SrvD%z(ThisState), & @@ -673,8 +673,8 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, case (Module_SeaSt) call SeaSt_JacobianPInput(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), & - T%SeaSt%z(ThisState), T%SeaSt%OtherSt(ThisState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - dYdu=dYdu, dXdu=dXdu) + T%SeaSt%z(ThisState), T%SeaSt%OtherSt(ThisState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) case (Module_SrvD) call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & @@ -769,10 +769,10 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err case (Module_SeaSt) call SeaSt_JacobianPContState(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, & - T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), & - T%SeaSt%z(ThisState), T%SeaSt%OtherSt(ThisState), & - T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - dYdx=dYdx, dXdx=dXdx) + T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), & + T%SeaSt%z(ThisState), T%SeaSt%OtherSt(ThisState), & + T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) case (Module_SrvD) call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(1), T%SrvD%p, & @@ -844,8 +844,34 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) call ED_CopyConstrState(T%ED%z(Src), T%ED%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return call ED_CopyOtherState(T%ED%OtherSt(Src), T%ED%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return -! case (Module_ExtPtfm) -! case (Module_FEAM) + case (Module_ExtInfw) + + ! call ExtInfw_CopyContState(T%ExtInfw%x(Src), T%ExtInfw%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call ExtInfw_CopyDiscState(T%ExtInfw%xd(Src), T%ExtInfw%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call ExtInfw_CopyConstrState(T%ExtInfw%z(Src), T%ExtInfw%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call ExtInfw_CopyOtherState(T%ExtInfw%OtherSt(Src), T%ExtInfw%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ExtLd) + + call ExtLd_CopyContState(T%ExtLd%x(Src), T%ExtLd%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyDiscState(T%ExtLd%xd(Src), T%ExtLd%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyConstrState(T%ExtLd%z(Src), T%ExtLd%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyOtherState(T%ExtLd%OtherSt(Src), T%ExtLd%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ExtPtfm) + + call ExtPtfm_CopyContState(T%ExtPtfm%x(Src), T%ExtPtfm%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyDiscState(T%ExtPtfm%xd(Src), T%ExtPtfm%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyConstrState(T%ExtPtfm%z(Src), T%ExtPtfm%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyOtherState(T%ExtPtfm%OtherSt(Src), T%ExtPtfm%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_FEAM) + + call FEAM_CopyContState(T%FEAM%x(Src), T%FEAM%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyDiscState(T%FEAM%xd(Src), T%FEAM%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyConstrState(T%FEAM%z(Src), T%FEAM%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyOtherState(T%FEAM%OtherSt(Src), T%FEAM%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case (Module_HD) call HydroDyn_CopyContState(T%HD%x(Src), T%HD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return @@ -853,8 +879,20 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) ! call HydroDyn_CopyConstrState(T%HD%z(Src), T%HD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return ! call HydroDyn_CopyOtherState(T%HD%OtherSt(Src), T%HD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return -! case (Module_IceD) -! case (Module_IceF) + case (Module_IceD) + + call IceD_CopyContState(T%IceD%x(Src, ModData%Ins), T%IceD%x(Dst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyDiscState(T%IceD%xd(Src, ModData%Ins), T%IceD%xd(Dst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyConstrState(T%IceD%z(Src, ModData%Ins), T%IceD%z(Dst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyOtherState(T%IceD%OtherSt(Src, ModData%Ins), T%IceD%OtherSt(Dst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_IceF) + + call IceFloe_CopyContState(T%IceF%x(Src), T%IceF%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyDiscState(T%IceF%xd(Src), T%IceF%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyConstrState(T%IceF%z(Src), T%IceF%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyOtherState(T%IceF%OtherSt(Src), T%IceF%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case (Module_IfW) ! call IfW_CopyContState(T%IfW%x(Src), T%IfW%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return @@ -862,10 +900,27 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) ! call IfW_CopyConstrState(T%IfW%z(Src), T%IfW%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return ! call IfW_CopyOtherState(T%IfW%OtherSt(Src), T%IfW%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return -! case (Module_MAP) -! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) + case (Module_MAP) + + call MAP_CopyContState(T%MAP%x(Src), T%MAP%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MAP_CopyDiscState(T%MAP%xd(Src), T%MAP%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MAP_CopyConstrState(T%MAP%z(Src), T%MAP%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call MAP_CopyOtherState(T%MAP%OtherSt(Src), T%MAP%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_MD) + + call MD_CopyContState(T%MD%x(Src), T%MD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyDiscState(T%MD%xd(Src), T%MD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyConstrState(T%MD%z(Src), T%MD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyOtherState(T%MD%OtherSt(Src), T%MD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_Orca) + + call Orca_CopyContState(T%Orca%x(Src), T%Orca%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyDiscState(T%Orca%xd(Src), T%Orca%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyConstrState(T%Orca%z(Src), T%Orca%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyOtherState(T%Orca%OtherSt(Src), T%Orca%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case (Module_SD) call SD_CopyContState(T%SD%x(Src), T%SD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return @@ -873,7 +928,13 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) call SD_CopyConstrState(T%SD%z(Src), T%SD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return call SD_CopyOtherState(T%SD%OtherSt(Src), T%SD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return -! case (Module_SeaSt) + case (Module_SeaSt) + + call SeaSt_CopyContState(T%SeaSt%x(Src), T%SeaSt%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyDiscState(T%SeaSt%xd(Src), T%SeaSt%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyConstrState(T%SeaSt%z(Src), T%SeaSt%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyOtherState(T%SeaSt%OtherSt(Src), T%SeaSt%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case (Module_SrvD) call SrvD_CopyContState(T%SrvD%x(Src), T%SrvD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return @@ -893,10 +954,9 @@ logical function Failed() end function end subroutine -subroutine FAST_CopyInputs(ModData, T, DstInputTime, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) +subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData !< Module data - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - real(DbKi), intent(in) :: DstInputTime !< Destination input time + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type integer(IntKi), intent(in) :: iSrc, iDst !< Input indices integer(IntKi), intent(in) :: CtrlCode !< Mesh copy code integer(IntKi), intent(out) :: ErrStat @@ -911,95 +971,466 @@ subroutine FAST_CopyInputs(ModData, T, DstInputTime, iSrc, iDst, CtrlCode, ErrSt ErrStat = ErrID_None ErrMsg = '' + ! If source and destination indices are the same, return error + if (iSrc == iDst) then + call SetErrStat(ErrID_Fatal, "invalid indices: iSrc == iDst", ErrStat, ErrMsg, RoutineName) + return + end if + ! Select based on module ID select case (ModData%ID) case (Module_AD) - if (iDst > 0) T%AD%InputTimes(iDst) = DstInputTime - if (iSrc > 0 .and. iDst > 0) then - call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - else if (iSrc > 0) then - call AD_CopyInput(T%AD%Input(iSrc), T%AD%u, CtrlCode, Errstat2, ErrMsg2) - else - call AD_CopyInput(T%AD%u, T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end if + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call AD_CopyInput(T%AD%Input_Saved(-iSrc), T%AD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call AD_CopyInput(T%AD%Input_Saved(-iSrc), T%AD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call AD_CopyInput(T%AD%Input_Saved(-iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call AD_CopyInput(T%AD%u, T%AD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call AD_CopyInput(T%AD%u, T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call AD_CopyInput(T%AD%Input(iSrc), T%AD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select case (Module_BD) - if (iDst > 0) T%BD%InputTimes(iDst, ModData%Ins) = DstInputTime - if (iSrc > 0 .and. iDst > 0) then - call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - else if (iSrc > 0) then - call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - else - call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - end if + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call BD_CopyInput(T%BD%Input_Saved(-iSrc, ModData%Ins), T%BD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (0) + call BD_CopyInput(T%BD%Input_Saved(-iSrc, ModData%Ins), T%BD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call BD_CopyInput(T%BD%Input_Saved(-iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (0) + call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + end select + end select case (Module_ED) - if (iDst > 0) T%ED%InputTimes(iDst) = DstInputTime - if (iSrc > 0 .and. iDst > 0) then - call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - else if (iSrc > 0) then - call ED_CopyInput(T%ED%Input(iSrc), T%ED%u, CtrlCode, Errstat2, ErrMsg2) - else - call ED_CopyInput(T%ED%u, T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end if + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call ED_CopyInput(T%ED%Input_Saved(-iSrc), T%ED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call ED_CopyInput(T%ED%Input_Saved(-iSrc), T%ED%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call ED_CopyInput(T%ED%Input_Saved(-iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call ED_CopyInput(T%ED%u, T%ED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call ED_CopyInput(T%ED%u, T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call ED_CopyInput(T%ED%Input(iSrc), T%ED%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select + + case (Module_ExtPtfm) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call ExtPtfm_CopyInput(T%ExtPtfm%Input_Saved(-iSrc), T%ExtPtfm%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call ExtPtfm_CopyInput(T%ExtPtfm%Input_Saved(-iSrc), T%ExtPtfm%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call ExtPtfm_CopyInput(T%ExtPtfm%Input_Saved(-iSrc), T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call ExtPtfm_CopyInput(T%ExtPtfm%u, T%ExtPtfm%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call ExtPtfm_CopyInput(T%ExtPtfm%u, T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select + + case (Module_FEAM) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call FEAM_CopyInput(T%FEAM%Input_Saved(-iSrc), T%FEAM%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call FEAM_CopyInput(T%FEAM%Input_Saved(-iSrc), T%FEAM%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call FEAM_CopyInput(T%FEAM%Input_Saved(-iSrc), T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call FEAM_CopyInput(T%FEAM%u, T%FEAM%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call FEAM_CopyInput(T%FEAM%u, T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select -! case (Module_ExtPtfm) -! case (Module_FEAM) case (Module_HD) - if (iDst > 0) T%HD%InputTimes(iDst) = DstInputTime - if (iSrc > 0 .and. iDst > 0) then - call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - else if (iSrc > 0) then - call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%u, CtrlCode, Errstat2, ErrMsg2) - else - call HydroDyn_CopyInput(T%HD%u, T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end if + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call HydroDyn_CopyInput(T%HD%Input_Saved(-iSrc), T%HD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call HydroDyn_CopyInput(T%HD%Input_Saved(-iSrc), T%HD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call HydroDyn_CopyInput(T%HD%Input_Saved(-iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call HydroDyn_CopyInput(T%HD%u, T%HD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call HydroDyn_CopyInput(T%HD%u, T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select -! case (Module_IceD) -! case (Module_IceF) + case (Module_IceD) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call IceD_CopyInput(T%IceD%Input_Saved(-iSrc, ModData%Ins), T%IceD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (0) + call IceD_CopyInput(T%IceD%Input_Saved(-iSrc, ModData%Ins), T%IceD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call IceD_CopyInput(T%IceD%Input_Saved(-iSrc, ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call IceD_CopyInput(T%IceD%u(ModData%Ins), T%IceD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call IceD_CopyInput(T%IceD%u(ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (0) + call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + end select + end select + + case (Module_IceF) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call IceFloe_CopyInput(T%IceF%Input_Saved(-iSrc), T%IceF%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call IceFloe_CopyInput(T%IceF%Input_Saved(-iSrc), T%IceF%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call IceFloe_CopyInput(T%IceF%Input_Saved(-iSrc), T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call IceFloe_CopyInput(T%IceF%u, T%IceF%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call IceFloe_CopyInput(T%IceF%u, T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select case (Module_IfW) - if (iDst > 0) T%IfW%InputTimes(iDst) = DstInputTime - if (iSrc > 0 .and. iDst > 0) then - call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - else if (iSrc > 0) then - call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%u, CtrlCode, Errstat2, ErrMsg2) - else - call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end if + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call InflowWind_CopyInput(T%IfW%Input_Saved(-iSrc), T%IfW%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call InflowWind_CopyInput(T%IfW%Input_Saved(-iSrc), T%IfW%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call InflowWind_CopyInput(T%IfW%Input_Saved(-iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call InflowWind_CopyInput(T%IfW%u, T%IfW%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select + + case (Module_MAP) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call MAP_CopyInput(T%MAP%Input_Saved(-iSrc), T%MAP%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call MAP_CopyInput(T%MAP%Input_Saved(-iSrc), T%MAP%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call MAP_CopyInput(T%MAP%Input_Saved(-iSrc), T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call MAP_CopyInput(T%MAP%u, T%MAP%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call MAP_CopyInput(T%MAP%u, T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select + + case (Module_MD) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call MD_CopyInput(T%MD%Input_Saved(-iSrc), T%MD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call MD_CopyInput(T%MD%Input_Saved(-iSrc), T%MD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call MD_CopyInput(T%MD%Input_Saved(-iSrc), T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call MD_CopyInput(T%MD%u, T%MD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call MD_CopyInput(T%MD%u, T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call MD_CopyInput(T%MD%Input(iSrc), T%MD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call MD_CopyInput(T%MD%Input(iSrc), T%MD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call MD_CopyInput(T%MD%Input(iSrc), T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select + + ! case (Module_ExtInfw) + + case (Module_Orca) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call Orca_CopyInput(T%Orca%Input_Saved(-iSrc), T%Orca%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call Orca_CopyInput(T%Orca%Input_Saved(-iSrc), T%Orca%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call Orca_CopyInput(T%Orca%Input_Saved(-iSrc), T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call Orca_CopyInput(T%Orca%u, T%Orca%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call Orca_CopyInput(T%Orca%u, T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select -! case (Module_MAP) -! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) case (Module_SD) - if (iDst > 0) T%SD%InputTimes(iDst) = DstInputTime - if (iSrc > 0 .and. iDst > 0) then - call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - else if (iSrc > 0) then - call SD_CopyInput(T%SD%Input(iSrc), T%SD%u, CtrlCode, Errstat2, ErrMsg2) - else - call SD_CopyInput(T%SD%u, T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end if + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call SD_CopyInput(T%SD%Input_Saved(-iSrc), T%SD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call SD_CopyInput(T%SD%Input_Saved(-iSrc), T%SD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SD_CopyInput(T%SD%Input_Saved(-iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call SD_CopyInput(T%SD%u, T%SD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SD_CopyInput(T%SD%u, T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call SD_CopyInput(T%SD%Input(iSrc), T%SD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select + + case (Module_SeaSt) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call SeaSt_CopyInput(T%SeaSt%Input_Saved(-iSrc), T%SeaSt%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call SeaSt_CopyInput(T%SeaSt%Input_Saved(-iSrc), T%SeaSt%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SeaSt_CopyInput(T%SeaSt%Input_Saved(-iSrc), T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call SeaSt_CopyInput(T%SeaSt%u, T%SeaSt%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SeaSt_CopyInput(T%SeaSt%u, T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select -! case (Module_SeaSt) case (Module_SrvD) - if (iDst > 0) T%SrvD%InputTimes(iDst) = DstInputTime - if (iSrc > 0 .and. iDst > 0) then - call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - else if (iSrc > 0) then - call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%u, CtrlCode, Errstat2, ErrMsg2) - else - call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end if + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call SrvD_CopyInput(T%SrvD%Input_Saved(-iSrc), T%SrvD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call SrvD_CopyInput(T%SrvD%Input_Saved(-iSrc), T%SrvD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SrvD_CopyInput(T%SrvD%Input_Saved(-iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0) + select case (iDst) + case (:-1) + call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (1:) + select case (iDst) + case (:-1) + call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0) + call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%u, CtrlCode, Errstat2, ErrMsg2) + case (1:) + call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select case default ErrStat2 = ErrID_Fatal diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index ff584af59a..753ca00127 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -318,7 +318,7 @@ subroutine FAST_Update(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) end if - IF ( Turbine(iTurb)%m_FAST%Lin%FoundSteady) THEN + IF ( Turbine(iTurb)%m_Glue%CS%FoundSteady) THEN EndSimulationEarly = .TRUE. END IF diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index b9a3cbb6a3..aece2d521f 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -1,5 +1,5 @@ !********************************************************************************************************************************** -! FAST_ModLin.f90 performs linearization using the ModVars module. +! FAST_ModGlue.f90 performs linearization using the ModVars module. !.................................................................................................................................. ! LICENSING ! Copyright (C) 2024 National Renewable Energy Laboratory @@ -31,7 +31,9 @@ module FAST_ModGlue implicit none private -public :: ModGlue_Init, ModGlue_Linearize_OP, MV_AddModule +public :: ModGlue_Init, MV_AddModule +public :: ModGlue_Linearize_OP, ModGlue_CalcSteady +public :: ModGlue_SaveOperatingPoint, ModGlue_RestoreOperatingPoint contains @@ -46,7 +48,7 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'ModLin_Init' + character(*), parameter :: RoutineName = 'ModGlue_Init' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi), allocatable :: modIDs(:), modIdx(:) @@ -58,46 +60,32 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - !---------------------------------------------------------------------------- - ! FAST Lin Settings - !---------------------------------------------------------------------------- - - m_FAST%Lin%NextLinTimeIndx = 1 - m_FAST%Lin%CopyOP_CtrlCode = MESH_NEWCOPY - m_FAST%Lin%n_rot = 0 - m_FAST%Lin%IsConverged = .false. - m_FAST%Lin%FoundSteady = .false. - m_FAST%Lin%ForceLin = .false. - m_FAST%Lin%AzimIndx = 1 - - p_FAST%AzimDelta = TwoPi/p_FAST%NLinTimes - !---------------------------------------------------------------------------- ! Module order and indexing !---------------------------------------------------------------------------- ! If no modules were added, return error - if (.not. allocated(m%ModData)) then + if (.not. allocated(m%Modules)) then call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) return end if ! Create array of indices for Mods array - modIdx = [(i, i=1, size(m%ModData))] + modIdx = [(i, i=1, size(m%Modules))] ! Get array of module IDs - modIDs = [(m%ModData(i)%ID, i=1, size(m%ModData))] + modIDs = [(m%Modules(i)%ID, i=1, size(m%Modules))] ! Establish module index order for linearization - allocate (p%iMod(0)) + allocate (p%Lin%iMod(0)) do i = 1, size(LinMods) - p%iMod = [p%iMod, pack(modIdx, ModIDs == LinMods(i))] + p%Lin%iMod = [p%Lin%iMod, pack(modIdx, ModIDs == LinMods(i))] end do ! Loop through modules, if module is not in index, return with error - do i = 1, size(m%ModData) - if (.not. any(i == p%iMod)) then - call SetErrStat(ErrID_Fatal, "Module "//trim(m%ModData(i)%Abbr)//" not supported in linearization", & + do i = 1, size(m%Modules) + if (.not. any(i == p%Lin%iMod)) then + call SetErrStat(ErrID_Fatal, "Module "//trim(m%Modules(i)%Abbr)//" not supported in linearization", & ErrStat, ErrMsg, RoutineName) return end if @@ -121,8 +109,8 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) allocate (y%ModGlue%Vars%x(0), y%ModGlue%Vars%xd(0), y%ModGlue%Vars%z(0), y%ModGlue%Vars%u(0), y%ModGlue%Vars%y(0)) ! Loop through each module by index - do i = 1, size(p%iMod) - associate (ModData => m%ModData(p%iMod(i))) + do i = 1, size(p%Lin%iMod) + associate (ModData => m%Modules(p%Lin%iMod(i))) ! Create variable name prefix for linearization names. Add instance ! number to module abbreviation if more than 1 instance or the module is BeamDyn @@ -254,7 +242,7 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Mesh Mapping !---------------------------------------------------------------------------- - call FAST_InitMappings(m%ModData, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InitMappings(m%Modules, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Allocate linearization arrays and matrices @@ -263,8 +251,22 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! If linearization is enabled if (p_FAST%Linearize) then + ! Copy linearization parameters + p%Lin%NumTimes = p_FAST%NLinTimes + p%Lin%InterpOrder = p_FAST%InterpOrder + if (allocated(m_FAST%Lin%LinTimes)) then + y%Lin%Times = m_FAST%Lin%LinTimes + end if + + ! Initialize indices + m%Lin%TimeIndex = 1 + m%Lin%AzimuthIndex = 1 + + ! Set flag to save operating points during linearization if mode shapes requested + p%Lin%SaveOPs = p_FAST%WrVTK == VTK_ModeShapes + ! Initialize linearization index - call Idx_Init(m%ModData, p%iMod, p%IdxLin, VF_None, ErrStat2, ErrMsg2); if (Failed()) return + call Idx_Init(m%Modules, p%Lin%iMod, p%Lin%Idx, VF_None, ErrStat2, ErrMsg2); if (Failed()) return ! Allocate linearization arrays call AllocAry(y%ModGlue%Lin%x, y%ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return @@ -283,10 +285,51 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) call AllocAry(y%ModGlue%Lin%dUdy, y%ModGlue%Vars%Nu, y%ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return ! Initialize arrays to store operating point states and input - call AllocAry(y%OP%x, y%ModGlue%Vars%Nx, p_FAST%NLinTimes, "x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%OP%xd, y%ModGlue%Vars%Nxd, p_FAST%NLinTimes, "xd", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%OP%z, y%ModGlue%Vars%Nz, p_FAST%NLinTimes, "z", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%OP%u, y%ModGlue%Vars%Nu, p_FAST%NLinTimes, "u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%x, y%ModGlue%Vars%Nx, p%Lin%NumTimes, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%xd, y%ModGlue%Vars%Nxd, p%Lin%NumTimes, "Lin%xd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%z, y%ModGlue%Vars%Nz, p%Lin%NumTimes, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%u, y%ModGlue%Vars%Nu, p%Lin%NumTimes, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return + + ! If steady state calculation is enabled + if (p_FAST%CalcSteady) then + + ! Disable saving of OPs during linearization as ModGlue_CalcSteady saves them automatically + p%Lin%SaveOPs = .false. + + ! Initialize variables + m%CS%AzimuthDelta = TwoPi_D/p%Lin%NumTimes + m%CS%NumRotations = 0 + m%CS%IsConverged = .false. + m%CS%FoundSteady = .false. + m%CS%ForceLin = .false. + + ! Calculate number of output values (ignoring write outputs) + m%CS%NumOutputs = 0 + do i = 1, size(y%ModGlue%Vars%y) + associate (Var => y%ModGlue%Vars%y(i)) + if (.not. MV_HasFlags(Var, VF_WriteOut)) m%CS%NumOutputs = m%CS%NumOutputs + Var%Num + end associate + end do + + ! Allocate arrays + call AllocAry(y%Lin%Times, p%Lin%NumTimes, "Lin%Times", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%AzimuthTarget, p%Lin%NumTimes, "CS%AzimuthTarget", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%psi_buffer, p_FAST%LinInterpOrder + 1, "CS%psi_buffer", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_buffer, y%ModGlue%Vars%Ny, p_FAST%LinInterpOrder + 1, "CS%y_buffer", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_interp, y%ModGlue%Vars%Ny, "CS%y_interp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_diff, y%ModGlue%Vars%Ny, "CS%y_diff", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_azimuth, y%ModGlue%Vars%Ny, p%Lin%NumTimes, "CS%y_azimuth", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_ref, y%ModGlue%Vars%Ny, "CS%y_ref", ErrStat2, ErrMsg2); if (Failed()) return + + ! Initialize arrays to zero + m%CS%psi_buffer = 0.0_R8Ki + m%CS%y_buffer = 0.0_R8Ki + m%CS%y_interp = 0.0_R8Ki + m%CS%y_diff = 0.0_R8Ki + m%CS%y_azimuth = 0.0_R8Ki + m%CS%y_ref = 1.0_R8Ki + + end if end if contains @@ -321,6 +364,331 @@ subroutine AddLinNamePrefix(VarAry, Prefix) end do end subroutine +subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ErrStat, ErrMsg) + + integer(IntKi), intent(IN) :: n_t_global !< integer time step + real(DbKi), intent(IN) :: t_global !< current simulation time + type(Glue_ParameterType), intent(inout) :: p !< Glue Parameters + type(Glue_MiscVarType), intent(inout) :: m !< Glue MiscVars + type(Glue_OutputFileType), intent(inout) :: y !< Glue Output + type(FAST_ParameterType), intent(inout) :: p_FAST !< FAST Parameters + type(FAST_MiscVarType), intent(inout) :: m_FAST !< FAST MiscVars + type(FAST_TurbineType), intent(inout) :: T !< Turbine Type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ModGlue_CalcSteady' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(DbKi) :: DeltaAzimuth, AzimuthTargetDelta, AzimuthTarget + real(DbKi) :: psi !< psi (rotor azimuth) at which the outputs are defined + real(DbKi) :: error + logical :: ProcessAzimuth + integer(IntKi) :: i, j, iy + + ErrStat = ErrID_None + ErrMsg = "" + + ! Get current azimuth angle from ElastoDyn output + psi = real(T%ED%y%LSSTipPxa, R8Ki) + call Zero2TwoPi(psi) + + ! Cyclic shift psi buffer and set first index to new psi + do i = size(m%CS%psi_buffer) - 1, 1, -1 + m%CS%psi_buffer(i + 1) = m%CS%psi_buffer(i) + end do + ! If passing the 2PI boundary, subtract 2PI from saved values so interpolation works correctly + if (psi < m%CS%psi_buffer(1)) m%CS%psi_buffer = m%CS%psi_buffer - TwoPi_D + m%CS%psi_buffer(1) = psi + + ! Cyclic shift output buffer and collect outputs from all modules + do i = size(m%CS%psi_buffer) - 1, 1, -1 + m%CS%y_buffer(:, i + 1) = m%CS%y_buffer(:, i) + end do + + ! Loop through modules and collect output + iy = 1 + do j = 1, size(p%Lin%iMod) + associate (ModData => m%Modules(p%Lin%iMod(j))) + + ! Skip of module has no outputs + if (ModData%Vars%Ny == 0) cycle + + ! Get outputs + call FAST_GetOP(ModData, t_global, STATE_CURR, T, ErrStat2, ErrMsg2, y_op=ModData%Lin%y) + if (Failed()) return + + ! Copy outputs to buffer + m%CS%y_buffer(iy:iy + ModData%Vars%Ny - 1, 1) = ModData%Lin%y + + ! Increment output index + iy = iy + ModData%Vars%Ny + end associate + end do + + ! If first call + if (n_t_global == 0) then + + ! Initialize azimuth targets + do i = 1, p%Lin%NumTimes + m%CS%AzimuthTarget(i) = (i - 1)*m%CS%AzimuthDelta + psi + call Zero2TwoPi(m%CS%AzimuthTarget(i)) + end do + + ! Initialize psi buffer for interpolation based on time step and rotor speed + do i = 1, size(m%CS%psi_buffer) + m%CS%psi_buffer(i) = psi - (i - 1)*p_FAST%DT*T%ED%y%LSS_Spd + end do + + ! Initialize output buffer by copying outputs from first buffer location + do i = 2, size(m%CS%y_buffer, 2) + m%CS%y_buffer(:, i) = m%CS%y_buffer(:, 1) + end do + + end if + + ! Calculate change in azimuth from last call, if change is too great, return error + DeltaAzimuth = psi - m%CS%psi_buffer(1) + call Zero2TwoPi(DeltaAzimuth) + if (DeltaAzimuth > m%CS%AzimuthDelta) then + call SetErrStat(ErrID_Fatal, "The rotor is spinning too fast. The time step or NLinTimes is too large when CalcSteady=true.", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Get the current azimuth target + AzimuthTarget = m%CS%AzimuthTarget(m%Lin%AzimuthIndex) + + ! Difference between current azimuth and the target + AzimuthTargetDelta = psi - AzimuthTarget + + ! Set flag to process next azimuth if psi is greater than the next azimuth target + ! and the difference between psi and the target is less than the AzimuthDelta (difference between targets) + ProcessAzimuth = (AzimuthTargetDelta >= 0.0_R8Ki) .and. (AzimuthTargetDelta < m%CS%AzimuthDelta) + + ! If this is the last step, force linearization + if (t_global >= p_FAST%TMax - 0.5_DbKi*p_FAST%DT) then + m%CS%ForceLin = .true. + m%Lin%AzimuthIndex = 1 + ProcessAzimuth = .true. + end if + + ! If flag is set to process azimuth + if (ProcessAzimuth) then + + ! Interpolate outputs to target azimuth + call InterpOutputsToAzimuth() + + ! If converged + if (m%CS%IsConverged) then + + ! Calculate error between interpolated outputs and outputs at this + ! azimuth from the previous rotation + error = CalcOutputErrorAtAzimuth() + + ! Update converged flag based on error and tolerance + m%CS%IsConverged = error < p_FAST%TrimTol + end if + + ! Save interpolated outputs for this azimuth + m%CS%y_azimuth(:, m%Lin%AzimuthIndex) = m%CS%y_interp + + ! If linearization is forced + if (m%CS%ForceLin) m%CS%IsConverged = .true. + + ! If converged or in first rotation, save this operating point for linearization later + if (m%CS%IsConverged .or. m%CS%NumRotations == 0) then ! + y%Lin%Times(m%Lin%AzimuthIndex) = t_global + call ModGlue_SaveOperatingPoint(p, m, m%Lin%AzimuthIndex, m%CS%NumRotations == 0, T, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Increment the azimuth index counter + m%Lin%AzimuthIndex = m%Lin%AzimuthIndex + 1 + + ! If we've completed one rotor revolution + if (m%Lin%AzimuthIndex > p%Lin%NumTimes) then + + ! Increment number of rotations + m%CS%NumRotations = m%CS%NumRotations + 1 + + ! Save if steady state has been found + m%CS%FoundSteady = m%CS%IsConverged + + ! If steady state has been found, return + if (m%CS%FoundSteady) return + + ! Compute the reference values for this rotor revolution + m%CS%y_ref = max(maxval(m%CS%y_azimuth, dim=2) - minval(m%CS%y_azimuth, dim=2), 0.01_R8Ki) + + ! Check errors next rotor revolution + m%CS%IsConverged = .true. + + ! Reset the azimuth index + m%Lin%AzimuthIndex = 1 + + ! Forcing linearization if time is close to tmax (with sufficient margin) + + ! If rotor has nonzero speed + if (T%ED%p%RotSpeed > 0) then + + ! If simulation is at least 10 revolutions, and error in rotor speed less than 0.1% + if ((p_FAST%TMax > 10*(TwoPi_D)/T%ED%p%RotSpeed) .and. & + (t_global >= p_FAST%TMax - 2._DbKi*(TwoPi_D)/T%ED%p%RotSpeed)) then + if (abs(T%ED%y%RotSpeed - T%ED%p%RotSpeed)/T%ED%p%RotSpeed < 0.001) then + m%CS%ForceLin = .true. + end if + end if + else + if (t_global >= p_FAST%TMax - 1.5_DbKi*p_FAST%DT) then + m%CS%ForceLin = .true. + end if + end if + + end if + end if + + ! If linearization is being forced, set flags and display message + if (m%CS%ForceLin) then + m%CS%IsConverged = .true. + m%CS%FoundSteady = .true. + call WrScr('') + call WrScr('[WARNING] Steady state not found before end of simulation. Forcing linearization.') + end if + +contains + + subroutine InterpOutputsToAzimuth() + real(R8Ki) :: a1, a2, a3 !< interpolation coefficients + real(R8Ki) :: ti(3), to !< temporary variables for interpolation + real(R8Ki) :: q01, q1(3) + real(R8Ki) :: q02, q2(3) + real(R8Ki) :: q0o, qo(3) + real(R8Ki) :: dot, theta, sin_theta, a, b + integer(IntKi) :: k, iq1, iq2 + logical :: first_quat + + ! Switch based on interpolation order + select case (p%Lin%InterpOrder) + case (0) + m%CS%y_interp = m%CS%y_buffer(:, 1) + return + case (1) + ti(1:2) = m%CS%psi_buffer - m%CS%psi_buffer(1) + to = AzimuthTarget - m%CS%psi_buffer(1) + a1 = -(to - ti(2))/ti(2) + a2 = to/ti(2) + m%CS%y_interp = a1*m%CS%y_buffer(:, 1) + a2*m%CS%y_buffer(:, 2) + case (2) + ti = m%CS%psi_buffer - m%CS%psi_buffer(1) + to = AzimuthTarget - m%CS%psi_buffer(1) + a1 = (to - ti(2))*(to - ti(3))/((ti(1) - ti(2))*(ti(1) - ti(3))) + a2 = (to - ti(1))*(to - ti(3))/((ti(2) - ti(1))*(ti(2) - ti(3))) + a3 = (to - ti(1))*(to - ti(2))/((ti(3) - ti(1))*(ti(3) - ti(2))) + m%CS%y_interp = a1*m%CS%y_buffer(:, 1) + a2*m%CS%y_buffer(:, 2) + a3*m%CS%y_buffer(:, 3) + case default + m%CS%y_interp = 0.0_R8Ki + return + end select + + ! Loop through glue output variables + first_quat = .true. + do i = 1, size(y%ModGlue%Vars%y) + associate (Var => y%ModGlue%Vars%y(i)) + + ! Switch based on variable field type + select case (Var%Field) + case (VF_Orientation) + + ! If first quaternion, calculate interpolation coefficients for quadratic interp + if (first_quat) then + first_quat = .false. + select case (p%Lin%InterpOrder) + case (1) + iq1 = 1 + iq2 = 2 + case (2) + ! Determine if azimuth target is between indices 1,2 or 2,3 + if (AzimuthTarget >= m%CS%psi_buffer(2)) then + iq1 = 1 + iq2 = 2 + else + iq1 = 2 + iq2 = 3 + end if + to = (AzimuthTarget - m%CS%psi_buffer(iq1))/(m%CS%psi_buffer(iq2) - m%CS%psi_buffer(iq1)) + end select + end if + + k = Var%iLoc(1) + do j = 1, Var%Nodes + q1 = m%CS%y_buffer(k:k + 2, iq1) + q2 = m%CS%y_buffer(k:k + 2, iq2) + q01 = quat_scalar(q1) + q02 = quat_scalar(q2) + dot = q01*q02 + dot_product(q1, q2) + if (dot < 0.0_R8Ki) then + dot = -dot + q02 = -q02 + q2 = -q2 + end if + if (dot > 0.9995_R8Ki) then + q0o = (1.0_R8Ki - to)*q01 + to*q02 + qo = (1.0_R8Ki - to)*q1 + to*q2 + else + theta = acos(dot) + sin_theta = sin(theta) + a = sin((1.0_R8Ki - to)*theta)/sin_theta + b = sin(to*theta)/sin_theta + q0o = a*q01 + b*q02 + qo = a*q1 + b*q2 + end if + qo = quat_canonical(q0o, qo) + m%CS%y_interp(k:k + 2) = qo + k = k + 3 + end do + + end select + + end associate + end do + end subroutine + + function CalcOutputErrorAtAzimuth() result(eps_squared) + real(R8Ki) :: eps_squared_sum, eps_squared + + ! Calculate difference between interpolated outputs for this rotation and + ! interpolated outputs from previous rotation + call MV_ComputeDiff(y%ModGlue%Vars%y, m%CS%y_interp, m%CS%y_azimuth(:, m%Lin%AzimuthIndex), m%CS%y_diff) + + ! Initialize epsilon squared sum + eps_squared_sum = 0 + + ! Loop through glue output variables, ignore write outputs + do i = 1, size(y%ModGlue%Vars%y) + associate (Var => y%ModGlue%Vars%y(i)) + if (MV_HasFlags(Var, VF_WriteOut)) cycle + + ! Loop through values in variable + do j = Var%iLoc(1), Var%iLoc(2) + + ! If difference is not essentially zero, sum difference + if (.not. EqualRealNos(m%CS%y_diff(j), 0.0_R8Ki)) then + eps_squared_sum = eps_squared_sum + (m%CS%y_diff(j)/m%CS%y_ref(j))**2 + end if + end do + end associate + end do + + ! Normalize error by number of outputs + eps_squared = eps_squared_sum/m%CS%NumOutputs + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_global, ErrStat, ErrMsg) type(Glue_ParameterType), intent(inout) :: p !< Glue parameters @@ -334,12 +702,13 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'ModLin_Init' + character(*), parameter :: RoutineName = 'ModGlue_Linearize_OP' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j, k integer(IntKi) :: ix, ixd, iz, iu, iy integer(IntKi) :: Un + integer(IntKi) :: StateLinIndex, InputLinIndex character(200) :: SimStr character(MaxWrScrLen) :: BlankLine character(1024) :: LinRootName @@ -354,16 +723,29 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob BlankLine = "" call WrOver(BlankLine) ! BlankLine contains MaxWrScrLen spaces SimStr = '(RotSpeed='//trim(Num2LStr(Turbine%ED%y%RotSpeed*RPS2RPM, Fmt))//' rpm, BldPitch1='//trim(Num2LStr(Turbine%ED%y%BlPitch(1)*R2D, Fmt))//' deg)' - call WrOver(' Performing linearization '//trim(Num2LStr(Turbine%m_FAST%Lin%NextLinTimeIndx))//' at simulation time '//TRIM(Num2LStr(t_global))//' s. '//trim(SimStr)) + call WrOver(' Performing linearization '//trim(Num2LStr(m%Lin%TimeIndex))//' at simulation time '//TRIM(Num2LStr(t_global))//' s. '//trim(SimStr)) call WrScr('') + !---------------------------------------------------------------------------- + ! Save operating point + !---------------------------------------------------------------------------- + + ! If flag set to save operating points during linearization + if (p%Lin%SaveOPs) then + call ModGlue_SaveOperatingPoint(p, m, m%Lin%TimeIndex, .true., Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! Initialization + !---------------------------------------------------------------------------- + ! Get parameters - ! NumBl = size(T%ED%Input(1)%BlPitchCom) y_FAST%Lin%RotSpeed = Turbine%ED%y%RotSpeed y_FAST%Lin%Azimuth = Turbine%ED%y%LSSTipPxa ! Assemble linearization root file name - LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(m_FAST%Lin%NextLinTimeIndx)) + LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(m%Lin%TimeIndex)) ! Get unit number for writing files call GetNewUnit(Un, ErrStat2, ErrMsg2); if (Failed()) return @@ -381,16 +763,16 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob y%ModGlue%Lin%dYdx = 0.0_R8Ki y%ModGlue%Lin%dXdx = 0.0_R8Ki - ! Loop through modules by index - do i = 1, size(p%iMod) - associate (ModData => m%ModData(p%iMod(i))) + ! Loop through linearization modules by index + do i = 1, size(p%Lin%iMod) + associate (ModData => m%Modules(p%Lin%iMod(i))) - ! Derivatives wrt input + ! Derivatives with respect to input call FAST_JacobianPInput(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & dYdu=ModData%Lin%dYdu, dXdu=ModData%Lin%dXdu) if (Failed()) return - ! Derivatives wrt continuous state + ! Derivatives with respect to continuous state call FAST_JacobianPContState(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & dYdx=ModData%Lin%dYdx, dXdx=ModData%Lin%dXdx, & StateRotation=ModData%Lin%StateRotation) @@ -430,7 +812,7 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob ! Assemble output file name based on module abbreviation ! If module is BeamDyn or more than one instance, include instance OutFileName = trim(LinRootName)//'.'//trim(ModData%Abbr)//".lin" - if ((ModData%ID == Module_BD) .or. (count(m%ModData%ID == ModData%ID) > 1)) then + if ((ModData%ID == Module_BD) .or. (count(m%Modules%ID == ModData%ID) > 1)) then OutFileName = trim(LinRootName)//'.'//trim(ModData%Abbr)//trim(Num2LStr(ModData%Ins))//".lin" end if @@ -447,10 +829,10 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob if (JacobianHasNaNs(ModData%Lin%dXdx, "dXdx", ModData%Abbr)) return ! Copy arrays into linearization operating points - if (size(y%ModGlue%Lin%x) > 0) y%OP%x(:,m_FAST%Lin%NextLinTimeIndx) = y%ModGlue%Lin%x - if (size(y%ModGlue%Lin%xd) > 0) y%OP%xd(:,m_FAST%Lin%NextLinTimeIndx) = y%ModGlue%Lin%xd - if (size(y%ModGlue%Lin%z) > 0) y%OP%z(:,m_FAST%Lin%NextLinTimeIndx) = y%ModGlue%Lin%z - if (size(y%ModGlue%Lin%u) > 0) y%OP%u(:,m_FAST%Lin%NextLinTimeIndx) = y%ModGlue%Lin%u + if (size(y%ModGlue%Lin%x) > 0) y%Lin%x(:, m%Lin%TimeIndex) = y%ModGlue%Lin%x + if (size(y%ModGlue%Lin%xd) > 0) y%Lin%xd(:, m%Lin%TimeIndex) = y%ModGlue%Lin%xd + if (size(y%ModGlue%Lin%z) > 0) y%Lin%z(:, m%Lin%TimeIndex) = y%ModGlue%Lin%z + if (size(y%ModGlue%Lin%u) > 0) y%Lin%u(:, m%Lin%TimeIndex) = y%ModGlue%Lin%u end associate end do @@ -458,7 +840,7 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob ! Linearize mesh mappings to populate dUdy and dUdu y%ModGlue%Lin%dUdy = 0.0_R8Ki call Eye2D(y%ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_LinearizeMappings(Turbine, m%ModData, m%Mappings, p%iMod, p%IdxLin, ErrStat2, ErrMsg2, y%ModGlue%Lin%dUdu, y%ModGlue%Lin%dUdy) + call FAST_LinearizeMappings(Turbine, m%Modules, m%Mappings, p%Lin%iMod, p%Lin%Idx, ErrStat2, ErrMsg2, y%ModGlue%Lin%dUdu, y%ModGlue%Lin%dUdy) if (Failed()) return ! Write glue code matrices to file @@ -467,11 +849,11 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob if (Failed()) return ! Update index for next linearization time - m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 + m%Lin%TimeIndex = m%Lin%TimeIndex + 1 contains logical function JacobianHasNaNs(Jac, label, abbr) - real(R8Ki), allocatable, intent(in) :: Jac(:,:) + real(R8Ki), allocatable, intent(in) :: Jac(:, :) character(*), intent(in) :: label, abbr JacobianHasNaNs = .false. if (.not. allocated(Jac)) return @@ -487,7 +869,103 @@ logical function Failed() end function Failed end subroutine -!> ModLin_StateMatrices forms the full-system state matrices for linearization: A, B, C, and D. +subroutine ModGlue_SaveOperatingPoint(p, m, OPIndex, NewCopy, Turbine, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(in) :: p + type(Glue_MiscVarType), intent(inout) :: m + integer(IntKi), intent(in) :: OPIndex + logical, intent(in) :: NewCopy + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModGlue_SaveOperatingPoint' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: StateIndex, InputIndex, CtrlCode, i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Set CtrlCode based on NewCopy flag + if (NewCopy) then + CtrlCode = MESH_NEWCOPY + else + CtrlCode = MESH_UPDATECOPY + end if + + ! Index into state array where linearization data will be stored for this OP + StateIndex = NumStateTimes + OPIndex + + ! Index into input save array where linearization data will be stored for OP + InputIndex = Turbine%p_FAST%InterpOrder + 1 + OPIndex + + ! Loop through modules by index + do i = 1, size(p%Lin%iMod) + associate (ModData => m%Modules(p%Lin%iMod(i))) + + ! Copy current module state to linearization save location + call FAST_CopyStates(ModData, Turbine, STATE_CURR, StateIndex, CtrlCode, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Copy current module output to linearization save location + call FAST_CopyInput(ModData, Turbine, INPUT_CURR, -InputIndex, CtrlCode, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +subroutine ModGlue_RestoreOperatingPoint(p, m, OPIndex, Turbine, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(in) :: p + type(Glue_MiscVarType), intent(inout) :: m + integer(IntKi), intent(in) :: OPIndex + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModGlue_RestoreOperatingPoint' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: StateIndex, InputIndex, i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Index into state array where linearization data will be stored for this OP + StateIndex = NumStateTimes + OPIndex + + ! Index into input save array where linearization data will be stored for OP + InputIndex = Turbine%p_FAST%InterpOrder + 1 + OPIndex + + ! Loop through modules by index + do i = 1, size(p%Lin%iMod) + associate (ModData => m%Modules(p%Lin%iMod(i))) + + ! Copy current module state to linearization save location + call FAST_CopyStates(ModData, Turbine, StateIndex, STATE_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Copy current module input to linearization save location + call FAST_CopyInput(ModData, Turbine, -InputIndex, INPUT_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +!> CalcGlueStateMatrices forms the full-system state matrices for linearization: A, B, C, and D. !! Note that it uses LAPACK_GEMM instead of MATMUL for matrix multiplications because of stack-space issues (these !! matrices get large quickly). subroutine CalcGlueStateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) @@ -496,7 +974,7 @@ subroutine CalcGlueStateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'ModLin_StateMatrices' + character(*), parameter :: RoutineName = 'CalcGlueStateMatrices' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 real(R8Ki), allocatable :: G(:, :), tmp(:, :) @@ -592,8 +1070,8 @@ subroutine Precondition(uVars, G, dUdu, dUdy, JacScaleFactor) logical :: isRowLoad, isColLoad logical, allocatable :: isLoad(:) - allocate(isLoad(size(dUdu,1))) - isLoad=.false. + allocate (isLoad(size(dUdu, 1))) + isLoad = .false. ! Loop through glue code input variables (cols) do i = 1, size(uVars) diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 7b182b686d..69e273f2a1 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -40,6 +40,10 @@ MODULE FAST_ModTypes INTEGER(IntKi), PARAMETER :: STATE_SAVED_CURR = 3 INTEGER(IntKi), PARAMETER :: STATE_SAVED_PRED = 4 + ! input array indices + INTEGER(IntKi), PARAMETER :: INPUT_TEMP = 0 + INTEGER(IntKi), PARAMETER :: INPUT_CURR = 1 + ! VTK visualization INTEGER(IntKi), PARAMETER :: VTK_Unknown = -1 !< unknown option (will produce error) INTEGER(IntKi), PARAMETER :: VTK_None = 0 !< none (no VTK output) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 1c048b04b8..7e1888827b 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -416,7 +416,6 @@ typedef ^ ^ IceD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ IceD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" typedef ^ ^ IceD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... BeamDyn data ....................................................................................................... # [ the last dimension of each allocatable array is for the instance of BeamDyn being used ] @@ -435,14 +434,13 @@ typedef ^ ^ BD_OutputType y_interp {:} - - "interpolated system outputs for Calc typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" typedef ^ ^ BD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... ElastoDyn data ....................................................................................................... -typedef FAST ElastoDyn_Data ED_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef FAST ElastoDyn_Data ED_ContinuousStateType x {:} - - "Continuous states" typedef ^ ^ ED_ContinuousStateType dxdt - - - "Continuous state derivatives" -typedef ^ ^ ED_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ ED_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ ED_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef ^ ^ ED_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ ED_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ ED_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ED_ParameterType p - - - "Parameters" typedef ^ ^ ED_InputType u - - - "System inputs" typedef ^ ^ ED_OutputType y - - - "System outputs" @@ -453,14 +451,13 @@ typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSt typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ ED_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ServoDyn data ....................................................................................................... -typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ SrvD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ SrvD_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ SrvD_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ SrvD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SrvD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SrvD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SrvD_ParameterType p - - - "Parameters" typedef ^ ^ SrvD_InputType u - - - "System inputs" typedef ^ ^ SrvD_OutputType y - - - "System outputs" @@ -471,13 +468,12 @@ typedef ^ ^ SrvD_OutputType y_interp - - - "interpolated system outputs for Calc typedef ^ ^ SrvD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ SrvD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn14 data ....................................................................................................... -typedef FAST AeroDyn14_Data AD14_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ AD14_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ AD14_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ AD14_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST AeroDyn14_Data AD14_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ AD14_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ AD14_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ AD14_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ AD14_ParameterType p - - - "Parameters" typedef ^ ^ AD14_InputType u - - - "System inputs" typedef ^ ^ AD14_OutputType y - - - "System outputs" @@ -485,13 +481,12 @@ typedef ^ ^ AD14_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ AD14_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ AD14_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn data ....................................................................................................... -typedef FAST AeroDyn_Data AD_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ AD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ AD_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ AD_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST AeroDyn_Data AD_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ AD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ AD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ AD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ AD_ParameterType p - - - "Parameters" typedef ^ ^ AD_InputType u - - - "System inputs" typedef ^ ^ AD_OutputType y - - - "System outputs" @@ -501,7 +496,6 @@ typedef ^ ^ AD_OutputType y_interp - - - "interpolated system outputs for CalcSt typedef ^ ^ AD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ AD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtLoads data ....................................................................................................... typedef FAST ExtLoads_Data ExtLd_ContinuousStateType x {NumStateTimes} - - "Continuous states" @@ -515,10 +509,10 @@ typedef ^ ^ ExtLd_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... InflowWind data ....................................................................................................... -typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ InflowWind_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ InflowWind_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ InflowWind_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" typedef ^ ^ InflowWind_InputType u - - - "System inputs" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" @@ -528,7 +522,6 @@ typedef ^ ^ InflowWind_OutputType y_interp - - - "interpolated system outputs fo typedef ^ ^ InflowWind_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ InflowWind_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExternalInflow integration data ....................................................................................................... typedef FAST ExternalInflow_Data ExtInfw_InputType u - - - "System inputs" @@ -542,11 +535,11 @@ typedef ^ ^ SC_DX_OutputType y - - - "System outputs" typedef ^ ^ SC_DX_ParameterType p - - - "System parameters" # ..... SubDyn data ....................................................................................................... -typedef FAST SubDyn_Data SD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef FAST SubDyn_Data SD_ContinuousStateType x {:} - - "Continuous states" typedef ^ ^ SD_ContinuousStateType dxdt - - - "Continuous state derivatives" -typedef ^ ^ SD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ SD_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ SD_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef ^ ^ SD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SD_ParameterType p - - - "Parameters" typedef ^ ^ SD_InputType u - - - "System inputs" typedef ^ ^ SD_OutputType y - - - "System outputs" @@ -556,13 +549,12 @@ typedef ^ ^ SD_InputType Input_Saved {:} - - "Backup Array of inputs associated typedef ^ ^ SD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtPtfm data ....................................................................................................... -typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ ExtPtfm_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ ExtPtfm_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ ExtPtfm_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ ExtPtfm_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ ExtPtfm_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ ExtPtfm_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ExtPtfm_ParameterType p - - - "Parameters" typedef ^ ^ ExtPtfm_InputType u - - - "System inputs" typedef ^ ^ ExtPtfm_OutputType y - - - "System outputs" @@ -570,13 +562,12 @@ typedef ^ ^ ExtPtfm_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ExtPtfm_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ ExtPtfm_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... SeaState data ....................................................................................................... -typedef FAST SeaState_Data SeaSt_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ SeaSt_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ SeaSt_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ SeaSt_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST SeaState_Data SeaSt_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" typedef ^ ^ SeaSt_InputType u - - - "System inputs" typedef ^ ^ SeaSt_OutputType y - - - "System outputs" @@ -586,14 +577,13 @@ typedef ^ ^ SeaSt_InputType Input_Saved {:} - - "Backup Array of inputs associat typedef ^ ^ SeaSt_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SeaSt_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... HydroDyn data ....................................................................................................... -typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {:} - - "Continuous states" typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType dxdt - - - "Continuous state derivatives" -typedef ^ ^ HydroDyn_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ HydroDyn_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ HydroDyn_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef ^ ^ HydroDyn_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ HydroDyn_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ HydroDyn_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ HydroDyn_ParameterType p - - - "Parameters" typedef ^ ^ HydroDyn_InputType u - - - "System inputs" typedef ^ ^ HydroDyn_OutputType y - - - "System outputs" @@ -603,13 +593,12 @@ typedef ^ ^ HydroDyn_OutputType y_interp - - - "interpolated system outputs for typedef ^ ^ HydroDyn_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ HydroDyn_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... IceFloe data ....................................................................................................... -typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ IceFloe_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ IceFloe_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ IceFloe_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ IceFloe_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ IceFloe_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ IceFloe_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ IceFloe_ParameterType p - - - "Parameters" typedef ^ ^ IceFloe_InputType u - - - "System inputs" typedef ^ ^ IceFloe_OutputType y - - - "System outputs" @@ -617,12 +606,11 @@ typedef ^ ^ IceFloe_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ IceFloe_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ IceFloe_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MAP data ....................................................................................................... -typedef FAST MAP_Data MAP_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ MAP_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ MAP_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef FAST MAP_Data MAP_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ MAP_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ MAP_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ MAP_OtherStateType OtherSt - - - "Other/optimization states" typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_InputType u - - - "System inputs" @@ -634,13 +622,12 @@ typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcS typedef ^ ^ MAP_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ MAP_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FEAMooring data ....................................................................................................... -typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ FEAM_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ FEAM_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ FEAM_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ FEAM_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ FEAM_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ FEAM_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ FEAM_ParameterType p - - - "Parameters" typedef ^ ^ FEAM_InputType u - - - "System inputs" typedef ^ ^ FEAM_OutputType y - - - "System outputs" @@ -648,13 +635,12 @@ typedef ^ ^ FEAM_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ FEAM_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ FEAM_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MoorDyn data ....................................................................................................... -typedef FAST MoorDyn_Data MD_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ MD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ MD_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ MD_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST MoorDyn_Data MD_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ MD_ParameterType p - - - "Parameters" typedef ^ ^ MD_InputType u - - - "System inputs" typedef ^ ^ MD_OutputType y - - - "System outputs" @@ -664,13 +650,12 @@ typedef ^ ^ MD_OutputType y_interp - - - "interpolated system outputs for CalcSt typedef ^ ^ MD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ MD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... OrcaFlex data ....................................................................................................... -typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ Orca_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ Orca_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ Orca_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ Orca_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ Orca_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ Orca_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ Orca_ParameterType p - - - "Parameters" typedef ^ ^ Orca_InputType u - - - "System inputs" typedef ^ ^ Orca_OutputType y - - - "System outputs" @@ -678,7 +663,6 @@ typedef ^ ^ Orca_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ Orca_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ Orca_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FAST_ModuleMapType data ....................................................................................................... # ! Data structures for mapping and coupling the various modules together diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 62821b43a6..69b32ef549 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3,7 +3,7 @@ ! FAST_Prog.f90, FAST_Library.f90, FAST_Prog.c are different drivers for this code. !.................................................................................................................................. ! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! Copyright (C) 2013-2024 National Renewable Energy Laboratory ! ! This file is part of FAST. ! @@ -128,6 +128,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD INTEGER(IntKi) :: IceDim ! dimension we're pre-allocating for number of IceDyn legs/instances INTEGER(IntKi) :: I ! generic loop counter INTEGER(IntKi) :: k ! blade loop counter + INTEGER(IntKi) :: InputArySize ! Number of inputs in module data input arrays + INTEGER(IntKi) :: InputSavedArySize ! Number of inputs in module data input saved arrays + INTEGER(IntKi) :: StateArySize ! Number of states in module data state arrays logical :: CallStart REAL(R8Ki) :: theta(3) ! angles for hub orientation matrix for aeromaps @@ -169,8 +172,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD p_FAST%TDesc = '' ! p_FAST%CheckHSSBrTrqC = .false. - y_FAST%Lin%WindSpeed = 0.0_ReKi - if (present(ExternInitData)) then CallStart = .not. ExternInitData%FarmIntegration if (ExternInitData%TurbIDforName >= 0) p_FAST%TDesc = 'T'//trim(num2lstr(ExternInitData%TurbIDforName)) @@ -232,28 +233,43 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD END IF - !............................................................................................................................... - p_FAST%dt_module = p_FAST%dt ! initialize time steps for each module - ! ........................ - ! initialize ElastoDyn (must be done first) - ! ........................ + !---------------------------------------------------------------------------- + ! Module data arrays + !---------------------------------------------------------------------------- - ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Module data input arrays are interpolation order plus 1 + InputArySize = p_FAST%InterpOrder + 1 - ALLOCATE( ED%Input_Saved( p_FAST%InterpOrder+1 ), ED%InputTimes_Saved( p_FAST%InterpOrder+1 ), ED%Output_bak( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input_Saved, ED%Output_bak, and ED%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Input saved arrays have storage for InputArray size + linearization + InputSavedArySize = InputArySize + p_FAST%NLinTimes + + ! Module data state arrays include data at linearization times after + ! STATE_CURR, STATE_PRED, STATE_SAVED_CURR, and STATE_SAVED_PRED + StateArySize = NumStateTimes + p_FAST%NLinTimes + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + y_FAST%Lin%WindSpeed = 0.0_ReKi + + !---------------------------------------------------------------------------- + ! Initialize ElastoDyn (must be done first) + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(ED%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("ED%Input")) return + allocate(ED%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return + allocate(ED%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return + allocate(ED%Output_bak (InputArySize ), stat=ErrStat2); if (FailedAlloc("ED%Output_bak")) return + allocate(ED%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("ED%x")) return + allocate(ED%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return + allocate(ED%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("ED%z")) return + allocate(ED%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return + + ! Set initialization input Init%InData_ED%Linearize = p_FAST%Linearize Init%InData_ED%CompAeroMaps = p_FAST%CompAeroMaps Init%InData_ED%RotSpeed = p_FAST%RotSpeedInit @@ -263,54 +279,28 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ELSE Init%InData_ED%ADInputFile = "" END IF - Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED - Init%InData_ED%Gravity = p_FAST%Gravity - Init%InData_ED%MHK = p_FAST%MHK Init%InData_ED%WtrDpth = p_FAST%WtrDpth - CALL ED_Init( Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, p_FAST%dt_module( MODULE_ED ), Init%OutData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Call module initialization routine + CALL ED_Init(Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, p_FAST%dt_module(MODULE_ED), Init%OutData_ED, ErrStat2, ErrMsg2) + if (Failed()) return - p_FAST%ModuleInitialized(Module_ED) = .TRUE. CALL SetModuleSubstepTime(Module_ED, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_ED)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) - else - - if (allocated(Init%OutData_ED%LinNames_y)) call move_alloc(Init%OutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) - if (allocated(Init%OutData_ED%LinNames_x)) call move_alloc(Init%OutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) - if (allocated(Init%OutData_ED%LinNames_u)) call move_alloc(Init%OutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) - if (allocated(Init%OutData_ED%RotFrame_y)) call move_alloc(Init%OutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) - if (allocated(Init%OutData_ED%RotFrame_x)) call move_alloc(Init%OutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) - if (allocated(Init%OutData_ED%DerivOrder_x)) call move_alloc(Init%OutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) - if (allocated(Init%OutData_ED%RotFrame_u)) call move_alloc(Init%OutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) - if (allocated(Init%OutData_ED%IsLoad_u )) call move_alloc(Init%OutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) - - if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) - end if - - ! Add module to array of modules - CALL MV_AddModule(m_Glue%ModData, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & - Init%OutData_ED%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! Add module to array of modules, return if errors occurred + CALL MV_AddModule(m_Glue%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + Init%OutData_ED%Vars, ErrStat2, ErrMsg2) + if (Failed()) return NumBl = Init%OutData_ED%NumBl p_FAST%GearBox_index = Init%OutData_ED%GearBox_index - if (p_FAST%CalcSteady) then if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then p_FAST%TrimCase = TrimCase_none @@ -321,227 +311,166 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD end if end if + p_FAST%ModuleInitialized(Module_ED) = .TRUE. + + !---------------------------------------------------------------------------- + ! Initialize BeamDyn + !---------------------------------------------------------------------------- - ! ........................ - ! initialize BeamDyn - ! ........................ - IF ( p_FAST%CompElast == Module_BD ) THEN - IF (p_FAST%CompAeroMaps) then + if (p_FAST%CompElast == Module_BD) then + if (p_FAST%CompAeroMaps) then p_FAST%nBeams = 1 ! initialize number of BeamDyn instances = 1 blade for aero maps - ELSE + else p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades - END IF - ELSE + end if + else p_FAST%nBeams = 0 - END IF - - ALLOCATE( BD%Input( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input and BD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( BD%Input_Saved( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes_Saved( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input_Saved and BD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( BD%x( p_FAST%nBeams,4), & - BD%xd( p_FAST%nBeams,4), & - BD%z( p_FAST%nBeams,4), & - BD%OtherSt( p_FAST%nBeams,4), & - BD%p( p_FAST%nBeams ), & - BD%u( p_FAST%nBeams ), & - BD%y( p_FAST%nBeams ), & - BD%m( p_FAST%nBeams ), & - Init%OutData_BD(p_FAST%nBeams ), & - STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating BeamDyn state, input, and output data.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF (p_FAST%CompElast == Module_BD) THEN - - Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. - - Init%InData_BD%Linearize = p_FAST%Linearize - Init%InData_BD%CompAeroMaps = p_FAST%CompAeroMaps - Init%InData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration" m/s^2 - - ! now initialize BeamDyn for all beams - dt_BD = p_FAST%dt_module( MODULE_BD ) + end if - Init%InData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) - Init%InData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) + ! Allocate module data arrays + allocate(BD%Input (InputArySize, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input")) return + allocate(BD%InputTimes (InputArySize, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%InputTimes")) return + allocate(BD%Input_Saved (InputSavedArySize, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input_Saved")) return + allocate(BD%x (p_FAST%nBeams, StateArySize ), stat=ErrStat2); if (FailedAlloc("BD%x")) return + allocate(BD%xd (p_FAST%nBeams, StateArySize ), stat=ErrStat2); if (FailedAlloc("BD%xd")) return + allocate(BD%z (p_FAST%nBeams, StateArySize ), stat=ErrStat2); if (FailedAlloc("BD%z")) return + allocate(BD%OtherSt (p_FAST%nBeams, StateArySize ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return + allocate(BD%p (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%p")) return + allocate(BD%u (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%u")) return + allocate(BD%y (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%y")) return + allocate(BD%m (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%m")) return + allocate(Init%OutData_BD (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("Init%OutData_BD")) return + + if (p_FAST%CompElast == Module_BD) then + + ! Set initialization input + Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. + Init%InData_BD%Linearize = p_FAST%Linearize + Init%InData_BD%CompAeroMaps = p_FAST%CompAeroMaps + Init%InData_BD%gravity = [0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity] ! "Gravitational acceleration" m/s^2 + Init%InData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) + Init%InData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) + + ! now initialize BeamDyn for all beams + dt_BD = p_FAST%dt_module(MODULE_BD) p_FAST%BD_OutputSibling = .true. - allocate( y_FAST%Lin%Modules(MODULE_BD)%Instance(p_FAST%nBeams), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(BD).", ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - end if - - DO k=1,p_FAST%nBeams - Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) - + DO k = 1, p_FAST%nBeams + Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM(Num2LStr(k)) Init%InData_BD%InputFile = p_FAST%BDBldFile(k) - Init%InData_BD%GlbPos = ED%y%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" Init%InData_BD%GlbRot = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" - ! These outputs are set in ElastoDyn only when BeamDyn is used: + ! These outputs are set in ElastoDyn only when BeamDyn is used: Init%InData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" Init%InData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" - Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" - Init%InData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" + Init%InData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" - CALL BD_Init( Init%InData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & - BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), dt_BD, Init%OutData_BD(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Call module initialization routine + CALL BD_Init(Init%InData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & + BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), dt_BD, Init%OutData_BD(k), ErrStat2, ErrMsg2) + if (Failed()) return !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n BD modules with n timesteps. - IF ( k == 1 ) THEN - p_FAST%dt_module( MODULE_BD ) = dt_BD - + IF (k == 1) THEN + p_FAST%dt_module(MODULE_BD) = dt_BD p_FAST%ModuleInitialized(Module_BD) = .TRUE. ! this really should be once per BD instance, but BD doesn't care so I won't go through the effort to track this CALL SetModuleSubstepTime(Module_BD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ELSEIF ( .NOT. EqualRealNos( p_FAST%dt_module( MODULE_BD ),dt_BD )) THEN - CALL SetErrStat(ErrID_Fatal,"All instances of BeamDyn (one per blade) must have the same time step.",ErrStat,ErrMsg,RoutineName) + ELSEIF (.NOT. EqualRealNos(p_FAST%dt_module(MODULE_BD), dt_BD)) THEN + ErrStat2 = ErrID_Fatal + ErrMsg2 = "All instances of BeamDyn (one per blade) must have the same time step." END IF + if (Failed()) return - ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings (but it needs to be true for all instances): + ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings (but it needs to be true for all instances): if (BD%p(k)%BldMotionNodeLoc /= BD_MESH_QP) p_FAST%BD_OutputSibling = .false. - if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName ) - - if (ErrStat>=AbortErrLev) exit !exit this loop so we don't get p_FAST%nBeams of the same errors + if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName) - if (size(y_FAST%Lin%Modules(MODULE_BD)%Instance) >= k) then ! for aero maps, we only use the first instance: - if (allocated(Init%OutData_BD(k)%LinNames_y)) call move_alloc(Init%OutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) - if (allocated(Init%OutData_BD(k)%LinNames_x)) call move_alloc(Init%OutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) - if (allocated(Init%OutData_BD(k)%LinNames_u)) call move_alloc(Init%OutData_BD(k)%LinNames_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_u ) - if (allocated(Init%OutData_BD(k)%RotFrame_y)) call move_alloc(Init%OutData_BD(k)%RotFrame_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_y ) - if (allocated(Init%OutData_BD(k)%RotFrame_x)) call move_alloc(Init%OutData_BD(k)%RotFrame_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_x ) - if (allocated(Init%OutData_BD(k)%RotFrame_u)) call move_alloc(Init%OutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) - if (allocated(Init%OutData_BD(k)%IsLoad_u )) call move_alloc(Init%OutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) - if (allocated(Init%OutData_BD(k)%DerivOrder_x)) call move_alloc(Init%OutData_BD(k)%DerivOrder_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%DerivOrder_x ) - - if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) - end if - - ! Add module instance to array of modules - CALL MV_AddModule(m_Glue%ModData, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Add module instance to array of modules, return on failure + CALL MV_AddModule(m_Glue%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & + p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) + if (Failed()) return END DO - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - END IF + !---------------------------------------------------------------------------- + ! Initialize AeroDyn14 + !---------------------------------------------------------------------------- - ! ........................ - ! initialize AeroDyn14 - ! ........................ - ALLOCATE( AD14%Input( p_FAST%InterpOrder+1 ), AD14%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD14%Input and AD14%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( AD14%Input_Saved( p_FAST%InterpOrder+1 ), AD14%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD14%Input_Saved and AD14%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(AD14%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("AD14%Input")) return + allocate(AD14%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("AD14%InputTimes")) return + allocate(AD14%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("AD14%Input_Saved")) return + allocate(AD14%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD14%x")) return + allocate(AD14%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD14%xd")) return + allocate(AD14%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD14%z")) return + allocate(AD14%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD14%OtherSt")) return - IF ( p_FAST%CompAero == Module_AD14 ) THEN + if (p_FAST%CompAero == Module_AD14) then CALL AD_SetInitInput(Init%InData_AD14, Init%OutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in Init%InData_AD14 - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return CALL AD14_Init( Init%InData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, p_FAST%dt_module( MODULE_AD14 ), Init%OutData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return p_FAST%ModuleInitialized(Module_AD14) = .TRUE. CALL SetModuleSubstepTime(Module_AD14, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return AirDens = Init%OutData_AD14%AirDens - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ENDIF - - - ! ........................ - ! initialize InflowWind - ! ........................ - ALLOCATE( IfW%Input( p_FAST%InterpOrder+1 ), IfW%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input and IfW%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( IfW%Input_Saved( p_FAST%InterpOrder+1 ), IfW%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input_Saved and IfW%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - - Init%InData_IfW%Linearize = p_FAST%Linearize - Init%InData_IfW%InputFileName = p_FAST%InflowFile - Init%InData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) - Init%InData_IfW%UseInputFile = .TRUE. - Init%InData_IfW%FixedWindFileRootName = .FALSE. - Init%InData_IfW%OutputAccel = p_FAST%MHK /= MHK_None - - Init%InData_IfW%MHK = p_FAST%MHK - Init%InData_IfW%WtrDpth = p_FAST%WtrDpth + endif - Init%InData_IfW%NumWindPoints = 0 + !---------------------------------------------------------------------------- + ! Initialize Inflow + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(IfW%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return + allocate(IfW%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return + allocate(IfW%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("IfW%Input_Saved")) return + allocate(IfW%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return + allocate(IfW%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return + allocate(IfW%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return + allocate(IfW%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return + + select case (p_FAST%CompInflow) + + case (Module_IfW) + + Init%InData_IfW%Linearize = p_FAST%Linearize + Init%InData_IfW%InputFileName = p_FAST%InflowFile + Init%InData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) + Init%InData_IfW%UseInputFile = .TRUE. + Init%InData_IfW%FixedWindFileRootName = .FALSE. + Init%InData_IfW%OutputAccel = p_FAST%MHK /= MHK_None + Init%InData_IfW%MHK = p_FAST%MHK + Init%InData_IfW%WtrDpth = p_FAST%WtrDpth - IF ( p_FAST%CompServo == Module_SrvD ) THEN + Init%InData_IfW%NumWindPoints = 0 + IF (p_FAST%CompServo == Module_SrvD) THEN Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + 1 END IF - - IF ( p_FAST%CompAero == Module_AD14 ) THEN + IF (p_FAST%CompAero == Module_AD14) THEN Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes END IF - ! lidar - Init%InData_IfW%lidar%Tmax = p_FAST%TMax - Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) - - Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_IfW%lidar%Tmax = p_FAST%TMax + Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) if ( p_FAST%CompElast == Module_BD ) then Init%InData_IfW%RadAvg = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) else Init%InData_IfW%RadAvg = Init%OutData_ED%BladeLength end if - IF ( PRESENT(ExternInitData) ) THEN + IF (PRESENT(ExternInitData)) THEN Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration if (Init%InData_IfW%Use4Dext) then @@ -551,59 +480,42 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD Init%InData_IfW%FDext%Vel => ExternInitData%windGrid_data end if ELSE - Init%InData_IfW%Use4Dext = .false. + Init%InData_IfW%Use4Dext = .false. END IF - CALL InflowWind_Init( Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & - IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Call module initialization routine + CALL InflowWind_Init(Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & + IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2) + if (Failed()) return - p_FAST%ModuleInitialized(Module_IfW) = .TRUE. CALL SetModuleSubstepTime(Module_IfW, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - allocate( y_FAST%Lin%Modules(MODULE_IfW)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_IfW%LinNames_y)) call move_alloc(Init%OutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) - if (allocated(Init%OutData_IfW%LinNames_u)) call move_alloc(Init%OutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) - if (allocated(Init%OutData_IfW%RotFrame_y)) call move_alloc(Init%OutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_IfW%RotFrame_u)) call move_alloc(Init%OutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_IfW%IsLoad_u )) call move_alloc(Init%OutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) - - if (allocated(Init%OutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(Init%OutData_IfW%WriteOutputHdr) - y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS - end if + y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS - CALL MV_AddModule(m_Glue%ModData, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + ! Add module to list of modules, return on error + CALL MV_AddModule(m_Glue%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & Init%OutData_IfW%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + if (Failed()) return IF ( p_FAST%CompServo == Module_SrvD ) THEN !assign the number of gates to ServD if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', errStat2, ErrMsg2) + CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) Init%InData_SrvD%LidSpeed = IfW%y%lidar%LidSpeed endif if (allocated(IfW%y%lidar%MsrPositionsX)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', errStat2, ErrMsg2) + CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) Init%InData_SrvD%MsrPositionsX = IfW%y%lidar%MsrPositionsX endif if (allocated(IfW%y%lidar%MsrPositionsY)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', errStat2, ErrMsg2) + CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) Init%InData_SrvD%MsrPositionsY = IfW%y%lidar%MsrPositionsY endif if (allocated(IfW%y%lidar%MsrPositionsZ)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', errStat2, ErrMsg2) + CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) Init%InData_SrvD%MsrPositionsZ = IfW%y%lidar%MsrPositionsZ endif @@ -613,8 +525,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing END IF + p_FAST%ModuleInitialized(Module_IfW) = .TRUE. - ELSEIF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + case (Module_ExtInfw) IF ( PRESENT(ExternInitData) ) THEN Init%InData_ExtInfw%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade @@ -624,35 +537,37 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL Cleanup() RETURN END IF + ! get blade and tower info from AD. Assumption made that all blades have same spanwise characteristics Init%InData_ExtInfw%BladeLength = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds) if (allocated(Init%OutData_AD%rotors(1)%TwrElev)) then Init%InData_ExtInfw%TowerHeight = Init%OutData_AD%rotors(1)%TwrElev(SIZE(Init%OutData_AD%rotors(1)%TwrElev)) - Init%OutData_AD%rotors(1)%TwrElev(1) ! TwrElev is based on ground or MSL. Need flexible tower length and first node Init%InData_ExtInfw%TowerBaseHeight = Init%OutData_AD%rotors(1)%TwrElev(1) ALLOCATE(Init%InData_ExtInfw%StructTwrHNodes( SIZE(Init%OutData_AD%rotors(1)%TwrElev)), STAT=ErrStat2) + if (FailedAlloc("Init%InData_ExtInfw%StructTwrHNodes")) return Init%InData_ExtInfw%StructTwrHNodes(:) = Init%OutData_AD%rotors(1)%TwrElev(:) else Init%InData_ExtInfw%TowerHeight = 0.0_ReKi Init%InData_ExtInfw%TowerBaseHeight = 0.0_ReKi endif - ALLOCATE(Init%InData_ExtInfw%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), STAT=ErrStat2) + + allocate(Init%InData_ExtInfw%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), stat=ErrStat2) + if (FailedAlloc("Init%InData_ExtInfw%StructBldRNodes")) return + Init%InData_ExtInfw%StructBldRNodes(:) = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(:) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ExtInfw%InitInput.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - !Set node clustering type + ! Set node clustering type Init%InData_ExtInfw%NodeClusterType = ExternInitData%NodeClusterType - ! set up the data structures for integration with ExternalInflow + + ! set up the data structures for integration with ExternalInflow CALL Init_ExtInfw( Init%InData_ExtInfw, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, ExtInfw, Init%OutData_ExtInfw, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! TODO: Fix + ! Add module to list of modules, return on error + ! CALL MV_AddModule(m_Glue%ModData, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & + ! Init%OutData_ExtInfw%Vars, ErrStat2, ErrMsg2) + ! if (Failed()) return !bjj: fix me!!! to do Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi @@ -660,45 +575,28 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! Set pointer to flowfield IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtInfw%FlowField - ELSE + case default + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi - END IF ! CompInflow - ! ........................ - ! some checks for AeroDyn14's Dynamic Inflow with Mean Wind Speed from InflowWind: - ! (DO NOT COPY THIS CODE!) - ! bjj: AeroDyn14 should not need this rule of thumb; it should check the instantaneous values when the code runs - ! ........................ + end select - IF ( p_FAST%CompAero == Module_AD14 ) THEN - IF (AD14%p%DynInfl) THEN - IF ( Init%OutData_IfW%WindFileInfo%MWS < 8.0 ) THEN - CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with wind speeds less than 8 m/s.',ErrStat,ErrMsg,RoutineName) - !CALL SetErrStat(ErrID_Info,'Estimated average inflow wind speed is less than 8 m/s. Dynamic Inflow will be turned off.',ErrStat,ErrMess,RoutineName ) - END IF - END IF - END IF + !---------------------------------------------------------------------------- + ! CompSeaSt (SeaState) + !---------------------------------------------------------------------------- - - ! ........................ - ! initialize SeaStates - ! ........................ - ALLOCATE( SeaSt%Input( p_FAST%InterpOrder+1 ), SeaSt%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input and SeaSt%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( SeaSt%Input_Saved( p_FAST%InterpOrder+1 ), SeaSt%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input_Saved and SeaSt%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(SeaSt%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return + allocate(SeaSt%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return + allocate(SeaSt%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("SeaSt%Input_Saved")) return + allocate(SeaSt%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return + allocate(SeaSt%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return + allocate(SeaSt%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return + allocate(SeaSt%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return if ( p_FAST%CompSeaSt == Module_SeaSt ) then + Init%InData_SeaSt%TMax = p_FAST%TMax Init%InData_SeaSt%Gravity = p_FAST%Gravity Init%InData_SeaSt%defWtrDens = p_FAST%WtrDens Init%InData_SeaSt%defWtrDpth = p_FAST%WtrDpth @@ -709,23 +607,23 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD Init%InData_SeaSt%InputFile = p_FAST%SeaStFile Init%InData_SeaSt%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SeaSt)) - ! these values support wave field handling + ! these values support wave field handling Init%InData_SeaSt%WaveFieldMod = p_FAST%WaveFieldMod Init%InData_SeaSt%PtfmLocationX = p_FAST%TurbinePos(1) Init%InData_SeaSt%PtfmLocationY = p_FAST%TurbinePos(2) - Init%InData_SeaSt%TMax = p_FAST%TMax - - ! wave field visualization + ! wave field visualization if (p_FAST%WrVTK == VTK_Animate .and. p_FAST%VTK_Type == VTK_Surf) Init%InData_SeaSt%SurfaceVis = .true. - - CALL SeaSt_Init( Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & - SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module( MODULE_SeaSt ), Init%OutData_SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. - CALL SetModuleSubstepTime(Module_SeaSt, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Call module initialization routine + CALL SeaSt_Init(Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & + SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module(MODULE_SeaSt), Init%OutData_SeaSt, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Add module to array, return on error + call MV_AddModule(m_Glue%Modules, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & + Init%OutData_SeaSt%Vars, ErrStat2, ErrMsg2) + if (Failed()) return if (allocated(Init%OutData_SeaSt%WaveElevVisGrid)) then p_FAST%VTK_surface%NWaveElevPts(1) = size(Init%OutData_SeaSt%WaveElevVisX) @@ -735,41 +633,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD p_FAST%VTK_surface%NWaveElevPts(2) = 0 endif - CALL MV_AddModule(m_Glue%ModData, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & - Init%OutData_SeaSt%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SeaSt).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_SeaSt%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%NumOutputs = size(Init%OutData_SeaSt%WriteOutputHdr) - end if + p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - end if + !---------------------------------------------------------------------------- + ! Initialize AeroDyn15 + !---------------------------------------------------------------------------- - ! ........................ - ! initialize AeroDyn15 - ! ........................ - ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( AD%Input_Saved( p_FAST%InterpOrder+1 ), AD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(AD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("AD%Input")) return + allocate(AD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return + allocate(AD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("AD%Input_Saved")) return + allocate(AD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD%x")) return + allocate(AD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return + allocate(AD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD%z")) return + allocate(AD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN @@ -798,15 +677,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD end if - ! set initialization data for AD - CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootOrientation', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! set initialization data for AD + call AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) + if (Failed()) return + + call AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootOrientation', errStat2, ErrMsg2) + if (Failed()) return Init%InData_AD%Gravity = p_FAST%Gravity Init%InData_AD%Linearize = p_FAST%Linearize @@ -843,46 +719,30 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! Set pointers to flowfield IF (p_FAST%CompInflow == Module_IfW) Init%InData_AD%FlowField => Init%OutData_IfW%FlowField + ! Call module initialization subroutine CALL AD_Init( Init%InData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), Init%OutData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return p_FAST%ModuleInitialized(Module_AD) = .TRUE. CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_AD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_AD%rotors(1)%LinNames_u )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) - if (allocated(Init%OutData_AD%rotors(1)%LinNames_y )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) - if (allocated(Init%OutData_AD%rotors(1)%LinNames_x )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_x ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_u )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_y )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_x )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_x ) - if (allocated(Init%OutData_AD%rotors(1)%IsLoad_u )) call move_alloc(Init%OutData_AD%rotors(1)%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_AD%rotors(1)%DerivOrder_x)) call move_alloc(Init%OutData_AD%rotors(1)%DerivOrder_x,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%DerivOrder_x ) - - if (allocated(Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%rotors(1)%WriteOutputHdr) - end if + if (Failed()) return ! Initialize a module instance for each rotor do i = 1, size(Init%OutData_AD%rotors) - CALL MV_AddModule(m_Glue%ModData, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%Modules, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & Init%OutData_AD%rotors(i)%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return end do - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - AirDens = Init%OutData_AD%rotors(1)%AirDens END IF ! CompAero + !---------------------------------------------------------------------------- + ! External Loads + !---------------------------------------------------------------------------- + IF ( p_FAST%CompAero == Module_ExtLd ) THEN IF ( PRESENT(ExternInitData) ) THEN @@ -890,353 +750,237 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! set initialization data for ExtLoads CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! TODO: Fix + ! Add module to list of modules, return on error + ! CALL MV_AddModule(m_Glue%ModData, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + ! Init%OutData_ExtLd%Vars, ErrStat2, ErrMsg2) + ! if (Failed()) return AirDens = Init%OutData_ExtLd%AirDens + p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. + END IF END IF - ! ........................ ! No aero of any sort - ! ........................ - IF ( (p_FAST%CompAero /= Module_AD14) .and. (p_FAST%CompAero /= Module_AD) .and. (p_FAST%CompAero /= Module_ExtLd) ) THEN - ELSE + if (.not. ((p_FAST%CompAero == Module_AD14) .or. (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd))) then AirDens = 0.0_ReKi - ENDIF - + endif + !---------------------------------------------------------------------------- + ! Initialize SuperController + !---------------------------------------------------------------------------- - ! ........................ - ! initialize SuperController - ! ........................ - IF ( PRESENT(ExternInitData) ) THEN - ! set up the data structures for integration with supercontroller - IF ( p_FAST%UseSC ) THEN - CALL SC_DX_Init( ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE + if (present(ExternInitData)) then + if (p_FAST%UseSC) then + call SC_DX_Init(ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2) + if (Failed()) return + else SC_DX%u%c_obj%toSC_Len = 0 SC_DX%u%c_obj%toSC = C_NULL_PTR SC_DX%y%c_obj%fromSC_Len = 0 SC_DX%y%c_obj%fromSC = C_NULL_PTR SC_DX%y%c_obj%fromSCglob_Len = 0 SC_DX%y%c_obj%fromSCglob = C_NULL_PTR - END IF - END IF - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - ! ........................ - ! initialize HydroDyn - ! ........................ - ALLOCATE( HD%Input( p_FAST%InterpOrder+1 ), HD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input and HD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( HD%Input_Saved( p_FAST%InterpOrder+1 ), HD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input_Saved and HD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF ( p_FAST%CompHydro == Module_HD ) THEN + end if + end if - Init%InData_HD%Gravity = p_FAST%Gravity - Init%InData_HD%UseInputFile = .TRUE. - Init%InData_HD%InputFile = p_FAST%HydroFile - Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) - Init%InData_HD%TMax = p_FAST%TMax - Init%InData_HD%Linearize = p_FAST%Linearize - if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. - - ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true - Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn - Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField - ! end if + !---------------------------------------------------------------------------- + ! CompHydro (HydroDyn) + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(HD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("HD%Input")) return + allocate(HD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("HD%InputTimes")) return + allocate(HD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("HD%Input_Saved")) return + allocate(HD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("HD%x")) return + allocate(HD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("HD%xd")) return + allocate(HD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("HD%z")) return + allocate(HD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("HD%OtherSt")) return + + IF (p_FAST%CompHydro == Module_HD) THEN + + Init%InData_HD%Gravity = p_FAST%Gravity + Init%InData_HD%UseInputFile = .TRUE. + Init%InData_HD%InputFile = p_FAST%HydroFile + Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) + Init%InData_HD%TMax = p_FAST%TMax + Init%InData_HD%Linearize = p_FAST%Linearize + Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn + Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField + if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes = .true. + ! Call module initialization routine + CALL HydroDyn_Init(Init%InData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & + HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module(MODULE_HD), Init%OutData_HD, ErrStat2, ErrMsg2) + if (Failed()) return - CALL HydroDyn_Init( Init%InData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & - HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module( MODULE_HD ), Init%OutData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - p_FAST%ModuleInitialized(Module_HD) = .TRUE. CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - CALL MV_AddModule(m_Glue%ModData, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & Init%OutData_HD%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - allocate( y_FAST%Lin%Modules(MODULE_HD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(HD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_HD%LinNames_y)) call move_alloc(Init%OutData_HD%LinNames_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_y ) - if (allocated(Init%OutData_HD%LinNames_u)) call move_alloc(Init%OutData_HD%LinNames_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_u ) - if (allocated(Init%OutData_HD%LinNames_x)) call move_alloc(Init%OutData_HD%LinNames_x, y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_x ) - if (allocated(Init%OutData_HD%DerivOrder_x)) call move_alloc(Init%OutData_HD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%DerivOrder_x) - if (allocated(Init%OutData_HD%IsLoad_u )) call move_alloc(Init%OutData_HD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%IsLoad_u ) - - if (allocated(Init%OutData_HD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%NumOutputs = size(Init%OutData_HD%WriteOutputHdr) - end if + p_FAST%ModuleInitialized(Module_HD) = .TRUE. - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF END IF ! CompHydro - ! ........................ - ! initialize SubDyn or ExtPtfm_MCKF - ! ........................ - ALLOCATE( SD%Input( p_FAST%InterpOrder+1 ), SD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input and SD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( SD%Input_Saved( p_FAST%InterpOrder+1 ), SD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input_Saved and SD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( ExtPtfm%Input( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input and ExtPtfm%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( ExtPtfm%Input_Saved( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input_Saved and ExtPtfm%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF ( p_FAST%CompSub == Module_SD ) THEN - - IF ( p_FAST%CompHydro == Module_HD ) THEN + !---------------------------------------------------------------------------- + ! CompSub (SubDyn or ExtPtfm) + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(SD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("SD%Input")) return + allocate(SD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("SD%InputTimes")) return + allocate(SD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("SD%Input_Saved")) return + allocate(SD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("SD%x")) return + allocate(SD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("SD%xd")) return + allocate(SD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("SD%z")) return + allocate(SD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("SD%OtherSt")) return + + ! Allocate module data arrays + allocate(ExtPtfm%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input")) return + allocate(ExtPtfm%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%InputTimes")) return + allocate(ExtPtfm%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input_Saved")) return + allocate(ExtPtfm%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%x")) return + allocate(ExtPtfm%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%xd")) return + allocate(ExtPtfm%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%z")) return + allocate(ExtPtfm%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%OtherSt")) return + + select case (p_FAST%CompSub) + + case (Module_SD) + + Init%InData_SD%WtrDpth = 0.0_ReKi + if (p_FAST%CompHydro == Module_HD) then Init%InData_SD%WtrDpth = Init%OutData_SeaSt%WaveField%WtrDpth - ELSE - Init%InData_SD%WtrDpth = 0.0_ReKi - END IF + end if Init%InData_SD%Linearize = p_FAST%Linearize Init%InData_SD%g = p_FAST%Gravity - !Ini%tInData_SD%UseInputFile = .TRUE. Init%InData_SD%SDInputFile = p_FAST%SubFile Init%InData_SD%RootName = p_FAST%OutFileRoot Init%InData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! "Interface point" where loads will be transferred to - Init%InData_SD%SubRotateZ = 0.0 ! Used by driver to rotate structure around z - + Init%InData_SD%SubRotateZ = 0.0 ! Used by driver to rotate structure around z CALL SD_Init( Init%InData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), Init%OutData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - p_FAST%ModuleInitialized(Module_SD) = .TRUE. CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - allocate( y_FAST%Lin%Modules(MODULE_SD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_SD%LinNames_y)) call move_alloc(Init%OutData_SD%LinNames_y,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_y) - if (allocated(Init%OutData_SD%LinNames_x)) call move_alloc(Init%OutData_SD%LinNames_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_x) - if (allocated(Init%OutData_SD%LinNames_u)) call move_alloc(Init%OutData_SD%LinNames_u,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_u) - if (allocated(Init%OutData_SD%RotFrame_y)) call move_alloc(Init%OutData_SD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_y) - if (allocated(Init%OutData_SD%RotFrame_x)) call move_alloc(Init%OutData_SD%RotFrame_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_x) - if (allocated(Init%OutData_SD%RotFrame_u)) call move_alloc(Init%OutData_SD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_u) - if (allocated(Init%OutData_SD%IsLoad_u )) call move_alloc(Init%OutData_SD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_SD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%NumOutputs = size(Init%OutData_SD%WriteOutputHdr) - if (allocated(Init%OutData_SD%DerivOrder_x)) call move_alloc(Init%OutData_SD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%DerivOrder_x) - end if - - CALL MV_AddModule(m_Glue%ModData, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & Init%OutData_SD%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + p_FAST%ModuleInitialized(Module_SD) = .TRUE. + + case (Module_ExtPtfm) Init%InData_ExtPtfm%InputFile = p_FAST%SubFile - Init%InData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) + Init%InData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//y_FAST%Module_Abrev(Module_ExtPtfm) Init%InData_ExtPtfm%Linearize = p_FAST%Linearize Init%InData_ExtPtfm%PtfmRefzt = ED%p%PtfmRefzt ! Required - CALL ExtPtfm_Init( Init%InData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & - ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), & - ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module( MODULE_ExtPtfm ), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL ExtPtfm_Init(Init%InData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & + ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), & + ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module(MODULE_ExtPtfm), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2) + if (Failed()) return - p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. CALL SetModuleSubstepTime(MODULE_ExtPtfm, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ExtPtfm).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_ExtPtfm%LinNames_y)) call move_alloc(Init%OutData_ExtPtfm%LinNames_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_y) - if (allocated(Init%OutData_ExtPtfm%LinNames_x)) call move_alloc(Init%OutData_ExtPtfm%LinNames_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_x) - if (allocated(Init%OutData_ExtPtfm%LinNames_u)) call move_alloc(Init%OutData_ExtPtfm%LinNames_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_u) - if (allocated(Init%OutData_ExtPtfm%RotFrame_y)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_y) - if (allocated(Init%OutData_ExtPtfm%RotFrame_x)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_x) - if (allocated(Init%OutData_ExtPtfm%RotFrame_u)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_u) - if (allocated(Init%OutData_ExtPtfm%IsLoad_u )) call move_alloc(Init%OutData_ExtPtfm%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_ExtPtfm%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%NumOutputs = size(Init%OutData_ExtPtfm%WriteOutputHdr) - if (allocated(Init%OutData_ExtPtfm%DerivOrder_x)) call move_alloc(Init%OutData_ExtPtfm%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%DerivOrder_x) - end if + if (Failed()) return + + p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + end select - END IF + !---------------------------------------------------------------------------- + ! CompMooring + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(MAPp%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%Input")) return + allocate(MAPp%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%InputTimes")) return + allocate(MAPp%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("MAPp%Input_Saved")) return + allocate(MAPp%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%x")) return + allocate(MAPp%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%xd")) return + allocate(MAPp%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%z")) return + ! allocate(MAPp%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%OtherSt")) return + + ! Allocate module data arrays + allocate(MD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("MD%Input")) return + allocate(MD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("MD%InputTimes")) return + allocate(MD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("MD%Input_Saved")) return + allocate(MD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("MD%x")) return + allocate(MD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("MD%xd")) return + allocate(MD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("MD%z")) return + allocate(MD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("MD%OtherSt")) return + + ! Allocate module data arrays + allocate(FEAM%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%Input")) return + allocate(FEAM%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%InputTimes")) return + allocate(FEAM%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("FEAM%Input_Saved")) return + allocate(FEAM%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%x")) return + allocate(FEAM%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%xd")) return + allocate(FEAM%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%z")) return + allocate(FEAM%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%OtherSt")) return + + ! Allocate module data arrays + allocate(Orca%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("Orca%Input")) return + allocate(Orca%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("Orca%InputTimes")) return + allocate(Orca%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("Orca%Input_Saved")) return + allocate(Orca%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("Orca%x")) return + allocate(Orca%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("Orca%xd")) return + allocate(Orca%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("Orca%z")) return + allocate(Orca%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("Orca%OtherSt")) return + + + select case (p_FAST%CompMooring) + + case (Module_MAP) - ! ------------------------------ - ! initialize CompMooring modules - ! ------------------------------ - ALLOCATE( MAPp%Input( p_FAST%InterpOrder+1 ), MAPp%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input and MAPp%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( MAPp%Input_Saved( p_FAST%InterpOrder+1 ), MAPp%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input_Saved and MAPp%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( MD%Input( p_FAST%InterpOrder+1 ), MD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input and MD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( MD%Input_Saved( p_FAST%InterpOrder+1 ), MD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input_Saved and MD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( FEAM%Input( p_FAST%InterpOrder+1 ), FEAM%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input and FEAM%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( FEAM%Input_Saved( p_FAST%InterpOrder+1 ), FEAM%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input_Saved and FEAM%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( Orca%Input( p_FAST%InterpOrder+1 ), Orca%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input and Orca%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( Orca%Input_Saved( p_FAST%InterpOrder+1 ), Orca%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input_Saved and Orca%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ! ........................ - ! initialize MAP - ! ........................ - IF (p_FAST%CompMooring == Module_MAP) THEN !bjj: until we modify this, MAP requires HydroDyn to be used. (perhaps we could send air density from AeroDyn or something...) CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. -! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name - Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver + ! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name + Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver Init%InData_MAP%sea_density = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState - ! differences for MAP++ + ! differences for MAP++ Init%InData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name Init%InData_MAP%depth = -Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize - CALL MAP_Init(Init%InData_MAP, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & - MAPp%y, MAPp%m, p_FAST%dt_module( MODULE_MAP ), Init%OutData_MAP, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL MAP_Init(Init%InData_MAP, MAPp%Input(1), MAPp%p, & + MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y, MAPp%m, p_FAST%dt_module(MODULE_MAP), Init%OutData_MAP, ErrStat2, ErrMsg2) + if (Failed()) return p_FAST%ModuleInitialized(Module_MAP) = .TRUE. CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - CALL MV_AddModule(m_Glue%ModData, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & + CALL MV_AddModule(m_Glue%Modules, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & Init%OutData_MAP%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - allocate( y_FAST%Lin%Modules(Module_MAP)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MAP).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_MAP%LinInitOut%LinNames_y)) call move_alloc(Init%OutData_MAP%LinInitOut%LinNames_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_y ) - if (allocated(Init%OutData_MAP%LinInitOut%LinNames_u)) call move_alloc(Init%OutData_MAP%LinInitOut%LinNames_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_u ) - if (allocated(Init%OutData_MAP%LinInitOut%IsLoad_u )) call move_alloc(Init%OutData_MAP%LinInitOut%IsLoad_u ,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%IsLoad_u ) - - if (allocated(Init%OutData_MAP%WriteOutputHdr)) y_FAST%Lin%Modules(Module_MAP)%Instance(1)%NumOutputs = size(Init%OutData_MAP%WriteOutputHdr) - end if + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ - ! initialize MoorDyn - ! ........................ - ELSEIF (p_FAST%CompMooring == Module_MD) THEN + case (Module_MD) ! some new allocations needed with version that's compatible with farm-level use - ALLOCATE( Init%InData_MD%PtfmInit(6,1), Init%InData_MD%TurbineRefPos(3,1), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MoorDyn PtfmInit and TurbineRefPos initialization inputs.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + allocate(Init%InData_MD%PtfmInit (6,1), stat=ErrStat2); if (FailedAlloc("Init%InData_MD%PtfmInit")) return + allocate(Init%InData_MD%TurbineRefPos(3,1), stat=ErrStat2); if (FailedAlloc("Init%InData_MD%TurbineRefPos")) return Init%InData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_MD%RootName = p_FAST%OutFileRoot @@ -1250,69 +994,47 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD Init%InData_MD%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) Init%InData_MD%Linearize = p_FAST%Linearize - if (p_FAST%WrVTK /= VTK_None) Init%InData_MD%VisMeshes=.true. + if (p_FAST%WrVTK /= VTK_None) Init%InData_MD%VisMeshes = .true. CALL MD_Init( Init%InData_MD, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & MD%OtherSt(STATE_CURR), MD%y, MD%m, p_FAST%dt_module( MODULE_MD ), Init%OutData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return p_FAST%ModuleInitialized(Module_MD) = .TRUE. CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_MD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_MD%LinNames_y)) call move_alloc(Init%OutData_MD%LinNames_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_y) - if (allocated(Init%OutData_MD%LinNames_x)) call move_alloc(Init%OutData_MD%LinNames_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_x) - if (allocated(Init%OutData_MD%LinNames_u)) call move_alloc(Init%OutData_MD%LinNames_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_u) - if (allocated(Init%OutData_MD%RotFrame_y)) call move_alloc(Init%OutData_MD%RotFrame_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_y) - if (allocated(Init%OutData_MD%RotFrame_x)) call move_alloc(Init%OutData_MD%RotFrame_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_x) - if (allocated(Init%OutData_MD%RotFrame_u)) call move_alloc(Init%OutData_MD%RotFrame_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_u) - if (allocated(Init%OutData_MD%IsLoad_u )) call move_alloc(Init%OutData_MD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_MD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%NumOutputs = size(Init%OutData_MD%WriteOutputHdr) - if (allocated(Init%OutData_MD%DerivOrder_x)) call move_alloc(Init%OutData_MD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%DerivOrder_x) - end if + if (Failed()) return - CALL MV_AddModule(m_Glue%ModData, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%Modules, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & Init%OutData_MD%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ - ! initialize FEAM - ! ........................ - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + case (Module_FEAM) Init%InData_FEAM%InputFile = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) - Init%InData_FEAM%PtfmInit = Init%OutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED - Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) - Init%InData_FEAM%gravity = p_FAST%Gravity ! This need to be according to g from driver - Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState -! Init%InData_FEAM%depth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState + Init%InData_FEAM%PtfmInit = Init%OutData_ED%PlatformPos ! ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED + Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) + Init%InData_FEAM%gravity = p_FAST%Gravity ! This need to be according to g from driver + Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState + ! Init%InData_FEAM%depth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState - CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & - FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), Init%OutData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL FEAM_Init(Init%InData_FEAM, FEAM%Input(1), FEAM%p, & + FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & + FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module(MODULE_FEAM), & + Init%OutData_FEAM, ErrStat2, ErrMsg2) + if (Failed()) return p_FAST%ModuleInitialized(Module_FEAM) = .TRUE. CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ - ! initialize OrcaFlex Interface - ! ........................ - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + ! TODO + ! CALL MV_AddModule(m_Glue%ModData, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & + ! Init%OutData_FEAM%Vars, ErrStat2, ErrMsg2) + ! if (Failed()) return + + case (Module_Orca) Init%InData_Orca%InputFile = p_FAST%MooringFile Init%InData_Orca%RootName = p_FAST%OutFileRoot @@ -1320,79 +1042,37 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL Orca_Init( Init%InData_Orca, Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & Orca%y, Orca%m, p_FAST%dt_module( MODULE_Orca ), Init%OutData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return p_FAST%ModuleInitialized(MODULE_Orca) = .TRUE. CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - END IF + ! TODO + ! CALL MV_AddModule(m_Glue%ModData, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & + ! Init%OutData_Orca%Vars, ErrStat2, ErrMsg2) + ! if (Failed()) return - ! ------------------------------ - ! initialize CompIce modules - ! ------------------------------ - ALLOCATE( IceF%Input( p_FAST%InterpOrder+1 ), IceF%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input and IceF%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + END select - ALLOCATE( IceF%Input_Saved( p_FAST%InterpOrder+1 ), IceF%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input_Saved and IceF%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + !---------------------------------------------------------------------------- + ! CompIce (IceD and IceF) + !---------------------------------------------------------------------------- - ! We need this to be allocated (else we have issues passing nonallocated arrays and using the first index of Input(), - ! but we don't need the space of IceD_MaxLegs if we're not using it. - IF ( p_FAST%CompIce /= Module_IceD ) THEN - IceDim = 1 - ELSE - IceDim = IceD_MaxLegs - END IF + !------------------------------------- + ! Initialize IceFloe + !------------------------------------- - ! because there may be multiple instances of IceDyn, we'll allocate arrays for that here - ! we could allocate these after - ALLOCATE( IceD%Input( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input and IceD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(IceF%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("IceF%Input")) return + allocate(IceF%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("IceF%InputTimes")) return + allocate(IceF%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("IceF%Input_Saved")) return + allocate(IceF%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("IceF%x")) return + allocate(IceF%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("IceF%xd")) return + allocate(IceF%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("IceF%z")) return + allocate(IceF%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("IceF%OtherSt")) return - ALLOCATE( IceD%Input_Saved( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes_Saved( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input_Saved and IceD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( IceD%x( IceDim,4), & - IceD%xd( IceDim,4), & - IceD%z( IceDim,4), & - IceD%OtherSt( IceDim,4), & - IceD%p( IceDim ), & - IceD%u( IceDim ), & - IceD%y( IceDim ), & - IceD%m( IceDim ), & - STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceD state, input, and output data.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - - ! ........................ - ! initialize IceFloe - ! ........................ - IF ( p_FAST%CompIce == Module_IceF ) THEN + IF (p_FAST%CompIce == Module_IceF) THEN Init%InData_IceF%InputFile = p_FAST%IceFile Init%InData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) @@ -1402,20 +1082,43 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL IceFloe_Init( Init%InData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), Init%OutData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return + + CALL SetModuleSubstepTime(Module_IceF, p_FAST, y_FAST, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Add module to list of modules + ! CALL MV_AddModule(m_Glue%ModData, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) + ! if (Failed()) return p_FAST%ModuleInitialized(Module_IceF) = .TRUE. - CALL SetModuleSubstepTime(Module_IceF, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ - ! initialize IceDyn - ! ........................ - ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + end if + + !------------------------------------- + ! Initialize IceDyn + !------------------------------------- + + ! We need this to be allocated (else we have issues passing nonallocated arrays and using the first index of Input(), + ! but we don't need the space of IceD_MaxLegs if we're not using it. + IceDim = 1 + IF (p_FAST%CompIce == Module_IceD) IceDim = IceD_MaxLegs + + ! Allocate module data arrays + allocate(IceD%Input (InputArySize, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input")) return + allocate(IceD%InputTimes (InputArySize, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%InputTimes")) return + allocate(IceD%Input_Saved (InputSavedArySize, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input_Saved")) return + allocate(IceD%x (IceDim, StateArySize), stat=ErrStat2); if (FailedAlloc("IceD%x")) return + allocate(IceD%xd (IceDim, StateArySize), stat=ErrStat2); if (FailedAlloc("IceD%xd")) return + allocate(IceD%z (IceDim, StateArySize), stat=ErrStat2); if (FailedAlloc("IceD%z")) return + allocate(IceD%OtherSt (IceDim, StateArySize), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return + allocate(IceD%p (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%p")) return + allocate(IceD%u (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%u")) return + allocate(IceD%y (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%y")) return + allocate(IceD%m (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%m")) return + + IF (p_FAST%CompIce == Module_IceD) THEN Init%InData_IceD%InputFile = p_FAST%IceFile Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' @@ -1427,14 +1130,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL IceD_Init( Init%InData_IceD, IceD%Input(1,1), IceD%p(1), IceD%x(1,STATE_CURR), IceD%xd(1,STATE_CURR), IceD%z(1,STATE_CURR), & IceD%OtherSt(1,STATE_CURR), IceD%y(1), IceD%m(1), p_FAST%dt_module( MODULE_IceD ), Init%OutData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - p_FAST%ModuleInitialized(Module_IceD) = .TRUE. CALL SetModuleSubstepTime(Module_IceD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - ! now initialize IceD for additional legs (if necessary) - dt_IceD = p_FAST%dt_module( MODULE_IceD ) + ! now initialize IceD for additional legs (if necessary) + dt_IceD = p_FAST%dt_module(MODULE_IceD) p_FAST%numIceLegs = Init%OutData_IceD%numLegs IF (p_FAST%numIceLegs > IceD_MaxLegs) THEN @@ -1444,45 +1146,45 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD DO i=2,p_FAST%numIceLegs ! basically, we just need IceDyn to set up its meshes for inputs/outputs and possibly initial values for states + Init%InData_IceD%LegNum = i Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//TRIM(Num2LStr(i)) CALL IceD_Init( Init%InData_IceD, IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), dt_IceD, Init%OutData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n IceD modules with n timesteps. - IF (.NOT. EqualRealNos( p_FAST%dt_module( MODULE_IceD ),dt_IceD )) THEN + IF (.NOT. EqualRealNos( p_FAST%dt_module(MODULE_IceD),dt_IceD )) THEN CALL SetErrStat(ErrID_Fatal,"All instances of IceDyn (one per support-structure leg) must be the same",ErrStat,ErrMsg,RoutineName) + return END IF + + ! Add module to list of modules + ! CALL MV_AddModule(m_Glue%ModData, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) + ! if (Failed()) return END DO - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + p_FAST%ModuleInitialized(Module_IceD) = .TRUE. END IF + !---------------------------------------------------------------------------- + ! CompServo (ServoDyn) + !---------------------------------------------------------------------------- - ! ........................ - ! initialize ServoDyn - ! ........................ - ALLOCATE( SrvD%Input( p_FAST%InterpOrder+1 ), SrvD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input and SrvD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( SrvD%Input_Saved( p_FAST%InterpOrder+1 ), SrvD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input_Saved and SrvD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(SrvD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%Input")) return + allocate(SrvD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%InputTimes")) return + allocate(SrvD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("SrvD%Input_Saved")) return + allocate(SrvD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%x")) return + allocate(SrvD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%xd")) return + allocate(SrvD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%z")) return + allocate(SrvD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%OtherSt")) return IF ( p_FAST%CompServo == Module_SrvD ) THEN + Init%InData_SrvD%InputFile = p_FAST%ServoFile Init%InData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) Init%InData_SrvD%NumBl = Init%OutData_ED%NumBl @@ -1508,18 +1210,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed Init%InData_SrvD%InterpOrder = p_FAST%InterpOrder - CALL AllocAry( Init%InData_SrvD%BladeRootRefPos, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootRefPos', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootTransDisp, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootTransDisp', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootRefOrient, 3, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootRefOrient', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootOrient, 3, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootOrient', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + CALL AllocAry(Init%InData_SrvD%BladeRootRefPos, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootRefPos', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(Init%InData_SrvD%BladeRootTransDisp, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootTransDisp', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(Init%InData_SrvD%BladeRootRefOrient, 3, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootRefOrient', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(Init%InData_SrvD%BladeRootOrient, 3, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootOrient', ErrStat2, ErrMsg2); if (Failed()) return + do k=1,Init%OutData_ED%NumBl Init%InData_SrvD%BladeRootRefPos(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) Init%InData_SrvD%BladeRootTransDisp(:,k) = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) @@ -1527,16 +1222,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y%BladeRootMotion(k)%Orientation(:,:,1) enddo - IF ( PRESENT(ExternInitData) ) THEN Init%InData_SrvD%NumSC2CtrlGlob = ExternInitData%NumSC2CtrlGlob IF ( (Init%InData_SrvD%NumSC2CtrlGlob > 0) ) THEN CALL AllocAry( Init%InData_SrvD%fromSCGlob, Init%InData_SrvD%NumSC2CtrlGlob, 'Init%InData_SrvD%fromSCGlob', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + if (Failed()) return do i=1,Init%InData_SrvD%NumSC2CtrlGlob Init%InData_SrvD%fromSCGlob(i) = ExternInitData%fromSCGlob(i) @@ -1546,11 +1236,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD Init%InData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl IF ( (Init%InData_SrvD%NumSC2Ctrl > 0) ) THEN CALL AllocAry( Init%InData_SrvD%fromSC, Init%InData_SrvD%NumSC2Ctrl, 'Init%InData_SrvD%fromSC', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + if (Failed()) return do i=1,Init%InData_SrvD%NumSC2Ctrl Init%InData_SrvD%fromSC(i) = ExternInitData%fromSC(i) @@ -1568,59 +1254,33 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! Set cable controls inputs (if requested by other modules) -- There is probably a nicer way to do this, but this will work for now. call SetSrvDCableControls() - CALL AllocAry(Init%InData_SrvD%BlPitchInit, Init%OutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them - CALL Cleanup() - RETURN - end if + if (Failed()) return Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch CALL SrvD_Init( Init%InData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), Init%OutData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return p_FAST%ModuleInitialized(Module_SrvD) = .TRUE. !IF ( Init%OutData_SrvD%CouplingScheme == ExplicitLoose ) THEN ... bjj: abort if we're doing anything else! CALL SetModuleSubstepTime(Module_SrvD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return - CALL MV_AddModule(m_Glue%ModData, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + ! Add module to list of modules + CALL MV_AddModule(m_Glue%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & Init%OutData_SrvD%Vars, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return !! initialize SrvD%y%ElecPwr and SrvD%y%GenTq because they are one timestep different (used as input for the next step)? - allocate( y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SrvD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_SrvD%LinNames_y)) call move_alloc(Init%OutData_SrvD%LinNames_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_y ) - if (allocated(Init%OutData_SrvD%LinNames_u)) call move_alloc(Init%OutData_SrvD%LinNames_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_u ) - if (allocated(Init%OutData_SrvD%LinNames_x)) call move_alloc(Init%OutData_SrvD%LinNames_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_x ) - if (allocated(Init%OutData_SrvD%RotFrame_y)) call move_alloc(Init%OutData_SrvD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_SrvD%RotFrame_u)) call move_alloc(Init%OutData_SrvD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_SrvD%RotFrame_x)) call move_alloc(Init%OutData_SrvD%RotFrame_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_x ) - if (allocated(Init%OutData_SrvD%IsLoad_u )) call move_alloc(Init%OutData_SrvD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_SrvD%DerivOrder_x)) call move_alloc(Init%OutData_SrvD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%DerivOrder_x) - - if (allocated(Init%OutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(Init%OutData_SrvD%WriteOutputHdr) - end if - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - ! ........................ - ! some checks for AeroDyn and ElastoDyn inputs with the high-speed shaft brake hack in ElastoDyn: - ! (DO NOT COPY THIS CODE!) - ! ........................ - ! bjj: this is a hack to get high-speed shaft braking in FAST v8 - + ! ........................ + ! some checks for AeroDyn and ElastoDyn inputs with the high-speed shaft brake hack in ElastoDyn: + ! (DO NOT COPY THIS CODE!) + ! ........................ + + ! bjj: this is a hack to get high-speed shaft braking in FAST v8 IF ( Init%OutData_SrvD%UseHSSBrake ) THEN IF ( p_FAST%CompAero == Module_AD14 ) THEN IF ( AD14%p%DYNINFL ) THEN @@ -1634,83 +1294,55 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ENDIF END IF ! Init%OutData_SrvD%UseHSSBrake - END IF - ! ........................ - ! Set up output for glue code (must be done after all modules are initialized so we have their WriteOutput information) - ! ........................ - - CALL FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !---------------------------------------------------------------------------- + ! Set up output for glue code + ! (must be done after all modules are initialized so we have their WriteOutput information) + !---------------------------------------------------------------------------- + CALL FAST_InitOutput(p_FAST, y_FAST, Init, ErrStat2, ErrMsg2) + if (Failed()) return - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- ! Initialize mesh-mapping data - ! ------------------------------------------------------------------------- - - CALL InitModuleMappings(p_FAST, ED, BD, AD14, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - ELSEIF (ErrStat /= ErrID_None) THEN - ! a little work-around in case the mesh mapping info messages get too long - CALL WrScr( NewLine//TRIM(ErrMsg)//NewLine ) - ErrStat = ErrID_None - ErrMsg = "" - END IF - - ! ------------------------------------------------------------------------- - ! Initialize for linearization or computing aero maps: - ! ------------------------------------------------------------------------- - if ( p_FAST%Linearize .or. p_FAST%CompAeroMaps) then - ! NOTE: In the following call, we use Init%OutData_AD%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, which - ! is consistent with the current AD implementation, but if AD changes this, then it must be handled here, too! - ! if (p_FAST%CompAero == MODULE_AD) then - ! call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) - ! else - ! call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) - ! endif - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! if (ErrStat >= AbortErrLev) then - ! call Cleanup() - ! return - ! end if - - ! if (p_FAST%CompAeroMaps) then - ! p_FAST%SizeJac_Opt1(1) = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL) - ! p_FAST%TolerSquared = p_FAST%TolerSquared * (p_FAST%SizeJac_Opt1(1)**2) ! do this calculation here so we don't have to keep dividing by the size of the array later - ! p_FAST%NumBl_Lin = 1 - ! else - ! p_FAST%NumBl_Lin = NumBl - ! end if - - end if - + !---------------------------------------------------------------------------- + + CALL InitModuleMappings(p_FAST, ED, BD, AD14, AD, ExtLd, HD, SD, ExtPtfm, & + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, & + ErrStat2, ErrMsg2) + if (Failed()) return + + ! Print warning messages from module mapping + ! a little work-around in case the mesh mapping info messages get too long + IF (ErrStat /= ErrID_None) THEN + CALL WrScr( NewLine//TRIM(ErrMsg)//NewLine ) + ErrStat = ErrID_None + ErrMsg = "" + END IF - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- ! Initialize data for VTK output - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + if ( p_FAST%WrVTK > VTK_None ) then call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_AD, Init%OutData_SeaSt, Init%OutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- ! Write initialization data to FAST summary file: - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + if (p_FAST%SumPrint) then CALL FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) endif - - ! ------------------------------------------------------------------------- - ! other misc variables initialized here: - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + ! Other misc variables initialized + !---------------------------------------------------------------------------- m_FAST%t_global = t_initial @@ -1747,26 +1379,36 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD endif end if + !---------------------------------------------------------------------------- + ! Cleanup + !---------------------------------------------------------------------------- - - - !............................................................................................................................... - ! Destroy initializion data - !............................................................................................................................... + ! Deallocate arrays that are no longer used CALL Cleanup() CONTAINS + SUBROUTINE Cleanup() - !............................................................................................................................... - ! Destroy initializion data - !............................................................................................................................... - ! We assume that all initializion data points to parameter data, so we just nullify the pointers instead of deallocate - ! data that they point to: + ! Destroy initialization data CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Cleanup + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + + logical function FailedAlloc(txt) + character(*), intent(in) :: txt + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Could not allocate "//txt, ErrStat, ErrMsg, RoutineName) + call Cleanup() + endif + FailedAlloc = ErrStat >= AbortErrLev + end function FailedAlloc + SUBROUTINE SetSrvDCableControls() ! There is probably a better method for doint this, but this will work for now. Kind of an ugly bit of hacking. Init%InData_SrvD%NumCableControl = 0 @@ -5686,11 +5328,6 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as ! order = SIZE(ED%Input) - DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !ED_OutputTimes(p_FAST%InterpOrder + 1 + j) = t_initial - (j - 1) * dt - END DO - DO j = 1, p_FAST%InterpOrder + 1 CALL ED_CopyInput (ED%Input(1), ED%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5721,11 +5358,7 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, DO k = 1,p_FAST%nBeams - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes_Saved(j,k) = t_initial - (j - 1) * p_FAST%dt - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL BD_CopyInput (BD%Input(1,k), BD%Input_Saved(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5757,13 +5390,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, IF ( p_FAST%CompServo == Module_SrvD ) THEN - ! Initialize Input-Output arrays for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt - END DO + ! Initialize Input-Output arrays for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5796,12 +5424,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, IF ( p_FAST%CompAero == Module_AD14 ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - AD14%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL AD14_CopyInput (AD14%Input(1), AD14%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5828,12 +5452,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL AD_CopyInput (AD%Input(1), AD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5864,13 +5484,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, IF ( p_FAST%CompInflow == Module_IfW ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !IfW%OutputTimes(i) = t_initial - (j - 1) * dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5900,12 +5515,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, IF ( p_FAST%CompHydro == Module_HD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !HD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL HydroDyn_CopyInput (HD%Input(1), HD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5936,12 +5547,7 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, IF (p_FAST%CompSub == Module_SD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !SD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL SD_CopyInput (SD%Input(1), SD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5969,11 +5575,7 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6003,13 +5605,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, IF (p_FAST%CompMooring == Module_MAP) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !MAP_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6040,13 +5637,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, END IF ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !MD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL MD_CopyInput (MD%Input(1), MD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6075,13 +5667,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !FEAM_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6108,12 +5695,8 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL Orca_CopyInput (Orca%Input(1), Orca%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6144,12 +5727,7 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, IF (p_FAST%CompIce == Module_IceF ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !IceF_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6179,12 +5757,7 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, DO i = 1,p_FAST%numIceLegs - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes_Saved(j,i) = t_initial - (j - 1) * p_FAST%dt - !IceD%OutputTimes(j,i) = t_initial - (j - 1) * dt - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input_Saved(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6876,10 +6449,6 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, !! copy the stored states and inputs from n_t_global the current states and inputs !---------------------------------------------------------------------------------------- - DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes_Saved(j) = ED%InputTimes(j) - END DO - DO j = 1, p_FAST%InterpOrder + 1 CALL ED_CopyInput (ED%Input(j), ED%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6912,10 +6481,6 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, DO k = 1,p_FAST%nBeams ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes_Saved(j,k) = BD%InputTimes(j,k) - END DO - DO j = 1, p_FAST%InterpOrder + 1 CALL BD_CopyInput (BD%Input(j,k), BD%Input_Saved(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6944,11 +6509,6 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, IF ( p_FAST%CompServo == Module_SrvD ) THEN ! Initialize Input-Output arrays for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes_Saved(j) = SrvD%InputTimes(j) - END DO - DO j = 1, p_FAST%InterpOrder + 1 CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6978,12 +6538,8 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, END IF IF ( p_FAST%CompAero == Module_AD14 ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - AD14%InputTimes_Saved(j) = AD14%InputTimes(j) - END DO + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL AD14_CopyInput (AD14%Input(j), AD14%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7008,12 +6564,8 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes_Saved(j) = AD%InputTimes(j) - END DO + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL AD_CopyInput (AD%Input(j), AD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7040,13 +6592,8 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, END IF ! CompAero == Module_AD IF ( p_FAST%CompInflow == Module_IfW ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes_Saved(j) = IfW%InputTimes(j) - !IfW%OutputTimes(i) = t_global - (j - 1) * dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7074,12 +6621,8 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, IF ( p_FAST%CompHydro == Module_HD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes_Saved(j) = HD%InputTimes(j) - !HD_OutputTimes(i) = t_global - (j - 1) * dt - END DO + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL HydroDyn_CopyInput (HD%Input(j), HD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7108,12 +6651,7 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, IF (p_FAST%CompSub == Module_SD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes_Saved(j) = SD%InputTimes(j) - !SD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL SD_CopyInput (SD%Input(j), SD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7139,11 +6677,7 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes_Saved(j) = ExtPtfm%InputTimes(j) - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7171,13 +6705,8 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, IF (p_FAST%CompMooring == Module_MAP) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes_Saved(j) = MAPp%InputTimes(j) - !MAP_OutputTimes(i) = t_global - (j - 1) * dt - END DO + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7202,13 +6731,8 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes_Saved(j) = MD%InputTimes(j) - !MD_OutputTimes(i) = t_global - (j - 1) * dt - END DO + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL MD_CopyInput (MD%Input(j), MD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7233,13 +6757,8 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes_Saved(j) = FEAM%InputTimes(j) - !FEAM_OutputTimes(i) = t_global - (j - 1) * dt - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7264,12 +6783,8 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes_Saved(j) = Orca%InputTimes(j) - END DO - + + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL Orca_CopyInput (Orca%Input(j), Orca%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7298,12 +6813,7 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, IF (p_FAST%CompIce == Module_IceF ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes_Saved(j) = IceF%InputTimes(j) - !IceF_OutputTimes(i) = t_global - (j - 1) * dt - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7331,12 +6841,7 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, DO i = 1,p_FAST%numIceLegs - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes_Saved(j,i) = IceD%InputTimes(j,i) - !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt - END DO - + ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input_Saved(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -9332,31 +8837,35 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - if ( .not. Turbine%p_FAST%Linearize ) return + ! Skip function if not performing linearization + if (.not. Turbine%p_FAST%Linearize) return + ! Calculate current time + t_global = t_initial + n_t_global*Turbine%p_FAST%dt + + ! If linearization times specified directly (not using CalcSteady) if (.not. Turbine%p_FAST%CalcSteady) then - if ( Turbine%m_FAST%Lin%NextLinTimeIndx <= Turbine%p_FAST%NLinTimes ) then !bjj: maybe this logic should go in FAST_Linearize_OP??? + if (Turbine%m_Glue%Lin%TimeIndex <= Turbine%p_FAST%NLinTimes) then !bjj: maybe this logic should go in FAST_Linearize_OP??? - next_lin_time = Turbine%m_FAST%Lin%LinTimes( Turbine%m_FAST%Lin%NextLinTimeIndx ) - t_global = t_initial + n_t_global*Turbine%p_FAST%dt + ! Get next linearization time + next_lin_time = Turbine%m_FAST%Lin%LinTimes(Turbine%m_Glue%Lin%TimeIndex) - if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then + ! If current time is greater than or very close to next linearization time + if ((t_global > next_lin_time) .or. EqualRealNos(t_global,next_lin_time)) then + ! Perform linearization call ModGlue_Linearize_OP(Turbine, Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - ! CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - ! Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF (ErrStat >= AbortErrLev) RETURN - - if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) then - if (Turbine%m_FAST%Lin%NextLinTimeIndx > Turbine%p_FAST%NLinTimes) call WrVTKCheckpoint() + ! If VTK flag is for modeshapes and all of the times have been linearizaed + if ((Turbine%p_FAST%WrVTK == VTK_ModeShapes) .and. & + (Turbine%m_Glue%Lin%TimeIndex > Turbine%p_FAST%NLinTimes)) then + ! we are creating a checkpoint file for each turbine, so setting NumTurbines=1 in the file + CALL FAST_CreateCheckpoint_T(t_initial, Turbine%p_FAST%n_TMax_m1+1, 1, Turbine, TRIM(Turbine%p_FAST%OutFileRoot)//'.ModeShapeVTK', ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if end if @@ -9365,72 +8874,74 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) else ! CalcSteady - t_global = t_initial + n_t_global*Turbine%p_FAST%dt + t_global = t_initial + n_t_global * Turbine%p_FAST%DT + + ! Perform steady state calculation + call ModGlue_CalcSteady(n_t_global, t_global, Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Save this for use elsewhere in the code + Turbine%m_FAST%Lin%FoundSteady = Turbine%m_Glue%CS%FoundSteady - ! TODO: migrate to ModLin - ! call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - ! Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & - ! Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) - ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! If steady state was found + if (Turbine%m_Glue%CS%FoundSteady) then - if (Turbine%m_FAST%Lin%FoundSteady) then - if (Turbine%m_FAST%Lin%ForceLin) then - Turbine%p_FAST%NLinTimes=1 + ! If linearization was forced, only linearize at first time + if (Turbine%m_Glue%CS%ForceLin) then + Turbine%p_Glue%Lin%NumTimes = 1 endif - do iLinTime=1,Turbine%p_FAST%NLinTimes - t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) + ! Loop through linearization times + do iLinTime = 1, Turbine%p_Glue%Lin%NumTimes - ! TODO: migrate to ModLin - ! call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - ! Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & - ! Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Set global time to saved linearization time + t_global = Turbine%y_Glue%Lin%Times(iLinTime) + + ! Restore operating point so linearization can be performed + call ModGlue_RestoreOperatingPoint(Turbine%p_Glue, Turbine%m_Glue, iLinTime, Turbine, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + ! Set flags to trigger Jacobian recalculation if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then Turbine%m_FAST%calcJacobian = .true. Turbine%m_FAST%NextJacCalcTime = t_global end if + ! Calculate using restored operating points CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN + ! Linearize at operating points call ModGlue_Linearize_OP(Turbine, Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - ! CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - ! Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF (ErrStat >= AbortErrLev) RETURN - end do - if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) CALL WrVTKCheckpoint() + ! If mode shape VTKs were requested, write checkpoint file + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) then + ! we are creating a checkpoint file for each turbine, so setting NumTurbines=1 in the file + CALL FAST_CreateCheckpoint_T(t_initial, Turbine%p_FAST%n_TMax_m1+1, 1, Turbine, TRIM(Turbine%p_FAST%OutFileRoot)//'.ModeShapeVTK', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if - if (Turbine%m_FAST%Lin%ForceLin) then + ! If linearization was forced, display message + if (Turbine%m_Glue%CS%ForceLin) then ErrStat2 = ErrID_Warn ErrMsg2 = 'Linearization was forced at simulation end. The linearized model may not be sufficiently representative of the solution in steady state.' - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif end if end if - return -contains - subroutine WrVTKCheckpoint() - ! we are creating a checkpoint file for each turbine, so setting NumTurbines=1 in the file - CALL FAST_CreateCheckpoint_T(t_initial, Turbine%p_FAST%n_TMax_m1+1, 1, Turbine, TRIM(Turbine%p_FAST%OutFileRoot)//'.ModeShapeVTK', ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end subroutine WrVTKCheckpoint END SUBROUTINE FAST_Linearize_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -10336,7 +9847,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, E CALL FAST_RestoreForVTKModeShape_T(t_initial, Turbine(i_turb)%p_FAST, Turbine(i_turb)%y_FAST, Turbine(i_turb)%m_FAST, & Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%ExtLd, Turbine(i_turb)%IfW, Turbine(i_turb)%ExtInfw, & Turbine(i_turb)%SeaSt, Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & - Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) + Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), Turbine(i_turb), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -10346,7 +9857,7 @@ END SUBROUTINE FAST_RestoreForVTKModeShape_Tary !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the motions generated by mode shapes and outputs VTK data for it SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time @@ -10375,6 +9886,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< Turbine type INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -10453,10 +9965,9 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) end if - ! TODO: migrate to ModLin - ! call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - ! MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Restore operating point + call ModGlue_RestoreOperatingPoint(Turbine%p_Glue, Turbine%m_Glue, iLinTime, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! ! set perturbation of states based on x_eig magnitude and phase ! call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & @@ -10486,10 +9997,9 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, do it = 1,nt tprime = (it-1)*dt - ! TODO: migrate to ModLin - ! call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - ! MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Restore operating point + call ModGlue_RestoreOperatingPoint(Turbine%p_Glue, Turbine%m_Glue, iLinTime, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! ! set perturbation of states based on x_eig magnitude and phase ! call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 53ec49a9b2..65bbe108e2 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -410,7 +410,6 @@ MODULE FAST_Types TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE IceDyn_Data ! ======================= ! ========= BeamDyn_Data ======= @@ -429,16 +428,15 @@ MODULE FAST_Types TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE BeamDyn_Data ! ======================= ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data - TYPE(ED_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(ED_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] TYPE(ED_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] - TYPE(ED_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(ED_ParameterType) :: p !< Parameters [-] TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] @@ -449,15 +447,14 @@ MODULE FAST_Types TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ElastoDyn_Data ! ======================= ! ========= ServoDyn_Data ======= TYPE, PUBLIC :: ServoDyn_Data - TYPE(SrvD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(SrvD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(SrvD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(SrvD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(SrvD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(SrvD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SrvD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SrvD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SrvD_ParameterType) :: p !< Parameters [-] TYPE(SrvD_InputType) :: u !< System inputs [-] TYPE(SrvD_OutputType) :: y !< System outputs [-] @@ -468,15 +465,14 @@ MODULE FAST_Types TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ServoDyn_Data ! ======================= ! ========= AeroDyn14_Data ======= TYPE, PUBLIC :: AeroDyn14_Data - TYPE(AD14_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(AD14_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(AD14_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(AD14_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(AD14_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(AD14_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(AD14_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(AD14_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(AD14_ParameterType) :: p !< Parameters [-] TYPE(AD14_InputType) :: u !< System inputs [-] TYPE(AD14_OutputType) :: y !< System outputs [-] @@ -484,15 +480,14 @@ MODULE FAST_Types TYPE(AD14_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(AD14_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE AeroDyn14_Data ! ======================= ! ========= AeroDyn_Data ======= TYPE, PUBLIC :: AeroDyn_Data - TYPE(AD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(AD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(AD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(AD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(AD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(AD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(AD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(AD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(AD_ParameterType) :: p !< Parameters [-] TYPE(AD_InputType) :: u !< System inputs [-] TYPE(AD_OutputType) :: y !< System outputs [-] @@ -502,7 +497,6 @@ MODULE FAST_Types TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE AeroDyn_Data ! ======================= ! ========= ExtLoads_Data ======= @@ -520,10 +514,10 @@ MODULE FAST_Types ! ======================= ! ========= InflowWind_Data ======= TYPE, PUBLIC :: InflowWind_Data - TYPE(InflowWind_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(InflowWind_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(InflowWind_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(InflowWind_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(InflowWind_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(InflowWind_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(InflowWind_ParameterType) :: p !< Parameters [-] TYPE(InflowWind_InputType) :: u !< System inputs [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] @@ -533,7 +527,6 @@ MODULE FAST_Types TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE InflowWind_Data ! ======================= ! ========= ExternalInflow_Data ======= @@ -553,11 +546,11 @@ MODULE FAST_Types ! ======================= ! ========= SubDyn_Data ======= TYPE, PUBLIC :: SubDyn_Data - TYPE(SD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] TYPE(SD_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] - TYPE(SD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(SD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(SD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(SD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SD_ParameterType) :: p !< Parameters [-] TYPE(SD_InputType) :: u !< System inputs [-] TYPE(SD_OutputType) :: y !< System outputs [-] @@ -567,15 +560,14 @@ MODULE FAST_Types TYPE(SD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE SubDyn_Data ! ======================= ! ========= ExtPtfm_Data ======= TYPE, PUBLIC :: ExtPtfm_Data - TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(ExtPtfm_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(ExtPtfm_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(ExtPtfm_ParameterType) :: p !< Parameters [-] TYPE(ExtPtfm_InputType) :: u !< System inputs [-] TYPE(ExtPtfm_OutputType) :: y !< System outputs [-] @@ -583,15 +575,14 @@ MODULE FAST_Types TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ExtPtfm_Data ! ======================= ! ========= SeaState_Data ======= TYPE, PUBLIC :: SeaState_Data - TYPE(SeaSt_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(SeaSt_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(SeaSt_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(SeaSt_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(SeaSt_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SeaSt_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SeaSt_ParameterType) :: p !< Parameters [-] TYPE(SeaSt_InputType) :: u !< System inputs [-] TYPE(SeaSt_OutputType) :: y !< System outputs [-] @@ -601,16 +592,15 @@ MODULE FAST_Types TYPE(SeaSt_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SeaSt_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE SeaState_Data ! ======================= ! ========= HydroDyn_Data ======= TYPE, PUBLIC :: HydroDyn_Data - TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] TYPE(HydroDyn_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] - TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(HydroDyn_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] @@ -620,15 +610,14 @@ MODULE FAST_Types TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE HydroDyn_Data ! ======================= ! ========= IceFloe_Data ======= TYPE, PUBLIC :: IceFloe_Data - TYPE(IceFloe_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(IceFloe_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(IceFloe_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(IceFloe_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(IceFloe_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(IceFloe_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(IceFloe_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(IceFloe_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(IceFloe_ParameterType) :: p !< Parameters [-] TYPE(IceFloe_InputType) :: u !< System inputs [-] TYPE(IceFloe_OutputType) :: y !< System outputs [-] @@ -636,14 +625,13 @@ MODULE FAST_Types TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE IceFloe_Data ! ======================= ! ========= MAP_Data ======= TYPE, PUBLIC :: MAP_Data - TYPE(MAP_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(MAP_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(MAP_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(MAP_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(MAP_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(MAP_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(MAP_OtherStateType) :: OtherSt !< Other/optimization states [-] TYPE(MAP_ParameterType) :: p !< Parameters [-] TYPE(MAP_InputType) :: u !< System inputs [-] @@ -655,15 +643,14 @@ MODULE FAST_Types TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE MAP_Data ! ======================= ! ========= FEAMooring_Data ======= TYPE, PUBLIC :: FEAMooring_Data - TYPE(FEAM_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(FEAM_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(FEAM_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(FEAM_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(FEAM_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(FEAM_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(FEAM_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(FEAM_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(FEAM_ParameterType) :: p !< Parameters [-] TYPE(FEAM_InputType) :: u !< System inputs [-] TYPE(FEAM_OutputType) :: y !< System outputs [-] @@ -671,15 +658,14 @@ MODULE FAST_Types TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE FEAMooring_Data ! ======================= ! ========= MoorDyn_Data ======= TYPE, PUBLIC :: MoorDyn_Data - TYPE(MD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(MD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(MD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(MD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(MD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(MD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(MD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(MD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(MD_ParameterType) :: p !< Parameters [-] TYPE(MD_InputType) :: u !< System inputs [-] TYPE(MD_OutputType) :: y !< System outputs [-] @@ -689,15 +675,14 @@ MODULE FAST_Types TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE MoorDyn_Data ! ======================= ! ========= OrcaFlex_Data ======= TYPE, PUBLIC :: OrcaFlex_Data - TYPE(Orca_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(Orca_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(Orca_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(Orca_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(Orca_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(Orca_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(Orca_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(Orca_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(Orca_ParameterType) :: p !< Parameters [-] TYPE(Orca_InputType) :: u !< System inputs [-] TYPE(Orca_OutputType) :: y !< System outputs [-] @@ -705,7 +690,6 @@ MODULE FAST_Types TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE OrcaFlex_Data ! ======================= ! ========= FAST_ModuleMapType ======= @@ -6381,18 +6365,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end if DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes end if - if (allocated(SrcIceDyn_DataData%InputTimes_Saved)) then - LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstIceDyn_DataData%InputTimes_Saved)) then - allocate(DstIceDyn_DataData%InputTimes_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstIceDyn_DataData%InputTimes_Saved = SrcIceDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) @@ -6511,9 +6483,6 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) if (allocated(IceDyn_DataData%InputTimes)) then deallocate(IceDyn_DataData%InputTimes) end if - if (allocated(IceDyn_DataData%InputTimes_Saved)) then - deallocate(IceDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackIceDyn_Data(RF, Indata) @@ -6626,7 +6595,6 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6782,7 +6750,6 @@ subroutine FAST_UnPackIceDyn_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -7032,18 +6999,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end if DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes end if - if (allocated(SrcBeamDyn_DataData%InputTimes_Saved)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstBeamDyn_DataData%InputTimes_Saved)) then - allocate(DstBeamDyn_DataData%InputTimes_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstBeamDyn_DataData%InputTimes_Saved = SrcBeamDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) @@ -7191,9 +7146,6 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) if (allocated(BeamDyn_DataData%InputTimes)) then deallocate(BeamDyn_DataData%InputTimes) end if - if (allocated(BeamDyn_DataData%InputTimes_Saved)) then - deallocate(BeamDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackBeamDyn_Data(RF, Indata) @@ -7335,7 +7287,6 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7532,7 +7483,6 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -7548,37 +7498,73 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcElastoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcElastoDyn_DataData%x)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%x, kind=B8Ki) + if (.not. allocated(DstElastoDyn_DataData%x)) then + allocate(DstElastoDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call ED_CopyContState(SrcElastoDyn_DataData%dxdt, DstElastoDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - LB(1:1) = lbound(SrcElastoDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcElastoDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcElastoDyn_DataData%xd)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%xd, kind=B8Ki) + if (.not. allocated(DstElastoDyn_DataData%xd)) then + allocate(DstElastoDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcElastoDyn_DataData%z)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%z, kind=B8Ki) + if (.not. allocated(DstElastoDyn_DataData%z)) then + allocate(DstElastoDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcElastoDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstElastoDyn_DataData%OtherSt)) then + allocate(DstElastoDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call ED_CopyParam(SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -7670,18 +7656,6 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, end if DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes end if - if (allocated(SrcElastoDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstElastoDyn_DataData%InputTimes_Saved)) then - allocate(DstElastoDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstElastoDyn_DataData%InputTimes_Saved = SrcElastoDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) @@ -7695,32 +7669,44 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ElastoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(ElastoDyn_DataData%x)) then + LB(1:1) = lbound(ElastoDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%x) + end if call ED_DestroyContState(ElastoDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - LB(1:1) = lbound(ElastoDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ElastoDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ElastoDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(ElastoDyn_DataData%xd)) then + LB(1:1) = lbound(ElastoDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%xd) + end if + if (allocated(ElastoDyn_DataData%z)) then + LB(1:1) = lbound(ElastoDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%z) + end if + if (allocated(ElastoDyn_DataData%OtherSt)) then + LB(1:1) = lbound(ElastoDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%OtherSt) + end if call ED_DestroyParam(ElastoDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ED_DestroyInput(ElastoDyn_DataData%u, ErrStat2, ErrMsg2) @@ -7770,9 +7756,6 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) if (allocated(ElastoDyn_DataData%InputTimes)) then deallocate(ElastoDyn_DataData%InputTimes) end if - if (allocated(ElastoDyn_DataData%InputTimes_Saved)) then - deallocate(ElastoDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackElastoDyn_Data(RF, Indata) @@ -7782,27 +7765,43 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackContState(RF, InData%x(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call ED_PackContState(RF, InData%x(i1)) + end do + end if call ED_PackContState(RF, InData%dxdt) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call ED_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call ED_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call ED_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call ED_PackParam(RF, InData%p) call ED_PackInput(RF, InData%u) call ED_PackOutput(RF, InData%y) @@ -7845,7 +7844,6 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7858,27 +7856,59 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_UnpackContState(RF, OutData%x(i1)) ! x - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if call ED_UnpackContState(RF, OutData%dxdt) ! dxdt - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call ED_UnpackParam(RF, OutData%p) ! p call ED_UnpackInput(RF, OutData%u) ! u call ED_UnpackOutput(RF, OutData%y) ! y @@ -7937,7 +7967,6 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -7953,34 +7982,70 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcServoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcServoDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcServoDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcServoDyn_DataData%x)) then + LB(1:1) = lbound(SrcServoDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%x, kind=B8Ki) + if (.not. allocated(DstServoDyn_DataData%x)) then + allocate(DstServoDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcServoDyn_DataData%xd)) then + LB(1:1) = lbound(SrcServoDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%xd, kind=B8Ki) + if (.not. allocated(DstServoDyn_DataData%xd)) then + allocate(DstServoDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcServoDyn_DataData%z)) then + LB(1:1) = lbound(SrcServoDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%z, kind=B8Ki) + if (.not. allocated(DstServoDyn_DataData%z)) then + allocate(DstServoDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcServoDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstServoDyn_DataData%OtherSt)) then + allocate(DstServoDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call SrvD_CopyParam(SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -8059,18 +8124,6 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct end if DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes end if - if (allocated(SrcServoDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstServoDyn_DataData%InputTimes_Saved)) then - allocate(DstServoDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstServoDyn_DataData%InputTimes_Saved = SrcServoDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) @@ -8084,30 +8137,42 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ServoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ServoDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ServoDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ServoDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(ServoDyn_DataData%x)) then + LB(1:1) = lbound(ServoDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%x) + end if + if (allocated(ServoDyn_DataData%xd)) then + LB(1:1) = lbound(ServoDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%xd) + end if + if (allocated(ServoDyn_DataData%z)) then + LB(1:1) = lbound(ServoDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%z) + end if + if (allocated(ServoDyn_DataData%OtherSt)) then + LB(1:1) = lbound(ServoDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%OtherSt) + end if call SrvD_DestroyParam(ServoDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SrvD_DestroyInput(ServoDyn_DataData%u, ErrStat2, ErrMsg2) @@ -8150,9 +8215,6 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) if (allocated(ServoDyn_DataData%InputTimes)) then deallocate(ServoDyn_DataData%InputTimes) end if - if (allocated(ServoDyn_DataData%InputTimes_Saved)) then - deallocate(ServoDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackServoDyn_Data(RF, Indata) @@ -8162,26 +8224,42 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call SrvD_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call SrvD_PackParam(RF, InData%p) call SrvD_PackInput(RF, InData%u) call SrvD_PackOutput(RF, InData%y) @@ -8216,7 +8294,6 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8229,26 +8306,58 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call SrvD_UnpackParam(RF, OutData%p) ! p call SrvD_UnpackInput(RF, OutData%u) ! u call SrvD_UnpackOutput(RF, OutData%y) ! y @@ -8295,7 +8404,6 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg) @@ -8311,34 +8419,70 @@ subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn14_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcAeroDyn14_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn14_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_CopyContState(SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn14_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn14_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_CopyDiscState(SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn14_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn14_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_CopyConstrState(SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn14_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn14_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_CopyOtherState(SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcAeroDyn14_DataData%x)) then + LB(1:1) = lbound(SrcAeroDyn14_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%x, kind=B8Ki) + if (.not. allocated(DstAeroDyn14_DataData%x)) then + allocate(DstAeroDyn14_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD14_CopyContState(SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn14_DataData%xd)) then + LB(1:1) = lbound(SrcAeroDyn14_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%xd, kind=B8Ki) + if (.not. allocated(DstAeroDyn14_DataData%xd)) then + allocate(DstAeroDyn14_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD14_CopyDiscState(SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn14_DataData%z)) then + LB(1:1) = lbound(SrcAeroDyn14_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%z, kind=B8Ki) + if (.not. allocated(DstAeroDyn14_DataData%z)) then + allocate(DstAeroDyn14_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD14_CopyConstrState(SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn14_DataData%OtherSt)) then + LB(1:1) = lbound(SrcAeroDyn14_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstAeroDyn14_DataData%OtherSt)) then + allocate(DstAeroDyn14_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD14_CopyOtherState(SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call AD14_CopyParam(SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -8395,18 +8539,6 @@ subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, end if DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes end if - if (allocated(SrcAeroDyn14_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcAeroDyn14_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn14_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstAeroDyn14_DataData%InputTimes_Saved)) then - allocate(DstAeroDyn14_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstAeroDyn14_DataData%InputTimes_Saved = SrcAeroDyn14_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) @@ -8420,30 +8552,42 @@ subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn14_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDyn14_DataData%x, kind=B8Ki) - UB(1:1) = ubound(AeroDyn14_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_DestroyContState(AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn14_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(AeroDyn14_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_DestroyDiscState(AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn14_DataData%z, kind=B8Ki) - UB(1:1) = ubound(AeroDyn14_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_DestroyConstrState(AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn14_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(AeroDyn14_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_DestroyOtherState(AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(AeroDyn14_DataData%x)) then + LB(1:1) = lbound(AeroDyn14_DataData%x, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD14_DestroyContState(AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn14_DataData%x) + end if + if (allocated(AeroDyn14_DataData%xd)) then + LB(1:1) = lbound(AeroDyn14_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD14_DestroyDiscState(AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn14_DataData%xd) + end if + if (allocated(AeroDyn14_DataData%z)) then + LB(1:1) = lbound(AeroDyn14_DataData%z, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD14_DestroyConstrState(AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn14_DataData%z) + end if + if (allocated(AeroDyn14_DataData%OtherSt)) then + LB(1:1) = lbound(AeroDyn14_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD14_DestroyOtherState(AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn14_DataData%OtherSt) + end if call AD14_DestroyParam(AeroDyn14_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AD14_DestroyInput(AeroDyn14_DataData%u, ErrStat2, ErrMsg2) @@ -8473,9 +8617,6 @@ subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) if (allocated(AeroDyn14_DataData%InputTimes)) then deallocate(AeroDyn14_DataData%InputTimes) end if - if (allocated(AeroDyn14_DataData%InputTimes_Saved)) then - deallocate(AeroDyn14_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackAeroDyn14_Data(RF, Indata) @@ -8485,26 +8626,42 @@ subroutine FAST_PackAeroDyn14_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD14_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD14_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD14_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD14_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call AD14_PackParam(RF, InData%p) call AD14_PackInput(RF, InData%u) call AD14_PackOutput(RF, InData%y) @@ -8528,7 +8685,6 @@ subroutine FAST_PackAeroDyn14_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8541,26 +8697,58 @@ subroutine FAST_UnPackAeroDyn14_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD14_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD14_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD14_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD14_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD14_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call AD14_UnpackParam(RF, OutData%p) ! p call AD14_UnpackInput(RF, OutData%u) ! u call AD14_UnpackOutput(RF, OutData%y) ! y @@ -8592,7 +8780,6 @@ subroutine FAST_UnPackAeroDyn14_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -8608,34 +8795,70 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcAeroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcAeroDyn_DataData%x)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%x, kind=B8Ki) + if (.not. allocated(DstAeroDyn_DataData%x)) then + allocate(DstAeroDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn_DataData%xd)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%xd, kind=B8Ki) + if (.not. allocated(DstAeroDyn_DataData%xd)) then + allocate(DstAeroDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn_DataData%z)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%z, kind=B8Ki) + if (.not. allocated(DstAeroDyn_DataData%z)) then + allocate(DstAeroDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstAeroDyn_DataData%OtherSt)) then + allocate(DstAeroDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call AD_CopyParam(SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -8711,18 +8934,6 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC end if DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes end if - if (allocated(SrcAeroDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstAeroDyn_DataData%InputTimes_Saved)) then - allocate(DstAeroDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstAeroDyn_DataData%InputTimes_Saved = SrcAeroDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) @@ -8736,30 +8947,42 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(AeroDyn_DataData%x)) then + LB(1:1) = lbound(AeroDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%x) + end if + if (allocated(AeroDyn_DataData%xd)) then + LB(1:1) = lbound(AeroDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%xd) + end if + if (allocated(AeroDyn_DataData%z)) then + LB(1:1) = lbound(AeroDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%z) + end if + if (allocated(AeroDyn_DataData%OtherSt)) then + LB(1:1) = lbound(AeroDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%OtherSt) + end if call AD_DestroyParam(AeroDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AD_DestroyInput(AeroDyn_DataData%u, ErrStat2, ErrMsg2) @@ -8800,9 +9023,6 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) if (allocated(AeroDyn_DataData%InputTimes)) then deallocate(AeroDyn_DataData%InputTimes) end if - if (allocated(AeroDyn_DataData%InputTimes_Saved)) then - deallocate(AeroDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackAeroDyn_Data(RF, Indata) @@ -8812,26 +9032,42 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call AD_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call AD_PackParam(RF, InData%p) call AD_PackInput(RF, InData%u) call AD_PackOutput(RF, InData%y) @@ -8865,7 +9101,6 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8878,26 +9113,58 @@ subroutine FAST_UnPackAeroDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call AD_UnpackParam(RF, OutData%p) ! p call AD_UnpackInput(RF, OutData%u) ! u call AD_UnpackOutput(RF, OutData%y) ! y @@ -8943,7 +9210,6 @@ subroutine FAST_UnPackAeroDyn_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExtLoads_Data(SrcExtLoads_DataData, DstExtLoads_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9145,46 +9411,82 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcInflowWind_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcInflowWind_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcInflowWind_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call InflowWind_CopyParam(SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call InflowWind_CopyInput(SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call InflowWind_CopyOutput(SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call InflowWind_CopyMisc(SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + if (allocated(SrcInflowWind_DataData%x)) then + LB(1:1) = lbound(SrcInflowWind_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%x, kind=B8Ki) + if (.not. allocated(DstInflowWind_DataData%x)) then + allocate(DstInflowWind_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInflowWind_DataData%xd)) then + LB(1:1) = lbound(SrcInflowWind_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%xd, kind=B8Ki) + if (.not. allocated(DstInflowWind_DataData%xd)) then + allocate(DstInflowWind_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInflowWind_DataData%z)) then + LB(1:1) = lbound(SrcInflowWind_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%z, kind=B8Ki) + if (.not. allocated(DstInflowWind_DataData%z)) then + allocate(DstInflowWind_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInflowWind_DataData%OtherSt)) then + LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstInflowWind_DataData%OtherSt)) then + allocate(DstInflowWind_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call InflowWind_CopyParam(SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyMisc(SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcInflowWind_DataData%Output)) then LB(1:1) = lbound(SrcInflowWind_DataData%Output, kind=B8Ki) UB(1:1) = ubound(SrcInflowWind_DataData%Output, kind=B8Ki) @@ -9248,18 +9550,6 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa end if DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes end if - if (allocated(SrcInflowWind_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstInflowWind_DataData%InputTimes_Saved)) then - allocate(DstInflowWind_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInflowWind_DataData%InputTimes_Saved = SrcInflowWind_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) @@ -9273,30 +9563,42 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(InflowWind_DataData%x, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(InflowWind_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(InflowWind_DataData%z, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(InflowWind_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(InflowWind_DataData%x)) then + LB(1:1) = lbound(InflowWind_DataData%x, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%x) + end if + if (allocated(InflowWind_DataData%xd)) then + LB(1:1) = lbound(InflowWind_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%xd) + end if + if (allocated(InflowWind_DataData%z)) then + LB(1:1) = lbound(InflowWind_DataData%z, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%z) + end if + if (allocated(InflowWind_DataData%OtherSt)) then + LB(1:1) = lbound(InflowWind_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%OtherSt) + end if call InflowWind_DestroyParam(InflowWind_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyInput(InflowWind_DataData%u, ErrStat2, ErrMsg2) @@ -9337,9 +9639,6 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) if (allocated(InflowWind_DataData%InputTimes)) then deallocate(InflowWind_DataData%InputTimes) end if - if (allocated(InflowWind_DataData%InputTimes_Saved)) then - deallocate(InflowWind_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackInflowWind_Data(RF, Indata) @@ -9349,26 +9648,42 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call InflowWind_PackParam(RF, InData%p) call InflowWind_PackInput(RF, InData%u) call InflowWind_PackOutput(RF, InData%y) @@ -9402,7 +9717,6 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9415,26 +9729,58 @@ subroutine FAST_UnPackInflowWind_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call InflowWind_UnpackParam(RF, OutData%p) ! p call InflowWind_UnpackInput(RF, OutData%u) ! u call InflowWind_UnpackOutput(RF, OutData%y) ! y @@ -9480,7 +9826,6 @@ subroutine FAST_UnPackInflowWind_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExternalInflow_Data(SrcExternalInflow_DataData, DstExternalInflow_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9623,37 +9968,73 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSubDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcSubDyn_DataData%x)) then + LB(1:1) = lbound(SrcSubDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%x, kind=B8Ki) + if (.not. allocated(DstSubDyn_DataData%x)) then + allocate(DstSubDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call SD_CopyContState(SrcSubDyn_DataData%dxdt, DstSubDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - LB(1:1) = lbound(SrcSubDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSubDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcSubDyn_DataData%xd)) then + LB(1:1) = lbound(SrcSubDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%xd, kind=B8Ki) + if (.not. allocated(DstSubDyn_DataData%xd)) then + allocate(DstSubDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSubDyn_DataData%z)) then + LB(1:1) = lbound(SrcSubDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%z, kind=B8Ki) + if (.not. allocated(DstSubDyn_DataData%z)) then + allocate(DstSubDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSubDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstSubDyn_DataData%OtherSt)) then + allocate(DstSubDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call SD_CopyParam(SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -9729,18 +10110,6 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode end if DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes end if - if (allocated(SrcSubDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstSubDyn_DataData%InputTimes_Saved)) then - allocate(DstSubDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstSubDyn_DataData%InputTimes_Saved = SrcSubDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) @@ -9754,37 +10123,49 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SubDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(SubDyn_DataData%x)) then + LB(1:1) = lbound(SubDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%x) + end if call SD_DestroyContState(SubDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - LB(1:1) = lbound(SubDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SubDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SubDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyInput(SubDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyOutput(SubDyn_DataData%y, ErrStat2, ErrMsg2) + if (allocated(SubDyn_DataData%xd)) then + LB(1:1) = lbound(SubDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%xd) + end if + if (allocated(SubDyn_DataData%z)) then + LB(1:1) = lbound(SubDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%z) + end if + if (allocated(SubDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SubDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%OtherSt) + end if + call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInput(SubDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyOutput(SubDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9820,9 +10201,6 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) if (allocated(SubDyn_DataData%InputTimes)) then deallocate(SubDyn_DataData%InputTimes) end if - if (allocated(SubDyn_DataData%InputTimes_Saved)) then - deallocate(SubDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackSubDyn_Data(RF, Indata) @@ -9832,27 +10210,43 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackContState(RF, InData%x(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_PackContState(RF, InData%x(i1)) + end do + end if call SD_PackContState(RF, InData%dxdt) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call SD_PackParam(RF, InData%p) call SD_PackInput(RF, InData%u) call SD_PackOutput(RF, InData%y) @@ -9886,7 +10280,6 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) end if call SD_PackOutput(RF, InData%y_interp) call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9899,27 +10292,59 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_UnpackContState(RF, OutData%x(i1)) ! x - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if call SD_UnpackContState(RF, OutData%dxdt) ! dxdt - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call SD_UnpackParam(RF, OutData%p) ! p call SD_UnpackInput(RF, OutData%u) ! u call SD_UnpackOutput(RF, OutData%y) ! y @@ -9965,7 +10390,6 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) end if call SD_UnpackOutput(RF, OutData%y_interp) ! y_interp call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9981,34 +10405,70 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcExtPtfm_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcExtPtfm_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcExtPtfm_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcExtPtfm_DataData%x)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%x, kind=B8Ki) + if (.not. allocated(DstExtPtfm_DataData%x)) then + allocate(DstExtPtfm_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%xd)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%xd, kind=B8Ki) + if (.not. allocated(DstExtPtfm_DataData%xd)) then + allocate(DstExtPtfm_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%z)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%z, kind=B8Ki) + if (.not. allocated(DstExtPtfm_DataData%z)) then + allocate(DstExtPtfm_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%OtherSt)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstExtPtfm_DataData%OtherSt)) then + allocate(DstExtPtfm_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call ExtPtfm_CopyParam(SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -10065,18 +10525,6 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC end if DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes end if - if (allocated(SrcExtPtfm_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstExtPtfm_DataData%InputTimes_Saved)) then - allocate(DstExtPtfm_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstExtPtfm_DataData%InputTimes_Saved = SrcExtPtfm_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) @@ -10090,30 +10538,42 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ExtPtfm_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ExtPtfm_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ExtPtfm_DataData%z, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ExtPtfm_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(ExtPtfm_DataData%x)) then + LB(1:1) = lbound(ExtPtfm_DataData%x, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%x) + end if + if (allocated(ExtPtfm_DataData%xd)) then + LB(1:1) = lbound(ExtPtfm_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%xd) + end if + if (allocated(ExtPtfm_DataData%z)) then + LB(1:1) = lbound(ExtPtfm_DataData%z, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%z) + end if + if (allocated(ExtPtfm_DataData%OtherSt)) then + LB(1:1) = lbound(ExtPtfm_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%OtherSt) + end if call ExtPtfm_DestroyParam(ExtPtfm_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ExtPtfm_DestroyInput(ExtPtfm_DataData%u, ErrStat2, ErrMsg2) @@ -10143,9 +10603,6 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) if (allocated(ExtPtfm_DataData%InputTimes)) then deallocate(ExtPtfm_DataData%InputTimes) end if - if (allocated(ExtPtfm_DataData%InputTimes_Saved)) then - deallocate(ExtPtfm_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackExtPtfm_Data(RF, Indata) @@ -10155,26 +10612,42 @@ subroutine FAST_PackExtPtfm_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call ExtPtfm_PackParam(RF, InData%p) call ExtPtfm_PackInput(RF, InData%u) call ExtPtfm_PackOutput(RF, InData%y) @@ -10198,7 +10671,6 @@ subroutine FAST_PackExtPtfm_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -10211,30 +10683,62 @@ subroutine FAST_UnPackExtPtfm_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call ExtPtfm_UnpackParam(RF, OutData%p) ! p - call ExtPtfm_UnpackInput(RF, OutData%u) ! u - call ExtPtfm_UnpackOutput(RF, OutData%y) ! y - call ExtPtfm_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if + call ExtPtfm_UnpackParam(RF, OutData%p) ! p + call ExtPtfm_UnpackInput(RF, OutData%u) ! u + call ExtPtfm_UnpackOutput(RF, OutData%y) ! y + call ExtPtfm_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -10262,7 +10766,6 @@ subroutine FAST_UnPackExtPtfm_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10278,34 +10781,70 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSeaState_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSeaState_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSeaState_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSeaState_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcSeaState_DataData%x)) then + LB(1:1) = lbound(SrcSeaState_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%x, kind=B8Ki) + if (.not. allocated(DstSeaState_DataData%x)) then + allocate(DstSeaState_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSeaState_DataData%xd)) then + LB(1:1) = lbound(SrcSeaState_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%xd, kind=B8Ki) + if (.not. allocated(DstSeaState_DataData%xd)) then + allocate(DstSeaState_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSeaState_DataData%z)) then + LB(1:1) = lbound(SrcSeaState_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%z, kind=B8Ki) + if (.not. allocated(DstSeaState_DataData%z)) then + allocate(DstSeaState_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSeaState_DataData%OtherSt)) then + LB(1:1) = lbound(SrcSeaState_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstSeaState_DataData%OtherSt)) then + allocate(DstSeaState_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -10381,18 +10920,6 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct end if DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes end if - if (allocated(SrcSeaState_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcSeaState_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstSeaState_DataData%InputTimes_Saved)) then - allocate(DstSeaState_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstSeaState_DataData%InputTimes_Saved = SrcSeaState_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) @@ -10406,30 +10933,42 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SeaState_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SeaState_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SeaState_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SeaState_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(SeaState_DataData%x)) then + LB(1:1) = lbound(SeaState_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%x) + end if + if (allocated(SeaState_DataData%xd)) then + LB(1:1) = lbound(SeaState_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%xd) + end if + if (allocated(SeaState_DataData%z)) then + LB(1:1) = lbound(SeaState_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%z) + end if + if (allocated(SeaState_DataData%OtherSt)) then + LB(1:1) = lbound(SeaState_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%OtherSt) + end if call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) @@ -10470,9 +11009,6 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) if (allocated(SeaState_DataData%InputTimes)) then deallocate(SeaState_DataData%InputTimes) end if - if (allocated(SeaState_DataData%InputTimes_Saved)) then - deallocate(SeaState_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackSeaState_Data(RF, Indata) @@ -10482,26 +11018,42 @@ subroutine FAST_PackSeaState_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call SeaSt_PackParam(RF, InData%p) call SeaSt_PackInput(RF, InData%u) call SeaSt_PackOutput(RF, InData%y) @@ -10535,7 +11087,6 @@ subroutine FAST_PackSeaState_Data(RF, Indata) end if call SeaSt_PackOutput(RF, InData%y_interp) call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -10548,26 +11099,58 @@ subroutine FAST_UnPackSeaState_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call SeaSt_UnpackParam(RF, OutData%p) ! p call SeaSt_UnpackInput(RF, OutData%u) ! u call SeaSt_UnpackOutput(RF, OutData%y) ! y @@ -10613,7 +11196,6 @@ subroutine FAST_UnPackSeaState_Data(RF, OutData) end if call SeaSt_UnpackOutput(RF, OutData%y_interp) ! y_interp call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10629,38 +11211,74 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcHydroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcHydroDyn_DataData%x)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%x, kind=B8Ki) + if (.not. allocated(DstHydroDyn_DataData%x)) then + allocate(DstHydroDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call HydroDyn_CopyContState(SrcHydroDyn_DataData%dxdt, DstHydroDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - LB(1:1) = lbound(SrcHydroDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcHydroDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call HydroDyn_CopyParam(SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + if (allocated(SrcHydroDyn_DataData%xd)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%xd, kind=B8Ki) + if (.not. allocated(DstHydroDyn_DataData%xd)) then + allocate(DstHydroDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcHydroDyn_DataData%z)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%z, kind=B8Ki) + if (.not. allocated(DstHydroDyn_DataData%z)) then + allocate(DstHydroDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcHydroDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstHydroDyn_DataData%OtherSt)) then + allocate(DstHydroDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call HydroDyn_CopyParam(SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call HydroDyn_CopyInput(SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) @@ -10735,18 +11353,6 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct end if DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes end if - if (allocated(SrcHydroDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstHydroDyn_DataData%InputTimes_Saved)) then - allocate(DstHydroDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstHydroDyn_DataData%InputTimes_Saved = SrcHydroDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) @@ -10760,32 +11366,44 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(HydroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(HydroDyn_DataData%x)) then + LB(1:1) = lbound(HydroDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%x) + end if call HydroDyn_DestroyContState(HydroDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - LB(1:1) = lbound(HydroDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(HydroDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(HydroDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(HydroDyn_DataData%xd)) then + LB(1:1) = lbound(HydroDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%xd) + end if + if (allocated(HydroDyn_DataData%z)) then + LB(1:1) = lbound(HydroDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%z) + end if + if (allocated(HydroDyn_DataData%OtherSt)) then + LB(1:1) = lbound(HydroDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%OtherSt) + end if call HydroDyn_DestroyParam(HydroDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call HydroDyn_DestroyInput(HydroDyn_DataData%u, ErrStat2, ErrMsg2) @@ -10826,9 +11444,6 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) if (allocated(HydroDyn_DataData%InputTimes)) then deallocate(HydroDyn_DataData%InputTimes) end if - if (allocated(HydroDyn_DataData%InputTimes_Saved)) then - deallocate(HydroDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackHydroDyn_Data(RF, Indata) @@ -10838,27 +11453,43 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackContState(RF, InData%x(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(RF, InData%x(i1)) + end do + end if call HydroDyn_PackContState(RF, InData%dxdt) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call HydroDyn_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call HydroDyn_PackParam(RF, InData%p) call HydroDyn_PackInput(RF, InData%u) call HydroDyn_PackOutput(RF, InData%y) @@ -10892,7 +11523,6 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -10905,27 +11535,59 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(RF, OutData%x(i1)) ! x - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if call HydroDyn_UnpackContState(RF, OutData%dxdt) ! dxdt - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call HydroDyn_UnpackParam(RF, OutData%p) ! p call HydroDyn_UnpackInput(RF, OutData%u) ! u call HydroDyn_UnpackOutput(RF, OutData%y) ! y @@ -10971,7 +11633,6 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10987,34 +11648,70 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcIceFloe_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcIceFloe_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcIceFloe_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcIceFloe_DataData%x)) then + LB(1:1) = lbound(SrcIceFloe_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%x, kind=B8Ki) + if (.not. allocated(DstIceFloe_DataData%x)) then + allocate(DstIceFloe_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%xd)) then + LB(1:1) = lbound(SrcIceFloe_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%xd, kind=B8Ki) + if (.not. allocated(DstIceFloe_DataData%xd)) then + allocate(DstIceFloe_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%z)) then + LB(1:1) = lbound(SrcIceFloe_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%z, kind=B8Ki) + if (.not. allocated(DstIceFloe_DataData%z)) then + allocate(DstIceFloe_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%OtherSt)) then + LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstIceFloe_DataData%OtherSt)) then + allocate(DstIceFloe_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call IceFloe_CopyParam(SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -11071,18 +11768,6 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC end if DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes end if - if (allocated(SrcIceFloe_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstIceFloe_DataData%InputTimes_Saved)) then - allocate(DstIceFloe_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstIceFloe_DataData%InputTimes_Saved = SrcIceFloe_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) @@ -11096,30 +11781,42 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(IceFloe_DataData%x, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(IceFloe_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(IceFloe_DataData%z, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(IceFloe_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(IceFloe_DataData%x)) then + LB(1:1) = lbound(IceFloe_DataData%x, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%x) + end if + if (allocated(IceFloe_DataData%xd)) then + LB(1:1) = lbound(IceFloe_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%xd) + end if + if (allocated(IceFloe_DataData%z)) then + LB(1:1) = lbound(IceFloe_DataData%z, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%z) + end if + if (allocated(IceFloe_DataData%OtherSt)) then + LB(1:1) = lbound(IceFloe_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%OtherSt) + end if call IceFloe_DestroyParam(IceFloe_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call IceFloe_DestroyInput(IceFloe_DataData%u, ErrStat2, ErrMsg2) @@ -11149,9 +11846,6 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) if (allocated(IceFloe_DataData%InputTimes)) then deallocate(IceFloe_DataData%InputTimes) end if - if (allocated(IceFloe_DataData%InputTimes_Saved)) then - deallocate(IceFloe_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackIceFloe_Data(RF, Indata) @@ -11161,26 +11855,42 @@ subroutine FAST_PackIceFloe_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call IceFloe_PackParam(RF, InData%p) call IceFloe_PackInput(RF, InData%u) call IceFloe_PackOutput(RF, InData%y) @@ -11204,7 +11914,6 @@ subroutine FAST_PackIceFloe_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11217,26 +11926,58 @@ subroutine FAST_UnPackIceFloe_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call IceFloe_UnpackParam(RF, OutData%p) ! p call IceFloe_UnpackInput(RF, OutData%u) ! u call IceFloe_UnpackOutput(RF, OutData%y) ! y @@ -11268,7 +12009,6 @@ subroutine FAST_UnPackIceFloe_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11284,27 +12024,54 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcMAP_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMAP_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMAP_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcMAP_DataData%x)) then + LB(1:1) = lbound(SrcMAP_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%x, kind=B8Ki) + if (.not. allocated(DstMAP_DataData%x)) then + allocate(DstMAP_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMAP_DataData%xd)) then + LB(1:1) = lbound(SrcMAP_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%xd, kind=B8Ki) + if (.not. allocated(DstMAP_DataData%xd)) then + allocate(DstMAP_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMAP_DataData%z)) then + LB(1:1) = lbound(SrcMAP_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%z, kind=B8Ki) + if (.not. allocated(DstMAP_DataData%z)) then + allocate(DstMAP_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call MAP_CopyOtherState(SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -11386,18 +12153,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat end if DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes end if - if (allocated(SrcMAP_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcMAP_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstMAP_DataData%InputTimes_Saved)) then - allocate(DstMAP_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMAP_DataData%InputTimes_Saved = SrcMAP_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) @@ -11411,24 +12166,33 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(MAP_DataData%x, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MAP_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MAP_DataData%z, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(MAP_DataData%x)) then + LB(1:1) = lbound(MAP_DataData%x, kind=B8Ki) + UB(1:1) = ubound(MAP_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%x) + end if + if (allocated(MAP_DataData%xd)) then + LB(1:1) = lbound(MAP_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(MAP_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%xd) + end if + if (allocated(MAP_DataData%z)) then + LB(1:1) = lbound(MAP_DataData%z, kind=B8Ki) + UB(1:1) = ubound(MAP_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%z) + end if call MAP_DestroyOtherState(MAP_DataData%OtherSt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyParam(MAP_DataData%p, ErrStat2, ErrMsg2) @@ -11473,9 +12237,6 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) if (allocated(MAP_DataData%InputTimes)) then deallocate(MAP_DataData%InputTimes) end if - if (allocated(MAP_DataData%InputTimes_Saved)) then - deallocate(MAP_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackMAP_Data(RF, Indata) @@ -11485,21 +12246,33 @@ subroutine FAST_PackMAP_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackConstrState(RF, InData%z(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call MAP_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(RF, InData%z(i1)) + end do + end if call MAP_PackOtherState(RF, InData%OtherSt) call MAP_PackParam(RF, InData%p) call MAP_PackInput(RF, InData%u) @@ -11535,7 +12308,6 @@ subroutine FAST_PackMAP_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11548,21 +12320,45 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_UnpackConstrState(RF, OutData%z(i1)) ! z - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if call MAP_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt call MAP_UnpackParam(RF, OutData%p) ! p call MAP_UnpackInput(RF, OutData%u) ! u @@ -11610,7 +12406,6 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11626,53 +12421,89 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcFEAMooring_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcFEAMooring_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcFEAMooring_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call FEAM_CopyParam(SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FEAM_CopyInput(SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FEAM_CopyOutput(SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call FEAM_CopyMisc(SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcFEAMooring_DataData%Input)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%Input, kind=B8Ki) - if (.not. allocated(DstFEAMooring_DataData%Input)) then - allocate(DstFEAMooring_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcFEAMooring_DataData%x)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%x, kind=B8Ki) + if (.not. allocated(DstFEAMooring_DataData%x)) then + allocate(DstFEAMooring_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%xd)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%xd, kind=B8Ki) + if (.not. allocated(DstFEAMooring_DataData%xd)) then + allocate(DstFEAMooring_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%z)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%z, kind=B8Ki) + if (.not. allocated(DstFEAMooring_DataData%z)) then + allocate(DstFEAMooring_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%OtherSt)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstFEAMooring_DataData%OtherSt)) then + allocate(DstFEAMooring_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FEAM_CopyParam(SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInput(SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyOutput(SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyMisc(SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcFEAMooring_DataData%Input)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%Input, kind=B8Ki) + if (.not. allocated(DstFEAMooring_DataData%Input)) then + allocate(DstFEAMooring_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if @@ -11710,18 +12541,6 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa end if DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes end if - if (allocated(SrcFEAMooring_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstFEAMooring_DataData%InputTimes_Saved)) then - allocate(DstFEAMooring_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstFEAMooring_DataData%InputTimes_Saved = SrcFEAMooring_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) @@ -11735,30 +12554,42 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(FEAMooring_DataData%x, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(FEAMooring_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(FEAMooring_DataData%z, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(FEAMooring_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(FEAMooring_DataData%x)) then + LB(1:1) = lbound(FEAMooring_DataData%x, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%x) + end if + if (allocated(FEAMooring_DataData%xd)) then + LB(1:1) = lbound(FEAMooring_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%xd) + end if + if (allocated(FEAMooring_DataData%z)) then + LB(1:1) = lbound(FEAMooring_DataData%z, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%z) + end if + if (allocated(FEAMooring_DataData%OtherSt)) then + LB(1:1) = lbound(FEAMooring_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%OtherSt) + end if call FEAM_DestroyParam(FEAMooring_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FEAM_DestroyInput(FEAMooring_DataData%u, ErrStat2, ErrMsg2) @@ -11788,9 +12619,6 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) if (allocated(FEAMooring_DataData%InputTimes)) then deallocate(FEAMooring_DataData%InputTimes) end if - if (allocated(FEAMooring_DataData%InputTimes_Saved)) then - deallocate(FEAMooring_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackFEAMooring_Data(RF, Indata) @@ -11800,26 +12628,42 @@ subroutine FAST_PackFEAMooring_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call FEAM_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call FEAM_PackParam(RF, InData%p) call FEAM_PackInput(RF, InData%u) call FEAM_PackOutput(RF, InData%y) @@ -11843,7 +12687,6 @@ subroutine FAST_PackFEAMooring_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11856,26 +12699,58 @@ subroutine FAST_UnPackFEAMooring_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call FEAM_UnpackParam(RF, OutData%p) ! p call FEAM_UnpackInput(RF, OutData%u) ! u call FEAM_UnpackOutput(RF, OutData%y) ! y @@ -11907,7 +12782,6 @@ subroutine FAST_UnPackFEAMooring_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11923,34 +12797,70 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcMoorDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMoorDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMoorDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcMoorDyn_DataData%x)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%x, kind=B8Ki) + if (.not. allocated(DstMoorDyn_DataData%x)) then + allocate(DstMoorDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMoorDyn_DataData%xd)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%xd, kind=B8Ki) + if (.not. allocated(DstMoorDyn_DataData%xd)) then + allocate(DstMoorDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMoorDyn_DataData%z)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%z, kind=B8Ki) + if (.not. allocated(DstMoorDyn_DataData%z)) then + allocate(DstMoorDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMoorDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstMoorDyn_DataData%OtherSt)) then + allocate(DstMoorDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call MD_CopyParam(SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -12026,18 +12936,6 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC end if DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes end if - if (allocated(SrcMoorDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstMoorDyn_DataData%InputTimes_Saved)) then - allocate(DstMoorDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMoorDyn_DataData%InputTimes_Saved = SrcMoorDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) @@ -12051,33 +12949,45 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(MoorDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MoorDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MoorDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MoorDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call MD_DestroyParam(MoorDyn_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MD_DestroyInput(MoorDyn_DataData%u, ErrStat2, ErrMsg2) + if (allocated(MoorDyn_DataData%x)) then + LB(1:1) = lbound(MoorDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%x) + end if + if (allocated(MoorDyn_DataData%xd)) then + LB(1:1) = lbound(MoorDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%xd) + end if + if (allocated(MoorDyn_DataData%z)) then + LB(1:1) = lbound(MoorDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%z) + end if + if (allocated(MoorDyn_DataData%OtherSt)) then + LB(1:1) = lbound(MoorDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%OtherSt) + end if + call MD_DestroyParam(MoorDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MoorDyn_DataData%u, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MD_DestroyOutput(MoorDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12115,9 +13025,6 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) if (allocated(MoorDyn_DataData%InputTimes)) then deallocate(MoorDyn_DataData%InputTimes) end if - if (allocated(MoorDyn_DataData%InputTimes_Saved)) then - deallocate(MoorDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackMoorDyn_Data(RF, Indata) @@ -12127,26 +13034,42 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call MD_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call MD_PackParam(RF, InData%p) call MD_PackInput(RF, InData%u) call MD_PackOutput(RF, InData%y) @@ -12180,7 +13103,6 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12193,26 +13115,58 @@ subroutine FAST_UnPackMoorDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call MD_UnpackParam(RF, OutData%p) ! p call MD_UnpackInput(RF, OutData%u) ! u call MD_UnpackOutput(RF, OutData%y) ! y @@ -12258,7 +13212,6 @@ subroutine FAST_UnPackMoorDyn_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg) @@ -12274,34 +13227,70 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcOrcaFlex_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcOrcaFlex_DataData%x)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%x, kind=B8Ki) + if (.not. allocated(DstOrcaFlex_DataData%x)) then + allocate(DstOrcaFlex_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%xd)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%xd, kind=B8Ki) + if (.not. allocated(DstOrcaFlex_DataData%xd)) then + allocate(DstOrcaFlex_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%z)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%z, kind=B8Ki) + if (.not. allocated(DstOrcaFlex_DataData%z)) then + allocate(DstOrcaFlex_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%OtherSt)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstOrcaFlex_DataData%OtherSt)) then + allocate(DstOrcaFlex_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call Orca_CopyParam(SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -12358,18 +13347,6 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct end if DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes end if - if (allocated(SrcOrcaFlex_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstOrcaFlex_DataData%InputTimes_Saved)) then - allocate(DstOrcaFlex_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOrcaFlex_DataData%InputTimes_Saved = SrcOrcaFlex_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) @@ -12383,30 +13360,42 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OrcaFlex_DataData%x, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(OrcaFlex_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(OrcaFlex_DataData%z, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(OrcaFlex_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(OrcaFlex_DataData%x)) then + LB(1:1) = lbound(OrcaFlex_DataData%x, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%x) + end if + if (allocated(OrcaFlex_DataData%xd)) then + LB(1:1) = lbound(OrcaFlex_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%xd) + end if + if (allocated(OrcaFlex_DataData%z)) then + LB(1:1) = lbound(OrcaFlex_DataData%z, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%z) + end if + if (allocated(OrcaFlex_DataData%OtherSt)) then + LB(1:1) = lbound(OrcaFlex_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%OtherSt) + end if call Orca_DestroyParam(OrcaFlex_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Orca_DestroyInput(OrcaFlex_DataData%u, ErrStat2, ErrMsg2) @@ -12436,9 +13425,6 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) if (allocated(OrcaFlex_DataData%InputTimes)) then deallocate(OrcaFlex_DataData%InputTimes) end if - if (allocated(OrcaFlex_DataData%InputTimes_Saved)) then - deallocate(OrcaFlex_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackOrcaFlex_Data(RF, Indata) @@ -12448,26 +13434,42 @@ subroutine FAST_PackOrcaFlex_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call Orca_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call Orca_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call Orca_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call Orca_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call Orca_PackParam(RF, InData%p) call Orca_PackInput(RF, InData%u) call Orca_PackOutput(RF, InData%y) @@ -12491,7 +13493,6 @@ subroutine FAST_PackOrcaFlex_Data(RF, Indata) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12504,26 +13505,58 @@ subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call Orca_UnpackParam(RF, OutData%p) ! p call Orca_UnpackInput(RF, OutData%u) ! u call Orca_UnpackOutput(RF, OutData%y) ! y @@ -12555,7 +13588,6 @@ subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index ed39280b5e..a8446d2c4d 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -130,8 +130,13 @@ typedef ^ ^ Glue_LinType Lin - - - # Glue Parameters #---------------------------------------------------------------------------------------------------------------------------------- -typedef ^ Glue_ParameterType IntKi iMod : - - "ModData index order for linearization" - -typedef ^ ^ VarsIdxType IdxLin - - - "Variable index for linearization data" - +typedef ^ Glue_LinParam IntKi NumTimes - - - "Number of times to linearize" - +typedef ^ ^ IntKi InterpOrder - - - "Interpolation order" - +typedef ^ ^ logical SaveOPs - - - "flag to save operating points during linearization" - +typedef ^ ^ VarsIdxType Idx - - - "Variable index for linearization data" - +typedef ^ ^ IntKi iMod : - - "ModData index order for linearization" - + +typedef ^ Glue_ParameterType Glue_LinParam Lin - - - "Linearization parameters" typedef ^ ^ R8Ki DT - - - "solution time step" - typedef ^ ^ R8Ki ConvTol - - - "Solution convergence tolerance" - typedef ^ ^ IntKi NumCrctn - - - "" - @@ -169,21 +174,42 @@ typedef ^ ^ IntKi iModPost : - - # Output Data #---------------------------------------------------------------------------------------------------------------------------------- -typedef ^ Glue_LinSave R8Ki x :: - - "linearization operating point continuous state" - +typedef ^ Glue_LinSave R8Ki Times : - - "linearization times" - +typedef ^ ^ R8Ki u :: - - "linearization operating point input" - +typedef ^ ^ R8Ki x :: - - "linearization operating point continuous state" - typedef ^ ^ R8Ki xd :: - - "linearization operating point discrete state" - typedef ^ ^ R8Ki z :: - - "linearization operating point constraint state" - typedef ^ ^ R8Ki OtherSt :: - - "linearization operating point other state" - -typedef ^ ^ R8Ki u :: - - "linearization operating point input" - typedef ^ Glue_OutputFileType ModDataType ModGlue - - - "glue module data" - -typedef ^ ^ Glue_LinSave OP - - - "Operating point data for linearization +typedef ^ ^ Glue_LinSave Lin - - - "Operating point data for linearization" #---------------------------------------------------------------------------------------------------------------------------------- # Miscellaneous Data #---------------------------------------------------------------------------------------------------------------------------------- -typedef ^ Glue_MiscVarType ModDataType ModData : - - "module variable and value data" - +typedef ^ Glue_CalcSteady R8Ki AzimuthTarget : - - "target azimuth positions where outputs are calculated" - +typedef ^ ^ R8Ki AzimuthDelta - - - "" - +typedef ^ ^ logical IsConverged - - - "Steady State calculation is converged" - +typedef ^ ^ logical FoundSteady - - - "" - +typedef ^ ^ logical ForceLin - - - "" - +typedef ^ ^ IntKi NumRotations - - - "Number of rotor rotations" - +typedef ^ ^ IntKi NumOutputs - - - "Number of output values (ignoring write outputs)" - +typedef ^ ^ R8Ki psi_buffer : - - "azimuth buffer for interpolation" - +typedef ^ ^ R8Ki y_buffer :: - - "output buffer for interpolation" - +typedef ^ ^ R8Ki y_azimuth :: - - "output values at target azimuths" - +typedef ^ ^ R8Ki y_interp : - - "output values interpolated to target azimuth" - +typedef ^ ^ R8Ki y_diff : - - "difference between outputs from current and previous rotation" - +typedef ^ ^ R8Ki y_ref : - - "reference output values for error calculation" - + +typedef ^ Glue_LinMisc IntKi TimeIndex - - - "" - +typedef ^ ^ IntKi AzimuthIndex - - - "" - +typedef ^ ^ logical IsConverged - - - "" - + +typedef ^ Glue_MiscVarType ModDataType Modules : - - "module variable and value data" - typedef ^ ^ MappingType Mappings : - - "Module mapping" - +typedef ^ ^ Glue_LinMisc Lin - - - "Linearization misc vars" +typedef ^ ^ Glue_CalcSteady CS - - - "CalcSteady calculation data" typedef ^ ^ R8Ki q :: - - "" - typedef ^ ^ R8Ki qn :: - - "" - typedef ^ ^ R8Ki x : - - "" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 23c3a9c1f3..39d1ef11c9 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -146,10 +146,18 @@ MODULE Glue_Types TYPE(Glue_LinType) :: Lin !< Linearization matrices [-] END TYPE VarsIdxType ! ======================= +! ========= Glue_LinParam ======= + TYPE, PUBLIC :: Glue_LinParam + INTEGER(IntKi) :: NumTimes = 0_IntKi !< Number of times to linearize [-] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order [-] + LOGICAL :: SaveOPs = .false. !< flag to save operating points during linearization [-] + TYPE(VarsIdxType) :: Idx !< Variable index for linearization data [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] + END TYPE Glue_LinParam +! ======================= ! ========= Glue_ParameterType ======= TYPE, PUBLIC :: Glue_ParameterType - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] - TYPE(VarsIdxType) :: IdxLin !< Variable index for linearization data [-] + TYPE(Glue_LinParam) :: Lin !< Linearization parameters [-] REAL(R8Ki) :: DT = 0.0_R8Ki !< solution time step [-] REAL(R8Ki) :: ConvTol = 0.0_R8Ki !< Solution convergence tolerance [-] INTEGER(IntKi) :: NumCrctn = 0_IntKi !< [-] @@ -186,23 +194,50 @@ MODULE Glue_Types ! ======================= ! ========= Glue_LinSave ======= TYPE, PUBLIC :: Glue_LinSave + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: Times !< linearization times [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: u !< linearization operating point input [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: x !< linearization operating point continuous state [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: xd !< linearization operating point discrete state [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: z !< linearization operating point constraint state [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< linearization operating point other state [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: u !< linearization operating point input [-] END TYPE Glue_LinSave ! ======================= ! ========= Glue_OutputFileType ======= TYPE, PUBLIC :: Glue_OutputFileType TYPE(ModDataType) :: ModGlue !< glue module data [-] - TYPE(Glue_LinSave) :: OP + TYPE(Glue_LinSave) :: Lin !< Operating point data for linearization [-] END TYPE Glue_OutputFileType ! ======================= +! ========= Glue_CalcSteady ======= + TYPE, PUBLIC :: Glue_CalcSteady + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: AzimuthTarget !< target azimuth positions where outputs are calculated [-] + REAL(R8Ki) :: AzimuthDelta = 0.0_R8Ki !< [-] + LOGICAL :: IsConverged = .false. !< Steady State calculation is converged [-] + LOGICAL :: FoundSteady = .false. !< [-] + LOGICAL :: ForceLin = .false. !< [-] + INTEGER(IntKi) :: NumRotations = 0_IntKi !< Number of rotor rotations [-] + INTEGER(IntKi) :: NumOutputs = 0_IntKi !< Number of output values (ignoring write outputs) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: psi_buffer !< azimuth buffer for interpolation [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: y_buffer !< output buffer for interpolation [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: y_azimuth !< output values at target azimuths [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_interp !< output values interpolated to target azimuth [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_diff !< difference between outputs from current and previous rotation [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_ref !< reference output values for error calculation [-] + END TYPE Glue_CalcSteady +! ======================= +! ========= Glue_LinMisc ======= + TYPE, PUBLIC :: Glue_LinMisc + INTEGER(IntKi) :: TimeIndex = 0_IntKi !< [-] + INTEGER(IntKi) :: AzimuthIndex = 0_IntKi !< [-] + LOGICAL :: IsConverged = .false. !< [-] + END TYPE Glue_LinMisc +! ======================= ! ========= Glue_MiscVarType ======= TYPE, PUBLIC :: Glue_MiscVarType - TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModData !< module variable and value data [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: Modules !< module variable and value data [-] TYPE(MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mapping [-] + TYPE(Glue_LinMisc) :: Lin !< Linearization misc vars [-] + TYPE(Glue_CalcSteady) :: CS !< CalcSteady calculation data [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: q !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: qn !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] @@ -1130,31 +1165,95 @@ subroutine Glue_UnPackVarsIdxType(RF, OutData) call Glue_UnpackLinType(RF, OutData%Lin) ! Lin end subroutine -subroutine Glue_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(Glue_ParameterType), intent(in) :: SrcParamData - type(Glue_ParameterType), intent(inout) :: DstParamData +subroutine Glue_CopyLinParam(SrcLinParamData, DstLinParamData, CtrlCode, ErrStat, ErrMsg) + type(Glue_LinParam), intent(in) :: SrcLinParamData + type(Glue_LinParam), intent(inout) :: DstLinParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_CopyParam' + character(*), parameter :: RoutineName = 'Glue_CopyLinParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcParamData%iMod)) then - LB(1:1) = lbound(SrcParamData%iMod, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iMod, kind=B8Ki) - if (.not. allocated(DstParamData%iMod)) then - allocate(DstParamData%iMod(LB(1):UB(1)), stat=ErrStat2) + DstLinParamData%NumTimes = SrcLinParamData%NumTimes + DstLinParamData%InterpOrder = SrcLinParamData%InterpOrder + DstLinParamData%SaveOPs = SrcLinParamData%SaveOPs + call Glue_CopyVarsIdxType(SrcLinParamData%Idx, DstLinParamData%Idx, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcLinParamData%iMod)) then + LB(1:1) = lbound(SrcLinParamData%iMod, kind=B8Ki) + UB(1:1) = ubound(SrcLinParamData%iMod, kind=B8Ki) + if (.not. allocated(DstLinParamData%iMod)) then + allocate(DstLinParamData%iMod(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iMod.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinParamData%iMod.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%iMod = SrcParamData%iMod + DstLinParamData%iMod = SrcLinParamData%iMod end if - call Glue_CopyVarsIdxType(SrcParamData%IdxLin, DstParamData%IdxLin, CtrlCode, ErrStat2, ErrMsg2) +end subroutine + +subroutine Glue_DestroyLinParam(LinParamData, ErrStat, ErrMsg) + type(Glue_LinParam), intent(inout) :: LinParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyLinParam' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyVarsIdxType(LinParamData%Idx, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(LinParamData%iMod)) then + deallocate(LinParamData%iMod) + end if +end subroutine + +subroutine Glue_PackLinParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_LinParam), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackLinParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumTimes) + call RegPack(RF, InData%InterpOrder) + call RegPack(RF, InData%SaveOPs) + call Glue_PackVarsIdxType(RF, InData%Idx) + call RegPackAlloc(RF, InData%iMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackLinParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_LinParam), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackLinParam' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SaveOPs); if (RegCheckErr(RF, RoutineName)) return + call Glue_UnpackVarsIdxType(RF, OutData%Idx) ! Idx + call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(in) :: SrcParamData + type(Glue_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_CopyLinParam(SrcParamData%Lin, DstParamData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstParamData%DT = SrcParamData%DT @@ -1299,10 +1398,7 @@ subroutine Glue_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ParamData%iMod)) then - deallocate(ParamData%iMod) - end if - call Glue_DestroyVarsIdxType(ParamData%IdxLin, ErrStat2, ErrMsg2) + call Glue_DestroyLinParam(ParamData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%iJL)) then deallocate(ParamData%iJL) @@ -1338,8 +1434,7 @@ subroutine Glue_PackParam(RF, Indata) type(Glue_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackParam' if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%iMod) - call Glue_PackVarsIdxType(RF, InData%IdxLin) + call Glue_PackLinParam(RF, InData%Lin) call RegPack(RF, InData%DT) call RegPack(RF, InData%ConvTol) call RegPack(RF, InData%NumCrctn) @@ -1383,8 +1478,7 @@ subroutine Glue_UnPackParam(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return - call Glue_UnpackVarsIdxType(RF, OutData%IdxLin) ! IdxLin + call Glue_UnpackLinParam(RF, OutData%Lin) ! Lin call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return @@ -1430,6 +1524,30 @@ subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, E character(*), parameter :: RoutineName = 'Glue_CopyLinSave' ErrStat = ErrID_None ErrMsg = '' + if (allocated(SrcLinSaveData%Times)) then + LB(1:1) = lbound(SrcLinSaveData%Times, kind=B8Ki) + UB(1:1) = ubound(SrcLinSaveData%Times, kind=B8Ki) + if (.not. allocated(DstLinSaveData%Times)) then + allocate(DstLinSaveData%Times(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%Times.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%Times = SrcLinSaveData%Times + end if + if (allocated(SrcLinSaveData%u)) then + LB(1:2) = lbound(SrcLinSaveData%u, kind=B8Ki) + UB(1:2) = ubound(SrcLinSaveData%u, kind=B8Ki) + if (.not. allocated(DstLinSaveData%u)) then + allocate(DstLinSaveData%u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%u = SrcLinSaveData%u + end if if (allocated(SrcLinSaveData%x)) then LB(1:2) = lbound(SrcLinSaveData%x, kind=B8Ki) UB(1:2) = ubound(SrcLinSaveData%x, kind=B8Ki) @@ -1478,18 +1596,6 @@ subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, E end if DstLinSaveData%OtherSt = SrcLinSaveData%OtherSt end if - if (allocated(SrcLinSaveData%u)) then - LB(1:2) = lbound(SrcLinSaveData%u, kind=B8Ki) - UB(1:2) = ubound(SrcLinSaveData%u, kind=B8Ki) - if (.not. allocated(DstLinSaveData%u)) then - allocate(DstLinSaveData%u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinSaveData%u = SrcLinSaveData%u - end if end subroutine subroutine Glue_DestroyLinSave(LinSaveData, ErrStat, ErrMsg) @@ -1499,6 +1605,12 @@ subroutine Glue_DestroyLinSave(LinSaveData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyLinSave' ErrStat = ErrID_None ErrMsg = '' + if (allocated(LinSaveData%Times)) then + deallocate(LinSaveData%Times) + end if + if (allocated(LinSaveData%u)) then + deallocate(LinSaveData%u) + end if if (allocated(LinSaveData%x)) then deallocate(LinSaveData%x) end if @@ -1511,9 +1623,6 @@ subroutine Glue_DestroyLinSave(LinSaveData, ErrStat, ErrMsg) if (allocated(LinSaveData%OtherSt)) then deallocate(LinSaveData%OtherSt) end if - if (allocated(LinSaveData%u)) then - deallocate(LinSaveData%u) - end if end subroutine subroutine Glue_PackLinSave(RF, Indata) @@ -1521,11 +1630,12 @@ subroutine Glue_PackLinSave(RF, Indata) type(Glue_LinSave), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackLinSave' if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Times) + call RegPackAlloc(RF, InData%u) call RegPackAlloc(RF, InData%x) call RegPackAlloc(RF, InData%xd) call RegPackAlloc(RF, InData%z) call RegPackAlloc(RF, InData%OtherSt) - call RegPackAlloc(RF, InData%u) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1537,11 +1647,12 @@ subroutine Glue_UnPackLinSave(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Times); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%OtherSt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Glue_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1558,7 +1669,7 @@ subroutine Glue_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, call Glue_CopyModDataType(SrcOutputFileTypeData%ModGlue, DstOutputFileTypeData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call Glue_CopyLinSave(SrcOutputFileTypeData%OP, DstOutputFileTypeData%OP, CtrlCode, ErrStat2, ErrMsg2) + call Glue_CopyLinSave(SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -1574,7 +1685,7 @@ subroutine Glue_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) ErrMsg = '' call Glue_DestroyModDataType(OutputFileTypeData%ModGlue, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Glue_DestroyLinSave(OutputFileTypeData%OP, ErrStat2, ErrMsg2) + call Glue_DestroyLinSave(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -1584,7 +1695,7 @@ subroutine Glue_PackOutputFileType(RF, Indata) character(*), parameter :: RoutineName = 'Glue_PackOutputFileType' if (RF%ErrStat >= AbortErrLev) return call Glue_PackModDataType(RF, InData%ModGlue) - call Glue_PackLinSave(RF, InData%OP) + call Glue_PackLinSave(RF, InData%Lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1594,7 +1705,228 @@ subroutine Glue_UnPackOutputFileType(RF, OutData) character(*), parameter :: RoutineName = 'Glue_UnPackOutputFileType' if (RF%ErrStat /= ErrID_None) return call Glue_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue - call Glue_UnpackLinSave(RF, OutData%OP) ! OP + call Glue_UnpackLinSave(RF, OutData%Lin) ! Lin +end subroutine + +subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, ErrStat, ErrMsg) + type(Glue_CalcSteady), intent(in) :: SrcCalcSteadyData + type(Glue_CalcSteady), intent(inout) :: DstCalcSteadyData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyCalcSteady' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcCalcSteadyData%AzimuthTarget)) then + LB(1:1) = lbound(SrcCalcSteadyData%AzimuthTarget, kind=B8Ki) + UB(1:1) = ubound(SrcCalcSteadyData%AzimuthTarget, kind=B8Ki) + if (.not. allocated(DstCalcSteadyData%AzimuthTarget)) then + allocate(DstCalcSteadyData%AzimuthTarget(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%AzimuthTarget.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%AzimuthTarget = SrcCalcSteadyData%AzimuthTarget + end if + DstCalcSteadyData%AzimuthDelta = SrcCalcSteadyData%AzimuthDelta + DstCalcSteadyData%IsConverged = SrcCalcSteadyData%IsConverged + DstCalcSteadyData%FoundSteady = SrcCalcSteadyData%FoundSteady + DstCalcSteadyData%ForceLin = SrcCalcSteadyData%ForceLin + DstCalcSteadyData%NumRotations = SrcCalcSteadyData%NumRotations + DstCalcSteadyData%NumOutputs = SrcCalcSteadyData%NumOutputs + if (allocated(SrcCalcSteadyData%psi_buffer)) then + LB(1:1) = lbound(SrcCalcSteadyData%psi_buffer, kind=B8Ki) + UB(1:1) = ubound(SrcCalcSteadyData%psi_buffer, kind=B8Ki) + if (.not. allocated(DstCalcSteadyData%psi_buffer)) then + allocate(DstCalcSteadyData%psi_buffer(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%psi_buffer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%psi_buffer = SrcCalcSteadyData%psi_buffer + end if + if (allocated(SrcCalcSteadyData%y_buffer)) then + LB(1:2) = lbound(SrcCalcSteadyData%y_buffer, kind=B8Ki) + UB(1:2) = ubound(SrcCalcSteadyData%y_buffer, kind=B8Ki) + if (.not. allocated(DstCalcSteadyData%y_buffer)) then + allocate(DstCalcSteadyData%y_buffer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_buffer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_buffer = SrcCalcSteadyData%y_buffer + end if + if (allocated(SrcCalcSteadyData%y_azimuth)) then + LB(1:2) = lbound(SrcCalcSteadyData%y_azimuth, kind=B8Ki) + UB(1:2) = ubound(SrcCalcSteadyData%y_azimuth, kind=B8Ki) + if (.not. allocated(DstCalcSteadyData%y_azimuth)) then + allocate(DstCalcSteadyData%y_azimuth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_azimuth.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_azimuth = SrcCalcSteadyData%y_azimuth + end if + if (allocated(SrcCalcSteadyData%y_interp)) then + LB(1:1) = lbound(SrcCalcSteadyData%y_interp, kind=B8Ki) + UB(1:1) = ubound(SrcCalcSteadyData%y_interp, kind=B8Ki) + if (.not. allocated(DstCalcSteadyData%y_interp)) then + allocate(DstCalcSteadyData%y_interp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_interp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_interp = SrcCalcSteadyData%y_interp + end if + if (allocated(SrcCalcSteadyData%y_diff)) then + LB(1:1) = lbound(SrcCalcSteadyData%y_diff, kind=B8Ki) + UB(1:1) = ubound(SrcCalcSteadyData%y_diff, kind=B8Ki) + if (.not. allocated(DstCalcSteadyData%y_diff)) then + allocate(DstCalcSteadyData%y_diff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_diff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_diff = SrcCalcSteadyData%y_diff + end if + if (allocated(SrcCalcSteadyData%y_ref)) then + LB(1:1) = lbound(SrcCalcSteadyData%y_ref, kind=B8Ki) + UB(1:1) = ubound(SrcCalcSteadyData%y_ref, kind=B8Ki) + if (.not. allocated(DstCalcSteadyData%y_ref)) then + allocate(DstCalcSteadyData%y_ref(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_ref.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_ref = SrcCalcSteadyData%y_ref + end if +end subroutine + +subroutine Glue_DestroyCalcSteady(CalcSteadyData, ErrStat, ErrMsg) + type(Glue_CalcSteady), intent(inout) :: CalcSteadyData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyCalcSteady' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CalcSteadyData%AzimuthTarget)) then + deallocate(CalcSteadyData%AzimuthTarget) + end if + if (allocated(CalcSteadyData%psi_buffer)) then + deallocate(CalcSteadyData%psi_buffer) + end if + if (allocated(CalcSteadyData%y_buffer)) then + deallocate(CalcSteadyData%y_buffer) + end if + if (allocated(CalcSteadyData%y_azimuth)) then + deallocate(CalcSteadyData%y_azimuth) + end if + if (allocated(CalcSteadyData%y_interp)) then + deallocate(CalcSteadyData%y_interp) + end if + if (allocated(CalcSteadyData%y_diff)) then + deallocate(CalcSteadyData%y_diff) + end if + if (allocated(CalcSteadyData%y_ref)) then + deallocate(CalcSteadyData%y_ref) + end if +end subroutine + +subroutine Glue_PackCalcSteady(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_CalcSteady), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackCalcSteady' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AzimuthTarget) + call RegPack(RF, InData%AzimuthDelta) + call RegPack(RF, InData%IsConverged) + call RegPack(RF, InData%FoundSteady) + call RegPack(RF, InData%ForceLin) + call RegPack(RF, InData%NumRotations) + call RegPack(RF, InData%NumOutputs) + call RegPackAlloc(RF, InData%psi_buffer) + call RegPackAlloc(RF, InData%y_buffer) + call RegPackAlloc(RF, InData%y_azimuth) + call RegPackAlloc(RF, InData%y_interp) + call RegPackAlloc(RF, InData%y_diff) + call RegPackAlloc(RF, InData%y_ref) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackCalcSteady(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_CalcSteady), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackCalcSteady' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AzimuthTarget); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimuthDelta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsConverged); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FoundSteady); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ForceLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRotations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%psi_buffer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_buffer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_interp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_diff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_ref); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyLinMisc(SrcLinMiscData, DstLinMiscData, CtrlCode, ErrStat, ErrMsg) + type(Glue_LinMisc), intent(in) :: SrcLinMiscData + type(Glue_LinMisc), intent(inout) :: DstLinMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_CopyLinMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstLinMiscData%TimeIndex = SrcLinMiscData%TimeIndex + DstLinMiscData%AzimuthIndex = SrcLinMiscData%AzimuthIndex + DstLinMiscData%IsConverged = SrcLinMiscData%IsConverged +end subroutine + +subroutine Glue_DestroyLinMisc(LinMiscData, ErrStat, ErrMsg) + type(Glue_LinMisc), intent(inout) :: LinMiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyLinMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Glue_PackLinMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_LinMisc), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackLinMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TimeIndex) + call RegPack(RF, InData%AzimuthIndex) + call RegPack(RF, InData%IsConverged) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackLinMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_LinMisc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackLinMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TimeIndex); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimuthIndex); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsConverged); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1610,18 +1942,18 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%ModData)) then - LB(1:1) = lbound(SrcMiscData%ModData, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ModData, kind=B8Ki) - if (.not. allocated(DstMiscData%ModData)) then - allocate(DstMiscData%ModData(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%Modules)) then + LB(1:1) = lbound(SrcMiscData%Modules, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Modules, kind=B8Ki) + if (.not. allocated(DstMiscData%Modules)) then + allocate(DstMiscData%Modules(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ModData.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Modules.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call Glue_CopyModDataType(SrcMiscData%ModData(i1), DstMiscData%ModData(i1), CtrlCode, ErrStat2, ErrMsg2) + call Glue_CopyModDataType(SrcMiscData%Modules(i1), DstMiscData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -1642,6 +1974,12 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end if + call Glue_CopyLinMisc(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyCalcSteady(SrcMiscData%CS, DstMiscData%CS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%q)) then LB(1:2) = lbound(SrcMiscData%q, kind=B8Ki) UB(1:2) = ubound(SrcMiscData%q, kind=B8Ki) @@ -1947,14 +2285,14 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%ModData)) then - LB(1:1) = lbound(MiscData%ModData, kind=B8Ki) - UB(1:1) = ubound(MiscData%ModData, kind=B8Ki) + if (allocated(MiscData%Modules)) then + LB(1:1) = lbound(MiscData%Modules, kind=B8Ki) + UB(1:1) = ubound(MiscData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) - call Glue_DestroyModDataType(MiscData%ModData(i1), ErrStat2, ErrMsg2) + call Glue_DestroyModDataType(MiscData%Modules(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%ModData) + deallocate(MiscData%Modules) end if if (allocated(MiscData%Mappings)) then LB(1:1) = lbound(MiscData%Mappings, kind=B8Ki) @@ -1965,6 +2303,10 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%Mappings) end if + call Glue_DestroyLinMisc(MiscData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyCalcSteady(MiscData%CS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%q)) then deallocate(MiscData%q) end if @@ -2046,13 +2388,13 @@ subroutine Glue_PackMisc(RF, Indata) integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%ModData)) - if (allocated(InData%ModData)) then - call RegPackBounds(RF, 1, lbound(InData%ModData, kind=B8Ki), ubound(InData%ModData, kind=B8Ki)) - LB(1:1) = lbound(InData%ModData, kind=B8Ki) - UB(1:1) = ubound(InData%ModData, kind=B8Ki) + call RegPack(RF, allocated(InData%Modules)) + if (allocated(InData%Modules)) then + call RegPackBounds(RF, 1, lbound(InData%Modules, kind=B8Ki), ubound(InData%Modules, kind=B8Ki)) + LB(1:1) = lbound(InData%Modules, kind=B8Ki) + UB(1:1) = ubound(InData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) - call Glue_PackModDataType(RF, InData%ModData(i1)) + call Glue_PackModDataType(RF, InData%Modules(i1)) end do end if call RegPack(RF, allocated(InData%Mappings)) @@ -2064,6 +2406,8 @@ subroutine Glue_PackMisc(RF, Indata) call Glue_PackMappingType(RF, InData%Mappings(i1)) end do end if + call Glue_PackLinMisc(RF, InData%Lin) + call Glue_PackCalcSteady(RF, InData%CS) call RegPackAlloc(RF, InData%q) call RegPackAlloc(RF, InData%qn) call RegPackAlloc(RF, InData%x) @@ -2104,17 +2448,17 @@ subroutine Glue_UnPackMisc(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%ModData)) deallocate(OutData%ModData) + if (allocated(OutData%Modules)) deallocate(OutData%Modules) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%ModData(LB(1):UB(1)),stat=stat) + allocate(OutData%Modules(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModData.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modules.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Glue_UnpackModDataType(RF, OutData%ModData(i1)) ! ModData + call Glue_UnpackModDataType(RF, OutData%Modules(i1)) ! Modules end do end if if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) @@ -2130,6 +2474,8 @@ subroutine Glue_UnPackMisc(RF, OutData) call Glue_UnpackMappingType(RF, OutData%Mappings(i1)) ! Mappings end do end if + call Glue_UnpackLinMisc(RF, OutData%Lin) ! Lin + call Glue_UnpackCalcSteady(RF, OutData%CS) ! CS call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%qn); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return From c603aef6c0c85fe37bc54eae91a250ed2b78dc8e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 3 Jun 2024 14:19:42 +0000 Subject: [PATCH 140/319] Add MV_ExtrapInterp function to ModVar This function provides the extrapolation and interpolation routines for an array of values governed by module variables --- modules/nwtc-library/src/ModVar.f90 | 135 +++++++++++++++++- modules/openfast-library/src/FAST_ModGlue.f90 | 103 +------------ 2 files changed, 137 insertions(+), 101 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index f4eafbb90a..33c879578b 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -31,11 +31,11 @@ module ModVar private public :: MV_InitVarsJac, MV_Pack, MV_Unpack -public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff +public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff, MV_ExtrapInterp public :: MV_AddVar, MV_AddMeshVar public :: MV_HasFlags, MV_SetFlags, MV_UnsetFlags, MV_NumVars public :: LoadFields, MotionFields, TransFields, AngularFields -public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv, quat_scalar, quat_canonical +public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv public :: MV_FieldString, IdxStr public :: DumpMatrix @@ -653,6 +653,135 @@ subroutine MV_ComputeCentralDiff(VarAry, Delta, PosAry, NegAry, DerivAry) end subroutine +!> MV_ExtrapInterp interpolates arrays of variable data to the target x value from +!! the array of x values. Supports constant, linear, and quadratic interpolation +!! similar to the ExtrapInterp routines created by the registry. +subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: y(:, :) + real(R8Ki), intent(in) :: tin(:) + real(R8Ki), intent(inout) :: y_out(:) + real(R8Ki), intent(in) :: tin_out + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_ExtrapInterp' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: InterpOrder + real(R8Ki) :: t(3), t_out, a1, a2, a3, ti + real(R8Ki) :: q1(4), q2(4), q(4) + real(R8Ki) :: dot, theta, sin_theta, a, b + integer(IntKi) :: i, j, k + integer(IntKi), parameter :: iq1 = 1 + integer(IntKi) :: iq2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Check that array sizes match + if (size(t) /= size(y, 2)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate interpolation order + InterpOrder = size(t) - 1 + + ! Switch based on interpolation order + select case (InterpOrder) + + case (0) ! Constant interpolation (copy) + + y_out = y(:, 1) + + case (1) ! Linear Interpolation + + t(1:2) = tin - tin(1) + t_out = tin_out - tin(1) + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + y_out = a1*y(:, 1) + a2*y(:, 2) + iq2 = 2 + + case (2) ! Quadratic Interpolation + + t = tin - tin(1) + t_out = tin_out - tin(1) + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + y_out = a1*y(:, 1) + a2*y(:, 2) + a3*y(:, 3) + iq2 = 3 + + case default + + ! Unsupported Interpolation + call SetErrStat(ErrID_Fatal, 'size(t) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select + + ! If order is zero, return since interp is a copy + if (InterpOrder == 0) return + + !---------------------------------------------------------------------------- + ! Handle variables that can't be linearly interpolated (ie. orientations) + !---------------------------------------------------------------------------- + + ! Calculate interpolation parameter [0,1] + ti = t_out/t(iq2) + + ! Loop through glue output variables + do i = 1, size(VarAry) + + ! Switch based on variable field type + select case (VarAry(i)%Field) + + case (VF_Orientation) ! SLERP for orientation quaternions + + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Nodes + + ! Get quaternion 1 from array, calculate scalar + q1(2:4) = y(k:k + 2, iq1) + q1(1) = quat_scalar(q1(2:4)) + + ! Get quaternion 2 from array, calculate scalar + q2(2:4) = y(k:k + 2, iq2) + q2(1) = quat_scalar(q2(2:4)) + + ! Calculate dot product of two quaternions + ! If dot product is negative, invert second quaternion + dot = dot_product(q1, q2) + if (dot < 0.0_R8Ki) then + dot = -dot + q2 = -q2 + end if + + ! If the quaternions are very close, use linear interpolation + if (dot > 0.9995_R8Ki) then + q = (1.0_R8Ki - ti)*q1 + ti*q2 + else + theta = acos(dot) + sin_theta = sin(theta) + a = sin((1.0_R8Ki - ti)*theta)/sin_theta + b = sin(ti*theta)/sin_theta + q = a*q1 + b*q2 + end if + + ! Store canonical quaternion in output array + y_out(k:k + 2) = quat_canonical(q(1), q(2:4)) + + ! Increment quaternion index + k = k + 3 + end do + + end select + + end do + +end subroutine + !------------------------------------------------------------------------------- ! Functions for adding Variables !------------------------------------------------------------------------------- @@ -897,7 +1026,7 @@ pure function quat_canonical(q0, q) result(qc) real(R8Ki) :: qc(3), m integer(IntKi) :: i m = q0*q0 + dot_product(q, q) - qc = q / m + qc = q/m if (q0 > 0.0_R8Ki) return if (q0 < 0.0_R8Ki) then qc = -qc diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index aece2d521f..815a79c794 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -476,7 +476,8 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, if (ProcessAzimuth) then ! Interpolate outputs to target azimuth - call InterpOutputsToAzimuth() + call MV_ExtrapInterp(y%ModGlue%Vars%y, m%CS%y_buffer, m%CS%psi_buffer, & + m%CS%y_interp, AzimuthTarget, ErrStat2, ErrMsg2) ! If converged if (m%CS%IsConverged) then @@ -557,102 +558,6 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, contains - subroutine InterpOutputsToAzimuth() - real(R8Ki) :: a1, a2, a3 !< interpolation coefficients - real(R8Ki) :: ti(3), to !< temporary variables for interpolation - real(R8Ki) :: q01, q1(3) - real(R8Ki) :: q02, q2(3) - real(R8Ki) :: q0o, qo(3) - real(R8Ki) :: dot, theta, sin_theta, a, b - integer(IntKi) :: k, iq1, iq2 - logical :: first_quat - - ! Switch based on interpolation order - select case (p%Lin%InterpOrder) - case (0) - m%CS%y_interp = m%CS%y_buffer(:, 1) - return - case (1) - ti(1:2) = m%CS%psi_buffer - m%CS%psi_buffer(1) - to = AzimuthTarget - m%CS%psi_buffer(1) - a1 = -(to - ti(2))/ti(2) - a2 = to/ti(2) - m%CS%y_interp = a1*m%CS%y_buffer(:, 1) + a2*m%CS%y_buffer(:, 2) - case (2) - ti = m%CS%psi_buffer - m%CS%psi_buffer(1) - to = AzimuthTarget - m%CS%psi_buffer(1) - a1 = (to - ti(2))*(to - ti(3))/((ti(1) - ti(2))*(ti(1) - ti(3))) - a2 = (to - ti(1))*(to - ti(3))/((ti(2) - ti(1))*(ti(2) - ti(3))) - a3 = (to - ti(1))*(to - ti(2))/((ti(3) - ti(1))*(ti(3) - ti(2))) - m%CS%y_interp = a1*m%CS%y_buffer(:, 1) + a2*m%CS%y_buffer(:, 2) + a3*m%CS%y_buffer(:, 3) - case default - m%CS%y_interp = 0.0_R8Ki - return - end select - - ! Loop through glue output variables - first_quat = .true. - do i = 1, size(y%ModGlue%Vars%y) - associate (Var => y%ModGlue%Vars%y(i)) - - ! Switch based on variable field type - select case (Var%Field) - case (VF_Orientation) - - ! If first quaternion, calculate interpolation coefficients for quadratic interp - if (first_quat) then - first_quat = .false. - select case (p%Lin%InterpOrder) - case (1) - iq1 = 1 - iq2 = 2 - case (2) - ! Determine if azimuth target is between indices 1,2 or 2,3 - if (AzimuthTarget >= m%CS%psi_buffer(2)) then - iq1 = 1 - iq2 = 2 - else - iq1 = 2 - iq2 = 3 - end if - to = (AzimuthTarget - m%CS%psi_buffer(iq1))/(m%CS%psi_buffer(iq2) - m%CS%psi_buffer(iq1)) - end select - end if - - k = Var%iLoc(1) - do j = 1, Var%Nodes - q1 = m%CS%y_buffer(k:k + 2, iq1) - q2 = m%CS%y_buffer(k:k + 2, iq2) - q01 = quat_scalar(q1) - q02 = quat_scalar(q2) - dot = q01*q02 + dot_product(q1, q2) - if (dot < 0.0_R8Ki) then - dot = -dot - q02 = -q02 - q2 = -q2 - end if - if (dot > 0.9995_R8Ki) then - q0o = (1.0_R8Ki - to)*q01 + to*q02 - qo = (1.0_R8Ki - to)*q1 + to*q2 - else - theta = acos(dot) - sin_theta = sin(theta) - a = sin((1.0_R8Ki - to)*theta)/sin_theta - b = sin(to*theta)/sin_theta - q0o = a*q01 + b*q02 - qo = a*q1 + b*q2 - end if - qo = quat_canonical(q0o, qo) - m%CS%y_interp(k:k + 2) = qo - k = k + 3 - end do - - end select - - end associate - end do - end subroutine - function CalcOutputErrorAtAzimuth() result(eps_squared) real(R8Ki) :: eps_squared_sum, eps_squared @@ -663,9 +568,11 @@ function CalcOutputErrorAtAzimuth() result(eps_squared) ! Initialize epsilon squared sum eps_squared_sum = 0 - ! Loop through glue output variables, ignore write outputs + ! Loop through glue output variables do i = 1, size(y%ModGlue%Vars%y) associate (Var => y%ModGlue%Vars%y(i)) + + ! Skip write outputs if (MV_HasFlags(Var, VF_WriteOut)) cycle ! Loop through values in variable From 1e4bc9a95dfc9d3ec24d0c74ebe9f7078570c63f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 3 Jun 2024 15:09:19 +0000 Subject: [PATCH 141/319] Rename ModVar variables fields to better differentiate from Flags. Add VF_2PI flag for variables that are in the range of [0, 2PI] --- modules/aerodyn/src/AeroDyn.f90 | 32 +++--- modules/beamdyn/src/BeamDyn.f90 | 58 +++++----- modules/elastodyn/src/ElastoDyn.f90 | 79 ++++++------- modules/hydrodyn/src/HydroDyn.f90 | 26 ++--- modules/inflowwind/src/InflowWind.f90 | 14 +-- modules/map/src/map.f90 | 6 +- modules/moordyn/src/MoorDyn.f90 | 50 ++++---- modules/nwtc-library/src/ModVar.f90 | 108 +++++++++--------- .../nwtc-library/src/NWTC_Library_Types.f90 | 31 ++--- .../src/Registry_NWTC_Library.txt | 31 ++--- .../src/Registry_NWTC_Library_base.txt | 31 ++--- modules/openfast-library/src/FAST_Funcs.f90 | 8 +- modules/openfast-library/src/FAST_Mapping.f90 | 38 +++--- modules/openfast-library/src/FAST_ModGlue.f90 | 8 +- modules/seastate/src/SeaState.f90 | 6 +- modules/servodyn/src/ServoDyn.f90 | 26 ++--- modules/subdyn/src/SubDyn.f90 | 6 +- 17 files changed, 281 insertions(+), 277 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 5315f706ac..ca3a18ca9f 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5624,7 +5624,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD if (p%BEMT%DBEMT%lin_nx/2 > 0) then p%iVarDBEMT = size(p%Vars%x) + 1 do j = 1, p%NumBlades - call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & + call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & Num=p%NumBlNds*2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & Perturb=Perturb, & @@ -5632,7 +5632,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD DBEMTLinName(j, i, "tangential", .false.)], i = 1, p%NumBlNds)]) end do do j = 1, p%NumBlades - call MV_AddVar(p%Vars%x, "DBEMT%Element", VF_Scalar, & + call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & Num=p%NumBlNds*2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & Perturb=Perturb, & @@ -5663,7 +5663,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', -' end select - call MV_AddVar(p%Vars%x, NodeLabel, VF_Scalar, & + call MV_AddVar(p%Vars%x, NodeLabel, FieldScalar, & Flags=ior(VF_DerivOrder1, VF_RotFrame), & Perturb=p%BEMT%UA%dx(state), & LinNames=[NodeLabel]) @@ -5684,28 +5684,28 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call MV_AddMeshVar(p%Vars%u, "Nacelle", & VarIdx=p%iVarNacelleMotion, & Mesh=u%NacelleMotion, & - Fields=[VF_TransDisp, VF_Orientation], & + Fields=[FieldTransDisp, FieldOrientation], & Perturbs=[PerturbBlade(1), Perturb]) ! Add hub motion call MV_AddMeshVar(p%Vars%u, "Hub", & VarIdx=p%iVarHubMotion, & Mesh=u%HubMotion, & - Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel], & + Fields=[FieldTransDisp, FieldOrientation, FieldAngularVel], & Perturbs=[PerturbBlade(1), Perturb, Perturb]) ! Add tail fin motion call MV_AddMeshVar(p%Vars%u, "TFin", & VarIdx=p%iVarTFinMotion, & Mesh=u%TFinMotion, & - Fields=[VF_TransDisp, VF_Orientation, VF_TransVel], & + Fields=[FieldTransDisp, FieldOrientation, FieldTransVel], & Perturbs=[Perturb, Perturb, Perturb]) ! Add tower motion call MV_AddMeshVar(p%Vars%u, "Tower", & VarIdx=p%iVarTowerMotion, & Mesh=u%TowerMotion, & - Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_TransAcc], & + Fields=[FieldTransDisp, FieldOrientation, FieldTransVel, FieldTransAcc], & Perturbs=[PerturbTower, Perturb, PerturbTower, PerturbTower]) ! Add blade root motion @@ -5715,7 +5715,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call MV_AddMeshVar(p%Vars%u, "Blade root "//Num2LStr(j), & VarIdx=p%iVarBladeRootMotion(j), & Mesh=u%BladeRootMotion(j), & - Fields=[VF_Orientation], & + Fields=[FieldOrientation], & Perturbs=[Perturb]) end do @@ -5726,13 +5726,13 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(j), & VarIdx=p%iVarBladeMotion(j), & Mesh=u%BladeMotion(j), & - Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc], & + Fields=[FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc], & Perturbs=[PerturbBlade(j), Perturb, PerturbBlade(j), Perturb, PerturbBlade(j), Perturb]) ! Set AeroMap flag on subset of fields for first blade if (j == 1) then do i = p%iVarBladeMotion(j), size(p%Vars%u) select case (p%Vars%u(i)%Field) - case (VF_TransDisp, VF_Orientation, VF_TransVel) + case (FieldTransDisp, FieldOrientation, FieldTransVel) call MV_SetFlags(p%Vars%u(i), VF_AeroMap) end select end do @@ -5743,7 +5743,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call AllocAry(p%iVarUserProp, p%NumBlades, "iVarUserProp", ErrStat2, ErrMsg2); if (Failed()) return p%iVarUserProp = 0 do j = 1, p%NumBlades - call MV_AddVar(p%Vars%u, "UserProp Blade"//IdxStr(j), VF_Scalar, & + call MV_AddVar(p%Vars%u, "UserProp Blade"//IdxStr(j), FieldScalar, & VarIdx=p%iVarUserProp(j), & Flags=ior(VF_Linearize, VF_RotFrame), & Num=p%NumBlNds, & @@ -5752,19 +5752,19 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD end do ! Extended inputs - call MV_AddVar(p%Vars%u, "HWindSpeed", VF_Scalar, & + call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, & VarIdx=p%iVarHWindSpeed, & Flags=VF_ExtLin + VF_Linearize, & Perturb=Perturb, & LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%u, "PLExp", VF_Scalar, & + call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, & VarIdx=p%iVarPLexp, & Flags=VF_ExtLin + VF_Linearize, & Perturb=Perturb, & LinNames=['Extended input: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%u, "PropagationDir", VF_Scalar, & + call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, & VarIdx=p%iVarPropagationDir, & Flags=VF_ExtLin + VF_Linearize, & Perturb=Perturb, & @@ -5808,7 +5808,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD ! Rotor outputs do j = 1, p%NumOuts - call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), VF_Scalar, & + call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), FieldScalar, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(j)%Indx), & iUsr=j, & LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) @@ -5816,7 +5816,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD ! Blade node outputs do j = p%NumOuts + 1, p%NumOuts + p%BldNd_TotNumOuts - call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), VF_Scalar, & + call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), FieldScalar, & Flags=VF_WriteOut + VF_RotFrame, & iUsr=j, & LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 90b89bc8f7..a45b9f8b5a 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -5850,7 +5850,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) do i = 2, p%node_total label = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' - call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransDisp, & + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldTransDisp, & Num=3, & Flags=Flags, & iUsr=i, & @@ -5858,7 +5858,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) LinNames=[trim(label)//' translational displacement in X, m', & trim(label)//' translational displacement in Y, m', & trim(label)//' translational displacement in Z, m']) - call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_Orientation, & + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldOrientation, & Num=3, & Flags=Flags, & iUsr=i, & @@ -5872,7 +5872,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) do i = 2, p%node_total label = 'First time derivative of finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' - call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransVel, & + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldTransVel, & Num=3, & Flags=Flags, & iUsr=i, & @@ -5880,7 +5880,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) LinNames=[trim(label)//' translational displacement in X, m/s', & trim(label)//' translational displacement in Y, m/s', & trim(label)//' translational displacement in Z, m/s']) - call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_AngularVel, & + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldAngularVel, & Num=3, & Flags=Flags, & iUsr=i, & @@ -5900,23 +5900,23 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) call MV_AddMeshVar(p%Vars%u, "RootMotion", MotionFields, & VarIdx=p%iVarRootMotion, & Mesh=u%RootMotion, & - Perturbs=[0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransDisp - 0.2_R8Ki*D2R_D, & ! VF_Orientation - 0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransVel - 0.2_R8Ki*D2R_D, & ! VF_AngularVel - 0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransAcc - 0.2_R8Ki*D2R_D]) ! VF_AngularAcc + Perturbs=[0.2_R8Ki*D2R_D * p%blade_length, & ! FieldTransDisp + 0.2_R8Ki*D2R_D, & ! FieldOrientation + 0.2_R8Ki*D2R_D * p%blade_length, & ! FieldTransVel + 0.2_R8Ki*D2R_D, & ! FieldAngularVel + 0.2_R8Ki*D2R_D * p%blade_length, & ! FieldTransAcc + 0.2_R8Ki*D2R_D]) ! FieldAngularAcc call MV_AddMeshVar(p%Vars%u, "PointLoad", LoadFields, & VarIdx=p%iVarPointLoad, & Mesh=u%PointLoad, & - Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! VF_Force - MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! VF_Moment + Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! FieldForce + MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! FieldMoment call MV_AddMeshVar(p%Vars%u, "DistrLoad", LoadFields, & VarIdx=p%iVarDistrLoad, & Flags=ior(VF_Line, VF_AeroMap), & Mesh=u%DistrLoad, & - Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! VF_Force - MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! VF_Moment + Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! FieldForce + MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! FieldMoment !---------------------------------------------------------------------------- ! Output variables @@ -5932,7 +5932,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) if (p%CompAeroMaps) then do i = p%iVarBldMotion, size(p%Vars%y) select case (p%Vars%y(i)%Field) - case (VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel) + case (FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel) call MV_SetFlags(p%Vars%y(i), VF_AeroMap) end select end do @@ -5940,7 +5940,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) p%iVarWriteOutput = size(p%Vars%y) + 1 do i = 1, p%NumOuts - call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & VarIdx = j, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & iUsr=i, & @@ -5950,7 +5950,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) idx = p%NumOuts + 1 do i = 1, p%BldNd_NumOuts - call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & + call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, FieldScalar, & VarIdx = j, & Num=size(p%BldNd_BlOutNd), & Flags=VF_WriteOut + BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & @@ -6018,14 +6018,14 @@ subroutine BD_PackContStateQuatOP(p, x, Values) do i = 1, size(p%Vars%x) associate (Var => p%Vars%x(i)) select case(Var%Field) - case (VF_TransDisp) + case (FieldTransDisp) Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ displacement - case (VF_Orientation) + case (FieldOrientation) quat = wm_to_quat(wm_inv(x%q(4:6,Var%iUsr(1)))) Values(Var%iLoc(1):Var%iLoc(2)) = quat ! WM to quaternion - case (VF_TransVel) + case (FieldTransVel) Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ velocity - case (VF_AngularVel) + case (FieldAngularVel) Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular velocity end select end associate @@ -6041,14 +6041,14 @@ subroutine BD_UnpackContStateQuatOP(p, Values, x) do i = 1, size(p%Vars%x) associate (Var => p%Vars%x(i)) select case(Var%Field) - case (VF_TransDisp) + case (FieldTransDisp) x%q(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ displacement - case (VF_Orientation) + case (FieldOrientation) wm = wm_inv(quat_to_wm(Values(Var%iLoc(1):Var%iLoc(2)))) x%q(4:6,Var%iUsr(1)) = wm ! Quaternion to WM - case (VF_TransVel) + case (FieldTransVel) x%dqdt(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ velocity - case (VF_AngularVel) + case (FieldAngularVel) x%dqdt(4:6,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! Angular velocity end select end associate @@ -6063,13 +6063,13 @@ subroutine BD_PackContStateOP(p, x, Values) do i = 1, size(p%Vars%x) associate (Var => p%Vars%x(i)) select case(Var%Field) - case (VF_TransDisp) + case (FieldTransDisp) Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ velocity - case (VF_Orientation) + case (FieldOrientation) Values(Var%iLoc(1):Var%iLoc(2)) = x%q(4:6,Var%iUsr(1)) ! Angular velocity - case (VF_TransVel) + case (FieldTransVel) Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ acceleration - case (VF_AngularVel) + case (FieldAngularVel) Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular acceleration end select end associate diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 74e4914e21..7e59905c2c 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -11256,112 +11256,112 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat !---------------------------------------------------------------------------- ! Add continuous state variables (translation and rotation) - call MV_AddVar(p%Vars%x, 'PlatformSurge', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'PlatformSurge', FieldTransDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_Sg, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal surge translation DOF (internal DOF index = DOF_Sg), m'], & Active=InputFileData%PtfmSgDOF) - call MV_AddVar(p%Vars%x, 'PlatformSway', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'PlatformSway', FieldTransDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_Sw, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal sway translation DOF (internal DOF index = DOF_Sw), m'], & Active=InputFileData%PtfmSwDOF) - call MV_AddVar(p%Vars%x, 'PlatformHeave', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'PlatformHeave', FieldTransDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_Hv, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform vertical heave translation DOF (internal DOF index = DOF_Hv), m'], & Active=InputFileData%PtfmHvDOF) - call MV_AddVar(p%Vars%x, 'PlatformRoll', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'PlatformRoll', FieldAngularDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_R, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform roll tilt rotation DOF (internal DOF index = DOF_R), rad'], & Active=InputFileData%PtfmRDOF) - call MV_AddVar(p%Vars%x, 'PlatformPitch', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'PlatformPitch', FieldAngularDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_P, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform pitch tilt rotation DOF (internal DOF index = DOF_P), rad'], & Active=InputFileData%PtfmPDOF) - call MV_AddVar(p%Vars%x, 'PlatformYaw', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'PlatformYaw', FieldAngularDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_Y, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform yaw rotation DOF (internal DOF index = DOF_Y), rad'], & Active=InputFileData%PtfmYDOF) - call MV_AddVar(p%Vars%x, 'TowerFA1', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'TowerFA1', FieldTransDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_TFA1, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower fore-aft bending mode DOF (internal DOF index = DOF_TFA1), m'], & Active=InputFileData%TwFADOF1) - call MV_AddVar(p%Vars%x, 'TowerSS1', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'TowerSS1', FieldTransDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_TSS1, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower side-to-side bending mode DOF (internal DOF index = DOF_TSS1), m'], & Active=InputFileData%TwSSDOF1) - call MV_AddVar(p%Vars%x, 'TowerFA2', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'TowerFA2', FieldTransDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_TFA2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower fore-aft bending mode DOF (internal DOF index = DOF_TFA2), m'], & Active=InputFileData%TwFADOF2) - call MV_AddVar(p%Vars%x, 'TowerSS2', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'TowerSS2', FieldTransDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_TSS2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower side-to-side bending mode DOF (internal DOF index = DOF_TSS2), m'], & Active=InputFileData%TwSSDOF2) - call MV_AddVar(p%Vars%x, 'NacelleYaw', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'NacelleYaw', FieldAngularDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_Yaw, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Nacelle yaw DOF (internal DOF index = DOF_Yaw), rad'], & Active=InputFileData%YawDOF) - call MV_AddVar(p%Vars%x, 'RotorFurl', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'RotorFurl', FieldAngularDisp, & Flags=VF_DerivOrder2 + VF_AeroMap, & iUsr=DOF_RFrl, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Rotor-furl DOF (internal DOF index = DOF_RFrl), rad'], & Active=InputFileData%RFrlDOF) - call MV_AddVar(p%Vars%x, 'GeneratorAzimuth', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'GeneratorAzimuth', FieldAngularDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_GeAz, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Variable speed generator DOF (internal DOF index = DOF_GeAz), rad'], & Active=InputFileData%GenDOF) - call MV_AddVar(p%Vars%x, 'DrivetrainFlexibility', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'DrivetrainFlexibility', FieldAngularDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_DrTr, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Drivetrain rotational-flexibility DOF (internal DOF index = DOF_DrTr), rad'], & Active=InputFileData%DrTrDOF) - call MV_AddVar(p%Vars%x, 'TailFurl', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'TailFurl', FieldAngularDisp, & Flags=VF_DerivOrder2 + VF_AeroMap, & iUsr=DOF_TFrl, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Tail-furl DOF (internal DOF index = DOF_TFrl), rad'], & Active=InputFileData%TFrlDOF) - call MV_AddVar(p%Vars%x, 'RotorTeeter', VF_AngularDisp, & + call MV_AddVar(p%Vars%x, 'RotorTeeter', FieldAngularDisp, & Flags=VF_DerivOrder2, & iUsr=DOF_Teet, & Perturb=2.0_R8Ki * D2R_D, & @@ -11371,7 +11371,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) - call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', FieldTransDisp, & Flags=Flags, & iUsr=DOF_BF(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & @@ -11383,7 +11383,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) - call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', FieldTransDisp, & Flags=Flags, & iUsr=DOF_BE(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & @@ -11395,7 +11395,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) - call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', VF_TransDisp, & + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', FieldTransDisp, & Flags=Flags, & iUsr=DOF_BF(i,2), & Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & @@ -11412,8 +11412,8 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat p%Vars%x(i)%Perturb = max(p%Vars%x(i)%Perturb, MinPerturb) ! Update from position to velocity - if (p%Vars%x(i)%Field == VF_TransDisp) Field = VF_TransVel - if (p%Vars%x(i)%Field == VF_AngularDisp) Field = VF_AngularVel + if (p%Vars%x(i)%Field == FieldTransDisp) Field = FieldTransVel + if (p%Vars%x(i)%Field == FieldAngularDisp) Field = FieldAngularVel ! Add variable (only active variables are in x) call MV_AddVar(p%Vars%x, p%Vars%x(i)%Name, Field, & @@ -11490,28 +11490,28 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat MaxTorque / 100.0_R8Ki]) ! Non-mesh input variables - call MV_AddVar(p%Vars%u, "BlPitchCom", VF_Scalar, & + call MV_AddVar(p%Vars%u, "BlPitchCom", FieldScalar, & VarIdx=p%iVarBlPitchCom, & Num=p%NumBl, & - Flags=VF_RotFrame + VF_Linearize, & + Flags=VF_RotFrame + VF_Linearize + VF_2PI, & Perturb=2.0_R8Ki * D2R_D, & LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) - call MV_AddVar(p%Vars%u, "YawMom", VF_Scalar, & + call MV_AddVar(p%Vars%u, "YawMom", FieldScalar, & VarIdx=p%iVarYawMom, & Flags=VF_Linearize, & Perturb=MaxTorque / 100.0_R8Ki, & LinNames=['Yaw moment, Nm']) - call MV_AddVar(p%Vars%u, "GenTrq", VF_Scalar, & + call MV_AddVar(p%Vars%u, "GenTrq", FieldScalar, & VarIdx=p%iVarGenTrq, & Flags=VF_Linearize, & Perturb=MaxTorque / (100.0_R8Ki*p%GBRatio), & LinNames=['Generator torque, Nm']) - call MV_AddVar(p%Vars%u, "BlPitchComC", VF_Scalar, & + call MV_AddVar(p%Vars%u, "BlPitchComC", FieldScalar, & VarIdx=p%iVarBlPitchComC, & - Flags=VF_ExtLin + VF_Linearize, & + Flags=VF_ExtLin + VF_Linearize + VF_2PI, & LinNames=['Extended input: collective blade-pitch command, rad']) ! Set minimum input perturbations @@ -11537,7 +11537,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat if (i == 1) then do j = p%iVarBladeMotion(i), size(p%Vars%y) select case (p%Vars%y(j)%Field) - case (VF_TransDisp, VF_AngularDisp, VF_TransVel, VF_AngularVel) + case (FieldTransDisp, FieldAngularDisp, FieldTransVel, FieldAngularVel) call MV_SetFlags(p%Vars%y(j), VF_AeroMap) end select end do @@ -11556,7 +11556,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat Flags=ior(VF_Line, VF_SmallAngle)) call MV_AddMeshVar(p%Vars%y, 'Hub', & - Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel], & + Fields=[FieldTransDisp, FieldOrientation, FieldAngularVel], & VarIdx=p%iVarHubMotion, & Mesh=y%HubPtMotion) @@ -11571,26 +11571,27 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat Mesh=y%NacelleMotion) call MV_AddMeshVar(p%Vars%y, 'TailFin', & - Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel], & + Fields=[FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & VarIdx=p%iVarTFinCMMotion, & Mesh=y%TFinCMMotion) - call MV_AddVar(p%Vars%y, 'Yaw', VF_AngularDisp, & + call MV_AddVar(p%Vars%y, 'Yaw', FieldScalar, & + Flags=VF_2PI, & VarIdx=p%iVarYaw, & LinNames=['Yaw, rad']) - call MV_AddVar(p%Vars%y, 'YawRate', VF_Scalar, & + call MV_AddVar(p%Vars%y, 'YawRate', FieldScalar, & VarIdx=p%iVarYawRate, & LinNames=['YawRate, rad/s']) - call MV_AddVar(p%Vars%y, 'HSS_Spd', VF_Scalar, & + call MV_AddVar(p%Vars%y, 'HSS_Spd', FieldScalar, & VarIdx=p%iVarHSS_Spd, & LinNames=['HSS_Spd, rad/s']) ! Write output variables p%iVarWriteOut = size(p%Vars%y) + 1 do i = 1, p%NumOuts - call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & @@ -11599,7 +11600,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat k = p%NumOuts + 1 do i = 1, p%BldNd_NumOuts do j = 1, p%BldNd_BladesOut - call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & + call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, FieldScalar, & Num=p%BldNodes, & Flags=VF_WriteOut + VF_RotFrame, & iUsr=k, & @@ -11658,9 +11659,9 @@ subroutine ED_PackContStateOP(p, x, ary) integer(IntKi) :: i do i = 1, size(p%Vars%x) select case(p%Vars%x(i)%Field) - case (VF_TransDisp, VF_AngularDisp) + case (FieldTransDisp, FieldAngularDisp) ary(p%Vars%x(i)%iLoc(1)) = x%QT(p%Vars%x(i)%iUsr(1)) - case (VF_TransVel, VF_AngularVel) + case (FieldTransVel, FieldAngularVel) ary(p%Vars%x(i)%iLoc(1)) = x%QDT(p%Vars%x(i)%iUsr(1)) case default ary(p%Vars%x(i)%iLoc(1)) = 0.0_R8Ki @@ -11675,9 +11676,9 @@ subroutine ED_UnpackStateOP(p, ary, x) integer(IntKi) :: i do i = 1, size(p%Vars%x) select case(p%Vars%x(i)%Field) - case (VF_TransDisp, VF_AngularDisp) + case (FieldTransDisp, FieldAngularDisp) x%QT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) - case (VF_TransVel, VF_AngularVel) + case (FieldTransVel, FieldAngularVel) x%QDT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) end select end do diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index ba7e4feae0..b589352b67 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -980,7 +980,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E do k = 1, p%nWAMITObj if (p%WAMIT(k)%SS_Exctn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) - call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", VF_Scalar, & + call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", FieldScalar, & Flags=VF_DerivOrder1, & Num=p%WAMIT(k)%SS_Exctn%numStates, & Perturb=20000.0_R8Ki * D2R_D, & @@ -990,7 +990,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E do k = 1, p%nWAMITObj if (p%WAMIT(k)%SS_Rdtn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) - call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", VF_Scalar, & + call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", FieldScalar, & Flags=VF_DerivOrder1, & Num=p%WAMIT(k)%SS_Rdtn%numStates, & Perturb=2.0_R8Ki * D2R_D , & @@ -1006,12 +1006,12 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E PerturbRot = 2*D2R ! Create perturbation array (order based on MotionFields) - Perturbs = [PerturbTrans, & ! VF_TransDisp - PerturbRot, & ! VF_Orientation - PerturbTrans, & ! VF_TransVel - PerturbRot, & ! VF_AngularVel - PerturbTrans, & ! VF_TransAcc - PerturbRot] ! VF_AngularAcc + Perturbs = [PerturbTrans, & ! FieldTransDisp + PerturbRot, & ! FieldOrientation + PerturbTrans, & ! FieldTransVel + PerturbRot, & ! FieldAngularVel + PerturbTrans, & ! FieldTransAcc + PerturbRot] ! FieldAngularAcc call MV_AddMeshVar(p%Vars%u, "Morison", MotionFields, u%Morison%Mesh, & VarIdx=p%iVarMorisonMotionMesh, & @@ -1025,22 +1025,22 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E VarIdx=p%iVarPRPMotionMesh, & Perturbs=Perturbs) - call MV_AddVar(p%Vars%u, "WaveElev0", VF_Scalar, & + call MV_AddVar(p%Vars%u, "WaveElev0", FieldScalar, & VarIdx=p%iVarWaveElev0, & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: wave elevation at platform ref point, m']) - call MV_AddVar(p%Vars%u, "HWindSpeed", VF_Scalar, & + call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, & VarIdx=p%iVarHWindSpeed, & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: horizontal current speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%u, "PLexp", VF_Scalar, & + call MV_AddVar(p%Vars%u, "PLexp", FieldScalar, & VarIdx=p%iVarPLexp, & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%u, "PropagationDir", VF_Scalar, & + call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, & VarIdx=p%iVarPropagationDir, & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: propagation direction, rad']) @@ -1053,7 +1053,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E call MV_AddMeshVar(p%Vars%y, "WAMITLoads", LoadFields, y%WAMITMesh, VarIdx=p%iVarWAMITLoadMesh) - call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & VarIdx=p%iVarWriteOut, & Flags=VF_WriteOut, & Num=p%NumTotalOuts, & diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index 42dc658aa7..f80b08dff8 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -677,17 +677,17 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Input variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%u, "HWindSpeed", VF_Scalar, & + call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, & VarIdx=p%iVarHWindSpeed, & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%u, "PLExp", VF_Scalar, & + call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, & VarIdx=p%iVarPLExp, & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%u, "PropagationDir", VF_Scalar, & + call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, & VarIdx=p%iVarPropagationDir, & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: propagation direction, rad']) @@ -696,22 +696,22 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Output variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%y, "HWindSpeed", VF_Scalar, & + call MV_AddVar(p%Vars%y, "HWindSpeed", FieldScalar, & VarIdx=p%iVarHWindSpeedY, & Flags=VF_ExtLin, & LinNames=['Extended output: horizontal wind speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%y, "PLExp", VF_Scalar, & + call MV_AddVar(p%Vars%y, "PLExp", FieldScalar, & VarIdx=p%iVarPLExpY, & Flags=VF_ExtLin, & LinNames=['Extended output: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%y, "PropagationDir", VF_Scalar, & + call MV_AddVar(p%Vars%y, "PropagationDir", FieldScalar, & VarIdx=p%iVarPropagationDirY, & Flags=VF_ExtLin, & LinNames=['Extended output: propagation direction, rad']) - call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & VarIdx=p%iVarWriteOutput, & Flags=VF_WriteOut, & Num=p%NumOuts, & diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index 940a91cf56..b6ad7b8820 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -750,7 +750,7 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ! Input variables !------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%u, "PtFairDisplacement", [VF_TransDisp], & + call MV_AddMeshVar(p%Vars%u, "PtFairDisplacement", [FieldTransDisp], & VarIdx=p%iVarPtFairDisplacement, & Mesh=u%PtFairDisplacement, & Perturbs=[0.2_R8Ki*D2R * max(p%depth,1.0_R8Ki)]) @@ -759,12 +759,12 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ! Output variables !------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, "FairleadLoads", [VF_Force], & + call MV_AddMeshVar(p%Vars%y, "FairleadLoads", [FieldForce], & VarIdx=p%iVarPtFairleadLoad, & Mesh=y%ptFairleadLoad) ! Write outputs - call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & VarIdx=p%iVarWriteOutput, & Flags=VF_WriteOut, & Num=p%numOuts,& diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 3a546d0cbb..4d19ca5689 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -2804,18 +2804,18 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If coupled pinned body if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, VF_AngularDisp, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, Num=3, Flags=VF_DerivOrder2, & iUsr=m%BodyStateIs1(l)+3, & ! x%state index Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, VF_TransDisp, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, Num=3, Flags=VF_DerivOrder2, & iUsr=m%BodyStateIs1(l)+6, & ! x%state index Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, VF_AngularDisp, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, Num=3, Flags=VF_DerivOrder2, & iUsr=m%BodyStateIs1(l)+9, & ! x%state index Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) @@ -2829,18 +2829,18 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If pinned rod if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, VF_AngularDisp, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, Num=3, Flags=VF_DerivOrder2, & iUsr=m%RodStateIs1(l)+3, & ! x%state index Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, VF_TransDisp, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, Num=3, Flags=VF_DerivOrder2, & iUsr=m%RodStateIs1(l)+6, & ! x%state index Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, VF_AngularDisp, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, Num=3, Flags=VF_DerivOrder2, & iUsr=m%RodStateIs1(l)+9, & ! x%state index Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) @@ -2851,7 +2851,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) - call MV_AddVar(p%Vars%x, LinStr, VF_TransDisp, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, Num=3, Flags=VF_DerivOrder2, & iUsr=m%PointStateIs1(l)+3, & ! x%state index Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) @@ -2863,7 +2863,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E N = m%LineList(l)%N ! number of segments in the line do i = 0, N-2 LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) - call MV_AddVar(p%Vars%x, LinStr, VF_TransDisp, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, Num=3, Flags=VF_DerivOrder2, & iUsr=m%LineStateIs1(l) + 3*N + 3*i - 3, & ! x%state index Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) @@ -2881,18 +2881,18 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If coupled pinned body if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, VF_AngularVel, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, Num=3, Flags=VF_DerivOrder2, & iUsr=m%BodyStateIs1(l)+0, & ! x%state index Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, VF_TransVel, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, Num=3, Flags=VF_DerivOrder2, & iUsr=m%BodyStateIs1(l)+0, & ! x%state index Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, VF_AngularVel, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, Num=3, Flags=VF_DerivOrder2, & iUsr=m%BodyStateIs1(l)+3, & ! x%state index Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) @@ -2906,18 +2906,18 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If pinned rod if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, VF_AngularVel, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, Num=3, Flags=VF_DerivOrder2, & iUsr=m%RodStateIs1(l)+0, & ! x%state index Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, VF_TransVel, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, Num=3, Flags=VF_DerivOrder2, & iUsr=m%RodStateIs1(l)+0, & ! x%state index Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, VF_AngularVel, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, Num=3, Flags=VF_DerivOrder2, & iUsr=m%RodStateIs1(l)+3, & ! x%state index Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) @@ -2928,7 +2928,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) - call MV_AddVar(p%Vars%x, LinStr, VF_TransVel, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, Num=3, Flags=VF_DerivOrder2, & iUsr=m%PointStateIs1(l)+0, & ! x%state index Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) @@ -2940,7 +2940,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E N = m%LineList(l)%N ! number of segments in the line do i = 0, N-2 LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) - call MV_AddVar(p%Vars%x, LinStr, VF_TransVel, Num=3, Flags=VF_DerivOrder2, & + call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, Num=3, Flags=VF_DerivOrder2, & iUsr=m%LineStateIs1(l) + 3*i + 0, & ! x%state index Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) @@ -2956,12 +2956,12 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E call MV_AddMeshVar(p%Vars%u, "CoupledKinematics", MotionFields, & VarIdx=p%iVarCoupledKinematics, & Mesh=u%CoupledKinematics(1), & - Perturbs=[dl_slack_min, & ! VF_TransDisp - 0.1_R8Ki, & ! VF_Orientation - 0.1_R8Ki, & ! VF_TransVel - 0.1_R8Ki, & ! VF_AngularVel - 0.1_R8Ki, & ! VF_TransAcc - 0.1_R8Ki]) ! VF_AngularAcc + Perturbs=[dl_slack_min, & ! FieldTransDisp + 0.1_R8Ki, & ! FieldOrientation + 0.1_R8Ki, & ! FieldTransVel + 0.1_R8Ki, & ! FieldAngularVel + 0.1_R8Ki, & ! FieldTransAcc + 0.1_R8Ki]) ! FieldAngularAcc ! This could be stored more efficiently, but maintains order compatible with previous implementation. if (.not. allocated(u%DeltaL)) then @@ -2988,12 +2988,12 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E LinStr = '(lines: none)' end if - call MV_AddVar(p%Vars%u, "DeltaL "//trim(num2lstr(i)), VF_TransDisp, & + call MV_AddVar(p%Vars%u, "DeltaL "//trim(num2lstr(i)), FieldTransDisp, & iUsr=i, & Perturb=dl_slack_min, & LinNames=['CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr)]) - call MV_AddVar(p%Vars%u, "DeltaLdot "//trim(num2lstr(i)), VF_TransVel, & + call MV_AddVar(p%Vars%u, "DeltaLdot "//trim(num2lstr(i)), FieldTransVel, & iUsr=i, & Perturb=0.2_R8Ki, & LinNames=['CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr)]) @@ -3009,7 +3009,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E Mesh=y%CoupledLoads(1)) ! Write outputs - call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & VarIdx=p%iVarWriteOutput, & Flags=VF_WriteOut, & Num=p%numOuts,& diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 33c879578b..597543f167 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -40,10 +40,10 @@ module ModVar public :: DumpMatrix integer(IntKi), parameter :: & - LoadFields(*) = [VF_Force, VF_Moment], & - TransFields(*) = [VF_TransDisp, VF_TransVel, VF_TransAcc], & - AngularFields(*) = [VF_Orientation, VF_AngularDisp, VF_AngularVel, VF_AngularAcc], & - MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc] + LoadFields(*) = [FieldForce, FieldMoment], & + TransFields(*) = [FieldTransDisp, FieldTransVel, FieldTransAcc], & + AngularFields(*) = [FieldOrientation, FieldAngularDisp, FieldAngularVel, FieldAngularAcc], & + MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc] interface MV_Pack module procedure MV_PackVarRank0R4, MV_PackVarRank1R4, MV_PackVarRank2R4 @@ -65,24 +65,24 @@ function MV_FieldString(Field) result(str) integer(IntKi), intent(in) :: Field character(16) :: str select case (Field) - case (VF_AngularAcc) - str = "VF_AngularAcc" - case (VF_AngularDisp) - str = "VF_AngularDisp" - case (VF_AngularVel) - str = "VF_AngularVel" - case (VF_Force) - str = "VF_Force" - case (VF_Moment) - str = "VF_Moment" - case (VF_Orientation) - str = "VF_Orientation" - case (VF_TransAcc) - str = "VF_TransAcc" - case (VF_TransDisp) - str = "VF_TransDisp" - case (VF_TransVel) - str = "VF_TransVel" + case (FieldAngularAcc) + str = "FieldAngularAcc" + case (FieldAngularDisp) + str = "FieldAngularDisp" + case (FieldAngularVel) + str = "FieldAngularVel" + case (FieldForce) + str = "FieldForce" + case (FieldMoment) + str = "FieldMoment" + case (FieldOrientation) + str = "FieldOrientation" + case (FieldTransAcc) + str = "FieldTransAcc" + case (FieldTransDisp) + str = "FieldTransDisp" + case (FieldTransVel) + str = "FieldTransVel" case default str = "Unknown" end select @@ -243,21 +243,21 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) ! Switch based on field number select case (Var%Field) - case (VF_Force) + case (FieldForce) Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, Var%Nodes)] - case (VF_Moment) + case (FieldMoment) Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, Var%Nodes)] - case (VF_TransDisp) + case (FieldTransDisp) Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, Var%Nodes)] - case (VF_Orientation) + case (FieldOrientation) Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, Var%Nodes)] - case (VF_TransVel) + case (FieldTransVel) Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, Var%Nodes)] - case (VF_AngularVel) + case (FieldAngularVel) Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, Var%Nodes)] - case (VF_TransAcc) + case (FieldTransAcc) Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, Var%Nodes)] - case (VF_AngularAcc) + case (FieldAngularAcc) Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, Var%Nodes)] case default call SetErrStat(ErrID_Fatal, "Invalid mesh field type", ErrStat, ErrMsg, RoutineName) @@ -467,27 +467,27 @@ subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) if (VarAry(i)%MeshID /= MeshID) exit associate (iLoc => VarAry(i)%iLoc) select case (VarAry(i)%Field) - case (VF_Force) + case (FieldForce) Values(iLoc(1):iLoc(2)) = pack(Mesh%Force, .true.) - case (VF_Moment) + case (FieldMoment) Values(iLoc(1):iLoc(2)) = pack(Mesh%Moment, .true.) - case (VF_TransDisp) + case (FieldTransDisp) Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationDisp, .true.) - case (VF_Orientation) + case (FieldOrientation) k = iLoc(1) do j = 1, VarAry(i)%Nodes Values(k:k + 2) = dcm_to_quat(Mesh%Orientation(:, :, j)) k = k + 3 end do - case (VF_TransVel) + case (FieldTransVel) Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationVel, .true.) - case (VF_AngularVel) + case (FieldAngularVel) Values(iLoc(1):iLoc(2)) = pack(Mesh%RotationVel, .true.) - case (VF_TransAcc) + case (FieldTransAcc) Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationAcc, .true.) - case (VF_AngularAcc) + case (FieldAngularAcc) Values(iLoc(1):iLoc(2)) = pack(Mesh%RotationAcc, .true.) - case (VF_Scalar) + case (FieldScalar) Values(iLoc(1):iLoc(2)) = pack(Mesh%Scalars, .true.) end select end associate @@ -506,27 +506,27 @@ subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) if (VarAry(i)%MeshID /= MeshID) exit associate (iLoc => VarAry(i)%iLoc) select case (VarAry(i)%Field) - case (VF_Force) + case (FieldForce) Mesh%Force = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Force)) - case (VF_Moment) + case (FieldMoment) Mesh%Moment = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Moment)) - case (VF_TransDisp) + case (FieldTransDisp) Mesh%TranslationDisp = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationDisp)) - case (VF_Orientation) + case (FieldOrientation) k = iLoc(1) do j = 1, VarAry(i)%Nodes Mesh%Orientation(:, :, j) = quat_to_dcm(Values(k:k + 2)) k = k + 3 end do - case (VF_TransVel) + case (FieldTransVel) Mesh%TranslationVel = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationVel)) - case (VF_AngularVel) + case (FieldAngularVel) Mesh%RotationVel = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%RotationVel)) - case (VF_TransAcc) + case (FieldTransAcc) Mesh%TranslationAcc = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationAcc)) - case (VF_AngularAcc) + case (FieldAngularAcc) Mesh%RotationAcc = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%RotationAcc)) - case (VF_Scalar) + case (FieldScalar) Mesh%Scalars = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Scalars)) end select end associate @@ -554,7 +554,7 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) i = Var%iLoc(1) + iLin - 1 ! If variable field is orientation, perturbation is in radians - if (Var%Field == VF_Orientation) then + if (Var%Field == FieldOrientation) then j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) quat_p = perturb_quat(Perturb, j + 1) ! Quaternion of perturbed angle i = i - j ! index of start of quaternion parameters (3) @@ -582,7 +582,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) do i = 1, size(VarAry) ! If variable field is orientation - if (VarAry(i)%Field == VF_Orientation) then + if (VarAry(i)%Field == FieldOrientation) then ! Starting index into arrays k = VarAry(i)%iLoc(1) @@ -737,7 +737,7 @@ subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) ! Switch based on variable field type select case (VarAry(i)%Field) - case (VF_Orientation) ! SLERP for orientation quaternions + case (FieldOrientation) ! SLERP for orientation quaternions k = VarAry(i)%iLoc(1) do j = 1, VarAry(i)%Nodes @@ -891,11 +891,11 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Pe Var%DerivOrder = DerivOrder else select case (Var%Field) - case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position/displacement + case (FieldOrientation, FieldTransDisp, FieldAngularDisp) ! Position/displacement Var%DerivOrder = 0 - case (VF_TransVel, VF_AngularVel) ! Velocity + case (FieldTransVel, FieldAngularVel) ! Velocity Var%DerivOrder = 1 - case (VF_TransAcc, VF_AngularAcc) ! Acceleration + case (FieldTransAcc, FieldAngularAcc) ! Acceleration Var%DerivOrder = 2 case default Var%DerivOrder = -1 diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index cf2792c2ef..592016c723 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -35,16 +35,16 @@ MODULE NWTC_Library_Types USE ModReg IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Force = 1 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Moment = 2 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Orientation = 3 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransDisp = 4 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularDisp = 5 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransVel = 6 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularVel = 7 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransAcc = 8 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularAcc = 9 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Scalar = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldForce = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldMoment = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldOrientation = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransDisp = 4 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularDisp = 5 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransVel = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularVel = 7 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransAcc = 8 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularAcc = 9 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldScalar = 10 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] @@ -52,11 +52,12 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Linearize = 8 ! Variable for linearization [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_ExtLin = 16 ! Variable for extended linearization [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_SmallAngle = 32 ! Use small angles to calculate difference in linearization [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 64 ! Variable for write output [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 128 ! Variable for solver [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 256 ! Variable for aeromap [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 512 ! Variable is derivative order 1 in linearization file [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 1024 ! Variable is derivative order 2 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_2PI = 64 ! Variable is an angle with range [0,2pi] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 128 ! Variable for write output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 256 ! Variable for solver [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 512 ! Variable for aeromap [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 1024 ! Variable is derivative order 1 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 2048 ! Variable is derivative order 2 in linearization file [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index e1dddf105e..5249bcbe22 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -45,16 +45,16 @@ typedef ^ ^ CHARACTER(6) RNG_type param ^ - IntKi VarNameLen - 64 - "" - -param ^ - IntKi VF_Force - 1 - "" - -param ^ - IntKi VF_Moment - 2 - "" - -param ^ - IntKi VF_Orientation - 3 - "" - -param ^ - IntKi VF_TransDisp - 4 - "" - -param ^ - IntKi VF_AngularDisp - 5 - "" - -param ^ - IntKi VF_TransVel - 6 - "" - -param ^ - IntKi VF_AngularVel - 7 - "" - -param ^ - IntKi VF_TransAcc - 8 - "" - -param ^ - IntKi VF_AngularAcc - 9 - "" - -param ^ - IntKi VF_Scalar - 10 - "" - +param ^ - IntKi FieldForce - 1 - "" - +param ^ - IntKi FieldMoment - 2 - "" - +param ^ - IntKi FieldOrientation - 3 - "" - +param ^ - IntKi FieldTransDisp - 4 - "" - +param ^ - IntKi FieldAngularDisp - 5 - "" - +param ^ - IntKi FieldTransVel - 6 - "" - +param ^ - IntKi FieldAngularVel - 7 - "" - +param ^ - IntKi FieldTransAcc - 8 - "" - +param ^ - IntKi FieldAngularAcc - 9 - "" - +param ^ - IntKi FieldScalar - 10 - "" - param ^ - IntKi VF_None - 0 - "Variable with no flags" - param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - @@ -63,11 +63,12 @@ param ^ - IntKi VF_RotFrame - 4 - param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - param ^ - IntKi VF_SmallAngle - 32 - "Use small angles to calculate difference in linearization" - -param ^ - IntKi VF_WriteOut - 64 - "Variable for write output" - -param ^ - IntKi VF_Solve - 128 - "Variable for solver" - -param ^ - IntKi VF_AeroMap - 256 - "Variable for aeromap" - -param ^ - IntKi VF_DerivOrder1 - 512 - "Variable is derivative order 1 in linearization file" - -param ^ - IntKi VF_DerivOrder2 - 1024 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_2PI - 64 - "Variable is an angle with range [0,2pi]" - +param ^ - IntKi VF_WriteOut - 128 - "Variable for write output" - +param ^ - IntKi VF_Solve - 256 - "Variable for solver" - +param ^ - IntKi VF_AeroMap - 512 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 1024 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 2048 - "Variable is derivative order 2 in linearization file" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index f31f8b4cac..aa2089cf8a 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -45,16 +45,16 @@ typedef ^ ^ CHARACTER(6) RNG_type param ^ - IntKi VarNameLen - 64 - "" - -param ^ - IntKi VF_Force - 1 - "" - -param ^ - IntKi VF_Moment - 2 - "" - -param ^ - IntKi VF_Orientation - 3 - "" - -param ^ - IntKi VF_TransDisp - 4 - "" - -param ^ - IntKi VF_AngularDisp - 5 - "" - -param ^ - IntKi VF_TransVel - 6 - "" - -param ^ - IntKi VF_AngularVel - 7 - "" - -param ^ - IntKi VF_TransAcc - 8 - "" - -param ^ - IntKi VF_AngularAcc - 9 - "" - -param ^ - IntKi VF_Scalar - 10 - "" - +param ^ - IntKi FieldForce - 1 - "" - +param ^ - IntKi FieldMoment - 2 - "" - +param ^ - IntKi FieldOrientation - 3 - "" - +param ^ - IntKi FieldTransDisp - 4 - "" - +param ^ - IntKi FieldAngularDisp - 5 - "" - +param ^ - IntKi FieldTransVel - 6 - "" - +param ^ - IntKi FieldAngularVel - 7 - "" - +param ^ - IntKi FieldTransAcc - 8 - "" - +param ^ - IntKi FieldAngularAcc - 9 - "" - +param ^ - IntKi FieldScalar - 10 - "" - param ^ - IntKi VF_None - 0 - "Variable with no flags" - param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - @@ -63,11 +63,12 @@ param ^ - IntKi VF_RotFrame - 4 - param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - param ^ - IntKi VF_SmallAngle - 32 - "Use small angles to calculate difference in linearization" - -param ^ - IntKi VF_WriteOut - 64 - "Variable for write output" - -param ^ - IntKi VF_Solve - 128 - "Variable for solver" - -param ^ - IntKi VF_AeroMap - 256 - "Variable for aeromap" - -param ^ - IntKi VF_DerivOrder1 - 512 - "Variable is derivative order 1 in linearization file" - -param ^ - IntKi VF_DerivOrder2 - 1024 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_2PI - 64 - "Variable is an angle with range [0,2pi]" - +param ^ - IntKi VF_WriteOut - 128 - "Variable for write output" - +param ^ - IntKi VF_Solve - 256 - "Variable for solver" - +param ^ - IntKi VF_AeroMap - 512 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 1024 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 2048 - "Variable is derivative order 2 in linearization file" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index f59833d286..778fdb29de 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -322,10 +322,10 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! Set BD accelerations and algorithmic accelerations from q matrix ! do j = 1, size(p_BD%Vars%x) ! select case (p_BD%Vars%x(j)%Field) - ! case (VF_TransDisp) + ! case (FieldTransDisp) ! os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 3) ! os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 4) - ! case (VF_Orientation) + ! case (FieldOrientation) ! os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 3) ! os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 4) ! end select @@ -338,10 +338,10 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! Update q matrix accelerations and algorithmic accelerations from BD ! do j = 1, size(p_BD%Vars%x) ! select case (p_BD%Vars%x(j)%Field) - ! case (VF_TransDisp) + ! case (FieldTransDisp) ! q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) ! q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) - ! case (VF_Orientation) + ! case (FieldOrientation) ! q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) ! q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) ! end select diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index c452a7fc27..f1b66c031c 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1847,34 +1847,34 @@ subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMes Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) ! Get data locations for variables of source mesh fields - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransDisp, Mapping%iVarSrcTransDisp) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransVel, Mapping%iVarSrcTransVel) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_TransAcc, Mapping%iVarSrcTransAcc) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Orientation, Mapping%iVarSrcOrientation) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_AngularVel, Mapping%iVarSrcAngularVel) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_AngularAcc, Mapping%iVarSrcAngularAcc) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Force, Mapping%iVarSrcForce) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, VF_Moment, Mapping%iVarSrcMoment) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransDisp, Mapping%iVarSrcTransDisp) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransVel, Mapping%iVarSrcTransVel) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransAcc, Mapping%iVarSrcTransAcc) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldOrientation, Mapping%iVarSrcOrientation) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldAngularVel, Mapping%iVarSrcAngularVel) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldAngularAcc, Mapping%iVarSrcAngularAcc) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldForce, Mapping%iVarSrcForce) + call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldMoment, Mapping%iVarSrcMoment) ! Get data locations for variables of destination mesh fields - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransDisp, Mapping%iVarDstTransDisp) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransVel, Mapping%iVarDstTransVel) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_TransAcc, Mapping%iVarDstTransAcc) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Orientation, Mapping%iVarDstOrientation) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_AngularVel, Mapping%iVarDstAngularVel) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_AngularAcc, Mapping%iVarDstAngularAcc) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Force, Mapping%iVarDstForce) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, VF_Moment, Mapping%iVarDstMoment) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransDisp, Mapping%iVarDstTransDisp) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransVel, Mapping%iVarDstTransVel) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransAcc, Mapping%iVarDstTransAcc) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldOrientation, Mapping%iVarDstOrientation) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldAngularVel, Mapping%iVarDstAngularVel) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldAngularAcc, Mapping%iVarDstAngularAcc) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldForce, Mapping%iVarDstForce) + call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldMoment, Mapping%iVarDstMoment) if (present(SrcDispMesh)) then Mapping%SrcDispMeshID = SrcDispMesh%ID - call FindVarByMeshAndField(SrcMod%Vars%u, SrcDispMesh%ID, VF_TransDisp, Mapping%iVarSrcDispTransDisp) + call FindVarByMeshAndField(SrcMod%Vars%u, SrcDispMesh%ID, FieldTransDisp, Mapping%iVarSrcDispTransDisp) end if if (present(DstDispMesh)) then Mapping%DstDispMeshID = DstDispMesh%ID - call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_TransDisp, Mapping%iVarDstDispTransDisp) - call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, VF_Orientation, Mapping%iVarDstDispOrientation) + call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, FieldTransDisp, Mapping%iVarDstDispTransDisp) + call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, FieldOrientation, Mapping%iVarDstDispOrientation) end if contains diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 815a79c794..9c6584c2e2 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -984,7 +984,7 @@ subroutine Precondition(uVars, G, dUdu, dUdy, JacScaleFactor) do i = 1, size(uVars) ! Get if col variable is a load - isColLoad = uVars(i)%Field == VF_Force .or. uVars(i)%Field == VF_Moment + isColLoad = uVars(i)%Field == FieldForce .or. uVars(i)%Field == FieldMoment ! Get col variable start and end indices in matrix associate (iLoc => uVars(i)%iLoc) @@ -995,7 +995,7 @@ subroutine Precondition(uVars, G, dUdu, dUdy, JacScaleFactor) do j = 1, size(uVars) ! Get if row variable is a load - isRowLoad = uVars(j)%Field == VF_Force .or. uVars(j)%Field == VF_Moment + isRowLoad = uVars(j)%Field == FieldForce .or. uVars(j)%Field == FieldMoment ! Get row variable start and end indices in matrix associate (jLoc => uVars(j)%iLoc) @@ -1042,7 +1042,7 @@ subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) do i = 1, size(uVars) ! If variable is a (force or moment), apply post-conditioner - if (uVars(i)%Field == VF_Force .or. uVars(i)%Field == VF_Moment) then + if (uVars(i)%Field == FieldForce .or. uVars(i)%Field == FieldMoment) then ! Otherwise get variable start and end indices in matrix associate (iLoc => uVars(i)%iLoc) @@ -1298,7 +1298,7 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer i_op = Var%iLoc(1) + j - 1 ! If variable is orientation and show rotation matrix flag is true - if (ShowRotLoc .and. (Var%Field == VF_Orientation)) then + if (ShowRotLoc .and. (Var%Field == FieldOrientation)) then ! Skip writing if not the first value in orientation (3 values) if (mod(j - 1, 3) /= 0) cycle diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 67ec7cb012..159c4aad1b 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -492,7 +492,7 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS !---------------------------------------------------------------------------- ! Extended input - call MV_AddVar(p%Vars%u, "WaveElev0", VF_Scalar, & + call MV_AddVar(p%Vars%u, "WaveElev0", FieldScalar, & VarIdx=p%iVarWaveElev0U, & Flags=VF_ExtLin, & Perturb=0.02_R8Ki * Pi / 180.0_R8Ki * max(1.0_R8Ki, p%WaveField%WtrDpth), & @@ -503,14 +503,14 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS !---------------------------------------------------------------------------- ! Extended output - call MV_AddVar(p%Vars%y, "WaveElev0", VF_Scalar, & + call MV_AddVar(p%Vars%y, "WaveElev0", FieldScalar, & VarIdx=p%iVarWaveElev0Y, & Flags=VF_ExtLin, & LinNames=['Extended output: wave elevation at platform ref point, m']) ! Output variables - call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, Num=p%NumOuts, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, Num=p%NumOuts, & Flags=VF_WriteOut, & VarIdx=p%iVarWriteOutput, & LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 453a6dc015..2e0a17a803 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -676,7 +676,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er do i = 1, p%NumBStC do j = 1, p%NumBl Desc = 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, VF_Scalar, Num=6, & + call MV_AddVar(p%Vars%x, Desc, FieldScalar, Num=6, & Flags=VF_DerivOrder2+VF_RotFrame, & LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & Perturb=xPerturb) @@ -686,7 +686,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ! Nacelle Structural Controller do j = 1, p%NumNStC Desc = 'Nacelle StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, VF_Scalar, Num=6, & + call MV_AddVar(p%Vars%x, Desc, FieldScalar, Num=6, & Flags=VF_DerivOrder2, & LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & Perturb=xPerturb) @@ -695,7 +695,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ! Tower Structural Controller do j = 1, p%NumTStC Desc = 'Tower StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, VF_Scalar, Num=6, & + call MV_AddVar(p%Vars%x, Desc, FieldScalar, Num=6, & Flags=VF_DerivOrder2, & LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & Perturb=xPerturb) @@ -704,7 +704,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ! Substructure Structural Controller do j = 1, p%NumSStC Desc = 'Substructure StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, VF_Scalar, Num=6, & + call MV_AddVar(p%Vars%x, Desc, FieldScalar, Num=6, & Flags=VF_DerivOrder2, & LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & Perturb=xPerturb) @@ -718,11 +718,11 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er uPerturbAng = 0.2_R8Ki * Pi_R8 / 180.0_R8Ki uPerturbs = [uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng] - call MV_AddVar(p%Vars%u, "Yaw", VF_Scalar, VarIdx=p%iVarYaw, LinNames=['Yaw, rad']) + call MV_AddVar(p%Vars%u, "Yaw", FieldScalar, Flags=VF_2PI, VarIdx=p%iVarYaw, LinNames=['Yaw, rad']) - call MV_AddVar(p%Vars%u, "YawRate", VF_Scalar, VarIdx=p%iVarYawRate, LinNames=['YawRate, rad/s']) + call MV_AddVar(p%Vars%u, "YawRate", FieldScalar, VarIdx=p%iVarYawRate, LinNames=['YawRate, rad/s']) - call MV_AddVar(p%Vars%u, "HSS_Spd", VF_Scalar, VarIdx=p%iVarHSS_Spd, LinNames=['HSS_Spd, rad/s']) + call MV_AddVar(p%Vars%u, "HSS_Spd", FieldScalar, VarIdx=p%iVarHSS_Spd, LinNames=['HSS_Spd, rad/s']) ! Structural controllers do j = 1, p%NumBStC @@ -755,21 +755,21 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ! Output variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%y, "BlPitchCom", VF_Scalar, & + call MV_AddVar(p%Vars%y, "BlPitchCom", FieldScalar, & VarIdx=p%iVarBlPitchCom, & - Flags=VF_RotFrame, & + Flags=VF_RotFrame + VF_2PI, & Num=size(y%BlPitchCom), & LinNames=[('BlPitchCom('//trim(Num2LStr(i))//'), rad', i = 1, size(y%BlPitchCom))]) - call MV_AddVar(p%Vars%y, "YawMom", VF_Scalar, & + call MV_AddVar(p%Vars%y, "YawMom", FieldScalar, & VarIdx=p%iVarYawMom, & LinNames=['YawMom, Nm']) - call MV_AddVar(p%Vars%y, "GenTrq", VF_Scalar, & + call MV_AddVar(p%Vars%y, "GenTrq", FieldScalar, & VarIdx=p%iVarGenTrq, & LinNames=['GenTrq, Nm']) - call MV_AddVar(p%Vars%y, "ElecPwr", VF_Scalar, & + call MV_AddVar(p%Vars%y, "ElecPwr", FieldScalar, & VarIdx=p%iVarElecPwr, & LinNames=['ElecPwr, W']) @@ -822,7 +822,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er p%iVarWriteOutput = 0 end if do i = 1, p%NumOuts - call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units], & diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 53cadc6b46..64359a457f 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -450,11 +450,11 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Continuous State Variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%x, "Modes", VF_Scalar, p%nDOFM, jUsr=1, DerivOrder=0, & + call MV_AddVar(p%Vars%x, "Modes", FieldScalar, p%nDOFM, jUsr=1, DerivOrder=0, & Perturb=2.0_ReKi*D2R_D, & LinNames=[('Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -', i=1, p%nDOFM)]) - call MV_AddVar(p%Vars%x, "Modes", VF_Scalar, p%nDOFM, jUsr=2, DerivOrder=1, & + call MV_AddVar(p%Vars%x, "Modes", FieldScalar, p%nDOFM, jUsr=2, DerivOrder=1, & Perturb=2.0_ReKi*D2R_D, & LinNames=[('First time derivative of Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -/s', i=1, p%nDOFM)]) @@ -495,7 +495,7 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) Mesh=y%Y3Mesh) ! Output variables - call MV_AddVar(p%Vars%y, "WriteOutput", VF_Scalar, Num=p%NumOuts, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, Num=p%NumOuts, & Flags=VF_WriteOut, & VarIdx=p%iVarWriteOutput, & LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) From 1621b8a239de59b81a1b95fa71bf15ff0d785fda Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 3 Jun 2024 16:00:39 +0000 Subject: [PATCH 142/319] Add proper angle interpolation on [0,2PI] to MV_ExtrapInterp --- modules/nwtc-library/src/ModVar.f90 | 175 +++++++++++++++++----------- 1 file changed, 110 insertions(+), 65 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 597543f167..2602318c69 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -669,12 +669,9 @@ subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: InterpOrder - real(R8Ki) :: t(3), t_out, a1, a2, a3, ti - real(R8Ki) :: q1(4), q2(4), q(4) - real(R8Ki) :: dot, theta, sin_theta, a, b + real(R8Ki) :: t(3), t_out, a1, a2, a3 + real(R8Ki) :: q1(4), q2(4), q3(4), q(4) integer(IntKi) :: i, j, k - integer(IntKi), parameter :: iq1 = 1 - integer(IntKi) :: iq2 ErrStat = ErrID_None ErrMsg = '' @@ -702,7 +699,56 @@ subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) a1 = -(t_out - t(2))/t(2) a2 = t_out/t(2) y_out = a1*y(:, 1) + a2*y(:, 2) - iq2 = 2 + + ! Loop through glue output variables + do i = 1, size(VarAry) + + ! Switch based on variable field type + select case (VarAry(i)%Field) + + case (FieldOrientation) ! SLERP for orientation quaternions + + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Nodes + + ! Get quaternion 1 from array, calculate scalar + q1(2:4) = y(k:k + 2, 1) + q1(1) = quat_scalar(q1(2:4)) + + ! Get quaternion 2 from array, calculate scalar + q2(2:4) = y(k:k + 2, 2) + q2(1) = quat_scalar(q2(2:4)) + + ! Calculate dot product of two quaternions + ! Make quaternion 2 consistent with quaternion 1 for interp + if (dot_product(q1, q2) < 0.0_R8Ki) q2 = -q2 + + ! Interpolate quaternion components + q = a1*q1 + a2*q2 + + ! Store canonical quaternion in output array + y_out(k:k + 2) = quat_canonical(q(1), q(2:4)) + + ! Increment quaternion index + k = k + 3 + end do + + case (FieldScalar) ! Scalar field + + ! If field is on the range [0,2PI], perform angular interp + if (MV_HasFlags(VarAry(i), VF_2PI)) then + + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Num + call Angles_ExtrapInterp(y(k, 1), y(k, 2), t(1:2), y_out(k), t_out) + k = k + 1 + end do + + end if + + end select + + end do case (2) ! Quadratic Interpolation @@ -712,73 +758,67 @@ subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) y_out = a1*y(:, 1) + a2*y(:, 2) + a3*y(:, 3) - iq2 = 3 - case default + ! Loop through glue output variables + do i = 1, size(VarAry) - ! Unsupported Interpolation - call SetErrStat(ErrID_Fatal, 'size(t) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) - return - end select + ! Switch based on variable field type + select case (VarAry(i)%Field) - ! If order is zero, return since interp is a copy - if (InterpOrder == 0) return + case (FieldOrientation) ! SLERP for orientation quaternions - !---------------------------------------------------------------------------- - ! Handle variables that can't be linearly interpolated (ie. orientations) - !---------------------------------------------------------------------------- + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Nodes - ! Calculate interpolation parameter [0,1] - ti = t_out/t(iq2) + ! Get quaternion 1 from array, calculate scalar + q1(2:4) = y(k:k + 2, 1) + q1(1) = quat_scalar(q1(2:4)) - ! Loop through glue output variables - do i = 1, size(VarAry) + ! Get quaternion 2 from array, calculate scalar + q2(2:4) = y(k:k + 2, 2) + q2(1) = quat_scalar(q2(2:4)) - ! Switch based on variable field type - select case (VarAry(i)%Field) + ! Get quaternion 3 from array, calculate scalar + q3(2:4) = y(k:k + 2, 3) + q3(1) = quat_scalar(q2(2:4)) - case (FieldOrientation) ! SLERP for orientation quaternions + ! Make quaternions 2 and 3 consistent with quaternion 1 + if (dot_product(q1, q2) < 0.0_R8Ki) q2 = -q2 + if (dot_product(q1, q3) < 0.0_R8Ki) q3 = -q3 - k = VarAry(i)%iLoc(1) - do j = 1, VarAry(i)%Nodes + ! Interpolate quaternion components + q = a1*q1 + a2*q2 + a3*q3 - ! Get quaternion 1 from array, calculate scalar - q1(2:4) = y(k:k + 2, iq1) - q1(1) = quat_scalar(q1(2:4)) + ! Store canonical quaternion in output array + y_out(k:k + 2) = quat_canonical(q(1), q(2:4)) - ! Get quaternion 2 from array, calculate scalar - q2(2:4) = y(k:k + 2, iq2) - q2(1) = quat_scalar(q2(2:4)) + ! Increment quaternion index + k = k + 3 + end do - ! Calculate dot product of two quaternions - ! If dot product is negative, invert second quaternion - dot = dot_product(q1, q2) - if (dot < 0.0_R8Ki) then - dot = -dot - q2 = -q2 - end if + case (FieldScalar) ! Scalar field + + ! If field is on the range [0,2PI], perform angular interp + if (MV_HasFlags(VarAry(i), VF_2PI)) then + + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Num + call Angles_ExtrapInterp(y(k, 1), y(k, 2), y(k, 3), t, y_out(k), t_out) + k = k + 1 + end do - ! If the quaternions are very close, use linear interpolation - if (dot > 0.9995_R8Ki) then - q = (1.0_R8Ki - ti)*q1 + ti*q2 - else - theta = acos(dot) - sin_theta = sin(theta) - a = sin((1.0_R8Ki - ti)*theta)/sin_theta - b = sin(ti*theta)/sin_theta - q = a*q1 + b*q2 end if - ! Store canonical quaternion in output array - y_out(k:k + 2) = quat_canonical(q(1), q(2:4)) + end select - ! Increment quaternion index - k = k + 3 - end do + end do - end select + case default - end do + ! Unsupported Interpolation + call SetErrStat(ErrID_Fatal, 'size(t) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select end subroutine @@ -1027,18 +1067,23 @@ pure function quat_canonical(q0, q) result(qc) integer(IntKi) :: i m = q0*q0 + dot_product(q, q) qc = q/m - if (q0 > 0.0_R8Ki) return if (q0 < 0.0_R8Ki) then - qc = -qc - return + qc = -q/m + else + qc = q/m end if - do i = 1, 3 - if (q(i) > 0.0_R8Ki) return - if (q(i) < 0.0_R8Ki) then - qc = -qc - return - end if - end do + ! if (q0 > 0.0_R8Ki) return + ! if (q0 < 0.0_R8Ki) then + ! qc = -qc + ! return + ! end if + ! do i = 1, 3 + ! if (q(i) > 0.0_R8Ki) return + ! if (q(i) < 0.0_R8Ki) then + ! qc = -qc + ! return + ! end if + ! end do end function function dcm_to_quat(dcm) result(q) From 25a77422255f93266f3affe5b679c9e6375dfb4a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 3 Jun 2024 19:24:59 +0000 Subject: [PATCH 143/319] Add FEAM and Orca to Module System --- modules/feamooring/src/FEAM.f90 | 73 ++++++++++++++ modules/feamooring/src/FEAM_Registry.txt | 7 +- modules/feamooring/src/FEAMooring_Types.f90 | 97 +++++++++++++++++++ modules/openfast-library/src/FAST_Subs.f90 | 22 ++--- .../src/OrcaFlexInterface.f90 | 78 ++++++++++++++- .../src/OrcaFlexInterface.txt | 9 +- .../src/OrcaFlexInterface_Types.f90 | 97 +++++++++++++++++++ 7 files changed, 367 insertions(+), 16 deletions(-) diff --git a/modules/feamooring/src/FEAM.f90 b/modules/feamooring/src/FEAM.f90 index a97aeee76b..b1287a0f99 100644 --- a/modules/feamooring/src/FEAM.f90 +++ b/modules/feamooring/src/FEAM.f90 @@ -284,6 +284,14 @@ SUBROUTINE FEAM_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, I IF (ErrStat >= AbortErrLev) RETURN y%WriteOutput = 0 + !............................................................................................ + ! Module Variables + !............................................................................................ + + call FEAM_InitVars(u, p, x, y, misc, InitOut, .false., ErrStat2, ErrMsg2) + call CheckError( ErrStat2, ErrMsg2 ) + if (ErrStat >= AbortErrLev) return + !............................................................................................ ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which ! this module must be called here: @@ -332,6 +340,71 @@ END SUBROUTINE CheckError !---------------------------------------------------------------------------------------------------------------------------------- END SUBROUTINE FEAM_Init !---------------------------------------------------------------------------------------------------------------------------------- + +subroutine FEAM_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(FEAM_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(FEAM_ParameterType), intent(inout) :: p !< Parameters + type(FEAM_ContinuousStateType), intent(inout) :: x !< Continuous state + type(FEAM_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(FEAM_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(FEAM_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'FEAM_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, Flags, idx + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !--------------------------------------------------------------------------- + ! Continuous State Variables + !--------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! Input variables + !--------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%u, "PtFairleadDisplacement", [FieldTransDisp], & + VarIdx=p%iVarPtFairleadDisplacement, & + Mesh=u%PtFairleadDisplacement) + + !--------------------------------------------------------------------------- + ! Output variables + !--------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'PtFairleadLoad', [FieldForce], & + VarIdx=p%iVarPtFairleadLoad, & + Mesh=y%PtFairleadLoad) + + !--------------------------------------------------------------------------- + ! Initialize Variables and Values + !--------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine +!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Init_States(p, x, xd, z, OtherState, ErrStat, ErrMsg) TYPE(FEAM_ParameterType), INTENT(IN ) :: p ! Parameters diff --git a/modules/feamooring/src/FEAM_Registry.txt b/modules/feamooring/src/FEAM_Registry.txt index c0482b23bd..1b6d221196 100644 --- a/modules/feamooring/src/FEAM_Registry.txt +++ b/modules/feamooring/src/FEAM_Registry.txt @@ -69,6 +69,7 @@ typedef ^ ^ ReKi WtrDens - typedef FEAMooring/FEAM InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ ^ ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables" - typedef ^ ^ ReKi LAnchxi {:} - - "Anchor coordinate" - typedef ^ ^ ReKi LAnchyi {:} - - "Anchor coordinate" - typedef ^ ^ ReKi LAnchzi {:} - - "Anchor coordinate" - @@ -114,7 +115,8 @@ typedef ^ ^ ReKi EMAS0 {15}{1 # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. # these could be local variables: -typedef ^ MiscVarType ReKi GLF {:}{:} - - "Global forcing matrix" - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" +typedef ^ ^ ReKi GLF {:}{:} - - "Global forcing matrix" - typedef ^ ^ ReKi GLK {:}{:}{:} - - "Global stiffness matrix" - typedef ^ ^ ReKi EMASS {15}{15} - - "Line element mass" typedef ^ ^ ReKi ESTIF {15}{15} - - "Line element stiffness" @@ -147,6 +149,9 @@ typedef ^ ^ IntKi LastIndWave - # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef FEAMooring/FEAM ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ^ ReKi GRAV {3} - - "Gravity" - +typedef ^ ^ ModVarsType &Vars - - - "Module Variables" +typedef ^ ^ IntKi iVarPtFairleadDisplacement - - - "Index for PtFairleadDisplacement" +typedef ^ ^ IntKi iVarPtFairleadLoad - - - "Index for PtFairleadLoad" # parameters from Mooring typedef ^ ^ ReKi Eps - - - "Tolerance for static iteration" typedef ^ ^ ReKi Gravity - - - "Gravity" diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 39e61fc637..d67474e96c 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -90,6 +90,7 @@ MODULE FEAMooring_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LAnchxi !< Anchor coordinate [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LAnchyi !< Anchor coordinate [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LAnchzi !< Anchor coordinate [-] @@ -132,6 +133,7 @@ MODULE FEAMooring_Types ! ======================= ! ========= FEAM_MiscVarType ======= TYPE, PUBLIC :: FEAM_MiscVarType + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLF !< Global forcing matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GLK !< Global stiffness matrix [-] REAL(ReKi) , DIMENSION(1:15,1:15) :: EMASS = 0.0_ReKi !< Line element mass [-] @@ -162,6 +164,9 @@ MODULE FEAMooring_Types TYPE, PUBLIC :: FEAM_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] REAL(ReKi) , DIMENSION(1:3) :: GRAV = 0.0_ReKi !< Gravity [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarPtFairleadDisplacement = 0_IntKi !< Index for PtFairleadDisplacement [-] + INTEGER(IntKi) :: iVarPtFairleadLoad = 0_IntKi !< Index for PtFairleadLoad [-] REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] @@ -762,6 +767,7 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%LAnchxi)) then LB(1:1) = lbound(SrcInitOutputData%LAnchxi, kind=B8Ki) UB(1:1) = ubound(SrcInitOutputData%LAnchxi, kind=B8Ki) @@ -853,6 +859,7 @@ subroutine FEAM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LAnchxi)) then deallocate(InitOutputData%LAnchxi) end if @@ -877,10 +884,18 @@ subroutine FEAM_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(FEAM_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPackAlloc(RF, InData%LAnchxi) call RegPackAlloc(RF, InData%LAnchyi) call RegPackAlloc(RF, InData%LAnchzi) @@ -897,10 +912,30 @@ subroutine FEAM_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpackAlloc(RF, OutData%LAnchxi); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LAnchyi); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LAnchzi); if (RegCheckErr(RF, RoutineName)) return @@ -1227,9 +1262,13 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%GLF)) then LB(1:2) = lbound(SrcMiscData%GLF, kind=B8Ki) UB(1:2) = ubound(SrcMiscData%GLF, kind=B8Ki) @@ -1370,9 +1409,13 @@ subroutine FEAM_DestroyMisc(MiscData, ErrStat, ErrMsg) type(FEAM_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%GLF)) then deallocate(MiscData%GLF) end if @@ -1410,6 +1453,7 @@ subroutine FEAM_PackMisc(RF, Indata) type(FEAM_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackMisc' if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModJacType(RF, InData%Jac) call RegPackAlloc(RF, InData%GLF) call RegPackAlloc(RF, InData%GLK) call RegPack(RF, InData%EMASS) @@ -1445,6 +1489,7 @@ subroutine FEAM_UnPackMisc(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call RegUnpackAlloc(RF, OutData%GLF); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%GLK); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EMASS); if (RegCheckErr(RF, RoutineName)) return @@ -1486,6 +1531,20 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstParamData%DT = SrcParamData%DT DstParamData%GRAV = SrcParamData%GRAV + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + DstParamData%iVarPtFairleadDisplacement = SrcParamData%iVarPtFairleadDisplacement + DstParamData%iVarPtFairleadLoad = SrcParamData%iVarPtFairleadLoad DstParamData%Eps = SrcParamData%Eps DstParamData%Gravity = SrcParamData%Gravity DstParamData%WtrDens = SrcParamData%WtrDens @@ -1751,6 +1810,12 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FEAM_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%NEQ)) then deallocate(ParamData%NEQ) end if @@ -1819,9 +1884,19 @@ subroutine FEAM_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'FEAM_PackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%GRAV) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarPtFairleadDisplacement) + call RegPack(RF, InData%iVarPtFairleadLoad) call RegPack(RF, InData%Eps) call RegPack(RF, InData%Gravity) call RegPack(RF, InData%WtrDens) @@ -1891,9 +1966,31 @@ subroutine FEAM_UnPackParam(RF, OutData) integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GRAV); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarPtFairleadDisplacement); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPtFairleadLoad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Eps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 69b32ef549..5ddacc9083 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -565,7 +565,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! TODO: Fix ! Add module to list of modules, return on error - ! CALL MV_AddModule(m_Glue%ModData, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & + ! CALL MV_AddModule(m_Glue%Modules, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & ! Init%OutData_ExtInfw%Vars, ErrStat2, ErrMsg2) ! if (Failed()) return @@ -757,7 +757,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! TODO: Fix ! Add module to list of modules, return on error - ! CALL MV_AddModule(m_Glue%ModData, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + ! CALL MV_AddModule(m_Glue%Modules, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & ! Init%OutData_ExtLd%Vars, ErrStat2, ErrMsg2) ! if (Failed()) return @@ -1029,10 +1029,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - ! TODO - ! CALL MV_AddModule(m_Glue%ModData, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & - ! Init%OutData_FEAM%Vars, ErrStat2, ErrMsg2) - ! if (Failed()) return + CALL MV_AddModule(m_Glue%Modules, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & + Init%OutData_FEAM%Vars, ErrStat2, ErrMsg2) + if (Failed()) return case (Module_Orca) @@ -1048,10 +1047,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - ! TODO - ! CALL MV_AddModule(m_Glue%ModData, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & - ! Init%OutData_Orca%Vars, ErrStat2, ErrMsg2) - ! if (Failed()) return + CALL MV_AddModule(m_Glue%Modules, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & + Init%OutData_Orca%Vars, ErrStat2, ErrMsg2) + if (Failed()) return END select @@ -1088,7 +1086,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules - ! CALL MV_AddModule(m_Glue%ModData, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + ! CALL MV_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) ! if (Failed()) return @@ -1161,7 +1159,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD END IF ! Add module to list of modules - ! CALL MV_AddModule(m_Glue%ModData, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + ! CALL MV_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) ! if (Failed()) return END DO diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 index 3671b6266c..efd48127a6 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 @@ -375,8 +375,18 @@ SUBROUTINE Orca_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO m%PtfmFt = 0.0_ReKi m%LastTimeStep = -1.0_DbKi - InitOut%Ver = Orca_Ver + !............................................................................................ + ! Module Variables + !............................................................................................ + call Orca_InitVars(u, p, x, y, m, InitOut, .false., ErrStatTmp, ErrMsgTmp) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp + RETURN + END IF + + InitOut%Ver = Orca_Ver CONTAINS !------------------------------------------------------------------ @@ -391,6 +401,72 @@ END SUBROUTINE CleanUp END SUBROUTINE Orca_Init +!---------------------------------------------------------------------------------------------------------------------------------- + +subroutine Orca_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(Orca_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(Orca_ParameterType), intent(inout) :: p !< Parameters + type(Orca_ContinuousStateType), intent(inout) :: x !< Continuous state + type(Orca_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(Orca_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(Orca_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'FEAM_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, Flags, idx + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%u, "PtfmMesh", MotionFields, & + VarIdx=p%iVarPtfmMeshU, & + Mesh=u%PtfmMesh) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'PtfmMesh', LoadFields, & + VarIdx=p%iVarPtfmMeshY, & + Mesh=y%PtfmMesh) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary OrcaFlex Interface input file and places the values it reads in the InputFileData structure. !! It opens an echo file if requested. diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface.txt b/modules/orcaflex-interface/src/OrcaFlexInterface.txt index da75c894e1..feb8f7621b 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface.txt +++ b/modules/orcaflex-interface/src/OrcaFlexInterface.txt @@ -22,6 +22,7 @@ typedef ^ ^ ReKi TMax typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ ^ ModVarsType *Vars - - - "Module Variables" # Inputfile information @@ -44,7 +45,8 @@ typedef ^ OtherStateType SiKi DummyOtherState - - - "Remov # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi PtfmAM {6}{6} - - "Added mass matrix results from OrcaFlex" - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" +typedef ^ ^ ReKi PtfmAM {6}{6} - - "Added mass matrix results from OrcaFlex" - typedef ^ ^ ReKi PtfmFt {6} - - "Force/moment results from OrcaFlex" - typedef ^ ^ ReKi F_PtfmAM {6} - - "Force/moment results calculated from the added mass and accel" - typedef ^ ^ ReKi AllOuts : - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" @@ -52,7 +54,10 @@ typedef ^ ^ DbKi LastTimeStep - - - # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" +typedef ^ ^ IntKi iVarPtfmMeshU - - - "Index of platform mesh input variable" +typedef ^ ^ IntKi iVarPtfmMeshY - - - "Index of platform mesh output variable" +typedef ^ ^ DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ^ DLL_Type DLL_Orca - - - "Info for the OrcaFlex DLL" - typedef ^ ^ CHARACTER(1024) SimNamePath - - - "Path with simulation rootname with null end character for passing to C" - typedef ^ ^ IntKi SimNamePathLen - - - "Length of SimNamePath (including null char)" - diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index bcc4f7269c..112c4892ba 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -47,6 +47,7 @@ MODULE OrcaFlexInterface_Types TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE Orca_InitOutputType ! ======================= ! ========= Orca_InputFile ======= @@ -65,6 +66,7 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_MiscVarType ======= TYPE, PUBLIC :: Orca_MiscVarType + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAM = 0.0_ReKi !< Added mass matrix results from OrcaFlex [-] REAL(ReKi) , DIMENSION(1:6) :: PtfmFt = 0.0_ReKi !< Force/moment results from OrcaFlex [-] REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM = 0.0_ReKi !< Force/moment results calculated from the added mass and accel [-] @@ -74,6 +76,9 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_ParameterType ======= TYPE, PUBLIC :: Orca_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarPtfmMeshU = 0_IntKi !< Index of platform mesh input variable [-] + INTEGER(IntKi) :: iVarPtfmMeshY = 0_IntKi !< Index of platform mesh output variable [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] TYPE(DLL_Type) :: DLL_Orca !< Info for the OrcaFlex DLL [-] CHARACTER(1024) :: SimNamePath !< Path with simulation rootname with null end character for passing to C [-] @@ -193,6 +198,7 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -212,16 +218,25 @@ subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + nullify(InitOutputData%Vars) end subroutine subroutine Orca_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(Orca_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -232,10 +247,30 @@ subroutine Orca_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine Orca_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -334,9 +369,13 @@ subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return DstMiscData%PtfmAM = SrcMiscData%PtfmAM DstMiscData%PtfmFt = SrcMiscData%PtfmFt DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM @@ -359,9 +398,13 @@ subroutine Orca_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Orca_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%AllOuts)) then deallocate(MiscData%AllOuts) end if @@ -372,6 +415,7 @@ subroutine Orca_PackMisc(RF, Indata) type(Orca_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackMisc' if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModJacType(RF, InData%Jac) call RegPack(RF, InData%PtfmAM) call RegPack(RF, InData%PtfmFt) call RegPack(RF, InData%F_PtfmAM) @@ -388,6 +432,7 @@ subroutine Orca_UnPackMisc(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call RegUnpack(RF, OutData%PtfmAM); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmFt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%F_PtfmAM); if (RegCheckErr(RF, RoutineName)) return @@ -408,6 +453,20 @@ subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Orca_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + DstParamData%iVarPtfmMeshU = SrcParamData%iVarPtfmMeshU + DstParamData%iVarPtfmMeshY = SrcParamData%iVarPtfmMeshY DstParamData%DT = SrcParamData%DT DstParamData%DLL_Orca = SrcParamData%DLL_Orca DstParamData%SimNamePath = SrcParamData%SimNamePath @@ -442,6 +501,12 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Orca_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if call FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then @@ -461,7 +526,17 @@ subroutine Orca_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'Orca_PackParam' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarPtfmMeshU) + call RegPack(RF, InData%iVarPtfmMeshY) call RegPack(RF, InData%DT) call DLLTypePack(RF, InData%DLL_Orca) call RegPack(RF, InData%SimNamePath) @@ -487,7 +562,29 @@ subroutine Orca_UnPackParam(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarPtfmMeshU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPtfmMeshY); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call DLLTypeUnpack(RF, OutData%DLL_Orca) ! DLL_Orca call RegUnpack(RF, OutData%SimNamePath); if (RegCheckErr(RF, RoutineName)) return From 5c1d034981a0a071c1358f2d2acda6a859197b27 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 3 Jun 2024 19:26:00 +0000 Subject: [PATCH 144/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index c2c1f07c99..48fd95d194 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit c2c1f07c99eaeb4572c9a51579514302f3212a5b +Subproject commit 48fd95d1947a664da176b7720ffd0c962f64f6ed From e347f854267241143bc0e640ba8551877da3ef2b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 3 Jun 2024 20:42:49 +0000 Subject: [PATCH 145/319] Add OrcaFlex, ExtInfw, ExtLd to module system. Fix spelling in InitVars functions --- modules/aerodyn/src/AeroDyn.f90 | 2 +- modules/beamdyn/src/BeamDyn.f90 | 2 +- modules/externalinflow/src/ExternalInflow.f90 | 65 ++++++++++++++- .../src/ExternalInflow_Registry.txt | 3 + .../src/ExternalInflow_Types.f90 | 83 +++++++++++++++++++ modules/extloads/src/ExtLoads.f90 | 83 +++++++++++++++++++ modules/extloads/src/ExtLoads_Registry.txt | 3 + modules/extloads/src/ExtLoads_Types.f90 | 83 +++++++++++++++++++ modules/feamooring/src/FEAM.f90 | 2 +- modules/inflowwind/src/InflowWind.f90 | 2 +- modules/inflowwind/src/InflowWind_IO.f90 | 6 +- modules/map/src/map.f90 | 2 +- modules/moordyn/src/MoorDyn.f90 | 2 +- modules/openfast-library/src/FAST_Subs.f90 | 14 ++-- .../src/OrcaFlexInterface.f90 | 4 +- modules/servodyn/src/ServoDyn.f90 | 2 +- modules/subdyn/src/SubDyn.f90 | 2 +- 17 files changed, 338 insertions(+), 22 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index ca3a18ca9f..2298558a83 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5592,7 +5592,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars ! Create rotor label diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index a45b9f8b5a..ca5e3af53c 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -5834,7 +5834,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars !---------------------------------------------------------------------------- diff --git a/modules/externalinflow/src/ExternalInflow.f90 b/modules/externalinflow/src/ExternalInflow.f90 index 8aa7086020..343c853293 100644 --- a/modules/externalinflow/src/ExternalInflow.f90 +++ b/modules/externalinflow/src/ExternalInflow.f90 @@ -268,13 +268,20 @@ SUBROUTINE Init_ExtInfw( InitInp, p_FAST, AirDens, u_AD, initOut_AD, y_AD, ExtIn !............................................................................................ CALL AllocAry( InitOut%WriteOutputHdr, 3, 'WriteOutputHdr', ErrStat2, ErrMsg2 ); if (Failed()) return; CALL AllocAry( InitOut%WriteOutputUnt, 3, 'WriteOutputUnt', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocAry( ExtInfw%y%WriteOutput, 3, 'WriteOutput', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocAry( ExtInfw%y%WriteOutput, 3, 'WriteOutput', ErrStat2, ErrMsg2 ); if (Failed()) return; InitOut%WriteOutputHdr(1) = 'Wind1VelX'; InitOut%WriteOutputUnt(1) = '(m/s)' InitOut%WriteOutputHdr(2) = 'Wind1VelY'; InitOut%WriteOutputUnt(2) = '(m/s)' InitOut%WriteOutputHdr(3) = 'Wind1VelZ'; InitOut%WriteOutputUnt(3) = '(m/s)' ExtInfw%y%WriteOutput = 0.0_ReKi + !............................................................................................ + ! Module Variables + !............................................................................................ + + call ExtInfw_InitVars(ExtInfw%u, ExtInfw%p, ExtInfw%y, ExtInfw%m, InitOut, .false., ErrStat2, ErrMsg2) + if (Failed()) return + InitOut%Ver = ExtInfw_Ver RETURN @@ -292,6 +299,62 @@ logical function Failed2() endif end function Failed2 END SUBROUTINE Init_ExtInfw + +!---------------------------------------------------------------------------------------------------------------------------------- + +subroutine ExtInfw_InitVars(u, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ExtInfw_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ExtInfw_ParameterType), intent(inout) :: p !< Parameters + type(ExtInfw_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ExtInfw_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ExtInfw_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ExtInfw_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE ExtInfw_UpdateFlowField(p_FAST, ExtInfw, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code diff --git a/modules/externalinflow/src/ExternalInflow_Registry.txt b/modules/externalinflow/src/ExternalInflow_Registry.txt index 346b559395..bde7687af5 100644 --- a/modules/externalinflow/src/ExternalInflow_Registry.txt +++ b/modules/externalinflow/src/ExternalInflow_Registry.txt @@ -29,8 +29,10 @@ typedef ExternalInflow/ExtInfw InitOutputType CHARACTER(ChanLen) WriteOu typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType FlowFieldType *FlowField - - - "Pointer of flow field data type" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # ..... MiscVars ................................................................................................................ +typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshType ActForceMotionsPoints {:} - - "point mesh for transferring AeroDyn motions to ExternalInflow (includes hub+blades+nacelle+tower+tailfin)" - typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshType ActForceLoadsPoints {:} - - "point mesh for transferring AeroDyn distributed loads to ExternalInflow (includes hub+blades+nacelle+tower+tailfin)" - typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshMapType Line2_to_Point_Loads {:} - - "mapping data structure to convert line2 loads to point loads" - @@ -39,6 +41,7 @@ typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType FlowFieldType &FlowFi # ..... Parameters ................................................................................................................ +typedef ExternalInflow/ExtInfw ParameterType ModVarsType &Vars - - - "Module Variables" typedef ExternalInflow/ExtInfw ParameterType ReKi AirDens - - - "Air density for normalization of loads sent to ExternalInflow" kg/m^3 typedef ExternalInflow/ExtInfw ParameterType IntKi NumBl - - - "Number of blades" - typedef ExternalInflow/ExtInfw ParameterType IntKi NMappings - - - "Number of mappings" - diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index 22d2c9ee48..8d1741fd86 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -74,6 +74,7 @@ MODULE ExternalInflow_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of flow field data type [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE ExtInfw_InitOutputType ! ======================= ! ========= ExtInfw_MiscVarType_C ======= @@ -82,6 +83,7 @@ MODULE ExternalInflow_Types END TYPE ExtInfw_MiscVarType_C TYPE, PUBLIC :: ExtInfw_MiscVarType TYPE( ExtInfw_MiscVarType_C ) :: C_obj + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceMotionsPoints !< point mesh for transferring AeroDyn motions to ExternalInflow (includes hub+blades+nacelle+tower+tailfin) [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceLoadsPoints !< point mesh for transferring AeroDyn distributed loads to ExternalInflow (includes hub+blades+nacelle+tower+tailfin) [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: Line2_to_Point_Loads !< mapping data structure to convert line2 loads to point loads [-] @@ -110,6 +112,7 @@ MODULE ExternalInflow_Types END TYPE ExtInfw_ParameterType_C TYPE, PUBLIC :: ExtInfw_ParameterType TYPE( ExtInfw_ParameterType_C ) :: C_obj + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density for normalization of loads sent to ExternalInflow [kg/m^3] INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [-] INTEGER(IntKi) :: NMappings = 0_IntKi !< Number of mappings [-] @@ -457,6 +460,7 @@ subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%FlowField => SrcInitOutputData%FlowField + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine ExtInfw_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -477,6 +481,7 @@ subroutine ExtInfw_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%FlowField) + nullify(InitOutputData%Vars) end subroutine subroutine ExtInfw_PackInitOutput(RF, Indata) @@ -499,6 +504,13 @@ subroutine ExtInfw_PackInitOutput(RF, Indata) call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -533,6 +545,24 @@ subroutine ExtInfw_UnPackInitOutput(RF, OutData) else OutData%FlowField => null() end if + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine SUBROUTINE ExtInfw_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) @@ -582,6 +612,9 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtInfw_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%ActForceMotionsPoints)) then LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints, kind=B8Ki) UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints, kind=B8Ki) @@ -671,6 +704,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtInfw_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%ActForceMotionsPoints)) then LB(1:1) = lbound(MiscData%ActForceMotionsPoints, kind=B8Ki) UB(1:1) = ubound(MiscData%ActForceMotionsPoints, kind=B8Ki) @@ -727,6 +762,7 @@ subroutine ExtInfw_PackMisc(RF, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if + call NWTC_Library_PackModJacType(RF, InData%Jac) call RegPack(RF, allocated(InData%ActForceMotionsPoints)) if (allocated(InData%ActForceMotionsPoints)) then call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints, kind=B8Ki), ubound(InData%ActForceMotionsPoints, kind=B8Ki)) @@ -784,6 +820,7 @@ subroutine ExtInfw_UnPackMisc(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac if (allocated(OutData%ActForceMotionsPoints)) deallocate(OutData%ActForceMotionsPoints) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -898,9 +935,22 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if DstParamData%AirDens = SrcParamData%AirDens DstParamData%C_obj%AirDens = SrcParamData%C_obj%AirDens DstParamData%NumBl = SrcParamData%NumBl @@ -959,9 +1009,17 @@ subroutine ExtInfw_DestroyParam(ParamData, ErrStat, ErrMsg) type(ExtInfw_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (associated(ParamData%forceBldRnodes)) then deallocate(ParamData%forceBldRnodes) ParamData%forceBldRnodes => null() @@ -986,6 +1044,13 @@ subroutine ExtInfw_PackParam(RF, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPack(RF, InData%AirDens) call RegPack(RF, InData%NumBl) call RegPack(RF, InData%NMappings) @@ -1012,6 +1077,24 @@ subroutine ExtInfw_UnPackParam(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%AirDens = OutData%AirDens call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index 03b4404407..ad4a624bb9 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -185,6 +185,13 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !............................................................................................ + ! Module Variables + !............................................................................................ + + call ExtLd_InitVars(u, p, y, m, InitOut, .false., ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return contains logical function Failed() @@ -193,6 +200,82 @@ logical function Failed() end function Failed end subroutine ExtLd_Init + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine ExtLd_InitVars(u, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ExtLd_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ExtLd_ParameterType), intent(inout) :: p !< Parameters + type(ExtLd_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ExtLd_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ExtLd_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ExtLd_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%u, "TowerMotion", MotionFields, Mesh=u%TowerMotion) + call MV_AddMeshVar(p%Vars%u, "HubMotion", MotionFields, Mesh=u%HubMotion) + call MV_AddMeshVar(p%Vars%u, "NacelleMotion", MotionFields, Mesh=u%NacelleMotion) + do i = 1, size(u%BladeRootMotion) + call MV_AddMeshVar(p%Vars%u, "BladeRootMotion"//IdxStr(i), MotionFields, Mesh=u%BladeRootMotion(i)) + end do + do i = 1, size(u%BladeRootMotion) + call MV_AddMeshVar(p%Vars%u, "BladeMotion"//IdxStr(i), MotionFields, Mesh=u%BladeMotion(i)) + end do + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'TowerLoad', LoadFields, Mesh=y%TowerLoad) + do i = 1, size(y%BladeLoad) + call MV_AddMeshVar(p%Vars%y, 'BladeLoad'//IdxStr(i), LoadFields, Mesh=y%BladeLoad(i)) + end do + call MV_AddMeshVar(p%Vars%y, 'TowerLoadAD', LoadFields, Mesh=y%TowerLoadAD) + do i = 1, size(y%BladeLoadAD) + call MV_AddMeshVar(p%Vars%y, 'BladeLoadAD'//IdxStr(i), LoadFields, Mesh=y%BladeLoadAD(i)) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes ExtLoads meshes and output array variables for use during the simulation. subroutine Init_y(y, u, m, p, errStat, errMsg) diff --git a/modules/extloads/src/ExtLoads_Registry.txt b/modules/extloads/src/ExtLoads_Registry.txt index 5f3af5384d..7d20ae9896 100644 --- a/modules/extloads/src/ExtLoads_Registry.txt +++ b/modules/extloads/src/ExtLoads_Registry.txt @@ -52,6 +52,7 @@ typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 typedef ^ InitOutputType FlowFieldType *FlowField - - - "Pointer of flow field data type" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -64,6 +65,7 @@ typedef ^ DiscreteStateType ReKi blah - - - "Somethin typedef ^ MiscVarType ReKi az - - - "Current azimuth" - typedef ^ MiscVarType ReKi phi_cfd - - - "Blending ratio of load from external driver [0-1]" - typedef ^ MiscVarType FlowFieldType &FlowField - - - "Flow field data type" - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" # Define constraint states here: typedef ^ ConstraintStateType ReKi blah - - - "Something" - @@ -76,6 +78,7 @@ typedef ^ OtherStateType ReKi blah - - - "Som # ..... Parameters ................................................................................................................ # Define parameters here: +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ ParameterType ExtLdDX_ParameterType DX_p - - - "Data to send to external driver" typedef ^ ParameterType IntKi NumBlds - - - "Number of blades on the turbine" - typedef ^ ParameterType IntKi NumBldNds {:} - - "Number of blade nodes for each blade" - diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 45272e87ce..2c3c7135d7 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -80,6 +80,7 @@ MODULE ExtLoads_Types TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of flow field data type [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE ExtLd_InitOutputType ! ======================= ! ========= ExtLd_ContinuousStateType ======= @@ -97,6 +98,7 @@ MODULE ExtLoads_Types REAL(ReKi) :: az = 0.0_ReKi !< Current azimuth [-] REAL(ReKi) :: phi_cfd = 0.0_ReKi !< Blending ratio of load from external driver [0-1] [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data type [-] + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] END TYPE ExtLd_MiscVarType ! ======================= ! ========= ExtLd_ConstraintStateType ======= @@ -111,6 +113,7 @@ MODULE ExtLoads_Types ! ======================= ! ========= ExtLd_ParameterType ======= TYPE, PUBLIC :: ExtLd_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] TYPE(ExtLdDX_ParameterType) :: DX_p !< Data to send to external driver [-] INTEGER(IntKi) :: NumBlds = 0_IntKi !< Number of blades on the turbine [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NumBldNds !< Number of blade nodes for each blade [-] @@ -457,6 +460,7 @@ subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, if (ErrStat >= AbortErrLev) return DstInitOutputData%AirDens = SrcInitOutputData%AirDens DstInitOutputData%FlowField => SrcInitOutputData%FlowField + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine ExtLd_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -477,6 +481,7 @@ subroutine ExtLd_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%FlowField) + nullify(InitOutputData%Vars) end subroutine subroutine ExtLd_PackInitOutput(RF, Indata) @@ -496,6 +501,13 @@ subroutine ExtLd_PackInitOutput(RF, Indata) call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -531,6 +543,24 @@ subroutine ExtLd_UnPackInitOutput(RF, OutData) else OutData%FlowField => null() end if + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine ExtLd_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -635,6 +665,9 @@ subroutine ExtLd_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ExtLd_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -652,6 +685,8 @@ subroutine ExtLd_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%FlowField) MiscData%FlowField => null() end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ExtLd_PackMisc(RF, Indata) @@ -669,6 +704,7 @@ subroutine ExtLd_PackMisc(RF, Indata) call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if + call NWTC_Library_PackModJacType(RF, InData%Jac) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -702,6 +738,7 @@ subroutine ExtLd_UnPackMisc(RF, OutData) else OutData%FlowField => null() end if + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac end subroutine subroutine ExtLd_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -792,6 +829,18 @@ subroutine ExtLd_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'ExtLd_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if call ExtLdDX_CopyParam(SrcParamData%DX_p, DstParamData%DX_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -828,6 +877,12 @@ subroutine ExtLd_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtLd_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if call ExtLdDX_DestroyParam(ParamData%DX_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%NumBldNds)) then @@ -839,7 +894,15 @@ subroutine ExtLd_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackParam' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call ExtLdDX_PackParam(RF, InData%DX_p) call RegPack(RF, InData%NumBlds) call RegPackAlloc(RF, InData%NumBldNds) @@ -862,7 +925,27 @@ subroutine ExtLd_UnPackParam(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call ExtLdDX_UnpackParam(RF, OutData%DX_p) ! DX_p call RegUnpack(RF, OutData%NumBlds); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%NumBldNds); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/feamooring/src/FEAM.f90 b/modules/feamooring/src/FEAM.f90 index b1287a0f99..2f68c997de 100644 --- a/modules/feamooring/src/FEAM.f90 +++ b/modules/feamooring/src/FEAM.f90 @@ -369,7 +369,7 @@ subroutine FEAM_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars !--------------------------------------------------------------------------- diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index f80b08dff8..90326d8abc 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -666,7 +666,7 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars !---------------------------------------------------------------------------- diff --git a/modules/inflowwind/src/InflowWind_IO.f90 b/modules/inflowwind/src/InflowWind_IO.f90 index 62c6f7639b..3e639eb2b0 100644 --- a/modules/inflowwind/src/InflowWind_IO.f90 +++ b/modules/inflowwind/src/InflowWind_IO.f90 @@ -87,7 +87,7 @@ subroutine IfW_SteadyWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" - ! Set parameters from inititialization input + ! Set parameters from initialization input UF%DataSize = 1 UF%RefHeight = InitInp%RefHt UF%RefLength = 1.0_ReKi @@ -185,7 +185,7 @@ subroutine IfW_SteadyFlowField_Init(FF, RefHt, HWindSpeed, PLExp, ErrStat, ErrMs ! Set flow-field type to uniform FF%FieldType = Uniform_FieldType - ! Set parameters from inititialization input + ! Set parameters from initialization input FF%Uniform%DataSize = 1 FF%Uniform%RefHeight = RefHt FF%Uniform%RefLength = 1.0_ReKi @@ -237,7 +237,7 @@ subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = "" - ! Set parameters from inititialization input + ! Set parameters from initialization input UF%RefHeight = InitInp%RefHt UF%RefLength = InitInp%RefLength diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index b6ad7b8820..18ab79b969 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -738,7 +738,7 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars !------------------------------------------------------------------------- diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 4d19ca5689..0507746e5a 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -2758,7 +2758,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars !------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 5ddacc9083..5917c1c141 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -563,11 +563,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL Init_ExtInfw( Init%InData_ExtInfw, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, ExtInfw, Init%OutData_ExtInfw, ErrStat2, ErrMsg2 ) if (Failed()) return - ! TODO: Fix ! Add module to list of modules, return on error - ! CALL MV_AddModule(m_Glue%Modules, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & - ! Init%OutData_ExtInfw%Vars, ErrStat2, ErrMsg2) - ! if (Failed()) return + CALL MV_AddModule(m_Glue%Modules, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & + Init%OutData_ExtInfw%Vars, ErrStat2, ErrMsg2) + if (Failed()) return !bjj: fix me!!! to do Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi @@ -755,11 +754,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - ! TODO: Fix ! Add module to list of modules, return on error - ! CALL MV_AddModule(m_Glue%Modules, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & - ! Init%OutData_ExtLd%Vars, ErrStat2, ErrMsg2) - ! if (Failed()) return + CALL MV_AddModule(m_Glue%Modules, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + Init%OutData_ExtLd%Vars, ErrStat2, ErrMsg2) + if (Failed()) return AirDens = Init%OutData_ExtLd%AirDens diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 index efd48127a6..48b52da49b 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 @@ -414,7 +414,7 @@ subroutine Orca_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'FEAM_InitVars' + character(*), parameter :: RoutineName = 'Orca_InitVars' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -431,7 +431,7 @@ subroutine Orca_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars !---------------------------------------------------------------------------- diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 2e0a17a803..1728af7469 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -662,7 +662,7 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars !---------------------------------------------------------------------------- diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 64359a457f..5df83eda70 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -443,7 +443,7 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) return end if - ! Add pointers to vars to inititialization output + ! Add pointers to vars to initialization output InitOut%Vars => p%Vars !---------------------------------------------------------------------------- From b5fe903d288711c2043b750074a261047e99bba8 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 3 Jun 2024 20:43:22 +0000 Subject: [PATCH 146/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 48fd95d194..9e2b5b5b5c 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 48fd95d1947a664da176b7720ffd0c962f64f6ed +Subproject commit 9e2b5b5b5c5a3421f836c74ccc1c5960825e88dd From 0cb0072ca63bd6ae999998c2e10a8836938fcf19 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 3 Jun 2024 21:18:10 +0000 Subject: [PATCH 147/319] Remove unused linearization routines in MAP, BeamDyn, SubDyn --- modules/beamdyn/src/BeamDyn_IO.f90 | 505 --------------------- modules/beamdyn/src/BeamDyn_Types.f90 | 48 -- modules/beamdyn/src/Registry_BeamDyn.txt | 6 - modules/map/CMakeLists.txt | 2 - modules/map/src/MAP_Fortran_Registry.txt | 22 - modules/map/src/MAP_Fortran_Types.f90 | 249 ---------- modules/map/src/MAP_Registry.txt | 5 +- modules/map/src/MAP_Types.f90 | 38 +- modules/map/src/MAP_Types.h | 1 + modules/map/src/map.f90 | 179 +------- modules/openfast-library/src/FAST_Subs.f90 | 2 +- modules/subdyn/src/SubDyn_Output.f90 | 245 ---------- modules/subdyn/src/SubDyn_Registry.txt | 7 - modules/subdyn/src/SubDyn_Types.f90 | 52 --- 14 files changed, 13 insertions(+), 1348 deletions(-) delete mode 100644 modules/map/src/MAP_Fortran_Registry.txt delete mode 100644 modules/map/src/MAP_Fortran_Types.f90 diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index c928cb19a6..a16faf23c5 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -2048,511 +2048,6 @@ SUBROUTINE BD_PrintSum( p, x, OtherState, m, InitInp, ErrStat, ErrMsg ) RETURN END SUBROUTINE BD_PrintSum -!---------------------------------------------------------------------------------------------------------------------------------- - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutine ! -SUBROUTINE Init_Jacobian( p, u, y, m, InitOut, ErrStat, ErrMsg) - - TYPE(BD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(BD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(BD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(BD_MiscVarType) , INTENT(INOUT) :: m !< misc var data - TYPE(BD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, index, nu, i_meshField - REAL(R8Ki) :: perturb, perturb_b - REAL(R8Ki) :: MaxThrust, MaxTorque - CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) - - - - ErrStat = ErrID_None - ErrMsg = "" - - call Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call Init_Jacobian_x_z( p, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! determine how many inputs there are in the Jacobians - if (p%CompAeroMaps) then - nu = u%DistrLoad%NNodes * 6 ! 3 forces + 3 moments at each node - else - nu = u%RootMotion%NNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities (rotation+translation) + 6 accelerations at each node - + u%PointLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%DistrLoad%NNodes * 6 ! 3 forces + 3 moments at each node - end if - - ! all other inputs (e.g., hub motion) ignored - - !............................ - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see beamdyn::perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - !............................ - - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !............... - ! BD input mappings stored in p%Jac_u_indx: - !............... - index = 1 - !Module/Mesh/Field: u%RootMotion%TranslationDisp = 1; - !Module/Mesh/Field: u%RootMotion%Orientation = 2; - !Module/Mesh/Field: u%RootMotion%TranslationVel = 3; - !Module/Mesh/Field: u%RootMotion%RotationVel = 4; - !Module/Mesh/Field: u%RootMotion%TranslationAcc = 5; - !Module/Mesh/Field: u%RootMotion%RotationAcc = 6; - if (.not. p%CompAeroMaps) then - do i_meshField = 1,6 - do i=1,u%RootMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !Module/Mesh/Field: u%PointLoad%Force = 7; - !Module/Mesh/Field: u%PointLoad%Moment = 8; - do i_meshField = 7,8 - do i=1,u%PointLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - end if - - !Module/Mesh/Field: u%DistrLoad%Force = 9; - !Module/Mesh/Field: u%DistrLoad%Moment = 10; - do i_meshField = 9,10 - do i=1,u%DistrLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !i_meshField - - - - !...................................... - ! default perturbations, p%du: - !...................................... - call allocAry( p%du, 10, 'p%du', ErrStat2, ErrMsg2) ! 10 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - perturb = 0.2_R8Ki*D2R_D - perturb_b = 0.2_R8Ki*D2R_D * p%blade_length - - MaxThrust = 170.0_R8Ki*p%blade_length**2 - MaxTorque = 14.0_R8Ki*p%blade_length**3 - - p%du( 1) = perturb_b ! u%RootMotion%TranslationDisp = 1; - p%du( 2) = perturb ! u%RootMotion%Orientation = 2; - p%du( 3) = perturb_b ! u%RootMotion%TranslationVel = 3; - p%du( 4) = perturb ! u%RootMotion%RotationVel = 4; - p%du( 5) = perturb_b ! u%RootMotion%TranslationAcc = 5; - p%du( 6) = perturb ! u%RootMotion%RotationAcc = 6; - - p%du( 7) = MaxThrust / (100.0_R8Ki * 3.0_R8Ki * u%PointLoad%NNodes ) ! u%PointLoad%Force = 7; - p%du( 8) = MaxTorque / (100.0_R8Ki * 3.0_R8Ki * u%PointLoad%NNodes ) ! u%PointLoad%Moment = 8; - - p%du( 9) = MaxThrust / (100.0_R8Ki * 3.0_R8Ki * u%DistrLoad%NNodes ) ! u%DistrLoad%Force = 9; - p%du(10) = MaxTorque / (100.0_R8Ki * 3.0_R8Ki * u%DistrLoad%NNodes ) ! u%DistrLoad%Moment =10; - - !..................... - ! get names of linearized inputs - !..................... - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame - - index = 1 - InitOut%IsLoad_u = .true. ! initialize all inputs as loads, and overwrite for the RootMotion mesh, below: - if (.not. p%CompAeroMaps) then - call PackMotionMesh_Names(u%RootMotion, 'RootMotion', InitOut%LinNames_u, index) ! all 6 motion fields - InitOut%IsLoad_u(1:index-1) = .false. ! the RootMotion inputs are not loads - call PackLoadMesh_Names( u%PointLoad, 'PointLoad', InitOut%LinNames_u, index) - end if - call PackLoadMesh_Names( u%DistrLoad, 'DistrLoad', InitOut%LinNames_u, index) - - -END SUBROUTINE Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. -SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - TYPE(BD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(BD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(BD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables: - INTEGER(IntKi) :: i - INTEGER(IntKi) :: j - INTEGER(IntKi) :: index_next - LOGICAL :: AllOut(MaxOutPts) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_y' - - CHARACTER(ChanLen) :: ChannelName - LOGICAL :: isRotating - LOGICAL :: BladeMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - ErrStat = ErrID_None - ErrMsg = "" - - if (p%CompAeroMaps) then - p%Jac_ny = y%BldMotion%NNodes * 12 ! 6 displacements (translation, rotation) + 6 velocities - else - - ! determine how many outputs there are in the Jacobians - p%Jac_ny = y%ReactionForce%NNodes * 6 & ! 3 forces + 3 moments at each node - + y%BldMotion%NNodes * 18 & ! 6 displacements (translation, rotation) + 6 velocities + 6 accelerations at each node - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values - end if - - ! get the names of the linearized outputs: - call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'RotFrame_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - - InitOut%RotFrame_y = .false. ! need to set all the values in the global system to .false - - index_next = 1 - if (p%CompAeroMaps) then - BladeMask = .true. ! default is all the fields - BladeMask(MASKID_TRANSLATIONACC) = .false. - BladeMask(MASKID_ROTATIONACC) = .false. - - call PackMotionMesh_Names(y%BldMotion, 'Blade motion', InitOut%LinNames_y, index_next, FieldMask=BladeMask) - else - call PackLoadMesh_Names( y%ReactionForce, 'Reaction force', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%BldMotion, 'Blade motion', InitOut%LinNames_y, index_next) - - do i=1,p%NumOuts + p%BldNd_TotNumOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do - - AllOut = .true. ! all output values except those specifically in the global system are in the rotating system - AllOut(TipTVXg) = .false. - AllOut(TipTVYg) = .false. - AllOut(TipTVZg) = .false. - AllOut(TipRVXg) = .false. - AllOut(TipRVYg) = .false. - AllOut(TipRVZg) = .false. - - do j=1,9 - do i=1,3 !x,y,z - AllOut(NTVg(j,i)) = .false. - AllOut(NRVg(j,i)) = .false. - end do - end do - - do i=1,p%NumOuts - if (p%OutParam(i)%Indx == 0 ) then - InitOut%RotFrame_y(i+index_next-1) = .false. - else - InitOut%RotFrame_y(i+index_next-1) = AllOut( p%OutParam(i)%Indx ) - end if - end do - - - ! set outputs for all nodes out: - index_next = index_next + p%NumOuts - DO i=1,p%BldNd_NumOuts - ChannelName = p%BldNd_OutParam(i)%Name - call Conv2UC(ChannelName) - if ( ChannelName( LEN_TRIM(ChannelName):LEN_TRIM(ChannelName) ) == 'G') then ! channel is in global coordinate system - isRotating = .false. - else - isRotating = .true. - end if - InitOut%RotFrame_y(index_next : index_next+size(p%BldNd_BlOutNd)-1 ) = isRotating - index_next = index_next + size(p%BldNd_BlOutNd) - ENDDO - end if - - -END SUBROUTINE Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. -SUBROUTINE Init_Jacobian_x_z( p, InitOut, ErrStat, ErrMsg) - - TYPE(BD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(BD_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_x' - CHARACTER(200) :: Describe - - ! local variables: - INTEGER(IntKi) :: i - INTEGER(IntKi) :: indx - - ErrStat = ErrID_None - ErrMsg = "" - - p%Jac_nx = p%dof_node * (p%node_total-1) ! the first node is actually a constraint state - - ! allocate space for the row/column names and for perturbation sizes - !call allocAry(p%dx, p%dof_node*(p%node_total-1), 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%LinNames_x, p%Jac_nx*2, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, p%Jac_nx*2, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, p%Jac_nx*2, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !CALL AllocAry(InitOut%LinNames_z, p%dof_node*2, 'LinNames_z', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !CALL AllocAry(InitOut%RotFrame_z, p%dof_node*2, 'RotFrame_z', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - !...................................... - ! default perturbations, p%dx: - !...................................... - p%dx(1:3) = 0.2_BDKi*D2R_D * p%blade_length ! deflection states in m and m/s - p%dx(4:6) = 0.2_BDKi*D2R_D ! deflection states in rad and rad/s - - InitOut%RotFrame_x = p%RotStates - InitOut%DerivOrder_x = 2 - - !...................................... - ! set linearization output names: - !...................................... - indx = 1 - DO i=2, p%node_total - Describe = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' - InitOut%LinNames_x(indx) = trim(Describe)//' translational displacement in X, m' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' translational displacement in Y, m' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' translational displacement in Z, m' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' rotational displacement in X, rad' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' rotational displacement in Y, rad' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' rotational displacement in Z, rad' - indx = indx + 1 - END DO - - do i=1,p%Jac_nx - InitOut%LinNames_x(i+p%Jac_nx) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%Jac_nx) = InitOut%RotFrame_x(i) - end do - - - !InitOut%RotFrame_z = .true. - !InitOut%LinNames_z(1) = 'Node 1 translational displacement in X, m' - !InitOut%LinNames_z(2) = 'Node 1 translational displacement in Y, m' - !InitOut%LinNames_z(3) = 'Node 1 translational displacement in Z, m' - !InitOut%LinNames_z(4) = 'Node 1 rotational displacement in X, -' - !InitOut%LinNames_z(5) = 'Node 1 rotational displacement in Y, -' - !InitOut%LinNames_z(6) = 'Node 1 rotational displacement in Z, -' - ! - !do i=1,6 - ! InitOut%LinNames_x(i+6) = 'First time derivative of '//trim(InitOut%LinNames_z(i))//'/s' - !end do - - -END SUBROUTINE Init_Jacobian_x_z -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(BD_InputType) , INTENT(INOUT) :: u !< perturbed BD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - CASE ( 1) !Module/Mesh/Field: u%RootMotion%TranslationDisp = 1; - u%RootMotion%TranslationDisp( fieldIndx,node) = u%RootMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%RootMotion%Orientation = 2; - CALL PerturbOrientationMatrix( u%RootMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) ! NOTE: call not using DCM_logmap - CASE ( 3) !Module/Mesh/Field: u%RootMotion%TranslationVel = 3; - u%RootMotion%TranslationVel( fieldIndx,node) = u%RootMotion%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%RootMotion%RotationVel = 4; - u%RootMotion%RotationVel(fieldIndx,node) = u%RootMotion%RotationVel(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%RootMotion%TranslationAcc = 5; - u%RootMotion%TranslationAcc( fieldIndx,node) = u%RootMotion%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%RootMotion%RotationAcc = 6; - u%RootMotion%RotationAcc(fieldIndx,node) = u%RootMotion%RotationAcc(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%PointLoad%Force = 7; - u%PointLoad%Force(fieldIndx,node) = u%PointLoad%Force(fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PointLoad%Moment = 8; - u%PointLoad%Moment(fieldIndx,node) = u%PointLoad%Moment(fieldIndx,node) + du * perturb_sign - - CASE ( 9) !Module/Mesh/Field: u%DistrLoad%Force = 9; - u%DistrLoad%Force( fieldIndx,node) = u%DistrLoad%Force( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%DistrLoad%Moment = 10; - u%DistrLoad%Moment(fieldIndx,node) = u%DistrLoad%Moment(fieldIndx,node) + du * perturb_sign - - END SELECT - -END SUBROUTINE Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(BD_OutputType) , INTENT(IN ) :: y_p !< BD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(BD_OutputType) , INTENT(IN ) :: y_m !< BD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: i ! loop over outputs - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - indx_first = 1 - if (p%CompAeroMaps) then - Mask = .true. - Mask(MASKID_TRANSLATIONACC) = .false. - Mask(MASKID_ROTATIONACC) = .false. - call PackMotionMesh_dY(y_p%BldMotion, y_m%BldMotion, dY, indx_first, FieldMask=Mask) ! 4 motion fields - else - call PackLoadMesh_dY( y_p%ReactionForce, y_m%ReactionForce, dY, indx_first) - call PackMotionMesh_dY(y_p%BldMotion, y_m%BldMotion, dY, indx_first) ! all 6 motion fields - - do i=1,p%NumOuts + p%BldNd_TotNumOuts - dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) - end do - end if - - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_x( p, fieldIndx, node, dof, perturb_sign, x, dx ) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: fieldIndx !< field in the state type: 1=displacements; 2=velocities - INTEGER( IntKi ) , INTENT(IN ) :: node !< node number - INTEGER( IntKi ) , INTENT(IN ) :: dof !< dof for this perturbation - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(BD_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed BD states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - - ! local variables - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: rotation(3,3) - - dx = p%dx(dof) - - if (fieldIndx==1) then - if (dof < 4) then ! translational displacement - x%q( dof, node ) = x%q( dof, node ) + dx * perturb_sign - else ! w-m parameters - call BD_CrvMatrixR( x%q( 4:6, node ), rotation ) ! returns the rotation matrix (transpose of DCM) that was stored in the state as a w-m parameter - orientation = transpose(rotation) - - CALL PerturbOrientationMatrix( orientation, dx * perturb_sign, dof-3 ) ! NOTE: call not using DCM_logmap - - rotation = transpose(orientation) - call BD_CrvExtractCrv( rotation, x%q( 4:6, node ), ErrStat2, ErrMsg2 ) ! return the w-m parameters of the new orientation - end if - else - x%dqdt( dof, node ) = x%dqdt( dof, node ) + dx * perturb_sign - end if - - -END SUBROUTINE Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_dX(p, x_p, x_m, delta, dX) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(BD_ContinuousStateType) , INTENT(IN ) :: x_p !< BD continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(BD_ContinuousStateType) , INTENT(IN ) :: x_m !< BD continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial X}{\partial u_i} = \frac{x_p - x_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial X}{\partial x_i} = \frac{x_p - x_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: i ! loop over nodes - INTEGER(IntKi) :: dof ! loop over dofs - INTEGER(IntKi) :: index ! index indicating next value of dX to be filled - - index = 1 - do i=2,p%node_total - do dof=1,p%dof_node - dX(index) = x_p%q( dof, i ) - x_m%q( dof, i ) - index = index+1 - end do - end do - - do i=2,p%node_total - do dof=1,p%dof_node - dX(index) = x_p%dqdt( dof, i ) - x_m%dqdt( dof, i ) - index = index+1 - end do - end do - - dX = dX / ( 2.0_R8Ki*delta) - -END SUBROUTINE Compute_dX !---------------------------------------------------------------------------------------------------------------------------------- END MODULE BeamDyn_IO diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index c959634326..6037ec12a5 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -242,11 +242,6 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: QPtw_Shp_Jac !< optimization variable: QPtw_Shp_Jac(idx_qp,i,nelem) = p%Shp(i,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: QPtw_ShpDer !< optimization variable: QPtw_ShpDer(idx_qp,i) = p%ShpDer(i,idx_qp)*p%QPtWeight(idx_qp) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: FEweight !< weighting factors for integrating local sectional loads [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:6) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false) [-] END TYPE BD_ParameterType @@ -1717,33 +1712,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%FEweight = SrcParamData%FEweight end if - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du - end if - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx DstParamData%RotStates = SrcParamData%RotStates DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps end subroutine @@ -1857,12 +1825,6 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%FEweight)) then deallocate(ParamData%FEweight) end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if end subroutine subroutine BD_PackParam(RF, Indata) @@ -1972,11 +1934,6 @@ subroutine BD_PackParam(RF, Indata) call RegPackAlloc(RF, InData%QPtw_Shp_Jac) call RegPackAlloc(RF, InData%QPtw_ShpDer) call RegPackAlloc(RF, InData%FEweight) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%du) - call RegPack(RF, InData%dx) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%Jac_nx) call RegPack(RF, InData%RotStates) call RegPack(RF, InData%CompAeroMaps) if (RegCheckErr(RF, RoutineName)) return @@ -2111,11 +2068,6 @@ subroutine BD_UnPackParam(RF, OutData) call RegUnpackAlloc(RF, OutData%QPtw_Shp_Jac); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%QPtw_ShpDer); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%FEweight); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 3ef4928657..facc5b45cf 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -248,12 +248,6 @@ typedef ^ ParameterType ^ QPtw_ShpDer_ShpDer_Jac {:}{:}{:} typedef ^ ParameterType ^ QPtw_Shp_Jac {:}{:}{:} - - "optimization variable: QPtw_Shp_Jac(idx_qp,i,nelem) = p%Shp(i,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem)" - typedef ^ ParameterType ^ QPtw_ShpDer {:}{:} - - "optimization variable: QPtw_ShpDer(idx_qp,i) = p%ShpDer(i,idx_qp)*p%QPtWeight(idx_qp)" - typedef ^ ParameterType ^ FEweight {:}{:} - - "weighting factors for integrating local sectional loads" - - -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType R8Ki dx {6} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false)" - diff --git a/modules/map/CMakeLists.txt b/modules/map/CMakeLists.txt index 735d2058df..a2c5556cf6 100644 --- a/modules/map/CMakeLists.txt +++ b/modules/map/CMakeLists.txt @@ -25,7 +25,6 @@ if (NOT WIN32) endif() if (GENERATE_TYPES) - generate_f90_types(src/MAP_Fortran_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Fortran_Types.f90 -noextrap) generate_f90_types(src/MAP_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Types.f90 -ccode) endif() @@ -35,7 +34,6 @@ file(GLOB MAP_C_HEADERS src/*.h src/*/*.h) add_library(maplib STATIC src/map.f90 src/MAP_Types.f90 - src/MAP_Fortran_Types.f90 ${MAP_CLIB_SOURCES} ) target_link_libraries(maplib nwtclibs) diff --git a/modules/map/src/MAP_Fortran_Registry.txt b/modules/map/src/MAP_Fortran_Registry.txt deleted file mode 100644 index b1ad941a80..0000000000 --- a/modules/map/src/MAP_Fortran_Registry.txt +++ /dev/null @@ -1,22 +0,0 @@ -################## Registry for MAP++ ############### -# column 1 -# column 2 ModuleName/ModName or ^ to use the value from the previous line (SD is nickname for ModuleName) -# column 3 Derived data type (without "ModName_" prefix) -# column 4 Derived data types's Field type -# column 5 Variable name -# column 6 Dimension of variable {:} for allocatable -# column 7 Variable's initial value (if set in the data type) -# column 8 I think this is a switch for mixed-language programming; it's mostly unused -# column 9 Description -# column 10 Units -# Keyword ModuleName/ModName Derived data type Field type Variable name variable dimension Initial value for mix language, not used Description Units - -include Registry_NWTC_Library.txt - -typedef MAP_Fortran/MAP_Fortran Lin_InitInputType LOGICAL linearize - .false. - "Flag that tells this module if the glue code wants to linearize. (fortran-only)" - -typedef ^ Lin_InitOutputType CHARACTER(200) LinNames_y {:} "" - "second line of output file contents: units (fortran-only)" - -typedef ^ ^ CHARACTER(200) LinNames_u {:} "" - "Names of the inputs used in linearization (fortran-only)" - -typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) (fortran-only)" - -typedef ^ Lin_ParamType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian (fortran-only)" - -typedef ^ ^ R8Ki du - - - "determines size of the translational displacement perturbation for u (inputs) (fortran-only)" - -typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix (fortran-only)" - diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 deleted file mode 100644 index 76bc63b701..0000000000 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ /dev/null @@ -1,249 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'MAP_Fortran_Types.f90' -! -! WARNING This file is generated automatically by the FAST registry. -! Do not edit. Your changes to this file will be lost. -! -! FAST Registry -!********************************************************************************************************************************* -! MAP_Fortran_Types -!................................................................................................................................. -! This file is part of MAP_Fortran. -! -! Copyright (C) 2012-2016 National Renewable Energy Laboratory -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -! -! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. -! -!********************************************************************************************************************************* -!> This module contains the user-defined types needed in MAP_Fortran. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. -MODULE MAP_Fortran_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= Lin_InitInputType ======= - TYPE, PUBLIC :: Lin_InitInputType - LOGICAL :: linearize = .false. !< Flag that tells this module if the glue code wants to linearize. (fortran-only) [-] - END TYPE Lin_InitInputType -! ======================= -! ========= Lin_InitOutputType ======= - TYPE, PUBLIC :: Lin_InitOutputType - CHARACTER(200) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< second line of output file contents: units (fortran-only) [-] - CHARACTER(200) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization (fortran-only) [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) (fortran-only) [-] - END TYPE Lin_InitOutputType -! ======================= -! ========= Lin_ParamType ======= - TYPE, PUBLIC :: Lin_ParamType - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian (fortran-only) [-] - REAL(R8Ki) :: du = 0.0_R8Ki !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] - INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix (fortran-only) [-] - END TYPE Lin_ParamType -! ======================= -CONTAINS - -subroutine MAP_Fortran_CopyLin_InitInputType(SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) - type(Lin_InitInputType), intent(in) :: SrcLin_InitInputTypeData - type(Lin_InitInputType), intent(inout) :: DstLin_InitInputTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitInputType' - ErrStat = ErrID_None - ErrMsg = '' - DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize -end subroutine - -subroutine MAP_Fortran_DestroyLin_InitInputType(Lin_InitInputTypeData, ErrStat, ErrMsg) - type(Lin_InitInputType), intent(inout) :: Lin_InitInputTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine MAP_Fortran_PackLin_InitInputType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Lin_InitInputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%linearize) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MAP_Fortran_UnPackLin_InitInputType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Lin_InitInputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%linearize); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) - type(Lin_InitOutputType), intent(in) :: SrcLin_InitOutputTypeData - type(Lin_InitOutputType), intent(inout) :: DstLin_InitOutputTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcLin_InitOutputTypeData%LinNames_y)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y, kind=B8Ki) - if (.not. allocated(DstLin_InitOutputTypeData%LinNames_y)) then - allocate(DstLin_InitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y - end if - if (allocated(SrcLin_InitOutputTypeData%LinNames_u)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u, kind=B8Ki) - if (.not. allocated(DstLin_InitOutputTypeData%LinNames_u)) then - allocate(DstLin_InitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u - end if - if (allocated(SrcLin_InitOutputTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u, kind=B8Ki) - if (.not. allocated(DstLin_InitOutputTypeData%IsLoad_u)) then - allocate(DstLin_InitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u - end if -end subroutine - -subroutine MAP_Fortran_DestroyLin_InitOutputType(Lin_InitOutputTypeData, ErrStat, ErrMsg) - type(Lin_InitOutputType), intent(inout) :: Lin_InitOutputTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(Lin_InitOutputTypeData%LinNames_y)) then - deallocate(Lin_InitOutputTypeData%LinNames_y) - end if - if (allocated(Lin_InitOutputTypeData%LinNames_u)) then - deallocate(Lin_InitOutputTypeData%LinNames_u) - end if - if (allocated(Lin_InitOutputTypeData%IsLoad_u)) then - deallocate(Lin_InitOutputTypeData%IsLoad_u) - end if -end subroutine - -subroutine MAP_Fortran_PackLin_InitOutputType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Lin_InitOutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%LinNames_y) - call RegPackAlloc(RF, InData%LinNames_u) - call RegPackAlloc(RF, InData%IsLoad_u) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MAP_Fortran_UnPackLin_InitOutputType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Lin_InitOutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg) - type(Lin_ParamType), intent(in) :: SrcLin_ParamTypeData - type(Lin_ParamType), intent(inout) :: DstLin_ParamTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcLin_ParamTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstLin_ParamTypeData%Jac_u_indx)) then - allocate(DstLin_ParamTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx - end if - DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du - DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny -end subroutine - -subroutine MAP_Fortran_DestroyLin_ParamType(Lin_ParamTypeData, ErrStat, ErrMsg) - type(Lin_ParamType), intent(inout) :: Lin_ParamTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(Lin_ParamTypeData%Jac_u_indx)) then - deallocate(Lin_ParamTypeData%Jac_u_indx) - end if -end subroutine - -subroutine MAP_Fortran_PackLin_ParamType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Lin_ParamType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_ParamType' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPack(RF, InData%du) - call RegPack(RF, InData%Jac_ny) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MAP_Fortran_UnPackLin_ParamType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Lin_ParamType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return -end subroutine -END MODULE MAP_Fortran_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Registry.txt b/modules/map/src/MAP_Registry.txt index a74aa4c316..a6c807f813 100644 --- a/modules/map/src/MAP_Registry.txt +++ b/modules/map/src/MAP_Registry.txt @@ -13,7 +13,6 @@ include Registry_NWTC_Library.txt -usefrom MAP_Fortran_Registry.txt ## ============================== Define input types here: ============================================================================================================================================ typedef MAP InitInputType R8Ki gravity - -999.9 - "gravity constant" "[m/s^2]" @@ -25,7 +24,7 @@ typedef ^ ^ CHARACTER(255) library_input_str typedef ^ ^ CHARACTER(255) node_input_str - "" - "node string information (from input file)" typedef ^ ^ CHARACTER(255) line_input_str - "" - "element library string information (from input file)" typedef ^ ^ CHARACTER(255) option_input_str - "" - "solver options library string information (from input file)" -typedef ^ ^ Lin_InitInputType LinInitInp - - - " " - +typedef ^ ^ logical Linearize - "" - "Flag to perform linearization" ## ============================== Define Initialization outputs here: ================================================================================================================================ typedef ^ InitOutputType CHARACTER(99) progName - "" - "program name" typedef ^ ^ CHARACTER(99) version - "" - "version numnber" @@ -33,7 +32,6 @@ typedef ^ ^ CHARACTER(24) compilingData typedef ^ ^ CHARACTER(15) writeOutputHdr {:} "" - "first line output file contents: output variable names" typedef ^ ^ CHARACTER(15) writeOutputUnt {:} "" - "second line of output file contents: units" typedef ^ ^ ProgDesc Ver - "" - "this module's name, version, and date" -typedef ^ ^ Lin_InitOutputType LinInitOut - - - "Init Output linearization data (fortran-only)" - typedef ^ ^ ModVarsType *Vars - - - "Module Variables" - ## ============================== Define Continuous states here: ===================================================================================================================================== @@ -88,7 +86,6 @@ typedef ^ ^ R8Ki dt typedef ^ ^ CHARACTER(255) InputLines {500} - - "input file line for restart" typedef ^ ^ CHARACTER(1) InputLineType {500} - - "input file line type for restart" typedef ^ ^ INTEGER numOuts - 0 - "Number of write outputs" - -typedef ^ ^ Lin_ParamType LinParams - - - "Parameter linearization data (fortran-only)" # ============================== Inputs ============================================================================================================================================ typedef ^ InputType R8Ki x {:} - - "fairlead x displacement" "[m]" diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index f93875a67d..bf2ff656c9 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE MAP_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE MAP_Fortran_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: MAP_u_PtFairDisplacement = 1 ! Mesh number for MAP MAP_u_PtFairDisplacement mesh [-] @@ -48,6 +47,7 @@ MODULE MAP_Types CHARACTER(KIND=C_CHAR), DIMENSION(255) :: node_input_str CHARACTER(KIND=C_CHAR), DIMENSION(255) :: line_input_str CHARACTER(KIND=C_CHAR), DIMENSION(255) :: option_input_str + LOGICAL(KIND=C_BOOL) :: Linearize END TYPE MAP_InitInputType_C TYPE, PUBLIC :: MAP_InitInputType TYPE( MAP_InitInputType_C ) :: C_obj @@ -60,7 +60,7 @@ MODULE MAP_Types CHARACTER(255) :: node_input_str !< node string information (from input file) [-] CHARACTER(255) :: line_input_str !< element library string information (from input file) [-] CHARACTER(255) :: option_input_str !< solver options library string information (from input file) [-] - TYPE(Lin_InitInputType) :: LinInitInp !< [-] + LOGICAL :: Linearize = .false. !< Flag to perform linearization [-] END TYPE MAP_InitInputType ! ======================= ! ========= MAP_InitOutputType_C ======= @@ -82,7 +82,6 @@ MODULE MAP_Types CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputHdr !< first line output file contents: output variable names [-] CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] - TYPE(Lin_InitOutputType) :: LinInitOut !< Init Output linearization data (fortran-only) [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE MAP_InitOutputType ! ======================= @@ -210,7 +209,6 @@ MODULE MAP_Types CHARACTER(255) , DIMENSION(1:500) :: InputLines !< input file line for restart [-] CHARACTER(1) , DIMENSION(1:500) :: InputLineType !< input file line type for restart [-] INTEGER(IntKi) :: numOuts = 0 !< Number of write outputs [-] - TYPE(Lin_ParamType) :: LinParams !< Parameter linearization data (fortran-only) [-] END TYPE MAP_ParameterType ! ======================= ! ========= MAP_InputType_C ======= @@ -274,8 +272,6 @@ subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' @@ -297,22 +293,17 @@ subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str DstInitInputData%option_input_str = SrcInitInputData%option_input_str DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str - call MAP_Fortran_CopyLin_InitInputType(SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%C_obj%Linearize = SrcInitInputData%C_obj%Linearize end subroutine subroutine MAP_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(MAP_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' - call MAP_Fortran_DestroyLin_InitInputType(InitInputData%LinInitInp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackInitInput(RF, Indata) @@ -333,7 +324,7 @@ subroutine MAP_PackInitInput(RF, Indata) call RegPack(RF, InData%node_input_str) call RegPack(RF, InData%line_input_str) call RegPack(RF, InData%option_input_str) - call MAP_Fortran_PackLin_InitInputType(RF, InData%LinInitInp) + call RegPack(RF, InData%Linearize) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -360,7 +351,8 @@ subroutine MAP_UnPackInitInput(RF, OutData) OutData%C_obj%line_input_str = transfer(OutData%line_input_str, OutData%C_obj%line_input_str ) call RegUnpack(RF, OutData%option_input_str); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%option_input_str = transfer(OutData%option_input_str, OutData%C_obj%option_input_str ) - call MAP_Fortran_UnpackLin_InitInputType(RF, OutData%LinInitInp) ! LinInitInp + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%Linearize = OutData%Linearize end subroutine SUBROUTINE MAP_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) @@ -387,6 +379,7 @@ SUBROUTINE MAP_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers InitInputData%node_input_str = TRANSFER(InitInputData%C_obj%node_input_str, InitInputData%node_input_str ) InitInputData%line_input_str = TRANSFER(InitInputData%C_obj%line_input_str, InitInputData%line_input_str ) InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) + InitInputData%Linearize = InitInputData%C_obj%Linearize END SUBROUTINE SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) @@ -413,6 +406,7 @@ SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str) InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str) InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str) + InitInputData%C_obj%Linearize = InitInputData%Linearize END SUBROUTINE subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -460,9 +454,6 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MAP_Fortran_CopyLin_InitOutputType(SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine @@ -483,8 +474,6 @@ subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MAP_Fortran_DestroyLin_InitOutputType(InitOutputData%LinInitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%Vars) end subroutine @@ -504,7 +493,6 @@ subroutine MAP_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%writeOutputHdr) call RegPackAlloc(RF, InData%writeOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) - call MAP_Fortran_PackLin_InitOutputType(RF, InData%LinInitOut) call RegPack(RF, associated(InData%Vars)) if (associated(InData%Vars)) then call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) @@ -534,7 +522,6 @@ subroutine MAP_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver - call MAP_Fortran_UnpackLin_InitOutputType(RF, OutData%LinInitOut) ! LinInitOut if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -1883,9 +1870,6 @@ subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%InputLineType = SrcParamData%InputLineType DstParamData%numOuts = SrcParamData%numOuts DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts - call MAP_Fortran_CopyLin_ParamType(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -1903,8 +1887,6 @@ subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Vars) ParamData%Vars => null() end if - call MAP_Fortran_DestroyLin_ParamType(ParamData%LinParams, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackParam(RF, Indata) @@ -1934,7 +1916,6 @@ subroutine MAP_PackParam(RF, Indata) call RegPack(RF, InData%InputLines) call RegPack(RF, InData%InputLineType) call RegPack(RF, InData%numOuts) - call MAP_Fortran_PackLin_ParamType(RF, InData%LinParams) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1984,7 +1965,6 @@ subroutine MAP_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%InputLineType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%numOuts); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%numOuts = OutData%numOuts - call MAP_Fortran_UnpackLin_ParamType(RF, OutData%LinParams) ! LinParams end subroutine SUBROUTINE MAP_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) diff --git a/modules/map/src/MAP_Types.h b/modules/map/src/MAP_Types.h index e5985fc8c3..b32b32578b 100644 --- a/modules/map/src/MAP_Types.h +++ b/modules/map/src/MAP_Types.h @@ -29,6 +29,7 @@ typedef struct MAP_InitInputType { char node_input_str[255]; char line_input_str[255]; char option_input_str[255]; + bool Linearize; } MAP_InitInputType_t; typedef struct MAP_InitOutputType { diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index 18ab79b969..41f369ed1d 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -691,7 +691,7 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, m, Interval, InitOut, Er !............................................................................................ ! Module Variables !............................................................................................ - call MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, InitInp%LinInitInp%Linearize, ErrStat2, ErrMsg2) + call MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !............................................................................................ @@ -1169,184 +1169,7 @@ SUBROUTINE map_set_input_file_contents(InitInp, p) END DO END SUBROUTINE map_set_input_file_contents -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine map::map_init_jacobian is consistant with this routine! -SUBROUTINE map_Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(map_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(map_InputType) , INTENT(INOUT) :: u !< perturbed map inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - integer :: fieldIndx - integer :: node - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - fieldIndx = p%LinParams%Jac_u_indx(n,2) - node = p%LinParams%Jac_u_indx(n,3) - du = p%LinParams%du - u%PtFairDisplacement%TranslationDisp (fieldIndx,node) = u%PtFairDisplacement%TranslationDisp (fieldIndx,node) + du * perturb_sign - -END SUBROUTINE map_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine map::map_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(map_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(map_OutputType) , INTENT(IN ) :: y_p !< map outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) - TYPE(map_OutputType) , INTENT(IN ) :: y_m !< map outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - - integer(IntKi) :: indx_first ! index indicating next value of dY to be filled - logical :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - integer(IntKi) :: k - - indx_first = 1 - if ( y_p%ptFairleadLoad%Committed ) then - call PackLoadMesh_dY(y_p%ptFairleadLoad, y_m%ptFairleadLoad, dY, indx_first) - end if - - do k=1,p%numOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - - - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding linearization routines ! -SUBROUTINE MAP_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) - - TYPE(map_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(map_InputType) , INTENT(IN ) :: u !< inputs - TYPE(map_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(map_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_next, index_last, nu, i_meshField, m, meshFieldCount - REAL(R8Ki) :: perturb_t, perturb - REAL(R8Ki) :: ScaleLength - LOGICAL :: FieldMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - ErrStat = ErrID_None - ErrMsg = "" - - !...................................... - ! init linearization outputs: - !...................................... - - ! determine how many outputs there are in the Jacobians - p%LinParams%Jac_ny = 0 - if ( y%ptFairleadLoad%Committed ) then - p%LinParams%Jac_ny = y%ptFairleadLoad%NNodes * 3 ! 3 Forces, no Moments, at each node on the fairlead loads mesh - end if - - p%LinParams%Jac_ny = p%LinParams%Jac_ny + p%numOuts ! WriteOutput values - - !................. - ! set linearization output names: - !................. - call AllocAry(InitOut%LinInitOut%LinNames_y, p%LinParams%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - index_next = 1 - if ( y%ptFairleadLoad%Committed ) then - index_last = index_next - call PackLoadMesh_Names(y%ptFairleadLoad, 'FairleadLoads', InitOut%LinInitOut%LinNames_y, index_next) - end if - - index_last = index_next - do i=1,p%numOuts - InitOut%LinInitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do - - - !...................................... - ! init linearization inputs: - !...................................... - - - ! determine how many inputs there are in the Jacobians - nu = 0; - if ( u%PtFairDisplacement%Committed ) then - nu = nu + u%PtFairDisplacement%NNodes * 3 ! 3 TranslationDisp at each node - end if - - ! note: all other inputs are ignored - - !.................... - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see hydrodyn::map_perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index of the acceleration/load field - ! column 3 is the node - !.................... - - !............... - ! MAP input mappings stored in p%Jac_u_indx: - !............... - call AllocAry(p%LinParams%Jac_u_indx, nu, 3, 'p%LinParams%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - index = 1 - meshFieldCount = 0 - if ( u%PtFairDisplacement%Committed ) then - !Module/Mesh/Field: u%PtFairDisplacement%TranslationDisp = 1; - i_meshField = 1 - do i=1,u%PtFairDisplacement%NNodes - do j=1,3 - p%LinParams%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%PtFairDisplacement%{TranslationDisp} = m - p%LinParams%Jac_u_indx(index,2) = j !index: j - p%LinParams%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - meshFieldCount = meshFieldCount + 1 - end if - - !................ - ! input perturbations, du: - !................ - - p%LinParams%du = 0.2_R8Ki*D2R * max(p%depth,1.0_R8Ki) ! translation input scaling ! u%PtFairDisplacement%TranslationDisp - - !................ - ! names of the columns, InitOut%LinNames_u: - !................ - call AllocAry(InitOut%LinInitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call AllocAry(InitOut%LinInitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%LinInitOut%IsLoad_u(:) = .false. ! MAP's inputs are NOT loads - - index = 1 - if ( u%PtFairDisplacement%Committed ) then - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - call PackMotionMesh_Names(u%PtFairDisplacement, 'PtFairDisplacement', InitOut%LinInitOut%LinNames_u, index, FieldMask=FieldMask) - end if - -END SUBROUTINE MAP_Init_Jacobian SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 5917c1c141..74000a29ab 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -959,7 +959,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD Init%InData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name Init%InData_MAP%depth = -Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState - Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize + Init%InData_MAP%Linearize = p_FAST%Linearize CALL MAP_Init(Init%InData_MAP, MAPp%Input(1), MAPp%p, & MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & diff --git a/modules/subdyn/src/SubDyn_Output.f90 b/modules/subdyn/src/SubDyn_Output.f90 index 769caf5ec0..66fb1b3f22 100644 --- a/modules/subdyn/src/SubDyn_Output.f90 +++ b/modules/subdyn/src/SubDyn_Output.f90 @@ -40,11 +40,6 @@ MODULE SubDyn_Output PUBLIC :: SDOut_WriteOutputUnits PUBLIC :: SDOut_WriteOutputs PUBLIC :: SDOut_Init - PUBLIC :: SD_Init_Jacobian - PUBLIC :: SD_Perturb_u - PUBLIC :: SD_Perturb_x - PUBLIC :: SD_Compute_dY - PUBLIC :: SD_Compute_dX CONTAINS @@ -816,245 +811,5 @@ SUBROUTINE SDOut_ChkOutLst( OutList, p, ErrStat, ErrMsg ) END SUBROUTINE SDOut_ChkOutLst !==================================================================================================== -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutine ! -SUBROUTINE SD_Init_Jacobian(Init, p, u, y, InitOut, ErrStat, ErrMsg) - TYPE(SD_InitType) , INTENT(IN ) :: Init !< Init - TYPE(SD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(SD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(SD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(SD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Init_Jacobian' - real(ReKi) :: dx, dy, dz, maxDim - ! local variables: - ErrStat = ErrID_None - ErrMsg = "" - ! --- System dimension - dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) - dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) - dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) - maxDim = max(dx, dy, dz) - - ! --- System dimension - call Init_Jacobian_y(); if (Failed()) return - call Init_Jacobian_x(); if (Failed()) return - call Init_Jacobian_u(); if (Failed()) return - -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Init_Jacobian') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. - - SUBROUTINE Init_Jacobian_y() - INTEGER(IntKi) :: index_next, i - ! Number of outputs - p%Jac_ny = y%Y1Mesh%nNodes * 6 & ! 3 forces + 3 moments at each node - + y%Y2Mesh%nNodes * 18 & ! 6 displacements + 6 velocities + 6 accelerations at each node - + y%Y3Mesh%nNodes * 18 & ! 6 displacements + 6 velocities + 6 accelerations at each node - + p%NumOuts ! WriteOutput values - ! Storage info for each output (names, rotframe) - call AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - ! Names - index_next = 1 - call PackLoadMesh_Names( y%Y1Mesh, 'Interface displacement', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%Y2Mesh, 'Nodes motion mixed' , InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%Y3Mesh, 'Nodes motion full' , InitOut%LinNames_y, index_next) - do i=1,p%NumOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do - ! RotFrame - InitOut%RotFrame_y(:) = .false. - END SUBROUTINE Init_Jacobian_y - - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. - SUBROUTINE Init_Jacobian_x() - INTEGER(IntKi) :: i - p%Jac_nx = p%nDOFM ! qm - ! allocate space for the row/column names and for perturbation sizes - CALL AllocAry(InitOut%LinNames_x , 2*p%Jac_nx, 'LinNames_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%RotFrame_x , 2*p%Jac_nx, 'RotFrame_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%DerivOrder_x, 2*p%Jac_nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - ! default perturbations, p%dx: - p%dx(1) = 2.0_ReKi*D2R_D ! deflection states in rad and rad/s - p%dx(2) = 2.0_ReKi*D2R_D ! deflection states in rad and rad/s - InitOut%RotFrame_x = .false. - InitOut%DerivOrder_x = 2 - ! set linearization output names: - do i=1,p%Jac_nx - InitOut%LinNames_x(i) = 'Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -'; - end do - do i=1,p%Jac_nx - InitOut%LinNames_x(i+p%Jac_nx) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%Jac_nx) = InitOut%RotFrame_x(i) - end do - END SUBROUTINE Init_Jacobian_x - - SUBROUTINE Init_Jacobian_u() - REAL(R8Ki) :: perturb - INTEGER(IntKi) :: i, j, idx, nu, i_meshField - ! Number of inputs - nu = u%TPMesh%nNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities + 6 accelerations at each node - + u%LMesh%nNodes * 6 ! 3 forces + 3 moments at each node - ! --- Info of linearized inputs (Names, RotFrame, IsLoad) - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%IsLoad_u , nu, 'IsLoad_u' , ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame - idx = 1 - call PackMotionMesh_Names(u%TPMesh, 'TPMesh', InitOut%LinNames_u, idx) ! all 6 motion fields - InitOut%IsLoad_u(1:idx-1) = .false. ! the TPMesh inputs are not loads - InitOut%IsLoad_u(idx:) = .true. ! the remaining inputs are loads - call PackLoadMesh_Names( u%LMesh, 'LMesh', InitOut%LinNames_u, idx) - - ! --- Jac_u_indx: matrix to store index to help us figure out what the ith value of the u vector really means - ! (see perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - idx = 1 - !Module/Mesh/Field: u%TPMesh%TranslationDisp = 1; - !Module/Mesh/Field: u%TPMesh%Orientation = 2; - !Module/Mesh/Field: u%TPMesh%TranslationVel = 3; - !Module/Mesh/Field: u%TPMesh%RotationVel = 4; - !Module/Mesh/Field: u%TPMesh%TranslationAcc = 5; - !Module/Mesh/Field: u%TPMesh%RotationAcc = 6; - do i_meshField = 1,6 - do i=1,u%TPMesh%nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField - p%Jac_u_indx(idx,2) = j !component idx: j - p%Jac_u_indx(idx,3) = i !Node: i - idx = idx + 1 - end do !j - end do !i - end do - !Module/Mesh/Field: u%LMesh%Force = 7; - !Module/Mesh/Field: u%LMesh%Moment = 8; - do i_meshField = 7,8 - do i=1,u%LMesh%nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField - p%Jac_u_indx(idx,2) = j !component idx: j - p%Jac_u_indx(idx,3) = i !Node: i - idx = idx + 1 - end do !j - end do !i - end do - - ! --- Default perturbations, p%du: - call allocAry( p%du, 8, 'p%du', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return ! 8 = number of unique values in p%Jac_u_indx(:,1) - perturb = 2.0_R8Ki*D2R_D - p%du( 1) = perturb ! u%TPMesh%TranslationDisp = 1; - p%du( 2) = perturb ! u%TPMesh%Orientation = 2; - p%du( 3) = perturb ! u%TPMesh%TranslationVel = 3; - p%du( 4) = perturb ! u%TPMesh%RotationVel = 4; - p%du( 5) = perturb ! u%TPMesh%TranslationAcc = 5; - p%du( 6) = perturb ! u%TPMesh%RotationAcc = 6; - p%du( 7) = 170*maxDim**2 ! u%LMesh%Force = 7; - p%du( 8) = 14*maxDim**3 ! u%LMesh%Moment = 8; - END SUBROUTINE Init_Jacobian_u - -END SUBROUTINE SD_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE SD_Perturb_u( p, n, perturb_sign, u, du ) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(SD_InputType) , INTENT(INOUT) :: u !< perturbed SD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - du = p%du( p%Jac_u_indx(n,1) ) - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%TPMesh%TranslationDisp = 1; - u%TPMesh%TranslationDisp( fieldIndx,node) = u%TPMesh%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%TPMesh%Orientation = 2; - CALL PerturbOrientationMatrix( u%TPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 3) !Module/Mesh/Field: u%TPMesh%TranslationVel = 3; - u%TPMesh%TranslationVel( fieldIndx,node) = u%TPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%TPMesh%RotationVel = 4; - u%TPMesh%RotationVel(fieldIndx,node) = u%TPMesh%RotationVel(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%TPMesh%TranslationAcc = 5; - u%TPMesh%TranslationAcc( fieldIndx,node) = u%TPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%TPMesh%RotationAcc = 6; - u%TPMesh%RotationAcc(fieldIndx,node) = u%TPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - CASE ( 7) !Module/Mesh/Field: u%LMesh%Force = 7; - u%LMesh%Force(fieldIndx,node) = u%LMesh%Force(fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%LMesh%Moment = 8; - u%LMesh%Moment(fieldIndx,node) = u%LMesh%Moment(fieldIndx,node) + du * perturb_sign - END SELECT -END SUBROUTINE SD_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE SD_Compute_dY(p, y_p, y_m, delta, dY) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(SD_OutputType) , INTENT(IN ) :: y_p !< SD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(SD_OutputType) , INTENT(IN ) :: y_m !< SD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - ! local variables: - INTEGER(IntKi) :: i ! loop over outputs - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - indx_first = 1 - call PackLoadMesh_dY( y_p%Y1Mesh, y_m%Y1Mesh, dY, indx_first) - call PackMotionMesh_dY(y_p%Y2Mesh, y_m%Y2Mesh, dY, indx_first, UseSmlAngle=.true.) ! all 6 motion fields - call PackMotionMesh_dY(y_p%Y3Mesh, y_m%Y3Mesh, dY, indx_first, UseSmlAngle=.true.) ! all 6 motion fields - do i=1,p%NumOuts - dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) - end do - dY = dY / (2.0_R8Ki*delta) -END SUBROUTINE SD_Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine sd_init_jacobian is consistant with this routine! -SUBROUTINE SD_Perturb_x( p, fieldIndx, mode, perturb_sign, x, dx ) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: fieldIndx !< field in the state type: 1=displacements; 2=velocities - INTEGER( IntKi ) , INTENT(IN ) :: mode !< node number - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< perturbed SD states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - if (fieldIndx==1) then - dx=p%dx(1) - x%qm(mode) = x%qm(mode) + dx * perturb_sign - else - dx=p%dx(2) - x%qmdot(mode) = x%qmdot(mode) + dx * perturb_sign - end if -END SUBROUTINE SD_Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine sd_init_jacobian is consistant with this routine! -SUBROUTINE SD_Compute_dX(p, x_p, x_m, delta, dX) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x_p !< SD continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x_m !< SD continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial X}{\partial u_i} = \frac{x_p - x_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial X}{\partial x_i} = \frac{x_p - x_m}{2 \, \Delta x}\f$ - INTEGER(IntKi) :: i ! loop over modes - do i=1,p%Jac_nx - dX(i) = x_p%qm(i) - x_m%qm(i) - end do - do i=1,p%Jac_nx - dX(p%Jac_nx+i) = x_p%qmdot(i) - x_m%qmdot(i) - end do - dX = dX / (2.0_R8Ki*delta) -END SUBROUTINE SD_Compute_dX END MODULE SubDyn_Output diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 3caf46913e..20e8031c22 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -272,13 +272,6 @@ typedef ^ ParameterType LOGICAL OutReact - - - "Flag to check typedef ^ ParameterType IntKi OutAllInt - - - "Integer version of OutAll" typedef ^ ParameterType IntKi OutAllDims - - - "Integer version of OutAll" typedef ^ ParameterType IntKi OutDec - - - "Output Decimation for Requested Channels" -# --- Parametesr - Linearization -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType R8Ki dx {2} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - -typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - # ============================== Inputs ============================================================================================================================================ typedef ^ InputType MeshType TPMesh - - - "Transition piece inputs on a point mesh" diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 5bcfe8a312..630d7fc1a1 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -323,12 +323,6 @@ MODULE SubDyn_Types INTEGER(IntKi) :: OutAllInt = 0_IntKi !< Integer version of OutAll [-] INTEGER(IntKi) :: OutAllDims = 0_IntKi !< Integer version of OutAll [-] INTEGER(IntKi) :: OutDec = 0_IntKi !< Output Decimation for Requested Channels [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:2) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] - LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] END TYPE SD_ParameterType ! ======================= ! ========= SD_InputType ======= @@ -2877,34 +2871,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutAllInt = SrcParamData%OutAllInt DstParamData%OutAllDims = SrcParamData%OutAllDims DstParamData%OutDec = SrcParamData%OutDec - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du - end if - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates end subroutine subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -3137,12 +3103,6 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%OutParam) end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if end subroutine subroutine SD_PackParam(RF, Indata) @@ -3319,12 +3279,6 @@ subroutine SD_PackParam(RF, Indata) call RegPack(RF, InData%OutAllInt) call RegPack(RF, InData%OutAllDims) call RegPack(RF, InData%OutDec) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%du) - call RegPack(RF, InData%dx) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%Jac_nx) - call RegPack(RF, InData%RotStates) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3544,12 +3498,6 @@ subroutine SD_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%OutAllInt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%OutAllDims); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%OutDec); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) From 9917249632a9c19ca7a70a1be50bb7d83773b7f4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 6 Jun 2024 22:21:53 +0000 Subject: [PATCH 148/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 9e2b5b5b5c..4d17325af0 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 9e2b5b5b5c5a3421f836c74ccc1c5960825e88dd +Subproject commit 4d17325af0913132fdfe92c15f3ea00669b50d12 From b543b77f1da0bcb949bd8a63dfafd25ff603a45a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 15 Jun 2024 13:22:34 +0000 Subject: [PATCH 149/319] Making progress on AeroMap, update indexing --- glue-codes/openfast/src/FAST_Prog.f90 | 4 +- modules/aerodyn/src/AeroDyn.f90 | 8 +- modules/elastodyn/src/ElastoDyn.f90 | 18 +- modules/lindyn/src/LinDyn_Types.f90 | 34 + modules/nwtc-library/src/ModVar.f90 | 11 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 12 +- .../src/Registry_NWTC_Library.txt | 6 +- .../src/Registry_NWTC_Library_base.txt | 6 +- modules/openfast-library/CMakeLists.txt | 4 +- modules/openfast-library/src/FAST_AeroMap.f90 | 1216 +++++++++++++---- modules/openfast-library/src/FAST_Funcs.f90 | 76 +- modules/openfast-library/src/FAST_Idx.f90 | 385 ------ modules/openfast-library/src/FAST_Mapping.f90 | 616 +++++---- modules/openfast-library/src/FAST_ModData.f90 | 413 ++++++ modules/openfast-library/src/FAST_ModGlue.f90 | 642 ++------- modules/openfast-library/src/FAST_Mods.f90 | 1 + modules/openfast-library/src/FAST_Subs.f90 | 33 +- .../openfast-library/src/Glue_Registry.txt | 76 +- modules/openfast-library/src/Glue_Types.f90 | 1076 ++++++++++++--- 19 files changed, 2896 insertions(+), 1741 deletions(-) delete mode 100644 modules/openfast-library/src/FAST_Idx.f90 create mode 100644 modules/openfast-library/src/FAST_ModData.f90 diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index ca53a9e917..f74d94c5a5 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -32,7 +32,7 @@ PROGRAM FAST USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs -! USE FAST_AeroMap, ONLY : FAST_RunSteadyStateDriver +USE FAST_AeroMap, ONLY : FAST_RunSteadyStateDriver IMPLICIT NONE @@ -80,7 +80,7 @@ PROGRAM FAST ELSE IF ( TRIM(FlagArg) == 'STEADYSTATE' ) THEN ! Do steady-state analysis, not time-marching -- this works for only 1 turbine (i.e., NumTurbines==1)! ! this runs the steady-state solver driver and ENDS the program: - ! CALL FAST_RunSteadyStateDriver( Turbine(1) ) + CALL FAST_RunSteadyStateDriver( Turbine(1) ) ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 2298558a83..c0c683c6dd 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5579,7 +5579,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD character(64) :: NodeLabel character(1), parameter :: UVW(3) = ['U','V','W'] real(R8Ki) :: Perturb, PerturbTower, PerturbBlade(MaxBl) - integer(IntKi) :: i, j, n, state + integer(IntKi) :: i, j, n, state, Flags ErrStat = ErrID_None ErrMsg = "" @@ -5798,9 +5798,11 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD call AllocAry(p%iVarBladeLoad, p%NumBlades, "iVarBladeLoad", ErrStat2, ErrMsg2); if (Failed()) return p%iVarBladeLoad = 0 do j = 1, p%NumBlades + Flags = VF_Line + if (j == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddMeshVar(p%Vars%y, "Blade "//Num2LStr(j), LoadFields, & VarIdx=p%iVarBladeLoad(j), & - Flags=ior(VF_AeroMap, VF_Line), & + Flags=Flags, & Mesh=y%BladeLoad(j)) end do @@ -6056,7 +6058,7 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - if (present(dXdu)) then + if (present(dXdu) .and. (p%Vars%Nx > 0)) then ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 7e59905c2c..c22726b423 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -2081,7 +2081,9 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta ENDDO ! I - All active (enabled) DOFs m%QD2T = dxdt%QDT - + + ! If computing AeroMaps, put accelerations where velocities would be located + if (p%CompAeroMaps) dxdt%QT = dxdt%QDT ! Let's calculate the sign (+/-1) of the low-speed shaft torque for this time step and store it in SgnPrvLSTQ. ! This will be used during the next call to RtHS (bjj: currently violates framework, but DOE wants a hack for HSS brake). @@ -11412,8 +11414,12 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat p%Vars%x(i)%Perturb = max(p%Vars%x(i)%Perturb, MinPerturb) ! Update from position to velocity - if (p%Vars%x(i)%Field == FieldTransDisp) Field = FieldTransVel - if (p%Vars%x(i)%Field == FieldAngularDisp) Field = FieldAngularVel + select case (p%Vars%x(i)%Field) + case (FieldTransDisp) + Field = FieldTransVel + case (FieldAngularDisp) + Field = FieldAngularVel + end select ! Add variable (only active variables are in x) call MV_AddVar(p%Vars%x, p%Vars%x(i)%Name, Field, & @@ -11423,8 +11429,8 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat Perturb=p%Vars%x(i)%Perturb, & LinNames=['First time derivative of '//trim(p%Vars%x(i)%LinNames(1))//'/s']) - ! Remove aero map flag from newly created variable - call MV_UnsetFlags(p%Vars%x(j), VF_AeroMap) + ! Remove aero map flag from velocity variable + call MV_ClearFlags(p%Vars%x(j), VF_AeroMap) end do end if @@ -11537,7 +11543,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat if (i == 1) then do j = p%iVarBladeMotion(i), size(p%Vars%y) select case (p%Vars%y(j)%Field) - case (FieldTransDisp, FieldAngularDisp, FieldTransVel, FieldAngularVel) + case (FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel) call MV_SetFlags(p%Vars%y(j), VF_AeroMap) end select end do diff --git a/modules/lindyn/src/LinDyn_Types.f90 b/modules/lindyn/src/LinDyn_Types.f90 index ebaaa657a2..62945121f9 100644 --- a/modules/lindyn/src/LinDyn_Types.f90 +++ b/modules/lindyn/src/LinDyn_Types.f90 @@ -1555,5 +1555,39 @@ SUBROUTINE LD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function LD_InputMeshPointer(u, ML) result(Mesh) + type(LD_InputType), target, intent(in) :: u + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function LD_InputMeshName(ML) result(Name) + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function + +function LD_OutputMeshPointer(y, ML) result(Mesh) + type(LD_OutputType), target, intent(in) :: y + type(MeshLocType), intent(in) :: ML + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (ML%Num) + end select +end function + +function LD_OutputMeshName(ML) result(Name) + type(MeshLocType), intent(in) :: ML + character(32) :: Name + Name = "" + select case (ML%Num) + end select +end function END MODULE LinDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 2602318c69..03eab37651 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -33,10 +33,10 @@ module ModVar public :: MV_InitVarsJac, MV_Pack, MV_Unpack public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff, MV_ExtrapInterp public :: MV_AddVar, MV_AddMeshVar -public :: MV_HasFlags, MV_SetFlags, MV_UnsetFlags, MV_NumVars +public :: MV_HasFlags, MV_SetFlags, MV_ClearFlags, MV_NumVars public :: LoadFields, MotionFields, TransFields, AngularFields public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv -public :: MV_FieldString, IdxStr +public :: MV_FieldString, MV_IsLoad, IdxStr public :: DumpMatrix integer(IntKi), parameter :: & @@ -967,6 +967,11 @@ function MV_NumVars(VarAry, FlagFilter) result(Num) end if end function +pure logical function MV_IsLoad(Var) + type(ModVarType), intent(in) :: Var + MV_IsLoad = Var%Field == FieldForce .or. Var%Field == FieldMoment +end function + !------------------------------------------------------------------------------- ! Flag Utilities !------------------------------------------------------------------------------- @@ -984,7 +989,7 @@ subroutine MV_SetFlags(Var, Flags) Var%Flags = ior(Var%Flags, Flags) end subroutine -subroutine MV_UnsetFlags(Var, Flags) +subroutine MV_ClearFlags(Var, Flags) type(ModVarType), intent(inout) :: Var integer(IntKi), intent(in) :: Flags integer(IntKi) :: i diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 592016c723..74d9cd2aa6 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -116,13 +116,15 @@ MODULE NWTC_Library_Types ! ========= ModVarType ======= TYPE, PUBLIC :: ModVarType character(VarNameLen) :: Name !< [-] + INTEGER(IntKi) :: iMod = 0 !< Module index [-] + INTEGER(IntKi) :: iVar = 0 !< Variable index [-] INTEGER(IntKi) :: Field = 0 !< [-] INTEGER(IntKi) :: Nodes = 1 !< [-] INTEGER(IntKi) :: Num = 1 !< [-] INTEGER(IntKi) :: Flags = 0 !< [-] INTEGER(IntKi) :: DerivOrder = 0 !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0_IntKi !< indices in local arrays [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0 !< indices in local arrays [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0 !< first user defined index for variable, can be used a lower/upper bounds [-] INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] REAL(R8Ki) :: Perturb = 0 !< perturbation amount for linearization [-] @@ -599,6 +601,8 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr ErrStat = ErrID_None ErrMsg = '' DstModVarTypeData%Name = SrcModVarTypeData%Name + DstModVarTypeData%iMod = SrcModVarTypeData%iMod + DstModVarTypeData%iVar = SrcModVarTypeData%iVar DstModVarTypeData%Field = SrcModVarTypeData%Field DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes DstModVarTypeData%Num = SrcModVarTypeData%Num @@ -641,6 +645,8 @@ subroutine NWTC_Library_PackModVarType(RF, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarType' if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Name) + call RegPack(RF, InData%iMod) + call RegPack(RF, InData%iVar) call RegPack(RF, InData%Field) call RegPack(RF, InData%Nodes) call RegPack(RF, InData%Num) @@ -664,6 +670,8 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Field); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nodes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 5249bcbe22..cbb1c3a661 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -76,13 +76,15 @@ param ^ - IntKi VC_Option1 - 2 - param ^ - IntKi VC_Option2 - 3 - "" - typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi iMod - 0 - "Module index" - +typedef ^ ^ IntKi iVar - 0 - "Variable index" - typedef ^ ^ IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iLoc 2 - - "indices in local arrays" - -typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - +typedef ^ ^ IntKi iLoc 2 0 - "indices in local arrays" - +typedef ^ ^ IntKi iUsr 2 0 - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index aa2089cf8a..003305ff72 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -76,13 +76,15 @@ param ^ - IntKi VC_Option1 - 2 - param ^ - IntKi VC_Option2 - 3 - "" - typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi iMod - 0 - "Module index" - +typedef ^ ^ IntKi iVar - 0 - "Variable index" - typedef ^ ^ IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iLoc 2 - - "indices in local arrays" - -typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - +typedef ^ ^ IntKi iLoc 2 0 - "indices in local arrays" - +typedef ^ ^ IntKi iUsr 2 0 - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 0ac4b5a079..676d03af12 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -75,10 +75,10 @@ add_library(openfast_postlib STATIC # src/FAST_SS_Solver.f90 src/FAST_Funcs.f90 + src/FAST_ModData.f90 src/FAST_ModGlue.f90 src/FAST_Mapping.f90 - src/FAST_Idx.f90 - # src/FAST_AeroMap.f90 + src/FAST_AeroMap.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 1934b64ed5..ed5d5fd21d 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -20,22 +20,23 @@ module FAST_AeroMap -use FAST_Types +use FAST_ModData use FAST_ModTypes +use FAST_Types use FAST_Funcs -use FAST_Idx +use FAST_Mapping use FAST_Subs implicit none ! Define array of module IDs used in AeroMap -integer(IntKi), parameter :: AeroMapModIDs(*) = [Module_ED, Module_BD, Module_AD] +integer(IntKi), parameter :: AeroMapModIDs(*) = [Module_ED, Module_BD, Module_AD] -real(DbKi), parameter :: SS_t_global = 0.0_DbKi -real(DbKi), parameter :: UJacSclFact_x = 1.0d3 +real(DbKi), parameter :: SS_t_global = 0.0_DbKi +real(DbKi), parameter :: UJacSclFact_x = 1.0d3 -logical, parameter :: output_debugging = .false. +logical, parameter :: output_debugging = .true. contains @@ -52,7 +53,7 @@ subroutine FAST_RunSteadyStateDriver(Turbine) ProgName = TRIM(FAST_Ver%Name)//' Aero Map' FAST_Ver%Name = ProgName - call FAST_AeroMapDriver(Turbine, ErrStat, ErrMsg) + call FAST_AeroMapDriver(Turbine%m_Glue, Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, Turbine, ErrStat, ErrMsg) call CheckError(ErrStat, ErrMsg, 'FAST_AeroMapDriver') call ExitThisProgram_T(Turbine, ErrID_None, .true.) @@ -71,23 +72,30 @@ subroutine CheckError(ErrID, Msg, SimMsg) end subroutine CheckError end subroutine -subroutine FAST_AeroMapDriver(Turbine, ErrStat, ErrMsg) +subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) use InflowWind_IO, only: IfW_SteadyFlowField_Init - type(FAST_TurbineType), intent(inout) :: Turbine !< all data for one instance of a turbine - character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi), intent(out) :: ErrStat !< Error status of the operation - - character(*), parameter :: RoutineName = 'FAST_AeroMapDriver' - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: ErrStat2 - logical, parameter :: CompAeroMaps = .true. - real(DbKi), parameter :: t_initial = 0.0_DbKi - integer(IntKi), allocatable :: modIDs(:), modIdx(:), iModOrder(:) - integer(IntKi) :: i - integer(IntKi) :: JacSize - real(R8Ki), allocatable :: Jmat(:, :) - integer(IntKi), allocatable :: JacPivot(:) - type(VarsIdxType) :: AeroMapIdx + type(Glue_MiscVarType), intent(inout) :: m !< MiscVars for the glue code + type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters for the glue code + type(FAST_OutputFileType), intent(inout) :: y_FAST !< Output variables for the glue code + type(FAST_MiscVarType), intent(inout) :: m_FAST + type(FAST_TurbineType), intent(inout) :: T !< all data for one instance of a turbine + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + + character(*), parameter :: RoutineName = 'FAST_AeroMapDriver' + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: ErrStat2 + logical, parameter :: CompAeroMaps = .true. + real(DbKi), parameter :: t_initial = 0.0_DbKi + integer(IntKi), allocatable :: modIDs(:), modIdx(:), iModOrder(:) + integer(IntKi) :: i + integer(IntKi) :: JacSize + integer(IntKi) :: n_case !< loop counter + real(DbKi) :: n_global + real(ReKi), allocatable :: UnusedAry(:) + type(AeroMapCase) :: CaseDataTmp ! tsr, windSpeed, pitch, and rotor speed for this case (to try a different operating point first) + integer(IntKi) :: NStatus + character(MaxWrScrLen), parameter :: BlankLine = " " ErrStat = ErrID_None ErrMsg = '' @@ -96,90 +104,167 @@ subroutine FAST_AeroMapDriver(Turbine, ErrStat, ErrMsg) ! Initialization !---------------------------------------------------------------------------- - Turbine%TurbID = 1 + ! Set Turbine ID + T%TurbID = 1 + + ! Initialize linearization file number (will be incremented before use) + m%AM%LinFileNum = 0 ! Standard Turbine initialization - call FAST_InitializeAll(t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, & - Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, & - Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, & - Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg) + call FAST_InitializeAll(t_initial, T%m_Glue, T%p_FAST, T%y_FAST, T%m_FAST, & + T%ED, T%BD, T%SrvD, T%AD14, T%AD, & + T%ExtLd, T%IfW, T%ExtInfw, T%SC_DX, & + T%SeaSt, T%HD, T%SD, T%ExtPtfm, T%MAP, & + T%FEAM, T%MD, T%Orca, T%IceF, T%IceD, & + T%MeshMapData, CompAeroMaps, ErrStat2, ErrMsg2) + if (Failed()) return + + ! TODO: Move into FAST_InitializeAll + ! Initialize module data transfer mappings + call FAST_InitMappings(m%Modules, m%Mappings, T, ErrStat2, ErrMsg2) + if (Failed()) return ! Initialize steady flow field in AeroDyn - call IfW_SteadyFlowField_Init(Turbine%AD%p%FlowField, & + call IfW_SteadyFlowField_Init(T%AD%p%FlowField, & RefHt=100.0_ReKi, HWindSpeed=8.0_ReKi, PLExp=0.0_ReKi, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Modules + !---------------------------------------------------------------------------- + + ! Initialize module indices + m%AM%iModED = 0 + m%AM%iModBD = 0 + m%AM%iModAD = 0 + + ! Get indices of modules that are used by Aero Mapping (first instance only) + call GetModuleOrder(m%Modules, AeroMapModIDs, m%AM%iModOrder) + do i = 1, size(m%AM%iModOrder) + associate (ModData => m%Modules(m%AM%iModOrder(i))) + if (ModData%Ins == 1) then + select case (ModData%ID) + case (Module_ED) + m%AM%iModED = i + case (Module_BD) + m%AM%iModBD = i + case (Module_AD) + m%AM%iModAD = i + end select + end if + end associate + end do + + ! If BeamDyn is active + if (m%AM%iModBD > 0) then + m%AM%iModED = 0 + m%AM%iModOrder = [m%AM%iModBD, m%AM%iModAD] + else if (m%AM%iModED > 0) then + m%AM%iModOrder = [m%AM%iModED, m%AM%iModAD] + end if - ! Get indices of Mods that are used by Aero Mapping - call GetModuleOrder(Turbine%y_FAST%Modules, AeroMapModIDs, iModOrder) + ! Loop through module indices, copy states and inputs + do i = 1, size(m%AM%iModOrder) + associate (ModData => m%Modules(m%AM%iModOrder(i))) - ! Loop through module data indices - do i = 1, size(iModOrder) + ! Copy current state to predicted state + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return - ! Copy current state to predicted state - call FAST_CopyStates(Turbine%y_FAST%Modules(iModOrder(i)), Turbine, STATE_CURR, STATE_PRED, MESH_NEWCOPY, & - ErrStat2, ErrMsg2); if (Failed()) return + ! Copy current inputs to previous inputs + call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return - ! Copy inputs to second index - call FAST_CopyInput(Turbine%y_FAST%Modules(iModOrder(i)), Turbine, 0.0_DbKi, iSrc=1, iDst=2, CtrlCode=MESH_NEWCOPY, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + ! If linearization is enabled, set lin file module abbreviation for file name + ! If module is BeamDyn or more than one instance, append instance number to abbreviation + if ((ModData%ID == Module_BD) .or. (count(m%Modules%ID == ModData%ID) > 1)) then + ModData%Lin%Abbr = trim(ModData%Abbr)//Num2LStr(ModData%Ins) + else + ModData%Lin%Abbr = ModData%Abbr + end if + + end associate end do + !---------------------------------------------------------------------------- + ! Build AeroMap module + !---------------------------------------------------------------------------- + ! Generate index for variables with AeroMap flag - call Idx_Init(Turbine%y_FAST%Modules, iModOrder, AeroMapIdx, VF_AeroMap, ErrStat2, ErrMsg2); if (Failed()) return + call ModD_CombineModules(m%Modules, m%AM%iModOrder, VF_AeroMap, .true., m%AM%Mod, ErrStat2, ErrMsg2) + if (Failed()) return - ! Jacobian size is number of states plus number of inputs - JacSize = AeroMapIdx%Nx + AeroMapIdx%Nu + !---------------------------------------------------------------------------- + ! Allocation + !---------------------------------------------------------------------------- - ! Allocate Jacobian matrix - call AllocAry(Jmat, JacSize, JacSize, 'Jmat', ErrStat2, ErrMsg2); if (Failed()) return + ! Allocate components of the Jacobian matrix + call AllocAry(m%AM%Jac11, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Nx, 'Jac11', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Jac12, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Nu, 'Jac12', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Jac21, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Nx, 'Jac21', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Jac22, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Nu, 'Jac22', ErrStat2, ErrMsg2); if (Failed()) return + + ! Jacobian size is number of states plus number of inputs + JacSize = m%AM%Mod%Vars%Nx + m%AM%Mod%Vars%Nu ! Allocate Jacobian pivot vector - call AllocAry(JacPivot, JacSize, 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%JacPivot, JacSize, 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2); if (Failed()) return - !---------------------------------------------------------------------------- - ! Calculate steady-state solutions: - !---------------------------------------------------------------------------- + ! Storage for residual and solution delta + call AllocAry(m%AM%Residual, JacSize, 'Residual', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%SolveDelta, JacSize, 'SolveDelta', ErrStat2, ErrMsg2); if (Failed()) return - call FAST_SteadyState(Turbine%y_FAST%Modules, iModOrder, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + ! Allocate Jacobian matrix + call AllocAry(m%AM%Mod%Lin%J, JacSize, JacSize, 'J', ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate Idx Jacobian storage + call AllocAry(m%AM%Mod%Lin%dYdu, m%AM%Mod%Vars%Ny, m%AM%Mod%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%dXdu, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%dYdx, m%AM%Mod%Vars%Ny, m%AM%Mod%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%dXdx, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%dXdy, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Ny, 'dXdy', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%dUdu, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%dUdy, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate operating point arrays + if (output_debugging) then + call AllocAry(m%AM%Mod%Lin%x, m%AM%Mod%Vars%Nx, 'x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%dx, m%AM%Mod%Vars%Nx, 'dx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%u, m%AM%Mod%Vars%Nu, 'u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%y, m%AM%Mod%Vars%Ny, 'y', ErrStat2, ErrMsg2); if (Failed()) return + end if -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine + ! Allocate arrays to store inputs + call AllocAry(m%AM%u1, m%AM%Mod%Vars%Nu, 'u1', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%u2, m%AM%Mod%Vars%Nu, 'u2', ErrStat2, ErrMsg2); if (Failed()) return -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -subroutine FAST_SteadyState(Mods, ModOrder, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: Mods(:) - integer(IntKi), intent(in) :: ModOrder(:) - type(FAST_ParameterType), intent(IN) :: p_FAST !< Parameters for the glue code - type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Output variables for the glue code - type(FAST_MiscVarType), intent(INOUT) :: m_FAST - type(FAST_TurbineType), intent(inout) :: T !< all data for one instance of a turbine - integer(IntKi), intent(out) :: ErrStat !< Error status of the operation - character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Move hub orientation matrices to AeroMap structure + call move_alloc(T%MeshMapData%HubOrient, m%AM%HubOrientation) - integer(IntKi) :: n_case !< loop counter - real(DbKi) :: n_global - real(ReKi), allocatable :: UnusedAry(:) - real(R8Ki), allocatable :: Jmat(:, :) - type(FAST_SS_CaseType) :: CaseData ! tsr, windSpeed, pitch, and rotor speed for this case - type(FAST_SS_CaseType) :: caseData_try2 ! tsr, windSpeed, pitch, and rotor speed for this case (to try a different operating point first) + ! Allocate cases + allocate (m%AM%Cases(p_FAST%NumSSCases), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating AeroMap cases", ErrStat, ErrMsg, RoutineName) + return + end if - character(*), parameter :: RoutineName = 'FAST_SteadyState' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMSg2 - integer(IntKi) :: NStatus - character(MaxWrScrLen), parameter :: BlankLine = " " + ! Populate case data + do n_case = 1, p_FAST%NumSSCases + if (p_FAST%WindSpeedOrTSR == 1) then + m%AM%Cases(n_case)%WindSpeed = p_FAST%WS_TSR(n_case) + m%AM%Cases(n_case)%TSR = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/m%AM%Cases(n_case)%WindSpeed + else + m%AM%Cases(n_case)%TSR = p_FAST%WS_TSR(n_case) + m%AM%Cases(n_case)%WindSpeed = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/m%AM%Cases(n_case)%TSR + end if + m%AM%Cases(n_case)%Pitch = p_FAST%Pitch(n_case) + m%AM%Cases(n_case)%RotSpeed = p_FAST%RotSpeed(n_case) + end do - ErrStat = ErrID_None - ErrMsg = "" + !---------------------------------------------------------------------------- + ! Calculate steady-state solution for each case + !---------------------------------------------------------------------------- ! how often do we inform the user which case we are on? NStatus = min(100, p_FAST%NumSSCases/100 + 1) ! at least 100 every 100 cases or 100 times per simulation @@ -193,40 +278,29 @@ subroutine FAST_SteadyState(Mods, ModOrder, p_FAST, y_FAST, m_FAST, T, ErrStat, call WrOver(' Case '//trim(Num2LStr(n_case))//' of '//trim(Num2LStr(p_FAST%NumSSCases))) end if - ! Populate case data - if (p_FAST%WindSpeedOrTSR == 1) then - CaseData%WindSpeed = p_FAST%WS_TSR(n_case) - CaseData%TSR = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/CaseData%WindSpeed - else - CaseData%TSR = p_FAST%WS_TSR(n_case) - CaseData%WindSpeed = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/CaseData%TSR - end if - CaseData%Pitch = p_FAST%Pitch(n_case) - CaseData%RotSpeed = p_FAST%RotSpeed(n_case) - ! Call steady-state solve for this pitch and rotor speed - call SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + call SolveSteadyState(m, m%AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T%MeshMapData, T, ErrStat2, ErrMsg2) ! we didn't converge; let's try a different operating point and see if that helps: if (ErrStat2 >= ErrID_Severe) then ! Create copy of case data for second attempt - caseData_try2 = CaseData + CaseDataTmp = m%AM%Cases(n_case) ! Modify pitch, TSR, and WindSpeed - caseData_try2%Pitch = caseData_try2%Pitch*0.5_ReKi - caseData_try2%TSR = caseData_try2%TSR*0.5_ReKi - caseData_try2%WindSpeed = caseData_try2%WindSpeed*0.5_ReKi + CaseDataTmp%Pitch = CaseDataTmp%Pitch*0.5_ReKi + CaseDataTmp%TSR = CaseDataTmp%TSR*0.5_ReKi + CaseDataTmp%WindSpeed = CaseDataTmp%WindSpeed*0.5_ReKi ! Write message about retrying case call WrScr('Retrying case '//trim(Num2LStr(n_case))//', first trying to get a better initial guess. Average error is '// & trim(Num2LStr(y_FAST%DriverWriteOutput(SS_Indx_Err)))//'.') - call SolveSteadyState(Mods, ModOrder, caseData_try2, Jmat, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + ! call SolveSteadyState(m, CaseDataTmp, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) ! if that worked, try the real case again: if (ErrStat2 < AbortErrLev) then - call SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + ! call SolveSteadyState(m, m%AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) call WrOver(BlankLine) end if @@ -234,10 +308,10 @@ subroutine FAST_SteadyState(Mods, ModOrder, p_FAST, y_FAST, m_FAST, T, ErrStat, if (ErrStat2 > ErrID_None) then ErrMsg2 = trim(ErrMsg2)//" case "//trim(Num2LStr(n_case))// & - ' (tsr='//trim(Num2LStr(CaseData%tsr))// & - ', wind speed='//trim(Num2LStr(CaseData%windSpeed))//' m/s'// & - ', pitch='//trim(num2lstr(CaseData%pitch*R2D))//' deg'// & - ', rotor speed='//trim(num2lstr(CaseData%RotSpeed*RPS2RPM))//' rpm)' + ' (tsr='//trim(Num2LStr(m%AM%Cases(n_case)%tsr))// & + ', wind speed='//trim(Num2LStr(m%AM%Cases(n_case)%windSpeed))//' m/s'// & + ', pitch='//trim(num2lstr(m%AM%Cases(n_case)%pitch*R2D))//' deg'// & + ', rotor speed='//trim(num2lstr(m%AM%Cases(n_case)%RotSpeed*RPS2RPM))//' rpm)' call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if @@ -270,35 +344,27 @@ logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function -end subroutine FAST_SteadyState +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the Input-Output solve for the steady-state solver. !! Note that this has been customized for the physics in the problems and is not a general solution. -subroutine SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, Turbine, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: Mods(:) - integer(IntKi), intent(in) :: ModOrder(:) - type(FAST_SS_CaseType), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - real(R8Ki), intent(INOUT) :: Jmat(:, :) !< temporary storage space for jacobian matrix - type(FAST_ParameterType), intent(IN) :: p_FAST !< Glue-code simulation parameters - type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Glue-code output file values - type(FAST_MiscVarType), intent(INOUT) :: m_FAST !< Miscellaneous variables - type(ElastoDyn_Data), intent(INOUT) :: ED !< ElastoDyn data - type(BeamDyn_Data), intent(INOUT) :: BD !< BeamDyn data - type(AeroDyn_Data), intent(INOUT) :: AD !< AeroDyn data - type(FAST_TurbineType), intent(inout) :: Turbine - type(FAST_ModuleMapType), intent(INOUT) :: MeshMapData !< data for mapping meshes between modules - integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation - character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None +subroutine SolveSteadyState(m, caseData, p_FAST, y_FAST, m_FAST, MeshMapData, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + type(FAST_ParameterType), intent(in) :: p_FAST !< Glue-code simulation parameters + type(FAST_OutputFileType), intent(inout) :: y_FAST !< Glue-code output file values + type(FAST_MiscVarType), intent(inout) :: m_FAST !< Miscellaneous variables + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + type(FAST_ModuleMapType), intent(inout) :: MeshMapData !< data for mapping meshes between modules + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None character(*), parameter :: RoutineName = 'SolveSteadyState' - integer(IntKi) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None !bjj: store these so that we don't reallocate every time? - real(R8Ki) :: u(p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules - real(R8Ki) :: u_delta(p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules - real(R8Ki) :: Fn_U_Resid(p_FAST%SizeJac_Opt1(1)) ! Residual of U real(R8Ki) :: err real(R8Ki) :: err_prev real(R8Ki), parameter :: reduction_factor = 0.1_R8Ki @@ -322,11 +388,16 @@ subroutine SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FA !---------------------------------------------------------------------------- ! Set the rotor speed in ElastoDyn - ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed + T%ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed - call SteadyStatePrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) - call CopyStatesInputs(p_FAST, ED, BD, AD, ErrStat2, ErrMsg2, MESH_UPDATECOPY) ! COPY the inputs to the temp copy (so we get updated input values) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Update module inputs + call SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD) + do i = 1, size(m%AM%iModOrder) + associate (ModData => m%Modules(m%AM%iModOrder(i))) + call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end associate + end do K = 0 err = 1.0E3 @@ -349,81 +420,64 @@ subroutine SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FA ! Set GetWriteOutput flag true if not the first iteration GetWriteOutput = K > 0 - ! Loop through modules in order - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) + !----------------------------------------- + ! Caclulate ElastoDyn / BeamDyn output + !----------------------------------------- - !------------------------------------------------------------------- - ! ElastoDyn / BeamDyn CalcOutput - !------------------------------------------------------------------- + ! If BeamDyn is active + if (m%AM%iModBD > 0) then - ! If ElastoDyn blades and module is ED or BeamDyn Blades and module is BD and 1st blade, calculate output - if (((p_FAST%CompElast == Module_ED) .and. (ModData%ID == Module_ED)) .or. & - ((p_FAST%CompElast == Module_BD) .and. (ModData%ID == Module_BD) .and. (ModData%Ins == 1))) then + ! Calculate BeamDyn output + call FAST_CalcOutput(m%Modules(m%AM%iModBD), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_CalcOutput(ModData, m_FAST%ModLin%Mappings, SS_t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if + else - !------------------------------------------------------------------- - ! AeroDyn InputSolve - !------------------------------------------------------------------- - - ! If module is AD (assumes AD comes after ED/BD in ModOrder) - if (ModData%ID == Module_AD) then - - ! If first iteration - if (K == 0) then - - ! Perform AeroDyn input solve to get initial guess from structural module - ! (this ensures that the pitch is accounted for in the fixed aero-map solve:): - call FAST_InputSolve(ModData, Mods, m_FAST%ModLin%Mappings, Turbine, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Prescribe AeroDyn blade motion inputs on first blade: - Turbine%AD%u%rotors(1)%BladeMotion(1)%RotationVel = 0.0_ReKi - Turbine%AD%u%rotors(1)%BladeMotion(1)%TranslationAcc = 0.0_ReKi - - ! Initialize AeroDyn blade motion from blade 1 to remaining blades - ! adjusting for hub orientation - do k = 2, size(Turbine%AD%u%rotors(1)%BladeMotion) - do j = 1, Turbine%AD%u%rotors(1)%BladeMotion(k)%NNodes - Turbine%AD%u%rotors(1)%BladeMotion(k)%TranslationDisp(:, j) = matmul(Turbine%AD%u%rotors(1)%BladeMotion(1)%TranslationDisp(:, j), MeshMapData%HubOrient(:, :, k)) - Turbine%AD%u%rotors(1)%BladeMotion(k)%Orientation(:, :, j) = matmul(Turbine%AD%u%rotors(1)%BladeMotion(1)%Orientation(:, :, j), MeshMapData%HubOrient(:, :, k)) - Turbine%AD%u%rotors(1)%BladeMotion(k)%TranslationVel(:, j) = matmul(Turbine%AD%u%rotors(1)%BladeMotion(1)%TranslationVel(:, j), MeshMapData%HubOrient(:, :, k)) - end do - end do + ! Calculate ElastoDyn output + call FAST_CalcOutput(m%Modules(m%AM%iModED), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !---------------------------------------------------------------------------------------------------- - ! set up x-u vector, using local initial guesses: - !---------------------------------------------------------------------------------------------------- - call Create_SS_Vector(p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR) + end if - end if ! K == 0 + !----------------------------------------- + ! AeroDyn InputSolve + !----------------------------------------- - ! Calculate AeroDyn Output - call FAST_CalcOutput(ModData, m_FAST%ModLin%Mappings, SS_t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call ResetInputsAndStates() - return - end if + ! If first iteration + if (K == 0) then - end if ! ModData%ID == Module_AD + ! Perform AeroDyn input solve to get initial guess from structural module + ! (this ensures that the pitch is accounted for in the fixed aero-map solve:): + call SS_AD_InputSolve(m, INPUT_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_AD_InputSolve_OtherBlades(m, INPUT_CURR, T) - end associate - end do + ! set up x-u vector, using local initial guesses + call SS_GetInputs(m, m%AM%u1, p_FAST%UJacSclFact, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + + end if + + !----------------------------------------- + ! Calculate AeroDyn Output + !----------------------------------------- + + call FAST_CalcOutput(m%Modules(m%AM%iModAD), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call ResetInputsAndStates() + return + end if ! If iteration is at or above maximum iteration, exit loop if (K >= MaxIter) exit !------------------------------------------------------------------------------------------------- - ! Calculate residual and the Jacobian: + ! Calculate residual and the Jacobian ! (note that we don't want to change module%Input(1), here) ! Also, the residual uses values from y_FAST, so do this before calculating the jacobian !------------------------------------------------------------------------------------------------- - call SteadyStateSolve_Residual(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, u, Fn_U_Resid, ErrStat2, ErrMsg2) + call SS_BuildResidual(caseData, m, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) then call ResetInputsAndStates() @@ -432,25 +486,12 @@ subroutine SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FA ! If Jacobian needs to be recalculated if (mod(K, p_FAST%N_UJac) == 0) then - - - call FormSteadyStateJacobian(caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call Precondition_Jmat(p_FAST, y_FAST, Jmat) - - ! Get the LU decomposition of this matrix using a LAPACK routine: - ! The result is of the form Jmat = P * L * U - - call LAPACK_getrf(M=size(Jmat, 1), N=size(Jmat, 2), & - A=Jmat, IPIV=MeshMapData%Jacobian_pivot, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) then call ResetInputsAndStates() return end if - end if !------------------------------------------------------------------------- @@ -458,19 +499,29 @@ subroutine SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FA ! using the LAPACK routine !------------------------------------------------------------------------- - u_delta = -Fn_U_Resid - call LAPACK_getrs(TRANS="N", N=SIZE(Jmat, 1), A=Jmat, & - IPIV=MeshMapData%Jacobian_pivot, B=u_delta, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + ! Copy negative of residual into solve + m%AM%SolveDelta = -m%AM%Residual + + ! Solve for changes in states and inputs + call LAPACK_getrs(TRANS="N", N=size(m%AM%Mod%Lin%J, 1), A=m%AM%Mod%Lin%J, & + IPIV=m%AM%JacPivot, B=m%AM%SolveDelta, ErrStat=ErrStat2, ErrMsg=ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return !------------------------------------------------------------------------- - ! check for error, update inputs if necessary, and iterate again + ! Check for error, update inputs if necessary, and iterate again !------------------------------------------------------------------------- + + ! Save previous error err_prev = err - err = DOT_PRODUCT(u_delta, u_delta) - y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/p_FAST%SizeJac_Opt1(1) + ! Calculate new error + err = dot_product(m%AM%SolveDelta, m%AM%SolveDelta) + + ! Store normalized error in output + y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/size(m%AM%Mod%Lin%J, 1) + + ! If error is below tolerance if (err <= p_FAST%TolerSquared) then if (K == 0) then ! the error will be incorrect in this instance, but the outputs will be better MaxIter = K @@ -483,28 +534,31 @@ subroutine SolveSteadyState(Mods, ModOrder, caseData, Jmat, p_FAST, y_FAST, m_FA if (K > 5 .and. err > 1.0E35) exit ! this is obviously not converging. Let's try something else. !------------------------------------------------------------------------- - ! modify inputs and states for next iteration + ! Modify inputs and states for next iteration !------------------------------------------------------------------------- + + ! If current error is greater than previous error (solution diverging), + ! reduce delta (take a smaller step) if (err > err_prev) then - u_delta = u_delta*reduction_factor ! don't take a full step if we're getting farther from the solution! + m%AM%SolveDelta = m%AM%SolveDelta*reduction_factor err_prev = err_prev*reduction_factor end if - call Add_SteadyState_delta(p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData) + ! ! call Add_SteadyState_delta(p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData) - !u = u + u_delta - call Create_SS_Vector(p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR) + ! !u = u + u_delta + ! call SS_GetInputs(m, T, p_FAST%UJacSclFact, INPUT_CURR, STATE_CURR, ErrStat2, ErrMsg2) - K = K + 1 - y_FAST%DriverWriteOutput(SS_Indx_Iter) = k + ! K = K + 1 + ! y_FAST%DriverWriteOutput(SS_Indx_Iter) = k end do ! K - if (p_FAST%CompElast == Module_BD) then - ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: - call ED_CalcOutput(SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if + ! if (p_FAST%CompElast == Module_BD) then + ! ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: + ! call ED_CalcOutput(SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! end if call ResetInputsAndStates() @@ -523,14 +577,13 @@ subroutine ResetInputsAndStates() ! roundoff can lead to non-zero values with the method below, which is most useful for states) if (p_FAST%CompElast == Module_BD) then do K = 1, p_FAST%nBeams - BD%Input(1, k)%DistrLoad%Force = 0.0_ReKi - BD%Input(1, k)%DistrLoad%Moment = 0.0_ReKi + T%BD%Input(1, k)%DistrLoad%Force = 0.0_ReKi + T%BD%Input(1, k)%DistrLoad%Moment = 0.0_ReKi end do - end if - call Create_SS_Vector(p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR) ! find the values we have been modifying (in u... continuous states and inputs) - call Add_SteadyState_delta(p_FAST, y_FAST, -u, AD, ED, BD, MeshMapData) ! and reset them to 0 (by adding -u) + call SS_GetInputs(m, m%AM%u1, p_FAST%UJacSclFact, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) ! find the values we have been modifying (in u... continuous states and inputs) + ! call Add_SteadyState_delta(p_FAST, y_FAST, -u, AD, ED, BD, MeshMapData) ! and reset them to 0 (by adding -u) end if end if @@ -538,16 +591,711 @@ end subroutine ResetInputsAndStates end subroutine SolveSteadyState +subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + type(FAST_ParameterType), intent(IN) :: p_FAST !< Parameters for the glue code + type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Output variables for the glue code + type(FAST_MiscVarType), intent(INOUT) :: m_FAST !< Miscellaneous variables + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_BuildJacobian' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMSg2 + character(1024) :: LinRootName + integer(IntKi) :: i, j, k, c, r, iRow(2), iCol(2) + integer(IntKi) :: nx ! Number of states + integer(IntKi) :: Un + + ErrStat = ErrID_None + ErrMsg = "" + + ! Set number of states + nx = m%AM%Mod%Vars%Nx + + ! If output debugging is requested + if (output_debugging) then + + ! Get unit number for output files + call GetNewUnit(Un, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Build linearization root name + m%AM%LinFileNum = m%AM%LinFileNum + 1 + LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(m%AM%LinFileNum)) + + ! These values get printed in the linearization output files, so we'll set them here: + y_FAST%Lin%WindSpeed = caseData%WindSpeed + y_FAST%Lin%RotSpeed = caseData%RotSpeed + y_FAST%Lin%Azimuth = 0.0_ReKi + end if + + ! Initialize Jacobian + m%AM%Mod%Lin%J = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! dXdy + !---------------------------------------------------------------------------- + + m%AM%Mod%Lin%dXdy = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! Module Jacobians + !---------------------------------------------------------------------------- + + ! Loop through modules + do i = 1, size(m%AM%iModOrder) + associate (ModData => m%Modules(m%AM%iModOrder(i)), iMod => m%AM%iModOrder(i)) + + ! Calculate dYdu and dXdu + call FAST_JacobianPInput(ModData, SS_t_global, STATE_CURR, T, ErrStat, ErrMsg, & + FlagFilter=VF_AeroMap, dYdu=ModData%Lin%dYdu, dXdu=ModData%Lin%dXdu) + if (Failed()) return + + ! Calculate dYdx and dXdx + call FAST_JacobianPContState(ModData, SS_t_global, STATE_CURR, T, ErrStat, ErrMsg, & + FlagFilter=VF_AeroMap, dYdx=ModData%Lin%dYdx, dXdx=ModData%Lin%dXdx) + if (Failed()) return + + ! If output debugging requested + if (output_debugging) then + + ! Calculate operating point values + call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, y_op=ModData%Lin%y, x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) + if (Failed()) return + + ! Write linearization matrices + call CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, SS_t_global, Un, LinRootName, VF_AeroMap, .false., ErrStat2, ErrMsg2) + if (Failed()) return + + ! Pack values into module + if (allocated(ModData%Lin%x)) call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, ModData%Lin%x, m%AM%Mod%Lin%x) + if (allocated(ModData%Lin%dx)) call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, ModData%Lin%dx, m%AM%Mod%Lin%dx) + if (allocated(ModData%Lin%u)) call ModD_PackAry(m%AM%Mod%Xfr(iMod)%u, ModData%Lin%u, m%AM%Mod%Lin%u) + if (allocated(ModData%Lin%y)) call ModD_PackAry(m%AM%Mod%Xfr(iMod)%y, ModData%Lin%y, m%AM%Mod%Lin%y) + + end if + + ! If this module is BeamDyn, calculate dxdotdy + if (ModData%ID == Module_BD) then + + ! TODO: implement beamdyn + ! NOTE that this implies that the FEA nodes (states) are the same as the output nodes!!!! (note that we have overlapping nodes at the element end points) + ! r = 1 + ! do i = 2, BD%p(k)%node_total ! the first node isn't technically a state + ! c = (BD%p(k)%NdIndx(i) - 1)*3 + 1 ! BldMeshNode = BD%p(k)%NdIndx(i) + + ! !dxdotdy(r:r+2,c:c+2) = SkewSymMat( [p_FAST%RotSpeed, 0.0_ReKi, 0.0_ReKi] ) + ! dxdotdy(r + 2, c + 1) = caseData%RotSpeed + ! dxdotdy(r + 1, c + 2) = -caseData%RotSpeed + + ! ! derivative + ! dxdotdy(r + nx + 1, c + 1) = -OmegaSquared + ! dxdotdy(r + nx + 2, c + 2) = -OmegaSquared + + ! r = r + BD%p(k)%dof_node + ! end do + end if + + ! Add module Jacobians to global Jacobians + if (allocated(ModData%Lin%dYdu)) call ModD_PackMatrix(m%AM%Mod%Xfr(iMod)%y, m%AM%Mod%Xfr(iMod)%u, ModData%Lin%dYdu, m%AM%Mod%Lin%dYdu) + if (allocated(ModData%Lin%dXdu)) call ModD_PackMatrix(m%AM%Mod%Xfr(iMod)%x, m%AM%Mod%Xfr(iMod)%u, ModData%Lin%dXdu, m%AM%Mod%Lin%dXdu) + if (allocated(ModData%Lin%dYdx)) call ModD_PackMatrix(m%AM%Mod%Xfr(iMod)%y, m%AM%Mod%Xfr(iMod)%x, ModData%Lin%dYdx, m%AM%Mod%Lin%dYdx) + if (allocated(ModData%Lin%dXdx)) call ModD_PackMatrix(m%AM%Mod%Xfr(iMod)%x, m%AM%Mod%Xfr(iMod)%x, ModData%Lin%dXdx, m%AM%Mod%Lin%dXdx) + + end associate + end do + + !---------------------------------------------------------------------------- + ! Glue Jacobians + !---------------------------------------------------------------------------- + + m%AM%Mod%Lin%dUdy = 0.0_R8Ki + call Eye2D(m%AM%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_LinearizeMappings(T, m%Modules, m%Mappings, m%AM%iModOrder, m%AM%Mod%Xfr, ErrStat2, ErrMsg2, & + m%AM%Mod%Lin%dUdu, m%AM%Mod%Lin%dUdy) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Form Jacobian matrix + !---------------------------------------------------------------------------- + + ! Calculate Jacobian block 11 = dX/dx - dX/dy * dY/dx + m%AM%Jac11 = m%AM%Mod%Lin%dXdx + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, m%AM%Mod%Lin%dXdy, m%AM%Mod%Lin%dYdx, 1.0_R8Ki, m%AM%Jac11, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate Jacobian block 12 = dX/du - dX/dy * dY/du + m%AM%Jac12 = m%AM%Mod%Lin%dXdu + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, m%AM%Mod%Lin%dXdy, m%AM%Mod%Lin%dYdu, 1.0_R8Ki, m%AM%Jac12, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate Jacobian block 21 = dU/dy * dY/dx + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%AM%Mod%Lin%dUdy, m%AM%Mod%Lin%dYdx, 0.0_R8Ki, m%AM%Jac21, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate Jacobian block 22 = dU/du + dU/dy * dY/du + m%AM%Jac22 = m%AM%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%AM%Mod%Lin%dUdy, m%AM%Mod%Lin%dYdu, 1.0_R8Ki, m%AM%Jac22, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Assemble blocks to form full Jacobian + m%AM%Mod%Lin%J(:nx, :nx) = m%AM%Jac11 + m%AM%Mod%Lin%J(:nx, nx + 1:) = m%AM%Jac12 + m%AM%Mod%Lin%J(nx + 1:, :nx) = m%AM%Jac21 + m%AM%Mod%Lin%J(nx + 1:, nx + 1:) = m%AM%Jac22 + + ! If output debugging is enabled, write combined matrices and Jacobian + if (output_debugging) then + call CalcWriteLinearMatrices(m%AM%Mod, p_FAST, y_FAST, SS_t_global, Un, LinRootName, VF_AeroMap, .false., ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! Condition Jacobian matrix + !---------------------------------------------------------------------------- + + ! Loop through inputs + do c = 1, size(m%AM%Mod%Vars%u) + + iCol = m%AM%Mod%Vars%u(c)%iLoc + nx + + ! If column is a load + if (MV_IsLoad(m%AM%Mod%Vars%u(c))) then + + ! Column is a load, state rows are not loads + m%AM%Mod%Lin%J(1:nx, iCol(1):iCol(2)) = & + m%AM%Mod%Lin%J(1:nx, iCol(1):iCol(2))*p_FAST%UJacSclFact + + ! Loop through rows + do r = 1, size(m%AM%Mod%Vars%u) + ! If column is load, but row is a motion + if (.not. MV_IsLoad(m%AM%Mod%Vars%u(r))) then + iRow = m%AM%Mod%Vars%u(r)%iLoc + nx + m%AM%Mod%Lin%J(iRow(1):iRow(2), iCol(1):iCol(2)) = & + m%AM%Mod%Lin%J(iRow(1):iRow(2), iCol(1):iCol(2))*p_FAST%UJacSclFact + end if + end do + + else + + ! Loop through rows + do r = 1, size(m%AM%Mod%Vars%u) + ! Column is a motion, but row is a load + if (MV_IsLoad(m%AM%Mod%Vars%u(r))) then + iRow = m%AM%Mod%Vars%u(r)%iLoc + nx + m%AM%Mod%Lin%J(iRow(1):iRow(2), iCol(1):iCol(2)) = & + m%AM%Mod%Lin%J(iRow(1):iRow(2), iCol(1):iCol(2))/p_FAST%UJacSclFact + end if + end do + + end if + end do + + !---------------------------------------------------------------------------- + ! Factor Jacobian matrix + ! Get the LU decomposition of this matrix using a LAPACK routine: + ! The result is of the form Jmat = P * L * U + !---------------------------------------------------------------------------- + + call LAPACK_getrf(M=size(m%AM%Mod%Lin%J, 1), N=size(m%AM%Mod%Lin%J, 2), & + A=m%AM%Mod%Lin%J, IPIV=m%AM%JacPivot, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + +contains + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function + + subroutine Cleanup() + if (Un > 0) close (Un) + end subroutine Cleanup + +end subroutine SS_BuildJacobian + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine SS_BuildResidual(caseData, m, T, ErrStat, ErrMsg) + type(AeroMapCase), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_BuildResidual' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, iVarMod(2), iVarGbl(2) + + integer, parameter :: InputIndex = INPUT_PREV + integer, parameter :: StateIndex = STATE_PRED + + ErrStat = ErrID_None + ErrMsg = "" + + !note: prescribed inputs are already set in both InputIndex=1 and InputIndex=2 so we can ignore them here + ! Use current inputs to calculate CCSD in STATE_PRED + call SteadyStateCCSD(m, caseData, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Store state accelerations in residual + if (m%AM%iModBD > 0) then + call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModBD)%x, m%Modules(m%AM%iModBD)%Lin%dx, m%AM%Residual) + else if (m%AM%iModED > 0) then + call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%Modules(m%AM%iModED)%Lin%dx, m%AM%Residual) + end if + + ! note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the SS_GetInputs + call SteadyStateCalculatedInputs(m, InputIndex, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Pack the output "residual vector" with these state derivatives and new inputs: + call SS_GetInputs(m, m%AM%u2, T%p_FAST%UJacSclFact, InputIndex, StateIndex, T, ErrStat2, ErrMsg2) + + ! Store difference in inputs + m%AM%Residual(m%AM%Mod%Vars%Nx + 1:) = m%AM%u1 - m%AM%u2 + +end subroutine SS_BuildResidual + +!------------------------------------------------------------------------------- + +!> SS_BD_InputSolve sets the blade load inputs required for BD. +subroutine SS_BD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_BD_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + call FAST_InputSolve(m%Modules(m%AM%iModBD), m%Modules, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine SS_BD_InputSolve + +!> SS_BD_InputSolve_OtherBlades sets the blade-load ElastoDyn inputs from blade 1 to the other blades. +subroutine SS_BD_InputSolve_OtherBlades(m, InputIndex, T) + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi) :: j, k + do k = 2, T%p_FAST%nBeams + do j = 1, T%BD%Input(InputIndex, k)%DistrLoad%NNodes + T%BD%Input(InputIndex, k)%DistrLoad%Force(:, j) = MATMUL(T%BD%Input(InputIndex, 1)%DistrLoad%Force(:, j), m%AM%HubOrientation(:, :, k)) + T%BD%Input(InputIndex, k)%DistrLoad%Moment(:, j) = MATMUL(T%BD%Input(InputIndex, 1)%DistrLoad%Moment(:, j), m%AM%HubOrientation(:, :, k)) + end do + end do +end subroutine SS_BD_InputSolve_OtherBlades + +!> This routine sets the blade load inputs required for ED. +subroutine SS_ED_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_ED_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + call FAST_InputSolve(m%Modules(m%AM%iModED), m%Modules, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine SS_ED_InputSolve + +!> SS_ED_InputSolve_OtherBlades sets the blade-load ElastoDyn inputs from blade 1 to the other blades. +subroutine SS_ED_InputSolve_OtherBlades(m, InputIndex, T) + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + + integer(IntKi) :: j, k + + associate (BladePtLoads => T%ED%Input(InputIndex)%BladePtLoads) + do k = 2, size(BladePtLoads, 1) + do j = 1, BladePtLoads(k)%NNodes + BladePtLoads(k)%Force(:, j) = MATMUL(BladePtLoads(1)%Force(:, j), m%AM%HubOrientation(:, :, k)) + BladePtLoads(k)%Moment(:, j) = MATMUL(BladePtLoads(1)%Moment(:, j), m%AM%HubOrientation(:, :, k)) + end do + end do + end associate +end subroutine SS_ED_InputSolve_OtherBlades + +!> SS_AD_InputSolve sets the blade-motion AeroDyn inputs for Blade 1. +subroutine SS_AD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_AD_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Get blade motion inputs + call FAST_InputSolve(m%Modules(m%AM%iModAD), m%Modules, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Set prescribed values for first blade + T%AD%Input(InputIndex)%rotors(1)%BladeMotion(1)%RotationVel = 0.0_ReKi + T%AD%Input(InputIndex)%rotors(1)%BladeMotion(1)%TranslationAcc = 0.0_ReKi + +end subroutine SS_AD_InputSolve + +!> SS_AD_InputSolve_OtherBlades sets the blade-motion AeroDyn inputs. +subroutine SS_AD_InputSolve_OtherBlades(m, InputIndex, T) + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + + integer(IntKi) :: j, k + + associate (BladeMotion => T%AD%Input(InputIndex)%rotors(1)%BladeMotion) + do k = 2, size(BladeMotion, 1) + do j = 1, BladeMotion(k)%NNodes + BladeMotion(k)%TranslationDisp(:, j) = MATMUL(BladeMotion(1)%TranslationDisp(:, j), m%AM%HubOrientation(:, :, k)) + BladeMotion(k)%Orientation(:, :, j) = MATMUL(BladeMotion(1)%Orientation(:, :, j), m%AM%HubOrientation(:, :, k)) + BladeMotion(k)%TranslationVel(:, j) = MATMUL(BladeMotion(1)%TranslationVel(:, j), m%AM%HubOrientation(:, :, k)) + end do + end do + end associate +end subroutine SS_AD_InputSolve_OtherBlades + +subroutine SteadyStateCCSD(m, caseData, InputIndex, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + type(AeroMapCase), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + integer(IntKi), intent(IN) :: InputIndex !< Index into input array + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status + character(*), intent(OUT) :: ErrMsg !< Error message + + character(*), parameter :: RoutineName = 'SteadyStateCCSD' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i, k + integer(IntKi) :: BldMeshNode + real(R8Ki) :: Omega_Hub(3) + real(R8Ki) :: position(3) + real(R8Ki) :: omega_cross_position(3) + + ErrStat = ErrID_None + ErrMsg = "" + + ! Select based on which module is simulating the blades + select case (T%p_FAST%CompElast) + + case (Module_ED) ! ElastoDyn + + call FAST_GetOP(m%Modules(m%AM%iModED), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, dx_op=m%Modules(m%AM%iModED)%Lin%dx) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + case (Module_BD) ! BeamDyn + + ! Set hub rotation speed + Omega_Hub = [caseData%RotSpeed, 0.0_R8Ki, 0.0_R8Ki] + + ! TODO: Make this work for BeamDyn + ! do K = 1, T%p_FAST%nBeams + + ! call BD_CalcContStateDeriv(SS_t_global, BD%Input(InputIndex, k), BD%p(k), BD%x(k, STATE_CURR), BD%xd(k, STATE_CURR), BD%z(k, STATE_CURR), & + ! BD%OtherSt(k, STATE_CURR), BD%m(k), BD%x(k, STATE_PRED), ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! ! subtract xdot(y) here: + ! ! note that this only works when the BldMotion mesh is on the FE nodes + ! do i = 2, BD%p(k)%node_total ! the first node isn't technically a state + ! BldMeshNode = BD%p(k)%NdIndx(i) + ! position = BD%y(k)%BldMotion%Position(:, BldMeshNode) + BD%y(k)%BldMotion%TranslationDisp(:, BldMeshNode) + ! omega_cross_position = cross_product(Omega_Hub, position) + + ! BD%x(k, STATE_PRED)%q(1:3, i) = BD%x(k, STATE_PRED)%q(1:3, i) - omega_cross_position + ! BD%x(k, STATE_PRED)%q(4:6, i) = BD%x(k, STATE_PRED)%q(4:6, i) - Omega_Hub + ! BD%x(k, STATE_PRED)%dqdt(1:3, i) = BD%x(k, STATE_PRED)%dqdt(1:3, i) - cross_product(Omega_Hub, omega_cross_position) + ! end do + + ! end do + + end select + +end subroutine SteadyStateCCSD + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine SteadyStateCalculatedInputs(m, InputIndex, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + integer(IntKi), intent(IN) :: InputIndex !< Index into input array + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status + character(*), intent(OUT) :: ErrMsg !< Error message + + character(*), parameter :: RoutineName = 'SteadyStateCalculatedInputs' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = "" + + ! Transfer motions to AeroDyn first + call SS_AD_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Transfer loads to structural solver next + if (m%AM%iModBD > 0) then + call SS_BD_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + else if (m%AM%iModED > 0) then + call SS_ED_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + +end subroutine SteadyStateCalculatedInputs + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine adds u_delta to the corresponding mesh field and scales it as appropriate +! subroutine Add_SteadyState_delta(p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData) +! !.................................................................................................................................. +! type(FAST_ParameterType), intent(IN) :: p_FAST !< Glue-code simulation parameters +! type(FAST_OutputFileType), intent(IN) :: y_FAST !< Output variables for the glue code +! real(R8Ki), intent(IN) :: u_delta(:) !< The delta amount to add to the appropriate mesh fields +! type(ElastoDyn_Data), intent(INOUT) :: ED !< ElastoDyn data +! type(BeamDyn_Data), intent(INOUT) :: BD !< BeamDyn data +! type(AeroDyn_Data), intent(INOUT) :: AD !< AeroDyn data +! type(FAST_ModuleMapType), intent(IN) :: MeshMapData !< data for mapping meshes between modules + +! ! local variables +! integer :: n +! integer :: fieldIndx +! integer :: node +! integer :: indx, indx_last +! integer :: i, j, k +! integer :: nx, nStates + +! real(R8Ki) :: orientation(3, 3) +! real(R8Ki) :: rotation(3, 3) + +! integer(IntKi) :: ErrStat2 +! character(ErrMsgLen) :: ErrMsg2 + +! nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + +! ! structural code states: +! if (p_FAST%CompElast == Module_ED) then +! nStates = nx + +! do j = 1, nStates + +! do k = 1, ED%p%NActvDOF_Stride ! transfer these states to the other blades (this means that the original states MUST be set the same for all blades!!!) +! indx = ED%p%DOFs%PS((j - 1)*ED%p%NActvDOF_Stride + k) + +! ED%x(STATE_CURR)%QT(indx) = ED%x(STATE_CURR)%QT(indx) + u_delta(j) +! ED%x(STATE_CURR)%QDT(indx) = 0.0_R8Ki !ED%x( STATE_CURR)%QDT(indx) + u_delta(j+nStates) +! end do + +! end do + +! elseif (p_FAST%CompElast == Module_BD) then +! nStates = nx/2 + +! ! see BD's Perturb_x function: + +! do k = 1, p_FAST%nBeams +! indx = 1 +! do i = 2, BD%p(k)%node_total +! indx_last = indx + BD%p(k)%dof_node - 1 +! BD%x(k, STATE_CURR)%dqdt(:, i) = BD%x(k, STATE_CURR)%dqdt(:, i) + u_delta(nStates + indx:indx_last + nStates) +! BD%x(k, STATE_CURR)%q(1:3, i) = BD%x(k, STATE_CURR)%q(1:3, i) + u_delta(indx:indx + 2) + +! ! w-m parameters +! call BD_CrvMatrixR(BD%x(k, STATE_CURR)%q(4:6, i), rotation) ! returns the rotation matrix (transpose of DCM) that was stored in the state as a w-m parameter +! orientation = transpose(rotation) + +! call PerturbOrientationMatrix(Orientation, Perturbations=u_delta(indx + 3:indx_last)) + +! rotation = transpose(orientation) +! call BD_CrvExtractCrv(rotation, BD%x(k, STATE_CURR)%q(4:6, i), ErrStat2, ErrMsg2) ! return the w-m parameters of the new orientation + +! indx = indx_last + 1 +! end do +! end do +! end if !CompElast + +! ! inputs: +! ! we are at u_delta(nx+1 : end) +! n = nx + 1 +! if (p_FAST%CompElast == Module_ED) then + +! do K = 1, p_FAST%NumBl_Lin !we don't need all blades here: SIZE(ED%Input(1)%BladePtLoads,1) ! Loop through all blades + +! do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes +! do fieldIndx = 1, 3 +! ED%Input(1)%BladePtLoads(k)%Force(fieldIndx, node) = ED%Input(1)%BladePtLoads(k)%Force(fieldIndx, node) + u_delta(n)*p_FAST%UJacSclFact +! n = n + 1 +! end do +! end do + +! do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes +! do fieldIndx = 1, 3 +! ED%Input(1)%BladePtLoads(k)%Moment(fieldIndx, node) = ED%Input(1)%BladePtLoads(k)%Moment(fieldIndx, node) + u_delta(n)*p_FAST%UJacSclFact +! n = n + 1 +! end do +! end do + +! end do + +! call SS_ED_InputSolve_OtherBlades(p_FAST, ED%Input(1), MeshMapData) + +! elseif (p_FAST%CompElast == Module_BD) then + +! do K = 1, p_FAST%NumBl_Lin !we don't need all blades here: p_FAST%nBeams ! Loop through all blades + +! do node = 1, BD%Input(1, k)%DistrLoad%NNodes +! do fieldIndx = 1, 3 +! BD%Input(1, k)%DistrLoad%Force(fieldIndx, node) = BD%Input(1, k)%DistrLoad%Force(fieldIndx, node) + u_delta(n)*p_FAST%UJacSclFact +! n = n + 1 +! end do +! end do + +! do node = 1, BD%Input(1, k)%DistrLoad%NNodes +! do fieldIndx = 1, 3 +! BD%Input(1, k)%DistrLoad%Moment(fieldIndx, node) = BD%Input(1, k)%DistrLoad%Moment(fieldIndx, node) + u_delta(n)*p_FAST%UJacSclFact +! n = n + 1 +! end do +! end do + +! end do + +! call SS_BD_InputSolve_OtherBlades(p_FAST, BD, MeshMapData, 1) ! 1 is for the input index (i.e., Input(1,Blades2-end) + +! end if !CompElast + +! ! AeroDyn +! do k = 1, p_FAST%NumBl_Lin !we don't need all blades here: SIZE(AD%Input(1)%BladeMotion) +! do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes +! do fieldIndx = 1, 3 +! AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp(fieldIndx, node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp(fieldIndx, node) + u_delta(n) +! n = n + 1 +! end do +! end do + +! do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes +! call PerturbOrientationMatrix(AD%Input(1)%rotors(1)%BladeMotion(k)%Orientation(:, :, node), Perturbations=u_delta(n:n + 2)) +! n = n + 3 +! end do + +! do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes +! AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel(:, node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel(:, node) + u_delta(n:n + 2) + +! n = n + 3 +! end do + +! end do + +! ! now update the inputs on other blades: +! call SS_AD_InputSolve_OtherBlades(p_FAST, AD%Input(1), MeshMapData) ! transfer results from blade 1 to other blades + +! end subroutine Add_SteadyState_delta + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine basically packs the relevant parts of the modules' inputs and states for use in the steady-state solver. +subroutine SS_GetInputs(m, u_vec, ScaleFactor, InputIndex, StateIndex, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: m !< Glue-code simulation parameters + real(R8Ki), intent(inout) :: u_vec(:) !< Array of input packed values + real(R8Ki), intent(in) :: ScaleFactor !< Jacobian scaling factor + integer(IntKi), intent(in) :: InputIndex !< Input array index + integer(IntKi), intent(in) :: StateIndex !< State array index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SolveSteadyState' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i, j, k, ieMod, ieGbl + integer(IntKi) :: iMod(3), iVarMod(2), iVarGbl(2) + + iMod = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] + + ! Loop through modules + do i = 1, size(iMod) + + ! Skip inactive modules + if (iMod(i) == 0) cycle + + associate (ModData => m%Modules(iMod(i))) + + ! Get states and outputs + call FAST_GetOP(ModData, SS_t_global, InputIndex, StateIndex, T, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u) + if (Failed()) return + + ! Transfer selected input data from module to RHS based on Idx + if (allocated(ModData%Lin%u)) then + do j = 1, size(ModData%Vars%u) + + ! Get module and global variable indices from Idx, skip if not used + if (.not. ModD_GetValLoc(m%AM%Mod%Xfr(iMod(i))%u, j, iVarMod, iVarGbl)) cycle + + ! Convert or store based on field type + select case (ModData%Vars%u(j)%Field) + + case (FieldForce, FieldMoment) + ! If field is a force or moment, scale by scale factor + u_vec(iVarGbl(1):iVarGbl(2)) = ModData%Lin%u(iVarMod(1):iVarMod(2))/ScaleFactor + + case (FieldOrientation) + ! Convert orientations to rotation vectors + ieMod = iVarMod(1) + ieGbl = iVarGbl(1) + do k = 1, ModData%Vars%u(j)%Nodes + u_vec(ieGbl:ieGbl + 2) = -quat_to_rvec(ModData%Lin%u(ieMod:ieMod + 2)) + ieMod = ieMod + 3 + ieGbl = ieGbl + 3 + end do + + case default + u_vec(iVarGbl(1):iVarGbl(2)) = ModData%Lin%u(iVarMod(1):iVarMod(2)) + end select + + end do + end if + + end associate + + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine SS_GetInputs + !---------------------------------------------------------------------------------------------------------------------------------- -subroutine SteadyStatePrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) - type(FAST_SS_CaseType), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - type(FAST_ParameterType), intent(IN) :: p_FAST !< Parameters for the glue code - type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Output variables for the glue code - type(FAST_MiscVarType), intent(INOUT) :: m_FAST !< Miscellaneous variables +subroutine SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters for the glue code + type(FAST_OutputFileType), intent(inout) :: y_FAST !< Output variables for the glue code + type(FAST_MiscVarType), intent(inout) :: m_FAST !< Miscellaneous variables - type(ElastoDyn_Data), intent(INOUT) :: ED !< ElastoDyn data - type(BeamDyn_Data), intent(INOUT) :: BD !< BeamDyn data - type(AeroDyn_Data), intent(INOUT) :: AD !< AeroDyn data + type(ElastoDyn_Data), intent(inout) :: ED !< ElastoDyn data + type(BeamDyn_Data), intent(inout) :: BD !< BeamDyn data + type(AeroDyn_Data), intent(inout) :: AD !< AeroDyn data integer(IntKi) :: k real(R8Ki) :: theta(3) @@ -619,6 +1367,6 @@ subroutine SteadyStatePrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD%Input(1)%rotors(1)%UserProp = 0.0_ReKi -end subroutine SteadyStatePrescribedInputs +end subroutine SetPrescribedInputs end module diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 778fdb29de..6457a2d3b3 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -441,11 +441,12 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcOutput(ModData, Maps, ThisTime, ThisState, T, ErrStat, ErrMsg) +subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData !< Module data type(MappingType), intent(inout) :: Maps(:) !< Output->Input mappings real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: ThisState !< State index + integer(IntKi), intent(in) :: InputIndex !< Input index + integer(IntKi), intent(in) :: StateIndex !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -462,41 +463,41 @@ subroutine FAST_CalcOutput(ModData, Maps, ThisTime, ThisState, T, ErrStat, ErrMs select case (ModData%ID) case (Module_AD) - call AD_CalcOutput(ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), T%AD%z(ThisState), & - T%AD%OtherSt(ThisState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep) + call AD_CalcOutput(ThisTime, T%AD%Input(InputIndex), T%AD%p, T%AD%x(StateIndex), T%AD%xd(StateIndex), T%AD%z(StateIndex), & + T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep) case (Module_BD) - call BD_CalcOutput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), & - T%BD%xd(ModData%Ins, ThisState), T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + call BD_CalcOutput(ThisTime, T%BD%Input(InputIndex, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, StateIndex), & + T%BD%xd(ModData%Ins, StateIndex), T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2) case (Module_ED) - call ED_CalcOutput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & - T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2) + call ED_CalcOutput(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & + T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), T%ED%y, T%ED%m, ErrStat2, ErrMsg2) ! case (Module_ExtPtfm) ! case (Module_FEAM) case (Module_HD) - call HydroDyn_CalcOutput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & - T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2) + call HydroDyn_CalcOutput(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & + T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2) ! case (Module_IceD) ! case (Module_IceF) case (Module_IfW) - call InflowWind_CalcOutput(ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(ThisState), T%IfW%xd(ThisState), T%IfW%z(ThisState), & - T%IfW%OtherSt(ThisState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) + call InflowWind_CalcOutput(ThisTime, T%IfW%Input(InputIndex), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), T%IfW%z(StateIndex), & + T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) ! case (Module_MAP) ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) case (Module_SD) - call SD_CalcOutput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), T%SD%z(ThisState), & - T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2) + call SD_CalcOutput(ThisTime, T%SD%Input(InputIndex), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), T%SD%z(StateIndex), & + T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2) ! case (Module_SeaSt) case (Module_SrvD) - call SrvD_CalcOutput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), T%SrvD%z(ThisState), & - T%SrvD%OtherSt(ThisState), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) + call SrvD_CalcOutput(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), & + T%SrvD%OtherSt(StateIndex), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) case default call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) @@ -512,11 +513,12 @@ subroutine FAST_CalcOutput(ModData, Maps, ThisTime, ThisState, T, ErrStat, ErrMs end subroutine -subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilter, & +subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, FlagFilter, & u_op, y_op, x_op, dx_op, xd_op, z_op) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: ThisState !< State index + integer(IntKi), intent(in) :: InputIndex !< Input index + integer(IntKi), intent(in) :: StateIndex !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -540,19 +542,19 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt select case (ModData%ID) case (Module_AD) - call AD_GetOP(ModData%Ins, ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), T%AD%z(ThisState), & - T%AD%OtherSt(ThisState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & + call AD_GetOP(ModData%Ins, ThisTime, T%AD%Input(InputIndex), T%AD%p, T%AD%x(StateIndex), T%AD%xd(StateIndex), T%AD%z(StateIndex), & + T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case (Module_BD) - call BD_GetOP(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), & - T%BD%xd(ModData%Ins, ThisState), T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + call BD_GetOP(ThisTime, T%BD%Input(InputIndex, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, StateIndex), & + T%BD%xd(ModData%Ins, StateIndex), T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case (Module_ED) - call ED_GetOP(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & - T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + call ED_GetOP(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & + T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) ! case (Module_ExtPtfm) @@ -560,42 +562,42 @@ subroutine FAST_GetOP(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilt ! case (Module_FEAM) case (Module_HD) - call HD_GetOP(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & - T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + call HD_GetOP(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & + T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) ! case (Module_IceD) ! case (Module_IceF) case (Module_IfW) - call InflowWind_GetOP(ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(ThisState), T%IfW%xd(ThisState), T%IfW%z(ThisState), & - T%IfW%OtherSt(ThisState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + call InflowWind_GetOP(ThisTime, T%IfW%Input(InputIndex), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), T%IfW%z(StateIndex), & + T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case (Module_MAP) - call MAP_GetOP(ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(ThisState), T%MAP%xd(ThisState), T%MAP%z(ThisState), & + call MAP_GetOP(ThisTime, T%MAP%Input(InputIndex), T%MAP%p, T%MAP%x(StateIndex), T%MAP%xd(StateIndex), T%MAP%z(StateIndex), & T%MAP%OtherSt, T%MAP%y, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op) !, x_op=x_op, dx_op=dx_op) MAP doesn't have states case (Module_MD) - call MD_GetOP(ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(ThisState), T%MD%xd(ThisState), T%MD%z(ThisState), & - T%MD%OtherSt(ThisState), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + call MD_GetOP(ThisTime, T%MD%Input(InputIndex), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), T%MD%z(StateIndex), & + T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) ! case (Module_OpFM) ! case (Module_Orca) case (Module_SD) - call SD_GetOP(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), T%SD%z(ThisState), & - T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + call SD_GetOP(ThisTime, T%SD%Input(InputIndex), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), T%SD%z(StateIndex), & + T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case (Module_SeaSt) - call SeaSt_GetOP(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), T%SeaSt%z(ThisState), & - T%SeaSt%OtherSt(ThisState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + call SeaSt_GetOP(ThisTime, T%SeaSt%Input(InputIndex), T%SeaSt%p, T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), T%SeaSt%z(StateIndex), & + T%SeaSt%OtherSt(StateIndex), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case (Module_SrvD) - call SrvD_GetOP(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), T%SrvD%z(ThisState), & - T%SrvD%OtherSt(ThisState), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & + call SrvD_GetOP(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), & + T%SrvD%OtherSt(StateIndex), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case default diff --git a/modules/openfast-library/src/FAST_Idx.f90 b/modules/openfast-library/src/FAST_Idx.f90 deleted file mode 100644 index 55624c6810..0000000000 --- a/modules/openfast-library/src/FAST_Idx.f90 +++ /dev/null @@ -1,385 +0,0 @@ -!********************************************************************************************************************************** -! FAST_ModLin.f90 performs linearization using the ModVars module. -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2024 National Renewable Energy Laboratory -! -! This file is part of FAST. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -!********************************************************************************************************************************** -module FAST_Idx - -use NWTC_Library -use NWTC_LAPACK - -use FAST_Types - -implicit none - -private -public :: Idx_Init, Idx_GetValLoc, GetModuleOrder - -contains - -subroutine GetModuleOrder(Mods, ModIDs, ModOrder) - type(ModDataType), intent(in) :: Mods(:) !< Array of module data structures - integer(IntKi), intent(in) :: ModIDs(:) !< List of module IDs to keep in order - integer(IntKi), allocatable, intent(out) :: ModOrder(:) !< Module data indices in order of ModIDs - integer(IntKi), allocatable :: ModIDAry(:), indices(:) - integer(IntKi) :: i - - ! Create array 1 to size(Mod) representing the index of each module data - indices = [(i, i = 1, size(Mods))] - - ! Get array of module IDs from array of module data - ModIDAry = [(Mods(i)%ID, i = 1, size(Mods))] - - ! Initialize module order array with no size - allocate (ModOrder(0)) - - ! Loop through module IDs to keep, add module data indices that match module ID to order array - do i = 1, size(ModIDs) - ModOrder = [ModOrder, pack(indices, ModIDAry == ModIDs(i))] - end do - -end subroutine - -subroutine Idx_Init(Mods, ModOrder, Idx, FlagFilter, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mods(:) - integer(IntKi), intent(in) :: ModOrder(:) - type(VarsIdxType), intent(out) :: Idx - integer(IntKi), intent(in) :: FlagFilter - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'Idx_Init' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: NumVars - integer(IntKi) :: iGbl(2) - integer(IntKi) :: i, j - - ! Initialize error return - ErrStat = ErrID_None - ErrMsg = "" - - ! Destroy VarIdx in case it has been previously used - call Glue_DestroyVarsIdxType(Idx, ErrStat2, ErrMsg2); if (Failed()) return - - ! Save filter in index - Idx%FlagFilter = FlagFilter - - !---------------------------------------------------------------------------- - ! Indexing Data Description - !---------------------------------------------------------------------------- - - ! For each variable (x, u, y, etc.) there are two arrays: - ! 1) Variable local and global value indices (ValLocGbl) - ! 2) Module variable start index (ModVarStart) - ! ValLocGbl has 4 rows and N columns where N is the total number of variables - ! for all modules in Mods. The columns are as follows: - ! 1) Values start index inside module arrays/matrices (iLoc(1)) - ! 2) Values end index inside module arrays/matrices (iLoc(2)) - ! 3) Values start index in global arrays/matrices (iGbl(1)) - ! 4) Values end index in global arrays/matrices (iLoc(2)) - ! ModVarStart contains N rows where N is the total number of modules in Mods. - ! The values in this array contain the variable start index offset for each - ! module into ValLocGbl so value indices can be looked up given module index - ! and variable index. Keeping all value indices in one matrix makes data - ! storage much simpler at the cost of of having to maintain the array of - ! module offsets. - - !---------------------------------------------------------------------------- - ! Build index for continuous state variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%x%ModVarStart, size(Mods) + 1, "VarIdx%x%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%x%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%x) - Idx%x%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%x%ValLocGbl, 4, NumVars, "VarIdx%x%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%x%ValLocGbl = 0 - - ! Initialize global index to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%x) - if (MV_HasFlags(ModData%Vars%x(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%x(j)%Num - 1 - Idx%x%ValLocGbl(:, Idx%x%ModVarStart(ModData%Idx) + j) = [ModData%Vars%x(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Nx = iGbl(2) - - !---------------------------------------------------------------------------- - ! Build index for discrete state variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%xd%ModVarStart, size(Mods) + 1, "VarIdx%xd%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%xd%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables and values - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%xd) - Idx%xd%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%xd%ValLocGbl, 4, NumVars, "VarIdx%xd%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%xd%ValLocGbl = 0 - - ! Initialize global index and number of values to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%xd) - if (MV_HasFlags(ModData%Vars%xd(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%xd(j)%Num - 1 - Idx%xd%ValLocGbl(:, Idx%xd%ModVarStart(ModData%Idx) + j) = [ModData%Vars%xd(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Nxd = iGbl(2) - - !---------------------------------------------------------------------------- - ! Build index for constraint state variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%z%ModVarStart, size(Mods) + 1, "VarIdx%z%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%z%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%z) - Idx%z%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%z%ValLocGbl, 4, NumVars, "VarIdx%z%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%z%ValLocGbl = 0 - - ! Initialize global index to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%z) - if (MV_HasFlags(ModData%Vars%z(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%z(j)%Num - 1 - Idx%z%ValLocGbl(:, Idx%z%ModVarStart(ModData%Idx) + j) = [ModData%Vars%z(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Nz = iGbl(2) - - !---------------------------------------------------------------------------- - ! Build index for input variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%u%ModVarStart, size(Mods) + 1, "VarIdx%u%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%u%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%u) - Idx%u%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%u%ValLocGbl, 4, NumVars, "VarIdx%u%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%u%ValLocGbl = 0 - - ! Initialize global index to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%u) - if (MV_HasFlags(ModData%Vars%u(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%u(j)%Num - 1 - Idx%u%ValLocGbl(:, Idx%u%ModVarStart(ModData%Idx) + j) = [ModData%Vars%u(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Nu = iGbl(2) - - !---------------------------------------------------------------------------- - ! Build index for output variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%y%ModVarStart, size(Mods) + 1, "VarIdx%y%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%y%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%y) - Idx%y%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%y%ValLocGbl, 4, NumVars, "VarIdx%y%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%y%ValLocGbl = 0 - - ! Initialize global index to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%y) - if (MV_HasFlags(ModData%Vars%y(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%y(j)%Num - 1 - Idx%y%ValLocGbl(:, Idx%y%ModVarStart(ModData%Idx) + j) = [ModData%Vars%y(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Ny = iGbl(2) - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine - -! Idx_GetValLoc is used to get the global or module value indices based on module index and variable index. -! iMod is the start and end indices of the values in the module data -! iGbl is teh start and end indices of the values in the global data -subroutine Idx_GetValLoc(Idx, ModIdx, VarIdx, iMod, iGbl) - type(VarIdxType), intent(in) :: Idx - integer(IntKi), intent(in) :: ModIdx, VarIdx - integer(IntKi), optional, intent(out) :: iMod(2), iGbl(2) - integer(IntKi) :: col - col = Idx%ModVarStart(ModIdx) + VarIdx - if (present(iMod)) iMod = Idx%ValLocGbl(1:2, col) - if (present(iGbl)) iGbl = Idx%ValLocGbl(3:4, col) -end subroutine - -subroutine MV_AddModule(Mods, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) - type(ModDataType), allocatable, intent(inout) :: Mods(:) - integer(IntKi), intent(in) :: ModID - character(*), intent(in) :: ModAbbr - integer(IntKi), intent(in) :: Instance - real(R8Ki), intent(in) :: ModDT - real(R8Ki), intent(in) :: SolverDT - type(ModVarsType), pointer, intent(in) :: Vars - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'MV_AddModule' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(ModDataType) :: ModData - - ErrStat = ErrID_None - ErrMsg = '' - - ! If module array hasn't been allocated, allocate with zero size - if (.not. allocated(Mods)) allocate (Mods(0)) - - ! Populate ModuleDataType derived type - ModData = ModDataType(Idx=size(Mods) + 1, ID=ModID, Abbr=ModAbbr, & - Ins=Instance, DT=ModDT, Vars=Vars) - - ! Allocate source and destination mapping arrays - call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !---------------------------------------------------------------------------- - ! Calculate Module Substepping - !---------------------------------------------------------------------------- - - ! If module time step is same as global time step, set substeps to 1 - if (EqualRealNos(ModData%DT, SolverDT)) then - ModData%SubSteps = 1 - else - ! If the module time step is greater than the global time step, set error - if (ModData%DT > SolverDT) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & - " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & - "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - - ! Calculate the number of substeps - ModData%SubSteps = nint(SolverDT/ModData%DT) - - ! If the module DT is not an exact integer divisor of the global time step, set error - if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & - " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & - "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - end if - - !---------------------------------------------------------------------------- - ! Add module data to array - !---------------------------------------------------------------------------- - - Mods = [Mods, ModData] - -end subroutine - -end module diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index f1b66c031c..696a54fe65 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -22,15 +22,13 @@ module FAST_Mapping use FAST_Types use FAST_ModTypes -use FAST_Idx +use FAST_ModData implicit none private public :: FAST_InitMappings, FAST_LinearizeMappings, FAST_ResetRemapFlags, FAST_InputSolve -integer(IntKi), parameter :: AD_rotor = 1 - integer(IntKi), parameter :: Xfr_Invalid = 0, & Xfr_Point_to_Point = 1, & Xfr_Line2_to_Point = 2, & @@ -52,12 +50,12 @@ module FAST_Mapping contains -subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, UseU, Mesh, ErrStat, ErrMsg) +subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, InputIndex, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData - type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshLocType), intent(in) :: MeshLoc - logical, intent(in) :: UseU + type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshType), pointer, intent(out) :: Mesh + integer(IntKi), intent(in) :: InputIndex integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -68,103 +66,143 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, UseU, Mesh, ErrStat, select case (ModData%ID) case (Module_AD) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => AD_InputMeshPointer(Turbine%AD%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => AD_InputMeshPointer(Turbine%AD%u, MeshLoc) - else - Mesh => AD_InputMeshPointer(Turbine%AD%Input(1), MeshLoc) - end if + case (1:) + Mesh => AD_InputMeshPointer(Turbine%AD%Input(InputIndex), MeshLoc) + end select case (Module_BD) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => BD_InputMeshPointer(Turbine%BD%Input_Saved(-InputIndex, ModData%Ins), MeshLoc) + case (0) Mesh => BD_InputMeshPointer(Turbine%BD%u(ModData%Ins), MeshLoc) - else - Mesh => BD_InputMeshPointer(Turbine%BD%Input(1, ModData%Ins), MeshLoc) - end if + case (1:) + Mesh => BD_InputMeshPointer(Turbine%BD%Input(InputIndex, ModData%Ins), MeshLoc) + end select case (Module_ED) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => ED_InputMeshPointer(Turbine%ED%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => ED_InputMeshPointer(Turbine%ED%u, MeshLoc) - else - Mesh => ED_InputMeshPointer(Turbine%ED%Input(1), MeshLoc) - end if + case (1:) + Mesh => ED_InputMeshPointer(Turbine%ED%Input(InputIndex), MeshLoc) + end select case (Module_ExtInfw) - if (UseU) then - Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) - else - ! ExtInfw doesn't have the typical input structure, using u for both - ! Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%Input(1), MeshLoc) - Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) - end if + ! ExtInfw doesn't have the typical input structure, using u for both + Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) case (Module_ExtPtfm) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%u, MeshLoc) - else - Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input(1), MeshLoc) - end if + case (1:) + Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input(InputIndex), MeshLoc) + end select case (Module_FEAM) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => FEAM_InputMeshPointer(Turbine%FEAM%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => FEAM_InputMeshPointer(Turbine%FEAM%u, MeshLoc) - else - Mesh => FEAM_InputMeshPointer(Turbine%FEAM%Input(1), MeshLoc) - end if + case (1:) + Mesh => FEAM_InputMeshPointer(Turbine%FEAM%Input(InputIndex), MeshLoc) + end select case (Module_HD) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => HydroDyn_InputMeshPointer(Turbine%HD%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => HydroDyn_InputMeshPointer(Turbine%HD%u, MeshLoc) - else - Mesh => HydroDyn_InputMeshPointer(Turbine%HD%Input(1), MeshLoc) - end if + case (1:) + Mesh => HydroDyn_InputMeshPointer(Turbine%HD%Input(InputIndex), MeshLoc) + end select case (Module_IceD) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => IceD_InputMeshPointer(Turbine%IceD%Input_Saved(-InputIndex, ModData%Ins), MeshLoc) + case (0) Mesh => IceD_InputMeshPointer(Turbine%IceD%u(ModData%Ins), MeshLoc) - else - Mesh => IceD_InputMeshPointer(Turbine%IceD%Input(1, ModData%Ins), MeshLoc) - end if + case (1:) + Mesh => IceD_InputMeshPointer(Turbine%IceD%Input(InputIndex, ModData%Ins), MeshLoc) + end select case (Module_IceF) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => IceFloe_InputMeshPointer(Turbine%IceF%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => IceFloe_InputMeshPointer(Turbine%IceF%u, MeshLoc) - else - Mesh => IceFloe_InputMeshPointer(Turbine%IceF%Input(1), MeshLoc) - end if + case (1:) + Mesh => IceFloe_InputMeshPointer(Turbine%IceF%Input(InputIndex), MeshLoc) + end select case (Module_IfW) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => InflowWind_InputMeshPointer(Turbine%IfW%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => InflowWind_InputMeshPointer(Turbine%IfW%u, MeshLoc) - else - Mesh => InflowWind_InputMeshPointer(Turbine%IfW%Input(1), MeshLoc) - end if + case (1:) + Mesh => InflowWind_InputMeshPointer(Turbine%IfW%Input(InputIndex), MeshLoc) + end select case (Module_MAP) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => MAP_InputMeshPointer(Turbine%MAP%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => MAP_InputMeshPointer(Turbine%MAP%u, MeshLoc) - else - Mesh => MAP_InputMeshPointer(Turbine%MAP%Input(1), MeshLoc) - end if + case (1:) + Mesh => MAP_InputMeshPointer(Turbine%MAP%Input(InputIndex), MeshLoc) + end select case (Module_MD) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => MD_InputMeshPointer(Turbine%MD%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => MD_InputMeshPointer(Turbine%MD%u, MeshLoc) - else - Mesh => MD_InputMeshPointer(Turbine%MD%Input(1), MeshLoc) - end if + case (1:) + Mesh => MD_InputMeshPointer(Turbine%MD%Input(InputIndex), MeshLoc) + end select case (Module_Orca) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => Orca_InputMeshPointer(Turbine%Orca%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => Orca_InputMeshPointer(Turbine%Orca%u, MeshLoc) - else - Mesh => Orca_InputMeshPointer(Turbine%Orca%Input(1), MeshLoc) - end if + case (1:) + Mesh => Orca_InputMeshPointer(Turbine%Orca%Input(InputIndex), MeshLoc) + end select case (Module_SD) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => SD_InputMeshPointer(Turbine%SD%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => SD_InputMeshPointer(Turbine%SD%u, MeshLoc) - else - Mesh => SD_InputMeshPointer(Turbine%SD%Input(1), MeshLoc) - end if + case (1:) + Mesh => SD_InputMeshPointer(Turbine%SD%Input(InputIndex), MeshLoc) + end select case (Module_SeaSt) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%u, MeshLoc) - else - Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input(1), MeshLoc) - end if + case (1:) + Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input(InputIndex), MeshLoc) + end select case (Module_SrvD) - if (UseU) then + select case (InputIndex) + case (:-1) + Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input_Saved(-InputIndex), MeshLoc) + case (0) Mesh => SrvD_InputMeshPointer(Turbine%SrvD%u, MeshLoc) - else - Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input(1), MeshLoc) - end if + case (1:) + Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input(InputIndex), MeshLoc) + end select case default ErrStat = ErrID_Fatal ErrMsg = "Unsupported module: "//ModData%Abbr @@ -184,8 +222,8 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, UseU, Mesh, ErrStat, subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData - type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshLocType), intent(in) :: MeshLoc + type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshType), pointer, intent(out) :: Mesh integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -410,8 +448,8 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) ! Loop through mappings do iMap = 1, size(Mappings) - associate (SrcMod => Mods(Mappings(iMap)%SrcModIdx), & - DstMod => Mods(Mappings(iMap)%DstModIdx)) + associate (SrcMod => Mods(Mappings(iMap)%iModSrc), & + DstMod => Mods(Mappings(iMap)%iModDst)) ! Add mapping index to sorce and destination module mapping arrays SrcMod%SrcMaps = [SrcMod%SrcMaps, iMap] @@ -430,7 +468,7 @@ logical function Failed() end subroutine subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) - type(MappingType), allocatable :: Mappings(:) + type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat @@ -440,56 +478,75 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i + logical :: NotCompAeroMaps ErrStat = ErrID_None ErrMsg = '' + ! Flag is true if not computing AeroMaps + NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + + ! Select based on source module identifier select case (SrcMod%ID) case (Module_BD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion - DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, SrcMod%Ins), & ! AD%u%rotors(1)%BladeMotion(SrcMod%Ins) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, DstMod%Ins, SrcMod%Ins), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(SrcMod%Ins) + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps .or. (SrcMod%Ins == 1)) + if (Failed()) return case (Module_ED) if (Turbine%p_FAST%CompElast == Module_ED) then do i = 1, size(Turbine%ED%y%BladeLn2Mesh) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, i), & ! AD%u%rotors(1)%BladeMotion(i) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, DstMod%Ins, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps .or. (i == 1)) + if (Failed()) return end do end if call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - DstMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, AD_rotor), & ! AD%u%rotors(1)%TowerMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + DstMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, DstMod%Ins), & ! AD%u%rotors(DstMod%Ins)%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return do i = 1, size(Turbine%ED%y%BladeRootMotion) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) - DstMeshLoc=MeshLocType(AD_u_rotors_BladeRootMotion, AD_rotor, i), & ! AD%u%rotors(1)%BladeRootMotion(i) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstMeshLoc=MeshLocType(AD_u_rotors_BladeRootMotion, DstMod%Ins, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return end do call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - DstMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! AD%u%rotors(1)%HubMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + DstMeshLoc=MeshLocType(AD_u_rotors_HubMotion, DstMod%Ins), & ! AD%u%rotors(DstMod%Ins)%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, AD_rotor), & ! AD%u%rotors(1)%NacelleMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + DstMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, DstMod%Ins), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion - DstMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! AD%u%rotors(1)%TFinMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + DstMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, DstMod%Ins), & ! AD%u%rotors(DstMod%Ins)%TFinMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return case (Module_IfW) @@ -497,19 +554,22 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) SrcMod=SrcMod, DstMod=DstMod, & iVarSrc=Turbine%IfW%p%iVarHWindSpeed, & iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarHWindSpeed, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return call MapVariable(Mappings, "IfW PLExp -> AD PLExp", & SrcMod=SrcMod, DstMod=DstMod, & iVarSrc=Turbine%IfW%p%iVarPLExp, & iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarPLExp, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return call MapVariable(Mappings, "IfW PropagationDir -> AD PropagationDir", & SrcMod=SrcMod, DstMod=DstMod, & iVarSrc=Turbine%IfW%p%iVarPropagationDir, & iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarPropagationDir, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_SrvD) @@ -535,33 +595,44 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i + logical :: NotCompAeroMaps ErrStat = ErrID_None ErrMsg = '' + ! Flag is true if not computing AeroMaps + NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + + ! Select based on source module identifier select case (SrcMod%ID) case (Module_AD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, AD_rotor, DstMod%Ins), & ! AD%y%rotors(1)%BladeLoad(DstMod%Ins) - SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, DstMod%Ins), & ! AD%u%rotors(1)%BladeMotion(DstMod%Ins) + SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, SrcMod%Ins, DstMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(DstMod%Ins) + SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, SrcMod%Ins, DstMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(DstMod%Ins) DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%u(DstMod%Ins)%DistrLoad DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps .or. (DstMod%Ins == 1)) + if (Failed()) return case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, DstMod%Ins), & ! ED%y%BladeRootMotion(DstMod%Ins) DstMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%u(DstMod%Ins)%RootMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return ! Hub motion not used ! call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & ! SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion ! DstMeshLoc=MeshLocType(BD_u_HubMotion), & ! BD%Input(1, DstMod%Ins)%HubMotion - ! ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ! ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + ! Active=NotCompAeroMaps) + ! if (Failed()) return case (Module_ExtLd) @@ -576,7 +647,8 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(DstMod%Ins, i) DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return end do end select @@ -599,60 +671,76 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j + logical :: NotCompAeroMaps ErrStat = ErrID_None ErrMsg = '' + ! Flag is true if not computing AeroMaps + NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + + ! Select based on source module identifier select case (SrcMod%ID) case (Module_AD) do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, AD_rotor, i), & ! AD%y%rotors(iR)%BladeLoad(i) - SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, AD_rotor, i), & ! AD%u%rotors(iR)%BladeMotion(i) + SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, SrcMod%Ins, i), & ! AD%y%rotors(SrcMod%InsR)%BladeLoad(i) + SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, SrcMod%Ins, i), & ! AD%u%rotors(SrcMod%InsR)%BladeMotion(i) DstMeshLoc=MeshLocType(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - Active=Turbine%p_FAST%CompElast == Module_ED, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=(Turbine%p_FAST%CompElast == Module_ED) .and. (NotCompAeroMaps .or. (i == 1))) + if (Failed()) return end do call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_HubLoad, AD_Rotor), & ! AD%y%rotors(1)%HubLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_HubMotion, AD_rotor), & ! AD%u%rotors(1)%HubMotion - DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%u%HubPtLoad - DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + SrcMeshLoc=MeshLocType(AD_y_rotors_HubLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%HubLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_HubMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%HubMotion + DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_NacelleLoad, AD_Rotor), & ! AD%y%rotors(1)%NacelleLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, AD_rotor), & ! AD%u%rotors(1)%NacelleMotion - DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%u%NacelleLoads - DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + SrcMeshLoc=MeshLocType(AD_y_rotors_NacelleLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion + DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_TFinLoad, AD_Rotor), & ! AD%y%rotors(1)%TFinLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, AD_rotor), & ! AD%u%rotors(1)%TFinMotion - DstMeshLoc=MeshLocType(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads - DstDispMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + SrcMeshLoc=MeshLocType(AD_y_rotors_TFinLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion + DstMeshLoc=MeshLocType(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads + DstDispMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_TowerLoad, AD_Rotor), & ! AD%y%rotors(1)%TowerLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, AD_rotor), & ! AD%u%rotors(1)%TowerMotion - DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerPtLoads - DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + SrcMeshLoc=MeshLocType(AD_y_rotors_TowerLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad + SrcDispMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion + DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads + DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return case (Module_BD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce - SrcDispMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%Input(1, SrcMod%Ins)%RootMotion - DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%Input(1)%HubPtLoad + SrcDispMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion + DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%u%HubPtLoad DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return case (Module_ExtLd) @@ -664,10 +752,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh SrcDispMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_FEAM) @@ -677,7 +766,8 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_HD) @@ -688,7 +778,8 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub == Module_None, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -697,7 +788,8 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub == Module_None, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_IceD) @@ -705,10 +797,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(IceD_y_PointMesh), & ! IceD%y%PointMesh SrcDispMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_IceF) @@ -716,10 +809,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh SrcDispMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_MAP) @@ -727,10 +821,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad SrcDispMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_MD) @@ -738,10 +833,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) SrcDispMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_Orca) @@ -749,19 +845,21 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh SrcDispMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_SD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & - SrcDispMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%Input(1)%TPMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + SrcDispMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%u%TPMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_SrvD) @@ -786,10 +884,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) - DstMeshLoc=MeshLocType(ED_u_BladePtLoads, j), & ! ED%Input(1)%BladePtLoads(j) + DstMeshLoc=MeshLocType(ED_u_BladePtLoads, j), & ! ED%u%BladePtLoads(j) DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) Active=Turbine%p_FAST%CompElast == Module_ED, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return end do end do @@ -798,9 +897,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & SrcDispMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%Input(1)%NacelleLoads + DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%u%NacelleLoads DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return end do ! Tower Structural Controller @@ -808,9 +908,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & SrcDispMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%Input(1)%TowerLoads + DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%u%TowerLoads DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return end do ! Substructure Structural Controller @@ -818,10 +919,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%Input(1)%PlatformPtMesh + DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return end do end select @@ -987,12 +1089,12 @@ subroutine InitMappings_FEAM(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) if (Turbine%p_FAST%CompSub /= Module_SD) then - ! CALL MeshMapCreate( SubstructureMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + ! CALL MeshMapCreate( SubstructureMotion, FEAM%u%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) end if case (Module_SD) - ! CALL MeshMapCreate( SubstructureMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + ! CALL MeshMapCreate( SubstructureMotion, FEAM%u%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) end select @@ -1024,18 +1126,18 @@ subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_PRPMesh), & ! HD%Input(1)%PRPMesh + DstMeshLoc=MeshLocType(HydroDyn_u_PRPMesh), & ! HD%u%PRPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh + DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh + DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return @@ -1050,12 +1152,12 @@ subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh - DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%Input(1)%Morison%Mesh + DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh - DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%Input(1)%WAMITMesh + DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1565,8 +1667,8 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & ! Get mesh pointers call FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(SrcMod, Turbine, SrcDispMeshLoc, .false., SrcDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(SrcMod, Turbine, SrcDispMeshLoc, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return call FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return ! If any meshes aren't commited, return @@ -1591,7 +1693,7 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & return end if - call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return call FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Create mapping description @@ -1602,10 +1704,10 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & ! Initialize mapping structure Mapping%MapType = Map_LoadMesh - Mapping%SrcModIdx = SrcMod%Idx + Mapping%iModSrc = SrcMod%iMod Mapping%SrcModID = SrcMod%ID Mapping%SrcIns = SrcMod%Ins - Mapping%DstModIdx = DstMod%Idx + Mapping%iModDst = DstMod%iMod Mapping%DstModID = DstMod%ID Mapping%DstIns = DstMod%Ins Mapping%SrcMeshLoc = SrcMeshLoc @@ -1708,7 +1810,7 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL ! Get mesh pointers call FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return ! If source or destination meshes aren't commited, return if (.not. (SrcMesh%committed .and. DstMesh%committed)) return @@ -1730,10 +1832,10 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL ! Initialize mapping structure Mapping%MapType = Map_MotionMesh - Mapping%SrcModIdx = SrcMod%Idx + Mapping%iModSrc = SrcMod%iMod Mapping%SrcModID = SrcMod%ID Mapping%SrcIns = SrcMod%Ins - Mapping%DstModIdx = DstMod%Idx + Mapping%iModDst = DstMod%iMod Mapping%DstModID = DstMod%ID Mapping%DstIns = DstMod%Ins Mapping%SrcMeshLoc = SrcMeshLoc @@ -1795,8 +1897,8 @@ subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, Err ! Initialize mapping structure Mapping%Desc = Key Mapping%MapType = Map_Variable - Mapping%SrcModIdx = SrcMod%Idx - Mapping%DstModIdx = DstMod%Idx + Mapping%iModSrc = SrcMod%iMod + Mapping%iModDst = DstMod%iMod Mapping%SrcModID = SrcMod%ID Mapping%DstModID = DstMod%ID Mapping%SrcIns = SrcMod%Ins @@ -1823,8 +1925,8 @@ subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) ! Initialize mapping structure Mapping%Desc = Desc Mapping%MapType = Map_Custom - Mapping%SrcModIdx = SrcMod%Idx - Mapping%DstModIdx = DstMod%Idx + Mapping%iModSrc = SrcMod%iMod + Mapping%iModDst = DstMod%iMod Mapping%SrcModID = SrcMod%ID Mapping%DstModID = DstMod%ID Mapping%SrcIns = SrcMod%Ins @@ -1913,12 +2015,12 @@ function MeshTransferType(SrcMesh, DstMesh) result(XfrType) end if end function -subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrStat, ErrMsg, dUdu, dUdy) +subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ModXfr, ErrStat, ErrMsg, dUdu, dUdy) type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type type(ModDataType), intent(in) :: Mods(:) !< Module data - type(MappingType), intent(inout) :: Mappings(:) + type(MappingType), intent(inout) :: Mappings(:) integer(IntKi), intent(in) :: ModOrder(:) - type(VarsIdxType), intent(in) :: Idx + type(ModXfrType), intent(in) :: ModXfr(:) integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg real(R8Ki), intent(inout) :: dUdu(:, :), dUdy(:, :) @@ -1926,7 +2028,7 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrSta character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: iLocSrc(2), iLocDst(2), nLocSrc, nLocDst + integer(IntKi) :: iLocSrc(2), iLocDst(2), nLocSrc, nLocDst, iMod integer(IntKi) :: i, j, k type(MeshType), pointer :: SrcMesh, DstMesh type(MeshType), pointer :: SrcDispMesh, DstDispMesh @@ -1937,9 +2039,13 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrSta ! Loop through modules in specified order do i = 1, size(ModOrder) + ! Get module index + iMod = ModOrder(i) + ! Loop through mappings where this module is the destination - do j = 1, size(Mods((ModOrder(i)))%DstMaps) - associate (Mapping => Mappings(Mods((ModOrder(i)))%DstMaps(j))) + do j = 1, size(Mods(iMod)%DstMaps) + + associate (Mapping => Mappings(Mods(iMod)%DstMaps(j))) ! Select based on type of mapping select case (Mapping%MapType) @@ -1947,9 +2053,8 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrSta case (Map_Variable) ! Get source and destination global value indices, skip if no global index for either - call Idx_GetValLoc(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrc, iGbl=iLocSrc) - call Idx_GetValLoc(Idx%u, Mapping%DstModIdx, Mapping%iVarDst, iGbl=iLocDst) - if (iLocSrc(1) == 0 .or. iLocDst(1) == 0) cycle + if (.not. ModD_GetValLoc(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrc, iDst=iLocSrc)) cycle + if (.not. ModD_GetValLoc(ModXfr(Mapping%iModDst)%u, Mapping%iVarDst, iDst=iLocDst)) cycle ! Get number of source and destination locations nLocSrc = iLocSrc(2) - iLocSrc(1) + 1 @@ -1972,8 +2077,8 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrSta case (Map_MotionMesh) ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return ! Perform linearization based on transfer type call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap); if (Failed()) return @@ -1987,12 +2092,12 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, Idx, ErrSta case (Map_LoadMesh) ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, .false., DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return ! Get source and destination displacement meshes - call FAST_InputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcDispMeshLoc, .false., SrcDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDispMeshLoc, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return ! If DstDispMesh is a sibling of DstMesh if (Mapping%DstUsesSibling) then @@ -2077,17 +2182,17 @@ subroutine Assemble_dUdu(Mapping) ! Effect of input Translation Displacement on input Translation Velocity if (allocated(Mapping%MeshMap%dM%tv_uD)) then - call SumBlock(Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_uD, dUdu) + call SumBlock(ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_uD, dUdu) end if ! Effect of input Translation Displacement on input Translation Acceleration if (allocated(Mapping%MeshMap%dM%ta_uD)) then - call SumBlock(Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_uD, dUdu) + call SumBlock(ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_uD, dUdu) end if ! Effect of input Translation Displacement on input Moments if (allocated(Mapping%MeshMap%dM%M_uS)) then - call SumBlock(Idx%u, Mapping%SrcModIdx, Mapping%iVarSrcDispTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%M_uS, dUdu) + call SumBlock(ModXfr(Mapping%iModSrc)%u, Mapping%iVarSrcDispTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%MeshMap%dM%M_uS, dUdu) end if end subroutine @@ -2102,26 +2207,26 @@ subroutine Assemble_dUdy_Loads(Mapping) ! Load identity if (allocated(Mapping%MeshMap%dM%li)) then - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcForce, Idx%u, Mapping%DstModIdx, Mapping%iVarDstForce, Mapping%MeshMap%dM%li, dUdy) - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcMoment, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%li, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcForce, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstForce, Mapping%MeshMap%dM%li, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcMoment, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%MeshMap%dM%li, dUdy) end if ! Force to Moment if (allocated(Mapping%MeshMap%dM%m_f)) then - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcForce, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_f, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcForce, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_f, dUdy) end if ! Destination Translation Displacement to Moment if (allocated(Mapping%MeshMap%dM%m_uD)) then if (Mapping%DstUsesSibling) then ! Direct transfer - call SumBlock(Idx%y, Mapping%DstModIdx, Mapping%iVarDstDispTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_uD, dUdy) + call SumBlock(ModXfr(Mapping%iModDst)%y, Mapping%iVarDstDispTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_uD, dUdy) else ! Compose linearization of motion and loads Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%mi) - call SumBlock(Idx%y, Mapping%DstModIdx, Mapping%iVarDstDispTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%TmpMatrix, dUdy) + call SumBlock(ModXfr(Mapping%iModDst)%y, Mapping%iVarDstDispTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%TmpMatrix, dUdy) Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%fx_p) - call SumBlock(Idx%y, Mapping%DstModIdx, Mapping%iVarDstDispOrientation, Idx%u, Mapping%DstModIdx, Mapping%iVarDstMoment, Mapping%TmpMatrix, dUdy) + call SumBlock(ModXfr(Mapping%iModDst)%y, Mapping%iVarDstDispOrientation, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%TmpMatrix, dUdy) end if end if end subroutine @@ -2143,54 +2248,49 @@ subroutine Assemble_dUdy_Motions(Mapping) ! Motion identity if (allocated(Mapping%MeshMap%dM%mi)) then - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcOrientation, Idx%u, Mapping%DstModIdx, Mapping%iVarDstOrientation, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstAngularVel, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstAngularAcc, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcOrientation, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstOrientation, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransVel, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularVel, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstAngularVel, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransAcc, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularAcc, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstAngularAcc, Mapping%MeshMap%dM%mi, dUdy) end if ! Rotation to Translation if (allocated(Mapping%MeshMap%dM%fx_p)) then - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcOrientation, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%fx_p, dUdy) - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%fx_p, dUdy) - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularAcc, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcOrientation, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularVel, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularAcc, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%fx_p, dUdy) end if ! Translation displacement to Translation velocity if (allocated(Mapping%MeshMap%dM%tv_us)) then - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_us, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_us, dUdy) end if ! Translation displacement to Translation acceleration if (allocated(Mapping%MeshMap%dM%ta_us)) then - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcTransDisp, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_us, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_us, dUdy) end if ! Angular velocity to Translation acceleration if (allocated(Mapping%MeshMap%dM%ta_rv)) then - call SumBlock(Idx%y, Mapping%SrcModIdx, Mapping%iVarSrcAngularVel, Idx%u, Mapping%DstModIdx, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_rv, dUdy) + call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularVel, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_rv, dUdy) end if end subroutine - subroutine SumBlock(IdxSrc, iModSrc, iVarSrc, IdxDst, iModDst, iVarDst, SrcM, DstM) - type(VarIdxType), intent(in) :: IdxDst, IdxSrc - integer(IntKi), intent(in) :: iModDst, iModSrc + subroutine SumBlock(XfrSrc, iVarSrc, XfrDst, iVarDst, SrcM, DstM) + type(VarXfrType), intent(in) :: XfrDst(:), XfrSrc(:) integer(IntKi), intent(in) :: iVarDst, iVarSrc real(R8Ki), intent(in) :: SrcM(:, :) real(R8Ki), intent(inout) :: DstM(:, :) - integer(IntKi) :: iLocSrc(2), iLocDst(2) ! If no variable index for source or destination, return if (iVarDst == 0 .or. iVarSrc == 0) return ! Get global indices for source/destination modules/variables - call Idx_GetValLoc(IdxSrc, iModSrc, iVarSrc, iGbl=iLocSrc) - call Idx_GetValLoc(IdxDst, iModDst, iVarDst, iGbl=iLocDst) - - ! If no global indices for source or destination, return - if (iLocDst(1) == 0 .or. iLocSrc(1) == 0) return + if (.not. ModD_GetValLoc(XfrSrc, iVarSrc, iDst=iLocSrc)) return + if (.not. ModD_GetValLoc(XfrDst, iVarDst, iDst=iLocDst)) return ! Subtracts the source matrix from the destination sub-matrix associate (DstSubM => DstM(iLocDst(1):iLocDst(2), iLocSrc(1):iLocSrc(2))) @@ -2204,14 +2304,14 @@ logical function Failed() end function end subroutine -subroutine FAST_InputSolve(ModData, Mods, Mappings, Turbine, ErrStat, ErrMsg, UseU) +subroutine FAST_InputSolve(ModData, Mods, Mappings, InputIndex, Turbine, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData !< Module data type(ModDataType), intent(in) :: Mods(:) !< Module data - type(MappingType), intent(inout) :: Mappings(:) !< Mesh and variable mappings + type(MappingType), intent(inout) :: Mappings(:) !< Mesh and variable mappings + integer(IntKi), intent(in) :: InputIndex !< Input index to store data type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - logical, intent(in) :: UseU ! Flag to transfer to u instead of Input character(*), parameter :: RoutineName = 'FAST_InputSolve' integer(IntKi) :: ErrStat2 @@ -2232,7 +2332,7 @@ subroutine FAST_InputSolve(ModData, Mods, Mappings, Turbine, ErrStat, ErrMsg, Us case (Map_Custom) - call Custom_InputSolve(Turbine, Mapping, ErrStat2, ErrMsg2, UseU) + call Custom_InputSolve(Turbine, Mapping, InputIndex, ErrStat2, ErrMsg2) if (Failed()) return case (Map_Variable) @@ -2240,42 +2340,42 @@ subroutine FAST_InputSolve(ModData, Mods, Mappings, Turbine, ErrStat, ErrMsg, Us case (Map_MotionMesh) ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU, DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstMeshLoc, DstMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return - ! Perform linearization based on transfer type + ! Perform transfer based on type select case (Mapping%XfrType) case (Xfr_Point_to_Point) - call Linearize_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + call Transfer_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) case (Xfr_Point_to_Line2) - call Linearize_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + call Transfer_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) case (Xfr_Line2_to_Point) - call Linearize_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + call Transfer_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) case (Xfr_Line2_to_Line2) - call Linearize_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + call Transfer_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) end select if (Failed()) return case (Map_LoadMesh) ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstMeshLoc, UseU, DstMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstMeshLoc, DstMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return ! Get source and destination displacement meshes - call FAST_InputMeshPointer(Mods(Mapping%SrcModIdx), Turbine, Mapping%SrcDispMeshLoc, UseU, SrcDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(Mods(Mapping%DstModIdx), Turbine, Mapping%DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDispMeshLoc, SrcDispMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - ! Perform linearization based on transfer type + ! Perform transfer based on type select case (Mapping%XfrType) case (Xfr_Point_to_Point) - call Linearize_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + call Transfer_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) case (Xfr_Point_to_Line2) - call Linearize_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + call Transfer_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) case (Xfr_Line2_to_Point) - call Linearize_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + call Transfer_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) case (Xfr_Line2_to_Line2) - call Linearize_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) + call Transfer_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) end select if (Failed()) return @@ -2292,12 +2392,12 @@ logical function Failed() end function end subroutine -subroutine Custom_InputSolve(T, Mapping, ErrStat, ErrMsg, UseU) +subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - type(MappingType), intent(in) :: Mapping + type(MappingType), intent(in) :: Mapping + integer(IntKi), intent(in) :: InputIndex integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - logical, intent(in) :: UseU ! Flag to transfer to u instead of Input character(*), parameter :: RoutineName = 'Custom_InputSolve' integer(IntKi) :: ErrStat2 @@ -2318,36 +2418,36 @@ subroutine Custom_InputSolve(T, Mapping, ErrStat, ErrMsg, UseU) select case (Mapping%DstModID) case (Module_AD) - if (UseU) then - u_AD => T%AD%u + if (InputIndex > 0) then + u_AD => T%AD%Input(InputIndex) else - u_AD => T%AD%Input(1) + u_AD => T%AD%u end if case (Module_ED) - if (UseU) then - u_ED => T%ED%u + if (InputIndex > 0) then + u_ED => T%ED%Input(InputIndex) else - u_ED => T%ED%Input(1) + u_ED => T%ED%u end if case (Module_ExtLd) u_ExtLd => T%ExtLd%u case (Module_IfW) - if (UseU) then - u_IfW => T%IfW%u + if (InputIndex > 0) then + u_IfW => T%IfW%Input(InputIndex) else - u_IfW => T%IfW%Input(1) + u_IfW => T%IfW%u end if case (Module_SD) - if (UseU) then - u_SD => T%SD%u + if (InputIndex > 0) then + u_SD => T%SD%Input(InputIndex) else - u_SD => T%SD%Input(1) + u_SD => T%SD%u end if case (Module_SrvD) - if (UseU) then - u_SrvD => T%SrvD%u + if (InputIndex > 0) then + u_SrvD => T%SrvD%Input(InputIndex) else - u_SrvD => T%SrvD%Input(1) + u_SrvD => T%SrvD%u end if end select diff --git a/modules/openfast-library/src/FAST_ModData.f90 b/modules/openfast-library/src/FAST_ModData.f90 new file mode 100644 index 0000000000..5bd888141c --- /dev/null +++ b/modules/openfast-library/src/FAST_ModData.f90 @@ -0,0 +1,413 @@ +!********************************************************************************************************************************** +! FAST_ModLin.f90 performs linearization using the ModVars module. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +module FAST_ModData + +use NWTC_Library +use NWTC_LAPACK + +use FAST_Types + +implicit none + +private +public :: ModD_AddModule +public :: ModD_GetValLoc, GetModuleOrder +public :: ModD_PackAry, ModD_PackMatrix, ModD_CombineModules + +contains + +subroutine GetModuleOrder(Mods, ModIDs, ModOrder) + type(ModDataType), intent(in) :: Mods(:) !< Array of module data structures + integer(IntKi), intent(in) :: ModIDs(:) !< List of module IDs to keep in order + integer(IntKi), allocatable, intent(out) :: ModOrder(:) !< Module data indices in order of ModIDs + integer(IntKi), allocatable :: ModIDAry(:), indices(:) + integer(IntKi) :: i + + ! Create array 1 to size(Mod) representing the index of each module data + indices = [(i, i=1, size(Mods))] + + ! Get array of module IDs from array of module data + ModIDAry = [(Mods(i)%ID, i=1, size(Mods))] + + ! Initialize module order array with no size + allocate (ModOrder(0)) + + ! Loop through module IDs to keep, add module data indices that match module ID to order array + do i = 1, size(ModIDs) + ModOrder = [ModOrder, pack(indices, ModIDAry == ModIDs(i))] + end do + +end subroutine + +subroutine ModD_CombineModules(ModAry, iModOrder, FlagFilter, Linearize, ModOut, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModAry(:) + integer(IntKi), intent(in) :: iModOrder(:) + integer(IntKi), intent(in) :: FlagFilter + type(ModDataType), intent(out) :: ModOut + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModD_Build' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: NumVars + integer(IntKi) :: iGbl(2) + integer(IntKi) :: i, j, k + integer(IntKi) :: iMod + integer(IntKi) :: xNum, xdNum, zNum, uNum, yNum + integer(IntKi) :: ix, ixd, iz, iu, iy + character(20) :: NamePrefix + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + ! If no modules or order is empty, return error + if ((size(ModAry) == 0) .or. (size(iModOrder) == 0)) then + call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) + return + end if + + !---------------------------------------------------------------------------- + ! Construct index to lookup variables + !---------------------------------------------------------------------------- + + ! Allocate variable index array with size equal to number of modules + allocate (ModOut%Xfr(size(ModAry)), stat=ErrStat2) + if (FailedAlloc("ModOut%Xfr")) return + + !---------------------------------------------------------------------------- + ! Combine modules into output module + !---------------------------------------------------------------------------- + + ! Clear module linearization abbreviation + ModOut%Lin%Abbr = "" + + ! Allocate variable structure for glue + allocate (ModOut%Vars) + + ! Initialize number of variables in each group + xNum = 0; xdNum = 0; zNum = 0; uNum = 0; yNum = 0 + + ! Loop through each module and sum the number of variables that will be in + ! the combined module + do i = 1, size(iModOrder) + iMod = iModOrder(i) + associate (ModData => ModAry(iMod)) + + ! Continuous state + call CountVariablesFiltered(ModData%Vars%x, NumVars) + allocate (ModOut%Xfr(iMod)%x(NumVars), stat=ErrStat2) + if (FailedAlloc("ModOut%Xfr(iMod)%x")) return + xNum = xNum + NumVars + + ! Discrete state + call CountVariablesFiltered(ModData%Vars%xd, NumVars) + allocate (ModOut%Xfr(iMod)%xd(NumVars), stat=ErrStat2) + if (FailedAlloc("ModOut%Xfr(iMod)%xd")) return + xdNum = xdNum + NumVars + + ! Constraint state + call CountVariablesFiltered(ModData%Vars%z, NumVars) + allocate (ModOut%Xfr(iMod)%z(NumVars), stat=ErrStat2) + if (FailedAlloc("ModOut%Xfr(iMod)%z")) return + zNum = zNum + NumVars + + ! Input + call CountVariablesFiltered(ModData%Vars%u, NumVars) + allocate (ModOut%Xfr(iMod)%u(NumVars), stat=ErrStat2) + if (FailedAlloc("ModOut%Xfr(iMod)%u")) return + uNum = uNum + NumVars + + ! Output + call CountVariablesFiltered(ModData%Vars%y, NumVars) + allocate (ModOut%Xfr(iMod)%y(NumVars), stat=ErrStat2) + if (FailedAlloc("ModOut%Xfr(iMod)%y")) return + yNum = yNum + NumVars + + end associate + end do + + ! Allocate arrays for to hold combined variables + allocate (ModOut%Vars%x(xNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%x")) return + allocate (ModOut%Vars%xd(xdNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%xd")) return + allocate (ModOut%Vars%z(zNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%z")) return + allocate (ModOut%Vars%u(uNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%u")) return + allocate (ModOut%Vars%y(yNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%y")) return + + ! Initialize variable index counters + ix = 1; ixd = 1; iz = 1; iu = 1; iy = 1 + + ! Initialize number of values in each group variable group + ModOut%Vars%Nx = 0 + ModOut%Vars%Nxd = 0 + ModOut%Vars%Nz = 0 + ModOut%Vars%Nu = 0 + ModOut%Vars%Ny = 0 + + ! Loop through each module by index and add variables + do i = 1, size(iModOrder) + iMod = iModOrder(i) + associate (ModData => ModAry(iMod)) + + ! Create variable name prefix for linearization names. Add instance + ! number to module abbreviation if more than 1 instance or the module is BeamDyn + if ((ModData%ID == Module_BD) .or. (count(ModAry%ID == ModData%ID) > 1)) then + NamePrefix = trim(ModData%Abbr)//"_"//Num2LStr(ModData%Ins) + ModData%Lin%Abbr = "."//trim(ModData%Abbr)//Num2LStr(ModData%Ins) + else + NamePrefix = ModData%Abbr + ModData%Lin%Abbr = "."//ModData%Abbr + end if + + if (size(ModData%Vars%x) > 0) call AddVariables(ModData%Vars%x, ModOut%Vars%x, ModOut%Xfr(iMod)%x, ix, ModOut%Vars%Nx) ! Continuous state + if (size(ModData%Vars%xd) > 0) call AddVariables(ModData%Vars%xd, ModOut%Vars%xd, ModOut%Xfr(iMod)%xd, ixd, ModOut%Vars%Nxd) ! Discrete state + if (size(ModData%Vars%z) > 0) call AddVariables(ModData%Vars%z, ModOut%Vars%z, ModOut%Xfr(iMod)%z, iz, ModOut%Vars%Nz) ! Constraint state + if (size(ModData%Vars%u) > 0) call AddVariables(ModData%Vars%u, ModOut%Vars%u, ModOut%Xfr(iMod)%u, iu, ModOut%Vars%Nu) ! Input + if (size(ModData%Vars%y) > 0) call AddVariables(ModData%Vars%y, ModOut%Vars%y, ModOut%Xfr(iMod)%y, iy, ModOut%Vars%Ny) ! Output + end associate + end do + +contains + + subroutine AddVariables(VarAryIn, VarAryOut, VarXfr, iVar, iVal) + type(ModVarType), intent(in) :: VarAryIn(:) + type(ModVarType), intent(inout) :: VarAryOut(:) + type(VarXfrType), intent(inout) :: VarXfr(:) + integer(IntKi), intent(inout) :: iVar + integer(IntKi), intent(inout) :: iVal + + integer(IntKi) :: NumVals, iXfr + + iXfr = 1 + + ! Loop through variables in original module + do k = 1, size(VarAryIn) + + ! If filter flag is not none and variable doesn't have flag, cycle + if (.not. MV_HasFlags(VarAryIn(k), FlagFilter) .and. FlagFilter /= VF_None) cycle + + associate (Var => VarAryOut(iVar)) + + ! Add variable to module + VarAryOut(iVar) = VarAryIn(k) + + ! Get number of values in variable + NumVals = VarAryIn(k)%Num + + ! Set value indices in combined module + Var%iLoc = [iVal + 1, iVal + NumVals] + + ! Increment global value index + iVal = iVal + NumVals + + ! Set transfer index + VarXfr(iXfr)%iVar = k ! Variable number in source module + VarXfr(iXfr)%NumVals = NumVals ! Number of values in variable + VarXfr(iXfr)%iSrc = VarAryIn(k)%iLoc ! value start-end indices in source module + VarXfr(iXfr)%iDst = Var%iLoc ! Value start-end indices in destination module + + ! Increment transfer index + iXfr = iXfr + 1 + + ! Prepend module names + call AddLinNamePrefix(Var, NamePrefix) + + ! Increment variable index + iVar = iVar + 1 + + end associate + + end do + + end subroutine + + subroutine CountVariablesFiltered(VarAry, nVars) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(out) :: nVars + nVars = 0 + ! If no filter + if (FlagFilter == VF_None) then + ! Count all variables in array + nVars = size(VarAry) + else + ! Loop through filters and increment nVars if they have the flag + do k = 1, size(VarAry) + if (MV_HasFlags(VarAry(k), FlagFilter)) nVars = nVars + 1 + end do + end if + end subroutine + + subroutine AddLinNamePrefix(Var, Prefix) + type(ModVarType), intent(inout) :: Var + character(*), intent(in) :: Prefix + integer(IntKi) :: j + if (allocated(Var%LinNames)) then + do j = 1, size(Var%LinNames) + Var%LinNames(j) = trim(Prefix)//" "//Var%LinNames(j) + end do + end if + end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function + + logical function FailedAlloc(name) + character(*), intent(in) :: name + if (ErrStat2 == 0) then + FailedAlloc = .false. + else + call SetErrStat(ErrID_Fatal, "Failed to allocate "//name, ErrStat, ErrMsg, RoutineName) + FailedAlloc = .true. + end if + end function + +end subroutine + +! ModD_GetValLoc is used to get the global or module value indices based on module index and variable index. +! iMod is the start and end indices of the values in the module data +! iGbl is teh start and end indices of the values in the global data +logical function ModD_GetValLoc(VarXfrAry, iVar, iSrc, iDst) result(Active) + type(VarXfrType), intent(in) :: VarXfrAry(:) + integer(IntKi), intent(in) :: iVar + integer(IntKi), optional, intent(out) :: iSrc(2), iDst(2) + integer(IntKi) :: i + do i = 1, size(VarXfrAry) + if (VarXfrAry(i)%iVar /= iVar) cycle + if (present(iSrc)) iSrc = VarXfrAry(i)%iSrc + if (present(iDst)) iDst = VarXfrAry(i)%iDst + Active = .true. + return + end do + Active = .false. +end function + +subroutine ModD_PackAry(VarXfrAry, SrcAry, DstAry) + type(VarXfrType), intent(in) :: VarXfrAry(:) + real(R8Ki), intent(in) :: SrcAry(:) + real(R8Ki), intent(inout) :: DstAry(:) + integer(IntKi) :: i + do i = 1, size(VarXfrAry) + DstAry(VarXfrAry(i)%iDst(1):VarXfrAry(i)%iDst(2)) = & + SrcAry(VarXfrAry(i)%iSrc(1):VarXfrAry(i)%iSrc(2)) + end do +end subroutine + +subroutine ModD_PackMatrix(RowXfrAry, ColXfrAry, SrcMat, DstMat) + type(VarXfrType), intent(in) :: RowXfrAry(:), ColXfrAry(:) + real(R8Ki), intent(in) :: SrcMat(:, :) + real(R8Ki), intent(inout) :: DstMat(:, :) + integer(IntKi) :: i, j + do i = 1, size(RowXfrAry) + do j = 1, size(ColXfrAry) + DstMat(RowXfrAry(i)%iDst(1):RowXfrAry(i)%iDst(2), ColXfrAry(j)%iDst(1):ColXfrAry(j)%iDst(2)) = & + SrcMat(RowXfrAry(i)%iSrc(1):RowXfrAry(i)%iSrc(2), ColXfrAry(j)%iSrc(1):ColXfrAry(j)%iSrc(2)) + end do + end do +end subroutine + +subroutine ModD_AddModule(Mods, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: Mods(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: ModDT + real(R8Ki), intent(in) :: SolverDT + type(ModVarsType), pointer, intent(in) :: Vars + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModD_AddModule' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + integer(IntKi) :: iMod + + ErrStat = ErrID_None + ErrMsg = '' + + ! If module array hasn't been allocated, allocate with zero size + if (.not. allocated(Mods)) allocate (Mods(0)) + + ! Populate ModuleDataType derived type + ModData = ModDataType(iMod=size(Mods) + 1, ID=ModID, Abbr=ModAbbr, & + Ins=Instance, DT=ModDT, Vars=Vars) + + ! Allocate source and destination mapping arrays + call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Calculate Module Substepping + !---------------------------------------------------------------------------- + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData%DT, SolverDT)) then + ModData%SubSteps = 1 + else + ! If the module time step is greater than the global time step, set error + if (ModData%DT > SolverDT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate the number of substeps + ModData%SubSteps = nint(SolverDT/ModData%DT) + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Add module data to array + !---------------------------------------------------------------------------- + + Mods = [Mods, ModData] + + ! Get index of newly added module + iMod = size(Mods) + + ! Set module index in each variable + ModData%Vars%x%iMod = iMod + ModData%Vars%xd%iMod = iMod + ModData%Vars%z%iMod = iMod + ModData%Vars%u%iMod = iMod + ModData%Vars%y%iMod = iMod + +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 9c6584c2e2..18806cba0f 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -24,6 +24,7 @@ module FAST_ModGlue use NWTC_LAPACK use FAST_ModTypes +use FAST_ModData use FAST_Types use FAST_Funcs use FAST_Mapping @@ -31,9 +32,10 @@ module FAST_ModGlue implicit none private -public :: ModGlue_Init, MV_AddModule +public :: ModGlue_Init public :: ModGlue_Linearize_OP, ModGlue_CalcSteady public :: ModGlue_SaveOperatingPoint, ModGlue_RestoreOperatingPoint +public :: CalcWriteLinearMatrices contains @@ -54,7 +56,6 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) integer(IntKi), allocatable :: modIDs(:), modIdx(:) integer(IntKi) :: i, j, k integer(IntKi) :: FlagFilters - character(20) :: NamePrefix ! Initialize error return ErrStat = ErrID_None @@ -85,96 +86,30 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Loop through modules, if module is not in index, return with error do i = 1, size(m%Modules) if (.not. any(i == p%Lin%iMod)) then - call SetErrStat(ErrID_Fatal, "Module "//trim(m%Modules(i)%Abbr)//" not supported in linearization", & - ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Module "//trim(m%Modules(i)%Abbr)// & + " not supported in linearization", ErrStat, ErrMsg, RoutineName) return end if end do !---------------------------------------------------------------------------- - ! Glue Module Variables + ! Set Variable Flags for linearization !---------------------------------------------------------------------------- - ! Allocate variable structure for glue - allocate (y%ModGlue%Vars) - - ! Initialize number of values in each variable group - y%ModGlue%Vars%Nx = 0 - y%ModGlue%Vars%Nxd = 0 - y%ModGlue%Vars%Nz = 0 - y%ModGlue%Vars%Nu = 0 - y%ModGlue%Vars%Ny = 0 - - ! Allocate arrays for glue variables - allocate (y%ModGlue%Vars%x(0), y%ModGlue%Vars%xd(0), y%ModGlue%Vars%z(0), y%ModGlue%Vars%u(0), y%ModGlue%Vars%y(0)) - ! Loop through each module by index do i = 1, size(p%Lin%iMod) associate (ModData => m%Modules(p%Lin%iMod(i))) - ! Create variable name prefix for linearization names. Add instance - ! number to module abbreviation if more than 1 instance or the module is BeamDyn - NamePrefix = ModData%Abbr - if ((ModData%ID == Module_BD) .or. (count(modIDs == ModData%ID) > 1)) then - NamePrefix = trim(NamePrefix)//"_"//Num2LStr(ModData%Ins) - end if - - !---------------------------------------------------------------------- - ! Module continuous state variables - !---------------------------------------------------------------------- - - ! Set linearize flag on all variables + ! Set linearize flag on all continuous state variables do j = 1, size(ModData%Vars%x) call MV_SetFlags(ModData%Vars%x(j), VF_Linearize) end do - ! Set module data start index in global arrays, increment data size - y%ModGlue%Vars%Nx = y%ModGlue%Vars%Nx + ModData%Vars%Nx - - ! Save start index of module variables and append to glue code variables - k = size(y%ModGlue%Vars%x) + 1 - y%ModGlue%Vars%x = [y%ModGlue%Vars%x, ModData%Vars%x] - - ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(y%ModGlue%Vars%x(k:), NamePrefix) - - !---------------------------------------------------------------------- - ! Module discrete state variables - !---------------------------------------------------------------------- - - ! Set module data start index in global arrays, increment data size - y%ModGlue%Vars%Nxd = y%ModGlue%Vars%Nxd + ModData%Vars%Nxd - - ! Save start index of module variables and append to glue code variables - k = size(y%ModGlue%Vars%xd) + 1 - y%ModGlue%Vars%xd = [y%ModGlue%Vars%xd, ModData%Vars%xd] - - ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(y%ModGlue%Vars%xd(k:), NamePrefix) - - !---------------------------------------------------------------------- - ! Module constraint state variables - !---------------------------------------------------------------------- - - ! Set module data start index in global arrays, increment data size - y%ModGlue%Vars%Nz = y%ModGlue%Vars%Nz + ModData%Vars%Nz - - ! Save start index of module variables and append to glue code variables - k = size(y%ModGlue%Vars%z) + 1 - y%ModGlue%Vars%z = [y%ModGlue%Vars%z, ModData%Vars%z] - - ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(y%ModGlue%Vars%z(k:), NamePrefix) - - !---------------------------------------------------------------------- - ! Module input variables - !---------------------------------------------------------------------- - - ! Add or remove linearize flag based on requested output + ! Add or remove linearize flag based on requested input select case (p_FAST%LinInputs) case (LIN_NONE) do j = 1, size(ModData%Vars%u) - call MV_UnsetFlags(ModData%Vars%u(j), VF_Linearize) + call MV_ClearFlags(ModData%Vars%u(j), VF_Linearize) end do case (LIN_STANDARD) ! For standard inputs, use VF_Linearize flag as set in the module @@ -184,32 +119,18 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) end do end select - ! Set module data start index in global arrays, increment data size - y%ModGlue%Vars%Nu = y%ModGlue%Vars%Nu + ModData%Vars%Nu - - ! Save start index of module variables and append to glue code variables - k = size(y%ModGlue%Vars%u) + 1 - y%ModGlue%Vars%u = [y%ModGlue%Vars%u, ModData%Vars%u] - - ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(y%ModGlue%Vars%u(k:), NamePrefix) - - !---------------------------------------------------------------------- - ! Module output variables - !---------------------------------------------------------------------- - ! Add or remove linearize flag based on requested output select case (p_FAST%LinOutputs) case (LIN_NONE) do j = 1, size(ModData%Vars%y) - call MV_UnsetFlags(ModData%Vars%y(j), VF_Linearize) + call MV_ClearFlags(ModData%Vars%y(j), VF_Linearize) end do case (LIN_STANDARD) ! Set linearize flag for write output variables do j = 1, size(ModData%Vars%y) if (MV_HasFlags(ModData%Vars%y(j), VF_WriteOut)) then call MV_SetFlags(ModData%Vars%y(j), VF_Linearize) else - call MV_UnsetFlags(ModData%Vars%y(j), VF_Linearize) + call MV_ClearFlags(ModData%Vars%y(j), VF_Linearize) end if end do case (LIN_ALL) @@ -218,25 +139,14 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) end do end select - ! Set module data start index in global arrays, increment data size - y%ModGlue%Vars%Ny = y%ModGlue%Vars%Ny + ModData%Vars%Ny - - ! Save start index of module variables and append to glue code variables - k = size(y%ModGlue%Vars%y) + 1 - y%ModGlue%Vars%y = [y%ModGlue%Vars%y, ModData%Vars%y] - - ! Loop through added variables and add name prefix to linearization names - call AddLinNamePrefix(y%ModGlue%Vars%y(k:), NamePrefix) - end associate end do - ! Calculate number of values in each group and set data location index - call CalcVarDataLoc(y%ModGlue%Vars%x, y%ModGlue%Vars%Nx) - call CalcVarDataLoc(y%ModGlue%Vars%xd, y%ModGlue%Vars%Nxd) - call CalcVarDataLoc(y%ModGlue%Vars%z, y%ModGlue%Vars%Nz) - call CalcVarDataLoc(y%ModGlue%Vars%u, y%ModGlue%Vars%Nu) - call CalcVarDataLoc(y%ModGlue%Vars%y, y%ModGlue%Vars%Ny) + !---------------------------------------------------------------------------- + ! Glue Module + !---------------------------------------------------------------------------- + + call ModD_CombineModules(m%Modules, p%Lin%iMod, VF_None, p_FAST%Linearize, m%ModGlue, ErrStat2, ErrMsg2) !---------------------------------------------------------------------------- ! Mesh Mapping @@ -265,30 +175,27 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Set flag to save operating points during linearization if mode shapes requested p%Lin%SaveOPs = p_FAST%WrVTK == VTK_ModeShapes - ! Initialize linearization index - call Idx_Init(m%Modules, p%Lin%iMod, p%Lin%Idx, VF_None, ErrStat2, ErrMsg2); if (Failed()) return - ! Allocate linearization arrays - call AllocAry(y%ModGlue%Lin%x, y%ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%dx, y%ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%xd, y%ModGlue%Vars%Nxd, "xd", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%z, y%ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%u, y%ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%y, y%ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%x, m%ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%dx, m%ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%xd, m%ModGlue%Vars%Nxd, "xd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%z, m%ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%u, m%ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%y, m%ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return ! Allocate full Jacobian matrices - call AllocAry(y%ModGlue%Lin%dYdu, y%ModGlue%Vars%Ny, y%ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%dXdu, y%ModGlue%Vars%Nx, y%ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%dYdx, y%ModGlue%Vars%Ny, y%ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%dXdx, y%ModGlue%Vars%Nx, y%ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%dUdu, y%ModGlue%Vars%Nu, y%ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%ModGlue%Lin%dUdy, y%ModGlue%Vars%Nu, y%ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%dYdu, m%ModGlue%Vars%Ny, m%ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%dXdu, m%ModGlue%Vars%Nx, m%ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%dYdx, m%ModGlue%Vars%Ny, m%ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%dXdx, m%ModGlue%Vars%Nx, m%ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%dUdu, m%ModGlue%Vars%Nu, m%ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%ModGlue%Lin%dUdy, m%ModGlue%Vars%Nu, m%ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return ! Initialize arrays to store operating point states and input - call AllocAry(y%Lin%x, y%ModGlue%Vars%Nx, p%Lin%NumTimes, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%Lin%xd, y%ModGlue%Vars%Nxd, p%Lin%NumTimes, "Lin%xd", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%Lin%z, y%ModGlue%Vars%Nz, p%Lin%NumTimes, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%Lin%u, y%ModGlue%Vars%Nu, p%Lin%NumTimes, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%x, m%ModGlue%Vars%Nx, p%Lin%NumTimes, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%xd, m%ModGlue%Vars%Nxd, p%Lin%NumTimes, "Lin%xd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%z, m%ModGlue%Vars%Nz, p%Lin%NumTimes, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%u, m%ModGlue%Vars%Nu, p%Lin%NumTimes, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return ! If steady state calculation is enabled if (p_FAST%CalcSteady) then @@ -305,8 +212,8 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Calculate number of output values (ignoring write outputs) m%CS%NumOutputs = 0 - do i = 1, size(y%ModGlue%Vars%y) - associate (Var => y%ModGlue%Vars%y(i)) + do i = 1, size(m%ModGlue%Vars%y) + associate (Var => m%ModGlue%Vars%y(i)) if (.not. MV_HasFlags(Var, VF_WriteOut)) m%CS%NumOutputs = m%CS%NumOutputs + Var%Num end associate end do @@ -315,11 +222,11 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) call AllocAry(y%Lin%Times, p%Lin%NumTimes, "Lin%Times", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%CS%AzimuthTarget, p%Lin%NumTimes, "CS%AzimuthTarget", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%CS%psi_buffer, p_FAST%LinInterpOrder + 1, "CS%psi_buffer", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_buffer, y%ModGlue%Vars%Ny, p_FAST%LinInterpOrder + 1, "CS%y_buffer", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_interp, y%ModGlue%Vars%Ny, "CS%y_interp", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_diff, y%ModGlue%Vars%Ny, "CS%y_diff", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_azimuth, y%ModGlue%Vars%Ny, p%Lin%NumTimes, "CS%y_azimuth", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_ref, y%ModGlue%Vars%Ny, "CS%y_ref", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_buffer, m%ModGlue%Vars%Ny, p_FAST%LinInterpOrder + 1, "CS%y_buffer", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_interp, m%ModGlue%Vars%Ny, "CS%y_interp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_diff, m%ModGlue%Vars%Ny, "CS%y_diff", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_azimuth, m%ModGlue%Vars%Ny, p%Lin%NumTimes, "CS%y_azimuth", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_ref, m%ModGlue%Vars%Ny, "CS%y_ref", ErrStat2, ErrMsg2); if (Failed()) return ! Initialize arrays to zero m%CS%psi_buffer = 0.0_R8Ki @@ -351,19 +258,6 @@ end function Failed end subroutine -subroutine AddLinNamePrefix(VarAry, Prefix) - type(ModVarType), intent(inout) :: VarAry(:) - character(*), intent(in) :: Prefix - integer(IntKi) :: i, j - do i = 1, size(VarAry) - if (allocated(VarAry(i)%LinNames)) then - do j = 1, size(VarAry(i)%LinNames) - VarAry(i)%LinNames(j) = trim(Prefix)//" "//VarAry(i)%LinNames(j) - end do - end if - end do -end subroutine - subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ErrStat, ErrMsg) integer(IntKi), intent(IN) :: n_t_global !< integer time step @@ -415,7 +309,7 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, if (ModData%Vars%Ny == 0) cycle ! Get outputs - call FAST_GetOP(ModData, t_global, STATE_CURR, T, ErrStat2, ErrMsg2, y_op=ModData%Lin%y) + call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, y_op=ModData%Lin%y) if (Failed()) return ! Copy outputs to buffer @@ -476,7 +370,7 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, if (ProcessAzimuth) then ! Interpolate outputs to target azimuth - call MV_ExtrapInterp(y%ModGlue%Vars%y, m%CS%y_buffer, m%CS%psi_buffer, & + call MV_ExtrapInterp(m%ModGlue%Vars%y, m%CS%y_buffer, m%CS%psi_buffer, & m%CS%y_interp, AzimuthTarget, ErrStat2, ErrMsg2) ! If converged @@ -563,14 +457,14 @@ function CalcOutputErrorAtAzimuth() result(eps_squared) ! Calculate difference between interpolated outputs for this rotation and ! interpolated outputs from previous rotation - call MV_ComputeDiff(y%ModGlue%Vars%y, m%CS%y_interp, m%CS%y_azimuth(:, m%Lin%AzimuthIndex), m%CS%y_diff) + call MV_ComputeDiff(m%ModGlue%Vars%y, m%CS%y_interp, m%CS%y_azimuth(:, m%Lin%AzimuthIndex), m%CS%y_diff) ! Initialize epsilon squared sum eps_squared_sum = 0 ! Loop through glue output variables - do i = 1, size(y%ModGlue%Vars%y) - associate (Var => y%ModGlue%Vars%y(i)) + do i = 1, size(m%ModGlue%Vars%y) + associate (Var => m%ModGlue%Vars%y(i)) ! Skip write outputs if (MV_HasFlags(Var, VF_WriteOut)) cycle @@ -619,7 +513,6 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob character(200) :: SimStr character(MaxWrScrLen) :: BlankLine character(1024) :: LinRootName - character(1024) :: OutFileName character(*), parameter :: Fmt = 'F10.2' ! Initialize error return @@ -665,10 +558,10 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob iy = 1 ! Initialize data in Jacobian matrices to zero - y%ModGlue%Lin%dYdu = 0.0_R8Ki - y%ModGlue%Lin%dXdu = 0.0_R8Ki - y%ModGlue%Lin%dYdx = 0.0_R8Ki - y%ModGlue%Lin%dXdx = 0.0_R8Ki + m%ModGlue%Lin%dYdu = 0.0_R8Ki + m%ModGlue%Lin%dXdu = 0.0_R8Ki + m%ModGlue%Lin%dYdx = 0.0_R8Ki + m%ModGlue%Lin%dXdx = 0.0_R8Ki ! Loop through linearization modules by index do i = 1, size(p%Lin%iMod) @@ -687,24 +580,24 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob ! Operating point values (must come after Jacobian routines because ! some modules calculate OP in those routines [MD]) - call FAST_GetOP(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & u_op=ModData%Lin%u, y_op=ModData%Lin%y, & x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) if (Failed()) return ! Copy module linearization arrays into glue linearization arrays - if ((size(y%ModGlue%Lin%x) > 0) .and. allocated(ModData%Lin%x)) y%ModGlue%Lin%x(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%x - if ((size(y%ModGlue%Lin%dx) > 0) .and. allocated(ModData%Lin%dx)) y%ModGlue%Lin%dx(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dx - if ((size(y%ModGlue%Lin%xd) > 0) .and. allocated(ModData%Lin%xd)) y%ModGlue%Lin%xd(ixd:ixd + ModData%Vars%Nxd - 1) = ModData%Lin%xd - if ((size(y%ModGlue%Lin%z) > 0) .and. allocated(ModData%Lin%z)) y%ModGlue%Lin%z(iz:iz + ModData%Vars%Nz - 1) = ModData%Lin%z - if ((size(y%ModGlue%Lin%u) > 0) .and. allocated(ModData%Lin%u)) y%ModGlue%Lin%u(iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%u - if ((size(y%ModGlue%Lin%y) > 0) .and. allocated(ModData%Lin%y)) y%ModGlue%Lin%y(iy:iy + ModData%Vars%Ny - 1) = ModData%Lin%y + if ((size(m%ModGlue%Lin%x) > 0) .and. allocated(ModData%Lin%x)) m%ModGlue%Lin%x(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%x + if ((size(m%ModGlue%Lin%dx) > 0) .and. allocated(ModData%Lin%dx)) m%ModGlue%Lin%dx(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dx + if ((size(m%ModGlue%Lin%xd) > 0) .and. allocated(ModData%Lin%xd)) m%ModGlue%Lin%xd(ixd:ixd + ModData%Vars%Nxd - 1) = ModData%Lin%xd + if ((size(m%ModGlue%Lin%z) > 0) .and. allocated(ModData%Lin%z)) m%ModGlue%Lin%z(iz:iz + ModData%Vars%Nz - 1) = ModData%Lin%z + if ((size(m%ModGlue%Lin%u) > 0) .and. allocated(ModData%Lin%u)) m%ModGlue%Lin%u(iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%u + if ((size(m%ModGlue%Lin%y) > 0) .and. allocated(ModData%Lin%y)) m%ModGlue%Lin%y(iy:iy + ModData%Vars%Ny - 1) = ModData%Lin%y ! Copy module Jacobians into glue code Jacobian - if ((size(y%ModGlue%Lin%dYdu) > 0) .and. allocated(ModData%Lin%dYdu)) y%ModGlue%Lin%dYdu(iy:iy + ModData%Vars%Ny - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dYdu - if ((size(y%ModGlue%Lin%dXdu) > 0) .and. allocated(ModData%Lin%dXdu)) y%ModGlue%Lin%dXdu(ix:ix + ModData%Vars%Nx - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dXdu - if ((size(y%ModGlue%Lin%dYdx) > 0) .and. allocated(ModData%Lin%dYdx)) y%ModGlue%Lin%dYdx(iy:iy + ModData%Vars%Ny - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dYdx - if ((size(y%ModGlue%Lin%dXdx) > 0) .and. allocated(ModData%Lin%dXdx)) y%ModGlue%Lin%dXdx(ix:ix + ModData%Vars%Nx - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dXdx + if ((size(m%ModGlue%Lin%dYdu) > 0) .and. allocated(ModData%Lin%dYdu)) m%ModGlue%Lin%dYdu(iy:iy + ModData%Vars%Ny - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dYdu + if ((size(m%ModGlue%Lin%dXdu) > 0) .and. allocated(ModData%Lin%dXdu)) m%ModGlue%Lin%dXdu(ix:ix + ModData%Vars%Nx - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dXdu + if ((size(m%ModGlue%Lin%dYdx) > 0) .and. allocated(ModData%Lin%dYdx)) m%ModGlue%Lin%dYdx(iy:iy + ModData%Vars%Ny - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dYdx + if ((size(m%ModGlue%Lin%dXdx) > 0) .and. allocated(ModData%Lin%dXdx)) m%ModGlue%Lin%dXdx(ix:ix + ModData%Vars%Nx - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dXdx ! Increment starting index for next module ix = ix + ModData%Vars%Nx @@ -716,15 +609,8 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob ! If writing the module matrices was requested if (p_FAST%LinOutMod) then - ! Assemble output file name based on module abbreviation - ! If module is BeamDyn or more than one instance, include instance - OutFileName = trim(LinRootName)//'.'//trim(ModData%Abbr)//".lin" - if ((ModData%ID == Module_BD) .or. (count(m%Modules%ID == ModData%ID) > 1)) then - OutFileName = trim(LinRootName)//'.'//trim(ModData%Abbr)//trim(Num2LStr(ModData%Ins))//".lin" - end if - ! Write linearization matrices - call CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFileName, .false., ErrStat2, ErrMsg2) + call CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRootName, VF_Linearize, .false., ErrStat2, ErrMsg2) if (Failed()) return end if @@ -736,23 +622,22 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob if (JacobianHasNaNs(ModData%Lin%dXdx, "dXdx", ModData%Abbr)) return ! Copy arrays into linearization operating points - if (size(y%ModGlue%Lin%x) > 0) y%Lin%x(:, m%Lin%TimeIndex) = y%ModGlue%Lin%x - if (size(y%ModGlue%Lin%xd) > 0) y%Lin%xd(:, m%Lin%TimeIndex) = y%ModGlue%Lin%xd - if (size(y%ModGlue%Lin%z) > 0) y%Lin%z(:, m%Lin%TimeIndex) = y%ModGlue%Lin%z - if (size(y%ModGlue%Lin%u) > 0) y%Lin%u(:, m%Lin%TimeIndex) = y%ModGlue%Lin%u + if (size(m%ModGlue%Lin%x) > 0) y%Lin%x(:, m%Lin%TimeIndex) = m%ModGlue%Lin%x + if (size(m%ModGlue%Lin%xd) > 0) y%Lin%xd(:, m%Lin%TimeIndex) = m%ModGlue%Lin%xd + if (size(m%ModGlue%Lin%z) > 0) y%Lin%z(:, m%Lin%TimeIndex) = m%ModGlue%Lin%z + if (size(m%ModGlue%Lin%u) > 0) y%Lin%u(:, m%Lin%TimeIndex) = m%ModGlue%Lin%u end associate end do ! Linearize mesh mappings to populate dUdy and dUdu - y%ModGlue%Lin%dUdy = 0.0_R8Ki - call Eye2D(y%ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_LinearizeMappings(Turbine, m%Modules, m%Mappings, p%Lin%iMod, p%Lin%Idx, ErrStat2, ErrMsg2, y%ModGlue%Lin%dUdu, y%ModGlue%Lin%dUdy) + m%ModGlue%Lin%dUdy = 0.0_R8Ki + call Eye2D(m%ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_LinearizeMappings(Turbine, m%Modules, m%Mappings, p%Lin%iMod, m%ModGlue%Xfr, ErrStat2, ErrMsg2, m%ModGlue%Lin%dUdu, m%ModGlue%Lin%dUdy) if (Failed()) return ! Write glue code matrices to file - OutFileName = trim(LinRootName)//".lin" - call CalcWriteLinearMatrices(y%ModGlue, p_FAST, y_FAST, t_global, Un, OutFileName, .true., ErrStat2, ErrMsg2) + call CalcWriteLinearMatrices(m%ModGlue, p_FAST, y_FAST, t_global, Un, LinRootName, VF_Linearize, .true., ErrStat2, ErrMsg2) if (Failed()) return ! Update index for next linearization time @@ -1060,14 +945,15 @@ subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) end subroutine -subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFileName, IsGlue, ErrStat, ErrMsg) +subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRootName, FilterFlag, IsGlue, ErrStat, ErrMsg) type(ModDataType), intent(inout) :: ModData !< Module data type(FAST_ParameterType) :: p_FAST !< Parameters type(FAST_OutputFileType) :: y_FAST !< Output variables real(DbKi), intent(in) :: t_global !< current time step (written in file) integer(IntKi), intent(out) :: Un !< Unit number for file - character(*), intent(in) :: OutFileName !< output file name + character(*), intent(in) :: LinRootName !< output file name + integer(IntKi), intent(in) :: FilterFlag !< Variable flag for filtering logical :: IsGlue !< Flag indicating this is writing glue code matrices integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -1076,23 +962,27 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFil integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(32) :: Desc + character(1024) :: OutFileName integer(IntKi) :: i integer(IntKi) :: Nx, Nxd, Nz, Nu, Ny character(50) :: Fmt - logical, allocatable :: uUse(:), yUse(:) + logical, allocatable :: uUse(:), yUse(:), xUse(:) ErrStat = ErrID_None ErrMsg = "" + ! Assemble output file name based on module linearization abbreviation + OutFileName = trim(LinRootName)//trim(ModData%Lin%Abbr)//".lin" + ! Open linearization file call OpenFOutFile(Un, OutFileName, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate number of values in variable after applying filter - Nx = MV_NumVars(ModData%Vars%x, VF_Linearize) - Nxd = MV_NumVars(ModData%Vars%xd, VF_Linearize) - Nz = MV_NumVars(ModData%Vars%z, VF_Linearize) - Nu = MV_NumVars(ModData%Vars%u, VF_Linearize) - Ny = MV_NumVars(ModData%Vars%y, VF_Linearize) + Nx = MV_NumVars(ModData%Vars%x, FilterFlag) + Nxd = MV_NumVars(ModData%Vars%xd, FilterFlag) + Nz = MV_NumVars(ModData%Vars%z, FilterFlag) + Nu = MV_NumVars(ModData%Vars%u, FilterFlag) + Ny = MV_NumVars(ModData%Vars%y, FilterFlag) !---------------------------------------------------------------------------- ! Header @@ -1129,38 +1019,47 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFil if (Nx > 0) then write (Un, '(A)') 'Order of continuous states:' - call WrLinFile_txt_Table(ModData%Vars%x, VF_Linearize, p_FAST, Un, "Row/Column", ModData%Lin%x) + call WrLinFile_txt_Table(ModData%Vars%x, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%x) write (Un, '(A)') 'Order of continuous state derivatives:' - call WrLinFile_txt_Table(ModData%Vars%x, VF_Linearize, p_FAST, Un, "Row/Column", ModData%Lin%dx, IsDeriv=.true.) + call WrLinFile_txt_Table(ModData%Vars%x, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%dx, IsDeriv=.true.) end if if (Nxd > 0) then write (Un, '(A)') 'Order of discrete states:' - call WrLinFile_txt_Table(ModData%Vars%xd, VF_Linearize, p_FAST, Un, "Row/Column", ModData%Lin%xd) + call WrLinFile_txt_Table(ModData%Vars%xd, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%xd) end if if (Nz > 0) then write (Un, '(A)') 'Order of constraint states:' - call WrLinFile_txt_Table(ModData%Vars%z, VF_Linearize, p_FAST, Un, "Row/Column", ModData%Lin%z) + call WrLinFile_txt_Table(ModData%Vars%z, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%z) end if if (Nu > 0) then write (Un, '(A)') 'Order of inputs:' - call WrLinFile_txt_Table(ModData%Vars%u, VF_Linearize, p_FAST, Un, "Column ", ModData%Lin%u, ShowRot=.true.) + call WrLinFile_txt_Table(ModData%Vars%u, FilterFlag, p_FAST, Un, "Column ", ModData%Lin%u, ShowRot=.true.) end if if (Ny > 0) then write (Un, '(A)') 'Order of outputs:' - call WrLinFile_txt_Table(ModData%Vars%y, VF_Linearize, p_FAST, Un, "Row ", ModData%Lin%y, ShowRot=.true.) + call WrLinFile_txt_Table(ModData%Vars%y, FilterFlag, p_FAST, Un, "Row ", ModData%Lin%y, ShowRot=.true.) end if + ! Create boolean array indicating which state values to write + allocate (xUse(ModData%Vars%Nx)) + xUse = .false. + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) + if (MV_HasFlags(Var, FilterFlag)) xUse(Var%iLoc(1):Var%iLoc(2)) = .true. + end associate + end do + ! Create boolean array indicating which input values to write allocate (uUse(ModData%Vars%Nu)) uUse = .false. do i = 1, size(ModData%Vars%u) associate (Var => ModData%Vars%u(i)) - if (MV_HasFlags(Var, VF_Linearize)) uUse(Var%iLoc(1):Var%iLoc(2)) = .true. + if (MV_HasFlags(Var, FilterFlag)) uUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do @@ -1169,20 +1068,21 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFil yUse = .false. do i = 1, size(ModData%Vars%y) associate (Var => ModData%Vars%y(i)) - if (MV_HasFlags(Var, VF_Linearize)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. + if (MV_HasFlags(Var, FilterFlag)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do ! If Jacobian matrix output is requested if (p_FAST%LinOutJac) then write (Un, '(/,A,/)') 'Jacobian matrices:' - if (IsGlue) then - call WrPartialMatrix(ModData%Lin%dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=uUse, UseCol=uUse) - call WrPartialMatrix(ModData%Lin%dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=uUse, UseCol=yUse) - else - if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'dXdx') - if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'dXdu', UseCol=uUse) - if (allocated(ModData%Lin%dYdx)) call WrPartialMatrix(ModData%Lin%dYdx, Un, p_FAST%OutFmt, 'dYdx', UseRow=yUse) + if (allocated(ModData%Lin%dUdu)) call WrPartialMatrix(ModData%Lin%dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=uUse, UseCol=uUse) + if (allocated(ModData%Lin%dUdy)) call WrPartialMatrix(ModData%Lin%dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=uUse, UseCol=yUse) + if (allocated(ModData%Lin%dXdy)) call WrPartialMatrix(ModData%Lin%dXdy, Un, p_FAST%OutFmt, 'dXdy', UseRow=xUse, UseCol=yUse) + if (allocated(ModData%Lin%J)) call WrPartialMatrix(ModData%Lin%J, Un, p_FAST%OutFmt, 'J') + if (.not. IsGlue) then + if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'dXdx', UseRow=xUse, UseCol=xUse) + if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'dXdu', UseRow=xUse, UseCol=uUse) + if (allocated(ModData%Lin%dYdx)) call WrPartialMatrix(ModData%Lin%dYdx, Un, p_FAST%OutFmt, 'dYdx', UseRow=yUse, UseCol=xUse) if (allocated(ModData%Lin%dYdu)) call WrPartialMatrix(ModData%Lin%dYdu, Un, p_FAST%OutFmt, 'dYdu', UseRow=yUse, UseCol=uUse) end if end if @@ -1197,9 +1097,9 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, OutFil ! Write the linearized state matrices write (Un, '(/,A,/)') 'Linearized state matrices:' - if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'A') - if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'B', UseCol=uUse) - if (allocated(ModData%Lin%dYdx)) call WrPartialMatrix(ModData%Lin%dYdx, Un, p_FAST%OutFmt, 'C', UseRow=yUse) + if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'A', UseRow=xUse, UseCol=xUse) + if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'B', UseRow=xUse, UseCol=uUse) + if (allocated(ModData%Lin%dYdx)) call WrPartialMatrix(ModData%Lin%dYdx, Un, p_FAST%OutFmt, 'C', UseRow=yUse, UseCol=xUse) if (allocated(ModData%Lin%dYdu)) call WrPartialMatrix(ModData%Lin%dYdu, Un, p_FAST%OutFmt, 'D', UseRow=yUse, UseCol=uUse) if (allocated(ModData%Lin%StateRotation)) call WrPartialMatrix(ModData%Lin%StateRotation, Un, p_FAST%OutFmt, 'StateRotation') @@ -1325,329 +1225,5 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer end subroutine WrLinFile_txt_Table -subroutine Idx_Init(Mods, ModOrder, Idx, FlagFilter, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mods(:) - integer(IntKi), intent(in) :: ModOrder(:) - type(VarsIdxType), intent(out) :: Idx - integer(IntKi), intent(in) :: FlagFilter - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'Idx_Init' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: NumVars - integer(IntKi) :: iGbl(2) - integer(IntKi) :: i, j - - ! Initialize error return - ErrStat = ErrID_None - ErrMsg = "" - - ! Destroy VarIdx in case it has been previously used - call Glue_DestroyVarsIdxType(Idx, ErrStat2, ErrMsg2); if (Failed()) return - - ! Save filter in index - Idx%FlagFilter = FlagFilter - - !---------------------------------------------------------------------------- - ! Indexing Data Description - !---------------------------------------------------------------------------- - - ! For each variable (x, u, y, etc.) there are two arrays: - ! 1) Variable local and global value indices (ValLocGbl) - ! 2) Module variable start index (ModVarStart) - ! ValLocGbl has 4 rows and N columns where N is the total number of variables - ! for all modules in Mods. The columns are as follows: - ! 1) Values start index inside module arrays/matrices (iLoc(1)) - ! 2) Values end index inside module arrays/matrices (iLoc(2)) - ! 3) Values start index in global arrays/matrices (iGbl(1)) - ! 4) Values end index in global arrays/matrices (iLoc(2)) - ! ModVarStart contains N rows where N is the total number of modules in Mods. - ! The values in this array contain the variable start index offset for each - ! module into ValLocGbl so value indices can be looked up given module index - ! and variable index. Keeping all value indices in one matrix makes data - ! storage much simpler at the cost of of having to maintain the array of - ! module offsets. - - !---------------------------------------------------------------------------- - ! Build index for continuous state variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%x%ModVarStart, size(Mods) + 1, "VarIdx%x%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%x%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%x) - Idx%x%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%x%ValLocGbl, 4, NumVars, "VarIdx%x%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%x%ValLocGbl = 0 - - ! Initialize global index to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%x) - if (MV_HasFlags(ModData%Vars%x(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%x(j)%Num - 1 - Idx%x%ValLocGbl(:, Idx%x%ModVarStart(ModData%Idx) + j) = [ModData%Vars%x(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Nx = iGbl(2) - - !---------------------------------------------------------------------------- - ! Build index for discrete state variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%xd%ModVarStart, size(Mods) + 1, "VarIdx%xd%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%xd%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables and values - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%xd) - Idx%xd%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%xd%ValLocGbl, 4, NumVars, "VarIdx%xd%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%xd%ValLocGbl = 0 - - ! Initialize global index and number of values to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%xd) - if (MV_HasFlags(ModData%Vars%xd(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%xd(j)%Num - 1 - Idx%xd%ValLocGbl(:, Idx%xd%ModVarStart(ModData%Idx) + j) = [ModData%Vars%xd(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Nxd = iGbl(2) - - !---------------------------------------------------------------------------- - ! Build index for constraint state variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%z%ModVarStart, size(Mods) + 1, "VarIdx%z%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%z%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%z) - Idx%z%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%z%ValLocGbl, 4, NumVars, "VarIdx%z%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%z%ValLocGbl = 0 - - ! Initialize global index to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%z) - if (MV_HasFlags(ModData%Vars%z(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%z(j)%Num - 1 - Idx%z%ValLocGbl(:, Idx%z%ModVarStart(ModData%Idx) + j) = [ModData%Vars%z(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Nz = iGbl(2) - - !---------------------------------------------------------------------------- - ! Build index for input variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%u%ModVarStart, size(Mods) + 1, "VarIdx%u%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%u%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%u) - Idx%u%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%u%ValLocGbl, 4, NumVars, "VarIdx%u%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%u%ValLocGbl = 0 - - ! Initialize global index to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%u) - if (MV_HasFlags(ModData%Vars%u(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%u(j)%Num - 1 - Idx%u%ValLocGbl(:, Idx%u%ModVarStart(ModData%Idx) + j) = [ModData%Vars%u(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Nu = iGbl(2) - - !---------------------------------------------------------------------------- - ! Build index for output variables - !---------------------------------------------------------------------------- - - ! Allocate array of module variable start indices for each module, init to 0 - call AllocAry(Idx%y%ModVarStart, size(Mods) + 1, "VarIdx%y%ModVarStart", ErrStat2, ErrMsg2); if (Failed()) return - Idx%y%ModVarStart(1) = 0 - - ! Populate ModVarStart with variable offsets and calculate total number of variables - NumVars = 0 - do i = 1, size(Mods) - NumVars = NumVars + size(Mods(i)%Vars%y) - Idx%y%ModVarStart(i + 1) = NumVars - end do - - ! Allocate variable value index matrix and initialize to zero - call AllocAry(Idx%y%ValLocGbl, 4, NumVars, "VarIdx%y%ValLocGbl", ErrStat2, ErrMsg2); if (Failed()) return - Idx%y%ValLocGbl = 0 - - ! Initialize global index to zero - iGbl = 0 - - ! Loop through modules and variables, add value indices to index if variable has filter flags, increment global indices - do i = 1, size(ModOrder) - associate (ModData => Mods(ModOrder(i))) - do j = 1, size(ModData%Vars%y) - if (MV_HasFlags(ModData%Vars%y(j), FlagFilter)) then - iGbl(1) = iGbl(2) + 1 - iGbl(2) = iGbl(1) + ModData%Vars%y(j)%Num - 1 - Idx%y%ValLocGbl(:, Idx%y%ModVarStart(ModData%Idx) + j) = [ModData%Vars%y(j)%iLoc, iGbl] - end if - end do - end associate - end do - - ! Save total number of values - Idx%Ny = iGbl(2) - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine - -logical function Idx_GetLocGbl(Idx, ModIdx, VarIdx, iLoc, iGbl) - type(VarIdxType), intent(in) :: Idx - integer(IntKi), intent(in) :: ModIdx, VarIdx - integer(IntKi), intent(out) :: iLoc(2), iGbl(2) - integer(IntKi) :: iLocGbl(4) - iLocGbl = Idx%ValLocGbl(:, Idx%ModVarStart(ModIdx) + VarIdx) - iLoc = iLocGbl(1:2) - iGbl = iLocGbl(3:4) - Idx_GetLocGbl = iLocGbl(3) /= 0 ! Variable has global index -end function - -subroutine MV_AddModule(Mods, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) - type(ModDataType), allocatable, intent(inout) :: Mods(:) - integer(IntKi), intent(in) :: ModID - character(*), intent(in) :: ModAbbr - integer(IntKi), intent(in) :: Instance - real(R8Ki), intent(in) :: ModDT - real(R8Ki), intent(in) :: SolverDT - type(ModVarsType), pointer, intent(in) :: Vars - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'MV_AddModule' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(ModDataType) :: ModData - - ErrStat = ErrID_None - ErrMsg = '' - - ! If module array hasn't been allocated, allocate with zero size - if (.not. allocated(Mods)) allocate (Mods(0)) - - ! Populate ModuleDataType derived type - ModData = ModDataType(Idx=size(Mods) + 1, ID=ModID, Abbr=ModAbbr, & - Ins=Instance, DT=ModDT, Vars=Vars) - - ! Allocate source and destination mapping arrays - call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !---------------------------------------------------------------------------- - ! Calculate Module Substepping - !---------------------------------------------------------------------------- - - ! If module time step is same as global time step, set substeps to 1 - if (EqualRealNos(ModData%DT, SolverDT)) then - ModData%SubSteps = 1 - else - ! If the module time step is greater than the global time step, set error - if (ModData%DT > SolverDT) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & - " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & - "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - - ! Calculate the number of substeps - ModData%SubSteps = nint(SolverDT/ModData%DT) - - ! If the module DT is not an exact integer divisor of the global time step, set error - if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & - " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & - "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - end if - - !---------------------------------------------------------------------------- - ! Add module data to array - !---------------------------------------------------------------------------- - - Mods = [Mods, ModData] - -end subroutine end module diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 69e273f2a1..9c8fda1b9a 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -43,6 +43,7 @@ MODULE FAST_ModTypes ! input array indices INTEGER(IntKi), PARAMETER :: INPUT_TEMP = 0 INTEGER(IntKi), PARAMETER :: INPUT_CURR = 1 + INTEGER(IntKi), PARAMETER :: INPUT_PREV = 2 ! VTK visualization INTEGER(IntKi), PARAMETER :: VTK_Unknown = -1 !< unknown option (will produce error) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 05757bdfac..410338c08c 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -21,6 +21,7 @@ !********************************************************************************************************************************** MODULE FAST_Subs + USE FAST_ModData USE FAST_ModGlue USE FAST_Solver ! USE FAST_Linear @@ -294,7 +295,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to array of modules, return if errors occurred - CALL MV_AddModule(m_Glue%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & Init%OutData_ED%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -390,7 +391,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName) ! Add module instance to array of modules, return on failure - CALL MV_AddModule(m_Glue%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & + CALL ModD_AddModule(m_Glue%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -494,7 +495,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & Init%OutData_IfW%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -564,7 +565,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%Modules, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & Init%OutData_ExtInfw%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -620,7 +621,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to array, return on error - call MV_AddModule(m_Glue%Modules, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & + call ModD_AddModule(m_Glue%Modules, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & Init%OutData_SeaSt%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -729,7 +730,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! Initialize a module instance for each rotor do i = 1, size(Init%OutData_AD%rotors) - CALL MV_AddModule(m_Glue%Modules, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & Init%OutData_AD%rotors(i)%Vars, ErrStat2, ErrMsg2) if (Failed()) return end do @@ -755,7 +756,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%Modules, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & Init%OutData_ExtLd%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -823,7 +824,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & Init%OutData_HD%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -876,7 +877,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & Init%OutData_SD%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -970,7 +971,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & Init%OutData_MAP%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -1002,7 +1003,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & Init%OutData_MD%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -1027,7 +1028,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & Init%OutData_FEAM%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -1045,7 +1046,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & Init%OutData_Orca%Vars, ErrStat2, ErrMsg2) if (Failed()) return @@ -1084,7 +1085,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules - ! CALL MV_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + ! CALL ModD_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) ! if (Failed()) return @@ -1157,7 +1158,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD END IF ! Add module to list of modules - ! CALL MV_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + ! CALL ModD_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) ! if (Failed()) return END DO @@ -1265,7 +1266,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules - CALL MV_AddModule(m_Glue%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + CALL ModD_AddModule(m_Glue%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & Init%OutData_SrvD%Vars, ErrStat2, ErrMsg2) if (Failed()) return diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index a8446d2c4d..d5b6d3f54b 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -20,9 +20,9 @@ param ^ - IntKi Map_MotionMesh - 2 - param ^ - IntKi Map_Variable - 3 - "Individual variable mapping type" - param ^ - IntKi Map_Custom - 4 - "Custom mapping not used for linearization" - -typedef ^ MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - -typedef ^ ^ IntKi SrcModIdx - 0 - "Source module index in ModData array" - -typedef ^ ^ IntKi DstModIdx - 0 - "Destination module index in ModData array" - +typedef ^ MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - +typedef ^ ^ IntKi iModSrc - 0 - "Source module index in ModData array" - +typedef ^ ^ IntKi iModDst - 0 - "Destination module index in ModData array" - typedef ^ ^ IntKi SrcModID - 0 - "Source module ID" - typedef ^ ^ IntKi DstModID - 0 - "Destination module ID" - typedef ^ ^ IntKi SrcIns - 0 - "Source module Instance" - @@ -71,7 +71,8 @@ typedef ^ ^ IntKi iVarDstDispOrientation - - - # Glue Linearization #---------------------------------------------------------------------------------------------------------------------------------- -typedef ^ Glue_LinType R8Ki x : - - "" - +typedef ^ Glue_LinType character(ChanLen) Abbr - - - "" - +typedef ^ ^ R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - typedef ^ ^ R8Ki xd : - - "" - typedef ^ ^ R8Ki z : - - "" - @@ -83,10 +84,12 @@ typedef ^ ^ R8Ki x_pos : - - typedef ^ ^ R8Ki x_neg : - - "" - typedef ^ ^ R8Ki y_pos : - - "" - typedef ^ ^ R8Ki y_neg : - - "" - +typedef ^ ^ R8Ki J :: - - "" - typedef ^ ^ R8Ki dYdx :: - - "" - typedef ^ ^ R8Ki dXdx :: - - "" - typedef ^ ^ R8Ki dYdu :: - - "" - typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dXdy :: - - "" - typedef ^ ^ R8Ki dUdu :: - - "" - typedef ^ ^ R8Ki dUdy :: - - "" - typedef ^ ^ R8Ki StateRotation :: - - "" - @@ -95,37 +98,29 @@ typedef ^ ^ R8Ki StateRotation :: - - # Module Data #---------------------------------------------------------------------------------------------------------------------------------- +typedef ^ VarXfrType IntKi iVar - - - "" - +typedef ^ ^ IntKi NumVals - - - "" - +typedef ^ ^ IntKi iSrc 2 - - "" - +typedef ^ ^ IntKi iDst 2 - - "" - + +typedef ^ ModXfrType VarXfrType x : - - "" - +typedef ^ ^ VarXfrType xd : - - "" - +typedef ^ ^ VarXfrType z : - - "" - +typedef ^ ^ VarXfrType u : - - "" - +typedef ^ ^ VarXfrType y : - - "" - + typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - typedef ^ ^ R8Ki DT - 0 - "Module time step" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ ModXfrType Xfr : - - "Variable index for combined modules" - typedef ^ ^ Glue_LinType Lin - - - "Module linearization data" - typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" -#---------------------------------------------------------------------------------------------------------------------------------- -# Variable Indexing -#---------------------------------------------------------------------------------------------------------------------------------- - -typedef ^ VarIdxType IntKi ModVarStart : - - "Variable start index from module index" - -typedef ^ ^ IntKi ValLocGbl :: - - "Variable local and global value indices" - - -typedef ^ VarsIdxType IntKi FlagFilter - - - "" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nxd - - - "" - -typedef ^ ^ IntKi Nz - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ^ VarIdxType x - - - "" - -typedef ^ ^ VarIdxType xd - - - "" - -typedef ^ ^ VarIdxType z - - - "" - -typedef ^ ^ VarIdxType u - - - "" - -typedef ^ ^ VarIdxType y - - - "" - -typedef ^ ^ Glue_LinType Lin - - - "Linearization matrices" - - #---------------------------------------------------------------------------------------------------------------------------------- # Glue Parameters #---------------------------------------------------------------------------------------------------------------------------------- @@ -133,7 +128,6 @@ typedef ^ ^ Glue_LinType Lin - - - typedef ^ Glue_LinParam IntKi NumTimes - - - "Number of times to linearize" - typedef ^ ^ IntKi InterpOrder - - - "Interpolation order" - typedef ^ ^ logical SaveOPs - - - "flag to save operating points during linearization" - -typedef ^ ^ VarsIdxType Idx - - - "Variable index for linearization data" - typedef ^ ^ IntKi iMod : - - "ModData index order for linearization" - typedef ^ Glue_ParameterType Glue_LinParam Lin - - - "Linearization parameters" @@ -181,8 +175,7 @@ typedef ^ ^ R8Ki xd :: - - typedef ^ ^ R8Ki z :: - - "linearization operating point constraint state" - typedef ^ ^ R8Ki OtherSt :: - - "linearization operating point other state" - -typedef ^ Glue_OutputFileType ModDataType ModGlue - - - "glue module data" - -typedef ^ ^ Glue_LinSave Lin - - - "Operating point data for linearization" +typedef ^ Glue_OutputFileType Glue_LinSave Lin - - - "Operating point data for linearization" #---------------------------------------------------------------------------------------------------------------------------------- # Miscellaneous Data @@ -202,14 +195,39 @@ typedef ^ ^ R8Ki y_interp : - - typedef ^ ^ R8Ki y_diff : - - "difference between outputs from current and previous rotation" - typedef ^ ^ R8Ki y_ref : - - "reference output values for error calculation" - +typedef ^ AeroMapCase ReKi RotSpeed - - - "Rotor speed for this case of the steady-state solve [>0]" "rad/s" +typedef ^ ^ ReKi TSR - - - "TSR for this case of the steady-state solve [>0]" "-" +typedef ^ ^ ReKi WindSpeed - - - "Windspeed for this case of the steady-state solve [>0]" "m/s" +typedef ^ ^ ReKi Pitch - - - "Pitch angle for this case of the steady-state solve" "rad" + +typedef ^ Glue_AeroMap ModDataType Mod - - - "Module combining all active modules" - +typedef ^ ^ IntKi iModOrder : - - "Index of module order for AeroMap modules" - +typedef ^ ^ IntKi iModED - - - "Index of ElastoDyn module" - +typedef ^ ^ IntKi iModBD - 0 - "Index of BeamDyn blade 1 module" - +typedef ^ ^ IntKi iModAD - - - "Index of AeroDyn module" - +typedef ^ ^ R8Ki Jac11 :: - - "Components of Jacobian matrix" - +typedef ^ ^ R8Ki Jac12 :: - - "Components of Jacobian matrix" - +typedef ^ ^ R8Ki Jac21 :: - - "Components of Jacobian matrix" - +typedef ^ ^ R8Ki Jac22 :: - - "Components of Jacobian matrix" - +typedef ^ ^ IntKi JacPivot : - - "Jacobian matrix pivot array" - +typedef ^ ^ R8Ki HubOrientation ::: - - "Hub orientation matrix for each blade" - +typedef ^ ^ R8Ki u1 : - - "" - +typedef ^ ^ R8Ki u2 : - - "" - +typedef ^ ^ R8Ki Residual : - - "" - +typedef ^ ^ R8Ki SolveDelta : - - "" - +typedef ^ ^ AeroMapCase Cases : - - "cases to run for aero mapping" - +typedef ^ ^ IntKi LinFileNum - 1 - "Linearization file number" - + typedef ^ Glue_LinMisc IntKi TimeIndex - - - "" - typedef ^ ^ IntKi AzimuthIndex - - - "" - typedef ^ ^ logical IsConverged - - - "" - -typedef ^ Glue_MiscVarType ModDataType Modules : - - "module variable and value data" - +typedef ^ Glue_MiscVarType ModDataType Modules : - - "Module variable and value data" - typedef ^ ^ MappingType Mappings : - - "Module mapping" - +typedef ^ ^ ModDataType ModGlue - - - "Glue code module" - typedef ^ ^ Glue_LinMisc Lin - - - "Linearization misc vars" typedef ^ ^ Glue_CalcSteady CS - - - "CalcSteady calculation data" +typedef ^ ^ Glue_AeroMap AM - - - "AeroMap data" typedef ^ ^ R8Ki q :: - - "" - typedef ^ ^ R8Ki qn :: - - "" - typedef ^ ^ R8Ki x : - - "" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 39d1ef11c9..98b6c29944 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -40,8 +40,8 @@ MODULE Glue_Types ! ========= MappingType ======= TYPE, PUBLIC :: MappingType character(128) :: Desc !< Description of mapping (used to lookup non-mesh maps) [-] - INTEGER(IntKi) :: SrcModIdx = 0 !< Source module index in ModData array [-] - INTEGER(IntKi) :: DstModIdx = 0 !< Destination module index in ModData array [-] + INTEGER(IntKi) :: iModSrc = 0 !< Source module index in ModData array [-] + INTEGER(IntKi) :: iModDst = 0 !< Destination module index in ModData array [-] INTEGER(IntKi) :: SrcModID = 0 !< Source module ID [-] INTEGER(IntKi) :: DstModID = 0 !< Destination module ID [-] INTEGER(IntKi) :: SrcIns = 0 !< Source module Instance [-] @@ -89,6 +89,7 @@ MODULE Glue_Types ! ======================= ! ========= Glue_LinType ======= TYPE, PUBLIC :: Glue_LinType + character(ChanLen) :: Abbr !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] @@ -101,57 +102,54 @@ MODULE Glue_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdy !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] END TYPE Glue_LinType ! ======================= +! ========= VarXfrType ======= + TYPE, PUBLIC :: VarXfrType + INTEGER(IntKi) :: iVar = 0_IntKi !< [-] + INTEGER(IntKi) :: NumVals = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iSrc = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iDst = 0_IntKi !< [-] + END TYPE VarXfrType +! ======================= +! ========= ModXfrType ======= + TYPE, PUBLIC :: ModXfrType + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: x !< [-] + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: xd !< [-] + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: z !< [-] + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: u !< [-] + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: y !< [-] + END TYPE ModXfrType +! ======================= ! ========= ModDataType ======= TYPE, PUBLIC :: ModDataType character(ChanLen) :: Abbr !< Module name abbreviation [-] INTEGER(IntKi) :: ID = 0 !< Module identification number [-] - INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: iMod = 0 !< Module index in array of modules [-] INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] REAL(R8Ki) :: DT = 0 !< Module time step [-] INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] + TYPE(ModXfrType) , DIMENSION(:), ALLOCATABLE :: Xfr !< Variable index for combined modules [-] TYPE(Glue_LinType) :: Lin !< Module linearization data [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] END TYPE ModDataType ! ======================= -! ========= VarIdxType ======= - TYPE, PUBLIC :: VarIdxType - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ModVarStart !< Variable start index from module index [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ValLocGbl !< Variable local and global value indices [-] - END TYPE VarIdxType -! ======================= -! ========= VarsIdxType ======= - TYPE, PUBLIC :: VarsIdxType - INTEGER(IntKi) :: FlagFilter = 0_IntKi !< [-] - INTEGER(IntKi) :: Nx = 0_IntKi !< [-] - INTEGER(IntKi) :: Nxd = 0_IntKi !< [-] - INTEGER(IntKi) :: Nz = 0_IntKi !< [-] - INTEGER(IntKi) :: Nu = 0_IntKi !< [-] - INTEGER(IntKi) :: Ny = 0_IntKi !< [-] - TYPE(VarIdxType) :: x !< [-] - TYPE(VarIdxType) :: xd !< [-] - TYPE(VarIdxType) :: z !< [-] - TYPE(VarIdxType) :: u !< [-] - TYPE(VarIdxType) :: y !< [-] - TYPE(Glue_LinType) :: Lin !< Linearization matrices [-] - END TYPE VarsIdxType -! ======================= ! ========= Glue_LinParam ======= TYPE, PUBLIC :: Glue_LinParam INTEGER(IntKi) :: NumTimes = 0_IntKi !< Number of times to linearize [-] INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order [-] LOGICAL :: SaveOPs = .false. !< flag to save operating points during linearization [-] - TYPE(VarsIdxType) :: Idx !< Variable index for linearization data [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] END TYPE Glue_LinParam ! ======================= @@ -204,7 +202,6 @@ MODULE Glue_Types ! ======================= ! ========= Glue_OutputFileType ======= TYPE, PUBLIC :: Glue_OutputFileType - TYPE(ModDataType) :: ModGlue !< glue module data [-] TYPE(Glue_LinSave) :: Lin !< Operating point data for linearization [-] END TYPE Glue_OutputFileType ! ======================= @@ -225,6 +222,35 @@ MODULE Glue_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_ref !< reference output values for error calculation [-] END TYPE Glue_CalcSteady ! ======================= +! ========= AeroMapCase ======= + TYPE, PUBLIC :: AeroMapCase + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor speed for this case of the steady-state solve [>0] [rad/s] + REAL(ReKi) :: TSR = 0.0_ReKi !< TSR for this case of the steady-state solve [>0] [-] + REAL(ReKi) :: WindSpeed = 0.0_ReKi !< Windspeed for this case of the steady-state solve [>0] [m/s] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Pitch angle for this case of the steady-state solve [rad] + END TYPE AeroMapCase +! ======================= +! ========= Glue_AeroMap ======= + TYPE, PUBLIC :: Glue_AeroMap + TYPE(ModDataType) :: Mod !< Module combining all active modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOrder !< Index of module order for AeroMap modules [-] + INTEGER(IntKi) :: iModED = 0_IntKi !< Index of ElastoDyn module [-] + INTEGER(IntKi) :: iModBD = 0 !< Index of BeamDyn blade 1 module [-] + INTEGER(IntKi) :: iModAD = 0_IntKi !< Index of AeroDyn module [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac11 !< Components of Jacobian matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac12 !< Components of Jacobian matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac21 !< Components of Jacobian matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac22 !< Components of Jacobian matrix [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: JacPivot !< Jacobian matrix pivot array [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: HubOrientation !< Hub orientation matrix for each blade [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u1 !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u2 !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: Residual !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SolveDelta !< [-] + TYPE(AeroMapCase) , DIMENSION(:), ALLOCATABLE :: Cases !< cases to run for aero mapping [-] + INTEGER(IntKi) :: LinFileNum = 1 !< Linearization file number [-] + END TYPE Glue_AeroMap +! ======================= ! ========= Glue_LinMisc ======= TYPE, PUBLIC :: Glue_LinMisc INTEGER(IntKi) :: TimeIndex = 0_IntKi !< [-] @@ -234,10 +260,12 @@ MODULE Glue_Types ! ======================= ! ========= Glue_MiscVarType ======= TYPE, PUBLIC :: Glue_MiscVarType - TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: Modules !< module variable and value data [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: Modules !< Module variable and value data [-] TYPE(MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mapping [-] + TYPE(ModDataType) :: ModGlue !< Glue code module [-] TYPE(Glue_LinMisc) :: Lin !< Linearization misc vars [-] TYPE(Glue_CalcSteady) :: CS !< CalcSteady calculation data [-] + TYPE(Glue_AeroMap) :: AM !< AeroMap data [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: q !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: qn !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] @@ -283,8 +311,8 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode ErrStat = ErrID_None ErrMsg = '' DstMappingTypeData%Desc = SrcMappingTypeData%Desc - DstMappingTypeData%SrcModIdx = SrcMappingTypeData%SrcModIdx - DstMappingTypeData%DstModIdx = SrcMappingTypeData%DstModIdx + DstMappingTypeData%iModSrc = SrcMappingTypeData%iModSrc + DstMappingTypeData%iModDst = SrcMappingTypeData%iModDst DstMappingTypeData%SrcModID = SrcMappingTypeData%SrcModID DstMappingTypeData%DstModID = SrcMappingTypeData%DstModID DstMappingTypeData%SrcIns = SrcMappingTypeData%SrcIns @@ -393,8 +421,8 @@ subroutine Glue_PackMappingType(RF, Indata) character(*), parameter :: RoutineName = 'Glue_PackMappingType' if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Desc) - call RegPack(RF, InData%SrcModIdx) - call RegPack(RF, InData%DstModIdx) + call RegPack(RF, InData%iModSrc) + call RegPack(RF, InData%iModDst) call RegPack(RF, InData%SrcModID) call RegPack(RF, InData%DstModID) call RegPack(RF, InData%SrcIns) @@ -450,8 +478,8 @@ subroutine Glue_UnPackMappingType(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Desc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SrcModIdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstModIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModDst); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcModID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstModID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcIns); if (RegCheckErr(RF, RoutineName)) return @@ -508,6 +536,7 @@ subroutine Glue_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E character(*), parameter :: RoutineName = 'Glue_CopyLinType' ErrStat = ErrID_None ErrMsg = '' + DstLinTypeData%Abbr = SrcLinTypeData%Abbr if (allocated(SrcLinTypeData%x)) then LB(1:1) = lbound(SrcLinTypeData%x, kind=B8Ki) UB(1:1) = ubound(SrcLinTypeData%x, kind=B8Ki) @@ -652,6 +681,18 @@ subroutine Glue_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if DstLinTypeData%y_neg = SrcLinTypeData%y_neg end if + if (allocated(SrcLinTypeData%J)) then + LB(1:2) = lbound(SrcLinTypeData%J, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%J, kind=B8Ki) + if (.not. allocated(DstLinTypeData%J)) then + allocate(DstLinTypeData%J(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%J.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%J = SrcLinTypeData%J + end if if (allocated(SrcLinTypeData%dYdx)) then LB(1:2) = lbound(SrcLinTypeData%dYdx, kind=B8Ki) UB(1:2) = ubound(SrcLinTypeData%dYdx, kind=B8Ki) @@ -700,6 +741,18 @@ subroutine Glue_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if DstLinTypeData%dXdu = SrcLinTypeData%dXdu end if + if (allocated(SrcLinTypeData%dXdy)) then + LB(1:2) = lbound(SrcLinTypeData%dXdy, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%dXdy, kind=B8Ki) + if (.not. allocated(DstLinTypeData%dXdy)) then + allocate(DstLinTypeData%dXdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dXdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%dXdy = SrcLinTypeData%dXdy + end if if (allocated(SrcLinTypeData%dUdu)) then LB(1:2) = lbound(SrcLinTypeData%dUdu, kind=B8Ki) UB(1:2) = ubound(SrcLinTypeData%dUdu, kind=B8Ki) @@ -781,6 +834,9 @@ subroutine Glue_DestroyLinType(LinTypeData, ErrStat, ErrMsg) if (allocated(LinTypeData%y_neg)) then deallocate(LinTypeData%y_neg) end if + if (allocated(LinTypeData%J)) then + deallocate(LinTypeData%J) + end if if (allocated(LinTypeData%dYdx)) then deallocate(LinTypeData%dYdx) end if @@ -793,6 +849,9 @@ subroutine Glue_DestroyLinType(LinTypeData, ErrStat, ErrMsg) if (allocated(LinTypeData%dXdu)) then deallocate(LinTypeData%dXdu) end if + if (allocated(LinTypeData%dXdy)) then + deallocate(LinTypeData%dXdy) + end if if (allocated(LinTypeData%dUdu)) then deallocate(LinTypeData%dUdu) end if @@ -809,6 +868,7 @@ subroutine Glue_PackLinType(RF, Indata) type(Glue_LinType), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackLinType' if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Abbr) call RegPackAlloc(RF, InData%x) call RegPackAlloc(RF, InData%dx) call RegPackAlloc(RF, InData%xd) @@ -821,10 +881,12 @@ subroutine Glue_PackLinType(RF, Indata) call RegPackAlloc(RF, InData%x_neg) call RegPackAlloc(RF, InData%y_pos) call RegPackAlloc(RF, InData%y_neg) + call RegPackAlloc(RF, InData%J) call RegPackAlloc(RF, InData%dYdx) call RegPackAlloc(RF, InData%dXdx) call RegPackAlloc(RF, InData%dYdu) call RegPackAlloc(RF, InData%dXdu) + call RegPackAlloc(RF, InData%dXdy) call RegPackAlloc(RF, InData%dUdu) call RegPackAlloc(RF, InData%dUdy) call RegPackAlloc(RF, InData%StateRotation) @@ -839,6 +901,7 @@ subroutine Glue_UnPackLinType(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return @@ -851,21 +914,355 @@ subroutine Glue_UnPackLinType(RF, OutData) call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdy); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine Glue_CopyVarXfrType(SrcVarXfrTypeData, DstVarXfrTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarXfrType), intent(in) :: SrcVarXfrTypeData + type(VarXfrType), intent(inout) :: DstVarXfrTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_CopyVarXfrType' + ErrStat = ErrID_None + ErrMsg = '' + DstVarXfrTypeData%iVar = SrcVarXfrTypeData%iVar + DstVarXfrTypeData%NumVals = SrcVarXfrTypeData%NumVals + DstVarXfrTypeData%iSrc = SrcVarXfrTypeData%iSrc + DstVarXfrTypeData%iDst = SrcVarXfrTypeData%iDst +end subroutine + +subroutine Glue_DestroyVarXfrType(VarXfrTypeData, ErrStat, ErrMsg) + type(VarXfrType), intent(inout) :: VarXfrTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyVarXfrType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Glue_PackVarXfrType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarXfrType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackVarXfrType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%iVar) + call RegPack(RF, InData%NumVals) + call RegPack(RF, InData%iSrc) + call RegPack(RF, InData%iDst) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackVarXfrType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarXfrType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackVarXfrType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumVals); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iDst); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyModXfrType(SrcModXfrTypeData, DstModXfrTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModXfrType), intent(in) :: SrcModXfrTypeData + type(ModXfrType), intent(inout) :: DstModXfrTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyModXfrType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModXfrTypeData%x)) then + LB(1:1) = lbound(SrcModXfrTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%x, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%x)) then + allocate(DstModXfrTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyVarXfrType(SrcModXfrTypeData%x(i1), DstModXfrTypeData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModXfrTypeData%xd)) then + LB(1:1) = lbound(SrcModXfrTypeData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%xd, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%xd)) then + allocate(DstModXfrTypeData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyVarXfrType(SrcModXfrTypeData%xd(i1), DstModXfrTypeData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModXfrTypeData%z)) then + LB(1:1) = lbound(SrcModXfrTypeData%z, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%z, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%z)) then + allocate(DstModXfrTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyVarXfrType(SrcModXfrTypeData%z(i1), DstModXfrTypeData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModXfrTypeData%u)) then + LB(1:1) = lbound(SrcModXfrTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%u, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%u)) then + allocate(DstModXfrTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyVarXfrType(SrcModXfrTypeData%u(i1), DstModXfrTypeData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModXfrTypeData%y)) then + LB(1:1) = lbound(SrcModXfrTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%y, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%y)) then + allocate(DstModXfrTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyVarXfrType(SrcModXfrTypeData%y(i1), DstModXfrTypeData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine Glue_DestroyModXfrType(ModXfrTypeData, ErrStat, ErrMsg) + type(ModXfrType), intent(inout) :: ModXfrTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyModXfrType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModXfrTypeData%x)) then + LB(1:1) = lbound(ModXfrTypeData%x, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyVarXfrType(ModXfrTypeData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%x) + end if + if (allocated(ModXfrTypeData%xd)) then + LB(1:1) = lbound(ModXfrTypeData%xd, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyVarXfrType(ModXfrTypeData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%xd) + end if + if (allocated(ModXfrTypeData%z)) then + LB(1:1) = lbound(ModXfrTypeData%z, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyVarXfrType(ModXfrTypeData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%z) + end if + if (allocated(ModXfrTypeData%u)) then + LB(1:1) = lbound(ModXfrTypeData%u, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%u, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyVarXfrType(ModXfrTypeData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%u) + end if + if (allocated(ModXfrTypeData%y)) then + LB(1:1) = lbound(ModXfrTypeData%y, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%y, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyVarXfrType(ModXfrTypeData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%y) + end if +end subroutine + +subroutine Glue_PackModXfrType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModXfrType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackModXfrType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackVarXfrType(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackVarXfrType(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackVarXfrType(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + LB(1:1) = lbound(InData%u, kind=B8Ki) + UB(1:1) = ubound(InData%u, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackVarXfrType(RF, InData%u(i1)) + end do + end if + call RegPack(RF, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) + LB(1:1) = lbound(InData%y, kind=B8Ki) + UB(1:1) = ubound(InData%y, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackVarXfrType(RF, InData%y(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackModXfrType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModXfrType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackModXfrType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackVarXfrType(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackVarXfrType(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackVarXfrType(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackVarXfrType(RF, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackVarXfrType(RF, OutData%y(i1)) ! y + end do + end if +end subroutine + subroutine Glue_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) type(ModDataType), intent(in) :: SrcModDataTypeData type(ModDataType), intent(inout) :: DstModDataTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -874,11 +1271,27 @@ subroutine Glue_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode ErrMsg = '' DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr DstModDataTypeData%ID = SrcModDataTypeData%ID - DstModDataTypeData%Idx = SrcModDataTypeData%Idx + DstModDataTypeData%iMod = SrcModDataTypeData%iMod DstModDataTypeData%Ins = SrcModDataTypeData%Ins DstModDataTypeData%DT = SrcModDataTypeData%DT DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps DstModDataTypeData%Vars => SrcModDataTypeData%Vars + if (allocated(SrcModDataTypeData%Xfr)) then + LB(1:1) = lbound(SrcModDataTypeData%Xfr, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%Xfr, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%Xfr)) then + allocate(DstModDataTypeData%Xfr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%Xfr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyModXfrType(SrcModDataTypeData%Xfr(i1), DstModDataTypeData%Xfr(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call Glue_CopyLinType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -912,12 +1325,23 @@ subroutine Glue_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) type(ModDataType), intent(inout) :: ModDataTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_DestroyModDataType' ErrStat = ErrID_None ErrMsg = '' nullify(ModDataTypeData%Vars) + if (allocated(ModDataTypeData%Xfr)) then + LB(1:1) = lbound(ModDataTypeData%Xfr, kind=B8Ki) + UB(1:1) = ubound(ModDataTypeData%Xfr, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyModXfrType(ModDataTypeData%Xfr(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModDataTypeData%Xfr) + end if call Glue_DestroyLinType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModDataTypeData%SrcMaps)) then @@ -932,11 +1356,13 @@ subroutine Glue_PackModDataType(RF, Indata) type(RegFile), intent(inout) :: RF type(ModDataType), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackModDataType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Abbr) call RegPack(RF, InData%ID) - call RegPack(RF, InData%Idx) + call RegPack(RF, InData%iMod) call RegPack(RF, InData%Ins) call RegPack(RF, InData%DT) call RegPack(RF, InData%SubSteps) @@ -947,6 +1373,15 @@ subroutine Glue_PackModDataType(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if + call RegPack(RF, allocated(InData%Xfr)) + if (allocated(InData%Xfr)) then + call RegPackBounds(RF, 1, lbound(InData%Xfr, kind=B8Ki), ubound(InData%Xfr, kind=B8Ki)) + LB(1:1) = lbound(InData%Xfr, kind=B8Ki) + UB(1:1) = ubound(InData%Xfr, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackModXfrType(RF, InData%Xfr(i1)) + end do + end if call Glue_PackLinType(RF, InData%Lin) call RegPackAlloc(RF, InData%SrcMaps) call RegPackAlloc(RF, InData%DstMaps) @@ -957,6 +1392,7 @@ subroutine Glue_UnPackModDataType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackModDataType' + integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc @@ -965,7 +1401,7 @@ subroutine Glue_UnPackModDataType(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return @@ -987,182 +1423,22 @@ subroutine Glue_UnPackModDataType(RF, OutData) else OutData%Vars => null() end if - call Glue_UnpackLinType(RF, OutData%Lin) ! Lin - call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_CopyVarIdxType(SrcVarIdxTypeData, DstVarIdxTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarIdxType), intent(in) :: SrcVarIdxTypeData - type(VarIdxType), intent(inout) :: DstVarIdxTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'Glue_CopyVarIdxType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcVarIdxTypeData%ModVarStart)) then - LB(1:1) = lbound(SrcVarIdxTypeData%ModVarStart, kind=B8Ki) - UB(1:1) = ubound(SrcVarIdxTypeData%ModVarStart, kind=B8Ki) - if (.not. allocated(DstVarIdxTypeData%ModVarStart)) then - allocate(DstVarIdxTypeData%ModVarStart(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarIdxTypeData%ModVarStart.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstVarIdxTypeData%ModVarStart = SrcVarIdxTypeData%ModVarStart - end if - if (allocated(SrcVarIdxTypeData%ValLocGbl)) then - LB(1:2) = lbound(SrcVarIdxTypeData%ValLocGbl, kind=B8Ki) - UB(1:2) = ubound(SrcVarIdxTypeData%ValLocGbl, kind=B8Ki) - if (.not. allocated(DstVarIdxTypeData%ValLocGbl)) then - allocate(DstVarIdxTypeData%ValLocGbl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVarIdxTypeData%ValLocGbl.', ErrStat, ErrMsg, RoutineName) - return - end if + if (allocated(OutData%Xfr)) deallocate(OutData%Xfr) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Xfr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xfr.', RF%ErrStat, RF%ErrMsg, RoutineName) + return end if - DstVarIdxTypeData%ValLocGbl = SrcVarIdxTypeData%ValLocGbl - end if -end subroutine - -subroutine Glue_DestroyVarIdxType(VarIdxTypeData, ErrStat, ErrMsg) - type(VarIdxType), intent(inout) :: VarIdxTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Glue_DestroyVarIdxType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(VarIdxTypeData%ModVarStart)) then - deallocate(VarIdxTypeData%ModVarStart) - end if - if (allocated(VarIdxTypeData%ValLocGbl)) then - deallocate(VarIdxTypeData%ValLocGbl) + do i1 = LB(1), UB(1) + call Glue_UnpackModXfrType(RF, OutData%Xfr(i1)) ! Xfr + end do end if -end subroutine - -subroutine Glue_PackVarIdxType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(VarIdxType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Glue_PackVarIdxType' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%ModVarStart) - call RegPackAlloc(RF, InData%ValLocGbl) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_UnPackVarIdxType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(VarIdxType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Glue_UnPackVarIdxType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%ModVarStart); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ValLocGbl); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_CopyVarsIdxType(SrcVarsIdxTypeData, DstVarsIdxTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarsIdxType), intent(in) :: SrcVarsIdxTypeData - type(VarsIdxType), intent(inout) :: DstVarsIdxTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_CopyVarsIdxType' - ErrStat = ErrID_None - ErrMsg = '' - DstVarsIdxTypeData%FlagFilter = SrcVarsIdxTypeData%FlagFilter - DstVarsIdxTypeData%Nx = SrcVarsIdxTypeData%Nx - DstVarsIdxTypeData%Nxd = SrcVarsIdxTypeData%Nxd - DstVarsIdxTypeData%Nz = SrcVarsIdxTypeData%Nz - DstVarsIdxTypeData%Nu = SrcVarsIdxTypeData%Nu - DstVarsIdxTypeData%Ny = SrcVarsIdxTypeData%Ny - call Glue_CopyVarIdxType(SrcVarsIdxTypeData%x, DstVarsIdxTypeData%x, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call Glue_CopyVarIdxType(SrcVarsIdxTypeData%xd, DstVarsIdxTypeData%xd, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call Glue_CopyVarIdxType(SrcVarsIdxTypeData%z, DstVarsIdxTypeData%z, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call Glue_CopyVarIdxType(SrcVarsIdxTypeData%u, DstVarsIdxTypeData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call Glue_CopyVarIdxType(SrcVarsIdxTypeData%y, DstVarsIdxTypeData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call Glue_CopyLinType(SrcVarsIdxTypeData%Lin, DstVarsIdxTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine Glue_DestroyVarsIdxType(VarsIdxTypeData, ErrStat, ErrMsg) - type(VarsIdxType), intent(inout) :: VarsIdxTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_DestroyVarsIdxType' - ErrStat = ErrID_None - ErrMsg = '' - call Glue_DestroyVarIdxType(VarsIdxTypeData%x, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Glue_DestroyVarIdxType(VarsIdxTypeData%xd, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Glue_DestroyVarIdxType(VarsIdxTypeData%z, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Glue_DestroyVarIdxType(VarsIdxTypeData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Glue_DestroyVarIdxType(VarsIdxTypeData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Glue_DestroyLinType(VarsIdxTypeData%Lin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine Glue_PackVarsIdxType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(VarsIdxType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Glue_PackVarsIdxType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%FlagFilter) - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nxd) - call RegPack(RF, InData%Nz) - call RegPack(RF, InData%Nu) - call RegPack(RF, InData%Ny) - call Glue_PackVarIdxType(RF, InData%x) - call Glue_PackVarIdxType(RF, InData%xd) - call Glue_PackVarIdxType(RF, InData%z) - call Glue_PackVarIdxType(RF, InData%u) - call Glue_PackVarIdxType(RF, InData%y) - call Glue_PackLinType(RF, InData%Lin) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_UnPackVarsIdxType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(VarsIdxType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Glue_UnPackVarsIdxType' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%FlagFilter); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return - call Glue_UnpackVarIdxType(RF, OutData%x) ! x - call Glue_UnpackVarIdxType(RF, OutData%xd) ! xd - call Glue_UnpackVarIdxType(RF, OutData%z) ! z - call Glue_UnpackVarIdxType(RF, OutData%u) ! u - call Glue_UnpackVarIdxType(RF, OutData%y) ! y call Glue_UnpackLinType(RF, OutData%Lin) ! Lin + call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Glue_CopyLinParam(SrcLinParamData, DstLinParamData, CtrlCode, ErrStat, ErrMsg) @@ -1173,16 +1449,12 @@ subroutine Glue_CopyLinParam(SrcLinParamData, DstLinParamData, CtrlCode, ErrStat character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_CopyLinParam' ErrStat = ErrID_None ErrMsg = '' DstLinParamData%NumTimes = SrcLinParamData%NumTimes DstLinParamData%InterpOrder = SrcLinParamData%InterpOrder DstLinParamData%SaveOPs = SrcLinParamData%SaveOPs - call Glue_CopyVarsIdxType(SrcLinParamData%Idx, DstLinParamData%Idx, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcLinParamData%iMod)) then LB(1:1) = lbound(SrcLinParamData%iMod, kind=B8Ki) UB(1:1) = ubound(SrcLinParamData%iMod, kind=B8Ki) @@ -1201,13 +1473,9 @@ subroutine Glue_DestroyLinParam(LinParamData, ErrStat, ErrMsg) type(Glue_LinParam), intent(inout) :: LinParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_DestroyLinParam' ErrStat = ErrID_None ErrMsg = '' - call Glue_DestroyVarsIdxType(LinParamData%Idx, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(LinParamData%iMod)) then deallocate(LinParamData%iMod) end if @@ -1221,7 +1489,6 @@ subroutine Glue_PackLinParam(RF, Indata) call RegPack(RF, InData%NumTimes) call RegPack(RF, InData%InterpOrder) call RegPack(RF, InData%SaveOPs) - call Glue_PackVarsIdxType(RF, InData%Idx) call RegPackAlloc(RF, InData%iMod) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1237,7 +1504,6 @@ subroutine Glue_UnPackLinParam(RF, OutData) call RegUnpack(RF, OutData%NumTimes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SaveOPs); if (RegCheckErr(RF, RoutineName)) return - call Glue_UnpackVarsIdxType(RF, OutData%Idx) ! Idx call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1666,9 +1932,6 @@ subroutine Glue_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, character(*), parameter :: RoutineName = 'Glue_CopyOutputFileType' ErrStat = ErrID_None ErrMsg = '' - call Glue_CopyModDataType(SrcOutputFileTypeData%ModGlue, DstOutputFileTypeData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call Glue_CopyLinSave(SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1683,8 +1946,6 @@ subroutine Glue_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyOutputFileType' ErrStat = ErrID_None ErrMsg = '' - call Glue_DestroyModDataType(OutputFileTypeData%ModGlue, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Glue_DestroyLinSave(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -1694,7 +1955,6 @@ subroutine Glue_PackOutputFileType(RF, Indata) type(Glue_OutputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackOutputFileType' if (RF%ErrStat >= AbortErrLev) return - call Glue_PackModDataType(RF, InData%ModGlue) call Glue_PackLinSave(RF, InData%Lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1704,7 +1964,6 @@ subroutine Glue_UnPackOutputFileType(RF, OutData) type(Glue_OutputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackOutputFileType' if (RF%ErrStat /= ErrID_None) return - call Glue_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue call Glue_UnpackLinSave(RF, OutData%Lin) ! Lin end subroutine @@ -1885,6 +2144,355 @@ subroutine Glue_UnPackCalcSteady(RF, OutData) call RegUnpackAlloc(RF, OutData%y_ref); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine Glue_CopyAeroMapCase(SrcAeroMapCaseData, DstAeroMapCaseData, CtrlCode, ErrStat, ErrMsg) + type(AeroMapCase), intent(in) :: SrcAeroMapCaseData + type(AeroMapCase), intent(inout) :: DstAeroMapCaseData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_CopyAeroMapCase' + ErrStat = ErrID_None + ErrMsg = '' + DstAeroMapCaseData%RotSpeed = SrcAeroMapCaseData%RotSpeed + DstAeroMapCaseData%TSR = SrcAeroMapCaseData%TSR + DstAeroMapCaseData%WindSpeed = SrcAeroMapCaseData%WindSpeed + DstAeroMapCaseData%Pitch = SrcAeroMapCaseData%Pitch +end subroutine + +subroutine Glue_DestroyAeroMapCase(AeroMapCaseData, ErrStat, ErrMsg) + type(AeroMapCase), intent(inout) :: AeroMapCaseData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyAeroMapCase' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Glue_PackAeroMapCase(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AeroMapCase), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackAeroMapCase' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TSR) + call RegPack(RF, InData%WindSpeed) + call RegPack(RF, InData%Pitch) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackAeroMapCase(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AeroMapCase), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackAeroMapCase' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(in) :: SrcAeroMapData + type(Glue_AeroMap), intent(inout) :: DstAeroMapData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyAeroMap' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_CopyModDataType(SrcAeroMapData%Mod, DstAeroMapData%Mod, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroMapData%iModOrder)) then + LB(1:1) = lbound(SrcAeroMapData%iModOrder, kind=B8Ki) + UB(1:1) = ubound(SrcAeroMapData%iModOrder, kind=B8Ki) + if (.not. allocated(DstAeroMapData%iModOrder)) then + allocate(DstAeroMapData%iModOrder(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%iModOrder.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%iModOrder = SrcAeroMapData%iModOrder + end if + DstAeroMapData%iModED = SrcAeroMapData%iModED + DstAeroMapData%iModBD = SrcAeroMapData%iModBD + DstAeroMapData%iModAD = SrcAeroMapData%iModAD + if (allocated(SrcAeroMapData%Jac11)) then + LB(1:2) = lbound(SrcAeroMapData%Jac11, kind=B8Ki) + UB(1:2) = ubound(SrcAeroMapData%Jac11, kind=B8Ki) + if (.not. allocated(DstAeroMapData%Jac11)) then + allocate(DstAeroMapData%Jac11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Jac11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Jac11 = SrcAeroMapData%Jac11 + end if + if (allocated(SrcAeroMapData%Jac12)) then + LB(1:2) = lbound(SrcAeroMapData%Jac12, kind=B8Ki) + UB(1:2) = ubound(SrcAeroMapData%Jac12, kind=B8Ki) + if (.not. allocated(DstAeroMapData%Jac12)) then + allocate(DstAeroMapData%Jac12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Jac12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Jac12 = SrcAeroMapData%Jac12 + end if + if (allocated(SrcAeroMapData%Jac21)) then + LB(1:2) = lbound(SrcAeroMapData%Jac21, kind=B8Ki) + UB(1:2) = ubound(SrcAeroMapData%Jac21, kind=B8Ki) + if (.not. allocated(DstAeroMapData%Jac21)) then + allocate(DstAeroMapData%Jac21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Jac21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Jac21 = SrcAeroMapData%Jac21 + end if + if (allocated(SrcAeroMapData%Jac22)) then + LB(1:2) = lbound(SrcAeroMapData%Jac22, kind=B8Ki) + UB(1:2) = ubound(SrcAeroMapData%Jac22, kind=B8Ki) + if (.not. allocated(DstAeroMapData%Jac22)) then + allocate(DstAeroMapData%Jac22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Jac22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Jac22 = SrcAeroMapData%Jac22 + end if + if (allocated(SrcAeroMapData%JacPivot)) then + LB(1:1) = lbound(SrcAeroMapData%JacPivot, kind=B8Ki) + UB(1:1) = ubound(SrcAeroMapData%JacPivot, kind=B8Ki) + if (.not. allocated(DstAeroMapData%JacPivot)) then + allocate(DstAeroMapData%JacPivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%JacPivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%JacPivot = SrcAeroMapData%JacPivot + end if + if (allocated(SrcAeroMapData%HubOrientation)) then + LB(1:3) = lbound(SrcAeroMapData%HubOrientation, kind=B8Ki) + UB(1:3) = ubound(SrcAeroMapData%HubOrientation, kind=B8Ki) + if (.not. allocated(DstAeroMapData%HubOrientation)) then + allocate(DstAeroMapData%HubOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%HubOrientation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%HubOrientation = SrcAeroMapData%HubOrientation + end if + if (allocated(SrcAeroMapData%u1)) then + LB(1:1) = lbound(SrcAeroMapData%u1, kind=B8Ki) + UB(1:1) = ubound(SrcAeroMapData%u1, kind=B8Ki) + if (.not. allocated(DstAeroMapData%u1)) then + allocate(DstAeroMapData%u1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%u1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%u1 = SrcAeroMapData%u1 + end if + if (allocated(SrcAeroMapData%u2)) then + LB(1:1) = lbound(SrcAeroMapData%u2, kind=B8Ki) + UB(1:1) = ubound(SrcAeroMapData%u2, kind=B8Ki) + if (.not. allocated(DstAeroMapData%u2)) then + allocate(DstAeroMapData%u2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%u2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%u2 = SrcAeroMapData%u2 + end if + if (allocated(SrcAeroMapData%Residual)) then + LB(1:1) = lbound(SrcAeroMapData%Residual, kind=B8Ki) + UB(1:1) = ubound(SrcAeroMapData%Residual, kind=B8Ki) + if (.not. allocated(DstAeroMapData%Residual)) then + allocate(DstAeroMapData%Residual(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Residual.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Residual = SrcAeroMapData%Residual + end if + if (allocated(SrcAeroMapData%SolveDelta)) then + LB(1:1) = lbound(SrcAeroMapData%SolveDelta, kind=B8Ki) + UB(1:1) = ubound(SrcAeroMapData%SolveDelta, kind=B8Ki) + if (.not. allocated(DstAeroMapData%SolveDelta)) then + allocate(DstAeroMapData%SolveDelta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%SolveDelta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%SolveDelta = SrcAeroMapData%SolveDelta + end if + if (allocated(SrcAeroMapData%Cases)) then + LB(1:1) = lbound(SrcAeroMapData%Cases, kind=B8Ki) + UB(1:1) = ubound(SrcAeroMapData%Cases, kind=B8Ki) + if (.not. allocated(DstAeroMapData%Cases)) then + allocate(DstAeroMapData%Cases(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Cases.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyAeroMapCase(SrcAeroMapData%Cases(i1), DstAeroMapData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstAeroMapData%LinFileNum = SrcAeroMapData%LinFileNum +end subroutine + +subroutine Glue_DestroyAeroMap(AeroMapData, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AeroMapData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyAeroMap' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyModDataType(AeroMapData%Mod, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroMapData%iModOrder)) then + deallocate(AeroMapData%iModOrder) + end if + if (allocated(AeroMapData%Jac11)) then + deallocate(AeroMapData%Jac11) + end if + if (allocated(AeroMapData%Jac12)) then + deallocate(AeroMapData%Jac12) + end if + if (allocated(AeroMapData%Jac21)) then + deallocate(AeroMapData%Jac21) + end if + if (allocated(AeroMapData%Jac22)) then + deallocate(AeroMapData%Jac22) + end if + if (allocated(AeroMapData%JacPivot)) then + deallocate(AeroMapData%JacPivot) + end if + if (allocated(AeroMapData%HubOrientation)) then + deallocate(AeroMapData%HubOrientation) + end if + if (allocated(AeroMapData%u1)) then + deallocate(AeroMapData%u1) + end if + if (allocated(AeroMapData%u2)) then + deallocate(AeroMapData%u2) + end if + if (allocated(AeroMapData%Residual)) then + deallocate(AeroMapData%Residual) + end if + if (allocated(AeroMapData%SolveDelta)) then + deallocate(AeroMapData%SolveDelta) + end if + if (allocated(AeroMapData%Cases)) then + LB(1:1) = lbound(AeroMapData%Cases, kind=B8Ki) + UB(1:1) = ubound(AeroMapData%Cases, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyAeroMapCase(AeroMapData%Cases(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroMapData%Cases) + end if +end subroutine + +subroutine Glue_PackAeroMap(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_AeroMap), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackAeroMap' + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call Glue_PackModDataType(RF, InData%Mod) + call RegPackAlloc(RF, InData%iModOrder) + call RegPack(RF, InData%iModED) + call RegPack(RF, InData%iModBD) + call RegPack(RF, InData%iModAD) + call RegPackAlloc(RF, InData%Jac11) + call RegPackAlloc(RF, InData%Jac12) + call RegPackAlloc(RF, InData%Jac21) + call RegPackAlloc(RF, InData%Jac22) + call RegPackAlloc(RF, InData%JacPivot) + call RegPackAlloc(RF, InData%HubOrientation) + call RegPackAlloc(RF, InData%u1) + call RegPackAlloc(RF, InData%u2) + call RegPackAlloc(RF, InData%Residual) + call RegPackAlloc(RF, InData%SolveDelta) + call RegPack(RF, allocated(InData%Cases)) + if (allocated(InData%Cases)) then + call RegPackBounds(RF, 1, lbound(InData%Cases, kind=B8Ki), ubound(InData%Cases, kind=B8Ki)) + LB(1:1) = lbound(InData%Cases, kind=B8Ki) + UB(1:1) = ubound(InData%Cases, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackAeroMapCase(RF, InData%Cases(i1)) + end do + end if + call RegPack(RF, InData%LinFileNum) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackAeroMap(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_AeroMap), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackAeroMap' + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call Glue_UnpackModDataType(RF, OutData%Mod) ! Mod + call RegUnpackAlloc(RF, OutData%iModOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModED); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModBD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModAD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac21); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%JacPivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Residual); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SolveDelta); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Cases)) deallocate(OutData%Cases) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Cases(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackAeroMapCase(RF, OutData%Cases(i1)) ! Cases + end do + end if + call RegUnpack(RF, OutData%LinFileNum); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine Glue_CopyLinMisc(SrcLinMiscData, DstLinMiscData, CtrlCode, ErrStat, ErrMsg) type(Glue_LinMisc), intent(in) :: SrcLinMiscData type(Glue_LinMisc), intent(inout) :: DstLinMiscData @@ -1974,12 +2582,18 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end if + call Glue_CopyModDataType(SrcMiscData%ModGlue, DstMiscData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return call Glue_CopyLinMisc(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call Glue_CopyCalcSteady(SrcMiscData%CS, DstMiscData%CS, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call Glue_CopyAeroMap(SrcMiscData%AM, DstMiscData%AM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%q)) then LB(1:2) = lbound(SrcMiscData%q, kind=B8Ki) UB(1:2) = ubound(SrcMiscData%q, kind=B8Ki) @@ -2303,10 +2917,14 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%Mappings) end if + call Glue_DestroyModDataType(MiscData%ModGlue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Glue_DestroyLinMisc(MiscData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Glue_DestroyCalcSteady(MiscData%CS, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyAeroMap(MiscData%AM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%q)) then deallocate(MiscData%q) end if @@ -2406,8 +3024,10 @@ subroutine Glue_PackMisc(RF, Indata) call Glue_PackMappingType(RF, InData%Mappings(i1)) end do end if + call Glue_PackModDataType(RF, InData%ModGlue) call Glue_PackLinMisc(RF, InData%Lin) call Glue_PackCalcSteady(RF, InData%CS) + call Glue_PackAeroMap(RF, InData%AM) call RegPackAlloc(RF, InData%q) call RegPackAlloc(RF, InData%qn) call RegPackAlloc(RF, InData%x) @@ -2474,8 +3094,10 @@ subroutine Glue_UnPackMisc(RF, OutData) call Glue_UnpackMappingType(RF, OutData%Mappings(i1)) ! Mappings end do end if + call Glue_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue call Glue_UnpackLinMisc(RF, OutData%Lin) ! Lin call Glue_UnpackCalcSteady(RF, OutData%CS) ! CS + call Glue_UnpackAeroMap(RF, OutData%AM) ! AM call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%qn); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return From 7182ff8d4115a3bde4c655565511f5611d0a7b1d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 15 Jun 2024 13:41:34 +0000 Subject: [PATCH 150/319] Change FAST_Idx.f90 to FAST_ModData.90 in simulink CMakeLists.txt --- glue-codes/simulink/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index 9840eed67a..3d5471b4d8 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -61,7 +61,7 @@ matlab_add_mex( ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Funcs.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModGlue.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mapping.f90 - ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Idx.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModData.f90 LINK_TO ${MEX_LIBS} ${MEX_LIBS} # DO NOT REMOVE (needed to ensure no unresolved symbols) From c465160f9c343425479b9af9a109a87d59319e3a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 18 Jun 2024 12:10:25 +0000 Subject: [PATCH 151/319] AeroMap working for ElastoDyn --- modules/aerodyn/src/AeroDyn.f90 | 17 +- modules/elastodyn/src/ElastoDyn.f90 | 39 +- modules/elastodyn/src/ElastoDyn_Registry.txt | 4 + modules/elastodyn/src/ElastoDyn_Types.f90 | 54 ++ modules/nwtc-library/src/ModVar.f90 | 65 ++- modules/openfast-library/src/FAST_AeroMap.f90 | 474 ++++++++---------- modules/openfast-library/src/FAST_Funcs.f90 | 125 ++++- modules/openfast-library/src/FAST_ModData.f90 | 23 +- .../openfast-library/src/Glue_Registry.txt | 2 + modules/openfast-library/src/Glue_Types.f90 | 8 + 10 files changed, 499 insertions(+), 312 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index c0c683c6dd..7c2e745d98 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -6787,47 +6787,37 @@ logical function Failed() end subroutine RotGetOP !> AD_SetOP populates the data structures from the operating point arrays. (Extended inputs are not used) -subroutine AD_SetOP(iRotor, u, p, x, xd, z, y, ErrStat, ErrMsg, u_op, y_op, x_op, xd_op, z_op) +subroutine AD_SetOP(iRotor, u, p, x, xd, z, ErrStat, ErrMsg, u_op, x_op, xd_op, z_op) INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point TYPE(AD_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states at operating point TYPE(AD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Output at operating point INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: y_op(:) !< values of linearized outputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: x_op(:) !< values of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: z_op(:) !< values of linearized constraint states - if (iRotor < 1 .or. iRotor > size(p%rotors)) then - ErrStat = ErrID_Fatal - ErrMsg = "AD_SetOP: Invalid rotor index: "//trim(Num2LStr(iRotor))//", must be between 1 and "//Num2LStr(size(p%rotors)) - return - end if - - call RotSetOP(u%rotors(iRotor), p%rotors(iRotor), x%rotors(iRotor), xd%rotors(iRotor), z%rotors(iRotor), y%rotors(iRotor), ErrStat, ErrMsg, u_op, y_op, x_op, xd_op, z_op) + call RotSetOP(u%rotors(iRotor), p%rotors(iRotor), x%rotors(iRotor), xd%rotors(iRotor), z%rotors(iRotor), ErrStat, ErrMsg, u_op, x_op, xd_op, z_op) end subroutine !> RotSetOP populates the data structures from the operating point arrays. (Extended inputs are not used) -subroutine RotSetOP(u, p, x, xd, z, y, ErrStat, ErrMsg, u_op, x_op, xd_op, z_op, y_op) +subroutine RotSetOP(u, p, x, xd, z, ErrStat, ErrMsg, u_op, x_op, xd_op, z_op) type(RotInputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(RotParameterType), intent(in ) :: p !< Parameters type(RotContinuousStateType), intent(inout) :: x !< Continuous states at operating point type(RotDiscreteStateType), intent(inout) :: xd !< Discrete states at operating point type(RotConstraintStateType), intent(inout) :: z !< Constraint states at operating point - type(RotOutputType), intent(inout) :: y !< Output at operating point integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None real(R8Ki), allocatable, optional, intent(in ) :: u_op(:) !< values of linearized inputs real(R8Ki), allocatable, optional, intent(in ) :: x_op(:) !< values of linearized continuous states real(R8Ki), allocatable, optional, intent(in ) :: xd_op(:) !< values of linearized discrete states real(R8Ki), allocatable, optional, intent(in ) :: z_op(:) !< values of linearized constraint states - real(R8Ki), allocatable, optional, intent(in ) :: y_op(:) !< values of linearized outputs character(*), parameter :: RoutineName = 'AD_SetOP' integer(IntKi) :: ErrStat2 @@ -6837,7 +6827,6 @@ subroutine RotSetOP(u, p, x, xd, z, y, ErrStat, ErrMsg, u_op, x_op, xd_op, z_op, ErrMsg = '' if (present(u_op)) call AD_UnpackInputOP(p, u_op, u) - if (present(y_op)) call AD_UnpackOutputOP(p, y_op, y) if (present(x_op)) call AD_UnpackContStateOP(p, x_op, x) if (present(xd_op)) call AD_UnpackDiscStateOP(p, xd_op, xd) if (present(z_op)) call AD_UnpackConstrStateOP(p, z_op, z) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index c22726b423..318efdc61f 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -63,8 +63,9 @@ MODULE ElastoDyn ! states (z) PUBLIC :: ED_GetOP ! Routine to pack the operating point values (for linearization) into arrays + PUBLIC :: ED_SetOP ! Routine to unpack the operating point values from arrays - PUBLIC :: ED_PackContStateOP, ED_UnpackStateOP + PUBLIC :: ED_PackContStateOP, ED_UnpackContStateOP PUBLIC :: ED_PackInputOP, ED_UnpackInputOP PUBLIC :: ED_PackOutputOP @@ -10878,13 +10879,13 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) @@ -10917,13 +10918,13 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) @@ -11213,6 +11214,26 @@ logical function Failed() Failed = ErrStat >= AbortErrLev end function END SUBROUTINE ED_GetOP + +!---------------------------------------------------------------------------------------------------------------------------------- +!> ED_SetOP sets input and state values from an array. Inverse of ED_GetOP +subroutine ED_SetOP(u, p, x, xd, z, u_op, x_op, xd_op, z_op) + TYPE(ED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ED_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point + TYPE(ED_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states at operating point + TYPE(ED_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + + if (present(u_op)) call ED_UnpackInputOP(p, u_op, u) + if (present(x_op)) call ED_UnpackContStateOP(p, x_op, x) + ! if (present(xd_op)) call ED_UnpackDiscStateOP(p, xd, xd_op) + ! if (present(z_op)) call ED_UnpackDiscStateOP(p, z, z_op) + +END subroutine !---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- @@ -11370,10 +11391,12 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat LinNames=['Hub teetering DOF (internal DOF index = DOF_Teet), rad'], & Active=InputFileData%TeetDOF) + call AllocAry(p%iVarBladeFlap1, p%NumBl, 'iVarBladeFlap1', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', FieldTransDisp, & + VarIdx=p%iVarBladeFlap1(i), & Flags=Flags, & iUsr=DOF_BF(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & @@ -11382,10 +11405,12 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat Active=InputFileData%FlapDOF1) end do + call AllocAry(p%iVarBladeEdge1, p%NumBl, 'iVarBladeEdge1', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', FieldTransDisp, & + VarIdx=p%iVarBladeEdge1(i), & Flags=Flags, & iUsr=DOF_BE(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & @@ -11394,10 +11419,12 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat Active=InputFileData%EdgeDOF) end do + call AllocAry(p%iVarBladeFlap2, p%NumBl, 'iVarBladeFlap2', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', FieldTransDisp, & + VarIdx=p%iVarBladeFlap2(i), & Flags=Flags, & iUsr=DOF_BF(i,2), & Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & @@ -11675,7 +11702,7 @@ subroutine ED_PackContStateOP(p, x, ary) end do end subroutine -subroutine ED_UnpackStateOP(p, ary, x) +subroutine ED_UnpackContStateOP(p, ary, x) type(ED_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: ary(:) type(ED_ContinuousStateType), intent(inout) :: x diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 312539f1b6..4a8c5aadbd 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -764,6 +764,10 @@ typedef ^ ParameterType Integer NumBl_Lin - - - "number of blades in the jacobia typedef ^ ParameterType Integer NActvVelDOF_Lin - - - "number of velocity states in the jacobian" - typedef ^ ParameterType Integer NActvDOF_Lin - - - "number of active DOFs to use in the jacobian" - typedef ^ ParameterType Integer NActvDOF_Stride - - - "stride for active DOFs to use in the jacobian" - +# State variable indices +typedef ^ ParameterType IntKi iVarBladeFlap1 {:} - - "Indices of BladeFlap1 variable" - +typedef ^ ParameterType IntKi iVarBladeEdge1 {:} - - "Indices of BladeEdge1 variable" - +typedef ^ ParameterType IntKi iVarBladeFlap2 {:} - - "Indices of BladeFlap2 variable" - # Input variable indices typedef ^ ParameterType IntKi iVarBladePtLoads {:} - - "Indices of blade point loads mesh variable" - typedef ^ ParameterType IntKi iVarPlatformPtMesh - - - "Index of platform point loads mesh variable" - diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 3532e8a93f..632e0e48c1 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -779,6 +779,9 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: NActvVelDOF_Lin = 0_IntKi !< number of velocity states in the jacobian [-] INTEGER(IntKi) :: NActvDOF_Lin = 0_IntKi !< number of active DOFs to use in the jacobian [-] INTEGER(IntKi) :: NActvDOF_Stride = 0_IntKi !< stride for active DOFs to use in the jacobian [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeFlap1 !< Indices of BladeFlap1 variable [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeEdge1 !< Indices of BladeEdge1 variable [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeFlap2 !< Indices of BladeFlap2 variable [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladePtLoads !< Indices of blade point loads mesh variable [-] INTEGER(IntKi) :: iVarPlatformPtMesh = 0_IntKi !< Index of platform point loads mesh variable [-] INTEGER(IntKi) :: iVarTowerPtLoads = 0_IntKi !< Index of tower point loads mesh variable [-] @@ -5760,6 +5763,42 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NActvVelDOF_Lin = SrcParamData%NActvVelDOF_Lin DstParamData%NActvDOF_Lin = SrcParamData%NActvDOF_Lin DstParamData%NActvDOF_Stride = SrcParamData%NActvDOF_Stride + if (allocated(SrcParamData%iVarBladeFlap1)) then + LB(1:1) = lbound(SrcParamData%iVarBladeFlap1, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarBladeFlap1, kind=B8Ki) + if (.not. allocated(DstParamData%iVarBladeFlap1)) then + allocate(DstParamData%iVarBladeFlap1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeFlap1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarBladeFlap1 = SrcParamData%iVarBladeFlap1 + end if + if (allocated(SrcParamData%iVarBladeEdge1)) then + LB(1:1) = lbound(SrcParamData%iVarBladeEdge1, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarBladeEdge1, kind=B8Ki) + if (.not. allocated(DstParamData%iVarBladeEdge1)) then + allocate(DstParamData%iVarBladeEdge1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeEdge1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarBladeEdge1 = SrcParamData%iVarBladeEdge1 + end if + if (allocated(SrcParamData%iVarBladeFlap2)) then + LB(1:1) = lbound(SrcParamData%iVarBladeFlap2, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%iVarBladeFlap2, kind=B8Ki) + if (.not. allocated(DstParamData%iVarBladeFlap2)) then + allocate(DstParamData%iVarBladeFlap2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeFlap2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%iVarBladeFlap2 = SrcParamData%iVarBladeFlap2 + end if if (allocated(SrcParamData%iVarBladePtLoads)) then LB(1:1) = lbound(SrcParamData%iVarBladePtLoads, kind=B8Ki) UB(1:1) = ubound(SrcParamData%iVarBladePtLoads, kind=B8Ki) @@ -6021,6 +6060,15 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%dx)) then deallocate(ParamData%dx) end if + if (allocated(ParamData%iVarBladeFlap1)) then + deallocate(ParamData%iVarBladeFlap1) + end if + if (allocated(ParamData%iVarBladeEdge1)) then + deallocate(ParamData%iVarBladeEdge1) + end if + if (allocated(ParamData%iVarBladeFlap2)) then + deallocate(ParamData%iVarBladeFlap2) + end if if (allocated(ParamData%iVarBladePtLoads)) then deallocate(ParamData%iVarBladePtLoads) end if @@ -6291,6 +6339,9 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%NActvVelDOF_Lin) call RegPack(RF, InData%NActvDOF_Lin) call RegPack(RF, InData%NActvDOF_Stride) + call RegPackAlloc(RF, InData%iVarBladeFlap1) + call RegPackAlloc(RF, InData%iVarBladeEdge1) + call RegPackAlloc(RF, InData%iVarBladeFlap2) call RegPackAlloc(RF, InData%iVarBladePtLoads) call RegPack(RF, InData%iVarPlatformPtMesh) call RegPack(RF, InData%iVarTowerPtLoads) @@ -6596,6 +6647,9 @@ subroutine ED_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%NActvVelDOF_Lin); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NActvDOF_Lin); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NActvDOF_Stride); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladeFlap1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladeEdge1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iVarBladeFlap2); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iVarBladePtLoads); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarPlatformPtMesh); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarTowerPtLoads); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 03eab37651..e33843e575 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -31,7 +31,7 @@ module ModVar private public :: MV_InitVarsJac, MV_Pack, MV_Unpack -public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff, MV_ExtrapInterp +public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff, MV_ExtrapInterp, MV_AddDelta public :: MV_AddVar, MV_AddMeshVar public :: MV_HasFlags, MV_SetFlags, MV_ClearFlags, MV_NumVars public :: LoadFields, MotionFields, TransFields, AngularFields @@ -309,7 +309,7 @@ function Failed() ! Functions for packing and unpacking data by variable !------------------------------------------------------------------------------- -subroutine MV_PackMatrix(RowVarAry, ColVarAry, FlagFilter, M, SubM) +subroutine MV_PackMatrix(RowVarAry, ColVarAry, M, SubM, FlagFilter) type(ModVarType), intent(in) :: RowVarAry(:), ColVarAry(:) real(R8Ki), intent(in) :: M(:, :) real(R8Ki), intent(inout) :: SubM(:, :) @@ -319,9 +319,9 @@ subroutine MV_PackMatrix(RowVarAry, ColVarAry, FlagFilter, M, SubM) col = 1 row = 1 do i = 1, size(ColVarAry) - if (iand(ColVarAry(i)%Flags, FlagFilter) == 0) cycle + if (.not. MV_HasFlags(ColVarAry(i), FlagFilter)) cycle do j = 1, size(RowVarAry) - if (iand(RowVarAry(j)%Flags, FlagFilter) == 0) cycle + if (.not. MV_HasFlags(RowVarAry(j), FlagFilter)) cycle associate (rVar => RowVarAry(i), cVar => ColVarAry(i)) SubM(row:row + rVar%Num - 1, col:col + cVar%Num - 1) = M(rVar%iLoc(1):rVar%iLoc(2), cVar%iLoc(1):cVar%iLoc(2)) end associate @@ -822,6 +822,43 @@ subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) end subroutine +subroutine MV_AddDelta(VarAry, DeltaAry, DataAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: DeltaAry(:) ! Array of delta values + real(R8Ki), intent(inout) :: DataAry(:) ! Array to be modified + integer(IntKi) :: i, j, k + real(R8Ki) :: quat_base(3), quat_delta(3) + + ! Loop through variables + do i = 1, size(VarAry) + associate (iLoc => VarAry(i)%iLoc) + select case (VarAry(i)%Field) + case (FieldOrientation) + + ! Starting index into arrays + k = iLoc(1) + + ! Loop through nodes + do j = 1, VarAry(i)%Nodes + + ! Quaternions from negative and positive perturbations + quat_base = DataAry(k:k + 2) + quat_delta = rvec_to_quat(DeltaAry(k:k + 2)) + + ! Calculate composition of base quaternion and delta quaternion + DataAry(k:k + 2) = quat_compose(quat_base, quat_delta) + + ! Increment starting index + k = k + 3 + end do + + case default + DataAry(iLoc(1):iLoc(2)) = DataAry(iLoc(1):iLoc(2)) + DeltaAry(iLoc(1):iLoc(2)) + end select + end associate + end do +end subroutine + !------------------------------------------------------------------------------- ! Functions for adding Variables !------------------------------------------------------------------------------- @@ -976,12 +1013,15 @@ pure logical function MV_IsLoad(Var) ! Flag Utilities !------------------------------------------------------------------------------- +!> MV_HasFlags returns true if Flags is VF_None or if variable contains all +!> flags in Flags. pure logical function MV_HasFlags(Var, Flags) type(ModVarType), intent(in) :: Var integer(IntKi), intent(in) :: Flags MV_HasFlags = iand(Var%Flags, Flags) == Flags end function +!> MV_SetFlags adds the given flags to the variable. subroutine MV_SetFlags(Var, Flags) type(ModVarType), intent(inout) :: Var integer(IntKi), intent(in) :: Flags @@ -989,6 +1029,7 @@ subroutine MV_SetFlags(Var, Flags) Var%Flags = ior(Var%Flags, Flags) end subroutine +!> MV_ClearFlags removes the given flags from the variable. subroutine MV_ClearFlags(Var, Flags) type(ModVarType), intent(inout) :: Var integer(IntKi), intent(in) :: Flags @@ -1251,17 +1292,23 @@ pure function quat_to_rvec(q) result(rvec) else qr = sqrt(1.0_R8Ki - m*m) ! Scalar part theta = 2.0_R8Ki*atan2(m, qr) ! Angle - rvec = theta*q/m + rvec = -theta*q/m ! Negative sign doesn't make sense, but needed for quaternions end if end function pure function rvec_to_quat(rvec) result(q) real(R8Ki), intent(in) :: rvec(3) - real(R8Ki) :: theta, q0, q(3) + real(R8Ki) :: theta, half_theta, q0, q(3) theta = sqrt(dot_product(rvec, rvec)) - q0 = cos(theta/2.0_R8Ki) - q = rvec/theta*sin(theta/2.0_R8Ki) - q = quat_canonical(q0, q) + if (theta < epsilon(theta)) then + ! Angle is zero, quaternion is identity + q = 0.0_R8Ki + else + half_theta = theta/2.0_R8Ki + q0 = cos(half_theta) + q = rvec/theta*sin(half_theta) + q = -quat_canonical(q0, q) ! Negative sign doesn't make sense, but needed for quaternions + end if end function pure function wm_to_quat(c) result(q) diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index ed5d5fd21d..de872c3480 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -36,7 +36,7 @@ module FAST_AeroMap real(DbKi), parameter :: SS_t_global = 0.0_DbKi real(DbKi), parameter :: UJacSclFact_x = 1.0d3 -logical, parameter :: output_debugging = .true. +logical, parameter :: output_debugging = .false. contains @@ -228,12 +228,10 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) call AllocAry(m%AM%Mod%Lin%dUdy, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return ! Allocate operating point arrays - if (output_debugging) then - call AllocAry(m%AM%Mod%Lin%x, m%AM%Mod%Vars%Nx, 'x', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%dx, m%AM%Mod%Vars%Nx, 'dx', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%u, m%AM%Mod%Vars%Nu, 'u', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%y, m%AM%Mod%Vars%Ny, 'y', ErrStat2, ErrMsg2); if (Failed()) return - end if + call AllocAry(m%AM%Mod%Lin%x, m%AM%Mod%Vars%Nx, 'x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%u, m%AM%Mod%Vars%Nu, 'u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%dx, m%AM%Mod%Vars%Nx, 'dx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%AM%Mod%Lin%y, m%AM%Mod%Vars%Ny, 'y', ErrStat2, ErrMsg2); if (Failed()) return ! Allocate arrays to store inputs call AllocAry(m%AM%u1, m%AM%Mod%Vars%Nu, 'u1', ErrStat2, ErrMsg2); if (Failed()) return @@ -242,6 +240,16 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) ! Move hub orientation matrices to AeroMap structure call move_alloc(T%MeshMapData%HubOrient, m%AM%HubOrientation) + !---------------------------------------------------------------------------- + ! AeroMap structure initialization + !---------------------------------------------------------------------------- + + ! Jacobian scaling factor + m%AM%JacScale = real(p_FAST%UJacSclFact, R8Ki) + + ! Set tolerance so the error doesn't need to be divided by size of array later + m%AM%SolveTolerance = p_FAST%tolerSquared*JacSize**2 + ! Allocate cases allocate (m%AM%Cases(p_FAST%NumSSCases), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -279,7 +287,7 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) end if ! Call steady-state solve for this pitch and rotor speed - call SolveSteadyState(m, m%AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T%MeshMapData, T, ErrStat2, ErrMsg2) + call SS_Solve(m, m%AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) ! we didn't converge; let's try a different operating point and see if that helps: if (ErrStat2 >= ErrID_Severe) then @@ -296,11 +304,11 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) call WrScr('Retrying case '//trim(Num2LStr(n_case))//', first trying to get a better initial guess. Average error is '// & trim(Num2LStr(y_FAST%DriverWriteOutput(SS_Indx_Err)))//'.') - ! call SolveSteadyState(m, CaseDataTmp, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + call SS_Solve(m, CaseDataTmp, p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) ! if that worked, try the real case again: if (ErrStat2 < AbortErrLev) then - ! call SolveSteadyState(m, m%AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + ! call SS_Solve(m, m%AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) call WrOver(BlankLine) end if @@ -349,35 +357,34 @@ logical function Failed() !---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the Input-Output solve for the steady-state solver. !! Note that this has been customized for the physics in the problems and is not a general solution. -subroutine SolveSteadyState(m, caseData, p_FAST, y_FAST, m_FAST, MeshMapData, T, ErrStat, ErrMsg) +subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case type(FAST_ParameterType), intent(in) :: p_FAST !< Glue-code simulation parameters type(FAST_OutputFileType), intent(inout) :: y_FAST !< Glue-code output file values type(FAST_MiscVarType), intent(inout) :: m_FAST !< Miscellaneous variables type(FAST_TurbineType), intent(inout) :: T !< Turbine type - type(FAST_ModuleMapType), intent(inout) :: MeshMapData !< data for mapping meshes between modules integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'SolveSteadyState' + character(*), parameter :: RoutineName = 'SS_Solve' integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None !bjj: store these so that we don't reallocate every time? real(R8Ki) :: err real(R8Ki) :: err_prev + real(R8Ki), allocatable :: u(:) real(R8Ki), parameter :: reduction_factor = 0.1_R8Ki integer(IntKi) :: nb ! loop counter (blade number) integer(IntKi) :: MaxIter ! maximum number of iterations integer(IntKi) :: K ! Input-output-solve iteration counter integer(IntKi) :: i, j + integer(IntKi) :: iModOrder(3), iMod logical :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput - ! Note: p_FAST%UJacSclFact is a scaling factor that gets us similar magnitudes between loads and accelerations... - !bjj: note, that this routine may have a problem if there is remapping done ErrStat = ErrID_None @@ -421,7 +428,7 @@ subroutine SolveSteadyState(m, caseData, p_FAST, y_FAST, m_FAST, MeshMapData, T, GetWriteOutput = K > 0 !----------------------------------------- - ! Caclulate ElastoDyn / BeamDyn output + ! Calculate ElastoDyn / BeamDyn output !----------------------------------------- ! If BeamDyn is active @@ -453,7 +460,7 @@ subroutine SolveSteadyState(m, caseData, p_FAST, y_FAST, m_FAST, MeshMapData, T, call SS_AD_InputSolve_OtherBlades(m, INPUT_CURR, T) ! set up x-u vector, using local initial guesses - call SS_GetInputs(m, m%AM%u1, p_FAST%UJacSclFact, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call SS_GetInputs(m, m%AM%u1, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) end if @@ -495,7 +502,7 @@ subroutine SolveSteadyState(m, caseData, p_FAST, y_FAST, m_FAST, MeshMapData, T, end if !------------------------------------------------------------------------- - ! Solve for delta u: Jac*u_delta = - Fn_U_Resid + ! Solve for delta u: J*SolveDelta = -Residual ! using the LAPACK routine !------------------------------------------------------------------------- @@ -522,7 +529,7 @@ subroutine SolveSteadyState(m, caseData, p_FAST, y_FAST, m_FAST, MeshMapData, T, y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/size(m%AM%Mod%Lin%J, 1) ! If error is below tolerance - if (err <= p_FAST%TolerSquared) then + if (err <= m%AM%SolveTolerance) then if (K == 0) then ! the error will be incorrect in this instance, but the outputs will be better MaxIter = K else @@ -540,32 +547,98 @@ subroutine SolveSteadyState(m, caseData, p_FAST, y_FAST, m_FAST, MeshMapData, T, ! If current error is greater than previous error (solution diverging), ! reduce delta (take a smaller step) if (err > err_prev) then - m%AM%SolveDelta = m%AM%SolveDelta*reduction_factor + m%AM%SolveDelta = m%AM%SolveDelta*reduction_factor err_prev = err_prev*reduction_factor end if - ! ! call Add_SteadyState_delta(p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData) + ! Set module order + iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] - ! !u = u + u_delta - ! call SS_GetInputs(m, T, p_FAST%UJacSclFact, INPUT_CURR, STATE_CURR, ErrStat2, ErrMsg2) + ! Update states and inputs in module + do i = 1, size(iModOrder) + iMod = iModOrder(i) + if (iMod == 0) cycle + call FAST_GetOP(m%Modules(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=m%Modules(iMod)%Lin%u, x_op=m%Modules(iMod)%Lin%x) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, m%Modules(iMod)%Lin%x, m%AM%Mod%Lin%x) + call ModD_PackAry(m%AM%Mod%Xfr(iMod)%u, m%Modules(iMod)%Lin%u, m%AM%Mod%Lin%u) + end do - ! K = K + 1 - ! y_FAST%DriverWriteOutput(SS_Indx_Iter) = k + ! Remove conditioning from solution vector + call PostconditionSolveDelta(m%AM%SolveDelta(m%AM%Mod%Vars%Nx + 1:), m%AM%JacScale) + + ! Add change in continuous states to current states + call MV_AddDelta(m%AM%Mod%Vars%x, m%AM%SolveDelta(:m%AM%Mod%Vars%Nx), m%AM%Mod%Lin%x) + + ! Add change in inputs to current inputs + call MV_AddDelta(m%AM%Mod%Vars%u, m%AM%SolveDelta(m%AM%Mod%Vars%Nx + 1:), m%AM%Mod%Lin%u) + + ! Update states and inputs in module + do i = 1, size(iModOrder) + iMod = iModOrder(i) + if (iMod == 0) cycle + call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%x, m%Modules(iMod)%Lin%x, m%AM%Mod%Lin%x) + call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%u, m%Modules(iMod)%Lin%u, m%AM%Mod%Lin%u) + + select case (m%Modules(iMod)%ID) + case (Module_ED) + ! Copy blade1 flap and edge states to other blades + do j = 2, T%ED%p%NumBl + associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(1)), & + VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(j))) + m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + end associate + associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(1)), & + VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(j))) + m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + end associate + associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(1)), & + VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(j))) + m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + end associate + end do + case (Module_BD) + ! TODO: Copy B1 states to other blades + end select + + ! Populate values in module + call FAST_SetOP(m%Modules(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=m%Modules(iMod)%Lin%u, x_op=m%Modules(iMod)%Lin%x) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + + ! Transfer results from blade 1 to other blades + if (m%AM%iModBD > 0) then + ! BeamDyn + call SS_BD_InputSolve_OtherBlades(m, INPUT_CURR, T) + else + ! ElastoDyn + call SS_ED_InputSolve_OtherBlades(m, INPUT_CURR, T) + end if + call SS_AD_InputSolve_OtherBlades(m, INPUT_CURR, T) + + ! u = u + u_delta + call SS_GetInputs(m, m%AM%u1, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + + K = K + 1 + y_FAST%DriverWriteOutput(SS_Indx_Iter) = k end do ! K - ! if (p_FAST%CompElast == Module_BD) then - ! ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: - ! call ED_CalcOutput(SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2) - ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! end if + !TODO + if (p_FAST%CompElast == Module_BD) then + ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: + ! call ED_CalcOutput(SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if call ResetInputsAndStates() contains subroutine ResetInputsAndStates() - if (err > p_FAST%TolerSquared) then + if (err > m%AM%SolveTolerance) then call SetErrStat(ErrID_Severe, 'Steady-state solver did not converge.', ErrStat, ErrMsg, RoutineName) @@ -582,14 +655,26 @@ subroutine ResetInputsAndStates() end do end if - call SS_GetInputs(m, m%AM%u1, p_FAST%UJacSclFact, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) ! find the values we have been modifying (in u... continuous states and inputs) - ! call Add_SteadyState_delta(p_FAST, y_FAST, -u, AD, ED, BD, MeshMapData) ! and reset them to 0 (by adding -u) + call SS_GetInputs(m, m%AM%u1, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) ! find the values we have been modifying (in u... continuous states and inputs) + ! call Add_SteadyState_delta(p_FAST, y_FAST, -u, AD, ED, BD) ! and reset them to 0 (by adding -u) end if end if end subroutine ResetInputsAndStates -end subroutine SolveSteadyState + subroutine PostconditionSolveDelta(Delta, JacScale) + real(R8Ki), intent(inout) :: Delta(:) + real(R8Ki), intent(in) :: JacScale + do i = 1, size(m%AM%Mod%Vars%u) + associate (Var => m%AM%Mod%Vars%u(i)) + if (MV_IsLoad(Var)) then + Delta(Var%iLoc(1):Var%iLoc(2)) = Delta(Var%iLoc(1):Var%iLoc(2))*JacScale + end if + end associate + end do + end subroutine + +end subroutine SS_Solve subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables @@ -605,9 +690,10 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMSg2 character(1024) :: LinRootName - integer(IntKi) :: i, j, k, c, r, iRow(2), iCol(2) + integer(IntKi) :: i, j, k, c, r, iRow(2), iCol(2), iLoc(2) integer(IntKi) :: nx ! Number of states integer(IntKi) :: Un + logical :: RowIsLoad, ColIsLoad ErrStat = ErrID_None ErrMsg = "" @@ -650,12 +736,12 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err associate (ModData => m%Modules(m%AM%iModOrder(i)), iMod => m%AM%iModOrder(i)) ! Calculate dYdu and dXdu - call FAST_JacobianPInput(ModData, SS_t_global, STATE_CURR, T, ErrStat, ErrMsg, & + call FAST_JacobianPInput(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & FlagFilter=VF_AeroMap, dYdu=ModData%Lin%dYdu, dXdu=ModData%Lin%dXdu) if (Failed()) return ! Calculate dYdx and dXdx - call FAST_JacobianPContState(ModData, SS_t_global, STATE_CURR, T, ErrStat, ErrMsg, & + call FAST_JacobianPContState(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & FlagFilter=VF_AeroMap, dYdx=ModData%Lin%dYdx, dXdx=ModData%Lin%dXdx) if (Failed()) return @@ -664,7 +750,7 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! Calculate operating point values call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & - u_op=ModData%Lin%u, y_op=ModData%Lin%y, x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) + FlagFilter=VF_AeroMap, u_op=ModData%Lin%u, y_op=ModData%Lin%y, x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) if (Failed()) return ! Write linearization matrices @@ -682,7 +768,7 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! If this module is BeamDyn, calculate dxdotdy if (ModData%ID == Module_BD) then - ! TODO: implement beamdyn + ! TODO: implement BeamDyn ! NOTE that this implies that the FEA nodes (states) are the same as the output nodes!!!! (note that we have overlapping nodes at the element end points) ! r = 1 ! do i = 2, BD%p(k)%node_total ! the first node isn't technically a state @@ -758,42 +844,40 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! Condition Jacobian matrix !---------------------------------------------------------------------------- - ! Loop through inputs - do c = 1, size(m%AM%Mod%Vars%u) + ! Note: m%AM%JacScale is a scaling factor that gets similar magnitudes between loads and accelerations... - iCol = m%AM%Mod%Vars%u(c)%iLoc + nx + associate (J => m%AM%Mod%Lin%J) - ! If column is a load - if (MV_IsLoad(m%AM%Mod%Vars%u(c))) then + ! Loop through inputs + do r = 1, size(m%AM%Mod%Vars%u) + iLoc = m%AM%Mod%Vars%u(r)%iLoc + nx + if (MV_IsLoad(m%AM%Mod%Vars%u(r))) then + ! Column is motion (state), row is load + J(iLoc(1):iLoc(2), 1:nx) = J(iLoc(1):iLoc(2), 1:nx)/m%AM%JacScale + ! Row is motion (state), column is load + J(1:nx, iLoc(1):iLoc(2)) = J(1:nx, iLoc(1):iLoc(2))*m%AM%JacScale + end if + end do - ! Column is a load, state rows are not loads - m%AM%Mod%Lin%J(1:nx, iCol(1):iCol(2)) = & - m%AM%Mod%Lin%J(1:nx, iCol(1):iCol(2))*p_FAST%UJacSclFact + ! Loop through input vars as columns + do c = 1, size(m%AM%Mod%Vars%u) + iCol = m%AM%Mod%Vars%u(c)%iLoc + nx + ColIsLoad = MV_IsLoad(m%AM%Mod%Vars%u(c)) - ! Loop through rows + ! Loop through input vars as rows do r = 1, size(m%AM%Mod%Vars%u) - ! If column is load, but row is a motion - if (.not. MV_IsLoad(m%AM%Mod%Vars%u(r))) then - iRow = m%AM%Mod%Vars%u(r)%iLoc + nx - m%AM%Mod%Lin%J(iRow(1):iRow(2), iCol(1):iCol(2)) = & - m%AM%Mod%Lin%J(iRow(1):iRow(2), iCol(1):iCol(2))*p_FAST%UJacSclFact - end if - end do - - else + iRow = m%AM%Mod%Vars%u(r)%iLoc + nx + RowIsLoad = MV_IsLoad(m%AM%Mod%Vars%u(r)) - ! Loop through rows - do r = 1, size(m%AM%Mod%Vars%u) - ! Column is a motion, but row is a load - if (MV_IsLoad(m%AM%Mod%Vars%u(r))) then - iRow = m%AM%Mod%Vars%u(r)%iLoc + nx - m%AM%Mod%Lin%J(iRow(1):iRow(2), iCol(1):iCol(2)) = & - m%AM%Mod%Lin%J(iRow(1):iRow(2), iCol(1):iCol(2))/p_FAST%UJacSclFact + if ((.not. RowIsLoad) .and. ColIsLoad) then ! Row is a motion, Col is a load + J(iRow(1):iRow(2), iCol(1):iCol(2)) = J(iRow(1):iRow(2), iCol(1):iCol(2))*m%AM%JacScale + else if (RowIsLoad .and. (.not. ColIsLoad)) then ! Row is a load, Col is a motion + J(iRow(1):iRow(2), iCol(1):iCol(2)) = J(iRow(1):iRow(2), iCol(1):iCol(2))/m%AM%JacScale end if end do + end do - end if - end do + end associate !---------------------------------------------------------------------------- ! Factor Jacobian matrix @@ -840,22 +924,15 @@ subroutine SS_BuildResidual(caseData, m, T, ErrStat, ErrMsg) !note: prescribed inputs are already set in both InputIndex=1 and InputIndex=2 so we can ignore them here ! Use current inputs to calculate CCSD in STATE_PRED - call SteadyStateCCSD(m, caseData, InputIndex, T, ErrStat2, ErrMsg2) + call SS_CalcContStateDeriv(m, caseData, INPUT_CURR, m%AM%Residual, T, ErrStat2, ErrMsg2) call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Store state accelerations in residual - if (m%AM%iModBD > 0) then - call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModBD)%x, m%Modules(m%AM%iModBD)%Lin%dx, m%AM%Residual) - else if (m%AM%iModED > 0) then - call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%Modules(m%AM%iModED)%Lin%dx, m%AM%Residual) - end if - ! note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the SS_GetInputs call SteadyStateCalculatedInputs(m, InputIndex, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Pack the output "residual vector" with these state derivatives and new inputs: - call SS_GetInputs(m, m%AM%u2, T%p_FAST%UJacSclFact, InputIndex, StateIndex, T, ErrStat2, ErrMsg2) + call SS_GetInputs(m, m%AM%u2, InputIndex, StateIndex, T, ErrStat2, ErrMsg2) ! Store difference in inputs m%AM%Residual(m%AM%Mod%Vars%Nx + 1:) = m%AM%u1 - m%AM%u2 @@ -978,13 +1055,14 @@ subroutine SS_AD_InputSolve_OtherBlades(m, InputIndex, T) end associate end subroutine SS_AD_InputSolve_OtherBlades -subroutine SteadyStateCCSD(m, caseData, InputIndex, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables - type(AeroMapCase), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - integer(IntKi), intent(IN) :: InputIndex !< Index into input array - type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type - integer(IntKi), intent(OUT) :: ErrStat !< Error status - character(*), intent(OUT) :: ErrMsg !< Error message +subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, Residual, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + integer(IntKi), intent(in) :: InputIndex !< Index into input array + real(R8Ki), intent(inout) :: Residual(:) !< Residual vector + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message character(*), parameter :: RoutineName = 'SteadyStateCCSD' integer(IntKi) :: ErrStat2 ! temporary Error status of the operation @@ -1003,13 +1081,20 @@ subroutine SteadyStateCCSD(m, caseData, InputIndex, T, ErrStat, ErrMsg) case (Module_ED) ! ElastoDyn - call FAST_GetOP(m%Modules(m%AM%iModED), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, dx_op=m%Modules(m%AM%iModED)%Lin%dx) + call FAST_GetOP(m%Modules(m%AM%iModED), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & + FlagFilter=VF_AeroMap, dx_op=m%Modules(m%AM%iModED)%Lin%dx) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%Modules(m%AM%iModED)%Lin%dx, Residual) + case (Module_BD) ! BeamDyn ! Set hub rotation speed - Omega_Hub = [caseData%RotSpeed, 0.0_R8Ki, 0.0_R8Ki] + Omega_Hub = [real(caseData%RotSpeed, R8Ki), 0.0_R8Ki, 0.0_R8Ki] + + call FAST_GetOP(m%Modules(m%AM%iModBD), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & + FlagFilter=VF_AeroMap, dx_op=m%Modules(m%AM%iModBD)%Lin%dx) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! TODO: Make this work for BeamDyn ! do K = 1, T%p_FAST%nBeams @@ -1032,9 +1117,11 @@ subroutine SteadyStateCCSD(m, caseData, InputIndex, T, ErrStat, ErrMsg) ! end do + call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModBD)%x, m%Modules(m%AM%iModBD)%Lin%dx, Residual) + end select -end subroutine SteadyStateCCSD +end subroutine SS_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- subroutine SteadyStateCalculatedInputs(m, InputIndex, T, ErrStat, ErrMsg) @@ -1064,180 +1151,38 @@ subroutine SteadyStateCalculatedInputs(m, InputIndex, T, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if -end subroutine SteadyStateCalculatedInputs - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine adds u_delta to the corresponding mesh field and scales it as appropriate -! subroutine Add_SteadyState_delta(p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData) -! !.................................................................................................................................. -! type(FAST_ParameterType), intent(IN) :: p_FAST !< Glue-code simulation parameters -! type(FAST_OutputFileType), intent(IN) :: y_FAST !< Output variables for the glue code -! real(R8Ki), intent(IN) :: u_delta(:) !< The delta amount to add to the appropriate mesh fields -! type(ElastoDyn_Data), intent(INOUT) :: ED !< ElastoDyn data -! type(BeamDyn_Data), intent(INOUT) :: BD !< BeamDyn data -! type(AeroDyn_Data), intent(INOUT) :: AD !< AeroDyn data -! type(FAST_ModuleMapType), intent(IN) :: MeshMapData !< data for mapping meshes between modules - -! ! local variables -! integer :: n -! integer :: fieldIndx -! integer :: node -! integer :: indx, indx_last -! integer :: i, j, k -! integer :: nx, nStates - -! real(R8Ki) :: orientation(3, 3) -! real(R8Ki) :: rotation(3, 3) - -! integer(IntKi) :: ErrStat2 -! character(ErrMsgLen) :: ErrMsg2 - -! nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) - -! ! structural code states: -! if (p_FAST%CompElast == Module_ED) then -! nStates = nx - -! do j = 1, nStates - -! do k = 1, ED%p%NActvDOF_Stride ! transfer these states to the other blades (this means that the original states MUST be set the same for all blades!!!) -! indx = ED%p%DOFs%PS((j - 1)*ED%p%NActvDOF_Stride + k) - -! ED%x(STATE_CURR)%QT(indx) = ED%x(STATE_CURR)%QT(indx) + u_delta(j) -! ED%x(STATE_CURR)%QDT(indx) = 0.0_R8Ki !ED%x( STATE_CURR)%QDT(indx) + u_delta(j+nStates) -! end do - -! end do - -! elseif (p_FAST%CompElast == Module_BD) then -! nStates = nx/2 - -! ! see BD's Perturb_x function: - -! do k = 1, p_FAST%nBeams -! indx = 1 -! do i = 2, BD%p(k)%node_total -! indx_last = indx + BD%p(k)%dof_node - 1 -! BD%x(k, STATE_CURR)%dqdt(:, i) = BD%x(k, STATE_CURR)%dqdt(:, i) + u_delta(nStates + indx:indx_last + nStates) -! BD%x(k, STATE_CURR)%q(1:3, i) = BD%x(k, STATE_CURR)%q(1:3, i) + u_delta(indx:indx + 2) - -! ! w-m parameters -! call BD_CrvMatrixR(BD%x(k, STATE_CURR)%q(4:6, i), rotation) ! returns the rotation matrix (transpose of DCM) that was stored in the state as a w-m parameter -! orientation = transpose(rotation) - -! call PerturbOrientationMatrix(Orientation, Perturbations=u_delta(indx + 3:indx_last)) - -! rotation = transpose(orientation) -! call BD_CrvExtractCrv(rotation, BD%x(k, STATE_CURR)%q(4:6, i), ErrStat2, ErrMsg2) ! return the w-m parameters of the new orientation - -! indx = indx_last + 1 -! end do -! end do -! end if !CompElast - -! ! inputs: -! ! we are at u_delta(nx+1 : end) -! n = nx + 1 -! if (p_FAST%CompElast == Module_ED) then - -! do K = 1, p_FAST%NumBl_Lin !we don't need all blades here: SIZE(ED%Input(1)%BladePtLoads,1) ! Loop through all blades - -! do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes -! do fieldIndx = 1, 3 -! ED%Input(1)%BladePtLoads(k)%Force(fieldIndx, node) = ED%Input(1)%BladePtLoads(k)%Force(fieldIndx, node) + u_delta(n)*p_FAST%UJacSclFact -! n = n + 1 -! end do -! end do - -! do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes -! do fieldIndx = 1, 3 -! ED%Input(1)%BladePtLoads(k)%Moment(fieldIndx, node) = ED%Input(1)%BladePtLoads(k)%Moment(fieldIndx, node) + u_delta(n)*p_FAST%UJacSclFact -! n = n + 1 -! end do -! end do - -! end do - -! call SS_ED_InputSolve_OtherBlades(p_FAST, ED%Input(1), MeshMapData) - -! elseif (p_FAST%CompElast == Module_BD) then - -! do K = 1, p_FAST%NumBl_Lin !we don't need all blades here: p_FAST%nBeams ! Loop through all blades - -! do node = 1, BD%Input(1, k)%DistrLoad%NNodes -! do fieldIndx = 1, 3 -! BD%Input(1, k)%DistrLoad%Force(fieldIndx, node) = BD%Input(1, k)%DistrLoad%Force(fieldIndx, node) + u_delta(n)*p_FAST%UJacSclFact -! n = n + 1 -! end do -! end do - -! do node = 1, BD%Input(1, k)%DistrLoad%NNodes -! do fieldIndx = 1, 3 -! BD%Input(1, k)%DistrLoad%Moment(fieldIndx, node) = BD%Input(1, k)%DistrLoad%Moment(fieldIndx, node) + u_delta(n)*p_FAST%UJacSclFact -! n = n + 1 -! end do -! end do - -! end do - -! call SS_BD_InputSolve_OtherBlades(p_FAST, BD, MeshMapData, 1) ! 1 is for the input index (i.e., Input(1,Blades2-end) - -! end if !CompElast - -! ! AeroDyn -! do k = 1, p_FAST%NumBl_Lin !we don't need all blades here: SIZE(AD%Input(1)%BladeMotion) -! do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes -! do fieldIndx = 1, 3 -! AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp(fieldIndx, node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp(fieldIndx, node) + u_delta(n) -! n = n + 1 -! end do -! end do - -! do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes -! call PerturbOrientationMatrix(AD%Input(1)%rotors(1)%BladeMotion(k)%Orientation(:, :, node), Perturbations=u_delta(n:n + 2)) -! n = n + 3 -! end do - -! do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes -! AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel(:, node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel(:, node) + u_delta(n:n + 2) - -! n = n + 3 -! end do - -! end do - -! ! now update the inputs on other blades: -! call SS_AD_InputSolve_OtherBlades(p_FAST, AD%Input(1), MeshMapData) ! transfer results from blade 1 to other blades - -! end subroutine Add_SteadyState_delta +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine basically packs the relevant parts of the modules' inputs and states for use in the steady-state solver. -subroutine SS_GetInputs(m, u_vec, ScaleFactor, InputIndex, StateIndex, T, ErrStat, ErrMsg) +subroutine SS_GetInputs(m, u_vec, InputIndex, StateIndex, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Glue-code simulation parameters real(R8Ki), intent(inout) :: u_vec(:) !< Array of input packed values - real(R8Ki), intent(in) :: ScaleFactor !< Jacobian scaling factor integer(IntKi), intent(in) :: InputIndex !< Input array index integer(IntKi), intent(in) :: StateIndex !< State array index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'SolveSteadyState' + character(*), parameter :: RoutineName = 'SS_Solve' integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: i, j, k, ieMod, ieGbl - integer(IntKi) :: iMod(3), iVarMod(2), iVarGbl(2) + integer(IntKi) :: i, j, k, ieSrc, ieDst, iMod + integer(IntKi) :: iModOrder(3), iSrc(2), iDst(2) - iMod = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] + iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] ! Loop through modules - do i = 1, size(iMod) + do i = 1, size(iModOrder) + iMod = iModOrder(i) ! Skip inactive modules - if (iMod(i) == 0) cycle + if (iMod == 0) cycle + + ! If no inputs for this module, cycle + if (.not. allocated(m%AM%Mod%Xfr(iMod)%u)) cycle - associate (ModData => m%Modules(iMod(i))) + associate (ModData => m%Modules(iMod), uXfr => m%AM%Mod%Xfr(iMod)%u) ! Get states and outputs call FAST_GetOP(ModData, SS_t_global, InputIndex, StateIndex, T, ErrStat2, ErrMsg2, & @@ -1245,35 +1190,30 @@ subroutine SS_GetInputs(m, u_vec, ScaleFactor, InputIndex, StateIndex, T, ErrSta if (Failed()) return ! Transfer selected input data from module to RHS based on Idx - if (allocated(ModData%Lin%u)) then - do j = 1, size(ModData%Vars%u) - - ! Get module and global variable indices from Idx, skip if not used - if (.not. ModD_GetValLoc(m%AM%Mod%Xfr(iMod(i))%u, j, iVarMod, iVarGbl)) cycle - - ! Convert or store based on field type - select case (ModData%Vars%u(j)%Field) - - case (FieldForce, FieldMoment) - ! If field is a force or moment, scale by scale factor - u_vec(iVarGbl(1):iVarGbl(2)) = ModData%Lin%u(iVarMod(1):iVarMod(2))/ScaleFactor - - case (FieldOrientation) - ! Convert orientations to rotation vectors - ieMod = iVarMod(1) - ieGbl = iVarGbl(1) - do k = 1, ModData%Vars%u(j)%Nodes - u_vec(ieGbl:ieGbl + 2) = -quat_to_rvec(ModData%Lin%u(ieMod:ieMod + 2)) - ieMod = ieMod + 3 - ieGbl = ieGbl + 3 - end do + do j = 1, size(uXfr) + + ! Convert or store values based on field type + select case (ModData%Vars%u(uXfr(j)%iVar)%Field) + + case (FieldForce, FieldMoment) + ! If field is a force or moment, scale by scale factor + u_vec(uXfr(j)%iDst(1):uXfr(j)%iDst(2)) = ModData%Lin%u(uXfr(j)%iSrc(1):uXfr(j)%iSrc(2))/m%AM%JacScale + + case (FieldOrientation) + ! Convert orientations to rotation vectors + ieSrc = uXfr(j)%iSrc(1) + ieDst = uXfr(j)%iDst(1) + do k = 1, ModData%Vars%u(j)%Nodes + u_vec(ieDst:ieDst + 2) = quat_to_rvec(ModData%Lin%u(ieSrc:ieSrc + 2)) + ieSrc = ieSrc + 3 + ieDst = ieDst + 3 + end do - case default - u_vec(iVarGbl(1):iVarGbl(2)) = ModData%Lin%u(iVarMod(1):iVarMod(2)) - end select + case default + u_vec(uXfr(j)%iDst(1):uXfr(j)%iDst(2)) = ModData%Lin%u(uXfr(j)%iSrc(1):uXfr(j)%iSrc(2)) + end select - end do - end if + end do end associate diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 6457a2d3b3..146888086d 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -360,7 +360,7 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! Transfer tight coupling states to module call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) ! call XferGblToLoc1D(ModData%ixs, x_TC, m_ED%Jac%x) - call ED_UnpackStateOP(p_ED, m_ED%Jac%x, x_ED) + call ED_UnpackContStateOP(p_ED, m_ED%Jac%x, x_ED) ! Update the azimuth angle call ED_UpdateAzimuth(p_ED, x_ED, T%p_FAST%DT) @@ -441,35 +441,43 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData !< Module data - type(MappingType), intent(inout) :: Maps(:) !< Output->Input mappings - real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: InputIndex !< Input index - integer(IntKi), intent(in) :: StateIndex !< State index - type(FAST_TurbineType), intent(inout) :: T !< Turbine type +subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, CalcWriteOutput) + type(ModDataType), intent(in) :: ModData !< Module data + type(MappingType), intent(inout) :: Maps(:) !< Output->Input mappings + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: InputIndex !< Input index + integer(IntKi), intent(in) :: StateIndex !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg + logical, optional, intent(in) :: CalcWriteOutput !< Flag to calculate data for write output character(*), parameter :: RoutineName = 'FAST_CalcOutput' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i + logical :: CalcWriteOutputLoc ErrStat = ErrID_None ErrMsg = '' + if (present(CalcWriteOutput)) then + CalcWriteOutputLoc = CalcWriteOutput + else + CalcWriteOutputLoc = .true. + end if + ! Select based on module ID select case (ModData%ID) case (Module_AD) call AD_CalcOutput(ThisTime, T%AD%Input(InputIndex), T%AD%p, T%AD%x(StateIndex), T%AD%xd(StateIndex), T%AD%z(StateIndex), & - T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep) + T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, CalcWriteOutput) case (Module_BD) call BD_CalcOutput(ThisTime, T%BD%Input(InputIndex, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, StateIndex), & T%BD%xd(ModData%Ins, StateIndex), T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & - T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2) + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, CalcWriteOutput) case (Module_ED) call ED_CalcOutput(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & @@ -611,6 +619,103 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end subroutine +subroutine FAST_SetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, & + FlagFilter, u_op, x_op, xd_op, z_op) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: InputIndex !< Input index + integer(IntKi), intent(in) :: StateIndex !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + integer(IntKi), optional, intent(in) :: FlagFilter !< Flag to filter variables + real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states + real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states + + character(*), parameter :: RoutineName = 'FAST_SetOP' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + ErrStat2 = ErrID_None + ErrMsg2 = "" + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + call AD_SetOP(ModData%Ins, T%AD%Input(InputIndex), T%AD%p, T%AD%x(StateIndex), & + T%AD%xd(StateIndex), T%AD%z(StateIndex), ErrStat2, ErrMsg2, & + u_op=u_op, x_op=x_op, xd_op=xd_op, z_op=z_op) + +! case (Module_BD) + ! call BD_SetOP(ThisTime, T%BD%Input(InputIndex, ModData%Ins), T%BD%p(ModData%Ins), & + ! T%BD%x(ModData%Ins, StateIndex), T%BD%xd(ModData%Ins, StateIndex), & + ! T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & + ! T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + ! u_op=u_op, x_op=x_op) + + case (Module_ED) + call ED_SetOP(T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & + T%ED%z(StateIndex), u_op=u_op, x_op=x_op, xd_op=xd_op, z_op=z_op) + +! case (Module_ExtPtfm) + +! case (Module_FEAM) + +! case (Module_HD) + ! call HD_SetOP(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & + ! T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) + ! call InflowWind_SetOP(ThisTime, T%IfW%Input(InputIndex), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), T%IfW%z(StateIndex), & + ! T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + +! case (Module_MAP) + ! call MAP_SetOP(ThisTime, T%MAP%Input(InputIndex), T%MAP%p, T%MAP%x(StateIndex), T%MAP%xd(StateIndex), T%MAP%z(StateIndex), & + ! T%MAP%OtherSt, T%MAP%y, ErrStat2, ErrMsg2, & + ! u_op=u_op, y_op=y_op) !, x_op=x_op, dx_op=dx_op) MAP doesn't have states + +! case (Module_MD) + ! call MD_SetOP(ThisTime, T%MD%Input(InputIndex), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), T%MD%z(StateIndex), & + ! T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + ! FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) + ! call SD_SetOP(ThisTime, T%SD%Input(InputIndex), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), T%SD%z(StateIndex), & + ! T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + +! case (Module_SeaSt) + ! call SeaSt_SetOP(ThisTime, T%SeaSt%Input(InputIndex), T%SeaSt%p, T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), T%SeaSt%z(StateIndex), & + ! T%SeaSt%OtherSt(StateIndex), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + +! case (Module_SrvD) + ! call SrvD_SetOP(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), & + ! T%SrvD%OtherSt(StateIndex), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & + ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + + case default + ! Unknown module + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Unsupported module: "//trim(ModData%Abbr) + end select + + ! Check for errors during calc output call + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +end subroutine + subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilter, dYdu, dXdu) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time diff --git a/modules/openfast-library/src/FAST_ModData.f90 b/modules/openfast-library/src/FAST_ModData.f90 index 5bd888141c..3b128e22bf 100644 --- a/modules/openfast-library/src/FAST_ModData.f90 +++ b/modules/openfast-library/src/FAST_ModData.f90 @@ -30,7 +30,7 @@ module FAST_ModData private public :: ModD_AddModule public :: ModD_GetValLoc, GetModuleOrder -public :: ModD_PackAry, ModD_PackMatrix, ModD_CombineModules +public :: ModD_PackAry, ModD_UnpackAry, ModD_PackMatrix, ModD_CombineModules contains @@ -303,14 +303,25 @@ logical function ModD_GetValLoc(VarXfrAry, iVar, iSrc, iDst) result(Active) Active = .false. end function -subroutine ModD_PackAry(VarXfrAry, SrcAry, DstAry) +subroutine ModD_PackAry(VarXfrAry, ModAry, GblAry) type(VarXfrType), intent(in) :: VarXfrAry(:) - real(R8Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: DstAry(:) + real(R8Ki), intent(in) :: ModAry(:) + real(R8Ki), intent(inout) :: GblAry(:) integer(IntKi) :: i do i = 1, size(VarXfrAry) - DstAry(VarXfrAry(i)%iDst(1):VarXfrAry(i)%iDst(2)) = & - SrcAry(VarXfrAry(i)%iSrc(1):VarXfrAry(i)%iSrc(2)) + GblAry(VarXfrAry(i)%iDst(1):VarXfrAry(i)%iDst(2)) = & + ModAry(VarXfrAry(i)%iSrc(1):VarXfrAry(i)%iSrc(2)) + end do +end subroutine + +subroutine ModD_UnpackAry(VarXfrAry, ModAry, GblAry) + type(VarXfrType), intent(in) :: VarXfrAry(:) + real(R8Ki), intent(inout) :: ModAry(:) + real(R8Ki), intent(in) :: GblAry(:) + integer(IntKi) :: i + do i = 1, size(VarXfrAry) + ModAry(VarXfrAry(i)%iSrc(1):VarXfrAry(i)%iSrc(2)) = & + GblAry(VarXfrAry(i)%iDst(1):VarXfrAry(i)%iDst(2)) end do end subroutine diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index d5b6d3f54b..719b0fa945 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -210,6 +210,8 @@ typedef ^ ^ R8Ki Jac12 :: - - typedef ^ ^ R8Ki Jac21 :: - - "Components of Jacobian matrix" - typedef ^ ^ R8Ki Jac22 :: - - "Components of Jacobian matrix" - typedef ^ ^ IntKi JacPivot : - - "Jacobian matrix pivot array" - +typedef ^ ^ R8Ki JacScale - - - "Jacobian scaling factor for loads" - +typedef ^ ^ R8Ki SolveTolerance - - - "Allowable solution tolerance" - typedef ^ ^ R8Ki HubOrientation ::: - - "Hub orientation matrix for each blade" - typedef ^ ^ R8Ki u1 : - - "" - typedef ^ ^ R8Ki u2 : - - "" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 98b6c29944..57843e5dfc 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -242,6 +242,8 @@ MODULE Glue_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac21 !< Components of Jacobian matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac22 !< Components of Jacobian matrix [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: JacPivot !< Jacobian matrix pivot array [-] + REAL(R8Ki) :: JacScale = 0.0_R8Ki !< Jacobian scaling factor for loads [-] + REAL(R8Ki) :: SolveTolerance = 0.0_R8Ki !< Allowable solution tolerance [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: HubOrientation !< Hub orientation matrix for each blade [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u1 !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u2 !< [-] @@ -2282,6 +2284,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E end if DstAeroMapData%JacPivot = SrcAeroMapData%JacPivot end if + DstAeroMapData%JacScale = SrcAeroMapData%JacScale + DstAeroMapData%SolveTolerance = SrcAeroMapData%SolveTolerance if (allocated(SrcAeroMapData%HubOrientation)) then LB(1:3) = lbound(SrcAeroMapData%HubOrientation, kind=B8Ki) UB(1:3) = ubound(SrcAeroMapData%HubOrientation, kind=B8Ki) @@ -2435,6 +2439,8 @@ subroutine Glue_PackAeroMap(RF, Indata) call RegPackAlloc(RF, InData%Jac21) call RegPackAlloc(RF, InData%Jac22) call RegPackAlloc(RF, InData%JacPivot) + call RegPack(RF, InData%JacScale) + call RegPack(RF, InData%SolveTolerance) call RegPackAlloc(RF, InData%HubOrientation) call RegPackAlloc(RF, InData%u1) call RegPackAlloc(RF, InData%u2) @@ -2472,6 +2478,8 @@ subroutine Glue_UnPackAeroMap(RF, OutData) call RegUnpackAlloc(RF, OutData%Jac21); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Jac22); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%JacPivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JacScale); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SolveTolerance); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u2); if (RegCheckErr(RF, RoutineName)) return From ffa70981c2c4f0d857daf16917ef56be9b1df303 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 18 Jun 2024 18:40:12 +0000 Subject: [PATCH 152/319] Get AeroMap reset working, re-enable AeroMap test for ED --- modules/openfast-library/src/FAST_AeroMap.f90 | 295 +++++++++++------- reg_tests/CTestList.cmake | 6 +- 2 files changed, 181 insertions(+), 120 deletions(-) diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index de872c3480..63fa4c2e32 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -381,7 +381,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) integer(IntKi) :: MaxIter ! maximum number of iterations integer(IntKi) :: K ! Input-output-solve iteration counter integer(IntKi) :: i, j - integer(IntKi) :: iModOrder(3), iMod + integer(IntKi) :: nx ! Number of state variables in Jacobian logical :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput @@ -394,6 +394,8 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) ! Some record keeping stuff: !---------------------------------------------------------------------------- + nx = m%AM%Mod%Vars%Nx + ! Set the rotor speed in ElastoDyn T%ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed @@ -460,7 +462,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) call SS_AD_InputSolve_OtherBlades(m, INPUT_CURR, T) ! set up x-u vector, using local initial guesses - call SS_GetInputs(m, m%AM%u1, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call SS_GetInputs(m, m%AM%u1, INPUT_CURR, T, ErrStat2, ErrMsg2) end if @@ -528,6 +530,9 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) ! Store normalized error in output y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/size(m%AM%Mod%Lin%J, 1) + ! Remove conditioning from solution vector + call PostconditionInputDelta(m%AM%SolveDelta(nx + 1:), m%AM%JacScale) + ! If error is below tolerance if (err <= m%AM%SolveTolerance) then if (K == 0) then ! the error will be incorrect in this instance, but the outputs will be better @@ -551,76 +556,11 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) err_prev = err_prev*reduction_factor end if - ! Set module order - iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] - - ! Update states and inputs in module - do i = 1, size(iModOrder) - iMod = iModOrder(i) - if (iMod == 0) cycle - call FAST_GetOP(m%Modules(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & - u_op=m%Modules(iMod)%Lin%u, x_op=m%Modules(iMod)%Lin%x) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, m%Modules(iMod)%Lin%x, m%AM%Mod%Lin%x) - call ModD_PackAry(m%AM%Mod%Xfr(iMod)%u, m%Modules(iMod)%Lin%u, m%AM%Mod%Lin%u) - end do - - ! Remove conditioning from solution vector - call PostconditionSolveDelta(m%AM%SolveDelta(m%AM%Mod%Vars%Nx + 1:), m%AM%JacScale) - - ! Add change in continuous states to current states - call MV_AddDelta(m%AM%Mod%Vars%x, m%AM%SolveDelta(:m%AM%Mod%Vars%Nx), m%AM%Mod%Lin%x) - - ! Add change in inputs to current inputs - call MV_AddDelta(m%AM%Mod%Vars%u, m%AM%SolveDelta(m%AM%Mod%Vars%Nx + 1:), m%AM%Mod%Lin%u) - - ! Update states and inputs in module - do i = 1, size(iModOrder) - iMod = iModOrder(i) - if (iMod == 0) cycle - call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%x, m%Modules(iMod)%Lin%x, m%AM%Mod%Lin%x) - call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%u, m%Modules(iMod)%Lin%u, m%AM%Mod%Lin%u) - - select case (m%Modules(iMod)%ID) - case (Module_ED) - ! Copy blade1 flap and edge states to other blades - do j = 2, T%ED%p%NumBl - associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(1)), & - VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(j))) - m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) - end associate - associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(1)), & - VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(j))) - m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) - end associate - associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(1)), & - VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(j))) - m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) - end associate - end do - case (Module_BD) - ! TODO: Copy B1 states to other blades - end select - - ! Populate values in module - call FAST_SetOP(m%Modules(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & - u_op=m%Modules(iMod)%Lin%u, x_op=m%Modules(iMod)%Lin%x) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - - ! Transfer results from blade 1 to other blades - if (m%AM%iModBD > 0) then - ! BeamDyn - call SS_BD_InputSolve_OtherBlades(m, INPUT_CURR, T) - else - ! ElastoDyn - call SS_ED_InputSolve_OtherBlades(m, INPUT_CURR, T) - end if - call SS_AD_InputSolve_OtherBlades(m, INPUT_CURR, T) - - ! u = u + u_delta - call SS_GetInputs(m, m%AM%u1, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + ! Update states and inputs based on solution + call SS_UpdateInputsStates(m, m%AM%SolveDelta, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Increment iteration counter and set it in write output K = K + 1 y_FAST%DriverWriteOutput(SS_Indx_Iter) = k @@ -642,9 +582,9 @@ subroutine ResetInputsAndStates() call SetErrStat(ErrID_Severe, 'Steady-state solver did not converge.', ErrStat, ErrMsg, RoutineName) + ! if we didn't get close on the solution, we should reset the states and inputs because they very well could + ! lead to numerical issues on the next iteration. Here, set the initial values to 0: if (err > 100.0) then - ! if we didn't get close on the solution, we should reset the states and inputs because they very well could - ! lead to numerical issues on the next iteration. Here, set the initial values to 0: ! because loads occasionally get very large when it fails, manually set these to zero (otherwise ! roundoff can lead to non-zero values with the method below, which is most useful for states) @@ -655,20 +595,25 @@ subroutine ResetInputsAndStates() end do end if - call SS_GetInputs(m, m%AM%u1, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) ! find the values we have been modifying (in u... continuous states and inputs) - ! call Add_SteadyState_delta(p_FAST, y_FAST, -u, AD, ED, BD) ! and reset them to 0 (by adding -u) + ! Find the values we have been modifying (in u... continuous states and inputs) + call SS_GetStates(m, m%AM%SolveDelta(:nx), STATE_CURR, T, ErrStat2, ErrMsg2) + call SS_GetInputs(m, m%AM%SolveDelta(nx + 1:), INPUT_CURR, T, ErrStat2, ErrMsg2) + ! Reset them to 0 (by adding -u) + m%AM%SolveDelta = -m%AM%SolveDelta + call SS_UpdateInputsStates(m, m%AM%SolveDelta, T, ErrStat2, ErrMsg2) end if end if + end subroutine ResetInputsAndStates - subroutine PostconditionSolveDelta(Delta, JacScale) - real(R8Ki), intent(inout) :: Delta(:) + subroutine PostconditionInputDelta(u_delta, JacScale) + real(R8Ki), intent(inout) :: u_delta(:) real(R8Ki), intent(in) :: JacScale do i = 1, size(m%AM%Mod%Vars%u) associate (Var => m%AM%Mod%Vars%u(i)) if (MV_IsLoad(Var)) then - Delta(Var%iLoc(1):Var%iLoc(2)) = Delta(Var%iLoc(1):Var%iLoc(2))*JacScale + u_delta(Var%iLoc(1):Var%iLoc(2)) = u_delta(Var%iLoc(1):Var%iLoc(2))*JacScale end if end associate end do @@ -676,6 +621,84 @@ subroutine PostconditionSolveDelta(Delta, JacScale) end subroutine SS_Solve +subroutine SS_UpdateInputsStates(m, delta, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(R8Ki), intent(in) :: delta(:) !< Change in state and input arrays + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_UpdateInputsStates' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i, j + integer(IntKi) :: iModOrder(3), iMod + + ! Set module order + iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] + + ! Update states and inputs in module + do i = 1, size(iModOrder) + iMod = iModOrder(i) + if (iMod == 0) cycle + call FAST_GetOP(m%Modules(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=m%Modules(iMod)%Lin%u, x_op=m%Modules(iMod)%Lin%x) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, m%Modules(iMod)%Lin%x, m%AM%Mod%Lin%x) + end do ! Remove conditioning from solution vector + + ! Add change in inputs to current inputs + call MV_AddDelta(m%AM%Mod%Vars%u, delta(m%AM%Mod%Vars%Nx + 1:), m%AM%u1) + + ! Add change in continuous states to current states + call MV_AddDelta(m%AM%Mod%Vars%x, delta(:m%AM%Mod%Vars%Nx), m%AM%Mod%Lin%x) + + ! Update states and inputs in module + do i = 1, size(iModOrder) + iMod = iModOrder(i) + if (iMod == 0) cycle + call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%x, m%Modules(iMod)%Lin%x, m%AM%Mod%Lin%x) + call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%u, m%Modules(iMod)%Lin%u, m%AM%u1) + + select case (m%Modules(iMod)%ID) + case (Module_ED) + ! Copy blade1 flap and edge states to other blades + do j = 2, T%ED%p%NumBl + associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(1)), & + VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(j))) + m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + end associate + associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(1)), & + VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(j))) + m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + end associate + associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(1)), & + VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(j))) + m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + end associate + end do + case (Module_BD) + ! TODO: Copy B1 states to other blades + end select + + ! Populate values in module + call FAST_SetOP(m%Modules(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=m%Modules(iMod)%Lin%u, x_op=m%Modules(iMod)%Lin%x) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + + ! Transfer results from blade 1 to other blades + if (m%AM%iModBD > 0) then + ! BeamDyn + call SS_BD_InputSolve_OtherBlades(m, INPUT_CURR, T) + else + ! ElastoDyn + call SS_ED_InputSolve_OtherBlades(m, INPUT_CURR, T) + end if + call SS_AD_InputSolve_OtherBlades(m, INPUT_CURR, T) + +end subroutine + subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case @@ -932,12 +955,28 @@ subroutine SS_BuildResidual(caseData, m, T, ErrStat, ErrMsg) call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Pack the output "residual vector" with these state derivatives and new inputs: - call SS_GetInputs(m, m%AM%u2, InputIndex, StateIndex, T, ErrStat2, ErrMsg2) + call SS_GetInputs(m, m%AM%u2, InputIndex, T, ErrStat2, ErrMsg2) ! Store difference in inputs - m%AM%Residual(m%AM%Mod%Vars%Nx + 1:) = m%AM%u1 - m%AM%u2 + call MV_ComputeDiff(m%AM%Mod%Vars%u, m%AM%u1, m%AM%u2, m%AM%Residual(m%AM%Mod%Vars%Nx + 1:)) + ! m%AM%Residual(m%AM%Mod%Vars%Nx + 1:) = m%AM%u1 - m%AM%u2 + + ! Condition residual for solve + call PreconditionInputResidual(m%AM%Residual(m%AM%Mod%Vars%Nx + 1:), m%AM%JacScale) -end subroutine SS_BuildResidual +contains + subroutine PreconditionInputResidual(u_residual, JacScale) + real(R8Ki), intent(inout) :: u_residual(:) + real(R8Ki), intent(in) :: JacScale + do i = 1, size(m%AM%Mod%Vars%u) + associate (Var => m%AM%Mod%Vars%u(i)) + if (MV_IsLoad(Var)) then + u_residual(Var%iLoc(1):Var%iLoc(2)) = u_residual(Var%iLoc(1):Var%iLoc(2))/JacScale + end if + end associate + end do + end subroutine +end subroutine !------------------------------------------------------------------------------- @@ -1055,16 +1094,16 @@ subroutine SS_AD_InputSolve_OtherBlades(m, InputIndex, T) end associate end subroutine SS_AD_InputSolve_OtherBlades -subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, Residual, T, ErrStat, ErrMsg) +subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, dx_vec, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case integer(IntKi), intent(in) :: InputIndex !< Index into input array - real(R8Ki), intent(inout) :: Residual(:) !< Residual vector + real(R8Ki), intent(inout) :: dx_vec(:) !< continuous state derivative vector type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat !< Error status character(*), intent(out) :: ErrMsg !< Error message - character(*), parameter :: RoutineName = 'SteadyStateCCSD' + character(*), parameter :: RoutineName = 'SS_CalcContStateDeriv' integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None integer(IntKi) :: i, k @@ -1085,7 +1124,7 @@ subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, Residual, T, ErrStat, FlagFilter=VF_AeroMap, dx_op=m%Modules(m%AM%iModED)%Lin%dx) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%Modules(m%AM%iModED)%Lin%dx, Residual) + call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%Modules(m%AM%iModED)%Lin%dx, dx_vec) case (Module_BD) ! BeamDyn @@ -1096,6 +1135,8 @@ subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, Residual, T, ErrStat, FlagFilter=VF_AeroMap, dx_op=m%Modules(m%AM%iModBD)%Lin%dx) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%Modules(m%AM%iModED)%Lin%dx, dx_vec) + ! TODO: Make this work for BeamDyn ! do K = 1, T%p_FAST%nBeams @@ -1117,8 +1158,6 @@ subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, Residual, T, ErrStat, ! end do - call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModBD)%x, m%Modules(m%AM%iModBD)%Lin%dx, Residual) - end select end subroutine SS_CalcContStateDeriv @@ -1155,20 +1194,18 @@ subroutine SteadyStateCalculatedInputs(m, InputIndex, T, ErrStat, ErrMsg) !---------------------------------------------------------------------------------------------------------------------------------- !> This routine basically packs the relevant parts of the modules' inputs and states for use in the steady-state solver. -subroutine SS_GetInputs(m, u_vec, InputIndex, StateIndex, T, ErrStat, ErrMsg) +subroutine SS_GetInputs(m, u_vec, InputIndex, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Glue-code simulation parameters real(R8Ki), intent(inout) :: u_vec(:) !< Array of input packed values integer(IntKi), intent(in) :: InputIndex !< Input array index - integer(IntKi), intent(in) :: StateIndex !< State array index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'SS_Solve' + character(*), parameter :: RoutineName = 'SS_GetInputs' integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: i, j, k, ieSrc, ieDst, iMod - integer(IntKi) :: iModOrder(3), iSrc(2), iDst(2) + integer(IntKi) :: i, iMod, iModOrder(3) iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] @@ -1182,41 +1219,65 @@ subroutine SS_GetInputs(m, u_vec, InputIndex, StateIndex, T, ErrStat, ErrMsg) ! If no inputs for this module, cycle if (.not. allocated(m%AM%Mod%Xfr(iMod)%u)) cycle - associate (ModData => m%Modules(iMod), uXfr => m%AM%Mod%Xfr(iMod)%u) + associate (ModData => m%Modules(iMod)) ! Get states and outputs - call FAST_GetOP(ModData, SS_t_global, InputIndex, StateIndex, T, ErrStat2, ErrMsg2, & - u_op=ModData%Lin%u) + call FAST_GetOP(ModData, SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, u_op=ModData%Lin%u) if (Failed()) return - ! Transfer selected input data from module to RHS based on Idx - do j = 1, size(uXfr) + ! Pack data into vector + call ModD_PackAry(m%AM%Mod%Xfr(iMod)%u, ModData%Lin%u, u_vec) - ! Convert or store values based on field type - select case (ModData%Vars%u(uXfr(j)%iVar)%Field) + end associate - case (FieldForce, FieldMoment) - ! If field is a force or moment, scale by scale factor - u_vec(uXfr(j)%iDst(1):uXfr(j)%iDst(2)) = ModData%Lin%u(uXfr(j)%iSrc(1):uXfr(j)%iSrc(2))/m%AM%JacScale + end do - case (FieldOrientation) - ! Convert orientations to rotation vectors - ieSrc = uXfr(j)%iSrc(1) - ieDst = uXfr(j)%iDst(1) - do k = 1, ModData%Vars%u(j)%Nodes - u_vec(ieDst:ieDst + 2) = quat_to_rvec(ModData%Lin%u(ieSrc:ieSrc + 2)) - ieSrc = ieSrc + 3 - ieDst = ieDst + 3 - end do +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - case default - u_vec(uXfr(j)%iDst(1):uXfr(j)%iDst(2)) = ModData%Lin%u(uXfr(j)%iSrc(1):uXfr(j)%iSrc(2)) - end select +subroutine SS_GetStates(m, x_vec, StateIndex, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: m !< Glue-code simulation parameters + real(R8Ki), intent(inout) :: x_vec(:) !< Array of input packed values + integer(IntKi), intent(in) :: StateIndex !< State array index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - end do + character(*), parameter :: RoutineName = 'SS_GetStates' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i, j, k + integer(IntKi) :: iModOrder(3), iMod - end associate + iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through modules + do i = 1, size(iModOrder) + iMod = iModOrder(i) + ! Skip inactive modules + if (iMod == 0) cycle + + ! If no inputs for this module, cycle + if (.not. allocated(m%AM%Mod%Xfr(iMod)%x)) cycle + + associate (ModData => m%Modules(iMod)) + + ! Get states and outputs + call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, StateIndex, T, ErrStat2, ErrMsg2, x_op=ModData%Lin%x) + if (Failed()) return + + ! Pack data into vector + call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, ModData%Lin%x, x_vec) + + end associate end do contains @@ -1224,7 +1285,7 @@ logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function -end subroutine SS_GetInputs +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- subroutine SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index a915a8f33d..13d2271860 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -316,7 +316,7 @@ of_regression("MHK_RM1_Floating" "openfast;elastodyn;aerod of_regression("Tailfin_FreeYaw1DOF_PolarBased" "openfast;elastodyn;aerodyn15") of_regression("Tailfin_FreeYaw1DOF_Unsteady" "openfast;elastodyn;aerodyn15") -# of_aeromap_regression("5MW_Land_AeroMap" "aeromap;elastodyn;aerodyn15") +of_aeromap_regression("5MW_Land_AeroMap" "aeromap;elastodyn;aerodyn15") # OpenFAST C++ API test if(BUILD_OPENFAST_CPP_API) @@ -343,8 +343,8 @@ of_regression_py("EllipticalWing_OLAF_py" "openfast;fastlib;p of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroacoustics") # Linearized OpenFAST regression tests -#of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn") #segfault currently -- fixed in next PR -#of_regression_linear("Fake5MW_AeroLin_B3_UA6" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn") #segfault currently -- fixed in next PR +of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn") #segfault currently -- fixed in next PR +of_regression_linear("Fake5MW_AeroLin_B3_UA6" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn") #segfault currently -- fixed in next PR of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "-highpass=0.10" "openfast;linear;beamdyn") of_regression_linear("Ideal_Beam_Free_Free_Linear" "-highpass=0.10" "openfast;linear;beamdyn") From d0d19f40e4b4930aea64c2aa1c70826fe91a4f37 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 20 Jun 2024 14:58:01 +0000 Subject: [PATCH 153/319] Minor cleanup in AeroMap --- modules/aerodyn/src/AeroDyn.f90 | 10 -- modules/openfast-library/src/FAST_AeroMap.f90 | 153 +++++++++--------- 2 files changed, 72 insertions(+), 91 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 7c2e745d98..2093345f1e 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -544,16 +544,6 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut if (Failed()) return; end do - !............................................................................................ - ! Initialize Jacobian: - !............................................................................................ - ! if (InitInp%Linearize .or. InitInp%CompAeroMaps) then - ! do iR = 1, nRotors - ! call Init_Jacobian(InputFileData%rotors(iR), p%rotors(iR), p, u%rotors(iR), y%rotors(iR), m%rotors(iR), InitOut%rotors(iR), errStat2, errMsg2) - ! if (Failed()) return; - ! enddo - ! end if - !............................................................................................ ! Print the summary file if requested: !............................................................................................ diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 63fa4c2e32..492d13f13b 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -400,7 +400,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) T%ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed ! Update module inputs - call SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD) + call SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD) do i = 1, size(m%AM%iModOrder) associate (ModData => m%Modules(m%AM%iModOrder(i))) call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -926,7 +926,6 @@ end subroutine Cleanup end subroutine SS_BuildJacobian -!---------------------------------------------------------------------------------------------------------------------------------- subroutine SS_BuildResidual(caseData, m, T, ErrStat, ErrMsg) type(AeroMapCase), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables @@ -951,15 +950,11 @@ subroutine SS_BuildResidual(caseData, m, T, ErrStat, ErrMsg) call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the SS_GetInputs - call SteadyStateCalculatedInputs(m, InputIndex, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 + call SS_GetCalculatedInputs(m, InputIndex, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Pack the output "residual vector" with these state derivatives and new inputs: - call SS_GetInputs(m, m%AM%u2, InputIndex, T, ErrStat2, ErrMsg2) - - ! Store difference in inputs + ! Calculate difference between prescribed and calculated inputs call MV_ComputeDiff(m%AM%Mod%Vars%u, m%AM%u1, m%AM%u2, m%AM%Residual(m%AM%Mod%Vars%Nx + 1:)) - ! m%AM%Residual(m%AM%Mod%Vars%Nx + 1:) = m%AM%u1 - m%AM%u2 ! Condition residual for solve call PreconditionInputResidual(m%AM%Residual(m%AM%Mod%Vars%Nx + 1:), m%AM%JacScale) @@ -997,7 +992,7 @@ subroutine SS_BD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) call FAST_InputSolve(m%Modules(m%AM%iModBD), m%Modules, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine SS_BD_InputSolve +end subroutine !> SS_BD_InputSolve_OtherBlades sets the blade-load ElastoDyn inputs from blade 1 to the other blades. subroutine SS_BD_InputSolve_OtherBlades(m, InputIndex, T) @@ -1007,11 +1002,11 @@ subroutine SS_BD_InputSolve_OtherBlades(m, InputIndex, T) integer(IntKi) :: j, k do k = 2, T%p_FAST%nBeams do j = 1, T%BD%Input(InputIndex, k)%DistrLoad%NNodes - T%BD%Input(InputIndex, k)%DistrLoad%Force(:, j) = MATMUL(T%BD%Input(InputIndex, 1)%DistrLoad%Force(:, j), m%AM%HubOrientation(:, :, k)) - T%BD%Input(InputIndex, k)%DistrLoad%Moment(:, j) = MATMUL(T%BD%Input(InputIndex, 1)%DistrLoad%Moment(:, j), m%AM%HubOrientation(:, :, k)) + T%BD%Input(InputIndex, k)%DistrLoad%Force(:, j) = matmul(T%BD%Input(InputIndex, 1)%DistrLoad%Force(:, j), m%AM%HubOrientation(:, :, k)) + T%BD%Input(InputIndex, k)%DistrLoad%Moment(:, j) = matmul(T%BD%Input(InputIndex, 1)%DistrLoad%Moment(:, j), m%AM%HubOrientation(:, :, k)) end do end do -end subroutine SS_BD_InputSolve_OtherBlades +end subroutine !> This routine sets the blade load inputs required for ED. subroutine SS_ED_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) @@ -1030,25 +1025,23 @@ subroutine SS_ED_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) call FAST_InputSolve(m%Modules(m%AM%iModED), m%Modules, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine SS_ED_InputSolve +end subroutine !> SS_ED_InputSolve_OtherBlades sets the blade-load ElastoDyn inputs from blade 1 to the other blades. subroutine SS_ED_InputSolve_OtherBlades(m, InputIndex, T) type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables integer(IntKi), intent(in) :: InputIndex !< Input index to transfer type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type - integer(IntKi) :: j, k - associate (BladePtLoads => T%ED%Input(InputIndex)%BladePtLoads) do k = 2, size(BladePtLoads, 1) do j = 1, BladePtLoads(k)%NNodes - BladePtLoads(k)%Force(:, j) = MATMUL(BladePtLoads(1)%Force(:, j), m%AM%HubOrientation(:, :, k)) - BladePtLoads(k)%Moment(:, j) = MATMUL(BladePtLoads(1)%Moment(:, j), m%AM%HubOrientation(:, :, k)) + BladePtLoads(k)%Force(:, j) = matmul(BladePtLoads(1)%Force(:, j), m%AM%HubOrientation(:, :, k)) + BladePtLoads(k)%Moment(:, j) = matmul(BladePtLoads(1)%Moment(:, j), m%AM%HubOrientation(:, :, k)) end do end do end associate -end subroutine SS_ED_InputSolve_OtherBlades +end subroutine !> SS_AD_InputSolve sets the blade-motion AeroDyn inputs for Blade 1. subroutine SS_AD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) @@ -1073,26 +1066,24 @@ subroutine SS_AD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) T%AD%Input(InputIndex)%rotors(1)%BladeMotion(1)%RotationVel = 0.0_ReKi T%AD%Input(InputIndex)%rotors(1)%BladeMotion(1)%TranslationAcc = 0.0_ReKi -end subroutine SS_AD_InputSolve +end subroutine !> SS_AD_InputSolve_OtherBlades sets the blade-motion AeroDyn inputs. subroutine SS_AD_InputSolve_OtherBlades(m, InputIndex, T) type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables integer(IntKi), intent(in) :: InputIndex !< Input index to transfer type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type - integer(IntKi) :: j, k - associate (BladeMotion => T%AD%Input(InputIndex)%rotors(1)%BladeMotion) do k = 2, size(BladeMotion, 1) do j = 1, BladeMotion(k)%NNodes - BladeMotion(k)%TranslationDisp(:, j) = MATMUL(BladeMotion(1)%TranslationDisp(:, j), m%AM%HubOrientation(:, :, k)) - BladeMotion(k)%Orientation(:, :, j) = MATMUL(BladeMotion(1)%Orientation(:, :, j), m%AM%HubOrientation(:, :, k)) - BladeMotion(k)%TranslationVel(:, j) = MATMUL(BladeMotion(1)%TranslationVel(:, j), m%AM%HubOrientation(:, :, k)) + BladeMotion(k)%TranslationDisp(:, j) = matmul(BladeMotion(1)%TranslationDisp(:, j), m%AM%HubOrientation(:, :, k)) + BladeMotion(k)%Orientation(:, :, j) = matmul(BladeMotion(1)%Orientation(:, :, j), m%AM%HubOrientation(:, :, k)) + BladeMotion(k)%TranslationVel(:, j) = matmul(BladeMotion(1)%TranslationVel(:, j), m%AM%HubOrientation(:, :, k)) end do end do end associate -end subroutine SS_AD_InputSolve_OtherBlades +end subroutine subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, dx_vec, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables @@ -1160,55 +1151,27 @@ subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, dx_vec, T, ErrStat, Er end select -end subroutine SS_CalcContStateDeriv - -!---------------------------------------------------------------------------------------------------------------------------------- -subroutine SteadyStateCalculatedInputs(m, InputIndex, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables - integer(IntKi), intent(IN) :: InputIndex !< Index into input array - type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type - integer(IntKi), intent(OUT) :: ErrStat !< Error status - character(*), intent(OUT) :: ErrMsg !< Error message - - character(*), parameter :: RoutineName = 'SteadyStateCalculatedInputs' - integer(IntKi) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMsg = "" - - ! Transfer motions to AeroDyn first - call SS_AD_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Transfer loads to structural solver next - if (m%AM%iModBD > 0) then - call SS_BD_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - else if (m%AM%iModED > 0) then - call SS_ED_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - end subroutine -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine basically packs the relevant parts of the modules' inputs and states for use in the steady-state solver. -subroutine SS_GetInputs(m, u_vec, InputIndex, T, ErrStat, ErrMsg) +subroutine SS_GetStates(m, x_vec, StateIndex, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Glue-code simulation parameters - real(R8Ki), intent(inout) :: u_vec(:) !< Array of input packed values - integer(IntKi), intent(in) :: InputIndex !< Input array index + real(R8Ki), intent(inout) :: x_vec(:) !< Array of input packed values + integer(IntKi), intent(in) :: StateIndex !< State array index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'SS_GetInputs' + character(*), parameter :: RoutineName = 'SS_GetStates' integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: i, iMod, iModOrder(3) + integer(IntKi) :: i, j, k + integer(IntKi) :: iModOrder(3), iMod iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] + ErrStat = ErrID_None + ErrMsg = '' + ! Loop through modules do i = 1, size(iModOrder) iMod = iModOrder(i) @@ -1217,19 +1180,18 @@ subroutine SS_GetInputs(m, u_vec, InputIndex, T, ErrStat, ErrMsg) if (iMod == 0) cycle ! If no inputs for this module, cycle - if (.not. allocated(m%AM%Mod%Xfr(iMod)%u)) cycle + if (.not. allocated(m%AM%Mod%Xfr(iMod)%x)) cycle associate (ModData => m%Modules(iMod)) ! Get states and outputs - call FAST_GetOP(ModData, SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, u_op=ModData%Lin%u) + call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, StateIndex, T, ErrStat2, ErrMsg2, x_op=ModData%Lin%x) if (Failed()) return ! Pack data into vector - call ModD_PackAry(m%AM%Mod%Xfr(iMod)%u, ModData%Lin%u, u_vec) + call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, ModData%Lin%x, x_vec) end associate - end do contains @@ -1239,25 +1201,22 @@ logical function Failed() end function end subroutine -subroutine SS_GetStates(m, x_vec, StateIndex, T, ErrStat, ErrMsg) +!> SS_GetInputs packs the relevant parts of the modules' inputs for use in the steady-state solver. +subroutine SS_GetInputs(m, u_vec, InputIndex, T, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: m !< Glue-code simulation parameters - real(R8Ki), intent(inout) :: x_vec(:) !< Array of input packed values - integer(IntKi), intent(in) :: StateIndex !< State array index + real(R8Ki), intent(inout) :: u_vec(:) !< Array of input packed values + integer(IntKi), intent(in) :: InputIndex !< Input array index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'SS_GetStates' + character(*), parameter :: RoutineName = 'SS_GetInputs' integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: i, j, k - integer(IntKi) :: iModOrder(3), iMod + integer(IntKi) :: i, iMod, iModOrder(3) iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] - ErrStat = ErrID_None - ErrMsg = '' - ! Loop through modules do i = 1, size(iModOrder) iMod = iModOrder(i) @@ -1266,18 +1225,19 @@ subroutine SS_GetStates(m, x_vec, StateIndex, T, ErrStat, ErrMsg) if (iMod == 0) cycle ! If no inputs for this module, cycle - if (.not. allocated(m%AM%Mod%Xfr(iMod)%x)) cycle + if (.not. allocated(m%AM%Mod%Xfr(iMod)%u)) cycle associate (ModData => m%Modules(iMod)) ! Get states and outputs - call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, StateIndex, T, ErrStat2, ErrMsg2, x_op=ModData%Lin%x) + call FAST_GetOP(ModData, SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, u_op=ModData%Lin%u) if (Failed()) return ! Pack data into vector - call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, ModData%Lin%x, x_vec) + call ModD_PackAry(m%AM%Mod%Xfr(iMod)%u, ModData%Lin%u, u_vec) end associate + end do contains @@ -1287,8 +1247,39 @@ logical function Failed() end function end subroutine -!---------------------------------------------------------------------------------------------------------------------------------- -subroutine SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) +subroutine SS_GetCalculatedInputs(m, InputIndex, T, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables + integer(IntKi), intent(in) :: InputIndex !< Index into input array + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message + + character(*), parameter :: RoutineName = 'SS_GetCalculatedInputs' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = "" + + ! Transfer motions to AeroDyn first + call SS_AD_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Transfer loads to structural solver next + if (m%AM%iModBD > 0) then + call SS_BD_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + else if (m%AM%iModED > 0) then + call SS_ED_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + ! Pack the transferred inputs into the vector + call SS_GetInputs(m, m%AM%u2, InputIndex, T, ErrStat2, ErrMsg2) + +end subroutine + +subroutine SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters for the glue code type(FAST_OutputFileType), intent(inout) :: y_FAST !< Output variables for the glue code @@ -1368,6 +1359,6 @@ subroutine SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) AD%Input(1)%rotors(1)%UserProp = 0.0_ReKi -end subroutine SetPrescribedInputs +end subroutine end module From 98b0e9ad8ade7048947fca36a06b39d3b5177258 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 20 Jun 2024 15:29:39 +0000 Subject: [PATCH 154/319] Add parsing of J matrix to FASTLinearizationFile --- reg_tests/lib/fast_linearization_file.py | 3 +++ 1 file changed, 3 insertions(+) diff --git a/reg_tests/lib/fast_linearization_file.py b/reg_tests/lib/fast_linearization_file.py index 7613f4dbf7..0901ae4951 100644 --- a/reg_tests/lib/fast_linearization_file.py +++ b/reg_tests/lib/fast_linearization_file.py @@ -174,6 +174,9 @@ def readMat(fid, n, m, name=''): self['C'] = readMat(f, ny, nx, 'C') elif line.find('D:')>=0: self['D'] = readMat(f, ny, nu, 'D') + elif line.find('J:')>=0: + _, rows, _, cols = line.spit() + self['J'] = readMat(f, int(rows), int(cols), 'J') elif line.find('dUdu:')>=0: self['dUdu'] = readMat(f, nu, nu,'dUdu') elif line.find('dUdy:')>=0: From f2996f7395f80a2f5fd120b4d28898c482e9ea96 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 8 Jul 2024 16:56:59 +0000 Subject: [PATCH 155/319] Partially working revision of module vars --- modules/aerodyn/src/AeroAcoustics_Types.f90 | 205 +++- modules/aerodyn/src/AeroDyn.f90 | 886 +++++++++--------- modules/aerodyn/src/AeroDyn_Registry.txt | 21 +- modules/aerodyn/src/AeroDyn_Types.f90 | 449 +++++---- modules/aerodyn/src/AirfoilInfo_Types.f90 | 123 ++- modules/aerodyn/src/BEMT_Types.f90 | 345 ++++++- modules/aerodyn/src/DBEMT_Types.f90 | 160 +++- modules/aerodyn/src/FVW_Types.f90 | 196 +++- modules/aerodyn/src/UnsteadyAero_Types.f90 | 185 +++- modules/aerodyn14/src/AeroDyn14_Types.f90 | 339 ++++++- modules/aerodyn14/src/DWM_Types.f90 | 360 ++++++- modules/beamdyn/src/BeamDyn.f90 | 385 ++++---- modules/beamdyn/src/BeamDyn_Types.f90 | 205 +++- modules/beamdyn/src/Registry_BeamDyn.txt | 6 - modules/elastodyn/src/ElastoDyn.f90 | 495 ++++------ modules/elastodyn/src/ElastoDyn_Registry.txt | 29 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 583 ++++++++---- .../src/ExternalInflow_Types.f90 | 168 +++- modules/extloads/src/ExtLoads.f90 | 18 +- modules/extloads/src/ExtLoadsDX_Types.f90 | 103 +- modules/extloads/src/ExtLoads_Types.f90 | 224 ++++- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 147 ++- modules/feamooring/src/FEAM.f90 | 4 +- modules/feamooring/src/FEAM_Registry.txt | 2 - modules/feamooring/src/FEAMooring_Types.f90 | 172 +++- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 135 ++- modules/hydrodyn/src/HydroDyn.f90 | 309 ++---- modules/hydrodyn/src/HydroDyn.txt | 15 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 257 +++-- modules/hydrodyn/src/Morison_Types.f90 | 148 ++- modules/hydrodyn/src/SS_Excitation_Types.f90 | 140 ++- modules/hydrodyn/src/SS_Radiation_Types.f90 | 140 ++- modules/hydrodyn/src/WAMIT2_Types.f90 | 39 +- modules/hydrodyn/src/WAMIT_Types.f90 | 157 +++- modules/icedyn/src/IceDyn_Types.f90 | 147 ++- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 142 ++- .../inflowwind/src/IfW_FlowField_Types.f90 | 3 +- modules/inflowwind/src/InflowWind.f90 | 21 +- modules/inflowwind/src/InflowWind.txt | 14 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 3 +- modules/inflowwind/src/InflowWind_Types.f90 | 249 ++++- modules/inflowwind/src/Lidar_Types.f90 | 175 +++- modules/map/src/MAP_Registry.txt | 3 - modules/map/src/MAP_Types.f90 | 224 ++++- modules/map/src/MAP_Types.h | 3 - modules/map/src/map.f90 | 14 +- modules/moordyn/src/MoorDyn.f90 | 475 ++++------ modules/moordyn/src/MoorDyn_Registry.txt | 5 - modules/moordyn/src/MoorDyn_Types.f90 | 196 +++- modules/nwtc-library/src/ModVar.f90 | 313 ++++++- .../nwtc-library/src/NWTC_Library_Types.f90 | 472 +++++++--- .../src/Registry_NWTC_Library.txt | 29 +- .../src/Registry_NWTC_Library_base.txt | 29 +- modules/openfast-library/CMakeLists.txt | 2 +- modules/openfast-library/src/FAST_Funcs.f90 | 72 +- modules/openfast-library/src/FAST_Mapping.f90 | 466 ++++----- modules/openfast-library/src/FAST_ModData.f90 | 14 +- modules/openfast-library/src/FAST_ModGlue.f90 | 15 +- modules/openfast-library/src/FAST_Types.f90 | 3 +- .../openfast-library/src/Glue_Registry.txt | 19 +- modules/openfast-library/src/Glue_Types.f90 | 399 +------- modules/openfast-registry/src/registry.hpp | 79 +- .../src/registry_gen_fortran.cpp | 174 +++- .../openfast-registry/src/registry_parse.cpp | 44 +- .../src/OrcaFlexInterface.f90 | 6 +- .../src/OrcaFlexInterface_Types.f90 | 142 ++- modules/seastate/src/Current_Types.f90 | 3 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 3 +- modules/seastate/src/SeaState.f90 | 32 +- modules/seastate/src/SeaState.txt | 6 +- modules/seastate/src/SeaState_Types.f90 | 149 ++- modules/seastate/src/Waves2_Types.f90 | 3 +- modules/seastate/src/Waves_Types.f90 | 3 +- modules/servodyn/src/ServoDyn.f90 | 370 ++++---- modules/servodyn/src/ServoDyn_Registry.txt | 12 - modules/servodyn/src/ServoDyn_Types.f90 | 613 +++++++++--- modules/servodyn/src/StrucCtrl_Types.f90 | 167 +++- modules/subdyn/src/SubDyn.f90 | 99 +- modules/subdyn/src/SubDyn_Types.f90 | 170 +++- .../supercontroller/src/SCDataEx_Types.f90 | 78 +- .../src/SuperController_Types.f90 | 145 ++- 81 files changed, 9286 insertions(+), 3669 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 722c4b4051..0a397e8dd7 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -277,7 +277,26 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputNode !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE AA_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: AA_x_DummyContState = 1 ! AA%DummyContState + integer(IntKi), public, parameter :: AA_z_DummyConstrState = 2 ! AA%DummyConstrState + integer(IntKi), public, parameter :: AA_u_RotGtoL = 3 ! AA%RotGtoL + integer(IntKi), public, parameter :: AA_u_AeroCent_G = 4 ! AA%AeroCent_G + integer(IntKi), public, parameter :: AA_u_Vrel = 5 ! AA%Vrel + integer(IntKi), public, parameter :: AA_u_AoANoise = 6 ! AA%AoANoise + integer(IntKi), public, parameter :: AA_u_Inflow = 7 ! AA%Inflow + integer(IntKi), public, parameter :: AA_y_SumSpecNoise = 8 ! AA%SumSpecNoise + integer(IntKi), public, parameter :: AA_y_SumSpecNoiseSep = 9 ! AA%SumSpecNoiseSep + integer(IntKi), public, parameter :: AA_y_OASPL = 10 ! AA%OASPL + integer(IntKi), public, parameter :: AA_y_OASPL_Mech = 11 ! AA%OASPL_Mech + integer(IntKi), public, parameter :: AA_y_DirectiviOutput = 12 ! AA%DirectiviOutput + integer(IntKi), public, parameter :: AA_y_OutLECoords = 13 ! AA%OutLECoords + integer(IntKi), public, parameter :: AA_y_PtotalFreq = 14 ! AA%PtotalFreq + integer(IntKi), public, parameter :: AA_y_WriteOutputForPE = 15 ! AA%WriteOutputForPE + integer(IntKi), public, parameter :: AA_y_WriteOutput = 16 ! AA%WriteOutput + integer(IntKi), public, parameter :: AA_y_WriteOutputSep = 17 ! AA%WriteOutputSep + integer(IntKi), public, parameter :: AA_y_WriteOutputNode = 18 ! AA%WriteOutputNode + +contains subroutine AA_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) type(AA_BladePropsType), intent(in) :: SrcBladePropsTypeData @@ -2992,7 +3011,7 @@ subroutine AA_UnPackOutput(RF, OutData) function AA_InputMeshPointer(u, ML) result(Mesh) type(AA_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -3000,7 +3019,7 @@ function AA_InputMeshPointer(u, ML) result(Mesh) end function function AA_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -3009,7 +3028,7 @@ function AA_InputMeshName(ML) result(Name) function AA_OutputMeshPointer(y, ML) result(Mesh) type(AA_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -3017,11 +3036,187 @@ function AA_OutputMeshPointer(y, ML) result(Mesh) end function function AA_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine AA_PackContStateAry(Vars, x, ValAry) + type(AA_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (AA_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AA_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (AA_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AA_PackConstrStateAry(Vars, z, ValAry) + type(AA_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (AA_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AA_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (AA_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AA_PackInputAry(Vars, u, ValAry) + type(AA_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (AA_u_RotGtoL) + call MV_Pack2(Var, u%RotGtoL, ValAry) ! Rank 4 Array + case (AA_u_AeroCent_G) + call MV_Pack2(Var, u%AeroCent_G, ValAry) ! Rank 3 Array + case (AA_u_Vrel) + call MV_Pack2(Var, u%Vrel, ValAry) ! Rank 2 Array + case (AA_u_AoANoise) + call MV_Pack2(Var, u%AoANoise, ValAry) ! Rank 2 Array + case (AA_u_Inflow) + call MV_Pack2(Var, u%Inflow, ValAry) ! Rank 3 Array + end select + end associate + end do +end subroutine + +subroutine AA_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (AA_u_RotGtoL) + call MV_Unpack2(Var, ValAry, u%RotGtoL) ! Rank 4 Array + case (AA_u_AeroCent_G) + call MV_Unpack2(Var, ValAry, u%AeroCent_G) ! Rank 3 Array + case (AA_u_Vrel) + call MV_Unpack2(Var, ValAry, u%Vrel) ! Rank 2 Array + case (AA_u_AoANoise) + call MV_Unpack2(Var, ValAry, u%AoANoise) ! Rank 2 Array + case (AA_u_Inflow) + call MV_Unpack2(Var, ValAry, u%Inflow) ! Rank 3 Array + end select + end associate + end do +end subroutine + +subroutine AA_PackOutputAry(Vars, y, ValAry) + type(AA_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (AA_y_SumSpecNoise) + call MV_Pack2(Var, y%SumSpecNoise, ValAry) ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + call MV_Pack2(Var, y%SumSpecNoiseSep, ValAry) ! Rank 3 Array + case (AA_y_OASPL) + call MV_Pack2(Var, y%OASPL, ValAry) ! Rank 3 Array + case (AA_y_OASPL_Mech) + call MV_Pack2(Var, y%OASPL_Mech, ValAry) ! Rank 4 Array + case (AA_y_DirectiviOutput) + call MV_Pack2(Var, y%DirectiviOutput, ValAry) ! Rank 1 Array + case (AA_y_OutLECoords) + call MV_Pack2(Var, y%OutLECoords, ValAry) ! Rank 4 Array + case (AA_y_PtotalFreq) + call MV_Pack2(Var, y%PtotalFreq, ValAry) ! Rank 2 Array + case (AA_y_WriteOutputForPE) + call MV_Pack2(Var, y%WriteOutputForPE, ValAry) ! Rank 1 Array + case (AA_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (AA_y_WriteOutputSep) + call MV_Pack2(Var, y%WriteOutputSep, ValAry) ! Rank 1 Array + case (AA_y_WriteOutputNode) + call MV_Pack2(Var, y%WriteOutputNode, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine AA_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (AA_y_SumSpecNoise) + call MV_Unpack2(Var, ValAry, y%SumSpecNoise) ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + call MV_Unpack2(Var, ValAry, y%SumSpecNoiseSep) ! Rank 3 Array + case (AA_y_OASPL) + call MV_Unpack2(Var, ValAry, y%OASPL) ! Rank 3 Array + case (AA_y_OASPL_Mech) + call MV_Unpack2(Var, ValAry, y%OASPL_Mech) ! Rank 4 Array + case (AA_y_DirectiviOutput) + call MV_Unpack2(Var, ValAry, y%DirectiviOutput) ! Rank 1 Array + case (AA_y_OutLECoords) + call MV_Unpack2(Var, ValAry, y%OutLECoords) ! Rank 4 Array + case (AA_y_PtotalFreq) + call MV_Unpack2(Var, ValAry, y%PtotalFreq) ! Rank 2 Array + case (AA_y_WriteOutputForPE) + call MV_Unpack2(Var, ValAry, y%WriteOutputForPE) ! Rank 1 Array + case (AA_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (AA_y_WriteOutputSep) + call MV_Unpack2(Var, ValAry, y%WriteOutputSep) ! Rank 1 Array + case (AA_y_WriteOutputNode) + call MV_Unpack2(Var, ValAry, y%WriteOutputNode) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 2093345f1e..680ed3d03c 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -5546,8 +5546,8 @@ SUBROUTINE TwrInfl_NearestPoint(p, u, RotInflow, BladeNodePosition, r_TowerBlade END SUBROUTINE TwrInfl_NearestPoint !---------------------------------------------------------------------------------------------------------------------------------- -subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileData, Linearize, CompAeroMaps, ErrStat, ErrMsg) - integer(IntKi), intent(in) :: Rotnum !< Rotor number +subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, Linearize, CompAeroMaps, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: iR !< Rotor number type(RotInputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(RotParameterType), intent(inout) :: p !< Parameters type(RotContinuousStateType), intent(inout) :: x !< States @@ -5586,7 +5586,7 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD InitOut%Vars => p%Vars ! Create rotor label - RotorLabel = 'R'//trim(Num2LStr(RotNum)) + RotorLabel = 'R'//trim(Num2LStr(iR)) !---------------------------------------------------------------------------- ! Perturbation values @@ -5612,10 +5612,10 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD ! DBEMT if (p%BEMT%DBEMT%lin_nx/2 > 0) then - p%iVarDBEMT = size(p%Vars%x) + 1 do j = 1, p%NumBlades call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & - Num=p%NumBlNds*2, & + DatLoc(AD_x_BEMT_DBEMT_element_vind), & + Num=2*p%NumBlNds, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & Perturb=Perturb, & LinNames=[([DBEMTLinName(j, i, "axial", .false.), & @@ -5623,42 +5623,35 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD end do do j = 1, p%NumBlades call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & - Num=p%NumBlNds*2, & + DatLoc(AD_x_BEMT_DBEMT_element_vind_1), & + Num=2*p%NumBlNds, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & Perturb=Perturb, & LinNames=[([DBEMTLinName(j, i, "axial", .true.), & DBEMTLinName(j, i, "tangential", .true.)], i = 1, p%NumBlNds)]) end do - else - p%iVarDBEMT = 0 end if ! Unsteady Aero - if (p%BEMT%UA%lin_nx == 0) then - p%iVarUA = 0 - else - p%iVarUA = size(p%Vars%x) + 1 - - ! Loop through UA elements - do n = 1, p%BEMT%UA%lin_nx - - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - state = p%BEMT%UA%lin_xIndx(n,3) - - select case (state) - case (1, 2) ! x1 and x2 are radians - NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', rad' - case (3, 4, 5) ! x3, x4 (and x5) are units of cl or cn - NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', -' - end select + do n = 1, p%BEMT%UA%lin_nx - call MV_AddVar(p%Vars%x, NodeLabel, FieldScalar, & - Flags=ior(VF_DerivOrder1, VF_RotFrame), & - Perturb=p%BEMT%UA%dx(state), & - LinNames=[NodeLabel]) - end do - end if + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + state = p%BEMT%UA%lin_xIndx(n,3) + + select case (state) + case (1, 2) ! x1 and x2 are radians + NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', rad' + case (3, 4, 5) ! x3, x4 (and x5) are units of cl or cn + NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', -' + end select + + call MV_AddVar(p%Vars%x, NodeLabel, FieldScalar, & + DatLoc(AD_x_BEMT_UA_element_x, i, j), iAry=state, & + Flags=ior(VF_DerivOrder1, VF_RotFrame), & + Perturb=p%BEMT%UA%dx(state), & + LinNames=[NodeLabel]) + end do ! BEMT states if (p%BEMT%lin_nx>0) then @@ -5671,91 +5664,73 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD !---------------------------------------------------------------------------- ! Add Nacelle motion - call MV_AddMeshVar(p%Vars%u, "Nacelle", & - VarIdx=p%iVarNacelleMotion, & + call MV_AddMeshVar(p%Vars%u, "Nacelle", [FieldTransDisp, FieldOrientation], & + DatLoc(AD_u_NacelleMotion), & Mesh=u%NacelleMotion, & - Fields=[FieldTransDisp, FieldOrientation], & Perturbs=[PerturbBlade(1), Perturb]) ! Add hub motion - call MV_AddMeshVar(p%Vars%u, "Hub", & - VarIdx=p%iVarHubMotion, & + call MV_AddMeshVar(p%Vars%u, "Hub", [FieldTransDisp, FieldOrientation, FieldAngularVel], & + DatLoc(AD_u_HubMotion), & Mesh=u%HubMotion, & - Fields=[FieldTransDisp, FieldOrientation, FieldAngularVel], & Perturbs=[PerturbBlade(1), Perturb, Perturb]) ! Add tail fin motion - call MV_AddMeshVar(p%Vars%u, "TFin", & - VarIdx=p%iVarTFinMotion, & + call MV_AddMeshVar(p%Vars%u, "TFin", [FieldTransDisp, FieldOrientation, FieldTransVel], & + DatLoc(AD_u_TFinMotion), & Mesh=u%TFinMotion, & - Fields=[FieldTransDisp, FieldOrientation, FieldTransVel], & Perturbs=[Perturb, Perturb, Perturb]) ! Add tower motion - call MV_AddMeshVar(p%Vars%u, "Tower", & - VarIdx=p%iVarTowerMotion, & + call MV_AddMeshVar(p%Vars%u, "Tower", [FieldTransDisp, FieldOrientation, FieldTransVel, FieldTransAcc], & + DatLoc(AD_u_TowerMotion), & Mesh=u%TowerMotion, & - Fields=[FieldTransDisp, FieldOrientation, FieldTransVel, FieldTransAcc], & Perturbs=[PerturbTower, Perturb, PerturbTower, PerturbTower]) ! Add blade root motion - call AllocAry(p%iVarBladeRootMotion, p%NumBlades, "iVarBladeRootMotion", ErrStat2, ErrMsg2); if (Failed()) return - p%iVarBladeRootMotion = 0 do j = 1, p%NumBlades - call MV_AddMeshVar(p%Vars%u, "Blade root "//Num2LStr(j), & - VarIdx=p%iVarBladeRootMotion(j), & + call MV_AddMeshVar(p%Vars%u, "Blade root "//Num2LStr(j), [FieldOrientation], & + DatLoc(AD_u_BladeRootMotion, j), & Mesh=u%BladeRootMotion(j), & - Fields=[FieldOrientation], & Perturbs=[Perturb]) end do ! Add blade motion - call AllocAry(p%iVarBladeMotion, p%NumBlades, "iVarBladeMotion", ErrStat2, ErrMsg2); if (Failed()) return - p%iVarBladeMotion = 0 do j = 1, p%NumBlades - call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(j), & - VarIdx=p%iVarBladeMotion(j), & + Flags = VF_None + if (j == 1) Flags = VF_AeroMap + call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(j), [FieldTransDisp, FieldOrientation, FieldTransVel], & + DatLoc(AD_u_BladeMotion, j), & + Flags=Flags, & Mesh=u%BladeMotion(j), & - Fields=[FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc], & - Perturbs=[PerturbBlade(j), Perturb, PerturbBlade(j), Perturb, PerturbBlade(j), Perturb]) - ! Set AeroMap flag on subset of fields for first blade - if (j == 1) then - do i = p%iVarBladeMotion(j), size(p%Vars%u) - select case (p%Vars%u(i)%Field) - case (FieldTransDisp, FieldOrientation, FieldTransVel) - call MV_SetFlags(p%Vars%u(i), VF_AeroMap) - end select - end do - end if + Perturbs=[PerturbBlade(j), Perturb, PerturbBlade(j)]) + call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(j), [FieldAngularVel, FieldTransAcc, FieldAngularAcc], & + DatLoc(AD_u_BladeMotion, j), & + Mesh=u%BladeMotion(j), & + Perturbs=[Perturb, PerturbBlade(j), Perturb]) end do ! Add user props - call AllocAry(p%iVarUserProp, p%NumBlades, "iVarUserProp", ErrStat2, ErrMsg2); if (Failed()) return - p%iVarUserProp = 0 do j = 1, p%NumBlades - call MV_AddVar(p%Vars%u, "UserProp Blade"//IdxStr(j), FieldScalar, & - VarIdx=p%iVarUserProp(j), & - Flags=ior(VF_Linearize, VF_RotFrame), & + call MV_AddVar(p%Vars%u, "UserProp Blade"//IdxStr(j), FieldScalar, DatLoc(AD_u_UserProp), jAry=j, & + Flags=VF_Linearize + VF_RotFrame, & Num=p%NumBlNds, & Perturb=Perturb, & LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', -', i = 1, p%NumBlNds)]) end do ! Extended inputs - call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, & - VarIdx=p%iVarHWindSpeed, & + call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, DatLoc(AD_u_HWindSpeed), & Flags=VF_ExtLin + VF_Linearize, & Perturb=Perturb, & LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, & - VarIdx=p%iVarPLexp, & + call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, DatLoc(AD_u_PLexp), & Flags=VF_ExtLin + VF_Linearize, & Perturb=Perturb, & LinNames=['Extended input: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, & - VarIdx=p%iVarPropagationDir, & + call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, DatLoc(AD_u_PropagationDir), & Flags=VF_ExtLin + VF_Linearize, & Perturb=Perturb, & LinNames=['Extended input: propagation direction, rad']) @@ -5765,52 +5740,43 @@ subroutine AD_InitVars(RotNum, u, p, x, z, OtherState, y, m, InitOut, InputFileD !---------------------------------------------------------------------------- ! Add nacelle load - call MV_AddMeshVar(p%Vars%y, "Nacelle", LoadFields, & - VarIdx=p%iVarNacelleLoad, & + call MV_AddMeshVar(p%Vars%y, "Nacelle", LoadFields, DatLoc(AD_y_NacelleLoad), & Mesh=y%NacelleLoad) ! Add hub load - call MV_AddMeshVar(p%Vars%y, "Hub", LoadFields, & - VarIdx=p%iVarHubLoad, & + call MV_AddMeshVar(p%Vars%y, "Hub", LoadFields, DatLoc(AD_y_HubLoad), & Mesh=y%HubLoad) ! Add tail fin load - call MV_AddMeshVar(p%Vars%y, "TFin", LoadFields, & - VarIdx=p%iVarTFinLoad, & + call MV_AddMeshVar(p%Vars%y, "TFin", LoadFields, DatLoc(AD_y_TFinLoad), & Mesh=y%TFinLoad) ! Add tower load - call MV_AddMeshVar(p%Vars%y, "Tower", LoadFields, & - VarIdx=p%iVarTowerLoad, & + call MV_AddMeshVar(p%Vars%y, "Tower", LoadFields, DatLoc(AD_y_TowerLoad), & Mesh=y%TowerLoad) ! Loop through blades, add blade loads - call AllocAry(p%iVarBladeLoad, p%NumBlades, "iVarBladeLoad", ErrStat2, ErrMsg2); if (Failed()) return - p%iVarBladeLoad = 0 do j = 1, p%NumBlades Flags = VF_Line if (j == 1) Flags = ior(Flags, VF_AeroMap) - call MV_AddMeshVar(p%Vars%y, "Blade "//Num2LStr(j), LoadFields, & - VarIdx=p%iVarBladeLoad(j), & + call MV_AddMeshVar(p%Vars%y, "Blade "//Num2LStr(j), LoadFields, DatLoc(AD_y_BladeLoad, j), & Flags=Flags, & Mesh=y%BladeLoad(j)) end do - p%iVarWriteOutput = size(p%Vars%y) + 1 - ! Rotor outputs do j = 1, p%NumOuts call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), FieldScalar, & + DatLoc(AD_y_WriteOutput), iAry=j, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(j)%Indx), & - iUsr=j, & LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) end do ! Blade node outputs do j = p%NumOuts + 1, p%NumOuts + p%BldNd_TotNumOuts call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), FieldScalar, & + DatLoc(AD_y_WriteOutput), iAry=j, & Flags=VF_WriteOut + VF_RotFrame, & - iUsr=j, & LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) end do @@ -5866,7 +5832,7 @@ end function Failed !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) +SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -5880,11 +5846,12 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number + integer(IntKi), parameter :: iR =1 ! Rotor index integer(intKi) :: StartNode @@ -5898,14 +5865,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call AD_CalcWind_Rotor(t, u%rotors(iR), p%FlowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), StartNode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return - call Rot_JacobianPInput( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) + call Rot_JacobianPInput( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) END SUBROUTINE AD_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter ) +SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. use IfW_FlowField, only: FlowFieldType, UniformField_InterpLinear REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -5923,35 +5890,58 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number character(*), parameter :: RoutineName = 'AD_JacobianPInput' integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - TYPE(RotOtherStateType) :: OtherState_copy - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc - INTEGER(IntKi) :: i, j, col, StartNode + type(RotOtherStateType) :: OtherState_copy + integer(IntKi) :: i, j, col, StartNode + integer(IntKi) :: iVarHWindSpeed, iVarPLexp, iVarPropagationDir type(UniformField_Interp) :: UF_op type(FlowFieldType),target :: FF_perturb type(FlowFieldType),pointer :: FF_ptr ! need a pointer in the CalcWind_Rotor routine type(RotInflowType) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs + type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + ! If vars were provided use them, otherwise use module variables + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars + end if + + ! Find indices for extended input variables + iVarHWindSpeed = 0 + iVarPLexp = 0 + iVarPropagationDir = 0 + do i = 1, size(VarsL%u) + select case(VarsL%u(i)%DL%Num) + case (AD_u_HWindSpeed) + iVarHWindSpeed = i + case (AD_u_PLexp) + iVarPLexp = i + case (AD_u_PropagationDir) + iVarPropagationDir = i + end select + end do + + ! If flow field will need to be perturbed (HWindSpeed, PLexp, or PropagationDir variables) + if (iVarHWindSpeed > 0 .or. iVarPLexp > 0 .or. iVarPropagationDir > 0) then + ! Copy the flow field (Uniform type, which as minimal data) + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FF_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + FF_ptr => FF_perturb + else + ! Otherwise, associate flowfield pointer to flowfield in parameters since it won't be modified + FF_ptr => p_AD%FlowField end if ! Get OP values here (i.e., set inputs for BEMT): @@ -5978,115 +5968,98 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y ! Copy inputs and pack them for perturbation call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackInputOP(p, u, m%Jac%u) + call AD_PackInputAry(VarsL, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Copy rotor inflow type for perturbation call AD_CopyRotInflowType(RotInflow, RotInflow_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - - ! If performing full linearization - if (IsFullLin) then - ! Copy the flow field so it can be perturbed - ! In full linearization, flow field will be Uniform type, which as minimal data - call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FF_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - FF_ptr => FF_perturb - else - ! Associate flowfield pointer to flowfield in parameters - FF_ptr => p_AD%FlowField - end if ! Loop through input variables - do i = 1, size(p%Vars%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%u) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate positive perturbation call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, 1, FF_ptr) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(VarsL%u(i), p_AD%FlowField, 1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call AD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, -1, FF_ptr) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(VarsL%u(i), p_AD%FlowField, -1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call AD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - if (present(dXdu) .and. (p%Vars%Nx > 0)) then + if (present(dXdu) .and. (VarsL%Nx > 0)) then ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%u) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, 1, FF_ptr) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(VarsL%u(i), p_AD%FlowField, 1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) + call AD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(i, p_AD%FlowField, -1, FF_ptr) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(VarsL%u(i), p_AD%FlowField, -1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) + call AD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%u(i)%Perturb) end do end do @@ -6102,27 +6075,30 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y call cleanup() contains - subroutine PerturbFlowField(iVar, BaseFF, PerturbSign, PerturbFF) - integer(IntKi), intent(in) :: iVar + subroutine PerturbFlowField(Var, BaseFF, PerturbSign, PerturbFF) + type(ModVarType), intent(in) :: Var type(FlowFieldType), intent(in) :: BaseFF integer(IntKi), intent(in) :: PerturbSign type(FlowFieldType), intent(inout) :: PerturbFF PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV PerturbFF%PropagationDir = BaseFF%PropagationDir - if (iVar == p%iVarHWindSpeed) then - PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH + p%Vars%u(iVar)%Perturb*PerturbSign - else if (iVar == p%iVarPLexp) then - PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV + p%Vars%u(iVar)%Perturb*PerturbSign - else if (iVar == p%iVarPropagationDir) then - PerturbFF%PropagationDir = BaseFF%PropagationDir + p%Vars%u(iVar)%Perturb*PerturbSign - end if + select case (Var%DL%Num) + case (AD_u_HWindSpeed) + PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH + Var%Perturb*PerturbSign + case (AD_u_PLexp) + PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV + Var%Perturb*PerturbSign + case (AD_u_PropagationDir) + PerturbFF%PropagationDir = BaseFF%PropagationDir + Var%Perturb*PerturbSign + end select end subroutine + logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev if (Failed) call cleanup() end function + subroutine cleanup() m%BEMT%UseFrozenWake = .false. end subroutine cleanup @@ -6130,7 +6106,7 @@ end subroutine Rot_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter ) +SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6147,6 +6123,7 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions !! (Y) with respect to the continuous !! states (x) [intent in to avoid deallocation] @@ -6159,7 +6136,6 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state !! functions (Z) with respect to !! the continuous states (x) [intent in to avoid deallocation] - INTEGER, OPTIONAL, INTENT(IN ) :: FlagFilter integer(IntKi), parameter :: iR = 1 ! Rotor index integer(IntKi) :: StartNode @@ -6172,14 +6148,14 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, StartNode = 1 call AD_CalcWind_Rotor(t, u%rotors(iR), p%FlowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), StartNode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return - call RotJacobianPContState(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter) + call RotJacobianPContState(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx) END SUBROUTINE AD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter ) +SUBROUTINE RotJacobianPContState(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6200,31 +6176,27 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) [intent in to avoid deallocation] - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags character(*), parameter :: RoutineName = 'AD_JacobianPContState' integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc integer(IntKi) :: i, j, col - - ! Initialize ErrStat + type(ModVarsType), pointer :: VarsL + ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + ! If vars were provided use them, otherwise use module variables + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars end if ! Get OP values here (i.e., set inputs for BEMT): @@ -6250,42 +6222,39 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Copy and pack states for perturbation call AD_CopyRotContinuousStateType(m%x_init, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateOP(p, m%x_init, m%Jac%x) + call AD_PackContStateAry(VarsL, m%x_init, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, VarsL%Ny, VarsL%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%x) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, VarsL%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call AD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call AD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = VarsL%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do @@ -6296,35 +6265,32 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%x) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, VarsL%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) + call AD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) + call AD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = VarsL%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%x(i)%Perturb) end do end do @@ -6627,7 +6593,7 @@ END SUBROUTINE RotJacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE AD_GetOP(iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter ) +SUBROUTINE AD_GetOP(iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, Vars) INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6646,7 +6612,7 @@ SUBROUTINE AD_GetOP(iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays integer(IntKi) :: StartNode @@ -6661,13 +6627,13 @@ SUBROUTINE AD_GetOP(iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg if (ErrStat >= AbortErrLev) return call RotGetOP(t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), & xd%rotors(iRotor), z%rotors(iRotor), OtherState%rotors(iRotor), y%rotors(iRotor), m%rotors(iRotor), & - ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter) + ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, Vars) END SUBROUTINE AD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, FlagFilter) +SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, Vars) use IfW_FlowField, only: FlowFieldType, Uniform_FieldType, UniformField_InterpLinear REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6688,42 +6654,44 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Skip vars that don't include these flags + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc - INTEGER(IntKi) :: ind, i, j, k, n + INTEGER(IntKi) :: i type(UniformField_Interp) :: UF_op + type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars end if ! Inputs if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - call AD_PackInputOP(p, u, u_op) + call AD_PackInputAry(VarsL, u, u_op) if (associated(p_AD%FlowField)) then if (p_AD%FlowField%FieldType == Uniform_FieldType) then UF_op = UniformField_InterpLinear(p_AD%FlowField%Uniform, t) - call MV_Pack(p%Vars%u, p%iVarHWindSpeed, UF_op%VelH, u_op) - call MV_Pack(p%Vars%u, p%iVarPLexp, UF_op%ShrV, u_op) - call MV_Pack(p%Vars%u, p%iVarPropagationDir, UF_op%AngleH + p_AD%FlowField%PropagationDir, u_op) + do i = 1, size(VarsL%u) + select case (VarsL%u(i)%DL%Num) + case (AD_u_HWindSpeed) + call MV_Pack2(VarsL%u(i), UF_op%VelH, u_op) + case (AD_u_PLexp) + call MV_Pack2(VarsL%u(i), UF_op%ShrV, u_op) + case (AD_u_PropagationDir) + call MV_Pack2(VarsL%u(i), UF_op%AngleH + p_AD%FlowField%PropagationDir, u_op) + end select + end do end if end if end if @@ -6731,29 +6699,26 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta ! Outputs if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - call AD_PackOutputOP(p, y, y_op, IsFullLin) + call AD_PackOutputAry(VarsL, y, y_op) end if ! Continuous States if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - call AD_PackContStateOP(p, x, x_op) + call AD_PackContStateAry(VarsL, x, x_op) end if ! Continous State Derivatives if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dx_op, VarsL%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); If (Failed()) return - call AD_PackContStateOP(p, m%dxdt_lin, dx_op) + call AD_PackContStateAry(VarsL, m%dxdt_lin, dx_op) end if ! Discrete States @@ -6765,8 +6730,7 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta if (.not. allocated(z_op)) then call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - call AD_PackConstrStateOP(p, z, z_op) + call AD_PackConstrStateAry(VarsL, z, z_op) end if contains @@ -6777,55 +6741,55 @@ logical function Failed() end subroutine RotGetOP !> AD_SetOP populates the data structures from the operating point arrays. (Extended inputs are not used) -subroutine AD_SetOP(iRotor, u, p, x, xd, z, ErrStat, ErrMsg, u_op, x_op, xd_op, z_op) - INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index - TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: z_op(:) !< values of linearized constraint states - - call RotSetOP(u%rotors(iRotor), p%rotors(iRotor), x%rotors(iRotor), xd%rotors(iRotor), z%rotors(iRotor), ErrStat, ErrMsg, u_op, x_op, xd_op, z_op) +subroutine AD_SetOP(iRotor, u, p, x, z, ErrStat, ErrMsg, Vars, u_op, x_op, z_op) + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index + TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point + TYPE(AD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: z_op(:) !< values of linearized constraint states + + call RotSetOP(u%rotors(iRotor), p%rotors(iRotor), x%rotors(iRotor), z%rotors(iRotor), ErrStat, ErrMsg, & + u_op, x_op, z_op, Vars) end subroutine !> RotSetOP populates the data structures from the operating point arrays. (Extended inputs are not used) -subroutine RotSetOP(u, p, x, xd, z, ErrStat, ErrMsg, u_op, x_op, xd_op, z_op) - type(RotInputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - type(RotParameterType), intent(in ) :: p !< Parameters - type(RotContinuousStateType), intent(inout) :: x !< Continuous states at operating point - type(RotDiscreteStateType), intent(inout) :: xd !< Discrete states at operating point - type(RotConstraintStateType), intent(inout) :: z !< Constraint states at operating point - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(R8Ki), allocatable, optional, intent(in ) :: u_op(:) !< values of linearized inputs - real(R8Ki), allocatable, optional, intent(in ) :: x_op(:) !< values of linearized continuous states - real(R8Ki), allocatable, optional, intent(in ) :: xd_op(:) !< values of linearized discrete states - real(R8Ki), allocatable, optional, intent(in ) :: z_op(:) !< values of linearized constraint states +subroutine RotSetOP(u, p, x, z, ErrStat, ErrMsg, u_op, x_op, z_op, Vars) + type(RotInputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(RotParameterType), intent(in ) :: p !< Parameters + type(RotContinuousStateType), intent(inout) :: x !< Continuous states at operating point + type(RotConstraintStateType), intent(inout) :: z !< Constraint states at operating point + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(R8Ki), allocatable, optional, intent(in ) :: u_op(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(in ) :: x_op(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(in ) :: z_op(:) !< values of linearized constraint states + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays character(*), parameter :: RoutineName = 'AD_SetOP' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 + type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - if (present(u_op)) call AD_UnpackInputOP(p, u_op, u) - if (present(x_op)) call AD_UnpackContStateOP(p, x_op, x) - if (present(xd_op)) call AD_UnpackDiscStateOP(p, xd_op, xd) - if (present(z_op)) call AD_UnpackConstrStateOP(p, z_op, z) + if (present(Vars)) then + VarsL => Vars + else + VarsL => p%Vars + end if + + if (present(u_op)) call AD_UnpackInputAry(VarsL, u_op, u) + if (present(x_op)) call AD_UnpackContStateAry(VarsL, x_op, x) + if (present(z_op)) call AD_UnpackConstrStateAry(VarsL, z_op, z) -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function end subroutine @@ -6868,195 +6832,195 @@ SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) END SUBROUTINE Compute_dY -subroutine AD_PackContStateOP(p, x, op) - type(RotParameterType), intent(in) :: p - type(RotContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: i, j, k, n, ind - ind = 1 - if (p%BEMT%DBEMT%lin_nx > 0) then - do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind) - op(ind) = x%BEMT%DBEMT%element(i,j)%vind(k) - ind = ind + 1 - end do - end do - end do - do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind_1) - op(ind) = x%BEMT%DBEMT%element(i,j)%vind_1(k) - ind = ind + 1 - end do - end do - end do - end if - - do n = 1, p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - op(ind) = x%BEMT%UA%element(i,j)%x(k) - ind = ind + 1 - end do -end subroutine - -subroutine AD_UnpackContStateOP(p, op, x) - type(RotParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(RotContinuousStateType), intent(inout) :: x - integer(IntKi) :: i, j, k, n, ind - ind = 1 - - if (p%BEMT%DBEMT%lin_nx > 0) then - do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind) - x%BEMT%DBEMT%element(i,j)%vind(k) = op(ind) - ind = ind + 1 - end do - end do - end do - do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind_1) - x%BEMT%DBEMT%element(i,j)%vind_1(k) = op(ind) - ind = ind + 1 - end do - end do - end do - end if - - do n = 1, p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - x%BEMT%UA%element(i,j)%x(k) = op(ind) - ind = ind + 1 - end do -end subroutine - -subroutine AD_PackDiscStateOP(p, xd, op) - type(RotParameterType), intent(in) :: p - type(RotDiscreteStateType), intent(in) :: xd - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: i, j, k -end subroutine - -subroutine AD_UnpackDiscStateOP(p, op, xd) - type(RotParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(RotDiscreteStateType), intent(inout) :: xd - integer(IntKi) :: i, j, k -end subroutine - -subroutine AD_PackConstrStateOP(p, z, op) - type(RotParameterType), intent(in) :: p - type(RotConstraintStateType), intent(in) :: z - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: i, k, ind - ind = 1 - do k = 1, p%NumBlades ! size(z%BEMT%Phi,2) - do i = 1, p%NumBlNds ! size(z%BEMT%Phi,1) - op(ind) = z%BEMT%phi(i,k) - ind = ind + 1 - end do - end do -end subroutine - -subroutine AD_UnpackConstrStateOP(p, op, z) - type(RotParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(RotConstraintStateType), intent(inout) :: z - integer(IntKi) :: i, k, ind - ind = 1 - do k = 1, p%NumBlades ! size(z%BEMT%Phi,2) - do i = 1, p%NumBlNds ! size(z%BEMT%Phi,1) - z%BEMT%phi(i,k) = op(ind) - ind = ind + 1 - end do - end do -end subroutine - -subroutine AD_PackInputOP(p, u, op) - type(RotParameterType), intent(in) :: p - type(RotInputType), intent(in) :: u - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: k - call MV_Pack(p%Vars%u, p%iVarNacelleMotion, u%NacelleMotion, op) - call MV_Pack(p%Vars%u, p%iVarHubMotion, u%HubMotion, op) - call MV_Pack(p%Vars%u, p%iVarTFinMotion, u%TFinMotion, op) - call MV_Pack(p%Vars%u, p%iVarTowerMotion, u%TowerMotion, op) - do k = 1, p%NumBlades - call MV_Pack(p%Vars%u, p%iVarBladeRootMotion(k), u%BladeRootMotion(k), op) - end do - do k = 1, p%NumBlades - call MV_Pack(p%Vars%u, p%iVarBladeMotion(k), u%BladeMotion(k), op) - end do - do k = 1, p%NumBlades - call MV_Pack(p%Vars%u, p%iVarUserProp(k), u%UserProp(:,k), op) - end do - call MV_Pack(p%Vars%u, p%iVarHWindSpeed, 0.0_R8Ki, op) - call MV_Pack(p%Vars%u, p%iVarPLexp, 0.0_R8Ki, op) - call MV_Pack(p%Vars%u, p%iVarPropagationDir, 0.0_R8Ki, op) -end subroutine - -subroutine AD_UnpackInputOP(p, op, u) - type(RotParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(RotInputType), intent(inout) :: u - integer(IntKi) :: k - call MV_Unpack(p%Vars%u, p%iVarNacelleMotion, op, u%NacelleMotion) - call MV_Unpack(p%Vars%u, p%iVarHubMotion, op, u%HubMotion) - call MV_Unpack(p%Vars%u, p%iVarTFinMotion, op, u%TFinMotion) - call MV_Unpack(p%Vars%u, p%iVarTowerMotion, op, u%TowerMotion) - do k = 1, p%NumBlades - call MV_Unpack(p%Vars%u, p%iVarBladeRootMotion(k), op, u%BladeRootMotion(k)) - end do - do k = 1, p%NumBlades - call MV_Unpack(p%Vars%u, p%iVarBladeMotion(k), op, u%BladeMotion(k)) - end do - do k = 1, p%NumBlades - call MV_Unpack(p%Vars%u, p%iVarUserProp(k), op, u%UserProp(:,k)) - end do -end subroutine - -subroutine AD_PackOutputOP(p, y, op, PackWriteOutput) - type(RotParameterType), intent(in) :: p - type(RotOutputType), intent(in) :: y - real(R8Ki), intent(out) :: op(:) - logical, intent(in) :: PackWriteOutput - integer(IntKi) :: k - call MV_Pack(p%Vars%y, p%iVarNacelleLoad, y%NacelleLoad, op) - call MV_Pack(p%Vars%y, p%iVarHubLoad, y%HubLoad, op) - call MV_Pack(p%Vars%y, p%iVarTFinLoad, y%TFinLoad, op) - call MV_Pack(p%Vars%y, p%iVarTowerLoad, y%TowerLoad, op) - do k = 1, p%NumBlades - call MV_Pack(p%Vars%y, p%iVarBladeLoad(k), y%BladeLoad(k), op) - end do - if (PackWriteOutput) then - do k = p%iVarWriteOutput, size(p%Vars%y) - call MV_Pack(p%Vars%y, k, y%WriteOutput(p%Vars%y(k)%iUsr(1)), op) - end do - end if -end subroutine - -subroutine AD_UnpackOutputOP(p, op, y) - type(RotParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(RotOutputType), intent(out) :: y - integer(IntKi) :: k - call MV_Unpack(p%Vars%y, p%iVarNacelleLoad, op, y%NacelleLoad) - call MV_Unpack(p%Vars%y, p%iVarHubLoad, op, y%HubLoad) - call MV_Unpack(p%Vars%y, p%iVarTFinLoad, op, y%TFinLoad) - call MV_Unpack(p%Vars%y, p%iVarTowerLoad, op, y%TowerLoad) - do k = 1, p%NumBlades - call MV_Unpack(p%Vars%y, p%iVarBladeLoad(k), op, y%BladeLoad(k)) - end do - do k = p%iVarWriteOutput, size(p%Vars%y) - call MV_Unpack(p%Vars%y, k, op, y%WriteOutput(p%Vars%y(k)%iUsr(1))) - end do -end subroutine +! subroutine AD_PackContStateOP(p, x, op) +! type(RotParameterType), intent(in) :: p +! type(RotContinuousStateType), intent(in) :: x +! real(R8Ki), intent(out) :: op(:) +! integer(IntKi) :: i, j, k, n, ind +! ind = 1 +! if (p%BEMT%DBEMT%lin_nx > 0) then +! do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) +! do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) +! do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind) +! op(ind) = x%BEMT%DBEMT%element(i,j)%vind(k) +! ind = ind + 1 +! end do +! end do +! end do +! do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) +! do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) +! do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind_1) +! op(ind) = x%BEMT%DBEMT%element(i,j)%vind_1(k) +! ind = ind + 1 +! end do +! end do +! end do +! end if + +! do n = 1, p%BEMT%UA%lin_nx +! i = p%BEMT%UA%lin_xIndx(n,1) +! j = p%BEMT%UA%lin_xIndx(n,2) +! k = p%BEMT%UA%lin_xIndx(n,3) +! op(ind) = x%BEMT%UA%element(i,j)%x(k) +! ind = ind + 1 +! end do +! end subroutine + +! subroutine AD_UnpackContStateOP(p, op, x) +! type(RotParameterType), intent(in) :: p +! real(R8Ki), intent(in) :: op(:) +! type(RotContinuousStateType), intent(inout) :: x +! integer(IntKi) :: i, j, k, n, ind +! ind = 1 + +! if (p%BEMT%DBEMT%lin_nx > 0) then +! do j = 1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) +! do i = 1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) +! do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind) +! x%BEMT%DBEMT%element(i,j)%vind(k) = op(ind) +! ind = ind + 1 +! end do +! end do +! end do +! do j = 1, p%NumBlades ! size(x%BEMT%DBEMT%element,2) +! do i = 1, p%NumBlNds ! size(x%BEMT%DBEMT%element,1) +! do k = 1, size(x%BEMT%DBEMT%element(i,j)%vind_1) +! x%BEMT%DBEMT%element(i,j)%vind_1(k) = op(ind) +! ind = ind + 1 +! end do +! end do +! end do +! end if + +! do n = 1, p%BEMT%UA%lin_nx +! i = p%BEMT%UA%lin_xIndx(n,1) +! j = p%BEMT%UA%lin_xIndx(n,2) +! k = p%BEMT%UA%lin_xIndx(n,3) +! x%BEMT%UA%element(i,j)%x(k) = op(ind) +! ind = ind + 1 +! end do +! end subroutine + +! subroutine AD_PackDiscStateOP(p, xd, op) +! type(RotParameterType), intent(in) :: p +! type(RotDiscreteStateType), intent(in) :: xd +! real(R8Ki), intent(out) :: op(:) +! integer(IntKi) :: i, j, k +! end subroutine + +! subroutine AD_UnpackDiscStateOP(p, op, xd) +! type(RotParameterType), intent(in) :: p +! real(R8Ki), intent(in) :: op(:) +! type(RotDiscreteStateType), intent(inout) :: xd +! integer(IntKi) :: i, j, k +! end subroutine + +! subroutine AD_PackConstrStateOP(p, z, op) +! type(RotParameterType), intent(in) :: p +! type(RotConstraintStateType), intent(in) :: z +! real(R8Ki), intent(out) :: op(:) +! integer(IntKi) :: i, k, ind +! ind = 1 +! do k = 1, p%NumBlades ! size(z%BEMT%Phi,2) +! do i = 1, p%NumBlNds ! size(z%BEMT%Phi,1) +! op(ind) = z%BEMT%phi(i,k) +! ind = ind + 1 +! end do +! end do +! end subroutine + +! subroutine AD_UnpackConstrStateOP(p, op, z) +! type(RotParameterType), intent(in) :: p +! real(R8Ki), intent(in) :: op(:) +! type(RotConstraintStateType), intent(inout) :: z +! integer(IntKi) :: i, k, ind +! ind = 1 +! do k = 1, p%NumBlades ! size(z%BEMT%Phi,2) +! do i = 1, p%NumBlNds ! size(z%BEMT%Phi,1) +! z%BEMT%phi(i,k) = op(ind) +! ind = ind + 1 +! end do +! end do +! end subroutine + +! subroutine AD_PackInputOP(p, u, op) +! type(RotParameterType), intent(in) :: p +! type(RotInputType), intent(in) :: u +! real(R8Ki), intent(out) :: op(:) +! integer(IntKi) :: k +! call MV_Pack(p%Vars%u, p%iVarNacelleMotion, u%NacelleMotion, op) +! call MV_Pack(p%Vars%u, p%iVarHubMotion, u%HubMotion, op) +! call MV_Pack(p%Vars%u, p%iVarTFinMotion, u%TFinMotion, op) +! call MV_Pack(p%Vars%u, p%iVarTowerMotion, u%TowerMotion, op) +! do k = 1, p%NumBlades +! call MV_Pack(p%Vars%u, p%iVarBladeRootMotion(k), u%BladeRootMotion(k), op) +! end do +! do k = 1, p%NumBlades +! call MV_Pack(p%Vars%u, p%iVarBladeMotion(k), u%BladeMotion(k), op) +! end do +! do k = 1, p%NumBlades +! call MV_Pack(p%Vars%u, p%iVarUserProp(k), u%UserProp(:,k), op) +! end do +! call MV_Pack(p%Vars%u, p%iVarHWindSpeed, 0.0_R8Ki, op) +! call MV_Pack(p%Vars%u, p%iVarPLexp, 0.0_R8Ki, op) +! call MV_Pack(p%Vars%u, p%iVarPropagationDir, 0.0_R8Ki, op) +! end subroutine + +! subroutine AD_UnpackInputOP(p, op, u) +! type(RotParameterType), intent(in) :: p +! real(R8Ki), intent(in) :: op(:) +! type(RotInputType), intent(inout) :: u +! integer(IntKi) :: k +! call MV_Unpack(p%Vars%u, p%iVarNacelleMotion, op, u%NacelleMotion) +! call MV_Unpack(p%Vars%u, p%iVarHubMotion, op, u%HubMotion) +! call MV_Unpack(p%Vars%u, p%iVarTFinMotion, op, u%TFinMotion) +! call MV_Unpack(p%Vars%u, p%iVarTowerMotion, op, u%TowerMotion) +! do k = 1, p%NumBlades +! call MV_Unpack(p%Vars%u, p%iVarBladeRootMotion(k), op, u%BladeRootMotion(k)) +! end do +! do k = 1, p%NumBlades +! call MV_Unpack(p%Vars%u, p%iVarBladeMotion(k), op, u%BladeMotion(k)) +! end do +! do k = 1, p%NumBlades +! call MV_Unpack(p%Vars%u, p%iVarUserProp(k), op, u%UserProp(:,k)) +! end do +! end subroutine + +! subroutine AD_PackOutputOP(p, y, op, PackWriteOutput) +! type(RotParameterType), intent(in) :: p +! type(RotOutputType), intent(in) :: y +! real(R8Ki), intent(out) :: op(:) +! logical, intent(in) :: PackWriteOutput +! integer(IntKi) :: k +! call MV_Pack(p%Vars%y, p%iVarNacelleLoad, y%NacelleLoad, op) +! call MV_Pack(p%Vars%y, p%iVarHubLoad, y%HubLoad, op) +! call MV_Pack(p%Vars%y, p%iVarTFinLoad, y%TFinLoad, op) +! call MV_Pack(p%Vars%y, p%iVarTowerLoad, y%TowerLoad, op) +! do k = 1, p%NumBlades +! call MV_Pack(p%Vars%y, p%iVarBladeLoad(k), y%BladeLoad(k), op) +! end do +! if (PackWriteOutput) then +! do k = p%iVarWriteOutput, size(p%Vars%y) +! call MV_Pack(p%Vars%y, k, y%WriteOutput(p%Vars%y(k)%iUsr(1)), op) +! end do +! end if +! end subroutine + +! subroutine AD_UnpackOutputOP(p, op, y) +! type(RotParameterType), intent(in) :: p +! real(R8Ki), intent(in) :: op(:) +! type(RotOutputType), intent(out) :: y +! integer(IntKi) :: k +! call MV_Unpack(p%Vars%y, p%iVarNacelleLoad, op, y%NacelleLoad) +! call MV_Unpack(p%Vars%y, p%iVarHubLoad, op, y%HubLoad) +! call MV_Unpack(p%Vars%y, p%iVarTFinLoad, op, y%TFinLoad) +! call MV_Unpack(p%Vars%y, p%iVarTowerLoad, op, y%TowerLoad) +! do k = 1, p%NumBlades +! call MV_Unpack(p%Vars%y, p%iVarBladeLoad(k), op, y%BladeLoad(k)) +! end do +! do k = p%iVarWriteOutput, size(p%Vars%y) +! call MV_Unpack(p%Vars%y, k, op, y%WriteOutput(p%Vars%y(k)%iUsr(1))) +! end do +! end subroutine END MODULE AeroDyn diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 5870303b6c..af4460c8a0 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -48,6 +48,9 @@ param ^ - IntKi APM_LiftingLine - 3 - "Use the bl # if more than AD_MaxBl_Out blades are used in the simulation, not all channels will have output information for the "extra" blades. # Also, the AD input file will require more lines for the additional blades. param ^ - IntKi AD_MaxBl_Out - 3 - "Maximum number of blades for information output (or linearization)" - +param ^ - IntKi AD_u_HWindSpeed - -1 - "DatLoc number for HWindSpeed extended input" - +param ^ - IntKi AD_u_PLExp - -2 - "DatLoc number for PLExp extended input" - +param ^ - IntKi AD_u_PropagationDir - -3 - "DatLoc number for PropagationDir extended input" - # Tail Fin parameters typedef ^ TFinParameterType IntKi TFinMod - - 0 "Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based}" (switch) @@ -294,24 +297,6 @@ typedef ^ AD_InflowType RotInflowType RotInflow {:} - - "Inflow on rotor" - # Parameters for each rotor typedef ^ RotParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ RotParameterType IntKi iVarDBEMT - 0 - "" - -typedef ^ RotParameterType IntKi iVarUA - 0 - "" - -typedef ^ RotParameterType IntKi iVarNacelleMotion - 0 - "" - -typedef ^ RotParameterType IntKi iVarHubMotion - 0 - "" - -typedef ^ RotParameterType IntKi iVarTFinMotion - 0 - "" - -typedef ^ RotParameterType IntKi iVarTowerMotion - 0 - "" - -typedef ^ RotParameterType IntKi iVarBladeRootMotion {:} - - "" - -typedef ^ RotParameterType IntKi iVarBladeMotion {:} - - "" - -typedef ^ RotParameterType IntKi iVarUserProp {:} - - "" - -typedef ^ RotParameterType IntKi iVarHWindSpeed - - - "" - -typedef ^ RotParameterType IntKi iVarPLexp - - - "" - -typedef ^ RotParameterType IntKi iVarPropagationDir - - - "" - -typedef ^ RotParameterType IntKi iVarNacelleLoad - 0 - "" - -typedef ^ RotParameterType IntKi iVarHubLoad - 0 - "" - -typedef ^ RotParameterType IntKi iVarTFinLoad - 0 - "" - -typedef ^ RotParameterType IntKi iVarTowerLoad - 0 - "" - -typedef ^ RotParameterType IntKi iVarBladeLoad {:} - - "" - -typedef ^ RotParameterType IntKi iVarWriteOutput - 0 - "" - typedef ^ RotParameterType IntKi NumBlades - - - "Number of blades on the turbine" - typedef ^ RotParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - typedef ^ RotParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 676b8ff491..523a49a718 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -58,17 +58,9 @@ MODULE AeroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_Polar = 2 ! Use staggered polar grid for momentum balance in each annulus [-] INTEGER(IntKi), PUBLIC, PARAMETER :: APM_LiftingLine = 3 ! Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_NacelleMotion = 1 ! Mesh number for AD AD_u_rotors_NacelleMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_TowerMotion = 2 ! Mesh number for AD AD_u_rotors_TowerMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_HubMotion = 3 ! Mesh number for AD AD_u_rotors_HubMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_BladeRootMotion = 4 ! Mesh number for AD AD_u_rotors_BladeRootMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_BladeMotion = 5 ! Mesh number for AD AD_u_rotors_BladeMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_rotors_TFinMotion = 6 ! Mesh number for AD AD_u_rotors_TFinMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_NacelleLoad = 7 ! Mesh number for AD AD_y_rotors_NacelleLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_HubLoad = 8 ! Mesh number for AD AD_y_rotors_HubLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_TowerLoad = 9 ! Mesh number for AD AD_y_rotors_TowerLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_BladeLoad = 10 ! Mesh number for AD AD_y_rotors_BladeLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_y_rotors_TFinLoad = 11 ! Mesh number for AD AD_y_rotors_TFinLoad mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_HWindSpeed = -1 ! DatLoc number for HWindSpeed extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_PLExp = -2 ! DatLoc number for PLExp extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_PropagationDir = -3 ! DatLoc number for PropagationDir extended input [-] ! ========= TFinParameterType ======= TYPE, PUBLIC :: TFinParameterType INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] @@ -350,24 +342,6 @@ MODULE AeroDyn_Types ! ========= RotParameterType ======= TYPE, PUBLIC :: RotParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarDBEMT = 0 !< [-] - INTEGER(IntKi) :: iVarUA = 0 !< [-] - INTEGER(IntKi) :: iVarNacelleMotion = 0 !< [-] - INTEGER(IntKi) :: iVarHubMotion = 0 !< [-] - INTEGER(IntKi) :: iVarTFinMotion = 0 !< [-] - INTEGER(IntKi) :: iVarTowerMotion = 0 !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeRootMotion !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeMotion !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarUserProp !< [-] - INTEGER(IntKi) :: iVarHWindSpeed = 0_IntKi !< [-] - INTEGER(IntKi) :: iVarPLexp = 0_IntKi !< [-] - INTEGER(IntKi) :: iVarPropagationDir = 0_IntKi !< [-] - INTEGER(IntKi) :: iVarNacelleLoad = 0 !< [-] - INTEGER(IntKi) :: iVarHubLoad = 0 !< [-] - INTEGER(IntKi) :: iVarTFinLoad = 0 !< [-] - INTEGER(IntKi) :: iVarTowerLoad = 0 !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeLoad !< [-] - INTEGER(IntKi) :: iVarWriteOutput = 0 !< [-] INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of nodes on the tower [-] @@ -568,7 +542,28 @@ MODULE AeroDyn_Types TYPE(AD_InflowType) , DIMENSION(:), ALLOCATABLE :: Inflow !< Inflow storage (size of u for history of inputs) [-] END TYPE AD_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: AD_x_BEMT_UA_element_x = 1 ! AD%BEMT%UA%element(DL%i1, DL%i2)%x + integer(IntKi), public, parameter :: AD_x_BEMT_DBEMT_element_vind = 2 ! AD%BEMT%DBEMT%element(DL%i1, DL%i2)%vind + integer(IntKi), public, parameter :: AD_x_BEMT_DBEMT_element_vind_1 = 3 ! AD%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1 + integer(IntKi), public, parameter :: AD_x_BEMT_V_w = 4 ! AD%BEMT%V_w + integer(IntKi), public, parameter :: AD_x_AA_DummyContState = 5 ! AD%AA%DummyContState + integer(IntKi), public, parameter :: AD_z_BEMT_phi = 6 ! AD%BEMT%phi + integer(IntKi), public, parameter :: AD_z_AA_DummyConstrState = 7 ! AD%AA%DummyConstrState + integer(IntKi), public, parameter :: AD_u_NacelleMotion = 8 ! AD%NacelleMotion + integer(IntKi), public, parameter :: AD_u_TowerMotion = 9 ! AD%TowerMotion + integer(IntKi), public, parameter :: AD_u_HubMotion = 10 ! AD%HubMotion + integer(IntKi), public, parameter :: AD_u_BladeRootMotion = 11 ! AD%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: AD_u_BladeMotion = 12 ! AD%BladeMotion(DL%i1) + integer(IntKi), public, parameter :: AD_u_TFinMotion = 13 ! AD%TFinMotion + integer(IntKi), public, parameter :: AD_u_UserProp = 14 ! AD%UserProp + integer(IntKi), public, parameter :: AD_y_NacelleLoad = 15 ! AD%NacelleLoad + integer(IntKi), public, parameter :: AD_y_HubLoad = 16 ! AD%HubLoad + integer(IntKi), public, parameter :: AD_y_TowerLoad = 17 ! AD%TowerLoad + integer(IntKi), public, parameter :: AD_y_BladeLoad = 18 ! AD%BladeLoad(DL%i1) + integer(IntKi), public, parameter :: AD_y_TFinLoad = 19 ! AD%TFinLoad + integer(IntKi), public, parameter :: AD_y_WriteOutput = 20 ! AD%WriteOutput + +contains subroutine AD_CopyTFinParameterType(SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg) type(TFinParameterType), intent(in) :: SrcTFinParameterTypeData @@ -3417,68 +3412,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstRotParameterTypeData%iVarDBEMT = SrcRotParameterTypeData%iVarDBEMT - DstRotParameterTypeData%iVarUA = SrcRotParameterTypeData%iVarUA - DstRotParameterTypeData%iVarNacelleMotion = SrcRotParameterTypeData%iVarNacelleMotion - DstRotParameterTypeData%iVarHubMotion = SrcRotParameterTypeData%iVarHubMotion - DstRotParameterTypeData%iVarTFinMotion = SrcRotParameterTypeData%iVarTFinMotion - DstRotParameterTypeData%iVarTowerMotion = SrcRotParameterTypeData%iVarTowerMotion - if (allocated(SrcRotParameterTypeData%iVarBladeRootMotion)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeRootMotion, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarBladeRootMotion)) then - allocate(DstRotParameterTypeData%iVarBladeRootMotion(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeRootMotion.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%iVarBladeRootMotion = SrcRotParameterTypeData%iVarBladeRootMotion - end if - if (allocated(SrcRotParameterTypeData%iVarBladeMotion)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeMotion, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarBladeMotion)) then - allocate(DstRotParameterTypeData%iVarBladeMotion(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeMotion.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%iVarBladeMotion = SrcRotParameterTypeData%iVarBladeMotion - end if - if (allocated(SrcRotParameterTypeData%iVarUserProp)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarUserProp, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarUserProp)) then - allocate(DstRotParameterTypeData%iVarUserProp(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarUserProp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%iVarUserProp = SrcRotParameterTypeData%iVarUserProp - end if - DstRotParameterTypeData%iVarHWindSpeed = SrcRotParameterTypeData%iVarHWindSpeed - DstRotParameterTypeData%iVarPLexp = SrcRotParameterTypeData%iVarPLexp - DstRotParameterTypeData%iVarPropagationDir = SrcRotParameterTypeData%iVarPropagationDir - DstRotParameterTypeData%iVarNacelleLoad = SrcRotParameterTypeData%iVarNacelleLoad - DstRotParameterTypeData%iVarHubLoad = SrcRotParameterTypeData%iVarHubLoad - DstRotParameterTypeData%iVarTFinLoad = SrcRotParameterTypeData%iVarTFinLoad - DstRotParameterTypeData%iVarTowerLoad = SrcRotParameterTypeData%iVarTowerLoad - if (allocated(SrcRotParameterTypeData%iVarBladeLoad)) then - LB(1:1) = lbound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%iVarBladeLoad, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%iVarBladeLoad)) then - allocate(DstRotParameterTypeData%iVarBladeLoad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%iVarBladeLoad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotParameterTypeData%iVarBladeLoad = SrcRotParameterTypeData%iVarBladeLoad - end if - DstRotParameterTypeData%iVarWriteOutput = SrcRotParameterTypeData%iVarWriteOutput DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds @@ -3795,18 +3728,6 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) deallocate(RotParameterTypeData%Vars) RotParameterTypeData%Vars => null() end if - if (allocated(RotParameterTypeData%iVarBladeRootMotion)) then - deallocate(RotParameterTypeData%iVarBladeRootMotion) - end if - if (allocated(RotParameterTypeData%iVarBladeMotion)) then - deallocate(RotParameterTypeData%iVarBladeMotion) - end if - if (allocated(RotParameterTypeData%iVarUserProp)) then - deallocate(RotParameterTypeData%iVarUserProp) - end if - if (allocated(RotParameterTypeData%iVarBladeLoad)) then - deallocate(RotParameterTypeData%iVarBladeLoad) - end if if (allocated(RotParameterTypeData%TwrDiam)) then deallocate(RotParameterTypeData%TwrDiam) end if @@ -3902,24 +3823,6 @@ subroutine AD_PackRotParameterType(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarDBEMT) - call RegPack(RF, InData%iVarUA) - call RegPack(RF, InData%iVarNacelleMotion) - call RegPack(RF, InData%iVarHubMotion) - call RegPack(RF, InData%iVarTFinMotion) - call RegPack(RF, InData%iVarTowerMotion) - call RegPackAlloc(RF, InData%iVarBladeRootMotion) - call RegPackAlloc(RF, InData%iVarBladeMotion) - call RegPackAlloc(RF, InData%iVarUserProp) - call RegPack(RF, InData%iVarHWindSpeed) - call RegPack(RF, InData%iVarPLexp) - call RegPack(RF, InData%iVarPropagationDir) - call RegPack(RF, InData%iVarNacelleLoad) - call RegPack(RF, InData%iVarHubLoad) - call RegPack(RF, InData%iVarTFinLoad) - call RegPack(RF, InData%iVarTowerLoad) - call RegPackAlloc(RF, InData%iVarBladeLoad) - call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%NumBlades) call RegPack(RF, InData%NumBlNds) call RegPack(RF, InData%NumTwrNds) @@ -4031,24 +3934,6 @@ subroutine AD_UnPackRotParameterType(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarDBEMT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarUA); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarNacelleMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHubMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTFinMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTowerMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladeRootMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladeMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarUserProp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHWindSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPLexp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPropagationDir); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarNacelleLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHubLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTFinLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTowerLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladeLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return @@ -6830,81 +6715,265 @@ SUBROUTINE AD_InflowType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, END SUBROUTINE function AD_InputMeshPointer(u, ML) result(Mesh) - type(AD_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(RotInputType), target, intent(in) :: u + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) - case (AD_u_rotors_NacelleMotion) - Mesh => u%rotors(ML%i1)%NacelleMotion - case (AD_u_rotors_TowerMotion) - Mesh => u%rotors(ML%i1)%TowerMotion - case (AD_u_rotors_HubMotion) - Mesh => u%rotors(ML%i1)%HubMotion - case (AD_u_rotors_BladeRootMotion) - Mesh => u%rotors(ML%i1)%BladeRootMotion(ML%i2) - case (AD_u_rotors_BladeMotion) - Mesh => u%rotors(ML%i1)%BladeMotion(ML%i2) - case (AD_u_rotors_TFinMotion) - Mesh => u%rotors(ML%i1)%TFinMotion + case (AD_u_NacelleMotion) + Mesh => u%NacelleMotion + case (AD_u_TowerMotion) + Mesh => u%TowerMotion + case (AD_u_HubMotion) + Mesh => u%HubMotion + case (AD_u_BladeRootMotion) + Mesh => u%BladeRootMotion(ML%i1) + case (AD_u_BladeMotion) + Mesh => u%BladeMotion(ML%i1) + case (AD_u_TFinMotion) + Mesh => u%TFinMotion end select end function function AD_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) - case (AD_u_rotors_NacelleMotion) - Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%NacelleMotion" - case (AD_u_rotors_TowerMotion) - Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%TowerMotion" - case (AD_u_rotors_HubMotion) - Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%HubMotion" - case (AD_u_rotors_BladeRootMotion) - Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%BladeRootMotion("//trim(Num2LStr(ML%i2))//")" - case (AD_u_rotors_BladeMotion) - Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%BladeMotion("//trim(Num2LStr(ML%i2))//")" - case (AD_u_rotors_TFinMotion) - Name = "u%rotors("//trim(Num2LStr(ML%i1))//")%TFinMotion" + case (AD_u_NacelleMotion) + Name = "u%NacelleMotion" + case (AD_u_TowerMotion) + Name = "u%TowerMotion" + case (AD_u_HubMotion) + Name = "u%HubMotion" + case (AD_u_BladeRootMotion) + Name = "u%BladeRootMotion("//trim(Num2LStr(ML%i1))//")" + case (AD_u_BladeMotion) + Name = "u%BladeMotion("//trim(Num2LStr(ML%i1))//")" + case (AD_u_TFinMotion) + Name = "u%TFinMotion" end select end function function AD_OutputMeshPointer(y, ML) result(Mesh) - type(AD_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(RotOutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) - case (AD_y_rotors_NacelleLoad) - Mesh => y%rotors(ML%i1)%NacelleLoad - case (AD_y_rotors_HubLoad) - Mesh => y%rotors(ML%i1)%HubLoad - case (AD_y_rotors_TowerLoad) - Mesh => y%rotors(ML%i1)%TowerLoad - case (AD_y_rotors_BladeLoad) - Mesh => y%rotors(ML%i1)%BladeLoad(ML%i2) - case (AD_y_rotors_TFinLoad) - Mesh => y%rotors(ML%i1)%TFinLoad + case (AD_y_NacelleLoad) + Mesh => y%NacelleLoad + case (AD_y_HubLoad) + Mesh => y%HubLoad + case (AD_y_TowerLoad) + Mesh => y%TowerLoad + case (AD_y_BladeLoad) + Mesh => y%BladeLoad(ML%i1) + case (AD_y_TFinLoad) + Mesh => y%TFinLoad end select end function function AD_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) - case (AD_y_rotors_NacelleLoad) - Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%NacelleLoad" - case (AD_y_rotors_HubLoad) - Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%HubLoad" - case (AD_y_rotors_TowerLoad) - Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%TowerLoad" - case (AD_y_rotors_BladeLoad) - Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%BladeLoad("//trim(Num2LStr(ML%i2))//")" - case (AD_y_rotors_TFinLoad) - Name = "y%rotors("//trim(Num2LStr(ML%i1))//")%TFinLoad" + case (AD_y_NacelleLoad) + Name = "y%NacelleLoad" + case (AD_y_HubLoad) + Name = "y%HubLoad" + case (AD_y_TowerLoad) + Name = "y%TowerLoad" + case (AD_y_BladeLoad) + Name = "y%BladeLoad("//trim(Num2LStr(ML%i1))//")" + case (AD_y_TFinLoad) + Name = "y%TFinLoad" end select end function + +subroutine AD_PackContStateAry(Vars, x, ValAry) + type(RotContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (AD_x_BEMT_UA_element_x) + call MV_Pack2(Var, x%BEMT%UA%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + call MV_Pack2(Var, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + call MV_Pack2(Var, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array + case (AD_x_BEMT_V_w) + call MV_Pack2(Var, x%BEMT%V_w, ValAry) ! Rank 1 Array + case (AD_x_AA_DummyContState) + call MV_Pack2(Var, x%AA%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AD_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (AD_x_BEMT_UA_element_x) + call MV_Unpack2(Var, ValAry, x%BEMT%UA%element(DL%i1, DL%i2)%x) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + call MV_Unpack2(Var, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + call MV_Unpack2(Var, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array + case (AD_x_BEMT_V_w) + call MV_Unpack2(Var, ValAry, x%BEMT%V_w) ! Rank 1 Array + case (AD_x_AA_DummyContState) + call MV_Unpack2(Var, ValAry, x%AA%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AD_PackConstrStateAry(Vars, z, ValAry) + type(RotConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (AD_z_BEMT_phi) + call MV_Pack2(Var, z%BEMT%phi, ValAry) ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + call MV_Pack2(Var, z%AA%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AD_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (AD_z_BEMT_phi) + call MV_Unpack2(Var, ValAry, z%BEMT%phi) ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%AA%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AD_PackInputAry(Vars, u, ValAry) + type(RotInputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (AD_u_NacelleMotion) + call MV_Pack2(Var, u%NacelleMotion, ValAry) ! Mesh + case (AD_u_TowerMotion) + call MV_Pack2(Var, u%TowerMotion, ValAry) ! Mesh + case (AD_u_HubMotion) + call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh + case (AD_u_BladeRootMotion) + call MV_Pack2(Var, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (AD_u_BladeMotion) + call MV_Pack2(Var, u%BladeMotion(DL%i1), ValAry) ! Mesh + case (AD_u_TFinMotion) + call MV_Pack2(Var, u%TFinMotion, ValAry) ! Mesh + case (AD_u_UserProp) + call MV_Pack2(Var, u%UserProp, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine AD_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotInputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (AD_u_NacelleMotion) + call MV_Unpack2(Var, ValAry, u%NacelleMotion) ! Mesh + case (AD_u_TowerMotion) + call MV_Unpack2(Var, ValAry, u%TowerMotion) ! Mesh + case (AD_u_HubMotion) + call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh + case (AD_u_BladeRootMotion) + call MV_Unpack2(Var, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (AD_u_BladeMotion) + call MV_Unpack2(Var, ValAry, u%BladeMotion(DL%i1)) ! Mesh + case (AD_u_TFinMotion) + call MV_Unpack2(Var, ValAry, u%TFinMotion) ! Mesh + case (AD_u_UserProp) + call MV_Unpack2(Var, ValAry, u%UserProp) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine AD_PackOutputAry(Vars, y, ValAry) + type(RotOutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (AD_y_NacelleLoad) + call MV_Pack2(Var, y%NacelleLoad, ValAry) ! Mesh + case (AD_y_HubLoad) + call MV_Pack2(Var, y%HubLoad, ValAry) ! Mesh + case (AD_y_TowerLoad) + call MV_Pack2(Var, y%TowerLoad, ValAry) ! Mesh + case (AD_y_BladeLoad) + call MV_Pack2(Var, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (AD_y_TFinLoad) + call MV_Pack2(Var, y%TFinLoad, ValAry) ! Mesh + case (AD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine AD_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotOutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (AD_y_NacelleLoad) + call MV_Unpack2(Var, ValAry, y%NacelleLoad) ! Mesh + case (AD_y_HubLoad) + call MV_Unpack2(Var, ValAry, y%HubLoad) ! Mesh + case (AD_y_TowerLoad) + call MV_Unpack2(Var, ValAry, y%TowerLoad) ! Mesh + case (AD_y_BladeLoad) + call MV_Unpack2(Var, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (AD_y_TFinLoad) + call MV_Unpack2(Var, ValAry, y%TFinLoad) ! Mesh + case (AD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE AeroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 59f4c8e4c6..99c6acef2a 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -198,7 +198,20 @@ MODULE AirfoilInfo_Types REAL(ReKi) :: FullyAttached = 0. !< fully attached cn or cl polar function (used for UA models) [-] END TYPE AFI_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: AFI_u_AoA = 1 ! AFI%AoA + integer(IntKi), public, parameter :: AFI_u_UserProp = 2 ! AFI%UserProp + integer(IntKi), public, parameter :: AFI_u_Re = 3 ! AFI%Re + integer(IntKi), public, parameter :: AFI_y_Cl = 4 ! AFI%Cl + integer(IntKi), public, parameter :: AFI_y_Cd = 5 ! AFI%Cd + integer(IntKi), public, parameter :: AFI_y_Cm = 6 ! AFI%Cm + integer(IntKi), public, parameter :: AFI_y_Cpmin = 7 ! AFI%Cpmin + integer(IntKi), public, parameter :: AFI_y_Cd0 = 8 ! AFI%Cd0 + integer(IntKi), public, parameter :: AFI_y_Cm0 = 9 ! AFI%Cm0 + integer(IntKi), public, parameter :: AFI_y_f_st = 10 ! AFI%f_st + integer(IntKi), public, parameter :: AFI_y_FullySeparate = 11 ! AFI%FullySeparate + integer(IntKi), public, parameter :: AFI_y_FullyAttached = 12 ! AFI%FullyAttached + +contains subroutine AFI_CopyUA_BL_Type(SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, ErrStat, ErrMsg) type(AFI_UA_BL_Type), intent(in) :: SrcUA_BL_TypeData @@ -1450,7 +1463,7 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat function AFI_InputMeshPointer(u, ML) result(Mesh) type(AFI_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1458,7 +1471,7 @@ function AFI_InputMeshPointer(u, ML) result(Mesh) end function function AFI_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1467,7 +1480,7 @@ function AFI_InputMeshName(ML) result(Name) function AFI_OutputMeshPointer(y, ML) result(Mesh) type(AFI_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1475,11 +1488,111 @@ function AFI_OutputMeshPointer(y, ML) result(Mesh) end function function AFI_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine AFI_PackInputAry(Vars, u, ValAry) + type(AFI_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (AFI_u_AoA) + call MV_Pack2(Var, u%AoA, ValAry) ! Scalar + case (AFI_u_UserProp) + call MV_Pack2(Var, u%UserProp, ValAry) ! Scalar + case (AFI_u_Re) + call MV_Pack2(Var, u%Re, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AFI_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (AFI_u_AoA) + call MV_Unpack2(Var, ValAry, u%AoA) ! Scalar + case (AFI_u_UserProp) + call MV_Unpack2(Var, ValAry, u%UserProp) ! Scalar + case (AFI_u_Re) + call MV_Unpack2(Var, ValAry, u%Re) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AFI_PackOutputAry(Vars, y, ValAry) + type(AFI_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (AFI_y_Cl) + call MV_Pack2(Var, y%Cl, ValAry) ! Scalar + case (AFI_y_Cd) + call MV_Pack2(Var, y%Cd, ValAry) ! Scalar + case (AFI_y_Cm) + call MV_Pack2(Var, y%Cm, ValAry) ! Scalar + case (AFI_y_Cpmin) + call MV_Pack2(Var, y%Cpmin, ValAry) ! Scalar + case (AFI_y_Cd0) + call MV_Pack2(Var, y%Cd0, ValAry) ! Scalar + case (AFI_y_Cm0) + call MV_Pack2(Var, y%Cm0, ValAry) ! Scalar + case (AFI_y_f_st) + call MV_Pack2(Var, y%f_st, ValAry) ! Scalar + case (AFI_y_FullySeparate) + call MV_Pack2(Var, y%FullySeparate, ValAry) ! Scalar + case (AFI_y_FullyAttached) + call MV_Pack2(Var, y%FullyAttached, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AFI_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (AFI_y_Cl) + call MV_Unpack2(Var, ValAry, y%Cl) ! Scalar + case (AFI_y_Cd) + call MV_Unpack2(Var, ValAry, y%Cd) ! Scalar + case (AFI_y_Cm) + call MV_Unpack2(Var, ValAry, y%Cm) ! Scalar + case (AFI_y_Cpmin) + call MV_Unpack2(Var, ValAry, y%Cpmin) ! Scalar + case (AFI_y_Cd0) + call MV_Unpack2(Var, ValAry, y%Cd0) ! Scalar + case (AFI_y_Cm0) + call MV_Unpack2(Var, ValAry, y%Cm0) ! Scalar + case (AFI_y_f_st) + call MV_Unpack2(Var, ValAry, y%f_st) ! Scalar + case (AFI_y_FullySeparate) + call MV_Unpack2(Var, ValAry, y%FullySeparate) ! Scalar + case (AFI_y_FullyAttached) + call MV_Unpack2(Var, ValAry, y%FullyAttached) ! Scalar + end select + end associate + end do +end subroutine END MODULE AirfoilInfo_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index a30b8102dc..6dac20d8f4 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -230,7 +230,54 @@ MODULE BEMT_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cpmin !< min Cpressure [-] END TYPE BEMT_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: BEMT_x_UA_element_x = 1 ! BEMT%UA%element(DL%i1, DL%i2)%x + integer(IntKi), public, parameter :: BEMT_x_DBEMT_element_vind = 2 ! BEMT%DBEMT%element(DL%i1, DL%i2)%vind + integer(IntKi), public, parameter :: BEMT_x_DBEMT_element_vind_1 = 3 ! BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1 + integer(IntKi), public, parameter :: BEMT_x_V_w = 4 ! BEMT%V_w + integer(IntKi), public, parameter :: BEMT_z_phi = 5 ! BEMT%phi + integer(IntKi), public, parameter :: BEMT_u_theta = 6 ! BEMT%theta + integer(IntKi), public, parameter :: BEMT_u_chi0 = 7 ! BEMT%chi0 + integer(IntKi), public, parameter :: BEMT_u_psiSkewOffset = 8 ! BEMT%psiSkewOffset + integer(IntKi), public, parameter :: BEMT_u_psi_s = 9 ! BEMT%psi_s + integer(IntKi), public, parameter :: BEMT_u_omega = 10 ! BEMT%omega + integer(IntKi), public, parameter :: BEMT_u_TSR = 11 ! BEMT%TSR + integer(IntKi), public, parameter :: BEMT_u_Vx = 12 ! BEMT%Vx + integer(IntKi), public, parameter :: BEMT_u_Vy = 13 ! BEMT%Vy + integer(IntKi), public, parameter :: BEMT_u_Vz = 14 ! BEMT%Vz + integer(IntKi), public, parameter :: BEMT_u_omega_z = 15 ! BEMT%omega_z + integer(IntKi), public, parameter :: BEMT_u_xVelCorr = 16 ! BEMT%xVelCorr + integer(IntKi), public, parameter :: BEMT_u_rLocal = 17 ! BEMT%rLocal + integer(IntKi), public, parameter :: BEMT_u_Un_disk = 18 ! BEMT%Un_disk + integer(IntKi), public, parameter :: BEMT_u_V0 = 19 ! BEMT%V0 + integer(IntKi), public, parameter :: BEMT_u_x_hat_disk = 20 ! BEMT%x_hat_disk + integer(IntKi), public, parameter :: BEMT_u_UserProp = 21 ! BEMT%UserProp + integer(IntKi), public, parameter :: BEMT_u_CantAngle = 22 ! BEMT%CantAngle + integer(IntKi), public, parameter :: BEMT_u_drdz = 23 ! BEMT%drdz + integer(IntKi), public, parameter :: BEMT_u_toeAngle = 24 ! BEMT%toeAngle + integer(IntKi), public, parameter :: BEMT_y_Vrel = 25 ! BEMT%Vrel + integer(IntKi), public, parameter :: BEMT_y_phi = 26 ! BEMT%phi + integer(IntKi), public, parameter :: BEMT_y_axInduction = 27 ! BEMT%axInduction + integer(IntKi), public, parameter :: BEMT_y_tanInduction = 28 ! BEMT%tanInduction + integer(IntKi), public, parameter :: BEMT_y_axInduction_qs = 29 ! BEMT%axInduction_qs + integer(IntKi), public, parameter :: BEMT_y_tanInduction_qs = 30 ! BEMT%tanInduction_qs + integer(IntKi), public, parameter :: BEMT_y_k = 31 ! BEMT%k + integer(IntKi), public, parameter :: BEMT_y_k_p = 32 ! BEMT%k_p + integer(IntKi), public, parameter :: BEMT_y_F = 33 ! BEMT%F + integer(IntKi), public, parameter :: BEMT_y_Re = 34 ! BEMT%Re + integer(IntKi), public, parameter :: BEMT_y_AOA = 35 ! BEMT%AOA + integer(IntKi), public, parameter :: BEMT_y_Cx = 36 ! BEMT%Cx + integer(IntKi), public, parameter :: BEMT_y_Cy = 37 ! BEMT%Cy + integer(IntKi), public, parameter :: BEMT_y_Cz = 38 ! BEMT%Cz + integer(IntKi), public, parameter :: BEMT_y_Cmx = 39 ! BEMT%Cmx + integer(IntKi), public, parameter :: BEMT_y_Cmy = 40 ! BEMT%Cmy + integer(IntKi), public, parameter :: BEMT_y_Cmz = 41 ! BEMT%Cmz + integer(IntKi), public, parameter :: BEMT_y_Cm = 42 ! BEMT%Cm + integer(IntKi), public, parameter :: BEMT_y_Cl = 43 ! BEMT%Cl + integer(IntKi), public, parameter :: BEMT_y_Cd = 44 ! BEMT%Cd + integer(IntKi), public, parameter :: BEMT_y_chi = 45 ! BEMT%chi + integer(IntKi), public, parameter :: BEMT_y_Cpmin = 46 ! BEMT%Cpmin + +contains subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(BEMT_InitInputType), intent(in) :: SrcInitInputData @@ -2655,7 +2702,7 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E function BEMT_InputMeshPointer(u, ML) result(Mesh) type(BEMT_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2663,7 +2710,7 @@ function BEMT_InputMeshPointer(u, ML) result(Mesh) end function function BEMT_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2672,7 +2719,7 @@ function BEMT_InputMeshName(ML) result(Name) function BEMT_OutputMeshPointer(y, ML) result(Mesh) type(BEMT_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2680,11 +2727,299 @@ function BEMT_OutputMeshPointer(y, ML) result(Mesh) end function function BEMT_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine BEMT_PackContStateAry(Vars, x, ValAry) + type(BEMT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (BEMT_x_UA_element_x) + call MV_Pack2(Var, x%UA%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + call MV_Pack2(Var, x%DBEMT%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + call MV_Pack2(Var, x%DBEMT%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array + case (BEMT_x_V_w) + call MV_Pack2(Var, x%V_w, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine BEMT_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (BEMT_x_UA_element_x) + call MV_Unpack2(Var, ValAry, x%UA%element(DL%i1, DL%i2)%x) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + call MV_Unpack2(Var, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + call MV_Unpack2(Var, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array + case (BEMT_x_V_w) + call MV_Unpack2(Var, ValAry, x%V_w) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine BEMT_PackConstrStateAry(Vars, z, ValAry) + type(BEMT_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (BEMT_z_phi) + call MV_Pack2(Var, z%phi, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine BEMT_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (BEMT_z_phi) + call MV_Unpack2(Var, ValAry, z%phi) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine BEMT_PackInputAry(Vars, u, ValAry) + type(BEMT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (BEMT_u_theta) + call MV_Pack2(Var, u%theta, ValAry) ! Rank 2 Array + case (BEMT_u_chi0) + call MV_Pack2(Var, u%chi0, ValAry) ! Scalar + case (BEMT_u_psiSkewOffset) + call MV_Pack2(Var, u%psiSkewOffset, ValAry) ! Scalar + case (BEMT_u_psi_s) + call MV_Pack2(Var, u%psi_s, ValAry) ! Rank 1 Array + case (BEMT_u_omega) + call MV_Pack2(Var, u%omega, ValAry) ! Scalar + case (BEMT_u_TSR) + call MV_Pack2(Var, u%TSR, ValAry) ! Scalar + case (BEMT_u_Vx) + call MV_Pack2(Var, u%Vx, ValAry) ! Rank 2 Array + case (BEMT_u_Vy) + call MV_Pack2(Var, u%Vy, ValAry) ! Rank 2 Array + case (BEMT_u_Vz) + call MV_Pack2(Var, u%Vz, ValAry) ! Rank 2 Array + case (BEMT_u_omega_z) + call MV_Pack2(Var, u%omega_z, ValAry) ! Rank 2 Array + case (BEMT_u_xVelCorr) + call MV_Pack2(Var, u%xVelCorr, ValAry) ! Rank 2 Array + case (BEMT_u_rLocal) + call MV_Pack2(Var, u%rLocal, ValAry) ! Rank 2 Array + case (BEMT_u_Un_disk) + call MV_Pack2(Var, u%Un_disk, ValAry) ! Scalar + case (BEMT_u_V0) + call MV_Pack2(Var, u%V0, ValAry) ! Rank 1 Array + case (BEMT_u_x_hat_disk) + call MV_Pack2(Var, u%x_hat_disk, ValAry) ! Rank 1 Array + case (BEMT_u_UserProp) + call MV_Pack2(Var, u%UserProp, ValAry) ! Rank 2 Array + case (BEMT_u_CantAngle) + call MV_Pack2(Var, u%CantAngle, ValAry) ! Rank 2 Array + case (BEMT_u_drdz) + call MV_Pack2(Var, u%drdz, ValAry) ! Rank 2 Array + case (BEMT_u_toeAngle) + call MV_Pack2(Var, u%toeAngle, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine BEMT_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (BEMT_u_theta) + call MV_Unpack2(Var, ValAry, u%theta) ! Rank 2 Array + case (BEMT_u_chi0) + call MV_Unpack2(Var, ValAry, u%chi0) ! Scalar + case (BEMT_u_psiSkewOffset) + call MV_Unpack2(Var, ValAry, u%psiSkewOffset) ! Scalar + case (BEMT_u_psi_s) + call MV_Unpack2(Var, ValAry, u%psi_s) ! Rank 1 Array + case (BEMT_u_omega) + call MV_Unpack2(Var, ValAry, u%omega) ! Scalar + case (BEMT_u_TSR) + call MV_Unpack2(Var, ValAry, u%TSR) ! Scalar + case (BEMT_u_Vx) + call MV_Unpack2(Var, ValAry, u%Vx) ! Rank 2 Array + case (BEMT_u_Vy) + call MV_Unpack2(Var, ValAry, u%Vy) ! Rank 2 Array + case (BEMT_u_Vz) + call MV_Unpack2(Var, ValAry, u%Vz) ! Rank 2 Array + case (BEMT_u_omega_z) + call MV_Unpack2(Var, ValAry, u%omega_z) ! Rank 2 Array + case (BEMT_u_xVelCorr) + call MV_Unpack2(Var, ValAry, u%xVelCorr) ! Rank 2 Array + case (BEMT_u_rLocal) + call MV_Unpack2(Var, ValAry, u%rLocal) ! Rank 2 Array + case (BEMT_u_Un_disk) + call MV_Unpack2(Var, ValAry, u%Un_disk) ! Scalar + case (BEMT_u_V0) + call MV_Unpack2(Var, ValAry, u%V0) ! Rank 1 Array + case (BEMT_u_x_hat_disk) + call MV_Unpack2(Var, ValAry, u%x_hat_disk) ! Rank 1 Array + case (BEMT_u_UserProp) + call MV_Unpack2(Var, ValAry, u%UserProp) ! Rank 2 Array + case (BEMT_u_CantAngle) + call MV_Unpack2(Var, ValAry, u%CantAngle) ! Rank 2 Array + case (BEMT_u_drdz) + call MV_Unpack2(Var, ValAry, u%drdz) ! Rank 2 Array + case (BEMT_u_toeAngle) + call MV_Unpack2(Var, ValAry, u%toeAngle) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine BEMT_PackOutputAry(Vars, y, ValAry) + type(BEMT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (BEMT_y_Vrel) + call MV_Pack2(Var, y%Vrel, ValAry) ! Rank 2 Array + case (BEMT_y_phi) + call MV_Pack2(Var, y%phi, ValAry) ! Rank 2 Array + case (BEMT_y_axInduction) + call MV_Pack2(Var, y%axInduction, ValAry) ! Rank 2 Array + case (BEMT_y_tanInduction) + call MV_Pack2(Var, y%tanInduction, ValAry) ! Rank 2 Array + case (BEMT_y_axInduction_qs) + call MV_Pack2(Var, y%axInduction_qs, ValAry) ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + call MV_Pack2(Var, y%tanInduction_qs, ValAry) ! Rank 2 Array + case (BEMT_y_k) + call MV_Pack2(Var, y%k, ValAry) ! Rank 2 Array + case (BEMT_y_k_p) + call MV_Pack2(Var, y%k_p, ValAry) ! Rank 2 Array + case (BEMT_y_F) + call MV_Pack2(Var, y%F, ValAry) ! Rank 2 Array + case (BEMT_y_Re) + call MV_Pack2(Var, y%Re, ValAry) ! Rank 2 Array + case (BEMT_y_AOA) + call MV_Pack2(Var, y%AOA, ValAry) ! Rank 2 Array + case (BEMT_y_Cx) + call MV_Pack2(Var, y%Cx, ValAry) ! Rank 2 Array + case (BEMT_y_Cy) + call MV_Pack2(Var, y%Cy, ValAry) ! Rank 2 Array + case (BEMT_y_Cz) + call MV_Pack2(Var, y%Cz, ValAry) ! Rank 2 Array + case (BEMT_y_Cmx) + call MV_Pack2(Var, y%Cmx, ValAry) ! Rank 2 Array + case (BEMT_y_Cmy) + call MV_Pack2(Var, y%Cmy, ValAry) ! Rank 2 Array + case (BEMT_y_Cmz) + call MV_Pack2(Var, y%Cmz, ValAry) ! Rank 2 Array + case (BEMT_y_Cm) + call MV_Pack2(Var, y%Cm, ValAry) ! Rank 2 Array + case (BEMT_y_Cl) + call MV_Pack2(Var, y%Cl, ValAry) ! Rank 2 Array + case (BEMT_y_Cd) + call MV_Pack2(Var, y%Cd, ValAry) ! Rank 2 Array + case (BEMT_y_chi) + call MV_Pack2(Var, y%chi, ValAry) ! Rank 2 Array + case (BEMT_y_Cpmin) + call MV_Pack2(Var, y%Cpmin, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine BEMT_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (BEMT_y_Vrel) + call MV_Unpack2(Var, ValAry, y%Vrel) ! Rank 2 Array + case (BEMT_y_phi) + call MV_Unpack2(Var, ValAry, y%phi) ! Rank 2 Array + case (BEMT_y_axInduction) + call MV_Unpack2(Var, ValAry, y%axInduction) ! Rank 2 Array + case (BEMT_y_tanInduction) + call MV_Unpack2(Var, ValAry, y%tanInduction) ! Rank 2 Array + case (BEMT_y_axInduction_qs) + call MV_Unpack2(Var, ValAry, y%axInduction_qs) ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + call MV_Unpack2(Var, ValAry, y%tanInduction_qs) ! Rank 2 Array + case (BEMT_y_k) + call MV_Unpack2(Var, ValAry, y%k) ! Rank 2 Array + case (BEMT_y_k_p) + call MV_Unpack2(Var, ValAry, y%k_p) ! Rank 2 Array + case (BEMT_y_F) + call MV_Unpack2(Var, ValAry, y%F) ! Rank 2 Array + case (BEMT_y_Re) + call MV_Unpack2(Var, ValAry, y%Re) ! Rank 2 Array + case (BEMT_y_AOA) + call MV_Unpack2(Var, ValAry, y%AOA) ! Rank 2 Array + case (BEMT_y_Cx) + call MV_Unpack2(Var, ValAry, y%Cx) ! Rank 2 Array + case (BEMT_y_Cy) + call MV_Unpack2(Var, ValAry, y%Cy) ! Rank 2 Array + case (BEMT_y_Cz) + call MV_Unpack2(Var, ValAry, y%Cz) ! Rank 2 Array + case (BEMT_y_Cmx) + call MV_Unpack2(Var, ValAry, y%Cmx) ! Rank 2 Array + case (BEMT_y_Cmy) + call MV_Unpack2(Var, ValAry, y%Cmy) ! Rank 2 Array + case (BEMT_y_Cmz) + call MV_Unpack2(Var, ValAry, y%Cmz) ! Rank 2 Array + case (BEMT_y_Cm) + call MV_Unpack2(Var, ValAry, y%Cm) ! Rank 2 Array + case (BEMT_y_Cl) + call MV_Unpack2(Var, ValAry, y%Cl) ! Rank 2 Array + case (BEMT_y_Cd) + call MV_Unpack2(Var, ValAry, y%Cd) ! Rank 2 Array + case (BEMT_y_chi) + call MV_Unpack2(Var, ValAry, y%chi) ! Rank 2 Array + case (BEMT_y_Cpmin) + call MV_Unpack2(Var, ValAry, y%Cpmin) ! Rank 2 Array + end select + end associate + end do +end subroutine END MODULE BEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 7312d4dcdd..75c8ece2ed 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -118,7 +118,17 @@ MODULE DBEMT_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: vind !< The filtered induced velocity, [1,i,j] is the axial induced velocity (-Vx*a) at node i on blade j and [2,i,j] is the tangential induced velocity (Vy*a') at node i on blade j [m/s] END TYPE DBEMT_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: DBEMT_x_element_vind = 1 ! DBEMT%element(DL%i1, DL%i2)%vind + integer(IntKi), public, parameter :: DBEMT_x_element_vind_1 = 2 ! DBEMT%element(DL%i1, DL%i2)%vind_1 + integer(IntKi), public, parameter :: DBEMT_z_DummyState = 3 ! DBEMT%DummyState + integer(IntKi), public, parameter :: DBEMT_u_AxInd_disk = 4 ! DBEMT%AxInd_disk + integer(IntKi), public, parameter :: DBEMT_u_Un_disk = 5 ! DBEMT%Un_disk + integer(IntKi), public, parameter :: DBEMT_u_R_disk = 6 ! DBEMT%R_disk + integer(IntKi), public, parameter :: DBEMT_u_element_vind_s = 7 ! DBEMT%element(DL%i1, DL%i2)%vind_s + integer(IntKi), public, parameter :: DBEMT_u_element_spanRatio = 8 ! DBEMT%element(DL%i1, DL%i2)%spanRatio + integer(IntKi), public, parameter :: DBEMT_y_vind = 9 ! DBEMT%vind + +contains subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(DBEMT_InitInputType), intent(in) :: SrcInitInputData @@ -1417,7 +1427,7 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, function DBEMT_InputMeshPointer(u, ML) result(Mesh) type(DBEMT_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1425,7 +1435,7 @@ function DBEMT_InputMeshPointer(u, ML) result(Mesh) end function function DBEMT_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1434,7 +1444,7 @@ function DBEMT_InputMeshName(ML) result(Name) function DBEMT_OutputMeshPointer(y, ML) result(Mesh) type(DBEMT_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1442,11 +1452,151 @@ function DBEMT_OutputMeshPointer(y, ML) result(Mesh) end function function DBEMT_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine DBEMT_PackContStateAry(Vars, x, ValAry) + type(DBEMT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (DBEMT_x_element_vind) + call MV_Pack2(Var, x%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + call MV_Pack2(Var, x%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine DBEMT_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (DBEMT_x_element_vind) + call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%vind) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine DBEMT_PackConstrStateAry(Vars, z, ValAry) + type(DBEMT_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (DBEMT_z_DummyState) + call MV_Pack2(Var, z%DummyState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine DBEMT_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (DBEMT_z_DummyState) + call MV_Unpack2(Var, ValAry, z%DummyState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine DBEMT_PackInputAry(Vars, u, ValAry) + type(DBEMT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (DBEMT_u_AxInd_disk) + call MV_Pack2(Var, u%AxInd_disk, ValAry) ! Scalar + case (DBEMT_u_Un_disk) + call MV_Pack2(Var, u%Un_disk, ValAry) ! Scalar + case (DBEMT_u_R_disk) + call MV_Pack2(Var, u%R_disk, ValAry) ! Scalar + case (DBEMT_u_element_vind_s) + call MV_Pack2(Var, u%element(DL%i1, DL%i2)%vind_s, ValAry) ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + call MV_Pack2(Var, u%element(DL%i1, DL%i2)%spanRatio, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine DBEMT_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (DBEMT_u_AxInd_disk) + call MV_Unpack2(Var, ValAry, u%AxInd_disk) ! Scalar + case (DBEMT_u_Un_disk) + call MV_Unpack2(Var, ValAry, u%Un_disk) ! Scalar + case (DBEMT_u_R_disk) + call MV_Unpack2(Var, ValAry, u%R_disk) ! Scalar + case (DBEMT_u_element_vind_s) + call MV_Unpack2(Var, ValAry, u%element(DL%i1, DL%i2)%vind_s) ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + call MV_Unpack2(Var, ValAry, u%element(DL%i1, DL%i2)%spanRatio) ! Scalar + end select + end associate + end do +end subroutine + +subroutine DBEMT_PackOutputAry(Vars, y, ValAry) + type(DBEMT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (DBEMT_y_vind) + call MV_Pack2(Var, y%vind, ValAry) ! Rank 3 Array + end select + end associate + end do +end subroutine + +subroutine DBEMT_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (DBEMT_y_vind) + call MV_Unpack2(Var, ValAry, y%vind) ! Rank 3 Array + end select + end associate + end do +end subroutine END MODULE DBEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index d06a5aebe9..4f3e7443ce 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -37,7 +37,6 @@ MODULE FVW_Types IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelocity = 1 ! Grid stores velocity field [-] INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelVorticity = 2 ! Grid stores velocity and vorticity [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FVW_u_WingsMesh = 1 ! Mesh number for FVW FVW_u_WingsMesh mesh [-] ! ========= GridOutType ======= TYPE, PUBLIC :: GridOutType CHARACTER(100) :: name !< Grid name [-] @@ -356,7 +355,24 @@ MODULE FVW_Types INTEGER(IntKi) :: Dummy = 0_IntKi !< Empty parameter to satisfy framework [-] END TYPE FVW_InitOutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: FVW_x_W_Gamma_NW = 1 ! FVW%W(DL%i1)%Gamma_NW + integer(IntKi), public, parameter :: FVW_x_W_Gamma_FW = 2 ! FVW%W(DL%i1)%Gamma_FW + integer(IntKi), public, parameter :: FVW_x_W_Eps_NW = 3 ! FVW%W(DL%i1)%Eps_NW + integer(IntKi), public, parameter :: FVW_x_W_Eps_FW = 4 ! FVW%W(DL%i1)%Eps_FW + integer(IntKi), public, parameter :: FVW_x_W_r_NW = 5 ! FVW%W(DL%i1)%r_NW + integer(IntKi), public, parameter :: FVW_x_W_r_FW = 6 ! FVW%W(DL%i1)%r_FW + integer(IntKi), public, parameter :: FVW_x_UA_element_x = 7 ! FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x + integer(IntKi), public, parameter :: FVW_z_W_Gamma_LL = 8 ! FVW%W(DL%i1)%Gamma_LL + integer(IntKi), public, parameter :: FVW_z_residual = 9 ! FVW%residual + integer(IntKi), public, parameter :: FVW_u_rotors_HubOrientation = 10 ! FVW%rotors(DL%i1)%HubOrientation + integer(IntKi), public, parameter :: FVW_u_rotors_HubPosition = 11 ! FVW%rotors(DL%i1)%HubPosition + integer(IntKi), public, parameter :: FVW_u_W_Vwnd_LL = 12 ! FVW%W(DL%i1)%Vwnd_LL + integer(IntKi), public, parameter :: FVW_u_W_omega_z = 13 ! FVW%W(DL%i1)%omega_z + integer(IntKi), public, parameter :: FVW_u_WingsMesh = 14 ! FVW%WingsMesh(DL%i1) + integer(IntKi), public, parameter :: FVW_u_V_wind = 15 ! FVW%V_wind + integer(IntKi), public, parameter :: FVW_y_W_Vind = 16 ! FVW%W(DL%i1)%Vind + +contains subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg) type(GridOutType), intent(in) :: SrcGridOutTypeData @@ -4091,7 +4107,7 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er function FVW_InputMeshPointer(u, ML) result(Mesh) type(FVW_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -4101,7 +4117,7 @@ function FVW_InputMeshPointer(u, ML) result(Mesh) end function function FVW_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -4112,7 +4128,7 @@ function FVW_InputMeshName(ML) result(Name) function FVW_OutputMeshPointer(y, ML) result(Mesh) type(FVW_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -4120,11 +4136,179 @@ function FVW_OutputMeshPointer(y, ML) result(Mesh) end function function FVW_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine FVW_PackContStateAry(Vars, x, ValAry) + type(FVW_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (FVW_x_W_Gamma_NW) + call MV_Pack2(Var, x%W(DL%i1)%Gamma_NW, ValAry) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + call MV_Pack2(Var, x%W(DL%i1)%Gamma_FW, ValAry) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + call MV_Pack2(Var, x%W(DL%i1)%Eps_NW, ValAry) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + call MV_Pack2(Var, x%W(DL%i1)%Eps_FW, ValAry) ! Rank 3 Array + case (FVW_x_W_r_NW) + call MV_Pack2(Var, x%W(DL%i1)%r_NW, ValAry) ! Rank 3 Array + case (FVW_x_W_r_FW) + call MV_Pack2(Var, x%W(DL%i1)%r_FW, ValAry) ! Rank 3 Array + case (FVW_x_UA_element_x) + call MV_Pack2(Var, x%UA(DL%i1)%element(DL%i2, DL%i3)%x, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine FVW_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (FVW_x_W_Gamma_NW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Gamma_NW) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Gamma_FW) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Eps_NW) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Eps_FW) ! Rank 3 Array + case (FVW_x_W_r_NW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%r_NW) ! Rank 3 Array + case (FVW_x_W_r_FW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%r_FW) ! Rank 3 Array + case (FVW_x_UA_element_x) + call MV_Unpack2(Var, ValAry, x%UA(DL%i1)%element(DL%i2, DL%i3)%x) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine FVW_PackConstrStateAry(Vars, z, ValAry) + type(FVW_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (FVW_z_W_Gamma_LL) + call MV_Pack2(Var, z%W(DL%i1)%Gamma_LL, ValAry) ! Rank 1 Array + case (FVW_z_residual) + call MV_Pack2(Var, z%residual, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine FVW_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (FVW_z_W_Gamma_LL) + call MV_Unpack2(Var, ValAry, z%W(DL%i1)%Gamma_LL) ! Rank 1 Array + case (FVW_z_residual) + call MV_Unpack2(Var, ValAry, z%residual) ! Scalar + end select + end associate + end do +end subroutine + +subroutine FVW_PackInputAry(Vars, u, ValAry) + type(FVW_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (FVW_u_rotors_HubOrientation) + call MV_Pack2(Var, u%rotors(DL%i1)%HubOrientation, ValAry) ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + call MV_Pack2(Var, u%rotors(DL%i1)%HubPosition, ValAry) ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + call MV_Pack2(Var, u%W(DL%i1)%Vwnd_LL, ValAry) ! Rank 2 Array + case (FVW_u_W_omega_z) + call MV_Pack2(Var, u%W(DL%i1)%omega_z, ValAry) ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_Pack2(Var, u%WingsMesh(DL%i1), ValAry) ! Mesh + case (FVW_u_V_wind) + call MV_Pack2(Var, u%V_wind, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine FVW_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (FVW_u_rotors_HubOrientation) + call MV_Unpack2(Var, ValAry, u%rotors(DL%i1)%HubOrientation) ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + call MV_Unpack2(Var, ValAry, u%rotors(DL%i1)%HubPosition) ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + call MV_Unpack2(Var, ValAry, u%W(DL%i1)%Vwnd_LL) ! Rank 2 Array + case (FVW_u_W_omega_z) + call MV_Unpack2(Var, ValAry, u%W(DL%i1)%omega_z) ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_Unpack2(Var, ValAry, u%WingsMesh(DL%i1)) ! Mesh + case (FVW_u_V_wind) + call MV_Unpack2(Var, ValAry, u%V_wind) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine FVW_PackOutputAry(Vars, y, ValAry) + type(FVW_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (FVW_y_W_Vind) + call MV_Pack2(Var, y%W(DL%i1)%Vind, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine FVW_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (FVW_y_W_Vind) + call MV_Unpack2(Var, ValAry, y%W(DL%i1)%Vind) ! Rank 2 Array + end select + end associate + end do +end subroutine END MODULE FVW_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 4c18632396..75b60b52fe 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -251,7 +251,22 @@ MODULE UnsteadyAero_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< outputs to be written to a file [-] END TYPE UA_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: UA_x_element_x = 1 ! UA%element(DL%i1, DL%i2)%x + integer(IntKi), public, parameter :: UA_z_DummyConstraintState = 2 ! UA%DummyConstraintState + integer(IntKi), public, parameter :: UA_u_U = 3 ! UA%U + integer(IntKi), public, parameter :: UA_u_alpha = 4 ! UA%alpha + integer(IntKi), public, parameter :: UA_u_Re = 5 ! UA%Re + integer(IntKi), public, parameter :: UA_u_UserProp = 6 ! UA%UserProp + integer(IntKi), public, parameter :: UA_u_v_ac = 7 ! UA%v_ac + integer(IntKi), public, parameter :: UA_u_omega = 8 ! UA%omega + integer(IntKi), public, parameter :: UA_y_Cn = 9 ! UA%Cn + integer(IntKi), public, parameter :: UA_y_Cc = 10 ! UA%Cc + integer(IntKi), public, parameter :: UA_y_Cm = 11 ! UA%Cm + integer(IntKi), public, parameter :: UA_y_Cl = 12 ! UA%Cl + integer(IntKi), public, parameter :: UA_y_Cd = 13 ! UA%Cd + integer(IntKi), public, parameter :: UA_y_WriteOutput = 14 ! UA%WriteOutput + +contains subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(UA_InitInputType), intent(in) :: SrcInitInputData @@ -2523,7 +2538,7 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err function UA_InputMeshPointer(u, ML) result(Mesh) type(UA_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2531,7 +2546,7 @@ function UA_InputMeshPointer(u, ML) result(Mesh) end function function UA_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2540,7 +2555,7 @@ function UA_InputMeshName(ML) result(Name) function UA_OutputMeshPointer(y, ML) result(Mesh) type(UA_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2548,11 +2563,171 @@ function UA_OutputMeshPointer(y, ML) result(Mesh) end function function UA_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine UA_PackContStateAry(Vars, x, ValAry) + type(UA_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (UA_x_element_x) + call MV_Pack2(Var, x%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine UA_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (UA_x_element_x) + call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%x) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine UA_PackConstrStateAry(Vars, z, ValAry) + type(UA_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (UA_z_DummyConstraintState) + call MV_Pack2(Var, z%DummyConstraintState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine UA_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (UA_z_DummyConstraintState) + call MV_Unpack2(Var, ValAry, z%DummyConstraintState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine UA_PackInputAry(Vars, u, ValAry) + type(UA_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (UA_u_U) + call MV_Pack2(Var, u%U, ValAry) ! Scalar + case (UA_u_alpha) + call MV_Pack2(Var, u%alpha, ValAry) ! Scalar + case (UA_u_Re) + call MV_Pack2(Var, u%Re, ValAry) ! Scalar + case (UA_u_UserProp) + call MV_Pack2(Var, u%UserProp, ValAry) ! Scalar + case (UA_u_v_ac) + call MV_Pack2(Var, u%v_ac, ValAry) ! Rank 1 Array + case (UA_u_omega) + call MV_Pack2(Var, u%omega, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine UA_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (UA_u_U) + call MV_Unpack2(Var, ValAry, u%U) ! Scalar + case (UA_u_alpha) + call MV_Unpack2(Var, ValAry, u%alpha) ! Scalar + case (UA_u_Re) + call MV_Unpack2(Var, ValAry, u%Re) ! Scalar + case (UA_u_UserProp) + call MV_Unpack2(Var, ValAry, u%UserProp) ! Scalar + case (UA_u_v_ac) + call MV_Unpack2(Var, ValAry, u%v_ac) ! Rank 1 Array + case (UA_u_omega) + call MV_Unpack2(Var, ValAry, u%omega) ! Scalar + end select + end associate + end do +end subroutine + +subroutine UA_PackOutputAry(Vars, y, ValAry) + type(UA_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (UA_y_Cn) + call MV_Pack2(Var, y%Cn, ValAry) ! Scalar + case (UA_y_Cc) + call MV_Pack2(Var, y%Cc, ValAry) ! Scalar + case (UA_y_Cm) + call MV_Pack2(Var, y%Cm, ValAry) ! Scalar + case (UA_y_Cl) + call MV_Pack2(Var, y%Cl, ValAry) ! Scalar + case (UA_y_Cd) + call MV_Pack2(Var, y%Cd, ValAry) ! Scalar + case (UA_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine UA_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (UA_y_Cn) + call MV_Unpack2(Var, ValAry, y%Cn) ! Scalar + case (UA_y_Cc) + call MV_Unpack2(Var, ValAry, y%Cc) ! Scalar + case (UA_y_Cm) + call MV_Unpack2(Var, ValAry, y%Cm) ! Scalar + case (UA_y_Cl) + call MV_Unpack2(Var, ValAry, y%Cl) ! Scalar + case (UA_y_Cd) + call MV_Unpack2(Var, ValAry, y%Cd) ! Scalar + case (UA_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE UnsteadyAero_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 8357cef188..64c49d872f 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -34,10 +34,6 @@ MODULE AeroDyn14_Types USE DWM_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: AD14_u_InputMarkers = 1 ! Mesh number for AD14 AD14_u_InputMarkers mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD14_u_Twr_InputMarkers = 2 ! Mesh number for AD14 AD14_u_Twr_InputMarkers mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD14_y_OutputLoads = 3 ! Mesh number for AD14 AD14_y_OutputLoads mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD14_y_Twr_OutputLoads = 4 ! Mesh number for AD14 AD14_y_Twr_OutputLoads mesh [-] ! ========= Marker ======= TYPE, PUBLIC :: Marker REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0 @@ -473,7 +469,52 @@ MODULE AeroDyn14_Types TYPE(MeshType) :: Twr_OutputLoads !< Tower Output Loads (mesh) [-] END TYPE AD14_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: AD14_x_DWM_dummy = 1 ! AD14%DWM%dummy + integer(IntKi), public, parameter :: AD14_x_DWM_IfW_DummyContState = 2 ! AD14%DWM%IfW%DummyContState + integer(IntKi), public, parameter :: AD14_z_DWM_dummy = 3 ! AD14%DWM%dummy + integer(IntKi), public, parameter :: AD14_z_DWM_IfW_DummyConstrState = 4 ! AD14%DWM%IfW%DummyConstrState + integer(IntKi), public, parameter :: AD14_u_InputMarkers = 5 ! AD14%InputMarkers(DL%i1) + integer(IntKi), public, parameter :: AD14_u_Twr_InputMarkers = 6 ! AD14%Twr_InputMarkers + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Blade_Position = 7 ! AD14%TurbineComponents%Blade(DL%i1)%Position + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Blade_Orientation = 8 ! AD14%TurbineComponents%Blade(DL%i1)%Orientation + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Blade_TranslationVel = 9 ! AD14%TurbineComponents%Blade(DL%i1)%TranslationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Blade_RotationVel = 10 ! AD14%TurbineComponents%Blade(DL%i1)%RotationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Hub_Position = 11 ! AD14%TurbineComponents%Hub%Position + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Hub_Orientation = 12 ! AD14%TurbineComponents%Hub%Orientation + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Hub_TranslationVel = 13 ! AD14%TurbineComponents%Hub%TranslationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Hub_RotationVel = 14 ! AD14%TurbineComponents%Hub%RotationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_RotorFurl_Position = 15 ! AD14%TurbineComponents%RotorFurl%Position + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_RotorFurl_Orientation = 16 ! AD14%TurbineComponents%RotorFurl%Orientation + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_RotorFurl_TranslationVel = 17 ! AD14%TurbineComponents%RotorFurl%TranslationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_RotorFurl_RotationVel = 18 ! AD14%TurbineComponents%RotorFurl%RotationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Nacelle_Position = 19 ! AD14%TurbineComponents%Nacelle%Position + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Nacelle_Orientation = 20 ! AD14%TurbineComponents%Nacelle%Orientation + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Nacelle_TranslationVel = 21 ! AD14%TurbineComponents%Nacelle%TranslationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Nacelle_RotationVel = 22 ! AD14%TurbineComponents%Nacelle%RotationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_TailFin_Position = 23 ! AD14%TurbineComponents%TailFin%Position + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_TailFin_Orientation = 24 ! AD14%TurbineComponents%TailFin%Orientation + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_TailFin_TranslationVel = 25 ! AD14%TurbineComponents%TailFin%TranslationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_TailFin_RotationVel = 26 ! AD14%TurbineComponents%TailFin%RotationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Tower_Position = 27 ! AD14%TurbineComponents%Tower%Position + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Tower_Orientation = 28 ! AD14%TurbineComponents%Tower%Orientation + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Tower_TranslationVel = 29 ! AD14%TurbineComponents%Tower%TranslationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Tower_RotationVel = 30 ! AD14%TurbineComponents%Tower%RotationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_SubStructure_Position = 31 ! AD14%TurbineComponents%SubStructure%Position + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_SubStructure_Orientation = 32 ! AD14%TurbineComponents%SubStructure%Orientation + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_SubStructure_TranslationVel = 33 ! AD14%TurbineComponents%SubStructure%TranslationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_SubStructure_RotationVel = 34 ! AD14%TurbineComponents%SubStructure%RotationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Foundation_Position = 35 ! AD14%TurbineComponents%Foundation%Position + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Foundation_Orientation = 36 ! AD14%TurbineComponents%Foundation%Orientation + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Foundation_TranslationVel = 37 ! AD14%TurbineComponents%Foundation%TranslationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_Foundation_RotationVel = 38 ! AD14%TurbineComponents%Foundation%RotationVel + integer(IntKi), public, parameter :: AD14_u_TurbineComponents_BladeLength = 39 ! AD14%TurbineComponents%BladeLength + integer(IntKi), public, parameter :: AD14_u_MulTabLoc = 40 ! AD14%MulTabLoc + integer(IntKi), public, parameter :: AD14_u_InflowVelocity = 41 ! AD14%InflowVelocity + integer(IntKi), public, parameter :: AD14_u_AvgInfVel = 42 ! AD14%AvgInfVel + integer(IntKi), public, parameter :: AD14_y_OutputLoads = 43 ! AD14%OutputLoads(DL%i1) + integer(IntKi), public, parameter :: AD14_y_Twr_OutputLoads = 44 ! AD14%Twr_OutputLoads + +contains subroutine AD14_CopyMarker(SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, ErrMsg) type(Marker), intent(in) :: SrcMarkerData @@ -4902,7 +4943,7 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E function AD14_InputMeshPointer(u, ML) result(Mesh) type(AD14_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -4914,7 +4955,7 @@ function AD14_InputMeshPointer(u, ML) result(Mesh) end function function AD14_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -4927,7 +4968,7 @@ function AD14_InputMeshName(ML) result(Name) function AD14_OutputMeshPointer(y, ML) result(Mesh) type(AD14_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -4939,7 +4980,7 @@ function AD14_OutputMeshPointer(y, ML) result(Mesh) end function function AD14_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -4949,5 +4990,285 @@ function AD14_OutputMeshName(ML) result(Name) Name = "y%Twr_OutputLoads" end select end function + +subroutine AD14_PackContStateAry(Vars, x, ValAry) + type(AD14_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (AD14_x_DWM_dummy) + call MV_Pack2(Var, x%DWM%dummy, ValAry) ! Scalar + case (AD14_x_DWM_IfW_DummyContState) + call MV_Pack2(Var, x%DWM%IfW%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AD14_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AD14_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (AD14_x_DWM_dummy) + call MV_Unpack2(Var, ValAry, x%DWM%dummy) ! Scalar + case (AD14_x_DWM_IfW_DummyContState) + call MV_Unpack2(Var, ValAry, x%DWM%IfW%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AD14_PackConstrStateAry(Vars, z, ValAry) + type(AD14_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (AD14_z_DWM_dummy) + call MV_Pack2(Var, z%DWM%dummy, ValAry) ! Scalar + case (AD14_z_DWM_IfW_DummyConstrState) + call MV_Pack2(Var, z%DWM%IfW%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AD14_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AD14_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (AD14_z_DWM_dummy) + call MV_Unpack2(Var, ValAry, z%DWM%dummy) ! Scalar + case (AD14_z_DWM_IfW_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DWM%IfW%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine AD14_PackInputAry(Vars, u, ValAry) + type(AD14_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (AD14_u_InputMarkers) + call MV_Pack2(Var, u%InputMarkers(DL%i1), ValAry) ! Mesh + case (AD14_u_Twr_InputMarkers) + call MV_Pack2(Var, u%Twr_InputMarkers, ValAry) ! Mesh + case (AD14_u_TurbineComponents_Blade_Position) + call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Blade_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Blade_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Blade_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_Position) + call MV_Pack2(Var, u%TurbineComponents%Hub%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Hub%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Hub_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Hub%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Hub%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_Position) + call MV_Pack2(Var, u%TurbineComponents%RotorFurl%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_Orientation) + call MV_Pack2(Var, u%TurbineComponents%RotorFurl%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_RotorFurl_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%RotorFurl%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%RotorFurl%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_Position) + call MV_Pack2(Var, u%TurbineComponents%Nacelle%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Nacelle%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Nacelle_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Nacelle%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Nacelle%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_Position) + call MV_Pack2(Var, u%TurbineComponents%TailFin%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_Orientation) + call MV_Pack2(Var, u%TurbineComponents%TailFin%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_TailFin_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%TailFin%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%TailFin%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_Position) + call MV_Pack2(Var, u%TurbineComponents%Tower%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Tower%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Tower_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Tower%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Tower%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_Position) + call MV_Pack2(Var, u%TurbineComponents%SubStructure%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_Orientation) + call MV_Pack2(Var, u%TurbineComponents%SubStructure%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_SubStructure_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%SubStructure%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%SubStructure%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_Position) + call MV_Pack2(Var, u%TurbineComponents%Foundation%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Foundation%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Foundation_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Foundation%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Foundation%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_BladeLength) + call MV_Pack2(Var, u%TurbineComponents%BladeLength, ValAry) ! Scalar + case (AD14_u_MulTabLoc) + call MV_Pack2(Var, u%MulTabLoc, ValAry) ! Rank 2 Array + case (AD14_u_InflowVelocity) + call MV_Pack2(Var, u%InflowVelocity, ValAry) ! Rank 2 Array + case (AD14_u_AvgInfVel) + call MV_Pack2(Var, u%AvgInfVel, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine AD14_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AD14_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (AD14_u_InputMarkers) + call MV_Unpack2(Var, ValAry, u%InputMarkers(DL%i1)) ! Mesh + case (AD14_u_Twr_InputMarkers) + call MV_Unpack2(Var, ValAry, u%Twr_InputMarkers) ! Mesh + case (AD14_u_TurbineComponents_Blade_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Blade_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Blade_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Blade_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Hub_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_RotorFurl_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Nacelle_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_TailFin_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Tower_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_SubStructure_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Foundation_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_BladeLength) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%BladeLength) ! Scalar + case (AD14_u_MulTabLoc) + call MV_Unpack2(Var, ValAry, u%MulTabLoc) ! Rank 2 Array + case (AD14_u_InflowVelocity) + call MV_Unpack2(Var, ValAry, u%InflowVelocity) ! Rank 2 Array + case (AD14_u_AvgInfVel) + call MV_Unpack2(Var, ValAry, u%AvgInfVel) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine AD14_PackOutputAry(Vars, y, ValAry) + type(AD14_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (AD14_y_OutputLoads) + call MV_Pack2(Var, y%OutputLoads(DL%i1), ValAry) ! Mesh + case (AD14_y_Twr_OutputLoads) + call MV_Pack2(Var, y%Twr_OutputLoads, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine AD14_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AD14_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (AD14_y_OutputLoads) + call MV_Unpack2(Var, ValAry, y%OutputLoads(DL%i1)) ! Mesh + case (AD14_y_Twr_OutputLoads) + call MV_Unpack2(Var, ValAry, y%Twr_OutputLoads) ! Mesh + end select + end associate + end do +end subroutine END MODULE AeroDyn14_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index e3a026588a..649ddfc56a 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -325,7 +325,57 @@ MODULE DWM_Types TYPE(InflowWind_InitOutputType) :: IfW END TYPE DWM_InitOutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: DWM_x_dummy = 1 ! DWM%dummy + integer(IntKi), public, parameter :: DWM_x_IfW_DummyContState = 2 ! DWM%IfW%DummyContState + integer(IntKi), public, parameter :: DWM_z_dummy = 3 ! DWM%dummy + integer(IntKi), public, parameter :: DWM_z_IfW_DummyConstrState = 4 ! DWM%IfW%DummyConstrState + integer(IntKi), public, parameter :: DWM_u_Upwind_result_upwind_U = 5 ! DWM%Upwind_result%upwind_U + integer(IntKi), public, parameter :: DWM_u_Upwind_result_upwind_wakecenter = 6 ! DWM%Upwind_result%upwind_wakecenter + integer(IntKi), public, parameter :: DWM_u_Upwind_result_upwind_meanU = 7 ! DWM%Upwind_result%upwind_meanU + integer(IntKi), public, parameter :: DWM_u_Upwind_result_upwind_TI = 8 ! DWM%Upwind_result%upwind_TI + integer(IntKi), public, parameter :: DWM_u_Upwind_result_upwind_small_TI = 9 ! DWM%Upwind_result%upwind_small_TI + integer(IntKi), public, parameter :: DWM_u_Upwind_result_upwind_smoothWake = 10 ! DWM%Upwind_result%upwind_smoothWake + integer(IntKi), public, parameter :: DWM_u_Upwind_result_velocity_aerodyn = 11 ! DWM%Upwind_result%velocity_aerodyn + integer(IntKi), public, parameter :: DWM_u_Upwind_result_TI_downstream = 12 ! DWM%Upwind_result%TI_downstream + integer(IntKi), public, parameter :: DWM_u_Upwind_result_small_scale_TI_downstream = 13 ! DWM%Upwind_result%small_scale_TI_downstream + integer(IntKi), public, parameter :: DWM_u_Upwind_result_smoothed_velocity_array = 14 ! DWM%Upwind_result%smoothed_velocity_array + integer(IntKi), public, parameter :: DWM_u_Upwind_result_vel_matrix = 15 ! DWM%Upwind_result%vel_matrix + integer(IntKi), public, parameter :: DWM_u_IfW_PositionXYZ = 16 ! DWM%IfW%PositionXYZ + integer(IntKi), public, parameter :: DWM_u_IfW_lidar_PulseLidEl = 17 ! DWM%IfW%lidar%PulseLidEl + integer(IntKi), public, parameter :: DWM_u_IfW_lidar_PulseLidAz = 18 ! DWM%IfW%lidar%PulseLidAz + integer(IntKi), public, parameter :: DWM_u_IfW_lidar_HubDisplacementX = 19 ! DWM%IfW%lidar%HubDisplacementX + integer(IntKi), public, parameter :: DWM_u_IfW_lidar_HubDisplacementY = 20 ! DWM%IfW%lidar%HubDisplacementY + integer(IntKi), public, parameter :: DWM_u_IfW_lidar_HubDisplacementZ = 21 ! DWM%IfW%lidar%HubDisplacementZ + integer(IntKi), public, parameter :: DWM_u_IfW_HubPosition = 22 ! DWM%IfW%HubPosition + integer(IntKi), public, parameter :: DWM_u_IfW_HubOrientation = 23 ! DWM%IfW%HubOrientation + integer(IntKi), public, parameter :: DWM_y_turbine_thrust_force = 24 ! DWM%turbine_thrust_force + integer(IntKi), public, parameter :: DWM_y_induction_factor = 25 ! DWM%induction_factor + integer(IntKi), public, parameter :: DWM_y_r_initial = 26 ! DWM%r_initial + integer(IntKi), public, parameter :: DWM_y_U_initial = 27 ! DWM%U_initial + integer(IntKi), public, parameter :: DWM_y_Mean_FFWS_array = 28 ! DWM%Mean_FFWS_array + integer(IntKi), public, parameter :: DWM_y_Mean_FFWS = 29 ! DWM%Mean_FFWS + integer(IntKi), public, parameter :: DWM_y_TI = 30 ! DWM%TI + integer(IntKi), public, parameter :: DWM_y_TI_downstream = 31 ! DWM%TI_downstream + integer(IntKi), public, parameter :: DWM_y_wake_u = 32 ! DWM%wake_u + integer(IntKi), public, parameter :: DWM_y_wake_position = 33 ! DWM%wake_position + integer(IntKi), public, parameter :: DWM_y_smoothed_velocity_array = 34 ! DWM%smoothed_velocity_array + integer(IntKi), public, parameter :: DWM_y_AtmUscale = 35 ! DWM%AtmUscale + integer(IntKi), public, parameter :: DWM_y_du_dz_ABL = 36 ! DWM%du_dz_ABL + integer(IntKi), public, parameter :: DWM_y_total_SDgenpwr = 37 ! DWM%total_SDgenpwr + integer(IntKi), public, parameter :: DWM_y_mean_SDgenpwr = 38 ! DWM%mean_SDgenpwr + integer(IntKi), public, parameter :: DWM_y_avg_ct = 39 ! DWM%avg_ct + integer(IntKi), public, parameter :: DWM_y_IfW_VelocityUVW = 40 ! DWM%IfW%VelocityUVW + integer(IntKi), public, parameter :: DWM_y_IfW_AccelUVW = 41 ! DWM%IfW%AccelUVW + integer(IntKi), public, parameter :: DWM_y_IfW_WriteOutput = 42 ! DWM%IfW%WriteOutput + integer(IntKi), public, parameter :: DWM_y_IfW_DiskVel = 43 ! DWM%IfW%DiskVel + integer(IntKi), public, parameter :: DWM_y_IfW_HubVel = 44 ! DWM%IfW%HubVel + integer(IntKi), public, parameter :: DWM_y_IfW_lidar_LidSpeed = 45 ! DWM%IfW%lidar%LidSpeed + integer(IntKi), public, parameter :: DWM_y_IfW_lidar_WtTrunc = 46 ! DWM%IfW%lidar%WtTrunc + integer(IntKi), public, parameter :: DWM_y_IfW_lidar_MsrPositionsX = 47 ! DWM%IfW%lidar%MsrPositionsX + integer(IntKi), public, parameter :: DWM_y_IfW_lidar_MsrPositionsY = 48 ! DWM%IfW%lidar%MsrPositionsY + integer(IntKi), public, parameter :: DWM_y_IfW_lidar_MsrPositionsZ = 49 ! DWM%IfW%lidar%MsrPositionsZ + +contains subroutine DWM_CopyCVSD(SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg) type(CVSD), intent(in) :: SrcCVSDData @@ -3168,7 +3218,7 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er function DWM_InputMeshPointer(u, ML) result(Mesh) type(DWM_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -3176,7 +3226,7 @@ function DWM_InputMeshPointer(u, ML) result(Mesh) end function function DWM_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -3185,7 +3235,7 @@ function DWM_InputMeshName(ML) result(Name) function DWM_OutputMeshPointer(y, ML) result(Mesh) type(DWM_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -3193,11 +3243,311 @@ function DWM_OutputMeshPointer(y, ML) result(Mesh) end function function DWM_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine DWM_PackContStateAry(Vars, x, ValAry) + type(DWM_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (DWM_x_dummy) + call MV_Pack2(Var, x%dummy, ValAry) ! Scalar + case (DWM_x_IfW_DummyContState) + call MV_Pack2(Var, x%IfW%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine DWM_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DWM_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (DWM_x_dummy) + call MV_Unpack2(Var, ValAry, x%dummy) ! Scalar + case (DWM_x_IfW_DummyContState) + call MV_Unpack2(Var, ValAry, x%IfW%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine DWM_PackConstrStateAry(Vars, z, ValAry) + type(DWM_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (DWM_z_dummy) + call MV_Pack2(Var, z%dummy, ValAry) ! Scalar + case (DWM_z_IfW_DummyConstrState) + call MV_Pack2(Var, z%IfW%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine DWM_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DWM_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (DWM_z_dummy) + call MV_Unpack2(Var, ValAry, z%dummy) ! Scalar + case (DWM_z_IfW_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%IfW%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine DWM_PackInputAry(Vars, u, ValAry) + type(DWM_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (DWM_u_Upwind_result_upwind_U) + call MV_Pack2(Var, u%Upwind_result%upwind_U, ValAry) ! Rank 2 Array + case (DWM_u_Upwind_result_upwind_wakecenter) + call MV_Pack2(Var, u%Upwind_result%upwind_wakecenter, ValAry) ! Rank 4 Array + case (DWM_u_Upwind_result_upwind_meanU) + call MV_Pack2(Var, u%Upwind_result%upwind_meanU, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_TI) + call MV_Pack2(Var, u%Upwind_result%upwind_TI, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_small_TI) + call MV_Pack2(Var, u%Upwind_result%upwind_small_TI, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_smoothWake) + call MV_Pack2(Var, u%Upwind_result%upwind_smoothWake, ValAry) ! Rank 2 Array + case (DWM_u_Upwind_result_velocity_aerodyn) + call MV_Pack2(Var, u%Upwind_result%velocity_aerodyn, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_TI_downstream) + call MV_Pack2(Var, u%Upwind_result%TI_downstream, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_small_scale_TI_downstream) + call MV_Pack2(Var, u%Upwind_result%small_scale_TI_downstream, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_smoothed_velocity_array) + call MV_Pack2(Var, u%Upwind_result%smoothed_velocity_array, ValAry) ! Rank 2 Array + case (DWM_u_Upwind_result_vel_matrix) + call MV_Pack2(Var, u%Upwind_result%vel_matrix, ValAry) ! Rank 3 Array + case (DWM_u_IfW_PositionXYZ) + call MV_Pack2(Var, u%IfW%PositionXYZ, ValAry) ! Rank 2 Array + case (DWM_u_IfW_lidar_PulseLidEl) + call MV_Pack2(Var, u%IfW%lidar%PulseLidEl, ValAry) ! Scalar + case (DWM_u_IfW_lidar_PulseLidAz) + call MV_Pack2(Var, u%IfW%lidar%PulseLidAz, ValAry) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementX) + call MV_Pack2(Var, u%IfW%lidar%HubDisplacementX, ValAry) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementY) + call MV_Pack2(Var, u%IfW%lidar%HubDisplacementY, ValAry) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementZ) + call MV_Pack2(Var, u%IfW%lidar%HubDisplacementZ, ValAry) ! Scalar + case (DWM_u_IfW_HubPosition) + call MV_Pack2(Var, u%IfW%HubPosition, ValAry) ! Rank 1 Array + case (DWM_u_IfW_HubOrientation) + call MV_Pack2(Var, u%IfW%HubOrientation, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine DWM_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DWM_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (DWM_u_Upwind_result_upwind_U) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_U) ! Rank 2 Array + case (DWM_u_Upwind_result_upwind_wakecenter) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_wakecenter) ! Rank 4 Array + case (DWM_u_Upwind_result_upwind_meanU) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_meanU) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_TI) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_TI) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_small_TI) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_small_TI) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_smoothWake) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_smoothWake) ! Rank 2 Array + case (DWM_u_Upwind_result_velocity_aerodyn) + call MV_Unpack2(Var, ValAry, u%Upwind_result%velocity_aerodyn) ! Rank 1 Array + case (DWM_u_Upwind_result_TI_downstream) + call MV_Unpack2(Var, ValAry, u%Upwind_result%TI_downstream) ! Rank 1 Array + case (DWM_u_Upwind_result_small_scale_TI_downstream) + call MV_Unpack2(Var, ValAry, u%Upwind_result%small_scale_TI_downstream) ! Rank 1 Array + case (DWM_u_Upwind_result_smoothed_velocity_array) + call MV_Unpack2(Var, ValAry, u%Upwind_result%smoothed_velocity_array) ! Rank 2 Array + case (DWM_u_Upwind_result_vel_matrix) + call MV_Unpack2(Var, ValAry, u%Upwind_result%vel_matrix) ! Rank 3 Array + case (DWM_u_IfW_PositionXYZ) + call MV_Unpack2(Var, ValAry, u%IfW%PositionXYZ) ! Rank 2 Array + case (DWM_u_IfW_lidar_PulseLidEl) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%PulseLidEl) ! Scalar + case (DWM_u_IfW_lidar_PulseLidAz) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%PulseLidAz) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementX) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementX) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementY) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementY) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementZ) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementZ) ! Scalar + case (DWM_u_IfW_HubPosition) + call MV_Unpack2(Var, ValAry, u%IfW%HubPosition) ! Rank 1 Array + case (DWM_u_IfW_HubOrientation) + call MV_Unpack2(Var, ValAry, u%IfW%HubOrientation) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine DWM_PackOutputAry(Vars, y, ValAry) + type(DWM_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (DWM_y_turbine_thrust_force) + call MV_Pack2(Var, y%turbine_thrust_force, ValAry) ! Rank 1 Array + case (DWM_y_induction_factor) + call MV_Pack2(Var, y%induction_factor, ValAry) ! Rank 1 Array + case (DWM_y_r_initial) + call MV_Pack2(Var, y%r_initial, ValAry) ! Rank 1 Array + case (DWM_y_U_initial) + call MV_Pack2(Var, y%U_initial, ValAry) ! Rank 1 Array + case (DWM_y_Mean_FFWS_array) + call MV_Pack2(Var, y%Mean_FFWS_array, ValAry) ! Rank 1 Array + case (DWM_y_Mean_FFWS) + call MV_Pack2(Var, y%Mean_FFWS, ValAry) ! Scalar + case (DWM_y_TI) + call MV_Pack2(Var, y%TI, ValAry) ! Scalar + case (DWM_y_TI_downstream) + call MV_Pack2(Var, y%TI_downstream, ValAry) ! Scalar + case (DWM_y_wake_u) + call MV_Pack2(Var, y%wake_u, ValAry) ! Rank 2 Array + case (DWM_y_wake_position) + call MV_Pack2(Var, y%wake_position, ValAry) ! Rank 3 Array + case (DWM_y_smoothed_velocity_array) + call MV_Pack2(Var, y%smoothed_velocity_array, ValAry) ! Rank 2 Array + case (DWM_y_AtmUscale) + call MV_Pack2(Var, y%AtmUscale, ValAry) ! Scalar + case (DWM_y_du_dz_ABL) + call MV_Pack2(Var, y%du_dz_ABL, ValAry) ! Scalar + case (DWM_y_total_SDgenpwr) + call MV_Pack2(Var, y%total_SDgenpwr, ValAry) ! Scalar + case (DWM_y_mean_SDgenpwr) + call MV_Pack2(Var, y%mean_SDgenpwr, ValAry) ! Scalar + case (DWM_y_avg_ct) + call MV_Pack2(Var, y%avg_ct, ValAry) ! Scalar + case (DWM_y_IfW_VelocityUVW) + call MV_Pack2(Var, y%IfW%VelocityUVW, ValAry) ! Rank 2 Array + case (DWM_y_IfW_AccelUVW) + call MV_Pack2(Var, y%IfW%AccelUVW, ValAry) ! Rank 2 Array + case (DWM_y_IfW_WriteOutput) + call MV_Pack2(Var, y%IfW%WriteOutput, ValAry) ! Rank 1 Array + case (DWM_y_IfW_DiskVel) + call MV_Pack2(Var, y%IfW%DiskVel, ValAry) ! Rank 1 Array + case (DWM_y_IfW_HubVel) + call MV_Pack2(Var, y%IfW%HubVel, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_LidSpeed) + call MV_Pack2(Var, y%IfW%lidar%LidSpeed, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_WtTrunc) + call MV_Pack2(Var, y%IfW%lidar%WtTrunc, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsX) + call MV_Pack2(Var, y%IfW%lidar%MsrPositionsX, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsY) + call MV_Pack2(Var, y%IfW%lidar%MsrPositionsY, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsZ) + call MV_Pack2(Var, y%IfW%lidar%MsrPositionsZ, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine DWM_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DWM_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (DWM_y_turbine_thrust_force) + call MV_Unpack2(Var, ValAry, y%turbine_thrust_force) ! Rank 1 Array + case (DWM_y_induction_factor) + call MV_Unpack2(Var, ValAry, y%induction_factor) ! Rank 1 Array + case (DWM_y_r_initial) + call MV_Unpack2(Var, ValAry, y%r_initial) ! Rank 1 Array + case (DWM_y_U_initial) + call MV_Unpack2(Var, ValAry, y%U_initial) ! Rank 1 Array + case (DWM_y_Mean_FFWS_array) + call MV_Unpack2(Var, ValAry, y%Mean_FFWS_array) ! Rank 1 Array + case (DWM_y_Mean_FFWS) + call MV_Unpack2(Var, ValAry, y%Mean_FFWS) ! Scalar + case (DWM_y_TI) + call MV_Unpack2(Var, ValAry, y%TI) ! Scalar + case (DWM_y_TI_downstream) + call MV_Unpack2(Var, ValAry, y%TI_downstream) ! Scalar + case (DWM_y_wake_u) + call MV_Unpack2(Var, ValAry, y%wake_u) ! Rank 2 Array + case (DWM_y_wake_position) + call MV_Unpack2(Var, ValAry, y%wake_position) ! Rank 3 Array + case (DWM_y_smoothed_velocity_array) + call MV_Unpack2(Var, ValAry, y%smoothed_velocity_array) ! Rank 2 Array + case (DWM_y_AtmUscale) + call MV_Unpack2(Var, ValAry, y%AtmUscale) ! Scalar + case (DWM_y_du_dz_ABL) + call MV_Unpack2(Var, ValAry, y%du_dz_ABL) ! Scalar + case (DWM_y_total_SDgenpwr) + call MV_Unpack2(Var, ValAry, y%total_SDgenpwr) ! Scalar + case (DWM_y_mean_SDgenpwr) + call MV_Unpack2(Var, ValAry, y%mean_SDgenpwr) ! Scalar + case (DWM_y_avg_ct) + call MV_Unpack2(Var, ValAry, y%avg_ct) ! Scalar + case (DWM_y_IfW_VelocityUVW) + call MV_Unpack2(Var, ValAry, y%IfW%VelocityUVW) ! Rank 2 Array + case (DWM_y_IfW_AccelUVW) + call MV_Unpack2(Var, ValAry, y%IfW%AccelUVW) ! Rank 2 Array + case (DWM_y_IfW_WriteOutput) + call MV_Unpack2(Var, ValAry, y%IfW%WriteOutput) ! Rank 1 Array + case (DWM_y_IfW_DiskVel) + call MV_Unpack2(Var, ValAry, y%IfW%DiskVel) ! Rank 1 Array + case (DWM_y_IfW_HubVel) + call MV_Unpack2(Var, ValAry, y%IfW%HubVel) ! Rank 1 Array + case (DWM_y_IfW_lidar_LidSpeed) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%LidSpeed) ! Rank 1 Array + case (DWM_y_IfW_lidar_WtTrunc) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%WtTrunc) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsX) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsX) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsY) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsY) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsZ) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsZ) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE DWM_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index ca5e3af53c..eb1e633843 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -53,10 +53,6 @@ MODULE BeamDyn PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT - PUBLIC :: BD_PackContStateQuatOP, BD_UnpackContStateQuatOP - PUBLIC :: BD_PackInputOP, BD_UnpackInputOP - PUBLIC :: BD_PackOutputOP - ! The original formulation kept all states in the inertial reference frame. This has been leading to convergence issues ! when there is a large rotational change from the reference frame (i.e. large turbine yaw, large blade pitch). During ! the development of the tight coupling algorithm for OpenFAST, we decided to try changing all the states in BeamDyn to @@ -5850,40 +5846,44 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) do i = 2, p%node_total label = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldTransDisp, & + DatLoc(BD_x_q), iAry=1, jAry=i, & Num=3, & Flags=Flags, & - iUsr=i, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(label)//' translational displacement in X, m', & trim(label)//' translational displacement in Y, m', & trim(label)//' translational displacement in Z, m']) + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldOrientation, & + DatLoc(BD_x_q), iAry=4, jAry=i, & Num=3, & Flags=Flags, & - iUsr=i, & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(label)//' rotational displacement in X, rad', & trim(label)//' rotational displacement in Y, rad', & trim(label)//' rotational displacement in Z, rad']) end do - ! Add translation velocity and angular velocity at blade nodes + ! Add translation and angular velocity at blade nodes do i = 2, p%node_total label = 'First time derivative of finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldTransVel, & + DatLoc(BD_x_dqdt), iAry=1, jAry=i, & Num=3, & Flags=Flags, & - iUsr=i, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(label)//' translational displacement in X, m/s', & trim(label)//' translational displacement in Y, m/s', & trim(label)//' translational displacement in Z, m/s']) + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldAngularVel, & + DatLoc(BD_x_dqdt), iAry=4, jAry=i, & Num=3, & Flags=Flags, & - iUsr=i, & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(label)//' rotational displacement in X, rad/s', & trim(label)//' rotational displacement in Y, rad/s', & @@ -5898,7 +5898,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) MaxTorque = 14.0_R8Ki*p%blade_length**3 call MV_AddMeshVar(p%Vars%u, "RootMotion", MotionFields, & - VarIdx=p%iVarRootMotion, & + DatLoc(BD_u_RootMotion), & Mesh=u%RootMotion, & Perturbs=[0.2_R8Ki*D2R_D * p%blade_length, & ! FieldTransDisp 0.2_R8Ki*D2R_D, & ! FieldOrientation @@ -5906,13 +5906,15 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) 0.2_R8Ki*D2R_D, & ! FieldAngularVel 0.2_R8Ki*D2R_D * p%blade_length, & ! FieldTransAcc 0.2_R8Ki*D2R_D]) ! FieldAngularAcc + call MV_AddMeshVar(p%Vars%u, "PointLoad", LoadFields, & - VarIdx=p%iVarPointLoad, & + DatLoc(BD_u_PointLoad), & Mesh=u%PointLoad, & Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! FieldForce MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! FieldMoment + call MV_AddMeshVar(p%Vars%u, "DistrLoad", LoadFields, & - VarIdx=p%iVarDistrLoad, & + DatLoc(BD_u_DistrLoad), & Flags=ior(VF_Line, VF_AeroMap), & Mesh=u%DistrLoad, & Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! FieldForce @@ -5922,28 +5924,19 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Output variables !---------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, 'Reaction force', LoadFields, & - VarIdx=p%iVarReactionForce, & - Mesh=y%ReactionForce) + call MV_AddMeshVar(p%Vars%y, 'Reaction force', LoadFields, DatLoc(BD_y_ReactionForce), Mesh=y%ReactionForce) - call MV_AddMeshVar(p%Vars%y, 'Blade motion', MotionFields, & - VarIdx=p%iVarBldMotion, & + call MV_AddMeshVar(p%Vars%y, 'Blade motion', [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & + DatLoc(BD_y_BldMotion), & + Flags=VF_AeroMap, & + Mesh=y%BldMotion) + call MV_AddMeshVar(p%Vars%y, 'Blade motion', [FieldTransAcc, FieldAngularAcc], DatLoc(BD_y_BldMotion), & Mesh=y%BldMotion) - if (p%CompAeroMaps) then - do i = p%iVarBldMotion, size(p%Vars%y) - select case (p%Vars%y(i)%Field) - case (FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel) - call MV_SetFlags(p%Vars%y(i), VF_AeroMap) - end select - end do - end if - p%iVarWriteOutput = size(p%Vars%y) + 1 do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & - VarIdx = j, & + DatLoc(BD_y_WriteOutput), iAry=i, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & - iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & Active=p%OutParam(i)%Indx > 0) end do @@ -5951,10 +5944,9 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) idx = p%NumOuts + 1 do i = 1, p%BldNd_NumOuts call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, FieldScalar, & - VarIdx = j, & + DatLoc(BD_y_WriteOutput), iAry=idx, & Num=size(p%BldNd_BlOutNd), & Flags=VF_WriteOut + BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & - iUsr=idx, & LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & Active=p%BldNd_OutParam(i)%Indx > 0) idx = idx + size(p%BldNd_BlOutNd) @@ -6009,105 +6001,89 @@ logical function Failed() end function Failed end subroutine -subroutine BD_PackContStateQuatOP(p, x, Values) - type(BD_ParameterType), intent(in) :: p +subroutine BD_PackContStateAryQuat(Vars, x, ValAry) + type(ModVarsType), intent(in) :: Vars type(BD_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: Values(:) - real(R8Ki) :: quat(3) + real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i - do i = 1, size(p%Vars%x) - associate (Var => p%Vars%x(i)) - select case(Var%Field) - case (FieldTransDisp) - Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ displacement - case (FieldOrientation) - quat = wm_to_quat(wm_inv(x%q(4:6,Var%iUsr(1)))) - Values(Var%iLoc(1):Var%iLoc(2)) = quat ! WM to quaternion - case (FieldTransVel) - Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ velocity - case (FieldAngularVel) - Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular velocity - end select - end associate + call BD_PackContStateAry(Vars, x, ValAry) + do i = 1, size(Vars%x) + if (Vars%x(i)%Field == FieldOrientation) then + associate(Var => Vars%x(i)) + ValAry(Var%iLoc(1):Var%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, Var%jAry))) + end associate + end if end do end subroutine -subroutine BD_UnpackContStateQuatOP(p, Values, x) - type(BD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Values(:) +subroutine BD_UnpackContStateAryQuat(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(BD_ContinuousStateType), intent(inout) :: x - real(R8Ki) :: wm(3) integer(IntKi) :: i - do i = 1, size(p%Vars%x) - associate (Var => p%Vars%x(i)) - select case(Var%Field) - case (FieldTransDisp) - x%q(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ displacement - case (FieldOrientation) - wm = wm_inv(quat_to_wm(Values(Var%iLoc(1):Var%iLoc(2)))) - x%q(4:6,Var%iUsr(1)) = wm ! Quaternion to WM - case (FieldTransVel) - x%dqdt(1:3,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! XYZ velocity - case (FieldAngularVel) - x%dqdt(4:6,Var%iUsr(1)) = Values(Var%iLoc(1):Var%iLoc(2)) ! Angular velocity - end select - end associate - end do -end subroutine - -subroutine BD_PackContStateOP(p, x, Values) - type(BD_ParameterType), intent(in) :: p - type(BD_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: Values(:) - integer(IntKi) :: i - do i = 1, size(p%Vars%x) - associate (Var => p%Vars%x(i)) - select case(Var%Field) - case (FieldTransDisp) - Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ velocity - case (FieldOrientation) - Values(Var%iLoc(1):Var%iLoc(2)) = x%q(4:6,Var%iUsr(1)) ! Angular velocity - case (FieldTransVel) - Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ acceleration - case (FieldAngularVel) - Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular acceleration - end select - end associate + call BD_UnpackContStateAry(Vars, ValAry, x) + do i = 1, size(Vars%x) + if (Vars%x(i)%Field == FieldOrientation) then + associate(Var => Vars%x(i)) + x%q(4:6, Var%jAry) = wm_inv(quat_to_wm(ValAry(Var%iLoc(1):Var%iLoc(2)))) + end associate + end if end do end subroutine -subroutine BD_PackInputOP(p, u, Values) - type(BD_ParameterType), intent(in) :: p - type(BD_InputType), intent(in) :: u - real(R8Ki), intent(out) :: Values(:) - call MV_Pack(p%Vars%u, p%iVarRootMotion, u%RootMotion, Values) - call MV_Pack(p%Vars%u, p%iVarPointLoad, u%PointLoad, Values) - call MV_Pack(p%Vars%u, p%iVarDistrLoad, u%DistrLoad, Values) -end subroutine - -subroutine BD_UnpackInputOP(p, Ary, u) - type(BD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Ary(:) - type(BD_InputType), intent(inout) :: u - call MV_Unpack(p%Vars%u, p%iVarRootMotion, Ary, u%RootMotion) - call MV_Unpack(p%Vars%u, p%iVarPointLoad, Ary, u%PointLoad) - call MV_Unpack(p%Vars%u, p%iVarDistrLoad, Ary, u%DistrLoad) -end subroutine - -subroutine BD_PackOutputOP(p, y, Ary, PackWriteOutput) - type(BD_ParameterType), intent(in) :: p - type(BD_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: Ary(:) - logical, intent(in) :: PackWriteOutput - integer(IntKi) :: i - call MV_Pack(p%Vars%y, p%iVarReactionForce, y%ReactionForce, Ary) - call MV_Pack(p%Vars%y, p%iVarBldMotion, y%BldMotion, Ary) - if (PackWriteOutput) then - do i = p%iVarWriteOutput, size(p%Vars%y) - call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) - end do - end if -end subroutine +! subroutine BD_PackContStateOP(p, x, Values) +! type(BD_ParameterType), intent(in) :: p +! type(BD_ContinuousStateType), intent(in) :: x +! real(R8Ki), intent(out) :: Values(:) +! integer(IntKi) :: i +! do i = 1, size(p%Vars%x) +! associate (Var => p%Vars%x(i)) +! select case(Var%Field) +! case (FieldTransDisp) +! Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ velocity +! case (FieldOrientation) +! Values(Var%iLoc(1):Var%iLoc(2)) = x%q(4:6,Var%iUsr(1)) ! Angular velocity +! case (FieldTransVel) +! Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ acceleration +! case (FieldAngularVel) +! Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular acceleration +! end select +! end associate +! end do +! end subroutine + +! subroutine BD_PackInputOP(p, u, Values) +! type(BD_ParameterType), intent(in) :: p +! type(BD_InputType), intent(in) :: u +! real(R8Ki), intent(out) :: Values(:) +! call MV_Pack(p%Vars%u, p%iVarRootMotion, u%RootMotion, Values) +! call MV_Pack(p%Vars%u, p%iVarPointLoad, u%PointLoad, Values) +! call MV_Pack(p%Vars%u, p%iVarDistrLoad, u%DistrLoad, Values) +! end subroutine + +! subroutine BD_UnpackInputOP(p, Ary, u) +! type(BD_ParameterType), intent(in) :: p +! real(R8Ki), intent(in) :: Ary(:) +! type(BD_InputType), intent(inout) :: u +! call MV_Unpack(p%Vars%u, p%iVarRootMotion, Ary, u%RootMotion) +! call MV_Unpack(p%Vars%u, p%iVarPointLoad, Ary, u%PointLoad) +! call MV_Unpack(p%Vars%u, p%iVarDistrLoad, Ary, u%DistrLoad) +! end subroutine + +! subroutine BD_PackOutputOP(p, y, Ary, PackWriteOutput) +! type(BD_ParameterType), intent(in) :: p +! type(BD_OutputType), intent(in) :: y +! real(R8Ki), intent(out) :: Ary(:) +! logical, intent(in) :: PackWriteOutput +! integer(IntKi) :: i +! call MV_Pack(p%Vars%y, p%iVarReactionForce, y%ReactionForce, Ary) +! call MV_Pack(p%Vars%y, p%iVarBldMotion, y%BldMotion, Ary) +! if (PackWriteOutput) then +! do i = p%iVarWriteOutput, size(p%Vars%y) +! call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) +! end do +! end if +! end subroutine !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ###### The following four routines are Jacobian routines for linearization capabilities ####### @@ -6115,7 +6091,7 @@ subroutine BD_PackOutputOP(p, y, Ary, PackWriteOutput) !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6132,7 +6108,7 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Filter variables by flag value + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] @@ -6143,19 +6119,19 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM character(ErrMsgLen) :: ErrMsg2 REAL(R8Ki) :: RotateStates(3,3) logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col + type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + ! If vars were provided use them, otherwise use module variables + if (present(Vars)) then + VarsL => Vars + IsFullLin = size(Vars%y) == size(p%Vars%y) else + VarsL => p%Vars IsFullLin = .true. - FlagFilterLoc = VF_None end if ! Get OP values here @@ -6163,42 +6139,39 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Make a copy of the inputs to perturb call BD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackInputOP(p, u, m%Jac%u) + call BD_PackInputAry(VarsL, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%u) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call BD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call BD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do @@ -6209,35 +6182,32 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%u) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) + call BD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) + call BD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%u(i)%Perturb) end do end do @@ -6275,7 +6245,7 @@ END SUBROUTINE BD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, dXddx, dZdx, StateRotation ) +SUBROUTINE BD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx, StateRotation) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6292,7 +6262,7 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) @@ -6305,24 +6275,24 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki) :: RotateStates(3,3) REAL(R8Ki) :: RotateStatesTranspose(3,3) logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col + type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + ! If vars were provided use them, otherwise use module variables + if (present(Vars)) then + VarsL => Vars + IsFullLin = size(Vars%y) == size(p%Vars%y) else + VarsL => p%Vars IsFullLin = .true. - FlagFilterLoc = VF_None end if ! Copy state values call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateQuatOP(p, x, m%Jac%x) + call BD_PackContStateAryQuat(VarsL, x, m%Jac%x) ! If rotate states is enabled if (p%RotStates) then @@ -6349,41 +6319,38 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, VarsL%Ny, VarsL%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%x) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, VarsL%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateQuatOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackContStateAryQuat(VarsL, m%Jac%x_perturb, m%x_perturb) call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call BD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateQuatOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackContStateAryQuat(VarsL, m%Jac%x_perturb, m%x_perturb) call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call BD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = VarsL%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do ! If rotate state is enabled, modify Jacobian if (p%RotStates) then - do i=1,size(dYdx,2),3 + do i = 1, size(dYdx,2), 3 dYdx(:, i:i+2) = matmul( dYdx(:, i:i+2), RotateStatesTranspose) end do end if @@ -6397,35 +6364,32 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%x) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, VarsL%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateQuatOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackContStateAryQuat(VarsL, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) + call BD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateQuatOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackContStateAryQuat(VarsL, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) + call BD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = VarsL%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%x(i)%Perturb) end do end do @@ -6594,7 +6558,7 @@ SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE BD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) +SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6607,7 +6571,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable index number + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states @@ -6620,17 +6584,16 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 LOGICAL :: ReturnTrimOP - logical :: IsFullLin INTEGER(IntKi) :: i - + type(ModVarsType), pointer :: VarsL + ErrStat = ErrID_None ErrMsg = '' - - ! Get variable index based on optional argument - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None + + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. + VarsL => p%Vars end if !---------------------------------------------------------------------------- @@ -6638,10 +6601,10 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackInputOP(p, u, u_op) + call BD_PackInputAry(VarsL, u, u_op) end if @@ -6650,10 +6613,10 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackOutputOP(p, y, y_op, IsFullLin) + call BD_PackOutputAry(VarsL, y, y_op) end if @@ -6662,10 +6625,10 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call BD_PackContStateOP(p, x, x_op) + call BD_PackContStateAry(VarsL, x, x_op) end if @@ -6674,11 +6637,11 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagF if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dx_op, VarsL%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return end if call BD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateOP(p, m%dxdt_lin, dx_op) + call BD_PackContStateAry(VarsL, m%dxdt_lin, dx_op) end if diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 6037ec12a5..fd2e03c750 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -39,12 +39,6 @@ MODULE BeamDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_FE = 1 ! Constant for creating y%BldMotion at the FE (GLL) nodes [-] INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_QP = 2 ! Constant for creating y%BldMotion at the quadrature nodes [-] INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_STATIONS = 3 ! Constant for creating y%BldMotion at the blade property input stations [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_u_RootMotion = 1 ! Mesh number for BD BD_u_RootMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_u_PointLoad = 2 ! Mesh number for BD BD_u_PointLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_u_DistrLoad = 3 ! Mesh number for BD BD_u_DistrLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_u_HubMotion = 4 ! Mesh number for BD BD_u_HubMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_y_ReactionForce = 5 ! Mesh number for BD BD_y_ReactionForce mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_y_BldMotion = 6 ! Mesh number for BD BD_y_BldMotion mesh [-] ! ========= BD_InitInputType ======= TYPE, PUBLIC :: BD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] @@ -166,12 +160,6 @@ MODULE BeamDyn_Types ! ========= BD_ParameterType ======= TYPE, PUBLIC :: BD_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarRootMotion = 0_IntKi !< Root motion variable index [-] - INTEGER(IntKi) :: iVarPointLoad = 0_IntKi !< Point load variable index [-] - INTEGER(IntKi) :: iVarDistrLoad = 0_IntKi !< Distributed load variable index [-] - INTEGER(IntKi) :: iVarReactionForce = 0_IntKi !< Reaction force variable index [-] - INTEGER(IntKi) :: iVarBldMotion = 0_IntKi !< Blade motion variable index [-] - INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Write output variable index [-] REAL(DbKi) :: dt = 0.0_R8Ki !< module dt [s] REAL(DbKi) , DIMENSION(1:9) :: coef = 0.0_R8Ki !< GA2 Coefficient [-] REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical Damping Coefficient for GA2 [-] @@ -345,7 +333,20 @@ MODULE BeamDyn_Types TYPE(BD_OutputType) :: y_lin !< [-] END TYPE BD_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: BD_x_q = 1 ! BD%q + integer(IntKi), public, parameter :: BD_x_dqdt = 2 ! BD%dqdt + integer(IntKi), public, parameter :: BD_z_DummyConstrState = 3 ! BD%DummyConstrState + integer(IntKi), public, parameter :: BD_u_RootMotion = 4 ! BD%RootMotion + integer(IntKi), public, parameter :: BD_u_PointLoad = 5 ! BD%PointLoad + integer(IntKi), public, parameter :: BD_u_DistrLoad = 6 ! BD%DistrLoad + integer(IntKi), public, parameter :: BD_u_HubMotion = 7 ! BD%HubMotion + integer(IntKi), public, parameter :: BD_y_ReactionForce = 8 ! BD%ReactionForce + integer(IntKi), public, parameter :: BD_y_BldMotion = 9 ! BD%BldMotion + integer(IntKi), public, parameter :: BD_y_RootMxr = 10 ! BD%RootMxr + integer(IntKi), public, parameter :: BD_y_RootMyr = 11 ! BD%RootMyr + integer(IntKi), public, parameter :: BD_y_WriteOutput = 12 ! BD%WriteOutput + +contains subroutine BD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(BD_InitInputType), intent(in) :: SrcInitInputData @@ -1340,12 +1341,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarRootMotion = SrcParamData%iVarRootMotion - DstParamData%iVarPointLoad = SrcParamData%iVarPointLoad - DstParamData%iVarDistrLoad = SrcParamData%iVarDistrLoad - DstParamData%iVarReactionForce = SrcParamData%iVarReactionForce - DstParamData%iVarBldMotion = SrcParamData%iVarBldMotion - DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput DstParamData%dt = SrcParamData%dt DstParamData%coef = SrcParamData%coef DstParamData%rhoinf = SrcParamData%rhoinf @@ -1842,12 +1837,6 @@ subroutine BD_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarRootMotion) - call RegPack(RF, InData%iVarPointLoad) - call RegPack(RF, InData%iVarDistrLoad) - call RegPack(RF, InData%iVarReactionForce) - call RegPack(RF, InData%iVarBldMotion) - call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%dt) call RegPack(RF, InData%coef) call RegPack(RF, InData%rhoinf) @@ -1968,12 +1957,6 @@ subroutine BD_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarRootMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPointLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDistrLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarReactionForce); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarBldMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%coef); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%rhoinf); if (RegCheckErr(RF, RoutineName)) return @@ -3770,7 +3753,7 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err function BD_InputMeshPointer(u, ML) result(Mesh) type(BD_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -3786,7 +3769,7 @@ function BD_InputMeshPointer(u, ML) result(Mesh) end function function BD_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -3803,7 +3786,7 @@ function BD_InputMeshName(ML) result(Name) function BD_OutputMeshPointer(y, ML) result(Mesh) type(BD_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -3815,7 +3798,7 @@ function BD_OutputMeshPointer(y, ML) result(Mesh) end function function BD_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -3825,5 +3808,157 @@ function BD_OutputMeshName(ML) result(Name) Name = "y%BldMotion" end select end function + +subroutine BD_PackContStateAry(Vars, x, ValAry) + type(BD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (BD_x_q) + call MV_Pack2(Var, x%q, ValAry) ! Rank 2 Array + case (BD_x_dqdt) + call MV_Pack2(Var, x%dqdt, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine BD_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (BD_x_q) + call MV_Unpack2(Var, ValAry, x%q) ! Rank 2 Array + case (BD_x_dqdt) + call MV_Unpack2(Var, ValAry, x%dqdt) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine BD_PackConstrStateAry(Vars, z, ValAry) + type(BD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (BD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine BD_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (BD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine BD_PackInputAry(Vars, u, ValAry) + type(BD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (BD_u_RootMotion) + call MV_Pack2(Var, u%RootMotion, ValAry) ! Mesh + case (BD_u_PointLoad) + call MV_Pack2(Var, u%PointLoad, ValAry) ! Mesh + case (BD_u_DistrLoad) + call MV_Pack2(Var, u%DistrLoad, ValAry) ! Mesh + case (BD_u_HubMotion) + call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine BD_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (BD_u_RootMotion) + call MV_Unpack2(Var, ValAry, u%RootMotion) ! Mesh + case (BD_u_PointLoad) + call MV_Unpack2(Var, ValAry, u%PointLoad) ! Mesh + case (BD_u_DistrLoad) + call MV_Unpack2(Var, ValAry, u%DistrLoad) ! Mesh + case (BD_u_HubMotion) + call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh + end select + end associate + end do +end subroutine + +subroutine BD_PackOutputAry(Vars, y, ValAry) + type(BD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (BD_y_ReactionForce) + call MV_Pack2(Var, y%ReactionForce, ValAry) ! Mesh + case (BD_y_BldMotion) + call MV_Pack2(Var, y%BldMotion, ValAry) ! Mesh + case (BD_y_RootMxr) + call MV_Pack2(Var, y%RootMxr, ValAry) ! Scalar + case (BD_y_RootMyr) + call MV_Pack2(Var, y%RootMyr, ValAry) ! Scalar + case (BD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine BD_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (BD_y_ReactionForce) + call MV_Unpack2(Var, ValAry, y%ReactionForce) ! Mesh + case (BD_y_BldMotion) + call MV_Unpack2(Var, ValAry, y%BldMotion) ! Mesh + case (BD_y_RootMxr) + call MV_Unpack2(Var, ValAry, y%RootMxr) ! Scalar + case (BD_y_RootMyr) + call MV_Unpack2(Var, ValAry, y%RootMyr) ! Scalar + case (BD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE BeamDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index facc5b45cf..33ab1808f6 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -166,12 +166,6 @@ typedef ^ ^ ^ mEta ::: - - "Center of ma # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ParameterType IntKi iVarRootMotion - - - "Root motion variable index" -typedef ^ ParameterType IntKi iVarPointLoad - - - "Point load variable index" -typedef ^ ParameterType IntKi iVarDistrLoad - - - "Distributed load variable index" -typedef ^ ParameterType IntKi iVarReactionForce - - - "Reaction force variable index" -typedef ^ ParameterType IntKi iVarBldMotion - - - "Blade motion variable index" -typedef ^ ParameterType IntKi iVarWriteOutput - - - "Write output variable index" typedef ^ ParameterType DbKi dt - - - "module dt" s typedef ^ ParameterType DbKi coef {9} - - "GA2 Coefficient" - typedef ^ ParameterType DbKi rhoinf - - - "Numerical Damping Coefficient for GA2" diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 318efdc61f..f7c59f4e22 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -65,10 +65,6 @@ MODULE ElastoDyn PUBLIC :: ED_GetOP ! Routine to pack the operating point values (for linearization) into arrays PUBLIC :: ED_SetOP ! Routine to unpack the operating point values from arrays - PUBLIC :: ED_PackContStateOP, ED_UnpackContStateOP - PUBLIC :: ED_PackInputOP, ED_UnpackInputOP - PUBLIC :: ED_PackOutputOP - PUBLIC :: ED_UpdateAzimuth CONTAINS @@ -10649,7 +10645,7 @@ END SUBROUTINE FixYawFric !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter ) +SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -10666,133 +10662,151 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] - integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation + CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc integer(IntKi) :: i, j, col + integer(IntKi) :: iVarBlPitchCom, iVarBlPitchComC + type(ModVarsType), pointer :: VarsL - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function - - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars end if + m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function + + ! Initialize pitch command variable indices + iVarBlPitchCom = 0 + iVarBlPitchComC = 0 + do i = 1, size(VarsL%u) + select case (VarsL%u(i)%DL%Num) + case (ED_u_BlPitchCom) + iVarBlPitchCom = i + case (ED_u_BlPitchComC) + iVarBlPitchComC = i + cycle + end select + end do + ! Update copy of the inputs to perturb call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackInputOP(p, u, m%Jac%u) + call ED_PackInputAry(VarsL, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) + do i = 1, size(VarsL%u) - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle - - ! Extended input: BlPitchComC is the sum of BlPitchCom across all blades - if (i == p%iVarBlPitchComC) then - associate (Var => p%Vars%u(p%iVarBlPitchCom)) - dYdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) - end associate - cycle - end if + ! Skip extended variable + if (i == iVarBlPitchComC) cycle ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call ED_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call ED_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + if (iVarBlPitchComC > 0) then + if (iVarBlPitchCom > 0) then + associate (Var => VarsL%u(iVarBlPitchCom)) + dYdu(:,VarsL%u(iVarBlPitchComC)%iLoc(1)) = sum(dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate + else + dYdu(:,VarsL%u(iVarBlPitchComC)%iLoc(1)) = 0.0_R8Ki + end if + end if end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - if (present(dXdu) .and. (p%Vars%Nx > 0)) then + if (present(dXdu) .and. (VarsL%Nx > 0)) then ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) + do i = 1, size(VarsL%u) - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + ! Skip extended variable + if (i == iVarBlPitchComC) cycle ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) + call ED_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) + call ED_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%u(i)%Perturb) end do end do ! Extended: BlPitchComC is the sum of BlPitchCom across all blades - associate (Var => p%Vars%u(p%iVarBlPitchCom)) - dXdu(:,p%Vars%u(p%iVarBlPitchComC)%iLoc(1)) = sum(dXdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) - end associate + if (iVarBlPitchComC > 0) then + if (iVarBlPitchCom > 0) then + associate (Var => VarsL%u(iVarBlPitchCom)) + dXdu(:,VarsL%u(iVarBlPitchComC)%iLoc(1)) = sum(dXdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate + else + dXdu(:,VarsL%u(iVarBlPitchComC)%iLoc(1)) = 0.0_R8Ki + end if + end if end if - if ( present( dXddu ) ) then + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) end if - if ( present( dZdu ) ) then + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) end if @@ -10807,12 +10821,11 @@ logical function Failed() subroutine cleanup() m%IgnoreMod = .false. end subroutine cleanup - END SUBROUTINE ED_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -10829,7 +10842,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable flag filter + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] @@ -10841,24 +10854,22 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, logical :: IsFullLin integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col - - ! Initialize ErrStat + type(ModVarsType), pointer :: VarsL + ErrStat = ErrID_None ErrMsg = '' - m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function - - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars end if + m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function + ! Copy state values call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateOP(p, x, m%Jac%x) + call ED_PackContStateAry(VarsL, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then @@ -10871,23 +10882,20 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Loop through state variables do i = 1, size(p%Vars%x) - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle - ! Loop through number of linearization perturbations in variable do j = 1, p%Vars%x(i)%Num ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputOP(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call ED_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call ED_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputOP(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call ED_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index col = p%Vars%x(i)%iLoc(1) + j - 1 @@ -10900,39 +10908,36 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - if (present(dXdx) .and. (p%Vars%Nx > 0)) then + if (present(dXdx) .and. (VarsL%Nx > 0)) then ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%x) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, VarsL%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_pos) + call ED_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateOP(p, m%dxdt_lin, m%Jac%x_neg) + call ED_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = VarsL%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%x(i)%Perturb) end do end do @@ -11105,7 +11110,7 @@ END SUBROUTINE ED_JacobianPConstrState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP, FlagFilter ) +SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -11118,6 +11123,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states @@ -11125,39 +11131,37 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Filter variables by flag CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin INTEGER(IntKi) :: i, k - - ! Initialize ErrStat + type(ModVarsType), pointer :: VarsL + ErrStat = ErrID_None ErrMsg = '' - - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None + + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. + VarsL => p%Vars end if !.................................. if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return + u_op = 0.0_R8Ki end if ! Pack input type into array - call ED_PackInputOP(p, u, u_op) + call ED_PackInputAry(VarsL, u, u_op) ! If full linearization, check extended inputs - if (IsFullLin) then + if (MV_FindVarDatLoc(VarsL%u, ED_u_BlPitchComC) > 0) then do k = 2,p%NumBl - if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then + if (.not. EqualRealNos(u%BlPitchCom(1), u%BlPitchCom(k)) ) then call SetErrStat(ErrID_Info, "Operating point of collective pitch extended input is invalid because "// & "the commanded blade pitch angles are not the same for each blade.", ErrStat, ErrMsg, RoutineName) exit @@ -11170,10 +11174,11 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + y_op = 0.0_R8Ki end if - call ED_PackOutputOP(p, y, y_op, IsFullLin) + call ED_PackOutputAry(VarsL, y, y_op) end if @@ -11181,10 +11186,11 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return + x_op = 0.0_R8Ki end if - call ED_PackContStateOP(p, x, x_op) + call ED_PackContStateAry(VarsL, x, x_op) end if @@ -11192,11 +11198,12 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dx_op, VarsL%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return + dx_op = 0.0_R8Ki end if call ED_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateOP(p, m%dxdt_lin, dx_op) + call ED_PackContStateAry(VarsL, m%dxdt_lin, dx_op) end if @@ -11217,21 +11224,30 @@ END SUBROUTINE ED_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> ED_SetOP sets input and state values from an array. Inverse of ED_GetOP -subroutine ED_SetOP(u, p, x, xd, z, u_op, x_op, xd_op, z_op) +subroutine ED_SetOP(u, p, x, xd, z, Vars, u_op, x_op, xd_op, z_op) TYPE(ED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(ED_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point TYPE(ED_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states at operating point TYPE(ED_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - if (present(u_op)) call ED_UnpackInputOP(p, u_op, u) - if (present(x_op)) call ED_UnpackContStateOP(p, x_op, x) - ! if (present(xd_op)) call ED_UnpackDiscStateOP(p, xd, xd_op) - ! if (present(z_op)) call ED_UnpackDiscStateOP(p, z, z_op) + type(ModVarsType), pointer :: VarsL + + if (present(Vars)) then + VarsL => Vars + else + VarsL => p%Vars + end if + + if (present(u_op)) call ED_UnpackInputAry(VarsL, u_op, u) + if (present(x_op)) call ED_UnpackContStateAry(VarsL, x_op, x) + ! if (present(xd_op)) call ED_UnpackDiscStateAry(VarsL, xd, xd_op) + ! if (present(z_op)) call ED_UnpackDiscStateAry(VarsL, z, z_op) END subroutine !---------------------------------------------------------------------------------------------------------------------------------- @@ -11280,153 +11296,147 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat ! Add continuous state variables (translation and rotation) call MV_AddVar(p%Vars%x, 'PlatformSurge', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Sg, & Flags=VF_DerivOrder2, & - iUsr=DOF_Sg, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal surge translation DOF (internal DOF index = DOF_Sg), m'], & Active=InputFileData%PtfmSgDOF) call MV_AddVar(p%Vars%x, 'PlatformSway', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Sw, & Flags=VF_DerivOrder2, & - iUsr=DOF_Sw, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal sway translation DOF (internal DOF index = DOF_Sw), m'], & Active=InputFileData%PtfmSwDOF) call MV_AddVar(p%Vars%x, 'PlatformHeave', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Hv, & Flags=VF_DerivOrder2, & - iUsr=DOF_Hv, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform vertical heave translation DOF (internal DOF index = DOF_Hv), m'], & Active=InputFileData%PtfmHvDOF) call MV_AddVar(p%Vars%x, 'PlatformRoll', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_R, & Flags=VF_DerivOrder2, & - iUsr=DOF_R, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform roll tilt rotation DOF (internal DOF index = DOF_R), rad'], & Active=InputFileData%PtfmRDOF) call MV_AddVar(p%Vars%x, 'PlatformPitch', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_P, & Flags=VF_DerivOrder2, & - iUsr=DOF_P, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform pitch tilt rotation DOF (internal DOF index = DOF_P), rad'], & Active=InputFileData%PtfmPDOF) call MV_AddVar(p%Vars%x, 'PlatformYaw', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Y, & Flags=VF_DerivOrder2, & - iUsr=DOF_Y, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform yaw rotation DOF (internal DOF index = DOF_Y), rad'], & Active=InputFileData%PtfmYDOF) call MV_AddVar(p%Vars%x, 'TowerFA1', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TFA1, & Flags=VF_DerivOrder2, & - iUsr=DOF_TFA1, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower fore-aft bending mode DOF (internal DOF index = DOF_TFA1), m'], & Active=InputFileData%TwFADOF1) call MV_AddVar(p%Vars%x, 'TowerSS1', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TSS1, & Flags=VF_DerivOrder2, & - iUsr=DOF_TSS1, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower side-to-side bending mode DOF (internal DOF index = DOF_TSS1), m'], & Active=InputFileData%TwSSDOF1) call MV_AddVar(p%Vars%x, 'TowerFA2', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TFA2, & Flags=VF_DerivOrder2, & - iUsr=DOF_TFA2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower fore-aft bending mode DOF (internal DOF index = DOF_TFA2), m'], & Active=InputFileData%TwFADOF2) call MV_AddVar(p%Vars%x, 'TowerSS2', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TSS2, & Flags=VF_DerivOrder2, & - iUsr=DOF_TSS2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower side-to-side bending mode DOF (internal DOF index = DOF_TSS2), m'], & Active=InputFileData%TwSSDOF2) call MV_AddVar(p%Vars%x, 'NacelleYaw', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Yaw, & Flags=VF_DerivOrder2, & - iUsr=DOF_Yaw, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Nacelle yaw DOF (internal DOF index = DOF_Yaw), rad'], & Active=InputFileData%YawDOF) call MV_AddVar(p%Vars%x, 'RotorFurl', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_RFrl, & Flags=VF_DerivOrder2 + VF_AeroMap, & - iUsr=DOF_RFrl, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Rotor-furl DOF (internal DOF index = DOF_RFrl), rad'], & Active=InputFileData%RFrlDOF) call MV_AddVar(p%Vars%x, 'GeneratorAzimuth', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_GeAz, & Flags=VF_DerivOrder2, & - iUsr=DOF_GeAz, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Variable speed generator DOF (internal DOF index = DOF_GeAz), rad'], & Active=InputFileData%GenDOF) call MV_AddVar(p%Vars%x, 'DrivetrainFlexibility', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_DrTr, & Flags=VF_DerivOrder2, & - iUsr=DOF_DrTr, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Drivetrain rotational-flexibility DOF (internal DOF index = DOF_DrTr), rad'], & Active=InputFileData%DrTrDOF) call MV_AddVar(p%Vars%x, 'TailFurl', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TFrl, & Flags=VF_DerivOrder2 + VF_AeroMap, & - iUsr=DOF_TFrl, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Tail-furl DOF (internal DOF index = DOF_TFrl), rad'], & Active=InputFileData%TFrlDOF) call MV_AddVar(p%Vars%x, 'RotorTeeter', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Teet, & Flags=VF_DerivOrder2, & - iUsr=DOF_Teet, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Hub teetering DOF (internal DOF index = DOF_Teet), rad'], & Active=InputFileData%TeetDOF) - call AllocAry(p%iVarBladeFlap1, p%NumBl, 'iVarBladeFlap1', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', FieldTransDisp, & - VarIdx=p%iVarBladeFlap1(i), & + DL=DatLoc(ED_x_QT), iAry=DOF_BF(i,1), & Flags=Flags, & - iUsr=DOF_BF(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & LinNames=['1st flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',1)), m'], & Active=InputFileData%FlapDOF1) end do - call AllocAry(p%iVarBladeEdge1, p%NumBl, 'iVarBladeEdge1', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', FieldTransDisp, & - VarIdx=p%iVarBladeEdge1(i), & + DL=DatLoc(ED_x_QT), iAry=DOF_BE(i,1), & Flags=Flags, & - iUsr=DOF_BE(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & LinNames=['1st edgewise bending-mode DOF of blade '//trim(Num2LStr(i))//& ' (internal DOF index = DOF_BE('//trim(Num2LStr(i))//',1)), m'], & Active=InputFileData%EdgeDOF) end do - call AllocAry(p%iVarBladeFlap2, p%NumBl, 'iVarBladeFlap2', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', FieldTransDisp, & - VarIdx=p%iVarBladeFlap2(i), & + DL=DatLoc(ED_x_QT), iAry=DOF_BF(i,2), & Flags=Flags, & - iUsr=DOF_BF(i,2), & Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & LinNames=['2nd flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',2)), m'], & @@ -11450,15 +11460,13 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat ! Add variable (only active variables are in x) call MV_AddVar(p%Vars%x, p%Vars%x(i)%Name, Field, & - VarIdx=j, & + DatLoc(ED_x_QDT), iAry=p%Vars%x(i)%iAry(1), & Flags=p%Vars%x(i)%Flags, & - iUsr=p%Vars%x(i)%iUsr(1), & Perturb=p%Vars%x(i)%Perturb, & LinNames=['First time derivative of '//trim(p%Vars%x(i)%LinNames(1))//'/s']) ! Remove aero map flag from velocity variable - call MV_ClearFlags(p%Vars%x(j), VF_AeroMap) - + call MV_ClearFlags(p%Vars%x(size(p%Vars%x)), VF_AeroMap) end do end if @@ -11474,79 +11482,75 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat ! Blade Point Loads if (allocated(u%BladePtLoads)) then - CALL AllocAry(p%iVarBladePtLoads, p%NumBl, 'iVarBladePtLoads', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, p%NumBl + Flags = VF_None + if (i == 1) Flags = VF_AeroMap call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(i), LoadFields, & - VarIdx=p%iVarBladePtLoads(i), & + DL=DatLoc(ED_u_BladePtLoads, i), & Mesh=u%BladePtLoads(i), & + Flags=Flags, & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%BldNodes), & MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)]) - ! Add aero map flag if first blade - if (i == 1) then - do j = p%iVarBladePtLoads(i), size(p%Vars%u) - p%Vars%u(j)%Flags = ior(p%Vars%u(j)%Flags, VF_AeroMap) - end do - end if end do end if ! Platform point loads call MV_AddMeshVar(p%Vars%u, "Platform", LoadFields, & - VarIdx=p%iVarPlatformPtMesh, & + DL=DatLoc(ED_u_PlatformPtMesh), & Mesh=u%PlatformPtMesh, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Tower point loads call MV_AddMeshVar(p%Vars%u, "Tower", LoadFields, & - VarIdx=p%iVarTowerPtLoads, & + DL=DatLoc(ED_u_TowerPtLoads), & Mesh=u%TowerPtLoads, & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%TwrNodes), & MaxTorque / (100.0_R8Ki*p%NumBl*p%TwrNodes)]) ! Hub point loads call MV_AddMeshVar(p%Vars%u, "Hub", LoadFields, & - VarIdx=p%iVarHubPtLoad, & + DL=DatLoc(ED_u_HubPtLoad), & Mesh=u%HubPtLoad, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Nacelle point loads call MV_AddMeshVar(p%Vars%u, "Nacelle", LoadFields, & - VarIdx=p%iVarNacelleLoads, & + DL=DatLoc(ED_u_NacelleLoads), & Mesh=u%NacelleLoads, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! TFinCM point loads call MV_AddMeshVar(p%Vars%u, "Tailfin", LoadFields, & - VarIdx=p%iVarTFinCMLoads, & + DL=DatLoc(ED_u_TFinCMLoads), & Mesh=u%TFinCMLoads, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Non-mesh input variables call MV_AddVar(p%Vars%u, "BlPitchCom", FieldScalar, & - VarIdx=p%iVarBlPitchCom, & + DL=DatLoc(ED_u_BlPitchCom), iAry=1, & Num=p%NumBl, & Flags=VF_RotFrame + VF_Linearize + VF_2PI, & Perturb=2.0_R8Ki * D2R_D, & LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) call MV_AddVar(p%Vars%u, "YawMom", FieldScalar, & - VarIdx=p%iVarYawMom, & + DL=DatLoc(ED_u_YawMom), & Flags=VF_Linearize, & Perturb=MaxTorque / 100.0_R8Ki, & LinNames=['Yaw moment, Nm']) call MV_AddVar(p%Vars%u, "GenTrq", FieldScalar, & - VarIdx=p%iVarGenTrq, & + DL=DatLoc(ED_u_GenTrq), & Flags=VF_Linearize, & Perturb=MaxTorque / (100.0_R8Ki*p%GBRatio), & LinNames=['Generator torque, Nm']) call MV_AddVar(p%Vars%u, "BlPitchComC", FieldScalar, & - VarIdx=p%iVarBlPitchComC, & + DL=DatLoc(ED_u_BlPitchComC), & Flags=VF_ExtLin + VF_Linearize + VF_2PI, & LinNames=['Extended input: collective blade-pitch command, rad']) - + ! Set minimum input perturbations do i = 1,size(p%Vars%u) p%Vars%u(i)%Perturb = max(p%Vars%u(i)%Perturb, MinPerturb) @@ -11556,77 +11560,66 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat ! Output variables !---------------------------------------------------------------------------- - CALL AllocAry(p%iVarBladeMotion, p%NumBl, 'iVarBladeMotion', ErrStat2, ErrMsg2); if (Failed()) return - p%iVarBladeMotion = 0 - CALL AllocAry(p%iVarBladeRootMotion, p%NumBl, 'iVarBladeRootMotion', ErrStat2, ErrMsg2); if (Failed()) return - p%iVarBladeRootMotion = 0 - if (allocated(y%BladeLn2Mesh))then do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), MotionFields, & - VarIdx=p%iVarBladeMotion(i), & + Flags = VF_None + if (i == 1) Flags = VF_AeroMap + call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & + DatLoc(ED_y_BladeLn2Mesh, i), & + Flags=Flags, & + Mesh=y%BladeLn2Mesh(i)) + call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), [FieldTransAcc, FieldAngularAcc], & + DatLoc(ED_y_BladeLn2Mesh, i), & Mesh=y%BladeLn2Mesh(i)) - ! Add aero map flag if first blade and field is translation/angular displacement/velocity - if (i == 1) then - do j = p%iVarBladeMotion(i), size(p%Vars%y) - select case (p%Vars%y(j)%Field) - case (FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel) - call MV_SetFlags(p%Vars%y(j), VF_AeroMap) - end select - end do - end if end do end if call MV_AddMeshVar(p%Vars%y, 'Platform', MotionFields, & - VarIdx=p%iVarPlatformMotion, & + DatLoc(ED_y_PlatformPtMesh), & Mesh=y%PlatformPtMesh, & Flags=VF_SmallAngle) call MV_AddMeshVar(p%Vars%y, 'Tower', MotionFields, & - VarIdx=p%iVarTowerMotion, & + DatLoc(ED_y_TowerLn2Mesh), & Mesh=y%TowerLn2Mesh, & Flags=ior(VF_Line, VF_SmallAngle)) - call MV_AddMeshVar(p%Vars%y, 'Hub', & - Fields=[FieldTransDisp, FieldOrientation, FieldAngularVel], & - VarIdx=p%iVarHubMotion, & + call MV_AddMeshVar(p%Vars%y, 'Hub', [FieldTransDisp, FieldOrientation, FieldAngularVel], & + DatLoc(ED_y_HubPtMotion), & Mesh=y%HubPtMotion) do i = 1, p%NumBl call MV_AddMeshVar(p%Vars%y, 'Blade root '//Num2LStr(i), MotionFields, & - VarIdx=p%iVarBladeRootMotion(i), & + DatLoc(ED_y_BladeRootMotion, i), & Mesh=y%BladeRootMotion(i)) end do call MV_AddMeshVar(p%Vars%y, 'Nacelle', MotionFields, & - VarIdx=p%iVarNacelleMotion, & + DatLoc(ED_y_NacelleMotion), & Mesh=y%NacelleMotion) - call MV_AddMeshVar(p%Vars%y, 'TailFin', & - Fields=[FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & - VarIdx=p%iVarTFinCMMotion, & + call MV_AddMeshVar(p%Vars%y, 'TailFin', [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & + DatLoc(ED_y_TFinCMMotion), & Mesh=y%TFinCMMotion) call MV_AddVar(p%Vars%y, 'Yaw', FieldScalar, & + DatLoc(ED_y_Yaw), & Flags=VF_2PI, & - VarIdx=p%iVarYaw, & LinNames=['Yaw, rad']) call MV_AddVar(p%Vars%y, 'YawRate', FieldScalar, & - VarIdx=p%iVarYawRate, & + DatLoc(ED_y_YawRate), & LinNames=['YawRate, rad/s']) call MV_AddVar(p%Vars%y, 'HSS_Spd', FieldScalar, & - VarIdx=p%iVarHSS_Spd, & + DatLoc(ED_y_HSS_Spd), & LinNames=['HSS_Spd, rad/s']) ! Write output variables - p%iVarWriteOut = size(p%Vars%y) + 1 do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & + DatLoc(ED_y_WriteOutput), iAry=i, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & - iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & Active=(p%OutParam(i)%Indx > 0)) end do @@ -11634,9 +11627,9 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%BldNd_NumOuts do j = 1, p%BldNd_BladesOut call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, FieldScalar, & + DatLoc(ED_y_WriteOutput), iAry=k, & Num=p%BldNodes, & Flags=VF_WriteOut + VF_RotFrame, & - iUsr=k, & LinNames=[(BldOutLinName(p%BldNd_OutParam(i), j, k), k=1, p%BldNodes)], & Active=(p%BldNd_OutParam(i)%Indx > 0)) k = k + p%BldNodes @@ -11685,109 +11678,5 @@ logical function Failed() end function Failed end subroutine -subroutine ED_PackContStateOP(p, x, ary) - type(ED_ParameterType), intent(in) :: p - type(ED_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: ary(:) - integer(IntKi) :: i - do i = 1, size(p%Vars%x) - select case(p%Vars%x(i)%Field) - case (FieldTransDisp, FieldAngularDisp) - ary(p%Vars%x(i)%iLoc(1)) = x%QT(p%Vars%x(i)%iUsr(1)) - case (FieldTransVel, FieldAngularVel) - ary(p%Vars%x(i)%iLoc(1)) = x%QDT(p%Vars%x(i)%iUsr(1)) - case default - ary(p%Vars%x(i)%iLoc(1)) = 0.0_R8Ki - end select - end do -end subroutine - -subroutine ED_UnpackContStateOP(p, ary, x) - type(ED_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: ary(:) - type(ED_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(p%Vars%x) - select case(p%Vars%x(i)%Field) - case (FieldTransDisp, FieldAngularDisp) - x%QT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) - case (FieldTransVel, FieldAngularVel) - x%QDT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) - end select - end do -end subroutine - -subroutine ED_PackInputOP(p, u, Ary) - type(ED_ParameterType), intent(in) :: p - type(ED_InputType), intent(in) :: u - real(R8Ki), intent(out) :: Ary(:) - integer(IntKi) :: i - if (allocated(u%BladePtLoads)) then - do i = 1, size(u%BladePtLoads) - call MV_Pack(p%Vars%u, p%iVarBladePtLoads(i), u%BladePtLoads(i), Ary) - end do - end if - call MV_Pack(p%Vars%u, p%iVarPlatformPtMesh, u%PlatformPtMesh, Ary) - call MV_Pack(p%Vars%u, p%iVarTowerPtLoads, u%TowerPtLoads, Ary) - call MV_Pack(p%Vars%u, p%iVarHubPtLoad, u%HubPtLoad, Ary) - call MV_Pack(p%Vars%u, p%iVarNacelleLoads, u%NacelleLoads, Ary) - call MV_Pack(p%Vars%u, p%iVarTFinCMLoads, u%TFinCMLoads, Ary) - call MV_Pack(p%Vars%u, p%iVarBlPitchCom, u%BlPitchCom, Ary) - call MV_Pack(p%Vars%u, p%iVarYawMom, u%YawMom, Ary) - call MV_Pack(p%Vars%u, p%iVarGenTrq, u%GenTrq, Ary) - call MV_Pack(p%Vars%u, p%iVarBlPitchComC, u%BlPitchCom(1), Ary) -end subroutine - -subroutine ED_UnpackInputOP(p, Ary, u) - type(ED_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Ary(:) - type(ED_InputType), intent(inout) :: u - integer(IntKi) :: i - if (allocated(u%BladePtLoads)) then - do i = 1, size(u%BladePtLoads) - call MV_Unpack(p%Vars%u, p%iVarBladePtLoads(i), Ary, u%BladePtLoads(i)) - end do - end if - call MV_Unpack(p%Vars%u, p%iVarPlatformPtMesh, Ary, u%PlatformPtMesh) - call MV_Unpack(p%Vars%u, p%iVarTowerPtLoads, Ary, u%TowerPtLoads) - call MV_Unpack(p%Vars%u, p%iVarHubPtLoad, Ary, u%HubPtLoad) - call MV_Unpack(p%Vars%u, p%iVarNacelleLoads, Ary, u%NacelleLoads) - call MV_Unpack(p%Vars%u, p%iVarTFinCMLoads, Ary, u%TFinCMLoads) - call MV_Unpack(p%Vars%u, p%iVarBlPitchCom, Ary, u%BlPitchCom) - call MV_Unpack(p%Vars%u, p%iVarYawMom, Ary, u%YawMom) - call MV_Unpack(p%Vars%u, p%iVarGenTrq, Ary, u%GenTrq) -end subroutine - -subroutine ED_PackOutputOP(p, y, Ary, PackWriteOutput) - type(ED_ParameterType), intent(in) :: p - type(ED_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: Ary(:) - logical, intent(in) :: PackWriteOutput - integer(IntKi) :: i - if (allocated(y%BladeLn2Mesh)) then - do i = 1, size(y%BladeLn2Mesh) - call MV_Pack(p%Vars%y, p%iVarBladeMotion(i), y%BladeLn2Mesh(i), Ary) - end do - end if - call MV_Pack(p%Vars%y, p%iVarPlatformMotion, y%PlatformPtMesh, Ary) - call MV_Pack(p%Vars%y, p%iVarTowerMotion, y%TowerLn2Mesh, Ary) - call MV_Pack(p%Vars%y, p%iVarHubMotion, y%HubPtMotion, Ary) - if (allocated(y%BladeRootMotion)) then - do i = 1, size(y%BladeRootMotion) - call MV_Pack(p%Vars%y, p%iVarBladeRootMotion(i), y%BladeRootMotion(i), Ary) - end do - end if - call MV_Pack(p%Vars%y, p%iVarNacelleMotion, y%NacelleMotion, Ary) - call MV_Pack(p%Vars%y, p%iVarTFinCMMotion, y%TFinCMMotion, Ary) - call MV_Pack(p%Vars%y, p%iVarYaw, y%Yaw, Ary) - call MV_Pack(p%Vars%y, p%iVarYawRate, y%YawRate, Ary) - call MV_Pack(p%Vars%y, p%iVarHSS_Spd, y%HSS_Spd, Ary) - if (PackWriteOutput) then - do i = p%iVarWriteOut, size(p%Vars%y) - call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) - end do - end if -end subroutine - END MODULE ElastoDyn !********************************************************************************************************************************** diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 4a8c5aadbd..05c39e19fd 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -14,7 +14,7 @@ include Registry_NWTC_Library.txt # ElastoDyn Constants param ElastoDyn/ED - IntKi ED_NMX - 4 - "Used in updating predictor-corrector values (size of state history)" - - +param ^ - IntKi ED_u_BlPitchComC - -1 - "DatLoc number for collective blade pitch extended input" - # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: @@ -764,33 +764,6 @@ typedef ^ ParameterType Integer NumBl_Lin - - - "number of blades in the jacobia typedef ^ ParameterType Integer NActvVelDOF_Lin - - - "number of velocity states in the jacobian" - typedef ^ ParameterType Integer NActvDOF_Lin - - - "number of active DOFs to use in the jacobian" - typedef ^ ParameterType Integer NActvDOF_Stride - - - "stride for active DOFs to use in the jacobian" - -# State variable indices -typedef ^ ParameterType IntKi iVarBladeFlap1 {:} - - "Indices of BladeFlap1 variable" - -typedef ^ ParameterType IntKi iVarBladeEdge1 {:} - - "Indices of BladeEdge1 variable" - -typedef ^ ParameterType IntKi iVarBladeFlap2 {:} - - "Indices of BladeFlap2 variable" - -# Input variable indices -typedef ^ ParameterType IntKi iVarBladePtLoads {:} - - "Indices of blade point loads mesh variable" - -typedef ^ ParameterType IntKi iVarPlatformPtMesh - - - "Index of platform point loads mesh variable" - -typedef ^ ParameterType IntKi iVarTowerPtLoads - - - "Index of tower point loads mesh variable" - -typedef ^ ParameterType IntKi iVarHubPtLoad - - - "Index of hub point load mesh variable" - -typedef ^ ParameterType IntKi iVarNacelleLoads - - - "Index of nacelle loads mesh variable" - -typedef ^ ParameterType IntKi iVarTFinCMLoads - - - "Index of tail fin CM loads mesh variable" - -typedef ^ ParameterType IntKi iVarBlPitchCom - - - "Index of blade pitch command variable" - -typedef ^ ParameterType IntKi iVarYawMom - - - "Index of yaw moment variable" - -typedef ^ ParameterType IntKi iVarGenTrq - - - "Index of generator torque variable" - -typedef ^ ParameterType IntKi iVarBlPitchComC - - - "Index of blade pitch command C variable" - -# Output variable indices -typedef ^ ParameterType IntKi iVarBladeMotion {:} - - "Indices of blade motion mesh variable" - -typedef ^ ParameterType IntKi iVarPlatformMotion - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarTowerMotion - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarHubMotion - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarBladeRootMotion {:} - - "Indices of variable" - -typedef ^ ParameterType IntKi iVarNacelleMotion - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarTFinCMMotion - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarYaw - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarYawRate - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarHSS_Spd - - - "Index of variable" - -typedef ^ ParameterType IntKi iVarWriteOut - - - "Index of variable" - # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 632e0e48c1..6b7542fc4e 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -34,23 +34,7 @@ MODULE ElastoDyn_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: ED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_BladePtLoads = 1 ! Mesh number for ED ED_u_BladePtLoads mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_PlatformPtMesh = 2 ! Mesh number for ED ED_u_PlatformPtMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_TowerPtLoads = 3 ! Mesh number for ED ED_u_TowerPtLoads mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_HubPtLoad = 4 ! Mesh number for ED ED_u_HubPtLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_NacelleLoads = 5 ! Mesh number for ED ED_u_NacelleLoads mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_TFinCMLoads = 6 ! Mesh number for ED ED_u_TFinCMLoads mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_BladeLn2Mesh = 7 ! Mesh number for ED ED_y_BladeLn2Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_PlatformPtMesh = 8 ! Mesh number for ED ED_y_PlatformPtMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_TowerLn2Mesh = 9 ! Mesh number for ED ED_y_TowerLn2Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_HubPtMotion14 = 10 ! Mesh number for ED ED_y_HubPtMotion14 mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_HubPtMotion = 11 ! Mesh number for ED ED_y_HubPtMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_BladeRootMotion14 = 12 ! Mesh number for ED ED_y_BladeRootMotion14 mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_BladeRootMotion = 13 ! Mesh number for ED ED_y_BladeRootMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_RotorFurlMotion14 = 14 ! Mesh number for ED ED_y_RotorFurlMotion14 mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_NacelleMotion = 15 ! Mesh number for ED ED_y_NacelleMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_TowerBaseMotion14 = 16 ! Mesh number for ED ED_y_TowerBaseMotion14 mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_y_TFinCMMotion = 17 ! Mesh number for ED ED_y_TFinCMMotion mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_BlPitchComC = -1 ! DatLoc number for collective blade pitch extended input [-] ! ========= ED_InitInputType ======= TYPE, PUBLIC :: ED_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] @@ -779,30 +763,6 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: NActvVelDOF_Lin = 0_IntKi !< number of velocity states in the jacobian [-] INTEGER(IntKi) :: NActvDOF_Lin = 0_IntKi !< number of active DOFs to use in the jacobian [-] INTEGER(IntKi) :: NActvDOF_Stride = 0_IntKi !< stride for active DOFs to use in the jacobian [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeFlap1 !< Indices of BladeFlap1 variable [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeEdge1 !< Indices of BladeEdge1 variable [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeFlap2 !< Indices of BladeFlap2 variable [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladePtLoads !< Indices of blade point loads mesh variable [-] - INTEGER(IntKi) :: iVarPlatformPtMesh = 0_IntKi !< Index of platform point loads mesh variable [-] - INTEGER(IntKi) :: iVarTowerPtLoads = 0_IntKi !< Index of tower point loads mesh variable [-] - INTEGER(IntKi) :: iVarHubPtLoad = 0_IntKi !< Index of hub point load mesh variable [-] - INTEGER(IntKi) :: iVarNacelleLoads = 0_IntKi !< Index of nacelle loads mesh variable [-] - INTEGER(IntKi) :: iVarTFinCMLoads = 0_IntKi !< Index of tail fin CM loads mesh variable [-] - INTEGER(IntKi) :: iVarBlPitchCom = 0_IntKi !< Index of blade pitch command variable [-] - INTEGER(IntKi) :: iVarYawMom = 0_IntKi !< Index of yaw moment variable [-] - INTEGER(IntKi) :: iVarGenTrq = 0_IntKi !< Index of generator torque variable [-] - INTEGER(IntKi) :: iVarBlPitchComC = 0_IntKi !< Index of blade pitch command C variable [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeMotion !< Indices of blade motion mesh variable [-] - INTEGER(IntKi) :: iVarPlatformMotion = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) :: iVarTowerMotion = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) :: iVarHubMotion = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarBladeRootMotion !< Indices of variable [-] - INTEGER(IntKi) :: iVarNacelleMotion = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) :: iVarTFinCMMotion = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) :: iVarYaw = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) :: iVarYawRate = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) :: iVarHSS_Spd = 0_IntKi !< Index of variable [-] - INTEGER(IntKi) :: iVarWriteOut = 0_IntKi !< Index of variable [-] END TYPE ED_ParameterType ! ======================= ! ========= ED_InputType ======= @@ -886,7 +846,62 @@ MODULE ElastoDyn_Types TYPE(ED_OutputType) :: y_lin !< [-] END TYPE ED_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ED_x_QT = 1 ! ED%QT + integer(IntKi), public, parameter :: ED_x_QDT = 2 ! ED%QDT + integer(IntKi), public, parameter :: ED_z_DummyConstrState = 3 ! ED%DummyConstrState + integer(IntKi), public, parameter :: ED_u_BladePtLoads = 4 ! ED%BladePtLoads(DL%i1) + integer(IntKi), public, parameter :: ED_u_PlatformPtMesh = 5 ! ED%PlatformPtMesh + integer(IntKi), public, parameter :: ED_u_TowerPtLoads = 6 ! ED%TowerPtLoads + integer(IntKi), public, parameter :: ED_u_HubPtLoad = 7 ! ED%HubPtLoad + integer(IntKi), public, parameter :: ED_u_NacelleLoads = 8 ! ED%NacelleLoads + integer(IntKi), public, parameter :: ED_u_TFinCMLoads = 9 ! ED%TFinCMLoads + integer(IntKi), public, parameter :: ED_u_TwrAddedMass = 10 ! ED%TwrAddedMass + integer(IntKi), public, parameter :: ED_u_PtfmAddedMass = 11 ! ED%PtfmAddedMass + integer(IntKi), public, parameter :: ED_u_BlPitchCom = 12 ! ED%BlPitchCom + integer(IntKi), public, parameter :: ED_u_YawMom = 13 ! ED%YawMom + integer(IntKi), public, parameter :: ED_u_GenTrq = 14 ! ED%GenTrq + integer(IntKi), public, parameter :: ED_u_HSSBrTrqC = 15 ! ED%HSSBrTrqC + integer(IntKi), public, parameter :: ED_y_BladeLn2Mesh = 16 ! ED%BladeLn2Mesh(DL%i1) + integer(IntKi), public, parameter :: ED_y_PlatformPtMesh = 17 ! ED%PlatformPtMesh + integer(IntKi), public, parameter :: ED_y_TowerLn2Mesh = 18 ! ED%TowerLn2Mesh + integer(IntKi), public, parameter :: ED_y_HubPtMotion14 = 19 ! ED%HubPtMotion14 + integer(IntKi), public, parameter :: ED_y_HubPtMotion = 20 ! ED%HubPtMotion + integer(IntKi), public, parameter :: ED_y_BladeRootMotion14 = 21 ! ED%BladeRootMotion14 + integer(IntKi), public, parameter :: ED_y_BladeRootMotion = 22 ! ED%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: ED_y_RotorFurlMotion14 = 23 ! ED%RotorFurlMotion14 + integer(IntKi), public, parameter :: ED_y_NacelleMotion = 24 ! ED%NacelleMotion + integer(IntKi), public, parameter :: ED_y_TowerBaseMotion14 = 25 ! ED%TowerBaseMotion14 + integer(IntKi), public, parameter :: ED_y_TFinCMMotion = 26 ! ED%TFinCMMotion + integer(IntKi), public, parameter :: ED_y_WriteOutput = 27 ! ED%WriteOutput + integer(IntKi), public, parameter :: ED_y_BlPitch = 28 ! ED%BlPitch + integer(IntKi), public, parameter :: ED_y_Yaw = 29 ! ED%Yaw + integer(IntKi), public, parameter :: ED_y_YawRate = 30 ! ED%YawRate + integer(IntKi), public, parameter :: ED_y_LSS_Spd = 31 ! ED%LSS_Spd + integer(IntKi), public, parameter :: ED_y_HSS_Spd = 32 ! ED%HSS_Spd + integer(IntKi), public, parameter :: ED_y_RotSpeed = 33 ! ED%RotSpeed + integer(IntKi), public, parameter :: ED_y_TwrAccel = 34 ! ED%TwrAccel + integer(IntKi), public, parameter :: ED_y_YawAngle = 35 ! ED%YawAngle + integer(IntKi), public, parameter :: ED_y_RootMyc = 36 ! ED%RootMyc + integer(IntKi), public, parameter :: ED_y_YawBrTAxp = 37 ! ED%YawBrTAxp + integer(IntKi), public, parameter :: ED_y_YawBrTAyp = 38 ! ED%YawBrTAyp + integer(IntKi), public, parameter :: ED_y_LSSTipPxa = 39 ! ED%LSSTipPxa + integer(IntKi), public, parameter :: ED_y_RootMxc = 40 ! ED%RootMxc + integer(IntKi), public, parameter :: ED_y_LSSTipMxa = 41 ! ED%LSSTipMxa + integer(IntKi), public, parameter :: ED_y_LSSTipMya = 42 ! ED%LSSTipMya + integer(IntKi), public, parameter :: ED_y_LSSTipMza = 43 ! ED%LSSTipMza + integer(IntKi), public, parameter :: ED_y_LSSTipMys = 44 ! ED%LSSTipMys + integer(IntKi), public, parameter :: ED_y_LSSTipMzs = 45 ! ED%LSSTipMzs + integer(IntKi), public, parameter :: ED_y_YawBrMyn = 46 ! ED%YawBrMyn + integer(IntKi), public, parameter :: ED_y_YawBrMzn = 47 ! ED%YawBrMzn + integer(IntKi), public, parameter :: ED_y_NcIMURAxs = 48 ! ED%NcIMURAxs + integer(IntKi), public, parameter :: ED_y_NcIMURAys = 49 ! ED%NcIMURAys + integer(IntKi), public, parameter :: ED_y_NcIMURAzs = 50 ! ED%NcIMURAzs + integer(IntKi), public, parameter :: ED_y_RotPwr = 51 ! ED%RotPwr + integer(IntKi), public, parameter :: ED_y_LSShftFxa = 52 ! ED%LSShftFxa + integer(IntKi), public, parameter :: ED_y_LSShftFys = 53 ! ED%LSShftFys + integer(IntKi), public, parameter :: ED_y_LSShftFzs = 54 ! ED%LSShftFzs + +contains subroutine ED_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(ED_InitInputType), intent(in) :: SrcInitInputData @@ -5763,96 +5778,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NActvVelDOF_Lin = SrcParamData%NActvVelDOF_Lin DstParamData%NActvDOF_Lin = SrcParamData%NActvDOF_Lin DstParamData%NActvDOF_Stride = SrcParamData%NActvDOF_Stride - if (allocated(SrcParamData%iVarBladeFlap1)) then - LB(1:1) = lbound(SrcParamData%iVarBladeFlap1, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarBladeFlap1, kind=B8Ki) - if (.not. allocated(DstParamData%iVarBladeFlap1)) then - allocate(DstParamData%iVarBladeFlap1(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeFlap1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarBladeFlap1 = SrcParamData%iVarBladeFlap1 - end if - if (allocated(SrcParamData%iVarBladeEdge1)) then - LB(1:1) = lbound(SrcParamData%iVarBladeEdge1, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarBladeEdge1, kind=B8Ki) - if (.not. allocated(DstParamData%iVarBladeEdge1)) then - allocate(DstParamData%iVarBladeEdge1(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeEdge1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarBladeEdge1 = SrcParamData%iVarBladeEdge1 - end if - if (allocated(SrcParamData%iVarBladeFlap2)) then - LB(1:1) = lbound(SrcParamData%iVarBladeFlap2, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarBladeFlap2, kind=B8Ki) - if (.not. allocated(DstParamData%iVarBladeFlap2)) then - allocate(DstParamData%iVarBladeFlap2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeFlap2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarBladeFlap2 = SrcParamData%iVarBladeFlap2 - end if - if (allocated(SrcParamData%iVarBladePtLoads)) then - LB(1:1) = lbound(SrcParamData%iVarBladePtLoads, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarBladePtLoads, kind=B8Ki) - if (.not. allocated(DstParamData%iVarBladePtLoads)) then - allocate(DstParamData%iVarBladePtLoads(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladePtLoads.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarBladePtLoads = SrcParamData%iVarBladePtLoads - end if - DstParamData%iVarPlatformPtMesh = SrcParamData%iVarPlatformPtMesh - DstParamData%iVarTowerPtLoads = SrcParamData%iVarTowerPtLoads - DstParamData%iVarHubPtLoad = SrcParamData%iVarHubPtLoad - DstParamData%iVarNacelleLoads = SrcParamData%iVarNacelleLoads - DstParamData%iVarTFinCMLoads = SrcParamData%iVarTFinCMLoads - DstParamData%iVarBlPitchCom = SrcParamData%iVarBlPitchCom - DstParamData%iVarYawMom = SrcParamData%iVarYawMom - DstParamData%iVarGenTrq = SrcParamData%iVarGenTrq - DstParamData%iVarBlPitchComC = SrcParamData%iVarBlPitchComC - if (allocated(SrcParamData%iVarBladeMotion)) then - LB(1:1) = lbound(SrcParamData%iVarBladeMotion, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarBladeMotion, kind=B8Ki) - if (.not. allocated(DstParamData%iVarBladeMotion)) then - allocate(DstParamData%iVarBladeMotion(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeMotion.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarBladeMotion = SrcParamData%iVarBladeMotion - end if - DstParamData%iVarPlatformMotion = SrcParamData%iVarPlatformMotion - DstParamData%iVarTowerMotion = SrcParamData%iVarTowerMotion - DstParamData%iVarHubMotion = SrcParamData%iVarHubMotion - if (allocated(SrcParamData%iVarBladeRootMotion)) then - LB(1:1) = lbound(SrcParamData%iVarBladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarBladeRootMotion, kind=B8Ki) - if (.not. allocated(DstParamData%iVarBladeRootMotion)) then - allocate(DstParamData%iVarBladeRootMotion(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBladeRootMotion.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarBladeRootMotion = SrcParamData%iVarBladeRootMotion - end if - DstParamData%iVarNacelleMotion = SrcParamData%iVarNacelleMotion - DstParamData%iVarTFinCMMotion = SrcParamData%iVarTFinCMMotion - DstParamData%iVarYaw = SrcParamData%iVarYaw - DstParamData%iVarYawRate = SrcParamData%iVarYawRate - DstParamData%iVarHSS_Spd = SrcParamData%iVarHSS_Spd - DstParamData%iVarWriteOut = SrcParamData%iVarWriteOut end subroutine subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -6060,24 +5985,6 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%dx)) then deallocate(ParamData%dx) end if - if (allocated(ParamData%iVarBladeFlap1)) then - deallocate(ParamData%iVarBladeFlap1) - end if - if (allocated(ParamData%iVarBladeEdge1)) then - deallocate(ParamData%iVarBladeEdge1) - end if - if (allocated(ParamData%iVarBladeFlap2)) then - deallocate(ParamData%iVarBladeFlap2) - end if - if (allocated(ParamData%iVarBladePtLoads)) then - deallocate(ParamData%iVarBladePtLoads) - end if - if (allocated(ParamData%iVarBladeMotion)) then - deallocate(ParamData%iVarBladeMotion) - end if - if (allocated(ParamData%iVarBladeRootMotion)) then - deallocate(ParamData%iVarBladeRootMotion) - end if end subroutine subroutine ED_PackParam(RF, Indata) @@ -6339,30 +6246,6 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%NActvVelDOF_Lin) call RegPack(RF, InData%NActvDOF_Lin) call RegPack(RF, InData%NActvDOF_Stride) - call RegPackAlloc(RF, InData%iVarBladeFlap1) - call RegPackAlloc(RF, InData%iVarBladeEdge1) - call RegPackAlloc(RF, InData%iVarBladeFlap2) - call RegPackAlloc(RF, InData%iVarBladePtLoads) - call RegPack(RF, InData%iVarPlatformPtMesh) - call RegPack(RF, InData%iVarTowerPtLoads) - call RegPack(RF, InData%iVarHubPtLoad) - call RegPack(RF, InData%iVarNacelleLoads) - call RegPack(RF, InData%iVarTFinCMLoads) - call RegPack(RF, InData%iVarBlPitchCom) - call RegPack(RF, InData%iVarYawMom) - call RegPack(RF, InData%iVarGenTrq) - call RegPack(RF, InData%iVarBlPitchComC) - call RegPackAlloc(RF, InData%iVarBladeMotion) - call RegPack(RF, InData%iVarPlatformMotion) - call RegPack(RF, InData%iVarTowerMotion) - call RegPack(RF, InData%iVarHubMotion) - call RegPackAlloc(RF, InData%iVarBladeRootMotion) - call RegPack(RF, InData%iVarNacelleMotion) - call RegPack(RF, InData%iVarTFinCMMotion) - call RegPack(RF, InData%iVarYaw) - call RegPack(RF, InData%iVarYawRate) - call RegPack(RF, InData%iVarHSS_Spd) - call RegPack(RF, InData%iVarWriteOut) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6647,30 +6530,6 @@ subroutine ED_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%NActvVelDOF_Lin); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NActvDOF_Lin); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NActvDOF_Stride); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladeFlap1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladeEdge1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladeFlap2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladePtLoads); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPlatformPtMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTowerPtLoads); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHubPtLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarNacelleLoads); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTFinCMLoads); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarBlPitchCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarYawMom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarGenTrq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarBlPitchComC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladeMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPlatformMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTowerMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHubMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBladeRootMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarNacelleMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarTFinCMMotion); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarYaw); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarYawRate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWriteOut); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -7911,7 +7770,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err function ED_InputMeshPointer(u, ML) result(Mesh) type(ED_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -7931,7 +7790,7 @@ function ED_InputMeshPointer(u, ML) result(Mesh) end function function ED_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -7952,7 +7811,7 @@ function ED_InputMeshName(ML) result(Name) function ED_OutputMeshPointer(y, ML) result(Mesh) type(ED_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -7982,7 +7841,7 @@ function ED_OutputMeshPointer(y, ML) result(Mesh) end function function ED_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -8010,5 +7869,325 @@ function ED_OutputMeshName(ML) result(Name) Name = "y%TFinCMMotion" end select end function + +subroutine ED_PackContStateAry(Vars, x, ValAry) + type(ED_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (ED_x_QT) + call MV_Pack2(Var, x%QT, ValAry) ! Rank 1 Array + case (ED_x_QDT) + call MV_Pack2(Var, x%QDT, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ED_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (ED_x_QT) + call MV_Unpack2(Var, ValAry, x%QT) ! Rank 1 Array + case (ED_x_QDT) + call MV_Unpack2(Var, ValAry, x%QDT) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ED_PackConstrStateAry(Vars, z, ValAry) + type(ED_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (ED_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ED_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (ED_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ED_PackInputAry(Vars, u, ValAry) + type(ED_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ED_u_BladePtLoads) + call MV_Pack2(Var, u%BladePtLoads(DL%i1), ValAry) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_Pack2(Var, u%PlatformPtMesh, ValAry) ! Mesh + case (ED_u_TowerPtLoads) + call MV_Pack2(Var, u%TowerPtLoads, ValAry) ! Mesh + case (ED_u_HubPtLoad) + call MV_Pack2(Var, u%HubPtLoad, ValAry) ! Mesh + case (ED_u_NacelleLoads) + call MV_Pack2(Var, u%NacelleLoads, ValAry) ! Mesh + case (ED_u_TFinCMLoads) + call MV_Pack2(Var, u%TFinCMLoads, ValAry) ! Mesh + case (ED_u_TwrAddedMass) + call MV_Pack2(Var, u%TwrAddedMass, ValAry) ! Rank 3 Array + case (ED_u_PtfmAddedMass) + call MV_Pack2(Var, u%PtfmAddedMass, ValAry) ! Rank 2 Array + case (ED_u_BlPitchCom) + call MV_Pack2(Var, u%BlPitchCom, ValAry) ! Rank 1 Array + case (ED_u_YawMom) + call MV_Pack2(Var, u%YawMom, ValAry) ! Scalar + case (ED_u_GenTrq) + call MV_Pack2(Var, u%GenTrq, ValAry) ! Scalar + case (ED_u_HSSBrTrqC) + call MV_Pack2(Var, u%HSSBrTrqC, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ED_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ED_u_BladePtLoads) + call MV_Unpack2(Var, ValAry, u%BladePtLoads(DL%i1)) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_Unpack2(Var, ValAry, u%PlatformPtMesh) ! Mesh + case (ED_u_TowerPtLoads) + call MV_Unpack2(Var, ValAry, u%TowerPtLoads) ! Mesh + case (ED_u_HubPtLoad) + call MV_Unpack2(Var, ValAry, u%HubPtLoad) ! Mesh + case (ED_u_NacelleLoads) + call MV_Unpack2(Var, ValAry, u%NacelleLoads) ! Mesh + case (ED_u_TFinCMLoads) + call MV_Unpack2(Var, ValAry, u%TFinCMLoads) ! Mesh + case (ED_u_TwrAddedMass) + call MV_Unpack2(Var, ValAry, u%TwrAddedMass) ! Rank 3 Array + case (ED_u_PtfmAddedMass) + call MV_Unpack2(Var, ValAry, u%PtfmAddedMass) ! Rank 2 Array + case (ED_u_BlPitchCom) + call MV_Unpack2(Var, ValAry, u%BlPitchCom) ! Rank 1 Array + case (ED_u_YawMom) + call MV_Unpack2(Var, ValAry, u%YawMom) ! Scalar + case (ED_u_GenTrq) + call MV_Unpack2(Var, ValAry, u%GenTrq) ! Scalar + case (ED_u_HSSBrTrqC) + call MV_Unpack2(Var, ValAry, u%HSSBrTrqC) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ED_PackOutputAry(Vars, y, ValAry) + type(ED_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_Pack2(Var, y%BladeLn2Mesh(DL%i1), ValAry) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_Pack2(Var, y%PlatformPtMesh, ValAry) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_Pack2(Var, y%TowerLn2Mesh, ValAry) ! Mesh + case (ED_y_HubPtMotion14) + call MV_Pack2(Var, y%HubPtMotion14, ValAry) ! Mesh + case (ED_y_HubPtMotion) + call MV_Pack2(Var, y%HubPtMotion, ValAry) ! Mesh + case (ED_y_BladeRootMotion14) + call MV_Pack2(Var, y%BladeRootMotion14, ValAry) ! Mesh + case (ED_y_BladeRootMotion) + call MV_Pack2(Var, y%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ED_y_RotorFurlMotion14) + call MV_Pack2(Var, y%RotorFurlMotion14, ValAry) ! Mesh + case (ED_y_NacelleMotion) + call MV_Pack2(Var, y%NacelleMotion, ValAry) ! Mesh + case (ED_y_TowerBaseMotion14) + call MV_Pack2(Var, y%TowerBaseMotion14, ValAry) ! Mesh + case (ED_y_TFinCMMotion) + call MV_Pack2(Var, y%TFinCMMotion, ValAry) ! Mesh + case (ED_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (ED_y_BlPitch) + call MV_Pack2(Var, y%BlPitch, ValAry) ! Rank 1 Array + case (ED_y_Yaw) + call MV_Pack2(Var, y%Yaw, ValAry) ! Scalar + case (ED_y_YawRate) + call MV_Pack2(Var, y%YawRate, ValAry) ! Scalar + case (ED_y_LSS_Spd) + call MV_Pack2(Var, y%LSS_Spd, ValAry) ! Scalar + case (ED_y_HSS_Spd) + call MV_Pack2(Var, y%HSS_Spd, ValAry) ! Scalar + case (ED_y_RotSpeed) + call MV_Pack2(Var, y%RotSpeed, ValAry) ! Scalar + case (ED_y_TwrAccel) + call MV_Pack2(Var, y%TwrAccel, ValAry) ! Scalar + case (ED_y_YawAngle) + call MV_Pack2(Var, y%YawAngle, ValAry) ! Scalar + case (ED_y_RootMyc) + call MV_Pack2(Var, y%RootMyc, ValAry) ! Rank 1 Array + case (ED_y_YawBrTAxp) + call MV_Pack2(Var, y%YawBrTAxp, ValAry) ! Scalar + case (ED_y_YawBrTAyp) + call MV_Pack2(Var, y%YawBrTAyp, ValAry) ! Scalar + case (ED_y_LSSTipPxa) + call MV_Pack2(Var, y%LSSTipPxa, ValAry) ! Scalar + case (ED_y_RootMxc) + call MV_Pack2(Var, y%RootMxc, ValAry) ! Rank 1 Array + case (ED_y_LSSTipMxa) + call MV_Pack2(Var, y%LSSTipMxa, ValAry) ! Scalar + case (ED_y_LSSTipMya) + call MV_Pack2(Var, y%LSSTipMya, ValAry) ! Scalar + case (ED_y_LSSTipMza) + call MV_Pack2(Var, y%LSSTipMza, ValAry) ! Scalar + case (ED_y_LSSTipMys) + call MV_Pack2(Var, y%LSSTipMys, ValAry) ! Scalar + case (ED_y_LSSTipMzs) + call MV_Pack2(Var, y%LSSTipMzs, ValAry) ! Scalar + case (ED_y_YawBrMyn) + call MV_Pack2(Var, y%YawBrMyn, ValAry) ! Scalar + case (ED_y_YawBrMzn) + call MV_Pack2(Var, y%YawBrMzn, ValAry) ! Scalar + case (ED_y_NcIMURAxs) + call MV_Pack2(Var, y%NcIMURAxs, ValAry) ! Scalar + case (ED_y_NcIMURAys) + call MV_Pack2(Var, y%NcIMURAys, ValAry) ! Scalar + case (ED_y_NcIMURAzs) + call MV_Pack2(Var, y%NcIMURAzs, ValAry) ! Scalar + case (ED_y_RotPwr) + call MV_Pack2(Var, y%RotPwr, ValAry) ! Scalar + case (ED_y_LSShftFxa) + call MV_Pack2(Var, y%LSShftFxa, ValAry) ! Scalar + case (ED_y_LSShftFys) + call MV_Pack2(Var, y%LSShftFys, ValAry) ! Scalar + case (ED_y_LSShftFzs) + call MV_Pack2(Var, y%LSShftFzs, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ED_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_Unpack2(Var, ValAry, y%BladeLn2Mesh(DL%i1)) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_Unpack2(Var, ValAry, y%PlatformPtMesh) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_Unpack2(Var, ValAry, y%TowerLn2Mesh) ! Mesh + case (ED_y_HubPtMotion14) + call MV_Unpack2(Var, ValAry, y%HubPtMotion14) ! Mesh + case (ED_y_HubPtMotion) + call MV_Unpack2(Var, ValAry, y%HubPtMotion) ! Mesh + case (ED_y_BladeRootMotion14) + call MV_Unpack2(Var, ValAry, y%BladeRootMotion14) ! Mesh + case (ED_y_BladeRootMotion) + call MV_Unpack2(Var, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh + case (ED_y_RotorFurlMotion14) + call MV_Unpack2(Var, ValAry, y%RotorFurlMotion14) ! Mesh + case (ED_y_NacelleMotion) + call MV_Unpack2(Var, ValAry, y%NacelleMotion) ! Mesh + case (ED_y_TowerBaseMotion14) + call MV_Unpack2(Var, ValAry, y%TowerBaseMotion14) ! Mesh + case (ED_y_TFinCMMotion) + call MV_Unpack2(Var, ValAry, y%TFinCMMotion) ! Mesh + case (ED_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (ED_y_BlPitch) + call MV_Unpack2(Var, ValAry, y%BlPitch) ! Rank 1 Array + case (ED_y_Yaw) + call MV_Unpack2(Var, ValAry, y%Yaw) ! Scalar + case (ED_y_YawRate) + call MV_Unpack2(Var, ValAry, y%YawRate) ! Scalar + case (ED_y_LSS_Spd) + call MV_Unpack2(Var, ValAry, y%LSS_Spd) ! Scalar + case (ED_y_HSS_Spd) + call MV_Unpack2(Var, ValAry, y%HSS_Spd) ! Scalar + case (ED_y_RotSpeed) + call MV_Unpack2(Var, ValAry, y%RotSpeed) ! Scalar + case (ED_y_TwrAccel) + call MV_Unpack2(Var, ValAry, y%TwrAccel) ! Scalar + case (ED_y_YawAngle) + call MV_Unpack2(Var, ValAry, y%YawAngle) ! Scalar + case (ED_y_RootMyc) + call MV_Unpack2(Var, ValAry, y%RootMyc) ! Rank 1 Array + case (ED_y_YawBrTAxp) + call MV_Unpack2(Var, ValAry, y%YawBrTAxp) ! Scalar + case (ED_y_YawBrTAyp) + call MV_Unpack2(Var, ValAry, y%YawBrTAyp) ! Scalar + case (ED_y_LSSTipPxa) + call MV_Unpack2(Var, ValAry, y%LSSTipPxa) ! Scalar + case (ED_y_RootMxc) + call MV_Unpack2(Var, ValAry, y%RootMxc) ! Rank 1 Array + case (ED_y_LSSTipMxa) + call MV_Unpack2(Var, ValAry, y%LSSTipMxa) ! Scalar + case (ED_y_LSSTipMya) + call MV_Unpack2(Var, ValAry, y%LSSTipMya) ! Scalar + case (ED_y_LSSTipMza) + call MV_Unpack2(Var, ValAry, y%LSSTipMza) ! Scalar + case (ED_y_LSSTipMys) + call MV_Unpack2(Var, ValAry, y%LSSTipMys) ! Scalar + case (ED_y_LSSTipMzs) + call MV_Unpack2(Var, ValAry, y%LSSTipMzs) ! Scalar + case (ED_y_YawBrMyn) + call MV_Unpack2(Var, ValAry, y%YawBrMyn) ! Scalar + case (ED_y_YawBrMzn) + call MV_Unpack2(Var, ValAry, y%YawBrMzn) ! Scalar + case (ED_y_NcIMURAxs) + call MV_Unpack2(Var, ValAry, y%NcIMURAxs) ! Scalar + case (ED_y_NcIMURAys) + call MV_Unpack2(Var, ValAry, y%NcIMURAys) ! Scalar + case (ED_y_NcIMURAzs) + call MV_Unpack2(Var, ValAry, y%NcIMURAzs) ! Scalar + case (ED_y_RotPwr) + call MV_Unpack2(Var, ValAry, y%RotPwr) ! Scalar + case (ED_y_LSShftFxa) + call MV_Unpack2(Var, ValAry, y%LSShftFxa) ! Scalar + case (ED_y_LSShftFys) + call MV_Unpack2(Var, ValAry, y%LSShftFys) ! Scalar + case (ED_y_LSShftFzs) + call MV_Unpack2(Var, ValAry, y%LSShftFzs) ! Scalar + end select + end associate + end do +end subroutine END MODULE ElastoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index 71898a8bf0..f507c7eced 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -207,7 +207,29 @@ MODULE ExternalInflow_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE ExtInfw_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ExtInfw_u_pxVel = 1 ! ExtInfw%pxVel + integer(IntKi), public, parameter :: ExtInfw_u_pyVel = 2 ! ExtInfw%pyVel + integer(IntKi), public, parameter :: ExtInfw_u_pzVel = 3 ! ExtInfw%pzVel + integer(IntKi), public, parameter :: ExtInfw_u_pxForce = 4 ! ExtInfw%pxForce + integer(IntKi), public, parameter :: ExtInfw_u_pyForce = 5 ! ExtInfw%pyForce + integer(IntKi), public, parameter :: ExtInfw_u_pzForce = 6 ! ExtInfw%pzForce + integer(IntKi), public, parameter :: ExtInfw_u_xdotForce = 7 ! ExtInfw%xdotForce + integer(IntKi), public, parameter :: ExtInfw_u_ydotForce = 8 ! ExtInfw%ydotForce + integer(IntKi), public, parameter :: ExtInfw_u_zdotForce = 9 ! ExtInfw%zdotForce + integer(IntKi), public, parameter :: ExtInfw_u_pOrientation = 10 ! ExtInfw%pOrientation + integer(IntKi), public, parameter :: ExtInfw_u_fx = 11 ! ExtInfw%fx + integer(IntKi), public, parameter :: ExtInfw_u_fy = 12 ! ExtInfw%fy + integer(IntKi), public, parameter :: ExtInfw_u_fz = 13 ! ExtInfw%fz + integer(IntKi), public, parameter :: ExtInfw_u_momentx = 14 ! ExtInfw%momentx + integer(IntKi), public, parameter :: ExtInfw_u_momenty = 15 ! ExtInfw%momenty + integer(IntKi), public, parameter :: ExtInfw_u_momentz = 16 ! ExtInfw%momentz + integer(IntKi), public, parameter :: ExtInfw_u_forceNodesChord = 17 ! ExtInfw%forceNodesChord + integer(IntKi), public, parameter :: ExtInfw_y_u = 18 ! ExtInfw%u + integer(IntKi), public, parameter :: ExtInfw_y_v = 19 ! ExtInfw%v + integer(IntKi), public, parameter :: ExtInfw_y_w = 20 ! ExtInfw%w + integer(IntKi), public, parameter :: ExtInfw_y_WriteOutput = 21 ! ExtInfw%WriteOutput + +contains subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(ExtInfw_InitInputType), intent(in) :: SrcInitInputData @@ -2814,7 +2836,7 @@ SUBROUTINE ExtInfw_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat function ExtInfw_InputMeshPointer(u, ML) result(Mesh) type(ExtInfw_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2822,7 +2844,7 @@ function ExtInfw_InputMeshPointer(u, ML) result(Mesh) end function function ExtInfw_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2831,7 +2853,7 @@ function ExtInfw_InputMeshName(ML) result(Name) function ExtInfw_OutputMeshPointer(y, ML) result(Mesh) type(ExtInfw_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2839,11 +2861,147 @@ function ExtInfw_OutputMeshPointer(y, ML) result(Mesh) end function function ExtInfw_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine ExtInfw_PackInputAry(Vars, u, ValAry) + type(ExtInfw_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ExtInfw_u_pxVel) + call MV_Pack2(Var, u%pxVel, ValAry) ! Rank 1 Array + case (ExtInfw_u_pyVel) + call MV_Pack2(Var, u%pyVel, ValAry) ! Rank 1 Array + case (ExtInfw_u_pzVel) + call MV_Pack2(Var, u%pzVel, ValAry) ! Rank 1 Array + case (ExtInfw_u_pxForce) + call MV_Pack2(Var, u%pxForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_pyForce) + call MV_Pack2(Var, u%pyForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_pzForce) + call MV_Pack2(Var, u%pzForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_xdotForce) + call MV_Pack2(Var, u%xdotForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_ydotForce) + call MV_Pack2(Var, u%ydotForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_zdotForce) + call MV_Pack2(Var, u%zdotForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_pOrientation) + call MV_Pack2(Var, u%pOrientation, ValAry) ! Rank 1 Array + case (ExtInfw_u_fx) + call MV_Pack2(Var, u%fx, ValAry) ! Rank 1 Array + case (ExtInfw_u_fy) + call MV_Pack2(Var, u%fy, ValAry) ! Rank 1 Array + case (ExtInfw_u_fz) + call MV_Pack2(Var, u%fz, ValAry) ! Rank 1 Array + case (ExtInfw_u_momentx) + call MV_Pack2(Var, u%momentx, ValAry) ! Rank 1 Array + case (ExtInfw_u_momenty) + call MV_Pack2(Var, u%momenty, ValAry) ! Rank 1 Array + case (ExtInfw_u_momentz) + call MV_Pack2(Var, u%momentz, ValAry) ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + call MV_Pack2(Var, u%forceNodesChord, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtInfw_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ExtInfw_u_pxVel) + call MV_Unpack2(Var, ValAry, u%pxVel) ! Rank 1 Array + case (ExtInfw_u_pyVel) + call MV_Unpack2(Var, ValAry, u%pyVel) ! Rank 1 Array + case (ExtInfw_u_pzVel) + call MV_Unpack2(Var, ValAry, u%pzVel) ! Rank 1 Array + case (ExtInfw_u_pxForce) + call MV_Unpack2(Var, ValAry, u%pxForce) ! Rank 1 Array + case (ExtInfw_u_pyForce) + call MV_Unpack2(Var, ValAry, u%pyForce) ! Rank 1 Array + case (ExtInfw_u_pzForce) + call MV_Unpack2(Var, ValAry, u%pzForce) ! Rank 1 Array + case (ExtInfw_u_xdotForce) + call MV_Unpack2(Var, ValAry, u%xdotForce) ! Rank 1 Array + case (ExtInfw_u_ydotForce) + call MV_Unpack2(Var, ValAry, u%ydotForce) ! Rank 1 Array + case (ExtInfw_u_zdotForce) + call MV_Unpack2(Var, ValAry, u%zdotForce) ! Rank 1 Array + case (ExtInfw_u_pOrientation) + call MV_Unpack2(Var, ValAry, u%pOrientation) ! Rank 1 Array + case (ExtInfw_u_fx) + call MV_Unpack2(Var, ValAry, u%fx) ! Rank 1 Array + case (ExtInfw_u_fy) + call MV_Unpack2(Var, ValAry, u%fy) ! Rank 1 Array + case (ExtInfw_u_fz) + call MV_Unpack2(Var, ValAry, u%fz) ! Rank 1 Array + case (ExtInfw_u_momentx) + call MV_Unpack2(Var, ValAry, u%momentx) ! Rank 1 Array + case (ExtInfw_u_momenty) + call MV_Unpack2(Var, ValAry, u%momenty) ! Rank 1 Array + case (ExtInfw_u_momentz) + call MV_Unpack2(Var, ValAry, u%momentz) ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + call MV_Unpack2(Var, ValAry, u%forceNodesChord) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtInfw_PackOutputAry(Vars, y, ValAry) + type(ExtInfw_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ExtInfw_y_u) + call MV_Pack2(Var, y%u, ValAry) ! Rank 1 Array + case (ExtInfw_y_v) + call MV_Pack2(Var, y%v, ValAry) ! Rank 1 Array + case (ExtInfw_y_w) + call MV_Pack2(Var, y%w, ValAry) ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtInfw_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ExtInfw_y_u) + call MV_Unpack2(Var, ValAry, y%u) ! Rank 1 Array + case (ExtInfw_y_v) + call MV_Unpack2(Var, ValAry, y%v) ! Rank 1 Array + case (ExtInfw_y_w) + call MV_Unpack2(Var, ValAry, y%w) ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE ExternalInflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index ad4a624bb9..a04a14d83f 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -240,27 +240,27 @@ subroutine ExtLd_InitVars(u, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Input variables !---------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%u, "TowerMotion", MotionFields, Mesh=u%TowerMotion) - call MV_AddMeshVar(p%Vars%u, "HubMotion", MotionFields, Mesh=u%HubMotion) - call MV_AddMeshVar(p%Vars%u, "NacelleMotion", MotionFields, Mesh=u%NacelleMotion) + call MV_AddMeshVar(p%Vars%u, "TowerMotion", MotionFields, DatLoc(ExtLd_u_TowerMotion), Mesh=u%TowerMotion) + call MV_AddMeshVar(p%Vars%u, "HubMotion", MotionFields, DatLoc(ExtLd_u_HubMotion), Mesh=u%HubMotion) + call MV_AddMeshVar(p%Vars%u, "NacelleMotion", MotionFields, DatLoc(ExtLd_u_NacelleMotion), Mesh=u%NacelleMotion) do i = 1, size(u%BladeRootMotion) - call MV_AddMeshVar(p%Vars%u, "BladeRootMotion"//IdxStr(i), MotionFields, Mesh=u%BladeRootMotion(i)) + call MV_AddMeshVar(p%Vars%u, "BladeRootMotion"//IdxStr(i), MotionFields, DatLoc(ExtLd_u_BladeRootMotion, i), Mesh=u%BladeRootMotion(i)) end do do i = 1, size(u%BladeRootMotion) - call MV_AddMeshVar(p%Vars%u, "BladeMotion"//IdxStr(i), MotionFields, Mesh=u%BladeMotion(i)) + call MV_AddMeshVar(p%Vars%u, "BladeMotion"//IdxStr(i), MotionFields, DatLoc(ExtLd_u_BladeMotion, i), Mesh=u%BladeMotion(i)) end do !---------------------------------------------------------------------------- ! Output variables !---------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, 'TowerLoad', LoadFields, Mesh=y%TowerLoad) + call MV_AddMeshVar(p%Vars%y, 'TowerLoad', LoadFields, DatLoc(ExtLd_y_TowerLoad), Mesh=y%TowerLoad) do i = 1, size(y%BladeLoad) - call MV_AddMeshVar(p%Vars%y, 'BladeLoad'//IdxStr(i), LoadFields, Mesh=y%BladeLoad(i)) + call MV_AddMeshVar(p%Vars%y, 'BladeLoad'//IdxStr(i), LoadFields, DatLoc(ExtLd_y_BladeLoad, i), Mesh=y%BladeLoad(i)) end do - call MV_AddMeshVar(p%Vars%y, 'TowerLoadAD', LoadFields, Mesh=y%TowerLoadAD) + call MV_AddMeshVar(p%Vars%y, 'TowerLoadAD', LoadFields, DatLoc(ExtLd_y_TowerLoadAD), Mesh=y%TowerLoadAD) do i = 1, size(y%BladeLoadAD) - call MV_AddMeshVar(p%Vars%y, 'BladeLoadAD'//IdxStr(i), LoadFields, Mesh=y%BladeLoadAD(i)) + call MV_AddMeshVar(p%Vars%y, 'BladeLoadAD'//IdxStr(i), LoadFields, DatLoc(ExtLd_y_BladeLoadAD, i), Mesh=y%BladeLoadAD(i)) end do !---------------------------------------------------------------------------- diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index 0c984b8fbc..c5eee5437f 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -117,7 +117,16 @@ MODULE ExtLoadsDX_Types REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldLd => NULL() !< Loads on all blades - Externally supplied [-] END TYPE ExtLdDX_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ExtLdDX_u_twrDef = 1 ! ExtLdDX%twrDef + integer(IntKi), public, parameter :: ExtLdDX_u_bldDef = 2 ! ExtLdDX%bldDef + integer(IntKi), public, parameter :: ExtLdDX_u_hubDef = 3 ! ExtLdDX%hubDef + integer(IntKi), public, parameter :: ExtLdDX_u_nacDef = 4 ! ExtLdDX%nacDef + integer(IntKi), public, parameter :: ExtLdDX_u_bldRootDef = 5 ! ExtLdDX%bldRootDef + integer(IntKi), public, parameter :: ExtLdDX_u_bldPitch = 6 ! ExtLdDX%bldPitch + integer(IntKi), public, parameter :: ExtLdDX_y_twrLd = 7 ! ExtLdDX%twrLd + integer(IntKi), public, parameter :: ExtLdDX_y_bldLd = 8 ! ExtLdDX%bldLd + +contains subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) type(ExtLdDX_InputType), intent(in) :: SrcInputData @@ -1684,7 +1693,7 @@ SUBROUTINE ExtLdDX_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat function ExtLdDX_InputMeshPointer(u, ML) result(Mesh) type(ExtLdDX_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1692,7 +1701,7 @@ function ExtLdDX_InputMeshPointer(u, ML) result(Mesh) end function function ExtLdDX_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1701,7 +1710,7 @@ function ExtLdDX_InputMeshName(ML) result(Name) function ExtLdDX_OutputMeshPointer(y, ML) result(Mesh) type(ExtLdDX_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1709,11 +1718,95 @@ function ExtLdDX_OutputMeshPointer(y, ML) result(Mesh) end function function ExtLdDX_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine ExtLdDX_PackInputAry(Vars, u, ValAry) + type(ExtLdDX_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ExtLdDX_u_twrDef) + call MV_Pack2(Var, u%twrDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldDef) + call MV_Pack2(Var, u%bldDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_hubDef) + call MV_Pack2(Var, u%hubDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_nacDef) + call MV_Pack2(Var, u%nacDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + call MV_Pack2(Var, u%bldRootDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + call MV_Pack2(Var, u%bldPitch, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtLdDX_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ExtLdDX_u_twrDef) + call MV_Unpack2(Var, ValAry, u%twrDef) ! Rank 1 Array + case (ExtLdDX_u_bldDef) + call MV_Unpack2(Var, ValAry, u%bldDef) ! Rank 1 Array + case (ExtLdDX_u_hubDef) + call MV_Unpack2(Var, ValAry, u%hubDef) ! Rank 1 Array + case (ExtLdDX_u_nacDef) + call MV_Unpack2(Var, ValAry, u%nacDef) ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + call MV_Unpack2(Var, ValAry, u%bldRootDef) ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + call MV_Unpack2(Var, ValAry, u%bldPitch) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtLdDX_PackOutputAry(Vars, y, ValAry) + type(ExtLdDX_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ExtLdDX_y_twrLd) + call MV_Pack2(Var, y%twrLd, ValAry) ! Rank 1 Array + case (ExtLdDX_y_bldLd) + call MV_Pack2(Var, y%bldLd, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtLdDX_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ExtLdDX_y_twrLd) + call MV_Unpack2(Var, ValAry, y%twrLd) ! Rank 1 Array + case (ExtLdDX_y_bldLd) + call MV_Unpack2(Var, ValAry, y%bldLd) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE ExtLoadsDX_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 2c3c7135d7..2e65938e00 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -35,15 +35,6 @@ MODULE ExtLoads_Types USE ExtLoadsDX_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_TowerMotion = 1 ! Mesh number for ExtLd ExtLd_u_TowerMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_HubMotion = 2 ! Mesh number for ExtLd ExtLd_u_HubMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_NacelleMotion = 3 ! Mesh number for ExtLd ExtLd_u_NacelleMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_BladeRootMotion = 4 ! Mesh number for ExtLd ExtLd_u_BladeRootMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_u_BladeMotion = 5 ! Mesh number for ExtLd ExtLd_u_BladeMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_y_TowerLoad = 6 ! Mesh number for ExtLd ExtLd_y_TowerLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_y_BladeLoad = 7 ! Mesh number for ExtLd ExtLd_y_BladeLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_y_TowerLoadAD = 8 ! Mesh number for ExtLd ExtLd_y_TowerLoadAD mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtLd_y_BladeLoadAD = 9 ! Mesh number for ExtLd ExtLd_y_BladeLoadAD mesh [-] ! ========= ExtLd_InitInputType ======= TYPE, PUBLIC :: ExtLd_InitInputType INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] @@ -148,7 +139,28 @@ MODULE ExtLoads_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoadAD !< loads on each blade from aerodyn [-] END TYPE ExtLd_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ExtLd_x_blah = 1 ! ExtLd%blah + integer(IntKi), public, parameter :: ExtLd_z_blah = 2 ! ExtLd%blah + integer(IntKi), public, parameter :: ExtLd_u_DX_u_twrDef = 3 ! ExtLd%DX_u%twrDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_bldDef = 4 ! ExtLd%DX_u%bldDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_hubDef = 5 ! ExtLd%DX_u%hubDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_nacDef = 6 ! ExtLd%DX_u%nacDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_bldRootDef = 7 ! ExtLd%DX_u%bldRootDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_bldPitch = 8 ! ExtLd%DX_u%bldPitch + integer(IntKi), public, parameter :: ExtLd_u_az = 9 ! ExtLd%az + integer(IntKi), public, parameter :: ExtLd_u_TowerMotion = 10 ! ExtLd%TowerMotion + integer(IntKi), public, parameter :: ExtLd_u_HubMotion = 11 ! ExtLd%HubMotion + integer(IntKi), public, parameter :: ExtLd_u_NacelleMotion = 12 ! ExtLd%NacelleMotion + integer(IntKi), public, parameter :: ExtLd_u_BladeRootMotion = 13 ! ExtLd%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: ExtLd_u_BladeMotion = 14 ! ExtLd%BladeMotion(DL%i1) + integer(IntKi), public, parameter :: ExtLd_y_DX_y_twrLd = 15 ! ExtLd%DX_y%twrLd + integer(IntKi), public, parameter :: ExtLd_y_DX_y_bldLd = 16 ! ExtLd%DX_y%bldLd + integer(IntKi), public, parameter :: ExtLd_y_TowerLoad = 17 ! ExtLd%TowerLoad + integer(IntKi), public, parameter :: ExtLd_y_BladeLoad = 18 ! ExtLd%BladeLoad(DL%i1) + integer(IntKi), public, parameter :: ExtLd_y_TowerLoadAD = 19 ! ExtLd%TowerLoadAD + integer(IntKi), public, parameter :: ExtLd_y_BladeLoadAD = 20 ! ExtLd%BladeLoadAD(DL%i1) + +contains subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(ExtLd_InitInputType), intent(in) :: SrcInitInputData @@ -1690,7 +1702,7 @@ SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, function ExtLd_InputMeshPointer(u, ML) result(Mesh) type(ExtLd_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1708,7 +1720,7 @@ function ExtLd_InputMeshPointer(u, ML) result(Mesh) end function function ExtLd_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1727,7 +1739,7 @@ function ExtLd_InputMeshName(ML) result(Name) function ExtLd_OutputMeshPointer(y, ML) result(Mesh) type(ExtLd_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1743,7 +1755,7 @@ function ExtLd_OutputMeshPointer(y, ML) result(Mesh) end function function ExtLd_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1757,5 +1769,189 @@ function ExtLd_OutputMeshName(ML) result(Name) Name = "y%BladeLoadAD("//trim(Num2LStr(ML%i1))//")" end select end function + +subroutine ExtLd_PackContStateAry(Vars, x, ValAry) + type(ExtLd_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (ExtLd_x_blah) + call MV_Pack2(Var, x%blah, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ExtLd_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (ExtLd_x_blah) + call MV_Unpack2(Var, ValAry, x%blah) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ExtLd_PackConstrStateAry(Vars, z, ValAry) + type(ExtLd_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (ExtLd_z_blah) + call MV_Pack2(Var, z%blah, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ExtLd_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (ExtLd_z_blah) + call MV_Unpack2(Var, ValAry, z%blah) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ExtLd_PackInputAry(Vars, u, ValAry) + type(ExtLd_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ExtLd_u_DX_u_twrDef) + call MV_Pack2(Var, u%DX_u%twrDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + call MV_Pack2(Var, u%DX_u%bldDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + call MV_Pack2(Var, u%DX_u%hubDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + call MV_Pack2(Var, u%DX_u%nacDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + call MV_Pack2(Var, u%DX_u%bldRootDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + call MV_Pack2(Var, u%DX_u%bldPitch, ValAry) ! Rank 1 Array + case (ExtLd_u_az) + call MV_Pack2(Var, u%az, ValAry) ! Scalar + case (ExtLd_u_TowerMotion) + call MV_Pack2(Var, u%TowerMotion, ValAry) ! Mesh + case (ExtLd_u_HubMotion) + call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_Pack2(Var, u%NacelleMotion, ValAry) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_Pack2(Var, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_Pack2(Var, u%BladeMotion(DL%i1), ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine ExtLd_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ExtLd_u_DX_u_twrDef) + call MV_Unpack2(Var, ValAry, u%DX_u%twrDef) ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + call MV_Unpack2(Var, ValAry, u%DX_u%bldDef) ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + call MV_Unpack2(Var, ValAry, u%DX_u%hubDef) ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + call MV_Unpack2(Var, ValAry, u%DX_u%nacDef) ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + call MV_Unpack2(Var, ValAry, u%DX_u%bldRootDef) ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + call MV_Unpack2(Var, ValAry, u%DX_u%bldPitch) ! Rank 1 Array + case (ExtLd_u_az) + call MV_Unpack2(Var, ValAry, u%az) ! Scalar + case (ExtLd_u_TowerMotion) + call MV_Unpack2(Var, ValAry, u%TowerMotion) ! Mesh + case (ExtLd_u_HubMotion) + call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_Unpack2(Var, ValAry, u%NacelleMotion) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_Unpack2(Var, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_Unpack2(Var, ValAry, u%BladeMotion(DL%i1)) ! Mesh + end select + end associate + end do +end subroutine + +subroutine ExtLd_PackOutputAry(Vars, y, ValAry) + type(ExtLd_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ExtLd_y_DX_y_twrLd) + call MV_Pack2(Var, y%DX_y%twrLd, ValAry) ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + call MV_Pack2(Var, y%DX_y%bldLd, ValAry) ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_Pack2(Var, y%TowerLoad, ValAry) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_Pack2(Var, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (ExtLd_y_TowerLoadAD) + call MV_Pack2(Var, y%TowerLoadAD, ValAry) ! Mesh + case (ExtLd_y_BladeLoadAD) + call MV_Pack2(Var, y%BladeLoadAD(DL%i1), ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine ExtLd_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ExtLd_y_DX_y_twrLd) + call MV_Unpack2(Var, ValAry, y%DX_y%twrLd) ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + call MV_Unpack2(Var, ValAry, y%DX_y%bldLd) ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_Unpack2(Var, ValAry, y%TowerLoad) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_Unpack2(Var, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (ExtLd_y_TowerLoadAD) + call MV_Unpack2(Var, ValAry, y%TowerLoadAD) ! Mesh + case (ExtLd_y_BladeLoadAD) + call MV_Unpack2(Var, ValAry, y%BladeLoadAD(DL%i1)) ! Mesh + end select + end associate + end do +end subroutine END MODULE ExtLoads_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 5e52d7c82b..5686f0bc33 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -33,8 +33,6 @@ MODULE ExtPtfm_MCKF_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtPtfm_u_PtfmMesh = 1 ! Mesh number for ExtPtfm ExtPtfm_u_PtfmMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ExtPtfm_y_PtfmMesh = 2 ! Mesh number for ExtPtfm ExtPtfm_y_PtfmMesh mesh [-] ! ========= ExtPtfm_InitInputType ======= TYPE, PUBLIC :: ExtPtfm_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] @@ -156,7 +154,14 @@ MODULE ExtPtfm_MCKF_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Example of data to be written to an output file [s,-] END TYPE ExtPtfm_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ExtPtfm_x_qm = 1 ! ExtPtfm%qm + integer(IntKi), public, parameter :: ExtPtfm_x_qmdot = 2 ! ExtPtfm%qmdot + integer(IntKi), public, parameter :: ExtPtfm_z_DummyConstrState = 3 ! ExtPtfm%DummyConstrState + integer(IntKi), public, parameter :: ExtPtfm_u_PtfmMesh = 4 ! ExtPtfm%PtfmMesh + integer(IntKi), public, parameter :: ExtPtfm_y_PtfmMesh = 5 ! ExtPtfm%PtfmMesh + integer(IntKi), public, parameter :: ExtPtfm_y_WriteOutput = 6 ! ExtPtfm%WriteOutput + +contains subroutine ExtPtfm_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(ExtPtfm_InitInputType), intent(in) :: SrcInitInputData @@ -1863,7 +1868,7 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat function ExtPtfm_InputMeshPointer(u, ML) result(Mesh) type(ExtPtfm_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1873,7 +1878,7 @@ function ExtPtfm_InputMeshPointer(u, ML) result(Mesh) end function function ExtPtfm_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1884,7 +1889,7 @@ function ExtPtfm_InputMeshName(ML) result(Name) function ExtPtfm_OutputMeshPointer(y, ML) result(Mesh) type(ExtPtfm_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1894,7 +1899,7 @@ function ExtPtfm_OutputMeshPointer(y, ML) result(Mesh) end function function ExtPtfm_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1902,5 +1907,133 @@ function ExtPtfm_OutputMeshName(ML) result(Name) Name = "y%PtfmMesh" end select end function + +subroutine ExtPtfm_PackContStateAry(Vars, x, ValAry) + type(ExtPtfm_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (ExtPtfm_x_qm) + call MV_Pack2(Var, x%qm, ValAry) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + call MV_Pack2(Var, x%qmdot, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtPtfm_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (ExtPtfm_x_qm) + call MV_Unpack2(Var, ValAry, x%qm) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + call MV_Unpack2(Var, ValAry, x%qmdot) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtPtfm_PackConstrStateAry(Vars, z, ValAry) + type(ExtPtfm_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (ExtPtfm_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ExtPtfm_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (ExtPtfm_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine ExtPtfm_PackInputAry(Vars, u, ValAry) + type(ExtPtfm_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_Pack2(Var, u%PtfmMesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine ExtPtfm_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_Unpack2(Var, ValAry, u%PtfmMesh) ! Mesh + end select + end associate + end do +end subroutine + +subroutine ExtPtfm_PackOutputAry(Vars, y, ValAry) + type(ExtPtfm_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_Pack2(Var, y%PtfmMesh, ValAry) ! Mesh + case (ExtPtfm_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine ExtPtfm_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_Unpack2(Var, ValAry, y%PtfmMesh) ! Mesh + case (ExtPtfm_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE ExtPtfm_MCKF_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/src/FEAM.f90 b/modules/feamooring/src/FEAM.f90 index 2f68c997de..f1d01cdc70 100644 --- a/modules/feamooring/src/FEAM.f90 +++ b/modules/feamooring/src/FEAM.f90 @@ -381,7 +381,7 @@ subroutine FEAM_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) !--------------------------------------------------------------------------- call MV_AddMeshVar(p%Vars%u, "PtFairleadDisplacement", [FieldTransDisp], & - VarIdx=p%iVarPtFairleadDisplacement, & + DatLoc(FEAM_u_PtFairleadDisplacement), & Mesh=u%PtFairleadDisplacement) !--------------------------------------------------------------------------- @@ -389,7 +389,7 @@ subroutine FEAM_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) !--------------------------------------------------------------------------- call MV_AddMeshVar(p%Vars%y, 'PtFairleadLoad', [FieldForce], & - VarIdx=p%iVarPtFairleadLoad, & + DatLoc(FEAM_y_PtFairleadLoad), & Mesh=y%PtFairleadLoad) !--------------------------------------------------------------------------- diff --git a/modules/feamooring/src/FEAM_Registry.txt b/modules/feamooring/src/FEAM_Registry.txt index 1b6d221196..1d4030418a 100644 --- a/modules/feamooring/src/FEAM_Registry.txt +++ b/modules/feamooring/src/FEAM_Registry.txt @@ -150,8 +150,6 @@ typedef ^ ^ IntKi LastIndWave - typedef FEAMooring/FEAM ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ^ ReKi GRAV {3} - - "Gravity" - typedef ^ ^ ModVarsType &Vars - - - "Module Variables" -typedef ^ ^ IntKi iVarPtFairleadDisplacement - - - "Index for PtFairleadDisplacement" -typedef ^ ^ IntKi iVarPtFairleadLoad - - - "Index for PtFairleadLoad" # parameters from Mooring typedef ^ ^ ReKi Eps - - - "Tolerance for static iteration" typedef ^ ^ ReKi Gravity - - - "Gravity" diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index d67474e96c..2fc0ec35ec 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -33,10 +33,6 @@ MODULE FEAMooring_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: FEAM_u_HydroForceLineMesh = 1 ! Mesh number for FEAM FEAM_u_HydroForceLineMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FEAM_u_PtFairleadDisplacement = 2 ! Mesh number for FEAM FEAM_u_PtFairleadDisplacement mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FEAM_y_PtFairleadLoad = 3 ! Mesh number for FEAM FEAM_y_PtFairleadLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FEAM_y_LineMeshPosition = 4 ! Mesh number for FEAM FEAM_y_LineMeshPosition mesh [-] ! ========= FEAM_InputFile ======= TYPE, PUBLIC :: FEAM_InputFile REAL(DbKi) :: DT = 0.0_R8Ki !< Communication interval for mooring dynamics [s] @@ -165,8 +161,6 @@ MODULE FEAMooring_Types REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] REAL(ReKi) , DIMENSION(1:3) :: GRAV = 0.0_ReKi !< Gravity [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarPtFairleadDisplacement = 0_IntKi !< Index for PtFairleadDisplacement [-] - INTEGER(IntKi) :: iVarPtFairleadLoad = 0_IntKi !< Index for PtFairleadLoad [-] REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] @@ -232,7 +226,17 @@ MODULE FEAMooring_Types TYPE(MeshType) :: LineMeshPosition !< Meshed output data [-] END TYPE FEAM_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: FEAM_x_GLU = 1 ! FEAM%GLU + integer(IntKi), public, parameter :: FEAM_x_GLDU = 2 ! FEAM%GLDU + integer(IntKi), public, parameter :: FEAM_z_TSN = 3 ! FEAM%TSN + integer(IntKi), public, parameter :: FEAM_z_TZER = 4 ! FEAM%TZER + integer(IntKi), public, parameter :: FEAM_u_HydroForceLineMesh = 5 ! FEAM%HydroForceLineMesh + integer(IntKi), public, parameter :: FEAM_u_PtFairleadDisplacement = 6 ! FEAM%PtFairleadDisplacement + integer(IntKi), public, parameter :: FEAM_y_WriteOutput = 7 ! FEAM%WriteOutput + integer(IntKi), public, parameter :: FEAM_y_PtFairleadLoad = 8 ! FEAM%PtFairleadLoad + integer(IntKi), public, parameter :: FEAM_y_LineMeshPosition = 9 ! FEAM%LineMeshPosition + +contains subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(FEAM_InputFile), intent(in) :: SrcInputFileData @@ -1543,8 +1547,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarPtFairleadDisplacement = SrcParamData%iVarPtFairleadDisplacement - DstParamData%iVarPtFairleadLoad = SrcParamData%iVarPtFairleadLoad DstParamData%Eps = SrcParamData%Eps DstParamData%Gravity = SrcParamData%Gravity DstParamData%WtrDens = SrcParamData%WtrDens @@ -1895,8 +1897,6 @@ subroutine FEAM_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarPtFairleadDisplacement) - call RegPack(RF, InData%iVarPtFairleadLoad) call RegPack(RF, InData%Eps) call RegPack(RF, InData%Gravity) call RegPack(RF, InData%WtrDens) @@ -1989,8 +1989,6 @@ subroutine FEAM_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarPtFairleadDisplacement); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPtFairleadLoad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Eps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return @@ -2514,7 +2512,7 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E function FEAM_InputMeshPointer(u, ML) result(Mesh) type(FEAM_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2526,7 +2524,7 @@ function FEAM_InputMeshPointer(u, ML) result(Mesh) end function function FEAM_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2539,7 +2537,7 @@ function FEAM_InputMeshName(ML) result(Name) function FEAM_OutputMeshPointer(y, ML) result(Mesh) type(FEAM_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2551,7 +2549,7 @@ function FEAM_OutputMeshPointer(y, ML) result(Mesh) end function function FEAM_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2561,5 +2559,145 @@ function FEAM_OutputMeshName(ML) result(Name) Name = "y%LineMeshPosition" end select end function + +subroutine FEAM_PackContStateAry(Vars, x, ValAry) + type(FEAM_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (FEAM_x_GLU) + call MV_Pack2(Var, x%GLU, ValAry) ! Rank 2 Array + case (FEAM_x_GLDU) + call MV_Pack2(Var, x%GLDU, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine FEAM_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (FEAM_x_GLU) + call MV_Unpack2(Var, ValAry, x%GLU) ! Rank 2 Array + case (FEAM_x_GLDU) + call MV_Unpack2(Var, ValAry, x%GLDU) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine FEAM_PackConstrStateAry(Vars, z, ValAry) + type(FEAM_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (FEAM_z_TSN) + call MV_Pack2(Var, z%TSN, ValAry) ! Rank 1 Array + case (FEAM_z_TZER) + call MV_Pack2(Var, z%TZER, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine FEAM_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (FEAM_z_TSN) + call MV_Unpack2(Var, ValAry, z%TSN) ! Rank 1 Array + case (FEAM_z_TZER) + call MV_Unpack2(Var, ValAry, z%TZER) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine FEAM_PackInputAry(Vars, u, ValAry) + type(FEAM_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_Pack2(Var, u%HydroForceLineMesh, ValAry) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_Pack2(Var, u%PtFairleadDisplacement, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine FEAM_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_Unpack2(Var, ValAry, u%HydroForceLineMesh) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_Unpack2(Var, ValAry, u%PtFairleadDisplacement) ! Mesh + end select + end associate + end do +end subroutine + +subroutine FEAM_PackOutputAry(Vars, y, ValAry) + type(FEAM_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (FEAM_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_Pack2(Var, y%PtFairleadLoad, ValAry) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_Pack2(Var, y%LineMeshPosition, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine FEAM_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (FEAM_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_Unpack2(Var, ValAry, y%PtFairleadLoad) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_Unpack2(Var, ValAry, y%LineMeshPosition) ! Mesh + end select + end associate + end do +end subroutine END MODULE FEAMooring_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 03c5e7d0af..b6583e000f 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -98,7 +98,12 @@ MODULE Conv_Radiation_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Rdtn !< [-] END TYPE Conv_Rdtn_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: Conv_Rdtn_x_DummyContState = 1 ! Conv_Rdtn%DummyContState + integer(IntKi), public, parameter :: Conv_Rdtn_z_DummyConstrState = 2 ! Conv_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: Conv_Rdtn_u_Velocity = 3 ! Conv_Rdtn%Velocity + integer(IntKi), public, parameter :: Conv_Rdtn_y_F_Rdtn = 4 ! Conv_Rdtn%F_Rdtn + +contains subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Conv_Rdtn_InitInputType), intent(in) :: SrcInitInputData @@ -974,7 +979,7 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt function Conv_Rdtn_InputMeshPointer(u, ML) result(Mesh) type(Conv_Rdtn_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -982,7 +987,7 @@ function Conv_Rdtn_InputMeshPointer(u, ML) result(Mesh) end function function Conv_Rdtn_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -991,7 +996,7 @@ function Conv_Rdtn_InputMeshName(ML) result(Name) function Conv_Rdtn_OutputMeshPointer(y, ML) result(Mesh) type(Conv_Rdtn_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -999,11 +1004,131 @@ function Conv_Rdtn_OutputMeshPointer(y, ML) result(Mesh) end function function Conv_Rdtn_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine Conv_Rdtn_PackContStateAry(Vars, x, ValAry) + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Conv_Rdtn_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Conv_Rdtn_PackConstrStateAry(Vars, z, ValAry) + type(Conv_Rdtn_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Conv_Rdtn_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Conv_Rdtn_PackInputAry(Vars, u, ValAry) + type(Conv_Rdtn_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_u_Velocity) + call MV_Pack2(Var, u%Velocity, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine Conv_Rdtn_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_u_Velocity) + call MV_Unpack2(Var, ValAry, u%Velocity) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine Conv_Rdtn_PackOutputAry(Vars, y, ValAry) + type(Conv_Rdtn_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + call MV_Pack2(Var, y%F_Rdtn, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine Conv_Rdtn_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + call MV_Unpack2(Var, ValAry, y%F_Rdtn) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE Conv_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index b589352b67..bc356a78b4 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -981,6 +981,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E if (p%WAMIT(k)%SS_Exctn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", FieldScalar, & + DatLoc(HydroDyn_x_WAMIT_SS_Exctn_x), & Flags=VF_DerivOrder1, & Num=p%WAMIT(k)%SS_Exctn%numStates, & Perturb=20000.0_R8Ki * D2R_D, & @@ -991,6 +992,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E if (p%WAMIT(k)%SS_Rdtn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", FieldScalar, & + DatLoc(HydroDyn_x_WAMIT_SS_Rdtn_x), & Flags=VF_DerivOrder1, & Num=p%WAMIT(k)%SS_Rdtn%numStates, & Perturb=2.0_R8Ki * D2R_D , & @@ -1013,35 +1015,28 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E PerturbTrans, & ! FieldTransAcc PerturbRot] ! FieldAngularAcc - call MV_AddMeshVar(p%Vars%u, "Morison", MotionFields, u%Morison%Mesh, & - VarIdx=p%iVarMorisonMotionMesh, & + call MV_AddMeshVar(p%Vars%u, "Morison", MotionFields, DatLoc(HydroDyn_u_Morison_Mesh), u%Morison%Mesh, & Perturbs=Perturbs) - call MV_AddMeshVar(p%Vars%u, "WAMIT", MotionFields, u%WAMITMesh, & - VarIdx=p%iVarWAMITMotionMesh, & + call MV_AddMeshVar(p%Vars%u, "WAMIT", MotionFields, DatLoc(HydroDyn_u_WAMITMesh), u%WAMITMesh, & Perturbs=Perturbs) - call MV_AddMeshVar(p%Vars%u, "Platform-RefPt", MotionFields, u%PRPMesh, & - VarIdx=p%iVarPRPMotionMesh, & + call MV_AddMeshVar(p%Vars%u, "Platform-RefPt", MotionFields, DatLoc(HydroDyn_u_PRPMesh), u%PRPMesh, & Perturbs=Perturbs) - call MV_AddVar(p%Vars%u, "WaveElev0", FieldScalar, & - VarIdx=p%iVarWaveElev0, & + call MV_AddVar(p%Vars%u, "WaveElev0", FieldScalar, DatLoc(HydroDyn_u_WaveElev0), & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: wave elevation at platform ref point, m']) - call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, & - VarIdx=p%iVarHWindSpeed, & + call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, DatLoc(HydroDyn_u_HWindSpeed), & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: horizontal current speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%u, "PLexp", FieldScalar, & - VarIdx=p%iVarPLexp, & + call MV_AddVar(p%Vars%u, "PLexp", FieldScalar, DatLoc(HydroDyn_u_PLexp), & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, & - VarIdx=p%iVarPropagationDir, & + call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, DatLoc(HydroDyn_u_PropagationDir), & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: propagation direction, rad']) @@ -1049,12 +1044,11 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E ! Output variables !---------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, "MorisonLoads", LoadFields, y%Morison%Mesh, VarIdx=p%iVarMorisonLoadMesh) + call MV_AddMeshVar(p%Vars%y, "MorisonLoads", LoadFields, DatLoc(HydroDyn_y_Morison_Mesh), y%Morison%Mesh) - call MV_AddMeshVar(p%Vars%y, "WAMITLoads", LoadFields, y%WAMITMesh, VarIdx=p%iVarWAMITLoadMesh) + call MV_AddMeshVar(p%Vars%y, "WAMITLoads", LoadFields, DatLoc(HydroDyn_y_WAMITMesh), y%WAMITMesh) - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & - VarIdx=p%iVarWriteOut, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(HydroDyn_y_WriteOutput), & Flags=VF_WriteOut, & Num=p%NumTotalOuts, & LinNames=[(WriteOutputLinName(i), i = 1, p%NumTotalOuts)]) @@ -1671,7 +1665,7 @@ end function CalcLoadsAtWRP !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter ) +SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -1688,6 +1682,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect !! to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with @@ -1696,82 +1691,78 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with !! respect to the inputs (u) [intent in to avoid deallocation] - integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPInput' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, k, col INTEGER(IntKi) :: startingI, startingJ, bOffset, offsetI + integer(IntKi) :: iVarWaveElev0, iVarHWindSpeed, iVarPLexp, iVarPropagationDir + type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars end if - + + ! Get extended input variable indices + iVarWaveElev0 = MV_FindVarDatLoc(VarsL%u, HydroDyn_u_WaveElev0) + iVarHWindSpeed = MV_FindVarDatLoc(VarsL%u, HydroDyn_u_HWindSpeed) + iVarPLexp = MV_FindVarDatLoc(VarsL%u, HydroDyn_u_PLexp) + iVarPropagationDir = MV_FindVarDatLoc(VarsL%u, HydroDyn_u_PropagationDir) + ! make a copy of the inputs to perturb - call HydroDyn_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - if (Failed()) return + call HydroDyn_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Pack inputs into array - call HD_PackInputValues(p, u, m%Jac%u) - if (Failed()) return + call HydroDyn_PackInputAry(VarsL, u, m%Jac%u); if (Failed()) return ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - IF ( PRESENT( dYdu ) ) THEN + if (present(dYdu)) then ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2) - if (Failed()) return + call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%u) ! If variable is extended input, skip - if (MV_HasFlags(p%Vars%u(i), VF_ExtLin)) cycle + if (MV_HasFlags(VarsL%u(i), VF_ExtLin)) cycle ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call HD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call HydroDyn_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call HydroDyn_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call HD_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call HydroDyn_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call HydroDyn_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do ! Set extended inputs - dYdu(:, p%Vars%u(p%iVarWaveElev0)%iLoc(1)) = 0.0_R8Ki - dYdu(:, p%Vars%u(p%iVarHWindSpeed)%iLoc(1)) = 0.0_R8Ki - dYdu(:, p%Vars%u(p%iVarPLexp)%iLoc(1)) = 0.0_R8Ki - dYdu(:, p%Vars%u(p%iVarPropagationDir)%iLoc(1)) = 0.0_R8Ki + dYdu(:, VarsL%u(iVarWaveElev0)%iLoc(1)) = 0.0_R8Ki + dYdu(:, VarsL%u(iVarHWindSpeed)%iLoc(1)) = 0.0_R8Ki + dYdu(:, VarsL%u(iVarPLexp)%iLoc(1)) = 0.0_R8Ki + dYdu(:, VarsL%u(iVarPropagationDir)%iLoc(1)) = 0.0_R8Ki END IF @@ -1783,7 +1774,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2) + call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2) if (Failed()) return end if @@ -1893,7 +1884,7 @@ END SUBROUTINE HD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, FlagFilter ) +SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -1910,6 +1901,7 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect !! to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect @@ -1918,65 +1910,57 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the continuous states (x) [intent in to avoid deallocation] - integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation - CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPContState' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc - INTEGER(IntKi) :: i, j, k, col, sOffset - + CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPContState' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j, k, col, sOffset + type(ModVarsType), pointer :: VarsL + ErrStat = ErrID_None ErrMsg = '' - - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars end if ! Copy State values to perturb call HydroDyn_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call HD_PackStateValues(p, x, m%Jac%x) + call HydroDyn_PackContStateAry(VarsL, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, VarsL%Ny, VarsL%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + do i = 1, size(VarsL%x) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, VarsL%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call HD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call HydroDyn_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HD_PackOutputValues(p, m%y_lin, m%Jac%y_pos, IsFullLin) + call HydroDyn_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call HD_UnpackStateValues(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call HydroDyn_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HD_PackOutputValues(p, m%y_lin, m%Jac%y_neg, IsFullLin) + call HydroDyn_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = VarsL%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do @@ -1987,7 +1971,7 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! allocate dXdu if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if dXdx = 0.0_R8Ki @@ -2146,7 +2130,7 @@ END SUBROUTINE HD_JacobianPConstrState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, u_op, y_op, x_op, dx_op, xd_op, z_op ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -2159,6 +2143,7 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states @@ -2170,51 +2155,56 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 INTEGER(IntKi) :: i, j, index - + type(ModVarsType), pointer :: VarsL + ErrStat = ErrID_None ErrMsg = '' + + if (present(Vars)) then + VarsL => Vars + else + VarsL => p%Vars + end if !.................................. IF ( PRESENT( u_op ) ) THEN if (.not. allocated(u_op)) then - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) - if (Failed()) return + call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return + u_op = 0.0_R8Ki end if - call HD_PackInputValues(p, u, u_op) + call HydroDyn_PackInputAry(VarsL, u, u_op) END IF !.................................. if ( PRESENT( y_op ) ) then if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) - if (Failed()) return + call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + y_op = 0.0_R8Ki end if - call HD_PackOutputValues(p, y, y_op, .true.) + call HydroDyn_PackOutputAry(VarsL, y, y_op) end if !.................................. - IF ( PRESENT( x_op ) ) THEN - if (p%Vars%Nx == 0) return + IF ( PRESENT( x_op ) .and. VarsL%Nx > 0) THEN if ( y%WAMITMesh%Committed ) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2) - if (Failed()) return + call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return + x_op = 0.0_R8Ki end if - call HD_PackStateValues(p, x, x_op) + call HydroDyn_PackContStateAry(VarsL, x, x_op) end if END IF !.................................. - IF ( PRESENT( dx_op ) ) THEN - if (p%Vars%Nx == 0) return + IF ( PRESENT( dx_op ) .and. VarsL%Nx > 0) THEN if ( y%WAMITMesh%Committed ) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2) - if (Failed()) return + call AllocAry(dx_op, VarsL%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return + dx_op = 0.0_R8Ki end if call HydroDyn_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2 ) if (Failed()) return - call HD_PackStateValues(p, m%dxdt_lin, dx_op) + call HydroDyn_PackContStateAry(VarsL, m%dxdt_lin, dx_op) end if END IF @@ -2233,113 +2223,6 @@ logical function Failed() end function Failed END SUBROUTINE HD_GetOP -subroutine HD_PackStateValues(p, x, ary) - type(HydroDyn_ParameterType), intent(in) :: p - type(HydroDyn_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: ary(:) - integer(IntKi) :: i, j, k - k = 1 - do j = 1, p%nWAMITObj - do i = 1,p%WAMIT(j)%SS_Exctn%numStates ! Loop through all DOFs - ary(k) = x%WAMIT(j)%SS_Exctn%x(i) - k = k + 1 - end do - end do - do j = 1, p%nWAMITObj - do i = 1,p%WAMIT(j)%SS_Rdtn%numStates ! Loop through all DOFs - ary(k) = x%WAMIT(j)%SS_Rdtn%x(i) - k = k + 1 - end do - end do -end subroutine - -subroutine HD_UnpackStateValues(p, ary, x) - type(HydroDyn_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: ary(:) - type(HydroDyn_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i, j, k - k = 1 - do j = 1, p%nWAMITObj - do i = 1,p%WAMIT(j)%SS_Exctn%numStates ! Loop through all DOFs - x%WAMIT(j)%SS_Exctn%x(i) = ary(k) - k = k + 1 - end do - end do - do j = 1, p%nWAMITObj - do i = 1,p%WAMIT(j)%SS_Rdtn%numStates ! Loop through all DOFs - x%WAMIT(j)%SS_Rdtn%x(i) = ary(k) - k = k + 1 - end do - end do -end subroutine - -subroutine HD_PackInputValues(p, u, Ary) - type(HydroDyn_ParameterType), intent(in) :: p - type(HydroDyn_InputType), intent(in) :: u - real(R8Ki), intent(out) :: Ary(:) - integer(IntKi) :: i - call MV_Pack(p%Vars%u, p%iVarMorisonMotionMesh, u%Morison%Mesh, Ary) - call MV_Pack(p%Vars%u, p%iVarWAMITMotionMesh, u%WAMITMesh, Ary) - call MV_Pack(p%Vars%u, p%iVarPRPMotionMesh, u%PRPMesh, Ary) - call MV_Pack(p%Vars%u, p%iVarWaveElev0, 0.0_R8Ki, Ary) ! Extended input - call MV_Pack(p%Vars%u, p%iVarHWindSpeed, 0.0_R8Ki, Ary) ! Extended input - call MV_Pack(p%Vars%u, p%iVarPLexp, 0.0_R8Ki, Ary) ! Extended input - call MV_Pack(p%Vars%u, p%iVarPropagationDir, 0.0_R8Ki, Ary) ! Extended input - -!FIXME: when sea current from IfW/FlowField is enabled, this code must be updated and enabled -! !------------------------------ -! ! Extended inputs -- Linearization is only possible with Steady or Uniform Wind, so take advantage of that here -! ! Module/Mesh/Field: HWindSpeed = 37 -! ! Module/Mesh/Field: PLexp = 38 -! ! Module/Mesh/Field: PropagationDir = 39 -! call IfW_UniformWind_GetOP(p_AD%FlowField%Uniform, t, .false. , OP_out) -! ! HWindSpeed -! u_op(index) = OP_out(1); index = index + 1 -! ! PLexp -! u_op(index) = OP_out(2); index = index + 1 -! ! PropagationDir (include AngleH in calculation if any) -! u_op(index) = OP_out(3) + p_AD%FlowField%PropagationDir; index = index + 1 -end subroutine - -subroutine HD_UnpackInputValues(p, Ary, u) - type(HydroDyn_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Ary(:) - type(HydroDyn_InputType), intent(inout) :: u - integer(IntKi) :: i - call MV_Unpack(p%Vars%u, p%iVarMorisonMotionMesh, Ary, u%Morison%Mesh) - call MV_Unpack(p%Vars%u, p%iVarWAMITMotionMesh, Ary, u%WAMITMesh) - call MV_Unpack(p%Vars%u, p%iVarPRPMotionMesh, Ary, u%PRPMesh) - ! call MV_Unpack(p%Vars%u, p%iVarWaveElev0, Ary, ) ! Extended input - ! u_op(index) = 0.0_R8Ki; index=index+1 ! WaveElev0 -- linearization not allowed for non-zero - ! u_op(index) = 0.0_R8Ki; index=index+1 ! HWindSpeed - ! u_op(index) = 0.0_R8Ki; index=index+1 ! PLexp - ! u_op(index) = 0.0_R8Ki; index=index+1 ! PropagationDir - -!FIXME: when sea current from IfW/FlowField is enabled, this code must be updated and enabled -! !------------------------------ -! ! Extended inputs -- Linearization is only possible with Steady or Uniform Wind, so take advantage of that here -! ! Module/Mesh/Field: HWindSpeed = 37 -! ! Module/Mesh/Field: PLexp = 38 -! ! Module/Mesh/Field: PropagationDir = 39 -! call IfW_UniformWind_GetOP(p_AD%FlowField%Uniform, t, .false. , OP_out) -! ! HWindSpeed -! u_op(index) = OP_out(1); index = index + 1 -! ! PLexp -! u_op(index) = OP_out(2); index = index + 1 -! ! PropagationDir (include AngleH in calculation if any) -! u_op(index) = OP_out(3) + p_AD%FlowField%PropagationDir; index = index + 1 -end subroutine - -subroutine HD_PackOutputValues(p, y, Ary, PackWriteOutput) - type(HydroDyn_ParameterType), intent(in) :: p - type(HydroDyn_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: Ary(:) - logical, intent(in) :: PackWriteOutput - integer(IntKi) :: i - call MV_Pack(p%Vars%y, p%iVarMorisonLoadMesh, y%Morison%Mesh, Ary) - call MV_Pack(p%Vars%y, p%iVarWAMITLoadMesh, y%WAMITMesh, Ary) - call MV_Pack(p%Vars%y, p%iVarWriteOut, y%WriteOutput, Ary) -end subroutine !---------------------------------------------------------------------------------------------------------------------------------- END MODULE HydroDyn diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index f3c633933f..c737f6df65 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -25,6 +25,11 @@ usefrom SeaSt_WaveField.txt param HydroDyn/HydroDyn unused INTEGER MaxHDOutputs - 510 - "The maximum number of output channels supported by this module" - param HydroDyn/HydroDyn unused INTEGER MaxUserOutputs - 5150 - " Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150" - +param ^ ^ IntKi HydroDyn_u_WaveElev0 - -1 - "WaveElev0 Extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_HWindSpeed - -1 - "HWindSpeed extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_PLexp - -1 - "PLexp extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_PropagationDir - -1 - "PropagationDir extended input DatLoc number" - + ######################### # ..... Input file data ........................................................................................................... # This is data defined in the Input File for this module (or could otherwise be passed in) @@ -124,16 +129,6 @@ typedef ^ ^ Morison_Oth # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - -typedef ^ ^ IntKi iVarMorisonMotionMesh - 0 - "Morison Motion Mesh variable index" -typedef ^ ^ IntKi iVarWAMITMotionMesh - 0 - "WAMIT Motion Mesh variable index" -typedef ^ ^ IntKi iVarPRPMotionMesh - 0 - "PRP Motion Mesh variable index" -typedef ^ ^ IntKi iVarWaveElev0 - 0 - "Wave Elevation variable index" -typedef ^ ^ IntKi iVarHWindSpeed - 0 - "Horizontal wind speed variable index" -typedef ^ ^ IntKi iVarPLexp - 0 - "Wind shear exponent variable index" -typedef ^ ^ IntKi iVarPropagationDir - 0 - "Wind propagation direction variable index" -typedef ^ ^ IntKi iVarMorisonLoadMesh - 0 - "Morison Load Mesh variable index" -typedef ^ ^ IntKi iVarWAMITLoadMesh - 0 - "WAMIT Load Mesh variable index" -typedef ^ ^ IntKi iVarWriteOut - 0 - "Write Output variable index" typedef ^ ^ INTEGER nWAMITObj - - - "number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - typedef ^ ^ INTEGER vecMultiplier - - - "multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1" - typedef ^ ^ WAMIT_ParameterType WAMIT {:} - - "Parameter data for the WAMIT module" - diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index df4f281811..467d6655f7 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -41,14 +41,10 @@ MODULE HydroDyn_Types IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_Morison_Mesh = 1 ! Mesh number for HydroDyn HydroDyn_u_Morison_Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_WAMITMesh = 2 ! Mesh number for HydroDyn HydroDyn_u_WAMITMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PRPMesh = 3 ! Mesh number for HydroDyn HydroDyn_u_PRPMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_WAMIT_Mesh = 4 ! Mesh number for HydroDyn HydroDyn_y_WAMIT_Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_WAMIT2_Mesh = 5 ! Mesh number for HydroDyn HydroDyn_y_WAMIT2_Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_Morison_Mesh = 6 ! Mesh number for HydroDyn HydroDyn_y_Morison_Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_Morison_VisMesh = 7 ! Mesh number for HydroDyn HydroDyn_y_Morison_VisMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_y_WAMITMesh = 8 ! Mesh number for HydroDyn HydroDyn_y_WAMITMesh mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_WaveElev0 = -1 ! WaveElev0 Extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_HWindSpeed = -1 ! HWindSpeed extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PLexp = -1 ! PLexp extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PropagationDir = -1 ! PropagationDir extended input DatLoc number [-] ! ========= HydroDyn_InputFile ======= TYPE, PUBLIC :: HydroDyn_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -149,16 +145,6 @@ MODULE HydroDyn_Types ! ========= HydroDyn_ParameterType ======= TYPE, PUBLIC :: HydroDyn_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarMorisonMotionMesh = 0 !< Morison Motion Mesh variable index [-] - INTEGER(IntKi) :: iVarWAMITMotionMesh = 0 !< WAMIT Motion Mesh variable index [-] - INTEGER(IntKi) :: iVarPRPMotionMesh = 0 !< PRP Motion Mesh variable index [-] - INTEGER(IntKi) :: iVarWaveElev0 = 0 !< Wave Elevation variable index [-] - INTEGER(IntKi) :: iVarHWindSpeed = 0 !< Horizontal wind speed variable index [-] - INTEGER(IntKi) :: iVarPLexp = 0 !< Wind shear exponent variable index [-] - INTEGER(IntKi) :: iVarPropagationDir = 0 !< Wind propagation direction variable index [-] - INTEGER(IntKi) :: iVarMorisonLoadMesh = 0 !< Morison Load Mesh variable index [-] - INTEGER(IntKi) :: iVarWAMITLoadMesh = 0 !< WAMIT Load Mesh variable index [-] - INTEGER(IntKi) :: iVarWriteOut = 0 !< Write Output variable index [-] INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] TYPE(WAMIT_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< Parameter data for the WAMIT module [-] @@ -229,7 +215,26 @@ MODULE HydroDyn_Types TYPE(WAMIT_InputType) , DIMENSION(:), ALLOCATABLE :: u_WAMIT !< WAMIT module inputs [-] END TYPE HydroDyn_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: HydroDyn_x_WAMIT_SS_Rdtn_x = 1 ! HydroDyn%WAMIT(DL%i1)%SS_Rdtn%x + integer(IntKi), public, parameter :: HydroDyn_x_WAMIT_SS_Exctn_x = 2 ! HydroDyn%WAMIT(DL%i1)%SS_Exctn%x + integer(IntKi), public, parameter :: HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState = 3 ! HydroDyn%WAMIT(DL%i1)%Conv_Rdtn%DummyContState + integer(IntKi), public, parameter :: HydroDyn_x_Morison_DummyContState = 4 ! HydroDyn%Morison%DummyContState + integer(IntKi), public, parameter :: HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState = 5 ! HydroDyn%WAMIT%Conv_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState = 6 ! HydroDyn%WAMIT%SS_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState = 7 ! HydroDyn%WAMIT%SS_Exctn%DummyConstrState + integer(IntKi), public, parameter :: HydroDyn_z_Morison_DummyConstrState = 8 ! HydroDyn%Morison%DummyConstrState + integer(IntKi), public, parameter :: HydroDyn_u_Morison_Mesh = 9 ! HydroDyn%Morison%Mesh + integer(IntKi), public, parameter :: HydroDyn_u_WAMITMesh = 10 ! HydroDyn%WAMITMesh + integer(IntKi), public, parameter :: HydroDyn_u_PRPMesh = 11 ! HydroDyn%PRPMesh + integer(IntKi), public, parameter :: HydroDyn_y_WAMIT_Mesh = 12 ! HydroDyn%WAMIT(DL%i1)%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_WAMIT2_Mesh = 13 ! HydroDyn%WAMIT2(DL%i1)%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_Mesh = 14 ! HydroDyn%Morison%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_VisMesh = 15 ! HydroDyn%Morison%VisMesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_WriteOutput = 16 ! HydroDyn%Morison%WriteOutput + integer(IntKi), public, parameter :: HydroDyn_y_WAMITMesh = 17 ! HydroDyn%WAMITMesh + integer(IntKi), public, parameter :: HydroDyn_y_WriteOutput = 18 ! HydroDyn%WriteOutput + +contains subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(HydroDyn_InputFile), intent(in) :: SrcInputFileData @@ -1355,16 +1360,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarMorisonMotionMesh = SrcParamData%iVarMorisonMotionMesh - DstParamData%iVarWAMITMotionMesh = SrcParamData%iVarWAMITMotionMesh - DstParamData%iVarPRPMotionMesh = SrcParamData%iVarPRPMotionMesh - DstParamData%iVarWaveElev0 = SrcParamData%iVarWaveElev0 - DstParamData%iVarHWindSpeed = SrcParamData%iVarHWindSpeed - DstParamData%iVarPLexp = SrcParamData%iVarPLexp - DstParamData%iVarPropagationDir = SrcParamData%iVarPropagationDir - DstParamData%iVarMorisonLoadMesh = SrcParamData%iVarMorisonLoadMesh - DstParamData%iVarWAMITLoadMesh = SrcParamData%iVarWAMITLoadMesh - DstParamData%iVarWriteOut = SrcParamData%iVarWriteOut DstParamData%nWAMITObj = SrcParamData%nWAMITObj DstParamData%vecMultiplier = SrcParamData%vecMultiplier if (allocated(SrcParamData%WAMIT)) then @@ -1608,16 +1603,6 @@ subroutine HydroDyn_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarMorisonMotionMesh) - call RegPack(RF, InData%iVarWAMITMotionMesh) - call RegPack(RF, InData%iVarPRPMotionMesh) - call RegPack(RF, InData%iVarWaveElev0) - call RegPack(RF, InData%iVarHWindSpeed) - call RegPack(RF, InData%iVarPLexp) - call RegPack(RF, InData%iVarPropagationDir) - call RegPack(RF, InData%iVarMorisonLoadMesh) - call RegPack(RF, InData%iVarWAMITLoadMesh) - call RegPack(RF, InData%iVarWriteOut) call RegPack(RF, InData%nWAMITObj) call RegPack(RF, InData%vecMultiplier) call RegPack(RF, allocated(InData%WAMIT)) @@ -1712,16 +1697,6 @@ subroutine HydroDyn_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarMorisonMotionMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWAMITMotionMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPRPMotionMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWaveElev0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHWindSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPLexp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPropagationDir); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarMorisonLoadMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWAMITLoadMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWriteOut); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nWAMITObj); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%vecMultiplier); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) @@ -2692,7 +2667,7 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta function HydroDyn_InputMeshPointer(u, ML) result(Mesh) type(HydroDyn_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2706,7 +2681,7 @@ function HydroDyn_InputMeshPointer(u, ML) result(Mesh) end function function HydroDyn_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2721,7 +2696,7 @@ function HydroDyn_InputMeshName(ML) result(Name) function HydroDyn_OutputMeshPointer(y, ML) result(Mesh) type(HydroDyn_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2739,7 +2714,7 @@ function HydroDyn_OutputMeshPointer(y, ML) result(Mesh) end function function HydroDyn_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2755,5 +2730,181 @@ function HydroDyn_OutputMeshName(ML) result(Name) Name = "y%WAMITMesh" end select end function + +subroutine HydroDyn_PackContStateAry(Vars, x, ValAry) + type(HydroDyn_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + call MV_Pack2(Var, x%WAMIT(DL%i1)%SS_Rdtn%x, ValAry) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + call MV_Pack2(Var, x%WAMIT(DL%i1)%SS_Exctn%x, ValAry) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + call MV_Pack2(Var, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState, ValAry) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + call MV_Pack2(Var, x%Morison%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine HydroDyn_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%SS_Rdtn%x) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%SS_Exctn%x) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + call MV_Unpack2(Var, ValAry, x%Morison%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine HydroDyn_PackConstrStateAry(Vars, z, ValAry) + type(HydroDyn_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + call MV_Pack2(Var, z%WAMIT%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + call MV_Pack2(Var, z%WAMIT%SS_Rdtn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + call MV_Pack2(Var, z%WAMIT%SS_Exctn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + call MV_Pack2(Var, z%Morison%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine HydroDyn_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%WAMIT%Conv_Rdtn%DummyConstrState) ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%WAMIT%SS_Rdtn%DummyConstrState) ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%WAMIT%SS_Exctn%DummyConstrState) ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%Morison%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine HydroDyn_PackInputAry(Vars, u, ValAry) + type(HydroDyn_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_Pack2(Var, u%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_u_WAMITMesh) + call MV_Pack2(Var, u%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_Pack2(Var, u%PRPMesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine HydroDyn_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_Unpack2(Var, ValAry, u%Morison%Mesh) ! Mesh + case (HydroDyn_u_WAMITMesh) + call MV_Unpack2(Var, ValAry, u%WAMITMesh) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_Unpack2(Var, ValAry, u%PRPMesh) ! Mesh + end select + end associate + end do +end subroutine + +subroutine HydroDyn_PackOutputAry(Vars, y, ValAry) + type(HydroDyn_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_Pack2(Var, y%WAMIT(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_Pack2(Var, y%WAMIT2(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_Pack2(Var, y%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_Pack2(Var, y%Morison%VisMesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + call MV_Pack2(Var, y%Morison%WriteOutput, ValAry) ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_Pack2(Var, y%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine HydroDyn_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_Unpack2(Var, ValAry, y%WAMIT(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_Unpack2(Var, ValAry, y%WAMIT2(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_Unpack2(Var, ValAry, y%Morison%Mesh) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_Unpack2(Var, ValAry, y%Morison%VisMesh) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + call MV_Unpack2(Var, ValAry, y%Morison%WriteOutput) ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_Unpack2(Var, ValAry, y%WAMITMesh) ! Mesh + case (HydroDyn_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE HydroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 5ec8657362..e8b27b6417 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -34,9 +34,6 @@ MODULE Morison_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Morison_u_Mesh = 1 ! Mesh number for Morison Morison_u_Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Morison_y_Mesh = 2 ! Mesh number for Morison Morison_y_Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Morison_y_VisMesh = 3 ! Mesh number for Morison Morison_y_VisMesh mesh [-] ! ========= Morison_JointType ======= TYPE, PUBLIC :: Morison_JointType INTEGER(IntKi) :: JointID = 0_IntKi !< User-specified integer ID for the given joint [-] @@ -433,7 +430,14 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< [-] END TYPE Morison_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: Morison_x_DummyContState = 1 ! Morison%DummyContState + integer(IntKi), public, parameter :: Morison_z_DummyConstrState = 2 ! Morison%DummyConstrState + integer(IntKi), public, parameter :: Morison_u_Mesh = 3 ! Morison%Mesh + integer(IntKi), public, parameter :: Morison_y_Mesh = 4 ! Morison%Mesh + integer(IntKi), public, parameter :: Morison_y_VisMesh = 5 ! Morison%VisMesh + integer(IntKi), public, parameter :: Morison_y_WriteOutput = 6 ! Morison%WriteOutput + +contains subroutine Morison_CopyJointType(SrcJointTypeData, DstJointTypeData, CtrlCode, ErrStat, ErrMsg) type(Morison_JointType), intent(in) :: SrcJointTypeData @@ -4663,7 +4667,7 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat function Morison_InputMeshPointer(u, ML) result(Mesh) type(Morison_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -4673,7 +4677,7 @@ function Morison_InputMeshPointer(u, ML) result(Mesh) end function function Morison_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -4684,7 +4688,7 @@ function Morison_InputMeshName(ML) result(Name) function Morison_OutputMeshPointer(y, ML) result(Mesh) type(Morison_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -4696,7 +4700,7 @@ function Morison_OutputMeshPointer(y, ML) result(Mesh) end function function Morison_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -4706,5 +4710,133 @@ function Morison_OutputMeshName(ML) result(Name) Name = "y%VisMesh" end select end function + +subroutine Morison_PackContStateAry(Vars, x, ValAry) + type(Morison_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (Morison_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Morison_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (Morison_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Morison_PackConstrStateAry(Vars, z, ValAry) + type(Morison_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (Morison_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Morison_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (Morison_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Morison_PackInputAry(Vars, u, ValAry) + type(Morison_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (Morison_u_Mesh) + call MV_Pack2(Var, u%Mesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine Morison_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (Morison_u_Mesh) + call MV_Unpack2(Var, ValAry, u%Mesh) ! Mesh + end select + end associate + end do +end subroutine + +subroutine Morison_PackOutputAry(Vars, y, ValAry) + type(Morison_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (Morison_y_Mesh) + call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh + case (Morison_y_VisMesh) + call MV_Pack2(Var, y%VisMesh, ValAry) ! Mesh + case (Morison_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine Morison_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (Morison_y_Mesh) + call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh + case (Morison_y_VisMesh) + call MV_Unpack2(Var, ValAry, y%VisMesh) ! Mesh + case (Morison_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE Morison_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 5389377922..749ff381e0 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -101,7 +101,13 @@ MODULE SS_Excitation_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< output Data [kN] END TYPE SS_Exc_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SS_Exc_x_x = 1 ! SS_Exc%x + integer(IntKi), public, parameter :: SS_Exc_z_DummyConstrState = 2 ! SS_Exc%DummyConstrState + integer(IntKi), public, parameter :: SS_Exc_u_PtfmPos = 3 ! SS_Exc%PtfmPos + integer(IntKi), public, parameter :: SS_Exc_y_y = 4 ! SS_Exc%y + integer(IntKi), public, parameter :: SS_Exc_y_WriteOutput = 5 ! SS_Exc%WriteOutput + +contains subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SS_Exc_InitInputType), intent(in) :: SrcInitInputData @@ -1154,7 +1160,7 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, function SS_Exc_InputMeshPointer(u, ML) result(Mesh) type(SS_Exc_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1162,7 +1168,7 @@ function SS_Exc_InputMeshPointer(u, ML) result(Mesh) end function function SS_Exc_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1171,7 +1177,7 @@ function SS_Exc_InputMeshName(ML) result(Name) function SS_Exc_OutputMeshPointer(y, ML) result(Mesh) type(SS_Exc_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1179,11 +1185,135 @@ function SS_Exc_OutputMeshPointer(y, ML) result(Mesh) end function function SS_Exc_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine SS_Exc_PackContStateAry(Vars, x, ValAry) + type(SS_Exc_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SS_Exc_x_x) + call MV_Pack2(Var, x%x, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SS_Exc_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SS_Exc_x_x) + call MV_Unpack2(Var, ValAry, x%x) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SS_Exc_PackConstrStateAry(Vars, z, ValAry) + type(SS_Exc_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SS_Exc_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SS_Exc_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SS_Exc_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SS_Exc_PackInputAry(Vars, u, ValAry) + type(SS_Exc_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SS_Exc_u_PtfmPos) + call MV_Pack2(Var, u%PtfmPos, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine SS_Exc_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SS_Exc_u_PtfmPos) + call MV_Unpack2(Var, ValAry, u%PtfmPos) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine SS_Exc_PackOutputAry(Vars, y, ValAry) + type(SS_Exc_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SS_Exc_y_y) + call MV_Pack2(Var, y%y, ValAry) ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SS_Exc_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SS_Exc_y_y) + call MV_Unpack2(Var, ValAry, y%y) ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE SS_Excitation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 6953cd03ae..2eaa61f153 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -95,7 +95,13 @@ MODULE SS_Radiation_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< output Data [(kN)] END TYPE SS_Rad_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SS_Rad_x_x = 1 ! SS_Rad%x + integer(IntKi), public, parameter :: SS_Rad_z_DummyConstrState = 2 ! SS_Rad%DummyConstrState + integer(IntKi), public, parameter :: SS_Rad_u_dq = 3 ! SS_Rad%dq + integer(IntKi), public, parameter :: SS_Rad_y_y = 4 ! SS_Rad%y + integer(IntKi), public, parameter :: SS_Rad_y_WriteOutput = 5 ! SS_Rad%WriteOutput + +contains subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SS_Rad_InitInputType), intent(in) :: SrcInitInputData @@ -1075,7 +1081,7 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, function SS_Rad_InputMeshPointer(u, ML) result(Mesh) type(SS_Rad_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1083,7 +1089,7 @@ function SS_Rad_InputMeshPointer(u, ML) result(Mesh) end function function SS_Rad_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1092,7 +1098,7 @@ function SS_Rad_InputMeshName(ML) result(Name) function SS_Rad_OutputMeshPointer(y, ML) result(Mesh) type(SS_Rad_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1100,11 +1106,135 @@ function SS_Rad_OutputMeshPointer(y, ML) result(Mesh) end function function SS_Rad_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine SS_Rad_PackContStateAry(Vars, x, ValAry) + type(SS_Rad_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SS_Rad_x_x) + call MV_Pack2(Var, x%x, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SS_Rad_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SS_Rad_x_x) + call MV_Unpack2(Var, ValAry, x%x) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SS_Rad_PackConstrStateAry(Vars, z, ValAry) + type(SS_Rad_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SS_Rad_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SS_Rad_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SS_Rad_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SS_Rad_PackInputAry(Vars, u, ValAry) + type(SS_Rad_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SS_Rad_u_dq) + call MV_Pack2(Var, u%dq, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SS_Rad_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SS_Rad_u_dq) + call MV_Unpack2(Var, ValAry, u%dq) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SS_Rad_PackOutputAry(Vars, y, ValAry) + type(SS_Rad_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SS_Rad_y_y) + call MV_Pack2(Var, y%y, ValAry) ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SS_Rad_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SS_Rad_y_y) + call MV_Unpack2(Var, ValAry, y%y) ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE SS_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index a52406a21f..2ea38b0534 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -35,7 +35,6 @@ MODULE WAMIT2_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WAMIT2_y_Mesh = 1 ! Mesh number for WAMIT2 WAMIT2_y_Mesh mesh [-] ! ========= WAMIT2_InitInputType ======= TYPE, PUBLIC :: WAMIT2_InitInputType LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] @@ -85,7 +84,9 @@ MODULE WAMIT2_Types TYPE(MeshType) :: Mesh !< Loads at the platform reference point in the inertial frame [-] END TYPE WAMIT2_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: WAMIT2_y_Mesh = 1 ! WAMIT2%Mesh + +contains subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(WAMIT2_InitInputType), intent(in) :: SrcInitInputData @@ -635,7 +636,7 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, function WAMIT2_OutputMeshPointer(y, ML) result(Mesh) type(WAMIT2_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -645,7 +646,7 @@ function WAMIT2_OutputMeshPointer(y, ML) result(Mesh) end function function WAMIT2_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -653,5 +654,35 @@ function WAMIT2_OutputMeshName(ML) result(Name) Name = "y%Mesh" end select end function + +subroutine WAMIT2_PackOutputAry(Vars, y, ValAry) + type(WAMIT2_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (WAMIT2_y_Mesh) + call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine WAMIT2_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT2_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (WAMIT2_y_Mesh) + call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh + end select + end associate + end do +end subroutine END MODULE WAMIT2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index a7d24e9386..9a9d4aa852 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -36,8 +36,6 @@ MODULE WAMIT_Types USE SS_Excitation_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: WAMIT_u_Mesh = 1 ! Mesh number for WAMIT WAMIT_u_Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WAMIT_y_Mesh = 2 ! Mesh number for WAMIT WAMIT_y_Mesh mesh [-] ! ========= WAMIT_InitInputType ======= TYPE, PUBLIC :: WAMIT_InitInputType INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] @@ -141,7 +139,16 @@ MODULE WAMIT_Types TYPE(MeshType) :: Mesh !< Loads at the WAMIT reference point in the inertial frame [-] END TYPE WAMIT_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: WAMIT_x_SS_Rdtn_x = 1 ! WAMIT%SS_Rdtn%x + integer(IntKi), public, parameter :: WAMIT_x_SS_Exctn_x = 2 ! WAMIT%SS_Exctn%x + integer(IntKi), public, parameter :: WAMIT_x_Conv_Rdtn_DummyContState = 3 ! WAMIT%Conv_Rdtn%DummyContState + integer(IntKi), public, parameter :: WAMIT_z_Conv_Rdtn_DummyConstrState = 4 ! WAMIT%Conv_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: WAMIT_z_SS_Rdtn_DummyConstrState = 5 ! WAMIT%SS_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: WAMIT_z_SS_Exctn_DummyConstrState = 6 ! WAMIT%SS_Exctn%DummyConstrState + integer(IntKi), public, parameter :: WAMIT_u_Mesh = 7 ! WAMIT%Mesh + integer(IntKi), public, parameter :: WAMIT_y_Mesh = 8 ! WAMIT%Mesh + +contains subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(WAMIT_InitInputType), intent(in) :: SrcInitInputData @@ -1429,7 +1436,7 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, function WAMIT_InputMeshPointer(u, ML) result(Mesh) type(WAMIT_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1439,7 +1446,7 @@ function WAMIT_InputMeshPointer(u, ML) result(Mesh) end function function WAMIT_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1450,7 +1457,7 @@ function WAMIT_InputMeshName(ML) result(Name) function WAMIT_OutputMeshPointer(y, ML) result(Mesh) type(WAMIT_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1460,7 +1467,7 @@ function WAMIT_OutputMeshPointer(y, ML) result(Mesh) end function function WAMIT_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1468,5 +1475,141 @@ function WAMIT_OutputMeshName(ML) result(Name) Name = "y%Mesh" end select end function + +subroutine WAMIT_PackContStateAry(Vars, x, ValAry) + type(WAMIT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (WAMIT_x_SS_Rdtn_x) + call MV_Pack2(Var, x%SS_Rdtn%x, ValAry) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + call MV_Pack2(Var, x%SS_Exctn%x, ValAry) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + call MV_Pack2(Var, x%Conv_Rdtn%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine WAMIT_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (WAMIT_x_SS_Rdtn_x) + call MV_Unpack2(Var, ValAry, x%SS_Rdtn%x) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + call MV_Unpack2(Var, ValAry, x%SS_Exctn%x) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + call MV_Unpack2(Var, ValAry, x%Conv_Rdtn%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine WAMIT_PackConstrStateAry(Vars, z, ValAry) + type(WAMIT_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + call MV_Pack2(Var, z%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + call MV_Pack2(Var, z%SS_Rdtn%DummyConstrState, ValAry) ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + call MV_Pack2(Var, z%SS_Exctn%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine WAMIT_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%Conv_Rdtn%DummyConstrState) ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%SS_Rdtn%DummyConstrState) ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%SS_Exctn%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine WAMIT_PackInputAry(Vars, u, ValAry) + type(WAMIT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (WAMIT_u_Mesh) + call MV_Pack2(Var, u%Mesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine WAMIT_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (WAMIT_u_Mesh) + call MV_Unpack2(Var, ValAry, u%Mesh) ! Mesh + end select + end associate + end do +end subroutine + +subroutine WAMIT_PackOutputAry(Vars, y, ValAry) + type(WAMIT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (WAMIT_y_Mesh) + call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine WAMIT_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (WAMIT_y_Mesh) + call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh + end select + end associate + end do +end subroutine END MODULE WAMIT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 4c63aa4a9d..64210e2abe 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -33,8 +33,6 @@ MODULE IceDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_u_PointMesh = 1 ! Mesh number for IceD IceD_u_PointMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_y_PointMesh = 2 ! Mesh number for IceD IceD_y_PointMesh mesh [-] ! ========= IceD_InputFile ======= TYPE, PUBLIC :: IceD_InputFile INTEGER(IntKi) :: IceModel = 0_IntKi !< The current ice model number [-] @@ -226,7 +224,14 @@ MODULE IceDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE IceD_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: IceD_x_q = 1 ! IceD%q + integer(IntKi), public, parameter :: IceD_x_dqdt = 2 ! IceD%dqdt + integer(IntKi), public, parameter :: IceD_z_DummyConstrState = 3 ! IceD%DummyConstrState + integer(IntKi), public, parameter :: IceD_u_PointMesh = 4 ! IceD%PointMesh + integer(IntKi), public, parameter :: IceD_y_PointMesh = 5 ! IceD%PointMesh + integer(IntKi), public, parameter :: IceD_y_WriteOutput = 6 ! IceD%WriteOutput + +contains subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(IceD_InputFile), intent(in) :: SrcInputFileData @@ -1744,7 +1749,7 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E function IceD_InputMeshPointer(u, ML) result(Mesh) type(IceD_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1754,7 +1759,7 @@ function IceD_InputMeshPointer(u, ML) result(Mesh) end function function IceD_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1765,7 +1770,7 @@ function IceD_InputMeshName(ML) result(Name) function IceD_OutputMeshPointer(y, ML) result(Mesh) type(IceD_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1775,7 +1780,7 @@ function IceD_OutputMeshPointer(y, ML) result(Mesh) end function function IceD_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1783,5 +1788,133 @@ function IceD_OutputMeshName(ML) result(Name) Name = "y%PointMesh" end select end function + +subroutine IceD_PackContStateAry(Vars, x, ValAry) + type(IceD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (IceD_x_q) + call MV_Pack2(Var, x%q, ValAry) ! Scalar + case (IceD_x_dqdt) + call MV_Pack2(Var, x%dqdt, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine IceD_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (IceD_x_q) + call MV_Unpack2(Var, ValAry, x%q) ! Scalar + case (IceD_x_dqdt) + call MV_Unpack2(Var, ValAry, x%dqdt) ! Scalar + end select + end associate + end do +end subroutine + +subroutine IceD_PackConstrStateAry(Vars, z, ValAry) + type(IceD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (IceD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine IceD_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (IceD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine IceD_PackInputAry(Vars, u, ValAry) + type(IceD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (IceD_u_PointMesh) + call MV_Pack2(Var, u%PointMesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine IceD_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (IceD_u_PointMesh) + call MV_Unpack2(Var, ValAry, u%PointMesh) ! Mesh + end select + end associate + end do +end subroutine + +subroutine IceD_PackOutputAry(Vars, y, ValAry) + type(IceD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (IceD_y_PointMesh) + call MV_Pack2(Var, y%PointMesh, ValAry) ! Mesh + case (IceD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine IceD_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (IceD_y_PointMesh) + call MV_Unpack2(Var, ValAry, y%PointMesh) ! Mesh + case (IceD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE IceDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 3ffd9095a3..d864bfb15e 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -33,8 +33,6 @@ MODULE IceFloe_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: IceFloe_u_iceMesh = 1 ! Mesh number for IceFloe IceFloe_u_iceMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: IceFloe_y_iceMesh = 2 ! Mesh number for IceFloe IceFloe_y_iceMesh mesh [-] ! ========= IceFloe_InitInputType ======= TYPE, PUBLIC :: IceFloe_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] @@ -110,7 +108,13 @@ MODULE IceFloe_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE IceFloe_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: IceFloe_x_DummyContStateVar = 1 ! IceFloe%DummyContStateVar + integer(IntKi), public, parameter :: IceFloe_z_DummyConstrStateVar = 2 ! IceFloe%DummyConstrStateVar + integer(IntKi), public, parameter :: IceFloe_u_iceMesh = 3 ! IceFloe%iceMesh + integer(IntKi), public, parameter :: IceFloe_y_iceMesh = 4 ! IceFloe%iceMesh + integer(IntKi), public, parameter :: IceFloe_y_WriteOutput = 5 ! IceFloe%WriteOutput + +contains subroutine IceFloe_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(IceFloe_InitInputType), intent(in) :: SrcInitInputData @@ -1026,7 +1030,7 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat function IceFloe_InputMeshPointer(u, ML) result(Mesh) type(IceFloe_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1036,7 +1040,7 @@ function IceFloe_InputMeshPointer(u, ML) result(Mesh) end function function IceFloe_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1047,7 +1051,7 @@ function IceFloe_InputMeshName(ML) result(Name) function IceFloe_OutputMeshPointer(y, ML) result(Mesh) type(IceFloe_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1057,7 +1061,7 @@ function IceFloe_OutputMeshPointer(y, ML) result(Mesh) end function function IceFloe_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1065,5 +1069,129 @@ function IceFloe_OutputMeshName(ML) result(Name) Name = "y%iceMesh" end select end function + +subroutine IceFloe_PackContStateAry(Vars, x, ValAry) + type(IceFloe_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (IceFloe_x_DummyContStateVar) + call MV_Pack2(Var, x%DummyContStateVar, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine IceFloe_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (IceFloe_x_DummyContStateVar) + call MV_Unpack2(Var, ValAry, x%DummyContStateVar) ! Scalar + end select + end associate + end do +end subroutine + +subroutine IceFloe_PackConstrStateAry(Vars, z, ValAry) + type(IceFloe_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (IceFloe_z_DummyConstrStateVar) + call MV_Pack2(Var, z%DummyConstrStateVar, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine IceFloe_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (IceFloe_z_DummyConstrStateVar) + call MV_Unpack2(Var, ValAry, z%DummyConstrStateVar) ! Scalar + end select + end associate + end do +end subroutine + +subroutine IceFloe_PackInputAry(Vars, u, ValAry) + type(IceFloe_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (IceFloe_u_iceMesh) + call MV_Pack2(Var, u%iceMesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine IceFloe_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (IceFloe_u_iceMesh) + call MV_Unpack2(Var, ValAry, u%iceMesh) ! Mesh + end select + end associate + end do +end subroutine + +subroutine IceFloe_PackOutputAry(Vars, y, ValAry) + type(IceFloe_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (IceFloe_y_iceMesh) + call MV_Pack2(Var, y%iceMesh, ValAry) ! Mesh + case (IceFloe_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine IceFloe_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (IceFloe_y_iceMesh) + call MV_Unpack2(Var, ValAry, y%iceMesh) ! Mesh + case (IceFloe_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE IceFloe_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 0bad2a2bde..7e11f3efb7 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -164,7 +164,8 @@ MODULE IfW_FlowField_Types TYPE(UserFieldType) :: User !< User Field Wind Data [-] END TYPE FlowFieldType ! ======================= -CONTAINS + +contains subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUniformFieldTypeData, CtrlCode, ErrStat, ErrMsg) type(UniformFieldType), intent(in) :: SrcUniformFieldTypeData diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index 99173c987a..627f722fdc 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -575,18 +575,15 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Input variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, & - VarIdx=p%iVarHWindSpeed, & + call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, DatLoc(InflowWind_u_HWindSpeed), & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, & - VarIdx=p%iVarPLExp, & + call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, DatLoc(InflowWind_u_PLExp), & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, & - VarIdx=p%iVarPropagationDir, & + call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, DatLoc(InflowWind_u_PropagationDir), & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: propagation direction, rad']) @@ -594,23 +591,19 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Output variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%y, "HWindSpeed", FieldScalar, & - VarIdx=p%iVarHWindSpeedY, & + call MV_AddVar(p%Vars%y, "HWindSpeed", FieldScalar, DatLoc(InflowWind_y_HWindSpeed), & Flags=VF_ExtLin, & LinNames=['Extended output: horizontal wind speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%y, "PLExp", FieldScalar, & - VarIdx=p%iVarPLExpY, & + call MV_AddVar(p%Vars%y, "PLExp", FieldScalar, DatLoc(InflowWind_y_PLExp), & Flags=VF_ExtLin, & LinNames=['Extended output: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%y, "PropagationDir", FieldScalar, & - VarIdx=p%iVarPropagationDirY, & + call MV_AddVar(p%Vars%y, "PropagationDir", FieldScalar, DatLoc(InflowWind_y_PropagationDir), & Flags=VF_ExtLin, & LinNames=['Extended output: propagation direction, rad']) - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & - VarIdx=p%iVarWriteOutput, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(InflowWind_y_WriteOutput), & Flags=VF_WriteOut, & Num=p%NumOuts, & LinNames=[(WriteOutputLinName(i), i = 1, p%NumOuts)]) diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index eca5cb2cfb..81416b8fae 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -28,6 +28,13 @@ param ^ - IntKi Highest_Win param ^ - IntKi IfW_NumPtsAvg - 144 - "Number of points averaged for rotor-average wind speed" - +param ^ - IntKi InflowWind_u_HWindSpeed - -1 - "DatLoc number for HWindSpeed extended input" - +param ^ - IntKi InflowWind_u_PLExp - -2 - "DatLoc number for PLExp extended input" - +param ^ - IntKi InflowWind_u_PropagationDir - -3 - "DatLoc number for PropagationDir extended input" - +param ^ - IntKi InflowWind_y_HWindSpeed - -1 - "DatLoc number for HWindSpeed extended output" - +param ^ - IntKi InflowWind_y_PLExp - -2 - "DatLoc number for PLExp extended output" - +param ^ - IntKi InflowWind_y_PropagationDir - -3 - "DatLoc number for PropagationDir extended output" - + ######################### # ..... Input file data ........................................................................................................... # This is data defined in the Input File for this module (or could otherwise be passed in) @@ -121,13 +128,6 @@ typedef ^ ^ ModVarsType *Vars # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ^ IntKi iVarHWindSpeed - - - "Horizontal wind speed variable index" - -typedef ^ ^ IntKi iVarPLExp - - - "Vertical power-law shear exponent variable index" - -typedef ^ ^ IntKi iVarPropagationDir - - - "Propagation direction variable index" - -typedef ^ ^ IntKi iVarHWindSpeedY - - - "Horizontal wind speed variable index" - -typedef ^ ^ IntKi iVarPLExpY - - - "Vertical power-law shear exponent variable index" - -typedef ^ ^ IntKi iVarPropagationDirY - - - "Propagation direction variable index" - -typedef ^ ^ IntKi iVarWriteOutput - - - "Write output variable index" - typedef ^ ^ CHARACTER(1024) RootFileName - - - "Root of the InflowWind input filename" - typedef ^ ^ DbKi DT - - - "Time step for cont. state integration & disc. state update" seconds typedef ^ ^ ReKi WindViXYZprime :: - - "List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ )" meters diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 2a3c6466c1..2d69550e5d 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -140,7 +140,8 @@ MODULE InflowWind_IO_Types INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of points where wind components will be provided [-] END TYPE Points_InitInputType ! ======================= -CONTAINS + +contains subroutine InflowWind_IO_CopyWindFileDat(SrcWindFileDatData, DstWindFileDatData, CtrlCode, ErrStat, ErrMsg) type(WindFileDat), intent(in) :: SrcWindFileDatData diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 2ed9dbfef6..498807800f 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -48,6 +48,12 @@ MODULE InflowWind_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Point_WindNumber = 9 ! 1D wind components from ExtInflow [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Highest_WindNumber = 9 ! Highest wind number supported. [-] INTEGER(IntKi), PUBLIC, PARAMETER :: IfW_NumPtsAvg = 144 ! Number of points averaged for rotor-average wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_HWindSpeed = -1 ! DatLoc number for HWindSpeed extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_PLExp = -2 ! DatLoc number for PLExp extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_PropagationDir = -3 ! DatLoc number for PropagationDir extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_HWindSpeed = -1 ! DatLoc number for HWindSpeed extended output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_PLExp = -2 ! DatLoc number for PLExp extended output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_PropagationDir = -3 ! DatLoc number for PropagationDir extended output [-] ! ========= InflowWind_InputFile ======= TYPE, PUBLIC :: InflowWind_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -140,13 +146,6 @@ MODULE InflowWind_Types ! ========= InflowWind_ParameterType ======= TYPE, PUBLIC :: InflowWind_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarHWindSpeed = 0_IntKi !< Horizontal wind speed variable index [-] - INTEGER(IntKi) :: iVarPLExp = 0_IntKi !< Vertical power-law shear exponent variable index [-] - INTEGER(IntKi) :: iVarPropagationDir = 0_IntKi !< Propagation direction variable index [-] - INTEGER(IntKi) :: iVarHWindSpeedY = 0_IntKi !< Horizontal wind speed variable index [-] - INTEGER(IntKi) :: iVarPLExpY = 0_IntKi !< Vertical power-law shear exponent variable index [-] - INTEGER(IntKi) :: iVarPropagationDirY = 0_IntKi !< Propagation direction variable index [-] - INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Write output variable index [-] CHARACTER(1024) :: RootFileName !< Root of the InflowWind input filename [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZprime !< List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ ) [meters] @@ -211,7 +210,28 @@ MODULE InflowWind_Types TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] END TYPE InflowWind_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: InflowWind_x_DummyContState = 1 ! InflowWind%DummyContState + integer(IntKi), public, parameter :: InflowWind_z_DummyConstrState = 2 ! InflowWind%DummyConstrState + integer(IntKi), public, parameter :: InflowWind_u_PositionXYZ = 3 ! InflowWind%PositionXYZ + integer(IntKi), public, parameter :: InflowWind_u_lidar_PulseLidEl = 4 ! InflowWind%lidar%PulseLidEl + integer(IntKi), public, parameter :: InflowWind_u_lidar_PulseLidAz = 5 ! InflowWind%lidar%PulseLidAz + integer(IntKi), public, parameter :: InflowWind_u_lidar_HubDisplacementX = 6 ! InflowWind%lidar%HubDisplacementX + integer(IntKi), public, parameter :: InflowWind_u_lidar_HubDisplacementY = 7 ! InflowWind%lidar%HubDisplacementY + integer(IntKi), public, parameter :: InflowWind_u_lidar_HubDisplacementZ = 8 ! InflowWind%lidar%HubDisplacementZ + integer(IntKi), public, parameter :: InflowWind_u_HubPosition = 9 ! InflowWind%HubPosition + integer(IntKi), public, parameter :: InflowWind_u_HubOrientation = 10 ! InflowWind%HubOrientation + integer(IntKi), public, parameter :: InflowWind_y_VelocityUVW = 11 ! InflowWind%VelocityUVW + integer(IntKi), public, parameter :: InflowWind_y_AccelUVW = 12 ! InflowWind%AccelUVW + integer(IntKi), public, parameter :: InflowWind_y_WriteOutput = 13 ! InflowWind%WriteOutput + integer(IntKi), public, parameter :: InflowWind_y_DiskVel = 14 ! InflowWind%DiskVel + integer(IntKi), public, parameter :: InflowWind_y_HubVel = 15 ! InflowWind%HubVel + integer(IntKi), public, parameter :: InflowWind_y_lidar_LidSpeed = 16 ! InflowWind%lidar%LidSpeed + integer(IntKi), public, parameter :: InflowWind_y_lidar_WtTrunc = 17 ! InflowWind%lidar%WtTrunc + integer(IntKi), public, parameter :: InflowWind_y_lidar_MsrPositionsX = 18 ! InflowWind%lidar%MsrPositionsX + integer(IntKi), public, parameter :: InflowWind_y_lidar_MsrPositionsY = 19 ! InflowWind%lidar%MsrPositionsY + integer(IntKi), public, parameter :: InflowWind_y_lidar_MsrPositionsZ = 20 ! InflowWind%lidar%MsrPositionsZ + +contains subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(InflowWind_InputFile), intent(in) :: SrcInputFileData @@ -873,13 +893,6 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarHWindSpeed = SrcParamData%iVarHWindSpeed - DstParamData%iVarPLExp = SrcParamData%iVarPLExp - DstParamData%iVarPropagationDir = SrcParamData%iVarPropagationDir - DstParamData%iVarHWindSpeedY = SrcParamData%iVarHWindSpeedY - DstParamData%iVarPLExpY = SrcParamData%iVarPLExpY - DstParamData%iVarPropagationDirY = SrcParamData%iVarPropagationDirY - DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput DstParamData%RootFileName = SrcParamData%RootFileName DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%WindViXYZprime)) then @@ -1029,13 +1042,6 @@ subroutine InflowWind_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarHWindSpeed) - call RegPack(RF, InData%iVarPLExp) - call RegPack(RF, InData%iVarPropagationDir) - call RegPack(RF, InData%iVarHWindSpeedY) - call RegPack(RF, InData%iVarPLExpY) - call RegPack(RF, InData%iVarPropagationDirY) - call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%RootFileName) call RegPack(RF, InData%DT) call RegPackAlloc(RF, InData%WindViXYZprime) @@ -1094,13 +1100,6 @@ subroutine InflowWind_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarHWindSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPLExp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPropagationDir); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHWindSpeedY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPLExpY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarPropagationDirY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RootFileName); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WindViXYZprime); if (RegCheckErr(RF, RoutineName)) return @@ -1967,7 +1966,7 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS function InflowWind_InputMeshPointer(u, ML) result(Mesh) type(InflowWind_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1975,7 +1974,7 @@ function InflowWind_InputMeshPointer(u, ML) result(Mesh) end function function InflowWind_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1984,7 +1983,7 @@ function InflowWind_InputMeshName(ML) result(Name) function InflowWind_OutputMeshPointer(y, ML) result(Mesh) type(InflowWind_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1992,11 +1991,195 @@ function InflowWind_OutputMeshPointer(y, ML) result(Mesh) end function function InflowWind_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine InflowWind_PackContStateAry(Vars, x, ValAry) + type(InflowWind_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (InflowWind_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine InflowWind_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (InflowWind_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine InflowWind_PackConstrStateAry(Vars, z, ValAry) + type(InflowWind_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (InflowWind_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine InflowWind_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (InflowWind_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine InflowWind_PackInputAry(Vars, u, ValAry) + type(InflowWind_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (InflowWind_u_PositionXYZ) + call MV_Pack2(Var, u%PositionXYZ, ValAry) ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + call MV_Pack2(Var, u%lidar%PulseLidEl, ValAry) ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + call MV_Pack2(Var, u%lidar%PulseLidAz, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + call MV_Pack2(Var, u%lidar%HubDisplacementX, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + call MV_Pack2(Var, u%lidar%HubDisplacementY, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + call MV_Pack2(Var, u%lidar%HubDisplacementZ, ValAry) ! Scalar + case (InflowWind_u_HubPosition) + call MV_Pack2(Var, u%HubPosition, ValAry) ! Rank 1 Array + case (InflowWind_u_HubOrientation) + call MV_Pack2(Var, u%HubOrientation, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine InflowWind_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (InflowWind_u_PositionXYZ) + call MV_Unpack2(Var, ValAry, u%PositionXYZ) ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + call MV_Unpack2(Var, ValAry, u%lidar%PulseLidEl) ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + call MV_Unpack2(Var, ValAry, u%lidar%PulseLidAz) ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementX) ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementY) ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementZ) ! Scalar + case (InflowWind_u_HubPosition) + call MV_Unpack2(Var, ValAry, u%HubPosition) ! Rank 1 Array + case (InflowWind_u_HubOrientation) + call MV_Unpack2(Var, ValAry, u%HubOrientation) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine InflowWind_PackOutputAry(Vars, y, ValAry) + type(InflowWind_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (InflowWind_y_VelocityUVW) + call MV_Pack2(Var, y%VelocityUVW, ValAry) ! Rank 2 Array + case (InflowWind_y_AccelUVW) + call MV_Pack2(Var, y%AccelUVW, ValAry) ! Rank 2 Array + case (InflowWind_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (InflowWind_y_DiskVel) + call MV_Pack2(Var, y%DiskVel, ValAry) ! Rank 1 Array + case (InflowWind_y_HubVel) + call MV_Pack2(Var, y%HubVel, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + call MV_Pack2(Var, y%lidar%LidSpeed, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + call MV_Pack2(Var, y%lidar%WtTrunc, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + call MV_Pack2(Var, y%lidar%MsrPositionsX, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + call MV_Pack2(Var, y%lidar%MsrPositionsY, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + call MV_Pack2(Var, y%lidar%MsrPositionsZ, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine InflowWind_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (InflowWind_y_VelocityUVW) + call MV_Unpack2(Var, ValAry, y%VelocityUVW) ! Rank 2 Array + case (InflowWind_y_AccelUVW) + call MV_Unpack2(Var, ValAry, y%AccelUVW) ! Rank 2 Array + case (InflowWind_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (InflowWind_y_DiskVel) + call MV_Unpack2(Var, ValAry, y%DiskVel) ! Rank 1 Array + case (InflowWind_y_HubVel) + call MV_Unpack2(Var, ValAry, y%HubVel) ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + call MV_Unpack2(Var, ValAry, y%lidar%LidSpeed) ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + call MV_Unpack2(Var, ValAry, y%lidar%WtTrunc) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsX) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsY) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsZ) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE InflowWind_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 689afb1934..92ff3b0daa 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -123,7 +123,20 @@ MODULE Lidar_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] END TYPE Lidar_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: Lidar_x_DummyContState = 1 ! Lidar%DummyContState + integer(IntKi), public, parameter :: Lidar_z_DummyConstrState = 2 ! Lidar%DummyConstrState + integer(IntKi), public, parameter :: Lidar_u_PulseLidEl = 3 ! Lidar%PulseLidEl + integer(IntKi), public, parameter :: Lidar_u_PulseLidAz = 4 ! Lidar%PulseLidAz + integer(IntKi), public, parameter :: Lidar_u_HubDisplacementX = 5 ! Lidar%HubDisplacementX + integer(IntKi), public, parameter :: Lidar_u_HubDisplacementY = 6 ! Lidar%HubDisplacementY + integer(IntKi), public, parameter :: Lidar_u_HubDisplacementZ = 7 ! Lidar%HubDisplacementZ + integer(IntKi), public, parameter :: Lidar_y_LidSpeed = 8 ! Lidar%LidSpeed + integer(IntKi), public, parameter :: Lidar_y_WtTrunc = 9 ! Lidar%WtTrunc + integer(IntKi), public, parameter :: Lidar_y_MsrPositionsX = 10 ! Lidar%MsrPositionsX + integer(IntKi), public, parameter :: Lidar_y_MsrPositionsY = 11 ! Lidar%MsrPositionsY + integer(IntKi), public, parameter :: Lidar_y_MsrPositionsZ = 12 ! Lidar%MsrPositionsZ + +contains subroutine Lidar_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Lidar_InitInputType), intent(in) :: SrcInitInputData @@ -1099,7 +1112,7 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, function Lidar_InputMeshPointer(u, ML) result(Mesh) type(Lidar_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1107,7 +1120,7 @@ function Lidar_InputMeshPointer(u, ML) result(Mesh) end function function Lidar_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1116,7 +1129,7 @@ function Lidar_InputMeshName(ML) result(Name) function Lidar_OutputMeshPointer(y, ML) result(Mesh) type(Lidar_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1124,11 +1137,163 @@ function Lidar_OutputMeshPointer(y, ML) result(Mesh) end function function Lidar_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine Lidar_PackContStateAry(Vars, x, ValAry) + type(Lidar_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (Lidar_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Lidar_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (Lidar_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Lidar_PackConstrStateAry(Vars, z, ValAry) + type(Lidar_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (Lidar_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Lidar_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (Lidar_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Lidar_PackInputAry(Vars, u, ValAry) + type(Lidar_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (Lidar_u_PulseLidEl) + call MV_Pack2(Var, u%PulseLidEl, ValAry) ! Scalar + case (Lidar_u_PulseLidAz) + call MV_Pack2(Var, u%PulseLidAz, ValAry) ! Scalar + case (Lidar_u_HubDisplacementX) + call MV_Pack2(Var, u%HubDisplacementX, ValAry) ! Scalar + case (Lidar_u_HubDisplacementY) + call MV_Pack2(Var, u%HubDisplacementY, ValAry) ! Scalar + case (Lidar_u_HubDisplacementZ) + call MV_Pack2(Var, u%HubDisplacementZ, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Lidar_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (Lidar_u_PulseLidEl) + call MV_Unpack2(Var, ValAry, u%PulseLidEl) ! Scalar + case (Lidar_u_PulseLidAz) + call MV_Unpack2(Var, ValAry, u%PulseLidAz) ! Scalar + case (Lidar_u_HubDisplacementX) + call MV_Unpack2(Var, ValAry, u%HubDisplacementX) ! Scalar + case (Lidar_u_HubDisplacementY) + call MV_Unpack2(Var, ValAry, u%HubDisplacementY) ! Scalar + case (Lidar_u_HubDisplacementZ) + call MV_Unpack2(Var, ValAry, u%HubDisplacementZ) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Lidar_PackOutputAry(Vars, y, ValAry) + type(Lidar_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (Lidar_y_LidSpeed) + call MV_Pack2(Var, y%LidSpeed, ValAry) ! Rank 1 Array + case (Lidar_y_WtTrunc) + call MV_Pack2(Var, y%WtTrunc, ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + call MV_Pack2(Var, y%MsrPositionsX, ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + call MV_Pack2(Var, y%MsrPositionsY, ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + call MV_Pack2(Var, y%MsrPositionsZ, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine Lidar_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (Lidar_y_LidSpeed) + call MV_Unpack2(Var, ValAry, y%LidSpeed) ! Rank 1 Array + case (Lidar_y_WtTrunc) + call MV_Unpack2(Var, ValAry, y%WtTrunc) ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + call MV_Unpack2(Var, ValAry, y%MsrPositionsX) ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + call MV_Unpack2(Var, ValAry, y%MsrPositionsY) ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + call MV_Unpack2(Var, ValAry, y%MsrPositionsZ) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE Lidar_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Registry.txt b/modules/map/src/MAP_Registry.txt index a6c807f813..b9347281c0 100644 --- a/modules/map/src/MAP_Registry.txt +++ b/modules/map/src/MAP_Registry.txt @@ -71,9 +71,6 @@ typedef ^ ^ R8Ki z { ## ============================== Parameters ============================================================================================================================================ typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ^ IntKi iVarPtFairDisplacement - - - "Variable index for fairlead displacement mesh" -typedef ^ ^ IntKi iVarPtFairleadLoad - - - "Variable index for fairlead loads mesh" -typedef ^ ^ IntKi iVarWriteOutput - - - "Variable index for write outputs" typedef ^ ^ R8Ki g - - - "gravitational constant" "[kg/m^2]" typedef ^ ^ R8Ki depth - - - "distance to seabed" "[m]" typedef ^ ^ R8Ki rho_sea - - - "density of seawater" "[m]" diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index ba397c4fa0..94930f8fc4 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -33,8 +33,6 @@ MODULE MAP_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MAP_u_PtFairDisplacement = 1 ! Mesh number for MAP MAP_u_PtFairDisplacement mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MAP_y_ptFairleadLoad = 2 ! Mesh number for MAP MAP_y_ptFairleadLoad mesh [-] ! ========= MAP_InitInputType_C ======= TYPE, BIND(C) :: MAP_InitInputType_C TYPE(C_PTR) :: object = C_NULL_PTR @@ -187,9 +185,6 @@ MODULE MAP_Types ! ========= MAP_ParameterType_C ======= TYPE, BIND(C) :: MAP_ParameterType_C TYPE(C_PTR) :: object = C_NULL_PTR - INTEGER(KIND=C_INT) :: iVarPtFairDisplacement - INTEGER(KIND=C_INT) :: iVarPtFairleadLoad - INTEGER(KIND=C_INT) :: iVarWriteOutput REAL(KIND=C_DOUBLE) :: g REAL(KIND=C_DOUBLE) :: depth REAL(KIND=C_DOUBLE) :: rho_sea @@ -199,9 +194,6 @@ MODULE MAP_Types TYPE, PUBLIC :: MAP_ParameterType TYPE( MAP_ParameterType_C ) :: C_obj TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarPtFairDisplacement = 0_IntKi !< Variable index for fairlead displacement mesh [-] - INTEGER(IntKi) :: iVarPtFairleadLoad = 0_IntKi !< Variable index for fairlead loads mesh [-] - INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Variable index for write outputs [-] REAL(R8Ki) :: g = 0.0_R8Ki !< gravitational constant [[kg/m^2]] REAL(R8Ki) :: depth = 0.0_R8Ki !< distance to seabed [[m]] REAL(R8Ki) :: rho_sea = 0.0_R8Ki !< density of seawater [[m]] @@ -264,7 +256,24 @@ MODULE MAP_Types TYPE(MAP_ConstraintStateType) :: z_lin !< Temporary variables for Jacobian calculations [-] END TYPE MAP_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: MAP_x_dummy = 1 ! MAP%dummy + integer(IntKi), public, parameter :: MAP_z_H = 2 ! MAP%H + integer(IntKi), public, parameter :: MAP_z_V = 3 ! MAP%V + integer(IntKi), public, parameter :: MAP_z_x = 4 ! MAP%x + integer(IntKi), public, parameter :: MAP_z_y = 5 ! MAP%y + integer(IntKi), public, parameter :: MAP_z_z = 6 ! MAP%z + integer(IntKi), public, parameter :: MAP_u_x = 7 ! MAP%x + integer(IntKi), public, parameter :: MAP_u_y = 8 ! MAP%y + integer(IntKi), public, parameter :: MAP_u_z = 9 ! MAP%z + integer(IntKi), public, parameter :: MAP_u_PtFairDisplacement = 10 ! MAP%PtFairDisplacement + integer(IntKi), public, parameter :: MAP_y_Fx = 11 ! MAP%Fx + integer(IntKi), public, parameter :: MAP_y_Fy = 12 ! MAP%Fy + integer(IntKi), public, parameter :: MAP_y_Fz = 13 ! MAP%Fz + integer(IntKi), public, parameter :: MAP_y_WriteOutput = 14 ! MAP%WriteOutput + integer(IntKi), public, parameter :: MAP_y_wrtOutput = 15 ! MAP%wrtOutput + integer(IntKi), public, parameter :: MAP_y_ptFairleadLoad = 16 ! MAP%ptFairleadLoad + +contains subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(MAP_InitInputType), intent(in) :: SrcInitInputData @@ -1936,12 +1945,6 @@ subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarPtFairDisplacement = SrcParamData%iVarPtFairDisplacement - DstParamData%C_obj%iVarPtFairDisplacement = SrcParamData%C_obj%iVarPtFairDisplacement - DstParamData%iVarPtFairleadLoad = SrcParamData%iVarPtFairleadLoad - DstParamData%C_obj%iVarPtFairleadLoad = SrcParamData%C_obj%iVarPtFairleadLoad - DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput - DstParamData%C_obj%iVarWriteOutput = SrcParamData%C_obj%iVarWriteOutput DstParamData%g = SrcParamData%g DstParamData%C_obj%g = SrcParamData%C_obj%g DstParamData%depth = SrcParamData%depth @@ -1990,9 +1993,6 @@ subroutine MAP_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarPtFairDisplacement) - call RegPack(RF, InData%iVarPtFairleadLoad) - call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%g) call RegPack(RF, InData%depth) call RegPack(RF, InData%rho_sea) @@ -2031,12 +2031,6 @@ subroutine MAP_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarPtFairDisplacement); if (RegCheckErr(RF, RoutineName)) return - OutData%C_obj%iVarPtFairDisplacement = OutData%iVarPtFairDisplacement - call RegUnpack(RF, OutData%iVarPtFairleadLoad); if (RegCheckErr(RF, RoutineName)) return - OutData%C_obj%iVarPtFairleadLoad = OutData%iVarPtFairleadLoad - call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return - OutData%C_obj%iVarWriteOutput = OutData%iVarWriteOutput call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%g = OutData%g call RegUnpack(RF, OutData%depth); if (RegCheckErr(RF, RoutineName)) return @@ -2066,9 +2060,6 @@ SUBROUTINE MAP_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) ELSE SkipPointers_local = .false. END IF - ParamData%iVarPtFairDisplacement = ParamData%C_obj%iVarPtFairDisplacement - ParamData%iVarPtFairleadLoad = ParamData%C_obj%iVarPtFairleadLoad - ParamData%iVarWriteOutput = ParamData%C_obj%iVarWriteOutput ParamData%g = ParamData%C_obj%g ParamData%depth = ParamData%C_obj%depth ParamData%rho_sea = ParamData%C_obj%rho_sea @@ -2091,9 +2082,6 @@ SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE SkipPointers_local = .false. END IF - ParamData%C_obj%iVarPtFairDisplacement = ParamData%iVarPtFairDisplacement - ParamData%C_obj%iVarPtFairleadLoad = ParamData%iVarPtFairleadLoad - ParamData%C_obj%iVarWriteOutput = ParamData%iVarWriteOutput ParamData%C_obj%g = ParamData%g ParamData%C_obj%depth = ParamData%depth ParamData%C_obj%rho_sea = ParamData%rho_sea @@ -3104,7 +3092,7 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er function MAP_InputMeshPointer(u, ML) result(Mesh) type(MAP_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -3114,7 +3102,7 @@ function MAP_InputMeshPointer(u, ML) result(Mesh) end function function MAP_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -3125,7 +3113,7 @@ function MAP_InputMeshName(ML) result(Name) function MAP_OutputMeshPointer(y, ML) result(Mesh) type(MAP_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -3135,7 +3123,7 @@ function MAP_OutputMeshPointer(y, ML) result(Mesh) end function function MAP_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -3143,5 +3131,173 @@ function MAP_OutputMeshName(ML) result(Name) Name = "y%ptFairleadLoad" end select end function + +subroutine MAP_PackContStateAry(Vars, x, ValAry) + type(MAP_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (MAP_x_dummy) + call MV_Pack2(Var, x%dummy, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine MAP_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (MAP_x_dummy) + call MV_Unpack2(Var, ValAry, x%dummy) ! Scalar + end select + end associate + end do +end subroutine + +subroutine MAP_PackConstrStateAry(Vars, z, ValAry) + type(MAP_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (MAP_z_H) + call MV_Pack2(Var, z%H, ValAry) ! Rank 1 Array + case (MAP_z_V) + call MV_Pack2(Var, z%V, ValAry) ! Rank 1 Array + case (MAP_z_x) + call MV_Pack2(Var, z%x, ValAry) ! Rank 1 Array + case (MAP_z_y) + call MV_Pack2(Var, z%y, ValAry) ! Rank 1 Array + case (MAP_z_z) + call MV_Pack2(Var, z%z, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine MAP_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (MAP_z_H) + call MV_Unpack2(Var, ValAry, z%H) ! Rank 1 Array + case (MAP_z_V) + call MV_Unpack2(Var, ValAry, z%V) ! Rank 1 Array + case (MAP_z_x) + call MV_Unpack2(Var, ValAry, z%x) ! Rank 1 Array + case (MAP_z_y) + call MV_Unpack2(Var, ValAry, z%y) ! Rank 1 Array + case (MAP_z_z) + call MV_Unpack2(Var, ValAry, z%z) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine MAP_PackInputAry(Vars, u, ValAry) + type(MAP_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (MAP_u_x) + call MV_Pack2(Var, u%x, ValAry) ! Rank 1 Array + case (MAP_u_y) + call MV_Pack2(Var, u%y, ValAry) ! Rank 1 Array + case (MAP_u_z) + call MV_Pack2(Var, u%z, ValAry) ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_Pack2(Var, u%PtFairDisplacement, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine MAP_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (MAP_u_x) + call MV_Unpack2(Var, ValAry, u%x) ! Rank 1 Array + case (MAP_u_y) + call MV_Unpack2(Var, ValAry, u%y) ! Rank 1 Array + case (MAP_u_z) + call MV_Unpack2(Var, ValAry, u%z) ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_Unpack2(Var, ValAry, u%PtFairDisplacement) ! Mesh + end select + end associate + end do +end subroutine + +subroutine MAP_PackOutputAry(Vars, y, ValAry) + type(MAP_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (MAP_y_Fx) + call MV_Pack2(Var, y%Fx, ValAry) ! Rank 1 Array + case (MAP_y_Fy) + call MV_Pack2(Var, y%Fy, ValAry) ! Rank 1 Array + case (MAP_y_Fz) + call MV_Pack2(Var, y%Fz, ValAry) ! Rank 1 Array + case (MAP_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (MAP_y_wrtOutput) + call MV_Pack2(Var, y%wrtOutput, ValAry) ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_Pack2(Var, y%ptFairleadLoad, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine MAP_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (MAP_y_Fx) + call MV_Unpack2(Var, ValAry, y%Fx) ! Rank 1 Array + case (MAP_y_Fy) + call MV_Unpack2(Var, ValAry, y%Fy) ! Rank 1 Array + case (MAP_y_Fz) + call MV_Unpack2(Var, ValAry, y%Fz) ! Rank 1 Array + case (MAP_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (MAP_y_wrtOutput) + call MV_Unpack2(Var, ValAry, y%wrtOutput) ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_Unpack2(Var, ValAry, y%ptFairleadLoad) ! Mesh + end select + end associate + end do +end subroutine END MODULE MAP_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.h b/modules/map/src/MAP_Types.h index b32b32578b..1297250660 100644 --- a/modules/map/src/MAP_Types.h +++ b/modules/map/src/MAP_Types.h @@ -82,9 +82,6 @@ typedef struct MAP_ConstraintStateType { typedef struct MAP_ParameterType { void *object; - int iVarPtFairDisplacement; - int iVarPtFairleadLoad; - int iVarWriteOutput; double g; double depth; double rho_sea; diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index 41f369ed1d..cda0d3a995 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -751,7 +751,7 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, !------------------------------------------------------------------------- call MV_AddMeshVar(p%Vars%u, "PtFairDisplacement", [FieldTransDisp], & - VarIdx=p%iVarPtFairDisplacement, & + DatLoc(MAP_u_PtFairDisplacement), & Mesh=u%PtFairDisplacement, & Perturbs=[0.2_R8Ki*D2R * max(p%depth,1.0_R8Ki)]) @@ -760,12 +760,12 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, !------------------------------------------------------------------------- call MV_AddMeshVar(p%Vars%y, "FairleadLoads", [FieldForce], & - VarIdx=p%iVarPtFairleadLoad, & + DatLoc(MAP_y_PtFairleadLoad), & Mesh=y%ptFairleadLoad) ! Write outputs call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & - VarIdx=p%iVarWriteOutput, & + DatLoc(MAP_y_WriteOutput), & Flags=VF_WriteOut, & Num=p%numOuts,& LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) @@ -1380,14 +1380,14 @@ subroutine MAP_PackInputValues(p, u, Ary) type(MAP_ParameterType), intent(in) :: p type(MAP_InputType), intent(in) :: u real(R8Ki), intent(out) :: Ary(:) - call MV_Pack(p%Vars%u, p%iVarPtFairDisplacement, u%PtFairDisplacement, Ary) + ! call MV_Pack(p%Vars%u, p%iVarPtFairDisplacement, u%PtFairDisplacement, Ary) end subroutine subroutine MAP_UnpackInputValues(p, Ary, u) type(MAP_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Ary(:) type(MAP_InputType), intent(inout) :: u - call MV_Unpack(p%Vars%u, p%iVarPtFairDisplacement, Ary, u%PtFairDisplacement) + ! call MV_Unpack(p%Vars%u, p%iVarPtFairDisplacement, Ary, u%PtFairDisplacement) end subroutine subroutine MAP_PackOutputValues(p, y, Ary, PackWriteOutput) @@ -1395,8 +1395,8 @@ subroutine MAP_PackOutputValues(p, y, Ary, PackWriteOutput) type(MAP_OutputType), intent(in) :: y real(R8Ki), intent(out) :: Ary(:) logical, intent(in) :: PackWriteOutput - call MV_Pack(p%Vars%y, p%iVarPtFairleadLoad, y%ptFairleadLoad, Ary) - if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, Ary) + ! call MV_Pack(p%Vars%y, p%iVarPtFairleadLoad, y%ptFairleadLoad, Ary) + ! if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, Ary) end subroutine !========================================================================================================== diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 0507746e5a..c70ee7c813 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -1613,13 +1613,13 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er end if else 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() + CALL CleanUp() return end if else 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 + CALL CleanUp() + return end if END DO @@ -1672,57 +1672,57 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er 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 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 + + ! 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 + 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 + + 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 + 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 + + ! 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 + 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 @@ -1739,8 +1739,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er 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 + CALL CleanUp() + return endif elseif (m%FailList(l)%isRod == 1) then ! Rod end A @@ -1756,8 +1756,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er 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 + CALL CleanUp() + return endif elseif (m%FailList(l)%isRod == 2) then ! Rod end B @@ -1773,19 +1773,19 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er 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 + 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 + 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 + 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 @@ -1802,12 +1802,12 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er else - m%FailList(l)%failStatus = 0; ! initialize as unfailed + m%FailList(l)%failStatus = 0; ! initialize as unfailed endif - endif - enddo + endif + enddo !------------------------------------------------------------------------------------------- @@ -2804,19 +2804,25 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If coupled pinned body if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%BodyStateIs1(l)+3, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, & + DL=DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+3, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%BodyStateIs1(l)+6, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, & + DL=DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+6, & + Num=3, Flags=VF_DerivOrder2, & Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%BodyStateIs1(l)+9, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, & + DL=DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+9, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) end if @@ -2829,19 +2835,22 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If pinned rod if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%RodStateIs1(l)+3, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+3, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%RodStateIs1(l)+6, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+6, & + Num=3, Flags=VF_DerivOrder2, & Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%RodStateIs1(l)+9, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+9, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) end if @@ -2851,8 +2860,9 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) - call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%PointStateIs1(l)+3, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + iAry=m%PointStateIs1(l)+3, & ! x%state index + Num=3, Flags=VF_DerivOrder2, & Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) end do @@ -2863,8 +2873,9 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E N = m%LineList(l)%N ! number of segments in the line do i = 0, N-2 LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) - call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%LineStateIs1(l) + 3*N + 3*i - 3, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + iAry=m%LineStateIs1(l) + 3*N + 3*i - 3, & ! x%state index + Num=3, Flags=VF_DerivOrder2, & Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) end do @@ -2881,19 +2892,22 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If coupled pinned body if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%BodyStateIs1(l)+0, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%BodyStateIs1(l)+0, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%BodyStateIs1(l)+3, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+3, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) end if @@ -2906,19 +2920,22 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If pinned rod if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%RodStateIs1(l)+0, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%RodStateIs1(l)+0, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%RodStateIs1(l)+3, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+3, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) end if @@ -2928,8 +2945,9 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) - call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%PointStateIs1(l)+0, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + iAry=m%PointStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) end do @@ -2940,8 +2958,9 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E N = m%LineList(l)%N ! number of segments in the line do i = 0, N-2 LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) - call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, Num=3, Flags=VF_DerivOrder2, & - iUsr=m%LineStateIs1(l) + 3*i + 0, & ! x%state index + call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + iAry=m%LineStateIs1(l) + 3*i + 0, & + Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) end do @@ -2954,7 +2973,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E allocate(p%Vars%u(0)) call MV_AddMeshVar(p%Vars%u, "CoupledKinematics", MotionFields, & - VarIdx=p%iVarCoupledKinematics, & + DatLoc(MD_u_CoupledKinematics), & Mesh=u%CoupledKinematics(1), & Perturbs=[dl_slack_min, & ! FieldTransDisp 0.1_R8Ki, & ! FieldOrientation @@ -2964,10 +2983,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E 0.1_R8Ki]) ! FieldAngularAcc ! This could be stored more efficiently, but maintains order compatible with previous implementation. - if (.not. allocated(u%DeltaL)) then - p%iVarDeltaL = 0 - else - p%iVarDeltaL = size(p%Vars%u) + 1 + if (allocated(u%DeltaL)) then ! Signals may be passed in without being requested for control do i = 1,size(u%DeltaL) @@ -2989,12 +3005,12 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E end if call MV_AddVar(p%Vars%u, "DeltaL "//trim(num2lstr(i)), FieldTransDisp, & - iUsr=i, & + DatLoc(MD_u_DeltaL), iAry=i, & Perturb=dl_slack_min, & LinNames=['CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr)]) call MV_AddVar(p%Vars%u, "DeltaLdot "//trim(num2lstr(i)), FieldTransVel, & - iUsr=i, & + DatLoc(MD_u_DeltaLdot), iAry=i, & Perturb=0.2_R8Ki, & LinNames=['CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr)]) end do @@ -3004,13 +3020,11 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! Output variables !------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, "LinNames_y", LoadFields, & - VarIdx=p%iVarCoupledLoads, & + call MV_AddMeshVar(p%Vars%y, "LinNames_y", LoadFields, DatLoc(MD_y_CoupledLoads), & Mesh=y%CoupledLoads(1)) ! Write outputs - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & - VarIdx=p%iVarWriteOutput, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(MD_y_WriteOutput), & Flags=VF_WriteOut, & Num=p%numOuts,& LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) @@ -3161,11 +3175,11 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er ! 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 + DO l= 1,p%nFails - if (m%FailList(l)%failStatus == 0) then + if (m%FailList(l)%failStatus == 0) then - if ((t >= m%FailList(l)%failTime) .AND. (m%FailList(l)%failTime .NE. 0.0)) then + if ((t >= m%FailList(l)%failTime) .AND. (m%FailList(l)%failTime .NE. 0.0)) then ! step 1: check for time-triggered failures @@ -3174,7 +3188,7 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er 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 + 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 @@ -3243,7 +3257,7 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er ENDDO !li = 1, p%nFails endif ! m%FailList(l)%failStatus == 1 - endif ! m%FailList(l)%failStatus == 0 + endif ! m%FailList(l)%failStatus == 0 ENDDO ! l= 0,nFails @@ -3586,7 +3600,7 @@ 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/point in state vector +! INTEGER(IntKi) :: iAry ! 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 @@ -4152,7 +4166,7 @@ END SUBROUTINE TimeStep !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) +SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -4164,11 +4178,11 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] - integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation ! local variables character(*), parameter :: RoutineName = 'MD_JacobianPInput' @@ -4177,61 +4191,59 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM logical :: IsFullLin integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col - - ! Initialize ErrStat + type(ModVarsType), pointer :: VarsL + ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + ! If vars were provided use them, otherwise use module variables + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars end if - + ! Get OP values here call MD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if(Failed()) return ! Copy inputs to perturb call MD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackInputOP(p, u, m%Jac%u) + call MD_PackInputAry(VarsL, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) + do i = 1, size(VarsL%u) ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + if (.not. MV_HasFlags(VarsL%u(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputOP(p, m%y_jac, m%Jac%y_pos, IsFullLin) + call MD_PackOutputAry(VarsL, m%y_jac, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputOP(p, m%y_jac, m%Jac%y_neg, IsFullLin) + call MD_PackOutputAry(VarsL, m%y_jac, m%Jac%y_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do END IF @@ -4241,35 +4253,35 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) + do i = 1, size(VarsL%u) ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + if (.not. MV_HasFlags(VarsL%u(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, VarsL%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateOP(p, m%dxdt_jac, m%Jac%x_pos) + call MD_PackContStateAry(VarsL, m%dxdt_jac, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateOP(p, m%dxdt_jac, m%Jac%x_neg) + call MD_PackContStateAry(VarsL, m%dxdt_jac, m%Jac%x_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = VarsL%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%u(i)%Perturb) end do end do @@ -4292,7 +4304,7 @@ END SUBROUTINE MD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -4304,7 +4316,7 @@ SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Variable flag filter + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] @@ -4317,58 +4329,56 @@ SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E logical :: IsFullLin integer(IntKi) :: FlagFilterLoc integer(IntKi) :: i, j, col - - ! Initialize ErrStat + type(ModVarsType), pointer :: VarsL + ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter + ! If vars were provided use them, otherwise use module variables + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. - FlagFilterLoc = VF_None + VarsL => p%Vars end if ! Copy state values call MD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateOP(p, x, m%Jac%x) + call MD_PackContStateAry(VarsL, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, VarsL%Ny, VarsL%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) + do i = 1, size(VarsL%x) ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + if (.not. MV_HasFlags(VarsL%x(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, VarsL%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputOP(p, m%y_jac, m%Jac%y_pos, IsFullLin) + call MD_PackOutputAry(VarsL, m%y_jac, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputOP(p, m%y_jac, m%Jac%y_neg, IsFullLin) + call MD_PackOutputAry(VarsL, m%y_jac, m%Jac%y_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = VarsL%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(VarsL%y, VarsL%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do @@ -4379,35 +4389,35 @@ SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) + do i = 1, size(VarsL%x) ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + if (.not. MV_HasFlags(VarsL%x(i), FlagFilterLoc)) cycle ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, VarsL%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateOP(p, m%dxdt_jac, m%Jac%x_pos) + call MD_PackContStateAry(VarsL, m%dxdt_jac, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateOP(p, m%dxdt_jac, m%Jac%x_neg) + call MD_PackContStateAry(VarsL, m%dxdt_jac, m%Jac%x_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = VarsL%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%x(i)%Perturb) end do end do end if @@ -4495,7 +4505,7 @@ SUBROUTINE MD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE MD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE MD_GetOP(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, u_op, y_op, x_op, dx_op, xd_op, z_op) +SUBROUTINE MD_GetOP(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, u_op, y_op, x_op, dx_op, xd_op, z_op) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -4507,7 +4517,7 @@ SUBROUTINE MD_GetOP(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFi TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Filter variables by flag + type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states @@ -4518,49 +4528,49 @@ SUBROUTINE MD_GetOP(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFi CHARACTER(*), PARAMETER :: RoutineName = 'MD_GetOP' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin + type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None + ! If vars were provided use them, otherwise use module variables + if (present(Vars)) then + VarsL => Vars else - IsFullLin = .true. + VarsL => p%Vars end if ! Inputs if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return end if - call MD_PackInputOP(p, u, u_op) + call MD_PackInputAry(VarsL, u, u_op) end if ! Outputs if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return end if - call MD_PackOutputOP(p, y, y_op, IsFullLin) + call MD_PackOutputAry(VarsL, y, y_op) end if ! Continuous states if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call MD_PackContStateOP(p, x, x_op) + call MD_PackContStateAry(VarsL, x, x_op) end if ! Continuous state derivatives if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Vars%Nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return + call AllocAry(dx_op, VarsL%Nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return end if call MD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if(Failed()) return - call MD_PackContStateOP(p, m%dxdt_jac, dx_op) + call MD_PackContStateAry(VarsL, m%dxdt_jac, dx_op) end if ! Discrete states @@ -4578,101 +4588,4 @@ logical function Failed() end function Failed END SUBROUTINE MD_GetOP -subroutine MD_PackContStateOP(p, x, op) - type(MD_ParameterType), intent(in) :: p - type(MD_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: i, j, k, n, ind - do i = 1, size(p%Vars%x) - associate(iUsr => p%Vars%x(i)%iUsr) - call MV_Pack(p%Vars%x, i, x%states(iUsr(1):iUsr(2)), op) - end associate - end do -end subroutine - -subroutine MD_UnpackContStateOP(p, op, x) - type(MD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(MD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i, j, k, n, ind - do i = 1, size(p%Vars%x) - associate(iUsr => p%Vars%x(i)%iUsr) - call MV_Unpack(p%Vars%x, i, op, x%states(iUsr(1):iUsr(2))) - end associate - end do -end subroutine - -subroutine MD_PackDiscStateOP(p, xd, op) - type(MD_ParameterType), intent(in) :: p - type(MD_DiscreteStateType), intent(in) :: xd - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: i, j, k -end subroutine - -subroutine MD_UnpackDiscStateOP(p, op, xd) - type(MD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(MD_DiscreteStateType), intent(inout) :: xd - integer(IntKi) :: i, j, k -end subroutine - -subroutine MD_PackConstrStateOP(p, z, op) - type(MD_ParameterType), intent(in) :: p - type(MD_ConstraintStateType), intent(in) :: z - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: i, k, ind -end subroutine - -subroutine MD_UnpackConstrStateOP(p, op, z) - type(MD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(MD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i, k, ind -end subroutine - -subroutine MD_PackInputOP(p, u, op) - type(MD_ParameterType), intent(in) :: p - type(MD_InputType), intent(in) :: u - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: i - call MV_Pack(p%Vars%u, p%iVarCoupledKinematics, u%CoupledKinematics(1), op) - if (p%iVarDeltaL > 0) then - do i = p%iVarDeltaL, size(p%Vars%u), 2 - call MV_Pack(p%Vars%u, i, u%DeltaL(p%Vars%u(i)%iUsr(1)), op) - call MV_Pack(p%Vars%u, i + 1, u%DeltaLdot(p%Vars%u(i+1)%iUsr(1)), op) - end do - end if -end subroutine - -subroutine MD_UnpackInputOP(p, op, u) - type(MD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(MD_InputType), intent(inout) :: u - integer(IntKi) :: i - call MV_Unpack(p%Vars%u, p%iVarCoupledKinematics, op, u%CoupledKinematics(1)) - if (p%iVarDeltaL > 0) then - do i = p%iVarDeltaL, size(p%Vars%u), 2 - call MV_Unpack(p%Vars%u, i, op, u%DeltaL(p%Vars%u(i+1)%iUsr(1))) - call MV_Unpack(p%Vars%u, i + 1, op, u%DeltaLdot(p%Vars%u(i+1)%iUsr(1))) - end do - end if -end subroutine - -subroutine MD_PackOutputOP(p, y, op, PackWriteOutput) - type(MD_ParameterType), intent(in) :: p - type(MD_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: op(:) - logical, intent(in) :: PackWriteOutput - call MV_Pack(p%Vars%y, p%iVarCoupledLoads, y%CoupledLoads(1), op) - if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, op) -end subroutine - -subroutine MD_UnpackOutputOP(p, op, y) - type(MD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(MD_OutputType), intent(out) :: y - call MV_Unpack(p%Vars%y, p%iVarCoupledLoads, op, y%CoupledLoads(1)) - call MV_Unpack(p%Vars%y, p%iVarWriteOutput, op, y%WriteOutput) -end subroutine - END MODULE MoorDyn diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index bcf599922a..3c59ac3ecc 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -318,11 +318,6 @@ typedef ^ OtherStateType SiKi dummy - ## ============================== Parameters ============================================================================================================================================ typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" "" -typedef ^ ^ IntKi iVarWriteOutput - 0 - "Variable index of WriteOutput" "" -typedef ^ ^ IntKi iVarCoupledLoads - 0 - "Variable index of CoupledLoads Mesh" "" -typedef ^ ^ IntKi iVarCoupledKinematics - 0 - "Variable index of CoupledKinematics Mesh" "" -typedef ^ ^ IntKi iVarDeltaL - 0 - "Variable index of DeltaL" "" -typedef ^ ^ IntKi iVarDeltaLdot - 0 - "Variable index of DeltaLdot" "" typedef ^ ^ IntKi nLineTypes - 0 - "number of line types" "" typedef ^ ^ IntKi nRodTypes - 0 - "number of rod types" "" typedef ^ ^ IntKi nPoints - 0 - "number of Point objects" "" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 19655fe5a0..3eedfb3fc1 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -33,12 +33,6 @@ MODULE MoorDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MD_u_CoupledKinematics = 1 ! Mesh number for MD MD_u_CoupledKinematics mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_CoupledLoads = 2 ! Mesh number for MD MD_y_CoupledLoads mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_VisLinesMesh = 3 ! Mesh number for MD MD_y_VisLinesMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_VisRodsMesh = 4 ! Mesh number for MD MD_y_VisRodsMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_VisBodiesMesh = 5 ! Mesh number for MD MD_y_VisBodiesMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MD_y_VisAnchsMesh = 6 ! Mesh number for MD MD_y_VisAnchsMesh mesh [-] ! ========= MD_InputFileType ======= TYPE, PUBLIC :: MD_InputFileType REAL(DbKi) :: DTIC = 0.5 !< convergence check time step for IC generation [[s]] @@ -361,11 +355,6 @@ MODULE MoorDyn_Types ! ========= MD_ParameterType ======= TYPE, PUBLIC :: MD_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [] - INTEGER(IntKi) :: iVarWriteOutput = 0 !< Variable index of WriteOutput [] - INTEGER(IntKi) :: iVarCoupledLoads = 0 !< Variable index of CoupledLoads Mesh [] - INTEGER(IntKi) :: iVarCoupledKinematics = 0 !< Variable index of CoupledKinematics Mesh [] - INTEGER(IntKi) :: iVarDeltaL = 0 !< Variable index of DeltaL [] - INTEGER(IntKi) :: iVarDeltaLdot = 0 !< Variable index of DeltaLdot [] INTEGER(IntKi) :: nLineTypes = 0 !< number of line types [] INTEGER(IntKi) :: nRodTypes = 0 !< number of rod types [] INTEGER(IntKi) :: nPoints = 0 !< number of Point objects [] @@ -501,7 +490,19 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_npoints !< number of grid points to describe the bathymetry grid [-] END TYPE MD_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: MD_x_states = 1 ! MD%states + integer(IntKi), public, parameter :: MD_z_dummy = 2 ! MD%dummy + integer(IntKi), public, parameter :: MD_u_CoupledKinematics = 3 ! MD%CoupledKinematics(DL%i1) + integer(IntKi), public, parameter :: MD_u_DeltaL = 4 ! MD%DeltaL + integer(IntKi), public, parameter :: MD_u_DeltaLdot = 5 ! MD%DeltaLdot + integer(IntKi), public, parameter :: MD_y_CoupledLoads = 6 ! MD%CoupledLoads(DL%i1) + integer(IntKi), public, parameter :: MD_y_WriteOutput = 7 ! MD%WriteOutput + integer(IntKi), public, parameter :: MD_y_VisLinesMesh = 8 ! MD%VisLinesMesh(DL%i1) + integer(IntKi), public, parameter :: MD_y_VisRodsMesh = 9 ! MD%VisRodsMesh(DL%i1) + integer(IntKi), public, parameter :: MD_y_VisBodiesMesh = 10 ! MD%VisBodiesMesh(DL%i1) + integer(IntKi), public, parameter :: MD_y_VisAnchsMesh = 11 ! MD%VisAnchsMesh(DL%i1) + +contains subroutine MD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) type(MD_InputFileType), intent(in) :: SrcInputFileTypeData @@ -2825,11 +2826,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput - DstParamData%iVarCoupledLoads = SrcParamData%iVarCoupledLoads - DstParamData%iVarCoupledKinematics = SrcParamData%iVarCoupledKinematics - DstParamData%iVarDeltaL = SrcParamData%iVarDeltaL - DstParamData%iVarDeltaLdot = SrcParamData%iVarDeltaLdot DstParamData%nLineTypes = SrcParamData%nLineTypes DstParamData%nRodTypes = SrcParamData%nRodTypes DstParamData%nPoints = SrcParamData%nPoints @@ -3294,11 +3290,6 @@ subroutine MD_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarWriteOutput) - call RegPack(RF, InData%iVarCoupledLoads) - call RegPack(RF, InData%iVarCoupledKinematics) - call RegPack(RF, InData%iVarDeltaL) - call RegPack(RF, InData%iVarDeltaLdot) call RegPack(RF, InData%nLineTypes) call RegPack(RF, InData%nRodTypes) call RegPack(RF, InData%nPoints) @@ -3419,11 +3410,6 @@ subroutine MD_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarCoupledLoads); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarCoupledKinematics); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDeltaL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDeltaLdot); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nLineTypes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nRodTypes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nPoints); if (RegCheckErr(RF, RoutineName)) return @@ -5132,7 +5118,7 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err function MD_InputMeshPointer(u, ML) result(Mesh) type(MD_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -5142,7 +5128,7 @@ function MD_InputMeshPointer(u, ML) result(Mesh) end function function MD_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -5153,7 +5139,7 @@ function MD_InputMeshName(ML) result(Name) function MD_OutputMeshPointer(y, ML) result(Mesh) type(MD_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -5171,7 +5157,7 @@ function MD_OutputMeshPointer(y, ML) result(Mesh) end function function MD_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -5187,5 +5173,153 @@ function MD_OutputMeshName(ML) result(Name) Name = "y%VisAnchsMesh("//trim(Num2LStr(ML%i1))//")" end select end function + +subroutine MD_PackContStateAry(Vars, x, ValAry) + type(MD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (MD_x_states) + call MV_Pack2(Var, x%states, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine MD_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (MD_x_states) + call MV_Unpack2(Var, ValAry, x%states) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine MD_PackConstrStateAry(Vars, z, ValAry) + type(MD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (MD_z_dummy) + call MV_Pack2(Var, z%dummy, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine MD_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (MD_z_dummy) + call MV_Unpack2(Var, ValAry, z%dummy) ! Scalar + end select + end associate + end do +end subroutine + +subroutine MD_PackInputAry(Vars, u, ValAry) + type(MD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (MD_u_CoupledKinematics) + call MV_Pack2(Var, u%CoupledKinematics(DL%i1), ValAry) ! Mesh + case (MD_u_DeltaL) + call MV_Pack2(Var, u%DeltaL, ValAry) ! Rank 1 Array + case (MD_u_DeltaLdot) + call MV_Pack2(Var, u%DeltaLdot, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine MD_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (MD_u_CoupledKinematics) + call MV_Unpack2(Var, ValAry, u%CoupledKinematics(DL%i1)) ! Mesh + case (MD_u_DeltaL) + call MV_Unpack2(Var, ValAry, u%DeltaL) ! Rank 1 Array + case (MD_u_DeltaLdot) + call MV_Unpack2(Var, ValAry, u%DeltaLdot) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine MD_PackOutputAry(Vars, y, ValAry) + type(MD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (MD_y_CoupledLoads) + call MV_Pack2(Var, y%CoupledLoads(DL%i1), ValAry) ! Mesh + case (MD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_Pack2(Var, y%VisLinesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisRodsMesh) + call MV_Pack2(Var, y%VisRodsMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_Pack2(Var, y%VisBodiesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_Pack2(Var, y%VisAnchsMesh(DL%i1), ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine MD_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (MD_y_CoupledLoads) + call MV_Unpack2(Var, ValAry, y%CoupledLoads(DL%i1)) ! Mesh + case (MD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_Unpack2(Var, ValAry, y%VisLinesMesh(DL%i1)) ! Mesh + case (MD_y_VisRodsMesh) + call MV_Unpack2(Var, ValAry, y%VisRodsMesh(DL%i1)) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_Unpack2(Var, ValAry, y%VisBodiesMesh(DL%i1)) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_Unpack2(Var, ValAry, y%VisAnchsMesh(DL%i1)) ! Mesh + end select + end associate + end do +end subroutine END MODULE MoorDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index e33843e575..49b2be4444 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -30,10 +30,10 @@ module ModVar implicit none private -public :: MV_InitVarsJac, MV_Pack, MV_Unpack +public :: MV_InitVarsJac, MV_Pack, MV_Unpack, MV_Pack2, MV_Unpack2 public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff, MV_ExtrapInterp, MV_AddDelta public :: MV_AddVar, MV_AddMeshVar -public :: MV_HasFlags, MV_SetFlags, MV_ClearFlags, MV_NumVars +public :: MV_HasFlags, MV_SetFlags, MV_ClearFlags, MV_NumVars, MV_FindVarDatLoc public :: LoadFields, MotionFields, TransFields, AngularFields public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv public :: MV_FieldString, MV_IsLoad, IdxStr @@ -57,10 +57,248 @@ module ModVar module procedure MV_UnpackMesh end interface +interface MV_Pack2 + module procedure MV_Pack2VarRank0R4, MV_Pack2VarRank1R4, MV_Pack2VarRank2R4, MV_Pack2VarRank3R4, MV_Pack2VarRank4R4 + module procedure MV_Pack2VarRank0R8, MV_Pack2VarRank1R8, MV_Pack2VarRank2R8, MV_Pack2VarRank3R8, MV_Pack2VarRank4R8 + module procedure MV_Pack2Mesh +end interface + +interface MV_Unpack2 + module procedure MV_Unpack2VarRank0R4, MV_Unpack2VarRank1R4, MV_Unpack2VarRank2R4, MV_Unpack2VarRank3R4, MV_Unpack2VarRank4R4 + module procedure MV_Unpack2VarRank0R8, MV_Unpack2VarRank1R8, MV_Unpack2VarRank2R8, MV_Unpack2VarRank3R8, MV_Unpack2VarRank4R8 + module procedure MV_Unpack2Mesh +end interface + logical, parameter :: UseSmallRotAngs = .true. contains +!------------------------------------------------------------------------------- +! MV_Pack2 +!------------------------------------------------------------------------------- + +subroutine MV_Pack2VarRank0R4(Var, Val, Ary) + type(ModVarType), intent(in) :: Var + real(R4Ki), intent(in) :: Val + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1)) = real(Val, R8Ki) +end subroutine + +subroutine MV_Pack2VarRank0R8(Var, Val, Ary) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Val + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1)) = Val +end subroutine + +subroutine MV_Pack2VarRank1R4(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R4Ki), intent(in) :: Vals(:) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = real(Vals(Var%iAry(1):Var%iAry(2)), R8Ki) +end subroutine + +subroutine MV_Pack2VarRank1R8(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Vals(:) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = Vals(Var%iAry(1):Var%iAry(2)) +end subroutine + +subroutine MV_Pack2VarRank2R4(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R4Ki), intent(in) :: Vals(:, :) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Vals(Var%iAry(1):Var%iAry(2), Var%jAry), R8Ki), .true.) +end subroutine + +subroutine MV_Pack2VarRank2R8(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Vals(:, :) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry), .true.) +end subroutine + +subroutine MV_Pack2VarRank3R4(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R4Ki), intent(in) :: Vals(:, :, :) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry), R8Ki), .true.) +end subroutine + +subroutine MV_Pack2VarRank3R8(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Vals(:, :, :) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry), .true.) +end subroutine + +subroutine MV_Pack2VarRank4R4(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R4Ki), intent(in) :: Vals(:, :, :, :) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), R8Ki), .true.) +end subroutine + +subroutine MV_Pack2VarRank4R8(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Vals(:, :, :, :) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), .true.) +end subroutine + +subroutine MV_Pack2Mesh(Var, Mesh, Ary) + type(ModVarType), intent(in) :: Var + type(MeshType), intent(in) :: Mesh + real(R8Ki), intent(inout) :: Ary(:) + integer(IntKi) :: i, j, k + select case (Var%Field) + case (FieldForce) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Force, R8Ki), .true.) + case (FieldMoment) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Moment, R8Ki), .true.) + case (FieldTransDisp) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationDisp, R8Ki), .true.) + case (FieldOrientation) + k = Var%iLoc(1) + do j = 1, Var%Nodes + Ary(k:k + 2) = dcm_to_quat(Mesh%Orientation(:, :, j)) + k = k + 3 + end do + case (FieldTransVel) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationVel, R8Ki), .true.) + case (FieldAngularVel) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%RotationVel, R8Ki), .true.) + case (FieldTransAcc) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationAcc, R8Ki), .true.) + case (FieldAngularAcc) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%RotationAcc, R8Ki), .true.) + case (FieldScalar) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Scalars, R8Ki), .true.) + end select +end subroutine + +!------------------------------------------------------------------------------- +! MV_Unpack2 +!------------------------------------------------------------------------------- + +subroutine MV_Unpack2VarRank0R4(Var, Ary, Val) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R4Ki), intent(inout) :: Val + Val = real(Ary(Var%iLoc(1)), R4Ki) +end subroutine + +subroutine MV_Unpack2VarRank0R8(Var, Ary, Val) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Val + Val = Ary(Var%iLoc(1)) +end subroutine + +subroutine MV_Unpack2VarRank1R4(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R4Ki), intent(inout) :: Vals(:) + Vals(Var%iAry(1):Var%iAry(2)) = real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki) +end subroutine + +subroutine MV_Unpack2VarRank1R8(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:) + Vals(Var%iAry(1):Var%iAry(2)) = Ary(Var%iLoc(1):Var%iLoc(2)) +end subroutine + +subroutine MV_Unpack2VarRank2R4(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R4Ki), intent(inout) :: Vals(:, :) + associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry)) + V = reshape(real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki), shape(V)) + end associate +end subroutine + +subroutine MV_Unpack2VarRank2R8(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:, :) + associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry)) + V = reshape(Ary(Var%iLoc(1):Var%iLoc(2)), shape(V)) + end associate +end subroutine + +subroutine MV_Unpack2VarRank3R4(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R4Ki), intent(inout) :: Vals(:, :, :) + associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry)) + V = reshape(real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki), shape(V)) + end associate +end subroutine + +subroutine MV_Unpack2VarRank3R8(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:, :, :) + associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry)) + V = reshape(Ary(Var%iLoc(1):Var%iLoc(2)), shape(V)) + end associate +end subroutine + +subroutine MV_Unpack2VarRank4R4(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R4Ki), intent(inout) :: Vals(:, :, :, :) + associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry)) + V = reshape(real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki), shape(V)) + end associate +end subroutine + +subroutine MV_Unpack2VarRank4R8(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:, :, :, :) + associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry)) + V = reshape(Ary(Var%iLoc(1):Var%iLoc(2)), shape(V)) + end associate +end subroutine + +subroutine MV_Unpack2Mesh(Var, Vals, Mesh) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Vals(:) + type(MeshType), intent(inout) :: Mesh + integer(IntKi) :: i, j, k + select case (Var%Field) + case (FieldForce) + Mesh%Force = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Force)) + case (FieldMoment) + Mesh%Moment = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Moment)) + case (FieldTransDisp) + Mesh%TranslationDisp = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationDisp)) + case (FieldOrientation) + k = Var%iLoc(1) + do j = 1, Var%Nodes + Mesh%Orientation(:, :, j) = quat_to_dcm(Vals(k:k + 2)) + k = k + 3 + end do + case (FieldTransVel) + Mesh%TranslationVel = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationVel)) + case (FieldAngularVel) + Mesh%RotationVel = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%RotationVel)) + case (FieldTransAcc) + Mesh%TranslationAcc = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationAcc)) + case (FieldAngularAcc) + Mesh%RotationAcc = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%RotationAcc)) + case (FieldScalar) + Mesh%Scalars = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Scalars)) + end select +end subroutine + +!------------------------------------------------------------------------------- +! Field Names +!------------------------------------------------------------------------------- + function MV_FieldString(Field) result(str) integer(IntKi), intent(in) :: Field character(16) :: str @@ -106,7 +344,6 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) ! Initialize number of variables in each group Vars%Nx = 0 - Vars%Nxd = 0 Vars%Nz = 0 Vars%Nu = 0 Vars%Ny = 0 @@ -120,15 +357,6 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) end do Vars%Nx = sum(Vars%x%Num) - ! Initialize discrete state variables - if (.not. allocated(Vars%xd)) allocate (Vars%xd(0)) - StartIndex = 1 - do i = 1, size(Vars%xd) - call ModVarType_Init(Vars%xd(i), StartIndex, Linearize, ErrStat2, ErrMsg2) - if (Failed()) return - end do - Vars%Nxd = sum(Vars%xd%Num) - ! Initialize constraint state variables if (.not. allocated(Vars%z)) allocate (Vars%z(0)) StartIndex = 1 @@ -164,9 +392,6 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) call AllocAry(Jac%x_pos, Vars%Nx, "Lin%x_pos", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(Jac%x_neg, Vars%Nx, "Lin%x_neg", ErrStat2, ErrMsg2); if (Failed()) return end if - if (Vars%Nxd > 0) then - call AllocAry(Jac%xd, Vars%Nxd, "Lin%xd", ErrStat2, ErrMsg2); if (Failed()) return - end if if (Vars%Nz > 0) then call AllocAry(Jac%z, Vars%Nz, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return end if @@ -863,22 +1088,23 @@ subroutine MV_AddDelta(VarAry, DeltaAry, DataAry) ! Functions for adding Variables !------------------------------------------------------------------------------- -subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs, VarIdx, Active) +subroutine MV_AddMeshVar(VarAry, Name, Fields, DL, Mesh, Flags, Perturbs, Active, iVar) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Fields(:) + type(DatLoc), intent(in) :: DL type(MeshType), intent(inout) :: Mesh integer(IntKi), optional, intent(in) :: Flags real(R8Ki), optional, intent(in) :: Perturbs(:) - integer(IntKi), optional, intent(out) :: VarIdx logical, optional, intent(in) :: Active integer(IntKi) :: FlagsLocal logical :: ActiveLocal real(R8Ki), allocatable :: PerturbsLocal(:) - integer(IntKi) :: i, idx + integer(IntKi), optional, intent(out) :: iVar + integer(IntKi) :: i - ! Initialize variable index (variable is not active or mesh is not commited) - if (present(VarIdx)) VarIdx = 0 + ! If variable index is present, initialize to zero in case variable is inactive + if (present(iVar)) iVar = 0 ! If active argument specified and not active, return if (present(Active)) then @@ -895,8 +1121,8 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs, VarIdx, Ac Mesh%ID = 1 end if - ! If present, set variable index from mesh ID - if (present(VarIdx)) VarIdx = Mesh%ID + ! Save variable index + if (present(iVar)) iVar = Mesh%ID ! Apply flags if specified FlagsLocal = VF_Mesh @@ -910,7 +1136,8 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs, VarIdx, Ac do i = 1, size(Fields) ! Add variable - call MV_AddVar(VarAry, Name, Fields(i), VarIdx=idx, & + call MV_AddVar(VarAry, Name, Fields(i), & + DL=DL, & Num=Mesh%Nnodes, & Flags=FlagsLocal, & Perturb=PerturbsLocal(i)) @@ -920,30 +1147,33 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs, VarIdx, Ac end do end subroutine -subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Perturb, LinNames, VarIdx, Active) +subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, DerivOrder, Perturb, LinNames, Active, iVar) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Field - integer(IntKi), optional, intent(in) :: Num, Flags, iUsr, jUsr + type(DatLoc), intent(in) :: DL + integer(IntKi), optional, intent(in) :: iAry, jAry, kAry + integer(IntKi), optional, intent(in) :: Num, Flags real(R8Ki), optional, intent(in) :: Perturb integer(IntKi), optional, intent(in) :: DerivOrder character(*), optional, intent(in) :: LinNames(:) - integer(IntKi), optional, intent(out) :: VarIdx logical, optional, intent(in) :: Active + integer(IntKi), optional, intent(out) :: iVar integer(IntKi) :: i type(ModVarType) :: Var + ! If variable index is present, initialize to zero in case variable is inactive + if (present(iVar)) iVar = 0 + ! If active argument specified and not active, return if (present(Active)) then if (.not. Active) then - ! Set variable index to zero if present - if (present(VarIdx)) VarIdx = 0 return end if end if ! Initialize var with default values - Var = ModVarType(Name=Name, Field=Field) + Var = ModVarType(Name=Name, Field=Field, DL=DL, Num=1) ! If number of values is zero, return if (present(Num)) then @@ -953,8 +1183,9 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Pe ! Set optional values if (present(Flags)) Var%Flags = Flags - if (present(iUsr)) Var%iUsr = [iUsr, iUsr + Var%Num - 1] - if (present(jUsr)) Var%jUsr = jUsr + if (present(iAry)) Var%iAry = [iAry, iAry + Var%Num - 1] + if (present(jAry)) Var%jAry = jAry + if (present(kAry)) Var%kAry = kAry if (present(Perturb)) Var%Perturb = Perturb if (present(LinNames)) then allocate (Var%LinNames(size(LinNames))) @@ -963,6 +1194,9 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Pe end do end if + ! If number is greater than 1 but iAry is zero, assume that iAry should be [1,Num] + if ((Var%Num > 1) .and. (Var%iAry(1) == 0)) Var%iAry = [1, Var%Num] + ! Set Derivative Order if (present(DerivOrder)) then Var%DerivOrder = DerivOrder @@ -987,7 +1221,8 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Pe end if ! Set variable index if present - if (present(VarIdx)) VarIdx = size(VarAry) + if (present(iVar)) iVar = size(VarAry) + end subroutine function MV_NumVars(VarAry, FlagFilter) result(Num) @@ -1009,6 +1244,20 @@ pure logical function MV_IsLoad(Var) MV_IsLoad = Var%Field == FieldForce .or. Var%Field == FieldMoment end function +! Find variable index in array based on DatLoc number +pure integer(IntKi) function MV_FindVarDatLoc(VarAry, DatLocNum) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(in) :: DatLocNum + integer(IntKi) :: i + do i = 1, size(VarAry) + if (VarAry(i)%DL%Num == DatLocNum) then + MV_FindVarDatLoc = i + return + end if + end do + MV_FindVarDatLoc = 0 +end function + !------------------------------------------------------------------------------- ! Flag Utilities !------------------------------------------------------------------------------- diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 74d9cd2aa6..f2f0c410d3 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -113,19 +113,30 @@ MODULE NWTC_Library_Types CHARACTER(6) :: RNG_type END TYPE NWTC_RandomNumber_ParameterType ! ======================= +! ========= DatLoc ======= + TYPE, PUBLIC :: DatLoc + INTEGER(IntKi) :: Num = 0 !< Mesh number in module [-] + INTEGER(IntKi) :: i1 = 0 !< Index 1 [-] + INTEGER(IntKi) :: i2 = 0 !< Index 2 [-] + INTEGER(IntKi) :: i3 = 0 !< Index 3 [-] + END TYPE DatLoc +! ======================= ! ========= ModVarType ======= TYPE, PUBLIC :: ModVarType character(VarNameLen) :: Name !< [-] INTEGER(IntKi) :: iMod = 0 !< Module index [-] INTEGER(IntKi) :: iVar = 0 !< Variable index [-] + TYPE(DatLoc) :: DL !< data location [-] INTEGER(IntKi) :: Field = 0 !< [-] INTEGER(IntKi) :: Nodes = 1 !< [-] INTEGER(IntKi) :: Num = 1 !< [-] INTEGER(IntKi) :: Flags = 0 !< [-] INTEGER(IntKi) :: DerivOrder = 0 !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0 !< indices in local arrays [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0 !< first user defined index for variable, can be used a lower/upper bounds [-] - INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iAry = 0 !< first user defined index for variable [-] + INTEGER(IntKi) :: jAry = 0 !< second user defined index for variable [-] + INTEGER(IntKi) :: kAry = 0 !< third user defined index for variable [-] + INTEGER(IntKi) :: mAry = 0 !< third user defined index for variable [-] INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] REAL(R8Ki) :: Perturb = 0 !< perturbation amount for linearization [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] @@ -134,12 +145,10 @@ MODULE NWTC_Library_Types ! ========= ModVarsType ======= TYPE, PUBLIC :: ModVarsType INTEGER(IntKi) :: Nx = 0 !< Number of x values [-] - INTEGER(IntKi) :: Nxd = 0 !< Number of xd values [-] INTEGER(IntKi) :: Nz = 0 !< Number of z values [-] INTEGER(IntKi) :: Nu = 0 !< Number of u values [-] INTEGER(IntKi) :: Ny = 0 !< Number of y values [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] - TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: xd !< Module state variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: z !< Module state variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] @@ -149,7 +158,6 @@ MODULE NWTC_Library_Types TYPE, PUBLIC :: ModJacType REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] @@ -161,15 +169,24 @@ MODULE NWTC_Library_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] END TYPE ModJacType ! ======================= -! ========= MeshLocType ======= - TYPE, PUBLIC :: MeshLocType - INTEGER(IntKi) :: Num = 0 !< Mesh number in module [-] - INTEGER(IntKi) :: i1 = 0 !< Mesh index 1 [-] - INTEGER(IntKi) :: i2 = 0 !< Mesh index 2 [-] - INTEGER(IntKi) :: i3 = 0 !< Mesh index 3 [-] - END TYPE MeshLocType +! ========= VarXfrType ======= + TYPE, PUBLIC :: VarXfrType + INTEGER(IntKi) :: iVar = 0_IntKi !< [-] + INTEGER(IntKi) :: NumVals = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iSrc = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iDst = 0_IntKi !< [-] + END TYPE VarXfrType +! ======================= +! ========= ModXfrType ======= + TYPE, PUBLIC :: ModXfrType + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: x !< [-] + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: z !< [-] + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: u !< [-] + TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: y !< [-] + END TYPE ModXfrType ! ======================= -CONTAINS + +contains subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) type(ProgDesc), intent(in) :: SrcProgDescData @@ -589,6 +606,53 @@ subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(RF, OutData) call RegUnpack(RF, OutData%RNG_type); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine NWTC_Library_CopyDatLoc(SrcDatLocData, DstDatLocData, CtrlCode, ErrStat, ErrMsg) + type(DatLoc), intent(in) :: SrcDatLocData + type(DatLoc), intent(inout) :: DstDatLocData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyDatLoc' + ErrStat = ErrID_None + ErrMsg = '' + DstDatLocData%Num = SrcDatLocData%Num + DstDatLocData%i1 = SrcDatLocData%i1 + DstDatLocData%i2 = SrcDatLocData%i2 + DstDatLocData%i3 = SrcDatLocData%i3 +end subroutine + +subroutine NWTC_Library_DestroyDatLoc(DatLocData, ErrStat, ErrMsg) + type(DatLoc), intent(inout) :: DatLocData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyDatLoc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackDatLoc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DatLoc), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackDatLoc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Num) + call RegPack(RF, InData%i1) + call RegPack(RF, InData%i2) + call RegPack(RF, InData%i3) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackDatLoc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DatLoc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackDatLoc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i3); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, CtrlCode, ErrStat, ErrMsg) type(ModVarType), intent(in) :: SrcModVarTypeData type(ModVarType), intent(inout) :: DstModVarTypeData @@ -597,20 +661,26 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' ErrStat = ErrID_None ErrMsg = '' DstModVarTypeData%Name = SrcModVarTypeData%Name DstModVarTypeData%iMod = SrcModVarTypeData%iMod DstModVarTypeData%iVar = SrcModVarTypeData%iVar + call NWTC_Library_CopyDatLoc(SrcModVarTypeData%DL, DstModVarTypeData%DL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return DstModVarTypeData%Field = SrcModVarTypeData%Field DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes DstModVarTypeData%Num = SrcModVarTypeData%Num DstModVarTypeData%Flags = SrcModVarTypeData%Flags DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc - DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr - DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr + DstModVarTypeData%iAry = SrcModVarTypeData%iAry + DstModVarTypeData%jAry = SrcModVarTypeData%jAry + DstModVarTypeData%kAry = SrcModVarTypeData%kAry + DstModVarTypeData%mAry = SrcModVarTypeData%mAry DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb if (allocated(SrcModVarTypeData%LinNames)) then @@ -631,9 +701,13 @@ subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) type(ModVarType), intent(inout) :: ModVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarType' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyDatLoc(ModVarTypeData%DL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModVarTypeData%LinNames)) then deallocate(ModVarTypeData%LinNames) end if @@ -647,14 +721,17 @@ subroutine NWTC_Library_PackModVarType(RF, Indata) call RegPack(RF, InData%Name) call RegPack(RF, InData%iMod) call RegPack(RF, InData%iVar) + call NWTC_Library_PackDatLoc(RF, InData%DL) call RegPack(RF, InData%Field) call RegPack(RF, InData%Nodes) call RegPack(RF, InData%Num) call RegPack(RF, InData%Flags) call RegPack(RF, InData%DerivOrder) call RegPack(RF, InData%iLoc) - call RegPack(RF, InData%iUsr) - call RegPack(RF, InData%jUsr) + call RegPack(RF, InData%iAry) + call RegPack(RF, InData%jAry) + call RegPack(RF, InData%kAry) + call RegPack(RF, InData%mAry) call RegPack(RF, InData%MeshID) call RegPack(RF, InData%Perturb) call RegPackAlloc(RF, InData%LinNames) @@ -672,14 +749,17 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackDatLoc(RF, OutData%DL) ! DL call RegUnpack(RF, OutData%Field); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nodes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Flags); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DerivOrder); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iUsr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%jUsr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iAry); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%jAry); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kAry); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mAry); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MeshID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Perturb); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames); if (RegCheckErr(RF, RoutineName)) return @@ -699,7 +779,6 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, ErrStat = ErrID_None ErrMsg = '' DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx - DstModVarsTypeData%Nxd = SrcModVarsTypeData%Nxd DstModVarsTypeData%Nz = SrcModVarsTypeData%Nz DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny @@ -719,22 +798,6 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcModVarsTypeData%xd)) then - LB(1:1) = lbound(SrcModVarsTypeData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcModVarsTypeData%xd, kind=B8Ki) - if (.not. allocated(DstModVarsTypeData%xd)) then - allocate(DstModVarsTypeData%xd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%xd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyModVarType(SrcModVarsTypeData%xd(i1), DstModVarsTypeData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcModVarsTypeData%z)) then LB(1:1) = lbound(SrcModVarsTypeData%z, kind=B8Ki) UB(1:1) = ubound(SrcModVarsTypeData%z, kind=B8Ki) @@ -805,15 +868,6 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) end do deallocate(ModVarsTypeData%x) end if - if (allocated(ModVarsTypeData%xd)) then - LB(1:1) = lbound(ModVarsTypeData%xd, kind=B8Ki) - UB(1:1) = ubound(ModVarsTypeData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyModVarType(ModVarsTypeData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModVarsTypeData%xd) - end if if (allocated(ModVarsTypeData%z)) then LB(1:1) = lbound(ModVarsTypeData%z, kind=B8Ki) UB(1:1) = ubound(ModVarsTypeData%z, kind=B8Ki) @@ -851,7 +905,6 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nxd) call RegPack(RF, InData%Nz) call RegPack(RF, InData%Nu) call RegPack(RF, InData%Ny) @@ -864,15 +917,6 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) call NWTC_Library_PackModVarType(RF, InData%x(i1)) end do end if - call RegPack(RF, allocated(InData%xd)) - if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackModVarType(RF, InData%xd(i1)) - end do - end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) @@ -913,7 +957,6 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nxd); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return @@ -930,19 +973,6 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) call NWTC_Library_UnpackModVarType(RF, OutData%x(i1)) ! x end do end if - if (allocated(OutData%xd)) deallocate(OutData%xd) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackModVarType(RF, OutData%xd(i1)) ! xd - end do - end if if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -1019,18 +1049,6 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr end if DstModJacTypeData%dx = SrcModJacTypeData%dx end if - if (allocated(SrcModJacTypeData%xd)) then - LB(1:1) = lbound(SrcModJacTypeData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%xd, kind=B8Ki) - if (.not. allocated(DstModJacTypeData%xd)) then - allocate(DstModJacTypeData%xd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%xd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModJacTypeData%xd = SrcModJacTypeData%xd - end if if (allocated(SrcModJacTypeData%z)) then LB(1:1) = lbound(SrcModJacTypeData%z, kind=B8Ki) UB(1:1) = ubound(SrcModJacTypeData%z, kind=B8Ki) @@ -1154,9 +1172,6 @@ subroutine NWTC_Library_DestroyModJacType(ModJacTypeData, ErrStat, ErrMsg) if (allocated(ModJacTypeData%dx)) then deallocate(ModJacTypeData%dx) end if - if (allocated(ModJacTypeData%xd)) then - deallocate(ModJacTypeData%xd) - end if if (allocated(ModJacTypeData%z)) then deallocate(ModJacTypeData%z) end if @@ -1193,7 +1208,6 @@ subroutine NWTC_Library_PackModJacType(RF, Indata) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%x) call RegPackAlloc(RF, InData%dx) - call RegPackAlloc(RF, InData%xd) call RegPackAlloc(RF, InData%z) call RegPackAlloc(RF, InData%u) call RegPackAlloc(RF, InData%y) @@ -1216,7 +1230,6 @@ subroutine NWTC_Library_UnPackModJacType(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return @@ -1228,51 +1241,288 @@ subroutine NWTC_Library_UnPackModJacType(RF, OutData) call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_CopyMeshLocType(SrcMeshLocTypeData, DstMeshLocTypeData, CtrlCode, ErrStat, ErrMsg) - type(MeshLocType), intent(in) :: SrcMeshLocTypeData - type(MeshLocType), intent(inout) :: DstMeshLocTypeData +subroutine NWTC_Library_CopyVarXfrType(SrcVarXfrTypeData, DstVarXfrTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarXfrType), intent(in) :: SrcVarXfrTypeData + type(VarXfrType), intent(inout) :: DstVarXfrTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshLocType' + character(*), parameter :: RoutineName = 'NWTC_Library_CopyVarXfrType' ErrStat = ErrID_None ErrMsg = '' - DstMeshLocTypeData%Num = SrcMeshLocTypeData%Num - DstMeshLocTypeData%i1 = SrcMeshLocTypeData%i1 - DstMeshLocTypeData%i2 = SrcMeshLocTypeData%i2 - DstMeshLocTypeData%i3 = SrcMeshLocTypeData%i3 + DstVarXfrTypeData%iVar = SrcVarXfrTypeData%iVar + DstVarXfrTypeData%NumVals = SrcVarXfrTypeData%NumVals + DstVarXfrTypeData%iSrc = SrcVarXfrTypeData%iSrc + DstVarXfrTypeData%iDst = SrcVarXfrTypeData%iDst end subroutine -subroutine NWTC_Library_DestroyMeshLocType(MeshLocTypeData, ErrStat, ErrMsg) - type(MeshLocType), intent(inout) :: MeshLocTypeData +subroutine NWTC_Library_DestroyVarXfrType(VarXfrTypeData, ErrStat, ErrMsg) + type(VarXfrType), intent(inout) :: VarXfrTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshLocType' + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyVarXfrType' ErrStat = ErrID_None ErrMsg = '' end subroutine -subroutine NWTC_Library_PackMeshLocType(RF, Indata) +subroutine NWTC_Library_PackVarXfrType(RF, Indata) type(RegFile), intent(inout) :: RF - type(MeshLocType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshLocType' + type(VarXfrType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackVarXfrType' if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Num) - call RegPack(RF, InData%i1) - call RegPack(RF, InData%i2) - call RegPack(RF, InData%i3) + call RegPack(RF, InData%iVar) + call RegPack(RF, InData%NumVals) + call RegPack(RF, InData%iSrc) + call RegPack(RF, InData%iDst) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackMeshLocType(RF, OutData) +subroutine NWTC_Library_UnPackVarXfrType(RF, OutData) type(RegFile), intent(inout) :: RF - type(MeshLocType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshLocType' + type(VarXfrType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackVarXfrType' if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%i3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumVals); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iDst); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModXfrType(SrcModXfrTypeData, DstModXfrTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModXfrType), intent(in) :: SrcModXfrTypeData + type(ModXfrType), intent(inout) :: DstModXfrTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModXfrType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModXfrTypeData%x)) then + LB(1:1) = lbound(SrcModXfrTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%x, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%x)) then + allocate(DstModXfrTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyVarXfrType(SrcModXfrTypeData%x(i1), DstModXfrTypeData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModXfrTypeData%z)) then + LB(1:1) = lbound(SrcModXfrTypeData%z, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%z, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%z)) then + allocate(DstModXfrTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyVarXfrType(SrcModXfrTypeData%z(i1), DstModXfrTypeData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModXfrTypeData%u)) then + LB(1:1) = lbound(SrcModXfrTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%u, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%u)) then + allocate(DstModXfrTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyVarXfrType(SrcModXfrTypeData%u(i1), DstModXfrTypeData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModXfrTypeData%y)) then + LB(1:1) = lbound(SrcModXfrTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcModXfrTypeData%y, kind=B8Ki) + if (.not. allocated(DstModXfrTypeData%y)) then + allocate(DstModXfrTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyVarXfrType(SrcModXfrTypeData%y(i1), DstModXfrTypeData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine NWTC_Library_DestroyModXfrType(ModXfrTypeData, ErrStat, ErrMsg) + type(ModXfrType), intent(inout) :: ModXfrTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModXfrType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModXfrTypeData%x)) then + LB(1:1) = lbound(ModXfrTypeData%x, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyVarXfrType(ModXfrTypeData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%x) + end if + if (allocated(ModXfrTypeData%z)) then + LB(1:1) = lbound(ModXfrTypeData%z, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyVarXfrType(ModXfrTypeData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%z) + end if + if (allocated(ModXfrTypeData%u)) then + LB(1:1) = lbound(ModXfrTypeData%u, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%u, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyVarXfrType(ModXfrTypeData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%u) + end if + if (allocated(ModXfrTypeData%y)) then + LB(1:1) = lbound(ModXfrTypeData%y, kind=B8Ki) + UB(1:1) = ubound(ModXfrTypeData%y, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyVarXfrType(ModXfrTypeData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModXfrTypeData%y) + end if +end subroutine + +subroutine NWTC_Library_PackModXfrType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModXfrType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModXfrType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackVarXfrType(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackVarXfrType(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + LB(1:1) = lbound(InData%u, kind=B8Ki) + UB(1:1) = ubound(InData%u, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackVarXfrType(RF, InData%u(i1)) + end do + end if + call RegPack(RF, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) + LB(1:1) = lbound(InData%y, kind=B8Ki) + UB(1:1) = ubound(InData%y, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackVarXfrType(RF, InData%y(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModXfrType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModXfrType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModXfrType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackVarXfrType(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackVarXfrType(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackVarXfrType(RF, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackVarXfrType(RF, OutData%y(i1)) ! y + end do + end if end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index cbb1c3a661..e6177bcebd 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -75,35 +75,40 @@ param ^ - IntKi VC_Tight - 1 - param ^ - IntKi VC_Option1 - 2 - "" - param ^ - IntKi VC_Option2 - 3 - "" - +typedef ^ DatLoc IntKi Num - 0 - "Mesh number in module" +typedef ^ ^ IntKi i1 - 0 - "Index 1" +typedef ^ ^ IntKi i2 - 0 - "Index 2" +typedef ^ ^ IntKi i3 - 0 - "Index 3" + typedef ^ ModVarType character(VarNameLen) Name - - - "" - typedef ^ ^ IntKi iMod - 0 - "Module index" - typedef ^ ^ IntKi iVar - 0 - "Variable index" - +typedef ^ ^ DatLoc DL - - - "data location" - typedef ^ ^ IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - typedef ^ ^ IntKi iLoc 2 0 - "indices in local arrays" - -typedef ^ ^ IntKi iUsr 2 0 - "first user defined index for variable, can be used a lower/upper bounds" - -typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi iAry 2 0 - "first user defined index for variable" - +typedef ^ ^ IntKi jAry - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi kAry - 0 - "third user defined index for variable" - +typedef ^ ^ IntKi mAry - 0 - "third user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" -typedef ^ ^ IntKi Nxd - 0 - "Number of xd values" typedef ^ ^ IntKi Nz - 0 - "Number of z values" typedef ^ ^ IntKi Nu - 0 - "Number of u values" typedef ^ ^ IntKi Ny - 0 - "Number of y values" typedef ^ ^ ModVarType x : - - "Module state variable array" - -typedef ^ ^ ModVarType xd : - - "Module state variable array" - typedef ^ ^ ModVarType z : - - "Module state variable array" - typedef ^ ^ ModVarType u : - - "Module input variable array" - typedef ^ ^ ModVarType y : - - "Module output variable array" - typedef ^ ModJacType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - -typedef ^ ^ R8Ki xd : - - "" - typedef ^ ^ R8Ki z : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - @@ -114,10 +119,16 @@ typedef ^ ^ R8Ki x_neg : - - typedef ^ ^ R8Ki y_pos : - - "" - typedef ^ ^ R8Ki y_neg : - - "" - -typedef ^ MeshLocType IntKi Num - 0 - "Mesh number in module" -typedef ^ ^ IntKi i1 - 0 - "Mesh index 1" -typedef ^ ^ IntKi i2 - 0 - "Mesh index 2" -typedef ^ ^ IntKi i3 - 0 - "Mesh index 3" +typedef ^ VarXfrType IntKi iVar - - - "" - +typedef ^ ^ IntKi NumVals - - - "" - +typedef ^ ^ IntKi iSrc 2 - - "" - +typedef ^ ^ IntKi iDst 2 - - "" - + +typedef ^ ModXfrType VarXfrType x : - - "" - +typedef ^ ^ VarXfrType z : - - "" - +typedef ^ ^ VarXfrType u : - - "" - +typedef ^ ^ VarXfrType y : - - "" - + # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 003305ff72..8baca31f66 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -75,35 +75,40 @@ param ^ - IntKi VC_Tight - 1 - param ^ - IntKi VC_Option1 - 2 - "" - param ^ - IntKi VC_Option2 - 3 - "" - +typedef ^ DatLoc IntKi Num - 0 - "Mesh number in module" +typedef ^ ^ IntKi i1 - 0 - "Index 1" +typedef ^ ^ IntKi i2 - 0 - "Index 2" +typedef ^ ^ IntKi i3 - 0 - "Index 3" + typedef ^ ModVarType character(VarNameLen) Name - - - "" - typedef ^ ^ IntKi iMod - 0 - "Module index" - typedef ^ ^ IntKi iVar - 0 - "Variable index" - +typedef ^ ^ DatLoc DL - - - "data location" - typedef ^ ^ IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - typedef ^ ^ IntKi iLoc 2 0 - "indices in local arrays" - -typedef ^ ^ IntKi iUsr 2 0 - "first user defined index for variable, can be used a lower/upper bounds" - -typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi iAry 2 0 - "first user defined index for variable" - +typedef ^ ^ IntKi jAry - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi kAry - 0 - "third user defined index for variable" - +typedef ^ ^ IntKi mAry - 0 - "third user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" -typedef ^ ^ IntKi Nxd - 0 - "Number of xd values" typedef ^ ^ IntKi Nz - 0 - "Number of z values" typedef ^ ^ IntKi Nu - 0 - "Number of u values" typedef ^ ^ IntKi Ny - 0 - "Number of y values" typedef ^ ^ ModVarType x : - - "Module state variable array" - -typedef ^ ^ ModVarType xd : - - "Module state variable array" - typedef ^ ^ ModVarType z : - - "Module state variable array" - typedef ^ ^ ModVarType u : - - "Module input variable array" - typedef ^ ^ ModVarType y : - - "Module output variable array" - typedef ^ ModJacType R8Ki x : - - "" - typedef ^ ^ R8Ki dx : - - "" - -typedef ^ ^ R8Ki xd : - - "" - typedef ^ ^ R8Ki z : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - @@ -114,7 +119,13 @@ typedef ^ ^ R8Ki x_neg : - - typedef ^ ^ R8Ki y_pos : - - "" - typedef ^ ^ R8Ki y_neg : - - "" - -typedef ^ MeshLocType IntKi Num - 0 - "Mesh number in module" -typedef ^ ^ IntKi i1 - 0 - "Mesh index 1" -typedef ^ ^ IntKi i2 - 0 - "Mesh index 2" -typedef ^ ^ IntKi i3 - 0 - "Mesh index 3" +typedef ^ VarXfrType IntKi iVar - - - "" - +typedef ^ ^ IntKi NumVals - - - "" - +typedef ^ ^ IntKi iSrc 2 - - "" - +typedef ^ ^ IntKi iDst 2 - - "" - + +typedef ^ ModXfrType VarXfrType x : - - "" - +typedef ^ ^ VarXfrType z : - - "" - +typedef ^ ^ VarXfrType u : - - "" - +typedef ^ ^ VarXfrType y : - - "" - + diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 676d03af12..4383fecf43 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -78,7 +78,7 @@ add_library(openfast_postlib STATIC src/FAST_ModData.f90 src/FAST_ModGlue.f90 src/FAST_Mapping.f90 - src/FAST_AeroMap.f90 + # src/FAST_AeroMap.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 146888086d..7eea0c3eb4 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -314,9 +314,9 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS os_BD => T%BD%OtherSt(ModData%Ins, STATE_PRED)) ! Transfer tight coupling states to module - call BD_PackContStateQuatOP(p_BD, x_BD, m_BD%Jac%x) + ! call BD_PackContStateQuatOP(p_BD, x_BD, m_BD%Jac%x) ! call XferGblToLoc1D(ModData%ixs, x_TC, m_BD%Jac%x) - call BD_UnpackContStateQuatOP(p_BD, m_BD%Jac%x, x_BD) + ! call BD_UnpackContStateQuatOP(p_BD, m_BD%Jac%x, x_BD) ! TODO: Fix state reset ! Set BD accelerations and algorithmic accelerations from q matrix @@ -332,8 +332,8 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! end do ! Update the global reference - call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg) - if (Failed()) return + ! call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg) + ! if (Failed()) return ! Update q matrix accelerations and algorithmic accelerations from BD ! do j = 1, size(p_BD%Vars%x) @@ -348,7 +348,7 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! end do ! Transfer updated states to solver - call BD_PackContStateQuatOP(p_BD, x_BD, m_BD%Jac%x) + ! call BD_PackContStateQuatOP(p_BD, x_BD, m_BD%Jac%x) ! call XferLocToGbl1D(ModData%ixs, m_BD%Jac%x, x_TC) end associate @@ -358,16 +358,14 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS u_ED => T%ED%Input(1), x_ED => T%ED%x(STATE_PRED)) ! Transfer tight coupling states to module - call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) - ! call XferGblToLoc1D(ModData%ixs, x_TC, m_ED%Jac%x) - call ED_UnpackContStateOP(p_ED, m_ED%Jac%x, x_ED) + ! call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) + ! call ED_UnpackContStateOP(p_ED, m_ED%Jac%x, x_ED) ! Update the azimuth angle - call ED_UpdateAzimuth(p_ED, x_ED, T%p_FAST%DT) + ! call ED_UpdateAzimuth(p_ED, x_ED, T%p_FAST%DT) ! Transfer updated states to solver - call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) - ! call XferLocToGbl1D(ModData%ixs, m_ED%Jac%x, x_TC) + ! call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) end associate @@ -521,8 +519,8 @@ subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, E end subroutine -subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, FlagFilter, & - u_op, y_op, x_op, dx_op, xd_op, z_op) +subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, & + Vars, u_op, y_op, x_op, dx_op, xd_op, z_op) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: InputIndex !< Input index @@ -530,7 +528,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - integer(IntKi), optional, intent(in) :: FlagFilter !< Flag to filter variable calculations + type(ModVarsType), optional, intent(in) :: Vars !< Variables real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs real(R8Ki), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states @@ -552,18 +550,18 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err case (Module_AD) call AD_GetOP(ModData%Ins, ThisTime, T%AD%Input(InputIndex), T%AD%p, T%AD%x(StateIndex), T%AD%xd(StateIndex), T%AD%z(StateIndex), & T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + Vars=Vars, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case (Module_BD) call BD_GetOP(ThisTime, T%BD%Input(InputIndex, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, StateIndex), & T%BD%xd(ModData%Ins, StateIndex), T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) case (Module_ED) call ED_GetOP(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) ! case (Module_ExtPtfm) @@ -589,7 +587,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err case (Module_MD) call MD_GetOP(ThisTime, T%MD%Input(InputIndex), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), T%MD%z(StateIndex), & T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) ! case (Module_OpFM) ! case (Module_Orca) @@ -716,15 +714,16 @@ subroutine FAST_SetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end subroutine -subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilter, dYdu, dXdu) +subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, Vars, dYdu, dXdu) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: ThisState !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - integer(IntKi), optional, intent(in) :: FlagFilter !< Variable index number - real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :), dXdu(:, :) + type(ModVarsType), optional, intent(in) :: Vars !< Variables + real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPInput' integer(IntKi) :: ErrStat2 @@ -739,17 +738,19 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, case (Module_AD) call AD_JacobianPInput(ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), & T%AD%z(ThisState), T%AD%OtherSt(ThisState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + Vars=Vars, dYdu=dYdu, dXdu=dXdu) case (Module_BD) - call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & - T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & + T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + Vars=Vars, dYdu=dYdu, dXdu=dXdu) case (Module_ED) call ED_JacobianPInput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + Vars=Vars, dYdu=dYdu, dXdu=dXdu) ! case (Module_ExtPtfm) @@ -776,7 +777,7 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, case (Module_SD) call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdu=dYdu, dXdu=dXdu) + dYdu=dYdu, dXdu=dXdu) case (Module_SeaSt) call SeaSt_JacobianPInput(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), & @@ -797,15 +798,16 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, end subroutine -subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, StateRotation) +subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, Vars, dYdx, dXdx, StateRotation) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: ThisState !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - integer(IntKi), optional :: FlagFilter - real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :) + type(ModVarsType), optional, intent(in) :: Vars !< Variables + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:, :) real(R8Ki), allocatable, optional, intent(inout) :: StateRotation(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPContState' @@ -823,21 +825,21 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err T%AD%x(ThisState), T%AD%xd(ThisState), & T%AD%z(ThisState), T%AD%OtherSt(ThisState), & T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + Vars=Vars, dYdx=dYdx, dXdx=dXdx) case (Module_BD) call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx, StateRotation=StateRotation) + Vars=Vars, dYdx=dYdx, dXdx=dXdx, StateRotation=StateRotation) case (Module_ED) call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & T%ED%x(ThisState), T%ED%xd(ThisState), & T%ED%z(ThisState), T%ED%OtherSt(ThisState), & T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + Vars=Vars, dYdx=dYdx, dXdx=dXdx) ! case (Module_ExtPtfm) @@ -846,7 +848,7 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err T%HD%x(ThisState), T%HD%xd(ThisState), & T%HD%z(ThisState), T%HD%OtherSt(ThisState), & T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + dYdx=dYdx, dXdx=dXdx) case (Module_IfW) call InflowWind_JacobianPContState(ThisTime, T%IfW%Input(1), T%IfW%p, & @@ -872,7 +874,7 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err T%SD%x(ThisState), T%SD%xd(ThisState), & T%SD%z(ThisState), T%SD%OtherSt(ThisState), & T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - FlagFilter=FlagFilter, dYdx=dYdx, dXdx=dXdx) + dYdx=dYdx, dXdx=dXdx) case (Module_SeaSt) call SeaSt_JacobianPContState(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, & diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 696a54fe65..48143c27ef 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -52,7 +52,7 @@ module FAST_Mapping subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, InputIndex, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData - type(MeshLocType), intent(in) :: MeshLoc + type(DatLoc), intent(in) :: MeshLoc type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshType), pointer, intent(out) :: Mesh integer(IntKi), intent(in) :: InputIndex @@ -68,11 +68,11 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, InputIndex, Er case (Module_AD) select case (InputIndex) case (:-1) - Mesh => AD_InputMeshPointer(Turbine%AD%Input_Saved(-InputIndex), MeshLoc) + Mesh => AD_InputMeshPointer(Turbine%AD%Input_Saved(-InputIndex)%rotors(ModData%Ins), MeshLoc) case (0) - Mesh => AD_InputMeshPointer(Turbine%AD%u, MeshLoc) + Mesh => AD_InputMeshPointer(Turbine%AD%u%rotors(ModData%Ins), MeshLoc) case (1:) - Mesh => AD_InputMeshPointer(Turbine%AD%Input(InputIndex), MeshLoc) + Mesh => AD_InputMeshPointer(Turbine%AD%Input(InputIndex)%rotors(ModData%Ins), MeshLoc) end select case (Module_BD) select case (InputIndex) @@ -222,7 +222,7 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, InputIndex, Er subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData - type(MeshLocType), intent(in) :: MeshLoc + type(DatLoc), intent(in) :: MeshLoc type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshType), pointer, intent(out) :: Mesh integer(IntKi), intent(out) :: ErrStat @@ -235,7 +235,7 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM select case (ModData%ID) case (Module_AD) - Mesh => AD_OutputMeshPointer(Turbine%AD%y, MeshLoc) + Mesh => AD_OutputMeshPointer(Turbine%AD%y%rotors(ModData%Ins), MeshLoc) case (Module_BD) Mesh => BD_OutputMeshPointer(Turbine%BD%y(ModData%Ins), MeshLoc) case (Module_ED) @@ -285,7 +285,7 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM function FAST_InputMeshName(ModData, MeshLoc) result(Name) type(ModDataType), intent(in) :: ModData - type(MeshLocType), intent(in) :: MeshLoc + type(DatLoc), intent(in) :: MeshLoc character(32) :: Name Name = "Unknown mesh in "//ModData%Abbr select case (ModData%ID) @@ -326,7 +326,7 @@ function FAST_InputMeshName(ModData, MeshLoc) result(Name) function FAST_OutputMeshName(ModData, MeshLoc) result(Name) type(ModDataType), intent(in) :: ModData - type(MeshLocType), intent(in) :: MeshLoc + type(DatLoc), intent(in) :: MeshLoc character(32) :: Name Name = "Unknown mesh in "//ModData%Abbr select case (ModData%ID) @@ -492,8 +492,8 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_BD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion - DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, DstMod%Ins, SrcMod%Ins), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(SrcMod%Ins) + SrcMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMeshLoc=DatLoc(AD_u_BladeMotion, SrcMod%Ins), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(SrcMod%Ins) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps .or. (SrcMod%Ins == 1)) if (Failed()) return @@ -503,8 +503,8 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) if (Turbine%p_FAST%CompElast == Module_ED) then do i = 1, size(Turbine%ED%y%BladeLn2Mesh) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - DstMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, DstMod%Ins, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) + SrcMeshLoc=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstMeshLoc=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps .or. (i == 1)) if (Failed()) return @@ -512,38 +512,38 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) end if call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - DstMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, DstMod%Ins), & ! AD%u%rotors(DstMod%Ins)%TowerMotion + SrcMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstMeshLoc=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return do i = 1, size(Turbine%ED%y%BladeRootMotion) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) - DstMeshLoc=MeshLocType(AD_u_rotors_BladeRootMotion, DstMod%Ins, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) + SrcMeshLoc=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstMeshLoc=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return end do call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - DstMeshLoc=MeshLocType(AD_u_rotors_HubMotion, DstMod%Ins), & ! AD%u%rotors(DstMod%Ins)%HubMotion + SrcMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMeshLoc=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, DstMod%Ins), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion + SrcMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMeshLoc=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion - DstMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, DstMod%Ins), & ! AD%u%rotors(DstMod%Ins)%TFinMotion + SrcMeshLoc=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + DstMeshLoc=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(DstMod%Ins)%TFinMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -552,22 +552,22 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapVariable(Mappings, "IfW HWindSpeed -> AD HWindSpeed", & SrcMod=SrcMod, DstMod=DstMod, & - iVarSrc=Turbine%IfW%p%iVarHWindSpeed, & - iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarHWindSpeed, & + iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, InflowWind_y_HWindSpeed), & + iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, AD_u_HWindSpeed), & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return call MapVariable(Mappings, "IfW PLExp -> AD PLExp", & SrcMod=SrcMod, DstMod=DstMod, & - iVarSrc=Turbine%IfW%p%iVarPLExp, & - iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarPLExp, & + iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, InflowWind_y_PLExp), & + iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, AD_u_PLExp), & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return call MapVariable(Mappings, "IfW PropagationDir -> AD PropagationDir", & SrcMod=SrcMod, DstMod=DstMod, & - iVarSrc=Turbine%IfW%p%iVarPropagationDir, & - iVarDst=Turbine%AD%p%rotors(DstMod%Ins)%iVarPropagationDir, & + iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, InflowWind_y_PropagationDir), & + iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, AD_u_PropagationDir), & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -609,10 +609,10 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_AD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, SrcMod%Ins, DstMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(DstMod%Ins) - SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, SrcMod%Ins, DstMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(DstMod%Ins) - DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%u(DstMod%Ins)%DistrLoad - DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + SrcMeshLoc=DatLoc(AD_y_BladeLoad, DstMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(DstMod%Ins) + SrcDispMeshLoc=DatLoc(AD_u_BladeMotion, DstMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(DstMod%Ins) + DstMeshLoc=DatLoc(BD_u_DistrLoad), & ! BD%u(DstMod%Ins)%DistrLoad + DstDispMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps .or. (DstMod%Ins == 1)) if (Failed()) return @@ -620,16 +620,16 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, DstMod%Ins), & ! ED%y%BladeRootMotion(DstMod%Ins) - DstMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%u(DstMod%Ins)%RootMotion + SrcMeshLoc=DatLoc(ED_y_BladeRootMotion, DstMod%Ins), & ! ED%y%BladeRootMotion(DstMod%Ins) + DstMeshLoc=DatLoc(BD_u_RootMotion), & ! BD%u(DstMod%Ins)%RootMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return ! Hub motion not used ! call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - ! SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion - ! DstMeshLoc=MeshLocType(BD_u_HubMotion), & ! BD%Input(1, DstMod%Ins)%HubMotion + ! SrcMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion + ! DstMeshLoc=DatLoc(BD_u_HubMotion), & ! BD%Input(1, DstMod%Ins)%HubMotion ! ErrStat=ErrStat2, ErrMsg=ErrMsg2, & ! Active=NotCompAeroMaps) ! if (Failed()) return @@ -643,10 +643,10 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do i = 1, Turbine%SrvD%p%NumBStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, DstMod%Ins, i), & ! SrvD%y%BStCLoadMesh(DstMod%Ins, i), & - SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(DstMod%Ins, i) - DstMeshLoc=MeshLocType(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad - DstDispMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + SrcMeshLoc=DatLoc(SrvD_y_BStCLoadMesh, DstMod%Ins, i), & ! SrvD%y%BStCLoadMesh(DstMod%Ins, i), & + SrcDispMeshLoc=DatLoc(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(DstMod%Ins, i) + DstMeshLoc=DatLoc(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad + DstDispMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return end do @@ -686,47 +686,47 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_BladeLoad, SrcMod%Ins, i), & ! AD%y%rotors(SrcMod%InsR)%BladeLoad(i) - SrcDispMeshLoc=MeshLocType(AD_u_rotors_BladeMotion, SrcMod%Ins, i), & ! AD%u%rotors(SrcMod%InsR)%BladeMotion(i) - DstMeshLoc=MeshLocType(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) - DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + SrcMeshLoc=DatLoc(AD_y_BladeLoad, SrcMod%Ins, i), & ! AD%y%rotors(SrcMod%InsR)%BladeLoad(i) + SrcDispMeshLoc=DatLoc(AD_u_BladeMotion, SrcMod%Ins, i), & ! AD%u%rotors(SrcMod%InsR)%BladeMotion(i) + DstMeshLoc=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispMeshLoc=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=(Turbine%p_FAST%CompElast == Module_ED) .and. (NotCompAeroMaps .or. (i == 1))) if (Failed()) return end do call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_HubLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%HubLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_HubMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%HubMotion - DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%u%HubPtLoad - DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + SrcMeshLoc=DatLoc(AD_y_HubLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%HubLoad + SrcDispMeshLoc=DatLoc(AD_u_HubMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%HubMotion + DstMeshLoc=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_NacelleLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_NacelleMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion - DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%u%NacelleLoads - DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + SrcMeshLoc=DatLoc(AD_y_NacelleLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad + SrcDispMeshLoc=DatLoc(AD_u_NacelleMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion + DstMeshLoc=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_TFinLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_TFinMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion - DstMeshLoc=MeshLocType(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads - DstDispMeshLoc=MeshLocType(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + SrcMeshLoc=DatLoc(AD_y_TFinLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad + SrcDispMeshLoc=DatLoc(AD_u_TFinMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion + DstMeshLoc=DatLoc(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads + DstDispMeshLoc=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(AD_y_rotors_TowerLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad - SrcDispMeshLoc=MeshLocType(AD_u_rotors_TowerMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion - DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads - DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + SrcMeshLoc=DatLoc(AD_y_TowerLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad + SrcDispMeshLoc=DatLoc(AD_u_TowerMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion + DstMeshLoc=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads + DstDispMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -734,10 +734,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_BD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce - SrcDispMeshLoc=MeshLocType(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion - DstMeshLoc=MeshLocType(ED_u_HubPtLoad), & ! ED%u%HubPtLoad - DstDispMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + SrcMeshLoc=DatLoc(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce + SrcDispMeshLoc=DatLoc(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion + DstMeshLoc=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -750,10 +750,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ExtPtfm) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh - SrcDispMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh + SrcDispMeshLoc=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -761,10 +761,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_FEAM) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & - SrcDispMeshLoc=MeshLocType(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & + SrcDispMeshLoc=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -773,20 +773,20 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh - SrcDispMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispMeshLoc=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub == Module_None, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh - SrcDispMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispMeshLoc=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub == Module_None, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -795,10 +795,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(IceD_y_PointMesh), & ! IceD%y%PointMesh - SrcDispMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(IceD_y_PointMesh), & ! IceD%y%PointMesh + SrcDispMeshLoc=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -807,10 +807,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh - SrcDispMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh + SrcDispMeshLoc=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -819,10 +819,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad - SrcDispMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispMeshLoc=DatLoc(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -831,10 +831,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) - SrcDispMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispMeshLoc=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -843,10 +843,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh - SrcDispMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh + SrcDispMeshLoc=DatLoc(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -854,38 +854,38 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_SD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & - SrcDispMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%u%TPMesh - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & + SrcDispMeshLoc=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return case (Module_SrvD) call MapVariable(Mappings, "SrvD BlPitchCom -> ED BlPitchCom", & - SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarBlPitchCom, & - DstMod=DstMod, iVarDst=Turbine%ED%p%iVarBlPitchCom, & + SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, SrvD_y_BlPitchCom), & + DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, ED_u_BlPitchCom), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "SrvD YawMom -> ED YawMom", & - SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarYawMom, & - DstMod=DstMod, iVarDst=Turbine%ED%p%iVarYawMom, & + SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, SrvD_y_YawMom), & + DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, ED_u_YawMom), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "SrvD GenTrq -> ED GenTrq", & - SrcMod=SrcMod, iVarSrc=Turbine%SrvD%p%iVarGenTrq, & - DstMod=DstMod, iVarDst=Turbine%ED%p%iVarGenTrq, & + SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, SrvD_y_GenTrq), & + DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, ED_u_GenTrq), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Blade Structural Controller (if ElastoDyn is used for blades) do j = 1, Turbine%SrvD%p%NumBStC do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) - DstMeshLoc=MeshLocType(ED_u_BladePtLoads, j), & ! ED%u%BladePtLoads(j) - DstDispMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + SrcMeshLoc=DatLoc(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & + SrcDispMeshLoc=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + DstMeshLoc=DatLoc(ED_u_BladePtLoads, j), & ! ED%u%BladePtLoads(j) + DstDispMeshLoc=DatLoc(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -895,10 +895,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Nacelle Structural Controller do j = 1, Turbine%SrvD%p%NumNStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_NacelleLoads), & ! ED%u%NacelleLoads - DstDispMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + SrcMeshLoc=DatLoc(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & + SrcDispMeshLoc=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + DstMeshLoc=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return end do @@ -906,10 +906,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Tower Structural Controller do j = 1, Turbine%SrvD%p%NumTStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_TowerPtLoads), & ! ED%u%TowerLoads - DstDispMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + SrcMeshLoc=DatLoc(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & + SrcDispMeshLoc=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + DstMeshLoc=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerLoads + DstDispMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return end do @@ -917,10 +917,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - DstMeshLoc=MeshLocType(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcMeshLoc=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispMeshLoc=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -962,8 +962,8 @@ subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg case (Module_BD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion - DstMeshLoc=MeshLocType(ExtLd_u_BladeMotion, SrcMod%Ins), & ! ExtLd%u%BladeMotion(SrcMod%Ins) + SrcMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMeshLoc=DatLoc(ExtLd_u_BladeMotion, SrcMod%Ins), & ! ExtLd%u%BladeMotion(SrcMod%Ins) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_ED) @@ -972,32 +972,32 @@ subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - DstMeshLoc=MeshLocType(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) + SrcMeshLoc=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstMeshLoc=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) - DstMeshLoc=MeshLocType(ExtLd_u_BladeRootMotion, i), & ! ExtLd%u%BladeRootMotion(i) + SrcMeshLoc=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstMeshLoc=DatLoc(ExtLd_u_BladeRootMotion, i), & ! ExtLd%u%BladeRootMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - DstMeshLoc=MeshLocType(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion + SrcMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstMeshLoc=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - DstMeshLoc=MeshLocType(ExtLd_u_HubMotion), & ! ExtLd%u%HubMotion + SrcMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMeshLoc=DatLoc(ExtLd_u_HubMotion), & ! ExtLd%u%HubMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstMeshLoc=MeshLocType(ExtLd_u_NacelleMotion), & ! ExtLd%u%NacelleMotion + SrcMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMeshLoc=DatLoc(ExtLd_u_NacelleMotion), & ! ExtLd%u%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1030,16 +1030,16 @@ subroutine InitMappings_ExtPtfm(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM if (Turbine%p_FAST%CompSub /= Module_SD) then call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end if case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%u%TPMesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1071,16 +1071,16 @@ subroutine InitMappings_FEAM(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=MeshLocType(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1125,39 +1125,39 @@ subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_PRPMesh), & ! HD%u%PRPMesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(HydroDyn_u_PRPMesh), & ! HD%u%PRPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return case (Module_SeaSt) call MapVariable(Mappings, "SEA WaveElev0 -> HD WaveElev0", & - SrcMod=SrcMod, iVarSrc=Turbine%SeaSt%p%iVarWaveElev0Y, & - DstMod=DstMod, iVarDst=Turbine%HD%p%iVarWaveElev0, & + SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, SeaSt_y_WaveElev0), & + DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, HydroDyn_u_WaveElev0), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh - DstMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + SrcMeshLoc=DatLoc(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstMeshLoc=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y2Mesh), & ! SD%y%Y2Mesh - DstMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + SrcMeshLoc=DatLoc(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstMeshLoc=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1186,16 +1186,16 @@ subroutine InitMappings_IceD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh + SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1225,16 +1225,16 @@ subroutine InitMappings_IceF(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1292,16 +1292,16 @@ subroutine InitMappings_MAP(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement + SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=DatLoc(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1332,16 +1332,16 @@ subroutine InitMappings_MD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SrvD) @@ -1375,8 +1375,8 @@ subroutine InitMappings_Orca(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1408,69 +1408,69 @@ subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(SD_u_TPMesh), & ! SD%u%TPMesh + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_FEAM) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & - SrcDispMeshLoc=MeshLocType(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcMeshLoc=DatLoc(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & + SrcDispMeshLoc=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_HD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh - SrcDispMeshLoc=MeshLocType(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcMeshLoc=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispMeshLoc=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh - SrcDispMeshLoc=MeshLocType(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcMeshLoc=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispMeshLoc=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_IceD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(IceD_y_PointMesh), & ! IceD%y%PointMesh - SrcDispMeshLoc=MeshLocType(IceD_u_PointMesh), & ! IceD%u%PointMesh - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcMeshLoc=DatLoc(IceD_y_PointMesh), & ! IceD%y%PointMesh + SrcDispMeshLoc=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_IceF) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh - SrcDispMeshLoc=MeshLocType(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcMeshLoc=DatLoc(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh + SrcDispMeshLoc=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_MAP) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad - SrcDispMeshLoc=MeshLocType(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcMeshLoc=DatLoc(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispMeshLoc=DatLoc(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_MD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) - SrcDispMeshLoc=MeshLocType(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcMeshLoc=DatLoc(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispMeshLoc=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SrvD) @@ -1480,10 +1480,10 @@ subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & - SrcDispMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - DstMeshLoc=MeshLocType(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcMeshLoc=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispMeshLoc=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1550,8 +1550,8 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Blade Structural Controller do i = 1, Turbine%SrvD%p%NumBStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(BD_y_BldMotion), & ! BD%y%BldMotion - DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(i, j) + SrcMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y%BldMotion + DstMeshLoc=DatLoc(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(i, j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1560,38 +1560,38 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapCustom(Mappings, Custom_ED_to_SrvD, SrcMod, DstMod) call MapVariable(Mappings, "ED Yaw -> SrvD Yaw", & - SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarYaw, & - DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarYaw, & + SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, ED_y_Yaw), & + DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, SrvD_u_Yaw), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED YawRate -> SrvD YawRate", & - SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarYawRate, & - DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarYawRate, & + SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, ED_y_YawRate), & + DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, SrvD_u_YawRate), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & - SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarHSS_Spd, & - DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarHSS_Spd, & + SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, ED_y_HSS_Spd), & + DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, SrvD_u_HSS_Spd), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & - SrcMod=SrcMod, iVarSrc=Turbine%ED%p%iVarHSS_Spd, & - DstMod=DstMod, iVarDst=Turbine%SrvD%p%iVarHSS_Spd, & + SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, ED_y_HSS_Spd), & + DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, SrvD_u_HSS_Spd), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Nacelle Structural Controller do j = 1, Turbine%SrvD%p%NumNStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstMeshLoc=MeshLocType(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + SrcMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMeshLoc=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do ! Tower Structural Controller do j = 1, Turbine%SrvD%p%NumTStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion - DstMeshLoc=MeshLocType(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + SrcMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion + DstMeshLoc=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1599,8 +1599,8 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do j = 1, Turbine%SrvD%p%NumBStC do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - DstMeshLoc=MeshLocType(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + SrcMeshLoc=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstMeshLoc=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1609,8 +1609,8 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller (if not using SubDyn) do j = 1, Turbine%SrvD%p%NumSStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstMeshLoc=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1624,8 +1624,8 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=MeshLocType(SD_y_y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=MeshLocType(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + SrcMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + DstMeshLoc=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1643,8 +1643,8 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & type(FAST_TurbineType), target :: Turbine type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod - type(MeshLocType), intent(in) :: SrcMeshLoc, DstMeshLoc - type(MeshLocType), intent(in) :: SrcDispMeshLoc, DstDispMeshLoc + type(DatLoc), intent(in) :: SrcMeshLoc, DstMeshLoc + type(DatLoc), intent(in) :: SrcDispMeshLoc, DstDispMeshLoc integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, optional, intent(in) :: Active @@ -1789,7 +1789,7 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL type(FAST_TurbineType), target :: Turbine type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod - type(MeshLocType), intent(in) :: SrcMeshLoc, DstMeshLoc + type(DatLoc), intent(in) :: SrcMeshLoc, DstMeshLoc integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, optional, intent(in) :: Active diff --git a/modules/openfast-library/src/FAST_ModData.f90 b/modules/openfast-library/src/FAST_ModData.f90 index 3b128e22bf..b9bee058ad 100644 --- a/modules/openfast-library/src/FAST_ModData.f90 +++ b/modules/openfast-library/src/FAST_ModData.f90 @@ -120,12 +120,6 @@ subroutine ModD_CombineModules(ModAry, iModOrder, FlagFilter, Linearize, ModOut, if (FailedAlloc("ModOut%Xfr(iMod)%x")) return xNum = xNum + NumVars - ! Discrete state - call CountVariablesFiltered(ModData%Vars%xd, NumVars) - allocate (ModOut%Xfr(iMod)%xd(NumVars), stat=ErrStat2) - if (FailedAlloc("ModOut%Xfr(iMod)%xd")) return - xdNum = xdNum + NumVars - ! Constraint state call CountVariablesFiltered(ModData%Vars%z, NumVars) allocate (ModOut%Xfr(iMod)%z(NumVars), stat=ErrStat2) @@ -149,7 +143,6 @@ subroutine ModD_CombineModules(ModAry, iModOrder, FlagFilter, Linearize, ModOut, ! Allocate arrays for to hold combined variables allocate (ModOut%Vars%x(xNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%x")) return - allocate (ModOut%Vars%xd(xdNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%xd")) return allocate (ModOut%Vars%z(zNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%z")) return allocate (ModOut%Vars%u(uNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%u")) return allocate (ModOut%Vars%y(yNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%y")) return @@ -159,7 +152,6 @@ subroutine ModD_CombineModules(ModAry, iModOrder, FlagFilter, Linearize, ModOut, ! Initialize number of values in each group variable group ModOut%Vars%Nx = 0 - ModOut%Vars%Nxd = 0 ModOut%Vars%Nz = 0 ModOut%Vars%Nu = 0 ModOut%Vars%Ny = 0 @@ -180,7 +172,6 @@ subroutine ModD_CombineModules(ModAry, iModOrder, FlagFilter, Linearize, ModOut, end if if (size(ModData%Vars%x) > 0) call AddVariables(ModData%Vars%x, ModOut%Vars%x, ModOut%Xfr(iMod)%x, ix, ModOut%Vars%Nx) ! Continuous state - if (size(ModData%Vars%xd) > 0) call AddVariables(ModData%Vars%xd, ModOut%Vars%xd, ModOut%Xfr(iMod)%xd, ixd, ModOut%Vars%Nxd) ! Discrete state if (size(ModData%Vars%z) > 0) call AddVariables(ModData%Vars%z, ModOut%Vars%z, ModOut%Xfr(iMod)%z, iz, ModOut%Vars%Nz) ! Constraint state if (size(ModData%Vars%u) > 0) call AddVariables(ModData%Vars%u, ModOut%Vars%u, ModOut%Xfr(iMod)%u, iu, ModOut%Vars%Nu) ! Input if (size(ModData%Vars%y) > 0) call AddVariables(ModData%Vars%y, ModOut%Vars%y, ModOut%Xfr(iMod)%y, iy, ModOut%Vars%Ny) ! Output @@ -203,8 +194,8 @@ subroutine AddVariables(VarAryIn, VarAryOut, VarXfr, iVar, iVal) ! Loop through variables in original module do k = 1, size(VarAryIn) - ! If filter flag is not none and variable doesn't have flag, cycle - if (.not. MV_HasFlags(VarAryIn(k), FlagFilter) .and. FlagFilter /= VF_None) cycle + ! If variable doesn't have flag, cycle + if (.not. MV_HasFlags(VarAryIn(k), FlagFilter)) cycle associate (Var => VarAryOut(iVar)) @@ -414,7 +405,6 @@ subroutine ModD_AddModule(Mods, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ! Set module index in each variable ModData%Vars%x%iMod = iMod - ModData%Vars%xd%iMod = iMod ModData%Vars%z%iMod = iMod ModData%Vars%u%iMod = iMod ModData%Vars%y%iMod = iMod diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 18806cba0f..1e0b63e4a1 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -178,7 +178,6 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Allocate linearization arrays call AllocAry(m%ModGlue%Lin%x, m%ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%ModGlue%Lin%dx, m%ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%xd, m%ModGlue%Vars%Nxd, "xd", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%ModGlue%Lin%z, m%ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%ModGlue%Lin%u, m%ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%ModGlue%Lin%y, m%ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return @@ -193,7 +192,6 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Initialize arrays to store operating point states and input call AllocAry(y%Lin%x, m%ModGlue%Vars%Nx, p%Lin%NumTimes, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(y%Lin%xd, m%ModGlue%Vars%Nxd, p%Lin%NumTimes, "Lin%xd", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(y%Lin%z, m%ModGlue%Vars%Nz, p%Lin%NumTimes, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(y%Lin%u, m%ModGlue%Vars%Nu, p%Lin%NumTimes, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return @@ -507,7 +505,7 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j, k - integer(IntKi) :: ix, ixd, iz, iu, iy + integer(IntKi) :: ix, iz, iu, iy integer(IntKi) :: Un integer(IntKi) :: StateLinIndex, InputLinIndex character(200) :: SimStr @@ -552,7 +550,6 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob ! Initialize the index numbers ix = 1 - ixd = 1 iz = 1 iu = 1 iy = 1 @@ -588,7 +585,6 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob ! Copy module linearization arrays into glue linearization arrays if ((size(m%ModGlue%Lin%x) > 0) .and. allocated(ModData%Lin%x)) m%ModGlue%Lin%x(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%x if ((size(m%ModGlue%Lin%dx) > 0) .and. allocated(ModData%Lin%dx)) m%ModGlue%Lin%dx(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dx - if ((size(m%ModGlue%Lin%xd) > 0) .and. allocated(ModData%Lin%xd)) m%ModGlue%Lin%xd(ixd:ixd + ModData%Vars%Nxd - 1) = ModData%Lin%xd if ((size(m%ModGlue%Lin%z) > 0) .and. allocated(ModData%Lin%z)) m%ModGlue%Lin%z(iz:iz + ModData%Vars%Nz - 1) = ModData%Lin%z if ((size(m%ModGlue%Lin%u) > 0) .and. allocated(ModData%Lin%u)) m%ModGlue%Lin%u(iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%u if ((size(m%ModGlue%Lin%y) > 0) .and. allocated(ModData%Lin%y)) m%ModGlue%Lin%y(iy:iy + ModData%Vars%Ny - 1) = ModData%Lin%y @@ -601,7 +597,6 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob ! Increment starting index for next module ix = ix + ModData%Vars%Nx - ixd = ixd + ModData%Vars%Nxd iz = iz + ModData%Vars%Nz iu = iu + ModData%Vars%Nu iy = iy + ModData%Vars%Ny @@ -623,7 +618,6 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob ! Copy arrays into linearization operating points if (size(m%ModGlue%Lin%x) > 0) y%Lin%x(:, m%Lin%TimeIndex) = m%ModGlue%Lin%x - if (size(m%ModGlue%Lin%xd) > 0) y%Lin%xd(:, m%Lin%TimeIndex) = m%ModGlue%Lin%xd if (size(m%ModGlue%Lin%z) > 0) y%Lin%z(:, m%Lin%TimeIndex) = m%ModGlue%Lin%z if (size(m%ModGlue%Lin%u) > 0) y%Lin%u(:, m%Lin%TimeIndex) = m%ModGlue%Lin%u @@ -979,7 +973,7 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRoo ! Calculate number of values in variable after applying filter Nx = MV_NumVars(ModData%Vars%x, FilterFlag) - Nxd = MV_NumVars(ModData%Vars%xd, FilterFlag) + Nxd = 0 Nz = MV_NumVars(ModData%Vars%z, FilterFlag) Nu = MV_NumVars(ModData%Vars%u, FilterFlag) Ny = MV_NumVars(ModData%Vars%y, FilterFlag) @@ -1025,11 +1019,6 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRoo call WrLinFile_txt_Table(ModData%Vars%x, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%dx, IsDeriv=.true.) end if - if (Nxd > 0) then - write (Un, '(A)') 'Order of discrete states:' - call WrLinFile_txt_Table(ModData%Vars%xd, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%xd) - end if - if (Nz > 0) then write (Un, '(A)') 'Order of constraint states:' call WrLinFile_txt_Table(ModData%Vars%z, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%z) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 65bbe108e2..cab1b1450f 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -897,7 +897,8 @@ MODULE FAST_Types TYPE(ExtPtfm_Data) :: ExtPtfm !< Data for the ExtPtfm (external platform loading) module [-] END TYPE FAST_TurbineType ! ======================= -CONTAINS + +contains subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) type(FAST_VTK_BLSurfaceType), intent(in) :: SrcVTK_BLSurfaceTypeData diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index 719b0fa945..74e32241b8 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -33,10 +33,10 @@ typedef ^ ^ IntKi iVarSrc - 0 - typedef ^ ^ IntKi iVarDst - 0 - "Destination variable index" - typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - -typedef ^ ^ MeshLocType SrcMeshLoc - - - "Source mesh locator (number and indices)" - -typedef ^ ^ MeshLocType DstMeshLoc - - - "Destination mesh locator (number and indices)" - -typedef ^ ^ MeshLocType SrcDispMeshLoc - - - "Source displacement mesh locator (number and indices)" - -typedef ^ ^ MeshLocType DstDispMeshLoc - - - "Destination displacement mesh locator (number and indices)" - +typedef ^ ^ DatLoc SrcMeshLoc - - - "Source mesh locator (number and indices)" - +typedef ^ ^ DatLoc DstMeshLoc - - - "Destination mesh locator (number and indices)" - +typedef ^ ^ DatLoc SrcDispMeshLoc - - - "Source displacement mesh locator (number and indices)" - +typedef ^ ^ DatLoc DstDispMeshLoc - - - "Destination displacement mesh locator (number and indices)" - typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - @@ -98,17 +98,6 @@ typedef ^ ^ R8Ki StateRotation :: - - # Module Data #---------------------------------------------------------------------------------------------------------------------------------- -typedef ^ VarXfrType IntKi iVar - - - "" - -typedef ^ ^ IntKi NumVals - - - "" - -typedef ^ ^ IntKi iSrc 2 - - "" - -typedef ^ ^ IntKi iDst 2 - - "" - - -typedef ^ ModXfrType VarXfrType x : - - "" - -typedef ^ ^ VarXfrType xd : - - "" - -typedef ^ ^ VarXfrType z : - - "" - -typedef ^ ^ VarXfrType u : - - "" - -typedef ^ ^ VarXfrType y : - - "" - - typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - typedef ^ ^ IntKi ID - 0 - "Module identification number" - typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 57843e5dfc..f808d13835 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -52,10 +52,10 @@ MODULE Glue_Types INTEGER(IntKi) :: iVarDst = 0 !< Destination variable index [-] INTEGER(IntKi) :: SrcDispMeshID = 0 !< Source displacement mesh identifier [-] INTEGER(IntKi) :: DstDispMeshID = 0 !< Destination displacement mesh identifier [-] - TYPE(MeshLocType) :: SrcMeshLoc !< Source mesh locator (number and indices) [-] - TYPE(MeshLocType) :: DstMeshLoc !< Destination mesh locator (number and indices) [-] - TYPE(MeshLocType) :: SrcDispMeshLoc !< Source displacement mesh locator (number and indices) [-] - TYPE(MeshLocType) :: DstDispMeshLoc !< Destination displacement mesh locator (number and indices) [-] + TYPE(DatLoc) :: SrcMeshLoc !< Source mesh locator (number and indices) [-] + TYPE(DatLoc) :: DstMeshLoc !< Destination mesh locator (number and indices) [-] + TYPE(DatLoc) :: SrcDispMeshLoc !< Source displacement mesh locator (number and indices) [-] + TYPE(DatLoc) :: DstDispMeshLoc !< Destination displacement mesh locator (number and indices) [-] INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] @@ -113,23 +113,6 @@ MODULE Glue_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] END TYPE Glue_LinType ! ======================= -! ========= VarXfrType ======= - TYPE, PUBLIC :: VarXfrType - INTEGER(IntKi) :: iVar = 0_IntKi !< [-] - INTEGER(IntKi) :: NumVals = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iSrc = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iDst = 0_IntKi !< [-] - END TYPE VarXfrType -! ======================= -! ========= ModXfrType ======= - TYPE, PUBLIC :: ModXfrType - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: x !< [-] - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: xd !< [-] - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: z !< [-] - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: u !< [-] - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: y !< [-] - END TYPE ModXfrType -! ======================= ! ========= ModDataType ======= TYPE, PUBLIC :: ModDataType character(ChanLen) :: Abbr !< Module name abbreviation [-] @@ -298,7 +281,8 @@ MODULE Glue_Types LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] END TYPE Glue_MiscVarType ! ======================= -CONTAINS + +contains subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode, ErrStat, ErrMsg) type(MappingType), intent(inout) :: SrcMappingTypeData @@ -325,16 +309,16 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode DstMappingTypeData%iVarDst = SrcMappingTypeData%iVarDst DstMappingTypeData%SrcDispMeshID = SrcMappingTypeData%SrcDispMeshID DstMappingTypeData%DstDispMeshID = SrcMappingTypeData%DstDispMeshID - call NWTC_Library_CopyMeshLocType(SrcMappingTypeData%SrcMeshLoc, DstMappingTypeData%SrcMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcMeshLoc, DstMappingTypeData%SrcMeshLoc, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshLocType(SrcMappingTypeData%DstMeshLoc, DstMappingTypeData%DstMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%DstMeshLoc, DstMappingTypeData%DstMeshLoc, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshLocType(SrcMappingTypeData%SrcDispMeshLoc, DstMappingTypeData%SrcDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcDispMeshLoc, DstMappingTypeData%SrcDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshLocType(SrcMappingTypeData%DstDispMeshLoc, DstMappingTypeData%DstDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%DstDispMeshLoc, DstMappingTypeData%DstDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstMappingTypeData%MapType = SrcMappingTypeData%MapType @@ -396,13 +380,13 @@ subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyMappingType' ErrStat = ErrID_None ErrMsg = '' - call NWTC_Library_DestroyMeshLocType(MappingTypeData%SrcMeshLoc, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyDatLoc(MappingTypeData%SrcMeshLoc, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshLocType(MappingTypeData%DstMeshLoc, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyDatLoc(MappingTypeData%DstMeshLoc, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshLocType(MappingTypeData%SrcDispMeshLoc, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyDatLoc(MappingTypeData%SrcDispMeshLoc, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshLocType(MappingTypeData%DstDispMeshLoc, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyDatLoc(MappingTypeData%DstDispMeshLoc, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MeshDestroy( MappingTypeData%TmpLoadMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -435,10 +419,10 @@ subroutine Glue_PackMappingType(RF, Indata) call RegPack(RF, InData%iVarDst) call RegPack(RF, InData%SrcDispMeshID) call RegPack(RF, InData%DstDispMeshID) - call NWTC_Library_PackMeshLocType(RF, InData%SrcMeshLoc) - call NWTC_Library_PackMeshLocType(RF, InData%DstMeshLoc) - call NWTC_Library_PackMeshLocType(RF, InData%SrcDispMeshLoc) - call NWTC_Library_PackMeshLocType(RF, InData%DstDispMeshLoc) + call NWTC_Library_PackDatLoc(RF, InData%SrcMeshLoc) + call NWTC_Library_PackDatLoc(RF, InData%DstMeshLoc) + call NWTC_Library_PackDatLoc(RF, InData%SrcDispMeshLoc) + call NWTC_Library_PackDatLoc(RF, InData%DstDispMeshLoc) call RegPack(RF, InData%MapType) call RegPack(RF, InData%XfrType) call RegPack(RF, InData%XfrTypeAux) @@ -492,10 +476,10 @@ subroutine Glue_UnPackMappingType(RF, OutData) call RegUnpack(RF, OutData%iVarDst); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcDispMeshID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstDispMeshID); if (RegCheckErr(RF, RoutineName)) return - call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcMeshLoc) ! SrcMeshLoc - call NWTC_Library_UnpackMeshLocType(RF, OutData%DstMeshLoc) ! DstMeshLoc - call NWTC_Library_UnpackMeshLocType(RF, OutData%SrcDispMeshLoc) ! SrcDispMeshLoc - call NWTC_Library_UnpackMeshLocType(RF, OutData%DstDispMeshLoc) ! DstDispMeshLoc + call NWTC_Library_UnpackDatLoc(RF, OutData%SrcMeshLoc) ! SrcMeshLoc + call NWTC_Library_UnpackDatLoc(RF, OutData%DstMeshLoc) ! DstMeshLoc + call NWTC_Library_UnpackDatLoc(RF, OutData%SrcDispMeshLoc) ! SrcDispMeshLoc + call NWTC_Library_UnpackDatLoc(RF, OutData%DstDispMeshLoc) ! DstDispMeshLoc call RegUnpack(RF, OutData%MapType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%XfrType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%XfrTypeAux); if (RegCheckErr(RF, RoutineName)) return @@ -927,337 +911,6 @@ subroutine Glue_UnPackLinType(RF, OutData) call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Glue_CopyVarXfrType(SrcVarXfrTypeData, DstVarXfrTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarXfrType), intent(in) :: SrcVarXfrTypeData - type(VarXfrType), intent(inout) :: DstVarXfrTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Glue_CopyVarXfrType' - ErrStat = ErrID_None - ErrMsg = '' - DstVarXfrTypeData%iVar = SrcVarXfrTypeData%iVar - DstVarXfrTypeData%NumVals = SrcVarXfrTypeData%NumVals - DstVarXfrTypeData%iSrc = SrcVarXfrTypeData%iSrc - DstVarXfrTypeData%iDst = SrcVarXfrTypeData%iDst -end subroutine - -subroutine Glue_DestroyVarXfrType(VarXfrTypeData, ErrStat, ErrMsg) - type(VarXfrType), intent(inout) :: VarXfrTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Glue_DestroyVarXfrType' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine Glue_PackVarXfrType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(VarXfrType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Glue_PackVarXfrType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%iVar) - call RegPack(RF, InData%NumVals) - call RegPack(RF, InData%iSrc) - call RegPack(RF, InData%iDst) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_UnPackVarXfrType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(VarXfrType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Glue_UnPackVarXfrType' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumVals); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iSrc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iDst); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_CopyModXfrType(SrcModXfrTypeData, DstModXfrTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModXfrType), intent(in) :: SrcModXfrTypeData - type(ModXfrType), intent(inout) :: DstModXfrTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_CopyModXfrType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcModXfrTypeData%x)) then - LB(1:1) = lbound(SrcModXfrTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%x, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%x)) then - allocate(DstModXfrTypeData%x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call Glue_CopyVarXfrType(SrcModXfrTypeData%x(i1), DstModXfrTypeData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcModXfrTypeData%xd)) then - LB(1:1) = lbound(SrcModXfrTypeData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%xd, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%xd)) then - allocate(DstModXfrTypeData%xd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%xd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call Glue_CopyVarXfrType(SrcModXfrTypeData%xd(i1), DstModXfrTypeData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcModXfrTypeData%z)) then - LB(1:1) = lbound(SrcModXfrTypeData%z, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%z, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%z)) then - allocate(DstModXfrTypeData%z(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%z.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call Glue_CopyVarXfrType(SrcModXfrTypeData%z(i1), DstModXfrTypeData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcModXfrTypeData%u)) then - LB(1:1) = lbound(SrcModXfrTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%u, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%u)) then - allocate(DstModXfrTypeData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call Glue_CopyVarXfrType(SrcModXfrTypeData%u(i1), DstModXfrTypeData%u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcModXfrTypeData%y)) then - LB(1:1) = lbound(SrcModXfrTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%y, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%y)) then - allocate(DstModXfrTypeData%y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call Glue_CopyVarXfrType(SrcModXfrTypeData%y(i1), DstModXfrTypeData%y(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if -end subroutine - -subroutine Glue_DestroyModXfrType(ModXfrTypeData, ErrStat, ErrMsg) - type(ModXfrType), intent(inout) :: ModXfrTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_DestroyModXfrType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ModXfrTypeData%x)) then - LB(1:1) = lbound(ModXfrTypeData%x, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_DestroyVarXfrType(ModXfrTypeData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%x) - end if - if (allocated(ModXfrTypeData%xd)) then - LB(1:1) = lbound(ModXfrTypeData%xd, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_DestroyVarXfrType(ModXfrTypeData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%xd) - end if - if (allocated(ModXfrTypeData%z)) then - LB(1:1) = lbound(ModXfrTypeData%z, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_DestroyVarXfrType(ModXfrTypeData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%z) - end if - if (allocated(ModXfrTypeData%u)) then - LB(1:1) = lbound(ModXfrTypeData%u, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%u, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_DestroyVarXfrType(ModXfrTypeData%u(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%u) - end if - if (allocated(ModXfrTypeData%y)) then - LB(1:1) = lbound(ModXfrTypeData%y, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%y, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_DestroyVarXfrType(ModXfrTypeData%y(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%y) - end if -end subroutine - -subroutine Glue_PackModXfrType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ModXfrType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Glue_PackModXfrType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%x)) - if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_PackVarXfrType(RF, InData%x(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd)) - if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_PackVarXfrType(RF, InData%xd(i1)) - end do - end if - call RegPack(RF, allocated(InData%z)) - if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_PackVarXfrType(RF, InData%z(i1)) - end do - end if - call RegPack(RF, allocated(InData%u)) - if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_PackVarXfrType(RF, InData%u(i1)) - end do - end if - call RegPack(RF, allocated(InData%y)) - if (allocated(InData%y)) then - call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - LB(1:1) = lbound(InData%y, kind=B8Ki) - UB(1:1) = ubound(InData%y, kind=B8Ki) - do i1 = LB(1), UB(1) - call Glue_PackVarXfrType(RF, InData%y(i1)) - end do - end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_UnPackModXfrType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ModXfrType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Glue_UnPackModXfrType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%x)) deallocate(OutData%x) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call Glue_UnpackVarXfrType(RF, OutData%x(i1)) ! x - end do - end if - if (allocated(OutData%xd)) deallocate(OutData%xd) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call Glue_UnpackVarXfrType(RF, OutData%xd(i1)) ! xd - end do - end if - if (allocated(OutData%z)) deallocate(OutData%z) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call Glue_UnpackVarXfrType(RF, OutData%z(i1)) ! z - end do - end if - if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call Glue_UnpackVarXfrType(RF, OutData%u(i1)) ! u - end do - end if - if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call Glue_UnpackVarXfrType(RF, OutData%y(i1)) ! y - end do - end if -end subroutine - subroutine Glue_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) type(ModDataType), intent(in) :: SrcModDataTypeData type(ModDataType), intent(inout) :: DstModDataTypeData @@ -1289,7 +942,7 @@ subroutine Glue_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode end if end if do i1 = LB(1), UB(1) - call Glue_CopyModXfrType(SrcModDataTypeData%Xfr(i1), DstModDataTypeData%Xfr(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModXfrType(SrcModDataTypeData%Xfr(i1), DstModDataTypeData%Xfr(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -1339,7 +992,7 @@ subroutine Glue_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) LB(1:1) = lbound(ModDataTypeData%Xfr, kind=B8Ki) UB(1:1) = ubound(ModDataTypeData%Xfr, kind=B8Ki) do i1 = LB(1), UB(1) - call Glue_DestroyModXfrType(ModDataTypeData%Xfr(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModXfrType(ModDataTypeData%Xfr(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ModDataTypeData%Xfr) @@ -1381,7 +1034,7 @@ subroutine Glue_PackModDataType(RF, Indata) LB(1:1) = lbound(InData%Xfr, kind=B8Ki) UB(1:1) = ubound(InData%Xfr, kind=B8Ki) do i1 = LB(1), UB(1) - call Glue_PackModXfrType(RF, InData%Xfr(i1)) + call NWTC_Library_PackModXfrType(RF, InData%Xfr(i1)) end do end if call Glue_PackLinType(RF, InData%Lin) @@ -1435,7 +1088,7 @@ subroutine Glue_UnPackModDataType(RF, OutData) return end if do i1 = LB(1), UB(1) - call Glue_UnpackModXfrType(RF, OutData%Xfr(i1)) ! Xfr + call NWTC_Library_UnpackModXfrType(RF, OutData%Xfr(i1)) ! Xfr end do end if call Glue_UnpackLinType(RF, OutData%Lin) ! Lin diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index b67c105018..8a97bab68b 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -9,6 +9,7 @@ #include #include #include +#include std::string tolower(std::string s); @@ -308,6 +309,50 @@ struct DataType return true; } + void get_field_names_paths(const std::string &name_prefix, const std::string &path_prefix, int index_num, std::vector &fields) + { + // Loop through fields + for (const auto &field : this->fields) + { + std::string array_index; + switch (field.rank) + { + case 5: + array_index = ", DL%i" + std::to_string(index_num + 5) + array_index; + case 4: + array_index = ", DL%i" + std::to_string(index_num + 4) + array_index; + case 3: + array_index = ", DL%i" + std::to_string(index_num + 3) + array_index; + case 2: + array_index = ", DL%i" + std::to_string(index_num + 2) + array_index; + case 1: + array_index = "(DL%i" + std::to_string(index_num + 1) + array_index + ")"; + } + + // If field is not derived or it is a mesh + if (field.data_type->tag != Tag::Derived) + { + auto new_field = field; + new_field.name = name_prefix + "_" + field.name; + new_field.desc = path_prefix + "%" + field.name; + fields.push_back(new_field); + } + else if ((tolower(field.data_type->derived.name).compare("meshtype") == 0)) + { + auto new_field = field; + new_field.name = name_prefix + "_" + field.name; + new_field.desc = path_prefix + "%" + field.name + array_index; + fields.push_back(new_field); + } + else + { + field.data_type->derived.get_field_names_paths(name_prefix + "_" + field.name, + path_prefix + "%" + field.name + array_index, + index_num + field.rank, fields); + } + } + } + void get_mesh_names_paths(const std::string &name_prefix, const std::string &path_prefix, int index_num, std::vector &names, std::vector &paths) { // Loop through fields @@ -321,39 +366,29 @@ struct DataType auto &ddt = field.data_type->derived; + std::string array_index; + switch (field.rank) + { + case 3: + array_index = ", ML%i" + std::to_string(index_num + 3) + array_index; + case 2: + array_index = ", ML%i" + std::to_string(index_num + 2) + array_index; + case 1: + array_index = "(ML%i" + std::to_string(index_num + 1) + array_index + ")"; + } + // If this field is a mesh, add field name to vector // otherwise get mesh names within derived type if (tolower(ddt.name).compare("meshtype") == 0) { names.push_back(name_prefix + "_" + field.name); - std::string array_index; - switch (field.rank) - { - case 3: - array_index = ", ML%i" + std::to_string(index_num + 3) + array_index; - case 2: - array_index = ", ML%i" + std::to_string(index_num + 2) + array_index; - case 1: - array_index = "(ML%i" + std::to_string(index_num + 1) + array_index + ")"; - } paths.push_back(path_prefix + "%" + field.name + array_index); } else { - std::string array_index; - switch (field.rank) - { - case 3: - array_index = ", ML%i" + std::to_string(index_num + 3) + array_index; - case 2: - array_index = ", ML%i" + std::to_string(index_num + 2) + array_index; - case 1: - array_index = "(ML%i" + std::to_string(index_num + 1) + array_index + ")"; - } field.data_type->derived.get_mesh_names_paths(name_prefix + "_" + field.name, path_prefix + "%" + field.name + array_index, - index_num + field.rank, - names, paths); + index_num + field.rank, names, paths); } } } diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 90991a1b6d..d1d8c12dfb 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -292,7 +292,40 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) w << "! =======================\n"; } - w << "CONTAINS\n"; + int field_num = 0; + std::vector> field_params({ + {"ContinuousState", "x"}, + {"ConstraintState", "z"}, + {"Input", "u"}, + {"Output", "y"}, + }); + + for (const auto &tmp : field_params) + { + auto type_name = mod.nickname + "_" + tmp[0] + "Type"; + if (tolower(mod.name).compare("aerodyn") == 0) + { + type_name = std::string("Rot") + tmp[0] + "Type"; + } + auto it = mod.data_types.find(type_name); + if (it == mod.data_types.end()) + continue; + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::string prefix = mod.nickname + "_" + tmp[1]; + auto &ddt = it->second->derived; + std::vector fields; + ddt.get_field_names_paths(prefix, mod.nickname, 0, fields); + auto param_type = this->find_data_type("integer"); + for (const auto &field : fields) + { + ++field_num; + // w << " type(DatDesc), public, parameter :: " << std::setw(32) << std::left << field.name << " = DatDesc(" << field_num << ", " << field.rank << ", \"" << field.desc << "\")\n"; + w << " integer(IntKi), public, parameter :: " << std::setw(32) << std::left << field.name << " = " << std::setw(3) << std::right << field_num << " ! " << field.desc << "\n"; + } + } + + w << "\ncontains\n"; // Generate subroutines for this module this->gen_fortran_subs(w, mod); @@ -346,10 +379,18 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) gen_ExtrapInterp(w, mod, "InflowType", "DbKi", 1); } - // Loop through input and output types if in module - for (const auto &is_input : std::vector{true, false}) + // Subroutines to generate mesh pointer functions + for (const auto &tmp : std::vector>{ + {"Input", "u"}, + {"Output", "y"}, + }) { - auto it = mod.data_types.find(mod.nickname + (is_input ? "_InputType" : "_OutputType")); + auto type_name = mod.nickname + "_" + tmp[0] + "Type"; + if (tolower(mod.name).compare("aerodyn") == 0) + { + type_name = std::string("Rot") + tmp[0] + "Type"; + } + auto it = mod.data_types.find(type_name); if (it == mod.data_types.end()) { continue; @@ -357,17 +398,16 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) auto &ddt = it->second->derived; // Get mesh names in derived type or subtypes and add parameters for identifying the mesh - std::string u_or_y = is_input ? "u" : "y"; std::vector mesh_names, mesh_paths; - ddt.get_mesh_names_paths(mod.nickname + "_" + u_or_y, u_or_y, 0, mesh_names, mesh_paths); - std::string routine_name = mod.nickname + (is_input ? "_Input" : "_Output") + "MeshPointer"; + ddt.get_mesh_names_paths(mod.nickname + "_" + tmp[1], tmp[1], 0, mesh_names, mesh_paths); + std::string routine_name = mod.nickname + "_" + tmp[0] + "MeshPointer"; std::string indent("\n"); // Mesh pointer routine - w << indent << "function " << routine_name << "(" << u_or_y << ", ML) result(Mesh)"; + w << indent << "function " << routine_name << "(" << tmp[1] << ", ML) result(Mesh)"; indent += " "; - w << indent << "type(" << ddt.type_fortran << "), target, intent(in) :: " << u_or_y; - w << indent << "type(MeshLocType), intent(in) :: ML"; + w << indent << "type(" << ddt.type_fortran << "), target, intent(in) :: " << tmp[1]; + w << indent << "type(DatLoc), intent(in) :: ML"; w << indent << "type(MeshType), pointer :: Mesh"; w << indent << "nullify(Mesh)"; w << indent << "select case (ML%Num)"; @@ -383,22 +423,23 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) // Mesh name routine indent = "\n"; - routine_name = mod.nickname + (is_input ? "_Input" : "_Output") + "MeshName"; + routine_name = mod.nickname + "_" + tmp[0] + "MeshName"; w << indent << "function " << routine_name << "(ML) result(Name)"; indent += " "; - w << indent << "type(MeshLocType), intent(in) :: ML"; + w << indent << "type(DatLoc), intent(in) :: ML"; w << indent << "character(32) :: Name"; w << indent << "Name = \"\""; w << indent << "select case (ML%Num)"; for (int i = 0; i < mesh_paths.size(); ++i) { std::string new_path(mesh_paths[i]); - for (int j = 1; j < 5; ++j){ - auto ind_str = "ML%i"+std::to_string(j); + for (int j = 1; j < 5; ++j) + { + auto ind_str = "ML%i" + std::to_string(j); auto ind = new_path.find(ind_str); if (ind != std::string::npos) { - new_path = new_path.substr(0, ind) + "\"//trim(Num2LStr(" + ind_str + "))//\"" + new_path.substr(ind+5); + new_path = new_path.substr(0, ind) + "\"//trim(Num2LStr(" + ind_str + "))//\"" + new_path.substr(ind + 5); } } w << indent << "case (" << mesh_names[i] << ")"; @@ -409,6 +450,107 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) w << indent << "end function"; w << indent; } + + // Subroutines to pack and unpack variable type data + for (const auto &tmp : std::vector>{ + {"ContinuousState", "x", "ContState"}, + {"ConstraintState", "z", "ConstrState"}, + {"Input", "u", "Input"}, + {"Output", "y", "Output"}, + }) + { + auto type_name = mod.nickname + "_" + tmp[0] + "Type"; + if (tolower(mod.name).compare("aerodyn") == 0) + { + type_name = std::string("Rot") + tmp[0] + "Type"; + } + auto it = mod.data_types.find(type_name); + if (it == mod.data_types.end()) + continue; + auto &ddt = it->second->derived; + auto &abbr = tmp[1]; + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::vector fields; + ddt.get_field_names_paths(mod.nickname + "_" + abbr, abbr, 0, fields); + + // Array packing routine + std::string routine_name = mod.nickname + "_Pack" + tmp[2] + "Ary"; + std::string indent("\n"); + std::string var_str = std::string("Vars%") + abbr; + w << indent << "subroutine " << routine_name << "(Vars, " << abbr << ", ValAry)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), intent(in) :: " << abbr; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; + w << indent << "integer(IntKi) :: i"; + w << indent << "do i = 1, size(" << var_str << ")"; + indent += " "; + w << indent << "associate (Var => " << var_str << "(i), DL => " << var_str << "(i)%DL)"; + indent += " "; + w << indent << "select case (Var%DL%Num)"; + for (const auto &field : fields) + { + w << indent << "case (" << field.name << ")"; + std::string comment = "Scalar"; + auto field_path = field.desc; + if ((field.data_type->tag == DataType::Tag::Derived)) + { + comment = "Mesh"; + } + else if (field.rank > 0) + { + comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; + } + w << indent << " call MV_Pack2(Var, " << field_path << ", ValAry) ! " << comment; + } + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end associate"; + indent.erase(indent.size() - 3); + w << indent << "end do"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + // Array unpacking routine + routine_name = mod.nickname + "_Unpack" + tmp[2] + "Ary"; + indent = "\n"; + w << indent << "subroutine " << routine_name << "(Vars, ValAry, "<< abbr <<")"; + indent += " "; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << abbr; + w << indent << "integer(IntKi) :: i"; + w << indent << "do i = 1, size(" << var_str << ")"; + indent += " "; + w << indent << "associate (Var => " << var_str << "(i), DL => " << var_str << "(i)%DL)"; + indent += " "; + w << indent << "select case (Var%DL%Num)"; + for (const auto &field : fields) + { + w << indent << "case (" << field.name << ")"; + std::string comment = "Scalar"; + auto field_path = field.desc; + if ((field.data_type->tag == DataType::Tag::Derived)) + { + comment = "Mesh"; + } + else if (field.rank > 0) + { + comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; + } + w << indent << " call MV_Unpack2(Var, ValAry, " << field_path << ") ! " << comment; + } + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end associate"; + indent.erase(indent.size() - 3); + w << indent << "end do"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + } } void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, @@ -914,7 +1056,7 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt // If C code is generated, output code to initialize C object if (gen_c_code) { - w << indent << "if (associated("<< var <<")) then"; + w << indent << "if (associated(" << var << ")) then"; w << indent << " " << var_c << "_Len = size(" << var << ")"; w << indent << " " << "if (" << var_c << "_Len > 0) " << var_c << " = c_loc(" << var << "("; for (int d = 1; d <= field.rank; d++) diff --git a/modules/openfast-registry/src/registry_parse.cpp b/modules/openfast-registry/src/registry_parse.cpp index 4a5d979206..b0132ca2be 100644 --- a/modules/openfast-registry/src/registry_parse.cpp +++ b/modules/openfast-registry/src/registry_parse.cpp @@ -72,42 +72,20 @@ void Registry::parse(const std::string &file_name, const int recurse_level) this->use_modules.push_back(module_name); } - // If this is the root file - if (recurse_level == 0) + // If this is not the root file, return + if (recurse_level != 0) { - // Get the root module - std::shared_ptr mod; - for (auto &it : this->modules) - { - if (it.second->is_root) - { - mod = it.second; - break; - } - } - - int mesh_num = 0; + return; + } - // Loop through input and output types if in module - for (const auto &is_input : std::vector{true, false}) + // Get the root module + std::shared_ptr mod; + for (auto &it : this->modules) + { + if (it.second->is_root) { - auto it = mod->data_types.find(mod->nickname + (is_input ? "_InputType" : "_OutputType")); - if (it == mod->data_types.end()) - { - continue; - } - - // Get mesh names in derived type or subtypes and add parameters for identifying the mesh - std::string prefix = mod->nickname + (is_input ? "_u" : "_y"); - auto &ddt = it->second->derived; - std::vector mesh_names, mesh_paths; - ddt.get_mesh_names_paths(prefix, "", 0, mesh_names, mesh_paths); - auto param_type = this->find_data_type("integer"); - for (const auto &mesh_name: mesh_names) - { - ++mesh_num; - mod->params.push_back(Parameter(mesh_name, param_type, std::to_string(mesh_num), "Mesh number for " + mod->nickname + " " + mesh_name + " mesh", "")); - } + mod = it.second; + break; } } } diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 index 48b52da49b..44a03d5734 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 @@ -442,16 +442,14 @@ subroutine Orca_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Input variables !---------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%u, "PtfmMesh", MotionFields, & - VarIdx=p%iVarPtfmMeshU, & + call MV_AddMeshVar(p%Vars%u, "PtfmMesh", MotionFields, DatLoc(Orca_u_PtfmMesh), & Mesh=u%PtfmMesh) !---------------------------------------------------------------------------- ! Output variables !---------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, 'PtfmMesh', LoadFields, & - VarIdx=p%iVarPtfmMeshY, & + call MV_AddMeshVar(p%Vars%y, 'PtfmMesh', LoadFields, DatLoc(Orca_y_PtfmMesh), & Mesh=y%PtfmMesh) !---------------------------------------------------------------------------- diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 112c4892ba..288b88bda6 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -33,8 +33,6 @@ MODULE OrcaFlexInterface_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Orca_u_PtfmMesh = 1 ! Mesh number for Orca Orca_u_PtfmMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Orca_y_PtfmMesh = 2 ! Mesh number for Orca Orca_y_PtfmMesh mesh [-] ! ========= Orca_InitInputType ======= TYPE, PUBLIC :: Orca_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] @@ -113,7 +111,13 @@ MODULE OrcaFlexInterface_Types REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_ConstraintStateType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: Orca_x_Dummy = 1 ! Orca%Dummy + integer(IntKi), public, parameter :: Orca_z_DummyConstrState = 2 ! Orca%DummyConstrState + integer(IntKi), public, parameter :: Orca_u_PtfmMesh = 3 ! Orca%PtfmMesh + integer(IntKi), public, parameter :: Orca_y_PtfmMesh = 4 ! Orca%PtfmMesh + integer(IntKi), public, parameter :: Orca_y_WriteOutput = 5 ! Orca%WriteOutput + +contains subroutine Orca_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Orca_InitInputType), intent(in) :: SrcInitInputData @@ -1156,7 +1160,7 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E function Orca_InputMeshPointer(u, ML) result(Mesh) type(Orca_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1166,7 +1170,7 @@ function Orca_InputMeshPointer(u, ML) result(Mesh) end function function Orca_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1177,7 +1181,7 @@ function Orca_InputMeshName(ML) result(Name) function Orca_OutputMeshPointer(y, ML) result(Mesh) type(Orca_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1187,7 +1191,7 @@ function Orca_OutputMeshPointer(y, ML) result(Mesh) end function function Orca_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1195,5 +1199,129 @@ function Orca_OutputMeshName(ML) result(Name) Name = "y%PtfmMesh" end select end function + +subroutine Orca_PackContStateAry(Vars, x, ValAry) + type(Orca_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (Orca_x_Dummy) + call MV_Pack2(Var, x%Dummy, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Orca_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (Orca_x_Dummy) + call MV_Unpack2(Var, ValAry, x%Dummy) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Orca_PackConstrStateAry(Vars, z, ValAry) + type(Orca_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (Orca_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Orca_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (Orca_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine Orca_PackInputAry(Vars, u, ValAry) + type(Orca_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (Orca_u_PtfmMesh) + call MV_Pack2(Var, u%PtfmMesh, ValAry) ! Mesh + end select + end associate + end do +end subroutine + +subroutine Orca_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (Orca_u_PtfmMesh) + call MV_Unpack2(Var, ValAry, u%PtfmMesh) ! Mesh + end select + end associate + end do +end subroutine + +subroutine Orca_PackOutputAry(Vars, y, ValAry) + type(Orca_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (Orca_y_PtfmMesh) + call MV_Pack2(Var, y%PtfmMesh, ValAry) ! Mesh + case (Orca_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine Orca_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (Orca_y_PtfmMesh) + call MV_Unpack2(Var, ValAry, y%PtfmMesh) ! Mesh + case (Orca_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE OrcaFlexInterface_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 4a2917f3a2..1216965766 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -58,7 +58,8 @@ MODULE Current_Types REAL(SiKi) :: PCurrVyiPz0 = 0.0_R4Ki !< [-] END TYPE Current_InitOutputType ! ======================= -CONTAINS + +contains subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Current_InitInputType), intent(in) :: SrcInitInputData diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index a12fb92d61..66ccc623fd 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -105,7 +105,8 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] END TYPE SeaSt_WaveFieldType ! ======================= -CONTAINS + +contains subroutine SeaSt_WaveField_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_WaveField_ParameterType), intent(in) :: SrcParamData diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 159c4aad1b..34f2968200 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -492,8 +492,7 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS !---------------------------------------------------------------------------- ! Extended input - call MV_AddVar(p%Vars%u, "WaveElev0", FieldScalar, & - VarIdx=p%iVarWaveElev0U, & + call MV_AddVar(p%Vars%u, "WaveElev0", FieldScalar, DatLoc(SeaSt_u_WaveElev0), & Flags=VF_ExtLin, & Perturb=0.02_R8Ki * Pi / 180.0_R8Ki * max(1.0_R8Ki, p%WaveField%WtrDpth), & LinNames=['Extended input: wave elevation at platform ref point, m']) @@ -503,16 +502,13 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS !---------------------------------------------------------------------------- ! Extended output - call MV_AddVar(p%Vars%y, "WaveElev0", FieldScalar, & - VarIdx=p%iVarWaveElev0Y, & + call MV_AddVar(p%Vars%y, "WaveElev0", FieldScalar, DatLoc(SeaSt_y_WaveElev0), & Flags=VF_ExtLin, & LinNames=['Extended output: wave elevation at platform ref point, m']) - ! Output variables - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, Num=p%NumOuts, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(SeaSt_y_WriteOutput), Num=p%NumOuts, & Flags=VF_WriteOut, & - VarIdx=p%iVarWriteOutput, & LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) !---------------------------------------------------------------------------- @@ -842,10 +838,11 @@ subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, E real(R8Ki), allocatable, optional, intent(inout) :: dXddu(:,:) !< Partial derivatives of discrete state real(R8Ki), allocatable, optional, intent(inout) :: dZdu(:,:) !< Partial derivatives of constraint state + character(*), parameter :: RoutineName = 'SeaSt_JacobianPInput' integer(IntKi) :: idx_dY,idx_du,i integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_JacobianPInput' + integer(IntKi) :: iVar_u_WaveElev0, iVar_y_WaveElev0 ! Initialize ErrStat ErrStat = ErrID_None @@ -861,11 +858,15 @@ subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Initialize Jacobian to zero dYdu = 0.0_R8Ki + iVar_u_WaveElev0 = MV_FindVarDatLoc(p%Vars%u, SeaSt_u_WaveElev0) + iVar_y_WaveElev0 = MV_FindVarDatLoc(p%Vars%y, SeaSt_y_WaveElev0) + ! Extended input to extended output (direct pass-through) - dYdu(p%Vars%y(p%iVarWaveElev0Y)%iLoc(1), p%Vars%u(p%iVarWaveElev0U)%iLoc(1)) = 1.0_R8Ki + if (iVar_u_WaveElev0 > 0 .and. iVar_y_WaveElev0 > 0) then + dYdu(p%Vars%y(iVar_y_WaveElev0)%iLoc(1), p%Vars%u(iVar_u_WaveElev0)%iLoc(1)) = 1.0_R8Ki + end if ! It isn't possible to determine the relationship between the extended input and the WrOuts. So we leave them all zero. - endif ! No states or constraints, so deallocate any such matrices @@ -1048,7 +1049,9 @@ subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_ end if ! no regular inputs, only extended input - u_op(p%Vars%u(p%iVarWaveElev0U)%iLoc(1)) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + + ! WaveElev0 is zero to be consistent with linearization requirements + call MV_Pack2(p%Vars%u(1), 0.0_R8Ki, u_op) ! NOTE: if more extended inputs are added, place them here end if @@ -1058,11 +1061,10 @@ subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_ call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) if (Failed()) return end if - - ! no regular outputs, only extended output and WrOuts - y_op(p%Vars%y(p%iVarWaveElev0Y)%iLoc(1)) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements - call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, y_op) + ! WaveElev0 is zero to be consistent with linearization requirements + call MV_Pack2(p%Vars%y(1), 0.0_R8Ki, y_op) + call MV_Pack2(p%Vars%y(2), y%WriteOutput, y_op) end if diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 7702df698c..3e9ecd972d 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -18,6 +18,9 @@ usefrom Current.txt usefrom Waves.txt usefrom Waves2.txt usefrom SeaSt_WaveField.txt + +param SeaState/SeaSt - IntKi SeaSt_u_WaveElev0 - -1 - "WaveElev0 Extended input DatLoc number" - +param ^ - IntKi SeaSt_y_WaveElev0 - -2 - "WaveElev0 Extended output DatLoc number" - # # typedef SeaState/SeaSt SeaSt_InputFile LOGICAL EchoFlag - - - "Echo the input file" @@ -122,9 +125,6 @@ typedef ^ OtherStateType R8Ki Unu # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ^ IntKi iVarWaveElev0U - - - "Index of WaveElev0 input variable" - -typedef ^ ^ IntKi iVarWaveElev0Y - - - "Index of WaveElev0 output variable" - -typedef ^ ^ IntKi iVarWriteOutput - - - "Index of WriteOutput variable" - typedef ^ ^ DbKi WaveDT - - - "Wave DT" sec typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - typedef ^ ^ INTEGER NGrid 3 - - "Number of grid entries in x, y, and z" diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index d98278538b..dba6c60a71 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -37,6 +37,8 @@ MODULE SeaState_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: SeaSt_u_WaveElev0 = -1 ! WaveElev0 Extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SeaSt_y_WaveElev0 = -2 ! WaveElev0 Extended output DatLoc number [-] ! ========= SeaSt_InputFile ======= TYPE, PUBLIC :: SeaSt_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -140,9 +142,6 @@ MODULE SeaState_Types ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarWaveElev0U = 0_IntKi !< Index of WaveElev0 input variable [-] - INTEGER(IntKi) :: iVarWaveElev0Y = 0_IntKi !< Index of WaveElev0 output variable [-] - INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< Index of WriteOutput variable [-] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] @@ -186,7 +185,12 @@ MODULE SeaState_Types TYPE(SeaSt_OutputType) :: y_lin !< Output type for linearization perturbation [-] END TYPE SeaSt_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SeaSt_x_UnusedStates = 1 ! SeaSt%UnusedStates + integer(IntKi), public, parameter :: SeaSt_z_UnusedStates = 2 ! SeaSt%UnusedStates + integer(IntKi), public, parameter :: SeaSt_u_DummyInput = 3 ! SeaSt%DummyInput + integer(IntKi), public, parameter :: SeaSt_y_WriteOutput = 4 ! SeaSt%WriteOutput + +contains subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_InputFile), intent(in) :: SrcInputFileData @@ -919,9 +923,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarWaveElev0U = SrcParamData%iVarWaveElev0U - DstParamData%iVarWaveElev0Y = SrcParamData%iVarWaveElev0Y - DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput DstParamData%WaveDT = SrcParamData%WaveDT DstParamData%NGridPts = SrcParamData%NGridPts DstParamData%NGrid = SrcParamData%NGrid @@ -1089,9 +1090,6 @@ subroutine SeaSt_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarWaveElev0U) - call RegPack(RF, InData%iVarWaveElev0Y) - call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%WaveDT) call RegPack(RF, InData%NGridPts) call RegPack(RF, InData%NGrid) @@ -1158,9 +1156,6 @@ subroutine SeaSt_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarWaveElev0U); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWaveElev0Y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveDT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NGridPts); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NGrid); if (RegCheckErr(RF, RoutineName)) return @@ -1385,7 +1380,7 @@ subroutine SeaSt_UnPackMisc(RF, OutData) function SeaSt_InputMeshPointer(u, ML) result(Mesh) type(SeaSt_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1393,7 +1388,7 @@ function SeaSt_InputMeshPointer(u, ML) result(Mesh) end function function SeaSt_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1402,7 +1397,7 @@ function SeaSt_InputMeshName(ML) result(Name) function SeaSt_OutputMeshPointer(y, ML) result(Mesh) type(SeaSt_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1410,11 +1405,131 @@ function SeaSt_OutputMeshPointer(y, ML) result(Mesh) end function function SeaSt_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine SeaSt_PackContStateAry(Vars, x, ValAry) + type(SeaSt_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SeaSt_x_UnusedStates) + call MV_Pack2(Var, x%UnusedStates, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SeaSt_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SeaSt_x_UnusedStates) + call MV_Unpack2(Var, ValAry, x%UnusedStates) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SeaSt_PackConstrStateAry(Vars, z, ValAry) + type(SeaSt_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SeaSt_z_UnusedStates) + call MV_Pack2(Var, z%UnusedStates, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SeaSt_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SeaSt_z_UnusedStates) + call MV_Unpack2(Var, ValAry, z%UnusedStates) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SeaSt_PackInputAry(Vars, u, ValAry) + type(SeaSt_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SeaSt_u_DummyInput) + call MV_Pack2(Var, u%DummyInput, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SeaSt_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SeaSt_u_DummyInput) + call MV_Unpack2(Var, ValAry, u%DummyInput) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SeaSt_PackOutputAry(Vars, y, ValAry) + type(SeaSt_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SeaSt_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SeaSt_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SeaSt_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE SeaState_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index a8bd1b7ccf..ac9aa95039 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -56,7 +56,8 @@ MODULE Waves2_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2S !< Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] END TYPE Waves2_InitOutputType ! ======================= -CONTAINS + +contains subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Waves2_InitInputType), intent(in) :: SrcInitInputData diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 4cbea1da35..ca5550d38e 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -76,7 +76,8 @@ MODULE Waves_Types REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] END TYPE Waves_InitOutputType ! ======================= -CONTAINS + +contains subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Waves_InitInputType), intent(in) :: SrcInitInputData diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 1728af7469..5f20fef592 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -676,7 +676,8 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er do i = 1, p%NumBStC do j = 1, p%NumBl Desc = 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, FieldScalar, Num=6, & + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_BStC_StC_x), & + Num=6, & Flags=VF_DerivOrder2+VF_RotFrame, & LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & Perturb=xPerturb) @@ -686,7 +687,8 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ! Nacelle Structural Controller do j = 1, p%NumNStC Desc = 'Nacelle StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, FieldScalar, Num=6, & + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_NStC_StC_x), & + Num=6, & Flags=VF_DerivOrder2, & LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & Perturb=xPerturb) @@ -695,7 +697,8 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ! Tower Structural Controller do j = 1, p%NumTStC Desc = 'Tower StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, FieldScalar, Num=6, & + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_TStC_StC_x), & + Num=6, & Flags=VF_DerivOrder2, & LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & Perturb=xPerturb) @@ -704,7 +707,8 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er ! Substructure Structural Controller do j = 1, p%NumSStC Desc = 'Substructure StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, FieldScalar, Num=6, & + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_SStC_StC_x), & + Num=6, & Flags=VF_DerivOrder2, & LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & Perturb=xPerturb) @@ -718,16 +722,17 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er uPerturbAng = 0.2_R8Ki * Pi_R8 / 180.0_R8Ki uPerturbs = [uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng] - call MV_AddVar(p%Vars%u, "Yaw", FieldScalar, Flags=VF_2PI, VarIdx=p%iVarYaw, LinNames=['Yaw, rad']) + call MV_AddVar(p%Vars%u, "Yaw", FieldScalar, DatLoc(SrvD_u_Yaw), Flags=VF_2PI, LinNames=['Yaw, rad']) - call MV_AddVar(p%Vars%u, "YawRate", FieldScalar, VarIdx=p%iVarYawRate, LinNames=['YawRate, rad/s']) + call MV_AddVar(p%Vars%u, "YawRate", FieldScalar, DatLoc(SrvD_u_YawRate), LinNames=['YawRate, rad/s']) - call MV_AddVar(p%Vars%u, "HSS_Spd", FieldScalar, VarIdx=p%iVarHSS_Spd, LinNames=['HSS_Spd, rad/s']) + call MV_AddVar(p%Vars%u, "HSS_Spd", FieldScalar, DatLoc(SrvD_u_HSS_Spd), LinNames=['HSS_Spd, rad/s']) ! Structural controllers do j = 1, p%NumBStC do i = 1, p%NumBl call MV_AddMeshVar(p%Vars%u, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), MotionFields, & + DatLoc(SrvD_u_BStCMotionMesh, i, j), & Mesh=u%BStCMotionMesh(i, j), & Perturbs=uPerturbs) end do @@ -735,18 +740,21 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er do j = 1, p%NumNStC call MV_AddMeshVar(p%Vars%u, 'Nacelle StC '//Num2LStr(j), MotionFields, & + DatLoc(SrvD_u_NStCMotionMesh, j), & Mesh=u%NStCMotionMesh(j), & Perturbs=uPerturbs) enddo do j = 1, p%NumTStC call MV_AddMeshVar(p%Vars%u, 'Tower StC '//Num2LStr(j), MotionFields, & + DatLoc(SrvD_u_TStCMotionMesh, j), & Mesh=u%TStCMotionMesh(j), & Perturbs=uPerturbs) enddo do j = 1, p%NumSStC call MV_AddMeshVar(p%Vars%u, 'Substructure StC '//Num2LStr(j), MotionFields, & + DatLoc(SrvD_u_SStCMotionMesh, j), & Mesh=u%SStCMotionMesh(j), & Perturbs=uPerturbs) enddo @@ -756,75 +764,63 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er !---------------------------------------------------------------------------- call MV_AddVar(p%Vars%y, "BlPitchCom", FieldScalar, & - VarIdx=p%iVarBlPitchCom, & + DatLoc(SrvD_y_BlPitchCom), & Flags=VF_RotFrame + VF_2PI, & Num=size(y%BlPitchCom), & LinNames=[('BlPitchCom('//trim(Num2LStr(i))//'), rad', i = 1, size(y%BlPitchCom))]) call MV_AddVar(p%Vars%y, "YawMom", FieldScalar, & - VarIdx=p%iVarYawMom, & + DatLoc(SrvD_y_YawMom), & LinNames=['YawMom, Nm']) call MV_AddVar(p%Vars%y, "GenTrq", FieldScalar, & - VarIdx=p%iVarGenTrq, & + DatLoc(SrvD_y_GenTrq), & LinNames=['GenTrq, Nm']) call MV_AddVar(p%Vars%y, "ElecPwr", FieldScalar, & - VarIdx=p%iVarElecPwr, & + DatLoc(SrvD_y_ElecPwr), & LinNames=['ElecPwr, W']) ! Structural controllers if (p%NumBStC > 0) then - call AllocAry(p%iVarBStCLoadMesh, p%NumBl, p%NumBStC, "iVarBStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; do j = 1, p%NumBStC do i = 1, p%NumBl call MV_AddMeshVar(p%Vars%y, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), LoadFields, & - VarIdx=p%iVarBStCLoadMesh(i,j), & + DatLoc(SrvD_y_BStCLoadMesh, i, j), & Mesh=y%BStCLoadMesh(i,j)) end do end do end if if (p%NumNStC > 0) then - call AllocAry(p%iVarNStCLoadMesh, p%NumNStC, "iVarNStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; - p%iVarNStCLoadMesh = 0 do j = 1, p%NumNStC call MV_AddMeshVar(p%Vars%y, 'Nacelle StC '//Num2LStr(j), LoadFields, & - VarIdx=p%iVarNStCLoadMesh(j), & + DatLoc(SrvD_y_NStCLoadMesh, j), & Mesh=y%NStCLoadMesh(j)) enddo end if if (p%NumTStC > 0) then - call AllocAry(p%iVarTStCLoadMesh, p%NumTStC, "iVarTStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; - p%iVarTStCLoadMesh = 0 do j = 1, p%NumTStC call MV_AddMeshVar(p%Vars%y, 'Tower StC '//Num2LStr(j), LoadFields, & - VarIdx=p%iVarTStCLoadMesh(j), & + DatLoc(SrvD_y_TStCLoadMesh, j), & Mesh=y%TStCLoadMesh(j)) enddo end if if (p%NumSStC > 0) then - call AllocAry(p%iVarSStCLoadMesh, p%NumSStC, "iVarSStCLoadMesh", ErrStat2, ErrMsg2); if (Failed()) return; - p%iVarSStCLoadMesh = 0 do j = 1, p%NumSStC call MV_AddMeshVar(p%Vars%y, 'Substructure StC '//Num2LStr(j), LoadFields, & - VarIdx=p%iVarSStCLoadMesh(j), & + DatLoc(SrvD_y_SStCLoadMesh, j), & Mesh=y%SStCLoadMesh(j)) enddo end if ! Write Outputs - if (p%NumOuts > 0) then - p%iVarWriteOutput = size(p%Vars%y) + 1 - else - p%iVarWriteOutput = 0 - end if do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & + DatLoc(SrvD_y_WriteOutput), iAry=i, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & - iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units], & Active=(p%OutParam(i)%Indx > 0)) end do @@ -4546,46 +4542,46 @@ end function Failed subroutine Get_u_op() integer(IntKi) :: i, j, iVar - if (.not. allocated(u_op)) then - call AllocAry( u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2 ); if (Failed()) return - end if + ! if (.not. allocated(u_op)) then + ! call AllocAry( u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2 ); if (Failed()) return + ! end if - call MV_Pack(p%Vars%u, p%iVarYaw, u%Yaw, u_op) - call MV_Pack(p%Vars%u, p%iVarYawRate, u%YawRate, u_op) - call MV_Pack(p%Vars%u, p%iVarHSS_Spd, u%HSS_Spd, u_op) + ! call MV_Pack(p%Vars%u, p%iVarYaw, u%Yaw, u_op) + ! call MV_Pack(p%Vars%u, p%iVarYawRate, u%YawRate, u_op) + ! call MV_Pack(p%Vars%u, p%iVarHSS_Spd, u%HSS_Spd, u_op) - !--------------------- - ! StC related inputs - !--------------------- + ! !--------------------- + ! ! StC related inputs + ! !--------------------- - ! TODO: add variable indices for these meshes instead of manually counting - iVar = p%iVarHSS_Spd + 1 + ! ! TODO: add variable indices for these meshes instead of manually counting + ! iVar = p%iVarHSS_Spd + 1 - ! Blade - do j = 1, p%NumBStC - do i = 1, p%NumBl - call MV_Pack(p%Vars%u, iVar, u%BStCMotionMesh(i,j), u_op) - iVar = iVar + 6 - enddo - enddo + ! ! Blade + ! do j = 1, p%NumBStC + ! do i = 1, p%NumBl + ! call MV_Pack(p%Vars%u, iVar, u%BStCMotionMesh(i,j), u_op) + ! iVar = iVar + 6 + ! enddo + ! enddo - ! Nacelle - do j = 1, p%NumNStC - call MV_Pack(p%Vars%u, iVar, u%NStCMotionMesh(j), u_op) - iVar = iVar + 6 - enddo + ! ! Nacelle + ! do j = 1, p%NumNStC + ! call MV_Pack(p%Vars%u, iVar, u%NStCMotionMesh(j), u_op) + ! iVar = iVar + 6 + ! enddo - ! Tower - do j = 1, p%NumTStC - call MV_Pack(p%Vars%u, iVar, u%TStCMotionMesh(j), u_op) - iVar = iVar + 6 - enddo + ! ! Tower + ! do j = 1, p%NumTStC + ! call MV_Pack(p%Vars%u, iVar, u%TStCMotionMesh(j), u_op) + ! iVar = iVar + 6 + ! enddo - ! Sub-structure - do j = 1, p%NumSStC - call MV_Pack(p%Vars%u, iVar, u%SStCMotionMesh(j), u_op) - iVar = iVar + 6 - enddo + ! ! Sub-structure + ! do j = 1, p%NumSStC + ! call MV_Pack(p%Vars%u, iVar, u%SStCMotionMesh(j), u_op) + ! iVar = iVar + 6 + ! enddo end subroutine Get_u_op @@ -4593,145 +4589,145 @@ end subroutine Get_u_op subroutine Get_y_op() integer(IntKi) :: i,j,index_next - if (.not. allocated(y_op)) then - CALL AllocAry(y_op, p%Vars%ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - call MV_Pack(p%Vars%y, p%iVarBlPitchCom, y%BlPitchCom, y_op) - call MV_Pack(p%Vars%y, p%iVarYawMom, y%YawMom, y_op) - call MV_Pack(p%Vars%y, p%iVarGenTrq, y%GenTrq, y_op) - call MV_Pack(p%Vars%y, p%iVarElecPwr, y%ElecPwr, y_op) - - ! StC related outputs - do j = 1, p%NumBStC ! Blade - do i = 1, p%NumBl - call MV_Pack(p%Vars%y, p%iVarBStCLoadMesh(i,j), y%BStCLoadMesh(i,j), y_op) - enddo - enddo - do j = 1, p%NumNStC ! Nacelle - call MV_Pack(p%Vars%y, p%iVarNStCLoadMesh(j), y%NStCLoadMesh(j), y_op) - enddo - do j = 1, p%NumTStC ! Tower - call MV_Pack(p%Vars%y, p%iVarTStCLoadMesh(j), y%TStCLoadMesh(j), y_op) - enddo - do j = 1, p%NumSStC ! Sub-structure - call MV_Pack(p%Vars%y, p%iVarSStCLoadMesh(j), y%SStCLoadMesh(j), y_op) - enddo - - ! y%outputs - if (p%iVarWriteOutput > 0) then - do i = p%iVarWriteOutput, size(p%Vars%y) - call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1)), y_op) - end do - end if + ! if (.not. allocated(y_op)) then + ! CALL AllocAry(y_op, p%Vars%ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + ! end if + + ! call MV_Pack(p%Vars%y, p%iVarBlPitchCom, y%BlPitchCom, y_op) + ! call MV_Pack(p%Vars%y, p%iVarYawMom, y%YawMom, y_op) + ! call MV_Pack(p%Vars%y, p%iVarGenTrq, y%GenTrq, y_op) + ! call MV_Pack(p%Vars%y, p%iVarElecPwr, y%ElecPwr, y_op) + + ! ! StC related outputs + ! do j = 1, p%NumBStC ! Blade + ! do i = 1, p%NumBl + ! call MV_Pack(p%Vars%y, p%iVarBStCLoadMesh(i,j), y%BStCLoadMesh(i,j), y_op) + ! enddo + ! enddo + ! do j = 1, p%NumNStC ! Nacelle + ! call MV_Pack(p%Vars%y, p%iVarNStCLoadMesh(j), y%NStCLoadMesh(j), y_op) + ! enddo + ! do j = 1, p%NumTStC ! Tower + ! call MV_Pack(p%Vars%y, p%iVarTStCLoadMesh(j), y%TStCLoadMesh(j), y_op) + ! enddo + ! do j = 1, p%NumSStC ! Sub-structure + ! call MV_Pack(p%Vars%y, p%iVarSStCLoadMesh(j), y%SStCLoadMesh(j), y_op) + ! enddo + + ! ! y%outputs + ! if (p%iVarWriteOutput > 0) then + ! do i = p%iVarWriteOutput, size(p%Vars%y) + ! call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1)), y_op) + ! end do + ! end if end subroutine Get_y_op !> Get the operating point continuous states and pack subroutine Get_x_op() integer(IntKi) :: i,j,k,idx - if (.not. allocated(x_op)) then - CALL AllocAry( x_op, p%Jac_nx, 'x_op', ErrStat2, ErrMsg2 ) - if (Failed()) return; - end if - idx = 0 - do j=1,p%NumBStC ! Blade StC -- displacement and velocity state - do k=1,p%NumBl - x_op(idx+1) = x%BStC(j)%StC_x(1,k) ! x --> x%BStC(j)%StC_x(1,k) - x_op(idx+2) = x%BStC(j)%StC_x(3,k) ! y --> x%BStC(j)%StC_x(3,k) - x_op(idx+3) = x%BStC(j)%StC_x(5,k) ! z --> x%BStC(j)%StC_x(5,k) - x_op(idx+4) = x%BStC(j)%StC_x(2,k) ! dx/dt --> x%BStC(j)%StC_x(2,k) - x_op(idx+5) = x%BStC(j)%StC_x(4,k) ! dy/dt --> x%BStC(j)%StC_x(4,k) - x_op(idx+6) = x%BStC(j)%StC_x(6,k) ! dz/dt --> x%BStC(j)%StC_x(6,k) - idx = idx + 6 - enddo - enddo - do j=1,p%NumNStC ! Nacelle StC -- displacement and velocity state - x_op(idx+1) = x%NStC(j)%StC_x(1,1) ! x --> x%NStC(j)%StC_x(1,1) - x_op(idx+2) = x%NStC(j)%StC_x(3,1) ! y --> x%NStC(j)%StC_x(3,1) - x_op(idx+3) = x%NStC(j)%StC_x(5,1) ! z --> x%NStC(j)%StC_x(5,1) - x_op(idx+4) = x%NStC(j)%StC_x(2,1) ! dx/dt --> x%NStC(j)%StC_x(2,1) - x_op(idx+5) = x%NStC(j)%StC_x(4,1) ! dy/dt --> x%NStC(j)%StC_x(4,1) - x_op(idx+6) = x%NStC(j)%StC_x(6,1) ! dz/dt --> x%NStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - do j=1,p%NumTStC ! Tower StC -- displacement and velocity state - x_op(idx+1) = x%TStC(j)%StC_x(1,1) ! x --> x%TStC(j)%StC_x(1,1) - x_op(idx+2) = x%TStC(j)%StC_x(3,1) ! y --> x%TStC(j)%StC_x(3,1) - x_op(idx+3) = x%TStC(j)%StC_x(5,1) ! z --> x%TStC(j)%StC_x(5,1) - x_op(idx+4) = x%TStC(j)%StC_x(2,1) ! dx/dt --> x%TStC(j)%StC_x(2,1) - x_op(idx+5) = x%TStC(j)%StC_x(4,1) ! dy/dt --> x%TStC(j)%StC_x(4,1) - x_op(idx+6) = x%TStC(j)%StC_x(6,1) ! dz/dt --> x%TStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - do j=1,p%NumSStC ! Substructure StC -- displacement and velocity state - x_op(idx+1) = x%SStC(j)%StC_x(1,1) ! x --> x%SStC(j)%StC_x(1,1) - x_op(idx+2) = x%SStC(j)%StC_x(3,1) ! y --> x%SStC(j)%StC_x(3,1) - x_op(idx+3) = x%SStC(j)%StC_x(5,1) ! z --> x%SStC(j)%StC_x(5,1) - x_op(idx+4) = x%SStC(j)%StC_x(2,1) ! dx/dt --> x%SStC(j)%StC_x(2,1) - x_op(idx+5) = x%SStC(j)%StC_x(4,1) ! dy/dt --> x%SStC(j)%StC_x(4,1) - x_op(idx+6) = x%SStC(j)%StC_x(6,1) ! dz/dt --> x%SStC(j)%StC_x(6,1) - idx = idx + 6 - enddo + ! if (.not. allocated(x_op)) then + ! CALL AllocAry( x_op, p%Jac_nx, 'x_op', ErrStat2, ErrMsg2 ) + ! if (Failed()) return; + ! end if + ! idx = 0 + ! do j=1,p%NumBStC ! Blade StC -- displacement and velocity state + ! do k=1,p%NumBl + ! x_op(idx+1) = x%BStC(j)%StC_x(1,k) ! x --> x%BStC(j)%StC_x(1,k) + ! x_op(idx+2) = x%BStC(j)%StC_x(3,k) ! y --> x%BStC(j)%StC_x(3,k) + ! x_op(idx+3) = x%BStC(j)%StC_x(5,k) ! z --> x%BStC(j)%StC_x(5,k) + ! x_op(idx+4) = x%BStC(j)%StC_x(2,k) ! dx/dt --> x%BStC(j)%StC_x(2,k) + ! x_op(idx+5) = x%BStC(j)%StC_x(4,k) ! dy/dt --> x%BStC(j)%StC_x(4,k) + ! x_op(idx+6) = x%BStC(j)%StC_x(6,k) ! dz/dt --> x%BStC(j)%StC_x(6,k) + ! idx = idx + 6 + ! enddo + ! enddo + ! do j=1,p%NumNStC ! Nacelle StC -- displacement and velocity state + ! x_op(idx+1) = x%NStC(j)%StC_x(1,1) ! x --> x%NStC(j)%StC_x(1,1) + ! x_op(idx+2) = x%NStC(j)%StC_x(3,1) ! y --> x%NStC(j)%StC_x(3,1) + ! x_op(idx+3) = x%NStC(j)%StC_x(5,1) ! z --> x%NStC(j)%StC_x(5,1) + ! x_op(idx+4) = x%NStC(j)%StC_x(2,1) ! dx/dt --> x%NStC(j)%StC_x(2,1) + ! x_op(idx+5) = x%NStC(j)%StC_x(4,1) ! dy/dt --> x%NStC(j)%StC_x(4,1) + ! x_op(idx+6) = x%NStC(j)%StC_x(6,1) ! dz/dt --> x%NStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! do j=1,p%NumTStC ! Tower StC -- displacement and velocity state + ! x_op(idx+1) = x%TStC(j)%StC_x(1,1) ! x --> x%TStC(j)%StC_x(1,1) + ! x_op(idx+2) = x%TStC(j)%StC_x(3,1) ! y --> x%TStC(j)%StC_x(3,1) + ! x_op(idx+3) = x%TStC(j)%StC_x(5,1) ! z --> x%TStC(j)%StC_x(5,1) + ! x_op(idx+4) = x%TStC(j)%StC_x(2,1) ! dx/dt --> x%TStC(j)%StC_x(2,1) + ! x_op(idx+5) = x%TStC(j)%StC_x(4,1) ! dy/dt --> x%TStC(j)%StC_x(4,1) + ! x_op(idx+6) = x%TStC(j)%StC_x(6,1) ! dz/dt --> x%TStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! do j=1,p%NumSStC ! Substructure StC -- displacement and velocity state + ! x_op(idx+1) = x%SStC(j)%StC_x(1,1) ! x --> x%SStC(j)%StC_x(1,1) + ! x_op(idx+2) = x%SStC(j)%StC_x(3,1) ! y --> x%SStC(j)%StC_x(3,1) + ! x_op(idx+3) = x%SStC(j)%StC_x(5,1) ! z --> x%SStC(j)%StC_x(5,1) + ! x_op(idx+4) = x%SStC(j)%StC_x(2,1) ! dx/dt --> x%SStC(j)%StC_x(2,1) + ! x_op(idx+5) = x%SStC(j)%StC_x(4,1) ! dy/dt --> x%SStC(j)%StC_x(4,1) + ! x_op(idx+6) = x%SStC(j)%StC_x(6,1) ! dz/dt --> x%SStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo end subroutine Get_x_op !> Get the operating point continuous states derivatives and pack - !! rather than copy the logic in CalcContStateDeriv for the StCs, we'll just - !! call it directly + ! rather than copy the logic in CalcContStateDeriv for the StCs, we'll just + ! call it directly subroutine Get_dx_op() integer(IntKi) :: i,j,k,idx type(SrvD_ContinuousStateType) :: dx !< derivative of continuous states at operating point - if (.not. allocated(dx_op)) then - CALL AllocAry( dx_op, p%Jac_nx, 'dx_op', ErrStat2, ErrMsg2 ) - if (Failed()) return; - end if - call SrvD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - if (Failed()) then - call SrvD_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - idx = 0 - do j=1,p%NumBStC ! Blade StC -- displacement and velocity state - do k=1,p%NumBl - dx_op(idx+1) = dx%BStC(j)%StC_x(1,k) ! x --> dx%BStC(j)%StC_x(1,k) - dx_op(idx+2) = dx%BStC(j)%StC_x(3,k) ! y --> dx%BStC(j)%StC_x(3,k) - dx_op(idx+3) = dx%BStC(j)%StC_x(5,k) ! z --> dx%BStC(j)%StC_x(5,k) - dx_op(idx+4) = dx%BStC(j)%StC_x(2,k) ! dx/dt --> dx%BStC(j)%StC_x(2,k) - dx_op(idx+5) = dx%BStC(j)%StC_x(4,k) ! dy/dt --> dx%BStC(j)%StC_x(4,k) - dx_op(idx+6) = dx%BStC(j)%StC_x(6,k) ! dz/dt --> dx%BStC(j)%StC_x(6,k) - idx = idx + 6 - enddo - enddo - do j=1,p%NumNStC ! Nacelle StC -- displacement and velocity state - dx_op(idx+1) = dx%NStC(j)%StC_x(1,1) ! x --> dx%NStC(j)%StC_x(1,1) - dx_op(idx+2) = dx%NStC(j)%StC_x(3,1) ! y --> dx%NStC(j)%StC_x(3,1) - dx_op(idx+3) = dx%NStC(j)%StC_x(5,1) ! z --> dx%NStC(j)%StC_x(5,1) - dx_op(idx+4) = dx%NStC(j)%StC_x(2,1) ! dx/dt --> dx%NStC(j)%StC_x(2,1) - dx_op(idx+5) = dx%NStC(j)%StC_x(4,1) ! dy/dt --> dx%NStC(j)%StC_x(4,1) - dx_op(idx+6) = dx%NStC(j)%StC_x(6,1) ! dz/dt --> dx%NStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - do j=1,p%NumTStC ! Tower StC -- displacement and velocity state - dx_op(idx+1) = dx%TStC(j)%StC_x(1,1) ! x --> dx%TStC(j)%StC_x(1,1) - dx_op(idx+2) = dx%TStC(j)%StC_x(3,1) ! y --> dx%TStC(j)%StC_x(3,1) - dx_op(idx+3) = dx%TStC(j)%StC_x(5,1) ! z --> dx%TStC(j)%StC_x(5,1) - dx_op(idx+4) = dx%TStC(j)%StC_x(2,1) ! dx/dt --> dx%TStC(j)%StC_x(2,1) - dx_op(idx+5) = dx%TStC(j)%StC_x(4,1) ! dy/dt --> dx%TStC(j)%StC_x(4,1) - dx_op(idx+6) = dx%TStC(j)%StC_x(6,1) ! dz/dt --> dx%TStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - do j=1,p%NumSStC ! Substructure StC -- displacement and velocity state - dx_op(idx+1) = dx%SStC(j)%StC_x(1,1) ! x --> dx%SStC(j)%StC_x(1,1) - dx_op(idx+2) = dx%SStC(j)%StC_x(3,1) ! y --> dx%SStC(j)%StC_x(3,1) - dx_op(idx+3) = dx%SStC(j)%StC_x(5,1) ! z --> dx%SStC(j)%StC_x(5,1) - dx_op(idx+4) = dx%SStC(j)%StC_x(2,1) ! dx/dt --> dx%SStC(j)%StC_x(2,1) - dx_op(idx+5) = dx%SStC(j)%StC_x(4,1) ! dy/dt --> dx%SStC(j)%StC_x(4,1) - dx_op(idx+6) = dx%SStC(j)%StC_x(6,1) ! dz/dt --> dx%SStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - ! clean up - call SrvD_DestroyContState( dx, ErrStat2, ErrMsg2) + ! if (.not. allocated(dx_op)) then + ! CALL AllocAry( dx_op, p%Jac_nx, 'dx_op', ErrStat2, ErrMsg2 ) + ! if (Failed()) return; + ! end if + ! call SrvD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) + ! if (Failed()) then + ! call SrvD_DestroyContState( dx, ErrStat2, ErrMsg2) + ! return + ! end if + ! idx = 0 + ! do j=1,p%NumBStC ! Blade StC -- displacement and velocity state + ! do k=1,p%NumBl + ! dx_op(idx+1) = dx%BStC(j)%StC_x(1,k) ! x --> dx%BStC(j)%StC_x(1,k) + ! dx_op(idx+2) = dx%BStC(j)%StC_x(3,k) ! y --> dx%BStC(j)%StC_x(3,k) + ! dx_op(idx+3) = dx%BStC(j)%StC_x(5,k) ! z --> dx%BStC(j)%StC_x(5,k) + ! dx_op(idx+4) = dx%BStC(j)%StC_x(2,k) ! dx/dt --> dx%BStC(j)%StC_x(2,k) + ! dx_op(idx+5) = dx%BStC(j)%StC_x(4,k) ! dy/dt --> dx%BStC(j)%StC_x(4,k) + ! dx_op(idx+6) = dx%BStC(j)%StC_x(6,k) ! dz/dt --> dx%BStC(j)%StC_x(6,k) + ! idx = idx + 6 + ! enddo + ! enddo + ! do j=1,p%NumNStC ! Nacelle StC -- displacement and velocity state + ! dx_op(idx+1) = dx%NStC(j)%StC_x(1,1) ! x --> dx%NStC(j)%StC_x(1,1) + ! dx_op(idx+2) = dx%NStC(j)%StC_x(3,1) ! y --> dx%NStC(j)%StC_x(3,1) + ! dx_op(idx+3) = dx%NStC(j)%StC_x(5,1) ! z --> dx%NStC(j)%StC_x(5,1) + ! dx_op(idx+4) = dx%NStC(j)%StC_x(2,1) ! dx/dt --> dx%NStC(j)%StC_x(2,1) + ! dx_op(idx+5) = dx%NStC(j)%StC_x(4,1) ! dy/dt --> dx%NStC(j)%StC_x(4,1) + ! dx_op(idx+6) = dx%NStC(j)%StC_x(6,1) ! dz/dt --> dx%NStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! do j=1,p%NumTStC ! Tower StC -- displacement and velocity state + ! dx_op(idx+1) = dx%TStC(j)%StC_x(1,1) ! x --> dx%TStC(j)%StC_x(1,1) + ! dx_op(idx+2) = dx%TStC(j)%StC_x(3,1) ! y --> dx%TStC(j)%StC_x(3,1) + ! dx_op(idx+3) = dx%TStC(j)%StC_x(5,1) ! z --> dx%TStC(j)%StC_x(5,1) + ! dx_op(idx+4) = dx%TStC(j)%StC_x(2,1) ! dx/dt --> dx%TStC(j)%StC_x(2,1) + ! dx_op(idx+5) = dx%TStC(j)%StC_x(4,1) ! dy/dt --> dx%TStC(j)%StC_x(4,1) + ! dx_op(idx+6) = dx%TStC(j)%StC_x(6,1) ! dz/dt --> dx%TStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! do j=1,p%NumSStC ! Substructure StC -- displacement and velocity state + ! dx_op(idx+1) = dx%SStC(j)%StC_x(1,1) ! x --> dx%SStC(j)%StC_x(1,1) + ! dx_op(idx+2) = dx%SStC(j)%StC_x(3,1) ! y --> dx%SStC(j)%StC_x(3,1) + ! dx_op(idx+3) = dx%SStC(j)%StC_x(5,1) ! z --> dx%SStC(j)%StC_x(5,1) + ! dx_op(idx+4) = dx%SStC(j)%StC_x(2,1) ! dx/dt --> dx%SStC(j)%StC_x(2,1) + ! dx_op(idx+5) = dx%SStC(j)%StC_x(4,1) ! dy/dt --> dx%SStC(j)%StC_x(4,1) + ! dx_op(idx+6) = dx%SStC(j)%StC_x(6,1) ! dz/dt --> dx%SStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! ! clean up + ! call SrvD_DestroyContState( dx, ErrStat2, ErrMsg2) end subroutine Get_dx_op END SUBROUTINE SrvD_GetOP diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index ef158127fb..c82ac2917e 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -476,18 +476,6 @@ typedef ^ ParameterType ReKi PulseSpacing - - - "Distance between range gates typedef ^ ParameterType ReKi URefLid - - - "Reference average wind speed for the lidar" m/s # parameters for variables typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - -typedef ^ ParameterType IntKi iVarYaw - - - "Yaw Variable Index" - -typedef ^ ParameterType IntKi iVarYawRate - - - "YawRate Variable Index" - -typedef ^ ParameterType IntKi iVarHSS_Spd - - - "HSS_Spd Variable Index" - -typedef ^ ParameterType IntKi iVarBlPitchCom - - - "BlPitchCom Variable Index" - -typedef ^ ParameterType IntKi iVarYawMom - - - "YawMom Variable Index" - -typedef ^ ParameterType IntKi iVarGenTrq - - - "GenTrq Variable Index" - -typedef ^ ParameterType IntKi iVarElecPwr - - - "ElecPwr Variable Index" - -typedef ^ ParameterType IntKi iVarBStCLoadMesh :: - - "BStCLoadMesh Variable Index" - -typedef ^ ParameterType IntKi iVarNStCLoadMesh : - - "NStCLoadMesh Variable Index" - -typedef ^ ParameterType IntKi iVarTStCLoadMesh : - - "TStCLoadMesh Variable Index" - -typedef ^ ParameterType IntKi iVarSStCLoadMesh : - - "SStCLoadMesh Variable Index" - -typedef ^ ParameterType IntKi iVarWriteOutput - - - "WriteOutput Variable Index" - # ..... Inputs .................................................................................................................... diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 1e80d19be5..dfcc9d7a4c 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -34,15 +34,6 @@ MODULE ServoDyn_Types USE StrucCtrl_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_PtfmMotionMesh = 1 ! Mesh number for SrvD SrvD_u_PtfmMotionMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_BStCMotionMesh = 2 ! Mesh number for SrvD SrvD_u_BStCMotionMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_NStCMotionMesh = 3 ! Mesh number for SrvD SrvD_u_NStCMotionMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_TStCMotionMesh = 4 ! Mesh number for SrvD SrvD_u_TStCMotionMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_u_SStCMotionMesh = 5 ! Mesh number for SrvD SrvD_u_SStCMotionMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_y_BStCLoadMesh = 6 ! Mesh number for SrvD SrvD_y_BStCLoadMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_y_NStCLoadMesh = 7 ! Mesh number for SrvD SrvD_y_NStCLoadMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_y_TStCLoadMesh = 8 ! Mesh number for SrvD SrvD_y_TStCLoadMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SrvD_y_SStCLoadMesh = 9 ! Mesh number for SrvD SrvD_y_SStCLoadMesh mesh [-] ! ========= SrvD_InitInputType ======= TYPE, PUBLIC :: SrvD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] @@ -488,18 +479,6 @@ MODULE ServoDyn_Types REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - INTEGER(IntKi) :: iVarYaw = 0_IntKi !< Yaw Variable Index [-] - INTEGER(IntKi) :: iVarYawRate = 0_IntKi !< YawRate Variable Index [-] - INTEGER(IntKi) :: iVarHSS_Spd = 0_IntKi !< HSS_Spd Variable Index [-] - INTEGER(IntKi) :: iVarBlPitchCom = 0_IntKi !< BlPitchCom Variable Index [-] - INTEGER(IntKi) :: iVarYawMom = 0_IntKi !< YawMom Variable Index [-] - INTEGER(IntKi) :: iVarGenTrq = 0_IntKi !< GenTrq Variable Index [-] - INTEGER(IntKi) :: iVarElecPwr = 0_IntKi !< ElecPwr Variable Index [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iVarBStCLoadMesh !< BStCLoadMesh Variable Index [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarNStCLoadMesh !< NStCLoadMesh Variable Index [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarTStCLoadMesh !< TStCLoadMesh Variable Index [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iVarSStCLoadMesh !< SStCLoadMesh Variable Index [-] - INTEGER(IntKi) :: iVarWriteOutput = 0_IntKi !< WriteOutput Variable Index [-] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -605,7 +584,85 @@ MODULE ServoDyn_Types TYPE(SrvD_OutputType) :: y_lin !< Output for output in Jacobian routines [-] END TYPE SrvD_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SrvD_x_DummyContState = 1 ! SrvD%DummyContState + integer(IntKi), public, parameter :: SrvD_x_BStC_StC_x = 2 ! SrvD%BStC(DL%i1)%StC_x + integer(IntKi), public, parameter :: SrvD_x_NStC_StC_x = 3 ! SrvD%NStC(DL%i1)%StC_x + integer(IntKi), public, parameter :: SrvD_x_TStC_StC_x = 4 ! SrvD%TStC(DL%i1)%StC_x + integer(IntKi), public, parameter :: SrvD_x_SStC_StC_x = 5 ! SrvD%SStC(DL%i1)%StC_x + integer(IntKi), public, parameter :: SrvD_z_DummyConstrState = 6 ! SrvD%DummyConstrState + integer(IntKi), public, parameter :: SrvD_z_BStC_DummyConstrState = 7 ! SrvD%BStC(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: SrvD_z_NStC_DummyConstrState = 8 ! SrvD%NStC(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: SrvD_z_TStC_DummyConstrState = 9 ! SrvD%TStC(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: SrvD_z_SStC_DummyConstrState = 10 ! SrvD%SStC(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: SrvD_u_BlPitch = 11 ! SrvD%BlPitch + integer(IntKi), public, parameter :: SrvD_u_Yaw = 12 ! SrvD%Yaw + integer(IntKi), public, parameter :: SrvD_u_YawRate = 13 ! SrvD%YawRate + integer(IntKi), public, parameter :: SrvD_u_LSS_Spd = 14 ! SrvD%LSS_Spd + integer(IntKi), public, parameter :: SrvD_u_HSS_Spd = 15 ! SrvD%HSS_Spd + integer(IntKi), public, parameter :: SrvD_u_RotSpeed = 16 ! SrvD%RotSpeed + integer(IntKi), public, parameter :: SrvD_u_ExternalYawPosCom = 17 ! SrvD%ExternalYawPosCom + integer(IntKi), public, parameter :: SrvD_u_ExternalYawRateCom = 18 ! SrvD%ExternalYawRateCom + integer(IntKi), public, parameter :: SrvD_u_ExternalBlPitchCom = 19 ! SrvD%ExternalBlPitchCom + integer(IntKi), public, parameter :: SrvD_u_ExternalGenTrq = 20 ! SrvD%ExternalGenTrq + integer(IntKi), public, parameter :: SrvD_u_ExternalElecPwr = 21 ! SrvD%ExternalElecPwr + integer(IntKi), public, parameter :: SrvD_u_ExternalHSSBrFrac = 22 ! SrvD%ExternalHSSBrFrac + integer(IntKi), public, parameter :: SrvD_u_ExternalBlAirfoilCom = 23 ! SrvD%ExternalBlAirfoilCom + integer(IntKi), public, parameter :: SrvD_u_ExternalCableDeltaL = 24 ! SrvD%ExternalCableDeltaL + integer(IntKi), public, parameter :: SrvD_u_ExternalCableDeltaLdot = 25 ! SrvD%ExternalCableDeltaLdot + integer(IntKi), public, parameter :: SrvD_u_TwrAccel = 26 ! SrvD%TwrAccel + integer(IntKi), public, parameter :: SrvD_u_YawErr = 27 ! SrvD%YawErr + integer(IntKi), public, parameter :: SrvD_u_WindDir = 28 ! SrvD%WindDir + integer(IntKi), public, parameter :: SrvD_u_RootMyc = 29 ! SrvD%RootMyc + integer(IntKi), public, parameter :: SrvD_u_YawBrTAxp = 30 ! SrvD%YawBrTAxp + integer(IntKi), public, parameter :: SrvD_u_YawBrTAyp = 31 ! SrvD%YawBrTAyp + integer(IntKi), public, parameter :: SrvD_u_LSSTipPxa = 32 ! SrvD%LSSTipPxa + integer(IntKi), public, parameter :: SrvD_u_RootMxc = 33 ! SrvD%RootMxc + integer(IntKi), public, parameter :: SrvD_u_LSSTipMxa = 34 ! SrvD%LSSTipMxa + integer(IntKi), public, parameter :: SrvD_u_LSSTipMya = 35 ! SrvD%LSSTipMya + integer(IntKi), public, parameter :: SrvD_u_LSSTipMza = 36 ! SrvD%LSSTipMza + integer(IntKi), public, parameter :: SrvD_u_LSSTipMys = 37 ! SrvD%LSSTipMys + integer(IntKi), public, parameter :: SrvD_u_LSSTipMzs = 38 ! SrvD%LSSTipMzs + integer(IntKi), public, parameter :: SrvD_u_YawBrMyn = 39 ! SrvD%YawBrMyn + integer(IntKi), public, parameter :: SrvD_u_YawBrMzn = 40 ! SrvD%YawBrMzn + integer(IntKi), public, parameter :: SrvD_u_NcIMURAxs = 41 ! SrvD%NcIMURAxs + integer(IntKi), public, parameter :: SrvD_u_NcIMURAys = 42 ! SrvD%NcIMURAys + integer(IntKi), public, parameter :: SrvD_u_NcIMURAzs = 43 ! SrvD%NcIMURAzs + integer(IntKi), public, parameter :: SrvD_u_RotPwr = 44 ! SrvD%RotPwr + integer(IntKi), public, parameter :: SrvD_u_HorWindV = 45 ! SrvD%HorWindV + integer(IntKi), public, parameter :: SrvD_u_YawAngle = 46 ! SrvD%YawAngle + integer(IntKi), public, parameter :: SrvD_u_LSShftFxa = 47 ! SrvD%LSShftFxa + integer(IntKi), public, parameter :: SrvD_u_LSShftFys = 48 ! SrvD%LSShftFys + integer(IntKi), public, parameter :: SrvD_u_LSShftFzs = 49 ! SrvD%LSShftFzs + integer(IntKi), public, parameter :: SrvD_u_fromSC = 50 ! SrvD%fromSC + integer(IntKi), public, parameter :: SrvD_u_fromSCglob = 51 ! SrvD%fromSCglob + integer(IntKi), public, parameter :: SrvD_u_Lidar = 52 ! SrvD%Lidar + integer(IntKi), public, parameter :: SrvD_u_PtfmMotionMesh = 53 ! SrvD%PtfmMotionMesh + integer(IntKi), public, parameter :: SrvD_u_BStCMotionMesh = 54 ! SrvD%BStCMotionMesh(DL%i1, DL%i2) + integer(IntKi), public, parameter :: SrvD_u_NStCMotionMesh = 55 ! SrvD%NStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_TStCMotionMesh = 56 ! SrvD%TStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_SStCMotionMesh = 57 ! SrvD%SStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_LidSpeed = 58 ! SrvD%LidSpeed + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsX = 59 ! SrvD%MsrPositionsX + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsY = 60 ! SrvD%MsrPositionsY + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsZ = 61 ! SrvD%MsrPositionsZ + integer(IntKi), public, parameter :: SrvD_y_WriteOutput = 62 ! SrvD%WriteOutput + integer(IntKi), public, parameter :: SrvD_y_BlPitchCom = 63 ! SrvD%BlPitchCom + integer(IntKi), public, parameter :: SrvD_y_BlAirfoilCom = 64 ! SrvD%BlAirfoilCom + integer(IntKi), public, parameter :: SrvD_y_YawMom = 65 ! SrvD%YawMom + integer(IntKi), public, parameter :: SrvD_y_GenTrq = 66 ! SrvD%GenTrq + integer(IntKi), public, parameter :: SrvD_y_HSSBrTrqC = 67 ! SrvD%HSSBrTrqC + integer(IntKi), public, parameter :: SrvD_y_ElecPwr = 68 ! SrvD%ElecPwr + integer(IntKi), public, parameter :: SrvD_y_TBDrCon = 69 ! SrvD%TBDrCon + integer(IntKi), public, parameter :: SrvD_y_Lidar = 70 ! SrvD%Lidar + integer(IntKi), public, parameter :: SrvD_y_CableDeltaL = 71 ! SrvD%CableDeltaL + integer(IntKi), public, parameter :: SrvD_y_CableDeltaLdot = 72 ! SrvD%CableDeltaLdot + integer(IntKi), public, parameter :: SrvD_y_BStCLoadMesh = 73 ! SrvD%BStCLoadMesh(DL%i1, DL%i2) + integer(IntKi), public, parameter :: SrvD_y_NStCLoadMesh = 74 ! SrvD%NStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_TStCLoadMesh = 75 ! SrvD%TStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_SStCLoadMesh = 76 ! SrvD%SStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_toSC = 77 ! SrvD%toSC + +contains subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SrvD_InitInputType), intent(in) :: SrcInitInputData @@ -4316,62 +4373,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - DstParamData%iVarYaw = SrcParamData%iVarYaw - DstParamData%iVarYawRate = SrcParamData%iVarYawRate - DstParamData%iVarHSS_Spd = SrcParamData%iVarHSS_Spd - DstParamData%iVarBlPitchCom = SrcParamData%iVarBlPitchCom - DstParamData%iVarYawMom = SrcParamData%iVarYawMom - DstParamData%iVarGenTrq = SrcParamData%iVarGenTrq - DstParamData%iVarElecPwr = SrcParamData%iVarElecPwr - if (allocated(SrcParamData%iVarBStCLoadMesh)) then - LB(1:2) = lbound(SrcParamData%iVarBStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%iVarBStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstParamData%iVarBStCLoadMesh)) then - allocate(DstParamData%iVarBStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarBStCLoadMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarBStCLoadMesh = SrcParamData%iVarBStCLoadMesh - end if - if (allocated(SrcParamData%iVarNStCLoadMesh)) then - LB(1:1) = lbound(SrcParamData%iVarNStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarNStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstParamData%iVarNStCLoadMesh)) then - allocate(DstParamData%iVarNStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarNStCLoadMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarNStCLoadMesh = SrcParamData%iVarNStCLoadMesh - end if - if (allocated(SrcParamData%iVarTStCLoadMesh)) then - LB(1:1) = lbound(SrcParamData%iVarTStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarTStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstParamData%iVarTStCLoadMesh)) then - allocate(DstParamData%iVarTStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarTStCLoadMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarTStCLoadMesh = SrcParamData%iVarTStCLoadMesh - end if - if (allocated(SrcParamData%iVarSStCLoadMesh)) then - LB(1:1) = lbound(SrcParamData%iVarSStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iVarSStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstParamData%iVarSStCLoadMesh)) then - allocate(DstParamData%iVarSStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iVarSStCLoadMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iVarSStCLoadMesh = SrcParamData%iVarSStCLoadMesh - end if - DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput end subroutine subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -4504,18 +4505,6 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Vars) ParamData%Vars => null() end if - if (allocated(ParamData%iVarBStCLoadMesh)) then - deallocate(ParamData%iVarBStCLoadMesh) - end if - if (allocated(ParamData%iVarNStCLoadMesh)) then - deallocate(ParamData%iVarNStCLoadMesh) - end if - if (allocated(ParamData%iVarTStCLoadMesh)) then - deallocate(ParamData%iVarTStCLoadMesh) - end if - if (allocated(ParamData%iVarSStCLoadMesh)) then - deallocate(ParamData%iVarSStCLoadMesh) - end if end subroutine subroutine SrvD_PackParam(RF, Indata) @@ -4697,18 +4686,6 @@ subroutine SrvD_PackParam(RF, Indata) call NWTC_Library_PackModVarsType(RF, InData%Vars) end if end if - call RegPack(RF, InData%iVarYaw) - call RegPack(RF, InData%iVarYawRate) - call RegPack(RF, InData%iVarHSS_Spd) - call RegPack(RF, InData%iVarBlPitchCom) - call RegPack(RF, InData%iVarYawMom) - call RegPack(RF, InData%iVarGenTrq) - call RegPack(RF, InData%iVarElecPwr) - call RegPackAlloc(RF, InData%iVarBStCLoadMesh) - call RegPackAlloc(RF, InData%iVarNStCLoadMesh) - call RegPackAlloc(RF, InData%iVarTStCLoadMesh) - call RegPackAlloc(RF, InData%iVarSStCLoadMesh) - call RegPack(RF, InData%iVarWriteOutput) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -4925,18 +4902,6 @@ subroutine SrvD_UnPackParam(RF, OutData) else OutData%Vars => null() end if - call RegUnpack(RF, OutData%iVarYaw); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarYawRate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarHSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarBlPitchCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarYawMom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarGenTrq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarElecPwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarBStCLoadMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarNStCLoadMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarTStCLoadMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iVarSStCLoadMesh); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -7251,7 +7216,7 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E function SrvD_InputMeshPointer(u, ML) result(Mesh) type(SrvD_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -7269,7 +7234,7 @@ function SrvD_InputMeshPointer(u, ML) result(Mesh) end function function SrvD_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -7288,7 +7253,7 @@ function SrvD_InputMeshName(ML) result(Name) function SrvD_OutputMeshPointer(y, ML) result(Mesh) type(SrvD_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -7304,7 +7269,7 @@ function SrvD_OutputMeshPointer(y, ML) result(Mesh) end function function SrvD_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -7318,5 +7283,417 @@ function SrvD_OutputMeshName(ML) result(Name) Name = "y%SStCLoadMesh("//trim(Num2LStr(ML%i1))//")" end select end function + +subroutine SrvD_PackContStateAry(Vars, x, ValAry) + type(SrvD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SrvD_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + case (SrvD_x_BStC_StC_x) + call MV_Pack2(Var, x%BStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + call MV_Pack2(Var, x%NStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + call MV_Pack2(Var, x%TStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + call MV_Pack2(Var, x%SStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine SrvD_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SrvD_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + case (SrvD_x_BStC_StC_x) + call MV_Unpack2(Var, ValAry, x%BStC(DL%i1)%StC_x) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + call MV_Unpack2(Var, ValAry, x%NStC(DL%i1)%StC_x) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + call MV_Unpack2(Var, ValAry, x%TStC(DL%i1)%StC_x) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + call MV_Unpack2(Var, ValAry, x%SStC(DL%i1)%StC_x) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine SrvD_PackConstrStateAry(Vars, z, ValAry) + type(SrvD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SrvD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_BStC_DummyConstrState) + call MV_Pack2(Var, z%BStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_NStC_DummyConstrState) + call MV_Pack2(Var, z%NStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_TStC_DummyConstrState) + call MV_Pack2(Var, z%TStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_SStC_DummyConstrState) + call MV_Pack2(Var, z%SStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SrvD_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SrvD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + case (SrvD_z_BStC_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%BStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_NStC_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%NStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_TStC_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%TStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_SStC_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%SStC(DL%i1)%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SrvD_PackInputAry(Vars, u, ValAry) + type(SrvD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SrvD_u_BlPitch) + call MV_Pack2(Var, u%BlPitch, ValAry) ! Rank 1 Array + case (SrvD_u_Yaw) + call MV_Pack2(Var, u%Yaw, ValAry) ! Scalar + case (SrvD_u_YawRate) + call MV_Pack2(Var, u%YawRate, ValAry) ! Scalar + case (SrvD_u_LSS_Spd) + call MV_Pack2(Var, u%LSS_Spd, ValAry) ! Scalar + case (SrvD_u_HSS_Spd) + call MV_Pack2(Var, u%HSS_Spd, ValAry) ! Scalar + case (SrvD_u_RotSpeed) + call MV_Pack2(Var, u%RotSpeed, ValAry) ! Scalar + case (SrvD_u_ExternalYawPosCom) + call MV_Pack2(Var, u%ExternalYawPosCom, ValAry) ! Scalar + case (SrvD_u_ExternalYawRateCom) + call MV_Pack2(Var, u%ExternalYawRateCom, ValAry) ! Scalar + case (SrvD_u_ExternalBlPitchCom) + call MV_Pack2(Var, u%ExternalBlPitchCom, ValAry) ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + call MV_Pack2(Var, u%ExternalGenTrq, ValAry) ! Scalar + case (SrvD_u_ExternalElecPwr) + call MV_Pack2(Var, u%ExternalElecPwr, ValAry) ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + call MV_Pack2(Var, u%ExternalHSSBrFrac, ValAry) ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + call MV_Pack2(Var, u%ExternalBlAirfoilCom, ValAry) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + call MV_Pack2(Var, u%ExternalCableDeltaL, ValAry) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + call MV_Pack2(Var, u%ExternalCableDeltaLdot, ValAry) ! Rank 1 Array + case (SrvD_u_TwrAccel) + call MV_Pack2(Var, u%TwrAccel, ValAry) ! Scalar + case (SrvD_u_YawErr) + call MV_Pack2(Var, u%YawErr, ValAry) ! Scalar + case (SrvD_u_WindDir) + call MV_Pack2(Var, u%WindDir, ValAry) ! Scalar + case (SrvD_u_RootMyc) + call MV_Pack2(Var, u%RootMyc, ValAry) ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + call MV_Pack2(Var, u%YawBrTAxp, ValAry) ! Scalar + case (SrvD_u_YawBrTAyp) + call MV_Pack2(Var, u%YawBrTAyp, ValAry) ! Scalar + case (SrvD_u_LSSTipPxa) + call MV_Pack2(Var, u%LSSTipPxa, ValAry) ! Scalar + case (SrvD_u_RootMxc) + call MV_Pack2(Var, u%RootMxc, ValAry) ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + call MV_Pack2(Var, u%LSSTipMxa, ValAry) ! Scalar + case (SrvD_u_LSSTipMya) + call MV_Pack2(Var, u%LSSTipMya, ValAry) ! Scalar + case (SrvD_u_LSSTipMza) + call MV_Pack2(Var, u%LSSTipMza, ValAry) ! Scalar + case (SrvD_u_LSSTipMys) + call MV_Pack2(Var, u%LSSTipMys, ValAry) ! Scalar + case (SrvD_u_LSSTipMzs) + call MV_Pack2(Var, u%LSSTipMzs, ValAry) ! Scalar + case (SrvD_u_YawBrMyn) + call MV_Pack2(Var, u%YawBrMyn, ValAry) ! Scalar + case (SrvD_u_YawBrMzn) + call MV_Pack2(Var, u%YawBrMzn, ValAry) ! Scalar + case (SrvD_u_NcIMURAxs) + call MV_Pack2(Var, u%NcIMURAxs, ValAry) ! Scalar + case (SrvD_u_NcIMURAys) + call MV_Pack2(Var, u%NcIMURAys, ValAry) ! Scalar + case (SrvD_u_NcIMURAzs) + call MV_Pack2(Var, u%NcIMURAzs, ValAry) ! Scalar + case (SrvD_u_RotPwr) + call MV_Pack2(Var, u%RotPwr, ValAry) ! Scalar + case (SrvD_u_HorWindV) + call MV_Pack2(Var, u%HorWindV, ValAry) ! Scalar + case (SrvD_u_YawAngle) + call MV_Pack2(Var, u%YawAngle, ValAry) ! Scalar + case (SrvD_u_LSShftFxa) + call MV_Pack2(Var, u%LSShftFxa, ValAry) ! Scalar + case (SrvD_u_LSShftFys) + call MV_Pack2(Var, u%LSShftFys, ValAry) ! Scalar + case (SrvD_u_LSShftFzs) + call MV_Pack2(Var, u%LSShftFzs, ValAry) ! Scalar + case (SrvD_u_fromSC) + call MV_Pack2(Var, u%fromSC, ValAry) ! Rank 1 Array + case (SrvD_u_fromSCglob) + call MV_Pack2(Var, u%fromSCglob, ValAry) ! Rank 1 Array + case (SrvD_u_Lidar) + call MV_Pack2(Var, u%Lidar, ValAry) ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_Pack2(Var, u%PtfmMotionMesh, ValAry) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_Pack2(Var, u%BStCMotionMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_Pack2(Var, u%NStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_Pack2(Var, u%TStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_Pack2(Var, u%SStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_LidSpeed) + call MV_Pack2(Var, u%LidSpeed, ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + call MV_Pack2(Var, u%MsrPositionsX, ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + call MV_Pack2(Var, u%MsrPositionsY, ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + call MV_Pack2(Var, u%MsrPositionsZ, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SrvD_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SrvD_u_BlPitch) + call MV_Unpack2(Var, ValAry, u%BlPitch) ! Rank 1 Array + case (SrvD_u_Yaw) + call MV_Unpack2(Var, ValAry, u%Yaw) ! Scalar + case (SrvD_u_YawRate) + call MV_Unpack2(Var, ValAry, u%YawRate) ! Scalar + case (SrvD_u_LSS_Spd) + call MV_Unpack2(Var, ValAry, u%LSS_Spd) ! Scalar + case (SrvD_u_HSS_Spd) + call MV_Unpack2(Var, ValAry, u%HSS_Spd) ! Scalar + case (SrvD_u_RotSpeed) + call MV_Unpack2(Var, ValAry, u%RotSpeed) ! Scalar + case (SrvD_u_ExternalYawPosCom) + call MV_Unpack2(Var, ValAry, u%ExternalYawPosCom) ! Scalar + case (SrvD_u_ExternalYawRateCom) + call MV_Unpack2(Var, ValAry, u%ExternalYawRateCom) ! Scalar + case (SrvD_u_ExternalBlPitchCom) + call MV_Unpack2(Var, ValAry, u%ExternalBlPitchCom) ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + call MV_Unpack2(Var, ValAry, u%ExternalGenTrq) ! Scalar + case (SrvD_u_ExternalElecPwr) + call MV_Unpack2(Var, ValAry, u%ExternalElecPwr) ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + call MV_Unpack2(Var, ValAry, u%ExternalHSSBrFrac) ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + call MV_Unpack2(Var, ValAry, u%ExternalBlAirfoilCom) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + call MV_Unpack2(Var, ValAry, u%ExternalCableDeltaL) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + call MV_Unpack2(Var, ValAry, u%ExternalCableDeltaLdot) ! Rank 1 Array + case (SrvD_u_TwrAccel) + call MV_Unpack2(Var, ValAry, u%TwrAccel) ! Scalar + case (SrvD_u_YawErr) + call MV_Unpack2(Var, ValAry, u%YawErr) ! Scalar + case (SrvD_u_WindDir) + call MV_Unpack2(Var, ValAry, u%WindDir) ! Scalar + case (SrvD_u_RootMyc) + call MV_Unpack2(Var, ValAry, u%RootMyc) ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + call MV_Unpack2(Var, ValAry, u%YawBrTAxp) ! Scalar + case (SrvD_u_YawBrTAyp) + call MV_Unpack2(Var, ValAry, u%YawBrTAyp) ! Scalar + case (SrvD_u_LSSTipPxa) + call MV_Unpack2(Var, ValAry, u%LSSTipPxa) ! Scalar + case (SrvD_u_RootMxc) + call MV_Unpack2(Var, ValAry, u%RootMxc) ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + call MV_Unpack2(Var, ValAry, u%LSSTipMxa) ! Scalar + case (SrvD_u_LSSTipMya) + call MV_Unpack2(Var, ValAry, u%LSSTipMya) ! Scalar + case (SrvD_u_LSSTipMza) + call MV_Unpack2(Var, ValAry, u%LSSTipMza) ! Scalar + case (SrvD_u_LSSTipMys) + call MV_Unpack2(Var, ValAry, u%LSSTipMys) ! Scalar + case (SrvD_u_LSSTipMzs) + call MV_Unpack2(Var, ValAry, u%LSSTipMzs) ! Scalar + case (SrvD_u_YawBrMyn) + call MV_Unpack2(Var, ValAry, u%YawBrMyn) ! Scalar + case (SrvD_u_YawBrMzn) + call MV_Unpack2(Var, ValAry, u%YawBrMzn) ! Scalar + case (SrvD_u_NcIMURAxs) + call MV_Unpack2(Var, ValAry, u%NcIMURAxs) ! Scalar + case (SrvD_u_NcIMURAys) + call MV_Unpack2(Var, ValAry, u%NcIMURAys) ! Scalar + case (SrvD_u_NcIMURAzs) + call MV_Unpack2(Var, ValAry, u%NcIMURAzs) ! Scalar + case (SrvD_u_RotPwr) + call MV_Unpack2(Var, ValAry, u%RotPwr) ! Scalar + case (SrvD_u_HorWindV) + call MV_Unpack2(Var, ValAry, u%HorWindV) ! Scalar + case (SrvD_u_YawAngle) + call MV_Unpack2(Var, ValAry, u%YawAngle) ! Scalar + case (SrvD_u_LSShftFxa) + call MV_Unpack2(Var, ValAry, u%LSShftFxa) ! Scalar + case (SrvD_u_LSShftFys) + call MV_Unpack2(Var, ValAry, u%LSShftFys) ! Scalar + case (SrvD_u_LSShftFzs) + call MV_Unpack2(Var, ValAry, u%LSShftFzs) ! Scalar + case (SrvD_u_fromSC) + call MV_Unpack2(Var, ValAry, u%fromSC) ! Rank 1 Array + case (SrvD_u_fromSCglob) + call MV_Unpack2(Var, ValAry, u%fromSCglob) ! Rank 1 Array + case (SrvD_u_Lidar) + call MV_Unpack2(Var, ValAry, u%Lidar) ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_Unpack2(Var, ValAry, u%PtfmMotionMesh) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_Unpack2(Var, ValAry, u%BStCMotionMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_Unpack2(Var, ValAry, u%NStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_Unpack2(Var, ValAry, u%TStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_Unpack2(Var, ValAry, u%SStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_LidSpeed) + call MV_Unpack2(Var, ValAry, u%LidSpeed) ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + call MV_Unpack2(Var, ValAry, u%MsrPositionsX) ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + call MV_Unpack2(Var, ValAry, u%MsrPositionsY) ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + call MV_Unpack2(Var, ValAry, u%MsrPositionsZ) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SrvD_PackOutputAry(Vars, y, ValAry) + type(SrvD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SrvD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (SrvD_y_BlPitchCom) + call MV_Pack2(Var, y%BlPitchCom, ValAry) ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + call MV_Pack2(Var, y%BlAirfoilCom, ValAry) ! Rank 1 Array + case (SrvD_y_YawMom) + call MV_Pack2(Var, y%YawMom, ValAry) ! Scalar + case (SrvD_y_GenTrq) + call MV_Pack2(Var, y%GenTrq, ValAry) ! Scalar + case (SrvD_y_HSSBrTrqC) + call MV_Pack2(Var, y%HSSBrTrqC, ValAry) ! Scalar + case (SrvD_y_ElecPwr) + call MV_Pack2(Var, y%ElecPwr, ValAry) ! Scalar + case (SrvD_y_TBDrCon) + call MV_Pack2(Var, y%TBDrCon, ValAry) ! Rank 1 Array + case (SrvD_y_Lidar) + call MV_Pack2(Var, y%Lidar, ValAry) ! Rank 1 Array + case (SrvD_y_CableDeltaL) + call MV_Pack2(Var, y%CableDeltaL, ValAry) ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + call MV_Pack2(Var, y%CableDeltaLdot, ValAry) ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_Pack2(Var, y%BStCLoadMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_Pack2(Var, y%NStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_Pack2(Var, y%TStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_Pack2(Var, y%SStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_toSC) + call MV_Pack2(Var, y%toSC, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SrvD_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SrvD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (SrvD_y_BlPitchCom) + call MV_Unpack2(Var, ValAry, y%BlPitchCom) ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + call MV_Unpack2(Var, ValAry, y%BlAirfoilCom) ! Rank 1 Array + case (SrvD_y_YawMom) + call MV_Unpack2(Var, ValAry, y%YawMom) ! Scalar + case (SrvD_y_GenTrq) + call MV_Unpack2(Var, ValAry, y%GenTrq) ! Scalar + case (SrvD_y_HSSBrTrqC) + call MV_Unpack2(Var, ValAry, y%HSSBrTrqC) ! Scalar + case (SrvD_y_ElecPwr) + call MV_Unpack2(Var, ValAry, y%ElecPwr) ! Scalar + case (SrvD_y_TBDrCon) + call MV_Unpack2(Var, ValAry, y%TBDrCon) ! Rank 1 Array + case (SrvD_y_Lidar) + call MV_Unpack2(Var, ValAry, y%Lidar) ! Rank 1 Array + case (SrvD_y_CableDeltaL) + call MV_Unpack2(Var, ValAry, y%CableDeltaL) ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + call MV_Unpack2(Var, ValAry, y%CableDeltaLdot) ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_Unpack2(Var, ValAry, y%BStCLoadMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_Unpack2(Var, ValAry, y%NStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_Unpack2(Var, ValAry, y%TStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_Unpack2(Var, ValAry, y%SStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_toSC) + call MV_Unpack2(Var, ValAry, y%toSC) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE ServoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 4e1ed7170a..f401cb9c57 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -33,8 +33,6 @@ MODULE StrucCtrl_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: StC_u_Mesh = 1 ! Mesh number for StC StC_u_Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: StC_y_Mesh = 2 ! Mesh number for StC StC_y_Mesh mesh [-] ! ========= StC_InputFile ======= TYPE, PUBLIC :: StC_InputFile CHARACTER(1024) :: StCFileName !< Name of the input file; remove if there is no file [-] @@ -250,7 +248,18 @@ MODULE StrucCtrl_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MeasVel !< StC measured relative velocity of tmd mass (local coordinates) signal to controller [m/s] END TYPE StC_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: StC_x_StC_x = 1 ! StC%StC_x + integer(IntKi), public, parameter :: StC_z_DummyConstrState = 2 ! StC%DummyConstrState + integer(IntKi), public, parameter :: StC_u_Mesh = 3 ! StC%Mesh(DL%i1) + integer(IntKi), public, parameter :: StC_u_CmdStiff = 4 ! StC%CmdStiff + integer(IntKi), public, parameter :: StC_u_CmdDamp = 5 ! StC%CmdDamp + integer(IntKi), public, parameter :: StC_u_CmdBrake = 6 ! StC%CmdBrake + integer(IntKi), public, parameter :: StC_u_CmdForce = 7 ! StC%CmdForce + integer(IntKi), public, parameter :: StC_y_Mesh = 8 ! StC%Mesh(DL%i1) + integer(IntKi), public, parameter :: StC_y_MeasDisp = 9 ! StC%MeasDisp + integer(IntKi), public, parameter :: StC_y_MeasVel = 10 ! StC%MeasVel + +contains subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(StC_InputFile), intent(in) :: SrcInputFileData @@ -2305,7 +2314,7 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er function StC_InputMeshPointer(u, ML) result(Mesh) type(StC_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2315,7 +2324,7 @@ function StC_InputMeshPointer(u, ML) result(Mesh) end function function StC_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2326,7 +2335,7 @@ function StC_InputMeshName(ML) result(Name) function StC_OutputMeshPointer(y, ML) result(Mesh) type(StC_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2336,7 +2345,7 @@ function StC_OutputMeshPointer(y, ML) result(Mesh) end function function StC_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2344,5 +2353,149 @@ function StC_OutputMeshName(ML) result(Name) Name = "y%Mesh("//trim(Num2LStr(ML%i1))//")" end select end function + +subroutine StC_PackContStateAry(Vars, x, ValAry) + type(StC_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (StC_x_StC_x) + call MV_Pack2(Var, x%StC_x, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine StC_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (StC_x_StC_x) + call MV_Unpack2(Var, ValAry, x%StC_x) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine StC_PackConstrStateAry(Vars, z, ValAry) + type(StC_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (StC_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine StC_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (StC_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine StC_PackInputAry(Vars, u, ValAry) + type(StC_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (StC_u_Mesh) + call MV_Pack2(Var, u%Mesh(DL%i1), ValAry) ! Mesh + case (StC_u_CmdStiff) + call MV_Pack2(Var, u%CmdStiff, ValAry) ! Rank 2 Array + case (StC_u_CmdDamp) + call MV_Pack2(Var, u%CmdDamp, ValAry) ! Rank 2 Array + case (StC_u_CmdBrake) + call MV_Pack2(Var, u%CmdBrake, ValAry) ! Rank 2 Array + case (StC_u_CmdForce) + call MV_Pack2(Var, u%CmdForce, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine StC_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (StC_u_Mesh) + call MV_Unpack2(Var, ValAry, u%Mesh(DL%i1)) ! Mesh + case (StC_u_CmdStiff) + call MV_Unpack2(Var, ValAry, u%CmdStiff) ! Rank 2 Array + case (StC_u_CmdDamp) + call MV_Unpack2(Var, ValAry, u%CmdDamp) ! Rank 2 Array + case (StC_u_CmdBrake) + call MV_Unpack2(Var, ValAry, u%CmdBrake) ! Rank 2 Array + case (StC_u_CmdForce) + call MV_Unpack2(Var, ValAry, u%CmdForce) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine StC_PackOutputAry(Vars, y, ValAry) + type(StC_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (StC_y_Mesh) + call MV_Pack2(Var, y%Mesh(DL%i1), ValAry) ! Mesh + case (StC_y_MeasDisp) + call MV_Pack2(Var, y%MeasDisp, ValAry) ! Rank 2 Array + case (StC_y_MeasVel) + call MV_Pack2(Var, y%MeasVel, ValAry) ! Rank 2 Array + end select + end associate + end do +end subroutine + +subroutine StC_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (StC_y_Mesh) + call MV_Unpack2(Var, ValAry, y%Mesh(DL%i1)) ! Mesh + case (StC_y_MeasDisp) + call MV_Unpack2(Var, ValAry, y%MeasDisp) ! Rank 2 Array + case (StC_y_MeasVel) + call MV_Unpack2(Var, ValAry, y%MeasVel) ! Rank 2 Array + end select + end associate + end do +end subroutine END MODULE StrucCtrl_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 720eec0b47..22e97d2477 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -48,8 +48,6 @@ Module SubDyn PUBLIC :: SD_JacobianPConstrState ! PUBLIC :: SD_GetOP ! PUBLIC :: SD_ProgDesc - PUBLIC :: SD_PackStateOP, SD_PackInputOP, SD_PackOutputOP - PUBLIC :: SD_UnpackStateOP, SD_UnpackInputOP CONTAINS @@ -450,11 +448,15 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Continuous State Variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%x, "Modes", FieldScalar, p%nDOFM, jUsr=1, DerivOrder=0, & + call MV_AddVar(p%Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qm), & + Num=p%nDOFM, & + DerivOrder=0, & Perturb=2.0_ReKi*D2R_D, & LinNames=[('Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -', i=1, p%nDOFM)]) - call MV_AddVar(p%Vars%x, "Modes", FieldScalar, p%nDOFM, jUsr=2, DerivOrder=1, & + call MV_AddVar(p%Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qmdot), & + Num=p%nDOFM, & + DerivOrder=0, & Perturb=2.0_ReKi*D2R_D, & LinNames=[('First time derivative of Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -/s', i=1, p%nDOFM)]) @@ -467,16 +469,17 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) maxDim = max(dx, dy, dz) - call MV_AddMeshVar(p%Vars%u, "TPMesh", MotionFields, Mesh=u%TPMesh, & - VarIdx=p%iVarTPMesh, & + call MV_AddMeshVar(p%Vars%u, "TPMesh", MotionFields, DatLoc(SD_u_TPMesh), & + Mesh=u%TPMesh, & Perturbs=[2.0_R8Ki*D2R_D, & ! TranslationDisp 2.0_R8Ki*D2R_D, & ! Orientation 2.0_R8Ki*D2R_D, & ! TranslationVel 2.0_R8Ki*D2R_D, & ! RotationVel 2.0_R8Ki*D2R_D, & ! TranslationAcc 2.0_R8Ki*D2R_D]) ! RotationAcc - call MV_AddMeshVar(p%Vars%u, "LMesh", LoadFields, Mesh=u%LMesh, & - VarIdx=p%iVarLMesh, & + + call MV_AddMeshVar(p%Vars%u, "LMesh", LoadFields, DatLoc(SD_u_LMesh), & + Mesh=u%LMesh, & Perturbs=[170*maxDim**2, 14*maxDim**3]) ! Force, Moment !---------------------------------------------------------------------------- @@ -484,20 +487,14 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! Mesh variables - call MV_AddMeshVar(p%Vars%y, 'Y1Mesh', LoadFields, & - VarIdx=p%iVarY1Mesh, & - Mesh=y%Y1Mesh) - call MV_AddMeshVar(p%Vars%y, 'Y2Mesh', MotionFields, & - VarIdx=p%iVarY2Mesh, & - Mesh=y%Y2Mesh) - call MV_AddMeshVar(p%Vars%y, 'Y3Mesh', MotionFields, & - VarIdx=p%iVarY3Mesh, & - Mesh=y%Y3Mesh) + call MV_AddMeshVar(p%Vars%y, 'Y1Mesh', LoadFields, DatLoc(SD_y_Y1Mesh), Mesh=y%Y1Mesh) + call MV_AddMeshVar(p%Vars%y, 'Y2Mesh', MotionFields, DatLoc(SD_y_Y2Mesh), Mesh=y%Y2Mesh) + call MV_AddMeshVar(p%Vars%y, 'Y3Mesh', MotionFields, DatLoc(SD_y_Y3Mesh), Mesh=y%Y3Mesh) ! Output variables - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, Num=p%NumOuts, & + call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(SD_y_WriteOutput), & + Num=p%NumOuts, & Flags=VF_WriteOut, & - VarIdx=p%iVarWriteOutput, & LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) !---------------------------------------------------------------------------- @@ -527,16 +524,16 @@ subroutine SD_PackStateOP(p, x, op) type(SD_ContinuousStateType), intent(in) :: x real(R8Ki), intent(out) :: op(:) integer(IntKi) :: i - do i = 1, size(p%Vars%x) - associate(Var => p%Vars%x(i)) - select case(Var%jUsr) - case (1) - op(Var%iLoc(1):Var%iLoc(2)) = x%qm - case (2) - op(Var%iLoc(1):Var%iLoc(2)) = x%qmdot - end select - end associate - end do + ! do i = 1, size(p%Vars%x) + ! associate(Var => p%Vars%x(i)) + ! select case(Var%jUsr) + ! case (1) + ! op(Var%iLoc(1):Var%iLoc(2)) = x%qm + ! case (2) + ! op(Var%iLoc(1):Var%iLoc(2)) = x%qmdot + ! end select + ! end associate + ! end do end subroutine subroutine SD_UnpackStateOP(p, op, x) @@ -544,32 +541,32 @@ subroutine SD_UnpackStateOP(p, op, x) real(R8Ki), intent(in) :: op(:) type(SD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i - do i = 1, size(p%Vars%x) - associate(Var => p%Vars%x(i)) - select case(Var%jUsr) - case (1) - x%qm = op(Var%iLoc(1):Var%iLoc(2)) - case (2) - x%qmdot = op(Var%iLoc(1):Var%iLoc(2)) - end select - end associate - end do + ! do i = 1, size(p%Vars%x) + ! associate(Var => p%Vars%x(i)) + ! select case(Var%jUsr) + ! case (1) + ! x%qm = op(Var%iLoc(1):Var%iLoc(2)) + ! case (2) + ! x%qmdot = op(Var%iLoc(1):Var%iLoc(2)) + ! end select + ! end associate + ! end do end subroutine subroutine SD_PackInputOP(p, u, op) type(SD_ParameterType), intent(in) :: p type(SD_InputType), intent(in) :: u real(R8Ki), intent(out) :: op(:) - call MV_Pack(p%Vars%u, p%iVarTPMesh, u%TPMesh, op) - call MV_Pack(p%Vars%u, p%iVarLMesh, u%LMesh, op) + ! call MV_Pack(p%Vars%u, p%iVarTPMesh, u%TPMesh, op) + ! call MV_Pack(p%Vars%u, p%iVarLMesh, u%LMesh, op) end subroutine subroutine SD_UnpackInputOP(p, op, u) type(SD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: op(:) type(SD_InputType), intent(inout) :: u - call MV_Unpack(p%Vars%u, p%iVarTPMesh, op, u%TPMesh) - call MV_Unpack(p%Vars%u, p%iVarLMesh, op, u%LMesh) + ! call MV_Unpack(p%Vars%u, p%iVarTPMesh, op, u%TPMesh) + ! call MV_Unpack(p%Vars%u, p%iVarLMesh, op, u%LMesh) end subroutine subroutine SD_PackOutputOP(p, y, op, PackWriteOutput) @@ -577,20 +574,20 @@ subroutine SD_PackOutputOP(p, y, op, PackWriteOutput) type(SD_OutputType), intent(in) :: y real(R8Ki), intent(out) :: op(:) logical, intent(in) :: PackWriteOutput - call MV_Pack(p%Vars%y, p%iVarY1Mesh, y%Y1Mesh, op) - call MV_Pack(p%Vars%y, p%iVarY2Mesh, y%Y2Mesh, op) - call MV_Pack(p%Vars%y, p%iVarY3Mesh, y%Y3Mesh, op) - if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, op) + ! call MV_Pack(p%Vars%y, p%iVarY1Mesh, y%Y1Mesh, op) + ! call MV_Pack(p%Vars%y, p%iVarY2Mesh, y%Y2Mesh, op) + ! call MV_Pack(p%Vars%y, p%iVarY3Mesh, y%Y3Mesh, op) + ! if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, op) end subroutine subroutine SD_UnpackOutputOP(p, op, y) type(SD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: op(:) type(SD_OutputType), intent(out) :: y - call MV_Unpack(p%Vars%y, p%iVarY1Mesh, op, y%Y1Mesh) - call MV_Unpack(p%Vars%y, p%iVarY2Mesh, op, y%Y2Mesh) - call MV_Unpack(p%Vars%y, p%iVarY3Mesh, op, y%Y3Mesh) - call MV_Unpack(p%Vars%y, p%iVarWriteOutput, op, y%WriteOutput) + ! call MV_Unpack(p%Vars%y, p%iVarY1Mesh, op, y%Y1Mesh) + ! call MV_Unpack(p%Vars%y, p%iVarY2Mesh, op, y%Y2Mesh) + ! call MV_Unpack(p%Vars%y, p%iVarY3Mesh, op, y%Y3Mesh) + ! call MV_Unpack(p%Vars%y, p%iVarWriteOutput, op, y%WriteOutput) end subroutine !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 630d7fc1a1..b83b742efd 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -33,11 +33,6 @@ MODULE SubDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SD_u_TPMesh = 1 ! Mesh number for SD SD_u_TPMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SD_u_LMesh = 2 ! Mesh number for SD SD_u_LMesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SD_y_Y1Mesh = 3 ! Mesh number for SD SD_y_Y1Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SD_y_Y2Mesh = 4 ! Mesh number for SD SD_y_Y2Mesh mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SD_y_Y3Mesh = 5 ! Mesh number for SD SD_y_Y3Mesh mesh [-] ! ========= IList ======= TYPE, PUBLIC :: IList INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: List !< List of integers [-] @@ -378,7 +373,18 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] END TYPE SD_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SD_x_qm = 1 ! SD%qm + integer(IntKi), public, parameter :: SD_x_qmdot = 2 ! SD%qmdot + integer(IntKi), public, parameter :: SD_z_DummyConstrState = 3 ! SD%DummyConstrState + integer(IntKi), public, parameter :: SD_u_TPMesh = 4 ! SD%TPMesh + integer(IntKi), public, parameter :: SD_u_LMesh = 5 ! SD%LMesh + integer(IntKi), public, parameter :: SD_u_CableDeltaL = 6 ! SD%CableDeltaL + integer(IntKi), public, parameter :: SD_y_Y1Mesh = 7 ! SD%Y1Mesh + integer(IntKi), public, parameter :: SD_y_Y2Mesh = 8 ! SD%Y2Mesh + integer(IntKi), public, parameter :: SD_y_Y3Mesh = 9 ! SD%Y3Mesh + integer(IntKi), public, parameter :: SD_y_WriteOutput = 10 ! SD%WriteOutput + +contains subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) type(IList), intent(in) :: SrcIListData @@ -4502,7 +4508,7 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err function SD_InputMeshPointer(u, ML) result(Mesh) type(SD_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -4514,7 +4520,7 @@ function SD_InputMeshPointer(u, ML) result(Mesh) end function function SD_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -4527,7 +4533,7 @@ function SD_InputMeshName(ML) result(Name) function SD_OutputMeshPointer(y, ML) result(Mesh) type(SD_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -4541,7 +4547,7 @@ function SD_OutputMeshPointer(y, ML) result(Mesh) end function function SD_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -4553,5 +4559,149 @@ function SD_OutputMeshName(ML) result(Name) Name = "y%Y3Mesh" end select end function + +subroutine SD_PackContStateAry(Vars, x, ValAry) + type(SD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SD_x_qm) + call MV_Pack2(Var, x%qm, ValAry) ! Rank 1 Array + case (SD_x_qmdot) + call MV_Pack2(Var, x%qmdot, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SD_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SD_x_qm) + call MV_Unpack2(Var, ValAry, x%qm) ! Rank 1 Array + case (SD_x_qmdot) + call MV_Unpack2(Var, ValAry, x%qmdot) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SD_PackConstrStateAry(Vars, z, ValAry) + type(SD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SD_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SD_PackInputAry(Vars, u, ValAry) + type(SD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SD_u_TPMesh) + call MV_Pack2(Var, u%TPMesh, ValAry) ! Mesh + case (SD_u_LMesh) + call MV_Pack2(Var, u%LMesh, ValAry) ! Mesh + case (SD_u_CableDeltaL) + call MV_Pack2(Var, u%CableDeltaL, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SD_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SD_u_TPMesh) + call MV_Unpack2(Var, ValAry, u%TPMesh) ! Mesh + case (SD_u_LMesh) + call MV_Unpack2(Var, ValAry, u%LMesh) ! Mesh + case (SD_u_CableDeltaL) + call MV_Unpack2(Var, ValAry, u%CableDeltaL) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SD_PackOutputAry(Vars, y, ValAry) + type(SD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SD_y_Y1Mesh) + call MV_Pack2(Var, y%Y1Mesh, ValAry) ! Mesh + case (SD_y_Y2Mesh) + call MV_Pack2(Var, y%Y2Mesh, ValAry) ! Mesh + case (SD_y_Y3Mesh) + call MV_Pack2(Var, y%Y3Mesh, ValAry) ! Mesh + case (SD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SD_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SD_y_Y1Mesh) + call MV_Unpack2(Var, ValAry, y%Y1Mesh) ! Mesh + case (SD_y_Y2Mesh) + call MV_Unpack2(Var, ValAry, y%Y2Mesh) ! Mesh + case (SD_y_Y3Mesh) + call MV_Unpack2(Var, ValAry, y%Y3Mesh) ! Mesh + case (SD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE SubDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 610e788e6c..57fb9613b8 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -91,7 +91,11 @@ MODULE SCDataEx_Types REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fromSCglob => NULL() !< turbine specific outputs of the super controller (to the turbine controller) [-] END TYPE SC_DX_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SC_DX_u_toSC = 1 ! SC_DX%toSC + integer(IntKi), public, parameter :: SC_DX_y_fromSC = 2 ! SC_DX%fromSC + integer(IntKi), public, parameter :: SC_DX_y_fromSCglob = 3 ! SC_DX%fromSCglob + +contains subroutine SC_DX_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SC_DX_InitInputType), intent(in) :: SrcInitInputData @@ -659,7 +663,7 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) function SC_DX_InputMeshPointer(u, ML) result(Mesh) type(SC_DX_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -667,7 +671,7 @@ function SC_DX_InputMeshPointer(u, ML) result(Mesh) end function function SC_DX_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -676,7 +680,7 @@ function SC_DX_InputMeshName(ML) result(Name) function SC_DX_OutputMeshPointer(y, ML) result(Mesh) type(SC_DX_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -684,11 +688,75 @@ function SC_DX_OutputMeshPointer(y, ML) result(Mesh) end function function SC_DX_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine SC_DX_PackInputAry(Vars, u, ValAry) + type(SC_DX_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SC_DX_u_toSC) + call MV_Pack2(Var, u%toSC, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SC_DX_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SC_DX_u_toSC) + call MV_Unpack2(Var, ValAry, u%toSC) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SC_DX_PackOutputAry(Vars, y, ValAry) + type(SC_DX_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SC_DX_y_fromSC) + call MV_Pack2(Var, y%fromSC, ValAry) ! Rank 1 Array + case (SC_DX_y_fromSCglob) + call MV_Pack2(Var, y%fromSCglob, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SC_DX_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SC_DX_y_fromSC) + call MV_Unpack2(Var, ValAry, y%fromSC) ! Rank 1 Array + case (SC_DX_y_fromSCglob) + call MV_Unpack2(Var, ValAry, y%fromSCglob) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE SCDataEx_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index af50c7be9b..0710efca6e 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -179,7 +179,14 @@ MODULE SuperController_Types REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fromSC => NULL() !< Turbine specific outputs of the super controller (to the turbine controller) [-] END TYPE SC_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SC_x_Dummy = 1 ! SC%Dummy + integer(IntKi), public, parameter :: SC_z_Dummy = 2 ! SC%Dummy + integer(IntKi), public, parameter :: SC_u_toSCglob = 3 ! SC%toSCglob + integer(IntKi), public, parameter :: SC_u_toSC = 4 ! SC%toSC + integer(IntKi), public, parameter :: SC_y_fromSCglob = 5 ! SC%fromSCglob + integer(IntKi), public, parameter :: SC_y_fromSC = 6 ! SC%fromSC + +contains subroutine SC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SC_InitInputType), intent(in) :: SrcInitInputData @@ -1824,7 +1831,7 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err function SC_InputMeshPointer(u, ML) result(Mesh) type(SC_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1832,7 +1839,7 @@ function SC_InputMeshPointer(u, ML) result(Mesh) end function function SC_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1841,7 +1848,7 @@ function SC_InputMeshName(ML) result(Name) function SC_OutputMeshPointer(y, ML) result(Mesh) type(SC_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1849,11 +1856,139 @@ function SC_OutputMeshPointer(y, ML) result(Mesh) end function function SC_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine SC_PackContStateAry(Vars, x, ValAry) + type(SC_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SC_x_Dummy) + call MV_Pack2(Var, x%Dummy, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SC_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i), DL => Vars%x(i)%DL) + select case (Var%DL%Num) + case (SC_x_Dummy) + call MV_Unpack2(Var, ValAry, x%Dummy) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SC_PackConstrStateAry(Vars, z, ValAry) + type(SC_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SC_z_Dummy) + call MV_Pack2(Var, z%Dummy, ValAry) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SC_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + associate (Var => Vars%z(i), DL => Vars%z(i)%DL) + select case (Var%DL%Num) + case (SC_z_Dummy) + call MV_Unpack2(Var, ValAry, z%Dummy) ! Scalar + end select + end associate + end do +end subroutine + +subroutine SC_PackInputAry(Vars, u, ValAry) + type(SC_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SC_u_toSCglob) + call MV_Pack2(Var, u%toSCglob, ValAry) ! Rank 1 Array + case (SC_u_toSC) + call MV_Pack2(Var, u%toSC, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SC_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i), DL => Vars%u(i)%DL) + select case (Var%DL%Num) + case (SC_u_toSCglob) + call MV_Unpack2(Var, ValAry, u%toSCglob) ! Rank 1 Array + case (SC_u_toSC) + call MV_Unpack2(Var, ValAry, u%toSC) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SC_PackOutputAry(Vars, y, ValAry) + type(SC_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SC_y_fromSCglob) + call MV_Pack2(Var, y%fromSCglob, ValAry) ! Rank 1 Array + case (SC_y_fromSC) + call MV_Pack2(Var, y%fromSC, ValAry) ! Rank 1 Array + end select + end associate + end do +end subroutine + +subroutine SC_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + associate (Var => Vars%y(i), DL => Vars%y(i)%DL) + select case (Var%DL%Num) + case (SC_y_fromSCglob) + call MV_Unpack2(Var, ValAry, y%fromSCglob) ! Rank 1 Array + case (SC_y_fromSC) + call MV_Unpack2(Var, ValAry, y%fromSC) ! Rank 1 Array + end select + end associate + end do +end subroutine END MODULE SuperController_Types !ENDOFREGISTRYGENERATEDFILE From 49fec4ed0c10e2d8f15e97e0310e6a1a2c3a93d1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 22 Jul 2024 17:19:56 +0000 Subject: [PATCH 156/319] Refactoring module variables again --- docs/source/user/glue/modvar.dot | 120 ++ glue-codes/openfast/src/FAST_Prog.f90 | 5 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 284 +++-- modules/aerodyn/src/AeroDyn.f90 | 310 +++-- modules/aerodyn/src/AeroDyn_Types.f90 | 300 +++-- modules/aerodyn/src/AirfoilInfo_Types.f90 | 166 +-- modules/aerodyn/src/BEMT_Types.f90 | 508 +++++---- modules/aerodyn/src/DBEMT_Types.f90 | 212 ++-- modules/aerodyn/src/FVW_Types.f90 | 268 +++-- modules/aerodyn/src/UnsteadyAero_Types.f90 | 252 ++-- modules/aerodyn14/src/AeroDyn14_Types.f90 | 492 ++++---- modules/aerodyn14/src/DWM_Types.f90 | 532 +++++---- modules/beamdyn/src/BeamDyn_Types.f90 | 236 ++-- modules/elastodyn/src/ElastoDyn.f90 | 325 +++--- modules/elastodyn/src/ElastoDyn_Registry.txt | 3 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 658 +++++------ .../src/ExternalInflow_Types.f90 | 238 ++-- modules/extloads/src/ExtLoadsDX_Types.f90 | 134 ++- modules/extloads/src/ExtLoads_Types.f90 | 300 +++-- modules/extptfm/src/ExtPtfm_MCKF_Registry.txt | 1 + modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 199 +++- modules/feamooring/src/FEAMooring_Types.f90 | 212 ++-- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 172 ++- modules/hydrodyn/src/HydroDyn.f90 | 8 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 284 +++-- modules/hydrodyn/src/Morison_Types.f90 | 188 ++- modules/hydrodyn/src/SS_Excitation_Types.f90 | 180 ++- modules/hydrodyn/src/SS_Radiation_Types.f90 | 180 ++- modules/hydrodyn/src/WAMIT2_Types.f90 | 43 +- modules/hydrodyn/src/WAMIT_Types.f90 | 204 ++-- modules/icedyn/src/IceDyn_Types.f90 | 188 ++- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 180 ++- modules/inflowwind/src/InflowWind.f90 | 100 +- modules/inflowwind/src/InflowWind.txt | 6 +- modules/inflowwind/src/InflowWind_Types.f90 | 306 +++-- modules/inflowwind/src/Lidar_Types.f90 | 236 ++-- modules/map/src/MAP_Types.f90 | 268 +++-- modules/moordyn/src/MoorDyn_Types.f90 | 228 ++-- modules/nwtc-library/src/ModVar.f90 | 282 ++++- .../nwtc-library/src/NWTC_Library_Types.f90 | 744 +++++++----- .../src/Registry_NWTC_Library.txt | 78 +- .../src/Registry_NWTC_Library_base.txt | 78 +- modules/openfast-library/CMakeLists.txt | 1 - modules/openfast-library/src/FAST_AeroMap.f90 | 1 - modules/openfast-library/src/FAST_Funcs.f90 | 813 +++++++++---- modules/openfast-library/src/FAST_Mapping.f90 | 902 +++++++-------- modules/openfast-library/src/FAST_ModData.f90 | 414 ------- modules/openfast-library/src/FAST_ModGlue.f90 | 579 +++++++--- modules/openfast-library/src/FAST_Subs.f90 | 61 +- .../openfast-library/src/Glue_Registry.txt | 111 +- modules/openfast-library/src/Glue_Types.f90 | 1012 +++++------------ .../src/registry_gen_fortran.cpp | 61 +- .../src/OrcaFlexInterface_Types.f90 | 180 ++- modules/seastate/src/SeaState.f90 | 4 +- modules/seastate/src/SeaState_Types.f90 | 172 ++- modules/servodyn/src/ServoDyn_Types.f90 | 756 ++++++------ modules/servodyn/src/StrucCtrl_Types.f90 | 220 ++-- modules/subdyn/src/SubDyn_Types.f90 | 220 ++-- .../supercontroller/src/SCDataEx_Types.f90 | 94 +- .../src/SuperController_Types.f90 | 188 ++- 60 files changed, 9097 insertions(+), 6400 deletions(-) create mode 100644 docs/source/user/glue/modvar.dot delete mode 100644 modules/openfast-library/src/FAST_ModData.f90 diff --git a/docs/source/user/glue/modvar.dot b/docs/source/user/glue/modvar.dot new file mode 100644 index 0000000000..37c989767a --- /dev/null +++ b/docs/source/user/glue/modvar.dot @@ -0,0 +1,120 @@ +digraph UML_Class_diagram { + graph [fontname = "Helvetica,Arial,sans-serif"; rankdir = LR; ranksep = 1] + node [fontname = "Helvetica,Arial,sans-serif"; shape = record; style = filled; fillcolor = gray95] + edge [fontname = "Helvetica,Arial,sans-serif"] + + + + DatLoc [shape = plain;label = < + + + + + +
DatLoc
NumIntKi
i1IntKi
i2IntKi
i3IntKi
>] + + ModVarType [shape = plain;label = < + + + + + + + + + + + + + + + + + +
ModVarType
Namecharacter
LinNames(:)character
DLDatLoc
FieldIntKi
NodesIntKi
NumIntKi
FlagsIntKi
DerivOrderIntKi
iLoc(2)IntKi
iGlu(2)IntKi
iAry(2)IntKi
jAryIntKi
kAryIntKi
mAryIntKi
MeshIDIntKi
PerturbR8Ki
>] + + ModVarsType [shape = plain;label = < + + + + + + + + + +
ModVarsType
NxIntKi
x(:)ModVarType
NzIntKi
z(:)ModVarType
NuIntKi
u(:)ModVarType
NyIntKi
y(:)ModVarType
>] + + ModLinType [shape = plain;label = < + + + + + + + + + + + + + + + + +
ModLinType
Abbrcharacter
x(:)R8Ki
dx(:)R8Ki
z(:)R8Ki
u(:)R8Ki
y(:)R8Ki
J(:,:)R8Ki
dYdx(:,:)R8Ki
dXdx(:,:)R8Ki
dYdu(:,:)R8Ki
dXdu(:,:)R8Ki
dXdy(:,:)R8Ki
dUdu(:,:)R8Ki
dUdy(:,:)R8Ki
StateRotation(:,:)R8Ki
>] + + ModDataType [shape = plain;label = < + + + + + + + + + + + +
ModDataType
Abbrcharacter
IDIntKi
iModIntKi
InsIntKi
DTR8Ki
SubStepsIntKi
iSrcMap(:)IntKi
iDstMap(:)IntKi
VarsModVarsType
LinModLinType
>] + + ModGlueType [shape = plain;label = < + + + + + +
ModGlueType
Namecharacter
VarsModVarsType
Mods(:)ModDataType
LinModLinType
>] + + ModVarType:DatLoc:e -> DatLoc:header:w; + ModVarsType:x:e -> ModVarType:header:w; + ModVarsType:z:e -> ModVarType:header:w; + ModVarsType:u:e -> ModVarType:header:w; + ModVarsType:y:e -> ModVarType:header:w; + + ModDataType:Vars:e -> ModVarsType:header:w; + + ModDataType:Lin:e -> ModLinType:header:w; + + ModGlueType:Mods:e -> ModDataType:header:w; + ModGlueType:Lin:e -> ModLinType:header:w; + + + + ModJacType [shape = plain;label = < + + + + + + + + + + + + + +
ModJacType
Namecharacter
x(:)R8Ki
z(:)R8Ki
u(:)R8Ki
y(:)R8Ki
x_perturb(:)R8Ki
z_perturb(:)R8Ki
u_perturb(:)R8Ki
X_pos(:)R8Ki
X_neg(:)R8Ki
Y_pos(:)R8Ki
Y_neg(:)R8Ki
>] + +} diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index f74d94c5a5..5064c05920 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -32,7 +32,7 @@ PROGRAM FAST USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs -USE FAST_AeroMap, ONLY : FAST_RunSteadyStateDriver +! USE FAST_AeroMap, ONLY : FAST_RunSteadyStateDriver IMPLICIT NONE @@ -80,7 +80,8 @@ PROGRAM FAST ELSE IF ( TRIM(FlagArg) == 'STEADYSTATE' ) THEN ! Do steady-state analysis, not time-marching -- this works for only 1 turbine (i.e., NumTurbines==1)! ! this runs the steady-state solver driver and ENDS the program: - CALL FAST_RunSteadyStateDriver( Turbine(1) ) + ! CALL FAST_RunSteadyStateDriver( Turbine(1) ) + CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true., SkipRunTimeMsg = .TRUE. ) ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 0a397e8dd7..9a5a0d92bd 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -3043,180 +3043,256 @@ function AA_OutputMeshName(ML) result(Name) end select end function +subroutine AA_PackContStateVar(Var, x, ValAry) + type(AA_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AA_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AA_PackContStateAry(Vars, x, ValAry) type(AA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (AA_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - end select - end associate + call AA_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine AA_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AA_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine AA_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AA_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (AA_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate + call AA_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine AA_PackConstrStateVar(Var, z, ValAry) + type(AA_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AA_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AA_PackConstrStateAry(Vars, z, ValAry) type(AA_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (AA_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call AA_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine AA_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AA_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine AA_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AA_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (AA_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call AA_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine AA_PackInputVar(Var, u, ValAry) + type(AA_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AA_u_RotGtoL) + call MV_Pack2(Var, u%RotGtoL, ValAry) ! Rank 4 Array + case (AA_u_AeroCent_G) + call MV_Pack2(Var, u%AeroCent_G, ValAry) ! Rank 3 Array + case (AA_u_Vrel) + call MV_Pack2(Var, u%Vrel, ValAry) ! Rank 2 Array + case (AA_u_AoANoise) + call MV_Pack2(Var, u%AoANoise, ValAry) ! Rank 2 Array + case (AA_u_Inflow) + call MV_Pack2(Var, u%Inflow, ValAry) ! Rank 3 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AA_PackInputAry(Vars, u, ValAry) type(AA_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (AA_u_RotGtoL) - call MV_Pack2(Var, u%RotGtoL, ValAry) ! Rank 4 Array - case (AA_u_AeroCent_G) - call MV_Pack2(Var, u%AeroCent_G, ValAry) ! Rank 3 Array - case (AA_u_Vrel) - call MV_Pack2(Var, u%Vrel, ValAry) ! Rank 2 Array - case (AA_u_AoANoise) - call MV_Pack2(Var, u%AoANoise, ValAry) ! Rank 2 Array - case (AA_u_Inflow) - call MV_Pack2(Var, u%Inflow, ValAry) ! Rank 3 Array - end select - end associate + call AA_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine AA_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AA_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AA_u_RotGtoL) + call MV_Unpack2(Var, ValAry, u%RotGtoL) ! Rank 4 Array + case (AA_u_AeroCent_G) + call MV_Unpack2(Var, ValAry, u%AeroCent_G) ! Rank 3 Array + case (AA_u_Vrel) + call MV_Unpack2(Var, ValAry, u%Vrel) ! Rank 2 Array + case (AA_u_AoANoise) + call MV_Unpack2(Var, ValAry, u%AoANoise) ! Rank 2 Array + case (AA_u_Inflow) + call MV_Unpack2(Var, ValAry, u%Inflow) ! Rank 3 Array + end select + end associate +end subroutine + subroutine AA_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AA_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (AA_u_RotGtoL) - call MV_Unpack2(Var, ValAry, u%RotGtoL) ! Rank 4 Array - case (AA_u_AeroCent_G) - call MV_Unpack2(Var, ValAry, u%AeroCent_G) ! Rank 3 Array - case (AA_u_Vrel) - call MV_Unpack2(Var, ValAry, u%Vrel) ! Rank 2 Array - case (AA_u_AoANoise) - call MV_Unpack2(Var, ValAry, u%AoANoise) ! Rank 2 Array - case (AA_u_Inflow) - call MV_Unpack2(Var, ValAry, u%Inflow) ! Rank 3 Array - end select - end associate + call AA_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine AA_PackOutputVar(Var, y, ValAry) + type(AA_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AA_y_SumSpecNoise) + call MV_Pack2(Var, y%SumSpecNoise, ValAry) ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + call MV_Pack2(Var, y%SumSpecNoiseSep, ValAry) ! Rank 3 Array + case (AA_y_OASPL) + call MV_Pack2(Var, y%OASPL, ValAry) ! Rank 3 Array + case (AA_y_OASPL_Mech) + call MV_Pack2(Var, y%OASPL_Mech, ValAry) ! Rank 4 Array + case (AA_y_DirectiviOutput) + call MV_Pack2(Var, y%DirectiviOutput, ValAry) ! Rank 1 Array + case (AA_y_OutLECoords) + call MV_Pack2(Var, y%OutLECoords, ValAry) ! Rank 4 Array + case (AA_y_PtotalFreq) + call MV_Pack2(Var, y%PtotalFreq, ValAry) ! Rank 2 Array + case (AA_y_WriteOutputForPE) + call MV_Pack2(Var, y%WriteOutputForPE, ValAry) ! Rank 1 Array + case (AA_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (AA_y_WriteOutputSep) + call MV_Pack2(Var, y%WriteOutputSep, ValAry) ! Rank 1 Array + case (AA_y_WriteOutputNode) + call MV_Pack2(Var, y%WriteOutputNode, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AA_PackOutputAry(Vars, y, ValAry) type(AA_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (AA_y_SumSpecNoise) - call MV_Pack2(Var, y%SumSpecNoise, ValAry) ! Rank 3 Array - case (AA_y_SumSpecNoiseSep) - call MV_Pack2(Var, y%SumSpecNoiseSep, ValAry) ! Rank 3 Array - case (AA_y_OASPL) - call MV_Pack2(Var, y%OASPL, ValAry) ! Rank 3 Array - case (AA_y_OASPL_Mech) - call MV_Pack2(Var, y%OASPL_Mech, ValAry) ! Rank 4 Array - case (AA_y_DirectiviOutput) - call MV_Pack2(Var, y%DirectiviOutput, ValAry) ! Rank 1 Array - case (AA_y_OutLECoords) - call MV_Pack2(Var, y%OutLECoords, ValAry) ! Rank 4 Array - case (AA_y_PtotalFreq) - call MV_Pack2(Var, y%PtotalFreq, ValAry) ! Rank 2 Array - case (AA_y_WriteOutputForPE) - call MV_Pack2(Var, y%WriteOutputForPE, ValAry) ! Rank 1 Array - case (AA_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (AA_y_WriteOutputSep) - call MV_Pack2(Var, y%WriteOutputSep, ValAry) ! Rank 1 Array - case (AA_y_WriteOutputNode) - call MV_Pack2(Var, y%WriteOutputNode, ValAry) ! Rank 1 Array - end select - end associate + call AA_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine AA_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AA_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AA_y_SumSpecNoise) + call MV_Unpack2(Var, ValAry, y%SumSpecNoise) ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + call MV_Unpack2(Var, ValAry, y%SumSpecNoiseSep) ! Rank 3 Array + case (AA_y_OASPL) + call MV_Unpack2(Var, ValAry, y%OASPL) ! Rank 3 Array + case (AA_y_OASPL_Mech) + call MV_Unpack2(Var, ValAry, y%OASPL_Mech) ! Rank 4 Array + case (AA_y_DirectiviOutput) + call MV_Unpack2(Var, ValAry, y%DirectiviOutput) ! Rank 1 Array + case (AA_y_OutLECoords) + call MV_Unpack2(Var, ValAry, y%OutLECoords) ! Rank 4 Array + case (AA_y_PtotalFreq) + call MV_Unpack2(Var, ValAry, y%PtotalFreq) ! Rank 2 Array + case (AA_y_WriteOutputForPE) + call MV_Unpack2(Var, ValAry, y%WriteOutputForPE) ! Rank 1 Array + case (AA_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (AA_y_WriteOutputSep) + call MV_Unpack2(Var, ValAry, y%WriteOutputSep) ! Rank 1 Array + case (AA_y_WriteOutputNode) + call MV_Unpack2(Var, ValAry, y%WriteOutputNode) ! Rank 1 Array + end select + end associate +end subroutine + subroutine AA_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AA_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (AA_y_SumSpecNoise) - call MV_Unpack2(Var, ValAry, y%SumSpecNoise) ! Rank 3 Array - case (AA_y_SumSpecNoiseSep) - call MV_Unpack2(Var, ValAry, y%SumSpecNoiseSep) ! Rank 3 Array - case (AA_y_OASPL) - call MV_Unpack2(Var, ValAry, y%OASPL) ! Rank 3 Array - case (AA_y_OASPL_Mech) - call MV_Unpack2(Var, ValAry, y%OASPL_Mech) ! Rank 4 Array - case (AA_y_DirectiviOutput) - call MV_Unpack2(Var, ValAry, y%DirectiviOutput) ! Rank 1 Array - case (AA_y_OutLECoords) - call MV_Unpack2(Var, ValAry, y%OutLECoords) ! Rank 4 Array - case (AA_y_PtotalFreq) - call MV_Unpack2(Var, ValAry, y%PtotalFreq) ! Rank 2 Array - case (AA_y_WriteOutputForPE) - call MV_Unpack2(Var, ValAry, y%WriteOutputForPE) ! Rank 1 Array - case (AA_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (AA_y_WriteOutputSep) - call MV_Unpack2(Var, ValAry, y%WriteOutputSep) ! Rank 1 Array - case (AA_y_WriteOutputNode) - call MV_Unpack2(Var, ValAry, y%WriteOutputNode) ! Rank 1 Array - end select - end associate + call AA_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 680ed3d03c..1781d76896 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -47,7 +47,7 @@ module AeroDyn ! continuous states, and updating discrete states public :: AD_CalcOutput ! Routine for computing outputs public :: AD_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - + public :: RotCalcContStateDeriv PUBLIC :: AD_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u) @@ -5613,22 +5613,26 @@ subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, ! DBEMT if (p%BEMT%DBEMT%lin_nx/2 > 0) then do j = 1, p%NumBlades - call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & - DatLoc(AD_x_BEMT_DBEMT_element_vind), & - Num=2*p%NumBlNds, & - Flags=ior(VF_DerivOrder2, VF_RotFrame), & - Perturb=Perturb, & - LinNames=[([DBEMTLinName(j, i, "axial", .false.), & - DBEMTLinName(j, i, "tangential", .false.)], i = 1, p%NumBlNds)]) + do i = 1, p%NumBlNds + call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & + DatLoc(AD_x_BEMT_DBEMT_element_vind, i, j), & + Num=2, & + Flags=ior(VF_DerivOrder2, VF_RotFrame), & + Perturb=Perturb, & + LinNames=[DBEMTLinName(j, i, "axial", .false.), & + DBEMTLinName(j, i, "tangential", .false.)]) + end do end do do j = 1, p%NumBlades - call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & - DatLoc(AD_x_BEMT_DBEMT_element_vind_1), & - Num=2*p%NumBlNds, & - Flags=ior(VF_DerivOrder2, VF_RotFrame), & - Perturb=Perturb, & - LinNames=[([DBEMTLinName(j, i, "axial", .true.), & - DBEMTLinName(j, i, "tangential", .true.)], i = 1, p%NumBlNds)]) + do i = 1, p%NumBlNds + call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & + DatLoc(AD_x_BEMT_DBEMT_element_vind_1, i, j), & + Num=2, & + Flags=ior(VF_DerivOrder2, VF_RotFrame), & + Perturb=Perturb, & + LinNames=[DBEMTLinName(j, i, "axial", .true.), & + DBEMTLinName(j, i, "tangential", .true.)]) + end do end do end if @@ -5786,14 +5790,16 @@ subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, call MV_InitVarsJac(p%Vars, m%Jac, Linearize .or. CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotContinuousStateType(x, m%x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotContinuousStateType(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotContinuousStateType(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInputType(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotOutputType(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotOtherStateType(OtherState, m%OtherState_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + if (Linearize .or. CompAeroMaps) then + call AD_CopyRotContinuousStateType(x, m%x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotContinuousStateType(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotContinuousStateType(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOutputType(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + end if contains @@ -5832,9 +5838,11 @@ end function Failed !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE AD_JacobianPInput(Vars, iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. + type(ModVarsType), INTENT(IN ) :: Vars !< Module vars + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -5846,35 +5854,29 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - - integer(IntKi), parameter :: iR =1 ! Rotor index integer(intKi) :: StartNode StartNode = 1 ! ignored during linearization since cannot linearize with ExtInflow - if (size(p%rotors)>1) then - errStat = ErrID_Fatal - errMsg = 'Linearization with more than one rotor not supported' - return - endif - call AD_CalcWind_Rotor(t, u%rotors(iR), p%FlowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), StartNode, ErrStat, ErrMsg) + call AD_CalcWind_Rotor(t, u%rotors(iRotor), p%FlowField, p%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), StartNode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return - call Rot_JacobianPInput( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) + call Rot_JacobianPInput(Vars, iRotor, t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), xd%rotors(iRotor), z%rotors(iRotor), OtherState%rotors(iRotor), y%rotors(iRotor), m%rotors(iRotor), m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) END SUBROUTINE AD_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE Rot_JacobianPInput(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. use IfW_FlowField, only: FlowFieldType, UniformField_InterpLinear + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays + INTEGER(IntKi), INTENT(IN ) :: iRot !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow @@ -5887,10 +5889,8 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y TYPE(RotOutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD !< misc variables - INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] @@ -5907,24 +5907,16 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y type(FlowFieldType),target :: FF_perturb type(FlowFieldType),pointer :: FF_ptr ! need a pointer in the CalcWind_Rotor routine type(RotInflowType) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - ! If vars were provided use them, otherwise use module variables - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - ! Find indices for extended input variables iVarHWindSpeed = 0 iVarPLexp = 0 iVarPropagationDir = 0 - do i = 1, size(VarsL%u) - select case(VarsL%u(i)%DL%Num) + do i = 1, size(Vars%u) + select case(Vars%u(i)%DL%Num) case (AD_u_HWindSpeed) iVarHWindSpeed = i case (AD_u_PLexp) @@ -5968,98 +5960,98 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y ! Copy inputs and pack them for perturbation call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackInputAry(VarsL, u, m%Jac%u) + call AD_PackInputAry(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, Vars%Ny, Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Copy rotor inflow type for perturbation call AD_CopyRotInflowType(RotInflow, RotInflow_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Loop through input variables - do i = 1, size(VarsL%u) + do i = 1, size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num ! Calculate positive perturbation call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(VarsL%u(i), p_AD%FlowField, 1, FF_ptr) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, 1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(VarsL%u(i), p_AD%FlowField, -1, FF_ptr) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, -1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) + call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - if (present(dXdu) .and. (VarsL%Nx > 0)) then + if (present(dXdu) .and. (Vars%Nx > 0)) then ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(VarsL%u) + do i = 1, size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(VarsL%u(i), p_AD%FlowField, 1, FF_ptr) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, 1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) + call AD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(VarsL%u(i), p_AD%FlowField, -1, FF_ptr) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call AD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, -1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) + call AD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do end do @@ -6106,9 +6098,11 @@ end subroutine Rot_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE AD_JacobianPContState(Vars, iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) !.................................................................................................................................. + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6123,7 +6117,6 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions !! (Y) with respect to the continuous !! states (x) [intent in to avoid deallocation] @@ -6136,28 +6129,23 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state !! functions (Z) with respect to !! the continuous states (x) [intent in to avoid deallocation] - integer(IntKi), parameter :: iR = 1 ! Rotor index - integer(IntKi) :: StartNode - - if (size(p%rotors)>1) then - errStat = ErrID_Fatal - errMsg = 'Linearization with more than one rotor not supported' - return - endif + integer(IntKi) :: StartNode StartNode = 1 - call AD_CalcWind_Rotor(t, u%rotors(iR), p%FlowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), StartNode, ErrStat, ErrMsg) + call AD_CalcWind_Rotor(t, u%rotors(iRotor), p%FlowField, p%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), StartNode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return - call RotJacobianPContState(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx) + call RotJacobianPContState(Vars, iRotor, t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), xd%rotors(iRotor), z%rotors(iRotor), OtherState%rotors(iRotor), y%rotors(iRotor), m%rotors(iRotor), m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) END SUBROUTINE AD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE RotJacobianPContState(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE RotJacobianPContState(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) !.................................................................................................................................. - + + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays + integer(IntKi), INTENT(IN ) :: iRot !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow @@ -6173,10 +6161,8 @@ SUBROUTINE RotJacobianPContState(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, !! connectivity) does not have to be recalculated for dYdx. TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD !< misc variables - INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] @@ -6187,18 +6173,10 @@ SUBROUTINE RotJacobianPContState(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, character(ErrMsgLen) :: ErrMsg2 integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer(IntKi) :: i, j, col - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - ! If vars were provided use them, otherwise use module variables - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - ! Get OP values here (i.e., set inputs for BEMT): if (p%DBEMT_Mod == DBEMT_frozen) then call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return @@ -6222,39 +6200,39 @@ SUBROUTINE RotJacobianPContState(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, ! Copy and pack states for perturbation call AD_CopyRotContinuousStateType(m%x_init, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateAry(VarsL, m%x_init, m%Jac%x) + call AD_PackContStateAry(Vars, m%x_init, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, VarsL%Ny, VarsL%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(VarsL%x) + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%x(i)%Num + do j = 1, Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) + call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = VarsL%x(i)%iLoc(1) + j - 1 + col = Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do @@ -6265,32 +6243,32 @@ SUBROUTINE RotJacobianPContState(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(VarsL%x) + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%x(i)%Num + do j = 1, Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) + call AD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) + call AD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = VarsL%x(i)%iLoc(1) + j - 1 + col = Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) end do end do @@ -6593,7 +6571,8 @@ END SUBROUTINE RotJacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE AD_GetOP(iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, Vars) +SUBROUTINE AD_GetOP(Vars, iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6612,7 +6591,6 @@ SUBROUTINE AD_GetOP(iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays integer(IntKi) :: StartNode @@ -6625,16 +6603,18 @@ SUBROUTINE AD_GetOP(iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg StartNode = 1 call AD_CalcWind_Rotor(t, u%rotors(iRotor), p%FlowField, p%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), StartNode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return - call RotGetOP(t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), & + call RotGetOP(Vars, iRotor, t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), & xd%rotors(iRotor), z%rotors(iRotor), OtherState%rotors(iRotor), y%rotors(iRotor), m%rotors(iRotor), & - ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, Vars) + ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op) END SUBROUTINE AD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, Vars) +SUBROUTINE RotGetOP(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op) use IfW_FlowField, only: FlowFieldType, Uniform_FieldType, UniformField_InterpLinear + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at operating point (may change to inout if a mesh copy is required) @@ -6654,42 +6634,34 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 INTEGER(IntKi) :: i type(UniformField_Interp) :: UF_op - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - ! Inputs if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(u_op, Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call AD_PackInputAry(VarsL, u, u_op) + call AD_PackInputAry(Vars, u, u_op) if (associated(p_AD%FlowField)) then if (p_AD%FlowField%FieldType == Uniform_FieldType) then UF_op = UniformField_InterpLinear(p_AD%FlowField%Uniform, t) - do i = 1, size(VarsL%u) - select case (VarsL%u(i)%DL%Num) + do i = 1, size(Vars%u) + select case (Vars%u(i)%DL%Num) case (AD_u_HWindSpeed) - call MV_Pack2(VarsL%u(i), UF_op%VelH, u_op) + call MV_Pack2(Vars%u(i), UF_op%VelH, u_op) case (AD_u_PLexp) - call MV_Pack2(VarsL%u(i), UF_op%ShrV, u_op) + call MV_Pack2(Vars%u(i), UF_op%ShrV, u_op) case (AD_u_PropagationDir) - call MV_Pack2(VarsL%u(i), UF_op%AngleH + p_AD%FlowField%PropagationDir, u_op) + call MV_Pack2(Vars%u(i), UF_op%AngleH + p_AD%FlowField%PropagationDir, u_op) end select end do end if @@ -6699,26 +6671,26 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta ! Outputs if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y_op, Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call AD_PackOutputAry(VarsL, y, y_op) + call AD_PackOutputAry(Vars, y, y_op) end if ! Continuous States if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(x_op, Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call AD_PackContStateAry(VarsL, x, x_op) + call AD_PackContStateAry(Vars, x, x_op) end if ! Continous State Derivatives if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, VarsL%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dx_op, Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return end if call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); If (Failed()) return - call AD_PackContStateAry(VarsL, m%dxdt_lin, dx_op) + call AD_PackContStateAry(Vars, m%dxdt_lin, dx_op) end if ! Discrete States @@ -6730,7 +6702,7 @@ SUBROUTINE RotGetOP(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSta if (.not. allocated(z_op)) then call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return end if - call AD_PackConstrStateAry(VarsL, z, z_op) + call AD_PackConstrStateAry(Vars, z, z_op) end if contains @@ -6741,7 +6713,8 @@ logical function Failed() end subroutine RotGetOP !> AD_SetOP populates the data structures from the operating point arrays. (Extended inputs are not used) -subroutine AD_SetOP(iRotor, u, p, x, z, ErrStat, ErrMsg, Vars, u_op, x_op, z_op) +subroutine AD_SetOP(Vars, iRotor, u, p, x, z, ErrStat, ErrMsg, u_op, x_op, z_op) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6749,49 +6722,20 @@ subroutine AD_SetOP(iRotor, u, p, x, z, ErrStat, ErrMsg, Vars, u_op, x_op, z_op) TYPE(AD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: x_op(:) !< values of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: z_op(:) !< values of linearized constraint states - call RotSetOP(u%rotors(iRotor), p%rotors(iRotor), x%rotors(iRotor), z%rotors(iRotor), ErrStat, ErrMsg, & - u_op, x_op, z_op, Vars) - -end subroutine - -!> RotSetOP populates the data structures from the operating point arrays. (Extended inputs are not used) -subroutine RotSetOP(u, p, x, z, ErrStat, ErrMsg, u_op, x_op, z_op, Vars) - type(RotInputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - type(RotParameterType), intent(in ) :: p !< Parameters - type(RotContinuousStateType), intent(inout) :: x !< Continuous states at operating point - type(RotConstraintStateType), intent(inout) :: z !< Constraint states at operating point - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(R8Ki), allocatable, optional, intent(in ) :: u_op(:) !< values of linearized inputs - real(R8Ki), allocatable, optional, intent(in ) :: x_op(:) !< values of linearized continuous states - real(R8Ki), allocatable, optional, intent(in ) :: z_op(:) !< values of linearized constraint states - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays - character(*), parameter :: RoutineName = 'AD_SetOP' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - - if (present(u_op)) call AD_UnpackInputAry(VarsL, u_op, u) - if (present(x_op)) call AD_UnpackContStateAry(VarsL, x_op, x) - if (present(z_op)) call AD_UnpackConstrStateAry(VarsL, z_op, z) - -end subroutine + if (present(u_op)) call AD_UnpackInputAry(Vars, u_op, u%rotors(iRotor)) + if (present(x_op)) call AD_UnpackContStateAry(Vars, x_op, x%rotors(iRotor)) + if (present(z_op)) call AD_UnpackConstrStateAry(Vars, z_op, z%rotors(iRotor)) +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 523a49a718..36395f86c4 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -6792,188 +6792,264 @@ function AD_OutputMeshName(ML) result(Name) end select end function +subroutine AD_PackContStateVar(Var, x, ValAry) + type(RotContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD_x_BEMT_UA_element_x) + call MV_Pack2(Var, x%BEMT%UA%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + call MV_Pack2(Var, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + call MV_Pack2(Var, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array + case (AD_x_BEMT_V_w) + call MV_Pack2(Var, x%BEMT%V_w, ValAry) ! Rank 1 Array + case (AD_x_AA_DummyContState) + call MV_Pack2(Var, x%AA%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AD_PackContStateAry(Vars, x, ValAry) type(RotContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (AD_x_BEMT_UA_element_x) - call MV_Pack2(Var, x%BEMT%UA%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind) - call MV_Pack2(Var, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind_1) - call MV_Pack2(Var, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array - case (AD_x_BEMT_V_w) - call MV_Pack2(Var, x%BEMT%V_w, ValAry) ! Rank 1 Array - case (AD_x_AA_DummyContState) - call MV_Pack2(Var, x%AA%DummyContState, ValAry) ! Scalar - end select - end associate + call AD_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine AD_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(RotContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD_x_BEMT_UA_element_x) + call MV_Unpack2(Var, ValAry, x%BEMT%UA%element(DL%i1, DL%i2)%x) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + call MV_Unpack2(Var, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + call MV_Unpack2(Var, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array + case (AD_x_BEMT_V_w) + call MV_Unpack2(Var, ValAry, x%BEMT%V_w) ! Rank 1 Array + case (AD_x_AA_DummyContState) + call MV_Unpack2(Var, ValAry, x%AA%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine AD_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(RotContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (AD_x_BEMT_UA_element_x) - call MV_Unpack2(Var, ValAry, x%BEMT%UA%element(DL%i1, DL%i2)%x) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind) - call MV_Unpack2(Var, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind_1) - call MV_Unpack2(Var, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array - case (AD_x_BEMT_V_w) - call MV_Unpack2(Var, ValAry, x%BEMT%V_w) ! Rank 1 Array - case (AD_x_AA_DummyContState) - call MV_Unpack2(Var, ValAry, x%AA%DummyContState) ! Scalar - end select - end associate + call AD_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine AD_PackConstrStateVar(Var, z, ValAry) + type(RotConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD_z_BEMT_phi) + call MV_Pack2(Var, z%BEMT%phi, ValAry) ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + call MV_Pack2(Var, z%AA%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AD_PackConstrStateAry(Vars, z, ValAry) type(RotConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (AD_z_BEMT_phi) - call MV_Pack2(Var, z%BEMT%phi, ValAry) ! Rank 2 Array - case (AD_z_AA_DummyConstrState) - call MV_Pack2(Var, z%AA%DummyConstrState, ValAry) ! Scalar - end select - end associate + call AD_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine AD_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(RotConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD_z_BEMT_phi) + call MV_Unpack2(Var, ValAry, z%BEMT%phi) ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%AA%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine AD_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(RotConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (AD_z_BEMT_phi) - call MV_Unpack2(Var, ValAry, z%BEMT%phi) ! Rank 2 Array - case (AD_z_AA_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%AA%DummyConstrState) ! Scalar - end select - end associate + call AD_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine AD_PackInputVar(Var, u, ValAry) + type(RotInputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD_u_NacelleMotion) + call MV_Pack2(Var, u%NacelleMotion, ValAry) ! Mesh + case (AD_u_TowerMotion) + call MV_Pack2(Var, u%TowerMotion, ValAry) ! Mesh + case (AD_u_HubMotion) + call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh + case (AD_u_BladeRootMotion) + call MV_Pack2(Var, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (AD_u_BladeMotion) + call MV_Pack2(Var, u%BladeMotion(DL%i1), ValAry) ! Mesh + case (AD_u_TFinMotion) + call MV_Pack2(Var, u%TFinMotion, ValAry) ! Mesh + case (AD_u_UserProp) + call MV_Pack2(Var, u%UserProp, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AD_PackInputAry(Vars, u, ValAry) type(RotInputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (AD_u_NacelleMotion) - call MV_Pack2(Var, u%NacelleMotion, ValAry) ! Mesh - case (AD_u_TowerMotion) - call MV_Pack2(Var, u%TowerMotion, ValAry) ! Mesh - case (AD_u_HubMotion) - call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh - case (AD_u_BladeRootMotion) - call MV_Pack2(Var, u%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (AD_u_BladeMotion) - call MV_Pack2(Var, u%BladeMotion(DL%i1), ValAry) ! Mesh - case (AD_u_TFinMotion) - call MV_Pack2(Var, u%TFinMotion, ValAry) ! Mesh - case (AD_u_UserProp) - call MV_Pack2(Var, u%UserProp, ValAry) ! Rank 2 Array - end select - end associate + call AD_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine AD_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(RotInputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD_u_NacelleMotion) + call MV_Unpack2(Var, ValAry, u%NacelleMotion) ! Mesh + case (AD_u_TowerMotion) + call MV_Unpack2(Var, ValAry, u%TowerMotion) ! Mesh + case (AD_u_HubMotion) + call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh + case (AD_u_BladeRootMotion) + call MV_Unpack2(Var, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (AD_u_BladeMotion) + call MV_Unpack2(Var, ValAry, u%BladeMotion(DL%i1)) ! Mesh + case (AD_u_TFinMotion) + call MV_Unpack2(Var, ValAry, u%TFinMotion) ! Mesh + case (AD_u_UserProp) + call MV_Unpack2(Var, ValAry, u%UserProp) ! Rank 2 Array + end select + end associate +end subroutine + subroutine AD_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(RotInputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (AD_u_NacelleMotion) - call MV_Unpack2(Var, ValAry, u%NacelleMotion) ! Mesh - case (AD_u_TowerMotion) - call MV_Unpack2(Var, ValAry, u%TowerMotion) ! Mesh - case (AD_u_HubMotion) - call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh - case (AD_u_BladeRootMotion) - call MV_Unpack2(Var, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh - case (AD_u_BladeMotion) - call MV_Unpack2(Var, ValAry, u%BladeMotion(DL%i1)) ! Mesh - case (AD_u_TFinMotion) - call MV_Unpack2(Var, ValAry, u%TFinMotion) ! Mesh - case (AD_u_UserProp) - call MV_Unpack2(Var, ValAry, u%UserProp) ! Rank 2 Array - end select - end associate + call AD_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine AD_PackOutputVar(Var, y, ValAry) + type(RotOutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD_y_NacelleLoad) + call MV_Pack2(Var, y%NacelleLoad, ValAry) ! Mesh + case (AD_y_HubLoad) + call MV_Pack2(Var, y%HubLoad, ValAry) ! Mesh + case (AD_y_TowerLoad) + call MV_Pack2(Var, y%TowerLoad, ValAry) ! Mesh + case (AD_y_BladeLoad) + call MV_Pack2(Var, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (AD_y_TFinLoad) + call MV_Pack2(Var, y%TFinLoad, ValAry) ! Mesh + case (AD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AD_PackOutputAry(Vars, y, ValAry) type(RotOutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (AD_y_NacelleLoad) - call MV_Pack2(Var, y%NacelleLoad, ValAry) ! Mesh - case (AD_y_HubLoad) - call MV_Pack2(Var, y%HubLoad, ValAry) ! Mesh - case (AD_y_TowerLoad) - call MV_Pack2(Var, y%TowerLoad, ValAry) ! Mesh - case (AD_y_BladeLoad) - call MV_Pack2(Var, y%BladeLoad(DL%i1), ValAry) ! Mesh - case (AD_y_TFinLoad) - call MV_Pack2(Var, y%TFinLoad, ValAry) ! Mesh - case (AD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call AD_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine AD_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(RotOutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD_y_NacelleLoad) + call MV_Unpack2(Var, ValAry, y%NacelleLoad) ! Mesh + case (AD_y_HubLoad) + call MV_Unpack2(Var, ValAry, y%HubLoad) ! Mesh + case (AD_y_TowerLoad) + call MV_Unpack2(Var, ValAry, y%TowerLoad) ! Mesh + case (AD_y_BladeLoad) + call MV_Unpack2(Var, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (AD_y_TFinLoad) + call MV_Unpack2(Var, ValAry, y%TFinLoad) ! Mesh + case (AD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine AD_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(RotOutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (AD_y_NacelleLoad) - call MV_Unpack2(Var, ValAry, y%NacelleLoad) ! Mesh - case (AD_y_HubLoad) - call MV_Unpack2(Var, ValAry, y%HubLoad) ! Mesh - case (AD_y_TowerLoad) - call MV_Unpack2(Var, ValAry, y%TowerLoad) ! Mesh - case (AD_y_BladeLoad) - call MV_Unpack2(Var, ValAry, y%BladeLoad(DL%i1)) ! Mesh - case (AD_y_TFinLoad) - call MV_Unpack2(Var, ValAry, y%TFinLoad) ! Mesh - case (AD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call AD_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE AeroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 99c6acef2a..5ff6a0914f 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -1495,104 +1495,142 @@ function AFI_OutputMeshName(ML) result(Name) end select end function +subroutine AFI_PackInputVar(Var, u, ValAry) + type(AFI_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AFI_u_AoA) + call MV_Pack2(Var, u%AoA, ValAry) ! Scalar + case (AFI_u_UserProp) + call MV_Pack2(Var, u%UserProp, ValAry) ! Scalar + case (AFI_u_Re) + call MV_Pack2(Var, u%Re, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AFI_PackInputAry(Vars, u, ValAry) type(AFI_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (AFI_u_AoA) - call MV_Pack2(Var, u%AoA, ValAry) ! Scalar - case (AFI_u_UserProp) - call MV_Pack2(Var, u%UserProp, ValAry) ! Scalar - case (AFI_u_Re) - call MV_Pack2(Var, u%Re, ValAry) ! Scalar - end select - end associate + call AFI_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine AFI_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AFI_u_AoA) + call MV_Unpack2(Var, ValAry, u%AoA) ! Scalar + case (AFI_u_UserProp) + call MV_Unpack2(Var, ValAry, u%UserProp) ! Scalar + case (AFI_u_Re) + call MV_Unpack2(Var, ValAry, u%Re) ! Scalar + end select + end associate +end subroutine + subroutine AFI_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AFI_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (AFI_u_AoA) - call MV_Unpack2(Var, ValAry, u%AoA) ! Scalar - case (AFI_u_UserProp) - call MV_Unpack2(Var, ValAry, u%UserProp) ! Scalar - case (AFI_u_Re) - call MV_Unpack2(Var, ValAry, u%Re) ! Scalar - end select - end associate + call AFI_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine AFI_PackOutputVar(Var, y, ValAry) + type(AFI_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AFI_y_Cl) + call MV_Pack2(Var, y%Cl, ValAry) ! Scalar + case (AFI_y_Cd) + call MV_Pack2(Var, y%Cd, ValAry) ! Scalar + case (AFI_y_Cm) + call MV_Pack2(Var, y%Cm, ValAry) ! Scalar + case (AFI_y_Cpmin) + call MV_Pack2(Var, y%Cpmin, ValAry) ! Scalar + case (AFI_y_Cd0) + call MV_Pack2(Var, y%Cd0, ValAry) ! Scalar + case (AFI_y_Cm0) + call MV_Pack2(Var, y%Cm0, ValAry) ! Scalar + case (AFI_y_f_st) + call MV_Pack2(Var, y%f_st, ValAry) ! Scalar + case (AFI_y_FullySeparate) + call MV_Pack2(Var, y%FullySeparate, ValAry) ! Scalar + case (AFI_y_FullyAttached) + call MV_Pack2(Var, y%FullyAttached, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AFI_PackOutputAry(Vars, y, ValAry) type(AFI_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (AFI_y_Cl) - call MV_Pack2(Var, y%Cl, ValAry) ! Scalar - case (AFI_y_Cd) - call MV_Pack2(Var, y%Cd, ValAry) ! Scalar - case (AFI_y_Cm) - call MV_Pack2(Var, y%Cm, ValAry) ! Scalar - case (AFI_y_Cpmin) - call MV_Pack2(Var, y%Cpmin, ValAry) ! Scalar - case (AFI_y_Cd0) - call MV_Pack2(Var, y%Cd0, ValAry) ! Scalar - case (AFI_y_Cm0) - call MV_Pack2(Var, y%Cm0, ValAry) ! Scalar - case (AFI_y_f_st) - call MV_Pack2(Var, y%f_st, ValAry) ! Scalar - case (AFI_y_FullySeparate) - call MV_Pack2(Var, y%FullySeparate, ValAry) ! Scalar - case (AFI_y_FullyAttached) - call MV_Pack2(Var, y%FullyAttached, ValAry) ! Scalar - end select - end associate + call AFI_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine AFI_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AFI_y_Cl) + call MV_Unpack2(Var, ValAry, y%Cl) ! Scalar + case (AFI_y_Cd) + call MV_Unpack2(Var, ValAry, y%Cd) ! Scalar + case (AFI_y_Cm) + call MV_Unpack2(Var, ValAry, y%Cm) ! Scalar + case (AFI_y_Cpmin) + call MV_Unpack2(Var, ValAry, y%Cpmin) ! Scalar + case (AFI_y_Cd0) + call MV_Unpack2(Var, ValAry, y%Cd0) ! Scalar + case (AFI_y_Cm0) + call MV_Unpack2(Var, ValAry, y%Cm0) ! Scalar + case (AFI_y_f_st) + call MV_Unpack2(Var, ValAry, y%f_st) ! Scalar + case (AFI_y_FullySeparate) + call MV_Unpack2(Var, ValAry, y%FullySeparate) ! Scalar + case (AFI_y_FullyAttached) + call MV_Unpack2(Var, ValAry, y%FullyAttached) ! Scalar + end select + end associate +end subroutine + subroutine AFI_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AFI_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (AFI_y_Cl) - call MV_Unpack2(Var, ValAry, y%Cl) ! Scalar - case (AFI_y_Cd) - call MV_Unpack2(Var, ValAry, y%Cd) ! Scalar - case (AFI_y_Cm) - call MV_Unpack2(Var, ValAry, y%Cm) ! Scalar - case (AFI_y_Cpmin) - call MV_Unpack2(Var, ValAry, y%Cpmin) ! Scalar - case (AFI_y_Cd0) - call MV_Unpack2(Var, ValAry, y%Cd0) ! Scalar - case (AFI_y_Cm0) - call MV_Unpack2(Var, ValAry, y%Cm0) ! Scalar - case (AFI_y_f_st) - call MV_Unpack2(Var, ValAry, y%f_st) ! Scalar - case (AFI_y_FullySeparate) - call MV_Unpack2(Var, ValAry, y%FullySeparate) ! Scalar - case (AFI_y_FullyAttached) - call MV_Unpack2(Var, ValAry, y%FullyAttached) ! Scalar - end select - end associate + call AFI_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE AirfoilInfo_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 6dac20d8f4..993dee9f85 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -2734,292 +2734,368 @@ function BEMT_OutputMeshName(ML) result(Name) end select end function +subroutine BEMT_PackContStateVar(Var, x, ValAry) + type(BEMT_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BEMT_x_UA_element_x) + call MV_Pack2(Var, x%UA%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + call MV_Pack2(Var, x%DBEMT%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + call MV_Pack2(Var, x%DBEMT%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array + case (BEMT_x_V_w) + call MV_Pack2(Var, x%V_w, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine BEMT_PackContStateAry(Vars, x, ValAry) type(BEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (BEMT_x_UA_element_x) - call MV_Pack2(Var, x%UA%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind) - call MV_Pack2(Var, x%DBEMT%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind_1) - call MV_Pack2(Var, x%DBEMT%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array - case (BEMT_x_V_w) - call MV_Pack2(Var, x%V_w, ValAry) ! Rank 1 Array - end select - end associate + call BEMT_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine BEMT_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BEMT_x_UA_element_x) + call MV_Unpack2(Var, ValAry, x%UA%element(DL%i1, DL%i2)%x) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + call MV_Unpack2(Var, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + call MV_Unpack2(Var, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array + case (BEMT_x_V_w) + call MV_Unpack2(Var, ValAry, x%V_w) ! Rank 1 Array + end select + end associate +end subroutine + subroutine BEMT_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BEMT_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (BEMT_x_UA_element_x) - call MV_Unpack2(Var, ValAry, x%UA%element(DL%i1, DL%i2)%x) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind) - call MV_Unpack2(Var, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind_1) - call MV_Unpack2(Var, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array - case (BEMT_x_V_w) - call MV_Unpack2(Var, ValAry, x%V_w) ! Rank 1 Array - end select - end associate + call BEMT_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine BEMT_PackConstrStateVar(Var, z, ValAry) + type(BEMT_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BEMT_z_phi) + call MV_Pack2(Var, z%phi, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine BEMT_PackConstrStateAry(Vars, z, ValAry) type(BEMT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (BEMT_z_phi) - call MV_Pack2(Var, z%phi, ValAry) ! Rank 2 Array - end select - end associate + call BEMT_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine BEMT_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BEMT_z_phi) + call MV_Unpack2(Var, ValAry, z%phi) ! Rank 2 Array + end select + end associate +end subroutine + subroutine BEMT_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BEMT_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (BEMT_z_phi) - call MV_Unpack2(Var, ValAry, z%phi) ! Rank 2 Array - end select - end associate + call BEMT_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine BEMT_PackInputVar(Var, u, ValAry) + type(BEMT_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BEMT_u_theta) + call MV_Pack2(Var, u%theta, ValAry) ! Rank 2 Array + case (BEMT_u_chi0) + call MV_Pack2(Var, u%chi0, ValAry) ! Scalar + case (BEMT_u_psiSkewOffset) + call MV_Pack2(Var, u%psiSkewOffset, ValAry) ! Scalar + case (BEMT_u_psi_s) + call MV_Pack2(Var, u%psi_s, ValAry) ! Rank 1 Array + case (BEMT_u_omega) + call MV_Pack2(Var, u%omega, ValAry) ! Scalar + case (BEMT_u_TSR) + call MV_Pack2(Var, u%TSR, ValAry) ! Scalar + case (BEMT_u_Vx) + call MV_Pack2(Var, u%Vx, ValAry) ! Rank 2 Array + case (BEMT_u_Vy) + call MV_Pack2(Var, u%Vy, ValAry) ! Rank 2 Array + case (BEMT_u_Vz) + call MV_Pack2(Var, u%Vz, ValAry) ! Rank 2 Array + case (BEMT_u_omega_z) + call MV_Pack2(Var, u%omega_z, ValAry) ! Rank 2 Array + case (BEMT_u_xVelCorr) + call MV_Pack2(Var, u%xVelCorr, ValAry) ! Rank 2 Array + case (BEMT_u_rLocal) + call MV_Pack2(Var, u%rLocal, ValAry) ! Rank 2 Array + case (BEMT_u_Un_disk) + call MV_Pack2(Var, u%Un_disk, ValAry) ! Scalar + case (BEMT_u_V0) + call MV_Pack2(Var, u%V0, ValAry) ! Rank 1 Array + case (BEMT_u_x_hat_disk) + call MV_Pack2(Var, u%x_hat_disk, ValAry) ! Rank 1 Array + case (BEMT_u_UserProp) + call MV_Pack2(Var, u%UserProp, ValAry) ! Rank 2 Array + case (BEMT_u_CantAngle) + call MV_Pack2(Var, u%CantAngle, ValAry) ! Rank 2 Array + case (BEMT_u_drdz) + call MV_Pack2(Var, u%drdz, ValAry) ! Rank 2 Array + case (BEMT_u_toeAngle) + call MV_Pack2(Var, u%toeAngle, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine BEMT_PackInputAry(Vars, u, ValAry) type(BEMT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (BEMT_u_theta) - call MV_Pack2(Var, u%theta, ValAry) ! Rank 2 Array - case (BEMT_u_chi0) - call MV_Pack2(Var, u%chi0, ValAry) ! Scalar - case (BEMT_u_psiSkewOffset) - call MV_Pack2(Var, u%psiSkewOffset, ValAry) ! Scalar - case (BEMT_u_psi_s) - call MV_Pack2(Var, u%psi_s, ValAry) ! Rank 1 Array - case (BEMT_u_omega) - call MV_Pack2(Var, u%omega, ValAry) ! Scalar - case (BEMT_u_TSR) - call MV_Pack2(Var, u%TSR, ValAry) ! Scalar - case (BEMT_u_Vx) - call MV_Pack2(Var, u%Vx, ValAry) ! Rank 2 Array - case (BEMT_u_Vy) - call MV_Pack2(Var, u%Vy, ValAry) ! Rank 2 Array - case (BEMT_u_Vz) - call MV_Pack2(Var, u%Vz, ValAry) ! Rank 2 Array - case (BEMT_u_omega_z) - call MV_Pack2(Var, u%omega_z, ValAry) ! Rank 2 Array - case (BEMT_u_xVelCorr) - call MV_Pack2(Var, u%xVelCorr, ValAry) ! Rank 2 Array - case (BEMT_u_rLocal) - call MV_Pack2(Var, u%rLocal, ValAry) ! Rank 2 Array - case (BEMT_u_Un_disk) - call MV_Pack2(Var, u%Un_disk, ValAry) ! Scalar - case (BEMT_u_V0) - call MV_Pack2(Var, u%V0, ValAry) ! Rank 1 Array - case (BEMT_u_x_hat_disk) - call MV_Pack2(Var, u%x_hat_disk, ValAry) ! Rank 1 Array - case (BEMT_u_UserProp) - call MV_Pack2(Var, u%UserProp, ValAry) ! Rank 2 Array - case (BEMT_u_CantAngle) - call MV_Pack2(Var, u%CantAngle, ValAry) ! Rank 2 Array - case (BEMT_u_drdz) - call MV_Pack2(Var, u%drdz, ValAry) ! Rank 2 Array - case (BEMT_u_toeAngle) - call MV_Pack2(Var, u%toeAngle, ValAry) ! Rank 2 Array - end select - end associate + call BEMT_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine BEMT_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BEMT_u_theta) + call MV_Unpack2(Var, ValAry, u%theta) ! Rank 2 Array + case (BEMT_u_chi0) + call MV_Unpack2(Var, ValAry, u%chi0) ! Scalar + case (BEMT_u_psiSkewOffset) + call MV_Unpack2(Var, ValAry, u%psiSkewOffset) ! Scalar + case (BEMT_u_psi_s) + call MV_Unpack2(Var, ValAry, u%psi_s) ! Rank 1 Array + case (BEMT_u_omega) + call MV_Unpack2(Var, ValAry, u%omega) ! Scalar + case (BEMT_u_TSR) + call MV_Unpack2(Var, ValAry, u%TSR) ! Scalar + case (BEMT_u_Vx) + call MV_Unpack2(Var, ValAry, u%Vx) ! Rank 2 Array + case (BEMT_u_Vy) + call MV_Unpack2(Var, ValAry, u%Vy) ! Rank 2 Array + case (BEMT_u_Vz) + call MV_Unpack2(Var, ValAry, u%Vz) ! Rank 2 Array + case (BEMT_u_omega_z) + call MV_Unpack2(Var, ValAry, u%omega_z) ! Rank 2 Array + case (BEMT_u_xVelCorr) + call MV_Unpack2(Var, ValAry, u%xVelCorr) ! Rank 2 Array + case (BEMT_u_rLocal) + call MV_Unpack2(Var, ValAry, u%rLocal) ! Rank 2 Array + case (BEMT_u_Un_disk) + call MV_Unpack2(Var, ValAry, u%Un_disk) ! Scalar + case (BEMT_u_V0) + call MV_Unpack2(Var, ValAry, u%V0) ! Rank 1 Array + case (BEMT_u_x_hat_disk) + call MV_Unpack2(Var, ValAry, u%x_hat_disk) ! Rank 1 Array + case (BEMT_u_UserProp) + call MV_Unpack2(Var, ValAry, u%UserProp) ! Rank 2 Array + case (BEMT_u_CantAngle) + call MV_Unpack2(Var, ValAry, u%CantAngle) ! Rank 2 Array + case (BEMT_u_drdz) + call MV_Unpack2(Var, ValAry, u%drdz) ! Rank 2 Array + case (BEMT_u_toeAngle) + call MV_Unpack2(Var, ValAry, u%toeAngle) ! Rank 2 Array + end select + end associate +end subroutine + subroutine BEMT_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BEMT_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (BEMT_u_theta) - call MV_Unpack2(Var, ValAry, u%theta) ! Rank 2 Array - case (BEMT_u_chi0) - call MV_Unpack2(Var, ValAry, u%chi0) ! Scalar - case (BEMT_u_psiSkewOffset) - call MV_Unpack2(Var, ValAry, u%psiSkewOffset) ! Scalar - case (BEMT_u_psi_s) - call MV_Unpack2(Var, ValAry, u%psi_s) ! Rank 1 Array - case (BEMT_u_omega) - call MV_Unpack2(Var, ValAry, u%omega) ! Scalar - case (BEMT_u_TSR) - call MV_Unpack2(Var, ValAry, u%TSR) ! Scalar - case (BEMT_u_Vx) - call MV_Unpack2(Var, ValAry, u%Vx) ! Rank 2 Array - case (BEMT_u_Vy) - call MV_Unpack2(Var, ValAry, u%Vy) ! Rank 2 Array - case (BEMT_u_Vz) - call MV_Unpack2(Var, ValAry, u%Vz) ! Rank 2 Array - case (BEMT_u_omega_z) - call MV_Unpack2(Var, ValAry, u%omega_z) ! Rank 2 Array - case (BEMT_u_xVelCorr) - call MV_Unpack2(Var, ValAry, u%xVelCorr) ! Rank 2 Array - case (BEMT_u_rLocal) - call MV_Unpack2(Var, ValAry, u%rLocal) ! Rank 2 Array - case (BEMT_u_Un_disk) - call MV_Unpack2(Var, ValAry, u%Un_disk) ! Scalar - case (BEMT_u_V0) - call MV_Unpack2(Var, ValAry, u%V0) ! Rank 1 Array - case (BEMT_u_x_hat_disk) - call MV_Unpack2(Var, ValAry, u%x_hat_disk) ! Rank 1 Array - case (BEMT_u_UserProp) - call MV_Unpack2(Var, ValAry, u%UserProp) ! Rank 2 Array - case (BEMT_u_CantAngle) - call MV_Unpack2(Var, ValAry, u%CantAngle) ! Rank 2 Array - case (BEMT_u_drdz) - call MV_Unpack2(Var, ValAry, u%drdz) ! Rank 2 Array - case (BEMT_u_toeAngle) - call MV_Unpack2(Var, ValAry, u%toeAngle) ! Rank 2 Array - end select - end associate + call BEMT_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine BEMT_PackOutputVar(Var, y, ValAry) + type(BEMT_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BEMT_y_Vrel) + call MV_Pack2(Var, y%Vrel, ValAry) ! Rank 2 Array + case (BEMT_y_phi) + call MV_Pack2(Var, y%phi, ValAry) ! Rank 2 Array + case (BEMT_y_axInduction) + call MV_Pack2(Var, y%axInduction, ValAry) ! Rank 2 Array + case (BEMT_y_tanInduction) + call MV_Pack2(Var, y%tanInduction, ValAry) ! Rank 2 Array + case (BEMT_y_axInduction_qs) + call MV_Pack2(Var, y%axInduction_qs, ValAry) ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + call MV_Pack2(Var, y%tanInduction_qs, ValAry) ! Rank 2 Array + case (BEMT_y_k) + call MV_Pack2(Var, y%k, ValAry) ! Rank 2 Array + case (BEMT_y_k_p) + call MV_Pack2(Var, y%k_p, ValAry) ! Rank 2 Array + case (BEMT_y_F) + call MV_Pack2(Var, y%F, ValAry) ! Rank 2 Array + case (BEMT_y_Re) + call MV_Pack2(Var, y%Re, ValAry) ! Rank 2 Array + case (BEMT_y_AOA) + call MV_Pack2(Var, y%AOA, ValAry) ! Rank 2 Array + case (BEMT_y_Cx) + call MV_Pack2(Var, y%Cx, ValAry) ! Rank 2 Array + case (BEMT_y_Cy) + call MV_Pack2(Var, y%Cy, ValAry) ! Rank 2 Array + case (BEMT_y_Cz) + call MV_Pack2(Var, y%Cz, ValAry) ! Rank 2 Array + case (BEMT_y_Cmx) + call MV_Pack2(Var, y%Cmx, ValAry) ! Rank 2 Array + case (BEMT_y_Cmy) + call MV_Pack2(Var, y%Cmy, ValAry) ! Rank 2 Array + case (BEMT_y_Cmz) + call MV_Pack2(Var, y%Cmz, ValAry) ! Rank 2 Array + case (BEMT_y_Cm) + call MV_Pack2(Var, y%Cm, ValAry) ! Rank 2 Array + case (BEMT_y_Cl) + call MV_Pack2(Var, y%Cl, ValAry) ! Rank 2 Array + case (BEMT_y_Cd) + call MV_Pack2(Var, y%Cd, ValAry) ! Rank 2 Array + case (BEMT_y_chi) + call MV_Pack2(Var, y%chi, ValAry) ! Rank 2 Array + case (BEMT_y_Cpmin) + call MV_Pack2(Var, y%Cpmin, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine BEMT_PackOutputAry(Vars, y, ValAry) type(BEMT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (BEMT_y_Vrel) - call MV_Pack2(Var, y%Vrel, ValAry) ! Rank 2 Array - case (BEMT_y_phi) - call MV_Pack2(Var, y%phi, ValAry) ! Rank 2 Array - case (BEMT_y_axInduction) - call MV_Pack2(Var, y%axInduction, ValAry) ! Rank 2 Array - case (BEMT_y_tanInduction) - call MV_Pack2(Var, y%tanInduction, ValAry) ! Rank 2 Array - case (BEMT_y_axInduction_qs) - call MV_Pack2(Var, y%axInduction_qs, ValAry) ! Rank 2 Array - case (BEMT_y_tanInduction_qs) - call MV_Pack2(Var, y%tanInduction_qs, ValAry) ! Rank 2 Array - case (BEMT_y_k) - call MV_Pack2(Var, y%k, ValAry) ! Rank 2 Array - case (BEMT_y_k_p) - call MV_Pack2(Var, y%k_p, ValAry) ! Rank 2 Array - case (BEMT_y_F) - call MV_Pack2(Var, y%F, ValAry) ! Rank 2 Array - case (BEMT_y_Re) - call MV_Pack2(Var, y%Re, ValAry) ! Rank 2 Array - case (BEMT_y_AOA) - call MV_Pack2(Var, y%AOA, ValAry) ! Rank 2 Array - case (BEMT_y_Cx) - call MV_Pack2(Var, y%Cx, ValAry) ! Rank 2 Array - case (BEMT_y_Cy) - call MV_Pack2(Var, y%Cy, ValAry) ! Rank 2 Array - case (BEMT_y_Cz) - call MV_Pack2(Var, y%Cz, ValAry) ! Rank 2 Array - case (BEMT_y_Cmx) - call MV_Pack2(Var, y%Cmx, ValAry) ! Rank 2 Array - case (BEMT_y_Cmy) - call MV_Pack2(Var, y%Cmy, ValAry) ! Rank 2 Array - case (BEMT_y_Cmz) - call MV_Pack2(Var, y%Cmz, ValAry) ! Rank 2 Array - case (BEMT_y_Cm) - call MV_Pack2(Var, y%Cm, ValAry) ! Rank 2 Array - case (BEMT_y_Cl) - call MV_Pack2(Var, y%Cl, ValAry) ! Rank 2 Array - case (BEMT_y_Cd) - call MV_Pack2(Var, y%Cd, ValAry) ! Rank 2 Array - case (BEMT_y_chi) - call MV_Pack2(Var, y%chi, ValAry) ! Rank 2 Array - case (BEMT_y_Cpmin) - call MV_Pack2(Var, y%Cpmin, ValAry) ! Rank 2 Array - end select - end associate + call BEMT_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine BEMT_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BEMT_y_Vrel) + call MV_Unpack2(Var, ValAry, y%Vrel) ! Rank 2 Array + case (BEMT_y_phi) + call MV_Unpack2(Var, ValAry, y%phi) ! Rank 2 Array + case (BEMT_y_axInduction) + call MV_Unpack2(Var, ValAry, y%axInduction) ! Rank 2 Array + case (BEMT_y_tanInduction) + call MV_Unpack2(Var, ValAry, y%tanInduction) ! Rank 2 Array + case (BEMT_y_axInduction_qs) + call MV_Unpack2(Var, ValAry, y%axInduction_qs) ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + call MV_Unpack2(Var, ValAry, y%tanInduction_qs) ! Rank 2 Array + case (BEMT_y_k) + call MV_Unpack2(Var, ValAry, y%k) ! Rank 2 Array + case (BEMT_y_k_p) + call MV_Unpack2(Var, ValAry, y%k_p) ! Rank 2 Array + case (BEMT_y_F) + call MV_Unpack2(Var, ValAry, y%F) ! Rank 2 Array + case (BEMT_y_Re) + call MV_Unpack2(Var, ValAry, y%Re) ! Rank 2 Array + case (BEMT_y_AOA) + call MV_Unpack2(Var, ValAry, y%AOA) ! Rank 2 Array + case (BEMT_y_Cx) + call MV_Unpack2(Var, ValAry, y%Cx) ! Rank 2 Array + case (BEMT_y_Cy) + call MV_Unpack2(Var, ValAry, y%Cy) ! Rank 2 Array + case (BEMT_y_Cz) + call MV_Unpack2(Var, ValAry, y%Cz) ! Rank 2 Array + case (BEMT_y_Cmx) + call MV_Unpack2(Var, ValAry, y%Cmx) ! Rank 2 Array + case (BEMT_y_Cmy) + call MV_Unpack2(Var, ValAry, y%Cmy) ! Rank 2 Array + case (BEMT_y_Cmz) + call MV_Unpack2(Var, ValAry, y%Cmz) ! Rank 2 Array + case (BEMT_y_Cm) + call MV_Unpack2(Var, ValAry, y%Cm) ! Rank 2 Array + case (BEMT_y_Cl) + call MV_Unpack2(Var, ValAry, y%Cl) ! Rank 2 Array + case (BEMT_y_Cd) + call MV_Unpack2(Var, ValAry, y%Cd) ! Rank 2 Array + case (BEMT_y_chi) + call MV_Unpack2(Var, ValAry, y%chi) ! Rank 2 Array + case (BEMT_y_Cpmin) + call MV_Unpack2(Var, ValAry, y%Cpmin) ! Rank 2 Array + end select + end associate +end subroutine + subroutine BEMT_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BEMT_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (BEMT_y_Vrel) - call MV_Unpack2(Var, ValAry, y%Vrel) ! Rank 2 Array - case (BEMT_y_phi) - call MV_Unpack2(Var, ValAry, y%phi) ! Rank 2 Array - case (BEMT_y_axInduction) - call MV_Unpack2(Var, ValAry, y%axInduction) ! Rank 2 Array - case (BEMT_y_tanInduction) - call MV_Unpack2(Var, ValAry, y%tanInduction) ! Rank 2 Array - case (BEMT_y_axInduction_qs) - call MV_Unpack2(Var, ValAry, y%axInduction_qs) ! Rank 2 Array - case (BEMT_y_tanInduction_qs) - call MV_Unpack2(Var, ValAry, y%tanInduction_qs) ! Rank 2 Array - case (BEMT_y_k) - call MV_Unpack2(Var, ValAry, y%k) ! Rank 2 Array - case (BEMT_y_k_p) - call MV_Unpack2(Var, ValAry, y%k_p) ! Rank 2 Array - case (BEMT_y_F) - call MV_Unpack2(Var, ValAry, y%F) ! Rank 2 Array - case (BEMT_y_Re) - call MV_Unpack2(Var, ValAry, y%Re) ! Rank 2 Array - case (BEMT_y_AOA) - call MV_Unpack2(Var, ValAry, y%AOA) ! Rank 2 Array - case (BEMT_y_Cx) - call MV_Unpack2(Var, ValAry, y%Cx) ! Rank 2 Array - case (BEMT_y_Cy) - call MV_Unpack2(Var, ValAry, y%Cy) ! Rank 2 Array - case (BEMT_y_Cz) - call MV_Unpack2(Var, ValAry, y%Cz) ! Rank 2 Array - case (BEMT_y_Cmx) - call MV_Unpack2(Var, ValAry, y%Cmx) ! Rank 2 Array - case (BEMT_y_Cmy) - call MV_Unpack2(Var, ValAry, y%Cmy) ! Rank 2 Array - case (BEMT_y_Cmz) - call MV_Unpack2(Var, ValAry, y%Cmz) ! Rank 2 Array - case (BEMT_y_Cm) - call MV_Unpack2(Var, ValAry, y%Cm) ! Rank 2 Array - case (BEMT_y_Cl) - call MV_Unpack2(Var, ValAry, y%Cl) ! Rank 2 Array - case (BEMT_y_Cd) - call MV_Unpack2(Var, ValAry, y%Cd) ! Rank 2 Array - case (BEMT_y_chi) - call MV_Unpack2(Var, ValAry, y%chi) ! Rank 2 Array - case (BEMT_y_Cpmin) - call MV_Unpack2(Var, ValAry, y%Cpmin) ! Rank 2 Array - end select - end associate + call BEMT_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE BEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 75c8ece2ed..33cb9ddea5 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -1459,144 +1459,220 @@ function DBEMT_OutputMeshName(ML) result(Name) end select end function +subroutine DBEMT_PackContStateVar(Var, x, ValAry) + type(DBEMT_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DBEMT_x_element_vind) + call MV_Pack2(Var, x%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + call MV_Pack2(Var, x%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine DBEMT_PackContStateAry(Vars, x, ValAry) type(DBEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (DBEMT_x_element_vind) - call MV_Pack2(Var, x%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array - case (DBEMT_x_element_vind_1) - call MV_Pack2(Var, x%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array - end select - end associate + call DBEMT_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine DBEMT_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DBEMT_x_element_vind) + call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%vind) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array + end select + end associate +end subroutine + subroutine DBEMT_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (DBEMT_x_element_vind) - call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%vind) ! Rank 1 Array - case (DBEMT_x_element_vind_1) - call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array - end select - end associate + call DBEMT_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine DBEMT_PackConstrStateVar(Var, z, ValAry) + type(DBEMT_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DBEMT_z_DummyState) + call MV_Pack2(Var, z%DummyState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine DBEMT_PackConstrStateAry(Vars, z, ValAry) type(DBEMT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (DBEMT_z_DummyState) - call MV_Pack2(Var, z%DummyState, ValAry) ! Scalar - end select - end associate + call DBEMT_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine DBEMT_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DBEMT_z_DummyState) + call MV_Unpack2(Var, ValAry, z%DummyState) ! Scalar + end select + end associate +end subroutine + subroutine DBEMT_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (DBEMT_z_DummyState) - call MV_Unpack2(Var, ValAry, z%DummyState) ! Scalar - end select - end associate + call DBEMT_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine DBEMT_PackInputVar(Var, u, ValAry) + type(DBEMT_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DBEMT_u_AxInd_disk) + call MV_Pack2(Var, u%AxInd_disk, ValAry) ! Scalar + case (DBEMT_u_Un_disk) + call MV_Pack2(Var, u%Un_disk, ValAry) ! Scalar + case (DBEMT_u_R_disk) + call MV_Pack2(Var, u%R_disk, ValAry) ! Scalar + case (DBEMT_u_element_vind_s) + call MV_Pack2(Var, u%element(DL%i1, DL%i2)%vind_s, ValAry) ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + call MV_Pack2(Var, u%element(DL%i1, DL%i2)%spanRatio, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine DBEMT_PackInputAry(Vars, u, ValAry) type(DBEMT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (DBEMT_u_AxInd_disk) - call MV_Pack2(Var, u%AxInd_disk, ValAry) ! Scalar - case (DBEMT_u_Un_disk) - call MV_Pack2(Var, u%Un_disk, ValAry) ! Scalar - case (DBEMT_u_R_disk) - call MV_Pack2(Var, u%R_disk, ValAry) ! Scalar - case (DBEMT_u_element_vind_s) - call MV_Pack2(Var, u%element(DL%i1, DL%i2)%vind_s, ValAry) ! Rank 1 Array - case (DBEMT_u_element_spanRatio) - call MV_Pack2(Var, u%element(DL%i1, DL%i2)%spanRatio, ValAry) ! Scalar - end select - end associate + call DBEMT_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine DBEMT_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DBEMT_u_AxInd_disk) + call MV_Unpack2(Var, ValAry, u%AxInd_disk) ! Scalar + case (DBEMT_u_Un_disk) + call MV_Unpack2(Var, ValAry, u%Un_disk) ! Scalar + case (DBEMT_u_R_disk) + call MV_Unpack2(Var, ValAry, u%R_disk) ! Scalar + case (DBEMT_u_element_vind_s) + call MV_Unpack2(Var, ValAry, u%element(DL%i1, DL%i2)%vind_s) ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + call MV_Unpack2(Var, ValAry, u%element(DL%i1, DL%i2)%spanRatio) ! Scalar + end select + end associate +end subroutine + subroutine DBEMT_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (DBEMT_u_AxInd_disk) - call MV_Unpack2(Var, ValAry, u%AxInd_disk) ! Scalar - case (DBEMT_u_Un_disk) - call MV_Unpack2(Var, ValAry, u%Un_disk) ! Scalar - case (DBEMT_u_R_disk) - call MV_Unpack2(Var, ValAry, u%R_disk) ! Scalar - case (DBEMT_u_element_vind_s) - call MV_Unpack2(Var, ValAry, u%element(DL%i1, DL%i2)%vind_s) ! Rank 1 Array - case (DBEMT_u_element_spanRatio) - call MV_Unpack2(Var, ValAry, u%element(DL%i1, DL%i2)%spanRatio) ! Scalar - end select - end associate + call DBEMT_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine DBEMT_PackOutputVar(Var, y, ValAry) + type(DBEMT_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DBEMT_y_vind) + call MV_Pack2(Var, y%vind, ValAry) ! Rank 3 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine DBEMT_PackOutputAry(Vars, y, ValAry) type(DBEMT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (DBEMT_y_vind) - call MV_Pack2(Var, y%vind, ValAry) ! Rank 3 Array - end select - end associate + call DBEMT_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine DBEMT_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DBEMT_y_vind) + call MV_Unpack2(Var, ValAry, y%vind) ! Rank 3 Array + end select + end associate +end subroutine + subroutine DBEMT_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (DBEMT_y_vind) - call MV_Unpack2(Var, ValAry, y%vind) ! Rank 3 Array - end select - end associate + call DBEMT_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE DBEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 4f3e7443ce..230b91a91e 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -4143,172 +4143,248 @@ function FVW_OutputMeshName(ML) result(Name) end select end function +subroutine FVW_PackContStateVar(Var, x, ValAry) + type(FVW_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FVW_x_W_Gamma_NW) + call MV_Pack2(Var, x%W(DL%i1)%Gamma_NW, ValAry) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + call MV_Pack2(Var, x%W(DL%i1)%Gamma_FW, ValAry) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + call MV_Pack2(Var, x%W(DL%i1)%Eps_NW, ValAry) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + call MV_Pack2(Var, x%W(DL%i1)%Eps_FW, ValAry) ! Rank 3 Array + case (FVW_x_W_r_NW) + call MV_Pack2(Var, x%W(DL%i1)%r_NW, ValAry) ! Rank 3 Array + case (FVW_x_W_r_FW) + call MV_Pack2(Var, x%W(DL%i1)%r_FW, ValAry) ! Rank 3 Array + case (FVW_x_UA_element_x) + call MV_Pack2(Var, x%UA(DL%i1)%element(DL%i2, DL%i3)%x, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine FVW_PackContStateAry(Vars, x, ValAry) type(FVW_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (FVW_x_W_Gamma_NW) - call MV_Pack2(Var, x%W(DL%i1)%Gamma_NW, ValAry) ! Rank 2 Array - case (FVW_x_W_Gamma_FW) - call MV_Pack2(Var, x%W(DL%i1)%Gamma_FW, ValAry) ! Rank 2 Array - case (FVW_x_W_Eps_NW) - call MV_Pack2(Var, x%W(DL%i1)%Eps_NW, ValAry) ! Rank 3 Array - case (FVW_x_W_Eps_FW) - call MV_Pack2(Var, x%W(DL%i1)%Eps_FW, ValAry) ! Rank 3 Array - case (FVW_x_W_r_NW) - call MV_Pack2(Var, x%W(DL%i1)%r_NW, ValAry) ! Rank 3 Array - case (FVW_x_W_r_FW) - call MV_Pack2(Var, x%W(DL%i1)%r_FW, ValAry) ! Rank 3 Array - case (FVW_x_UA_element_x) - call MV_Pack2(Var, x%UA(DL%i1)%element(DL%i2, DL%i3)%x, ValAry) ! Rank 1 Array - end select - end associate + call FVW_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine FVW_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FVW_x_W_Gamma_NW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Gamma_NW) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Gamma_FW) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Eps_NW) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Eps_FW) ! Rank 3 Array + case (FVW_x_W_r_NW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%r_NW) ! Rank 3 Array + case (FVW_x_W_r_FW) + call MV_Unpack2(Var, ValAry, x%W(DL%i1)%r_FW) ! Rank 3 Array + case (FVW_x_UA_element_x) + call MV_Unpack2(Var, ValAry, x%UA(DL%i1)%element(DL%i2, DL%i3)%x) ! Rank 1 Array + end select + end associate +end subroutine + subroutine FVW_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FVW_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (FVW_x_W_Gamma_NW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Gamma_NW) ! Rank 2 Array - case (FVW_x_W_Gamma_FW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Gamma_FW) ! Rank 2 Array - case (FVW_x_W_Eps_NW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Eps_NW) ! Rank 3 Array - case (FVW_x_W_Eps_FW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Eps_FW) ! Rank 3 Array - case (FVW_x_W_r_NW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%r_NW) ! Rank 3 Array - case (FVW_x_W_r_FW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%r_FW) ! Rank 3 Array - case (FVW_x_UA_element_x) - call MV_Unpack2(Var, ValAry, x%UA(DL%i1)%element(DL%i2, DL%i3)%x) ! Rank 1 Array - end select - end associate + call FVW_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine FVW_PackConstrStateVar(Var, z, ValAry) + type(FVW_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FVW_z_W_Gamma_LL) + call MV_Pack2(Var, z%W(DL%i1)%Gamma_LL, ValAry) ! Rank 1 Array + case (FVW_z_residual) + call MV_Pack2(Var, z%residual, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine FVW_PackConstrStateAry(Vars, z, ValAry) type(FVW_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (FVW_z_W_Gamma_LL) - call MV_Pack2(Var, z%W(DL%i1)%Gamma_LL, ValAry) ! Rank 1 Array - case (FVW_z_residual) - call MV_Pack2(Var, z%residual, ValAry) ! Scalar - end select - end associate + call FVW_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine FVW_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FVW_z_W_Gamma_LL) + call MV_Unpack2(Var, ValAry, z%W(DL%i1)%Gamma_LL) ! Rank 1 Array + case (FVW_z_residual) + call MV_Unpack2(Var, ValAry, z%residual) ! Scalar + end select + end associate +end subroutine + subroutine FVW_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FVW_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (FVW_z_W_Gamma_LL) - call MV_Unpack2(Var, ValAry, z%W(DL%i1)%Gamma_LL) ! Rank 1 Array - case (FVW_z_residual) - call MV_Unpack2(Var, ValAry, z%residual) ! Scalar - end select - end associate + call FVW_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine FVW_PackInputVar(Var, u, ValAry) + type(FVW_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FVW_u_rotors_HubOrientation) + call MV_Pack2(Var, u%rotors(DL%i1)%HubOrientation, ValAry) ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + call MV_Pack2(Var, u%rotors(DL%i1)%HubPosition, ValAry) ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + call MV_Pack2(Var, u%W(DL%i1)%Vwnd_LL, ValAry) ! Rank 2 Array + case (FVW_u_W_omega_z) + call MV_Pack2(Var, u%W(DL%i1)%omega_z, ValAry) ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_Pack2(Var, u%WingsMesh(DL%i1), ValAry) ! Mesh + case (FVW_u_V_wind) + call MV_Pack2(Var, u%V_wind, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine FVW_PackInputAry(Vars, u, ValAry) type(FVW_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (FVW_u_rotors_HubOrientation) - call MV_Pack2(Var, u%rotors(DL%i1)%HubOrientation, ValAry) ! Rank 2 Array - case (FVW_u_rotors_HubPosition) - call MV_Pack2(Var, u%rotors(DL%i1)%HubPosition, ValAry) ! Rank 1 Array - case (FVW_u_W_Vwnd_LL) - call MV_Pack2(Var, u%W(DL%i1)%Vwnd_LL, ValAry) ! Rank 2 Array - case (FVW_u_W_omega_z) - call MV_Pack2(Var, u%W(DL%i1)%omega_z, ValAry) ! Rank 1 Array - case (FVW_u_WingsMesh) - call MV_Pack2(Var, u%WingsMesh(DL%i1), ValAry) ! Mesh - case (FVW_u_V_wind) - call MV_Pack2(Var, u%V_wind, ValAry) ! Rank 2 Array - end select - end associate + call FVW_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine FVW_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FVW_u_rotors_HubOrientation) + call MV_Unpack2(Var, ValAry, u%rotors(DL%i1)%HubOrientation) ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + call MV_Unpack2(Var, ValAry, u%rotors(DL%i1)%HubPosition) ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + call MV_Unpack2(Var, ValAry, u%W(DL%i1)%Vwnd_LL) ! Rank 2 Array + case (FVW_u_W_omega_z) + call MV_Unpack2(Var, ValAry, u%W(DL%i1)%omega_z) ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_Unpack2(Var, ValAry, u%WingsMesh(DL%i1)) ! Mesh + case (FVW_u_V_wind) + call MV_Unpack2(Var, ValAry, u%V_wind) ! Rank 2 Array + end select + end associate +end subroutine + subroutine FVW_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FVW_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (FVW_u_rotors_HubOrientation) - call MV_Unpack2(Var, ValAry, u%rotors(DL%i1)%HubOrientation) ! Rank 2 Array - case (FVW_u_rotors_HubPosition) - call MV_Unpack2(Var, ValAry, u%rotors(DL%i1)%HubPosition) ! Rank 1 Array - case (FVW_u_W_Vwnd_LL) - call MV_Unpack2(Var, ValAry, u%W(DL%i1)%Vwnd_LL) ! Rank 2 Array - case (FVW_u_W_omega_z) - call MV_Unpack2(Var, ValAry, u%W(DL%i1)%omega_z) ! Rank 1 Array - case (FVW_u_WingsMesh) - call MV_Unpack2(Var, ValAry, u%WingsMesh(DL%i1)) ! Mesh - case (FVW_u_V_wind) - call MV_Unpack2(Var, ValAry, u%V_wind) ! Rank 2 Array - end select - end associate + call FVW_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine FVW_PackOutputVar(Var, y, ValAry) + type(FVW_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FVW_y_W_Vind) + call MV_Pack2(Var, y%W(DL%i1)%Vind, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine FVW_PackOutputAry(Vars, y, ValAry) type(FVW_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (FVW_y_W_Vind) - call MV_Pack2(Var, y%W(DL%i1)%Vind, ValAry) ! Rank 2 Array - end select - end associate + call FVW_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine FVW_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FVW_y_W_Vind) + call MV_Unpack2(Var, ValAry, y%W(DL%i1)%Vind) ! Rank 2 Array + end select + end associate +end subroutine + subroutine FVW_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FVW_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (FVW_y_W_Vind) - call MV_Unpack2(Var, ValAry, y%W(DL%i1)%Vind) ! Rank 2 Array - end select - end associate + call FVW_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE FVW_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 75b60b52fe..0f7ab0bef0 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -2570,164 +2570,240 @@ function UA_OutputMeshName(ML) result(Name) end select end function +subroutine UA_PackContStateVar(Var, x, ValAry) + type(UA_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (UA_x_element_x) + call MV_Pack2(Var, x%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine UA_PackContStateAry(Vars, x, ValAry) type(UA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (UA_x_element_x) - call MV_Pack2(Var, x%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array - end select - end associate + call UA_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine UA_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (UA_x_element_x) + call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%x) ! Rank 1 Array + end select + end associate +end subroutine + subroutine UA_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(UA_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (UA_x_element_x) - call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%x) ! Rank 1 Array - end select - end associate + call UA_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine UA_PackConstrStateVar(Var, z, ValAry) + type(UA_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (UA_z_DummyConstraintState) + call MV_Pack2(Var, z%DummyConstraintState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine UA_PackConstrStateAry(Vars, z, ValAry) type(UA_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (UA_z_DummyConstraintState) - call MV_Pack2(Var, z%DummyConstraintState, ValAry) ! Scalar - end select - end associate + call UA_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine UA_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (UA_z_DummyConstraintState) + call MV_Unpack2(Var, ValAry, z%DummyConstraintState) ! Scalar + end select + end associate +end subroutine + subroutine UA_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(UA_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (UA_z_DummyConstraintState) - call MV_Unpack2(Var, ValAry, z%DummyConstraintState) ! Scalar - end select - end associate + call UA_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine UA_PackInputVar(Var, u, ValAry) + type(UA_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (UA_u_U) + call MV_Pack2(Var, u%U, ValAry) ! Scalar + case (UA_u_alpha) + call MV_Pack2(Var, u%alpha, ValAry) ! Scalar + case (UA_u_Re) + call MV_Pack2(Var, u%Re, ValAry) ! Scalar + case (UA_u_UserProp) + call MV_Pack2(Var, u%UserProp, ValAry) ! Scalar + case (UA_u_v_ac) + call MV_Pack2(Var, u%v_ac, ValAry) ! Rank 1 Array + case (UA_u_omega) + call MV_Pack2(Var, u%omega, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine UA_PackInputAry(Vars, u, ValAry) type(UA_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (UA_u_U) - call MV_Pack2(Var, u%U, ValAry) ! Scalar - case (UA_u_alpha) - call MV_Pack2(Var, u%alpha, ValAry) ! Scalar - case (UA_u_Re) - call MV_Pack2(Var, u%Re, ValAry) ! Scalar - case (UA_u_UserProp) - call MV_Pack2(Var, u%UserProp, ValAry) ! Scalar - case (UA_u_v_ac) - call MV_Pack2(Var, u%v_ac, ValAry) ! Rank 1 Array - case (UA_u_omega) - call MV_Pack2(Var, u%omega, ValAry) ! Scalar - end select - end associate + call UA_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine UA_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(UA_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (UA_u_U) + call MV_Unpack2(Var, ValAry, u%U) ! Scalar + case (UA_u_alpha) + call MV_Unpack2(Var, ValAry, u%alpha) ! Scalar + case (UA_u_Re) + call MV_Unpack2(Var, ValAry, u%Re) ! Scalar + case (UA_u_UserProp) + call MV_Unpack2(Var, ValAry, u%UserProp) ! Scalar + case (UA_u_v_ac) + call MV_Unpack2(Var, ValAry, u%v_ac) ! Rank 1 Array + case (UA_u_omega) + call MV_Unpack2(Var, ValAry, u%omega) ! Scalar + end select + end associate +end subroutine + subroutine UA_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(UA_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (UA_u_U) - call MV_Unpack2(Var, ValAry, u%U) ! Scalar - case (UA_u_alpha) - call MV_Unpack2(Var, ValAry, u%alpha) ! Scalar - case (UA_u_Re) - call MV_Unpack2(Var, ValAry, u%Re) ! Scalar - case (UA_u_UserProp) - call MV_Unpack2(Var, ValAry, u%UserProp) ! Scalar - case (UA_u_v_ac) - call MV_Unpack2(Var, ValAry, u%v_ac) ! Rank 1 Array - case (UA_u_omega) - call MV_Unpack2(Var, ValAry, u%omega) ! Scalar - end select - end associate + call UA_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine UA_PackOutputVar(Var, y, ValAry) + type(UA_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (UA_y_Cn) + call MV_Pack2(Var, y%Cn, ValAry) ! Scalar + case (UA_y_Cc) + call MV_Pack2(Var, y%Cc, ValAry) ! Scalar + case (UA_y_Cm) + call MV_Pack2(Var, y%Cm, ValAry) ! Scalar + case (UA_y_Cl) + call MV_Pack2(Var, y%Cl, ValAry) ! Scalar + case (UA_y_Cd) + call MV_Pack2(Var, y%Cd, ValAry) ! Scalar + case (UA_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine UA_PackOutputAry(Vars, y, ValAry) type(UA_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (UA_y_Cn) - call MV_Pack2(Var, y%Cn, ValAry) ! Scalar - case (UA_y_Cc) - call MV_Pack2(Var, y%Cc, ValAry) ! Scalar - case (UA_y_Cm) - call MV_Pack2(Var, y%Cm, ValAry) ! Scalar - case (UA_y_Cl) - call MV_Pack2(Var, y%Cl, ValAry) ! Scalar - case (UA_y_Cd) - call MV_Pack2(Var, y%Cd, ValAry) ! Scalar - case (UA_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call UA_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine UA_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(UA_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (UA_y_Cn) + call MV_Unpack2(Var, ValAry, y%Cn) ! Scalar + case (UA_y_Cc) + call MV_Unpack2(Var, ValAry, y%Cc) ! Scalar + case (UA_y_Cm) + call MV_Unpack2(Var, ValAry, y%Cm) ! Scalar + case (UA_y_Cl) + call MV_Unpack2(Var, ValAry, y%Cl) ! Scalar + case (UA_y_Cd) + call MV_Unpack2(Var, ValAry, y%Cd) ! Scalar + case (UA_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine UA_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(UA_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (UA_y_Cn) - call MV_Unpack2(Var, ValAry, y%Cn) ! Scalar - case (UA_y_Cc) - call MV_Unpack2(Var, ValAry, y%Cc) ! Scalar - case (UA_y_Cm) - call MV_Unpack2(Var, ValAry, y%Cm) ! Scalar - case (UA_y_Cl) - call MV_Unpack2(Var, ValAry, y%Cl) ! Scalar - case (UA_y_Cd) - call MV_Unpack2(Var, ValAry, y%Cd) ! Scalar - case (UA_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call UA_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE UnsteadyAero_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 64c49d872f..98cffec05c 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -4991,284 +4991,360 @@ function AD14_OutputMeshName(ML) result(Name) end select end function +subroutine AD14_PackContStateVar(Var, x, ValAry) + type(AD14_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD14_x_DWM_dummy) + call MV_Pack2(Var, x%DWM%dummy, ValAry) ! Scalar + case (AD14_x_DWM_IfW_DummyContState) + call MV_Pack2(Var, x%DWM%IfW%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AD14_PackContStateAry(Vars, x, ValAry) type(AD14_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (AD14_x_DWM_dummy) - call MV_Pack2(Var, x%DWM%dummy, ValAry) ! Scalar - case (AD14_x_DWM_IfW_DummyContState) - call MV_Pack2(Var, x%DWM%IfW%DummyContState, ValAry) ! Scalar - end select - end associate + call AD14_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine AD14_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AD14_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD14_x_DWM_dummy) + call MV_Unpack2(Var, ValAry, x%DWM%dummy) ! Scalar + case (AD14_x_DWM_IfW_DummyContState) + call MV_Unpack2(Var, ValAry, x%DWM%IfW%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine AD14_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AD14_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (AD14_x_DWM_dummy) - call MV_Unpack2(Var, ValAry, x%DWM%dummy) ! Scalar - case (AD14_x_DWM_IfW_DummyContState) - call MV_Unpack2(Var, ValAry, x%DWM%IfW%DummyContState) ! Scalar - end select - end associate + call AD14_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine AD14_PackConstrStateVar(Var, z, ValAry) + type(AD14_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD14_z_DWM_dummy) + call MV_Pack2(Var, z%DWM%dummy, ValAry) ! Scalar + case (AD14_z_DWM_IfW_DummyConstrState) + call MV_Pack2(Var, z%DWM%IfW%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AD14_PackConstrStateAry(Vars, z, ValAry) type(AD14_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (AD14_z_DWM_dummy) - call MV_Pack2(Var, z%DWM%dummy, ValAry) ! Scalar - case (AD14_z_DWM_IfW_DummyConstrState) - call MV_Pack2(Var, z%DWM%IfW%DummyConstrState, ValAry) ! Scalar - end select - end associate + call AD14_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine AD14_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AD14_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD14_z_DWM_dummy) + call MV_Unpack2(Var, ValAry, z%DWM%dummy) ! Scalar + case (AD14_z_DWM_IfW_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DWM%IfW%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine AD14_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AD14_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (AD14_z_DWM_dummy) - call MV_Unpack2(Var, ValAry, z%DWM%dummy) ! Scalar - case (AD14_z_DWM_IfW_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DWM%IfW%DummyConstrState) ! Scalar - end select - end associate + call AD14_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine AD14_PackInputVar(Var, u, ValAry) + type(AD14_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD14_u_InputMarkers) + call MV_Pack2(Var, u%InputMarkers(DL%i1), ValAry) ! Mesh + case (AD14_u_Twr_InputMarkers) + call MV_Pack2(Var, u%Twr_InputMarkers, ValAry) ! Mesh + case (AD14_u_TurbineComponents_Blade_Position) + call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Blade_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Blade_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Blade_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_Position) + call MV_Pack2(Var, u%TurbineComponents%Hub%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Hub%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Hub_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Hub%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Hub%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_Position) + call MV_Pack2(Var, u%TurbineComponents%RotorFurl%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_Orientation) + call MV_Pack2(Var, u%TurbineComponents%RotorFurl%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_RotorFurl_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%RotorFurl%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%RotorFurl%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_Position) + call MV_Pack2(Var, u%TurbineComponents%Nacelle%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Nacelle%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Nacelle_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Nacelle%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Nacelle%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_Position) + call MV_Pack2(Var, u%TurbineComponents%TailFin%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_Orientation) + call MV_Pack2(Var, u%TurbineComponents%TailFin%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_TailFin_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%TailFin%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%TailFin%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_Position) + call MV_Pack2(Var, u%TurbineComponents%Tower%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Tower%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Tower_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Tower%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Tower%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_Position) + call MV_Pack2(Var, u%TurbineComponents%SubStructure%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_Orientation) + call MV_Pack2(Var, u%TurbineComponents%SubStructure%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_SubStructure_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%SubStructure%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%SubStructure%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_Position) + call MV_Pack2(Var, u%TurbineComponents%Foundation%Position, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_Orientation) + call MV_Pack2(Var, u%TurbineComponents%Foundation%Orientation, ValAry) ! Rank 2 Array + case (AD14_u_TurbineComponents_Foundation_TranslationVel) + call MV_Pack2(Var, u%TurbineComponents%Foundation%TranslationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_RotationVel) + call MV_Pack2(Var, u%TurbineComponents%Foundation%RotationVel, ValAry) ! Rank 1 Array + case (AD14_u_TurbineComponents_BladeLength) + call MV_Pack2(Var, u%TurbineComponents%BladeLength, ValAry) ! Scalar + case (AD14_u_MulTabLoc) + call MV_Pack2(Var, u%MulTabLoc, ValAry) ! Rank 2 Array + case (AD14_u_InflowVelocity) + call MV_Pack2(Var, u%InflowVelocity, ValAry) ! Rank 2 Array + case (AD14_u_AvgInfVel) + call MV_Pack2(Var, u%AvgInfVel, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AD14_PackInputAry(Vars, u, ValAry) type(AD14_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (AD14_u_InputMarkers) - call MV_Pack2(Var, u%InputMarkers(DL%i1), ValAry) ! Mesh - case (AD14_u_Twr_InputMarkers) - call MV_Pack2(Var, u%Twr_InputMarkers, ValAry) ! Mesh - case (AD14_u_TurbineComponents_Blade_Position) - call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%Position, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Blade_Orientation) - call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%Orientation, ValAry) ! Rank 2 Array - case (AD14_u_TurbineComponents_Blade_TranslationVel) - call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%TranslationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Blade_RotationVel) - call MV_Pack2(Var, u%TurbineComponents%Blade(DL%i1)%RotationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Hub_Position) - call MV_Pack2(Var, u%TurbineComponents%Hub%Position, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Hub_Orientation) - call MV_Pack2(Var, u%TurbineComponents%Hub%Orientation, ValAry) ! Rank 2 Array - case (AD14_u_TurbineComponents_Hub_TranslationVel) - call MV_Pack2(Var, u%TurbineComponents%Hub%TranslationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Hub_RotationVel) - call MV_Pack2(Var, u%TurbineComponents%Hub%RotationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_RotorFurl_Position) - call MV_Pack2(Var, u%TurbineComponents%RotorFurl%Position, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_RotorFurl_Orientation) - call MV_Pack2(Var, u%TurbineComponents%RotorFurl%Orientation, ValAry) ! Rank 2 Array - case (AD14_u_TurbineComponents_RotorFurl_TranslationVel) - call MV_Pack2(Var, u%TurbineComponents%RotorFurl%TranslationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_RotorFurl_RotationVel) - call MV_Pack2(Var, u%TurbineComponents%RotorFurl%RotationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Nacelle_Position) - call MV_Pack2(Var, u%TurbineComponents%Nacelle%Position, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Nacelle_Orientation) - call MV_Pack2(Var, u%TurbineComponents%Nacelle%Orientation, ValAry) ! Rank 2 Array - case (AD14_u_TurbineComponents_Nacelle_TranslationVel) - call MV_Pack2(Var, u%TurbineComponents%Nacelle%TranslationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Nacelle_RotationVel) - call MV_Pack2(Var, u%TurbineComponents%Nacelle%RotationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_TailFin_Position) - call MV_Pack2(Var, u%TurbineComponents%TailFin%Position, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_TailFin_Orientation) - call MV_Pack2(Var, u%TurbineComponents%TailFin%Orientation, ValAry) ! Rank 2 Array - case (AD14_u_TurbineComponents_TailFin_TranslationVel) - call MV_Pack2(Var, u%TurbineComponents%TailFin%TranslationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_TailFin_RotationVel) - call MV_Pack2(Var, u%TurbineComponents%TailFin%RotationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Tower_Position) - call MV_Pack2(Var, u%TurbineComponents%Tower%Position, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Tower_Orientation) - call MV_Pack2(Var, u%TurbineComponents%Tower%Orientation, ValAry) ! Rank 2 Array - case (AD14_u_TurbineComponents_Tower_TranslationVel) - call MV_Pack2(Var, u%TurbineComponents%Tower%TranslationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Tower_RotationVel) - call MV_Pack2(Var, u%TurbineComponents%Tower%RotationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_SubStructure_Position) - call MV_Pack2(Var, u%TurbineComponents%SubStructure%Position, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_SubStructure_Orientation) - call MV_Pack2(Var, u%TurbineComponents%SubStructure%Orientation, ValAry) ! Rank 2 Array - case (AD14_u_TurbineComponents_SubStructure_TranslationVel) - call MV_Pack2(Var, u%TurbineComponents%SubStructure%TranslationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_SubStructure_RotationVel) - call MV_Pack2(Var, u%TurbineComponents%SubStructure%RotationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Foundation_Position) - call MV_Pack2(Var, u%TurbineComponents%Foundation%Position, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Foundation_Orientation) - call MV_Pack2(Var, u%TurbineComponents%Foundation%Orientation, ValAry) ! Rank 2 Array - case (AD14_u_TurbineComponents_Foundation_TranslationVel) - call MV_Pack2(Var, u%TurbineComponents%Foundation%TranslationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_Foundation_RotationVel) - call MV_Pack2(Var, u%TurbineComponents%Foundation%RotationVel, ValAry) ! Rank 1 Array - case (AD14_u_TurbineComponents_BladeLength) - call MV_Pack2(Var, u%TurbineComponents%BladeLength, ValAry) ! Scalar - case (AD14_u_MulTabLoc) - call MV_Pack2(Var, u%MulTabLoc, ValAry) ! Rank 2 Array - case (AD14_u_InflowVelocity) - call MV_Pack2(Var, u%InflowVelocity, ValAry) ! Rank 2 Array - case (AD14_u_AvgInfVel) - call MV_Pack2(Var, u%AvgInfVel, ValAry) ! Rank 1 Array - end select - end associate + call AD14_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine AD14_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AD14_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD14_u_InputMarkers) + call MV_Unpack2(Var, ValAry, u%InputMarkers(DL%i1)) ! Mesh + case (AD14_u_Twr_InputMarkers) + call MV_Unpack2(Var, ValAry, u%Twr_InputMarkers) ! Mesh + case (AD14_u_TurbineComponents_Blade_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Blade_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Blade_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Blade_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Hub_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Hub_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_RotorFurl_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_RotorFurl_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Nacelle_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Nacelle_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_TailFin_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_TailFin_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Tower_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Tower_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_SubStructure_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_SubStructure_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_Position) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%Position) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_Orientation) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%Orientation) ! Rank 2 Array + case (AD14_u_TurbineComponents_Foundation_TranslationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%TranslationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_Foundation_RotationVel) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%RotationVel) ! Rank 1 Array + case (AD14_u_TurbineComponents_BladeLength) + call MV_Unpack2(Var, ValAry, u%TurbineComponents%BladeLength) ! Scalar + case (AD14_u_MulTabLoc) + call MV_Unpack2(Var, ValAry, u%MulTabLoc) ! Rank 2 Array + case (AD14_u_InflowVelocity) + call MV_Unpack2(Var, ValAry, u%InflowVelocity) ! Rank 2 Array + case (AD14_u_AvgInfVel) + call MV_Unpack2(Var, ValAry, u%AvgInfVel) ! Rank 1 Array + end select + end associate +end subroutine + subroutine AD14_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AD14_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (AD14_u_InputMarkers) - call MV_Unpack2(Var, ValAry, u%InputMarkers(DL%i1)) ! Mesh - case (AD14_u_Twr_InputMarkers) - call MV_Unpack2(Var, ValAry, u%Twr_InputMarkers) ! Mesh - case (AD14_u_TurbineComponents_Blade_Position) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%Position) ! Rank 1 Array - case (AD14_u_TurbineComponents_Blade_Orientation) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%Orientation) ! Rank 2 Array - case (AD14_u_TurbineComponents_Blade_TranslationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%TranslationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Blade_RotationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Blade(DL%i1)%RotationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Hub_Position) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%Position) ! Rank 1 Array - case (AD14_u_TurbineComponents_Hub_Orientation) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%Orientation) ! Rank 2 Array - case (AD14_u_TurbineComponents_Hub_TranslationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%TranslationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Hub_RotationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Hub%RotationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_RotorFurl_Position) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%Position) ! Rank 1 Array - case (AD14_u_TurbineComponents_RotorFurl_Orientation) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%Orientation) ! Rank 2 Array - case (AD14_u_TurbineComponents_RotorFurl_TranslationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%TranslationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_RotorFurl_RotationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%RotorFurl%RotationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Nacelle_Position) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%Position) ! Rank 1 Array - case (AD14_u_TurbineComponents_Nacelle_Orientation) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%Orientation) ! Rank 2 Array - case (AD14_u_TurbineComponents_Nacelle_TranslationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%TranslationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Nacelle_RotationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Nacelle%RotationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_TailFin_Position) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%Position) ! Rank 1 Array - case (AD14_u_TurbineComponents_TailFin_Orientation) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%Orientation) ! Rank 2 Array - case (AD14_u_TurbineComponents_TailFin_TranslationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%TranslationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_TailFin_RotationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%TailFin%RotationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Tower_Position) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%Position) ! Rank 1 Array - case (AD14_u_TurbineComponents_Tower_Orientation) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%Orientation) ! Rank 2 Array - case (AD14_u_TurbineComponents_Tower_TranslationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%TranslationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Tower_RotationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Tower%RotationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_SubStructure_Position) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%Position) ! Rank 1 Array - case (AD14_u_TurbineComponents_SubStructure_Orientation) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%Orientation) ! Rank 2 Array - case (AD14_u_TurbineComponents_SubStructure_TranslationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%TranslationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_SubStructure_RotationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%SubStructure%RotationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Foundation_Position) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%Position) ! Rank 1 Array - case (AD14_u_TurbineComponents_Foundation_Orientation) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%Orientation) ! Rank 2 Array - case (AD14_u_TurbineComponents_Foundation_TranslationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%TranslationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_Foundation_RotationVel) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%Foundation%RotationVel) ! Rank 1 Array - case (AD14_u_TurbineComponents_BladeLength) - call MV_Unpack2(Var, ValAry, u%TurbineComponents%BladeLength) ! Scalar - case (AD14_u_MulTabLoc) - call MV_Unpack2(Var, ValAry, u%MulTabLoc) ! Rank 2 Array - case (AD14_u_InflowVelocity) - call MV_Unpack2(Var, ValAry, u%InflowVelocity) ! Rank 2 Array - case (AD14_u_AvgInfVel) - call MV_Unpack2(Var, ValAry, u%AvgInfVel) ! Rank 1 Array - end select - end associate + call AD14_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine AD14_PackOutputVar(Var, y, ValAry) + type(AD14_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD14_y_OutputLoads) + call MV_Pack2(Var, y%OutputLoads(DL%i1), ValAry) ! Mesh + case (AD14_y_Twr_OutputLoads) + call MV_Pack2(Var, y%Twr_OutputLoads, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine AD14_PackOutputAry(Vars, y, ValAry) type(AD14_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (AD14_y_OutputLoads) - call MV_Pack2(Var, y%OutputLoads(DL%i1), ValAry) ! Mesh - case (AD14_y_Twr_OutputLoads) - call MV_Pack2(Var, y%Twr_OutputLoads, ValAry) ! Mesh - end select - end associate + call AD14_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine AD14_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AD14_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AD14_y_OutputLoads) + call MV_Unpack2(Var, ValAry, y%OutputLoads(DL%i1)) ! Mesh + case (AD14_y_Twr_OutputLoads) + call MV_Unpack2(Var, ValAry, y%Twr_OutputLoads) ! Mesh + end select + end associate +end subroutine + subroutine AD14_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AD14_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (AD14_y_OutputLoads) - call MV_Unpack2(Var, ValAry, y%OutputLoads(DL%i1)) ! Mesh - case (AD14_y_Twr_OutputLoads) - call MV_Unpack2(Var, ValAry, y%Twr_OutputLoads) ! Mesh - end select - end associate + call AD14_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE AeroDyn14_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 649ddfc56a..bfd7d46fdb 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -3250,304 +3250,380 @@ function DWM_OutputMeshName(ML) result(Name) end select end function +subroutine DWM_PackContStateVar(Var, x, ValAry) + type(DWM_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DWM_x_dummy) + call MV_Pack2(Var, x%dummy, ValAry) ! Scalar + case (DWM_x_IfW_DummyContState) + call MV_Pack2(Var, x%IfW%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine DWM_PackContStateAry(Vars, x, ValAry) type(DWM_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (DWM_x_dummy) - call MV_Pack2(Var, x%dummy, ValAry) ! Scalar - case (DWM_x_IfW_DummyContState) - call MV_Pack2(Var, x%IfW%DummyContState, ValAry) ! Scalar - end select - end associate + call DWM_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine DWM_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(DWM_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DWM_x_dummy) + call MV_Unpack2(Var, ValAry, x%dummy) ! Scalar + case (DWM_x_IfW_DummyContState) + call MV_Unpack2(Var, ValAry, x%IfW%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine DWM_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DWM_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (DWM_x_dummy) - call MV_Unpack2(Var, ValAry, x%dummy) ! Scalar - case (DWM_x_IfW_DummyContState) - call MV_Unpack2(Var, ValAry, x%IfW%DummyContState) ! Scalar - end select - end associate + call DWM_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine DWM_PackConstrStateVar(Var, z, ValAry) + type(DWM_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DWM_z_dummy) + call MV_Pack2(Var, z%dummy, ValAry) ! Scalar + case (DWM_z_IfW_DummyConstrState) + call MV_Pack2(Var, z%IfW%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine DWM_PackConstrStateAry(Vars, z, ValAry) type(DWM_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (DWM_z_dummy) - call MV_Pack2(Var, z%dummy, ValAry) ! Scalar - case (DWM_z_IfW_DummyConstrState) - call MV_Pack2(Var, z%IfW%DummyConstrState, ValAry) ! Scalar - end select - end associate + call DWM_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine DWM_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(DWM_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DWM_z_dummy) + call MV_Unpack2(Var, ValAry, z%dummy) ! Scalar + case (DWM_z_IfW_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%IfW%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine DWM_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DWM_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (DWM_z_dummy) - call MV_Unpack2(Var, ValAry, z%dummy) ! Scalar - case (DWM_z_IfW_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%IfW%DummyConstrState) ! Scalar - end select - end associate + call DWM_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine DWM_PackInputVar(Var, u, ValAry) + type(DWM_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DWM_u_Upwind_result_upwind_U) + call MV_Pack2(Var, u%Upwind_result%upwind_U, ValAry) ! Rank 2 Array + case (DWM_u_Upwind_result_upwind_wakecenter) + call MV_Pack2(Var, u%Upwind_result%upwind_wakecenter, ValAry) ! Rank 4 Array + case (DWM_u_Upwind_result_upwind_meanU) + call MV_Pack2(Var, u%Upwind_result%upwind_meanU, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_TI) + call MV_Pack2(Var, u%Upwind_result%upwind_TI, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_small_TI) + call MV_Pack2(Var, u%Upwind_result%upwind_small_TI, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_smoothWake) + call MV_Pack2(Var, u%Upwind_result%upwind_smoothWake, ValAry) ! Rank 2 Array + case (DWM_u_Upwind_result_velocity_aerodyn) + call MV_Pack2(Var, u%Upwind_result%velocity_aerodyn, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_TI_downstream) + call MV_Pack2(Var, u%Upwind_result%TI_downstream, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_small_scale_TI_downstream) + call MV_Pack2(Var, u%Upwind_result%small_scale_TI_downstream, ValAry) ! Rank 1 Array + case (DWM_u_Upwind_result_smoothed_velocity_array) + call MV_Pack2(Var, u%Upwind_result%smoothed_velocity_array, ValAry) ! Rank 2 Array + case (DWM_u_Upwind_result_vel_matrix) + call MV_Pack2(Var, u%Upwind_result%vel_matrix, ValAry) ! Rank 3 Array + case (DWM_u_IfW_PositionXYZ) + call MV_Pack2(Var, u%IfW%PositionXYZ, ValAry) ! Rank 2 Array + case (DWM_u_IfW_lidar_PulseLidEl) + call MV_Pack2(Var, u%IfW%lidar%PulseLidEl, ValAry) ! Scalar + case (DWM_u_IfW_lidar_PulseLidAz) + call MV_Pack2(Var, u%IfW%lidar%PulseLidAz, ValAry) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementX) + call MV_Pack2(Var, u%IfW%lidar%HubDisplacementX, ValAry) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementY) + call MV_Pack2(Var, u%IfW%lidar%HubDisplacementY, ValAry) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementZ) + call MV_Pack2(Var, u%IfW%lidar%HubDisplacementZ, ValAry) ! Scalar + case (DWM_u_IfW_HubPosition) + call MV_Pack2(Var, u%IfW%HubPosition, ValAry) ! Rank 1 Array + case (DWM_u_IfW_HubOrientation) + call MV_Pack2(Var, u%IfW%HubOrientation, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine DWM_PackInputAry(Vars, u, ValAry) type(DWM_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (DWM_u_Upwind_result_upwind_U) - call MV_Pack2(Var, u%Upwind_result%upwind_U, ValAry) ! Rank 2 Array - case (DWM_u_Upwind_result_upwind_wakecenter) - call MV_Pack2(Var, u%Upwind_result%upwind_wakecenter, ValAry) ! Rank 4 Array - case (DWM_u_Upwind_result_upwind_meanU) - call MV_Pack2(Var, u%Upwind_result%upwind_meanU, ValAry) ! Rank 1 Array - case (DWM_u_Upwind_result_upwind_TI) - call MV_Pack2(Var, u%Upwind_result%upwind_TI, ValAry) ! Rank 1 Array - case (DWM_u_Upwind_result_upwind_small_TI) - call MV_Pack2(Var, u%Upwind_result%upwind_small_TI, ValAry) ! Rank 1 Array - case (DWM_u_Upwind_result_upwind_smoothWake) - call MV_Pack2(Var, u%Upwind_result%upwind_smoothWake, ValAry) ! Rank 2 Array - case (DWM_u_Upwind_result_velocity_aerodyn) - call MV_Pack2(Var, u%Upwind_result%velocity_aerodyn, ValAry) ! Rank 1 Array - case (DWM_u_Upwind_result_TI_downstream) - call MV_Pack2(Var, u%Upwind_result%TI_downstream, ValAry) ! Rank 1 Array - case (DWM_u_Upwind_result_small_scale_TI_downstream) - call MV_Pack2(Var, u%Upwind_result%small_scale_TI_downstream, ValAry) ! Rank 1 Array - case (DWM_u_Upwind_result_smoothed_velocity_array) - call MV_Pack2(Var, u%Upwind_result%smoothed_velocity_array, ValAry) ! Rank 2 Array - case (DWM_u_Upwind_result_vel_matrix) - call MV_Pack2(Var, u%Upwind_result%vel_matrix, ValAry) ! Rank 3 Array - case (DWM_u_IfW_PositionXYZ) - call MV_Pack2(Var, u%IfW%PositionXYZ, ValAry) ! Rank 2 Array - case (DWM_u_IfW_lidar_PulseLidEl) - call MV_Pack2(Var, u%IfW%lidar%PulseLidEl, ValAry) ! Scalar - case (DWM_u_IfW_lidar_PulseLidAz) - call MV_Pack2(Var, u%IfW%lidar%PulseLidAz, ValAry) ! Scalar - case (DWM_u_IfW_lidar_HubDisplacementX) - call MV_Pack2(Var, u%IfW%lidar%HubDisplacementX, ValAry) ! Scalar - case (DWM_u_IfW_lidar_HubDisplacementY) - call MV_Pack2(Var, u%IfW%lidar%HubDisplacementY, ValAry) ! Scalar - case (DWM_u_IfW_lidar_HubDisplacementZ) - call MV_Pack2(Var, u%IfW%lidar%HubDisplacementZ, ValAry) ! Scalar - case (DWM_u_IfW_HubPosition) - call MV_Pack2(Var, u%IfW%HubPosition, ValAry) ! Rank 1 Array - case (DWM_u_IfW_HubOrientation) - call MV_Pack2(Var, u%IfW%HubOrientation, ValAry) ! Rank 2 Array - end select - end associate + call DWM_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine DWM_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(DWM_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DWM_u_Upwind_result_upwind_U) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_U) ! Rank 2 Array + case (DWM_u_Upwind_result_upwind_wakecenter) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_wakecenter) ! Rank 4 Array + case (DWM_u_Upwind_result_upwind_meanU) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_meanU) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_TI) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_TI) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_small_TI) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_small_TI) ! Rank 1 Array + case (DWM_u_Upwind_result_upwind_smoothWake) + call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_smoothWake) ! Rank 2 Array + case (DWM_u_Upwind_result_velocity_aerodyn) + call MV_Unpack2(Var, ValAry, u%Upwind_result%velocity_aerodyn) ! Rank 1 Array + case (DWM_u_Upwind_result_TI_downstream) + call MV_Unpack2(Var, ValAry, u%Upwind_result%TI_downstream) ! Rank 1 Array + case (DWM_u_Upwind_result_small_scale_TI_downstream) + call MV_Unpack2(Var, ValAry, u%Upwind_result%small_scale_TI_downstream) ! Rank 1 Array + case (DWM_u_Upwind_result_smoothed_velocity_array) + call MV_Unpack2(Var, ValAry, u%Upwind_result%smoothed_velocity_array) ! Rank 2 Array + case (DWM_u_Upwind_result_vel_matrix) + call MV_Unpack2(Var, ValAry, u%Upwind_result%vel_matrix) ! Rank 3 Array + case (DWM_u_IfW_PositionXYZ) + call MV_Unpack2(Var, ValAry, u%IfW%PositionXYZ) ! Rank 2 Array + case (DWM_u_IfW_lidar_PulseLidEl) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%PulseLidEl) ! Scalar + case (DWM_u_IfW_lidar_PulseLidAz) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%PulseLidAz) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementX) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementX) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementY) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementY) ! Scalar + case (DWM_u_IfW_lidar_HubDisplacementZ) + call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementZ) ! Scalar + case (DWM_u_IfW_HubPosition) + call MV_Unpack2(Var, ValAry, u%IfW%HubPosition) ! Rank 1 Array + case (DWM_u_IfW_HubOrientation) + call MV_Unpack2(Var, ValAry, u%IfW%HubOrientation) ! Rank 2 Array + end select + end associate +end subroutine + subroutine DWM_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DWM_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (DWM_u_Upwind_result_upwind_U) - call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_U) ! Rank 2 Array - case (DWM_u_Upwind_result_upwind_wakecenter) - call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_wakecenter) ! Rank 4 Array - case (DWM_u_Upwind_result_upwind_meanU) - call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_meanU) ! Rank 1 Array - case (DWM_u_Upwind_result_upwind_TI) - call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_TI) ! Rank 1 Array - case (DWM_u_Upwind_result_upwind_small_TI) - call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_small_TI) ! Rank 1 Array - case (DWM_u_Upwind_result_upwind_smoothWake) - call MV_Unpack2(Var, ValAry, u%Upwind_result%upwind_smoothWake) ! Rank 2 Array - case (DWM_u_Upwind_result_velocity_aerodyn) - call MV_Unpack2(Var, ValAry, u%Upwind_result%velocity_aerodyn) ! Rank 1 Array - case (DWM_u_Upwind_result_TI_downstream) - call MV_Unpack2(Var, ValAry, u%Upwind_result%TI_downstream) ! Rank 1 Array - case (DWM_u_Upwind_result_small_scale_TI_downstream) - call MV_Unpack2(Var, ValAry, u%Upwind_result%small_scale_TI_downstream) ! Rank 1 Array - case (DWM_u_Upwind_result_smoothed_velocity_array) - call MV_Unpack2(Var, ValAry, u%Upwind_result%smoothed_velocity_array) ! Rank 2 Array - case (DWM_u_Upwind_result_vel_matrix) - call MV_Unpack2(Var, ValAry, u%Upwind_result%vel_matrix) ! Rank 3 Array - case (DWM_u_IfW_PositionXYZ) - call MV_Unpack2(Var, ValAry, u%IfW%PositionXYZ) ! Rank 2 Array - case (DWM_u_IfW_lidar_PulseLidEl) - call MV_Unpack2(Var, ValAry, u%IfW%lidar%PulseLidEl) ! Scalar - case (DWM_u_IfW_lidar_PulseLidAz) - call MV_Unpack2(Var, ValAry, u%IfW%lidar%PulseLidAz) ! Scalar - case (DWM_u_IfW_lidar_HubDisplacementX) - call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementX) ! Scalar - case (DWM_u_IfW_lidar_HubDisplacementY) - call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementY) ! Scalar - case (DWM_u_IfW_lidar_HubDisplacementZ) - call MV_Unpack2(Var, ValAry, u%IfW%lidar%HubDisplacementZ) ! Scalar - case (DWM_u_IfW_HubPosition) - call MV_Unpack2(Var, ValAry, u%IfW%HubPosition) ! Rank 1 Array - case (DWM_u_IfW_HubOrientation) - call MV_Unpack2(Var, ValAry, u%IfW%HubOrientation) ! Rank 2 Array - end select - end associate + call DWM_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine DWM_PackOutputVar(Var, y, ValAry) + type(DWM_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DWM_y_turbine_thrust_force) + call MV_Pack2(Var, y%turbine_thrust_force, ValAry) ! Rank 1 Array + case (DWM_y_induction_factor) + call MV_Pack2(Var, y%induction_factor, ValAry) ! Rank 1 Array + case (DWM_y_r_initial) + call MV_Pack2(Var, y%r_initial, ValAry) ! Rank 1 Array + case (DWM_y_U_initial) + call MV_Pack2(Var, y%U_initial, ValAry) ! Rank 1 Array + case (DWM_y_Mean_FFWS_array) + call MV_Pack2(Var, y%Mean_FFWS_array, ValAry) ! Rank 1 Array + case (DWM_y_Mean_FFWS) + call MV_Pack2(Var, y%Mean_FFWS, ValAry) ! Scalar + case (DWM_y_TI) + call MV_Pack2(Var, y%TI, ValAry) ! Scalar + case (DWM_y_TI_downstream) + call MV_Pack2(Var, y%TI_downstream, ValAry) ! Scalar + case (DWM_y_wake_u) + call MV_Pack2(Var, y%wake_u, ValAry) ! Rank 2 Array + case (DWM_y_wake_position) + call MV_Pack2(Var, y%wake_position, ValAry) ! Rank 3 Array + case (DWM_y_smoothed_velocity_array) + call MV_Pack2(Var, y%smoothed_velocity_array, ValAry) ! Rank 2 Array + case (DWM_y_AtmUscale) + call MV_Pack2(Var, y%AtmUscale, ValAry) ! Scalar + case (DWM_y_du_dz_ABL) + call MV_Pack2(Var, y%du_dz_ABL, ValAry) ! Scalar + case (DWM_y_total_SDgenpwr) + call MV_Pack2(Var, y%total_SDgenpwr, ValAry) ! Scalar + case (DWM_y_mean_SDgenpwr) + call MV_Pack2(Var, y%mean_SDgenpwr, ValAry) ! Scalar + case (DWM_y_avg_ct) + call MV_Pack2(Var, y%avg_ct, ValAry) ! Scalar + case (DWM_y_IfW_VelocityUVW) + call MV_Pack2(Var, y%IfW%VelocityUVW, ValAry) ! Rank 2 Array + case (DWM_y_IfW_AccelUVW) + call MV_Pack2(Var, y%IfW%AccelUVW, ValAry) ! Rank 2 Array + case (DWM_y_IfW_WriteOutput) + call MV_Pack2(Var, y%IfW%WriteOutput, ValAry) ! Rank 1 Array + case (DWM_y_IfW_DiskVel) + call MV_Pack2(Var, y%IfW%DiskVel, ValAry) ! Rank 1 Array + case (DWM_y_IfW_HubVel) + call MV_Pack2(Var, y%IfW%HubVel, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_LidSpeed) + call MV_Pack2(Var, y%IfW%lidar%LidSpeed, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_WtTrunc) + call MV_Pack2(Var, y%IfW%lidar%WtTrunc, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsX) + call MV_Pack2(Var, y%IfW%lidar%MsrPositionsX, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsY) + call MV_Pack2(Var, y%IfW%lidar%MsrPositionsY, ValAry) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsZ) + call MV_Pack2(Var, y%IfW%lidar%MsrPositionsZ, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine DWM_PackOutputAry(Vars, y, ValAry) type(DWM_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (DWM_y_turbine_thrust_force) - call MV_Pack2(Var, y%turbine_thrust_force, ValAry) ! Rank 1 Array - case (DWM_y_induction_factor) - call MV_Pack2(Var, y%induction_factor, ValAry) ! Rank 1 Array - case (DWM_y_r_initial) - call MV_Pack2(Var, y%r_initial, ValAry) ! Rank 1 Array - case (DWM_y_U_initial) - call MV_Pack2(Var, y%U_initial, ValAry) ! Rank 1 Array - case (DWM_y_Mean_FFWS_array) - call MV_Pack2(Var, y%Mean_FFWS_array, ValAry) ! Rank 1 Array - case (DWM_y_Mean_FFWS) - call MV_Pack2(Var, y%Mean_FFWS, ValAry) ! Scalar - case (DWM_y_TI) - call MV_Pack2(Var, y%TI, ValAry) ! Scalar - case (DWM_y_TI_downstream) - call MV_Pack2(Var, y%TI_downstream, ValAry) ! Scalar - case (DWM_y_wake_u) - call MV_Pack2(Var, y%wake_u, ValAry) ! Rank 2 Array - case (DWM_y_wake_position) - call MV_Pack2(Var, y%wake_position, ValAry) ! Rank 3 Array - case (DWM_y_smoothed_velocity_array) - call MV_Pack2(Var, y%smoothed_velocity_array, ValAry) ! Rank 2 Array - case (DWM_y_AtmUscale) - call MV_Pack2(Var, y%AtmUscale, ValAry) ! Scalar - case (DWM_y_du_dz_ABL) - call MV_Pack2(Var, y%du_dz_ABL, ValAry) ! Scalar - case (DWM_y_total_SDgenpwr) - call MV_Pack2(Var, y%total_SDgenpwr, ValAry) ! Scalar - case (DWM_y_mean_SDgenpwr) - call MV_Pack2(Var, y%mean_SDgenpwr, ValAry) ! Scalar - case (DWM_y_avg_ct) - call MV_Pack2(Var, y%avg_ct, ValAry) ! Scalar - case (DWM_y_IfW_VelocityUVW) - call MV_Pack2(Var, y%IfW%VelocityUVW, ValAry) ! Rank 2 Array - case (DWM_y_IfW_AccelUVW) - call MV_Pack2(Var, y%IfW%AccelUVW, ValAry) ! Rank 2 Array - case (DWM_y_IfW_WriteOutput) - call MV_Pack2(Var, y%IfW%WriteOutput, ValAry) ! Rank 1 Array - case (DWM_y_IfW_DiskVel) - call MV_Pack2(Var, y%IfW%DiskVel, ValAry) ! Rank 1 Array - case (DWM_y_IfW_HubVel) - call MV_Pack2(Var, y%IfW%HubVel, ValAry) ! Rank 1 Array - case (DWM_y_IfW_lidar_LidSpeed) - call MV_Pack2(Var, y%IfW%lidar%LidSpeed, ValAry) ! Rank 1 Array - case (DWM_y_IfW_lidar_WtTrunc) - call MV_Pack2(Var, y%IfW%lidar%WtTrunc, ValAry) ! Rank 1 Array - case (DWM_y_IfW_lidar_MsrPositionsX) - call MV_Pack2(Var, y%IfW%lidar%MsrPositionsX, ValAry) ! Rank 1 Array - case (DWM_y_IfW_lidar_MsrPositionsY) - call MV_Pack2(Var, y%IfW%lidar%MsrPositionsY, ValAry) ! Rank 1 Array - case (DWM_y_IfW_lidar_MsrPositionsZ) - call MV_Pack2(Var, y%IfW%lidar%MsrPositionsZ, ValAry) ! Rank 1 Array - end select - end associate + call DWM_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine DWM_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(DWM_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (DWM_y_turbine_thrust_force) + call MV_Unpack2(Var, ValAry, y%turbine_thrust_force) ! Rank 1 Array + case (DWM_y_induction_factor) + call MV_Unpack2(Var, ValAry, y%induction_factor) ! Rank 1 Array + case (DWM_y_r_initial) + call MV_Unpack2(Var, ValAry, y%r_initial) ! Rank 1 Array + case (DWM_y_U_initial) + call MV_Unpack2(Var, ValAry, y%U_initial) ! Rank 1 Array + case (DWM_y_Mean_FFWS_array) + call MV_Unpack2(Var, ValAry, y%Mean_FFWS_array) ! Rank 1 Array + case (DWM_y_Mean_FFWS) + call MV_Unpack2(Var, ValAry, y%Mean_FFWS) ! Scalar + case (DWM_y_TI) + call MV_Unpack2(Var, ValAry, y%TI) ! Scalar + case (DWM_y_TI_downstream) + call MV_Unpack2(Var, ValAry, y%TI_downstream) ! Scalar + case (DWM_y_wake_u) + call MV_Unpack2(Var, ValAry, y%wake_u) ! Rank 2 Array + case (DWM_y_wake_position) + call MV_Unpack2(Var, ValAry, y%wake_position) ! Rank 3 Array + case (DWM_y_smoothed_velocity_array) + call MV_Unpack2(Var, ValAry, y%smoothed_velocity_array) ! Rank 2 Array + case (DWM_y_AtmUscale) + call MV_Unpack2(Var, ValAry, y%AtmUscale) ! Scalar + case (DWM_y_du_dz_ABL) + call MV_Unpack2(Var, ValAry, y%du_dz_ABL) ! Scalar + case (DWM_y_total_SDgenpwr) + call MV_Unpack2(Var, ValAry, y%total_SDgenpwr) ! Scalar + case (DWM_y_mean_SDgenpwr) + call MV_Unpack2(Var, ValAry, y%mean_SDgenpwr) ! Scalar + case (DWM_y_avg_ct) + call MV_Unpack2(Var, ValAry, y%avg_ct) ! Scalar + case (DWM_y_IfW_VelocityUVW) + call MV_Unpack2(Var, ValAry, y%IfW%VelocityUVW) ! Rank 2 Array + case (DWM_y_IfW_AccelUVW) + call MV_Unpack2(Var, ValAry, y%IfW%AccelUVW) ! Rank 2 Array + case (DWM_y_IfW_WriteOutput) + call MV_Unpack2(Var, ValAry, y%IfW%WriteOutput) ! Rank 1 Array + case (DWM_y_IfW_DiskVel) + call MV_Unpack2(Var, ValAry, y%IfW%DiskVel) ! Rank 1 Array + case (DWM_y_IfW_HubVel) + call MV_Unpack2(Var, ValAry, y%IfW%HubVel) ! Rank 1 Array + case (DWM_y_IfW_lidar_LidSpeed) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%LidSpeed) ! Rank 1 Array + case (DWM_y_IfW_lidar_WtTrunc) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%WtTrunc) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsX) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsX) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsY) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsY) ! Rank 1 Array + case (DWM_y_IfW_lidar_MsrPositionsZ) + call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsZ) ! Rank 1 Array + end select + end associate +end subroutine + subroutine DWM_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DWM_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (DWM_y_turbine_thrust_force) - call MV_Unpack2(Var, ValAry, y%turbine_thrust_force) ! Rank 1 Array - case (DWM_y_induction_factor) - call MV_Unpack2(Var, ValAry, y%induction_factor) ! Rank 1 Array - case (DWM_y_r_initial) - call MV_Unpack2(Var, ValAry, y%r_initial) ! Rank 1 Array - case (DWM_y_U_initial) - call MV_Unpack2(Var, ValAry, y%U_initial) ! Rank 1 Array - case (DWM_y_Mean_FFWS_array) - call MV_Unpack2(Var, ValAry, y%Mean_FFWS_array) ! Rank 1 Array - case (DWM_y_Mean_FFWS) - call MV_Unpack2(Var, ValAry, y%Mean_FFWS) ! Scalar - case (DWM_y_TI) - call MV_Unpack2(Var, ValAry, y%TI) ! Scalar - case (DWM_y_TI_downstream) - call MV_Unpack2(Var, ValAry, y%TI_downstream) ! Scalar - case (DWM_y_wake_u) - call MV_Unpack2(Var, ValAry, y%wake_u) ! Rank 2 Array - case (DWM_y_wake_position) - call MV_Unpack2(Var, ValAry, y%wake_position) ! Rank 3 Array - case (DWM_y_smoothed_velocity_array) - call MV_Unpack2(Var, ValAry, y%smoothed_velocity_array) ! Rank 2 Array - case (DWM_y_AtmUscale) - call MV_Unpack2(Var, ValAry, y%AtmUscale) ! Scalar - case (DWM_y_du_dz_ABL) - call MV_Unpack2(Var, ValAry, y%du_dz_ABL) ! Scalar - case (DWM_y_total_SDgenpwr) - call MV_Unpack2(Var, ValAry, y%total_SDgenpwr) ! Scalar - case (DWM_y_mean_SDgenpwr) - call MV_Unpack2(Var, ValAry, y%mean_SDgenpwr) ! Scalar - case (DWM_y_avg_ct) - call MV_Unpack2(Var, ValAry, y%avg_ct) ! Scalar - case (DWM_y_IfW_VelocityUVW) - call MV_Unpack2(Var, ValAry, y%IfW%VelocityUVW) ! Rank 2 Array - case (DWM_y_IfW_AccelUVW) - call MV_Unpack2(Var, ValAry, y%IfW%AccelUVW) ! Rank 2 Array - case (DWM_y_IfW_WriteOutput) - call MV_Unpack2(Var, ValAry, y%IfW%WriteOutput) ! Rank 1 Array - case (DWM_y_IfW_DiskVel) - call MV_Unpack2(Var, ValAry, y%IfW%DiskVel) ! Rank 1 Array - case (DWM_y_IfW_HubVel) - call MV_Unpack2(Var, ValAry, y%IfW%HubVel) ! Rank 1 Array - case (DWM_y_IfW_lidar_LidSpeed) - call MV_Unpack2(Var, ValAry, y%IfW%lidar%LidSpeed) ! Rank 1 Array - case (DWM_y_IfW_lidar_WtTrunc) - call MV_Unpack2(Var, ValAry, y%IfW%lidar%WtTrunc) ! Rank 1 Array - case (DWM_y_IfW_lidar_MsrPositionsX) - call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsX) ! Rank 1 Array - case (DWM_y_IfW_lidar_MsrPositionsY) - call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsY) ! Rank 1 Array - case (DWM_y_IfW_lidar_MsrPositionsZ) - call MV_Unpack2(Var, ValAry, y%IfW%lidar%MsrPositionsZ) ! Rank 1 Array - end select - end associate + call DWM_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE DWM_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index fd2e03c750..55b9dcdac6 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -3809,156 +3809,232 @@ function BD_OutputMeshName(ML) result(Name) end select end function +subroutine BD_PackContStateVar(Var, x, ValAry) + type(BD_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BD_x_q) + call MV_Pack2(Var, x%q, ValAry) ! Rank 2 Array + case (BD_x_dqdt) + call MV_Pack2(Var, x%dqdt, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine BD_PackContStateAry(Vars, x, ValAry) type(BD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (BD_x_q) - call MV_Pack2(Var, x%q, ValAry) ! Rank 2 Array - case (BD_x_dqdt) - call MV_Pack2(Var, x%dqdt, ValAry) ! Rank 2 Array - end select - end associate + call BD_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine BD_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BD_x_q) + call MV_Unpack2(Var, ValAry, x%q) ! Rank 2 Array + case (BD_x_dqdt) + call MV_Unpack2(Var, ValAry, x%dqdt) ! Rank 2 Array + end select + end associate +end subroutine + subroutine BD_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (BD_x_q) - call MV_Unpack2(Var, ValAry, x%q) ! Rank 2 Array - case (BD_x_dqdt) - call MV_Unpack2(Var, ValAry, x%dqdt) ! Rank 2 Array - end select - end associate + call BD_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine BD_PackConstrStateVar(Var, z, ValAry) + type(BD_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine BD_PackConstrStateAry(Vars, z, ValAry) type(BD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (BD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call BD_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine BD_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine BD_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (BD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call BD_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine BD_PackInputVar(Var, u, ValAry) + type(BD_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BD_u_RootMotion) + call MV_Pack2(Var, u%RootMotion, ValAry) ! Mesh + case (BD_u_PointLoad) + call MV_Pack2(Var, u%PointLoad, ValAry) ! Mesh + case (BD_u_DistrLoad) + call MV_Pack2(Var, u%DistrLoad, ValAry) ! Mesh + case (BD_u_HubMotion) + call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine BD_PackInputAry(Vars, u, ValAry) type(BD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (BD_u_RootMotion) - call MV_Pack2(Var, u%RootMotion, ValAry) ! Mesh - case (BD_u_PointLoad) - call MV_Pack2(Var, u%PointLoad, ValAry) ! Mesh - case (BD_u_DistrLoad) - call MV_Pack2(Var, u%DistrLoad, ValAry) ! Mesh - case (BD_u_HubMotion) - call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh - end select - end associate + call BD_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine BD_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(BD_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BD_u_RootMotion) + call MV_Unpack2(Var, ValAry, u%RootMotion) ! Mesh + case (BD_u_PointLoad) + call MV_Unpack2(Var, ValAry, u%PointLoad) ! Mesh + case (BD_u_DistrLoad) + call MV_Unpack2(Var, ValAry, u%DistrLoad) ! Mesh + case (BD_u_HubMotion) + call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh + end select + end associate +end subroutine + subroutine BD_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (BD_u_RootMotion) - call MV_Unpack2(Var, ValAry, u%RootMotion) ! Mesh - case (BD_u_PointLoad) - call MV_Unpack2(Var, ValAry, u%PointLoad) ! Mesh - case (BD_u_DistrLoad) - call MV_Unpack2(Var, ValAry, u%DistrLoad) ! Mesh - case (BD_u_HubMotion) - call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh - end select - end associate + call BD_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine BD_PackOutputVar(Var, y, ValAry) + type(BD_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BD_y_ReactionForce) + call MV_Pack2(Var, y%ReactionForce, ValAry) ! Mesh + case (BD_y_BldMotion) + call MV_Pack2(Var, y%BldMotion, ValAry) ! Mesh + case (BD_y_RootMxr) + call MV_Pack2(Var, y%RootMxr, ValAry) ! Scalar + case (BD_y_RootMyr) + call MV_Pack2(Var, y%RootMyr, ValAry) ! Scalar + case (BD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine BD_PackOutputAry(Vars, y, ValAry) type(BD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (BD_y_ReactionForce) - call MV_Pack2(Var, y%ReactionForce, ValAry) ! Mesh - case (BD_y_BldMotion) - call MV_Pack2(Var, y%BldMotion, ValAry) ! Mesh - case (BD_y_RootMxr) - call MV_Pack2(Var, y%RootMxr, ValAry) ! Scalar - case (BD_y_RootMyr) - call MV_Pack2(Var, y%RootMyr, ValAry) ! Scalar - case (BD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call BD_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine BD_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(BD_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (BD_y_ReactionForce) + call MV_Unpack2(Var, ValAry, y%ReactionForce) ! Mesh + case (BD_y_BldMotion) + call MV_Unpack2(Var, ValAry, y%BldMotion) ! Mesh + case (BD_y_RootMxr) + call MV_Unpack2(Var, ValAry, y%RootMxr) ! Scalar + case (BD_y_RootMyr) + call MV_Unpack2(Var, ValAry, y%RootMyr) ! Scalar + case (BD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine BD_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (BD_y_ReactionForce) - call MV_Unpack2(Var, ValAry, y%ReactionForce) ! Mesh - case (BD_y_BldMotion) - call MV_Unpack2(Var, ValAry, y%BldMotion) ! Mesh - case (BD_y_RootMxr) - call MV_Unpack2(Var, ValAry, y%RootMxr) ! Scalar - case (BD_y_RootMyr) - call MV_Unpack2(Var, ValAry, y%RootMyr) ! Scalar - case (BD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call BD_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE BeamDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index f7c59f4e22..3df264e41c 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -346,7 +346,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Module Variables !............................................................................................ - CALL ED_InitVars(u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + CALL ED_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) CALL CheckError( ErrStat2, ErrMsg2 ) !............................................................................................ @@ -10645,9 +10645,10 @@ END SUBROUTINE FixYawFric !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters @@ -10662,7 +10663,6 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] @@ -10673,24 +10673,18 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM CHARACTER(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j, col integer(IntKi) :: iVarBlPitchCom, iVarBlPitchComC - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if + m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function ! Initialize pitch command variable indices iVarBlPitchCom = 0 iVarBlPitchComC = 0 - do i = 1, size(VarsL%u) - select case (VarsL%u(i)%DL%Num) + do i = 1, size(Vars%u) + select case (Vars%u(i)%DL%Num) case (ED_u_BlPitchCom) iVarBlPitchCom = i case (ED_u_BlPitchComC) @@ -10701,102 +10695,102 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Update copy of the inputs to perturb call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackInputAry(VarsL, u, m%Jac%u) + call ED_PackInputAry(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(VarsL%u) + do i = 1, size(Vars%u) ! Skip extended variable if (i == iVarBlPitchComC) cycle ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) + call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do ! Extended: BlPitchComC is the sum of BlPitchCom across all blades if (iVarBlPitchComC > 0) then if (iVarBlPitchCom > 0) then - associate (Var => VarsL%u(iVarBlPitchCom)) - dYdu(:,VarsL%u(iVarBlPitchComC)%iLoc(1)) = sum(dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + associate (Var => Vars%u(iVarBlPitchCom)) + dYdu(:,Vars%u(iVarBlPitchComC)%iLoc(1)) = sum(dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) end associate else - dYdu(:,VarsL%u(iVarBlPitchComC)%iLoc(1)) = 0.0_R8Ki + dYdu(:,Vars%u(iVarBlPitchComC)%iLoc(1)) = 0.0_R8Ki end if end if end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - if (present(dXdu) .and. (VarsL%Nx > 0)) then + if (present(dXdu) .and. (m%Jac%Nx > 0)) then ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(VarsL%u) + do i = 1, size(Vars%u) ! Skip extended variable if (i == iVarBlPitchComC) cycle ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) + call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) + call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do end do ! Extended: BlPitchComC is the sum of BlPitchCom across all blades if (iVarBlPitchComC > 0) then if (iVarBlPitchCom > 0) then - associate (Var => VarsL%u(iVarBlPitchCom)) - dXdu(:,VarsL%u(iVarBlPitchComC)%iLoc(1)) = sum(dXdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + associate (Var => Vars%u(iVarBlPitchCom)) + dXdu(:,Vars%u(iVarBlPitchComC)%iLoc(1)) = sum(dXdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) end associate else - dXdu(:,VarsL%u(iVarBlPitchComC)%iLoc(1)) = 0.0_R8Ki + dXdu(:,Vars%u(iVarBlPitchComC)%iLoc(1)) = 0.0_R8Ki end if end if @@ -10825,9 +10819,9 @@ END SUBROUTINE ED_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx ) -!.................................................................................................................................. +SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters @@ -10842,7 +10836,6 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] @@ -10854,90 +10847,83 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, logical :: IsFullLin integer(IntKi) :: FlagFilterLoc INTEGER(IntKi) :: i, j, col - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function ! Copy state values call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(VarsL, x, m%Jac%x) + call ED_PackContStateAry(Vars, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(p%Vars%x) + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) + call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - if (present(dXdx) .and. (VarsL%Nx > 0)) then + if (present(dXdx) .and. (m%Jac%Nx > 0)) then ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(VarsL%x) + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%x(i)%Num + do j = 1, Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) + call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) + call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index - col = VarsL%x(i)%iLoc(1) + j - 1 + col = Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) end do end do @@ -11110,8 +11096,9 @@ END SUBROUTINE ED_JacobianPConstrState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) +SUBROUTINE ED_GetOP(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) + type(ModVarsType), INTENT(IN ) :: Vars !< Module information REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters @@ -11123,7 +11110,6 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states @@ -11136,30 +11122,23 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 INTEGER(IntKi) :: i, k - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if !.................................. if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(u_op, Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return u_op = 0.0_R8Ki end if ! Pack input type into array - call ED_PackInputAry(VarsL, u, u_op) + call ED_PackInputAry(Vars, u, u_op) ! If full linearization, check extended inputs - if (MV_FindVarDatLoc(VarsL%u, ED_u_BlPitchComC) > 0) then + if (MV_FindVarDatLoc(Vars%u, DatLoc(ED_u_BlPitchComC)) > 0) then do k = 2,p%NumBl if (.not. EqualRealNos(u%BlPitchCom(1), u%BlPitchCom(k)) ) then call SetErrStat(ErrID_Info, "Operating point of collective pitch extended input is invalid because "// & @@ -11174,11 +11153,11 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y_op, Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return y_op = 0.0_R8Ki end if - call ED_PackOutputAry(VarsL, y, y_op) + call ED_PackOutputAry(Vars, y, y_op) end if @@ -11186,11 +11165,11 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(x_op, Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return x_op = 0.0_R8Ki end if - call ED_PackContStateAry(VarsL, x, x_op) + call ED_PackContStateAry(Vars, x, x_op) end if @@ -11198,12 +11177,12 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, VarsL%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dx_op, Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return dx_op = 0.0_R8Ki end if call ED_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(VarsL, m%dxdt_lin, dx_op) + call ED_PackContStateAry(Vars, m%dxdt_lin, dx_op) end if @@ -11224,30 +11203,22 @@ END SUBROUTINE ED_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> ED_SetOP sets input and state values from an array. Inverse of ED_GetOP -subroutine ED_SetOP(u, p, x, xd, z, Vars, u_op, x_op, xd_op, z_op) +subroutine ED_SetOP(Vars, u, p, x, xd, z, u_op, x_op, xd_op, z_op) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module information TYPE(ED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(ED_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point TYPE(ED_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states at operating point TYPE(ED_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - type(ModVarsType), pointer :: VarsL - - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - - if (present(u_op)) call ED_UnpackInputAry(VarsL, u_op, u) - if (present(x_op)) call ED_UnpackContStateAry(VarsL, x_op, x) - ! if (present(xd_op)) call ED_UnpackDiscStateAry(VarsL, xd, xd_op) - ! if (present(z_op)) call ED_UnpackDiscStateAry(VarsL, z, z_op) + if (present(u_op)) call ED_UnpackInputAry(Vars, u_op, u) + if (present(x_op)) call ED_UnpackContStateAry(Vars, x_op, x) + ! if (present(xd_op)) call ED_UnpackDiscStateAry(Vars, xd, xd_op) + ! if (present(z_op)) call ED_UnpackDiscStateAry(Vars, z, z_op) END subroutine !---------------------------------------------------------------------------------------------------------------------------------- @@ -11255,13 +11226,13 @@ subroutine ED_SetOP(u, p, x, xd, z, Vars, u_op, x_op, xd_op, z_op) !---------------------------------------------------------------------------------------------------------------------------------- ! Tight Coupling !---------------------------------------------------------------------------------------------------------------------------------- -subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) +subroutine ED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) type(ED_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(ED_ParameterType), intent(inout) :: p !< Parameters type(ED_ContinuousStateType), intent(inout) :: x !< Continuous state type(ED_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; type(ED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) - type(ED_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + type(ModVarsType), intent(inout) :: Vars !< Module variables type(ED_InputFile), intent(in) :: InputFileData !< Input file data logical, intent(in) :: Linearize !< Flag to initialize linearization variables integer(IntKi), intent(out) :: ErrStat !< Error status of the operation @@ -11279,128 +11250,120 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat ErrStat = ErrID_None ErrMsg = "" - ! Allocate space for variables (deallocate if already allocated) - if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating vars", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Associate pointer in init output - InitOut%Vars => p%Vars + ! Clear module variables type + call NWTC_Library_DestroyModVarsType(Vars, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Continuous State Variables !---------------------------------------------------------------------------- ! Add continuous state variables (translation and rotation) - call MV_AddVar(p%Vars%x, 'PlatformSurge', FieldTransDisp, & + call MV_AddVar(Vars%x, 'PlatformSurge', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_Sg, & Flags=VF_DerivOrder2, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal surge translation DOF (internal DOF index = DOF_Sg), m'], & Active=InputFileData%PtfmSgDOF) - call MV_AddVar(p%Vars%x, 'PlatformSway', FieldTransDisp, & + call MV_AddVar(Vars%x, 'PlatformSway', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_Sw, & Flags=VF_DerivOrder2, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal sway translation DOF (internal DOF index = DOF_Sw), m'], & Active=InputFileData%PtfmSwDOF) - call MV_AddVar(p%Vars%x, 'PlatformHeave', FieldTransDisp, & + call MV_AddVar(Vars%x, 'PlatformHeave', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_Hv, & Flags=VF_DerivOrder2, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform vertical heave translation DOF (internal DOF index = DOF_Hv), m'], & Active=InputFileData%PtfmHvDOF) - call MV_AddVar(p%Vars%x, 'PlatformRoll', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'PlatformRoll', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_R, & Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform roll tilt rotation DOF (internal DOF index = DOF_R), rad'], & Active=InputFileData%PtfmRDOF) - call MV_AddVar(p%Vars%x, 'PlatformPitch', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'PlatformPitch', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_P, & Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform pitch tilt rotation DOF (internal DOF index = DOF_P), rad'], & Active=InputFileData%PtfmPDOF) - call MV_AddVar(p%Vars%x, 'PlatformYaw', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'PlatformYaw', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_Y, & Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform yaw rotation DOF (internal DOF index = DOF_Y), rad'], & Active=InputFileData%PtfmYDOF) - call MV_AddVar(p%Vars%x, 'TowerFA1', FieldTransDisp, & + call MV_AddVar(Vars%x, 'TowerFA1', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_TFA1, & Flags=VF_DerivOrder2, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower fore-aft bending mode DOF (internal DOF index = DOF_TFA1), m'], & Active=InputFileData%TwFADOF1) - call MV_AddVar(p%Vars%x, 'TowerSS1', FieldTransDisp, & + call MV_AddVar(Vars%x, 'TowerSS1', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_TSS1, & Flags=VF_DerivOrder2, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower side-to-side bending mode DOF (internal DOF index = DOF_TSS1), m'], & Active=InputFileData%TwSSDOF1) - call MV_AddVar(p%Vars%x, 'TowerFA2', FieldTransDisp, & + call MV_AddVar(Vars%x, 'TowerFA2', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_TFA2, & Flags=VF_DerivOrder2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower fore-aft bending mode DOF (internal DOF index = DOF_TFA2), m'], & Active=InputFileData%TwFADOF2) - call MV_AddVar(p%Vars%x, 'TowerSS2', FieldTransDisp, & + call MV_AddVar(Vars%x, 'TowerSS2', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_TSS2, & Flags=VF_DerivOrder2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower side-to-side bending mode DOF (internal DOF index = DOF_TSS2), m'], & Active=InputFileData%TwSSDOF2) - call MV_AddVar(p%Vars%x, 'NacelleYaw', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'NacelleYaw', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_Yaw, & Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Nacelle yaw DOF (internal DOF index = DOF_Yaw), rad'], & Active=InputFileData%YawDOF) - call MV_AddVar(p%Vars%x, 'RotorFurl', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'RotorFurl', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_RFrl, & Flags=VF_DerivOrder2 + VF_AeroMap, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Rotor-furl DOF (internal DOF index = DOF_RFrl), rad'], & Active=InputFileData%RFrlDOF) - call MV_AddVar(p%Vars%x, 'GeneratorAzimuth', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'GeneratorAzimuth', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_GeAz, & Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Variable speed generator DOF (internal DOF index = DOF_GeAz), rad'], & Active=InputFileData%GenDOF) - call MV_AddVar(p%Vars%x, 'DrivetrainFlexibility', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'DrivetrainFlexibility', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_DrTr, & Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Drivetrain rotational-flexibility DOF (internal DOF index = DOF_DrTr), rad'], & Active=InputFileData%DrTrDOF) - call MV_AddVar(p%Vars%x, 'TailFurl', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'TailFurl', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_TFrl, & Flags=VF_DerivOrder2 + VF_AeroMap, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Tail-furl DOF (internal DOF index = DOF_TFrl), rad'], & Active=InputFileData%TFrlDOF) - call MV_AddVar(p%Vars%x, 'RotorTeeter', FieldAngularDisp, & + call MV_AddVar(Vars%x, 'RotorTeeter', FieldAngularDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_Teet, & Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & @@ -11410,7 +11373,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) - call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', FieldTransDisp, & + call MV_AddVar(Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_BF(i,1), & Flags=Flags, & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & @@ -11422,7 +11385,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) - call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', FieldTransDisp, & + call MV_AddVar(Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_BE(i,1), & Flags=Flags, & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & @@ -11434,7 +11397,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%NumBl Flags = ior(VF_RotFrame, VF_DerivOrder2) if (i == 1) Flags = ior(Flags, VF_AeroMap) - call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', FieldTransDisp, & + call MV_AddVar(Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', FieldTransDisp, & DL=DatLoc(ED_x_QT), iAry=DOF_BF(i,2), & Flags=Flags, & Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & @@ -11444,14 +11407,14 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat end do ! Derivatives of continuous state variables - if (allocated(p%Vars%x)) then - do i = 1, size(p%Vars%x) + if (allocated(Vars%x)) then + do i = 1, size(Vars%x) ! Increase variable perturbation if below minimum - p%Vars%x(i)%Perturb = max(p%Vars%x(i)%Perturb, MinPerturb) + Vars%x(i)%Perturb = max(Vars%x(i)%Perturb, MinPerturb) ! Update from position to velocity - select case (p%Vars%x(i)%Field) + select case (Vars%x(i)%Field) case (FieldTransDisp) Field = FieldTransVel case (FieldAngularDisp) @@ -11459,14 +11422,14 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat end select ! Add variable (only active variables are in x) - call MV_AddVar(p%Vars%x, p%Vars%x(i)%Name, Field, & - DatLoc(ED_x_QDT), iAry=p%Vars%x(i)%iAry(1), & - Flags=p%Vars%x(i)%Flags, & - Perturb=p%Vars%x(i)%Perturb, & - LinNames=['First time derivative of '//trim(p%Vars%x(i)%LinNames(1))//'/s']) + call MV_AddVar(Vars%x, Vars%x(i)%Name, Field, & + DatLoc(ED_x_QDT), iAry=Vars%x(i)%iAry(1), & + Flags=Vars%x(i)%Flags, & + Perturb=Vars%x(i)%Perturb, & + LinNames=['First time derivative of '//trim(Vars%x(i)%LinNames(1))//'/s']) ! Remove aero map flag from velocity variable - call MV_ClearFlags(p%Vars%x(size(p%Vars%x)), VF_AeroMap) + call MV_ClearFlags(Vars%x(size(Vars%x)), VF_AeroMap) end do end if @@ -11485,7 +11448,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%NumBl Flags = VF_None if (i == 1) Flags = VF_AeroMap - call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(i), LoadFields, & + call MV_AddMeshVar(Vars%u, "Blade "//Num2LStr(i), LoadFields, & DL=DatLoc(ED_u_BladePtLoads, i), & Mesh=u%BladePtLoads(i), & Flags=Flags, & @@ -11495,65 +11458,65 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat end if ! Platform point loads - call MV_AddMeshVar(p%Vars%u, "Platform", LoadFields, & + call MV_AddMeshVar(Vars%u, "Platform", LoadFields, & DL=DatLoc(ED_u_PlatformPtMesh), & Mesh=u%PlatformPtMesh, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Tower point loads - call MV_AddMeshVar(p%Vars%u, "Tower", LoadFields, & + call MV_AddMeshVar(Vars%u, "Tower", LoadFields, & DL=DatLoc(ED_u_TowerPtLoads), & Mesh=u%TowerPtLoads, & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%TwrNodes), & MaxTorque / (100.0_R8Ki*p%NumBl*p%TwrNodes)]) ! Hub point loads - call MV_AddMeshVar(p%Vars%u, "Hub", LoadFields, & + call MV_AddMeshVar(Vars%u, "Hub", LoadFields, & DL=DatLoc(ED_u_HubPtLoad), & Mesh=u%HubPtLoad, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Nacelle point loads - call MV_AddMeshVar(p%Vars%u, "Nacelle", LoadFields, & + call MV_AddMeshVar(Vars%u, "Nacelle", LoadFields, & DL=DatLoc(ED_u_NacelleLoads), & Mesh=u%NacelleLoads, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! TFinCM point loads - call MV_AddMeshVar(p%Vars%u, "Tailfin", LoadFields, & + call MV_AddMeshVar(Vars%u, "Tailfin", LoadFields, & DL=DatLoc(ED_u_TFinCMLoads), & Mesh=u%TFinCMLoads, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Non-mesh input variables - call MV_AddVar(p%Vars%u, "BlPitchCom", FieldScalar, & + call MV_AddVar(Vars%u, "BlPitchCom", FieldScalar, & DL=DatLoc(ED_u_BlPitchCom), iAry=1, & Num=p%NumBl, & Flags=VF_RotFrame + VF_Linearize + VF_2PI, & Perturb=2.0_R8Ki * D2R_D, & LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) - call MV_AddVar(p%Vars%u, "YawMom", FieldScalar, & + call MV_AddVar(Vars%u, "YawMom", FieldScalar, & DL=DatLoc(ED_u_YawMom), & Flags=VF_Linearize, & Perturb=MaxTorque / 100.0_R8Ki, & LinNames=['Yaw moment, Nm']) - call MV_AddVar(p%Vars%u, "GenTrq", FieldScalar, & + call MV_AddVar(Vars%u, "GenTrq", FieldScalar, & DL=DatLoc(ED_u_GenTrq), & Flags=VF_Linearize, & Perturb=MaxTorque / (100.0_R8Ki*p%GBRatio), & LinNames=['Generator torque, Nm']) - call MV_AddVar(p%Vars%u, "BlPitchComC", FieldScalar, & + call MV_AddVar(Vars%u, "BlPitchComC", FieldScalar, & DL=DatLoc(ED_u_BlPitchComC), & Flags=VF_ExtLin + VF_Linearize + VF_2PI, & LinNames=['Extended input: collective blade-pitch command, rad']) ! Set minimum input perturbations - do i = 1,size(p%Vars%u) - p%Vars%u(i)%Perturb = max(p%Vars%u(i)%Perturb, MinPerturb) + do i = 1,size(Vars%u) + Vars%u(i)%Perturb = max(Vars%u(i)%Perturb, MinPerturb) end do !---------------------------------------------------------------------------- @@ -11564,60 +11527,60 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat do i = 1, p%NumBl Flags = VF_None if (i == 1) Flags = VF_AeroMap - call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & + call MV_AddMeshVar(Vars%y, 'Blade '//Num2LStr(i), [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & DatLoc(ED_y_BladeLn2Mesh, i), & Flags=Flags, & Mesh=y%BladeLn2Mesh(i)) - call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), [FieldTransAcc, FieldAngularAcc], & + call MV_AddMeshVar(Vars%y, 'Blade '//Num2LStr(i), [FieldTransAcc, FieldAngularAcc], & DatLoc(ED_y_BladeLn2Mesh, i), & Mesh=y%BladeLn2Mesh(i)) end do end if - call MV_AddMeshVar(p%Vars%y, 'Platform', MotionFields, & + call MV_AddMeshVar(Vars%y, 'Platform', MotionFields, & DatLoc(ED_y_PlatformPtMesh), & Mesh=y%PlatformPtMesh, & Flags=VF_SmallAngle) - call MV_AddMeshVar(p%Vars%y, 'Tower', MotionFields, & + call MV_AddMeshVar(Vars%y, 'Tower', MotionFields, & DatLoc(ED_y_TowerLn2Mesh), & Mesh=y%TowerLn2Mesh, & Flags=ior(VF_Line, VF_SmallAngle)) - call MV_AddMeshVar(p%Vars%y, 'Hub', [FieldTransDisp, FieldOrientation, FieldAngularVel], & + call MV_AddMeshVar(Vars%y, 'Hub', [FieldTransDisp, FieldOrientation, FieldAngularVel], & DatLoc(ED_y_HubPtMotion), & Mesh=y%HubPtMotion) do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'Blade root '//Num2LStr(i), MotionFields, & + call MV_AddMeshVar(Vars%y, 'Blade root '//Num2LStr(i), MotionFields, & DatLoc(ED_y_BladeRootMotion, i), & Mesh=y%BladeRootMotion(i)) end do - call MV_AddMeshVar(p%Vars%y, 'Nacelle', MotionFields, & + call MV_AddMeshVar(Vars%y, 'Nacelle', MotionFields, & DatLoc(ED_y_NacelleMotion), & Mesh=y%NacelleMotion) - call MV_AddMeshVar(p%Vars%y, 'TailFin', [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & + call MV_AddMeshVar(Vars%y, 'TailFin', [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & DatLoc(ED_y_TFinCMMotion), & Mesh=y%TFinCMMotion) - call MV_AddVar(p%Vars%y, 'Yaw', FieldScalar, & + call MV_AddVar(Vars%y, 'Yaw', FieldScalar, & DatLoc(ED_y_Yaw), & Flags=VF_2PI, & LinNames=['Yaw, rad']) - call MV_AddVar(p%Vars%y, 'YawRate', FieldScalar, & + call MV_AddVar(Vars%y, 'YawRate', FieldScalar, & DatLoc(ED_y_YawRate), & LinNames=['YawRate, rad/s']) - call MV_AddVar(p%Vars%y, 'HSS_Spd', FieldScalar, & + call MV_AddVar(Vars%y, 'HSS_Spd', FieldScalar, & DatLoc(ED_y_HSS_Spd), & LinNames=['HSS_Spd, rad/s']) ! Write output variables do i = 1, p%NumOuts - call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & + call MV_AddVar(Vars%y, p%OutParam(i)%Name, FieldScalar, & DatLoc(ED_y_WriteOutput), iAry=i, & Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & @@ -11626,7 +11589,7 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat k = p%NumOuts + 1 do i = 1, p%BldNd_NumOuts do j = 1, p%BldNd_BladesOut - call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, FieldScalar, & + call MV_AddVar(Vars%y, p%BldNd_OutParam(i)%Name, FieldScalar, & DatLoc(ED_y_WriteOutput), iAry=k, & Num=p%BldNodes, & Flags=VF_WriteOut + VF_RotFrame, & @@ -11637,15 +11600,17 @@ subroutine ED_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat end do !---------------------------------------------------------------------------- - ! Initialize Variables and Jacobian data + ! Initialization dependent on linearization !---------------------------------------------------------------------------- - call MV_InitVarsJac(p%Vars, m%Jac, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return + call MV_InitVarsJac(Vars, m%Jac, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return - call ED_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + if (Linearize) then + call ED_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + end if contains function BldOutLinName(OutParam, iBlade, iNode) result(Name) diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 05c39e19fd..6e46b92f33 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -58,7 +58,7 @@ typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - typedef ^ InitOutputType IntKi GearBox_index - - - "Index to gearbox rotation in state array (for steady-state calculations)" - -typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" +typedef ^ InitOutputType ModVarsType Vars - - - "Module Variables" # ..... Blade Input file data ........................................................................................................... typedef ElastoDyn/ED BladeInputData IntKi NBlInpSt - - - "Number of blade input stations" - @@ -527,7 +527,6 @@ typedef ^ OtherStateType R8Ki OmegaDotTn - - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi DT24 - - - "=DT/24 (used in loose coupling)" seconds typedef ^ ParameterType IntKi BldNodes - - - "Number of blade nodes used in the analysis" - diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 6b7542fc4e..232fd3e0d2 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -79,7 +79,7 @@ MODULE ElastoDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] INTEGER(IntKi) :: GearBox_index = 0_IntKi !< Index to gearbox rotation in state array (for steady-state calculations) [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE ED_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -534,7 +534,6 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] REAL(DbKi) :: DT24 = 0.0_R8Ki !< =DT/24 (used in loose coupling) [seconds] INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] @@ -1153,7 +1152,9 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if DstInitOutputData%GearBox_index = SrcInitOutputData%GearBox_index - DstInitOutputData%Vars => SrcInitOutputData%Vars + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -1206,14 +1207,14 @@ subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%IsLoad_u)) then deallocate(InitOutputData%IsLoad_u) end if - nullify(InitOutputData%Vars) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ED_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInitOutput' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) @@ -1243,13 +1244,7 @@ subroutine ED_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%IsLoad_u) call RegPack(RF, InData%GearBox_index) - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1260,8 +1255,6 @@ subroutine ED_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -1291,24 +1284,7 @@ subroutine ED_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -4890,18 +4866,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ED_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(SrcParamData%Vars)) then - if (.not. associated(DstParamData%Vars)) then - allocate(DstParamData%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if DstParamData%DT = SrcParamData%DT DstParamData%DT24 = SrcParamData%DT24 DstParamData%BldNodes = SrcParamData%BldNodes @@ -5791,12 +5755,6 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ED_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(ParamData%Vars)) then - call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(ParamData%Vars) - ParamData%Vars => null() - end if if (allocated(ParamData%PH)) then deallocate(ParamData%PH) end if @@ -5993,15 +5951,7 @@ subroutine ED_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'ED_PackParam' integer(B8Ki) :: i1, i2, i3, i4, i5 integer(B8Ki) :: LB(5), UB(5) - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if call RegPack(RF, InData%DT) call RegPack(RF, InData%DT24) call RegPack(RF, InData%BldNodes) @@ -6257,27 +6207,7 @@ subroutine ED_UnPackParam(RF, OutData) integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT24); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return @@ -7870,324 +7800,400 @@ function ED_OutputMeshName(ML) result(Name) end select end function +subroutine ED_PackContStateVar(Var, x, ValAry) + type(ED_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ED_x_QT) + call MV_Pack2(Var, x%QT, ValAry) ! Rank 1 Array + case (ED_x_QDT) + call MV_Pack2(Var, x%QDT, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ED_PackContStateAry(Vars, x, ValAry) type(ED_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (ED_x_QT) - call MV_Pack2(Var, x%QT, ValAry) ! Rank 1 Array - case (ED_x_QDT) - call MV_Pack2(Var, x%QDT, ValAry) ! Rank 1 Array - end select - end associate + call ED_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine ED_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ED_x_QT) + call MV_Unpack2(Var, ValAry, x%QT) ! Rank 1 Array + case (ED_x_QDT) + call MV_Unpack2(Var, ValAry, x%QDT) ! Rank 1 Array + end select + end associate +end subroutine + subroutine ED_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ED_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (ED_x_QT) - call MV_Unpack2(Var, ValAry, x%QT) ! Rank 1 Array - case (ED_x_QDT) - call MV_Unpack2(Var, ValAry, x%QDT) ! Rank 1 Array - end select - end associate + call ED_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine ED_PackConstrStateVar(Var, z, ValAry) + type(ED_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ED_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ED_PackConstrStateAry(Vars, z, ValAry) type(ED_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (ED_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call ED_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine ED_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ED_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine ED_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ED_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (ED_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call ED_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine ED_PackInputVar(Var, u, ValAry) + type(ED_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ED_u_BladePtLoads) + call MV_Pack2(Var, u%BladePtLoads(DL%i1), ValAry) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_Pack2(Var, u%PlatformPtMesh, ValAry) ! Mesh + case (ED_u_TowerPtLoads) + call MV_Pack2(Var, u%TowerPtLoads, ValAry) ! Mesh + case (ED_u_HubPtLoad) + call MV_Pack2(Var, u%HubPtLoad, ValAry) ! Mesh + case (ED_u_NacelleLoads) + call MV_Pack2(Var, u%NacelleLoads, ValAry) ! Mesh + case (ED_u_TFinCMLoads) + call MV_Pack2(Var, u%TFinCMLoads, ValAry) ! Mesh + case (ED_u_TwrAddedMass) + call MV_Pack2(Var, u%TwrAddedMass, ValAry) ! Rank 3 Array + case (ED_u_PtfmAddedMass) + call MV_Pack2(Var, u%PtfmAddedMass, ValAry) ! Rank 2 Array + case (ED_u_BlPitchCom) + call MV_Pack2(Var, u%BlPitchCom, ValAry) ! Rank 1 Array + case (ED_u_YawMom) + call MV_Pack2(Var, u%YawMom, ValAry) ! Scalar + case (ED_u_GenTrq) + call MV_Pack2(Var, u%GenTrq, ValAry) ! Scalar + case (ED_u_HSSBrTrqC) + call MV_Pack2(Var, u%HSSBrTrqC, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ED_PackInputAry(Vars, u, ValAry) type(ED_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ED_u_BladePtLoads) - call MV_Pack2(Var, u%BladePtLoads(DL%i1), ValAry) ! Mesh - case (ED_u_PlatformPtMesh) - call MV_Pack2(Var, u%PlatformPtMesh, ValAry) ! Mesh - case (ED_u_TowerPtLoads) - call MV_Pack2(Var, u%TowerPtLoads, ValAry) ! Mesh - case (ED_u_HubPtLoad) - call MV_Pack2(Var, u%HubPtLoad, ValAry) ! Mesh - case (ED_u_NacelleLoads) - call MV_Pack2(Var, u%NacelleLoads, ValAry) ! Mesh - case (ED_u_TFinCMLoads) - call MV_Pack2(Var, u%TFinCMLoads, ValAry) ! Mesh - case (ED_u_TwrAddedMass) - call MV_Pack2(Var, u%TwrAddedMass, ValAry) ! Rank 3 Array - case (ED_u_PtfmAddedMass) - call MV_Pack2(Var, u%PtfmAddedMass, ValAry) ! Rank 2 Array - case (ED_u_BlPitchCom) - call MV_Pack2(Var, u%BlPitchCom, ValAry) ! Rank 1 Array - case (ED_u_YawMom) - call MV_Pack2(Var, u%YawMom, ValAry) ! Scalar - case (ED_u_GenTrq) - call MV_Pack2(Var, u%GenTrq, ValAry) ! Scalar - case (ED_u_HSSBrTrqC) - call MV_Pack2(Var, u%HSSBrTrqC, ValAry) ! Scalar - end select - end associate + call ED_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine ED_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ED_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ED_u_BladePtLoads) + call MV_Unpack2(Var, ValAry, u%BladePtLoads(DL%i1)) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_Unpack2(Var, ValAry, u%PlatformPtMesh) ! Mesh + case (ED_u_TowerPtLoads) + call MV_Unpack2(Var, ValAry, u%TowerPtLoads) ! Mesh + case (ED_u_HubPtLoad) + call MV_Unpack2(Var, ValAry, u%HubPtLoad) ! Mesh + case (ED_u_NacelleLoads) + call MV_Unpack2(Var, ValAry, u%NacelleLoads) ! Mesh + case (ED_u_TFinCMLoads) + call MV_Unpack2(Var, ValAry, u%TFinCMLoads) ! Mesh + case (ED_u_TwrAddedMass) + call MV_Unpack2(Var, ValAry, u%TwrAddedMass) ! Rank 3 Array + case (ED_u_PtfmAddedMass) + call MV_Unpack2(Var, ValAry, u%PtfmAddedMass) ! Rank 2 Array + case (ED_u_BlPitchCom) + call MV_Unpack2(Var, ValAry, u%BlPitchCom) ! Rank 1 Array + case (ED_u_YawMom) + call MV_Unpack2(Var, ValAry, u%YawMom) ! Scalar + case (ED_u_GenTrq) + call MV_Unpack2(Var, ValAry, u%GenTrq) ! Scalar + case (ED_u_HSSBrTrqC) + call MV_Unpack2(Var, ValAry, u%HSSBrTrqC) ! Scalar + end select + end associate +end subroutine + subroutine ED_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ED_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ED_u_BladePtLoads) - call MV_Unpack2(Var, ValAry, u%BladePtLoads(DL%i1)) ! Mesh - case (ED_u_PlatformPtMesh) - call MV_Unpack2(Var, ValAry, u%PlatformPtMesh) ! Mesh - case (ED_u_TowerPtLoads) - call MV_Unpack2(Var, ValAry, u%TowerPtLoads) ! Mesh - case (ED_u_HubPtLoad) - call MV_Unpack2(Var, ValAry, u%HubPtLoad) ! Mesh - case (ED_u_NacelleLoads) - call MV_Unpack2(Var, ValAry, u%NacelleLoads) ! Mesh - case (ED_u_TFinCMLoads) - call MV_Unpack2(Var, ValAry, u%TFinCMLoads) ! Mesh - case (ED_u_TwrAddedMass) - call MV_Unpack2(Var, ValAry, u%TwrAddedMass) ! Rank 3 Array - case (ED_u_PtfmAddedMass) - call MV_Unpack2(Var, ValAry, u%PtfmAddedMass) ! Rank 2 Array - case (ED_u_BlPitchCom) - call MV_Unpack2(Var, ValAry, u%BlPitchCom) ! Rank 1 Array - case (ED_u_YawMom) - call MV_Unpack2(Var, ValAry, u%YawMom) ! Scalar - case (ED_u_GenTrq) - call MV_Unpack2(Var, ValAry, u%GenTrq) ! Scalar - case (ED_u_HSSBrTrqC) - call MV_Unpack2(Var, ValAry, u%HSSBrTrqC) ! Scalar - end select - end associate + call ED_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine ED_PackOutputVar(Var, y, ValAry) + type(ED_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_Pack2(Var, y%BladeLn2Mesh(DL%i1), ValAry) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_Pack2(Var, y%PlatformPtMesh, ValAry) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_Pack2(Var, y%TowerLn2Mesh, ValAry) ! Mesh + case (ED_y_HubPtMotion14) + call MV_Pack2(Var, y%HubPtMotion14, ValAry) ! Mesh + case (ED_y_HubPtMotion) + call MV_Pack2(Var, y%HubPtMotion, ValAry) ! Mesh + case (ED_y_BladeRootMotion14) + call MV_Pack2(Var, y%BladeRootMotion14, ValAry) ! Mesh + case (ED_y_BladeRootMotion) + call MV_Pack2(Var, y%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ED_y_RotorFurlMotion14) + call MV_Pack2(Var, y%RotorFurlMotion14, ValAry) ! Mesh + case (ED_y_NacelleMotion) + call MV_Pack2(Var, y%NacelleMotion, ValAry) ! Mesh + case (ED_y_TowerBaseMotion14) + call MV_Pack2(Var, y%TowerBaseMotion14, ValAry) ! Mesh + case (ED_y_TFinCMMotion) + call MV_Pack2(Var, y%TFinCMMotion, ValAry) ! Mesh + case (ED_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (ED_y_BlPitch) + call MV_Pack2(Var, y%BlPitch, ValAry) ! Rank 1 Array + case (ED_y_Yaw) + call MV_Pack2(Var, y%Yaw, ValAry) ! Scalar + case (ED_y_YawRate) + call MV_Pack2(Var, y%YawRate, ValAry) ! Scalar + case (ED_y_LSS_Spd) + call MV_Pack2(Var, y%LSS_Spd, ValAry) ! Scalar + case (ED_y_HSS_Spd) + call MV_Pack2(Var, y%HSS_Spd, ValAry) ! Scalar + case (ED_y_RotSpeed) + call MV_Pack2(Var, y%RotSpeed, ValAry) ! Scalar + case (ED_y_TwrAccel) + call MV_Pack2(Var, y%TwrAccel, ValAry) ! Scalar + case (ED_y_YawAngle) + call MV_Pack2(Var, y%YawAngle, ValAry) ! Scalar + case (ED_y_RootMyc) + call MV_Pack2(Var, y%RootMyc, ValAry) ! Rank 1 Array + case (ED_y_YawBrTAxp) + call MV_Pack2(Var, y%YawBrTAxp, ValAry) ! Scalar + case (ED_y_YawBrTAyp) + call MV_Pack2(Var, y%YawBrTAyp, ValAry) ! Scalar + case (ED_y_LSSTipPxa) + call MV_Pack2(Var, y%LSSTipPxa, ValAry) ! Scalar + case (ED_y_RootMxc) + call MV_Pack2(Var, y%RootMxc, ValAry) ! Rank 1 Array + case (ED_y_LSSTipMxa) + call MV_Pack2(Var, y%LSSTipMxa, ValAry) ! Scalar + case (ED_y_LSSTipMya) + call MV_Pack2(Var, y%LSSTipMya, ValAry) ! Scalar + case (ED_y_LSSTipMza) + call MV_Pack2(Var, y%LSSTipMza, ValAry) ! Scalar + case (ED_y_LSSTipMys) + call MV_Pack2(Var, y%LSSTipMys, ValAry) ! Scalar + case (ED_y_LSSTipMzs) + call MV_Pack2(Var, y%LSSTipMzs, ValAry) ! Scalar + case (ED_y_YawBrMyn) + call MV_Pack2(Var, y%YawBrMyn, ValAry) ! Scalar + case (ED_y_YawBrMzn) + call MV_Pack2(Var, y%YawBrMzn, ValAry) ! Scalar + case (ED_y_NcIMURAxs) + call MV_Pack2(Var, y%NcIMURAxs, ValAry) ! Scalar + case (ED_y_NcIMURAys) + call MV_Pack2(Var, y%NcIMURAys, ValAry) ! Scalar + case (ED_y_NcIMURAzs) + call MV_Pack2(Var, y%NcIMURAzs, ValAry) ! Scalar + case (ED_y_RotPwr) + call MV_Pack2(Var, y%RotPwr, ValAry) ! Scalar + case (ED_y_LSShftFxa) + call MV_Pack2(Var, y%LSShftFxa, ValAry) ! Scalar + case (ED_y_LSShftFys) + call MV_Pack2(Var, y%LSShftFys, ValAry) ! Scalar + case (ED_y_LSShftFzs) + call MV_Pack2(Var, y%LSShftFzs, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ED_PackOutputAry(Vars, y, ValAry) type(ED_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ED_y_BladeLn2Mesh) - call MV_Pack2(Var, y%BladeLn2Mesh(DL%i1), ValAry) ! Mesh - case (ED_y_PlatformPtMesh) - call MV_Pack2(Var, y%PlatformPtMesh, ValAry) ! Mesh - case (ED_y_TowerLn2Mesh) - call MV_Pack2(Var, y%TowerLn2Mesh, ValAry) ! Mesh - case (ED_y_HubPtMotion14) - call MV_Pack2(Var, y%HubPtMotion14, ValAry) ! Mesh - case (ED_y_HubPtMotion) - call MV_Pack2(Var, y%HubPtMotion, ValAry) ! Mesh - case (ED_y_BladeRootMotion14) - call MV_Pack2(Var, y%BladeRootMotion14, ValAry) ! Mesh - case (ED_y_BladeRootMotion) - call MV_Pack2(Var, y%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (ED_y_RotorFurlMotion14) - call MV_Pack2(Var, y%RotorFurlMotion14, ValAry) ! Mesh - case (ED_y_NacelleMotion) - call MV_Pack2(Var, y%NacelleMotion, ValAry) ! Mesh - case (ED_y_TowerBaseMotion14) - call MV_Pack2(Var, y%TowerBaseMotion14, ValAry) ! Mesh - case (ED_y_TFinCMMotion) - call MV_Pack2(Var, y%TFinCMMotion, ValAry) ! Mesh - case (ED_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (ED_y_BlPitch) - call MV_Pack2(Var, y%BlPitch, ValAry) ! Rank 1 Array - case (ED_y_Yaw) - call MV_Pack2(Var, y%Yaw, ValAry) ! Scalar - case (ED_y_YawRate) - call MV_Pack2(Var, y%YawRate, ValAry) ! Scalar - case (ED_y_LSS_Spd) - call MV_Pack2(Var, y%LSS_Spd, ValAry) ! Scalar - case (ED_y_HSS_Spd) - call MV_Pack2(Var, y%HSS_Spd, ValAry) ! Scalar - case (ED_y_RotSpeed) - call MV_Pack2(Var, y%RotSpeed, ValAry) ! Scalar - case (ED_y_TwrAccel) - call MV_Pack2(Var, y%TwrAccel, ValAry) ! Scalar - case (ED_y_YawAngle) - call MV_Pack2(Var, y%YawAngle, ValAry) ! Scalar - case (ED_y_RootMyc) - call MV_Pack2(Var, y%RootMyc, ValAry) ! Rank 1 Array - case (ED_y_YawBrTAxp) - call MV_Pack2(Var, y%YawBrTAxp, ValAry) ! Scalar - case (ED_y_YawBrTAyp) - call MV_Pack2(Var, y%YawBrTAyp, ValAry) ! Scalar - case (ED_y_LSSTipPxa) - call MV_Pack2(Var, y%LSSTipPxa, ValAry) ! Scalar - case (ED_y_RootMxc) - call MV_Pack2(Var, y%RootMxc, ValAry) ! Rank 1 Array - case (ED_y_LSSTipMxa) - call MV_Pack2(Var, y%LSSTipMxa, ValAry) ! Scalar - case (ED_y_LSSTipMya) - call MV_Pack2(Var, y%LSSTipMya, ValAry) ! Scalar - case (ED_y_LSSTipMza) - call MV_Pack2(Var, y%LSSTipMza, ValAry) ! Scalar - case (ED_y_LSSTipMys) - call MV_Pack2(Var, y%LSSTipMys, ValAry) ! Scalar - case (ED_y_LSSTipMzs) - call MV_Pack2(Var, y%LSSTipMzs, ValAry) ! Scalar - case (ED_y_YawBrMyn) - call MV_Pack2(Var, y%YawBrMyn, ValAry) ! Scalar - case (ED_y_YawBrMzn) - call MV_Pack2(Var, y%YawBrMzn, ValAry) ! Scalar - case (ED_y_NcIMURAxs) - call MV_Pack2(Var, y%NcIMURAxs, ValAry) ! Scalar - case (ED_y_NcIMURAys) - call MV_Pack2(Var, y%NcIMURAys, ValAry) ! Scalar - case (ED_y_NcIMURAzs) - call MV_Pack2(Var, y%NcIMURAzs, ValAry) ! Scalar - case (ED_y_RotPwr) - call MV_Pack2(Var, y%RotPwr, ValAry) ! Scalar - case (ED_y_LSShftFxa) - call MV_Pack2(Var, y%LSShftFxa, ValAry) ! Scalar - case (ED_y_LSShftFys) - call MV_Pack2(Var, y%LSShftFys, ValAry) ! Scalar - case (ED_y_LSShftFzs) - call MV_Pack2(Var, y%LSShftFzs, ValAry) ! Scalar - end select - end associate + call ED_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine ED_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ED_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_Unpack2(Var, ValAry, y%BladeLn2Mesh(DL%i1)) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_Unpack2(Var, ValAry, y%PlatformPtMesh) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_Unpack2(Var, ValAry, y%TowerLn2Mesh) ! Mesh + case (ED_y_HubPtMotion14) + call MV_Unpack2(Var, ValAry, y%HubPtMotion14) ! Mesh + case (ED_y_HubPtMotion) + call MV_Unpack2(Var, ValAry, y%HubPtMotion) ! Mesh + case (ED_y_BladeRootMotion14) + call MV_Unpack2(Var, ValAry, y%BladeRootMotion14) ! Mesh + case (ED_y_BladeRootMotion) + call MV_Unpack2(Var, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh + case (ED_y_RotorFurlMotion14) + call MV_Unpack2(Var, ValAry, y%RotorFurlMotion14) ! Mesh + case (ED_y_NacelleMotion) + call MV_Unpack2(Var, ValAry, y%NacelleMotion) ! Mesh + case (ED_y_TowerBaseMotion14) + call MV_Unpack2(Var, ValAry, y%TowerBaseMotion14) ! Mesh + case (ED_y_TFinCMMotion) + call MV_Unpack2(Var, ValAry, y%TFinCMMotion) ! Mesh + case (ED_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (ED_y_BlPitch) + call MV_Unpack2(Var, ValAry, y%BlPitch) ! Rank 1 Array + case (ED_y_Yaw) + call MV_Unpack2(Var, ValAry, y%Yaw) ! Scalar + case (ED_y_YawRate) + call MV_Unpack2(Var, ValAry, y%YawRate) ! Scalar + case (ED_y_LSS_Spd) + call MV_Unpack2(Var, ValAry, y%LSS_Spd) ! Scalar + case (ED_y_HSS_Spd) + call MV_Unpack2(Var, ValAry, y%HSS_Spd) ! Scalar + case (ED_y_RotSpeed) + call MV_Unpack2(Var, ValAry, y%RotSpeed) ! Scalar + case (ED_y_TwrAccel) + call MV_Unpack2(Var, ValAry, y%TwrAccel) ! Scalar + case (ED_y_YawAngle) + call MV_Unpack2(Var, ValAry, y%YawAngle) ! Scalar + case (ED_y_RootMyc) + call MV_Unpack2(Var, ValAry, y%RootMyc) ! Rank 1 Array + case (ED_y_YawBrTAxp) + call MV_Unpack2(Var, ValAry, y%YawBrTAxp) ! Scalar + case (ED_y_YawBrTAyp) + call MV_Unpack2(Var, ValAry, y%YawBrTAyp) ! Scalar + case (ED_y_LSSTipPxa) + call MV_Unpack2(Var, ValAry, y%LSSTipPxa) ! Scalar + case (ED_y_RootMxc) + call MV_Unpack2(Var, ValAry, y%RootMxc) ! Rank 1 Array + case (ED_y_LSSTipMxa) + call MV_Unpack2(Var, ValAry, y%LSSTipMxa) ! Scalar + case (ED_y_LSSTipMya) + call MV_Unpack2(Var, ValAry, y%LSSTipMya) ! Scalar + case (ED_y_LSSTipMza) + call MV_Unpack2(Var, ValAry, y%LSSTipMza) ! Scalar + case (ED_y_LSSTipMys) + call MV_Unpack2(Var, ValAry, y%LSSTipMys) ! Scalar + case (ED_y_LSSTipMzs) + call MV_Unpack2(Var, ValAry, y%LSSTipMzs) ! Scalar + case (ED_y_YawBrMyn) + call MV_Unpack2(Var, ValAry, y%YawBrMyn) ! Scalar + case (ED_y_YawBrMzn) + call MV_Unpack2(Var, ValAry, y%YawBrMzn) ! Scalar + case (ED_y_NcIMURAxs) + call MV_Unpack2(Var, ValAry, y%NcIMURAxs) ! Scalar + case (ED_y_NcIMURAys) + call MV_Unpack2(Var, ValAry, y%NcIMURAys) ! Scalar + case (ED_y_NcIMURAzs) + call MV_Unpack2(Var, ValAry, y%NcIMURAzs) ! Scalar + case (ED_y_RotPwr) + call MV_Unpack2(Var, ValAry, y%RotPwr) ! Scalar + case (ED_y_LSShftFxa) + call MV_Unpack2(Var, ValAry, y%LSShftFxa) ! Scalar + case (ED_y_LSShftFys) + call MV_Unpack2(Var, ValAry, y%LSShftFys) ! Scalar + case (ED_y_LSShftFzs) + call MV_Unpack2(Var, ValAry, y%LSShftFzs) ! Scalar + end select + end associate +end subroutine + subroutine ED_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ED_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ED_y_BladeLn2Mesh) - call MV_Unpack2(Var, ValAry, y%BladeLn2Mesh(DL%i1)) ! Mesh - case (ED_y_PlatformPtMesh) - call MV_Unpack2(Var, ValAry, y%PlatformPtMesh) ! Mesh - case (ED_y_TowerLn2Mesh) - call MV_Unpack2(Var, ValAry, y%TowerLn2Mesh) ! Mesh - case (ED_y_HubPtMotion14) - call MV_Unpack2(Var, ValAry, y%HubPtMotion14) ! Mesh - case (ED_y_HubPtMotion) - call MV_Unpack2(Var, ValAry, y%HubPtMotion) ! Mesh - case (ED_y_BladeRootMotion14) - call MV_Unpack2(Var, ValAry, y%BladeRootMotion14) ! Mesh - case (ED_y_BladeRootMotion) - call MV_Unpack2(Var, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh - case (ED_y_RotorFurlMotion14) - call MV_Unpack2(Var, ValAry, y%RotorFurlMotion14) ! Mesh - case (ED_y_NacelleMotion) - call MV_Unpack2(Var, ValAry, y%NacelleMotion) ! Mesh - case (ED_y_TowerBaseMotion14) - call MV_Unpack2(Var, ValAry, y%TowerBaseMotion14) ! Mesh - case (ED_y_TFinCMMotion) - call MV_Unpack2(Var, ValAry, y%TFinCMMotion) ! Mesh - case (ED_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (ED_y_BlPitch) - call MV_Unpack2(Var, ValAry, y%BlPitch) ! Rank 1 Array - case (ED_y_Yaw) - call MV_Unpack2(Var, ValAry, y%Yaw) ! Scalar - case (ED_y_YawRate) - call MV_Unpack2(Var, ValAry, y%YawRate) ! Scalar - case (ED_y_LSS_Spd) - call MV_Unpack2(Var, ValAry, y%LSS_Spd) ! Scalar - case (ED_y_HSS_Spd) - call MV_Unpack2(Var, ValAry, y%HSS_Spd) ! Scalar - case (ED_y_RotSpeed) - call MV_Unpack2(Var, ValAry, y%RotSpeed) ! Scalar - case (ED_y_TwrAccel) - call MV_Unpack2(Var, ValAry, y%TwrAccel) ! Scalar - case (ED_y_YawAngle) - call MV_Unpack2(Var, ValAry, y%YawAngle) ! Scalar - case (ED_y_RootMyc) - call MV_Unpack2(Var, ValAry, y%RootMyc) ! Rank 1 Array - case (ED_y_YawBrTAxp) - call MV_Unpack2(Var, ValAry, y%YawBrTAxp) ! Scalar - case (ED_y_YawBrTAyp) - call MV_Unpack2(Var, ValAry, y%YawBrTAyp) ! Scalar - case (ED_y_LSSTipPxa) - call MV_Unpack2(Var, ValAry, y%LSSTipPxa) ! Scalar - case (ED_y_RootMxc) - call MV_Unpack2(Var, ValAry, y%RootMxc) ! Rank 1 Array - case (ED_y_LSSTipMxa) - call MV_Unpack2(Var, ValAry, y%LSSTipMxa) ! Scalar - case (ED_y_LSSTipMya) - call MV_Unpack2(Var, ValAry, y%LSSTipMya) ! Scalar - case (ED_y_LSSTipMza) - call MV_Unpack2(Var, ValAry, y%LSSTipMza) ! Scalar - case (ED_y_LSSTipMys) - call MV_Unpack2(Var, ValAry, y%LSSTipMys) ! Scalar - case (ED_y_LSSTipMzs) - call MV_Unpack2(Var, ValAry, y%LSSTipMzs) ! Scalar - case (ED_y_YawBrMyn) - call MV_Unpack2(Var, ValAry, y%YawBrMyn) ! Scalar - case (ED_y_YawBrMzn) - call MV_Unpack2(Var, ValAry, y%YawBrMzn) ! Scalar - case (ED_y_NcIMURAxs) - call MV_Unpack2(Var, ValAry, y%NcIMURAxs) ! Scalar - case (ED_y_NcIMURAys) - call MV_Unpack2(Var, ValAry, y%NcIMURAys) ! Scalar - case (ED_y_NcIMURAzs) - call MV_Unpack2(Var, ValAry, y%NcIMURAzs) ! Scalar - case (ED_y_RotPwr) - call MV_Unpack2(Var, ValAry, y%RotPwr) ! Scalar - case (ED_y_LSShftFxa) - call MV_Unpack2(Var, ValAry, y%LSShftFxa) ! Scalar - case (ED_y_LSShftFys) - call MV_Unpack2(Var, ValAry, y%LSShftFys) ! Scalar - case (ED_y_LSShftFzs) - call MV_Unpack2(Var, ValAry, y%LSShftFzs) ! Scalar - end select - end associate + call ED_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE ElastoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index f507c7eced..7f399f8e18 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -2868,140 +2868,178 @@ function ExtInfw_OutputMeshName(ML) result(Name) end select end function +subroutine ExtInfw_PackInputVar(Var, u, ValAry) + type(ExtInfw_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtInfw_u_pxVel) + call MV_Pack2(Var, u%pxVel, ValAry) ! Rank 1 Array + case (ExtInfw_u_pyVel) + call MV_Pack2(Var, u%pyVel, ValAry) ! Rank 1 Array + case (ExtInfw_u_pzVel) + call MV_Pack2(Var, u%pzVel, ValAry) ! Rank 1 Array + case (ExtInfw_u_pxForce) + call MV_Pack2(Var, u%pxForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_pyForce) + call MV_Pack2(Var, u%pyForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_pzForce) + call MV_Pack2(Var, u%pzForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_xdotForce) + call MV_Pack2(Var, u%xdotForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_ydotForce) + call MV_Pack2(Var, u%ydotForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_zdotForce) + call MV_Pack2(Var, u%zdotForce, ValAry) ! Rank 1 Array + case (ExtInfw_u_pOrientation) + call MV_Pack2(Var, u%pOrientation, ValAry) ! Rank 1 Array + case (ExtInfw_u_fx) + call MV_Pack2(Var, u%fx, ValAry) ! Rank 1 Array + case (ExtInfw_u_fy) + call MV_Pack2(Var, u%fy, ValAry) ! Rank 1 Array + case (ExtInfw_u_fz) + call MV_Pack2(Var, u%fz, ValAry) ! Rank 1 Array + case (ExtInfw_u_momentx) + call MV_Pack2(Var, u%momentx, ValAry) ! Rank 1 Array + case (ExtInfw_u_momenty) + call MV_Pack2(Var, u%momenty, ValAry) ! Rank 1 Array + case (ExtInfw_u_momentz) + call MV_Pack2(Var, u%momentz, ValAry) ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + call MV_Pack2(Var, u%forceNodesChord, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtInfw_PackInputAry(Vars, u, ValAry) type(ExtInfw_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ExtInfw_u_pxVel) - call MV_Pack2(Var, u%pxVel, ValAry) ! Rank 1 Array - case (ExtInfw_u_pyVel) - call MV_Pack2(Var, u%pyVel, ValAry) ! Rank 1 Array - case (ExtInfw_u_pzVel) - call MV_Pack2(Var, u%pzVel, ValAry) ! Rank 1 Array - case (ExtInfw_u_pxForce) - call MV_Pack2(Var, u%pxForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_pyForce) - call MV_Pack2(Var, u%pyForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_pzForce) - call MV_Pack2(Var, u%pzForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_xdotForce) - call MV_Pack2(Var, u%xdotForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_ydotForce) - call MV_Pack2(Var, u%ydotForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_zdotForce) - call MV_Pack2(Var, u%zdotForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_pOrientation) - call MV_Pack2(Var, u%pOrientation, ValAry) ! Rank 1 Array - case (ExtInfw_u_fx) - call MV_Pack2(Var, u%fx, ValAry) ! Rank 1 Array - case (ExtInfw_u_fy) - call MV_Pack2(Var, u%fy, ValAry) ! Rank 1 Array - case (ExtInfw_u_fz) - call MV_Pack2(Var, u%fz, ValAry) ! Rank 1 Array - case (ExtInfw_u_momentx) - call MV_Pack2(Var, u%momentx, ValAry) ! Rank 1 Array - case (ExtInfw_u_momenty) - call MV_Pack2(Var, u%momenty, ValAry) ! Rank 1 Array - case (ExtInfw_u_momentz) - call MV_Pack2(Var, u%momentz, ValAry) ! Rank 1 Array - case (ExtInfw_u_forceNodesChord) - call MV_Pack2(Var, u%forceNodesChord, ValAry) ! Rank 1 Array - end select - end associate + call ExtInfw_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine ExtInfw_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtInfw_u_pxVel) + call MV_Unpack2(Var, ValAry, u%pxVel) ! Rank 1 Array + case (ExtInfw_u_pyVel) + call MV_Unpack2(Var, ValAry, u%pyVel) ! Rank 1 Array + case (ExtInfw_u_pzVel) + call MV_Unpack2(Var, ValAry, u%pzVel) ! Rank 1 Array + case (ExtInfw_u_pxForce) + call MV_Unpack2(Var, ValAry, u%pxForce) ! Rank 1 Array + case (ExtInfw_u_pyForce) + call MV_Unpack2(Var, ValAry, u%pyForce) ! Rank 1 Array + case (ExtInfw_u_pzForce) + call MV_Unpack2(Var, ValAry, u%pzForce) ! Rank 1 Array + case (ExtInfw_u_xdotForce) + call MV_Unpack2(Var, ValAry, u%xdotForce) ! Rank 1 Array + case (ExtInfw_u_ydotForce) + call MV_Unpack2(Var, ValAry, u%ydotForce) ! Rank 1 Array + case (ExtInfw_u_zdotForce) + call MV_Unpack2(Var, ValAry, u%zdotForce) ! Rank 1 Array + case (ExtInfw_u_pOrientation) + call MV_Unpack2(Var, ValAry, u%pOrientation) ! Rank 1 Array + case (ExtInfw_u_fx) + call MV_Unpack2(Var, ValAry, u%fx) ! Rank 1 Array + case (ExtInfw_u_fy) + call MV_Unpack2(Var, ValAry, u%fy) ! Rank 1 Array + case (ExtInfw_u_fz) + call MV_Unpack2(Var, ValAry, u%fz) ! Rank 1 Array + case (ExtInfw_u_momentx) + call MV_Unpack2(Var, ValAry, u%momentx) ! Rank 1 Array + case (ExtInfw_u_momenty) + call MV_Unpack2(Var, ValAry, u%momenty) ! Rank 1 Array + case (ExtInfw_u_momentz) + call MV_Unpack2(Var, ValAry, u%momentz) ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + call MV_Unpack2(Var, ValAry, u%forceNodesChord) ! Rank 1 Array + end select + end associate +end subroutine + subroutine ExtInfw_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtInfw_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ExtInfw_u_pxVel) - call MV_Unpack2(Var, ValAry, u%pxVel) ! Rank 1 Array - case (ExtInfw_u_pyVel) - call MV_Unpack2(Var, ValAry, u%pyVel) ! Rank 1 Array - case (ExtInfw_u_pzVel) - call MV_Unpack2(Var, ValAry, u%pzVel) ! Rank 1 Array - case (ExtInfw_u_pxForce) - call MV_Unpack2(Var, ValAry, u%pxForce) ! Rank 1 Array - case (ExtInfw_u_pyForce) - call MV_Unpack2(Var, ValAry, u%pyForce) ! Rank 1 Array - case (ExtInfw_u_pzForce) - call MV_Unpack2(Var, ValAry, u%pzForce) ! Rank 1 Array - case (ExtInfw_u_xdotForce) - call MV_Unpack2(Var, ValAry, u%xdotForce) ! Rank 1 Array - case (ExtInfw_u_ydotForce) - call MV_Unpack2(Var, ValAry, u%ydotForce) ! Rank 1 Array - case (ExtInfw_u_zdotForce) - call MV_Unpack2(Var, ValAry, u%zdotForce) ! Rank 1 Array - case (ExtInfw_u_pOrientation) - call MV_Unpack2(Var, ValAry, u%pOrientation) ! Rank 1 Array - case (ExtInfw_u_fx) - call MV_Unpack2(Var, ValAry, u%fx) ! Rank 1 Array - case (ExtInfw_u_fy) - call MV_Unpack2(Var, ValAry, u%fy) ! Rank 1 Array - case (ExtInfw_u_fz) - call MV_Unpack2(Var, ValAry, u%fz) ! Rank 1 Array - case (ExtInfw_u_momentx) - call MV_Unpack2(Var, ValAry, u%momentx) ! Rank 1 Array - case (ExtInfw_u_momenty) - call MV_Unpack2(Var, ValAry, u%momenty) ! Rank 1 Array - case (ExtInfw_u_momentz) - call MV_Unpack2(Var, ValAry, u%momentz) ! Rank 1 Array - case (ExtInfw_u_forceNodesChord) - call MV_Unpack2(Var, ValAry, u%forceNodesChord) ! Rank 1 Array - end select - end associate + call ExtInfw_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine ExtInfw_PackOutputVar(Var, y, ValAry) + type(ExtInfw_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtInfw_y_u) + call MV_Pack2(Var, y%u, ValAry) ! Rank 1 Array + case (ExtInfw_y_v) + call MV_Pack2(Var, y%v, ValAry) ! Rank 1 Array + case (ExtInfw_y_w) + call MV_Pack2(Var, y%w, ValAry) ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtInfw_PackOutputAry(Vars, y, ValAry) type(ExtInfw_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ExtInfw_y_u) - call MV_Pack2(Var, y%u, ValAry) ! Rank 1 Array - case (ExtInfw_y_v) - call MV_Pack2(Var, y%v, ValAry) ! Rank 1 Array - case (ExtInfw_y_w) - call MV_Pack2(Var, y%w, ValAry) ! Rank 1 Array - case (ExtInfw_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call ExtInfw_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine ExtInfw_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtInfw_y_u) + call MV_Unpack2(Var, ValAry, y%u) ! Rank 1 Array + case (ExtInfw_y_v) + call MV_Unpack2(Var, ValAry, y%v) ! Rank 1 Array + case (ExtInfw_y_w) + call MV_Unpack2(Var, ValAry, y%w) ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine ExtInfw_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtInfw_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ExtInfw_y_u) - call MV_Unpack2(Var, ValAry, y%u) ! Rank 1 Array - case (ExtInfw_y_v) - call MV_Unpack2(Var, ValAry, y%v) ! Rank 1 Array - case (ExtInfw_y_w) - call MV_Unpack2(Var, ValAry, y%w) ! Rank 1 Array - case (ExtInfw_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call ExtInfw_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE ExternalInflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index c5eee5437f..99a5ad20a9 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -1725,88 +1725,126 @@ function ExtLdDX_OutputMeshName(ML) result(Name) end select end function +subroutine ExtLdDX_PackInputVar(Var, u, ValAry) + type(ExtLdDX_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLdDX_u_twrDef) + call MV_Pack2(Var, u%twrDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldDef) + call MV_Pack2(Var, u%bldDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_hubDef) + call MV_Pack2(Var, u%hubDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_nacDef) + call MV_Pack2(Var, u%nacDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + call MV_Pack2(Var, u%bldRootDef, ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + call MV_Pack2(Var, u%bldPitch, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtLdDX_PackInputAry(Vars, u, ValAry) type(ExtLdDX_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ExtLdDX_u_twrDef) - call MV_Pack2(Var, u%twrDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldDef) - call MV_Pack2(Var, u%bldDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_hubDef) - call MV_Pack2(Var, u%hubDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_nacDef) - call MV_Pack2(Var, u%nacDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldRootDef) - call MV_Pack2(Var, u%bldRootDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldPitch) - call MV_Pack2(Var, u%bldPitch, ValAry) ! Rank 1 Array - end select - end associate + call ExtLdDX_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine ExtLdDX_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLdDX_u_twrDef) + call MV_Unpack2(Var, ValAry, u%twrDef) ! Rank 1 Array + case (ExtLdDX_u_bldDef) + call MV_Unpack2(Var, ValAry, u%bldDef) ! Rank 1 Array + case (ExtLdDX_u_hubDef) + call MV_Unpack2(Var, ValAry, u%hubDef) ! Rank 1 Array + case (ExtLdDX_u_nacDef) + call MV_Unpack2(Var, ValAry, u%nacDef) ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + call MV_Unpack2(Var, ValAry, u%bldRootDef) ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + call MV_Unpack2(Var, ValAry, u%bldPitch) ! Rank 1 Array + end select + end associate +end subroutine + subroutine ExtLdDX_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLdDX_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ExtLdDX_u_twrDef) - call MV_Unpack2(Var, ValAry, u%twrDef) ! Rank 1 Array - case (ExtLdDX_u_bldDef) - call MV_Unpack2(Var, ValAry, u%bldDef) ! Rank 1 Array - case (ExtLdDX_u_hubDef) - call MV_Unpack2(Var, ValAry, u%hubDef) ! Rank 1 Array - case (ExtLdDX_u_nacDef) - call MV_Unpack2(Var, ValAry, u%nacDef) ! Rank 1 Array - case (ExtLdDX_u_bldRootDef) - call MV_Unpack2(Var, ValAry, u%bldRootDef) ! Rank 1 Array - case (ExtLdDX_u_bldPitch) - call MV_Unpack2(Var, ValAry, u%bldPitch) ! Rank 1 Array - end select - end associate + call ExtLdDX_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine ExtLdDX_PackOutputVar(Var, y, ValAry) + type(ExtLdDX_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLdDX_y_twrLd) + call MV_Pack2(Var, y%twrLd, ValAry) ! Rank 1 Array + case (ExtLdDX_y_bldLd) + call MV_Pack2(Var, y%bldLd, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtLdDX_PackOutputAry(Vars, y, ValAry) type(ExtLdDX_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ExtLdDX_y_twrLd) - call MV_Pack2(Var, y%twrLd, ValAry) ! Rank 1 Array - case (ExtLdDX_y_bldLd) - call MV_Pack2(Var, y%bldLd, ValAry) ! Rank 1 Array - end select - end associate + call ExtLdDX_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine ExtLdDX_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLdDX_y_twrLd) + call MV_Unpack2(Var, ValAry, y%twrLd) ! Rank 1 Array + case (ExtLdDX_y_bldLd) + call MV_Unpack2(Var, ValAry, y%bldLd) ! Rank 1 Array + end select + end associate +end subroutine + subroutine ExtLdDX_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLdDX_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ExtLdDX_y_twrLd) - call MV_Unpack2(Var, ValAry, y%twrLd) ! Rank 1 Array - case (ExtLdDX_y_bldLd) - call MV_Unpack2(Var, ValAry, y%bldLd) ! Rank 1 Array - end select - end associate + call ExtLdDX_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE ExtLoadsDX_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 2e65938e00..09ee2cc51d 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -1770,188 +1770,264 @@ function ExtLd_OutputMeshName(ML) result(Name) end select end function +subroutine ExtLd_PackContStateVar(Var, x, ValAry) + type(ExtLd_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLd_x_blah) + call MV_Pack2(Var, x%blah, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtLd_PackContStateAry(Vars, x, ValAry) type(ExtLd_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (ExtLd_x_blah) - call MV_Pack2(Var, x%blah, ValAry) ! Scalar - end select - end associate + call ExtLd_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine ExtLd_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLd_x_blah) + call MV_Unpack2(Var, ValAry, x%blah) ! Scalar + end select + end associate +end subroutine + subroutine ExtLd_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (ExtLd_x_blah) - call MV_Unpack2(Var, ValAry, x%blah) ! Scalar - end select - end associate + call ExtLd_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine ExtLd_PackConstrStateVar(Var, z, ValAry) + type(ExtLd_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLd_z_blah) + call MV_Pack2(Var, z%blah, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtLd_PackConstrStateAry(Vars, z, ValAry) type(ExtLd_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (ExtLd_z_blah) - call MV_Pack2(Var, z%blah, ValAry) ! Scalar - end select - end associate + call ExtLd_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine ExtLd_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLd_z_blah) + call MV_Unpack2(Var, ValAry, z%blah) ! Scalar + end select + end associate +end subroutine + subroutine ExtLd_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (ExtLd_z_blah) - call MV_Unpack2(Var, ValAry, z%blah) ! Scalar - end select - end associate + call ExtLd_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine ExtLd_PackInputVar(Var, u, ValAry) + type(ExtLd_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLd_u_DX_u_twrDef) + call MV_Pack2(Var, u%DX_u%twrDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + call MV_Pack2(Var, u%DX_u%bldDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + call MV_Pack2(Var, u%DX_u%hubDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + call MV_Pack2(Var, u%DX_u%nacDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + call MV_Pack2(Var, u%DX_u%bldRootDef, ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + call MV_Pack2(Var, u%DX_u%bldPitch, ValAry) ! Rank 1 Array + case (ExtLd_u_az) + call MV_Pack2(Var, u%az, ValAry) ! Scalar + case (ExtLd_u_TowerMotion) + call MV_Pack2(Var, u%TowerMotion, ValAry) ! Mesh + case (ExtLd_u_HubMotion) + call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_Pack2(Var, u%NacelleMotion, ValAry) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_Pack2(Var, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_Pack2(Var, u%BladeMotion(DL%i1), ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtLd_PackInputAry(Vars, u, ValAry) type(ExtLd_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ExtLd_u_DX_u_twrDef) - call MV_Pack2(Var, u%DX_u%twrDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldDef) - call MV_Pack2(Var, u%DX_u%bldDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_hubDef) - call MV_Pack2(Var, u%DX_u%hubDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_nacDef) - call MV_Pack2(Var, u%DX_u%nacDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldRootDef) - call MV_Pack2(Var, u%DX_u%bldRootDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldPitch) - call MV_Pack2(Var, u%DX_u%bldPitch, ValAry) ! Rank 1 Array - case (ExtLd_u_az) - call MV_Pack2(Var, u%az, ValAry) ! Scalar - case (ExtLd_u_TowerMotion) - call MV_Pack2(Var, u%TowerMotion, ValAry) ! Mesh - case (ExtLd_u_HubMotion) - call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh - case (ExtLd_u_NacelleMotion) - call MV_Pack2(Var, u%NacelleMotion, ValAry) ! Mesh - case (ExtLd_u_BladeRootMotion) - call MV_Pack2(Var, u%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (ExtLd_u_BladeMotion) - call MV_Pack2(Var, u%BladeMotion(DL%i1), ValAry) ! Mesh - end select - end associate + call ExtLd_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine ExtLd_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLd_u_DX_u_twrDef) + call MV_Unpack2(Var, ValAry, u%DX_u%twrDef) ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + call MV_Unpack2(Var, ValAry, u%DX_u%bldDef) ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + call MV_Unpack2(Var, ValAry, u%DX_u%hubDef) ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + call MV_Unpack2(Var, ValAry, u%DX_u%nacDef) ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + call MV_Unpack2(Var, ValAry, u%DX_u%bldRootDef) ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + call MV_Unpack2(Var, ValAry, u%DX_u%bldPitch) ! Rank 1 Array + case (ExtLd_u_az) + call MV_Unpack2(Var, ValAry, u%az) ! Scalar + case (ExtLd_u_TowerMotion) + call MV_Unpack2(Var, ValAry, u%TowerMotion) ! Mesh + case (ExtLd_u_HubMotion) + call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_Unpack2(Var, ValAry, u%NacelleMotion) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_Unpack2(Var, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_Unpack2(Var, ValAry, u%BladeMotion(DL%i1)) ! Mesh + end select + end associate +end subroutine + subroutine ExtLd_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ExtLd_u_DX_u_twrDef) - call MV_Unpack2(Var, ValAry, u%DX_u%twrDef) ! Rank 1 Array - case (ExtLd_u_DX_u_bldDef) - call MV_Unpack2(Var, ValAry, u%DX_u%bldDef) ! Rank 1 Array - case (ExtLd_u_DX_u_hubDef) - call MV_Unpack2(Var, ValAry, u%DX_u%hubDef) ! Rank 1 Array - case (ExtLd_u_DX_u_nacDef) - call MV_Unpack2(Var, ValAry, u%DX_u%nacDef) ! Rank 1 Array - case (ExtLd_u_DX_u_bldRootDef) - call MV_Unpack2(Var, ValAry, u%DX_u%bldRootDef) ! Rank 1 Array - case (ExtLd_u_DX_u_bldPitch) - call MV_Unpack2(Var, ValAry, u%DX_u%bldPitch) ! Rank 1 Array - case (ExtLd_u_az) - call MV_Unpack2(Var, ValAry, u%az) ! Scalar - case (ExtLd_u_TowerMotion) - call MV_Unpack2(Var, ValAry, u%TowerMotion) ! Mesh - case (ExtLd_u_HubMotion) - call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh - case (ExtLd_u_NacelleMotion) - call MV_Unpack2(Var, ValAry, u%NacelleMotion) ! Mesh - case (ExtLd_u_BladeRootMotion) - call MV_Unpack2(Var, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh - case (ExtLd_u_BladeMotion) - call MV_Unpack2(Var, ValAry, u%BladeMotion(DL%i1)) ! Mesh - end select - end associate + call ExtLd_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine ExtLd_PackOutputVar(Var, y, ValAry) + type(ExtLd_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLd_y_DX_y_twrLd) + call MV_Pack2(Var, y%DX_y%twrLd, ValAry) ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + call MV_Pack2(Var, y%DX_y%bldLd, ValAry) ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_Pack2(Var, y%TowerLoad, ValAry) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_Pack2(Var, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (ExtLd_y_TowerLoadAD) + call MV_Pack2(Var, y%TowerLoadAD, ValAry) ! Mesh + case (ExtLd_y_BladeLoadAD) + call MV_Pack2(Var, y%BladeLoadAD(DL%i1), ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtLd_PackOutputAry(Vars, y, ValAry) type(ExtLd_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ExtLd_y_DX_y_twrLd) - call MV_Pack2(Var, y%DX_y%twrLd, ValAry) ! Rank 1 Array - case (ExtLd_y_DX_y_bldLd) - call MV_Pack2(Var, y%DX_y%bldLd, ValAry) ! Rank 1 Array - case (ExtLd_y_TowerLoad) - call MV_Pack2(Var, y%TowerLoad, ValAry) ! Mesh - case (ExtLd_y_BladeLoad) - call MV_Pack2(Var, y%BladeLoad(DL%i1), ValAry) ! Mesh - case (ExtLd_y_TowerLoadAD) - call MV_Pack2(Var, y%TowerLoadAD, ValAry) ! Mesh - case (ExtLd_y_BladeLoadAD) - call MV_Pack2(Var, y%BladeLoadAD(DL%i1), ValAry) ! Mesh - end select - end associate + call ExtLd_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine ExtLd_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtLd_y_DX_y_twrLd) + call MV_Unpack2(Var, ValAry, y%DX_y%twrLd) ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + call MV_Unpack2(Var, ValAry, y%DX_y%bldLd) ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_Unpack2(Var, ValAry, y%TowerLoad) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_Unpack2(Var, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (ExtLd_y_TowerLoadAD) + call MV_Unpack2(Var, ValAry, y%TowerLoadAD) ! Mesh + case (ExtLd_y_BladeLoadAD) + call MV_Unpack2(Var, ValAry, y%BladeLoadAD(DL%i1)) ! Mesh + end select + end associate +end subroutine + subroutine ExtLd_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ExtLd_y_DX_y_twrLd) - call MV_Unpack2(Var, ValAry, y%DX_y%twrLd) ! Rank 1 Array - case (ExtLd_y_DX_y_bldLd) - call MV_Unpack2(Var, ValAry, y%DX_y%bldLd) ! Rank 1 Array - case (ExtLd_y_TowerLoad) - call MV_Unpack2(Var, ValAry, y%TowerLoad) ! Mesh - case (ExtLd_y_BladeLoad) - call MV_Unpack2(Var, ValAry, y%BladeLoad(DL%i1)) ! Mesh - case (ExtLd_y_TowerLoadAD) - call MV_Unpack2(Var, ValAry, y%TowerLoadAD) ! Mesh - case (ExtLd_y_BladeLoadAD) - call MV_Unpack2(Var, ValAry, y%BladeLoadAD(DL%i1)) ! Mesh - end select - end associate + call ExtLd_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE ExtLoads_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt b/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt index 4297d50b33..7b8f425a72 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt +++ b/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt @@ -83,6 +83,7 @@ typedef ^ MiscVarType ReKi F_at_t {:} - - "The 6 typedef ^ MiscVarType IntKi Indx - - - "Index into times, to speed up interpolation" - typedef ^ MiscVarType LOGICAL EquilStart - - - "Flag to determine the equilibrium position of the CB DOF at initialization (first call)" - typedef ^ ^ ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" +typedef ^ ^ ExtPtfm_ContinuousStateType dxdt_lin - - - "continuous state derivatives" - # ..... Parameters ................................................................................................................ diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 5686f0bc33..026e8ef81d 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -106,6 +106,7 @@ MODULE ExtPtfm_MCKF_Types INTEGER(IntKi) :: Indx = 0_IntKi !< Index into times, to speed up interpolation [-] LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] + TYPE(ExtPtfm_ContinuousStateType) :: dxdt_lin !< continuous state derivatives [-] END TYPE ExtPtfm_MiscVarType ! ======================= ! ========= ExtPtfm_ParameterType ======= @@ -831,6 +832,7 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' ErrStat = ErrID_None ErrMsg = '' @@ -873,12 +875,17 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%AllOuts = SrcMiscData%AllOuts end if + call ExtPtfm_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ExtPtfm_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' @@ -891,6 +898,8 @@ subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%AllOuts)) then deallocate(MiscData%AllOuts) end if + call ExtPtfm_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ExtPtfm_PackMisc(RF, Indata) @@ -904,6 +913,7 @@ subroutine ExtPtfm_PackMisc(RF, Indata) call RegPack(RF, InData%Indx) call RegPack(RF, InData%EquilStart) call RegPackAlloc(RF, InData%AllOuts) + call ExtPtfm_PackContState(RF, InData%dxdt_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -921,6 +931,7 @@ subroutine ExtPtfm_UnPackMisc(RF, OutData) call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call ExtPtfm_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin end subroutine subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1908,132 +1919,208 @@ function ExtPtfm_OutputMeshName(ML) result(Name) end select end function +subroutine ExtPtfm_PackContStateVar(Var, x, ValAry) + type(ExtPtfm_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtPtfm_x_qm) + call MV_Pack2(Var, x%qm, ValAry) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + call MV_Pack2(Var, x%qmdot, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtPtfm_PackContStateAry(Vars, x, ValAry) type(ExtPtfm_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (ExtPtfm_x_qm) - call MV_Pack2(Var, x%qm, ValAry) ! Rank 1 Array - case (ExtPtfm_x_qmdot) - call MV_Pack2(Var, x%qmdot, ValAry) ! Rank 1 Array - end select - end associate + call ExtPtfm_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine ExtPtfm_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtPtfm_x_qm) + call MV_Unpack2(Var, ValAry, x%qm) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + call MV_Unpack2(Var, ValAry, x%qmdot) ! Rank 1 Array + end select + end associate +end subroutine + subroutine ExtPtfm_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (ExtPtfm_x_qm) - call MV_Unpack2(Var, ValAry, x%qm) ! Rank 1 Array - case (ExtPtfm_x_qmdot) - call MV_Unpack2(Var, ValAry, x%qmdot) ! Rank 1 Array - end select - end associate + call ExtPtfm_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine ExtPtfm_PackConstrStateVar(Var, z, ValAry) + type(ExtPtfm_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtPtfm_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtPtfm_PackConstrStateAry(Vars, z, ValAry) type(ExtPtfm_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (ExtPtfm_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call ExtPtfm_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine ExtPtfm_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtPtfm_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine ExtPtfm_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (ExtPtfm_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call ExtPtfm_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine ExtPtfm_PackInputVar(Var, u, ValAry) + type(ExtPtfm_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_Pack2(Var, u%PtfmMesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtPtfm_PackInputAry(Vars, u, ValAry) type(ExtPtfm_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ExtPtfm_u_PtfmMesh) - call MV_Pack2(Var, u%PtfmMesh, ValAry) ! Mesh - end select - end associate + call ExtPtfm_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine ExtPtfm_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_Unpack2(Var, ValAry, u%PtfmMesh) ! Mesh + end select + end associate +end subroutine + subroutine ExtPtfm_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (ExtPtfm_u_PtfmMesh) - call MV_Unpack2(Var, ValAry, u%PtfmMesh) ! Mesh - end select - end associate + call ExtPtfm_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine ExtPtfm_PackOutputVar(Var, y, ValAry) + type(ExtPtfm_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_Pack2(Var, y%PtfmMesh, ValAry) ! Mesh + case (ExtPtfm_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine ExtPtfm_PackOutputAry(Vars, y, ValAry) type(ExtPtfm_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ExtPtfm_y_PtfmMesh) - call MV_Pack2(Var, y%PtfmMesh, ValAry) ! Mesh - case (ExtPtfm_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call ExtPtfm_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine ExtPtfm_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_Unpack2(Var, ValAry, y%PtfmMesh) ! Mesh + case (ExtPtfm_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine ExtPtfm_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (ExtPtfm_y_PtfmMesh) - call MV_Unpack2(Var, ValAry, y%PtfmMesh) ! Mesh - case (ExtPtfm_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call ExtPtfm_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE ExtPtfm_MCKF_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 2fc0ec35ec..e301e5bd17 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -2560,144 +2560,220 @@ function FEAM_OutputMeshName(ML) result(Name) end select end function +subroutine FEAM_PackContStateVar(Var, x, ValAry) + type(FEAM_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FEAM_x_GLU) + call MV_Pack2(Var, x%GLU, ValAry) ! Rank 2 Array + case (FEAM_x_GLDU) + call MV_Pack2(Var, x%GLDU, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine FEAM_PackContStateAry(Vars, x, ValAry) type(FEAM_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (FEAM_x_GLU) - call MV_Pack2(Var, x%GLU, ValAry) ! Rank 2 Array - case (FEAM_x_GLDU) - call MV_Pack2(Var, x%GLDU, ValAry) ! Rank 2 Array - end select - end associate + call FEAM_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine FEAM_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FEAM_x_GLU) + call MV_Unpack2(Var, ValAry, x%GLU) ! Rank 2 Array + case (FEAM_x_GLDU) + call MV_Unpack2(Var, ValAry, x%GLDU) ! Rank 2 Array + end select + end associate +end subroutine + subroutine FEAM_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FEAM_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (FEAM_x_GLU) - call MV_Unpack2(Var, ValAry, x%GLU) ! Rank 2 Array - case (FEAM_x_GLDU) - call MV_Unpack2(Var, ValAry, x%GLDU) ! Rank 2 Array - end select - end associate + call FEAM_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine FEAM_PackConstrStateVar(Var, z, ValAry) + type(FEAM_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FEAM_z_TSN) + call MV_Pack2(Var, z%TSN, ValAry) ! Rank 1 Array + case (FEAM_z_TZER) + call MV_Pack2(Var, z%TZER, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine FEAM_PackConstrStateAry(Vars, z, ValAry) type(FEAM_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (FEAM_z_TSN) - call MV_Pack2(Var, z%TSN, ValAry) ! Rank 1 Array - case (FEAM_z_TZER) - call MV_Pack2(Var, z%TZER, ValAry) ! Rank 1 Array - end select - end associate + call FEAM_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine FEAM_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FEAM_z_TSN) + call MV_Unpack2(Var, ValAry, z%TSN) ! Rank 1 Array + case (FEAM_z_TZER) + call MV_Unpack2(Var, ValAry, z%TZER) ! Rank 1 Array + end select + end associate +end subroutine + subroutine FEAM_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FEAM_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (FEAM_z_TSN) - call MV_Unpack2(Var, ValAry, z%TSN) ! Rank 1 Array - case (FEAM_z_TZER) - call MV_Unpack2(Var, ValAry, z%TZER) ! Rank 1 Array - end select - end associate + call FEAM_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine FEAM_PackInputVar(Var, u, ValAry) + type(FEAM_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_Pack2(Var, u%HydroForceLineMesh, ValAry) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_Pack2(Var, u%PtFairleadDisplacement, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine FEAM_PackInputAry(Vars, u, ValAry) type(FEAM_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (FEAM_u_HydroForceLineMesh) - call MV_Pack2(Var, u%HydroForceLineMesh, ValAry) ! Mesh - case (FEAM_u_PtFairleadDisplacement) - call MV_Pack2(Var, u%PtFairleadDisplacement, ValAry) ! Mesh - end select - end associate + call FEAM_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine FEAM_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_Unpack2(Var, ValAry, u%HydroForceLineMesh) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_Unpack2(Var, ValAry, u%PtFairleadDisplacement) ! Mesh + end select + end associate +end subroutine + subroutine FEAM_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FEAM_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (FEAM_u_HydroForceLineMesh) - call MV_Unpack2(Var, ValAry, u%HydroForceLineMesh) ! Mesh - case (FEAM_u_PtFairleadDisplacement) - call MV_Unpack2(Var, ValAry, u%PtFairleadDisplacement) ! Mesh - end select - end associate + call FEAM_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine FEAM_PackOutputVar(Var, y, ValAry) + type(FEAM_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FEAM_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_Pack2(Var, y%PtFairleadLoad, ValAry) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_Pack2(Var, y%LineMeshPosition, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine FEAM_PackOutputAry(Vars, y, ValAry) type(FEAM_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (FEAM_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (FEAM_y_PtFairleadLoad) - call MV_Pack2(Var, y%PtFairleadLoad, ValAry) ! Mesh - case (FEAM_y_LineMeshPosition) - call MV_Pack2(Var, y%LineMeshPosition, ValAry) ! Mesh - end select - end associate + call FEAM_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine FEAM_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (FEAM_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_Unpack2(Var, ValAry, y%PtFairleadLoad) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_Unpack2(Var, ValAry, y%LineMeshPosition) ! Mesh + end select + end associate +end subroutine + subroutine FEAM_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FEAM_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (FEAM_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (FEAM_y_PtFairleadLoad) - call MV_Unpack2(Var, ValAry, y%PtFairleadLoad) ! Mesh - case (FEAM_y_LineMeshPosition) - call MV_Unpack2(Var, ValAry, y%LineMeshPosition) ! Mesh - end select - end associate + call FEAM_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE FEAMooring_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index b6583e000f..3452d44239 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -1011,124 +1011,200 @@ function Conv_Rdtn_OutputMeshName(ML) result(Name) end select end function +subroutine Conv_Rdtn_PackContStateVar(Var, x, ValAry) + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Conv_Rdtn_PackContStateAry(Vars, x, ValAry) type(Conv_Rdtn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - end select - end associate + call Conv_Rdtn_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine Conv_Rdtn_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine Conv_Rdtn_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate + call Conv_Rdtn_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine Conv_Rdtn_PackConstrStateVar(Var, z, ValAry) + type(Conv_Rdtn_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Conv_Rdtn_PackConstrStateAry(Vars, z, ValAry) type(Conv_Rdtn_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call Conv_Rdtn_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine Conv_Rdtn_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine Conv_Rdtn_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call Conv_Rdtn_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine Conv_Rdtn_PackInputVar(Var, u, ValAry) + type(Conv_Rdtn_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_u_Velocity) + call MV_Pack2(Var, u%Velocity, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Conv_Rdtn_PackInputAry(Vars, u, ValAry) type(Conv_Rdtn_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_u_Velocity) - call MV_Pack2(Var, u%Velocity, ValAry) ! Rank 1 Array - end select - end associate + call Conv_Rdtn_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine Conv_Rdtn_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_u_Velocity) + call MV_Unpack2(Var, ValAry, u%Velocity) ! Rank 1 Array + end select + end associate +end subroutine + subroutine Conv_Rdtn_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_u_Velocity) - call MV_Unpack2(Var, ValAry, u%Velocity) ! Rank 1 Array - end select - end associate + call Conv_Rdtn_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine Conv_Rdtn_PackOutputVar(Var, y, ValAry) + type(Conv_Rdtn_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + call MV_Pack2(Var, y%F_Rdtn, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Conv_Rdtn_PackOutputAry(Vars, y, ValAry) type(Conv_Rdtn_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_y_F_Rdtn) - call MV_Pack2(Var, y%F_Rdtn, ValAry) ! Rank 1 Array - end select - end associate + call Conv_Rdtn_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine Conv_Rdtn_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + call MV_Unpack2(Var, ValAry, y%F_Rdtn) ! Rank 1 Array + end select + end associate +end subroutine + subroutine Conv_Rdtn_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_y_F_Rdtn) - call MV_Unpack2(Var, ValAry, y%F_Rdtn) ! Rank 1 Array - end select - end associate + call Conv_Rdtn_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE Conv_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index bc356a78b4..02d5269386 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -1710,10 +1710,10 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end if ! Get extended input variable indices - iVarWaveElev0 = MV_FindVarDatLoc(VarsL%u, HydroDyn_u_WaveElev0) - iVarHWindSpeed = MV_FindVarDatLoc(VarsL%u, HydroDyn_u_HWindSpeed) - iVarPLexp = MV_FindVarDatLoc(VarsL%u, HydroDyn_u_PLexp) - iVarPropagationDir = MV_FindVarDatLoc(VarsL%u, HydroDyn_u_PropagationDir) + iVarWaveElev0 = MV_FindVarDatLoc(VarsL%u, DatLoc(HydroDyn_u_WaveElev0)) + iVarHWindSpeed = MV_FindVarDatLoc(VarsL%u, DatLoc(HydroDyn_u_HWindSpeed)) + iVarPLexp = MV_FindVarDatLoc(VarsL%u, DatLoc(HydroDyn_u_PLexp)) + iVarPropagationDir = MV_FindVarDatLoc(VarsL%u, DatLoc(HydroDyn_u_PropagationDir)) ! make a copy of the inputs to perturb call HydroDyn_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 467d6655f7..8d1c40ecee 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -2731,180 +2731,256 @@ function HydroDyn_OutputMeshName(ML) result(Name) end select end function +subroutine HydroDyn_PackContStateVar(Var, x, ValAry) + type(HydroDyn_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + call MV_Pack2(Var, x%WAMIT(DL%i1)%SS_Rdtn%x, ValAry) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + call MV_Pack2(Var, x%WAMIT(DL%i1)%SS_Exctn%x, ValAry) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + call MV_Pack2(Var, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState, ValAry) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + call MV_Pack2(Var, x%Morison%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine HydroDyn_PackContStateAry(Vars, x, ValAry) type(HydroDyn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (HydroDyn_x_WAMIT_SS_Rdtn_x) - call MV_Pack2(Var, x%WAMIT(DL%i1)%SS_Rdtn%x, ValAry) ! Rank 1 Array - case (HydroDyn_x_WAMIT_SS_Exctn_x) - call MV_Pack2(Var, x%WAMIT(DL%i1)%SS_Exctn%x, ValAry) ! Rank 1 Array - case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) - call MV_Pack2(Var, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState, ValAry) ! Scalar - case (HydroDyn_x_Morison_DummyContState) - call MV_Pack2(Var, x%Morison%DummyContState, ValAry) ! Scalar - end select - end associate + call HydroDyn_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine HydroDyn_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%SS_Rdtn%x) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%SS_Exctn%x) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + call MV_Unpack2(Var, ValAry, x%Morison%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine HydroDyn_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (HydroDyn_x_WAMIT_SS_Rdtn_x) - call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%SS_Rdtn%x) ! Rank 1 Array - case (HydroDyn_x_WAMIT_SS_Exctn_x) - call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%SS_Exctn%x) ! Rank 1 Array - case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) - call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState) ! Scalar - case (HydroDyn_x_Morison_DummyContState) - call MV_Unpack2(Var, ValAry, x%Morison%DummyContState) ! Scalar - end select - end associate + call HydroDyn_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine HydroDyn_PackConstrStateVar(Var, z, ValAry) + type(HydroDyn_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + call MV_Pack2(Var, z%WAMIT%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + call MV_Pack2(Var, z%WAMIT%SS_Rdtn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + call MV_Pack2(Var, z%WAMIT%SS_Exctn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + call MV_Pack2(Var, z%Morison%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine HydroDyn_PackConstrStateAry(Vars, z, ValAry) type(HydroDyn_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) - call MV_Pack2(Var, z%WAMIT%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) - call MV_Pack2(Var, z%WAMIT%SS_Rdtn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) - call MV_Pack2(Var, z%WAMIT%SS_Exctn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_Morison_DummyConstrState) - call MV_Pack2(Var, z%Morison%DummyConstrState, ValAry) ! Scalar - end select - end associate + call HydroDyn_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine HydroDyn_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%WAMIT%Conv_Rdtn%DummyConstrState) ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%WAMIT%SS_Rdtn%DummyConstrState) ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%WAMIT%SS_Exctn%DummyConstrState) ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%Morison%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine HydroDyn_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%WAMIT%Conv_Rdtn%DummyConstrState) ! Scalar - case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%WAMIT%SS_Rdtn%DummyConstrState) ! Scalar - case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%WAMIT%SS_Exctn%DummyConstrState) ! Scalar - case (HydroDyn_z_Morison_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%Morison%DummyConstrState) ! Scalar - end select - end associate + call HydroDyn_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine HydroDyn_PackInputVar(Var, u, ValAry) + type(HydroDyn_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_Pack2(Var, u%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_u_WAMITMesh) + call MV_Pack2(Var, u%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_Pack2(Var, u%PRPMesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine HydroDyn_PackInputAry(Vars, u, ValAry) type(HydroDyn_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (HydroDyn_u_Morison_Mesh) - call MV_Pack2(Var, u%Morison%Mesh, ValAry) ! Mesh - case (HydroDyn_u_WAMITMesh) - call MV_Pack2(Var, u%WAMITMesh, ValAry) ! Mesh - case (HydroDyn_u_PRPMesh) - call MV_Pack2(Var, u%PRPMesh, ValAry) ! Mesh - end select - end associate + call HydroDyn_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine HydroDyn_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_Unpack2(Var, ValAry, u%Morison%Mesh) ! Mesh + case (HydroDyn_u_WAMITMesh) + call MV_Unpack2(Var, ValAry, u%WAMITMesh) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_Unpack2(Var, ValAry, u%PRPMesh) ! Mesh + end select + end associate +end subroutine + subroutine HydroDyn_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (HydroDyn_u_Morison_Mesh) - call MV_Unpack2(Var, ValAry, u%Morison%Mesh) ! Mesh - case (HydroDyn_u_WAMITMesh) - call MV_Unpack2(Var, ValAry, u%WAMITMesh) ! Mesh - case (HydroDyn_u_PRPMesh) - call MV_Unpack2(Var, ValAry, u%PRPMesh) ! Mesh - end select - end associate + call HydroDyn_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine HydroDyn_PackOutputVar(Var, y, ValAry) + type(HydroDyn_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_Pack2(Var, y%WAMIT(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_Pack2(Var, y%WAMIT2(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_Pack2(Var, y%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_Pack2(Var, y%Morison%VisMesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + call MV_Pack2(Var, y%Morison%WriteOutput, ValAry) ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_Pack2(Var, y%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine HydroDyn_PackOutputAry(Vars, y, ValAry) type(HydroDyn_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (HydroDyn_y_WAMIT_Mesh) - call MV_Pack2(Var, y%WAMIT(DL%i1)%Mesh, ValAry) ! Mesh - case (HydroDyn_y_WAMIT2_Mesh) - call MV_Pack2(Var, y%WAMIT2(DL%i1)%Mesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_Mesh) - call MV_Pack2(Var, y%Morison%Mesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_VisMesh) - call MV_Pack2(Var, y%Morison%VisMesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_WriteOutput) - call MV_Pack2(Var, y%Morison%WriteOutput, ValAry) ! Rank 1 Array - case (HydroDyn_y_WAMITMesh) - call MV_Pack2(Var, y%WAMITMesh, ValAry) ! Mesh - case (HydroDyn_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call HydroDyn_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine HydroDyn_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_Unpack2(Var, ValAry, y%WAMIT(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_Unpack2(Var, ValAry, y%WAMIT2(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_Unpack2(Var, ValAry, y%Morison%Mesh) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_Unpack2(Var, ValAry, y%Morison%VisMesh) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + call MV_Unpack2(Var, ValAry, y%Morison%WriteOutput) ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_Unpack2(Var, ValAry, y%WAMITMesh) ! Mesh + case (HydroDyn_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine HydroDyn_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (HydroDyn_y_WAMIT_Mesh) - call MV_Unpack2(Var, ValAry, y%WAMIT(DL%i1)%Mesh) ! Mesh - case (HydroDyn_y_WAMIT2_Mesh) - call MV_Unpack2(Var, ValAry, y%WAMIT2(DL%i1)%Mesh) ! Mesh - case (HydroDyn_y_Morison_Mesh) - call MV_Unpack2(Var, ValAry, y%Morison%Mesh) ! Mesh - case (HydroDyn_y_Morison_VisMesh) - call MV_Unpack2(Var, ValAry, y%Morison%VisMesh) ! Mesh - case (HydroDyn_y_Morison_WriteOutput) - call MV_Unpack2(Var, ValAry, y%Morison%WriteOutput) ! Rank 1 Array - case (HydroDyn_y_WAMITMesh) - call MV_Unpack2(Var, ValAry, y%WAMITMesh) ! Mesh - case (HydroDyn_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call HydroDyn_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE HydroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index e8b27b6417..5c10d5dff0 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -4711,132 +4711,208 @@ function Morison_OutputMeshName(ML) result(Name) end select end function +subroutine Morison_PackContStateVar(Var, x, ValAry) + type(Morison_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Morison_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Morison_PackContStateAry(Vars, x, ValAry) type(Morison_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (Morison_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - end select - end associate + call Morison_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine Morison_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Morison_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine Morison_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Morison_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (Morison_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate + call Morison_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine Morison_PackConstrStateVar(Var, z, ValAry) + type(Morison_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Morison_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Morison_PackConstrStateAry(Vars, z, ValAry) type(Morison_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (Morison_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call Morison_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine Morison_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Morison_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine Morison_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Morison_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (Morison_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call Morison_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine Morison_PackInputVar(Var, u, ValAry) + type(Morison_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Morison_u_Mesh) + call MV_Pack2(Var, u%Mesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Morison_PackInputAry(Vars, u, ValAry) type(Morison_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (Morison_u_Mesh) - call MV_Pack2(Var, u%Mesh, ValAry) ! Mesh - end select - end associate + call Morison_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine Morison_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Morison_u_Mesh) + call MV_Unpack2(Var, ValAry, u%Mesh) ! Mesh + end select + end associate +end subroutine + subroutine Morison_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Morison_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (Morison_u_Mesh) - call MV_Unpack2(Var, ValAry, u%Mesh) ! Mesh - end select - end associate + call Morison_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine Morison_PackOutputVar(Var, y, ValAry) + type(Morison_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Morison_y_Mesh) + call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh + case (Morison_y_VisMesh) + call MV_Pack2(Var, y%VisMesh, ValAry) ! Mesh + case (Morison_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Morison_PackOutputAry(Vars, y, ValAry) type(Morison_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (Morison_y_Mesh) - call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh - case (Morison_y_VisMesh) - call MV_Pack2(Var, y%VisMesh, ValAry) ! Mesh - case (Morison_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call Morison_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine Morison_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Morison_y_Mesh) + call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh + case (Morison_y_VisMesh) + call MV_Unpack2(Var, ValAry, y%VisMesh) ! Mesh + case (Morison_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine Morison_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Morison_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (Morison_y_Mesh) - call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh - case (Morison_y_VisMesh) - call MV_Unpack2(Var, ValAry, y%VisMesh) ! Mesh - case (Morison_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call Morison_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE Morison_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 749ff381e0..80442bda3d 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -1192,128 +1192,204 @@ function SS_Exc_OutputMeshName(ML) result(Name) end select end function +subroutine SS_Exc_PackContStateVar(Var, x, ValAry) + type(SS_Exc_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Exc_x_x) + call MV_Pack2(Var, x%x, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SS_Exc_PackContStateAry(Vars, x, ValAry) type(SS_Exc_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SS_Exc_x_x) - call MV_Pack2(Var, x%x, ValAry) ! Rank 1 Array - end select - end associate + call SS_Exc_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine SS_Exc_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Exc_x_x) + call MV_Unpack2(Var, ValAry, x%x) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SS_Exc_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SS_Exc_x_x) - call MV_Unpack2(Var, ValAry, x%x) ! Rank 1 Array - end select - end associate + call SS_Exc_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine SS_Exc_PackConstrStateVar(Var, z, ValAry) + type(SS_Exc_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Exc_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SS_Exc_PackConstrStateAry(Vars, z, ValAry) type(SS_Exc_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SS_Exc_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call SS_Exc_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine SS_Exc_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Exc_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine SS_Exc_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SS_Exc_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call SS_Exc_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine SS_Exc_PackInputVar(Var, u, ValAry) + type(SS_Exc_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Exc_u_PtfmPos) + call MV_Pack2(Var, u%PtfmPos, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SS_Exc_PackInputAry(Vars, u, ValAry) type(SS_Exc_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SS_Exc_u_PtfmPos) - call MV_Pack2(Var, u%PtfmPos, ValAry) ! Rank 2 Array - end select - end associate + call SS_Exc_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine SS_Exc_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Exc_u_PtfmPos) + call MV_Unpack2(Var, ValAry, u%PtfmPos) ! Rank 2 Array + end select + end associate +end subroutine + subroutine SS_Exc_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SS_Exc_u_PtfmPos) - call MV_Unpack2(Var, ValAry, u%PtfmPos) ! Rank 2 Array - end select - end associate + call SS_Exc_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine SS_Exc_PackOutputVar(Var, y, ValAry) + type(SS_Exc_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Exc_y_y) + call MV_Pack2(Var, y%y, ValAry) ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SS_Exc_PackOutputAry(Vars, y, ValAry) type(SS_Exc_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SS_Exc_y_y) - call MV_Pack2(Var, y%y, ValAry) ! Rank 1 Array - case (SS_Exc_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call SS_Exc_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine SS_Exc_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Exc_y_y) + call MV_Unpack2(Var, ValAry, y%y) ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SS_Exc_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SS_Exc_y_y) - call MV_Unpack2(Var, ValAry, y%y) ! Rank 1 Array - case (SS_Exc_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call SS_Exc_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE SS_Excitation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 2eaa61f153..6ce22be8d6 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -1113,128 +1113,204 @@ function SS_Rad_OutputMeshName(ML) result(Name) end select end function +subroutine SS_Rad_PackContStateVar(Var, x, ValAry) + type(SS_Rad_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Rad_x_x) + call MV_Pack2(Var, x%x, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SS_Rad_PackContStateAry(Vars, x, ValAry) type(SS_Rad_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SS_Rad_x_x) - call MV_Pack2(Var, x%x, ValAry) ! Rank 1 Array - end select - end associate + call SS_Rad_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine SS_Rad_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Rad_x_x) + call MV_Unpack2(Var, ValAry, x%x) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SS_Rad_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SS_Rad_x_x) - call MV_Unpack2(Var, ValAry, x%x) ! Rank 1 Array - end select - end associate + call SS_Rad_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine SS_Rad_PackConstrStateVar(Var, z, ValAry) + type(SS_Rad_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Rad_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SS_Rad_PackConstrStateAry(Vars, z, ValAry) type(SS_Rad_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SS_Rad_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call SS_Rad_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine SS_Rad_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Rad_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine SS_Rad_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SS_Rad_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call SS_Rad_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine SS_Rad_PackInputVar(Var, u, ValAry) + type(SS_Rad_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Rad_u_dq) + call MV_Pack2(Var, u%dq, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SS_Rad_PackInputAry(Vars, u, ValAry) type(SS_Rad_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SS_Rad_u_dq) - call MV_Pack2(Var, u%dq, ValAry) ! Rank 1 Array - end select - end associate + call SS_Rad_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine SS_Rad_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Rad_u_dq) + call MV_Unpack2(Var, ValAry, u%dq) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SS_Rad_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SS_Rad_u_dq) - call MV_Unpack2(Var, ValAry, u%dq) ! Rank 1 Array - end select - end associate + call SS_Rad_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine SS_Rad_PackOutputVar(Var, y, ValAry) + type(SS_Rad_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Rad_y_y) + call MV_Pack2(Var, y%y, ValAry) ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SS_Rad_PackOutputAry(Vars, y, ValAry) type(SS_Rad_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SS_Rad_y_y) - call MV_Pack2(Var, y%y, ValAry) ! Rank 1 Array - case (SS_Rad_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call SS_Rad_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine SS_Rad_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SS_Rad_y_y) + call MV_Unpack2(Var, ValAry, y%y) ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SS_Rad_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SS_Rad_y_y) - call MV_Unpack2(Var, ValAry, y%y) ! Rank 1 Array - case (SS_Rad_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call SS_Rad_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE SS_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 2ea38b0534..acd5caee2d 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -655,34 +655,53 @@ function WAMIT2_OutputMeshName(ML) result(Name) end select end function +subroutine WAMIT2_PackOutputVar(Var, y, ValAry) + type(WAMIT2_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT2_y_Mesh) + call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine WAMIT2_PackOutputAry(Vars, y, ValAry) type(WAMIT2_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (WAMIT2_y_Mesh) - call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh - end select - end associate + call WAMIT2_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine WAMIT2_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT2_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT2_y_Mesh) + call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh + end select + end associate +end subroutine + subroutine WAMIT2_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT2_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (WAMIT2_y_Mesh) - call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh - end select - end associate + call WAMIT2_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE WAMIT2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 9a9d4aa852..a1b42574d2 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -1476,140 +1476,216 @@ function WAMIT_OutputMeshName(ML) result(Name) end select end function +subroutine WAMIT_PackContStateVar(Var, x, ValAry) + type(WAMIT_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT_x_SS_Rdtn_x) + call MV_Pack2(Var, x%SS_Rdtn%x, ValAry) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + call MV_Pack2(Var, x%SS_Exctn%x, ValAry) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + call MV_Pack2(Var, x%Conv_Rdtn%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine WAMIT_PackContStateAry(Vars, x, ValAry) type(WAMIT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (WAMIT_x_SS_Rdtn_x) - call MV_Pack2(Var, x%SS_Rdtn%x, ValAry) ! Rank 1 Array - case (WAMIT_x_SS_Exctn_x) - call MV_Pack2(Var, x%SS_Exctn%x, ValAry) ! Rank 1 Array - case (WAMIT_x_Conv_Rdtn_DummyContState) - call MV_Pack2(Var, x%Conv_Rdtn%DummyContState, ValAry) ! Scalar - end select - end associate + call WAMIT_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine WAMIT_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT_x_SS_Rdtn_x) + call MV_Unpack2(Var, ValAry, x%SS_Rdtn%x) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + call MV_Unpack2(Var, ValAry, x%SS_Exctn%x) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + call MV_Unpack2(Var, ValAry, x%Conv_Rdtn%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine WAMIT_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (WAMIT_x_SS_Rdtn_x) - call MV_Unpack2(Var, ValAry, x%SS_Rdtn%x) ! Rank 1 Array - case (WAMIT_x_SS_Exctn_x) - call MV_Unpack2(Var, ValAry, x%SS_Exctn%x) ! Rank 1 Array - case (WAMIT_x_Conv_Rdtn_DummyContState) - call MV_Unpack2(Var, ValAry, x%Conv_Rdtn%DummyContState) ! Scalar - end select - end associate + call WAMIT_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine WAMIT_PackConstrStateVar(Var, z, ValAry) + type(WAMIT_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + call MV_Pack2(Var, z%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + call MV_Pack2(Var, z%SS_Rdtn%DummyConstrState, ValAry) ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + call MV_Pack2(Var, z%SS_Exctn%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine WAMIT_PackConstrStateAry(Vars, z, ValAry) type(WAMIT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (WAMIT_z_Conv_Rdtn_DummyConstrState) - call MV_Pack2(Var, z%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar - case (WAMIT_z_SS_Rdtn_DummyConstrState) - call MV_Pack2(Var, z%SS_Rdtn%DummyConstrState, ValAry) ! Scalar - case (WAMIT_z_SS_Exctn_DummyConstrState) - call MV_Pack2(Var, z%SS_Exctn%DummyConstrState, ValAry) ! Scalar - end select - end associate + call WAMIT_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine WAMIT_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%Conv_Rdtn%DummyConstrState) ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%SS_Rdtn%DummyConstrState) ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%SS_Exctn%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine WAMIT_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (WAMIT_z_Conv_Rdtn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%Conv_Rdtn%DummyConstrState) ! Scalar - case (WAMIT_z_SS_Rdtn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%SS_Rdtn%DummyConstrState) ! Scalar - case (WAMIT_z_SS_Exctn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%SS_Exctn%DummyConstrState) ! Scalar - end select - end associate + call WAMIT_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine WAMIT_PackInputVar(Var, u, ValAry) + type(WAMIT_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT_u_Mesh) + call MV_Pack2(Var, u%Mesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine WAMIT_PackInputAry(Vars, u, ValAry) type(WAMIT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (WAMIT_u_Mesh) - call MV_Pack2(Var, u%Mesh, ValAry) ! Mesh - end select - end associate + call WAMIT_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine WAMIT_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT_u_Mesh) + call MV_Unpack2(Var, ValAry, u%Mesh) ! Mesh + end select + end associate +end subroutine + subroutine WAMIT_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (WAMIT_u_Mesh) - call MV_Unpack2(Var, ValAry, u%Mesh) ! Mesh - end select - end associate + call WAMIT_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine WAMIT_PackOutputVar(Var, y, ValAry) + type(WAMIT_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT_y_Mesh) + call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine WAMIT_PackOutputAry(Vars, y, ValAry) type(WAMIT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (WAMIT_y_Mesh) - call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh - end select - end associate + call WAMIT_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine WAMIT_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WAMIT_y_Mesh) + call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh + end select + end associate +end subroutine + subroutine WAMIT_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (WAMIT_y_Mesh) - call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh - end select - end associate + call WAMIT_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE WAMIT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 64210e2abe..981a0d8f82 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -1789,132 +1789,208 @@ function IceD_OutputMeshName(ML) result(Name) end select end function +subroutine IceD_PackContStateVar(Var, x, ValAry) + type(IceD_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceD_x_q) + call MV_Pack2(Var, x%q, ValAry) ! Scalar + case (IceD_x_dqdt) + call MV_Pack2(Var, x%dqdt, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine IceD_PackContStateAry(Vars, x, ValAry) type(IceD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (IceD_x_q) - call MV_Pack2(Var, x%q, ValAry) ! Scalar - case (IceD_x_dqdt) - call MV_Pack2(Var, x%dqdt, ValAry) ! Scalar - end select - end associate + call IceD_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine IceD_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceD_x_q) + call MV_Unpack2(Var, ValAry, x%q) ! Scalar + case (IceD_x_dqdt) + call MV_Unpack2(Var, ValAry, x%dqdt) ! Scalar + end select + end associate +end subroutine + subroutine IceD_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (IceD_x_q) - call MV_Unpack2(Var, ValAry, x%q) ! Scalar - case (IceD_x_dqdt) - call MV_Unpack2(Var, ValAry, x%dqdt) ! Scalar - end select - end associate + call IceD_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine IceD_PackConstrStateVar(Var, z, ValAry) + type(IceD_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine IceD_PackConstrStateAry(Vars, z, ValAry) type(IceD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (IceD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call IceD_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine IceD_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine IceD_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (IceD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call IceD_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine IceD_PackInputVar(Var, u, ValAry) + type(IceD_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceD_u_PointMesh) + call MV_Pack2(Var, u%PointMesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine IceD_PackInputAry(Vars, u, ValAry) type(IceD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (IceD_u_PointMesh) - call MV_Pack2(Var, u%PointMesh, ValAry) ! Mesh - end select - end associate + call IceD_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine IceD_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceD_u_PointMesh) + call MV_Unpack2(Var, ValAry, u%PointMesh) ! Mesh + end select + end associate +end subroutine + subroutine IceD_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (IceD_u_PointMesh) - call MV_Unpack2(Var, ValAry, u%PointMesh) ! Mesh - end select - end associate + call IceD_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine IceD_PackOutputVar(Var, y, ValAry) + type(IceD_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceD_y_PointMesh) + call MV_Pack2(Var, y%PointMesh, ValAry) ! Mesh + case (IceD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine IceD_PackOutputAry(Vars, y, ValAry) type(IceD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (IceD_y_PointMesh) - call MV_Pack2(Var, y%PointMesh, ValAry) ! Mesh - case (IceD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call IceD_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine IceD_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceD_y_PointMesh) + call MV_Unpack2(Var, ValAry, y%PointMesh) ! Mesh + case (IceD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine IceD_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (IceD_y_PointMesh) - call MV_Unpack2(Var, ValAry, y%PointMesh) ! Mesh - case (IceD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call IceD_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE IceDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index d864bfb15e..0df3890fe2 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -1070,128 +1070,204 @@ function IceFloe_OutputMeshName(ML) result(Name) end select end function +subroutine IceFloe_PackContStateVar(Var, x, ValAry) + type(IceFloe_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceFloe_x_DummyContStateVar) + call MV_Pack2(Var, x%DummyContStateVar, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine IceFloe_PackContStateAry(Vars, x, ValAry) type(IceFloe_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (IceFloe_x_DummyContStateVar) - call MV_Pack2(Var, x%DummyContStateVar, ValAry) ! Scalar - end select - end associate + call IceFloe_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine IceFloe_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceFloe_x_DummyContStateVar) + call MV_Unpack2(Var, ValAry, x%DummyContStateVar) ! Scalar + end select + end associate +end subroutine + subroutine IceFloe_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (IceFloe_x_DummyContStateVar) - call MV_Unpack2(Var, ValAry, x%DummyContStateVar) ! Scalar - end select - end associate + call IceFloe_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine IceFloe_PackConstrStateVar(Var, z, ValAry) + type(IceFloe_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceFloe_z_DummyConstrStateVar) + call MV_Pack2(Var, z%DummyConstrStateVar, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine IceFloe_PackConstrStateAry(Vars, z, ValAry) type(IceFloe_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (IceFloe_z_DummyConstrStateVar) - call MV_Pack2(Var, z%DummyConstrStateVar, ValAry) ! Scalar - end select - end associate + call IceFloe_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine IceFloe_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceFloe_z_DummyConstrStateVar) + call MV_Unpack2(Var, ValAry, z%DummyConstrStateVar) ! Scalar + end select + end associate +end subroutine + subroutine IceFloe_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (IceFloe_z_DummyConstrStateVar) - call MV_Unpack2(Var, ValAry, z%DummyConstrStateVar) ! Scalar - end select - end associate + call IceFloe_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine IceFloe_PackInputVar(Var, u, ValAry) + type(IceFloe_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceFloe_u_iceMesh) + call MV_Pack2(Var, u%iceMesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine IceFloe_PackInputAry(Vars, u, ValAry) type(IceFloe_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (IceFloe_u_iceMesh) - call MV_Pack2(Var, u%iceMesh, ValAry) ! Mesh - end select - end associate + call IceFloe_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine IceFloe_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceFloe_u_iceMesh) + call MV_Unpack2(Var, ValAry, u%iceMesh) ! Mesh + end select + end associate +end subroutine + subroutine IceFloe_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (IceFloe_u_iceMesh) - call MV_Unpack2(Var, ValAry, u%iceMesh) ! Mesh - end select - end associate + call IceFloe_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine IceFloe_PackOutputVar(Var, y, ValAry) + type(IceFloe_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceFloe_y_iceMesh) + call MV_Pack2(Var, y%iceMesh, ValAry) ! Mesh + case (IceFloe_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine IceFloe_PackOutputAry(Vars, y, ValAry) type(IceFloe_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (IceFloe_y_iceMesh) - call MV_Pack2(Var, y%iceMesh, ValAry) ! Mesh - case (IceFloe_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call IceFloe_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine IceFloe_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (IceFloe_y_iceMesh) + call MV_Unpack2(Var, ValAry, y%iceMesh) ! Mesh + case (IceFloe_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine IceFloe_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (IceFloe_y_iceMesh) - call MV_Unpack2(Var, ValAry, y%iceMesh) ! Mesh - case (IceFloe_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call IceFloe_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE IceFloe_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index 627f722fdc..adfd55cea8 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -58,6 +58,8 @@ MODULE InflowWind PUBLIC :: InflowWind_JacobianPDiscState PUBLIC :: InflowWind_JacobianPConstrState PUBLIC :: InflowWind_GetOP + PUBLIC :: InflowWind_PackExtInputAry + PUBLIC :: InflowWind_PackExtOutputAry CONTAINS !==================================================================================================== @@ -577,15 +579,15 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, DatLoc(InflowWind_u_HWindSpeed), & Flags=ior(VF_ExtLin, VF_Linearize), & - LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) + LinNames=['Extended input: horizontal wind speed (steady/uniform wind) (hub), m/s']) call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, DatLoc(InflowWind_u_PLExp), & Flags=ior(VF_ExtLin, VF_Linearize), & - LinNames=['Extended input: vertical power-law shear exponent, -']) + LinNames=['Extended input: vertical power-law shear exponent (hub), -']) call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, DatLoc(InflowWind_u_PropagationDir), & Flags=ior(VF_ExtLin, VF_Linearize), & - LinNames=['Extended input: propagation direction, rad']) + LinNames=['Extended input: propagation direction (hub), rad']) !---------------------------------------------------------------------------- ! Output variables @@ -593,15 +595,15 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) call MV_AddVar(p%Vars%y, "HWindSpeed", FieldScalar, DatLoc(InflowWind_y_HWindSpeed), & Flags=VF_ExtLin, & - LinNames=['Extended output: horizontal wind speed (steady/uniform wind), m/s']) + LinNames=['Extended output: horizontal wind speed (steady/uniform wind) (hub), m/s']) call MV_AddVar(p%Vars%y, "PLExp", FieldScalar, DatLoc(InflowWind_y_PLExp), & Flags=VF_ExtLin, & - LinNames=['Extended output: vertical power-law shear exponent, -']) + LinNames=['Extended output: vertical power-law shear exponent (hub), -']) call MV_AddVar(p%Vars%y, "PropagationDir", FieldScalar, DatLoc(InflowWind_y_PropagationDir), & Flags=VF_ExtLin, & - LinNames=['Extended output: propagation direction, rad']) + LinNames=['Extended output: propagation direction (hub), rad']) call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(InflowWind_y_WriteOutput), & Flags=VF_WriteOut, & @@ -774,7 +776,8 @@ END SUBROUTINE InflowWind_End !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE InflowWind_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module information REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1131,4 +1134,87 @@ SUBROUTINE InflowWind_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs ! END IF END SUBROUTINE InflowWind_GetOP +subroutine InflowWind_PackExtInputAry(Vars, t, p, ValAry) + type(ModVarsType), intent(in) :: Vars + real(DbKi), intent(in) :: t !< Time in seconds at operating point + type(InflowWind_ParameterType), intent(in) :: p !< Parameters + real(R8Ki), intent(inout) :: ValAry(:) + type(UniformField_Interp) :: op !< Interpolated values of UniformField + integer(IntKi) :: i + logical :: first + do i = 1, size(Vars%u) + associate(Var => Vars%u(i)) + select case(Var%DL%Num) + case (InflowWind_u_HWindSpeed) + call CalcExtOP() + call MV_Pack2(Var, op%VelH, ValAry) + case (InflowWind_u_PLExp) + call CalcExtOP() + call MV_Pack2(Var, op%ShrV, ValAry) + case (InflowWind_u_PropagationDir) + call CalcExtOP() + call MV_Pack2(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + end select + end associate + end do +contains + subroutine CalcExtOP() + if (.not. first) return + first = .false. + if (p%FlowField%FieldType == Uniform_FieldType) then + if (P%FlowField%VelInterpCubic) then + op = UniformField_InterpCubic(p%FlowField%Uniform, t) + else + op = UniformField_InterpLinear(p%FlowField%Uniform, t) + end if + else + op%VelH = 0.0_ReKi + op%ShrV = 0.0_ReKi + op%AngleH = 0.0_ReKi + end if + end subroutine +end subroutine + +subroutine InflowWind_PackExtOutputAry(Vars, t, p, ValAry) + type(ModVarsType), intent(in) :: Vars !< Time + real(DbKi), intent(in) :: t !< Time in seconds at operating point + type(InflowWind_ParameterType), intent(in) :: p !< Parameters + real(R8Ki), intent(inout) :: ValAry(:) + type(UniformField_Interp) :: op !< Interpolated values of UniformField + integer(IntKi) :: i + logical :: first + first = .true. + do i = 1, size(Vars%y) + associate(Var => Vars%y(i)) + select case(Var%DL%Num) + case (InflowWind_y_HWindSpeed) + call CalcExtOP() + call MV_Pack2(Var, op%VelH, ValAry) + case (InflowWind_y_PLExp) + call CalcExtOP() + call MV_Pack2(Var, op%ShrV, ValAry) + case (InflowWind_y_PropagationDir) + call CalcExtOP() + call MV_Pack2(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + end select + end associate + end do +contains + subroutine CalcExtOP() + if (.not. first) return + first = .false. + if (p%FlowField%FieldType == Uniform_FieldType) then + if (P%FlowField%VelInterpCubic) then + op = UniformField_InterpCubic(p%FlowField%Uniform, t) + else + op = UniformField_InterpLinear(p%FlowField%Uniform, t) + end if + else + op%VelH = 0.0_ReKi + op%ShrV = 0.0_ReKi + op%AngleH = 0.0_ReKi + end if + end subroutine +end subroutine + END MODULE InflowWind diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index 81416b8fae..b505f1851d 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -31,9 +31,9 @@ param ^ - IntKi IfW_NumPtsA param ^ - IntKi InflowWind_u_HWindSpeed - -1 - "DatLoc number for HWindSpeed extended input" - param ^ - IntKi InflowWind_u_PLExp - -2 - "DatLoc number for PLExp extended input" - param ^ - IntKi InflowWind_u_PropagationDir - -3 - "DatLoc number for PropagationDir extended input" - -param ^ - IntKi InflowWind_y_HWindSpeed - -1 - "DatLoc number for HWindSpeed extended output" - -param ^ - IntKi InflowWind_y_PLExp - -2 - "DatLoc number for PLExp extended output" - -param ^ - IntKi InflowWind_y_PropagationDir - -3 - "DatLoc number for PropagationDir extended output" - +param ^ - IntKi InflowWind_y_HWindSpeed - -4 - "DatLoc number for HWindSpeed extended output" - +param ^ - IntKi InflowWind_y_PLExp - -5 - "DatLoc number for PLExp extended output" - +param ^ - IntKi InflowWind_y_PropagationDir - -6 - "DatLoc number for PropagationDir extended output" - ######################### # ..... Input file data ........................................................................................................... diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 498807800f..bedad1921d 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -51,9 +51,9 @@ MODULE InflowWind_Types INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_HWindSpeed = -1 ! DatLoc number for HWindSpeed extended input [-] INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_PLExp = -2 ! DatLoc number for PLExp extended input [-] INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_PropagationDir = -3 ! DatLoc number for PropagationDir extended input [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_HWindSpeed = -1 ! DatLoc number for HWindSpeed extended output [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_PLExp = -2 ! DatLoc number for PLExp extended output [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_PropagationDir = -3 ! DatLoc number for PropagationDir extended output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_HWindSpeed = -4 ! DatLoc number for HWindSpeed extended output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_PLExp = -5 ! DatLoc number for PLExp extended output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_PropagationDir = -6 ! DatLoc number for PropagationDir extended output [-] ! ========= InflowWind_InputFile ======= TYPE, PUBLIC :: InflowWind_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -1998,188 +1998,264 @@ function InflowWind_OutputMeshName(ML) result(Name) end select end function +subroutine InflowWind_PackContStateVar(Var, x, ValAry) + type(InflowWind_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (InflowWind_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine InflowWind_PackContStateAry(Vars, x, ValAry) type(InflowWind_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (InflowWind_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - end select - end associate + call InflowWind_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine InflowWind_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (InflowWind_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine InflowWind_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (InflowWind_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate + call InflowWind_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine InflowWind_PackConstrStateVar(Var, z, ValAry) + type(InflowWind_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (InflowWind_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine InflowWind_PackConstrStateAry(Vars, z, ValAry) type(InflowWind_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (InflowWind_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call InflowWind_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine InflowWind_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (InflowWind_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine InflowWind_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (InflowWind_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call InflowWind_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine InflowWind_PackInputVar(Var, u, ValAry) + type(InflowWind_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (InflowWind_u_PositionXYZ) + call MV_Pack2(Var, u%PositionXYZ, ValAry) ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + call MV_Pack2(Var, u%lidar%PulseLidEl, ValAry) ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + call MV_Pack2(Var, u%lidar%PulseLidAz, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + call MV_Pack2(Var, u%lidar%HubDisplacementX, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + call MV_Pack2(Var, u%lidar%HubDisplacementY, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + call MV_Pack2(Var, u%lidar%HubDisplacementZ, ValAry) ! Scalar + case (InflowWind_u_HubPosition) + call MV_Pack2(Var, u%HubPosition, ValAry) ! Rank 1 Array + case (InflowWind_u_HubOrientation) + call MV_Pack2(Var, u%HubOrientation, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine InflowWind_PackInputAry(Vars, u, ValAry) type(InflowWind_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (InflowWind_u_PositionXYZ) - call MV_Pack2(Var, u%PositionXYZ, ValAry) ! Rank 2 Array - case (InflowWind_u_lidar_PulseLidEl) - call MV_Pack2(Var, u%lidar%PulseLidEl, ValAry) ! Scalar - case (InflowWind_u_lidar_PulseLidAz) - call MV_Pack2(Var, u%lidar%PulseLidAz, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementX) - call MV_Pack2(Var, u%lidar%HubDisplacementX, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementY) - call MV_Pack2(Var, u%lidar%HubDisplacementY, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementZ) - call MV_Pack2(Var, u%lidar%HubDisplacementZ, ValAry) ! Scalar - case (InflowWind_u_HubPosition) - call MV_Pack2(Var, u%HubPosition, ValAry) ! Rank 1 Array - case (InflowWind_u_HubOrientation) - call MV_Pack2(Var, u%HubOrientation, ValAry) ! Rank 2 Array - end select - end associate + call InflowWind_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine InflowWind_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (InflowWind_u_PositionXYZ) + call MV_Unpack2(Var, ValAry, u%PositionXYZ) ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + call MV_Unpack2(Var, ValAry, u%lidar%PulseLidEl) ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + call MV_Unpack2(Var, ValAry, u%lidar%PulseLidAz) ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementX) ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementY) ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementZ) ! Scalar + case (InflowWind_u_HubPosition) + call MV_Unpack2(Var, ValAry, u%HubPosition) ! Rank 1 Array + case (InflowWind_u_HubOrientation) + call MV_Unpack2(Var, ValAry, u%HubOrientation) ! Rank 2 Array + end select + end associate +end subroutine + subroutine InflowWind_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (InflowWind_u_PositionXYZ) - call MV_Unpack2(Var, ValAry, u%PositionXYZ) ! Rank 2 Array - case (InflowWind_u_lidar_PulseLidEl) - call MV_Unpack2(Var, ValAry, u%lidar%PulseLidEl) ! Scalar - case (InflowWind_u_lidar_PulseLidAz) - call MV_Unpack2(Var, ValAry, u%lidar%PulseLidAz) ! Scalar - case (InflowWind_u_lidar_HubDisplacementX) - call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementX) ! Scalar - case (InflowWind_u_lidar_HubDisplacementY) - call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementY) ! Scalar - case (InflowWind_u_lidar_HubDisplacementZ) - call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementZ) ! Scalar - case (InflowWind_u_HubPosition) - call MV_Unpack2(Var, ValAry, u%HubPosition) ! Rank 1 Array - case (InflowWind_u_HubOrientation) - call MV_Unpack2(Var, ValAry, u%HubOrientation) ! Rank 2 Array - end select - end associate + call InflowWind_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine InflowWind_PackOutputVar(Var, y, ValAry) + type(InflowWind_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (InflowWind_y_VelocityUVW) + call MV_Pack2(Var, y%VelocityUVW, ValAry) ! Rank 2 Array + case (InflowWind_y_AccelUVW) + call MV_Pack2(Var, y%AccelUVW, ValAry) ! Rank 2 Array + case (InflowWind_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (InflowWind_y_DiskVel) + call MV_Pack2(Var, y%DiskVel, ValAry) ! Rank 1 Array + case (InflowWind_y_HubVel) + call MV_Pack2(Var, y%HubVel, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + call MV_Pack2(Var, y%lidar%LidSpeed, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + call MV_Pack2(Var, y%lidar%WtTrunc, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + call MV_Pack2(Var, y%lidar%MsrPositionsX, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + call MV_Pack2(Var, y%lidar%MsrPositionsY, ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + call MV_Pack2(Var, y%lidar%MsrPositionsZ, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine InflowWind_PackOutputAry(Vars, y, ValAry) type(InflowWind_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (InflowWind_y_VelocityUVW) - call MV_Pack2(Var, y%VelocityUVW, ValAry) ! Rank 2 Array - case (InflowWind_y_AccelUVW) - call MV_Pack2(Var, y%AccelUVW, ValAry) ! Rank 2 Array - case (InflowWind_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (InflowWind_y_DiskVel) - call MV_Pack2(Var, y%DiskVel, ValAry) ! Rank 1 Array - case (InflowWind_y_HubVel) - call MV_Pack2(Var, y%HubVel, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_LidSpeed) - call MV_Pack2(Var, y%lidar%LidSpeed, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_WtTrunc) - call MV_Pack2(Var, y%lidar%WtTrunc, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsX) - call MV_Pack2(Var, y%lidar%MsrPositionsX, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsY) - call MV_Pack2(Var, y%lidar%MsrPositionsY, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsZ) - call MV_Pack2(Var, y%lidar%MsrPositionsZ, ValAry) ! Rank 1 Array - end select - end associate + call InflowWind_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine InflowWind_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (InflowWind_y_VelocityUVW) + call MV_Unpack2(Var, ValAry, y%VelocityUVW) ! Rank 2 Array + case (InflowWind_y_AccelUVW) + call MV_Unpack2(Var, ValAry, y%AccelUVW) ! Rank 2 Array + case (InflowWind_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (InflowWind_y_DiskVel) + call MV_Unpack2(Var, ValAry, y%DiskVel) ! Rank 1 Array + case (InflowWind_y_HubVel) + call MV_Unpack2(Var, ValAry, y%HubVel) ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + call MV_Unpack2(Var, ValAry, y%lidar%LidSpeed) ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + call MV_Unpack2(Var, ValAry, y%lidar%WtTrunc) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsX) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsY) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsZ) ! Rank 1 Array + end select + end associate +end subroutine + subroutine InflowWind_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (InflowWind_y_VelocityUVW) - call MV_Unpack2(Var, ValAry, y%VelocityUVW) ! Rank 2 Array - case (InflowWind_y_AccelUVW) - call MV_Unpack2(Var, ValAry, y%AccelUVW) ! Rank 2 Array - case (InflowWind_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (InflowWind_y_DiskVel) - call MV_Unpack2(Var, ValAry, y%DiskVel) ! Rank 1 Array - case (InflowWind_y_HubVel) - call MV_Unpack2(Var, ValAry, y%HubVel) ! Rank 1 Array - case (InflowWind_y_lidar_LidSpeed) - call MV_Unpack2(Var, ValAry, y%lidar%LidSpeed) ! Rank 1 Array - case (InflowWind_y_lidar_WtTrunc) - call MV_Unpack2(Var, ValAry, y%lidar%WtTrunc) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsX) - call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsX) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsY) - call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsY) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsZ) - call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsZ) ! Rank 1 Array - end select - end associate + call InflowWind_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE InflowWind_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 92ff3b0daa..799edb8eaf 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -1144,156 +1144,232 @@ function Lidar_OutputMeshName(ML) result(Name) end select end function +subroutine Lidar_PackContStateVar(Var, x, ValAry) + type(Lidar_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Lidar_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Lidar_PackContStateAry(Vars, x, ValAry) type(Lidar_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (Lidar_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - end select - end associate + call Lidar_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine Lidar_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Lidar_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate +end subroutine + subroutine Lidar_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Lidar_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (Lidar_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate + call Lidar_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine Lidar_PackConstrStateVar(Var, z, ValAry) + type(Lidar_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Lidar_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Lidar_PackConstrStateAry(Vars, z, ValAry) type(Lidar_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (Lidar_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call Lidar_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine Lidar_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Lidar_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine Lidar_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Lidar_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (Lidar_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call Lidar_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine Lidar_PackInputVar(Var, u, ValAry) + type(Lidar_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Lidar_u_PulseLidEl) + call MV_Pack2(Var, u%PulseLidEl, ValAry) ! Scalar + case (Lidar_u_PulseLidAz) + call MV_Pack2(Var, u%PulseLidAz, ValAry) ! Scalar + case (Lidar_u_HubDisplacementX) + call MV_Pack2(Var, u%HubDisplacementX, ValAry) ! Scalar + case (Lidar_u_HubDisplacementY) + call MV_Pack2(Var, u%HubDisplacementY, ValAry) ! Scalar + case (Lidar_u_HubDisplacementZ) + call MV_Pack2(Var, u%HubDisplacementZ, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Lidar_PackInputAry(Vars, u, ValAry) type(Lidar_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (Lidar_u_PulseLidEl) - call MV_Pack2(Var, u%PulseLidEl, ValAry) ! Scalar - case (Lidar_u_PulseLidAz) - call MV_Pack2(Var, u%PulseLidAz, ValAry) ! Scalar - case (Lidar_u_HubDisplacementX) - call MV_Pack2(Var, u%HubDisplacementX, ValAry) ! Scalar - case (Lidar_u_HubDisplacementY) - call MV_Pack2(Var, u%HubDisplacementY, ValAry) ! Scalar - case (Lidar_u_HubDisplacementZ) - call MV_Pack2(Var, u%HubDisplacementZ, ValAry) ! Scalar - end select - end associate + call Lidar_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine Lidar_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Lidar_u_PulseLidEl) + call MV_Unpack2(Var, ValAry, u%PulseLidEl) ! Scalar + case (Lidar_u_PulseLidAz) + call MV_Unpack2(Var, ValAry, u%PulseLidAz) ! Scalar + case (Lidar_u_HubDisplacementX) + call MV_Unpack2(Var, ValAry, u%HubDisplacementX) ! Scalar + case (Lidar_u_HubDisplacementY) + call MV_Unpack2(Var, ValAry, u%HubDisplacementY) ! Scalar + case (Lidar_u_HubDisplacementZ) + call MV_Unpack2(Var, ValAry, u%HubDisplacementZ) ! Scalar + end select + end associate +end subroutine + subroutine Lidar_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Lidar_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (Lidar_u_PulseLidEl) - call MV_Unpack2(Var, ValAry, u%PulseLidEl) ! Scalar - case (Lidar_u_PulseLidAz) - call MV_Unpack2(Var, ValAry, u%PulseLidAz) ! Scalar - case (Lidar_u_HubDisplacementX) - call MV_Unpack2(Var, ValAry, u%HubDisplacementX) ! Scalar - case (Lidar_u_HubDisplacementY) - call MV_Unpack2(Var, ValAry, u%HubDisplacementY) ! Scalar - case (Lidar_u_HubDisplacementZ) - call MV_Unpack2(Var, ValAry, u%HubDisplacementZ) ! Scalar - end select - end associate + call Lidar_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine Lidar_PackOutputVar(Var, y, ValAry) + type(Lidar_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Lidar_y_LidSpeed) + call MV_Pack2(Var, y%LidSpeed, ValAry) ! Rank 1 Array + case (Lidar_y_WtTrunc) + call MV_Pack2(Var, y%WtTrunc, ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + call MV_Pack2(Var, y%MsrPositionsX, ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + call MV_Pack2(Var, y%MsrPositionsY, ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + call MV_Pack2(Var, y%MsrPositionsZ, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Lidar_PackOutputAry(Vars, y, ValAry) type(Lidar_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (Lidar_y_LidSpeed) - call MV_Pack2(Var, y%LidSpeed, ValAry) ! Rank 1 Array - case (Lidar_y_WtTrunc) - call MV_Pack2(Var, y%WtTrunc, ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsX) - call MV_Pack2(Var, y%MsrPositionsX, ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsY) - call MV_Pack2(Var, y%MsrPositionsY, ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsZ) - call MV_Pack2(Var, y%MsrPositionsZ, ValAry) ! Rank 1 Array - end select - end associate + call Lidar_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine Lidar_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Lidar_y_LidSpeed) + call MV_Unpack2(Var, ValAry, y%LidSpeed) ! Rank 1 Array + case (Lidar_y_WtTrunc) + call MV_Unpack2(Var, ValAry, y%WtTrunc) ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + call MV_Unpack2(Var, ValAry, y%MsrPositionsX) ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + call MV_Unpack2(Var, ValAry, y%MsrPositionsY) ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + call MV_Unpack2(Var, ValAry, y%MsrPositionsZ) ! Rank 1 Array + end select + end associate +end subroutine + subroutine Lidar_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Lidar_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (Lidar_y_LidSpeed) - call MV_Unpack2(Var, ValAry, y%LidSpeed) ! Rank 1 Array - case (Lidar_y_WtTrunc) - call MV_Unpack2(Var, ValAry, y%WtTrunc) ! Rank 1 Array - case (Lidar_y_MsrPositionsX) - call MV_Unpack2(Var, ValAry, y%MsrPositionsX) ! Rank 1 Array - case (Lidar_y_MsrPositionsY) - call MV_Unpack2(Var, ValAry, y%MsrPositionsY) ! Rank 1 Array - case (Lidar_y_MsrPositionsZ) - call MV_Unpack2(Var, ValAry, y%MsrPositionsZ) ! Rank 1 Array - end select - end associate + call Lidar_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE Lidar_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 94930f8fc4..9da3a9462c 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -3132,172 +3132,248 @@ function MAP_OutputMeshName(ML) result(Name) end select end function +subroutine MAP_PackContStateVar(Var, x, ValAry) + type(MAP_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MAP_x_dummy) + call MV_Pack2(Var, x%dummy, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine MAP_PackContStateAry(Vars, x, ValAry) type(MAP_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (MAP_x_dummy) - call MV_Pack2(Var, x%dummy, ValAry) ! Scalar - end select - end associate + call MAP_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine MAP_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MAP_x_dummy) + call MV_Unpack2(Var, ValAry, x%dummy) ! Scalar + end select + end associate +end subroutine + subroutine MAP_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MAP_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (MAP_x_dummy) - call MV_Unpack2(Var, ValAry, x%dummy) ! Scalar - end select - end associate + call MAP_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine MAP_PackConstrStateVar(Var, z, ValAry) + type(MAP_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MAP_z_H) + call MV_Pack2(Var, z%H, ValAry) ! Rank 1 Array + case (MAP_z_V) + call MV_Pack2(Var, z%V, ValAry) ! Rank 1 Array + case (MAP_z_x) + call MV_Pack2(Var, z%x, ValAry) ! Rank 1 Array + case (MAP_z_y) + call MV_Pack2(Var, z%y, ValAry) ! Rank 1 Array + case (MAP_z_z) + call MV_Pack2(Var, z%z, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine MAP_PackConstrStateAry(Vars, z, ValAry) type(MAP_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (MAP_z_H) - call MV_Pack2(Var, z%H, ValAry) ! Rank 1 Array - case (MAP_z_V) - call MV_Pack2(Var, z%V, ValAry) ! Rank 1 Array - case (MAP_z_x) - call MV_Pack2(Var, z%x, ValAry) ! Rank 1 Array - case (MAP_z_y) - call MV_Pack2(Var, z%y, ValAry) ! Rank 1 Array - case (MAP_z_z) - call MV_Pack2(Var, z%z, ValAry) ! Rank 1 Array - end select - end associate + call MAP_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine MAP_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MAP_z_H) + call MV_Unpack2(Var, ValAry, z%H) ! Rank 1 Array + case (MAP_z_V) + call MV_Unpack2(Var, ValAry, z%V) ! Rank 1 Array + case (MAP_z_x) + call MV_Unpack2(Var, ValAry, z%x) ! Rank 1 Array + case (MAP_z_y) + call MV_Unpack2(Var, ValAry, z%y) ! Rank 1 Array + case (MAP_z_z) + call MV_Unpack2(Var, ValAry, z%z) ! Rank 1 Array + end select + end associate +end subroutine + subroutine MAP_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MAP_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (MAP_z_H) - call MV_Unpack2(Var, ValAry, z%H) ! Rank 1 Array - case (MAP_z_V) - call MV_Unpack2(Var, ValAry, z%V) ! Rank 1 Array - case (MAP_z_x) - call MV_Unpack2(Var, ValAry, z%x) ! Rank 1 Array - case (MAP_z_y) - call MV_Unpack2(Var, ValAry, z%y) ! Rank 1 Array - case (MAP_z_z) - call MV_Unpack2(Var, ValAry, z%z) ! Rank 1 Array - end select - end associate + call MAP_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine MAP_PackInputVar(Var, u, ValAry) + type(MAP_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MAP_u_x) + call MV_Pack2(Var, u%x, ValAry) ! Rank 1 Array + case (MAP_u_y) + call MV_Pack2(Var, u%y, ValAry) ! Rank 1 Array + case (MAP_u_z) + call MV_Pack2(Var, u%z, ValAry) ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_Pack2(Var, u%PtFairDisplacement, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine MAP_PackInputAry(Vars, u, ValAry) type(MAP_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (MAP_u_x) - call MV_Pack2(Var, u%x, ValAry) ! Rank 1 Array - case (MAP_u_y) - call MV_Pack2(Var, u%y, ValAry) ! Rank 1 Array - case (MAP_u_z) - call MV_Pack2(Var, u%z, ValAry) ! Rank 1 Array - case (MAP_u_PtFairDisplacement) - call MV_Pack2(Var, u%PtFairDisplacement, ValAry) ! Mesh - end select - end associate + call MAP_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine MAP_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MAP_u_x) + call MV_Unpack2(Var, ValAry, u%x) ! Rank 1 Array + case (MAP_u_y) + call MV_Unpack2(Var, ValAry, u%y) ! Rank 1 Array + case (MAP_u_z) + call MV_Unpack2(Var, ValAry, u%z) ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_Unpack2(Var, ValAry, u%PtFairDisplacement) ! Mesh + end select + end associate +end subroutine + subroutine MAP_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MAP_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (MAP_u_x) - call MV_Unpack2(Var, ValAry, u%x) ! Rank 1 Array - case (MAP_u_y) - call MV_Unpack2(Var, ValAry, u%y) ! Rank 1 Array - case (MAP_u_z) - call MV_Unpack2(Var, ValAry, u%z) ! Rank 1 Array - case (MAP_u_PtFairDisplacement) - call MV_Unpack2(Var, ValAry, u%PtFairDisplacement) ! Mesh - end select - end associate + call MAP_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine MAP_PackOutputVar(Var, y, ValAry) + type(MAP_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MAP_y_Fx) + call MV_Pack2(Var, y%Fx, ValAry) ! Rank 1 Array + case (MAP_y_Fy) + call MV_Pack2(Var, y%Fy, ValAry) ! Rank 1 Array + case (MAP_y_Fz) + call MV_Pack2(Var, y%Fz, ValAry) ! Rank 1 Array + case (MAP_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (MAP_y_wrtOutput) + call MV_Pack2(Var, y%wrtOutput, ValAry) ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_Pack2(Var, y%ptFairleadLoad, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine MAP_PackOutputAry(Vars, y, ValAry) type(MAP_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (MAP_y_Fx) - call MV_Pack2(Var, y%Fx, ValAry) ! Rank 1 Array - case (MAP_y_Fy) - call MV_Pack2(Var, y%Fy, ValAry) ! Rank 1 Array - case (MAP_y_Fz) - call MV_Pack2(Var, y%Fz, ValAry) ! Rank 1 Array - case (MAP_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (MAP_y_wrtOutput) - call MV_Pack2(Var, y%wrtOutput, ValAry) ! Rank 1 Array - case (MAP_y_ptFairleadLoad) - call MV_Pack2(Var, y%ptFairleadLoad, ValAry) ! Mesh - end select - end associate + call MAP_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine MAP_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MAP_y_Fx) + call MV_Unpack2(Var, ValAry, y%Fx) ! Rank 1 Array + case (MAP_y_Fy) + call MV_Unpack2(Var, ValAry, y%Fy) ! Rank 1 Array + case (MAP_y_Fz) + call MV_Unpack2(Var, ValAry, y%Fz) ! Rank 1 Array + case (MAP_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (MAP_y_wrtOutput) + call MV_Unpack2(Var, ValAry, y%wrtOutput) ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_Unpack2(Var, ValAry, y%ptFairleadLoad) ! Mesh + end select + end associate +end subroutine + subroutine MAP_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MAP_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (MAP_y_Fx) - call MV_Unpack2(Var, ValAry, y%Fx) ! Rank 1 Array - case (MAP_y_Fy) - call MV_Unpack2(Var, ValAry, y%Fy) ! Rank 1 Array - case (MAP_y_Fz) - call MV_Unpack2(Var, ValAry, y%Fz) ! Rank 1 Array - case (MAP_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (MAP_y_wrtOutput) - call MV_Unpack2(Var, ValAry, y%wrtOutput) ! Rank 1 Array - case (MAP_y_ptFairleadLoad) - call MV_Unpack2(Var, ValAry, y%ptFairleadLoad) ! Mesh - end select - end associate + call MAP_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE MAP_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 3eedfb3fc1..40e50db113 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -5174,152 +5174,228 @@ function MD_OutputMeshName(ML) result(Name) end select end function +subroutine MD_PackContStateVar(Var, x, ValAry) + type(MD_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MD_x_states) + call MV_Pack2(Var, x%states, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine MD_PackContStateAry(Vars, x, ValAry) type(MD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (MD_x_states) - call MV_Pack2(Var, x%states, ValAry) ! Rank 1 Array - end select - end associate + call MD_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine MD_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MD_x_states) + call MV_Unpack2(Var, ValAry, x%states) ! Rank 1 Array + end select + end associate +end subroutine + subroutine MD_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (MD_x_states) - call MV_Unpack2(Var, ValAry, x%states) ! Rank 1 Array - end select - end associate + call MD_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine MD_PackConstrStateVar(Var, z, ValAry) + type(MD_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MD_z_dummy) + call MV_Pack2(Var, z%dummy, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine MD_PackConstrStateAry(Vars, z, ValAry) type(MD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (MD_z_dummy) - call MV_Pack2(Var, z%dummy, ValAry) ! Scalar - end select - end associate + call MD_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine MD_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MD_z_dummy) + call MV_Unpack2(Var, ValAry, z%dummy) ! Scalar + end select + end associate +end subroutine + subroutine MD_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (MD_z_dummy) - call MV_Unpack2(Var, ValAry, z%dummy) ! Scalar - end select - end associate + call MD_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine MD_PackInputVar(Var, u, ValAry) + type(MD_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MD_u_CoupledKinematics) + call MV_Pack2(Var, u%CoupledKinematics(DL%i1), ValAry) ! Mesh + case (MD_u_DeltaL) + call MV_Pack2(Var, u%DeltaL, ValAry) ! Rank 1 Array + case (MD_u_DeltaLdot) + call MV_Pack2(Var, u%DeltaLdot, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine MD_PackInputAry(Vars, u, ValAry) type(MD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (MD_u_CoupledKinematics) - call MV_Pack2(Var, u%CoupledKinematics(DL%i1), ValAry) ! Mesh - case (MD_u_DeltaL) - call MV_Pack2(Var, u%DeltaL, ValAry) ! Rank 1 Array - case (MD_u_DeltaLdot) - call MV_Pack2(Var, u%DeltaLdot, ValAry) ! Rank 1 Array - end select - end associate + call MD_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine MD_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(MD_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MD_u_CoupledKinematics) + call MV_Unpack2(Var, ValAry, u%CoupledKinematics(DL%i1)) ! Mesh + case (MD_u_DeltaL) + call MV_Unpack2(Var, ValAry, u%DeltaL) ! Rank 1 Array + case (MD_u_DeltaLdot) + call MV_Unpack2(Var, ValAry, u%DeltaLdot) ! Rank 1 Array + end select + end associate +end subroutine + subroutine MD_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (MD_u_CoupledKinematics) - call MV_Unpack2(Var, ValAry, u%CoupledKinematics(DL%i1)) ! Mesh - case (MD_u_DeltaL) - call MV_Unpack2(Var, ValAry, u%DeltaL) ! Rank 1 Array - case (MD_u_DeltaLdot) - call MV_Unpack2(Var, ValAry, u%DeltaLdot) ! Rank 1 Array - end select - end associate + call MD_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine MD_PackOutputVar(Var, y, ValAry) + type(MD_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MD_y_CoupledLoads) + call MV_Pack2(Var, y%CoupledLoads(DL%i1), ValAry) ! Mesh + case (MD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_Pack2(Var, y%VisLinesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisRodsMesh) + call MV_Pack2(Var, y%VisRodsMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_Pack2(Var, y%VisBodiesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_Pack2(Var, y%VisAnchsMesh(DL%i1), ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine MD_PackOutputAry(Vars, y, ValAry) type(MD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (MD_y_CoupledLoads) - call MV_Pack2(Var, y%CoupledLoads(DL%i1), ValAry) ! Mesh - case (MD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (MD_y_VisLinesMesh) - call MV_Pack2(Var, y%VisLinesMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisRodsMesh) - call MV_Pack2(Var, y%VisRodsMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisBodiesMesh) - call MV_Pack2(Var, y%VisBodiesMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisAnchsMesh) - call MV_Pack2(Var, y%VisAnchsMesh(DL%i1), ValAry) ! Mesh - end select - end associate + call MD_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine MD_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(MD_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (MD_y_CoupledLoads) + call MV_Unpack2(Var, ValAry, y%CoupledLoads(DL%i1)) ! Mesh + case (MD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_Unpack2(Var, ValAry, y%VisLinesMesh(DL%i1)) ! Mesh + case (MD_y_VisRodsMesh) + call MV_Unpack2(Var, ValAry, y%VisRodsMesh(DL%i1)) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_Unpack2(Var, ValAry, y%VisBodiesMesh(DL%i1)) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_Unpack2(Var, ValAry, y%VisAnchsMesh(DL%i1)) ! Mesh + end select + end associate +end subroutine + subroutine MD_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (MD_y_CoupledLoads) - call MV_Unpack2(Var, ValAry, y%CoupledLoads(DL%i1)) ! Mesh - case (MD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (MD_y_VisLinesMesh) - call MV_Unpack2(Var, ValAry, y%VisLinesMesh(DL%i1)) ! Mesh - case (MD_y_VisRodsMesh) - call MV_Unpack2(Var, ValAry, y%VisRodsMesh(DL%i1)) ! Mesh - case (MD_y_VisBodiesMesh) - call MV_Unpack2(Var, ValAry, y%VisBodiesMesh(DL%i1)) ! Mesh - case (MD_y_VisAnchsMesh) - call MV_Unpack2(Var, ValAry, y%VisAnchsMesh(DL%i1)) ! Mesh - end select - end associate + call MD_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE MoorDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 49b2be4444..a9ea3df373 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -33,17 +33,18 @@ module ModVar public :: MV_InitVarsJac, MV_Pack, MV_Unpack, MV_Pack2, MV_Unpack2 public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff, MV_ExtrapInterp, MV_AddDelta public :: MV_AddVar, MV_AddMeshVar -public :: MV_HasFlags, MV_SetFlags, MV_ClearFlags, MV_NumVars, MV_FindVarDatLoc +public :: MV_HasFlags, MV_SetFlags, MV_ClearFlags, MV_NumVars, MV_NumVals, MV_FindVarDatLoc public :: LoadFields, MotionFields, TransFields, AngularFields public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv public :: MV_FieldString, MV_IsLoad, IdxStr -public :: DumpMatrix +public :: DumpMatrix, MV_AddModule +public :: MV_PackArray, MV_UnpackArray, MV_PackMatrix, MV_EqualDL integer(IntKi), parameter :: & LoadFields(*) = [FieldForce, FieldMoment], & TransFields(*) = [FieldTransDisp, FieldTransVel, FieldTransAcc], & - AngularFields(*) = [FieldOrientation, FieldAngularDisp, FieldAngularVel, FieldAngularAcc], & - MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc] + AngularFields(*) = [FieldOrientation, FieldAngularVel, FieldAngularAcc, FieldAngularDisp], & + MotionFields(*) = [FieldOrientation, FieldTransDisp, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc] interface MV_Pack module procedure MV_PackVarRank0R4, MV_PackVarRank1R4, MV_PackVarRank2R4 @@ -73,6 +74,42 @@ module ModVar contains +subroutine MV_PackArray(VarAry, ModAry, GluAry) + type(ModVarType), intent(in) :: VarAry(:) + real(R8Ki), allocatable, intent(in) :: ModAry(:) + real(R8Ki), intent(inout) :: GluAry(:) + integer(IntKi) :: i + if (.not. allocated(ModAry) .or. size(VarAry) == 0) return + do i = 1, size(VarAry) + GluAry(VarAry(i)%iGlu(1):VarAry(i)%iGlu(2)) = ModAry(VarAry(i)%iLoc(1):VarAry(i)%iLoc(2)) + end do +end subroutine + +subroutine MV_UnpackArray(VarAry, GluAry, ModAry) + type(ModVarType), intent(in) :: VarAry(:) + real(R8Ki), allocatable, intent(in) :: GluAry(:) + real(R8Ki), intent(inout) :: ModAry(:) + integer(IntKi) :: i + if (.not. allocated(GluAry) .or. size(VarAry) == 0) return + do i = 1, size(VarAry) + ModAry(VarAry(i)%iLoc(1):VarAry(i)%iLoc(2)) = GluAry(VarAry(i)%iGlu(1):VarAry(i)%iGlu(2)) + end do +end subroutine + +subroutine MV_PackMatrix(RowVarAry, ColVarAry, ModMat, GluMat) + type(ModVarType), intent(in) :: RowVarAry(:), ColVarAry(:) + real(R8Ki), allocatable, intent(in) :: ModMat(:, :) + real(R8Ki), intent(inout) :: GluMat(:, :) + integer(IntKi) :: i, j + if (.not. allocated(ModMat) .or. size(RowVarAry) == 0 .or. size(ColVarAry) == 0) return + do i = 1, size(ColVarAry) + do j = 1, size(RowVarAry) + GluMat(RowVarAry(j)%iGlu(1):RowVarAry(j)%iGlu(2), ColVarAry(i)%iGlu(1):ColVarAry(i)%iGlu(2)) = & + ModMat(RowVarAry(j)%iLoc(1):RowVarAry(j)%iLoc(2), ColVarAry(i)%iLoc(1):ColVarAry(i)%iLoc(2)) + end do + end do +end subroutine + !------------------------------------------------------------------------------- ! MV_Pack2 !------------------------------------------------------------------------------- @@ -327,13 +364,13 @@ function MV_FieldString(Field) result(str) end function subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) - type(ModVarsType), pointer, intent(inout) :: Vars - type(ModJacType), intent(inout) :: Jac - logical, intent(in) :: Linearize - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg + type(ModVarsType), intent(inout) :: Vars + type(ModJacType), intent(inout) :: Jac + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'MV_InitVarsLin' + character(*), parameter :: RoutineName = 'MV_InitVarsJac' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, StartIndex @@ -356,6 +393,7 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) if (Failed()) return end do Vars%Nx = sum(Vars%x%Num) + Jac%Nx = Vars%Nx ! Initialize constraint state variables if (.not. allocated(Vars%z)) allocate (Vars%z(0)) @@ -365,6 +403,7 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) if (Failed()) return end do Vars%Nz = sum(Vars%z%Num) + Jac%Nz = Vars%Nz ! Initialize input variables if (.not. allocated(Vars%u)) allocate (Vars%u(0)) @@ -374,6 +413,7 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) if (Failed()) return end do Vars%Nu = sum(Vars%u%Num) + Jac%Nu = Vars%Nu ! Initialize output variables if (.not. allocated(Vars%y)) allocate (Vars%y(0)) @@ -383,26 +423,28 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) if (Failed()) return end do Vars%Ny = sum(Vars%y%Num) + Jac%Ny = Vars%Ny - ! Allocate arrays - if (Vars%Nx > 0) then - call AllocAry(Jac%x, Vars%Nx, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%dx, Vars%Nx, "Lin%dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%x_perturb, Vars%Nx, "Lin%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%x_pos, Vars%Nx, "Lin%x_pos", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%x_neg, Vars%Nx, "Lin%x_neg", ErrStat2, ErrMsg2); if (Failed()) return - end if - if (Vars%Nz > 0) then - call AllocAry(Jac%z, Vars%Nz, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return - end if - if (Vars%Nu > 0) then - call AllocAry(Jac%u, Vars%Nu, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%u_perturb, Vars%Nu, "Lin%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return - end if - if (Vars%Ny > 0) then - call AllocAry(Jac%y, Vars%Ny, "Lin%y", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%y_pos, Vars%Ny, "Lin%y_pos", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%y_neg, Vars%Ny, "Lin%y_neg", ErrStat2, ErrMsg2); if (Failed()) return + ! Allocate Jacobian data arrays + if (Linearize) then + if (Jac%Nx > 0) then + call AllocAry(Jac%x, Jac%Nx, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_perturb, Jac%Nx, "Lin%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_pos, Jac%Nx, "Lin%x_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_neg, Jac%Nx, "Lin%x_neg", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Jac%Nz > 0) then + call AllocAry(Jac%z, Jac%Nz, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Jac%Nu > 0) then + call AllocAry(Jac%u, Jac%Nu, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%u_perturb, Jac%Nu, "Lin%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Jac%Ny > 0) then + call AllocAry(Jac%y, Jac%Ny, "Lin%y", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%y_pos, Jac%Ny, "Lin%y_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%y_neg, Jac%Ny, "Lin%y_neg", ErrStat2, ErrMsg2); if (Failed()) return + end if end if contains @@ -530,32 +572,121 @@ function Failed() end function end subroutine -!------------------------------------------------------------------------------- -! Functions for packing and unpacking data by variable -!------------------------------------------------------------------------------- +subroutine MV_AddModule(ModDataAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, Linearize, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: ModDataAry(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: ModDT + real(R8Ki), intent(in) :: SolverDT + type(ModVarsType), intent(in) :: Vars + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_AddModule' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + integer(IntKi) :: i, StartIndex -subroutine MV_PackMatrix(RowVarAry, ColVarAry, M, SubM, FlagFilter) - type(ModVarType), intent(in) :: RowVarAry(:), ColVarAry(:) - real(R8Ki), intent(in) :: M(:, :) - real(R8Ki), intent(inout) :: SubM(:, :) - integer(IntKi), intent(in) :: FlagFilter - integer(IntKi) :: i, j - integer(IntKi) :: row, col - col = 1 - row = 1 - do i = 1, size(ColVarAry) - if (.not. MV_HasFlags(ColVarAry(i), FlagFilter)) cycle - do j = 1, size(RowVarAry) - if (.not. MV_HasFlags(RowVarAry(j), FlagFilter)) cycle - associate (rVar => RowVarAry(i), cVar => ColVarAry(i)) - SubM(row:row + rVar%Num - 1, col:col + cVar%Num - 1) = M(rVar%iLoc(1):rVar%iLoc(2), cVar%iLoc(1):cVar%iLoc(2)) - end associate - row = row + RowVarAry(j)%Num - 1 - end do - col = col + ColVarAry(i)%Num - 1 + ErrStat = ErrID_None + ErrMsg = '' + + ! Populate module information + if (allocated(ModDataAry)) then + ModData%iMod = size(ModDataAry) + 1 + else + ModData%iMod = 1 + end if + ModData%ID = ModID + ModData%Abbr = ModAbbr + ModData%Ins = Instance + ModData%DT = ModDT + call NWTC_Library_CopyModVarsType(Vars, ModData%Vars, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Initialize arrays + !---------------------------------------------------------------------------- + + ! Allocate source and destination mapping arrays + call AllocAry(ModData%iSrcMaps, 0, "ModData%iSrcMaps", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ModData%iDstMaps, 0, "ModData%iDstMaps", ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Calculate Module Substepping + !---------------------------------------------------------------------------- + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData%DT, SolverDT)) then + ModData%SubSteps = 1 + else + ! If the module time step is greater than the global time step, set error + if (ModData%DT > SolverDT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate the number of substeps + ModData%SubSteps = nint(SolverDT/ModData%DT) + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Add module info to array + !---------------------------------------------------------------------------- + + if (.not. allocated(ModDataAry)) then + ModDataAry = [ModData] + else + ModDataAry = [ModDataAry, ModData] + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine GetModuleOrder(ModDataAry, ModIDs, ModOrder) + type(ModDataType), intent(in) :: ModDataAry(:) !< Array of module data structures + integer(IntKi), intent(in) :: ModIDs(:) !< List of module IDs to keep in order + integer(IntKi), allocatable, intent(out) :: ModOrder(:) !< Module data indices in order of ModIDs + integer(IntKi), allocatable :: ModIDAry(:), indices(:) + integer(IntKi) :: i + + ! Create array 1 to size(Mod) representing the index of each module data + indices = [(i, i=1, size(ModDataAry))] + + ! Get array of module IDs from array of module data + ModIDAry = [(ModDataAry(i)%ID, i=1, size(ModDataAry))] + + ! Initialize module order array with no size + allocate (ModOrder(0)) + + ! Loop through module IDs to keep, add module data indices that match module ID to order array + do i = 1, size(ModIDs) + ModOrder = [ModOrder, pack(indices, ModIDAry == ModIDs(i))] end do + end subroutine +!------------------------------------------------------------------------------- +! Functions for packing and unpacking data by variable +!------------------------------------------------------------------------------- + subroutine MV_PackVarRank0R4(VarAry, iVar, Val, Ary) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), intent(in) :: iVar @@ -1225,37 +1356,64 @@ subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, Deri end subroutine -function MV_NumVars(VarAry, FlagFilter) result(Num) +function MV_NumVals(VarAry, FlagFilter) result(Num) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), optional, intent(in) :: FlagFilter integer(IntKi) :: Num, i if (present(FlagFilter)) then Num = 0 do i = 1, size(VarAry) - if ((FlagFilter == VF_None) .or. (iand(VarAry(i)%Flags, FlagFilter) /= 0)) Num = Num + VarAry(i)%Num + if (MV_HasFlags(VarAry(i), FlagFilter)) Num = Num + VarAry(i)%Num end do else Num = sum(VarAry%Num) end if end function +function MV_NumVars(VarAry, FlagFilter) result(Num) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), optional, intent(in) :: FlagFilter + integer(IntKi) :: Num, i + if (present(FlagFilter)) then + Num = 0 + do i = 1, size(VarAry) + if (MV_HasFlags(VarAry(i), FlagFilter)) Num = Num + 1 + end do + else + Num = size(VarAry) + end if +end function + +! MV_IsLoad returns true if the variable field is FieldForce or FieldMoment pure logical function MV_IsLoad(Var) type(ModVarType), intent(in) :: Var MV_IsLoad = Var%Field == FieldForce .or. Var%Field == FieldMoment end function +! MV_EqualDL returns true if data location numbers are greater than zero and +! all components of the data location are the same. +pure logical function MV_EqualDL(DL1, DL2) + type(DatLoc), intent(in) :: DL1, DL2 + MV_EqualDL = DL1%Num > 0 .and. DL2%Num > 0 .and. & + DL1%Num == DL2%Num .and. & + DL1%i1 == DL2%i1 .and. & + DL1%i2 == DL2%i2 .and. & + DL1%i3 == DL2%i3 +end function + ! Find variable index in array based on DatLoc number -pure integer(IntKi) function MV_FindVarDatLoc(VarAry, DatLocNum) +pure function MV_FindVarDatLoc(VarAry, DL) result(iVar) type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: DatLocNum - integer(IntKi) :: i - do i = 1, size(VarAry) - if (VarAry(i)%DL%Num == DatLocNum) then - MV_FindVarDatLoc = i - return - end if + type(DatLoc), intent(in) :: DL + integer(IntKi) :: iVar + do iVar = 1, size(VarAry) + if (VarAry(iVar)%DL%Num /= DL%Num) cycle + if (VarAry(iVar)%DL%i1 /= DL%i1) cycle + if (VarAry(iVar)%DL%i2 /= DL%i2) cycle + if (VarAry(iVar)%DL%i3 /= DL%i3) cycle + return end do - MV_FindVarDatLoc = 0 + iVar = 0 end function !------------------------------------------------------------------------------- diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index f2f0c410d3..e46d5b8f2b 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -39,12 +39,13 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: FieldMoment = 2 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: FieldOrientation = 3 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransDisp = 4 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularDisp = 5 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransVel = 6 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularVel = 7 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransAcc = 8 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularAcc = 9 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FieldScalar = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransVel = 5 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularVel = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransAcc = 7 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularAcc = 8 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldScalar = 9 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularDisp = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldCount = 10 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] @@ -123,22 +124,21 @@ MODULE NWTC_Library_Types ! ======================= ! ========= ModVarType ======= TYPE, PUBLIC :: ModVarType - character(VarNameLen) :: Name !< [-] - INTEGER(IntKi) :: iMod = 0 !< Module index [-] - INTEGER(IntKi) :: iVar = 0 !< Variable index [-] - TYPE(DatLoc) :: DL !< data location [-] INTEGER(IntKi) :: Field = 0 !< [-] INTEGER(IntKi) :: Nodes = 1 !< [-] INTEGER(IntKi) :: Num = 1 !< [-] INTEGER(IntKi) :: Flags = 0 !< [-] INTEGER(IntKi) :: DerivOrder = 0 !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0 !< indices in local arrays [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0 !< indices in module arrays [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iGlu = 0 !< indices in module arrays [-] INTEGER(IntKi) , DIMENSION(1:2) :: iAry = 0 !< first user defined index for variable [-] INTEGER(IntKi) :: jAry = 0 !< second user defined index for variable [-] INTEGER(IntKi) :: kAry = 0 !< third user defined index for variable [-] INTEGER(IntKi) :: mAry = 0 !< third user defined index for variable [-] INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] REAL(R8Ki) :: Perturb = 0 !< perturbation amount for linearization [-] + TYPE(DatLoc) :: DL !< data location [-] + character(VarNameLen) :: Name !< [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType ! ======================= @@ -156,34 +156,55 @@ MODULE NWTC_Library_Types ! ======================= ! ========= ModJacType ======= TYPE, PUBLIC :: ModJacType + INTEGER(IntKi) :: Nx = 0 !< Number of x values [-] + INTEGER(IntKi) :: Nz = 0 !< Number of z values [-] + INTEGER(IntKi) :: Nu = 0 !< Number of u values [-] + INTEGER(IntKi) :: Ny = 0 !< Number of y values [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] END TYPE ModJacType ! ======================= -! ========= VarXfrType ======= - TYPE, PUBLIC :: VarXfrType - INTEGER(IntKi) :: iVar = 0_IntKi !< [-] - INTEGER(IntKi) :: NumVals = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iSrc = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iDst = 0_IntKi !< [-] - END TYPE VarXfrType +! ========= ModLinType ======= + TYPE, PUBLIC :: ModLinType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] + END TYPE ModLinType ! ======================= -! ========= ModXfrType ======= - TYPE, PUBLIC :: ModXfrType - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: x !< [-] - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: z !< [-] - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: u !< [-] - TYPE(VarXfrType) , DIMENSION(:), ALLOCATABLE :: y !< [-] - END TYPE ModXfrType +! ========= ModDataType ======= + TYPE, PUBLIC :: ModDataType + character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] + INTEGER(IntKi) :: iMod = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] + INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] + REAL(R8Ki) :: DT = 0 !< Module time step [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSrcMaps !< Indices of mappings where module is the source [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iDstMaps !< Indices of mappings where module is the destination [-] + TYPE(ModVarsType) :: Vars !< Module variables type [-] + TYPE(ModLinType) :: Lin !< Module linearization arrays and matrices [-] + END TYPE ModDataType ! ======================= contains @@ -665,24 +686,23 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' ErrStat = ErrID_None ErrMsg = '' - DstModVarTypeData%Name = SrcModVarTypeData%Name - DstModVarTypeData%iMod = SrcModVarTypeData%iMod - DstModVarTypeData%iVar = SrcModVarTypeData%iVar - call NWTC_Library_CopyDatLoc(SrcModVarTypeData%DL, DstModVarTypeData%DL, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstModVarTypeData%Field = SrcModVarTypeData%Field DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes DstModVarTypeData%Num = SrcModVarTypeData%Num DstModVarTypeData%Flags = SrcModVarTypeData%Flags DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc + DstModVarTypeData%iGlu = SrcModVarTypeData%iGlu DstModVarTypeData%iAry = SrcModVarTypeData%iAry DstModVarTypeData%jAry = SrcModVarTypeData%jAry DstModVarTypeData%kAry = SrcModVarTypeData%kAry DstModVarTypeData%mAry = SrcModVarTypeData%mAry DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb + call NWTC_Library_CopyDatLoc(SrcModVarTypeData%DL, DstModVarTypeData%DL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstModVarTypeData%Name = SrcModVarTypeData%Name if (allocated(SrcModVarTypeData%LinNames)) then LB(1:1) = lbound(SrcModVarTypeData%LinNames, kind=B8Ki) UB(1:1) = ubound(SrcModVarTypeData%LinNames, kind=B8Ki) @@ -718,22 +738,21 @@ subroutine NWTC_Library_PackModVarType(RF, Indata) type(ModVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarType' if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Name) - call RegPack(RF, InData%iMod) - call RegPack(RF, InData%iVar) - call NWTC_Library_PackDatLoc(RF, InData%DL) call RegPack(RF, InData%Field) call RegPack(RF, InData%Nodes) call RegPack(RF, InData%Num) call RegPack(RF, InData%Flags) call RegPack(RF, InData%DerivOrder) call RegPack(RF, InData%iLoc) + call RegPack(RF, InData%iGlu) call RegPack(RF, InData%iAry) call RegPack(RF, InData%jAry) call RegPack(RF, InData%kAry) call RegPack(RF, InData%mAry) call RegPack(RF, InData%MeshID) call RegPack(RF, InData%Perturb) + call NWTC_Library_PackDatLoc(RF, InData%DL) + call RegPack(RF, InData%Name) call RegPackAlloc(RF, InData%LinNames) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -746,22 +765,21 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return - call NWTC_Library_UnpackDatLoc(RF, OutData%DL) ! DL call RegUnpack(RF, OutData%Field); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nodes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Flags); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DerivOrder); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iGlu); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iAry); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%jAry); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%kAry); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%mAry); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MeshID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Perturb); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackDatLoc(RF, OutData%DL) ! DL + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1020,11 +1038,15 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModJacType' ErrStat = ErrID_None ErrMsg = '' + DstModJacTypeData%Nx = SrcModJacTypeData%Nx + DstModJacTypeData%Nz = SrcModJacTypeData%Nz + DstModJacTypeData%Nu = SrcModJacTypeData%Nu + DstModJacTypeData%Ny = SrcModJacTypeData%Ny if (allocated(SrcModJacTypeData%x)) then LB(1:1) = lbound(SrcModJacTypeData%x, kind=B8Ki) UB(1:1) = ubound(SrcModJacTypeData%x, kind=B8Ki) @@ -1037,18 +1059,6 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr end if DstModJacTypeData%x = SrcModJacTypeData%x end if - if (allocated(SrcModJacTypeData%dx)) then - LB(1:1) = lbound(SrcModJacTypeData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%dx, kind=B8Ki) - if (.not. allocated(DstModJacTypeData%dx)) then - allocate(DstModJacTypeData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModJacTypeData%dx = SrcModJacTypeData%dx - end if if (allocated(SrcModJacTypeData%z)) then LB(1:1) = lbound(SrcModJacTypeData%z, kind=B8Ki) UB(1:1) = ubound(SrcModJacTypeData%z, kind=B8Ki) @@ -1085,18 +1095,6 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr end if DstModJacTypeData%y = SrcModJacTypeData%y end if - if (allocated(SrcModJacTypeData%u_perturb)) then - LB(1:1) = lbound(SrcModJacTypeData%u_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%u_perturb, kind=B8Ki) - if (.not. allocated(DstModJacTypeData%u_perturb)) then - allocate(DstModJacTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModJacTypeData%u_perturb = SrcModJacTypeData%u_perturb - end if if (allocated(SrcModJacTypeData%x_perturb)) then LB(1:1) = lbound(SrcModJacTypeData%x_perturb, kind=B8Ki) UB(1:1) = ubound(SrcModJacTypeData%x_perturb, kind=B8Ki) @@ -1109,6 +1107,30 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr end if DstModJacTypeData%x_perturb = SrcModJacTypeData%x_perturb end if + if (allocated(SrcModJacTypeData%z_perturb)) then + LB(1:1) = lbound(SrcModJacTypeData%z_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%z_perturb, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%z_perturb)) then + allocate(DstModJacTypeData%z_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%z_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%z_perturb = SrcModJacTypeData%z_perturb + end if + if (allocated(SrcModJacTypeData%u_perturb)) then + LB(1:1) = lbound(SrcModJacTypeData%u_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModJacTypeData%u_perturb, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%u_perturb)) then + allocate(DstModJacTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%u_perturb = SrcModJacTypeData%u_perturb + end if if (allocated(SrcModJacTypeData%x_pos)) then LB(1:1) = lbound(SrcModJacTypeData%x_pos, kind=B8Ki) UB(1:1) = ubound(SrcModJacTypeData%x_pos, kind=B8Ki) @@ -1157,6 +1179,18 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr end if DstModJacTypeData%y_neg = SrcModJacTypeData%y_neg end if + if (allocated(SrcModJacTypeData%StateRotation)) then + LB(1:2) = lbound(SrcModJacTypeData%StateRotation, kind=B8Ki) + UB(1:2) = ubound(SrcModJacTypeData%StateRotation, kind=B8Ki) + if (.not. allocated(DstModJacTypeData%StateRotation)) then + allocate(DstModJacTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%StateRotation = SrcModJacTypeData%StateRotation + end if end subroutine subroutine NWTC_Library_DestroyModJacType(ModJacTypeData, ErrStat, ErrMsg) @@ -1169,9 +1203,6 @@ subroutine NWTC_Library_DestroyModJacType(ModJacTypeData, ErrStat, ErrMsg) if (allocated(ModJacTypeData%x)) then deallocate(ModJacTypeData%x) end if - if (allocated(ModJacTypeData%dx)) then - deallocate(ModJacTypeData%dx) - end if if (allocated(ModJacTypeData%z)) then deallocate(ModJacTypeData%z) end if @@ -1181,12 +1212,15 @@ subroutine NWTC_Library_DestroyModJacType(ModJacTypeData, ErrStat, ErrMsg) if (allocated(ModJacTypeData%y)) then deallocate(ModJacTypeData%y) end if - if (allocated(ModJacTypeData%u_perturb)) then - deallocate(ModJacTypeData%u_perturb) - end if if (allocated(ModJacTypeData%x_perturb)) then deallocate(ModJacTypeData%x_perturb) end if + if (allocated(ModJacTypeData%z_perturb)) then + deallocate(ModJacTypeData%z_perturb) + end if + if (allocated(ModJacTypeData%u_perturb)) then + deallocate(ModJacTypeData%u_perturb) + end if if (allocated(ModJacTypeData%x_pos)) then deallocate(ModJacTypeData%x_pos) end if @@ -1199,6 +1233,9 @@ subroutine NWTC_Library_DestroyModJacType(ModJacTypeData, ErrStat, ErrMsg) if (allocated(ModJacTypeData%y_neg)) then deallocate(ModJacTypeData%y_neg) end if + if (allocated(ModJacTypeData%StateRotation)) then + deallocate(ModJacTypeData%StateRotation) + end if end subroutine subroutine NWTC_Library_PackModJacType(RF, Indata) @@ -1206,17 +1243,22 @@ subroutine NWTC_Library_PackModJacType(RF, Indata) type(ModJacType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackModJacType' if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nz) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) call RegPackAlloc(RF, InData%x) - call RegPackAlloc(RF, InData%dx) call RegPackAlloc(RF, InData%z) call RegPackAlloc(RF, InData%u) call RegPackAlloc(RF, InData%y) - call RegPackAlloc(RF, InData%u_perturb) call RegPackAlloc(RF, InData%x_perturb) + call RegPackAlloc(RF, InData%z_perturb) + call RegPackAlloc(RF, InData%u_perturb) call RegPackAlloc(RF, InData%x_pos) call RegPackAlloc(RF, InData%x_neg) call RegPackAlloc(RF, InData%y_pos) call RegPackAlloc(RF, InData%y_neg) + call RegPackAlloc(RF, InData%StateRotation) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1224,305 +1266,413 @@ subroutine NWTC_Library_UnPackModJacType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModJacType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModJacType' - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_CopyVarXfrType(SrcVarXfrTypeData, DstVarXfrTypeData, CtrlCode, ErrStat, ErrMsg) - type(VarXfrType), intent(in) :: SrcVarXfrTypeData - type(VarXfrType), intent(inout) :: DstVarXfrTypeData +subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModLinType), intent(in) :: SrcModLinTypeData + type(ModLinType), intent(inout) :: DstModLinTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_CopyVarXfrType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModLinType' ErrStat = ErrID_None ErrMsg = '' - DstVarXfrTypeData%iVar = SrcVarXfrTypeData%iVar - DstVarXfrTypeData%NumVals = SrcVarXfrTypeData%NumVals - DstVarXfrTypeData%iSrc = SrcVarXfrTypeData%iSrc - DstVarXfrTypeData%iDst = SrcVarXfrTypeData%iDst + if (allocated(SrcModLinTypeData%x)) then + LB(1:1) = lbound(SrcModLinTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%x, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%x)) then + allocate(DstModLinTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%x = SrcModLinTypeData%x + end if + if (allocated(SrcModLinTypeData%dx)) then + LB(1:1) = lbound(SrcModLinTypeData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%dx, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dx)) then + allocate(DstModLinTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dx = SrcModLinTypeData%dx + end if + if (allocated(SrcModLinTypeData%z)) then + LB(1:1) = lbound(SrcModLinTypeData%z, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%z, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%z)) then + allocate(DstModLinTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%z = SrcModLinTypeData%z + end if + if (allocated(SrcModLinTypeData%u)) then + LB(1:1) = lbound(SrcModLinTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%u, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%u)) then + allocate(DstModLinTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%u = SrcModLinTypeData%u + end if + if (allocated(SrcModLinTypeData%y)) then + LB(1:1) = lbound(SrcModLinTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%y, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%y)) then + allocate(DstModLinTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%y = SrcModLinTypeData%y + end if + if (allocated(SrcModLinTypeData%J)) then + LB(1:2) = lbound(SrcModLinTypeData%J, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%J, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%J)) then + allocate(DstModLinTypeData%J(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%J.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%J = SrcModLinTypeData%J + end if + if (allocated(SrcModLinTypeData%dYdx)) then + LB(1:2) = lbound(SrcModLinTypeData%dYdx, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dYdx, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dYdx)) then + allocate(DstModLinTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dYdx = SrcModLinTypeData%dYdx + end if + if (allocated(SrcModLinTypeData%dXdx)) then + LB(1:2) = lbound(SrcModLinTypeData%dXdx, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dXdx, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dXdx)) then + allocate(DstModLinTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dXdx = SrcModLinTypeData%dXdx + end if + if (allocated(SrcModLinTypeData%dYdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dYdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dYdu, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dYdu)) then + allocate(DstModLinTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dYdu = SrcModLinTypeData%dYdu + end if + if (allocated(SrcModLinTypeData%dXdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dXdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dXdu, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dXdu)) then + allocate(DstModLinTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dXdu = SrcModLinTypeData%dXdu + end if + if (allocated(SrcModLinTypeData%dXdy)) then + LB(1:2) = lbound(SrcModLinTypeData%dXdy, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dXdy, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dXdy)) then + allocate(DstModLinTypeData%dXdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dXdy = SrcModLinTypeData%dXdy + end if + if (allocated(SrcModLinTypeData%dUdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dUdu, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dUdu, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dUdu)) then + allocate(DstModLinTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dUdu = SrcModLinTypeData%dUdu + end if + if (allocated(SrcModLinTypeData%dUdy)) then + LB(1:2) = lbound(SrcModLinTypeData%dUdy, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%dUdy, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%dUdy)) then + allocate(DstModLinTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%dUdy = SrcModLinTypeData%dUdy + end if + if (allocated(SrcModLinTypeData%StateRotation)) then + LB(1:2) = lbound(SrcModLinTypeData%StateRotation, kind=B8Ki) + UB(1:2) = ubound(SrcModLinTypeData%StateRotation, kind=B8Ki) + if (.not. allocated(DstModLinTypeData%StateRotation)) then + allocate(DstModLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModLinTypeData%StateRotation = SrcModLinTypeData%StateRotation + end if end subroutine -subroutine NWTC_Library_DestroyVarXfrType(VarXfrTypeData, ErrStat, ErrMsg) - type(VarXfrType), intent(inout) :: VarXfrTypeData +subroutine NWTC_Library_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) + type(ModLinType), intent(inout) :: ModLinTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyVarXfrType' + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModLinType' ErrStat = ErrID_None ErrMsg = '' + if (allocated(ModLinTypeData%x)) then + deallocate(ModLinTypeData%x) + end if + if (allocated(ModLinTypeData%dx)) then + deallocate(ModLinTypeData%dx) + end if + if (allocated(ModLinTypeData%z)) then + deallocate(ModLinTypeData%z) + end if + if (allocated(ModLinTypeData%u)) then + deallocate(ModLinTypeData%u) + end if + if (allocated(ModLinTypeData%y)) then + deallocate(ModLinTypeData%y) + end if + if (allocated(ModLinTypeData%J)) then + deallocate(ModLinTypeData%J) + end if + if (allocated(ModLinTypeData%dYdx)) then + deallocate(ModLinTypeData%dYdx) + end if + if (allocated(ModLinTypeData%dXdx)) then + deallocate(ModLinTypeData%dXdx) + end if + if (allocated(ModLinTypeData%dYdu)) then + deallocate(ModLinTypeData%dYdu) + end if + if (allocated(ModLinTypeData%dXdu)) then + deallocate(ModLinTypeData%dXdu) + end if + if (allocated(ModLinTypeData%dXdy)) then + deallocate(ModLinTypeData%dXdy) + end if + if (allocated(ModLinTypeData%dUdu)) then + deallocate(ModLinTypeData%dUdu) + end if + if (allocated(ModLinTypeData%dUdy)) then + deallocate(ModLinTypeData%dUdy) + end if + if (allocated(ModLinTypeData%StateRotation)) then + deallocate(ModLinTypeData%StateRotation) + end if end subroutine -subroutine NWTC_Library_PackVarXfrType(RF, Indata) +subroutine NWTC_Library_PackModLinType(RF, Indata) type(RegFile), intent(inout) :: RF - type(VarXfrType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackVarXfrType' + type(ModLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModLinType' if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%iVar) - call RegPack(RF, InData%NumVals) - call RegPack(RF, InData%iSrc) - call RegPack(RF, InData%iDst) + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%dx) + call RegPackAlloc(RF, InData%z) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%J) + call RegPackAlloc(RF, InData%dYdx) + call RegPackAlloc(RF, InData%dXdx) + call RegPackAlloc(RF, InData%dYdu) + call RegPackAlloc(RF, InData%dXdu) + call RegPackAlloc(RF, InData%dXdy) + call RegPackAlloc(RF, InData%dUdu) + call RegPackAlloc(RF, InData%dUdy) + call RegPackAlloc(RF, InData%StateRotation) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackVarXfrType(RF, OutData) +subroutine NWTC_Library_UnPackModLinType(RF, OutData) type(RegFile), intent(inout) :: RF - type(VarXfrType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackVarXfrType' + type(ModLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModLinType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%iVar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumVals); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iSrc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iDst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_CopyModXfrType(SrcModXfrTypeData, DstModXfrTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModXfrType), intent(in) :: SrcModXfrTypeData - type(ModXfrType), intent(inout) :: DstModXfrTypeData +subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: SrcModDataTypeData + type(ModDataType), intent(inout) :: DstModDataTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyModXfrType' + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcModXfrTypeData%x)) then - LB(1:1) = lbound(SrcModXfrTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%x, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%x)) then - allocate(DstModXfrTypeData%x(LB(1):UB(1)), stat=ErrStat2) + DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%ID = SrcModDataTypeData%ID + DstModDataTypeData%iMod = SrcModDataTypeData%iMod + DstModDataTypeData%Ins = SrcModDataTypeData%Ins + DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps + DstModDataTypeData%DT = SrcModDataTypeData%DT + if (allocated(SrcModDataTypeData%iSrcMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%iSrcMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%iSrcMaps, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%iSrcMaps)) then + allocate(DstModDataTypeData%iSrcMaps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%x.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iSrcMaps.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyVarXfrType(SrcModXfrTypeData%x(i1), DstModXfrTypeData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstModDataTypeData%iSrcMaps = SrcModDataTypeData%iSrcMaps end if - if (allocated(SrcModXfrTypeData%z)) then - LB(1:1) = lbound(SrcModXfrTypeData%z, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%z, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%z)) then - allocate(DstModXfrTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModDataTypeData%iDstMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%iDstMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%iDstMaps, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%iDstMaps)) then + allocate(DstModDataTypeData%iDstMaps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%z.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iDstMaps.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyVarXfrType(SrcModXfrTypeData%z(i1), DstModXfrTypeData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcModXfrTypeData%u)) then - LB(1:1) = lbound(SrcModXfrTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%u, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%u)) then - allocate(DstModXfrTypeData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyVarXfrType(SrcModXfrTypeData%u(i1), DstModXfrTypeData%u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcModXfrTypeData%y)) then - LB(1:1) = lbound(SrcModXfrTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModXfrTypeData%y, kind=B8Ki) - if (.not. allocated(DstModXfrTypeData%y)) then - allocate(DstModXfrTypeData%y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModXfrTypeData%y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyVarXfrType(SrcModXfrTypeData%y(i1), DstModXfrTypeData%y(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstModDataTypeData%iDstMaps = SrcModDataTypeData%iDstMaps end if + call NWTC_Library_CopyModVarsType(SrcModDataTypeData%Vars, DstModDataTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModLinType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine -subroutine NWTC_Library_DestroyModXfrType(ModXfrTypeData, ErrStat, ErrMsg) - type(ModXfrType), intent(inout) :: ModXfrTypeData +subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModDataTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModXfrType' + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModXfrTypeData%x)) then - LB(1:1) = lbound(ModXfrTypeData%x, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyVarXfrType(ModXfrTypeData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%x) - end if - if (allocated(ModXfrTypeData%z)) then - LB(1:1) = lbound(ModXfrTypeData%z, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyVarXfrType(ModXfrTypeData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%z) - end if - if (allocated(ModXfrTypeData%u)) then - LB(1:1) = lbound(ModXfrTypeData%u, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%u, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyVarXfrType(ModXfrTypeData%u(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%u) + if (allocated(ModDataTypeData%iSrcMaps)) then + deallocate(ModDataTypeData%iSrcMaps) end if - if (allocated(ModXfrTypeData%y)) then - LB(1:1) = lbound(ModXfrTypeData%y, kind=B8Ki) - UB(1:1) = ubound(ModXfrTypeData%y, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyVarXfrType(ModXfrTypeData%y(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModXfrTypeData%y) + if (allocated(ModDataTypeData%iDstMaps)) then + deallocate(ModDataTypeData%iDstMaps) end if + call NWTC_Library_DestroyModVarsType(ModDataTypeData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModLinType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine NWTC_Library_PackModXfrType(RF, Indata) +subroutine NWTC_Library_PackModDataType(RF, Indata) type(RegFile), intent(inout) :: RF - type(ModXfrType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackModXfrType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + type(ModDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%x)) - if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackVarXfrType(RF, InData%x(i1)) - end do - end if - call RegPack(RF, allocated(InData%z)) - if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackVarXfrType(RF, InData%z(i1)) - end do - end if - call RegPack(RF, allocated(InData%u)) - if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackVarXfrType(RF, InData%u(i1)) - end do - end if - call RegPack(RF, allocated(InData%y)) - if (allocated(InData%y)) then - call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - LB(1:1) = lbound(InData%y, kind=B8Ki) - UB(1:1) = ubound(InData%y, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackVarXfrType(RF, InData%y(i1)) - end do - end if + call RegPack(RF, InData%Abbr) + call RegPack(RF, InData%ID) + call RegPack(RF, InData%iMod) + call RegPack(RF, InData%Ins) + call RegPack(RF, InData%SubSteps) + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%iSrcMaps) + call RegPackAlloc(RF, InData%iDstMaps) + call NWTC_Library_PackModVarsType(RF, InData%Vars) + call NWTC_Library_PackModLinType(RF, InData%Lin) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackModXfrType(RF, OutData) +subroutine NWTC_Library_UnPackModDataType(RF, OutData) type(RegFile), intent(inout) :: RF - type(ModXfrType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModXfrType' - integer(B8Ki) :: i1 + type(ModDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%x)) deallocate(OutData%x) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackVarXfrType(RF, OutData%x(i1)) ! x - end do - end if - if (allocated(OutData%z)) deallocate(OutData%z) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackVarXfrType(RF, OutData%z(i1)) ! z - end do - end if - if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackVarXfrType(RF, OutData%u(i1)) ! u - end do - end if - if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackVarXfrType(RF, OutData%y(i1)) ! y - end do - end if + call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iSrcMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iDstMaps); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index e6177bcebd..52fabfd7ae 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -49,12 +49,13 @@ param ^ - IntKi FieldForce - 1 - param ^ - IntKi FieldMoment - 2 - "" - param ^ - IntKi FieldOrientation - 3 - "" - param ^ - IntKi FieldTransDisp - 4 - "" - -param ^ - IntKi FieldAngularDisp - 5 - "" - -param ^ - IntKi FieldTransVel - 6 - "" - -param ^ - IntKi FieldAngularVel - 7 - "" - -param ^ - IntKi FieldTransAcc - 8 - "" - -param ^ - IntKi FieldAngularAcc - 9 - "" - -param ^ - IntKi FieldScalar - 10 - "" - +param ^ - IntKi FieldTransVel - 5 - "" - +param ^ - IntKi FieldAngularVel - 6 - "" - +param ^ - IntKi FieldTransAcc - 7 - "" - +param ^ - IntKi FieldAngularAcc - 8 - "" - +param ^ - IntKi FieldScalar - 9 - "" - +param ^ - IntKi FieldAngularDisp - 10 - "" - +param ^ - IntKi FieldCount - 10 - "" - param ^ - IntKi VF_None - 0 - "Variable with no flags" - param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - @@ -80,55 +81,74 @@ typedef ^ ^ IntKi i1 - 0 - typedef ^ ^ IntKi i2 - 0 - "Index 2" typedef ^ ^ IntKi i3 - 0 - "Index 3" -typedef ^ ModVarType character(VarNameLen) Name - - - "" - -typedef ^ ^ IntKi iMod - 0 - "Module index" - -typedef ^ ^ IntKi iVar - 0 - "Variable index" - -typedef ^ ^ DatLoc DL - - - "data location" - -typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ModVarType IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iLoc 2 0 - "indices in local arrays" - +typedef ^ ^ IntKi iLoc 2 0 - "indices in module arrays" - +typedef ^ ^ IntKi iGlu 2 0 - "indices in module arrays" - typedef ^ ^ IntKi iAry 2 0 - "first user defined index for variable" - typedef ^ ^ IntKi jAry - 0 - "second user defined index for variable" - typedef ^ ^ IntKi kAry - 0 - "third user defined index for variable" - typedef ^ ^ IntKi mAry - 0 - "third user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - +typedef ^ ^ DatLoc DL - - - "data location" - +typedef ^ ^ character(VarNameLen) Name - - - "" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" typedef ^ ^ IntKi Nz - 0 - "Number of z values" typedef ^ ^ IntKi Nu - 0 - "Number of u values" typedef ^ ^ IntKi Ny - 0 - "Number of y values" -typedef ^ ^ ModVarType x : - - "Module state variable array" - -typedef ^ ^ ModVarType z : - - "Module state variable array" - -typedef ^ ^ ModVarType u : - - "Module input variable array" - -typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ ModVarType x : - - "Module state variable array" +typedef ^ ^ ModVarType z : - - "Module state variable array" +typedef ^ ^ ModVarType u : - - "Module input variable array" +typedef ^ ^ ModVarType y : - - "Module output variable array" -typedef ^ ModJacType R8Ki x : - - "" - -typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ModJacType IntKi Nx - 0 - "Number of x values" +typedef ^ ^ IntKi Nz - 0 - "Number of z values" +typedef ^ ^ IntKi Nu - 0 - "Number of u values" +typedef ^ ^ IntKi Ny - 0 - "Number of y values" +typedef ^ ^ R8Ki x : - - "" - typedef ^ ^ R8Ki z : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "" - typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki z_perturb : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "" - typedef ^ ^ R8Ki x_pos : - - "" - typedef ^ ^ R8Ki x_neg : - - "" - typedef ^ ^ R8Ki y_pos : - - "" - typedef ^ ^ R8Ki y_neg : - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - -typedef ^ VarXfrType IntKi iVar - - - "" - -typedef ^ ^ IntKi NumVals - - - "" - -typedef ^ ^ IntKi iSrc 2 - - "" - -typedef ^ ^ IntKi iDst 2 - - "" - - -typedef ^ ModXfrType VarXfrType x : - - "" - -typedef ^ ^ VarXfrType z : - - "" - -typedef ^ ^ VarXfrType u : - - "" - -typedef ^ ^ VarXfrType y : - - "" - - +typedef ^ ModLinType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki z : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki J :: - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dXdy :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - + +typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi iSrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi iDstMaps : - - "Indices of mappings where module is the destination" +typedef ^ ^ ModVarsType Vars - - - "Module variables type" - +typedef ^ ^ ModLinType Lin - - - "Module linearization arrays and matrices" # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 8baca31f66..7d8cc4c13b 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -49,12 +49,13 @@ param ^ - IntKi FieldForce - 1 - param ^ - IntKi FieldMoment - 2 - "" - param ^ - IntKi FieldOrientation - 3 - "" - param ^ - IntKi FieldTransDisp - 4 - "" - -param ^ - IntKi FieldAngularDisp - 5 - "" - -param ^ - IntKi FieldTransVel - 6 - "" - -param ^ - IntKi FieldAngularVel - 7 - "" - -param ^ - IntKi FieldTransAcc - 8 - "" - -param ^ - IntKi FieldAngularAcc - 9 - "" - -param ^ - IntKi FieldScalar - 10 - "" - +param ^ - IntKi FieldTransVel - 5 - "" - +param ^ - IntKi FieldAngularVel - 6 - "" - +param ^ - IntKi FieldTransAcc - 7 - "" - +param ^ - IntKi FieldAngularAcc - 8 - "" - +param ^ - IntKi FieldScalar - 9 - "" - +param ^ - IntKi FieldAngularDisp - 10 - "" - +param ^ - IntKi FieldCount - 10 - "" - param ^ - IntKi VF_None - 0 - "Variable with no flags" - param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - @@ -80,52 +81,71 @@ typedef ^ ^ IntKi i1 - 0 - typedef ^ ^ IntKi i2 - 0 - "Index 2" typedef ^ ^ IntKi i3 - 0 - "Index 3" -typedef ^ ModVarType character(VarNameLen) Name - - - "" - -typedef ^ ^ IntKi iMod - 0 - "Module index" - -typedef ^ ^ IntKi iVar - 0 - "Variable index" - -typedef ^ ^ DatLoc DL - - - "data location" - -typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ModVarType IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iLoc 2 0 - "indices in local arrays" - +typedef ^ ^ IntKi iLoc 2 0 - "indices in module arrays" - +typedef ^ ^ IntKi iGlu 2 0 - "indices in module arrays" - typedef ^ ^ IntKi iAry 2 0 - "first user defined index for variable" - typedef ^ ^ IntKi jAry - 0 - "second user defined index for variable" - typedef ^ ^ IntKi kAry - 0 - "third user defined index for variable" - typedef ^ ^ IntKi mAry - 0 - "third user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - +typedef ^ ^ DatLoc DL - - - "data location" - +typedef ^ ^ character(VarNameLen) Name - - - "" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" typedef ^ ^ IntKi Nz - 0 - "Number of z values" typedef ^ ^ IntKi Nu - 0 - "Number of u values" typedef ^ ^ IntKi Ny - 0 - "Number of y values" -typedef ^ ^ ModVarType x : - - "Module state variable array" - -typedef ^ ^ ModVarType z : - - "Module state variable array" - -typedef ^ ^ ModVarType u : - - "Module input variable array" - -typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ ModVarType x : - - "Module state variable array" +typedef ^ ^ ModVarType z : - - "Module state variable array" +typedef ^ ^ ModVarType u : - - "Module input variable array" +typedef ^ ^ ModVarType y : - - "Module output variable array" -typedef ^ ModJacType R8Ki x : - - "" - -typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ModJacType IntKi Nx - 0 - "Number of x values" +typedef ^ ^ IntKi Nz - 0 - "Number of z values" +typedef ^ ^ IntKi Nu - 0 - "Number of u values" +typedef ^ ^ IntKi Ny - 0 - "Number of y values" +typedef ^ ^ R8Ki x : - - "" - typedef ^ ^ R8Ki z : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "" - typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki z_perturb : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "" - typedef ^ ^ R8Ki x_pos : - - "" - typedef ^ ^ R8Ki x_neg : - - "" - typedef ^ ^ R8Ki y_pos : - - "" - typedef ^ ^ R8Ki y_neg : - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - -typedef ^ VarXfrType IntKi iVar - - - "" - -typedef ^ ^ IntKi NumVals - - - "" - -typedef ^ ^ IntKi iSrc 2 - - "" - -typedef ^ ^ IntKi iDst 2 - - "" - - -typedef ^ ModXfrType VarXfrType x : - - "" - -typedef ^ ^ VarXfrType z : - - "" - -typedef ^ ^ VarXfrType u : - - "" - -typedef ^ ^ VarXfrType y : - - "" - - +typedef ^ ModLinType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki z : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki J :: - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dXdy :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - + +typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi iSrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi iDstMaps : - - "Indices of mappings where module is the destination" +typedef ^ ^ ModVarsType Vars - - - "Module variables type" - +typedef ^ ^ ModLinType Lin - - - "Module linearization arrays and matrices" diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 4383fecf43..9adee153d1 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -75,7 +75,6 @@ add_library(openfast_postlib STATIC # src/FAST_SS_Solver.f90 src/FAST_Funcs.f90 - src/FAST_ModData.f90 src/FAST_ModGlue.f90 src/FAST_Mapping.f90 # src/FAST_AeroMap.f90 diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 492d13f13b..07fd8c447a 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -20,7 +20,6 @@ module FAST_AeroMap -use FAST_ModData use FAST_ModTypes use FAST_Types use FAST_Funcs diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 7eea0c3eb4..3cfe858adb 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -464,7 +464,7 @@ subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, E else CalcWriteOutputLoc = .true. end if - + ! Select based on module ID select case (ModData%ID) @@ -515,26 +515,24 @@ subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, E if (ErrStat >= AbortErrLev) return ! Set updated flag in mappings where this module is the source - Maps(ModData%SrcMaps)%Ready = .true. + Maps(ModData%iSrcMaps)%Ready = .true. end subroutine subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, & - Vars, u_op, y_op, x_op, dx_op, xd_op, z_op) - type(ModDataType), intent(in) :: ModData !< Module data + u_op, y_op, x_op, dx_op, z_op, u_glue, y_glue, x_glue, dx_glue, z_glue) + type(ModDataType), intent(in) :: ModData !< Module information real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: InputIndex !< Input index integer(IntKi), intent(in) :: StateIndex !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - type(ModVarsType), optional, intent(in) :: Vars !< Variables - real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs - real(R8Ki), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs - real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states - real(R8Ki), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states - real(R8Ki), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states - real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states + real(R8Ki), allocatable, optional, intent(inout) :: u_op(:), u_glue(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(inout) :: y_op(:), y_glue(:) !< values of linearized outputs + real(R8Ki), allocatable, optional, intent(inout) :: x_op(:), x_glue(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: dx_op(:), dx_glue(:) !< values of first time derivatives of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: z_op(:), z_glue(:) !< values of linearized constraint states character(*), parameter :: RoutineName = 'FAST_GetOP' integer(IntKi) :: ErrStat2 @@ -544,186 +542,529 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err ErrStat = ErrID_None ErrMsg = '' - ! Select based on module ID - select case (ModData%ID) + ! If inputs are requested + if (present(u_op)) then - case (Module_AD) - call AD_GetOP(ModData%Ins, ThisTime, T%AD%Input(InputIndex), T%AD%p, T%AD%x(StateIndex), T%AD%xd(StateIndex), T%AD%z(StateIndex), & - T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & - Vars=Vars, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + if (.not. allocated(u_op)) then + call AllocAry(u_op, ModData%Vars%Nu, "u_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if - case (Module_BD) - call BD_GetOP(ThisTime, T%BD%Input(InputIndex, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, StateIndex), & - T%BD%xd(ModData%Ins, StateIndex), T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & - T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_PackInputAry(ModData%Vars, T%AD%Input(InputIndex)%rotors(ModData%Ins), u_op) + case (Module_BD) + call BD_PackInputAry(ModData%Vars, T%BD%Input(InputIndex, ModData%Ins), u_op) + case (Module_ED) + call ED_PackInputAry(ModData%Vars, T%ED%Input(InputIndex), u_op) + case (Module_ExtPtfm) + call ExtPtfm_PackInputAry(ModData%Vars, T%ExtPtfm%Input(InputIndex), u_op) + case (Module_FEAM) + call FEAM_PackInputAry(ModData%Vars, T%FEAM%Input(InputIndex), u_op) + case (Module_HD) + call HydroDyn_PackInputAry(ModData%Vars, T%HD%Input(InputIndex), u_op) + case (Module_IceD) + call IceD_PackInputAry(ModData%Vars, T%IceD%Input(InputIndex, ModData%Ins), u_op) + case (Module_IceF) + call IceFloe_PackInputAry(ModData%Vars, T%IceF%Input(InputIndex), u_op) + case (Module_IfW) + call InflowWind_PackInputAry(ModData%Vars, T%IfW%Input(InputIndex), u_op) + call InflowWind_PackExtInputAry(ModData%Vars, ThisTime, T%IfW%p, u_op) + case (Module_MAP) + call MAP_PackInputAry(ModData%Vars, T%MAP%Input(InputIndex), u_op) + case (Module_MD) + call MD_PackInputAry(ModData%Vars, T%MD%Input(InputIndex), u_op) + case (Module_ExtInfw) + ! call ExtInfw_PackInputAry(ModData%Vars, T%ExtInfw%Input(InputIndex), u_op) + case (Module_Orca) + call Orca_PackInputAry(ModData%Vars, T%Orca%Input(InputIndex), u_op) + case (Module_SD) + call SD_PackInputAry(ModData%Vars, T%SD%Input(InputIndex), u_op) + case (Module_SeaSt) + call SeaSt_PackInputAry(ModData%Vars, T%SeaSt%Input(InputIndex), u_op) + case (Module_SrvD) + call SrvD_PackInputAry(ModData%Vars, T%SrvD%Input(InputIndex), u_op) + case default + call SetErrStat(ErrID_Fatal, "Input unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select - case (Module_ED) - call ED_GetOP(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & - T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! If glue array is present, transfer from module to glue + if (present(u_glue)) call MV_PackArray(ModData%Vars%u, u_op, u_glue) + end if -! case (Module_ExtPtfm) + ! If outputs are requested + if (present(y_op)) then -! case (Module_FEAM) + if (.not. allocated(y_op)) then + call AllocAry(y_op, ModData%Vars%Ny, "y_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if - case (Module_HD) - call HD_GetOP(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & - T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_PackOutputAry(ModData%Vars, T%AD%y%rotors(ModData%Ins), y_op) + case (Module_BD) + call BD_PackOutputAry(ModData%Vars, T%BD%y(ModData%Ins), y_op) + case (Module_ED) + call ED_PackOutputAry(ModData%Vars, T%ED%y, y_op) + case (Module_ExtPtfm) + call ExtPtfm_PackOutputAry(ModData%Vars, T%ExtPtfm%y, y_op) + case (Module_FEAM) + call FEAM_PackOutputAry(ModData%Vars, T%FEAM%y, y_op) + case (Module_HD) + call HydroDyn_PackOutputAry(ModData%Vars, T%HD%y, y_op) + case (Module_IceD) + call IceD_PackOutputAry(ModData%Vars, T%IceD%y(ModData%Ins), y_op) + case (Module_IceF) + call IceFloe_PackOutputAry(ModData%Vars, T%IceF%y, y_op) + case (Module_IfW) + call InflowWind_PackOutputAry(ModData%Vars, T%IfW%y, y_op) + call InflowWind_PackExtOutputAry(ModData%Vars, ThisTime, T%IfW%p, y_op) + case (Module_MAP) + call MAP_PackOutputAry(ModData%Vars, T%MAP%y, y_op) + case (Module_MD) + call MD_PackOutputAry(ModData%Vars, T%MD%y, y_op) + case (Module_ExtInfw) + call ExtInfw_PackOutputAry(ModData%Vars, T%ExtInfw%y, y_op) + case (Module_Orca) + call Orca_PackOutputAry(ModData%Vars, T%Orca%y, y_op) + case (Module_SD) + call SD_PackOutputAry(ModData%Vars, T%SD%y, y_op) + case (Module_SeaSt) + call SeaSt_PackOutputAry(ModData%Vars, T%SeaSt%y, y_op) + case (Module_SrvD) + call SrvD_PackOutputAry(ModData%Vars, T%SrvD%y, y_op) + case default + call SetErrStat(ErrID_Fatal, "Output unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select -! case (Module_IceD) -! case (Module_IceF) - case (Module_IfW) - call InflowWind_GetOP(ThisTime, T%IfW%Input(InputIndex), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), T%IfW%z(StateIndex), & - T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! If glue array is present, transfer from module to glue + if (present(y_glue)) call MV_PackArray(ModData%Vars%y, y_op, y_glue) + end if - case (Module_MAP) - call MAP_GetOP(ThisTime, T%MAP%Input(InputIndex), T%MAP%p, T%MAP%x(StateIndex), T%MAP%xd(StateIndex), T%MAP%z(StateIndex), & - T%MAP%OtherSt, T%MAP%y, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op) !, x_op=x_op, dx_op=dx_op) MAP doesn't have states + ! If continuous states are requested + if (present(x_op)) then - case (Module_MD) - call MD_GetOP(ThisTime, T%MD%Input(InputIndex), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), T%MD%z(StateIndex), & - T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + if (.not. allocated(x_op)) then + call AllocAry(x_op, ModData%Vars%Nx, "x_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if -! case (Module_OpFM) -! case (Module_Orca) - case (Module_SD) - call SD_GetOP(ThisTime, T%SD%Input(InputIndex), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), T%SD%z(StateIndex), & - T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_PackContStateAry(ModData%Vars, T%AD%x(StateIndex)%rotors(ModData%Ins), x_op) + case (Module_BD) + call BD_PackContStateAry(ModData%Vars, T%BD%x(StateIndex, ModData%Ins), x_op) + case (Module_ED) + call ED_PackContStateAry(ModData%Vars, T%ED%x(StateIndex), x_op) + case (Module_ExtPtfm) + call ExtPtfm_PackContStateAry(ModData%Vars, T%ExtPtfm%x(StateIndex), x_op) + case (Module_FEAM) + call FEAM_PackContStateAry(ModData%Vars, T%FEAM%x(StateIndex), x_op) + case (Module_HD) + call HydroDyn_PackContStateAry(ModData%Vars, T%HD%x(StateIndex), x_op) + case (Module_IceD) + call IceD_PackContStateAry(ModData%Vars, T%IceD%x(StateIndex, ModData%Ins), x_op) + case (Module_IceF) + call IceFloe_PackContStateAry(ModData%Vars, T%IceF%x(StateIndex), x_op) + case (Module_IfW) + call InflowWind_PackContStateAry(ModData%Vars, T%IfW%x(StateIndex), x_op) + case (Module_MAP) + call MAP_PackContStateAry(ModData%Vars, T%MAP%x(StateIndex), x_op) + case (Module_MD) + call MD_PackContStateAry(ModData%Vars, T%MD%x(StateIndex), x_op) + case (Module_ExtInfw) + ! call ExtInfw_PackContStateAry(ModData%Vars, T%ExtInfw%x(StateIndex), x_op) + case (Module_Orca) + call Orca_PackContStateAry(ModData%Vars, T%Orca%x(StateIndex), x_op) + case (Module_SD) + call SD_PackContStateAry(ModData%Vars, T%SD%x(StateIndex), x_op) + case (Module_SeaSt) + call SeaSt_PackContStateAry(ModData%Vars, T%SeaSt%x(StateIndex), x_op) + case (Module_SrvD) + call SrvD_PackContStateAry(ModData%Vars, T%SrvD%x(StateIndex), x_op) + case default + call SetErrStat(ErrID_Fatal, "Continuous State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select - case (Module_SeaSt) - call SeaSt_GetOP(ThisTime, T%SeaSt%Input(InputIndex), T%SeaSt%p, T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), T%SeaSt%z(StateIndex), & - T%SeaSt%OtherSt(StateIndex), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! If glue array is present, transfer from module to glue + if (present(x_glue)) call MV_PackArray(ModData%Vars%x, x_op, x_glue) + end if - case (Module_SrvD) - call SrvD_GetOP(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), & - T%SrvD%OtherSt(StateIndex), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & - u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! If continuous state derivatives are requested + if (present(dx_op)) then - case default - ! Unknown module - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Unsupported module: "//trim(ModData%Abbr) - end select + if (.not. allocated(dx_op)) then + call AllocAry(dx_op, ModData%Vars%Nx, "dx_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if - ! Check for errors during calc output call - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call RotCalcContStateDeriv(ThisTime, T%AD%Input(InputIndex)%rotors(ModData%Ins), & + T%AD%m%Inflow(InputIndex)%RotInflow(ModData%Ins), & + T%AD%p%rotors(ModData%Ins), & + T%AD%p, T%AD%x(StateIndex)%rotors(ModData%Ins), & + T%AD%xd(StateIndex)%rotors(ModData%Ins), & + T%AD%z(StateIndex)%rotors(ModData%Ins), & + T%AD%OtherSt(StateIndex)%rotors(ModData%Ins), & + T%AD%m%rotors(ModData%Ins), & + T%AD%m%rotors(ModData%Ins)%dxdt_lin, & + ErrStat2, ErrMsg2); if (Failed()) return + call AD_PackContStateAry(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) + case (Module_BD) + call BD_CalcContStateDeriv(ThisTime, T%BD%Input(InputIndex, ModData%Ins), & + T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, StateIndex), & + T%BD%xd(ModData%Ins, StateIndex), & + T%BD%z(ModData%Ins, StateIndex), & + T%BD%OtherSt(ModData%Ins, StateIndex), & + T%BD%m(ModData%Ins), & + T%BD%m(ModData%Ins)%dxdt_lin, & + ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackContStateAry(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) + case (Module_ED) + call ED_CalcContStateDeriv(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), & + T%ED%xd(StateIndex), T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), & + T%ED%m, T%ED%m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackContStateAry(ModData%Vars, T%ED%m%dxdt_lin, dx_op) +! case (Module_ExtPtfm) +! call ExtPtfm_CalcContStatExtPtfmeriv(ThisTime, T%ExtPtfm%Input(InputIndex), & +! T%ExtPtfm%p, T%ExtPtfm%x(StateIndex), & +! T%ExtPtfm%xd(StateIndex), T%ExtPtfm%z(StateIndex), & +! T%ExtPtfm%OtherSt(StateIndex), & +! T%ExtPtfm%m, T%ExtPtfm%m%dxdt_lin, & +! ErrStat2, ErrMsg2); if (Failed()) return +! call ExtPtfm_PackContStateAry(ModData%Vars, T%ExtPtfm%m%dxdt_lin, dx_op) +! case (Module_FEAM) +! call FEAM_PackContStateAry(ModData%Vars, T%FEAM%x(StateIndex), dx_op) + case (Module_HD) + call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), & + T%HD%xd(StateIndex), T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), & + T%HD%m, T%HD%m%dxdt_lin, ErrStat2, ErrMsg2) + call HydroDyn_PackContStateAry(ModData%Vars, T%HD%x(StateIndex), dx_op) +! case (Module_IceD) +! call IceD_CalcContStateDeriv(ThisTime, T%IceD%Input(InputIndex), T%IceD%p, T%IceD%x(StateIndex), & +! T%IceD%xd(StateIndex), T%IceD%z(StateIndex), T%IceD%OtherSt(StateIndex), & +! T%IceD%m, T%IceD%m%dxdt_lin, ErrStat2, ErrMsg2) +! call IceD_PackContStateAry(ModData%Vars, T%IceD%m%dxdt_lin, dx_op) +! case (Module_IceF) +! call IceFloe_PackContStateAry(ModData%Vars, T%IceF%x(StateIndex), dx_op) + case (Module_IfW) + call InflowWind_PackContStateAry(ModData%Vars, T%IfW%x(StateIndex), dx_op) + case (Module_MAP) + call MAP_PackContStateAry(ModData%Vars, T%MAP%x(StateIndex), dx_op) + case (Module_MD) + call MD_PackContStateAry(ModData%Vars, T%MD%x(StateIndex), dx_op) + case (Module_ExtInfw) + ! call ExtInfw_PackContStateAry(ModData%Vars, T%ExtInfw%x(StateIndex), dx_op) + case (Module_Orca) + call Orca_PackContStateAry(ModData%Vars, T%Orca%x(StateIndex), dx_op) + case (Module_SD) + call SD_PackContStateAry(ModData%Vars, T%SD%x(StateIndex), dx_op) + case (Module_SeaSt) + call SeaSt_PackContStateAry(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) + case (Module_SrvD) + call SrvD_PackContStateAry(ModData%Vars, T%SrvD%x(StateIndex), dx_op) + case default + call SetErrStat(ErrID_Fatal, "Continuous State Derivatives unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + ! If glue array is present, transfer from module to glue + if (present(dx_glue)) call MV_PackArray(ModData%Vars%x, dx_op, dx_glue) + end if + ! If constraint states are requested + if (present(z_op)) then + + if (.not. allocated(z_op)) then + call AllocAry(z_op, ModData%Vars%Nz, "z_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_PackContStateAry(ModData%Vars, T%AD%x(StateIndex)%rotors(ModData%Ins), z_op) + case (Module_BD) + call BD_PackContStateAry(ModData%Vars, T%BD%x(StateIndex, ModData%Ins), z_op) + case (Module_ED) + call ED_PackContStateAry(ModData%Vars, T%ED%x(StateIndex), z_op) + case (Module_ExtPtfm) + call ExtPtfm_PackContStateAry(ModData%Vars, T%ExtPtfm%x(StateIndex), z_op) + case (Module_FEAM) + call FEAM_PackContStateAry(ModData%Vars, T%FEAM%x(StateIndex), z_op) + case (Module_HD) + call HydroDyn_PackContStateAry(ModData%Vars, T%HD%x(StateIndex), z_op) + case (Module_IceD) + call IceD_PackContStateAry(ModData%Vars, T%IceD%x(StateIndex, ModData%Ins), z_op) + case (Module_IceF) + call IceFloe_PackContStateAry(ModData%Vars, T%IceF%x(StateIndex), z_op) + case (Module_IfW) + call InflowWind_PackContStateAry(ModData%Vars, T%IfW%x(StateIndex), z_op) + case (Module_MAP) + call MAP_PackContStateAry(ModData%Vars, T%MAP%x(StateIndex), z_op) + case (Module_MD) + call MD_PackContStateAry(ModData%Vars, T%MD%x(StateIndex), z_op) + case (Module_ExtInfw) + ! call ExtInfw_PackContStateAry(ModData%Vars, T%ExtInfw%x(StateIndex), z_op) + case (Module_Orca) + call Orca_PackContStateAry(ModData%Vars, T%Orca%x(StateIndex), z_op) + case (Module_SD) + call SD_PackContStateAry(ModData%Vars, T%SD%x(StateIndex), z_op) + case (Module_SeaSt) + call SeaSt_PackContStateAry(ModData%Vars, T%SeaSt%x(StateIndex), z_op) + case (Module_SrvD) + call SrvD_PackContStateAry(ModData%Vars, T%SrvD%x(StateIndex), z_op) + case default + call SetErrStat(ErrID_Fatal, "Constraint State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + ! If glue array is present, transfer from module to glue + if (present(z_glue)) call MV_PackArray(ModData%Vars%z, z_op, z_glue) + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function end subroutine -subroutine FAST_SetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, & - FlagFilter, u_op, x_op, xd_op, z_op) - type(ModDataType), intent(in) :: ModData !< Module data - real(DbKi), intent(in) :: ThisTime !< Time +subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & + u_op, y_op, x_op, z_op, u_glue, y_glue, x_glue, z_glue) + type(ModDataType), intent(in) :: ModData !< Module information integer(IntKi), intent(in) :: InputIndex !< Input index integer(IntKi), intent(in) :: StateIndex !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - integer(IntKi), optional, intent(in) :: FlagFilter !< Flag to filter variables - real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs - real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states - real(R8Ki), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states - real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states + real(R8Ki), allocatable, optional, intent(inout) :: u_op(:), u_glue(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(inout) :: y_op(:), y_glue(:) !< values of linearized outputs + real(R8Ki), allocatable, optional, intent(inout) :: x_op(:), x_glue(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: z_op(:), z_glue(:) !< values of linearized constraint states character(*), parameter :: RoutineName = 'FAST_SetOP' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i ErrStat = ErrID_None ErrMsg = '' - ErrStat2 = ErrID_None - ErrMsg2 = "" - ! Select based on module ID - select case (ModData%ID) + ! If inputs are requested + if (present(u_op)) then - case (Module_AD) - call AD_SetOP(ModData%Ins, T%AD%Input(InputIndex), T%AD%p, T%AD%x(StateIndex), & - T%AD%xd(StateIndex), T%AD%z(StateIndex), ErrStat2, ErrMsg2, & - u_op=u_op, x_op=x_op, xd_op=xd_op, z_op=z_op) + ! If glue array is present, transfer from module to glue + if (present(u_glue)) call MV_UnpackArray(ModData%Vars%u, u_glue, u_op) -! case (Module_BD) - ! call BD_SetOP(ThisTime, T%BD%Input(InputIndex, ModData%Ins), T%BD%p(ModData%Ins), & - ! T%BD%x(ModData%Ins, StateIndex), T%BD%xd(ModData%Ins, StateIndex), & - ! T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & - ! T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - ! u_op=u_op, x_op=x_op) + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_UnpackInputAry(ModData%Vars, u_op, T%AD%Input(InputIndex)%rotors(ModData%Ins)) + case (Module_BD) + call BD_UnpackInputAry(ModData%Vars, u_op, T%BD%Input(InputIndex, ModData%Ins)) + case (Module_ED) + call ED_UnpackInputAry(ModData%Vars, u_op, T%ED%Input(InputIndex)) + case (Module_ExtPtfm) + call ExtPtfm_UnpackInputAry(ModData%Vars, u_op, T%ExtPtfm%Input(InputIndex)) + case (Module_FEAM) + call FEAM_UnpackInputAry(ModData%Vars, u_op, T%FEAM%Input(InputIndex)) + case (Module_HD) + call HydroDyn_UnpackInputAry(ModData%Vars, u_op, T%HD%Input(InputIndex)) + case (Module_IceD) + call IceD_UnpackInputAry(ModData%Vars, u_op, T%IceD%Input(InputIndex, ModData%Ins)) + case (Module_IceF) + call IceFloe_UnpackInputAry(ModData%Vars, u_op, T%IceF%Input(InputIndex)) + case (Module_IfW) + call InflowWind_UnpackInputAry(ModData%Vars, u_op, T%IfW%Input(InputIndex)) + case (Module_MAP) + call MAP_UnpackInputAry(ModData%Vars, u_op, T%MAP%Input(InputIndex)) + case (Module_MD) + call MD_UnpackInputAry(ModData%Vars, u_op, T%MD%Input(InputIndex)) + case (Module_ExtInfw) + ! call ExtInfw_UnpackInputAry(ModData%Vu_op, ars, T%ExtInfw%Input(InputIndex)) + case (Module_Orca) + call Orca_UnpackInputAry(ModData%Vars, u_op, T%Orca%Input(InputIndex)) + case (Module_SD) + call SD_UnpackInputAry(ModData%Vars, u_op, T%SD%Input(InputIndex)) + case (Module_SeaSt) + call SeaSt_UnpackInputAry(ModData%Vars, u_op, T%SeaSt%Input(InputIndex)) + case (Module_SrvD) + call SrvD_UnpackInputAry(ModData%Vars, u_op, T%SrvD%Input(InputIndex)) + case default + call SetErrStat(ErrID_Fatal, "Input unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select - case (Module_ED) - call ED_SetOP(T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & - T%ED%z(StateIndex), u_op=u_op, x_op=x_op, xd_op=xd_op, z_op=z_op) + end if -! case (Module_ExtPtfm) + ! If outputs are requested + if (present(y_op)) then -! case (Module_FEAM) + ! If glue array is present, transfer from module to glue + if (present(y_glue)) call MV_UnpackArray(ModData%Vars%y, y_glue, y_op) -! case (Module_HD) - ! call HD_SetOP(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & - ! T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_UnpackOutputAry(ModData%Vars, y_op, T%AD%y%rotors(ModData%Ins)) + case (Module_BD) + call BD_UnpackOutputAry(ModData%Vars, y_op, T%BD%y(ModData%Ins)) + case (Module_ED) + call ED_UnpackOutputAry(ModData%Vars, y_op, T%ED%y) + case (Module_ExtPtfm) + call ExtPtfm_UnpackOutputAry(ModData%Vars, y_op, T%ExtPtfm%y) + case (Module_FEAM) + call FEAM_UnpackOutputAry(ModData%Vars, y_op, T%FEAM%y) + case (Module_HD) + call HydroDyn_UnpackOutputAry(ModData%Vars, y_op, T%HD%y) + case (Module_IceD) + call IceD_UnpackOutputAry(ModData%Vars, y_op, T%IceD%y(ModData%Ins)) + case (Module_IceF) + call IceFloe_UnpackOutputAry(ModData%Vars, y_op, T%IceF%y) + case (Module_IfW) + call InflowWind_UnpackOutputAry(ModData%Vars, y_op, T%IfW%y) + case (Module_MAP) + call MAP_UnpackOutputAry(ModData%Vars, y_op, T%MAP%y) + case (Module_MD) + call MD_UnpackOutputAry(ModData%Vars, y_op, T%MD%y) + case (Module_ExtInfw) + call ExtInfw_UnpackOutputAry(ModData%Vars, y_op, T%ExtInfw%y) + case (Module_Orca) + call Orca_UnpackOutputAry(ModData%Vars, y_op, T%Orca%y) + case (Module_SD) + call SD_UnpackOutputAry(ModData%Vars, y_op, T%SD%y) + case (Module_SeaSt) + call SeaSt_UnpackOutputAry(ModData%Vars, y_op, T%SeaSt%y) + case (Module_SrvD) + call SrvD_UnpackOutputAry(ModData%Vars, y_op, T%SrvD%y) + case default + call SetErrStat(ErrID_Fatal, "Output unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select -! case (Module_IceD) -! case (Module_IceF) -! case (Module_IfW) - ! call InflowWind_SetOP(ThisTime, T%IfW%Input(InputIndex), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), T%IfW%z(StateIndex), & - ! T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & - ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + end if -! case (Module_MAP) - ! call MAP_SetOP(ThisTime, T%MAP%Input(InputIndex), T%MAP%p, T%MAP%x(StateIndex), T%MAP%xd(StateIndex), T%MAP%z(StateIndex), & - ! T%MAP%OtherSt, T%MAP%y, ErrStat2, ErrMsg2, & - ! u_op=u_op, y_op=y_op) !, x_op=x_op, dx_op=dx_op) MAP doesn't have states + ! If continuous states are requested + if (present(x_op)) then -! case (Module_MD) - ! call MD_SetOP(ThisTime, T%MD%Input(InputIndex), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), T%MD%z(StateIndex), & - ! T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & - ! FlagFilter=FlagFilter, u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! If glue array is present, transfer from module to glue + if (present(x_glue)) call MV_UnpackArray(ModData%Vars%x, x_glue, x_op) -! case (Module_OpFM) -! case (Module_Orca) -! case (Module_SD) - ! call SD_SetOP(ThisTime, T%SD%Input(InputIndex), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), T%SD%z(StateIndex), & - ! T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_UnpackContStateAry(ModData%Vars, x_op, T%AD%x(StateIndex)%rotors(ModData%Ins)) + case (Module_BD) + call BD_UnpackContStateAry(ModData%Vars, x_op, T%BD%x(StateIndex, ModData%Ins)) + case (Module_ED) + call ED_UnpackContStateAry(ModData%Vars, x_op, T%ED%x(StateIndex)) + case (Module_ExtPtfm) + call ExtPtfm_UnpackContStateAry(ModData%Vars, x_op, T%ExtPtfm%x(StateIndex)) + case (Module_FEAM) + call FEAM_UnpackContStateAry(ModData%Vars, x_op, T%FEAM%x(StateIndex)) + case (Module_HD) + call HydroDyn_UnpackContStateAry(ModData%Vars, x_op, T%HD%x(StateIndex)) + case (Module_IceD) + call IceD_UnpackContStateAry(ModData%Vars, x_op, T%IceD%x(StateIndex, ModData%Ins)) + case (Module_IceF) + call IceFloe_UnpackContStateAry(ModData%Vars, x_op, T%IceF%x(StateIndex)) + case (Module_IfW) + call InflowWind_UnpackContStateAry(ModData%Vars, x_op, T%IfW%x(StateIndex)) + case (Module_MAP) + call MAP_UnpackContStateAry(ModData%Vars, x_op, T%MAP%x(StateIndex)) + case (Module_MD) + call MD_UnpackContStateAry(ModData%Vars, x_op, T%MD%x(StateIndex)) + case (Module_ExtInfw) + ! call ExtInfw_UnpackContStateAry(ModData%Varsx_op,, T%ExtInfw%x(StateIndex)) + case (Module_Orca) + call Orca_UnpackContStateAry(ModData%Vars, x_op, T%Orca%x(StateIndex)) + case (Module_SD) + call SD_UnpackContStateAry(ModData%Vars, x_op, T%SD%x(StateIndex)) + case (Module_SeaSt) + call SeaSt_UnpackContStateAry(ModData%Vars, x_op, T%SeaSt%x(StateIndex)) + case (Module_SrvD) + call SrvD_UnpackContStateAry(ModData%Vars, x_op, T%SrvD%x(StateIndex)) + case default + call SetErrStat(ErrID_Fatal, "Continuous State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select -! case (Module_SeaSt) - ! call SeaSt_SetOP(ThisTime, T%SeaSt%Input(InputIndex), T%SeaSt%p, T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), T%SeaSt%z(StateIndex), & - ! T%SeaSt%OtherSt(StateIndex), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + end if -! case (Module_SrvD) - ! call SrvD_SetOP(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), & - ! T%SrvD%OtherSt(StateIndex), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & - ! u_op=u_op, y_op=y_op, x_op=x_op, dx_op=dx_op) + ! If constraint states are requested + if (present(z_op)) then - case default - ! Unknown module - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Unsupported module: "//trim(ModData%Abbr) - end select + ! If glue array is present, transfer from module to glue + if (present(z_glue)) call MV_UnpackArray(ModData%Vars%z, z_glue, z_op) - ! Check for errors during calc output call - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_UnpackContStateAry(ModData%Vars, z_op, T%AD%x(StateIndex)%rotors(ModData%Ins)) + case (Module_BD) + call BD_UnpackContStateAry(ModData%Vars, z_op, T%BD%x(StateIndex, ModData%Ins)) + case (Module_ED) + call ED_UnpackContStateAry(ModData%Vars, z_op, T%ED%x(StateIndex)) + case (Module_ExtPtfm) + call ExtPtfm_UnpackContStateAry(ModData%Vars, z_op, T%ExtPtfm%x(StateIndex)) + case (Module_FEAM) + call FEAM_UnpackContStateAry(ModData%Vars, z_op, T%FEAM%x(StateIndex)) + case (Module_HD) + call HydroDyn_UnpackContStateAry(ModData%Vars, z_op, T%HD%x(StateIndex)) + case (Module_IceD) + call IceD_UnpackContStateAry(ModData%Vars, z_op, T%IceD%x(StateIndex, ModData%Ins)) + case (Module_IceF) + call IceFloe_UnpackContStateAry(ModData%Vars, z_op, T%IceF%x(StateIndex)) + case (Module_IfW) + call InflowWind_UnpackContStateAry(ModData%Vars, z_op, T%IfW%x(StateIndex)) + case (Module_MAP) + call MAP_UnpackContStateAry(ModData%Vars, z_op, T%MAP%x(StateIndex)) + case (Module_MD) + call MD_UnpackContStateAry(ModData%Vars, z_op, T%MD%x(StateIndex)) + case (Module_ExtInfw) + ! call ExtInfw_UnpackContStateAry(ModData%z_op,Vars, T%ExtInfw%x(StateIndex)) + case (Module_Orca) + call Orca_UnpackContStateAry(ModData%Vars, z_op, T%Orca%x(StateIndex)) + case (Module_SD) + call SD_UnpackContStateAry(ModData%Vars, z_op, T%SD%x(StateIndex)) + case (Module_SeaSt) + call SeaSt_UnpackContStateAry(ModData%Vars, z_op, T%SeaSt%x(StateIndex)) + case (Module_SrvD) + call SrvD_UnpackContStateAry(ModData%Vars, z_op, T%SrvD%x(StateIndex)) + case default + call SetErrStat(ErrID_Fatal, "Constraint State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function end subroutine -subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, Vars, dYdu, dXdu) - type(ModDataType), intent(in) :: ModData !< Module data +subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdu, dXdu, dYduGlue, dXduGlue) + type(ModDataType), intent(in) :: ModData !< Module information real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: ThisState !< State + integer(IntKi), intent(in) :: StateIndex !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - type(ModVarsType), optional, intent(in) :: Vars !< Variables - real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :) - real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :), dYduGlue(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:, :), dXduGlue(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPInput' integer(IntKi) :: ErrStat2 @@ -736,79 +1077,84 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, select case (ModData%ID) case (Module_AD) - call AD_JacobianPInput(ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(ThisState), T%AD%xd(ThisState), & - T%AD%z(ThisState), T%AD%OtherSt(ThisState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & - Vars=Vars, dYdu=dYdu, dXdu=dXdu) + call AD_JacobianPInput(ModData%Vars, ModData%Ins, ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(StateIndex), T%AD%xd(StateIndex), & + T%AD%z(StateIndex), T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) - case (Module_BD) - call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & - T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & - T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & - T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - Vars=Vars, dYdu=dYdu, dXdu=dXdu) + ! case (Module_BD) + ! call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%ModIns), T%BD%p(ModData%ModIns), & + ! T%BD%x(ModData%ModIns, StateIndex), T%BD%xd(ModData%ModIns, StateIndex), & + ! T%BD%z(ModData%ModIns, StateIndex), T%BD%OtherSt(ModData%ModIns, StateIndex), & + ! T%BD%y(ModData%ModIns), T%BD%m(ModData%ModIns), ErrStat2, ErrMsg2, & + ! dYdu=dYdu, dXdu=dXdu) case (Module_ED) - call ED_JacobianPInput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & - T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - Vars=Vars, dYdu=dYdu, dXdu=dXdu) + call ED_JacobianPInput(ModData%Vars, ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & + T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) ! case (Module_ExtPtfm) - case (Module_HD) - call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & - T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - dYdu=dYdu, dXdu=dXdu) + ! case (Module_HD) + ! call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & + ! T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + ! dYdu=dYdu, dXdu=dXdu) case (Module_IfW) - call InflowWind_JacobianPInput(ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(ThisState), T%IfW%xd(ThisState), & - T%IfW%z(ThisState), T%IfW%OtherSt(ThisState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + call InflowWind_JacobianPInput(ModData%Vars, ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), & + T%IfW%z(StateIndex), T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) - case (Module_MAP) - call MAP_JacobianPInput(ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(ThisState), T%MAP%xd(ThisState), & - T%MAP%z(ThisState), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & - dYdu=dYdu, dXdu=dXdu) + ! case (Module_MAP) + ! call MAP_JacobianPInput(ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(StateIndex), T%MAP%xd(StateIndex), & + ! T%MAP%z(StateIndex), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & + ! dYdu=dYdu, dXdu=dXdu) - case (Module_MD) - call MD_JacobianPInput(ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(ThisState), T%MD%xd(ThisState), & - T%MD%z(ThisState), T%MD%OtherSt(ThisState), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & - dYdu=dYdu, dXdu=dXdu) + ! case (Module_MD) + ! call MD_JacobianPInput(ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), & + ! T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + ! dYdu=dYdu, dXdu=dXdu) - case (Module_SD) - call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & - T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - dYdu=dYdu, dXdu=dXdu) + ! case (Module_SD) + ! call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), & + ! T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + ! dYdu=dYdu, dXdu=dXdu) - case (Module_SeaSt) - call SeaSt_JacobianPInput(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), & - T%SeaSt%z(ThisState), T%SeaSt%OtherSt(ThisState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - dYdu=dYdu, dXdu=dXdu) + ! case (Module_SeaSt) + ! call SeaSt_JacobianPInput(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), & + ! T%SeaSt%z(StateIndex), T%SeaSt%OtherSt(StateIndex), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + ! dYdu=dYdu, dXdu=dXdu) case (Module_SrvD) - call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & - T%SrvD%z(ThisState), T%SrvD%OtherSt(ThisState), T%SrvD%y, T%SrvD%m, & + call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), & + T%SrvD%z(StateIndex), T%SrvD%OtherSt(StateIndex), T%SrvD%y, T%SrvD%m, & ErrStat2, ErrMsg2, dYdu=dYdu, dXdu=dXdu) case default ErrStat2 = ErrID_Fatal - ErrMsg2 = "Unsupported module: "//ModData%Abbr + ErrMsg2 = "Unsupported module ID: "//ModData%Abbr end select call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! If dYdu and dYduGlue are present, transfer from module matrix to glue matrix + if (present(dYdu) .and. present(dYduGlue)) call MV_PackMatrix(ModData%Vars%y, ModData%Vars%u, dYdu, dYduGlue) + + ! If dXdu and dXduGlue are present, transfer from module matrix to glue matrix + if (present(dXdu) .and. present(dXduGlue)) call MV_PackMatrix(ModData%Vars%x, ModData%Vars%u, dXdu, dXduGlue) end subroutine -subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, Vars, dYdx, dXdx, StateRotation) - type(ModDataType), intent(in) :: ModData !< Module data +subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdx, dXdx, dYdxGlue, dXdxGlue) + type(ModDataType), intent(in) :: ModData !< Module info real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: ThisState !< State + integer(IntKi), intent(in) :: StateIndex !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - type(ModVarsType), optional, intent(in) :: Vars !< Variables - real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :) - real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:, :) - real(R8Ki), allocatable, optional, intent(inout) :: StateRotation(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dYdxGlue(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:, :), dXdxGlue(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPContState' integer(IntKi) :: ErrStat2 @@ -821,39 +1167,39 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err select case (ModData%ID) case (Module_AD) - call AD_JacobianPContState(ThisTime, T%AD%Input(1), T%AD%p, & - T%AD%x(ThisState), T%AD%xd(ThisState), & - T%AD%z(ThisState), T%AD%OtherSt(ThisState), & + call AD_JacobianPContState(ModData%Vars, ModData%Ins, ThisTime, T%AD%Input(1), T%AD%p, & + T%AD%x(StateIndex), T%AD%xd(StateIndex), & + T%AD%z(StateIndex), T%AD%OtherSt(StateIndex), & T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & - Vars=Vars, dYdx=dYdx, dXdx=dXdx) + dYdx=dYdx, dXdx=dXdx) - case (Module_BD) - call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & - T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & - T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & - T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - Vars=Vars, dYdx=dYdx, dXdx=dXdx, StateRotation=StateRotation) + ! case (Module_BD) + ! call BD_JacobianPContState(Vars, ThisTime, T%BD%Input(1, ModData%ModIns), T%BD%p(ModData%ModIns), & + ! T%BD%x(ModData%ModIns, StateIndex), T%BD%xd(ModData%ModIns, StateIndex), & + ! T%BD%z(ModData%ModIns, StateIndex), T%BD%OtherSt(ModData%ModIns, StateIndex), & + ! T%BD%y(ModData%ModIns), T%BD%m(ModData%ModIns), ErrStat2, ErrMsg2, & + ! dYdx=dYdx, dXdx=dXdx, StateRotation=ModData%Lin%StateRotation) case (Module_ED) - call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & - T%ED%x(ThisState), T%ED%xd(ThisState), & - T%ED%z(ThisState), T%ED%OtherSt(ThisState), & + call ED_JacobianPContState(ModData%Vars, ThisTime, T%ED%Input(1), T%ED%p, & + T%ED%x(StateIndex), T%ED%xd(StateIndex), & + T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), & T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - Vars=Vars, dYdx=dYdx, dXdx=dXdx) + dYdx=dYdx, dXdx=dXdx) ! case (Module_ExtPtfm) - case (Module_HD) - call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & - T%HD%x(ThisState), T%HD%xd(ThisState), & - T%HD%z(ThisState), T%HD%OtherSt(ThisState), & - T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - dYdx=dYdx, dXdx=dXdx) + ! case (Module_HD) + ! call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & + ! T%HD%x(StateIndex), T%HD%xd(StateIndex), & + ! T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), & + ! T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + ! dYdx=dYdx, dXdx=dXdx) case (Module_IfW) call InflowWind_JacobianPContState(ThisTime, T%IfW%Input(1), T%IfW%p, & - T%IfW%x(ThisState), T%IfW%xd(ThisState), & - T%IfW%z(ThisState), T%IfW%OtherSt(ThisState), & + T%IfW%x(StateIndex), T%IfW%xd(StateIndex), & + T%IfW%z(StateIndex), T%IfW%OtherSt(StateIndex), & T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) @@ -862,40 +1208,47 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, T, ErrStat, Err ErrStat2 = ErrID_None ErrMsg2 = '' - case (Module_MD) - call MD_JacobianPContState(ThisTime, T%MD%Input(1), T%MD%p, & - T%MD%x(ThisState), T%MD%xd(ThisState), & - T%MD%z(ThisState), T%MD%OtherSt(ThisState), & - T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & - dYdx=dYdx, dXdx=dXdx) - - case (Module_SD) - call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & - T%SD%x(ThisState), T%SD%xd(ThisState), & - T%SD%z(ThisState), T%SD%OtherSt(ThisState), & - T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - dYdx=dYdx, dXdx=dXdx) - - case (Module_SeaSt) - call SeaSt_JacobianPContState(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, & - T%SeaSt%x(ThisState), T%SeaSt%xd(ThisState), & - T%SeaSt%z(ThisState), T%SeaSt%OtherSt(ThisState), & - T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - dYdx=dYdx, dXdx=dXdx) + ! case (Module_MD) + ! call MD_JacobianPContState(ThisTime, T%MD%Input(1), T%MD%p, & + ! T%MD%x(StateIndex), T%MD%xd(StateIndex), & + ! T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), & + ! T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + ! dYdx=dYdx, dXdx=dXdx) + + ! case (Module_SD) + ! call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & + ! T%SD%x(StateIndex), T%SD%xd(StateIndex), & + ! T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), & + ! T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + ! dYdx=dYdx, dXdx=dXdx) + + ! case (Module_SeaSt) + ! call SeaSt_JacobianPContState(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, & + ! T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), & + ! T%SeaSt%z(StateIndex), T%SeaSt%OtherSt(StateIndex), & + ! T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + ! dYdx=dYdx, dXdx=dXdx) case (Module_SrvD) call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(1), T%SrvD%p, & - T%SrvD%x(ThisState), T%SrvD%xd(ThisState), & - T%SrvD%z(ThisState), T%SrvD%OtherSt(ThisState), & + T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), & + T%SrvD%z(StateIndex), T%SrvD%OtherSt(StateIndex), & T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) case default ErrStat2 = ErrID_Fatal - ErrMsg2 = "Unsupported module: "//ModData%Abbr + ErrMsg2 = "Unsupported module ID: "//ModData%Abbr end select call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! If dYdx and dYdxGlue are present, transfer from module matrix to glue matrix + if (present(dYdx) .and. present(dYdxGlue)) call MV_PackMatrix(ModData%Vars%y, ModData%Vars%x, dYdx, dYdxGlue) + + ! If dXdx and dXdxGlue are present, transfer from module matrix to glue matrix + if (present(dXdx) .and. present(dXdxGlue)) call MV_PackMatrix(ModData%Vars%x, ModData%Vars%x, dXdx, dXdxGlue) end subroutine @@ -1052,7 +1405,7 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) call SrvD_CopyOtherState(T%SrvD%OtherSt(Src), T%SrvD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(ModData%Abbr), ErrStat, ErrMsg, RoutineName) return end select diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 48143c27ef..9368cdf96a 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -22,7 +22,6 @@ module FAST_Mapping use FAST_Types use FAST_ModTypes -use FAST_ModData implicit none @@ -452,8 +451,8 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) DstMod => Mods(Mappings(iMap)%iModDst)) ! Add mapping index to sorce and destination module mapping arrays - SrcMod%SrcMaps = [SrcMod%SrcMaps, iMap] - DstMod%DstMaps = [DstMod%DstMaps, iMap] + SrcMod%iSrcMaps = [SrcMod%iSrcMaps, iMap] + DstMod%iDstMaps = [DstMod%iDstMaps, iMap] write (*, *) "Mapping: ", Mappings(iMap)%Desc @@ -492,8 +491,8 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_BD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion - DstMeshLoc=DatLoc(AD_u_BladeMotion, SrcMod%Ins), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(SrcMod%Ins) + SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstDL=DatLoc(AD_u_BladeMotion, SrcMod%Ins), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(SrcMod%Ins) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps .or. (SrcMod%Ins == 1)) if (Failed()) return @@ -503,8 +502,8 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) if (Turbine%p_FAST%CompElast == Module_ED) then do i = 1, size(Turbine%ED%y%BladeLn2Mesh) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - DstMeshLoc=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) + SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps .or. (i == 1)) if (Failed()) return @@ -512,38 +511,38 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) end if call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - DstMeshLoc=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion + SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return do i = 1, size(Turbine%ED%y%BladeRootMotion) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) - DstMeshLoc=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) + SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstDL=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return end do call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - DstMeshLoc=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion + SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstMeshLoc=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion + SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion - DstMeshLoc=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(DstMod%Ins)%TFinMotion + SrcDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + DstDL=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(DstMod%Ins)%TFinMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -552,22 +551,22 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapVariable(Mappings, "IfW HWindSpeed -> AD HWindSpeed", & SrcMod=SrcMod, DstMod=DstMod, & - iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, InflowWind_y_HWindSpeed), & - iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, AD_u_HWindSpeed), & + SrcDL=DatLoc(InflowWind_y_HWindSpeed), & + DstDL=DatLoc(AD_u_HWindSpeed), & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return call MapVariable(Mappings, "IfW PLExp -> AD PLExp", & SrcMod=SrcMod, DstMod=DstMod, & - iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, InflowWind_y_PLExp), & - iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, AD_u_PLExp), & + SrcDL=DatLoc(InflowWind_y_PLExp), & + DstDL=DatLoc(AD_u_PLExp), & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return call MapVariable(Mappings, "IfW PropagationDir -> AD PropagationDir", & SrcMod=SrcMod, DstMod=DstMod, & - iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, InflowWind_y_PropagationDir), & - iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, AD_u_PropagationDir), & + SrcDL=DatLoc(InflowWind_y_PropagationDir), & + DstDL=DatLoc(AD_u_PropagationDir), & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -609,10 +608,10 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_AD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(AD_y_BladeLoad, DstMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(DstMod%Ins) - SrcDispMeshLoc=DatLoc(AD_u_BladeMotion, DstMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(DstMod%Ins) - DstMeshLoc=DatLoc(BD_u_DistrLoad), & ! BD%u(DstMod%Ins)%DistrLoad - DstDispMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + SrcDL=DatLoc(AD_y_BladeLoad, DstMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(DstMod%Ins) + SrcDispDL=DatLoc(AD_u_BladeMotion, DstMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(DstMod%Ins) + DstDL=DatLoc(BD_u_DistrLoad), & ! BD%u(DstMod%Ins)%DistrLoad + DstDispDL=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps .or. (DstMod%Ins == 1)) if (Failed()) return @@ -620,16 +619,16 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_BladeRootMotion, DstMod%Ins), & ! ED%y%BladeRootMotion(DstMod%Ins) - DstMeshLoc=DatLoc(BD_u_RootMotion), & ! BD%u(DstMod%Ins)%RootMotion + SrcDL=DatLoc(ED_y_BladeRootMotion, DstMod%Ins), & ! ED%y%BladeRootMotion(DstMod%Ins) + DstDL=DatLoc(BD_u_RootMotion), & ! BD%u(DstMod%Ins)%RootMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return ! Hub motion not used ! call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - ! SrcMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion - ! DstMeshLoc=DatLoc(BD_u_HubMotion), & ! BD%Input(1, DstMod%Ins)%HubMotion + ! SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion + ! DstDL=DatLoc(BD_u_HubMotion), & ! BD%Input(1, DstMod%Ins)%HubMotion ! ErrStat=ErrStat2, ErrMsg=ErrMsg2, & ! Active=NotCompAeroMaps) ! if (Failed()) return @@ -643,10 +642,10 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do i = 1, Turbine%SrvD%p%NumBStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SrvD_y_BStCLoadMesh, DstMod%Ins, i), & ! SrvD%y%BStCLoadMesh(DstMod%Ins, i), & - SrcDispMeshLoc=DatLoc(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(DstMod%Ins, i) - DstMeshLoc=DatLoc(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad - DstDispMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + SrcDL=DatLoc(SrvD_y_BStCLoadMesh, DstMod%Ins, i), & ! SrvD%y%BStCLoadMesh(DstMod%Ins, i), & + SrcDispDL=DatLoc(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(DstMod%Ins, i) + DstDL=DatLoc(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad + DstDispDL=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return end do @@ -686,47 +685,47 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(AD_y_BladeLoad, SrcMod%Ins, i), & ! AD%y%rotors(SrcMod%InsR)%BladeLoad(i) - SrcDispMeshLoc=DatLoc(AD_u_BladeMotion, SrcMod%Ins, i), & ! AD%u%rotors(SrcMod%InsR)%BladeMotion(i) - DstMeshLoc=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) - DstDispMeshLoc=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + SrcDL=DatLoc(AD_y_BladeLoad, SrcMod%Ins, i), & ! AD%y%rotors(SrcMod%InsR)%BladeLoad(i) + SrcDispDL=DatLoc(AD_u_BladeMotion, SrcMod%Ins, i), & ! AD%u%rotors(SrcMod%InsR)%BladeMotion(i) + DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=(Turbine%p_FAST%CompElast == Module_ED) .and. (NotCompAeroMaps .or. (i == 1))) if (Failed()) return end do call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(AD_y_HubLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%HubLoad - SrcDispMeshLoc=DatLoc(AD_u_HubMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%HubMotion - DstMeshLoc=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad - DstDispMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + SrcDL=DatLoc(AD_y_HubLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%HubLoad + SrcDispDL=DatLoc(AD_u_HubMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%HubMotion + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(AD_y_NacelleLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad - SrcDispMeshLoc=DatLoc(AD_u_NacelleMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion - DstMeshLoc=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads - DstDispMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + SrcDL=DatLoc(AD_y_NacelleLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad + SrcDispDL=DatLoc(AD_u_NacelleMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion + DstDL=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(AD_y_TFinLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad - SrcDispMeshLoc=DatLoc(AD_u_TFinMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion - DstMeshLoc=DatLoc(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads - DstDispMeshLoc=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + SrcDL=DatLoc(AD_y_TFinLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad + SrcDispDL=DatLoc(AD_u_TFinMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion + DstDL=DatLoc(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads + DstDispDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(AD_y_TowerLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad - SrcDispMeshLoc=DatLoc(AD_u_TowerMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion - DstMeshLoc=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads - DstDispMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + SrcDL=DatLoc(AD_y_TowerLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad + SrcDispDL=DatLoc(AD_u_TowerMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion + DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads + DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -734,10 +733,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_BD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce - SrcDispMeshLoc=DatLoc(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion - DstMeshLoc=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad - DstDispMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + SrcDL=DatLoc(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce + SrcDispDL=DatLoc(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -750,10 +749,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ExtPtfm) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh - SrcDispMeshLoc=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh + SrcDispDL=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -761,10 +760,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_FEAM) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & - SrcDispMeshLoc=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & + SrcDispDL=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -773,20 +772,20 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh - SrcDispMeshLoc=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub == Module_None, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh - SrcDispMeshLoc=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub == Module_None, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -795,10 +794,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(IceD_y_PointMesh), & ! IceD%y%PointMesh - SrcDispMeshLoc=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(IceD_y_PointMesh), & ! IceD%y%PointMesh + SrcDispDL=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -807,10 +806,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh - SrcDispMeshLoc=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh + SrcDispDL=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -819,10 +818,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad - SrcDispMeshLoc=DatLoc(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispDL=DatLoc(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -831,10 +830,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) - SrcDispMeshLoc=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispDL=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -843,10 +842,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Platform loads (SubDyn not active) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh - SrcDispMeshLoc=DatLoc(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh + SrcDispDL=DatLoc(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -854,38 +853,38 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_SD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & - SrcDispMeshLoc=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & + SrcDispDL=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return case (Module_SrvD) call MapVariable(Mappings, "SrvD BlPitchCom -> ED BlPitchCom", & - SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, SrvD_y_BlPitchCom), & - DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, ED_u_BlPitchCom), & + SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_BlPitchCom), & + DstMod=DstMod, DstDL=DatLoc(ED_u_BlPitchCom), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "SrvD YawMom -> ED YawMom", & - SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, SrvD_y_YawMom), & - DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, ED_u_YawMom), & + SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_YawMom), & + DstMod=DstMod, DstDL=DatLoc(ED_u_YawMom), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "SrvD GenTrq -> ED GenTrq", & - SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, SrvD_y_GenTrq), & - DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, ED_u_GenTrq), & + SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_GenTrq), & + DstMod=DstMod, DstDL=DatLoc(ED_u_GenTrq), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Blade Structural Controller (if ElastoDyn is used for blades) do j = 1, Turbine%SrvD%p%NumBStC do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & - SrcDispMeshLoc=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) - DstMeshLoc=DatLoc(ED_u_BladePtLoads, j), & ! ED%u%BladePtLoads(j) - DstDispMeshLoc=DatLoc(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + SrcDL=DatLoc(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & + SrcDispDL=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + DstDL=DatLoc(ED_u_BladePtLoads, j), & ! ED%u%BladePtLoads(j) + DstDispDL=DatLoc(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -895,10 +894,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Nacelle Structural Controller do j = 1, Turbine%SrvD%p%NumNStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & - SrcDispMeshLoc=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) - DstMeshLoc=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads - DstDispMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + SrcDL=DatLoc(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & + SrcDispDL=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + DstDL=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return end do @@ -906,10 +905,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Tower Structural Controller do j = 1, Turbine%SrvD%p%NumTStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & - SrcDispMeshLoc=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) - DstMeshLoc=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerLoads - DstDispMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + SrcDL=DatLoc(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & + SrcDispDL=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerLoads + DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return end do @@ -917,10 +916,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & - SrcDispMeshLoc=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - DstMeshLoc=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh - DstDispMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + SrcDL=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -962,8 +961,8 @@ subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg case (Module_BD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion - DstMeshLoc=DatLoc(ExtLd_u_BladeMotion, SrcMod%Ins), & ! ExtLd%u%BladeMotion(SrcMod%Ins) + SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstDL=DatLoc(ExtLd_u_BladeMotion, SrcMod%Ins), & ! ExtLd%u%BladeMotion(SrcMod%Ins) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_ED) @@ -972,32 +971,32 @@ subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - DstMeshLoc=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) + SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) - DstMeshLoc=DatLoc(ExtLd_u_BladeRootMotion, i), & ! ExtLd%u%BladeRootMotion(i) + SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstDL=DatLoc(ExtLd_u_BladeRootMotion, i), & ! ExtLd%u%BladeRootMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - DstMeshLoc=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion + SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstDL=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - DstMeshLoc=DatLoc(ExtLd_u_HubMotion), & ! ExtLd%u%HubMotion + SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstDL=DatLoc(ExtLd_u_HubMotion), & ! ExtLd%u%HubMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstMeshLoc=DatLoc(ExtLd_u_NacelleMotion), & ! ExtLd%u%NacelleMotion + SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstDL=DatLoc(ExtLd_u_NacelleMotion), & ! ExtLd%u%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1030,16 +1029,16 @@ subroutine InitMappings_ExtPtfm(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM if (Turbine%p_FAST%CompSub /= Module_SD) then call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end if case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1071,16 +1070,16 @@ subroutine InitMappings_FEAM(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1125,39 +1124,39 @@ subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(HydroDyn_u_PRPMesh), & ! HD%u%PRPMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(HydroDyn_u_PRPMesh), & ! HD%u%PRPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return case (Module_SeaSt) call MapVariable(Mappings, "SEA WaveElev0 -> HD WaveElev0", & - SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, SeaSt_y_WaveElev0), & - DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, HydroDyn_u_WaveElev0), & + SrcMod=SrcMod, SrcDL=DatLoc(SeaSt_y_WaveElev0), & + DstMod=DstMod, DstDL=DatLoc(HydroDyn_u_WaveElev0), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_Y2Mesh), & ! SD%y%Y2Mesh - DstMeshLoc=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + SrcDL=DatLoc(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_Y2Mesh), & ! SD%y%Y2Mesh - DstMeshLoc=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + SrcDL=DatLoc(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1186,16 +1185,16 @@ subroutine InitMappings_IceD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1225,16 +1224,16 @@ subroutine InitMappings_IceF(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1292,16 +1291,16 @@ subroutine InitMappings_MAP(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=DatLoc(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1332,16 +1331,16 @@ subroutine InitMappings_MD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SD) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SrvD) @@ -1375,8 +1374,8 @@ subroutine InitMappings_Orca(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1408,69 +1407,69 @@ subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_FEAM) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & - SrcDispMeshLoc=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement - DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcDL=DatLoc(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & + SrcDispDL=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_HD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh - SrcDispMeshLoc=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh - DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcDL=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh - SrcDispMeshLoc=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh - DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcDL=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_IceD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(IceD_y_PointMesh), & ! IceD%y%PointMesh - SrcDispMeshLoc=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh - DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcDL=DatLoc(IceD_y_PointMesh), & ! IceD%y%PointMesh + SrcDispDL=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_IceF) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh - SrcDispMeshLoc=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh - DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcDL=DatLoc(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh + SrcDispDL=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_MAP) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad - SrcDispMeshLoc=DatLoc(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement - DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcDL=DatLoc(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispDL=DatLoc(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_MD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) - SrcDispMeshLoc=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) - DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcDL=DatLoc(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispDL=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_SrvD) @@ -1480,10 +1479,10 @@ subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & - SrcDispMeshLoc=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) - DstMeshLoc=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + SrcDL=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1550,8 +1549,8 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Blade Structural Controller do i = 1, Turbine%SrvD%p%NumBStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(BD_y_BldMotion), & ! BD%y%BldMotion - DstMeshLoc=DatLoc(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(i, j) + SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y%BldMotion + DstDL=DatLoc(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(i, j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1560,38 +1559,38 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapCustom(Mappings, Custom_ED_to_SrvD, SrcMod, DstMod) call MapVariable(Mappings, "ED Yaw -> SrvD Yaw", & - SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, ED_y_Yaw), & - DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, SrvD_u_Yaw), & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_Yaw), & + DstMod=DstMod, DstDL=DatLoc(SrvD_u_Yaw), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED YawRate -> SrvD YawRate", & - SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, ED_y_YawRate), & - DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, SrvD_u_YawRate), & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_YawRate), & + DstMod=DstMod, DstDL=DatLoc(SrvD_u_YawRate), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & - SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, ED_y_HSS_Spd), & - DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, SrvD_u_HSS_Spd), & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HSS_Spd), & + DstMod=DstMod, DstDL=DatLoc(SrvD_u_HSS_Spd), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & - SrcMod=SrcMod, iVarSrc=MV_FindVarDatLoc(SrcMod%Vars%y, ED_y_HSS_Spd), & - DstMod=DstMod, iVarDst=MV_FindVarDatLoc(DstMod%Vars%u, SrvD_u_HSS_Spd), & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HSS_Spd), & + DstMod=DstMod, DstDL=DatLoc(SrvD_u_HSS_Spd), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Nacelle Structural Controller do j = 1, Turbine%SrvD%p%NumNStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstMeshLoc=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstDL=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do ! Tower Structural Controller do j = 1, Turbine%SrvD%p%NumTStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion - DstMeshLoc=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion + DstDL=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1599,8 +1598,8 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do j = 1, Turbine%SrvD%p%NumBStC do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - DstMeshLoc=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstDL=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1609,8 +1608,8 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller (if not using SubDyn) do j = 1, Turbine%SrvD%p%NumSStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstMeshLoc=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1624,8 +1623,8 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcMeshLoc=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh - DstMeshLoc=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + SrcDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do @@ -1638,13 +1637,13 @@ logical function Failed() end function end subroutine -subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & - DstMod, DstMeshLoc, DstDispMeshLoc, ErrStat, ErrMsg, Active) +subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & + DstMod, DstDL, DstDispDL, ErrStat, ErrMsg, Active) type(FAST_TurbineType), target :: Turbine type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod - type(DatLoc), intent(in) :: SrcMeshLoc, DstMeshLoc - type(DatLoc), intent(in) :: SrcDispMeshLoc, DstDispMeshLoc + type(DatLoc), intent(in) :: SrcDL, DstDL + type(DatLoc), intent(in) :: SrcDispDL, DstDispDL integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, optional, intent(in) :: Active @@ -1666,41 +1665,41 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & end if ! Get mesh pointers - call FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(SrcMod, Turbine, SrcDispMeshLoc, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(SrcMod, Turbine, SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(SrcMod, Turbine, SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - ! If any meshes aren't commited, return + ! If any meshes aren't committed, return if (.not. (SrcMesh%committed .and. DstMesh%committed .and. SrcDispMesh%committed .and. DstDispMesh%committed)) return ! Check that all meshes in mapping have nonzero identifiers if (SrcMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputMeshName(SrcMod, SrcDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return else if (SrcDispMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcDispMesh "'//trim(FAST_InputMeshName(SrcMod, SrcDispMeshLoc))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'SrcDispMesh "'//trim(FAST_InputMeshName(SrcMod, SrcDispDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return else if (DstMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputMeshName(DstMod, DstMeshLoc))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputMeshName(DstMod, DstDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return else if (DstDispMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstDispMesh "'//trim(FAST_OutputMeshName(DstMod, DstDispMeshLoc))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'DstDispMesh "'//trim(FAST_OutputMeshName(DstMod, DstDispDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return end if - call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(DstMod, Turbine, DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Create mapping description - Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//" -> "// & - trim(FAST_InputMeshName(DstMod, DstMeshLoc))// & - " ["//trim(FAST_InputMeshName(SrcMod, SrcDispMeshLoc))// & - " -> "//trim(FAST_OutputMeshName(DstMod, DstDispMeshLoc))//"]" + Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcDL))//" -> "// & + trim(FAST_InputMeshName(DstMod, DstDL))// & + " ["//trim(FAST_InputMeshName(SrcMod, SrcDispDL))// & + " -> "//trim(FAST_OutputMeshName(DstMod, DstDispDL))//"]" ! Initialize mapping structure Mapping%MapType = Map_LoadMesh @@ -1710,10 +1709,11 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & Mapping%iModDst = DstMod%iMod Mapping%DstModID = DstMod%ID Mapping%DstIns = DstMod%Ins - Mapping%SrcMeshLoc = SrcMeshLoc - Mapping%SrcDispMeshLoc = SrcDispMeshLoc - Mapping%DstMeshLoc = DstMeshLoc - Mapping%DstDispMeshLoc = DstDispMeshLoc + Mapping%SrcDL = SrcDL + Mapping%SrcDispDL = SrcDispDL + Mapping%DstDL = DstDL + Mapping%DstDispDL = DstDispDL + Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) ! Create mesh mapping call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return @@ -1722,7 +1722,7 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, SrcDispMeshLoc, & call MeshCopy(DstMesh, Mapping%TmpLoadMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Get mapping indices for linearized mesh mapping - call InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) + ! call InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) ! If the destination displacement mesh is not a sibling of the load mesh Mapping%DstUsesSibling = IsSiblingMesh(DstMesh, DstDispMesh) @@ -1785,11 +1785,11 @@ pure logical function IsSiblingMesh(MeshA, MeshB) end function end subroutine -subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshLoc, ErrStat, ErrMsg, Active) +subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Active) type(FAST_TurbineType), target :: Turbine type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(in) :: SrcMod, DstMod - type(DatLoc), intent(in) :: SrcMeshLoc, DstMeshLoc + type(DatLoc), intent(in) :: SrcDL, DstDL integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, optional, intent(in) :: Active @@ -1809,26 +1809,26 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL end if ! Get mesh pointers - call FAST_OutputMeshPointer(SrcMod, Turbine, SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(DstMod, Turbine, DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(SrcMod, Turbine, SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return ! If source or destination meshes aren't commited, return if (.not. (SrcMesh%committed .and. DstMesh%committed)) return ! Check that all meshes in mapping have nonzero identifiers if (SrcMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputMeshName(SrcMod, SrcDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return else if (DstMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputMeshName(DstMod, DstMeshLoc))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputMeshName(DstMod, DstDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return end if ! Create mapping description - Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcMeshLoc))//" -> "// & - trim(FAST_InputMeshName(DstMod, DstMeshLoc)) + Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcDL))//" -> "// & + trim(FAST_InputMeshName(DstMod, DstDL)) ! Initialize mapping structure Mapping%MapType = Map_MotionMesh @@ -1838,14 +1838,15 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcMeshLoc, DstMod, DstMeshL Mapping%iModDst = DstMod%iMod Mapping%DstModID = DstMod%ID Mapping%DstIns = DstMod%Ins - Mapping%SrcMeshLoc = SrcMeshLoc - Mapping%DstMeshLoc = DstMeshLoc + Mapping%SrcDL = SrcDL + Mapping%DstDL = DstDL + Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) ! Create mesh mapping call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return ! Get mapping indices for linearized mesh mapping - call InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh) + ! call InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh) ! Add mapping to array of mappings Mappings = [Mappings, Mapping] @@ -1857,15 +1858,16 @@ logical function Failed() end function end subroutine -subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, ErrMsg, Active) +subroutine MapVariable(Maps, Key, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Active) type(MappingType), allocatable :: Maps(:) - character(*), intent(in) :: Key - type(ModDataType), intent(in) :: SrcMod, DstMod - integer(IntKi), intent(in) :: iVarSrc, iVarDst - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - logical, optional, intent(in) :: Active + character(*), intent(in) :: Key + type(ModDataType), intent(in) :: SrcMod, DstMod + type(DatLoc), intent(in) :: SrcDL, DstDL + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional, intent(in) :: Active type(MappingType) :: Mapping + integer(IntKi) :: iVarSrc, iVarDst ErrStat = ErrID_None ErrMsg = '' @@ -1874,6 +1876,10 @@ subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, Err if (.not. Active) return end if + ! Get source and destination variable indices + iVarSrc = MV_FindVarDatLoc(SrcMod%Vars%y, SrcDL) + iVarDst = MV_FindVarDatLoc(DstMod%Vars%u, DstDL) + ! If either variable index is zero, return error if (iVarSrc == 0) then ErrStat = ErrID_Fatal @@ -1903,8 +1909,8 @@ subroutine MapVariable(Maps, Key, SrcMod, DstMod, iVarSrc, iVarDst, ErrStat, Err Mapping%DstModID = DstMod%ID Mapping%SrcIns = SrcMod%Ins Mapping%DstIns = DstMod%Ins - Mapping%iVarSrc = iVarSrc - Mapping%iVarDst = iVarDst + Mapping%SrcDL = SrcDL + Mapping%DstDL = DstDL Maps = [Maps, Mapping] end subroutine @@ -1935,69 +1941,62 @@ subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) Maps = [Maps, Mapping] end subroutine -subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) - type(MappingType), intent(inout) :: Mapping - type(ModDataType), intent(in) :: SrcMod, DstMod - type(MeshType), intent(in) :: SrcMesh, DstMesh - type(MeshType), optional, intent(in) :: SrcDispMesh, DstDispMesh - - ! Save source and destination mesh ID - Mapping%SrcMeshID = SrcMesh%ID - Mapping%DstMeshID = DstMesh%ID - - ! Determine transfer type - Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) - - ! Get data locations for variables of source mesh fields - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransDisp, Mapping%iVarSrcTransDisp) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransVel, Mapping%iVarSrcTransVel) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransAcc, Mapping%iVarSrcTransAcc) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldOrientation, Mapping%iVarSrcOrientation) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldAngularVel, Mapping%iVarSrcAngularVel) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldAngularAcc, Mapping%iVarSrcAngularAcc) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldForce, Mapping%iVarSrcForce) - call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldMoment, Mapping%iVarSrcMoment) - - ! Get data locations for variables of destination mesh fields - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransDisp, Mapping%iVarDstTransDisp) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransVel, Mapping%iVarDstTransVel) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransAcc, Mapping%iVarDstTransAcc) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldOrientation, Mapping%iVarDstOrientation) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldAngularVel, Mapping%iVarDstAngularVel) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldAngularAcc, Mapping%iVarDstAngularAcc) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldForce, Mapping%iVarDstForce) - call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldMoment, Mapping%iVarDstMoment) - - if (present(SrcDispMesh)) then - Mapping%SrcDispMeshID = SrcDispMesh%ID - call FindVarByMeshAndField(SrcMod%Vars%u, SrcDispMesh%ID, FieldTransDisp, Mapping%iVarSrcDispTransDisp) - end if - - if (present(DstDispMesh)) then - Mapping%DstDispMeshID = DstDispMesh%ID - call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, FieldTransDisp, Mapping%iVarDstDispTransDisp) - call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, FieldOrientation, Mapping%iVarDstDispOrientation) - end if - -contains - subroutine FindVarByMeshAndField(VarAry, MeshID, Field, iVar) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: MeshID, Field - integer(IntKi), intent(out) :: iVar - integer(IntKi) :: i - - ! Initialize variable index to invalid value (not used) - iVar = 0 - - ! Loop through variables, if variable's mesh ID and field matches given values, return - do i = 1, size(VarAry) - if ((VarAry(i)%MeshID == MeshID) .and. (VarAry(i)%Field == Field)) then - iVar = i - return - end if - end do - end subroutine -end subroutine +! subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) +! type(MappingType), intent(inout) :: Mapping +! type(ModDataType), intent(in) :: SrcMod, DstMod +! type(MeshType), intent(in) :: SrcMesh, DstMesh +! type(MeshType), optional, intent(in) :: SrcDispMesh, DstDispMesh + +! ! Get data locations for variables of source mesh fields +! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransDisp, Mapping%iVarSrcTransDisp) +! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransVel, Mapping%iVarSrcTransVel) +! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransAcc, Mapping%iVarSrcTransAcc) +! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldOrientation, Mapping%iVarSrcOrientation) +! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldAngularVel, Mapping%iVarSrcAngularVel) +! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldAngularAcc, Mapping%iVarSrcAngularAcc) +! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldForce, Mapping%iVarSrcForce) +! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldMoment, Mapping%iVarSrcMoment) + +! ! Get data locations for variables of destination mesh fields +! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransDisp, Mapping%iVarDstTransDisp) +! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransVel, Mapping%iVarDstTransVel) +! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransAcc, Mapping%iVarDstTransAcc) +! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldOrientation, Mapping%iVarDstOrientation) +! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldAngularVel, Mapping%iVarDstAngularVel) +! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldAngularAcc, Mapping%iVarDstAngularAcc) +! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldForce, Mapping%iVarDstForce) +! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldMoment, Mapping%iVarDstMoment) + +! if (present(SrcDispMesh)) then +! Mapping%SrcDispMeshID = SrcDispMesh%ID +! call FindVarByMeshAndField(SrcMod%Vars%u, SrcDispMesh%ID, FieldTransDisp, Mapping%iVarSrcDispTransDisp) +! end if + +! if (present(DstDispMesh)) then +! Mapping%DstDispMeshID = DstDispMesh%ID +! call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, FieldTransDisp, Mapping%iVarDstDispTransDisp) +! call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, FieldOrientation, Mapping%iVarDstDispOrientation) +! end if + +! contains +! subroutine FindVarByMeshAndField(VarAry, MeshID, Field, iVar) +! type(ModVarType), intent(in) :: VarAry(:) +! integer(IntKi), intent(in) :: MeshID, Field +! integer(IntKi), intent(out) :: iVar +! integer(IntKi) :: i + +! ! Initialize variable index to invalid value (not used) +! iVar = 0 + +! ! Loop through variables, if variable's mesh ID and field matches given values, return +! do i = 1, size(VarAry) +! if ((VarAry(i)%MeshID == MeshID) .and. (VarAry(i)%Field == Field)) then +! iVar = i +! return +! end if +! end do +! end subroutine +! end subroutine function MeshTransferType(SrcMesh, DstMesh) result(XfrType) type(MeshType), intent(in) :: SrcMesh, DstMesh @@ -2015,20 +2014,17 @@ function MeshTransferType(SrcMesh, DstMesh) result(XfrType) end if end function -subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ModXfr, ErrStat, ErrMsg, dUdu, dUdy) +subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) + type(ModGlueType), intent(inout) :: ModGlue !< Glue module data + type(MappingType), intent(inout) :: Mappings(:) !< Variable mappings type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type - type(ModDataType), intent(in) :: Mods(:) !< Module data - type(MappingType), intent(inout) :: Mappings(:) - integer(IntKi), intent(in) :: ModOrder(:) - type(ModXfrType), intent(in) :: ModXfr(:) integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - real(R8Ki), intent(inout) :: dUdu(:, :), dUdy(:, :) character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: iLocSrc(2), iLocDst(2), nLocSrc, nLocDst, iMod + integer(IntKi) :: iLocSrc(2), iLocDst(2), nLocSrc, nLocDst integer(IntKi) :: i, j, k type(MeshType), pointer :: SrcMesh, DstMesh type(MeshType), pointer :: SrcDispMesh, DstDispMesh @@ -2036,98 +2032,96 @@ subroutine FAST_LinearizeMappings(Turbine, Mods, Mappings, ModOrder, ModXfr, Err ErrStat = ErrID_None ErrMsg = '' - ! Loop through modules in specified order - do i = 1, size(ModOrder) - - ! Get module index - iMod = ModOrder(i) + ! Loop through variable maps + do i = 1, size(ModGlue%ModMaps) - ! Loop through mappings where this module is the destination - do j = 1, size(Mods(iMod)%DstMaps) + associate (ModMap => ModGlue%ModMaps(i), & + Mapping => Mappings(ModGlue%ModMaps(i)%iMapping), & + ModSrc => ModGlue%ModDataAry(ModGlue%ModMaps(i)%iModSrc), & + ModDst => ModGlue%ModDataAry(ModGlue%ModMaps(i)%iModDst)) - associate (Mapping => Mappings(Mods(iMod)%DstMaps(j))) - - ! Select based on type of mapping - select case (Mapping%MapType) - - case (Map_Variable) + ! Select based on type of mapping + select case (Mapping%MapType) - ! Get source and destination global value indices, skip if no global index for either - if (.not. ModD_GetValLoc(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrc, iDst=iLocSrc)) cycle - if (.not. ModD_GetValLoc(ModXfr(Mapping%iModDst)%u, Mapping%iVarDst, iDst=iLocDst)) cycle + case (Map_Variable) - ! Get number of source and destination locations - nLocSrc = iLocSrc(2) - iLocSrc(1) + 1 - nLocDst = iLocDst(2) - iLocDst(1) + 1 + ! Get source and destination indices, skip if no variable index for either + if (ModMap%iVarSrc(1) == 0 .or. ModMap%iVarDst(1) == 0) cycle + iLocSrc = ModSrc%Vars%y(ModMap%iVarSrc(1))%iLoc + iLocDst = ModDst%Vars%u(ModMap%iVarDst(1))%iLoc + + ! Get number of source and destination locations + nLocSrc = iLocSrc(2) - iLocSrc(1) + 1 + nLocDst = iLocDst(2) - iLocDst(1) + 1 + + ! If source has multiple locations, destination must have same number, connect 1-to-1 + ! MapVariable checks that variables have same number if nLocSrc > 1 + if (nLocSrc > 1) then + do k = 0, nLocDst - 1 + ModGlue%Lin%dUdy(iLocDst(1) + k, iLocSrc(1) + k) = -1.0_R8Ki + end do + else if (nLocDst == 1) then + ! Source and destination have one location + ModGlue%Lin%dUdy(iLocDst(1), iLocSrc(1)) = -1.0_R8Ki + else + ! One source location to many destination locations + ModGlue%Lin%dUdy(iLocDst(1):iLocDst(2), iLocSrc(1)) = -1.0_R8Ki + end if - ! If source has multiple locations, destination must have same number, connect 1-to-1 - ! MapVariable checks that variables have same number if nLocSrc > 1 - if (nLocSrc > 1) then - do k = 0, nLocDst - 1 - dUdy(iLocDst(1) + k, iLocSrc(1) + k) = -1.0_R8Ki - end do - else if (nLocDst == 1) then - ! Source and destination have one location - dUdy(iLocDst(1), iLocSrc(1)) = -1.0_R8Ki - else - ! One source location to many destination locations - dUdy(iLocDst(1):iLocDst(2), iLocSrc(1)) = -1.0_R8Ki - end if + case (Map_MotionMesh) - case (Map_MotionMesh) + ! Get source and destination meshes + call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + ! Perform linearization based on transfer type + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap); if (Failed()) return - ! Perform linearization based on transfer type - call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap); if (Failed()) return + ! Copy linearization matrices to global dUdy matrix + call Assemble_dUdy_Motions(Mapping, ModMap, ModSrc%Vars, ModDst%Vars, ModGlue%Lin%dUdy) - ! Copy linearization matrices to global dUdy matrix - call Assemble_dUdy_Motions(Mapping) + ! Copy linearization matrices to global dUdu matrix + call Assemble_dUdu(Mapping, ModMap, ModSrc%Vars, ModDst%Vars, ModGlue%Lin%dUdu) - ! Copy linearization matrices to global dUdu matrix - call Assemble_dUdu(Mapping) + case (Map_LoadMesh) - case (Map_LoadMesh) + ! Get source and destination meshes + call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstMeshLoc, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + ! Get source and destination displacement meshes + call FAST_InputMeshPointer(ModSrc, Turbine, Mapping%SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(ModDst, Turbine, Mapping%DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - ! Get source and destination displacement meshes - call FAST_InputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDispMeshLoc, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + ! If DstDispMesh is a sibling of DstMesh + if (Mapping%DstUsesSibling) then - ! If DstDispMesh is a sibling of DstMesh - if (Mapping%DstUsesSibling) then + ! Linearize the load mesh transfer + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh); if (Failed()) return - ! Linearize the load mesh transfer - call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh); if (Failed()) return + else - else + ! Transfer destination displacement mesh to temporary motion mesh (cousin of destination load mesh) + call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return - ! Transfer destination displacement mesh to temporary motion mesh (cousin of destination load mesh) - call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return + ! Linearize the motion mesh transfer + call LinearizeMeshTransfer(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return - ! Linearize the motion mesh transfer - call LinearizeMeshTransfer(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return + ! Linearize the load mesh transfer + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh); if (Failed()) return - ! Linearize the load mesh transfer - call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh); if (Failed()) return + end if - end if + ! Copy linearization matrices to global dUdy matrix + call Assemble_dUdy_Loads(Mapping, ModMap, ModSrc%Vars, ModDst%Vars, ModGlue%Lin%dUdy) - ! Copy linearization matrices to global dUdy matrix - call Assemble_dUdy_Loads(Mapping) + ! Copy linearization matrices to global dUdu matrix + call Assemble_dUdu(Mapping, ModMap, ModSrc%Vars, ModDst%Vars, ModGlue%Lin%dUdu) - ! Copy linearization matrices to global dUdu matrix - call Assemble_dUdu(Mapping) + end select - end select + end associate - end associate - end do end do contains @@ -2177,22 +2171,25 @@ subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp) end select end subroutine - subroutine Assemble_dUdu(Mapping) + subroutine Assemble_dUdu(Mapping, ModMap, VarsSrc, VarsDst, dUdu) type(MappingType), intent(in) :: Mapping + type(ModMapType), intent(in) :: ModMap + type(ModVarsType), intent(in) :: VarsSrc, VarsDst + real(R8Ki), intent(inout) :: dUdu(:,:) ! Effect of input Translation Displacement on input Translation Velocity if (allocated(Mapping%MeshMap%dM%tv_uD)) then - call SumBlock(ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_uD, dUdu) + call SumBlock(VarsDst%u, ModMap%iVarDst(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransVel), Mapping%MeshMap%dM%tv_uD, dUdu) end if ! Effect of input Translation Displacement on input Translation Acceleration if (allocated(Mapping%MeshMap%dM%ta_uD)) then - call SumBlock(ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_uD, dUdu) + call SumBlock(VarsDst%u, ModMap%iVarDst(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%ta_uD, dUdu) end if ! Effect of input Translation Displacement on input Moments if (allocated(Mapping%MeshMap%dM%M_uS)) then - call SumBlock(ModXfr(Mapping%iModSrc)%u, Mapping%iVarSrcDispTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%MeshMap%dM%M_uS, dUdu) + call SumBlock(VarsSrc%u, ModMap%iVarSrcDisp(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%MeshMap%dM%M_uS, dUdu) end if end subroutine @@ -2202,31 +2199,34 @@ subroutine Assemble_dUdu(Mapping) !! (destination) mesh : !! M = -| M_li 0 | * M_mi | F^S | !! | M_fm M_li | | M^S | - subroutine Assemble_dUdy_Loads(Mapping) + subroutine Assemble_dUdy_Loads(Mapping, ModMap, VarsSrc, VarsDst, dUdy) type(MappingType), intent(inout) :: Mapping + type(ModMapType), intent(in) :: ModMap + type(ModVarsType), intent(in) :: VarsSrc, VarsDst + real(R8Ki), intent(inout) :: dUdy(:,:) ! Load identity if (allocated(Mapping%MeshMap%dM%li)) then - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcForce, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstForce, Mapping%MeshMap%dM%li, dUdy) - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcMoment, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%MeshMap%dM%li, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldForce), VarsDst%u, ModMap%iVarDst(FieldForce), Mapping%MeshMap%dM%li, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldMoment), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%MeshMap%dM%li, dUdy) end if ! Force to Moment if (allocated(Mapping%MeshMap%dM%m_f)) then - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcForce, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_f, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldForce), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%MeshMap%dM%m_f, dUdy) end if ! Destination Translation Displacement to Moment if (allocated(Mapping%MeshMap%dM%m_uD)) then if (Mapping%DstUsesSibling) then ! Direct transfer - call SumBlock(ModXfr(Mapping%iModDst)%y, Mapping%iVarDstDispTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%MeshMap%dM%m_uD, dUdy) + call SumBlock(VarsDst%y, ModMap%iVarDstDisp(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%MeshMap%dM%m_uD, dUdy) else ! Compose linearization of motion and loads Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%mi) - call SumBlock(ModXfr(Mapping%iModDst)%y, Mapping%iVarDstDispTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%TmpMatrix, dUdy) + call SumBlock(VarsDst%y, ModMap%iVarDstDisp(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%TmpMatrix, dUdy) Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%fx_p) - call SumBlock(ModXfr(Mapping%iModDst)%y, Mapping%iVarDstDispOrientation, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstMoment, Mapping%TmpMatrix, dUdy) + call SumBlock(VarsDst%y, ModMap%iVarDstDisp(FieldOrientation), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%TmpMatrix, dUdy) end if end if end subroutine @@ -2243,58 +2243,62 @@ subroutine Assemble_dUdy_Loads(Mapping) !! | 0 0 0 0 0 M_mi | !! where the matrices correspond to !! u^S, theta^S, v^S, omega^S, a^S, alpha^S - subroutine Assemble_dUdy_Motions(Mapping) - type(MappingType), intent(inout) :: Mapping + subroutine Assemble_dUdy_Motions(Mapping, ModMap, VarsSrc, VarsDst, dUdy) + type(MappingType), intent(in) :: Mapping + type(ModMapType), intent(in) :: ModMap + type(ModVarsType), intent(in) :: VarsSrc, VarsDst + real(R8Ki), intent(inout) :: dUdy(:,:) ! Motion identity if (allocated(Mapping%MeshMap%dM%mi)) then - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcOrientation, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstOrientation, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransVel, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularVel, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstAngularVel, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransAcc, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%mi, dUdy) - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularAcc, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstAngularAcc, Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransDisp), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldOrientation), VarsDst%u, ModMap%iVarDst(FieldOrientation), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransVel), VarsDst%u, ModMap%iVarDst(FieldTransVel), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularVel), VarsDst%u, ModMap%iVarDst(FieldAngularVel), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransAcc), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularAcc), VarsDst%u, ModMap%iVarDst(FieldAngularAcc), Mapping%MeshMap%dM%mi, dUdy) end if ! Rotation to Translation if (allocated(Mapping%MeshMap%dM%fx_p)) then - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcOrientation, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransDisp, Mapping%MeshMap%dM%fx_p, dUdy) - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularVel, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%fx_p, dUdy) - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularAcc, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldOrientation), VarsDst%u, ModMap%iVarDst(FieldTransDisp), Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularVel), VarsDst%u, ModMap%iVarDst(FieldTransVel), Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularAcc), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%fx_p, dUdy) end if ! Translation displacement to Translation velocity if (allocated(Mapping%MeshMap%dM%tv_us)) then - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransVel, Mapping%MeshMap%dM%tv_us, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransVel), Mapping%MeshMap%dM%tv_us, dUdy) end if ! Translation displacement to Translation acceleration if (allocated(Mapping%MeshMap%dM%ta_us)) then - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcTransDisp, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_us, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%ta_us, dUdy) end if ! Angular velocity to Translation acceleration if (allocated(Mapping%MeshMap%dM%ta_rv)) then - call SumBlock(ModXfr(Mapping%iModSrc)%y, Mapping%iVarSrcAngularVel, ModXfr(Mapping%iModDst)%u, Mapping%iVarDstTransAcc, Mapping%MeshMap%dM%ta_rv, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularVel), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%ta_rv, dUdy) end if end subroutine - subroutine SumBlock(XfrSrc, iVarSrc, XfrDst, iVarDst, SrcM, DstM) - type(VarXfrType), intent(in) :: XfrDst(:), XfrSrc(:) - integer(IntKi), intent(in) :: iVarDst, iVarSrc + subroutine SumBlock(VarArySrc, iVarSrc, VarAryDst, iVarDst, SrcM, DstM) + type(ModVarType), intent(in) :: VarArySrc(:), VarAryDst(:) + integer(IntKi), intent(in) :: iVarSrc, iVarDst real(R8Ki), intent(in) :: SrcM(:, :) real(R8Ki), intent(inout) :: DstM(:, :) ! If no variable index for source or destination, return if (iVarDst == 0 .or. iVarSrc == 0) return - ! Get global indices for source/destination modules/variables - if (.not. ModD_GetValLoc(XfrSrc, iVarSrc, iDst=iLocSrc)) return - if (.not. ModD_GetValLoc(XfrDst, iVarDst, iDst=iLocDst)) return + ! Get pointers to source and destination locations + associate (iLocSrc => VarArySrc(iVarSrc)%iLoc, iLocDst => VarAryDst(iVarDst)%iLoc) + + ! Subtracts the source matrix from the destination sub-matrix + associate (DstSubM => DstM(iLocDst(1):iLocDst(2), iLocSrc(1):iLocSrc(2))) + DstSubM = DstSubM - SrcM + end associate - ! Subtracts the source matrix from the destination sub-matrix - associate (DstSubM => DstM(iLocDst(1):iLocDst(2), iLocSrc(1):iLocSrc(2))) - DstSubM = DstSubM - SrcM end associate end subroutine @@ -2324,8 +2328,8 @@ subroutine FAST_InputSolve(ModData, Mods, Mappings, InputIndex, Turbine, ErrStat ErrMsg = '' ! Loop through mappings where the ModData module is the destination - do i = 1, size(ModData%DstMaps) - associate (Mapping => Mappings(ModData%DstMaps(i))) + do i = 1, size(ModData%iDstMaps) + associate (Mapping => Mappings(ModData%iDstMaps(i))) ! Select based on type of mapping select case (Mapping%MapType) @@ -2340,8 +2344,8 @@ subroutine FAST_InputSolve(ModData, Mods, Mappings, InputIndex, Turbine, ErrStat case (Map_MotionMesh) ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstMeshLoc, DstMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDL, DstMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return ! Perform transfer based on type select case (Mapping%XfrType) @@ -2359,12 +2363,12 @@ subroutine FAST_InputSolve(ModData, Mods, Mappings, InputIndex, Turbine, ErrStat case (Map_LoadMesh) ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcMeshLoc, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstMeshLoc, DstMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDL, DstMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return ! Get source and destination displacement meshes - call FAST_InputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDispMeshLoc, SrcDispMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDispMeshLoc, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDispDL, SrcDispMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Perform transfer based on type select case (Mapping%XfrType) diff --git a/modules/openfast-library/src/FAST_ModData.f90 b/modules/openfast-library/src/FAST_ModData.f90 deleted file mode 100644 index b9bee058ad..0000000000 --- a/modules/openfast-library/src/FAST_ModData.f90 +++ /dev/null @@ -1,414 +0,0 @@ -!********************************************************************************************************************************** -! FAST_ModLin.f90 performs linearization using the ModVars module. -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2024 National Renewable Energy Laboratory -! -! This file is part of FAST. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -!********************************************************************************************************************************** -module FAST_ModData - -use NWTC_Library -use NWTC_LAPACK - -use FAST_Types - -implicit none - -private -public :: ModD_AddModule -public :: ModD_GetValLoc, GetModuleOrder -public :: ModD_PackAry, ModD_UnpackAry, ModD_PackMatrix, ModD_CombineModules - -contains - -subroutine GetModuleOrder(Mods, ModIDs, ModOrder) - type(ModDataType), intent(in) :: Mods(:) !< Array of module data structures - integer(IntKi), intent(in) :: ModIDs(:) !< List of module IDs to keep in order - integer(IntKi), allocatable, intent(out) :: ModOrder(:) !< Module data indices in order of ModIDs - integer(IntKi), allocatable :: ModIDAry(:), indices(:) - integer(IntKi) :: i - - ! Create array 1 to size(Mod) representing the index of each module data - indices = [(i, i=1, size(Mods))] - - ! Get array of module IDs from array of module data - ModIDAry = [(Mods(i)%ID, i=1, size(Mods))] - - ! Initialize module order array with no size - allocate (ModOrder(0)) - - ! Loop through module IDs to keep, add module data indices that match module ID to order array - do i = 1, size(ModIDs) - ModOrder = [ModOrder, pack(indices, ModIDAry == ModIDs(i))] - end do - -end subroutine - -subroutine ModD_CombineModules(ModAry, iModOrder, FlagFilter, Linearize, ModOut, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: ModAry(:) - integer(IntKi), intent(in) :: iModOrder(:) - integer(IntKi), intent(in) :: FlagFilter - type(ModDataType), intent(out) :: ModOut - logical, intent(in) :: Linearize - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'ModD_Build' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: NumVars - integer(IntKi) :: iGbl(2) - integer(IntKi) :: i, j, k - integer(IntKi) :: iMod - integer(IntKi) :: xNum, xdNum, zNum, uNum, yNum - integer(IntKi) :: ix, ixd, iz, iu, iy - character(20) :: NamePrefix - - ! Initialize error return - ErrStat = ErrID_None - ErrMsg = "" - - ! If no modules or order is empty, return error - if ((size(ModAry) == 0) .or. (size(iModOrder) == 0)) then - call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) - return - end if - - !---------------------------------------------------------------------------- - ! Construct index to lookup variables - !---------------------------------------------------------------------------- - - ! Allocate variable index array with size equal to number of modules - allocate (ModOut%Xfr(size(ModAry)), stat=ErrStat2) - if (FailedAlloc("ModOut%Xfr")) return - - !---------------------------------------------------------------------------- - ! Combine modules into output module - !---------------------------------------------------------------------------- - - ! Clear module linearization abbreviation - ModOut%Lin%Abbr = "" - - ! Allocate variable structure for glue - allocate (ModOut%Vars) - - ! Initialize number of variables in each group - xNum = 0; xdNum = 0; zNum = 0; uNum = 0; yNum = 0 - - ! Loop through each module and sum the number of variables that will be in - ! the combined module - do i = 1, size(iModOrder) - iMod = iModOrder(i) - associate (ModData => ModAry(iMod)) - - ! Continuous state - call CountVariablesFiltered(ModData%Vars%x, NumVars) - allocate (ModOut%Xfr(iMod)%x(NumVars), stat=ErrStat2) - if (FailedAlloc("ModOut%Xfr(iMod)%x")) return - xNum = xNum + NumVars - - ! Constraint state - call CountVariablesFiltered(ModData%Vars%z, NumVars) - allocate (ModOut%Xfr(iMod)%z(NumVars), stat=ErrStat2) - if (FailedAlloc("ModOut%Xfr(iMod)%z")) return - zNum = zNum + NumVars - - ! Input - call CountVariablesFiltered(ModData%Vars%u, NumVars) - allocate (ModOut%Xfr(iMod)%u(NumVars), stat=ErrStat2) - if (FailedAlloc("ModOut%Xfr(iMod)%u")) return - uNum = uNum + NumVars - - ! Output - call CountVariablesFiltered(ModData%Vars%y, NumVars) - allocate (ModOut%Xfr(iMod)%y(NumVars), stat=ErrStat2) - if (FailedAlloc("ModOut%Xfr(iMod)%y")) return - yNum = yNum + NumVars - - end associate - end do - - ! Allocate arrays for to hold combined variables - allocate (ModOut%Vars%x(xNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%x")) return - allocate (ModOut%Vars%z(zNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%z")) return - allocate (ModOut%Vars%u(uNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%u")) return - allocate (ModOut%Vars%y(yNum), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%y")) return - - ! Initialize variable index counters - ix = 1; ixd = 1; iz = 1; iu = 1; iy = 1 - - ! Initialize number of values in each group variable group - ModOut%Vars%Nx = 0 - ModOut%Vars%Nz = 0 - ModOut%Vars%Nu = 0 - ModOut%Vars%Ny = 0 - - ! Loop through each module by index and add variables - do i = 1, size(iModOrder) - iMod = iModOrder(i) - associate (ModData => ModAry(iMod)) - - ! Create variable name prefix for linearization names. Add instance - ! number to module abbreviation if more than 1 instance or the module is BeamDyn - if ((ModData%ID == Module_BD) .or. (count(ModAry%ID == ModData%ID) > 1)) then - NamePrefix = trim(ModData%Abbr)//"_"//Num2LStr(ModData%Ins) - ModData%Lin%Abbr = "."//trim(ModData%Abbr)//Num2LStr(ModData%Ins) - else - NamePrefix = ModData%Abbr - ModData%Lin%Abbr = "."//ModData%Abbr - end if - - if (size(ModData%Vars%x) > 0) call AddVariables(ModData%Vars%x, ModOut%Vars%x, ModOut%Xfr(iMod)%x, ix, ModOut%Vars%Nx) ! Continuous state - if (size(ModData%Vars%z) > 0) call AddVariables(ModData%Vars%z, ModOut%Vars%z, ModOut%Xfr(iMod)%z, iz, ModOut%Vars%Nz) ! Constraint state - if (size(ModData%Vars%u) > 0) call AddVariables(ModData%Vars%u, ModOut%Vars%u, ModOut%Xfr(iMod)%u, iu, ModOut%Vars%Nu) ! Input - if (size(ModData%Vars%y) > 0) call AddVariables(ModData%Vars%y, ModOut%Vars%y, ModOut%Xfr(iMod)%y, iy, ModOut%Vars%Ny) ! Output - end associate - end do - -contains - - subroutine AddVariables(VarAryIn, VarAryOut, VarXfr, iVar, iVal) - type(ModVarType), intent(in) :: VarAryIn(:) - type(ModVarType), intent(inout) :: VarAryOut(:) - type(VarXfrType), intent(inout) :: VarXfr(:) - integer(IntKi), intent(inout) :: iVar - integer(IntKi), intent(inout) :: iVal - - integer(IntKi) :: NumVals, iXfr - - iXfr = 1 - - ! Loop through variables in original module - do k = 1, size(VarAryIn) - - ! If variable doesn't have flag, cycle - if (.not. MV_HasFlags(VarAryIn(k), FlagFilter)) cycle - - associate (Var => VarAryOut(iVar)) - - ! Add variable to module - VarAryOut(iVar) = VarAryIn(k) - - ! Get number of values in variable - NumVals = VarAryIn(k)%Num - - ! Set value indices in combined module - Var%iLoc = [iVal + 1, iVal + NumVals] - - ! Increment global value index - iVal = iVal + NumVals - - ! Set transfer index - VarXfr(iXfr)%iVar = k ! Variable number in source module - VarXfr(iXfr)%NumVals = NumVals ! Number of values in variable - VarXfr(iXfr)%iSrc = VarAryIn(k)%iLoc ! value start-end indices in source module - VarXfr(iXfr)%iDst = Var%iLoc ! Value start-end indices in destination module - - ! Increment transfer index - iXfr = iXfr + 1 - - ! Prepend module names - call AddLinNamePrefix(Var, NamePrefix) - - ! Increment variable index - iVar = iVar + 1 - - end associate - - end do - - end subroutine - - subroutine CountVariablesFiltered(VarAry, nVars) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(out) :: nVars - nVars = 0 - ! If no filter - if (FlagFilter == VF_None) then - ! Count all variables in array - nVars = size(VarAry) - else - ! Loop through filters and increment nVars if they have the flag - do k = 1, size(VarAry) - if (MV_HasFlags(VarAry(k), FlagFilter)) nVars = nVars + 1 - end do - end if - end subroutine - - subroutine AddLinNamePrefix(Var, Prefix) - type(ModVarType), intent(inout) :: Var - character(*), intent(in) :: Prefix - integer(IntKi) :: j - if (allocated(Var%LinNames)) then - do j = 1, size(Var%LinNames) - Var%LinNames(j) = trim(Prefix)//" "//Var%LinNames(j) - end do - end if - end subroutine - - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function - - logical function FailedAlloc(name) - character(*), intent(in) :: name - if (ErrStat2 == 0) then - FailedAlloc = .false. - else - call SetErrStat(ErrID_Fatal, "Failed to allocate "//name, ErrStat, ErrMsg, RoutineName) - FailedAlloc = .true. - end if - end function - -end subroutine - -! ModD_GetValLoc is used to get the global or module value indices based on module index and variable index. -! iMod is the start and end indices of the values in the module data -! iGbl is teh start and end indices of the values in the global data -logical function ModD_GetValLoc(VarXfrAry, iVar, iSrc, iDst) result(Active) - type(VarXfrType), intent(in) :: VarXfrAry(:) - integer(IntKi), intent(in) :: iVar - integer(IntKi), optional, intent(out) :: iSrc(2), iDst(2) - integer(IntKi) :: i - do i = 1, size(VarXfrAry) - if (VarXfrAry(i)%iVar /= iVar) cycle - if (present(iSrc)) iSrc = VarXfrAry(i)%iSrc - if (present(iDst)) iDst = VarXfrAry(i)%iDst - Active = .true. - return - end do - Active = .false. -end function - -subroutine ModD_PackAry(VarXfrAry, ModAry, GblAry) - type(VarXfrType), intent(in) :: VarXfrAry(:) - real(R8Ki), intent(in) :: ModAry(:) - real(R8Ki), intent(inout) :: GblAry(:) - integer(IntKi) :: i - do i = 1, size(VarXfrAry) - GblAry(VarXfrAry(i)%iDst(1):VarXfrAry(i)%iDst(2)) = & - ModAry(VarXfrAry(i)%iSrc(1):VarXfrAry(i)%iSrc(2)) - end do -end subroutine - -subroutine ModD_UnpackAry(VarXfrAry, ModAry, GblAry) - type(VarXfrType), intent(in) :: VarXfrAry(:) - real(R8Ki), intent(inout) :: ModAry(:) - real(R8Ki), intent(in) :: GblAry(:) - integer(IntKi) :: i - do i = 1, size(VarXfrAry) - ModAry(VarXfrAry(i)%iSrc(1):VarXfrAry(i)%iSrc(2)) = & - GblAry(VarXfrAry(i)%iDst(1):VarXfrAry(i)%iDst(2)) - end do -end subroutine - -subroutine ModD_PackMatrix(RowXfrAry, ColXfrAry, SrcMat, DstMat) - type(VarXfrType), intent(in) :: RowXfrAry(:), ColXfrAry(:) - real(R8Ki), intent(in) :: SrcMat(:, :) - real(R8Ki), intent(inout) :: DstMat(:, :) - integer(IntKi) :: i, j - do i = 1, size(RowXfrAry) - do j = 1, size(ColXfrAry) - DstMat(RowXfrAry(i)%iDst(1):RowXfrAry(i)%iDst(2), ColXfrAry(j)%iDst(1):ColXfrAry(j)%iDst(2)) = & - SrcMat(RowXfrAry(i)%iSrc(1):RowXfrAry(i)%iSrc(2), ColXfrAry(j)%iSrc(1):ColXfrAry(j)%iSrc(2)) - end do - end do -end subroutine - -subroutine ModD_AddModule(Mods, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) - type(ModDataType), allocatable, intent(inout) :: Mods(:) - integer(IntKi), intent(in) :: ModID - character(*), intent(in) :: ModAbbr - integer(IntKi), intent(in) :: Instance - real(R8Ki), intent(in) :: ModDT - real(R8Ki), intent(in) :: SolverDT - type(ModVarsType), pointer, intent(in) :: Vars - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'ModD_AddModule' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(ModDataType) :: ModData - integer(IntKi) :: iMod - - ErrStat = ErrID_None - ErrMsg = '' - - ! If module array hasn't been allocated, allocate with zero size - if (.not. allocated(Mods)) allocate (Mods(0)) - - ! Populate ModuleDataType derived type - ModData = ModDataType(iMod=size(Mods) + 1, ID=ModID, Abbr=ModAbbr, & - Ins=Instance, DT=ModDT, Vars=Vars) - - ! Allocate source and destination mapping arrays - call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !---------------------------------------------------------------------------- - ! Calculate Module Substepping - !---------------------------------------------------------------------------- - - ! If module time step is same as global time step, set substeps to 1 - if (EqualRealNos(ModData%DT, SolverDT)) then - ModData%SubSteps = 1 - else - ! If the module time step is greater than the global time step, set error - if (ModData%DT > SolverDT) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & - " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & - "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - - ! Calculate the number of substeps - ModData%SubSteps = nint(SolverDT/ModData%DT) - - ! If the module DT is not an exact integer divisor of the global time step, set error - if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & - " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & - "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - end if - - !---------------------------------------------------------------------------- - ! Add module data to array - !---------------------------------------------------------------------------- - - Mods = [Mods, ModData] - - ! Get index of newly added module - iMod = size(Mods) - - ! Set module index in each variable - ModData%Vars%x%iMod = iMod - ModData%Vars%z%iMod = iMod - ModData%Vars%u%iMod = iMod - ModData%Vars%y%iMod = iMod - -end subroutine - -end module diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 1e0b63e4a1..3643024cf6 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -24,7 +24,6 @@ module FAST_ModGlue use NWTC_LAPACK use FAST_ModTypes -use FAST_ModData use FAST_Types use FAST_Funcs use FAST_Mapping @@ -39,8 +38,336 @@ module FAST_ModGlue contains -subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) +subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappings, ModGlue, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModDataAry(:) + integer(IntKi), intent(in) :: iModAry(:) + integer(IntKi), intent(in) :: FlagFilter + logical, intent(in) :: Linearize + type(MappingType), intent(in) :: Mappings(:) !< Mesh and variable mappings + type(ModGlueType), intent(out) :: ModGlue + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Glue_CombineModules' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: iGbl(2) + integer(IntKi) :: i, j, k + integer(IntKi) :: iMod, iVarGlue + integer(IntKi) :: xNumVals, zNumVals, uNumVals, yNumVals + integer(IntKi) :: xNumVars, zNumVars, uNumVars, yNumVars + integer(IntKi) :: ix, iz, iu, iy + character(20) :: NamePrefix + type(ModMapType) :: ModMap + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + ! If no modules or order is empty, return error + if ((size(ModDataAry) == 0) .or. (size(iModAry) == 0)) then + call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) + return + end if + + !---------------------------------------------------------------------------- + ! Allocate module data array + !---------------------------------------------------------------------------- + + ! Allocate module info array based on number of modules in iMod + allocate (ModGlue%ModDataAry(size(iModAry)), stat=ErrStat2) + if (FailedAlloc("ModOut%VarsAry")) return + + !---------------------------------------------------------------------------- + ! Combine modules into glue module + !---------------------------------------------------------------------------- + + ! Initialize number of variables and values in each group + xNumVars = 0; zNumVars = 0; uNumVars = 0; yNumVars = 0 + xNumVals = 0; zNumVals = 0; uNumVals = 0; yNumVals = 0 + + ! Loop through each module and sum the number of variables that will be in + ! the combined module + do i = 1, size(iModAry) + associate (ModData => ModDataAry(iModAry(i)), GlueModData => ModGlue%ModDataAry(i)) + + ! Copy values from source module info + GlueModData%Abbr = ModData%Abbr + GlueModData%ID = ModData%ID + GlueModData%iMod = i + GlueModData%Ins = ModData%Ins + GlueModData%DT = ModData%DT + GlueModData%SubSteps = ModData%SubSteps + + ! Continuous state + call CopyVariables(ModData%Vars%x, GlueModData%Vars%x, xNumVals); if (Failed()) return + GlueModData%Vars%Nx = ModData%Vars%Nx ! Same as original module + xNumVars = xNumVars + size(GlueModData%Vars%x) + + ! Constraint state + call CopyVariables(ModData%Vars%z, GlueModData%Vars%z, zNumVals); if (Failed()) return + GlueModData%Vars%Nz = ModData%Vars%Nz ! Same as original module + zNumVars = zNumVars + size(GlueModData%Vars%z) + + ! Input + call CopyVariables(ModData%Vars%u, GlueModData%Vars%u, uNumVals); if (Failed()) return + GlueModData%Vars%Nu = ModData%Vars%Nu ! Same as original module + uNumVars = uNumVars + size(GlueModData%Vars%u) + + ! Output + call CopyVariables(ModData%Vars%y, GlueModData%Vars%y, yNumVals); if (Failed()) return + GlueModData%Vars%Ny = ModData%Vars%Ny ! Same as original module + yNumVars = yNumVars + size(GlueModData%Vars%y) + + end associate + end do + + ! Set total number of values in glue module + ModGlue%Vars%Nx = xNumVals + ModGlue%Vars%Nz = zNumVals + ModGlue%Vars%Nu = uNumVals + ModGlue%Vars%Ny = yNumVals + + ! Allocate arrays for to hold combined variables + allocate (ModGlue%Vars%x(xNumVars), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%x")) return + allocate (ModGlue%Vars%z(zNumVars), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%z")) return + allocate (ModGlue%Vars%u(uNumVars), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%u")) return + allocate (ModGlue%Vars%y(yNumVars), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%y")) return + + ! Loop through module info in glue module + ix = 0; iz = 0; iu = 0; iy = 0 + do i = 1, size(ModGlue%ModDataAry) + + associate (GlueModData => ModGlue%ModDataAry(i)) + + ! Determine module name prefix for linearization + if ((GlueModData%ID == Module_BD) .or. (count(ModDataAry%ID == GlueModData%ID) > 1)) then + NamePrefix = trim(GlueModData%Abbr)//"_"//Num2LStr(GlueModData%Ins) + GlueModData%Abbr = "."//trim(GlueModData%Abbr)//Num2LStr(GlueModData%Ins) + else + NamePrefix = GlueModData%Abbr + GlueModData%Abbr = "."//GlueModData%Abbr + end if + + ! Continuous state + do j = 1, size(GlueModData%Vars%x) + ix = ix + 1 + ModGlue%Vars%x(ix) = GlueModData%Vars%x(j) + ModGlue%Vars%x(ix)%iLoc = ModGlue%Vars%x(ix)%iGlu ! Set local indices to glue indices + ModGlue%Vars%x(ix)%iGlu = 0 ! Set glue indices to 0 + call AddLinNamePrefix(ModGlue%Vars%x(ix), NamePrefix) + end do + + ! Constraint state + do j = 1, size(GlueModData%Vars%z) + iz = iz + 1 + ModGlue%Vars%z(iz) = GlueModData%Vars%z(j) + ModGlue%Vars%z(iz)%iLoc = ModGlue%Vars%z(iz)%iGlu ! Set local indices to glue indices + ModGlue%Vars%z(iz)%iGlu = 0 ! Set glue indices to 0 + call AddLinNamePrefix(ModGlue%Vars%z(iz), NamePrefix) + end do + + ! Input + do j = 1, size(GlueModData%Vars%u) + iu = iu + 1 + ModGlue%Vars%u(iu) = GlueModData%Vars%u(j) + ModGlue%Vars%u(iu)%iLoc = ModGlue%Vars%u(iu)%iGlu ! Set local indices to glue indices + ModGlue%Vars%u(iu)%iGlu = 0 ! Set glue indices to 0 + call AddLinNamePrefix(ModGlue%Vars%u(iu), NamePrefix) + end do + + ! Output + do j = 1, size(GlueModData%Vars%y) + iy = iy + 1 + ModGlue%Vars%y(iy) = GlueModData%Vars%y(j) + ModGlue%Vars%y(iy)%iLoc = ModGlue%Vars%y(iy)%iGlu ! Set local indices to glue indices + ModGlue%Vars%y(iy)%iGlu = 0 ! Set glue indices to 0 + call AddLinNamePrefix(ModGlue%Vars%y(iy), NamePrefix) + end do + + end associate + end do + + !---------------------------------------------------------------------------- + ! Determine mappings which apply to the modules in this glue module + !---------------------------------------------------------------------------- + + ! Loop through mappings + do i = 1, size(Mappings) + + associate (Mapping => Mappings(i), & + ModSrc => ModDataAry(Mappings(i)%iModSrc), & + ModDst => ModDataAry(Mappings(i)%iModDst)) + + ! Find index of source module in glue module, cycle if not found + ModMap%iModSrc = 0 + do j = 1, size(iModAry) + if (iModAry(j) == Mapping%iModSrc) then + ModMap%iModSrc = j + end if + end do + if (ModMap%iModSrc == 0) cycle + + ! Find index of destination module in glue module, cycle if not found + ModMap%iModDst = 0 + do j = 1, size(iModAry) + if (iModAry(j) == Mapping%iModDst) then + ModMap%iModDst = j + end if + end do + if (ModMap%iModDst == 0) cycle + + ! Set mapping index + ModMap%iMapping = i + + ! Init variable indices and find indices that apply to the source data location + ModMap%iVarSrc = 0 + ModMap%iVarSrcDisp = 0 + select case (Mapping%MapType) + case (Map_Variable) + + do j = 1, size(ModSrc%Vars%y) + if (MV_EqualDL(ModSrc%Vars%y(j)%DL, Mapping%SrcDL)) ModMap%iVarSrc(1) = j + end do + + case (Map_LoadMesh, Map_MotionMesh) + + do j = 1, size(ModSrc%Vars%y) + if (MV_EqualDL(ModSrc%Vars%y(j)%DL, Mapping%SrcDL)) ModMap%iVarSrc(ModSrc%Vars%y(j)%Field) = j + end do + + if (Mapping%MapType == Map_LoadMesh) then + do j = 1, size(ModSrc%Vars%y) + if (MV_EqualDL(ModSrc%Vars%y(j)%DL, Mapping%SrcDispDL)) ModMap%iVarSrcDisp(ModSrc%Vars%y(j)%Field) = j + end do + end if + + end select + + ! If no source variable indices found, cycle + if (sum(ModMap%iVarSrc) == 0) cycle + if (Mapping%MapType == Map_LoadMesh .and. sum(ModMap%iVarSrcDisp) == 0) cycle + + ! Init variable indices and find indices that apply to the destination data location + ModMap%iVarDst = 0 + ModMap%iVarDstDisp = 0 + select case (Mapping%MapType) + case (Map_Variable) + + do j = 1, size(ModDst%Vars%u) + if (MV_EqualDL(ModDst%Vars%u(j)%DL, Mapping%DstDL)) ModMap%iVarDst(1) = j + end do + + case (Map_LoadMesh, Map_MotionMesh) + + do j = 1, size(ModDst%Vars%u) + if (MV_EqualDL(ModDst%Vars%u(j)%DL, Mapping%DstDL)) ModMap%iVarDst(ModSrc%Vars%y(j)%Field) = j + end do + + if (Mapping%MapType == Map_LoadMesh) then + do j = 1, size(ModDst%Vars%u) + if (MV_EqualDL(ModDst%Vars%u(j)%DL, Mapping%DstDispDL)) ModMap%iVarDstDisp(ModSrc%Vars%y(j)%Field) = j + end do + end if + + end select + ! If no destination variable indices found, cycle + if (sum(ModMap%iVarDst) == 0) cycle + if (Mapping%MapType == Map_LoadMesh .and. sum(ModMap%iVarDstDisp) == 0) cycle + + ! Add new module mapping to array + if (allocated(ModGlue%ModMaps)) then + ModGlue%ModMaps = [ModGlue%ModMaps, ModMap] + else + ModGlue%ModMaps = [ModMap] + end if + end associate + end do + +contains + + subroutine CopyVariables(VarAryIn, VarAryOut, iVal) + type(ModVarType), intent(in) :: VarAryIn(:) + type(ModVarType), allocatable, intent(inout) :: VarAryOut(:) + integer(IntKi), intent(inout) :: iVal + + integer(IntKi) :: NumVars, NumVals, iVar + + ! Get number of variables that have flag + NumVars = MV_NumVars(VarAryIn, FlagFilter) + + ! Allocate output array of variables + allocate (VarAryOut(NumVars), stat=ErrStat2) + if (ErrStat2 /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Failed to allocate vars" + return + end if + + iVar = 1 + + ! Loop through variables in original module + do k = 1, size(VarAryIn) + + ! If variable doesn't have flag, cycle + if (.not. MV_HasFlags(VarAryIn(k), FlagFilter)) cycle + + associate (Var => VarAryOut(iVar)) + + ! Copy variable + Var = VarAryIn(k) + + ! Get number of values in variable + NumVals = VarAryIn(k)%Num + + ! Set value indices in combined module + Var%iGlu = [iVal + 1, iVal + NumVals] + + ! Increment global value index + iVal = iVal + NumVals + + ! Increment variable index in module info variable array + iVar = iVar + 1 + + ! Deallocate linearization names if not doing linearization + if (.not. Linearize .and. allocated(Var%LinNames)) deallocate (Var%LinNames) + + end associate + + end do + + end subroutine + + subroutine AddLinNamePrefix(Var, Prefix) + type(ModVarType), intent(inout) :: Var + character(*), intent(in) :: Prefix + integer(IntKi) :: m + if (allocated(Var%LinNames)) then + do m = 1, size(Var%LinNames) + Var%LinNames(m) = trim(Prefix)//" "//Var%LinNames(m) + end do + end if + end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function + + logical function FailedAlloc(name) + character(*), intent(in) :: name + if (ErrStat2 == 0) then + FailedAlloc = .false. + else + call SetErrStat(ErrID_Fatal, "Failed to allocate "//name, ErrStat, ErrMsg, RoutineName) + FailedAlloc = .true. + end if + end function + +end subroutine + +subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) type(Glue_ParameterType), intent(inout) :: p !< Glue Parameters type(Glue_MiscVarType), intent(inout) :: m !< Glue MiscVars type(Glue_OutputFileType), intent(inout) :: y !< Glue Output @@ -143,16 +470,16 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) end do !---------------------------------------------------------------------------- - ! Glue Module + ! Mesh Mapping !---------------------------------------------------------------------------- - call ModD_CombineModules(m%Modules, p%Lin%iMod, VF_None, p_FAST%Linearize, m%ModGlue, ErrStat2, ErrMsg2) + call FAST_InitMappings(m%Modules, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- - ! Mesh Mapping + ! Glue Module !---------------------------------------------------------------------------- - call FAST_InitMappings(m%Modules, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call Glue_CombineModules(m%Modules, p%Lin%iMod, VF_None, p_FAST%Linearize, m%Mappings, m%ModGlue, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Allocate linearization arrays and matrices @@ -299,25 +626,23 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, end do ! Loop through modules and collect output - iy = 1 - do j = 1, size(p%Lin%iMod) - associate (ModData => m%Modules(p%Lin%iMod(j))) + + do j = 1, size(m%ModGlue%ModDataAry) + associate (ModData => m%ModGlue%ModDataAry(j)) ! Skip of module has no outputs - if (ModData%Vars%Ny == 0) cycle + if (size(ModData%Vars%y) == 0) cycle ! Get outputs - call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, y_op=ModData%Lin%y) + call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, y_op=m%ModGlue%Lin%y) if (Failed()) return - ! Copy outputs to buffer - m%CS%y_buffer(iy:iy + ModData%Vars%Ny - 1, 1) = ModData%Lin%y - - ! Increment output index - iy = iy + ModData%Vars%Ny end associate end do + ! Copy outputs to buffer (can't be used directly since it's not allocatable) + m%CS%y_buffer(:, 1) = m%ModGlue%Lin%y + ! If first call if (n_t_global == 0) then @@ -561,77 +886,53 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob m%ModGlue%Lin%dXdx = 0.0_R8Ki ! Loop through linearization modules by index - do i = 1, size(p%Lin%iMod) - associate (ModData => m%Modules(p%Lin%iMod(i))) + do i = 1, size(m%ModGlue%ModDataAry) + associate (ModData => m%ModGlue%ModDataAry(i)) ! Derivatives with respect to input call FAST_JacobianPInput(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - dYdu=ModData%Lin%dYdu, dXdu=ModData%Lin%dXdu) + dYdu=ModData%Lin%dYdu, dYduGlue=m%ModGlue%Lin%dYdu, & + dXdu=ModData%Lin%dXdu, dXduGlue=m%ModGlue%Lin%dXdu) if (Failed()) return ! Derivatives with respect to continuous state call FAST_JacobianPContState(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - dYdx=ModData%Lin%dYdx, dXdx=ModData%Lin%dXdx, & - StateRotation=ModData%Lin%StateRotation) + dYdx=ModData%Lin%dYdx, dYdxGlue=m%ModGlue%Lin%dYdx, & + dXdx=ModData%Lin%dXdx, dXdxGlue=m%ModGlue%Lin%dXdx) if (Failed()) return ! Operating point values (must come after Jacobian routines because ! some modules calculate OP in those routines [MD]) call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - u_op=ModData%Lin%u, y_op=ModData%Lin%y, & - x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) + u_op=ModData%Lin%u, u_glue=m%ModGlue%Lin%u, & + y_op=ModData%Lin%y, y_glue=m%ModGlue%Lin%y, & + x_op=ModData%Lin%x, x_glue=m%ModGlue%Lin%x, & + dx_op=ModData%Lin%dx, dx_glue=m%ModGlue%Lin%dx) if (Failed()) return - ! Copy module linearization arrays into glue linearization arrays - if ((size(m%ModGlue%Lin%x) > 0) .and. allocated(ModData%Lin%x)) m%ModGlue%Lin%x(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%x - if ((size(m%ModGlue%Lin%dx) > 0) .and. allocated(ModData%Lin%dx)) m%ModGlue%Lin%dx(ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dx - if ((size(m%ModGlue%Lin%z) > 0) .and. allocated(ModData%Lin%z)) m%ModGlue%Lin%z(iz:iz + ModData%Vars%Nz - 1) = ModData%Lin%z - if ((size(m%ModGlue%Lin%u) > 0) .and. allocated(ModData%Lin%u)) m%ModGlue%Lin%u(iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%u - if ((size(m%ModGlue%Lin%y) > 0) .and. allocated(ModData%Lin%y)) m%ModGlue%Lin%y(iy:iy + ModData%Vars%Ny - 1) = ModData%Lin%y - - ! Copy module Jacobians into glue code Jacobian - if ((size(m%ModGlue%Lin%dYdu) > 0) .and. allocated(ModData%Lin%dYdu)) m%ModGlue%Lin%dYdu(iy:iy + ModData%Vars%Ny - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dYdu - if ((size(m%ModGlue%Lin%dXdu) > 0) .and. allocated(ModData%Lin%dXdu)) m%ModGlue%Lin%dXdu(ix:ix + ModData%Vars%Nx - 1, iu:iu + ModData%Vars%Nu - 1) = ModData%Lin%dXdu - if ((size(m%ModGlue%Lin%dYdx) > 0) .and. allocated(ModData%Lin%dYdx)) m%ModGlue%Lin%dYdx(iy:iy + ModData%Vars%Ny - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dYdx - if ((size(m%ModGlue%Lin%dXdx) > 0) .and. allocated(ModData%Lin%dXdx)) m%ModGlue%Lin%dXdx(ix:ix + ModData%Vars%Nx - 1, ix:ix + ModData%Vars%Nx - 1) = ModData%Lin%dXdx - - ! Increment starting index for next module - ix = ix + ModData%Vars%Nx - iz = iz + ModData%Vars%Nz - iu = iu + ModData%Vars%Nu - iy = iy + ModData%Vars%Ny - - ! If writing the module matrices was requested + ! If requested, write the module linearization matrices was requested if (p_FAST%LinOutMod) then - - ! Write linearization matrices - call CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRootName, VF_Linearize, .false., ErrStat2, ErrMsg2) + call CalcWriteLinearMatrices(ModData%Vars, ModData%Lin, p_FAST, y_FAST, t_global, Un, & + LinRootName, VF_Linearize, ErrStat2, ErrMsg2, ModSuffix=ModData%Abbr) if (Failed()) return - end if - ! Check for NaNs or infinity in module Jacobian matrices - if (JacobianHasNaNs(ModData%Lin%dYdu, "dYdu", ModData%Abbr)) return - if (JacobianHasNaNs(ModData%Lin%dXdu, "dXdu", ModData%Abbr)) return - if (JacobianHasNaNs(ModData%Lin%dYdx, "dYdx", ModData%Abbr)) return - if (JacobianHasNaNs(ModData%Lin%dXdx, "dXdx", ModData%Abbr)) return - - ! Copy arrays into linearization operating points - if (size(m%ModGlue%Lin%x) > 0) y%Lin%x(:, m%Lin%TimeIndex) = m%ModGlue%Lin%x - if (size(m%ModGlue%Lin%z) > 0) y%Lin%z(:, m%Lin%TimeIndex) = m%ModGlue%Lin%z - if (size(m%ModGlue%Lin%u) > 0) y%Lin%u(:, m%Lin%TimeIndex) = m%ModGlue%Lin%u - end associate end do + ! Copy arrays into linearization operating points + if (size(m%ModGlue%Lin%x) > 0) y%Lin%x(:, m%Lin%TimeIndex) = m%ModGlue%Lin%x + if (size(m%ModGlue%Lin%z) > 0) y%Lin%z(:, m%Lin%TimeIndex) = m%ModGlue%Lin%z + if (size(m%ModGlue%Lin%u) > 0) y%Lin%u(:, m%Lin%TimeIndex) = m%ModGlue%Lin%u + ! Linearize mesh mappings to populate dUdy and dUdu m%ModGlue%Lin%dUdy = 0.0_R8Ki call Eye2D(m%ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_LinearizeMappings(Turbine, m%Modules, m%Mappings, p%Lin%iMod, m%ModGlue%Xfr, ErrStat2, ErrMsg2, m%ModGlue%Lin%dUdu, m%ModGlue%Lin%dUdy) + call FAST_LinearizeMappings(m%ModGlue, m%Mappings, Turbine, ErrStat2, ErrMsg2) if (Failed()) return ! Write glue code matrices to file - call CalcWriteLinearMatrices(m%ModGlue, p_FAST, y_FAST, t_global, Un, LinRootName, VF_Linearize, .true., ErrStat2, ErrMsg2) + call CalcWriteLinearMatrices(m%ModGlue%Vars, m%ModGlue%Lin, p_FAST, y_FAST, t_global, Un, LinRootName, VF_Linearize, ErrStat2, ErrMsg2) if (Failed()) return ! Update index for next linearization time @@ -754,8 +1055,9 @@ end function Failed !> CalcGlueStateMatrices forms the full-system state matrices for linearization: A, B, C, and D. !! Note that it uses LAPACK_GEMM instead of MATMUL for matrix multiplications because of stack-space issues (these !! matrices get large quickly). -subroutine CalcGlueStateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: ModGlue !< Glue module data +subroutine CalcGlueStateMatrices(Vars, Lin, JacScaleFactor, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: Vars !< Glue variable data + type(ModLinType), intent(inout) :: Lin !< Glue linearization data real(R8Ki), intent(in) :: JacScaleFactor !< Scale factor for conditioning the Jacobians integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -771,67 +1073,67 @@ subroutine CalcGlueStateMatrices(ModGlue, JacScaleFactor, ErrStat, ErrMsg) ! C = dYdx ! D = dYdu - ! call DumpMatrix(1000, "dUdu.bin", ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(1000, "dUdy.bin", ModGlue%Lin%dUdy, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(1000, "A.bin", ModGlue%Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(1000, "B.bin", ModGlue%Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(1000, "C.bin", ModGlue%Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(1000, "D.bin", ModGlue%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "dUdu.bin", Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "dUdy.bin", Lin%dUdy, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "A.bin", Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "B.bin", Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "C.bin", Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "D.bin", Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return ! *** get G matrix **** !---------------------- - call AllocAry(G, size(ModGlue%Lin%dUdu, 1), size(ModGlue%Lin%dUdu, 2), 'G', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ipiv, ModGlue%Vars%Nu, 'ipiv', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(G, size(Lin%dUdu, 1), size(Lin%dUdu, 2), 'G', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ipiv, Vars%Nu, 'ipiv', ErrStat2, ErrMsg2); if (Failed()) return - !G = dUdu + matmul(dUdy, y_FAST%Lin%Glue%D) - G = ModGlue%Lin%dUdu - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, ModGlue%Lin%dUdy, ModGlue%Lin%dYdu, 1.0_R8Ki, G, ErrStat2, ErrMsg2); if (Failed()) return + ! G = dUdu + matmul(dUdy, y_FAST%Lin%Glue%D) + G = Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, Lin%dUdy, Lin%dYdu, 1.0_R8Ki, G, ErrStat2, ErrMsg2); if (Failed()) return ! G can be ill-conditioned, so we are going to precondition with G_hat = S^(-1) * G * S ! we will also multiply the right-hand-side of the equations that need G inverse so that ! dUdy_hat = S^(-1)*dUdy and dUdu_hat = S^(-1)*dUdu - call Precondition(ModGlue%Vars%u, G, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy, JacScaleFactor) + call Precondition(Vars%u, G, Lin%dUdu, Lin%dUdy, JacScaleFactor) ! Form G_hat^(-1) * (S^-1*dUdy) and G^(-1) * (S^-1*dUdu) ! factor G for the two solves: call LAPACK_getrf(M=size(G, 1), N=size(G, 2), A=G, IPIV=ipiv, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! after the this solve, dUdy holds G_hat^(-1) * dUdy_hat: - call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=ModGlue%Lin%dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=Lin%dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! after the this solve, dUdu holds G_hat^(-1) * dUdu_hat: - call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=ModGlue%Lin%dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=Lin%dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Deallocate G and ipiv because the solves are complete deallocate (G) deallocate (ipiv) ! After this call, dUdu holds G^(-1)*dUdu and dUdy holds G^(-1)*dUdy - call Postcondition(ModGlue%Vars%u, ModGlue%Lin%dUdu, ModGlue%Lin%dUdy, JacScaleFactor) + call Postcondition(Vars%u, Lin%dUdu, Lin%dUdy, JacScaleFactor) ! Allocate tmp matrix for A and C calculations - call AllocAry(tmp, ModGlue%Vars%Nu, ModGlue%Vars%Nx, 'G^-1*dUdy*C', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(tmp, Vars%Nu, Vars%Nx, 'G^-1*dUdy*C', ErrStat2, ErrMsg2); if (Failed()) return ! tmp = G^(-1) * dUdy * diag(C) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, ModGlue%Lin%dUdy, ModGlue%Lin%dYdx, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, Lin%dUdy, Lin%dYdx, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2); if (Failed()) return ! A ! dXdx = dXdx - matmul(dXdu, tmp) - call LAPACK_GEMM('N', 'N', -1.0_R8Ki, ModGlue%Lin%dXdu, tmp, 1.0_R8Ki, ModGlue%Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, Lin%dXdu, tmp, 1.0_R8Ki, Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return ! C ! dYdx = dYdx - matmul(dYdu, tmp) - call LAPACK_GEMM('N', 'N', -1.0_R8Ki, ModGlue%Lin%dYdu, tmp, 1.0_R8Ki, ModGlue%Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, Lin%dYdu, tmp, 1.0_R8Ki, Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return ! B - tmp = ModGlue%Lin%dXdu + tmp = Lin%dXdu ! dXdu = matmul(dXdu, dUdu) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, ModGlue%Lin%dUdu, 0.0_R8Ki, ModGlue%Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, Lin%dUdu, 0.0_R8Ki, Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return ! D - tmp = ModGlue%Lin%dYdu + tmp = Lin%dYdu ! D = matmul(dYdu, dUdu) - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, ModGlue%Lin%dUdu, 0.0_R8Ki, ModGlue%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, Lin%dUdu, 0.0_R8Ki, Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return contains logical function Failed() @@ -863,7 +1165,7 @@ subroutine Precondition(uVars, G, dUdu, dUdy, JacScaleFactor) do i = 1, size(uVars) ! Get if col variable is a load - isColLoad = uVars(i)%Field == FieldForce .or. uVars(i)%Field == FieldMoment + isColLoad = MV_IsLoad(uVars(i)) ! Get col variable start and end indices in matrix associate (iLoc => uVars(i)%iLoc) @@ -874,7 +1176,7 @@ subroutine Precondition(uVars, G, dUdu, dUdy, JacScaleFactor) do j = 1, size(uVars) ! Get if row variable is a load - isRowLoad = uVars(j)%Field == FieldForce .or. uVars(j)%Field == FieldMoment + isRowLoad = MV_IsLoad(uVars(j)) ! Get row variable start and end indices in matrix associate (jLoc => uVars(j)%iLoc) @@ -939,18 +1241,18 @@ subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) end subroutine -subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRootName, FilterFlag, IsGlue, ErrStat, ErrMsg) - - type(ModDataType), intent(inout) :: ModData !< Module data - type(FAST_ParameterType) :: p_FAST !< Parameters - type(FAST_OutputFileType) :: y_FAST !< Output variables - real(DbKi), intent(in) :: t_global !< current time step (written in file) - integer(IntKi), intent(out) :: Un !< Unit number for file - character(*), intent(in) :: LinRootName !< output file name - integer(IntKi), intent(in) :: FilterFlag !< Variable flag for filtering - logical :: IsGlue !< Flag indicating this is writing glue code matrices - integer(IntKi), intent(out) :: ErrStat !< Error status of the operation - character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None +subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinRootName, FilterFlag, ErrStat, ErrMsg, ModSuffix) + type(ModVarsType), intent(in) :: Vars !< Variable data + type(ModLinType), intent(inout) :: Lin !< Linearization data + type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters + type(FAST_OutputFileType), intent(in) :: y_FAST !< Output variables + real(DbKi), intent(in) :: t_global !< current time step (written in file) + integer(IntKi), intent(out) :: Un !< Unit number for file + character(*), intent(in) :: LinRootName !< output file name + integer(IntKi), intent(in) :: FilterFlag !< Variable flag for filtering + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + character(*), optional, intent(in) :: ModSuffix !< Module suffix for file name character(*), parameter :: RoutineName = 'WriteModuleLinearMatrices' integer(IntKi) :: ErrStat2 @@ -965,18 +1267,22 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRoo ErrStat = ErrID_None ErrMsg = "" - ! Assemble output file name based on module linearization abbreviation - OutFileName = trim(LinRootName)//trim(ModData%Lin%Abbr)//".lin" + ! Assemble output file name based on glue linearization abbreviation + if (present(ModSuffix)) then + OutFileName = trim(LinRootName)//trim(ModSuffix)//".lin" + else + OutFileName = trim(LinRootName)//".lin" + end if ! Open linearization file call OpenFOutFile(Un, OutFileName, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate number of values in variable after applying filter - Nx = MV_NumVars(ModData%Vars%x, FilterFlag) + Nx = MV_NumVals(Vars%x, FilterFlag) Nxd = 0 - Nz = MV_NumVars(ModData%Vars%z, FilterFlag) - Nu = MV_NumVars(ModData%Vars%u, FilterFlag) - Ny = MV_NumVars(ModData%Vars%y, FilterFlag) + Nz = MV_NumVals(Vars%z, FilterFlag) + Nu = MV_NumVals(Vars%u, FilterFlag) + Ny = MV_NumVals(Vars%y, FilterFlag) !---------------------------------------------------------------------------- ! Header @@ -1013,50 +1319,50 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRoo if (Nx > 0) then write (Un, '(A)') 'Order of continuous states:' - call WrLinFile_txt_Table(ModData%Vars%x, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%x) + call WrLinFile_txt_Table(Vars%x, FilterFlag, p_FAST, Un, "Row/Column", Lin%x) write (Un, '(A)') 'Order of continuous state derivatives:' - call WrLinFile_txt_Table(ModData%Vars%x, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%dx, IsDeriv=.true.) + call WrLinFile_txt_Table(Vars%x, FilterFlag, p_FAST, Un, "Row/Column", Lin%dx, IsDeriv=.true.) end if if (Nz > 0) then write (Un, '(A)') 'Order of constraint states:' - call WrLinFile_txt_Table(ModData%Vars%z, FilterFlag, p_FAST, Un, "Row/Column", ModData%Lin%z) + call WrLinFile_txt_Table(Vars%z, FilterFlag, p_FAST, Un, "Row/Column", Lin%z) end if if (Nu > 0) then write (Un, '(A)') 'Order of inputs:' - call WrLinFile_txt_Table(ModData%Vars%u, FilterFlag, p_FAST, Un, "Column ", ModData%Lin%u, ShowRot=.true.) + call WrLinFile_txt_Table(Vars%u, FilterFlag, p_FAST, Un, "Column ", Lin%u, ShowRot=.true.) end if if (Ny > 0) then write (Un, '(A)') 'Order of outputs:' - call WrLinFile_txt_Table(ModData%Vars%y, FilterFlag, p_FAST, Un, "Row ", ModData%Lin%y, ShowRot=.true.) + call WrLinFile_txt_Table(Vars%y, FilterFlag, p_FAST, Un, "Row ", Lin%y, ShowRot=.true.) end if - ! Create boolean array indicating which state values to write - allocate (xUse(ModData%Vars%Nx)) + ! Create boolean array indicating which continuous state values to write + allocate (xUse(Vars%Nx)) xUse = .false. - do i = 1, size(ModData%Vars%x) - associate (Var => ModData%Vars%x(i)) + do i = 1, size(Vars%x) + associate (Var => Vars%x(i)) if (MV_HasFlags(Var, FilterFlag)) xUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do ! Create boolean array indicating which input values to write - allocate (uUse(ModData%Vars%Nu)) + allocate (uUse(Vars%Nu)) uUse = .false. - do i = 1, size(ModData%Vars%u) - associate (Var => ModData%Vars%u(i)) + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) if (MV_HasFlags(Var, FilterFlag)) uUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do ! Create boolean array indicating which output values to write - allocate (yUse(ModData%Vars%Ny)) + allocate (yUse(Vars%Ny)) yUse = .false. - do i = 1, size(ModData%Vars%y) - associate (Var => ModData%Vars%y(i)) + do i = 1, size(Vars%y) + associate (Var => Vars%y(i)) if (MV_HasFlags(Var, FilterFlag)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do @@ -1064,33 +1370,33 @@ subroutine CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, t_global, Un, LinRoo ! If Jacobian matrix output is requested if (p_FAST%LinOutJac) then write (Un, '(/,A,/)') 'Jacobian matrices:' - if (allocated(ModData%Lin%dUdu)) call WrPartialMatrix(ModData%Lin%dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=uUse, UseCol=uUse) - if (allocated(ModData%Lin%dUdy)) call WrPartialMatrix(ModData%Lin%dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=uUse, UseCol=yUse) - if (allocated(ModData%Lin%dXdy)) call WrPartialMatrix(ModData%Lin%dXdy, Un, p_FAST%OutFmt, 'dXdy', UseRow=xUse, UseCol=yUse) - if (allocated(ModData%Lin%J)) call WrPartialMatrix(ModData%Lin%J, Un, p_FAST%OutFmt, 'J') - if (.not. IsGlue) then - if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'dXdx', UseRow=xUse, UseCol=xUse) - if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'dXdu', UseRow=xUse, UseCol=uUse) - if (allocated(ModData%Lin%dYdx)) call WrPartialMatrix(ModData%Lin%dYdx, Un, p_FAST%OutFmt, 'dYdx', UseRow=yUse, UseCol=xUse) - if (allocated(ModData%Lin%dYdu)) call WrPartialMatrix(ModData%Lin%dYdu, Un, p_FAST%OutFmt, 'dYdu', UseRow=yUse, UseCol=uUse) + if (allocated(Lin%dUdu)) call WrPartialMatrix(Lin%dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=uUse, UseCol=uUse) + if (allocated(Lin%dUdy)) call WrPartialMatrix(Lin%dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=uUse, UseCol=yUse) + if (allocated(Lin%dXdy)) call WrPartialMatrix(Lin%dXdy, Un, p_FAST%OutFmt, 'dXdy', UseRow=xUse, UseCol=yUse) + if (allocated(Lin%J)) call WrPartialMatrix(Lin%J, Un, p_FAST%OutFmt, 'J') + if (present(ModSuffix)) then + if (allocated(Lin%dXdx)) call WrPartialMatrix(Lin%dXdx, Un, p_FAST%OutFmt, 'dXdx', UseRow=xUse, UseCol=xUse) + if (allocated(Lin%dXdu)) call WrPartialMatrix(Lin%dXdu, Un, p_FAST%OutFmt, 'dXdu', UseRow=xUse, UseCol=uUse) + if (allocated(Lin%dYdx)) call WrPartialMatrix(Lin%dYdx, Un, p_FAST%OutFmt, 'dYdx', UseRow=yUse, UseCol=xUse) + if (allocated(Lin%dYdu)) call WrPartialMatrix(Lin%dYdu, Un, p_FAST%OutFmt, 'dYdu', UseRow=yUse, UseCol=uUse) end if end if ! If this is glue code module, calculate the glue code state matrices (A, B, C, D) ! Called here, after writing dUdu and dUdy, because those matrices are overwritten ! in the process of calculating the other state matrices - if (IsGlue) then - call CalcGlueStateMatrices(ModData, real(p_FAST%UJacSclFact, R8Ki), ErrStat2, ErrMsg2) + if (.not. present(ModSuffix)) then + call CalcGlueStateMatrices(Vars, Lin, real(p_FAST%UJacSclFact, R8Ki), ErrStat2, ErrMsg2) if (Failed()) return end if ! Write the linearized state matrices write (Un, '(/,A,/)') 'Linearized state matrices:' - if (allocated(ModData%Lin%dXdx)) call WrPartialMatrix(ModData%Lin%dXdx, Un, p_FAST%OutFmt, 'A', UseRow=xUse, UseCol=xUse) - if (allocated(ModData%Lin%dXdu)) call WrPartialMatrix(ModData%Lin%dXdu, Un, p_FAST%OutFmt, 'B', UseRow=xUse, UseCol=uUse) - if (allocated(ModData%Lin%dYdx)) call WrPartialMatrix(ModData%Lin%dYdx, Un, p_FAST%OutFmt, 'C', UseRow=yUse, UseCol=xUse) - if (allocated(ModData%Lin%dYdu)) call WrPartialMatrix(ModData%Lin%dYdu, Un, p_FAST%OutFmt, 'D', UseRow=yUse, UseCol=uUse) - if (allocated(ModData%Lin%StateRotation)) call WrPartialMatrix(ModData%Lin%StateRotation, Un, p_FAST%OutFmt, 'StateRotation') + if (allocated(Lin%dXdx)) call WrPartialMatrix(Lin%dXdx, Un, p_FAST%OutFmt, 'A', UseRow=xUse, UseCol=xUse) + if (allocated(Lin%dXdu)) call WrPartialMatrix(Lin%dXdu, Un, p_FAST%OutFmt, 'B', UseRow=xUse, UseCol=uUse) + if (allocated(Lin%dYdx)) call WrPartialMatrix(Lin%dYdx, Un, p_FAST%OutFmt, 'C', UseRow=yUse, UseCol=xUse) + if (allocated(Lin%dYdu)) call WrPartialMatrix(Lin%dYdu, Un, p_FAST%OutFmt, 'D', UseRow=yUse, UseCol=uUse) + if (allocated(Lin%StateRotation)) call WrPartialMatrix(Lin%StateRotation, Un, p_FAST%OutFmt, 'StateRotation') ! Close file close (Un) @@ -1214,5 +1520,4 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer end subroutine WrLinFile_txt_Table - end module diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 410338c08c..dddbc66617 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -21,7 +21,6 @@ !********************************************************************************************************************************** MODULE FAST_Subs - USE FAST_ModData USE FAST_ModGlue USE FAST_Solver ! USE FAST_Linear @@ -295,8 +294,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to array of modules, return if errors occurred - CALL ModD_AddModule(m_Glue%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & - Init%OutData_ED%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + Init%OutData_ED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return NumBl = Init%OutData_ED%NumBl @@ -391,8 +390,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName) ! Add module instance to array of modules, return on failure - CALL ModD_AddModule(m_Glue%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & - p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & + p_FAST%DT, Init%OutData_BD(k)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return END DO @@ -495,8 +494,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS ! Add module to list of modules, return on error - CALL ModD_AddModule(m_Glue%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & - Init%OutData_IfW%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + Init%OutData_IfW%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return IF ( p_FAST%CompServo == Module_SrvD ) THEN !assign the number of gates to ServD @@ -565,8 +564,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules, return on error - CALL ModD_AddModule(m_Glue%Modules, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & - Init%OutData_ExtInfw%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & + Init%OutData_ExtInfw%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return !bjj: fix me!!! to do @@ -621,8 +620,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to array, return on error - call ModD_AddModule(m_Glue%Modules, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & - Init%OutData_SeaSt%Vars, ErrStat2, ErrMsg2) + call MV_AddModule(m_Glue%Modules, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & + Init%OutData_SeaSt%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return if (allocated(Init%OutData_SeaSt%WaveElevVisGrid)) then @@ -730,8 +729,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! Initialize a module instance for each rotor do i = 1, size(Init%OutData_AD%rotors) - CALL ModD_AddModule(m_Glue%Modules, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & - Init%OutData_AD%rotors(i)%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + Init%OutData_AD%rotors(i)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return end do @@ -756,8 +755,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules, return on error - CALL ModD_AddModule(m_Glue%Modules, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & - Init%OutData_ExtLd%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + Init%OutData_ExtLd%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return AirDens = Init%OutData_ExtLd%AirDens @@ -824,8 +823,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL ModD_AddModule(m_Glue%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & - Init%OutData_HD%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & + Init%OutData_HD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return p_FAST%ModuleInitialized(Module_HD) = .TRUE. @@ -877,8 +876,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL ModD_AddModule(m_Glue%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & - Init%OutData_SD%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & + Init%OutData_SD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return p_FAST%ModuleInitialized(Module_SD) = .TRUE. @@ -971,8 +970,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL ModD_AddModule(m_Glue%Modules, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & - Init%OutData_MAP%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & + Init%OutData_MAP%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return case (Module_MD) @@ -1003,8 +1002,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL ModD_AddModule(m_Glue%Modules, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & - Init%OutData_MD%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & + Init%OutData_MD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return case (Module_FEAM) @@ -1028,8 +1027,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL ModD_AddModule(m_Glue%Modules, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & - Init%OutData_FEAM%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & + Init%OutData_FEAM%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return case (Module_Orca) @@ -1046,8 +1045,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL ModD_AddModule(m_Glue%Modules, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & - Init%OutData_Orca%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & + Init%OutData_Orca%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return END select @@ -1085,7 +1084,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules - ! CALL ModD_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + ! CALL MV_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) ! if (Failed()) return @@ -1158,7 +1157,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD END IF ! Add module to list of modules - ! CALL ModD_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + ! CALL MV_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) ! if (Failed()) return END DO @@ -1266,8 +1265,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules - CALL ModD_AddModule(m_Glue%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & - Init%OutData_SrvD%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_Glue%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + Init%OutData_SrvD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return !! initialize SrvD%y%ElecPwr and SrvD%y%GenTq because they are one timestep different (used as input for the next step)? diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index 74e32241b8..1248c7ea0e 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -20,23 +20,35 @@ param ^ - IntKi Map_MotionMesh - 2 - param ^ - IntKi Map_Variable - 3 - "Individual variable mapping type" - param ^ - IntKi Map_Custom - 4 - "Custom mapping not used for linearization" - +typedef ^ ModMapType IntKi iMapping - 0 - "Mapping index" +typedef ^ ^ IntKi iModSrc - 0 - "Source module index" +typedef ^ ^ IntKi iModDst - 0 - "Destination module index" +typedef ^ ^ IntKi iVarSrc 10 0 - "Source variable indices" +typedef ^ ^ IntKi iVarSrcDisp 10 0 - "Source variable indices" +typedef ^ ^ IntKi iVarDst 10 0 - "Destination variable indices" +typedef ^ ^ IntKi iVarDstDisp 10 0 - "Destination variable indices" + +typedef ^ ModGlueType character(ChanLen) Name - - - "Glue name" - +typedef ^ ^ ModDataType ModDataAry : - - "Array of module info" - +typedef ^ ^ ModVarsType Vars - - - "Combined module variables" - +typedef ^ ^ ModLinType Lin - - - "Glue linearization data" - +typedef ^ ^ ModMapType ModMaps : - - "Var mapping" + typedef ^ MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - -typedef ^ ^ IntKi iModSrc - 0 - "Source module index in ModData array" - -typedef ^ ^ IntKi iModDst - 0 - "Destination module index in ModData array" - +typedef ^ ^ IntKi iModSrc - 0 - "Source module index in ModData array" - +typedef ^ ^ IntKi iModDst - 0 - "Destination module index in ModData array" - typedef ^ ^ IntKi SrcModID - 0 - "Source module ID" - typedef ^ ^ IntKi DstModID - 0 - "Destination module ID" - typedef ^ ^ IntKi SrcIns - 0 - "Source module Instance" - typedef ^ ^ IntKi DstIns - 0 - "Destination module Instance" - typedef ^ ^ IntKi SrcMeshID - 0 - "Source mesh identifier" - typedef ^ ^ IntKi DstMeshID - 0 - "Destination mesh identifier" - -typedef ^ ^ IntKi iVarSrc - 0 - "Source variable index" - -typedef ^ ^ IntKi iVarDst - 0 - "Destination variable index" - typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - -typedef ^ ^ DatLoc SrcMeshLoc - - - "Source mesh locator (number and indices)" - -typedef ^ ^ DatLoc DstMeshLoc - - - "Destination mesh locator (number and indices)" - -typedef ^ ^ DatLoc SrcDispMeshLoc - - - "Source displacement mesh locator (number and indices)" - -typedef ^ ^ DatLoc DstDispMeshLoc - - - "Destination displacement mesh locator (number and indices)" - +typedef ^ ^ DatLoc SrcDL - - - "Source mesh locator (number and indices)" - +typedef ^ ^ DatLoc DstDL - - - "Destination mesh locator (number and indices)" - +typedef ^ ^ DatLoc SrcDispDL - - - "Source displacement mesh locator (number and indices)" - +typedef ^ ^ DatLoc DstDispDL - - - "Destination displacement mesh locator (number and indices)" - typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - @@ -47,68 +59,25 @@ typedef ^ ^ MeshType TmpMotionMesh - - - typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - typedef ^ ^ MeshMapType MeshMapAux - - - "Auxiliary mesh mapping for destination load meshes without sibling motion mesh" - -typedef ^ ^ IntKi iVarSrcTransDisp - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcTransVel - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcTransAcc - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcOrientation - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcAngularVel - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcAngularAcc - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcForce - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcMoment - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarSrcDispTransDisp - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstTransDisp - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstTransVel - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstTransAcc - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstOrientation - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstAngularVel - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstAngularAcc - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstForce - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstMoment - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstDispTransDisp - - - "Var index for linearized mesh mapping" -typedef ^ ^ IntKi iVarDstDispOrientation - - - "Var index for linearized mesh mapping" - -#---------------------------------------------------------------------------------------------------------------------------------- -# Glue Linearization -#---------------------------------------------------------------------------------------------------------------------------------- - -typedef ^ Glue_LinType character(ChanLen) Abbr - - - "" - -typedef ^ ^ R8Ki x : - - "" - -typedef ^ ^ R8Ki dx : - - "" - -typedef ^ ^ R8Ki xd : - - "" - -typedef ^ ^ R8Ki z : - - "" - -typedef ^ ^ R8Ki u : - - "" - -typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "" - -typedef ^ ^ R8Ki x_perturb : - - "" - -typedef ^ ^ R8Ki x_pos : - - "" - -typedef ^ ^ R8Ki x_neg : - - "" - -typedef ^ ^ R8Ki y_pos : - - "" - -typedef ^ ^ R8Ki y_neg : - - "" - -typedef ^ ^ R8Ki J :: - - "" - -typedef ^ ^ R8Ki dYdx :: - - "" - -typedef ^ ^ R8Ki dXdx :: - - "" - -typedef ^ ^ R8Ki dYdu :: - - "" - -typedef ^ ^ R8Ki dXdu :: - - "" - -typedef ^ ^ R8Ki dXdy :: - - "" - -typedef ^ ^ R8Ki dUdu :: - - "" - -typedef ^ ^ R8Ki dUdy :: - - "" - -typedef ^ ^ R8Ki StateRotation :: - - "" - - -#---------------------------------------------------------------------------------------------------------------------------------- -# Module Data -#---------------------------------------------------------------------------------------------------------------------------------- - -typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - -typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - -typedef ^ ^ IntKi Ins - 0 - "Module instance number" - -typedef ^ ^ R8Ki DT - 0 - "Module time step" - -typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - -typedef ^ ^ ModXfrType Xfr : - - "Variable index for combined modules" - -typedef ^ ^ Glue_LinType Lin - - - "Module linearization data" - -typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" -typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" +#typedef ^ ^ IntKi iVarSrcTransDisp - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarSrcTransVel - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarSrcTransAcc - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarSrcOrientation - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarSrcAngularVel - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarSrcAngularAcc - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarSrcForce - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarSrcMoment - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarSrcDispTransDisp - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstTransDisp - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstTransVel - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstTransAcc - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstOrientation - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstAngularVel - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstAngularAcc - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstForce - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstMoment - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstDispTransDisp - - - "Var index for linearized mesh mapping" +#typedef ^ ^ IntKi iVarDstDispOrientation - - - "Var index for linearized mesh mapping" #---------------------------------------------------------------------------------------------------------------------------------- # Glue Parameters @@ -215,7 +184,7 @@ typedef ^ ^ logical IsConverged - - - typedef ^ Glue_MiscVarType ModDataType Modules : - - "Module variable and value data" - typedef ^ ^ MappingType Mappings : - - "Module mapping" - -typedef ^ ^ ModDataType ModGlue - - - "Glue code module" - +typedef ^ ^ ModGlueType ModGlue - - - "Glue code module" - typedef ^ ^ Glue_LinMisc Lin - - - "Linearization misc vars" typedef ^ ^ Glue_CalcSteady CS - - - "CalcSteady calculation data" typedef ^ ^ Glue_AeroMap AM - - - "AeroMap data" diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index f808d13835..56e8117b75 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -37,6 +37,26 @@ MODULE Glue_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Variable = 3 ! Individual variable mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Custom = 4 ! Custom mapping not used for linearization [-] +! ========= ModMapType ======= + TYPE, PUBLIC :: ModMapType + INTEGER(IntKi) :: iMapping = 0 !< Mapping index [-] + INTEGER(IntKi) :: iModSrc = 0 !< Source module index [-] + INTEGER(IntKi) :: iModDst = 0 !< Destination module index [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarSrc = 0 !< Source variable indices [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarSrcDisp = 0 !< Source variable indices [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarDst = 0 !< Destination variable indices [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarDstDisp = 0 !< Destination variable indices [-] + END TYPE ModMapType +! ======================= +! ========= ModGlueType ======= + TYPE, PUBLIC :: ModGlueType + character(ChanLen) :: Name !< Glue name [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModDataAry !< Array of module info [-] + TYPE(ModVarsType) :: Vars !< Combined module variables [-] + TYPE(ModLinType) :: Lin !< Glue linearization data [-] + TYPE(ModMapType) , DIMENSION(:), ALLOCATABLE :: ModMaps !< Var mapping [-] + END TYPE ModGlueType +! ======================= ! ========= MappingType ======= TYPE, PUBLIC :: MappingType character(128) :: Desc !< Description of mapping (used to lookup non-mesh maps) [-] @@ -48,14 +68,12 @@ MODULE Glue_Types INTEGER(IntKi) :: DstIns = 0 !< Destination module Instance [-] INTEGER(IntKi) :: SrcMeshID = 0 !< Source mesh identifier [-] INTEGER(IntKi) :: DstMeshID = 0 !< Destination mesh identifier [-] - INTEGER(IntKi) :: iVarSrc = 0 !< Source variable index [-] - INTEGER(IntKi) :: iVarDst = 0 !< Destination variable index [-] INTEGER(IntKi) :: SrcDispMeshID = 0 !< Source displacement mesh identifier [-] INTEGER(IntKi) :: DstDispMeshID = 0 !< Destination displacement mesh identifier [-] - TYPE(DatLoc) :: SrcMeshLoc !< Source mesh locator (number and indices) [-] - TYPE(DatLoc) :: DstMeshLoc !< Destination mesh locator (number and indices) [-] - TYPE(DatLoc) :: SrcDispMeshLoc !< Source displacement mesh locator (number and indices) [-] - TYPE(DatLoc) :: DstDispMeshLoc !< Destination displacement mesh locator (number and indices) [-] + TYPE(DatLoc) :: SrcDL !< Source mesh locator (number and indices) [-] + TYPE(DatLoc) :: DstDL !< Destination mesh locator (number and indices) [-] + TYPE(DatLoc) :: SrcDispDL !< Source displacement mesh locator (number and indices) [-] + TYPE(DatLoc) :: DstDispDL !< Destination displacement mesh locator (number and indices) [-] INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] @@ -66,68 +84,8 @@ MODULE Glue_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] TYPE(MeshMapType) :: MeshMapAux !< Auxiliary mesh mapping for destination load meshes without sibling motion mesh [-] - INTEGER(IntKi) :: iVarSrcTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcTransVel = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcTransAcc = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcAngularVel = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcAngularAcc = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcForce = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcMoment = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarSrcDispTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstTransVel = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstTransAcc = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstAngularVel = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstAngularAcc = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstForce = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstMoment = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstDispTransDisp = 0_IntKi !< Var index for linearized mesh mapping [-] - INTEGER(IntKi) :: iVarDstDispOrientation = 0_IntKi !< Var index for linearized mesh mapping [-] END TYPE MappingType ! ======================= -! ========= Glue_LinType ======= - TYPE, PUBLIC :: Glue_LinType - character(ChanLen) :: Abbr !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xd !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdy !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] - END TYPE Glue_LinType -! ======================= -! ========= ModDataType ======= - TYPE, PUBLIC :: ModDataType - character(ChanLen) :: Abbr !< Module name abbreviation [-] - INTEGER(IntKi) :: ID = 0 !< Module identification number [-] - INTEGER(IntKi) :: iMod = 0 !< Module index in array of modules [-] - INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] - REAL(R8Ki) :: DT = 0 !< Module time step [-] - INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] - TYPE(ModXfrType) , DIMENSION(:), ALLOCATABLE :: Xfr !< Variable index for combined modules [-] - TYPE(Glue_LinType) :: Lin !< Module linearization data [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] - END TYPE ModDataType -! ======================= ! ========= Glue_LinParam ======= TYPE, PUBLIC :: Glue_LinParam INTEGER(IntKi) :: NumTimes = 0_IntKi !< Number of times to linearize [-] @@ -247,7 +205,7 @@ MODULE Glue_Types TYPE, PUBLIC :: Glue_MiscVarType TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: Modules !< Module variable and value data [-] TYPE(MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mapping [-] - TYPE(ModDataType) :: ModGlue !< Glue code module [-] + TYPE(ModGlueType) :: ModGlue !< Glue code module [-] TYPE(Glue_LinMisc) :: Lin !< Linearization misc vars [-] TYPE(Glue_CalcSteady) :: CS !< CalcSteady calculation data [-] TYPE(Glue_AeroMap) :: AM !< AeroMap data [-] @@ -284,6 +242,222 @@ MODULE Glue_Types contains +subroutine Glue_CopyModMapType(SrcModMapTypeData, DstModMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModMapType), intent(in) :: SrcModMapTypeData + type(ModMapType), intent(inout) :: DstModMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_CopyModMapType' + ErrStat = ErrID_None + ErrMsg = '' + DstModMapTypeData%iMapping = SrcModMapTypeData%iMapping + DstModMapTypeData%iModSrc = SrcModMapTypeData%iModSrc + DstModMapTypeData%iModDst = SrcModMapTypeData%iModDst + DstModMapTypeData%iVarSrc = SrcModMapTypeData%iVarSrc + DstModMapTypeData%iVarSrcDisp = SrcModMapTypeData%iVarSrcDisp + DstModMapTypeData%iVarDst = SrcModMapTypeData%iVarDst + DstModMapTypeData%iVarDstDisp = SrcModMapTypeData%iVarDstDisp +end subroutine + +subroutine Glue_DestroyModMapType(ModMapTypeData, ErrStat, ErrMsg) + type(ModMapType), intent(inout) :: ModMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyModMapType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Glue_PackModMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackModMapType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%iMapping) + call RegPack(RF, InData%iModSrc) + call RegPack(RF, InData%iModDst) + call RegPack(RF, InData%iVarSrc) + call RegPack(RF, InData%iVarSrcDisp) + call RegPack(RF, InData%iVarDst) + call RegPack(RF, InData%iVarDstDisp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackModMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackModMapType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%iMapping); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModDst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstDisp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyModGlueType(SrcModGlueTypeData, DstModGlueTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModGlueType), intent(in) :: SrcModGlueTypeData + type(ModGlueType), intent(inout) :: DstModGlueTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyModGlueType' + ErrStat = ErrID_None + ErrMsg = '' + DstModGlueTypeData%Name = SrcModGlueTypeData%Name + if (allocated(SrcModGlueTypeData%ModDataAry)) then + LB(1:1) = lbound(SrcModGlueTypeData%ModDataAry, kind=B8Ki) + UB(1:1) = ubound(SrcModGlueTypeData%ModDataAry, kind=B8Ki) + if (.not. allocated(DstModGlueTypeData%ModDataAry)) then + allocate(DstModGlueTypeData%ModDataAry(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModGlueTypeData%ModDataAry.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModDataType(SrcModGlueTypeData%ModDataAry(i1), DstModGlueTypeData%ModDataAry(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyModVarsType(SrcModGlueTypeData%Vars, DstModGlueTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModLinType(SrcModGlueTypeData%Lin, DstModGlueTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModGlueTypeData%ModMaps)) then + LB(1:1) = lbound(SrcModGlueTypeData%ModMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModGlueTypeData%ModMaps, kind=B8Ki) + if (.not. allocated(DstModGlueTypeData%ModMaps)) then + allocate(DstModGlueTypeData%ModMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModGlueTypeData%ModMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyModMapType(SrcModGlueTypeData%ModMaps(i1), DstModGlueTypeData%ModMaps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine Glue_DestroyModGlueType(ModGlueTypeData, ErrStat, ErrMsg) + type(ModGlueType), intent(inout) :: ModGlueTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyModGlueType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModGlueTypeData%ModDataAry)) then + LB(1:1) = lbound(ModGlueTypeData%ModDataAry, kind=B8Ki) + UB(1:1) = ubound(ModGlueTypeData%ModDataAry, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModDataType(ModGlueTypeData%ModDataAry(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModGlueTypeData%ModDataAry) + end if + call NWTC_Library_DestroyModVarsType(ModGlueTypeData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModLinType(ModGlueTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModGlueTypeData%ModMaps)) then + LB(1:1) = lbound(ModGlueTypeData%ModMaps, kind=B8Ki) + UB(1:1) = ubound(ModGlueTypeData%ModMaps, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_DestroyModMapType(ModGlueTypeData%ModMaps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModGlueTypeData%ModMaps) + end if +end subroutine + +subroutine Glue_PackModGlueType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModGlueType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackModGlueType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, allocated(InData%ModDataAry)) + if (allocated(InData%ModDataAry)) then + call RegPackBounds(RF, 1, lbound(InData%ModDataAry, kind=B8Ki), ubound(InData%ModDataAry, kind=B8Ki)) + LB(1:1) = lbound(InData%ModDataAry, kind=B8Ki) + UB(1:1) = ubound(InData%ModDataAry, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModDataType(RF, InData%ModDataAry(i1)) + end do + end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) + call NWTC_Library_PackModLinType(RF, InData%Lin) + call RegPack(RF, allocated(InData%ModMaps)) + if (allocated(InData%ModMaps)) then + call RegPackBounds(RF, 1, lbound(InData%ModMaps, kind=B8Ki), ubound(InData%ModMaps, kind=B8Ki)) + LB(1:1) = lbound(InData%ModMaps, kind=B8Ki) + UB(1:1) = ubound(InData%ModMaps, kind=B8Ki) + do i1 = LB(1), UB(1) + call Glue_PackModMapType(RF, InData%ModMaps(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackModGlueType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModGlueType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackModGlueType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%ModDataAry)) deallocate(OutData%ModDataAry) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ModDataAry(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModDataAry.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModDataType(RF, OutData%ModDataAry(i1)) ! ModDataAry + end do + end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin + if (allocated(OutData%ModMaps)) deallocate(OutData%ModMaps) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ModMaps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModMaps.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackModMapType(RF, OutData%ModMaps(i1)) ! ModMaps + end do + end if +end subroutine + subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode, ErrStat, ErrMsg) type(MappingType), intent(inout) :: SrcMappingTypeData type(MappingType), intent(inout) :: DstMappingTypeData @@ -305,20 +479,18 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode DstMappingTypeData%DstIns = SrcMappingTypeData%DstIns DstMappingTypeData%SrcMeshID = SrcMappingTypeData%SrcMeshID DstMappingTypeData%DstMeshID = SrcMappingTypeData%DstMeshID - DstMappingTypeData%iVarSrc = SrcMappingTypeData%iVarSrc - DstMappingTypeData%iVarDst = SrcMappingTypeData%iVarDst DstMappingTypeData%SrcDispMeshID = SrcMappingTypeData%SrcDispMeshID DstMappingTypeData%DstDispMeshID = SrcMappingTypeData%DstDispMeshID - call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcMeshLoc, DstMappingTypeData%SrcMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcDL, DstMappingTypeData%SrcDL, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyDatLoc(SrcMappingTypeData%DstMeshLoc, DstMappingTypeData%DstMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%DstDL, DstMappingTypeData%DstDL, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcDispMeshLoc, DstMappingTypeData%SrcDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcDispDL, DstMappingTypeData%SrcDispDL, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyDatLoc(SrcMappingTypeData%DstDispMeshLoc, DstMappingTypeData%DstDispMeshLoc, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%DstDispDL, DstMappingTypeData%DstDispDL, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstMappingTypeData%MapType = SrcMappingTypeData%MapType @@ -350,25 +522,6 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode call NWTC_Library_CopyMeshMapType(SrcMappingTypeData%MeshMapAux, DstMappingTypeData%MeshMapAux, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstMappingTypeData%iVarSrcTransDisp = SrcMappingTypeData%iVarSrcTransDisp - DstMappingTypeData%iVarSrcTransVel = SrcMappingTypeData%iVarSrcTransVel - DstMappingTypeData%iVarSrcTransAcc = SrcMappingTypeData%iVarSrcTransAcc - DstMappingTypeData%iVarSrcOrientation = SrcMappingTypeData%iVarSrcOrientation - DstMappingTypeData%iVarSrcAngularVel = SrcMappingTypeData%iVarSrcAngularVel - DstMappingTypeData%iVarSrcAngularAcc = SrcMappingTypeData%iVarSrcAngularAcc - DstMappingTypeData%iVarSrcForce = SrcMappingTypeData%iVarSrcForce - DstMappingTypeData%iVarSrcMoment = SrcMappingTypeData%iVarSrcMoment - DstMappingTypeData%iVarSrcDispTransDisp = SrcMappingTypeData%iVarSrcDispTransDisp - DstMappingTypeData%iVarDstTransDisp = SrcMappingTypeData%iVarDstTransDisp - DstMappingTypeData%iVarDstTransVel = SrcMappingTypeData%iVarDstTransVel - DstMappingTypeData%iVarDstTransAcc = SrcMappingTypeData%iVarDstTransAcc - DstMappingTypeData%iVarDstOrientation = SrcMappingTypeData%iVarDstOrientation - DstMappingTypeData%iVarDstAngularVel = SrcMappingTypeData%iVarDstAngularVel - DstMappingTypeData%iVarDstAngularAcc = SrcMappingTypeData%iVarDstAngularAcc - DstMappingTypeData%iVarDstForce = SrcMappingTypeData%iVarDstForce - DstMappingTypeData%iVarDstMoment = SrcMappingTypeData%iVarDstMoment - DstMappingTypeData%iVarDstDispTransDisp = SrcMappingTypeData%iVarDstDispTransDisp - DstMappingTypeData%iVarDstDispOrientation = SrcMappingTypeData%iVarDstDispOrientation end subroutine subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) @@ -380,13 +533,13 @@ subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyMappingType' ErrStat = ErrID_None ErrMsg = '' - call NWTC_Library_DestroyDatLoc(MappingTypeData%SrcMeshLoc, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyDatLoc(MappingTypeData%SrcDL, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyDatLoc(MappingTypeData%DstMeshLoc, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyDatLoc(MappingTypeData%DstDL, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyDatLoc(MappingTypeData%SrcDispMeshLoc, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyDatLoc(MappingTypeData%SrcDispDL, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyDatLoc(MappingTypeData%DstDispMeshLoc, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyDatLoc(MappingTypeData%DstDispDL, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MeshDestroy( MappingTypeData%TmpLoadMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -415,14 +568,12 @@ subroutine Glue_PackMappingType(RF, Indata) call RegPack(RF, InData%DstIns) call RegPack(RF, InData%SrcMeshID) call RegPack(RF, InData%DstMeshID) - call RegPack(RF, InData%iVarSrc) - call RegPack(RF, InData%iVarDst) call RegPack(RF, InData%SrcDispMeshID) call RegPack(RF, InData%DstDispMeshID) - call NWTC_Library_PackDatLoc(RF, InData%SrcMeshLoc) - call NWTC_Library_PackDatLoc(RF, InData%DstMeshLoc) - call NWTC_Library_PackDatLoc(RF, InData%SrcDispMeshLoc) - call NWTC_Library_PackDatLoc(RF, InData%DstDispMeshLoc) + call NWTC_Library_PackDatLoc(RF, InData%SrcDL) + call NWTC_Library_PackDatLoc(RF, InData%DstDL) + call NWTC_Library_PackDatLoc(RF, InData%SrcDispDL) + call NWTC_Library_PackDatLoc(RF, InData%DstDispDL) call RegPack(RF, InData%MapType) call RegPack(RF, InData%XfrType) call RegPack(RF, InData%XfrTypeAux) @@ -433,25 +584,6 @@ subroutine Glue_PackMappingType(RF, Indata) call RegPackAlloc(RF, InData%TmpMatrix) call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) call NWTC_Library_PackMeshMapType(RF, InData%MeshMapAux) - call RegPack(RF, InData%iVarSrcTransDisp) - call RegPack(RF, InData%iVarSrcTransVel) - call RegPack(RF, InData%iVarSrcTransAcc) - call RegPack(RF, InData%iVarSrcOrientation) - call RegPack(RF, InData%iVarSrcAngularVel) - call RegPack(RF, InData%iVarSrcAngularAcc) - call RegPack(RF, InData%iVarSrcForce) - call RegPack(RF, InData%iVarSrcMoment) - call RegPack(RF, InData%iVarSrcDispTransDisp) - call RegPack(RF, InData%iVarDstTransDisp) - call RegPack(RF, InData%iVarDstTransVel) - call RegPack(RF, InData%iVarDstTransAcc) - call RegPack(RF, InData%iVarDstOrientation) - call RegPack(RF, InData%iVarDstAngularVel) - call RegPack(RF, InData%iVarDstAngularAcc) - call RegPack(RF, InData%iVarDstForce) - call RegPack(RF, InData%iVarDstMoment) - call RegPack(RF, InData%iVarDstDispTransDisp) - call RegPack(RF, InData%iVarDstDispOrientation) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -472,14 +604,12 @@ subroutine Glue_UnPackMappingType(RF, OutData) call RegUnpack(RF, OutData%DstIns); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcMeshID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstMeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDst); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcDispMeshID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstDispMeshID); if (RegCheckErr(RF, RoutineName)) return - call NWTC_Library_UnpackDatLoc(RF, OutData%SrcMeshLoc) ! SrcMeshLoc - call NWTC_Library_UnpackDatLoc(RF, OutData%DstMeshLoc) ! DstMeshLoc - call NWTC_Library_UnpackDatLoc(RF, OutData%SrcDispMeshLoc) ! SrcDispMeshLoc - call NWTC_Library_UnpackDatLoc(RF, OutData%DstDispMeshLoc) ! DstDispMeshLoc + call NWTC_Library_UnpackDatLoc(RF, OutData%SrcDL) ! SrcDL + call NWTC_Library_UnpackDatLoc(RF, OutData%DstDL) ! DstDL + call NWTC_Library_UnpackDatLoc(RF, OutData%SrcDispDL) ! SrcDispDL + call NWTC_Library_UnpackDatLoc(RF, OutData%DstDispDL) ! DstDispDL call RegUnpack(RF, OutData%MapType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%XfrType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%XfrTypeAux); if (RegCheckErr(RF, RoutineName)) return @@ -490,610 +620,6 @@ subroutine Glue_UnPackMappingType(RF, OutData) call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMapAux) ! MeshMapAux - call RegUnpack(RF, OutData%iVarSrcTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcTransVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcTransAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcOrientation); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcAngularVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcAngularAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcForce); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcMoment); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarSrcDispTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstTransVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstTransAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstOrientation); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstAngularVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstAngularAcc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstForce); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstMoment); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstDispTransDisp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iVarDstDispOrientation); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg) - type(Glue_LinType), intent(in) :: SrcLinTypeData - type(Glue_LinType), intent(inout) :: DstLinTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'Glue_CopyLinType' - ErrStat = ErrID_None - ErrMsg = '' - DstLinTypeData%Abbr = SrcLinTypeData%Abbr - if (allocated(SrcLinTypeData%x)) then - LB(1:1) = lbound(SrcLinTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%x, kind=B8Ki) - if (.not. allocated(DstLinTypeData%x)) then - allocate(DstLinTypeData%x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%x = SrcLinTypeData%x - end if - if (allocated(SrcLinTypeData%dx)) then - LB(1:1) = lbound(SrcLinTypeData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%dx, kind=B8Ki) - if (.not. allocated(DstLinTypeData%dx)) then - allocate(DstLinTypeData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%dx = SrcLinTypeData%dx - end if - if (allocated(SrcLinTypeData%xd)) then - LB(1:1) = lbound(SrcLinTypeData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%xd, kind=B8Ki) - if (.not. allocated(DstLinTypeData%xd)) then - allocate(DstLinTypeData%xd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%xd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%xd = SrcLinTypeData%xd - end if - if (allocated(SrcLinTypeData%z)) then - LB(1:1) = lbound(SrcLinTypeData%z, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%z, kind=B8Ki) - if (.not. allocated(DstLinTypeData%z)) then - allocate(DstLinTypeData%z(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%z.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%z = SrcLinTypeData%z - end if - if (allocated(SrcLinTypeData%u)) then - LB(1:1) = lbound(SrcLinTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%u, kind=B8Ki) - if (.not. allocated(DstLinTypeData%u)) then - allocate(DstLinTypeData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%u = SrcLinTypeData%u - end if - if (allocated(SrcLinTypeData%y)) then - LB(1:1) = lbound(SrcLinTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%y, kind=B8Ki) - if (.not. allocated(DstLinTypeData%y)) then - allocate(DstLinTypeData%y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%y = SrcLinTypeData%y - end if - if (allocated(SrcLinTypeData%u_perturb)) then - LB(1:1) = lbound(SrcLinTypeData%u_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%u_perturb, kind=B8Ki) - if (.not. allocated(DstLinTypeData%u_perturb)) then - allocate(DstLinTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%u_perturb = SrcLinTypeData%u_perturb - end if - if (allocated(SrcLinTypeData%x_perturb)) then - LB(1:1) = lbound(SrcLinTypeData%x_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%x_perturb, kind=B8Ki) - if (.not. allocated(DstLinTypeData%x_perturb)) then - allocate(DstLinTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%x_perturb = SrcLinTypeData%x_perturb - end if - if (allocated(SrcLinTypeData%x_pos)) then - LB(1:1) = lbound(SrcLinTypeData%x_pos, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%x_pos, kind=B8Ki) - if (.not. allocated(DstLinTypeData%x_pos)) then - allocate(DstLinTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%x_pos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%x_pos = SrcLinTypeData%x_pos - end if - if (allocated(SrcLinTypeData%x_neg)) then - LB(1:1) = lbound(SrcLinTypeData%x_neg, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%x_neg, kind=B8Ki) - if (.not. allocated(DstLinTypeData%x_neg)) then - allocate(DstLinTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%x_neg.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%x_neg = SrcLinTypeData%x_neg - end if - if (allocated(SrcLinTypeData%y_pos)) then - LB(1:1) = lbound(SrcLinTypeData%y_pos, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%y_pos, kind=B8Ki) - if (.not. allocated(DstLinTypeData%y_pos)) then - allocate(DstLinTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%y_pos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%y_pos = SrcLinTypeData%y_pos - end if - if (allocated(SrcLinTypeData%y_neg)) then - LB(1:1) = lbound(SrcLinTypeData%y_neg, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%y_neg, kind=B8Ki) - if (.not. allocated(DstLinTypeData%y_neg)) then - allocate(DstLinTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%y_neg.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%y_neg = SrcLinTypeData%y_neg - end if - if (allocated(SrcLinTypeData%J)) then - LB(1:2) = lbound(SrcLinTypeData%J, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%J, kind=B8Ki) - if (.not. allocated(DstLinTypeData%J)) then - allocate(DstLinTypeData%J(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%J.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%J = SrcLinTypeData%J - end if - if (allocated(SrcLinTypeData%dYdx)) then - LB(1:2) = lbound(SrcLinTypeData%dYdx, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%dYdx, kind=B8Ki) - if (.not. allocated(DstLinTypeData%dYdx)) then - allocate(DstLinTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%dYdx = SrcLinTypeData%dYdx - end if - if (allocated(SrcLinTypeData%dXdx)) then - LB(1:2) = lbound(SrcLinTypeData%dXdx, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%dXdx, kind=B8Ki) - if (.not. allocated(DstLinTypeData%dXdx)) then - allocate(DstLinTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%dXdx = SrcLinTypeData%dXdx - end if - if (allocated(SrcLinTypeData%dYdu)) then - LB(1:2) = lbound(SrcLinTypeData%dYdu, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%dYdu, kind=B8Ki) - if (.not. allocated(DstLinTypeData%dYdu)) then - allocate(DstLinTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%dYdu = SrcLinTypeData%dYdu - end if - if (allocated(SrcLinTypeData%dXdu)) then - LB(1:2) = lbound(SrcLinTypeData%dXdu, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%dXdu, kind=B8Ki) - if (.not. allocated(DstLinTypeData%dXdu)) then - allocate(DstLinTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%dXdu = SrcLinTypeData%dXdu - end if - if (allocated(SrcLinTypeData%dXdy)) then - LB(1:2) = lbound(SrcLinTypeData%dXdy, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%dXdy, kind=B8Ki) - if (.not. allocated(DstLinTypeData%dXdy)) then - allocate(DstLinTypeData%dXdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dXdy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%dXdy = SrcLinTypeData%dXdy - end if - if (allocated(SrcLinTypeData%dUdu)) then - LB(1:2) = lbound(SrcLinTypeData%dUdu, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%dUdu, kind=B8Ki) - if (.not. allocated(DstLinTypeData%dUdu)) then - allocate(DstLinTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%dUdu = SrcLinTypeData%dUdu - end if - if (allocated(SrcLinTypeData%dUdy)) then - LB(1:2) = lbound(SrcLinTypeData%dUdy, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%dUdy, kind=B8Ki) - if (.not. allocated(DstLinTypeData%dUdy)) then - allocate(DstLinTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%dUdy = SrcLinTypeData%dUdy - end if - if (allocated(SrcLinTypeData%StateRotation)) then - LB(1:2) = lbound(SrcLinTypeData%StateRotation, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%StateRotation, kind=B8Ki) - if (.not. allocated(DstLinTypeData%StateRotation)) then - allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation - end if -end subroutine - -subroutine Glue_DestroyLinType(LinTypeData, ErrStat, ErrMsg) - type(Glue_LinType), intent(inout) :: LinTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Glue_DestroyLinType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(LinTypeData%x)) then - deallocate(LinTypeData%x) - end if - if (allocated(LinTypeData%dx)) then - deallocate(LinTypeData%dx) - end if - if (allocated(LinTypeData%xd)) then - deallocate(LinTypeData%xd) - end if - if (allocated(LinTypeData%z)) then - deallocate(LinTypeData%z) - end if - if (allocated(LinTypeData%u)) then - deallocate(LinTypeData%u) - end if - if (allocated(LinTypeData%y)) then - deallocate(LinTypeData%y) - end if - if (allocated(LinTypeData%u_perturb)) then - deallocate(LinTypeData%u_perturb) - end if - if (allocated(LinTypeData%x_perturb)) then - deallocate(LinTypeData%x_perturb) - end if - if (allocated(LinTypeData%x_pos)) then - deallocate(LinTypeData%x_pos) - end if - if (allocated(LinTypeData%x_neg)) then - deallocate(LinTypeData%x_neg) - end if - if (allocated(LinTypeData%y_pos)) then - deallocate(LinTypeData%y_pos) - end if - if (allocated(LinTypeData%y_neg)) then - deallocate(LinTypeData%y_neg) - end if - if (allocated(LinTypeData%J)) then - deallocate(LinTypeData%J) - end if - if (allocated(LinTypeData%dYdx)) then - deallocate(LinTypeData%dYdx) - end if - if (allocated(LinTypeData%dXdx)) then - deallocate(LinTypeData%dXdx) - end if - if (allocated(LinTypeData%dYdu)) then - deallocate(LinTypeData%dYdu) - end if - if (allocated(LinTypeData%dXdu)) then - deallocate(LinTypeData%dXdu) - end if - if (allocated(LinTypeData%dXdy)) then - deallocate(LinTypeData%dXdy) - end if - if (allocated(LinTypeData%dUdu)) then - deallocate(LinTypeData%dUdu) - end if - if (allocated(LinTypeData%dUdy)) then - deallocate(LinTypeData%dUdy) - end if - if (allocated(LinTypeData%StateRotation)) then - deallocate(LinTypeData%StateRotation) - end if -end subroutine - -subroutine Glue_PackLinType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Glue_LinType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Glue_PackLinType' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Abbr) - call RegPackAlloc(RF, InData%x) - call RegPackAlloc(RF, InData%dx) - call RegPackAlloc(RF, InData%xd) - call RegPackAlloc(RF, InData%z) - call RegPackAlloc(RF, InData%u) - call RegPackAlloc(RF, InData%y) - call RegPackAlloc(RF, InData%u_perturb) - call RegPackAlloc(RF, InData%x_perturb) - call RegPackAlloc(RF, InData%x_pos) - call RegPackAlloc(RF, InData%x_neg) - call RegPackAlloc(RF, InData%y_pos) - call RegPackAlloc(RF, InData%y_neg) - call RegPackAlloc(RF, InData%J) - call RegPackAlloc(RF, InData%dYdx) - call RegPackAlloc(RF, InData%dXdx) - call RegPackAlloc(RF, InData%dYdu) - call RegPackAlloc(RF, InData%dXdu) - call RegPackAlloc(RF, InData%dXdy) - call RegPackAlloc(RF, InData%dUdu) - call RegPackAlloc(RF, InData%dUdy) - call RegPackAlloc(RF, InData%StateRotation) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_UnPackLinType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Glue_LinType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Glue_UnPackLinType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%J); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdy); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: SrcModDataTypeData - type(ModDataType), intent(inout) :: DstModDataTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_CopyModDataType' - ErrStat = ErrID_None - ErrMsg = '' - DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr - DstModDataTypeData%ID = SrcModDataTypeData%ID - DstModDataTypeData%iMod = SrcModDataTypeData%iMod - DstModDataTypeData%Ins = SrcModDataTypeData%Ins - DstModDataTypeData%DT = SrcModDataTypeData%DT - DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps - DstModDataTypeData%Vars => SrcModDataTypeData%Vars - if (allocated(SrcModDataTypeData%Xfr)) then - LB(1:1) = lbound(SrcModDataTypeData%Xfr, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%Xfr, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%Xfr)) then - allocate(DstModDataTypeData%Xfr(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%Xfr.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyModXfrType(SrcModDataTypeData%Xfr(i1), DstModDataTypeData%Xfr(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call Glue_CopyLinType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcModDataTypeData%SrcMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%SrcMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%SrcMaps)) then - allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps - end if - if (allocated(SrcModDataTypeData%DstMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%DstMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%DstMaps, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%DstMaps)) then - allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps - end if -end subroutine - -subroutine Glue_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) - type(ModDataType), intent(inout) :: ModDataTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_DestroyModDataType' - ErrStat = ErrID_None - ErrMsg = '' - nullify(ModDataTypeData%Vars) - if (allocated(ModDataTypeData%Xfr)) then - LB(1:1) = lbound(ModDataTypeData%Xfr, kind=B8Ki) - UB(1:1) = ubound(ModDataTypeData%Xfr, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyModXfrType(ModDataTypeData%Xfr(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ModDataTypeData%Xfr) - end if - call Glue_DestroyLinType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ModDataTypeData%SrcMaps)) then - deallocate(ModDataTypeData%SrcMaps) - end if - if (allocated(ModDataTypeData%DstMaps)) then - deallocate(ModDataTypeData%DstMaps) - end if -end subroutine - -subroutine Glue_PackModDataType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ModDataType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Glue_PackModDataType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - logical :: PtrInIndex - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Abbr) - call RegPack(RF, InData%ID) - call RegPack(RF, InData%iMod) - call RegPack(RF, InData%Ins) - call RegPack(RF, InData%DT) - call RegPack(RF, InData%SubSteps) - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if - call RegPack(RF, allocated(InData%Xfr)) - if (allocated(InData%Xfr)) then - call RegPackBounds(RF, 1, lbound(InData%Xfr, kind=B8Ki), ubound(InData%Xfr, kind=B8Ki)) - LB(1:1) = lbound(InData%Xfr, kind=B8Ki) - UB(1:1) = ubound(InData%Xfr, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackModXfrType(RF, InData%Xfr(i1)) - end do - end if - call Glue_PackLinType(RF, InData%Lin) - call RegPackAlloc(RF, InData%SrcMaps) - call RegPackAlloc(RF, InData%DstMaps) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Glue_UnPackModDataType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ModDataType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Glue_UnPackModDataType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if - if (allocated(OutData%Xfr)) deallocate(OutData%Xfr) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Xfr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xfr.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackModXfrType(RF, OutData%Xfr(i1)) ! Xfr - end do - end if - call Glue_UnpackLinType(RF, OutData%Lin) ! Lin - call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Glue_CopyLinParam(SrcLinParamData, DstLinParamData, CtrlCode, ErrStat, ErrMsg) @@ -1859,7 +1385,7 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E character(*), parameter :: RoutineName = 'Glue_CopyAeroMap' ErrStat = ErrID_None ErrMsg = '' - call Glue_CopyModDataType(SrcAeroMapData%Mod, DstAeroMapData%Mod, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModDataType(SrcAeroMapData%Mod, DstAeroMapData%Mod, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroMapData%iModOrder)) then @@ -2029,7 +1555,7 @@ subroutine Glue_DestroyAeroMap(AeroMapData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyAeroMap' ErrStat = ErrID_None ErrMsg = '' - call Glue_DestroyModDataType(AeroMapData%Mod, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModDataType(AeroMapData%Mod, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroMapData%iModOrder)) then deallocate(AeroMapData%iModOrder) @@ -2082,7 +1608,7 @@ subroutine Glue_PackAeroMap(RF, Indata) integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return - call Glue_PackModDataType(RF, InData%Mod) + call NWTC_Library_PackModDataType(RF, InData%Mod) call RegPackAlloc(RF, InData%iModOrder) call RegPack(RF, InData%iModED) call RegPack(RF, InData%iModBD) @@ -2121,7 +1647,7 @@ subroutine Glue_UnPackAeroMap(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call Glue_UnpackModDataType(RF, OutData%Mod) ! Mod + call NWTC_Library_UnpackModDataType(RF, OutData%Mod) ! Mod call RegUnpackAlloc(RF, OutData%iModOrder); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iModED); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iModBD); if (RegCheckErr(RF, RoutineName)) return @@ -2222,7 +1748,7 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if do i1 = LB(1), UB(1) - call Glue_CopyModDataType(SrcMiscData%Modules(i1), DstMiscData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModDataType(SrcMiscData%Modules(i1), DstMiscData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -2243,7 +1769,7 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end if - call Glue_CopyModDataType(SrcMiscData%ModGlue, DstMiscData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) + call Glue_CopyModGlueType(SrcMiscData%ModGlue, DstMiscData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call Glue_CopyLinMisc(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) @@ -2564,7 +2090,7 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) LB(1:1) = lbound(MiscData%Modules, kind=B8Ki) UB(1:1) = ubound(MiscData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) - call Glue_DestroyModDataType(MiscData%Modules(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModDataType(MiscData%Modules(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(MiscData%Modules) @@ -2578,7 +2104,7 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%Mappings) end if - call Glue_DestroyModDataType(MiscData%ModGlue, ErrStat2, ErrMsg2) + call Glue_DestroyModGlueType(MiscData%ModGlue, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Glue_DestroyLinMisc(MiscData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2673,7 +2199,7 @@ subroutine Glue_PackMisc(RF, Indata) LB(1:1) = lbound(InData%Modules, kind=B8Ki) UB(1:1) = ubound(InData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) - call Glue_PackModDataType(RF, InData%Modules(i1)) + call NWTC_Library_PackModDataType(RF, InData%Modules(i1)) end do end if call RegPack(RF, allocated(InData%Mappings)) @@ -2685,7 +2211,7 @@ subroutine Glue_PackMisc(RF, Indata) call Glue_PackMappingType(RF, InData%Mappings(i1)) end do end if - call Glue_PackModDataType(RF, InData%ModGlue) + call Glue_PackModGlueType(RF, InData%ModGlue) call Glue_PackLinMisc(RF, InData%Lin) call Glue_PackCalcSteady(RF, InData%CS) call Glue_PackAeroMap(RF, InData%AM) @@ -2739,7 +2265,7 @@ subroutine Glue_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call Glue_UnpackModDataType(RF, OutData%Modules(i1)) ! Modules + call NWTC_Library_UnpackModDataType(RF, OutData%Modules(i1)) ! Modules end do end if if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) @@ -2755,7 +2281,7 @@ subroutine Glue_UnPackMisc(RF, OutData) call Glue_UnpackMappingType(RF, OutData%Mappings(i1)) ! Mappings end do end if - call Glue_UnpackModDataType(RF, OutData%ModGlue) ! ModGlue + call Glue_UnpackModGlueType(RF, OutData%ModGlue) ! ModGlue call Glue_UnpackLinMisc(RF, OutData%Lin) ! Lin call Glue_UnpackCalcSteady(RF, OutData%CS) ! CS call Glue_UnpackAeroMap(RF, OutData%AM) ! AM diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index d1d8c12dfb..ecec85d994 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -451,7 +451,7 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) w << indent; } - // Subroutines to pack and unpack variable type data + // Subroutines to pack and unpack arrays based on variables for (const auto &tmp : std::vector>{ {"ContinuousState", "x", "ContState"}, {"ConstraintState", "z", "ConstrState"}, @@ -474,19 +474,17 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) std::vector fields; ddt.get_field_names_paths(mod.nickname + "_" + abbr, abbr, 0, fields); - // Array packing routine - std::string routine_name = mod.nickname + "_Pack" + tmp[2] + "Ary"; + // Var packing routine + std::string routine_name = mod.nickname + "_Pack" + tmp[2] + "Var"; std::string indent("\n"); - std::string var_str = std::string("Vars%") + abbr; - w << indent << "subroutine " << routine_name << "(Vars, " << abbr << ", ValAry)"; + std::string var_str = std::string("Var"); + w << indent << "subroutine " << routine_name << "(Var, " << abbr << ", ValAry)"; indent += " "; w << indent << "type(" << ddt.type_fortran << "), intent(in) :: " << abbr; - w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "type(ModVarType), intent(in) :: Var"; w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; w << indent << "integer(IntKi) :: i"; - w << indent << "do i = 1, size(" << var_str << ")"; - indent += " "; - w << indent << "associate (Var => " << var_str << "(i), DL => " << var_str << "(i)%DL)"; + w << indent << "associate (DL => Var%DL)"; indent += " "; w << indent << "select case (Var%DL%Num)"; for (const auto &field : fields) @@ -502,29 +500,42 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) { comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; } - w << indent << " call MV_Pack2(Var, " << field_path << ", ValAry) ! " << comment; + w << indent << " call MV_Pack2(Var, " << field_path << ", ValAry) ! " << comment; } + w << indent << "case default"; + w << indent << " ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki"; w << indent << "end select"; indent.erase(indent.size() - 3); w << indent << "end associate"; indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + // Vars packing routine + indent = "\n"; + w << indent << "subroutine " << mod.nickname + "_Pack" + tmp[2] + "Ary" << "(Vars, " << abbr << ", ValAry)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), intent(in) :: " << abbr; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; + w << indent << "integer(IntKi) :: i"; + w << indent << "do i = 1, size(Vars%" << abbr << ")"; + w << indent << " call " << routine_name << "(Vars%" << abbr << "(i), " << abbr << ", ValAry)"; w << indent << "end do"; indent.erase(indent.size() - 3); w << indent << "end subroutine"; w << indent; - // Array unpacking routine - routine_name = mod.nickname + "_Unpack" + tmp[2] + "Ary"; + // Var unpacking routine + routine_name = mod.nickname + "_Unpack" + tmp[2] + "Var"; indent = "\n"; - w << indent << "subroutine " << routine_name << "(Vars, ValAry, "<< abbr <<")"; + w << indent << "subroutine " << routine_name << "(Var, ValAry, " << abbr << ")"; indent += " "; - w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "type(ModVarType), intent(in) :: Var"; w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << abbr; w << indent << "integer(IntKi) :: i"; - w << indent << "do i = 1, size(" << var_str << ")"; - indent += " "; - w << indent << "associate (Var => " << var_str << "(i), DL => " << var_str << "(i)%DL)"; + w << indent << "associate (DL => Var%DL)"; indent += " "; w << indent << "select case (Var%DL%Num)"; for (const auto &field : fields) @@ -540,16 +551,30 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) { comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; } - w << indent << " call MV_Unpack2(Var, ValAry, " << field_path << ") ! " << comment; + w << indent << " call MV_Unpack2(Var, ValAry, " << field_path << ") ! " << comment; } w << indent << "end select"; indent.erase(indent.size() - 3); w << indent << "end associate"; indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + // Vars unpacking routine + indent = "\n"; + w << indent << "subroutine " << mod.nickname + "_Unpack" + tmp[2] + "Ary" << "(Vars, ValAry, " << abbr << ")"; + indent += " "; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << abbr; + w << indent << "integer(IntKi) :: i"; + w << indent << "do i = 1, size(Vars%" << abbr << ")"; + w << indent << " call " << routine_name << "(Vars%" << abbr << "(i), ValAry, " << abbr << ")"; w << indent << "end do"; indent.erase(indent.size() - 3); w << indent << "end subroutine"; w << indent; + w << indent; } } diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 288b88bda6..0a08515224 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -1200,128 +1200,204 @@ function Orca_OutputMeshName(ML) result(Name) end select end function +subroutine Orca_PackContStateVar(Var, x, ValAry) + type(Orca_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Orca_x_Dummy) + call MV_Pack2(Var, x%Dummy, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Orca_PackContStateAry(Vars, x, ValAry) type(Orca_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (Orca_x_Dummy) - call MV_Pack2(Var, x%Dummy, ValAry) ! Scalar - end select - end associate + call Orca_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine Orca_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Orca_x_Dummy) + call MV_Unpack2(Var, ValAry, x%Dummy) ! Scalar + end select + end associate +end subroutine + subroutine Orca_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Orca_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (Orca_x_Dummy) - call MV_Unpack2(Var, ValAry, x%Dummy) ! Scalar - end select - end associate + call Orca_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine Orca_PackConstrStateVar(Var, z, ValAry) + type(Orca_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Orca_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Orca_PackConstrStateAry(Vars, z, ValAry) type(Orca_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (Orca_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call Orca_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine Orca_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Orca_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine Orca_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Orca_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (Orca_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call Orca_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine Orca_PackInputVar(Var, u, ValAry) + type(Orca_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Orca_u_PtfmMesh) + call MV_Pack2(Var, u%PtfmMesh, ValAry) ! Mesh + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Orca_PackInputAry(Vars, u, ValAry) type(Orca_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (Orca_u_PtfmMesh) - call MV_Pack2(Var, u%PtfmMesh, ValAry) ! Mesh - end select - end associate + call Orca_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine Orca_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Orca_u_PtfmMesh) + call MV_Unpack2(Var, ValAry, u%PtfmMesh) ! Mesh + end select + end associate +end subroutine + subroutine Orca_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Orca_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (Orca_u_PtfmMesh) - call MV_Unpack2(Var, ValAry, u%PtfmMesh) ! Mesh - end select - end associate + call Orca_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine Orca_PackOutputVar(Var, y, ValAry) + type(Orca_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Orca_y_PtfmMesh) + call MV_Pack2(Var, y%PtfmMesh, ValAry) ! Mesh + case (Orca_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine Orca_PackOutputAry(Vars, y, ValAry) type(Orca_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (Orca_y_PtfmMesh) - call MV_Pack2(Var, y%PtfmMesh, ValAry) ! Mesh - case (Orca_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call Orca_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine Orca_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (Orca_y_PtfmMesh) + call MV_Unpack2(Var, ValAry, y%PtfmMesh) ! Mesh + case (Orca_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine Orca_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Orca_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (Orca_y_PtfmMesh) - call MV_Unpack2(Var, ValAry, y%PtfmMesh) ! Mesh - case (Orca_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call Orca_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE OrcaFlexInterface_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 34f2968200..714f829d1b 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -858,8 +858,8 @@ subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Initialize Jacobian to zero dYdu = 0.0_R8Ki - iVar_u_WaveElev0 = MV_FindVarDatLoc(p%Vars%u, SeaSt_u_WaveElev0) - iVar_y_WaveElev0 = MV_FindVarDatLoc(p%Vars%y, SeaSt_y_WaveElev0) + iVar_u_WaveElev0 = MV_FindVarDatLoc(p%Vars%u, DatLoc(SeaSt_u_WaveElev0)) + iVar_y_WaveElev0 = MV_FindVarDatLoc(p%Vars%y, DatLoc(SeaSt_y_WaveElev0)) ! Extended input to extended output (direct pass-through) if (iVar_u_WaveElev0 > 0 .and. iVar_y_WaveElev0 > 0) then diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index dba6c60a71..8a70473da4 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -1412,124 +1412,200 @@ function SeaSt_OutputMeshName(ML) result(Name) end select end function +subroutine SeaSt_PackContStateVar(Var, x, ValAry) + type(SeaSt_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SeaSt_x_UnusedStates) + call MV_Pack2(Var, x%UnusedStates, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SeaSt_PackContStateAry(Vars, x, ValAry) type(SeaSt_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SeaSt_x_UnusedStates) - call MV_Pack2(Var, x%UnusedStates, ValAry) ! Scalar - end select - end associate + call SeaSt_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine SeaSt_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SeaSt_x_UnusedStates) + call MV_Unpack2(Var, ValAry, x%UnusedStates) ! Scalar + end select + end associate +end subroutine + subroutine SeaSt_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SeaSt_x_UnusedStates) - call MV_Unpack2(Var, ValAry, x%UnusedStates) ! Scalar - end select - end associate + call SeaSt_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine SeaSt_PackConstrStateVar(Var, z, ValAry) + type(SeaSt_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SeaSt_z_UnusedStates) + call MV_Pack2(Var, z%UnusedStates, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SeaSt_PackConstrStateAry(Vars, z, ValAry) type(SeaSt_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SeaSt_z_UnusedStates) - call MV_Pack2(Var, z%UnusedStates, ValAry) ! Scalar - end select - end associate + call SeaSt_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine SeaSt_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SeaSt_z_UnusedStates) + call MV_Unpack2(Var, ValAry, z%UnusedStates) ! Scalar + end select + end associate +end subroutine + subroutine SeaSt_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SeaSt_z_UnusedStates) - call MV_Unpack2(Var, ValAry, z%UnusedStates) ! Scalar - end select - end associate + call SeaSt_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine SeaSt_PackInputVar(Var, u, ValAry) + type(SeaSt_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SeaSt_u_DummyInput) + call MV_Pack2(Var, u%DummyInput, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SeaSt_PackInputAry(Vars, u, ValAry) type(SeaSt_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SeaSt_u_DummyInput) - call MV_Pack2(Var, u%DummyInput, ValAry) ! Scalar - end select - end associate + call SeaSt_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine SeaSt_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SeaSt_u_DummyInput) + call MV_Unpack2(Var, ValAry, u%DummyInput) ! Scalar + end select + end associate +end subroutine + subroutine SeaSt_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SeaSt_u_DummyInput) - call MV_Unpack2(Var, ValAry, u%DummyInput) ! Scalar - end select - end associate + call SeaSt_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine SeaSt_PackOutputVar(Var, y, ValAry) + type(SeaSt_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SeaSt_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SeaSt_PackOutputAry(Vars, y, ValAry) type(SeaSt_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SeaSt_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call SeaSt_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine SeaSt_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SeaSt_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SeaSt_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SeaSt_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call SeaSt_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE SeaState_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index dfcc9d7a4c..434609d9db 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -7284,416 +7284,492 @@ function SrvD_OutputMeshName(ML) result(Name) end select end function +subroutine SrvD_PackContStateVar(Var, x, ValAry) + type(SrvD_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SrvD_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + case (SrvD_x_BStC_StC_x) + call MV_Pack2(Var, x%BStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + call MV_Pack2(Var, x%NStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + call MV_Pack2(Var, x%TStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + call MV_Pack2(Var, x%SStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SrvD_PackContStateAry(Vars, x, ValAry) type(SrvD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SrvD_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - case (SrvD_x_BStC_StC_x) - call MV_Pack2(Var, x%BStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array - case (SrvD_x_NStC_StC_x) - call MV_Pack2(Var, x%NStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array - case (SrvD_x_TStC_StC_x) - call MV_Pack2(Var, x%TStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array - case (SrvD_x_SStC_StC_x) - call MV_Pack2(Var, x%SStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array - end select - end associate + call SrvD_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine SrvD_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SrvD_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + case (SrvD_x_BStC_StC_x) + call MV_Unpack2(Var, ValAry, x%BStC(DL%i1)%StC_x) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + call MV_Unpack2(Var, ValAry, x%NStC(DL%i1)%StC_x) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + call MV_Unpack2(Var, ValAry, x%TStC(DL%i1)%StC_x) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + call MV_Unpack2(Var, ValAry, x%SStC(DL%i1)%StC_x) ! Rank 2 Array + end select + end associate +end subroutine + subroutine SrvD_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SrvD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SrvD_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - case (SrvD_x_BStC_StC_x) - call MV_Unpack2(Var, ValAry, x%BStC(DL%i1)%StC_x) ! Rank 2 Array - case (SrvD_x_NStC_StC_x) - call MV_Unpack2(Var, ValAry, x%NStC(DL%i1)%StC_x) ! Rank 2 Array - case (SrvD_x_TStC_StC_x) - call MV_Unpack2(Var, ValAry, x%TStC(DL%i1)%StC_x) ! Rank 2 Array - case (SrvD_x_SStC_StC_x) - call MV_Unpack2(Var, ValAry, x%SStC(DL%i1)%StC_x) ! Rank 2 Array - end select - end associate + call SrvD_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine SrvD_PackConstrStateVar(Var, z, ValAry) + type(SrvD_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SrvD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_BStC_DummyConstrState) + call MV_Pack2(Var, z%BStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_NStC_DummyConstrState) + call MV_Pack2(Var, z%NStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_TStC_DummyConstrState) + call MV_Pack2(Var, z%TStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_SStC_DummyConstrState) + call MV_Pack2(Var, z%SStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SrvD_PackConstrStateAry(Vars, z, ValAry) type(SrvD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SrvD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_BStC_DummyConstrState) - call MV_Pack2(Var, z%BStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_NStC_DummyConstrState) - call MV_Pack2(Var, z%NStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_TStC_DummyConstrState) - call MV_Pack2(Var, z%TStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_SStC_DummyConstrState) - call MV_Pack2(Var, z%SStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - end select - end associate + call SrvD_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine SrvD_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SrvD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + case (SrvD_z_BStC_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%BStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_NStC_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%NStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_TStC_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%TStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_SStC_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%SStC(DL%i1)%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine SrvD_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SrvD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SrvD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - case (SrvD_z_BStC_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%BStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_NStC_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%NStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_TStC_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%TStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_SStC_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%SStC(DL%i1)%DummyConstrState) ! Scalar - end select - end associate + call SrvD_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine SrvD_PackInputVar(Var, u, ValAry) + type(SrvD_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SrvD_u_BlPitch) + call MV_Pack2(Var, u%BlPitch, ValAry) ! Rank 1 Array + case (SrvD_u_Yaw) + call MV_Pack2(Var, u%Yaw, ValAry) ! Scalar + case (SrvD_u_YawRate) + call MV_Pack2(Var, u%YawRate, ValAry) ! Scalar + case (SrvD_u_LSS_Spd) + call MV_Pack2(Var, u%LSS_Spd, ValAry) ! Scalar + case (SrvD_u_HSS_Spd) + call MV_Pack2(Var, u%HSS_Spd, ValAry) ! Scalar + case (SrvD_u_RotSpeed) + call MV_Pack2(Var, u%RotSpeed, ValAry) ! Scalar + case (SrvD_u_ExternalYawPosCom) + call MV_Pack2(Var, u%ExternalYawPosCom, ValAry) ! Scalar + case (SrvD_u_ExternalYawRateCom) + call MV_Pack2(Var, u%ExternalYawRateCom, ValAry) ! Scalar + case (SrvD_u_ExternalBlPitchCom) + call MV_Pack2(Var, u%ExternalBlPitchCom, ValAry) ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + call MV_Pack2(Var, u%ExternalGenTrq, ValAry) ! Scalar + case (SrvD_u_ExternalElecPwr) + call MV_Pack2(Var, u%ExternalElecPwr, ValAry) ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + call MV_Pack2(Var, u%ExternalHSSBrFrac, ValAry) ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + call MV_Pack2(Var, u%ExternalBlAirfoilCom, ValAry) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + call MV_Pack2(Var, u%ExternalCableDeltaL, ValAry) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + call MV_Pack2(Var, u%ExternalCableDeltaLdot, ValAry) ! Rank 1 Array + case (SrvD_u_TwrAccel) + call MV_Pack2(Var, u%TwrAccel, ValAry) ! Scalar + case (SrvD_u_YawErr) + call MV_Pack2(Var, u%YawErr, ValAry) ! Scalar + case (SrvD_u_WindDir) + call MV_Pack2(Var, u%WindDir, ValAry) ! Scalar + case (SrvD_u_RootMyc) + call MV_Pack2(Var, u%RootMyc, ValAry) ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + call MV_Pack2(Var, u%YawBrTAxp, ValAry) ! Scalar + case (SrvD_u_YawBrTAyp) + call MV_Pack2(Var, u%YawBrTAyp, ValAry) ! Scalar + case (SrvD_u_LSSTipPxa) + call MV_Pack2(Var, u%LSSTipPxa, ValAry) ! Scalar + case (SrvD_u_RootMxc) + call MV_Pack2(Var, u%RootMxc, ValAry) ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + call MV_Pack2(Var, u%LSSTipMxa, ValAry) ! Scalar + case (SrvD_u_LSSTipMya) + call MV_Pack2(Var, u%LSSTipMya, ValAry) ! Scalar + case (SrvD_u_LSSTipMza) + call MV_Pack2(Var, u%LSSTipMza, ValAry) ! Scalar + case (SrvD_u_LSSTipMys) + call MV_Pack2(Var, u%LSSTipMys, ValAry) ! Scalar + case (SrvD_u_LSSTipMzs) + call MV_Pack2(Var, u%LSSTipMzs, ValAry) ! Scalar + case (SrvD_u_YawBrMyn) + call MV_Pack2(Var, u%YawBrMyn, ValAry) ! Scalar + case (SrvD_u_YawBrMzn) + call MV_Pack2(Var, u%YawBrMzn, ValAry) ! Scalar + case (SrvD_u_NcIMURAxs) + call MV_Pack2(Var, u%NcIMURAxs, ValAry) ! Scalar + case (SrvD_u_NcIMURAys) + call MV_Pack2(Var, u%NcIMURAys, ValAry) ! Scalar + case (SrvD_u_NcIMURAzs) + call MV_Pack2(Var, u%NcIMURAzs, ValAry) ! Scalar + case (SrvD_u_RotPwr) + call MV_Pack2(Var, u%RotPwr, ValAry) ! Scalar + case (SrvD_u_HorWindV) + call MV_Pack2(Var, u%HorWindV, ValAry) ! Scalar + case (SrvD_u_YawAngle) + call MV_Pack2(Var, u%YawAngle, ValAry) ! Scalar + case (SrvD_u_LSShftFxa) + call MV_Pack2(Var, u%LSShftFxa, ValAry) ! Scalar + case (SrvD_u_LSShftFys) + call MV_Pack2(Var, u%LSShftFys, ValAry) ! Scalar + case (SrvD_u_LSShftFzs) + call MV_Pack2(Var, u%LSShftFzs, ValAry) ! Scalar + case (SrvD_u_fromSC) + call MV_Pack2(Var, u%fromSC, ValAry) ! Rank 1 Array + case (SrvD_u_fromSCglob) + call MV_Pack2(Var, u%fromSCglob, ValAry) ! Rank 1 Array + case (SrvD_u_Lidar) + call MV_Pack2(Var, u%Lidar, ValAry) ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_Pack2(Var, u%PtfmMotionMesh, ValAry) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_Pack2(Var, u%BStCMotionMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_Pack2(Var, u%NStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_Pack2(Var, u%TStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_Pack2(Var, u%SStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_LidSpeed) + call MV_Pack2(Var, u%LidSpeed, ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + call MV_Pack2(Var, u%MsrPositionsX, ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + call MV_Pack2(Var, u%MsrPositionsY, ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + call MV_Pack2(Var, u%MsrPositionsZ, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SrvD_PackInputAry(Vars, u, ValAry) type(SrvD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SrvD_u_BlPitch) - call MV_Pack2(Var, u%BlPitch, ValAry) ! Rank 1 Array - case (SrvD_u_Yaw) - call MV_Pack2(Var, u%Yaw, ValAry) ! Scalar - case (SrvD_u_YawRate) - call MV_Pack2(Var, u%YawRate, ValAry) ! Scalar - case (SrvD_u_LSS_Spd) - call MV_Pack2(Var, u%LSS_Spd, ValAry) ! Scalar - case (SrvD_u_HSS_Spd) - call MV_Pack2(Var, u%HSS_Spd, ValAry) ! Scalar - case (SrvD_u_RotSpeed) - call MV_Pack2(Var, u%RotSpeed, ValAry) ! Scalar - case (SrvD_u_ExternalYawPosCom) - call MV_Pack2(Var, u%ExternalYawPosCom, ValAry) ! Scalar - case (SrvD_u_ExternalYawRateCom) - call MV_Pack2(Var, u%ExternalYawRateCom, ValAry) ! Scalar - case (SrvD_u_ExternalBlPitchCom) - call MV_Pack2(Var, u%ExternalBlPitchCom, ValAry) ! Rank 1 Array - case (SrvD_u_ExternalGenTrq) - call MV_Pack2(Var, u%ExternalGenTrq, ValAry) ! Scalar - case (SrvD_u_ExternalElecPwr) - call MV_Pack2(Var, u%ExternalElecPwr, ValAry) ! Scalar - case (SrvD_u_ExternalHSSBrFrac) - call MV_Pack2(Var, u%ExternalHSSBrFrac, ValAry) ! Scalar - case (SrvD_u_ExternalBlAirfoilCom) - call MV_Pack2(Var, u%ExternalBlAirfoilCom, ValAry) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaL) - call MV_Pack2(Var, u%ExternalCableDeltaL, ValAry) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaLdot) - call MV_Pack2(Var, u%ExternalCableDeltaLdot, ValAry) ! Rank 1 Array - case (SrvD_u_TwrAccel) - call MV_Pack2(Var, u%TwrAccel, ValAry) ! Scalar - case (SrvD_u_YawErr) - call MV_Pack2(Var, u%YawErr, ValAry) ! Scalar - case (SrvD_u_WindDir) - call MV_Pack2(Var, u%WindDir, ValAry) ! Scalar - case (SrvD_u_RootMyc) - call MV_Pack2(Var, u%RootMyc, ValAry) ! Rank 1 Array - case (SrvD_u_YawBrTAxp) - call MV_Pack2(Var, u%YawBrTAxp, ValAry) ! Scalar - case (SrvD_u_YawBrTAyp) - call MV_Pack2(Var, u%YawBrTAyp, ValAry) ! Scalar - case (SrvD_u_LSSTipPxa) - call MV_Pack2(Var, u%LSSTipPxa, ValAry) ! Scalar - case (SrvD_u_RootMxc) - call MV_Pack2(Var, u%RootMxc, ValAry) ! Rank 1 Array - case (SrvD_u_LSSTipMxa) - call MV_Pack2(Var, u%LSSTipMxa, ValAry) ! Scalar - case (SrvD_u_LSSTipMya) - call MV_Pack2(Var, u%LSSTipMya, ValAry) ! Scalar - case (SrvD_u_LSSTipMza) - call MV_Pack2(Var, u%LSSTipMza, ValAry) ! Scalar - case (SrvD_u_LSSTipMys) - call MV_Pack2(Var, u%LSSTipMys, ValAry) ! Scalar - case (SrvD_u_LSSTipMzs) - call MV_Pack2(Var, u%LSSTipMzs, ValAry) ! Scalar - case (SrvD_u_YawBrMyn) - call MV_Pack2(Var, u%YawBrMyn, ValAry) ! Scalar - case (SrvD_u_YawBrMzn) - call MV_Pack2(Var, u%YawBrMzn, ValAry) ! Scalar - case (SrvD_u_NcIMURAxs) - call MV_Pack2(Var, u%NcIMURAxs, ValAry) ! Scalar - case (SrvD_u_NcIMURAys) - call MV_Pack2(Var, u%NcIMURAys, ValAry) ! Scalar - case (SrvD_u_NcIMURAzs) - call MV_Pack2(Var, u%NcIMURAzs, ValAry) ! Scalar - case (SrvD_u_RotPwr) - call MV_Pack2(Var, u%RotPwr, ValAry) ! Scalar - case (SrvD_u_HorWindV) - call MV_Pack2(Var, u%HorWindV, ValAry) ! Scalar - case (SrvD_u_YawAngle) - call MV_Pack2(Var, u%YawAngle, ValAry) ! Scalar - case (SrvD_u_LSShftFxa) - call MV_Pack2(Var, u%LSShftFxa, ValAry) ! Scalar - case (SrvD_u_LSShftFys) - call MV_Pack2(Var, u%LSShftFys, ValAry) ! Scalar - case (SrvD_u_LSShftFzs) - call MV_Pack2(Var, u%LSShftFzs, ValAry) ! Scalar - case (SrvD_u_fromSC) - call MV_Pack2(Var, u%fromSC, ValAry) ! Rank 1 Array - case (SrvD_u_fromSCglob) - call MV_Pack2(Var, u%fromSCglob, ValAry) ! Rank 1 Array - case (SrvD_u_Lidar) - call MV_Pack2(Var, u%Lidar, ValAry) ! Rank 1 Array - case (SrvD_u_PtfmMotionMesh) - call MV_Pack2(Var, u%PtfmMotionMesh, ValAry) ! Mesh - case (SrvD_u_BStCMotionMesh) - call MV_Pack2(Var, u%BStCMotionMesh(DL%i1, DL%i2), ValAry) ! Mesh - case (SrvD_u_NStCMotionMesh) - call MV_Pack2(Var, u%NStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_TStCMotionMesh) - call MV_Pack2(Var, u%TStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_SStCMotionMesh) - call MV_Pack2(Var, u%SStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_LidSpeed) - call MV_Pack2(Var, u%LidSpeed, ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsX) - call MV_Pack2(Var, u%MsrPositionsX, ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsY) - call MV_Pack2(Var, u%MsrPositionsY, ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsZ) - call MV_Pack2(Var, u%MsrPositionsZ, ValAry) ! Rank 1 Array - end select - end associate + call SrvD_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine SrvD_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SrvD_u_BlPitch) + call MV_Unpack2(Var, ValAry, u%BlPitch) ! Rank 1 Array + case (SrvD_u_Yaw) + call MV_Unpack2(Var, ValAry, u%Yaw) ! Scalar + case (SrvD_u_YawRate) + call MV_Unpack2(Var, ValAry, u%YawRate) ! Scalar + case (SrvD_u_LSS_Spd) + call MV_Unpack2(Var, ValAry, u%LSS_Spd) ! Scalar + case (SrvD_u_HSS_Spd) + call MV_Unpack2(Var, ValAry, u%HSS_Spd) ! Scalar + case (SrvD_u_RotSpeed) + call MV_Unpack2(Var, ValAry, u%RotSpeed) ! Scalar + case (SrvD_u_ExternalYawPosCom) + call MV_Unpack2(Var, ValAry, u%ExternalYawPosCom) ! Scalar + case (SrvD_u_ExternalYawRateCom) + call MV_Unpack2(Var, ValAry, u%ExternalYawRateCom) ! Scalar + case (SrvD_u_ExternalBlPitchCom) + call MV_Unpack2(Var, ValAry, u%ExternalBlPitchCom) ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + call MV_Unpack2(Var, ValAry, u%ExternalGenTrq) ! Scalar + case (SrvD_u_ExternalElecPwr) + call MV_Unpack2(Var, ValAry, u%ExternalElecPwr) ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + call MV_Unpack2(Var, ValAry, u%ExternalHSSBrFrac) ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + call MV_Unpack2(Var, ValAry, u%ExternalBlAirfoilCom) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + call MV_Unpack2(Var, ValAry, u%ExternalCableDeltaL) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + call MV_Unpack2(Var, ValAry, u%ExternalCableDeltaLdot) ! Rank 1 Array + case (SrvD_u_TwrAccel) + call MV_Unpack2(Var, ValAry, u%TwrAccel) ! Scalar + case (SrvD_u_YawErr) + call MV_Unpack2(Var, ValAry, u%YawErr) ! Scalar + case (SrvD_u_WindDir) + call MV_Unpack2(Var, ValAry, u%WindDir) ! Scalar + case (SrvD_u_RootMyc) + call MV_Unpack2(Var, ValAry, u%RootMyc) ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + call MV_Unpack2(Var, ValAry, u%YawBrTAxp) ! Scalar + case (SrvD_u_YawBrTAyp) + call MV_Unpack2(Var, ValAry, u%YawBrTAyp) ! Scalar + case (SrvD_u_LSSTipPxa) + call MV_Unpack2(Var, ValAry, u%LSSTipPxa) ! Scalar + case (SrvD_u_RootMxc) + call MV_Unpack2(Var, ValAry, u%RootMxc) ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + call MV_Unpack2(Var, ValAry, u%LSSTipMxa) ! Scalar + case (SrvD_u_LSSTipMya) + call MV_Unpack2(Var, ValAry, u%LSSTipMya) ! Scalar + case (SrvD_u_LSSTipMza) + call MV_Unpack2(Var, ValAry, u%LSSTipMza) ! Scalar + case (SrvD_u_LSSTipMys) + call MV_Unpack2(Var, ValAry, u%LSSTipMys) ! Scalar + case (SrvD_u_LSSTipMzs) + call MV_Unpack2(Var, ValAry, u%LSSTipMzs) ! Scalar + case (SrvD_u_YawBrMyn) + call MV_Unpack2(Var, ValAry, u%YawBrMyn) ! Scalar + case (SrvD_u_YawBrMzn) + call MV_Unpack2(Var, ValAry, u%YawBrMzn) ! Scalar + case (SrvD_u_NcIMURAxs) + call MV_Unpack2(Var, ValAry, u%NcIMURAxs) ! Scalar + case (SrvD_u_NcIMURAys) + call MV_Unpack2(Var, ValAry, u%NcIMURAys) ! Scalar + case (SrvD_u_NcIMURAzs) + call MV_Unpack2(Var, ValAry, u%NcIMURAzs) ! Scalar + case (SrvD_u_RotPwr) + call MV_Unpack2(Var, ValAry, u%RotPwr) ! Scalar + case (SrvD_u_HorWindV) + call MV_Unpack2(Var, ValAry, u%HorWindV) ! Scalar + case (SrvD_u_YawAngle) + call MV_Unpack2(Var, ValAry, u%YawAngle) ! Scalar + case (SrvD_u_LSShftFxa) + call MV_Unpack2(Var, ValAry, u%LSShftFxa) ! Scalar + case (SrvD_u_LSShftFys) + call MV_Unpack2(Var, ValAry, u%LSShftFys) ! Scalar + case (SrvD_u_LSShftFzs) + call MV_Unpack2(Var, ValAry, u%LSShftFzs) ! Scalar + case (SrvD_u_fromSC) + call MV_Unpack2(Var, ValAry, u%fromSC) ! Rank 1 Array + case (SrvD_u_fromSCglob) + call MV_Unpack2(Var, ValAry, u%fromSCglob) ! Rank 1 Array + case (SrvD_u_Lidar) + call MV_Unpack2(Var, ValAry, u%Lidar) ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_Unpack2(Var, ValAry, u%PtfmMotionMesh) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_Unpack2(Var, ValAry, u%BStCMotionMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_Unpack2(Var, ValAry, u%NStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_Unpack2(Var, ValAry, u%TStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_Unpack2(Var, ValAry, u%SStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_LidSpeed) + call MV_Unpack2(Var, ValAry, u%LidSpeed) ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + call MV_Unpack2(Var, ValAry, u%MsrPositionsX) ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + call MV_Unpack2(Var, ValAry, u%MsrPositionsY) ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + call MV_Unpack2(Var, ValAry, u%MsrPositionsZ) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SrvD_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SrvD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SrvD_u_BlPitch) - call MV_Unpack2(Var, ValAry, u%BlPitch) ! Rank 1 Array - case (SrvD_u_Yaw) - call MV_Unpack2(Var, ValAry, u%Yaw) ! Scalar - case (SrvD_u_YawRate) - call MV_Unpack2(Var, ValAry, u%YawRate) ! Scalar - case (SrvD_u_LSS_Spd) - call MV_Unpack2(Var, ValAry, u%LSS_Spd) ! Scalar - case (SrvD_u_HSS_Spd) - call MV_Unpack2(Var, ValAry, u%HSS_Spd) ! Scalar - case (SrvD_u_RotSpeed) - call MV_Unpack2(Var, ValAry, u%RotSpeed) ! Scalar - case (SrvD_u_ExternalYawPosCom) - call MV_Unpack2(Var, ValAry, u%ExternalYawPosCom) ! Scalar - case (SrvD_u_ExternalYawRateCom) - call MV_Unpack2(Var, ValAry, u%ExternalYawRateCom) ! Scalar - case (SrvD_u_ExternalBlPitchCom) - call MV_Unpack2(Var, ValAry, u%ExternalBlPitchCom) ! Rank 1 Array - case (SrvD_u_ExternalGenTrq) - call MV_Unpack2(Var, ValAry, u%ExternalGenTrq) ! Scalar - case (SrvD_u_ExternalElecPwr) - call MV_Unpack2(Var, ValAry, u%ExternalElecPwr) ! Scalar - case (SrvD_u_ExternalHSSBrFrac) - call MV_Unpack2(Var, ValAry, u%ExternalHSSBrFrac) ! Scalar - case (SrvD_u_ExternalBlAirfoilCom) - call MV_Unpack2(Var, ValAry, u%ExternalBlAirfoilCom) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaL) - call MV_Unpack2(Var, ValAry, u%ExternalCableDeltaL) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaLdot) - call MV_Unpack2(Var, ValAry, u%ExternalCableDeltaLdot) ! Rank 1 Array - case (SrvD_u_TwrAccel) - call MV_Unpack2(Var, ValAry, u%TwrAccel) ! Scalar - case (SrvD_u_YawErr) - call MV_Unpack2(Var, ValAry, u%YawErr) ! Scalar - case (SrvD_u_WindDir) - call MV_Unpack2(Var, ValAry, u%WindDir) ! Scalar - case (SrvD_u_RootMyc) - call MV_Unpack2(Var, ValAry, u%RootMyc) ! Rank 1 Array - case (SrvD_u_YawBrTAxp) - call MV_Unpack2(Var, ValAry, u%YawBrTAxp) ! Scalar - case (SrvD_u_YawBrTAyp) - call MV_Unpack2(Var, ValAry, u%YawBrTAyp) ! Scalar - case (SrvD_u_LSSTipPxa) - call MV_Unpack2(Var, ValAry, u%LSSTipPxa) ! Scalar - case (SrvD_u_RootMxc) - call MV_Unpack2(Var, ValAry, u%RootMxc) ! Rank 1 Array - case (SrvD_u_LSSTipMxa) - call MV_Unpack2(Var, ValAry, u%LSSTipMxa) ! Scalar - case (SrvD_u_LSSTipMya) - call MV_Unpack2(Var, ValAry, u%LSSTipMya) ! Scalar - case (SrvD_u_LSSTipMza) - call MV_Unpack2(Var, ValAry, u%LSSTipMza) ! Scalar - case (SrvD_u_LSSTipMys) - call MV_Unpack2(Var, ValAry, u%LSSTipMys) ! Scalar - case (SrvD_u_LSSTipMzs) - call MV_Unpack2(Var, ValAry, u%LSSTipMzs) ! Scalar - case (SrvD_u_YawBrMyn) - call MV_Unpack2(Var, ValAry, u%YawBrMyn) ! Scalar - case (SrvD_u_YawBrMzn) - call MV_Unpack2(Var, ValAry, u%YawBrMzn) ! Scalar - case (SrvD_u_NcIMURAxs) - call MV_Unpack2(Var, ValAry, u%NcIMURAxs) ! Scalar - case (SrvD_u_NcIMURAys) - call MV_Unpack2(Var, ValAry, u%NcIMURAys) ! Scalar - case (SrvD_u_NcIMURAzs) - call MV_Unpack2(Var, ValAry, u%NcIMURAzs) ! Scalar - case (SrvD_u_RotPwr) - call MV_Unpack2(Var, ValAry, u%RotPwr) ! Scalar - case (SrvD_u_HorWindV) - call MV_Unpack2(Var, ValAry, u%HorWindV) ! Scalar - case (SrvD_u_YawAngle) - call MV_Unpack2(Var, ValAry, u%YawAngle) ! Scalar - case (SrvD_u_LSShftFxa) - call MV_Unpack2(Var, ValAry, u%LSShftFxa) ! Scalar - case (SrvD_u_LSShftFys) - call MV_Unpack2(Var, ValAry, u%LSShftFys) ! Scalar - case (SrvD_u_LSShftFzs) - call MV_Unpack2(Var, ValAry, u%LSShftFzs) ! Scalar - case (SrvD_u_fromSC) - call MV_Unpack2(Var, ValAry, u%fromSC) ! Rank 1 Array - case (SrvD_u_fromSCglob) - call MV_Unpack2(Var, ValAry, u%fromSCglob) ! Rank 1 Array - case (SrvD_u_Lidar) - call MV_Unpack2(Var, ValAry, u%Lidar) ! Rank 1 Array - case (SrvD_u_PtfmMotionMesh) - call MV_Unpack2(Var, ValAry, u%PtfmMotionMesh) ! Mesh - case (SrvD_u_BStCMotionMesh) - call MV_Unpack2(Var, ValAry, u%BStCMotionMesh(DL%i1, DL%i2)) ! Mesh - case (SrvD_u_NStCMotionMesh) - call MV_Unpack2(Var, ValAry, u%NStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_TStCMotionMesh) - call MV_Unpack2(Var, ValAry, u%TStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_SStCMotionMesh) - call MV_Unpack2(Var, ValAry, u%SStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_LidSpeed) - call MV_Unpack2(Var, ValAry, u%LidSpeed) ! Rank 1 Array - case (SrvD_u_MsrPositionsX) - call MV_Unpack2(Var, ValAry, u%MsrPositionsX) ! Rank 1 Array - case (SrvD_u_MsrPositionsY) - call MV_Unpack2(Var, ValAry, u%MsrPositionsY) ! Rank 1 Array - case (SrvD_u_MsrPositionsZ) - call MV_Unpack2(Var, ValAry, u%MsrPositionsZ) ! Rank 1 Array - end select - end associate + call SrvD_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine SrvD_PackOutputVar(Var, y, ValAry) + type(SrvD_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SrvD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case (SrvD_y_BlPitchCom) + call MV_Pack2(Var, y%BlPitchCom, ValAry) ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + call MV_Pack2(Var, y%BlAirfoilCom, ValAry) ! Rank 1 Array + case (SrvD_y_YawMom) + call MV_Pack2(Var, y%YawMom, ValAry) ! Scalar + case (SrvD_y_GenTrq) + call MV_Pack2(Var, y%GenTrq, ValAry) ! Scalar + case (SrvD_y_HSSBrTrqC) + call MV_Pack2(Var, y%HSSBrTrqC, ValAry) ! Scalar + case (SrvD_y_ElecPwr) + call MV_Pack2(Var, y%ElecPwr, ValAry) ! Scalar + case (SrvD_y_TBDrCon) + call MV_Pack2(Var, y%TBDrCon, ValAry) ! Rank 1 Array + case (SrvD_y_Lidar) + call MV_Pack2(Var, y%Lidar, ValAry) ! Rank 1 Array + case (SrvD_y_CableDeltaL) + call MV_Pack2(Var, y%CableDeltaL, ValAry) ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + call MV_Pack2(Var, y%CableDeltaLdot, ValAry) ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_Pack2(Var, y%BStCLoadMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_Pack2(Var, y%NStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_Pack2(Var, y%TStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_Pack2(Var, y%SStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_toSC) + call MV_Pack2(Var, y%toSC, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SrvD_PackOutputAry(Vars, y, ValAry) type(SrvD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SrvD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (SrvD_y_BlPitchCom) - call MV_Pack2(Var, y%BlPitchCom, ValAry) ! Rank 1 Array - case (SrvD_y_BlAirfoilCom) - call MV_Pack2(Var, y%BlAirfoilCom, ValAry) ! Rank 1 Array - case (SrvD_y_YawMom) - call MV_Pack2(Var, y%YawMom, ValAry) ! Scalar - case (SrvD_y_GenTrq) - call MV_Pack2(Var, y%GenTrq, ValAry) ! Scalar - case (SrvD_y_HSSBrTrqC) - call MV_Pack2(Var, y%HSSBrTrqC, ValAry) ! Scalar - case (SrvD_y_ElecPwr) - call MV_Pack2(Var, y%ElecPwr, ValAry) ! Scalar - case (SrvD_y_TBDrCon) - call MV_Pack2(Var, y%TBDrCon, ValAry) ! Rank 1 Array - case (SrvD_y_Lidar) - call MV_Pack2(Var, y%Lidar, ValAry) ! Rank 1 Array - case (SrvD_y_CableDeltaL) - call MV_Pack2(Var, y%CableDeltaL, ValAry) ! Rank 1 Array - case (SrvD_y_CableDeltaLdot) - call MV_Pack2(Var, y%CableDeltaLdot, ValAry) ! Rank 1 Array - case (SrvD_y_BStCLoadMesh) - call MV_Pack2(Var, y%BStCLoadMesh(DL%i1, DL%i2), ValAry) ! Mesh - case (SrvD_y_NStCLoadMesh) - call MV_Pack2(Var, y%NStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_TStCLoadMesh) - call MV_Pack2(Var, y%TStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_SStCLoadMesh) - call MV_Pack2(Var, y%SStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_toSC) - call MV_Pack2(Var, y%toSC, ValAry) ! Rank 1 Array - end select - end associate + call SrvD_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine SrvD_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SrvD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + case (SrvD_y_BlPitchCom) + call MV_Unpack2(Var, ValAry, y%BlPitchCom) ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + call MV_Unpack2(Var, ValAry, y%BlAirfoilCom) ! Rank 1 Array + case (SrvD_y_YawMom) + call MV_Unpack2(Var, ValAry, y%YawMom) ! Scalar + case (SrvD_y_GenTrq) + call MV_Unpack2(Var, ValAry, y%GenTrq) ! Scalar + case (SrvD_y_HSSBrTrqC) + call MV_Unpack2(Var, ValAry, y%HSSBrTrqC) ! Scalar + case (SrvD_y_ElecPwr) + call MV_Unpack2(Var, ValAry, y%ElecPwr) ! Scalar + case (SrvD_y_TBDrCon) + call MV_Unpack2(Var, ValAry, y%TBDrCon) ! Rank 1 Array + case (SrvD_y_Lidar) + call MV_Unpack2(Var, ValAry, y%Lidar) ! Rank 1 Array + case (SrvD_y_CableDeltaL) + call MV_Unpack2(Var, ValAry, y%CableDeltaL) ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + call MV_Unpack2(Var, ValAry, y%CableDeltaLdot) ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_Unpack2(Var, ValAry, y%BStCLoadMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_Unpack2(Var, ValAry, y%NStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_Unpack2(Var, ValAry, y%TStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_Unpack2(Var, ValAry, y%SStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_toSC) + call MV_Unpack2(Var, ValAry, y%toSC) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SrvD_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SrvD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SrvD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (SrvD_y_BlPitchCom) - call MV_Unpack2(Var, ValAry, y%BlPitchCom) ! Rank 1 Array - case (SrvD_y_BlAirfoilCom) - call MV_Unpack2(Var, ValAry, y%BlAirfoilCom) ! Rank 1 Array - case (SrvD_y_YawMom) - call MV_Unpack2(Var, ValAry, y%YawMom) ! Scalar - case (SrvD_y_GenTrq) - call MV_Unpack2(Var, ValAry, y%GenTrq) ! Scalar - case (SrvD_y_HSSBrTrqC) - call MV_Unpack2(Var, ValAry, y%HSSBrTrqC) ! Scalar - case (SrvD_y_ElecPwr) - call MV_Unpack2(Var, ValAry, y%ElecPwr) ! Scalar - case (SrvD_y_TBDrCon) - call MV_Unpack2(Var, ValAry, y%TBDrCon) ! Rank 1 Array - case (SrvD_y_Lidar) - call MV_Unpack2(Var, ValAry, y%Lidar) ! Rank 1 Array - case (SrvD_y_CableDeltaL) - call MV_Unpack2(Var, ValAry, y%CableDeltaL) ! Rank 1 Array - case (SrvD_y_CableDeltaLdot) - call MV_Unpack2(Var, ValAry, y%CableDeltaLdot) ! Rank 1 Array - case (SrvD_y_BStCLoadMesh) - call MV_Unpack2(Var, ValAry, y%BStCLoadMesh(DL%i1, DL%i2)) ! Mesh - case (SrvD_y_NStCLoadMesh) - call MV_Unpack2(Var, ValAry, y%NStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_TStCLoadMesh) - call MV_Unpack2(Var, ValAry, y%TStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_SStCLoadMesh) - call MV_Unpack2(Var, ValAry, y%SStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_toSC) - call MV_Unpack2(Var, ValAry, y%toSC) ! Rank 1 Array - end select - end associate + call SrvD_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE ServoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index f401cb9c57..6f619e99ea 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -2354,148 +2354,224 @@ function StC_OutputMeshName(ML) result(Name) end select end function +subroutine StC_PackContStateVar(Var, x, ValAry) + type(StC_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (StC_x_StC_x) + call MV_Pack2(Var, x%StC_x, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine StC_PackContStateAry(Vars, x, ValAry) type(StC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (StC_x_StC_x) - call MV_Pack2(Var, x%StC_x, ValAry) ! Rank 2 Array - end select - end associate + call StC_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine StC_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (StC_x_StC_x) + call MV_Unpack2(Var, ValAry, x%StC_x) ! Rank 2 Array + end select + end associate +end subroutine + subroutine StC_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(StC_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (StC_x_StC_x) - call MV_Unpack2(Var, ValAry, x%StC_x) ! Rank 2 Array - end select - end associate + call StC_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine StC_PackConstrStateVar(Var, z, ValAry) + type(StC_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (StC_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine StC_PackConstrStateAry(Vars, z, ValAry) type(StC_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (StC_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call StC_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine StC_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (StC_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine StC_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(StC_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (StC_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call StC_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine StC_PackInputVar(Var, u, ValAry) + type(StC_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (StC_u_Mesh) + call MV_Pack2(Var, u%Mesh(DL%i1), ValAry) ! Mesh + case (StC_u_CmdStiff) + call MV_Pack2(Var, u%CmdStiff, ValAry) ! Rank 2 Array + case (StC_u_CmdDamp) + call MV_Pack2(Var, u%CmdDamp, ValAry) ! Rank 2 Array + case (StC_u_CmdBrake) + call MV_Pack2(Var, u%CmdBrake, ValAry) ! Rank 2 Array + case (StC_u_CmdForce) + call MV_Pack2(Var, u%CmdForce, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine StC_PackInputAry(Vars, u, ValAry) type(StC_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (StC_u_Mesh) - call MV_Pack2(Var, u%Mesh(DL%i1), ValAry) ! Mesh - case (StC_u_CmdStiff) - call MV_Pack2(Var, u%CmdStiff, ValAry) ! Rank 2 Array - case (StC_u_CmdDamp) - call MV_Pack2(Var, u%CmdDamp, ValAry) ! Rank 2 Array - case (StC_u_CmdBrake) - call MV_Pack2(Var, u%CmdBrake, ValAry) ! Rank 2 Array - case (StC_u_CmdForce) - call MV_Pack2(Var, u%CmdForce, ValAry) ! Rank 2 Array - end select - end associate + call StC_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine StC_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(StC_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (StC_u_Mesh) + call MV_Unpack2(Var, ValAry, u%Mesh(DL%i1)) ! Mesh + case (StC_u_CmdStiff) + call MV_Unpack2(Var, ValAry, u%CmdStiff) ! Rank 2 Array + case (StC_u_CmdDamp) + call MV_Unpack2(Var, ValAry, u%CmdDamp) ! Rank 2 Array + case (StC_u_CmdBrake) + call MV_Unpack2(Var, ValAry, u%CmdBrake) ! Rank 2 Array + case (StC_u_CmdForce) + call MV_Unpack2(Var, ValAry, u%CmdForce) ! Rank 2 Array + end select + end associate +end subroutine + subroutine StC_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(StC_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (StC_u_Mesh) - call MV_Unpack2(Var, ValAry, u%Mesh(DL%i1)) ! Mesh - case (StC_u_CmdStiff) - call MV_Unpack2(Var, ValAry, u%CmdStiff) ! Rank 2 Array - case (StC_u_CmdDamp) - call MV_Unpack2(Var, ValAry, u%CmdDamp) ! Rank 2 Array - case (StC_u_CmdBrake) - call MV_Unpack2(Var, ValAry, u%CmdBrake) ! Rank 2 Array - case (StC_u_CmdForce) - call MV_Unpack2(Var, ValAry, u%CmdForce) ! Rank 2 Array - end select - end associate + call StC_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine StC_PackOutputVar(Var, y, ValAry) + type(StC_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (StC_y_Mesh) + call MV_Pack2(Var, y%Mesh(DL%i1), ValAry) ! Mesh + case (StC_y_MeasDisp) + call MV_Pack2(Var, y%MeasDisp, ValAry) ! Rank 2 Array + case (StC_y_MeasVel) + call MV_Pack2(Var, y%MeasVel, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine StC_PackOutputAry(Vars, y, ValAry) type(StC_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (StC_y_Mesh) - call MV_Pack2(Var, y%Mesh(DL%i1), ValAry) ! Mesh - case (StC_y_MeasDisp) - call MV_Pack2(Var, y%MeasDisp, ValAry) ! Rank 2 Array - case (StC_y_MeasVel) - call MV_Pack2(Var, y%MeasVel, ValAry) ! Rank 2 Array - end select - end associate + call StC_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine StC_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(StC_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (StC_y_Mesh) + call MV_Unpack2(Var, ValAry, y%Mesh(DL%i1)) ! Mesh + case (StC_y_MeasDisp) + call MV_Unpack2(Var, ValAry, y%MeasDisp) ! Rank 2 Array + case (StC_y_MeasVel) + call MV_Unpack2(Var, ValAry, y%MeasVel) ! Rank 2 Array + end select + end associate +end subroutine + subroutine StC_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(StC_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (StC_y_Mesh) - call MV_Unpack2(Var, ValAry, y%Mesh(DL%i1)) ! Mesh - case (StC_y_MeasDisp) - call MV_Unpack2(Var, ValAry, y%MeasDisp) ! Rank 2 Array - case (StC_y_MeasVel) - call MV_Unpack2(Var, ValAry, y%MeasVel) ! Rank 2 Array - end select - end associate + call StC_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE StrucCtrl_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index b83b742efd..0c1dee82da 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -4560,148 +4560,224 @@ function SD_OutputMeshName(ML) result(Name) end select end function +subroutine SD_PackContStateVar(Var, x, ValAry) + type(SD_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SD_x_qm) + call MV_Pack2(Var, x%qm, ValAry) ! Rank 1 Array + case (SD_x_qmdot) + call MV_Pack2(Var, x%qmdot, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SD_PackContStateAry(Vars, x, ValAry) type(SD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SD_x_qm) - call MV_Pack2(Var, x%qm, ValAry) ! Rank 1 Array - case (SD_x_qmdot) - call MV_Pack2(Var, x%qmdot, ValAry) ! Rank 1 Array - end select - end associate + call SD_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine SD_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SD_x_qm) + call MV_Unpack2(Var, ValAry, x%qm) ! Rank 1 Array + case (SD_x_qmdot) + call MV_Unpack2(Var, ValAry, x%qmdot) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SD_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SD_x_qm) - call MV_Unpack2(Var, ValAry, x%qm) ! Rank 1 Array - case (SD_x_qmdot) - call MV_Unpack2(Var, ValAry, x%qmdot) ! Rank 1 Array - end select - end associate + call SD_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine SD_PackConstrStateVar(Var, z, ValAry) + type(SD_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SD_PackConstrStateAry(Vars, z, ValAry) type(SD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - end select - end associate + call SD_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine SD_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + subroutine SD_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call SD_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine SD_PackInputVar(Var, u, ValAry) + type(SD_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SD_u_TPMesh) + call MV_Pack2(Var, u%TPMesh, ValAry) ! Mesh + case (SD_u_LMesh) + call MV_Pack2(Var, u%LMesh, ValAry) ! Mesh + case (SD_u_CableDeltaL) + call MV_Pack2(Var, u%CableDeltaL, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SD_PackInputAry(Vars, u, ValAry) type(SD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SD_u_TPMesh) - call MV_Pack2(Var, u%TPMesh, ValAry) ! Mesh - case (SD_u_LMesh) - call MV_Pack2(Var, u%LMesh, ValAry) ! Mesh - case (SD_u_CableDeltaL) - call MV_Pack2(Var, u%CableDeltaL, ValAry) ! Rank 1 Array - end select - end associate + call SD_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine SD_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SD_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SD_u_TPMesh) + call MV_Unpack2(Var, ValAry, u%TPMesh) ! Mesh + case (SD_u_LMesh) + call MV_Unpack2(Var, ValAry, u%LMesh) ! Mesh + case (SD_u_CableDeltaL) + call MV_Unpack2(Var, ValAry, u%CableDeltaL) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SD_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SD_u_TPMesh) - call MV_Unpack2(Var, ValAry, u%TPMesh) ! Mesh - case (SD_u_LMesh) - call MV_Unpack2(Var, ValAry, u%LMesh) ! Mesh - case (SD_u_CableDeltaL) - call MV_Unpack2(Var, ValAry, u%CableDeltaL) ! Rank 1 Array - end select - end associate + call SD_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine SD_PackOutputVar(Var, y, ValAry) + type(SD_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SD_y_Y1Mesh) + call MV_Pack2(Var, y%Y1Mesh, ValAry) ! Mesh + case (SD_y_Y2Mesh) + call MV_Pack2(Var, y%Y2Mesh, ValAry) ! Mesh + case (SD_y_Y3Mesh) + call MV_Pack2(Var, y%Y3Mesh, ValAry) ! Mesh + case (SD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SD_PackOutputAry(Vars, y, ValAry) type(SD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SD_y_Y1Mesh) - call MV_Pack2(Var, y%Y1Mesh, ValAry) ! Mesh - case (SD_y_Y2Mesh) - call MV_Pack2(Var, y%Y2Mesh, ValAry) ! Mesh - case (SD_y_Y3Mesh) - call MV_Pack2(Var, y%Y3Mesh, ValAry) ! Mesh - case (SD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - end select - end associate + call SD_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine SD_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SD_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SD_y_Y1Mesh) + call MV_Unpack2(Var, ValAry, y%Y1Mesh) ! Mesh + case (SD_y_Y2Mesh) + call MV_Unpack2(Var, ValAry, y%Y2Mesh) ! Mesh + case (SD_y_Y3Mesh) + call MV_Unpack2(Var, ValAry, y%Y3Mesh) ! Mesh + case (SD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SD_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SD_y_Y1Mesh) - call MV_Unpack2(Var, ValAry, y%Y1Mesh) ! Mesh - case (SD_y_Y2Mesh) - call MV_Unpack2(Var, ValAry, y%Y2Mesh) ! Mesh - case (SD_y_Y3Mesh) - call MV_Unpack2(Var, ValAry, y%Y3Mesh) ! Mesh - case (SD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate + call SD_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE SubDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 57fb9613b8..70acafbbda 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -695,68 +695,106 @@ function SC_DX_OutputMeshName(ML) result(Name) end select end function +subroutine SC_DX_PackInputVar(Var, u, ValAry) + type(SC_DX_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_DX_u_toSC) + call MV_Pack2(Var, u%toSC, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SC_DX_PackInputAry(Vars, u, ValAry) type(SC_DX_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SC_DX_u_toSC) - call MV_Pack2(Var, u%toSC, ValAry) ! Rank 1 Array - end select - end associate + call SC_DX_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine SC_DX_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_DX_u_toSC) + call MV_Unpack2(Var, ValAry, u%toSC) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SC_DX_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_DX_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SC_DX_u_toSC) - call MV_Unpack2(Var, ValAry, u%toSC) ! Rank 1 Array - end select - end associate + call SC_DX_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine SC_DX_PackOutputVar(Var, y, ValAry) + type(SC_DX_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_DX_y_fromSC) + call MV_Pack2(Var, y%fromSC, ValAry) ! Rank 1 Array + case (SC_DX_y_fromSCglob) + call MV_Pack2(Var, y%fromSCglob, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SC_DX_PackOutputAry(Vars, y, ValAry) type(SC_DX_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SC_DX_y_fromSC) - call MV_Pack2(Var, y%fromSC, ValAry) ! Rank 1 Array - case (SC_DX_y_fromSCglob) - call MV_Pack2(Var, y%fromSCglob, ValAry) ! Rank 1 Array - end select - end associate + call SC_DX_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine SC_DX_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_DX_y_fromSC) + call MV_Unpack2(Var, ValAry, y%fromSC) ! Rank 1 Array + case (SC_DX_y_fromSCglob) + call MV_Unpack2(Var, ValAry, y%fromSCglob) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SC_DX_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_DX_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SC_DX_y_fromSC) - call MV_Unpack2(Var, ValAry, y%fromSC) ! Rank 1 Array - case (SC_DX_y_fromSCglob) - call MV_Unpack2(Var, ValAry, y%fromSCglob) ! Rank 1 Array - end select - end associate + call SC_DX_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE SCDataEx_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 0710efca6e..297d4d088d 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -1863,132 +1863,208 @@ function SC_OutputMeshName(ML) result(Name) end select end function +subroutine SC_PackContStateVar(Var, x, ValAry) + type(SC_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_x_Dummy) + call MV_Pack2(Var, x%Dummy, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SC_PackContStateAry(Vars, x, ValAry) type(SC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SC_x_Dummy) - call MV_Pack2(Var, x%Dummy, ValAry) ! Scalar - end select - end associate + call SC_PackContStateVar(Vars%x(i), x, ValAry) end do end subroutine +subroutine SC_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_x_Dummy) + call MV_Unpack2(Var, ValAry, x%Dummy) ! Scalar + end select + end associate +end subroutine + subroutine SC_UnpackContStateAry(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (Var => Vars%x(i), DL => Vars%x(i)%DL) - select case (Var%DL%Num) - case (SC_x_Dummy) - call MV_Unpack2(Var, ValAry, x%Dummy) ! Scalar - end select - end associate + call SC_UnpackContStateVar(Vars%x(i), ValAry, x) end do end subroutine + +subroutine SC_PackConstrStateVar(Var, z, ValAry) + type(SC_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_z_Dummy) + call MV_Pack2(Var, z%Dummy, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SC_PackConstrStateAry(Vars, z, ValAry) type(SC_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SC_z_Dummy) - call MV_Pack2(Var, z%Dummy, ValAry) ! Scalar - end select - end associate + call SC_PackConstrStateVar(Vars%z(i), z, ValAry) end do end subroutine +subroutine SC_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_z_Dummy) + call MV_Unpack2(Var, ValAry, z%Dummy) ! Scalar + end select + end associate +end subroutine + subroutine SC_UnpackConstrStateAry(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (Var => Vars%z(i), DL => Vars%z(i)%DL) - select case (Var%DL%Num) - case (SC_z_Dummy) - call MV_Unpack2(Var, ValAry, z%Dummy) ! Scalar - end select - end associate + call SC_UnpackConstrStateVar(Vars%z(i), ValAry, z) end do end subroutine + +subroutine SC_PackInputVar(Var, u, ValAry) + type(SC_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_u_toSCglob) + call MV_Pack2(Var, u%toSCglob, ValAry) ! Rank 1 Array + case (SC_u_toSC) + call MV_Pack2(Var, u%toSC, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SC_PackInputAry(Vars, u, ValAry) type(SC_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SC_u_toSCglob) - call MV_Pack2(Var, u%toSCglob, ValAry) ! Rank 1 Array - case (SC_u_toSC) - call MV_Pack2(Var, u%toSC, ValAry) ! Rank 1 Array - end select - end associate + call SC_PackInputVar(Vars%u(i), u, ValAry) end do end subroutine +subroutine SC_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SC_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_u_toSCglob) + call MV_Unpack2(Var, ValAry, u%toSCglob) ! Rank 1 Array + case (SC_u_toSC) + call MV_Unpack2(Var, ValAry, u%toSC) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SC_UnpackInputAry(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (Var => Vars%u(i), DL => Vars%u(i)%DL) - select case (Var%DL%Num) - case (SC_u_toSCglob) - call MV_Unpack2(Var, ValAry, u%toSCglob) ! Rank 1 Array - case (SC_u_toSC) - call MV_Unpack2(Var, ValAry, u%toSC) ! Rank 1 Array - end select - end associate + call SC_UnpackInputVar(Vars%u(i), ValAry, u) end do end subroutine + +subroutine SC_PackOutputVar(Var, y, ValAry) + type(SC_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_y_fromSCglob) + call MV_Pack2(Var, y%fromSCglob, ValAry) ! Rank 1 Array + case (SC_y_fromSC) + call MV_Pack2(Var, y%fromSC, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + subroutine SC_PackOutputAry(Vars, y, ValAry) type(SC_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SC_y_fromSCglob) - call MV_Pack2(Var, y%fromSCglob, ValAry) ! Rank 1 Array - case (SC_y_fromSC) - call MV_Pack2(Var, y%fromSC, ValAry) ! Rank 1 Array - end select - end associate + call SC_PackOutputVar(Vars%y(i), y, ValAry) end do end subroutine +subroutine SC_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(SC_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (SC_y_fromSCglob) + call MV_Unpack2(Var, ValAry, y%fromSCglob) ! Rank 1 Array + case (SC_y_fromSC) + call MV_Unpack2(Var, ValAry, y%fromSC) ! Rank 1 Array + end select + end associate +end subroutine + subroutine SC_UnpackOutputAry(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (Var => Vars%y(i), DL => Vars%y(i)%DL) - select case (Var%DL%Num) - case (SC_y_fromSCglob) - call MV_Unpack2(Var, ValAry, y%fromSCglob) ! Rank 1 Array - case (SC_y_fromSC) - call MV_Unpack2(Var, ValAry, y%fromSC) ! Rank 1 Array - end select - end associate + call SC_UnpackOutputVar(Vars%y(i), ValAry, y) end do end subroutine + END MODULE SuperController_Types !ENDOFREGISTRYGENERATEDFILE From 35c64b24504a10d6be4354e259d8fc928d004a13 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 22 Jul 2024 18:18:06 +0000 Subject: [PATCH 157/319] Fix merge issues --- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 3 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 367 +++++++++++++++++- modules/awae/src/AWAE_Types.f90 | 256 +++++++++++- modules/elastodyn/src/ElastoDyn_Types.f90 | 100 ++--- modules/lindyn/src/LinDyn_Types.f90 | 216 ++++++++++- modules/nwtc-library/CMakeLists.txt | 1 + modules/nwtc-library/src/ModVar.f90 | 40 +- modules/nwtc-library/src/NWTC_Library.f90 | 1 + .../nwtc-library/src/NWTC_Library_Types.f90 | 6 +- .../src/Registry_NWTC_Library.txt | 3 +- .../src/Registry_NWTC_Library_base.txt | 3 +- modules/openfast-library/src/FAST_Subs.f90 | 68 ++-- modules/openfast-library/src/FAST_Types.f90 | 146 ++++--- .../wakedynamics/src/WakeDynamics_Types.f90 | 311 ++++++++++++++- reg_tests/r-test | 2 +- 15 files changed, 1316 insertions(+), 207 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 7d2b77655f..105e38c92a 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -197,7 +197,8 @@ MODULE AeroDyn_Driver_Types LOGICAL :: initialized = .false. !< [-] END TYPE AllData ! ======================= -CONTAINS + +contains subroutine AD_Dvr_CopyDvr_Case(SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg) type(Dvr_Case), intent(in) :: SrcDvr_CaseData diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index c802493e97..4d4bc612cb 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -35,17 +35,6 @@ MODULE AeroDyn_Inflow_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_Version = 1 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_NacelleMotion = 1 ! Mesh number for ADI ADI_u_AD_rotors_NacelleMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_TowerMotion = 2 ! Mesh number for ADI ADI_u_AD_rotors_TowerMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_HubMotion = 3 ! Mesh number for ADI ADI_u_AD_rotors_HubMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_BladeRootMotion = 4 ! Mesh number for ADI ADI_u_AD_rotors_BladeRootMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_BladeMotion = 5 ! Mesh number for ADI ADI_u_AD_rotors_BladeMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_u_AD_rotors_TFinMotion = 6 ! Mesh number for ADI ADI_u_AD_rotors_TFinMotion mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_NacelleLoad = 7 ! Mesh number for ADI ADI_y_AD_rotors_NacelleLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_HubLoad = 8 ! Mesh number for ADI ADI_y_AD_rotors_HubLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_TowerLoad = 9 ! Mesh number for ADI ADI_y_AD_rotors_TowerLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_BladeLoad = 10 ! Mesh number for ADI ADI_y_AD_rotors_BladeLoad mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_y_AD_rotors_TFinLoad = 11 ! Mesh number for ADI ADI_y_AD_rotors_TFinLoad mesh [-] ! ========= ADI_InflowWindData ======= TYPE, PUBLIC :: ADI_InflowWindData TYPE(InflowWind_ContinuousStateType) :: x !< Continuous states [-] @@ -186,7 +175,41 @@ MODULE AeroDyn_Inflow_Types TYPE(RotFED) , DIMENSION(:), ALLOCATABLE :: WT !< Wind turbine/rotors elastic data [-] END TYPE FED_Data ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ADI_x_AD_rotors_BEMT_UA_element_x = 1 ! ADI%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x + integer(IntKi), public, parameter :: ADI_x_AD_rotors_BEMT_DBEMT_element_vind = 2 ! ADI%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind + integer(IntKi), public, parameter :: ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1 = 3 ! ADI%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1 + integer(IntKi), public, parameter :: ADI_x_AD_rotors_BEMT_V_w = 4 ! ADI%AD%rotors(DL%i1)%BEMT%V_w + integer(IntKi), public, parameter :: ADI_x_AD_rotors_AA_DummyContState = 5 ! ADI%AD%rotors(DL%i1)%AA%DummyContState + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_Gamma_NW = 6 ! ADI%AD%FVW%W(DL%i1)%Gamma_NW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_Gamma_FW = 7 ! ADI%AD%FVW%W(DL%i1)%Gamma_FW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_Eps_NW = 8 ! ADI%AD%FVW%W(DL%i1)%Eps_NW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_Eps_FW = 9 ! ADI%AD%FVW%W(DL%i1)%Eps_FW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_r_NW = 10 ! ADI%AD%FVW%W(DL%i1)%r_NW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_r_FW = 11 ! ADI%AD%FVW%W(DL%i1)%r_FW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_UA_element_x = 12 ! ADI%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x + integer(IntKi), public, parameter :: ADI_z_AD_rotors_BEMT_phi = 13 ! ADI%AD%rotors(DL%i1)%BEMT%phi + integer(IntKi), public, parameter :: ADI_z_AD_rotors_AA_DummyConstrState = 14 ! ADI%AD%rotors(DL%i1)%AA%DummyConstrState + integer(IntKi), public, parameter :: ADI_z_AD_FVW_W_Gamma_LL = 15 ! ADI%AD%FVW%W(DL%i1)%Gamma_LL + integer(IntKi), public, parameter :: ADI_z_AD_FVW_residual = 16 ! ADI%AD%FVW%residual + integer(IntKi), public, parameter :: ADI_u_AD_rotors_NacelleMotion = 17 ! ADI%AD%rotors(DL%i1)%NacelleMotion + integer(IntKi), public, parameter :: ADI_u_AD_rotors_TowerMotion = 18 ! ADI%AD%rotors(DL%i1)%TowerMotion + integer(IntKi), public, parameter :: ADI_u_AD_rotors_HubMotion = 19 ! ADI%AD%rotors(DL%i1)%HubMotion + integer(IntKi), public, parameter :: ADI_u_AD_rotors_BladeRootMotion = 20 ! ADI%AD%rotors(DL%i1)%BladeRootMotion(DL%i2) + integer(IntKi), public, parameter :: ADI_u_AD_rotors_BladeMotion = 21 ! ADI%AD%rotors(DL%i1)%BladeMotion(DL%i2) + integer(IntKi), public, parameter :: ADI_u_AD_rotors_TFinMotion = 22 ! ADI%AD%rotors(DL%i1)%TFinMotion + integer(IntKi), public, parameter :: ADI_u_AD_rotors_UserProp = 23 ! ADI%AD%rotors(DL%i1)%UserProp + integer(IntKi), public, parameter :: ADI_y_AD_rotors_NacelleLoad = 24 ! ADI%AD%rotors(DL%i1)%NacelleLoad + integer(IntKi), public, parameter :: ADI_y_AD_rotors_HubLoad = 25 ! ADI%AD%rotors(DL%i1)%HubLoad + integer(IntKi), public, parameter :: ADI_y_AD_rotors_TowerLoad = 26 ! ADI%AD%rotors(DL%i1)%TowerLoad + integer(IntKi), public, parameter :: ADI_y_AD_rotors_BladeLoad = 27 ! ADI%AD%rotors(DL%i1)%BladeLoad(DL%i2) + integer(IntKi), public, parameter :: ADI_y_AD_rotors_TFinLoad = 28 ! ADI%AD%rotors(DL%i1)%TFinLoad + integer(IntKi), public, parameter :: ADI_y_AD_rotors_WriteOutput = 29 ! ADI%AD%rotors(DL%i1)%WriteOutput + integer(IntKi), public, parameter :: ADI_y_HHVel = 30 ! ADI%HHVel + integer(IntKi), public, parameter :: ADI_y_PLExp = 31 ! ADI%PLExp + integer(IntKi), public, parameter :: ADI_y_IW_WriteOutput = 32 ! ADI%IW_WriteOutput + integer(IntKi), public, parameter :: ADI_y_WriteOutput = 33 ! ADI%WriteOutput + +contains subroutine ADI_CopyInflowWindData(SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg) type(ADI_InflowWindData), intent(in) :: SrcInflowWindDataData @@ -1771,7 +1794,7 @@ subroutine ADI_UnPackFED_Data(RF, OutData) function ADI_InputMeshPointer(u, ML) result(Mesh) type(ADI_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1791,7 +1814,7 @@ function ADI_InputMeshPointer(u, ML) result(Mesh) end function function ADI_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1812,7 +1835,7 @@ function ADI_InputMeshName(ML) result(Name) function ADI_OutputMeshPointer(y, ML) result(Mesh) type(ADI_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1830,7 +1853,7 @@ function ADI_OutputMeshPointer(y, ML) result(Mesh) end function function ADI_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1846,5 +1869,317 @@ function ADI_OutputMeshName(ML) result(Name) Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%TFinLoad" end select end function + +subroutine ADI_PackContStateVar(Var, x, ValAry) + type(ADI_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + call MV_Pack2(Var, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x, ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + call MV_Pack2(Var, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind, ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + call MV_Pack2(Var, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1, ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + call MV_Pack2(Var, x%AD%rotors(DL%i1)%BEMT%V_w, ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + call MV_Pack2(Var, x%AD%rotors(DL%i1)%AA%DummyContState, ValAry) ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%Gamma_NW, ValAry) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%Gamma_FW, ValAry) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%Eps_NW, ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%Eps_FW, ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%r_NW, ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%r_FW, ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + call MV_Pack2(Var, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_PackContStateAry(Vars, x, ValAry) + type(ADI_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADI_PackContStateVar(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ADI_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%BEMT%V_w) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%AA%DummyContState) ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%Gamma_NW) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%Gamma_FW) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%Eps_NW) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%Eps_FW) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%r_NW) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%r_FW) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + call MV_Unpack2(Var, ValAry, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x) ! Rank 1 Array + end select + end associate +end subroutine + +subroutine ADI_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADI_UnpackContStateVar(Vars%x(i), ValAry, x) + end do +end subroutine + + +subroutine ADI_PackConstrStateVar(Var, z, ValAry) + type(ADI_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + call MV_Pack2(Var, z%AD%rotors(DL%i1)%BEMT%phi, ValAry) ! Rank 2 Array + case (ADI_z_AD_rotors_AA_DummyConstrState) + call MV_Pack2(Var, z%AD%rotors(DL%i1)%AA%DummyConstrState, ValAry) ! Scalar + case (ADI_z_AD_FVW_W_Gamma_LL) + call MV_Pack2(Var, z%AD%FVW%W(DL%i1)%Gamma_LL, ValAry) ! Rank 1 Array + case (ADI_z_AD_FVW_residual) + call MV_Pack2(Var, z%AD%FVW%residual, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_PackConstrStateAry(Vars, z, ValAry) + type(ADI_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ADI_PackConstrStateVar(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine ADI_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + call MV_Unpack2(Var, ValAry, z%AD%rotors(DL%i1)%BEMT%phi) ! Rank 2 Array + case (ADI_z_AD_rotors_AA_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%AD%rotors(DL%i1)%AA%DummyConstrState) ! Scalar + case (ADI_z_AD_FVW_W_Gamma_LL) + call MV_Unpack2(Var, ValAry, z%AD%FVW%W(DL%i1)%Gamma_LL) ! Rank 1 Array + case (ADI_z_AD_FVW_residual) + call MV_Unpack2(Var, ValAry, z%AD%FVW%residual) ! Scalar + end select + end associate +end subroutine + +subroutine ADI_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ADI_UnpackConstrStateVar(Vars%z(i), ValAry, z) + end do +end subroutine + + +subroutine ADI_PackInputVar(Var, u, ValAry) + type(ADI_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + call MV_Pack2(Var, u%AD%rotors(DL%i1)%NacelleMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_TowerMotion) + call MV_Pack2(Var, u%AD%rotors(DL%i1)%TowerMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_HubMotion) + call MV_Pack2(Var, u%AD%rotors(DL%i1)%HubMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_BladeRootMotion) + call MV_Pack2(Var, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2), ValAry) ! Mesh + case (ADI_u_AD_rotors_BladeMotion) + call MV_Pack2(Var, u%AD%rotors(DL%i1)%BladeMotion(DL%i2), ValAry) ! Mesh + case (ADI_u_AD_rotors_TFinMotion) + call MV_Pack2(Var, u%AD%rotors(DL%i1)%TFinMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_UserProp) + call MV_Pack2(Var, u%AD%rotors(DL%i1)%UserProp, ValAry) ! Rank 2 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_PackInputAry(Vars, u, ValAry) + type(ADI_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ADI_PackInputVar(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ADI_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%NacelleMotion) ! Mesh + case (ADI_u_AD_rotors_TowerMotion) + call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%TowerMotion) ! Mesh + case (ADI_u_AD_rotors_HubMotion) + call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%HubMotion) ! Mesh + case (ADI_u_AD_rotors_BladeRootMotion) + call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2)) ! Mesh + case (ADI_u_AD_rotors_BladeMotion) + call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%BladeMotion(DL%i2)) ! Mesh + case (ADI_u_AD_rotors_TFinMotion) + call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%TFinMotion) ! Mesh + case (ADI_u_AD_rotors_UserProp) + call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%UserProp) ! Rank 2 Array + end select + end associate +end subroutine + +subroutine ADI_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ADI_UnpackInputVar(Vars%u(i), ValAry, u) + end do +end subroutine + + +subroutine ADI_PackOutputVar(Var, y, ValAry) + type(ADI_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + call MV_Pack2(Var, y%AD%rotors(DL%i1)%NacelleLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_HubLoad) + call MV_Pack2(Var, y%AD%rotors(DL%i1)%HubLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_TowerLoad) + call MV_Pack2(Var, y%AD%rotors(DL%i1)%TowerLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_BladeLoad) + call MV_Pack2(Var, y%AD%rotors(DL%i1)%BladeLoad(DL%i2), ValAry) ! Mesh + case (ADI_y_AD_rotors_TFinLoad) + call MV_Pack2(Var, y%AD%rotors(DL%i1)%TFinLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_WriteOutput) + call MV_Pack2(Var, y%AD%rotors(DL%i1)%WriteOutput, ValAry) ! Rank 1 Array + case (ADI_y_HHVel) + call MV_Pack2(Var, y%HHVel, ValAry) ! Rank 2 Array + case (ADI_y_PLExp) + call MV_Pack2(Var, y%PLExp, ValAry) ! Scalar + case (ADI_y_IW_WriteOutput) + call MV_Pack2(Var, y%IW_WriteOutput, ValAry) ! Rank 1 Array + case (ADI_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_PackOutputAry(Vars, y, ValAry) + type(ADI_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ADI_PackOutputVar(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ADI_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%NacelleLoad) ! Mesh + case (ADI_y_AD_rotors_HubLoad) + call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%HubLoad) ! Mesh + case (ADI_y_AD_rotors_TowerLoad) + call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%TowerLoad) ! Mesh + case (ADI_y_AD_rotors_BladeLoad) + call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%BladeLoad(DL%i2)) ! Mesh + case (ADI_y_AD_rotors_TFinLoad) + call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%TFinLoad) ! Mesh + case (ADI_y_AD_rotors_WriteOutput) + call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%WriteOutput) ! Rank 1 Array + case (ADI_y_HHVel) + call MV_Unpack2(Var, ValAry, y%HHVel) ! Rank 2 Array + case (ADI_y_PLExp) + call MV_Unpack2(Var, ValAry, y%PLExp) ! Scalar + case (ADI_y_IW_WriteOutput) + call MV_Unpack2(Var, ValAry, y%IW_WriteOutput) ! Rank 1 Array + case (ADI_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + +subroutine ADI_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ADI_UnpackOutputVar(Vars%y(i), ValAry, y) + end do +end subroutine + END MODULE AeroDyn_Inflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 0f8aa53ce8..a6d5c44707 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -252,7 +252,21 @@ MODULE AWAE_Types REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WAT_k !< Scaling factor for each wake plane and turbine (ny, nz, np, nWT) [-] END TYPE AWAE_InputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: AWAE_x_IfW_DummyContState = 1 ! AWAE%IfW(DL%i1)%DummyContState + integer(IntKi), public, parameter :: AWAE_z_IfW_DummyConstrState = 2 ! AWAE%IfW(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: AWAE_u_xhat_plane = 3 ! AWAE%xhat_plane + integer(IntKi), public, parameter :: AWAE_u_p_plane = 4 ! AWAE%p_plane + integer(IntKi), public, parameter :: AWAE_u_Vx_wake = 5 ! AWAE%Vx_wake + integer(IntKi), public, parameter :: AWAE_u_Vy_wake = 6 ! AWAE%Vy_wake + integer(IntKi), public, parameter :: AWAE_u_Vz_wake = 7 ! AWAE%Vz_wake + integer(IntKi), public, parameter :: AWAE_u_D_wake = 8 ! AWAE%D_wake + integer(IntKi), public, parameter :: AWAE_u_WAT_k = 9 ! AWAE%WAT_k + integer(IntKi), public, parameter :: AWAE_y_Vdist_High_data = 10 ! AWAE%Vdist_High(DL%i1)%data + integer(IntKi), public, parameter :: AWAE_y_V_plane = 11 ! AWAE%V_plane + integer(IntKi), public, parameter :: AWAE_y_TI_amb = 12 ! AWAE%TI_amb + integer(IntKi), public, parameter :: AWAE_y_Vx_wind_disk = 13 ! AWAE%Vx_wind_disk + +contains subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlCode, ErrStat, ErrMsg) type(AWAE_HighWindGrid), intent(in) :: SrcHighWindGridData @@ -2597,7 +2611,7 @@ subroutine AWAE_UnPackInput(RF, OutData) function AWAE_InputMeshPointer(u, ML) result(Mesh) type(AWAE_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2605,7 +2619,7 @@ function AWAE_InputMeshPointer(u, ML) result(Mesh) end function function AWAE_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -2614,7 +2628,7 @@ function AWAE_InputMeshName(ML) result(Name) function AWAE_OutputMeshPointer(y, ML) result(Mesh) type(AWAE_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -2622,11 +2636,243 @@ function AWAE_OutputMeshPointer(y, ML) result(Mesh) end function function AWAE_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine AWAE_PackContStateVar(Var, x, ValAry) + type(AWAE_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AWAE_x_IfW_DummyContState) + call MV_Pack2(Var, x%IfW(DL%i1)%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_PackContStateAry(Vars, x, ValAry) + type(AWAE_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AWAE_PackContStateVar(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine AWAE_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AWAE_x_IfW_DummyContState) + call MV_Unpack2(Var, ValAry, x%IfW(DL%i1)%DummyContState) ! Scalar + end select + end associate +end subroutine + +subroutine AWAE_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AWAE_UnpackContStateVar(Vars%x(i), ValAry, x) + end do +end subroutine + + +subroutine AWAE_PackConstrStateVar(Var, z, ValAry) + type(AWAE_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AWAE_z_IfW_DummyConstrState) + call MV_Pack2(Var, z%IfW(DL%i1)%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_PackConstrStateAry(Vars, z, ValAry) + type(AWAE_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call AWAE_PackConstrStateVar(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine AWAE_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AWAE_z_IfW_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%IfW(DL%i1)%DummyConstrState) ! Scalar + end select + end associate +end subroutine + +subroutine AWAE_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call AWAE_UnpackConstrStateVar(Vars%z(i), ValAry, z) + end do +end subroutine + + +subroutine AWAE_PackInputVar(Var, u, ValAry) + type(AWAE_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AWAE_u_xhat_plane) + call MV_Pack2(Var, u%xhat_plane, ValAry) ! Rank 3 Array + case (AWAE_u_p_plane) + call MV_Pack2(Var, u%p_plane, ValAry) ! Rank 3 Array + case (AWAE_u_Vx_wake) + call MV_Pack2(Var, u%Vx_wake, ValAry) ! Rank 4 Array + case (AWAE_u_Vy_wake) + call MV_Pack2(Var, u%Vy_wake, ValAry) ! Rank 4 Array + case (AWAE_u_Vz_wake) + call MV_Pack2(Var, u%Vz_wake, ValAry) ! Rank 4 Array + case (AWAE_u_D_wake) + call MV_Pack2(Var, u%D_wake, ValAry) ! Rank 2 Array + case (AWAE_u_WAT_k) + call MV_Pack2(Var, u%WAT_k, ValAry) ! Rank 4 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_PackInputAry(Vars, u, ValAry) + type(AWAE_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AWAE_PackInputVar(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine AWAE_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AWAE_u_xhat_plane) + call MV_Unpack2(Var, ValAry, u%xhat_plane) ! Rank 3 Array + case (AWAE_u_p_plane) + call MV_Unpack2(Var, ValAry, u%p_plane) ! Rank 3 Array + case (AWAE_u_Vx_wake) + call MV_Unpack2(Var, ValAry, u%Vx_wake) ! Rank 4 Array + case (AWAE_u_Vy_wake) + call MV_Unpack2(Var, ValAry, u%Vy_wake) ! Rank 4 Array + case (AWAE_u_Vz_wake) + call MV_Unpack2(Var, ValAry, u%Vz_wake) ! Rank 4 Array + case (AWAE_u_D_wake) + call MV_Unpack2(Var, ValAry, u%D_wake) ! Rank 2 Array + case (AWAE_u_WAT_k) + call MV_Unpack2(Var, ValAry, u%WAT_k) ! Rank 4 Array + end select + end associate +end subroutine + +subroutine AWAE_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AWAE_UnpackInputVar(Vars%u(i), ValAry, u) + end do +end subroutine + + +subroutine AWAE_PackOutputVar(Var, y, ValAry) + type(AWAE_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AWAE_y_Vdist_High_data) + call MV_Pack2(Var, y%Vdist_High(DL%i1)%data, ValAry) ! Rank 5 Array + case (AWAE_y_V_plane) + call MV_Pack2(Var, y%V_plane, ValAry) ! Rank 3 Array + case (AWAE_y_TI_amb) + call MV_Pack2(Var, y%TI_amb, ValAry) ! Rank 1 Array + case (AWAE_y_Vx_wind_disk) + call MV_Pack2(Var, y%Vx_wind_disk, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_PackOutputAry(Vars, y, ValAry) + type(AWAE_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AWAE_PackOutputVar(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine AWAE_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (AWAE_y_Vdist_High_data) + call MV_Unpack2(Var, ValAry, y%Vdist_High(DL%i1)%data) ! Rank 5 Array + case (AWAE_y_V_plane) + call MV_Unpack2(Var, ValAry, y%V_plane) ! Rank 3 Array + case (AWAE_y_TI_amb) + call MV_Unpack2(Var, ValAry, y%TI_amb) ! Rank 1 Array + case (AWAE_y_Vx_wind_disk) + call MV_Unpack2(Var, ValAry, y%Vx_wind_disk) ! Rank 1 Array + end select + end associate +end subroutine + +subroutine AWAE_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AWAE_UnpackOutputVar(Vars%y(i), ValAry, y) + end do +end subroutine + END MODULE AWAE_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 274e67d039..7ee13b8575 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -863,42 +863,38 @@ MODULE ElastoDyn_Types integer(IntKi), public, parameter :: ED_y_BladeLn2Mesh = 16 ! ED%BladeLn2Mesh(DL%i1) integer(IntKi), public, parameter :: ED_y_PlatformPtMesh = 17 ! ED%PlatformPtMesh integer(IntKi), public, parameter :: ED_y_TowerLn2Mesh = 18 ! ED%TowerLn2Mesh - integer(IntKi), public, parameter :: ED_y_HubPtMotion14 = 19 ! ED%HubPtMotion14 - integer(IntKi), public, parameter :: ED_y_HubPtMotion = 20 ! ED%HubPtMotion - integer(IntKi), public, parameter :: ED_y_BladeRootMotion14 = 21 ! ED%BladeRootMotion14 - integer(IntKi), public, parameter :: ED_y_BladeRootMotion = 22 ! ED%BladeRootMotion(DL%i1) - integer(IntKi), public, parameter :: ED_y_RotorFurlMotion14 = 23 ! ED%RotorFurlMotion14 - integer(IntKi), public, parameter :: ED_y_NacelleMotion = 24 ! ED%NacelleMotion - integer(IntKi), public, parameter :: ED_y_TowerBaseMotion14 = 25 ! ED%TowerBaseMotion14 - integer(IntKi), public, parameter :: ED_y_TFinCMMotion = 26 ! ED%TFinCMMotion - integer(IntKi), public, parameter :: ED_y_WriteOutput = 27 ! ED%WriteOutput - integer(IntKi), public, parameter :: ED_y_BlPitch = 28 ! ED%BlPitch - integer(IntKi), public, parameter :: ED_y_Yaw = 29 ! ED%Yaw - integer(IntKi), public, parameter :: ED_y_YawRate = 30 ! ED%YawRate - integer(IntKi), public, parameter :: ED_y_LSS_Spd = 31 ! ED%LSS_Spd - integer(IntKi), public, parameter :: ED_y_HSS_Spd = 32 ! ED%HSS_Spd - integer(IntKi), public, parameter :: ED_y_RotSpeed = 33 ! ED%RotSpeed - integer(IntKi), public, parameter :: ED_y_TwrAccel = 34 ! ED%TwrAccel - integer(IntKi), public, parameter :: ED_y_YawAngle = 35 ! ED%YawAngle - integer(IntKi), public, parameter :: ED_y_RootMyc = 36 ! ED%RootMyc - integer(IntKi), public, parameter :: ED_y_YawBrTAxp = 37 ! ED%YawBrTAxp - integer(IntKi), public, parameter :: ED_y_YawBrTAyp = 38 ! ED%YawBrTAyp - integer(IntKi), public, parameter :: ED_y_LSSTipPxa = 39 ! ED%LSSTipPxa - integer(IntKi), public, parameter :: ED_y_RootMxc = 40 ! ED%RootMxc - integer(IntKi), public, parameter :: ED_y_LSSTipMxa = 41 ! ED%LSSTipMxa - integer(IntKi), public, parameter :: ED_y_LSSTipMya = 42 ! ED%LSSTipMya - integer(IntKi), public, parameter :: ED_y_LSSTipMza = 43 ! ED%LSSTipMza - integer(IntKi), public, parameter :: ED_y_LSSTipMys = 44 ! ED%LSSTipMys - integer(IntKi), public, parameter :: ED_y_LSSTipMzs = 45 ! ED%LSSTipMzs - integer(IntKi), public, parameter :: ED_y_YawBrMyn = 46 ! ED%YawBrMyn - integer(IntKi), public, parameter :: ED_y_YawBrMzn = 47 ! ED%YawBrMzn - integer(IntKi), public, parameter :: ED_y_NcIMURAxs = 48 ! ED%NcIMURAxs - integer(IntKi), public, parameter :: ED_y_NcIMURAys = 49 ! ED%NcIMURAys - integer(IntKi), public, parameter :: ED_y_NcIMURAzs = 50 ! ED%NcIMURAzs - integer(IntKi), public, parameter :: ED_y_RotPwr = 51 ! ED%RotPwr - integer(IntKi), public, parameter :: ED_y_LSShftFxa = 52 ! ED%LSShftFxa - integer(IntKi), public, parameter :: ED_y_LSShftFys = 53 ! ED%LSShftFys - integer(IntKi), public, parameter :: ED_y_LSShftFzs = 54 ! ED%LSShftFzs + integer(IntKi), public, parameter :: ED_y_HubPtMotion = 19 ! ED%HubPtMotion + integer(IntKi), public, parameter :: ED_y_BladeRootMotion = 20 ! ED%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: ED_y_NacelleMotion = 21 ! ED%NacelleMotion + integer(IntKi), public, parameter :: ED_y_TFinCMMotion = 22 ! ED%TFinCMMotion + integer(IntKi), public, parameter :: ED_y_WriteOutput = 23 ! ED%WriteOutput + integer(IntKi), public, parameter :: ED_y_BlPitch = 24 ! ED%BlPitch + integer(IntKi), public, parameter :: ED_y_Yaw = 25 ! ED%Yaw + integer(IntKi), public, parameter :: ED_y_YawRate = 26 ! ED%YawRate + integer(IntKi), public, parameter :: ED_y_LSS_Spd = 27 ! ED%LSS_Spd + integer(IntKi), public, parameter :: ED_y_HSS_Spd = 28 ! ED%HSS_Spd + integer(IntKi), public, parameter :: ED_y_RotSpeed = 29 ! ED%RotSpeed + integer(IntKi), public, parameter :: ED_y_TwrAccel = 30 ! ED%TwrAccel + integer(IntKi), public, parameter :: ED_y_YawAngle = 31 ! ED%YawAngle + integer(IntKi), public, parameter :: ED_y_RootMyc = 32 ! ED%RootMyc + integer(IntKi), public, parameter :: ED_y_YawBrTAxp = 33 ! ED%YawBrTAxp + integer(IntKi), public, parameter :: ED_y_YawBrTAyp = 34 ! ED%YawBrTAyp + integer(IntKi), public, parameter :: ED_y_LSSTipPxa = 35 ! ED%LSSTipPxa + integer(IntKi), public, parameter :: ED_y_RootMxc = 36 ! ED%RootMxc + integer(IntKi), public, parameter :: ED_y_LSSTipMxa = 37 ! ED%LSSTipMxa + integer(IntKi), public, parameter :: ED_y_LSSTipMya = 38 ! ED%LSSTipMya + integer(IntKi), public, parameter :: ED_y_LSSTipMza = 39 ! ED%LSSTipMza + integer(IntKi), public, parameter :: ED_y_LSSTipMys = 40 ! ED%LSSTipMys + integer(IntKi), public, parameter :: ED_y_LSSTipMzs = 41 ! ED%LSSTipMzs + integer(IntKi), public, parameter :: ED_y_YawBrMyn = 42 ! ED%YawBrMyn + integer(IntKi), public, parameter :: ED_y_YawBrMzn = 43 ! ED%YawBrMzn + integer(IntKi), public, parameter :: ED_y_NcIMURAxs = 44 ! ED%NcIMURAxs + integer(IntKi), public, parameter :: ED_y_NcIMURAys = 45 ! ED%NcIMURAys + integer(IntKi), public, parameter :: ED_y_NcIMURAzs = 46 ! ED%NcIMURAzs + integer(IntKi), public, parameter :: ED_y_RotPwr = 47 ! ED%RotPwr + integer(IntKi), public, parameter :: ED_y_LSShftFxa = 48 ! ED%LSShftFxa + integer(IntKi), public, parameter :: ED_y_LSShftFys = 49 ! ED%LSShftFys + integer(IntKi), public, parameter :: ED_y_LSShftFzs = 50 ! ED%LSShftFzs contains @@ -7719,20 +7715,12 @@ function ED_OutputMeshPointer(y, ML) result(Mesh) Mesh => y%PlatformPtMesh case (ED_y_TowerLn2Mesh) Mesh => y%TowerLn2Mesh - case (ED_y_HubPtMotion14) - Mesh => y%HubPtMotion14 case (ED_y_HubPtMotion) Mesh => y%HubPtMotion - case (ED_y_BladeRootMotion14) - Mesh => y%BladeRootMotion14 case (ED_y_BladeRootMotion) Mesh => y%BladeRootMotion(ML%i1) - case (ED_y_RotorFurlMotion14) - Mesh => y%RotorFurlMotion14 case (ED_y_NacelleMotion) Mesh => y%NacelleMotion - case (ED_y_TowerBaseMotion14) - Mesh => y%TowerBaseMotion14 case (ED_y_TFinCMMotion) Mesh => y%TFinCMMotion end select @@ -7749,20 +7737,12 @@ function ED_OutputMeshName(ML) result(Name) Name = "y%PlatformPtMesh" case (ED_y_TowerLn2Mesh) Name = "y%TowerLn2Mesh" - case (ED_y_HubPtMotion14) - Name = "y%HubPtMotion14" case (ED_y_HubPtMotion) Name = "y%HubPtMotion" - case (ED_y_BladeRootMotion14) - Name = "y%BladeRootMotion14" case (ED_y_BladeRootMotion) Name = "y%BladeRootMotion("//trim(Num2LStr(ML%i1))//")" - case (ED_y_RotorFurlMotion14) - Name = "y%RotorFurlMotion14" case (ED_y_NacelleMotion) Name = "y%NacelleMotion" - case (ED_y_TowerBaseMotion14) - Name = "y%TowerBaseMotion14" case (ED_y_TFinCMMotion) Name = "y%TFinCMMotion" end select @@ -7976,20 +7956,12 @@ subroutine ED_PackOutputVar(Var, y, ValAry) call MV_Pack2(Var, y%PlatformPtMesh, ValAry) ! Mesh case (ED_y_TowerLn2Mesh) call MV_Pack2(Var, y%TowerLn2Mesh, ValAry) ! Mesh - case (ED_y_HubPtMotion14) - call MV_Pack2(Var, y%HubPtMotion14, ValAry) ! Mesh case (ED_y_HubPtMotion) call MV_Pack2(Var, y%HubPtMotion, ValAry) ! Mesh - case (ED_y_BladeRootMotion14) - call MV_Pack2(Var, y%BladeRootMotion14, ValAry) ! Mesh case (ED_y_BladeRootMotion) call MV_Pack2(Var, y%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (ED_y_RotorFurlMotion14) - call MV_Pack2(Var, y%RotorFurlMotion14, ValAry) ! Mesh case (ED_y_NacelleMotion) call MV_Pack2(Var, y%NacelleMotion, ValAry) ! Mesh - case (ED_y_TowerBaseMotion14) - call MV_Pack2(Var, y%TowerBaseMotion14, ValAry) ! Mesh case (ED_y_TFinCMMotion) call MV_Pack2(Var, y%TFinCMMotion, ValAry) ! Mesh case (ED_y_WriteOutput) @@ -8077,20 +8049,12 @@ subroutine ED_UnpackOutputVar(Var, ValAry, y) call MV_Unpack2(Var, ValAry, y%PlatformPtMesh) ! Mesh case (ED_y_TowerLn2Mesh) call MV_Unpack2(Var, ValAry, y%TowerLn2Mesh) ! Mesh - case (ED_y_HubPtMotion14) - call MV_Unpack2(Var, ValAry, y%HubPtMotion14) ! Mesh case (ED_y_HubPtMotion) call MV_Unpack2(Var, ValAry, y%HubPtMotion) ! Mesh - case (ED_y_BladeRootMotion14) - call MV_Unpack2(Var, ValAry, y%BladeRootMotion14) ! Mesh case (ED_y_BladeRootMotion) call MV_Unpack2(Var, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh - case (ED_y_RotorFurlMotion14) - call MV_Unpack2(Var, ValAry, y%RotorFurlMotion14) ! Mesh case (ED_y_NacelleMotion) call MV_Unpack2(Var, ValAry, y%NacelleMotion) ! Mesh - case (ED_y_TowerBaseMotion14) - call MV_Unpack2(Var, ValAry, y%TowerBaseMotion14) ! Mesh case (ED_y_TFinCMMotion) call MV_Unpack2(Var, ValAry, y%TFinCMMotion) ! Mesh case (ED_y_WriteOutput) diff --git a/modules/lindyn/src/LinDyn_Types.f90 b/modules/lindyn/src/LinDyn_Types.f90 index 62945121f9..f55cab99cd 100644 --- a/modules/lindyn/src/LinDyn_Types.f90 +++ b/modules/lindyn/src/LinDyn_Types.f90 @@ -123,7 +123,13 @@ MODULE LinDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< outputs to be written to a file [-] END TYPE LD_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: LD_x_q = 1 ! LD%q + integer(IntKi), public, parameter :: LD_z_Dummy = 2 ! LD%Dummy + integer(IntKi), public, parameter :: LD_u_Fext = 3 ! LD%Fext + integer(IntKi), public, parameter :: LD_y_xdd = 4 ! LD%xdd + integer(IntKi), public, parameter :: LD_y_WriteOutput = 5 ! LD%WriteOutput + +contains subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(LD_InitInputType), intent(in) :: SrcInitInputData @@ -1558,7 +1564,7 @@ SUBROUTINE LD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err function LD_InputMeshPointer(u, ML) result(Mesh) type(LD_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1566,7 +1572,7 @@ function LD_InputMeshPointer(u, ML) result(Mesh) end function function LD_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1575,7 +1581,7 @@ function LD_InputMeshName(ML) result(Name) function LD_OutputMeshPointer(y, ML) result(Mesh) type(LD_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1583,11 +1589,211 @@ function LD_OutputMeshPointer(y, ML) result(Mesh) end function function LD_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine LD_PackContStateVar(Var, x, ValAry) + type(LD_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (LD_x_q) + call MV_Pack2(Var, x%q, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_PackContStateAry(Vars, x, ValAry) + type(LD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call LD_PackContStateVar(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine LD_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (LD_x_q) + call MV_Unpack2(Var, ValAry, x%q) ! Rank 1 Array + end select + end associate +end subroutine + +subroutine LD_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call LD_UnpackContStateVar(Vars%x(i), ValAry, x) + end do +end subroutine + + +subroutine LD_PackConstrStateVar(Var, z, ValAry) + type(LD_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (LD_z_Dummy) + call MV_Pack2(Var, z%Dummy, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_PackConstrStateAry(Vars, z, ValAry) + type(LD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call LD_PackConstrStateVar(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine LD_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (LD_z_Dummy) + call MV_Unpack2(Var, ValAry, z%Dummy) ! Scalar + end select + end associate +end subroutine + +subroutine LD_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call LD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + end do +end subroutine + + +subroutine LD_PackInputVar(Var, u, ValAry) + type(LD_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (LD_u_Fext) + call MV_Pack2(Var, u%Fext, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_PackInputAry(Vars, u, ValAry) + type(LD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call LD_PackInputVar(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine LD_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(LD_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (LD_u_Fext) + call MV_Unpack2(Var, ValAry, u%Fext) ! Rank 1 Array + end select + end associate +end subroutine + +subroutine LD_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call LD_UnpackInputVar(Vars%u(i), ValAry, u) + end do +end subroutine + + +subroutine LD_PackOutputVar(Var, y, ValAry) + type(LD_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (LD_y_xdd) + call MV_Pack2(Var, y%xdd, ValAry) ! Rank 1 Array + case (LD_y_WriteOutput) + call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_PackOutputAry(Vars, y, ValAry) + type(LD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call LD_PackOutputVar(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine LD_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(LD_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (LD_y_xdd) + call MV_Unpack2(Var, ValAry, y%xdd) ! Rank 1 Array + case (LD_y_WriteOutput) + call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array + end select + end associate +end subroutine + +subroutine LD_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call LD_UnpackOutputVar(Vars%y(i), ValAry, y) + end do +end subroutine + END MODULE LinDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 4c1e05e892..67b0a7607b 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -68,6 +68,7 @@ set(NWTCLIBS_SOURCES src/NWTC_Base.f90 src/SingPrec.f90 src/ModReg.f90 + src/ModVar.f90 src/ModMesh.f90 src/ModMesh_Mapping.f90 diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index a9ea3df373..15044027c9 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -59,14 +59,14 @@ module ModVar end interface interface MV_Pack2 - module procedure MV_Pack2VarRank0R4, MV_Pack2VarRank1R4, MV_Pack2VarRank2R4, MV_Pack2VarRank3R4, MV_Pack2VarRank4R4 - module procedure MV_Pack2VarRank0R8, MV_Pack2VarRank1R8, MV_Pack2VarRank2R8, MV_Pack2VarRank3R8, MV_Pack2VarRank4R8 + module procedure MV_Pack2VarRank0R4, MV_Pack2VarRank1R4, MV_Pack2VarRank2R4, MV_Pack2VarRank3R4, MV_Pack2VarRank4R4, MV_Pack2VarRank5R4 + module procedure MV_Pack2VarRank0R8, MV_Pack2VarRank1R8, MV_Pack2VarRank2R8, MV_Pack2VarRank3R8, MV_Pack2VarRank4R8, MV_Pack2VarRank5R8 module procedure MV_Pack2Mesh end interface interface MV_Unpack2 - module procedure MV_Unpack2VarRank0R4, MV_Unpack2VarRank1R4, MV_Unpack2VarRank2R4, MV_Unpack2VarRank3R4, MV_Unpack2VarRank4R4 - module procedure MV_Unpack2VarRank0R8, MV_Unpack2VarRank1R8, MV_Unpack2VarRank2R8, MV_Unpack2VarRank3R8, MV_Unpack2VarRank4R8 + module procedure MV_Unpack2VarRank0R4, MV_Unpack2VarRank1R4, MV_Unpack2VarRank2R4, MV_Unpack2VarRank3R4, MV_Unpack2VarRank4R4, MV_Unpack2VarRank5R4 + module procedure MV_Unpack2VarRank0R8, MV_Unpack2VarRank1R8, MV_Unpack2VarRank2R8, MV_Unpack2VarRank3R8, MV_Unpack2VarRank4R8, MV_Unpack2VarRank5R8 module procedure MV_Unpack2Mesh end interface @@ -184,6 +184,20 @@ subroutine MV_Pack2VarRank4R8(Var, Vals, Ary) Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), .true.) end subroutine +subroutine MV_Pack2VarRank5R4(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R4Ki), intent(in) :: Vals(:, :, :, :, :) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry), R8Ki), .true.) +end subroutine + +subroutine MV_Pack2VarRank5R8(Var, Vals, Ary) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Vals(:, :, :, :, :) + real(R8Ki), intent(inout) :: Ary(:) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry), .true.) +end subroutine + subroutine MV_Pack2Mesh(Var, Mesh, Ary) type(ModVarType), intent(in) :: Var type(MeshType), intent(in) :: Mesh @@ -301,6 +315,24 @@ subroutine MV_Unpack2VarRank4R8(Var, Ary, Vals) end associate end subroutine +subroutine MV_Unpack2VarRank5R4(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R4Ki), intent(inout) :: Vals(:, :, :, :, :) + associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry)) + V = reshape(real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki), shape(V)) + end associate +end subroutine + +subroutine MV_Unpack2VarRank5R8(Var, Ary, Vals) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:, :, :, :, :) + associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry)) + V = reshape(Ary(Var%iLoc(1):Var%iLoc(2)), shape(V)) + end associate +end subroutine + subroutine MV_Unpack2Mesh(Var, Vals, Mesh) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: Vals(:) diff --git a/modules/nwtc-library/src/NWTC_Library.f90 b/modules/nwtc-library/src/NWTC_Library.f90 index e9c944c128..bd37a1ac85 100644 --- a/modules/nwtc-library/src/NWTC_Library.f90 +++ b/modules/nwtc-library/src/NWTC_Library.f90 @@ -78,6 +78,7 @@ MODULE NWTC_Library USE NWTC_Str ! String utils USE ModMesh USE ModReg + USE ModVar #ifndef NO_MESHMAPPING ! Note that ModMesh_Mapping also includes LAPACK routines diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index e46d5b8f2b..055bb61217 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -134,7 +134,8 @@ MODULE NWTC_Library_Types INTEGER(IntKi) , DIMENSION(1:2) :: iAry = 0 !< first user defined index for variable [-] INTEGER(IntKi) :: jAry = 0 !< second user defined index for variable [-] INTEGER(IntKi) :: kAry = 0 !< third user defined index for variable [-] - INTEGER(IntKi) :: mAry = 0 !< third user defined index for variable [-] + INTEGER(IntKi) :: mAry = 0 !< fourth user defined index for variable [-] + INTEGER(IntKi) :: nAry = 0 !< fifth user defined index for variable [-] INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] REAL(R8Ki) :: Perturb = 0 !< perturbation amount for linearization [-] TYPE(DatLoc) :: DL !< data location [-] @@ -697,6 +698,7 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr DstModVarTypeData%jAry = SrcModVarTypeData%jAry DstModVarTypeData%kAry = SrcModVarTypeData%kAry DstModVarTypeData%mAry = SrcModVarTypeData%mAry + DstModVarTypeData%nAry = SrcModVarTypeData%nAry DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb call NWTC_Library_CopyDatLoc(SrcModVarTypeData%DL, DstModVarTypeData%DL, CtrlCode, ErrStat2, ErrMsg2) @@ -749,6 +751,7 @@ subroutine NWTC_Library_PackModVarType(RF, Indata) call RegPack(RF, InData%jAry) call RegPack(RF, InData%kAry) call RegPack(RF, InData%mAry) + call RegPack(RF, InData%nAry) call RegPack(RF, InData%MeshID) call RegPack(RF, InData%Perturb) call NWTC_Library_PackDatLoc(RF, InData%DL) @@ -776,6 +779,7 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) call RegUnpack(RF, OutData%jAry); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%kAry); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%mAry); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAry); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MeshID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Perturb); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackDatLoc(RF, OutData%DL) ! DL diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 52fabfd7ae..185ffa250f 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -91,7 +91,8 @@ typedef ^ ^ IntKi iGlu 2 0 - typedef ^ ^ IntKi iAry 2 0 - "first user defined index for variable" - typedef ^ ^ IntKi jAry - 0 - "second user defined index for variable" - typedef ^ ^ IntKi kAry - 0 - "third user defined index for variable" - -typedef ^ ^ IntKi mAry - 0 - "third user defined index for variable" - +typedef ^ ^ IntKi mAry - 0 - "fourth user defined index for variable" - +typedef ^ ^ IntKi nAry - 0 - "fifth user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ DatLoc DL - - - "data location" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 7d8cc4c13b..d007f45746 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -91,7 +91,8 @@ typedef ^ ^ IntKi iGlu 2 0 - typedef ^ ^ IntKi iAry 2 0 - "first user defined index for variable" - typedef ^ ^ IntKi jAry - 0 - "second user defined index for variable" - typedef ^ ^ IntKi kAry - 0 - "third user defined index for variable" - -typedef ^ ^ IntKi mAry - 0 - "third user defined index for variable" - +typedef ^ ^ IntKi mAry - 0 - "fourth user defined index for variable" - +typedef ^ ^ IntKi nAry - 0 - "fifth user defined index for variable" - typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ DatLoc DL - - - "data location" - diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index e3c6a90277..0bb8eab8ab 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -392,28 +392,21 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD END DO END IF + !---------------------------------------------------------------------------- + ! Initialize InflowWind + !---------------------------------------------------------------------------- - END IF - - - ! ........................ - ! initialize InflowWind - ! ........................ - ALLOCATE( IfW%Input( p_FAST%InterpOrder+1 ), IfW%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input and IfW%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( IfW%Input_Saved( p_FAST%InterpOrder+1 ), IfW%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input_Saved and IfW%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(IfW%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return + allocate(IfW%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return + allocate(IfW%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("IfW%Input_Saved")) return + allocate(IfW%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return + allocate(IfW%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return + allocate(IfW%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return + allocate(IfW%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return - IF ( p_FAST%CompInflow == Module_IfW ) THEN + select case(p_FAST%CompInflow) + case (Module_IfW) Init%InData_IfW%Linearize = p_FAST%Linearize Init%InData_IfW%InputFileName = p_FAST%InflowFile @@ -545,25 +538,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD case default Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi - END IF ! CompInflow + end select ! CompInflow + !---------------------------------------------------------------------------- + ! Initialize SeaStates + !---------------------------------------------------------------------------- - ! ........................ - ! initialize SeaStates - ! ........................ - ALLOCATE( SeaSt%Input( p_FAST%InterpOrder+1 ), SeaSt%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input and SeaSt%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( SeaSt%Input_Saved( p_FAST%InterpOrder+1 ), SeaSt%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input_Saved and SeaSt%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(SeaSt%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return + allocate(SeaSt%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return + allocate(SeaSt%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("SeaSt%Input_Saved")) return + allocate(SeaSt%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return + allocate(SeaSt%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return + allocate(SeaSt%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return + allocate(SeaSt%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return if ( p_FAST%CompSeaSt == Module_SeaSt ) then @@ -5252,10 +5240,6 @@ SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - END DO - DO j = 1, p_FAST%InterpOrder + 1 CALL AD_CopyInput (AD%Input(1), AD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -9576,7 +9560,7 @@ END SUBROUTINE FAST_RestoreForVTKModeShape_Tary !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the motions generated by mode shapes and outputs VTK data for it SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index f72aa29e8b..e1068f16db 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -51,36 +51,36 @@ MODULE FAST_Types USE ExtPtfm_MCKF_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Unknown = -1 ! Unknown [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_None = 0 ! No module selected [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Glue = 1 ! Glue code [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IfW = 2 ! InflowWind [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 ! ExternalInflow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ED = 4 ! ElastoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! ExternalLoads [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 12 ! SubDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 13 ! External Platform Loading MCKF [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 14 ! MAP (Mooring Analysis Program) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 15 ! FEAMooring [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 16 ! MoorDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 19 ! The number of modules available in FAST [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_TSR = 2 ! TSR [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_WS = 3 ! wind speed [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Unknown = -1 ! Unknown [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_None = 0 ! No module selected [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Glue = 1 ! Glue code [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IfW = 2 ! InflowWind [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 ! ExternalInflow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ED = 4 ! ElastoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! ExternalLoads [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 12 ! SubDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 13 ! External Platform Loading MCKF [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 14 ! MAP (Mooring Analysis Program) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 15 ! FEAMooring [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 16 ! MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 19 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_TSR = 2 ! TSR [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_WS = 3 ! wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] @@ -8287,32 +8287,7 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call SrvD_UnpackParam(RF, OutData%p) ! p - call SrvD_UnpackInput(RF, OutData%u) ! u - call SrvD_UnpackOutput(RF, OutData%y) ! y - call SrvD_UnpackMisc(RF, OutData%m) ! m - call SrvD_UnpackMisc(RF, OutData%m_bak) ! m_bak - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return @@ -8351,8 +8326,65 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if + call SrvD_UnpackParam(RF, OutData%p) ! p + call SrvD_UnpackInput(RF, OutData%u) ! u + call SrvD_UnpackOutput(RF, OutData%y) ! y + call SrvD_UnpackMisc(RF, OutData%m) ! m + call SrvD_UnpackMisc(RF, OutData%m_bak) ! m_bak + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call SrvD_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index ba66392f50..f7edf7340d 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -244,7 +244,32 @@ MODULE WakeDynamics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WAT_k !< Scaling factor k_mt(iP,y,z) for wake-added turbulence [-] END TYPE WD_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: WD_x_DummyContState = 1 ! WD%DummyContState + integer(IntKi), public, parameter :: WD_z_DummyConstrState = 2 ! WD%DummyConstrState + integer(IntKi), public, parameter :: WD_u_xhat_disk = 3 ! WD%xhat_disk + integer(IntKi), public, parameter :: WD_u_YawErr = 4 ! WD%YawErr + integer(IntKi), public, parameter :: WD_u_psi_skew = 5 ! WD%psi_skew + integer(IntKi), public, parameter :: WD_u_chi_skew = 6 ! WD%chi_skew + integer(IntKi), public, parameter :: WD_u_p_hub = 7 ! WD%p_hub + integer(IntKi), public, parameter :: WD_u_V_plane = 8 ! WD%V_plane + integer(IntKi), public, parameter :: WD_u_Vx_wind_disk = 9 ! WD%Vx_wind_disk + integer(IntKi), public, parameter :: WD_u_TI_amb = 10 ! WD%TI_amb + integer(IntKi), public, parameter :: WD_u_D_rotor = 11 ! WD%D_rotor + integer(IntKi), public, parameter :: WD_u_Vx_rel_disk = 12 ! WD%Vx_rel_disk + integer(IntKi), public, parameter :: WD_u_Ct_azavg = 13 ! WD%Ct_azavg + integer(IntKi), public, parameter :: WD_u_Cq_azavg = 14 ! WD%Cq_azavg + integer(IntKi), public, parameter :: WD_y_xhat_plane = 15 ! WD%xhat_plane + integer(IntKi), public, parameter :: WD_y_p_plane = 16 ! WD%p_plane + integer(IntKi), public, parameter :: WD_y_Vx_wake = 17 ! WD%Vx_wake + integer(IntKi), public, parameter :: WD_y_Vr_wake = 18 ! WD%Vr_wake + integer(IntKi), public, parameter :: WD_y_Vx_wake2 = 19 ! WD%Vx_wake2 + integer(IntKi), public, parameter :: WD_y_Vy_wake2 = 20 ! WD%Vy_wake2 + integer(IntKi), public, parameter :: WD_y_Vz_wake2 = 21 ! WD%Vz_wake2 + integer(IntKi), public, parameter :: WD_y_D_wake = 22 ! WD%D_wake + integer(IntKi), public, parameter :: WD_y_x_plane = 23 ! WD%x_plane + integer(IntKi), public, parameter :: WD_y_WAT_k = 24 ! WD%WAT_k + +contains subroutine WD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) type(WD_InputFileType), intent(in) :: SrcInputFileTypeData @@ -1914,7 +1939,7 @@ subroutine WD_UnPackOutput(RF, OutData) function WD_InputMeshPointer(u, ML) result(Mesh) type(WD_InputType), target, intent(in) :: u - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1922,7 +1947,7 @@ function WD_InputMeshPointer(u, ML) result(Mesh) end function function WD_InputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) @@ -1931,7 +1956,7 @@ function WD_InputMeshName(ML) result(Name) function WD_OutputMeshPointer(y, ML) result(Mesh) type(WD_OutputType), target, intent(in) :: y - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML type(MeshType), pointer :: Mesh nullify(Mesh) select case (ML%Num) @@ -1939,11 +1964,287 @@ function WD_OutputMeshPointer(y, ML) result(Mesh) end function function WD_OutputMeshName(ML) result(Name) - type(MeshLocType), intent(in) :: ML + type(DatLoc), intent(in) :: ML character(32) :: Name Name = "" select case (ML%Num) end select end function + +subroutine WD_PackContStateVar(Var, x, ValAry) + type(WD_ContinuousStateType), intent(in) :: x + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WD_x_DummyContState) + call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_PackContStateAry(Vars, x, ValAry) + type(WD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call WD_PackContStateVar(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine WD_UnpackContStateVar(Var, ValAry, x) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WD_x_DummyContState) + call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar + end select + end associate +end subroutine + +subroutine WD_UnpackContStateAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call WD_UnpackContStateVar(Vars%x(i), ValAry, x) + end do +end subroutine + + +subroutine WD_PackConstrStateVar(Var, z, ValAry) + type(WD_ConstraintStateType), intent(in) :: z + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WD_z_DummyConstrState) + call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_PackConstrStateAry(Vars, z, ValAry) + type(WD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call WD_PackConstrStateVar(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine WD_UnpackConstrStateVar(Var, ValAry, z) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WD_z_DummyConstrState) + call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar + end select + end associate +end subroutine + +subroutine WD_UnpackConstrStateAry(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call WD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + end do +end subroutine + + +subroutine WD_PackInputVar(Var, u, ValAry) + type(WD_InputType), intent(in) :: u + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WD_u_xhat_disk) + call MV_Pack2(Var, u%xhat_disk, ValAry) ! Rank 1 Array + case (WD_u_YawErr) + call MV_Pack2(Var, u%YawErr, ValAry) ! Scalar + case (WD_u_psi_skew) + call MV_Pack2(Var, u%psi_skew, ValAry) ! Scalar + case (WD_u_chi_skew) + call MV_Pack2(Var, u%chi_skew, ValAry) ! Scalar + case (WD_u_p_hub) + call MV_Pack2(Var, u%p_hub, ValAry) ! Rank 1 Array + case (WD_u_V_plane) + call MV_Pack2(Var, u%V_plane, ValAry) ! Rank 2 Array + case (WD_u_Vx_wind_disk) + call MV_Pack2(Var, u%Vx_wind_disk, ValAry) ! Scalar + case (WD_u_TI_amb) + call MV_Pack2(Var, u%TI_amb, ValAry) ! Scalar + case (WD_u_D_rotor) + call MV_Pack2(Var, u%D_rotor, ValAry) ! Scalar + case (WD_u_Vx_rel_disk) + call MV_Pack2(Var, u%Vx_rel_disk, ValAry) ! Scalar + case (WD_u_Ct_azavg) + call MV_Pack2(Var, u%Ct_azavg, ValAry) ! Rank 1 Array + case (WD_u_Cq_azavg) + call MV_Pack2(Var, u%Cq_azavg, ValAry) ! Rank 1 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_PackInputAry(Vars, u, ValAry) + type(WD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call WD_PackInputVar(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine WD_UnpackInputVar(Var, ValAry, u) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WD_InputType), intent(inout) :: u + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WD_u_xhat_disk) + call MV_Unpack2(Var, ValAry, u%xhat_disk) ! Rank 1 Array + case (WD_u_YawErr) + call MV_Unpack2(Var, ValAry, u%YawErr) ! Scalar + case (WD_u_psi_skew) + call MV_Unpack2(Var, ValAry, u%psi_skew) ! Scalar + case (WD_u_chi_skew) + call MV_Unpack2(Var, ValAry, u%chi_skew) ! Scalar + case (WD_u_p_hub) + call MV_Unpack2(Var, ValAry, u%p_hub) ! Rank 1 Array + case (WD_u_V_plane) + call MV_Unpack2(Var, ValAry, u%V_plane) ! Rank 2 Array + case (WD_u_Vx_wind_disk) + call MV_Unpack2(Var, ValAry, u%Vx_wind_disk) ! Scalar + case (WD_u_TI_amb) + call MV_Unpack2(Var, ValAry, u%TI_amb) ! Scalar + case (WD_u_D_rotor) + call MV_Unpack2(Var, ValAry, u%D_rotor) ! Scalar + case (WD_u_Vx_rel_disk) + call MV_Unpack2(Var, ValAry, u%Vx_rel_disk) ! Scalar + case (WD_u_Ct_azavg) + call MV_Unpack2(Var, ValAry, u%Ct_azavg) ! Rank 1 Array + case (WD_u_Cq_azavg) + call MV_Unpack2(Var, ValAry, u%Cq_azavg) ! Rank 1 Array + end select + end associate +end subroutine + +subroutine WD_UnpackInputAry(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call WD_UnpackInputVar(Vars%u(i), ValAry, u) + end do +end subroutine + + +subroutine WD_PackOutputVar(Var, y, ValAry) + type(WD_OutputType), intent(in) :: y + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WD_y_xhat_plane) + call MV_Pack2(Var, y%xhat_plane, ValAry) ! Rank 2 Array + case (WD_y_p_plane) + call MV_Pack2(Var, y%p_plane, ValAry) ! Rank 2 Array + case (WD_y_Vx_wake) + call MV_Pack2(Var, y%Vx_wake, ValAry) ! Rank 2 Array + case (WD_y_Vr_wake) + call MV_Pack2(Var, y%Vr_wake, ValAry) ! Rank 2 Array + case (WD_y_Vx_wake2) + call MV_Pack2(Var, y%Vx_wake2, ValAry) ! Rank 3 Array + case (WD_y_Vy_wake2) + call MV_Pack2(Var, y%Vy_wake2, ValAry) ! Rank 3 Array + case (WD_y_Vz_wake2) + call MV_Pack2(Var, y%Vz_wake2, ValAry) ! Rank 3 Array + case (WD_y_D_wake) + call MV_Pack2(Var, y%D_wake, ValAry) ! Rank 1 Array + case (WD_y_x_plane) + call MV_Pack2(Var, y%x_plane, ValAry) ! Rank 1 Array + case (WD_y_WAT_k) + call MV_Pack2(Var, y%WAT_k, ValAry) ! Rank 3 Array + case default + ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_PackOutputAry(Vars, y, ValAry) + type(WD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call WD_PackOutputVar(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine WD_UnpackOutputVar(Var, ValAry, y) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(WD_OutputType), intent(inout) :: y + integer(IntKi) :: i + associate (DL => Var%DL) + select case (Var%DL%Num) + case (WD_y_xhat_plane) + call MV_Unpack2(Var, ValAry, y%xhat_plane) ! Rank 2 Array + case (WD_y_p_plane) + call MV_Unpack2(Var, ValAry, y%p_plane) ! Rank 2 Array + case (WD_y_Vx_wake) + call MV_Unpack2(Var, ValAry, y%Vx_wake) ! Rank 2 Array + case (WD_y_Vr_wake) + call MV_Unpack2(Var, ValAry, y%Vr_wake) ! Rank 2 Array + case (WD_y_Vx_wake2) + call MV_Unpack2(Var, ValAry, y%Vx_wake2) ! Rank 3 Array + case (WD_y_Vy_wake2) + call MV_Unpack2(Var, ValAry, y%Vy_wake2) ! Rank 3 Array + case (WD_y_Vz_wake2) + call MV_Unpack2(Var, ValAry, y%Vz_wake2) ! Rank 3 Array + case (WD_y_D_wake) + call MV_Unpack2(Var, ValAry, y%D_wake) ! Rank 1 Array + case (WD_y_x_plane) + call MV_Unpack2(Var, ValAry, y%x_plane) ! Rank 1 Array + case (WD_y_WAT_k) + call MV_Unpack2(Var, ValAry, y%WAT_k) ! Rank 3 Array + end select + end associate +end subroutine + +subroutine WD_UnpackOutputAry(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call WD_UnpackOutputVar(Vars%y(i), ValAry, y) + end do +end subroutine + END MODULE WakeDynamics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/reg_tests/r-test b/reg_tests/r-test index 4d17325af0..1abd888ce2 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 4d17325af0913132fdfe92c15f3ea00669b50d12 +Subproject commit 1abd888ce2209432cf5d126d5bfcd989d221327b From 8dc5ebb9377bbcc226075d00b1a930bacf7fe6a2 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 24 Jul 2024 20:16:03 +0000 Subject: [PATCH 158/319] Linearization changes --- modules/aerodyn/src/AeroDyn.f90 | 102 +++-- modules/beamdyn/src/BeamDyn.f90 | 385 ++++-------------- modules/hydrodyn/src/HydroDyn.f90 | 314 +++++--------- modules/hydrodyn/src/HydroDyn.txt | 5 +- modules/inflowwind/src/InflowWind.f90 | 91 +---- modules/map/src/MAP_Registry.txt | 5 +- modules/map/src/map.f90 | 138 +------ modules/nwtc-library/src/ModVar.f90 | 329 +++++++-------- .../src/Registry_NWTC_Library.txt | 13 +- .../src/Registry_NWTC_Library_base.txt | 13 +- modules/openfast-library/src/FAST_Funcs.f90 | 192 ++++----- modules/openfast-library/src/FAST_Mapping.f90 | 174 ++++---- modules/openfast-library/src/FAST_ModGlue.f90 | 70 ++-- modules/openfast-registry/src/registry.hpp | 10 +- .../src/registry_gen_fortran.cpp | 110 ++--- modules/seastate/src/SeaState.f90 | 116 ++---- modules/seastate/src/SeaState.txt | 5 +- modules/servodyn/src/ServoDyn.f90 | 59 +-- modules/subdyn/src/SubDyn.f90 | 317 +++----------- modules/subdyn/src/SubDyn_Registry.txt | 3 +- 20 files changed, 875 insertions(+), 1576 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 1781d76896..e3064028dc 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -61,7 +61,7 @@ module AeroDyn ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) PUBLIC :: AD_GetOP !< Routine to pack the operating point values into arrays - PUBLIC :: AD_SetOP !< Routine to unpack the operating point arrays into data structures + PUBLIC :: AD_PackExtInputAry !< Routine pack extended inputs contains !---------------------------------------------------------------------------------------------------------------------------------- @@ -5614,7 +5614,7 @@ subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, if (p%BEMT%DBEMT%lin_nx/2 > 0) then do j = 1, p%NumBlades do i = 1, p%NumBlNds - call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & + call MV_AddVar(p%Vars%x, "DBEMT%Element%vind", FieldScalar, & DatLoc(AD_x_BEMT_DBEMT_element_vind, i, j), & Num=2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & @@ -5625,7 +5625,7 @@ subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, end do do j = 1, p%NumBlades do i = 1, p%NumBlNds - call MV_AddVar(p%Vars%x, "DBEMT%Element", FieldScalar, & + call MV_AddVar(p%Vars%x, "DBEMT%Element%vind_1", FieldScalar, & DatLoc(AD_x_BEMT_DBEMT_element_vind_1, i, j), & Num=2, & Flags=ior(VF_DerivOrder2, VF_RotFrame), & @@ -5689,6 +5689,7 @@ subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, call MV_AddMeshVar(p%Vars%u, "Tower", [FieldTransDisp, FieldOrientation, FieldTransVel, FieldTransAcc], & DatLoc(AD_u_TowerMotion), & Mesh=u%TowerMotion, & + Flags=VF_SmallAngle, & Perturbs=[PerturbTower, Perturb, PerturbTower, PerturbTower]) ! Add blade root motion @@ -5872,11 +5873,11 @@ END SUBROUTINE AD_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE Rot_JacobianPInput(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE Rot_JacobianPInput(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. use IfW_FlowField, only: FlowFieldType, UniformField_InterpLinear type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays - INTEGER(IntKi), INTENT(IN ) :: iRot !< Rotor index + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow @@ -5949,7 +5950,6 @@ SUBROUTINE Rot_JacobianPInput(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, Ot call AD_CopyRotContinuousStateType(x, m%x_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! Initialize x_init so that we get accurrate values for first step ! changes values only if states haven't been initialized if (.not. OtherState%BEMT%nodesInitialized) then @@ -5989,7 +5989,7 @@ SUBROUTINE Rot_JacobianPInput(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, Ot call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return - call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2); if (Failed()) return call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation @@ -6002,7 +6002,7 @@ SUBROUTINE Rot_JacobianPInput(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, Ot call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return - call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2); if (Failed()) return call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index @@ -6050,6 +6050,7 @@ SUBROUTINE Rot_JacobianPInput(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, Ot ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 + ! Get partial derivative via central difference and store in full linearization array dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do @@ -6141,11 +6142,11 @@ END SUBROUTINE AD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE RotJacobianPContState(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE RotJacobianPContState(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) !.................................................................................................................................. - type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays - integer(IntKi), INTENT(IN ) :: iRot !< Rotor index + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays + integer(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow @@ -6219,13 +6220,13 @@ SUBROUTINE RotJacobianPContState(Vars, iRot, t, u, RotInflow, p, p_AD, x, xd, z, ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) - call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return + call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2) ; if (Failed()) return call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) - call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRot, ErrStat2, ErrMsg2) ; if (Failed()) return + call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2) ; if (Failed()) return call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index @@ -6298,7 +6299,8 @@ END SUBROUTINE RotJacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. -SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +SUBROUTINE AD_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6319,8 +6321,6 @@ SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrStat = ErrID_None ErrMsg = '' - return; ! nothing to do here - ! IF ( PRESENT( dYdxd ) ) THEN ! END IF ! @@ -6338,7 +6338,8 @@ END SUBROUTINE AD_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. -SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +SUBROUTINE AD_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6712,30 +6713,49 @@ logical function Failed() end function end subroutine RotGetOP -!> AD_SetOP populates the data structures from the operating point arrays. (Extended inputs are not used) -subroutine AD_SetOP(Vars, iRotor, u, p, x, z, ErrStat, ErrMsg, u_op, x_op, z_op) - type(ModVarsType), INTENT(IN ) :: Vars !< Module variables - INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index - TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(IN ) :: z_op(:) !< values of linearized constraint states - - character(*), parameter :: RoutineName = 'AD_SetOP' - - ErrStat = ErrID_None - ErrMsg = '' - - if (present(u_op)) call AD_UnpackInputAry(Vars, u_op, u%rotors(iRotor)) - if (present(x_op)) call AD_UnpackContStateAry(Vars, x_op, x%rotors(iRotor)) - if (present(z_op)) call AD_UnpackConstrStateAry(Vars, z_op, z%rotors(iRotor)) - -end subroutine +subroutine AD_PackExtInputAry(Vars, t, p, ValAry) + use IfW_FlowField_Types, only : UniformField_Interp + use IfW_FlowField, only : UniformField_InterpCubic, UniformField_InterpLinear + type(ModVarsType), intent(in) :: Vars + real(DbKi), intent(in) :: t !< Time in seconds at operating point + type(AD_ParameterType), intent(in) :: p !< Parameters + real(R8Ki), intent(inout) :: ValAry(:) + type(UniformField_Interp) :: op !< Interpolated values of UniformField + integer(IntKi) :: i + logical :: first + first = .true. + do i = 1, size(Vars%u) + associate(Var => Vars%u(i)) + select case(Var%DL%Num) + case (AD_u_HWindSpeed) + call CalcExtOP() + call MV_Pack2(Var, op%VelH, ValAry) + case (AD_u_PLExp) + call CalcExtOP() + call MV_Pack2(Var, op%ShrV, ValAry) + case (AD_u_PropagationDir) + call CalcExtOP() + call MV_Pack2(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + end select + end associate + end do +contains + subroutine CalcExtOP() + if (.not. first) return + first = .false. + if (p%FlowField%FieldType == Uniform_FieldType) then + if (P%FlowField%VelInterpCubic) then + op = UniformField_InterpCubic(p%FlowField%Uniform, t) + else + op = UniformField_InterpLinear(p%FlowField%Uniform, t) + end if + else + op%VelH = 0.0_ReKi + op%ShrV = 0.0_ReKi + op%AngleH = 0.0_ReKi + end if + end subroutine +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index eb1e633843..a0a4a28cc9 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -48,7 +48,6 @@ MODULE BeamDyn PUBLIC :: BD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - PUBLIC :: BD_GetOP !< Routine to pack the operating point values (for linearization) into arrays PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT @@ -1969,9 +1968,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, CHARACTER(*), PARAMETER :: RoutineName = 'BD_CalcOutput' LOGICAL :: IsFullLin - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = "" AllOuts = 0.0_ReKi @@ -5848,8 +5845,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldTransDisp, & - DatLoc(BD_x_q), iAry=1, jAry=i, & - Num=3, & + DatLoc(BD_x_q), iAry=1, jAry=i, Num=3, & Flags=Flags, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(label)//' translational displacement in X, m', & @@ -5857,9 +5853,8 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) trim(label)//' translational displacement in Z, m']) call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldOrientation, & - DatLoc(BD_x_q), iAry=4, jAry=i, & - Num=3, & - Flags=Flags, & + DatLoc(BD_x_q), iAry=4, jAry=i, Num=3, & + Flags=ior(Flags, VF_WM_Rot), & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(label)//' rotational displacement in X, rad', & trim(label)//' rotational displacement in Y, rad', & @@ -5872,8 +5867,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldTransVel, & - DatLoc(BD_x_dqdt), iAry=1, jAry=i, & - Num=3, & + DatLoc(BD_x_dqdt), iAry=1, jAry=i, Num=3, & Flags=Flags, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(label)//' translational displacement in X, m/s', & @@ -5881,8 +5875,7 @@ subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) trim(label)//' translational displacement in Z, m/s']) call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldAngularVel, & - DatLoc(BD_x_dqdt), iAry=4, jAry=i, & - Num=3, & + DatLoc(BD_x_dqdt), iAry=4, jAry=i, Num=3, & Flags=Flags, & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(label)//' rotational displacement in X, rad/s', & @@ -6001,89 +5994,6 @@ logical function Failed() end function Failed end subroutine -subroutine BD_PackContStateAryQuat(Vars, x, ValAry) - type(ModVarsType), intent(in) :: Vars - type(BD_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - call BD_PackContStateAry(Vars, x, ValAry) - do i = 1, size(Vars%x) - if (Vars%x(i)%Field == FieldOrientation) then - associate(Var => Vars%x(i)) - ValAry(Var%iLoc(1):Var%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, Var%jAry))) - end associate - end if - end do -end subroutine - -subroutine BD_UnpackContStateAryQuat(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(BD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - call BD_UnpackContStateAry(Vars, ValAry, x) - do i = 1, size(Vars%x) - if (Vars%x(i)%Field == FieldOrientation) then - associate(Var => Vars%x(i)) - x%q(4:6, Var%jAry) = wm_inv(quat_to_wm(ValAry(Var%iLoc(1):Var%iLoc(2)))) - end associate - end if - end do -end subroutine - -! subroutine BD_PackContStateOP(p, x, Values) -! type(BD_ParameterType), intent(in) :: p -! type(BD_ContinuousStateType), intent(in) :: x -! real(R8Ki), intent(out) :: Values(:) -! integer(IntKi) :: i -! do i = 1, size(p%Vars%x) -! associate (Var => p%Vars%x(i)) -! select case(Var%Field) -! case (FieldTransDisp) -! Values(Var%iLoc(1):Var%iLoc(2)) = x%q(1:3,Var%iUsr(1)) ! XYZ velocity -! case (FieldOrientation) -! Values(Var%iLoc(1):Var%iLoc(2)) = x%q(4:6,Var%iUsr(1)) ! Angular velocity -! case (FieldTransVel) -! Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(1:3,Var%iUsr(1)) ! XYZ acceleration -! case (FieldAngularVel) -! Values(Var%iLoc(1):Var%iLoc(2)) = x%dqdt(4:6,Var%iUsr(1)) ! Angular acceleration -! end select -! end associate -! end do -! end subroutine - -! subroutine BD_PackInputOP(p, u, Values) -! type(BD_ParameterType), intent(in) :: p -! type(BD_InputType), intent(in) :: u -! real(R8Ki), intent(out) :: Values(:) -! call MV_Pack(p%Vars%u, p%iVarRootMotion, u%RootMotion, Values) -! call MV_Pack(p%Vars%u, p%iVarPointLoad, u%PointLoad, Values) -! call MV_Pack(p%Vars%u, p%iVarDistrLoad, u%DistrLoad, Values) -! end subroutine - -! subroutine BD_UnpackInputOP(p, Ary, u) -! type(BD_ParameterType), intent(in) :: p -! real(R8Ki), intent(in) :: Ary(:) -! type(BD_InputType), intent(inout) :: u -! call MV_Unpack(p%Vars%u, p%iVarRootMotion, Ary, u%RootMotion) -! call MV_Unpack(p%Vars%u, p%iVarPointLoad, Ary, u%PointLoad) -! call MV_Unpack(p%Vars%u, p%iVarDistrLoad, Ary, u%DistrLoad) -! end subroutine - -! subroutine BD_PackOutputOP(p, y, Ary, PackWriteOutput) -! type(BD_ParameterType), intent(in) :: p -! type(BD_OutputType), intent(in) :: y -! real(R8Ki), intent(out) :: Ary(:) -! logical, intent(in) :: PackWriteOutput -! integer(IntKi) :: i -! call MV_Pack(p%Vars%y, p%iVarReactionForce, y%ReactionForce, Ary) -! call MV_Pack(p%Vars%y, p%iVarBldMotion, y%BldMotion, Ary) -! if (PackWriteOutput) then -! do i = p%iVarWriteOutput, size(p%Vars%y) -! call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1):p%Vars%y(i)%iUsr(2)), Ary) -! end do -! end if -! end subroutine !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ###### The following four routines are Jacobian routines for linearization capabilities ####### @@ -6091,9 +6001,9 @@ subroutine BD_UnpackContStateAryQuat(Vars, ValAry, x) !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. +SUBROUTINE BD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6108,7 +6018,6 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] @@ -6118,60 +6027,59 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 REAL(R8Ki) :: RotateStates(3,3) - logical :: IsFullLin + logical :: NeedWriteOutput INTEGER(IntKi) :: i, j, col - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - ! If vars were provided use them, otherwise use module variables - if (present(Vars)) then - VarsL => Vars - IsFullLin = size(Vars%y) == size(p%Vars%y) - else - VarsL => p%Vars - IsFullLin = .true. - end if - ! Get OP values here call BD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if (Failed()) return ! Make a copy of the inputs to perturb call BD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackInputAry(VarsL, u, m%Jac%u) + call BD_PackInputAry(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if + + ! Determine if write outputs need to be calculated (usually at end of output variables) + NeedWriteOutput = .false. + do i = size(Vars%y), 1, -1 + if (MV_HasFlags(Vars%y(i), VF_WriteOut)) then + NeedWriteOutput = .true. + exit + end if + end do ! Loop through input variables - do i = 1, size(VarsL%u) + do i = 1, size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return + call BD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return + call BD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do @@ -6182,32 +6090,32 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(VarsL%u) + do i = 1, size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num + + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) + call BD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call BD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) - - ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + call BD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do end do @@ -6245,9 +6153,9 @@ END SUBROUTINE BD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE BD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx, StateRotation) -!.................................................................................................................................. +SUBROUTINE BD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, StateRotation) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6262,7 +6170,6 @@ SUBROUTINE BD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) @@ -6274,25 +6181,15 @@ SUBROUTINE BD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E CHARACTER(ErrMsgLen) :: ErrMsg2 REAL(R8Ki) :: RotateStates(3,3) REAL(R8Ki) :: RotateStatesTranspose(3,3) - logical :: IsFullLin INTEGER(IntKi) :: i, j, col - type(ModVarsType), pointer :: VarsL + logical :: NeedWriteOutput ErrStat = ErrID_None ErrMsg = '' - ! If vars were provided use them, otherwise use module variables - if (present(Vars)) then - VarsL => Vars - IsFullLin = size(Vars%y) == size(p%Vars%y) - else - VarsL => p%Vars - IsFullLin = .true. - end if - ! Copy state values call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAryQuat(VarsL, x, m%Jac%x) + call BD_PackContStateAry(Vars, x, m%Jac%x) ! If rotate states is enabled if (p%RotStates) then @@ -6319,32 +6216,41 @@ SUBROUTINE BD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, VarsL%Ny, VarsL%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if + ! Determine if write outputs need to be calculated (usually at end of output variables) + NeedWriteOutput = .false. + do i = size(Vars%y), 1, -1 + if (MV_HasFlags(Vars%y(i), VF_WriteOut)) then + NeedWriteOutput = .true. + exit + end if + end do + ! Loop through state variables - do i = 1, size(VarsL%x) + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%x(i)%Num + do j = 1, Vars%x(i)%Num + + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateAryQuat(VarsL, m%Jac%x_perturb, m%x_perturb) - call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return + call BD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateAryQuat(VarsL, m%Jac%x_perturb, m%x_perturb) - call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput=IsFullLin); if (Failed()) return - call BD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) - - ! Calculate column index - col = VarsL%x(i)%iLoc(1) + j - 1 + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return + call BD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do @@ -6364,32 +6270,32 @@ SUBROUTINE BD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(VarsL%x) + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%x(i)%Num + do j = 1, Vars%x(i)%Num + + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateAryQuat(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) + call BD_PackContStateDerivAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateAryQuat(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call BD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) - - ! Calculate column index - col = VarsL%x(i)%iLoc(1) + j - 1 + call BD_PackContStateDerivAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) end do end do @@ -6426,9 +6332,9 @@ END SUBROUTINE BD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. -SUBROUTINE BD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +SUBROUTINE BD_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) !.................................................................................................................................. - + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6500,9 +6406,9 @@ END SUBROUTINE BD_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and DZ/dz are returned. -SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. +SUBROUTINE BD_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6553,122 +6459,9 @@ SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat IF ( PRESENT(dZdz) ) THEN END IF - END SUBROUTINE BD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(BD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(BD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(BD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - - CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - LOGICAL :: ReturnTrimOP - INTEGER(IntKi) :: i - type(ModVarsType), pointer :: VarsL - - ErrStat = ErrID_None - ErrMsg = '' - - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - - !---------------------------------------------------------------------------- - - if (present(u_op)) then - - if (.not. allocated(u_op)) then - call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - call BD_PackInputAry(VarsL, u, u_op) - - end if - - !---------------------------------------------------------------------------- - - if (present(y_op)) then - - if (.not. allocated(y_op)) then - call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - call BD_PackOutputAry(VarsL, y, y_op) - - end if - - !---------------------------------------------------------------------------- - - if (present(x_op)) then - - if (.not. allocated(x_op)) then - call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - call BD_PackContStateAry(VarsL, x, x_op) - - end if - - !---------------------------------------------------------------------------- - - if (present(dx_op)) then - - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, VarsL%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - call BD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(VarsL, m%dxdt_lin, dx_op) - - end if - - !---------------------------------------------------------------------------- - - if (present(xd_op)) then - end if - - !---------------------------------------------------------------------------- - - if (present(z_op)) then - - ! this is a little weird, but seems to be how BD has implemented the first node in the continuous state array. - if (.not. allocated(z_op)) then - call AllocAry(z_op, p%dof_node * 2, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - z_op = [x%q(:, 1), x%dqdt(:, 1)] - - end if - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -END SUBROUTINE BD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 02d5269386..0c6678baa0 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -72,7 +72,6 @@ MODULE HydroDyn PUBLIC :: HD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - PUBLIC :: HD_GetOP !< Routine to pack the operating point values (for linearization) into arrays CONTAINS @@ -826,7 +825,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Module Variables: !............................................................................................ - call HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + call HydroDyn_InitVars(InitOut%Vars, u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............................................................................................ @@ -924,7 +923,8 @@ SUBROUTINE HydroDyn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) END SUBROUTINE HydroDyn_End -subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) +subroutine HydroDyn_InitVars(Vars, u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables type(HydroDyn_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(HydroDyn_ParameterType), intent(inout) :: p !< Parameters type(HydroDyn_ContinuousStateType), intent(inout) :: x !< Continuous state @@ -946,20 +946,9 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E character(10), parameter :: dofLabels(6) = & ['PtfmSg', 'PtfmSw', 'PtfmHv', 'PtfmR ', 'PtfmP ', 'PtfmY '] - ! Allocate space for variables (deallocate if already allocated) - if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating vars", ErrStat, ErrMsg, RoutineName) - return - end if - ErrStat = ErrID_None ErrMsg = "" - ! Associate pointer in init output - InitOut%Vars => p%Vars - !---------------------------------------------------------------------------- ! Continuous State Variables !---------------------------------------------------------------------------- @@ -980,7 +969,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E do k = 1, p%nWAMITObj if (p%WAMIT(k)%SS_Exctn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) - call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", FieldScalar, & + call MV_AddVar(Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", FieldScalar, & DatLoc(HydroDyn_x_WAMIT_SS_Exctn_x), & Flags=VF_DerivOrder1, & Num=p%WAMIT(k)%SS_Exctn%numStates, & @@ -991,7 +980,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E do k = 1, p%nWAMITObj if (p%WAMIT(k)%SS_Rdtn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) - call MV_AddVar(p%Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", FieldScalar, & + call MV_AddVar(Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", FieldScalar, & DatLoc(HydroDyn_x_WAMIT_SS_Rdtn_x), & Flags=VF_DerivOrder1, & Num=p%WAMIT(k)%SS_Rdtn%numStates, & @@ -1015,28 +1004,28 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E PerturbTrans, & ! FieldTransAcc PerturbRot] ! FieldAngularAcc - call MV_AddMeshVar(p%Vars%u, "Morison", MotionFields, DatLoc(HydroDyn_u_Morison_Mesh), u%Morison%Mesh, & + call MV_AddMeshVar(Vars%u, "Morison", MotionFields, DatLoc(HydroDyn_u_Morison_Mesh), u%Morison%Mesh, & Perturbs=Perturbs) - call MV_AddMeshVar(p%Vars%u, "WAMIT", MotionFields, DatLoc(HydroDyn_u_WAMITMesh), u%WAMITMesh, & + call MV_AddMeshVar(Vars%u, "WAMIT", MotionFields, DatLoc(HydroDyn_u_WAMITMesh), u%WAMITMesh, & Perturbs=Perturbs) - call MV_AddMeshVar(p%Vars%u, "Platform-RefPt", MotionFields, DatLoc(HydroDyn_u_PRPMesh), u%PRPMesh, & + call MV_AddMeshVar(Vars%u, "Platform-RefPt", MotionFields, DatLoc(HydroDyn_u_PRPMesh), u%PRPMesh, & Perturbs=Perturbs) - call MV_AddVar(p%Vars%u, "WaveElev0", FieldScalar, DatLoc(HydroDyn_u_WaveElev0), & + call MV_AddVar(Vars%u, "WaveElev0", FieldScalar, DatLoc(HydroDyn_u_WaveElev0), & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: wave elevation at platform ref point, m']) - call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, DatLoc(HydroDyn_u_HWindSpeed), & + call MV_AddVar(Vars%u, "HWindSpeed", FieldScalar, DatLoc(HydroDyn_u_HWindSpeed), & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: horizontal current speed (steady/uniform wind), m/s']) - call MV_AddVar(p%Vars%u, "PLexp", FieldScalar, DatLoc(HydroDyn_u_PLexp), & + call MV_AddVar(Vars%u, "PLexp", FieldScalar, DatLoc(HydroDyn_u_PLexp), & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: vertical power-law shear exponent, -']) - call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, DatLoc(HydroDyn_u_PropagationDir), & + call MV_AddVar(Vars%u, "PropagationDir", FieldScalar, DatLoc(HydroDyn_u_PropagationDir), & Flags=VF_ExtLin + VF_Linearize, & LinNames=['Extended input: propagation direction, rad']) @@ -1044,11 +1033,11 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E ! Output variables !---------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, "MorisonLoads", LoadFields, DatLoc(HydroDyn_y_Morison_Mesh), y%Morison%Mesh) + call MV_AddMeshVar(Vars%y, "MorisonLoads", LoadFields, DatLoc(HydroDyn_y_Morison_Mesh), y%Morison%Mesh) - call MV_AddMeshVar(p%Vars%y, "WAMITLoads", LoadFields, DatLoc(HydroDyn_y_WAMITMesh), y%WAMITMesh) + call MV_AddMeshVar(Vars%y, "WAMITLoads", LoadFields, DatLoc(HydroDyn_y_WAMITMesh), y%WAMITMesh) - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(HydroDyn_y_WriteOutput), & + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(HydroDyn_y_WriteOutput), & Flags=VF_WriteOut, & Num=p%NumTotalOuts, & LinNames=[(WriteOutputLinName(i), i = 1, p%NumTotalOuts)]) @@ -1057,7 +1046,7 @@ subroutine HydroDyn_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, E ! Initialize Variables and Jacobian data !---------------------------------------------------------------------------- - call MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return call HydroDyn_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call HydroDyn_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -1665,24 +1654,24 @@ end function CalcLoadsAtWRP !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); !! Output fields are not used by this routine, but type is !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect !! to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with @@ -1698,71 +1687,64 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM INTEGER(IntKi) :: i, j, k, col INTEGER(IntKi) :: startingI, startingJ, bOffset, offsetI integer(IntKi) :: iVarWaveElev0, iVarHWindSpeed, iVarPLexp, iVarPropagationDir - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if ! Get extended input variable indices - iVarWaveElev0 = MV_FindVarDatLoc(VarsL%u, DatLoc(HydroDyn_u_WaveElev0)) - iVarHWindSpeed = MV_FindVarDatLoc(VarsL%u, DatLoc(HydroDyn_u_HWindSpeed)) - iVarPLexp = MV_FindVarDatLoc(VarsL%u, DatLoc(HydroDyn_u_PLexp)) - iVarPropagationDir = MV_FindVarDatLoc(VarsL%u, DatLoc(HydroDyn_u_PropagationDir)) + iVarWaveElev0 = MV_FindVarDatLoc(Vars%u, DatLoc(HydroDyn_u_WaveElev0)) + iVarHWindSpeed = MV_FindVarDatLoc(Vars%u, DatLoc(HydroDyn_u_HWindSpeed)) + iVarPLexp = MV_FindVarDatLoc(Vars%u, DatLoc(HydroDyn_u_PLexp)) + iVarPropagationDir = MV_FindVarDatLoc(Vars%u, DatLoc(HydroDyn_u_PropagationDir)) ! make a copy of the inputs to perturb call HydroDyn_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Pack inputs into array - call HydroDyn_PackInputAry(VarsL, u, m%Jac%u); if (Failed()) return + call HydroDyn_PackInputAry(Vars, u, m%Jac%u); if (Failed()) return ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(VarsL%u) + do i = 1, size(Vars%u) ! If variable is extended input, skip - if (MV_HasFlags(VarsL%u(i), VF_ExtLin)) cycle + if (MV_HasFlags(Vars%u(i), VF_ExtLin)) cycle ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call HydroDyn_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call HydroDyn_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call HydroDyn_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call HydroDyn_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call HydroDyn_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) + call HydroDyn_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do ! Set extended inputs - dYdu(:, VarsL%u(iVarWaveElev0)%iLoc(1)) = 0.0_R8Ki - dYdu(:, VarsL%u(iVarHWindSpeed)%iLoc(1)) = 0.0_R8Ki - dYdu(:, VarsL%u(iVarPLexp)%iLoc(1)) = 0.0_R8Ki - dYdu(:, VarsL%u(iVarPropagationDir)%iLoc(1)) = 0.0_R8Ki + dYdu(:, Vars%u(iVarWaveElev0)%iLoc(1)) = 0.0_R8Ki + dYdu(:, Vars%u(iVarHWindSpeed)%iLoc(1)) = 0.0_R8Ki + dYdu(:, Vars%u(iVarPLexp)%iLoc(1)) = 0.0_R8Ki + dYdu(:, Vars%u(iVarPropagationDir)%iLoc(1)) = 0.0_R8Ki END IF @@ -1774,7 +1756,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2) + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2) if (Failed()) return end if @@ -1783,13 +1765,13 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM do j = 1,p%nWAMITObj do i = 1,p%WAMIT(j)%SS_Exctn%numStates - dXdu(offsetI+i,p%Vars%Nu) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 + dXdu(offsetI+i,m%Jac%Nu) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 end do offsetI = offsetI + p%WAMIT(j)%SS_Exctn%numStates end do startingI = p%totalStates - p%totalRdtnStates - startingJ = p%Vars%Nu - 4 - 18 - 4*3*p%NBody ! subtract 4 for extended inputs and 4*3*NBody to place us at the beginning of the velocity inputs + startingJ = m%Jac%Nu - 4 - 18 - 4*3*p%NBody ! subtract 4 for extended inputs and 4*3*NBody to place us at the beginning of the velocity inputs ! B is numStates by 6*NBody where NBody =1 if NBodyMod=2 or 3, but could be >1 for NBodyMod=1 if ( p%NBodyMod == 1 ) then ! Example for NBodyMod=1 and NBody = 2, @@ -1884,24 +1866,22 @@ END SUBROUTINE HD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx ) -!.................................................................................................................................. - +SUBROUTINE HD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); !! Output fields are not used by this routine, but type is !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect !! to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect @@ -1915,52 +1895,45 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 INTEGER(IntKi) :: i, j, k, col, sOffset - type(ModVarsType), pointer :: VarsL ErrStat = ErrID_None ErrMsg = '' - - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - + ! Copy State values to perturb call HydroDyn_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackContStateAry(VarsL, x, m%Jac%x) + call HydroDyn_PackContStateAry(Vars, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, VarsL%Ny, VarsL%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(VarsL%x) + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%x(i)%Num + do j = 1, Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call HydroDyn_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call HydroDyn_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call HydroDyn_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call HydroDyn_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call HydroDyn_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) + call HydroDyn_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index - col = VarsL%x(i)%iLoc(1) + j - 1 + col = Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do @@ -1971,7 +1944,7 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! allocate dXdu if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if dXdx = 0.0_R8Ki @@ -2019,21 +1992,20 @@ END SUBROUTINE HD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. -SUBROUTINE HD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) -!.................................................................................................................................. - +SUBROUTINE HD_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); !! Output fields are not used by this routine, but type is !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions @@ -2075,21 +2047,21 @@ END SUBROUTINE HD_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. -SUBROUTINE HD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. +SUBROUTINE HD_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); !! Output fields are not used by this routine, but type is !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output functions (Y) with respect @@ -2127,103 +2099,5 @@ SUBROUTINE HD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE HD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, u_op, y_op, x_op, dx_op, xd_op, z_op ) - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), target, optional, intent(in ) :: Vars !< Module variables for packing arrays - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - CHARACTER(*), PARAMETER :: RoutineName = 'HD_GetOP' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - INTEGER(IntKi) :: i, j, index - type(ModVarsType), pointer :: VarsL - - ErrStat = ErrID_None - ErrMsg = '' - - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - - !.................................. - IF ( PRESENT( u_op ) ) THEN - if (.not. allocated(u_op)) then - call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return - u_op = 0.0_R8Ki - end if - call HydroDyn_PackInputAry(VarsL, u, u_op) - END IF - - !.................................. - if ( PRESENT( y_op ) ) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return - y_op = 0.0_R8Ki - end if - call HydroDyn_PackOutputAry(VarsL, y, y_op) - end if - - !.................................. - IF ( PRESENT( x_op ) .and. VarsL%Nx > 0) THEN - if ( y%WAMITMesh%Committed ) then - if (.not. allocated(x_op)) then - call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return - x_op = 0.0_R8Ki - end if - call HydroDyn_PackContStateAry(VarsL, x, x_op) - end if - END IF - - !.................................. - IF ( PRESENT( dx_op ) .and. VarsL%Nx > 0) THEN - if ( y%WAMITMesh%Committed ) then - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, VarsL%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return - dx_op = 0.0_R8Ki - end if - call HydroDyn_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2 ) - if (Failed()) return - call HydroDyn_PackContStateAry(VarsL, m%dxdt_lin, dx_op) - end if - END IF - - !.................................. - IF ( PRESENT( xd_op ) ) THEN - END IF - - !.................................. - IF ( PRESENT( z_op ) ) THEN - END IF - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function Failed -END SUBROUTINE HD_GetOP - - -!---------------------------------------------------------------------------------------------------------------------------------- END MODULE HydroDyn !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index c737f6df65..c98b7bbdbc 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -84,7 +84,7 @@ typedef ^ ^ SeaSt_WaveFieldType # # Define outputs from the initialization routine here: # -typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" - +typedef ^ InitOutputType ModVarsType Vars - - - "Module Variables" - typedef ^ InitOutputType Morison_InitOutputType Morison - - - "Initialization output from the Morison module" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - @@ -128,8 +128,7 @@ typedef ^ ^ Morison_Oth # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # -typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - -typedef ^ ^ INTEGER nWAMITObj - - - "number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - +typedef ^ ParameterType INTEGER nWAMITObj - - - "number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - typedef ^ ^ INTEGER vecMultiplier - - - "multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1" - typedef ^ ^ WAMIT_ParameterType WAMIT {:} - - "Parameter data for the WAMIT module" - typedef ^ ^ WAMIT2_ParameterType WAMIT2 {:} - - "Parameter data for the WAMIT2 module" - diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index adfd55cea8..d73375f43e 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -57,7 +57,6 @@ MODULE InflowWind PUBLIC :: InflowWind_JacobianPContState PUBLIC :: InflowWind_JacobianPDiscState PUBLIC :: InflowWind_JacobianPConstrState - PUBLIC :: InflowWind_GetOP PUBLIC :: InflowWind_PackExtInputAry PUBLIC :: InflowWind_PackExtOutputAry @@ -777,7 +776,7 @@ END SUBROUTINE InflowWind_End !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. SUBROUTINE InflowWind_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) - TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module information + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module information REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -957,7 +956,8 @@ END SUBROUTINE IfW_UniformWind_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code -SUBROUTINE InflowWind_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE InflowWind_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + TYPE(ModVarsType), INTENT(OUT ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -978,7 +978,6 @@ SUBROUTINE InflowWind_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, E ErrStat = ErrID_None ErrMsg = '' - return ! IF ( PRESENT( dYdx ) ) THEN ! END IF ! IF ( PRESENT( dXdx ) ) THEN @@ -992,7 +991,8 @@ END SUBROUTINE InflowWind_JacobianPContState !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code -SUBROUTINE InflowWind_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +SUBROUTINE InflowWind_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) + TYPE(ModVarsType), INTENT(OUT ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1013,8 +1013,6 @@ SUBROUTINE InflowWind_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, E ErrStat = ErrID_None ErrMsg = '' - return - ! IF ( PRESENT( dYdxd ) ) THEN ! END IF ! IF ( PRESENT( dXdxd ) ) THEN @@ -1028,7 +1026,8 @@ END SUBROUTINE InflowWind_JacobianPDiscState !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code -SUBROUTINE InflowWind_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +SUBROUTINE InflowWind_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) + TYPE(ModVarsType), INTENT(OUT ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1049,8 +1048,6 @@ SUBROUTINE InflowWind_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat = ErrID_None ErrMsg = '' - return - ! IF ( PRESENT( dYdz ) ) THEN ! END IF ! IF ( PRESENT( dXdz ) ) THEN @@ -1060,79 +1057,6 @@ SUBROUTINE InflowWind_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ! IF ( PRESENT( dZdz ) ) THEN ! END IF END SUBROUTINE InflowWind_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE InflowWind_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(InflowWind_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(InflowWind_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(InflowWind_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - INTEGER(IntKi) :: i - real(R8Ki) :: tmp_op(NumExtendedIO) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_GetOP' - - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - - ! Since both u_op and y_op need this, calculate it up front - if (present(u_op) .or. present(y_op)) then - call IfW_UniformWind_GetOP( p%FlowField%Uniform, t, p%FlowField%VelInterpCubic, tmp_op ) - tmp_op(3) = p%FlowField%PropagationDir + tmp_op(3) ! include the AngleH from Uniform Wind input files - endif - - if ( PRESENT( u_op ) ) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, NumExtendedIO, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - u_op(1:NumExtendedIO) = tmp_op(1:NumExtendedIO) - - end if - - if ( PRESENT( y_op ) ) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, NumExtendedIO + p%NumOuts, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - y_op(1:NumExtendedIO) = tmp_op(1:NumExtendedIO) - do i=1,p%NumOuts - y_op(NumExtendedIO + i) = y%WriteOutput( i ) - end do - end if - - return - -! IF ( PRESENT( x_op ) ) THEN -! END IF -! IF ( PRESENT( dx_op ) ) THEN -! END IF -! IF ( PRESENT( xd_op ) ) THEN -! END IF -! IF ( PRESENT( z_op ) ) THEN -! END IF -END SUBROUTINE InflowWind_GetOP subroutine InflowWind_PackExtInputAry(Vars, t, p, ValAry) type(ModVarsType), intent(in) :: Vars @@ -1142,6 +1066,7 @@ subroutine InflowWind_PackExtInputAry(Vars, t, p, ValAry) type(UniformField_Interp) :: op !< Interpolated values of UniformField integer(IntKi) :: i logical :: first + first = .true. do i = 1, size(Vars%u) associate(Var => Vars%u(i)) select case(Var%DL%Num) diff --git a/modules/map/src/MAP_Registry.txt b/modules/map/src/MAP_Registry.txt index b9347281c0..3efd562074 100644 --- a/modules/map/src/MAP_Registry.txt +++ b/modules/map/src/MAP_Registry.txt @@ -32,7 +32,7 @@ typedef ^ ^ CHARACTER(24) compilingData typedef ^ ^ CHARACTER(15) writeOutputHdr {:} "" - "first line output file contents: output variable names" typedef ^ ^ CHARACTER(15) writeOutputUnt {:} "" - "second line of output file contents: units" typedef ^ ^ ProgDesc Ver - "" - "this module's name, version, and date" -typedef ^ ^ ModVarsType *Vars - - - "Module Variables" - +typedef ^ ^ ModVarsType Vars - - - "Module Variables" - ## ============================== Define Continuous states here: ===================================================================================================================================== typedef ^ ContinuousStateType R8Ki dummy - - - "Remove this variable if you have continuous states" - @@ -70,8 +70,7 @@ typedef ^ ^ R8Ki z { ## ============================== Parameters ============================================================================================================================================ -typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ^ R8Ki g - - - "gravitational constant" "[kg/m^2]" +typedef ^ ParameterType R8Ki g - - - "gravitational constant" "[kg/m^2]" typedef ^ ^ R8Ki depth - - - "distance to seabed" "[m]" typedef ^ ^ R8Ki rho_sea - - - "density of seawater" "[m]" typedef ^ ^ R8Ki dt - - - "time step coupling interval" "[sec]" diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index cda0d3a995..b36e094b71 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -33,7 +33,6 @@ MODULE MAP PUBLIC :: MAP_UpdateStates PUBLIC :: MAP_CalcOutput PUBLIC :: MAP_JacobianPInput - PUBLIC :: MAP_GetOP PUBLIC :: MAP_End PUBLIC :: MAP_Restart @@ -691,7 +690,7 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, m, Interval, InitOut, Er !............................................................................................ ! Module Variables !............................................................................................ - call MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2) + call MAP_InitVars(InitOut%Vars, InitInp, u, p, x, z, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !............................................................................................ @@ -708,7 +707,8 @@ END SUBROUTINE MAP_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes module variables for use by the solver and linearization. - subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrMsg) + subroutine MAP_InitVars(Vars, InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables type(MAP_InitInputType), intent(in) :: InitInp !< Initialization input type(MAP_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(MAP_ParameterType), intent(inout) :: p !< Parameters @@ -730,27 +730,15 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrStat = ErrID_None ErrMsg = "" - ! Allocate space for variables (deallocate if already allocated) - if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Add pointers to vars to initialization output - InitOut%Vars => p%Vars - !------------------------------------------------------------------------- ! Continuous State Variables !------------------------------------------------------------------------- - !------------------------------------------------------------------------- ! Input variables !------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%u, "PtFairDisplacement", [FieldTransDisp], & + call MV_AddMeshVar(Vars%u, "PtFairDisplacement", [FieldTransDisp], & DatLoc(MAP_u_PtFairDisplacement), & Mesh=u%PtFairDisplacement, & Perturbs=[0.2_R8Ki*D2R * max(p%depth,1.0_R8Ki)]) @@ -759,12 +747,12 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ! Output variables !------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, "FairleadLoads", [FieldForce], & + call MV_AddMeshVar(Vars%y, "FairleadLoads", [FieldForce], & DatLoc(MAP_y_PtFairleadLoad), & Mesh=y%ptFairleadLoad) ! Write outputs - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, & + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, & DatLoc(MAP_y_WriteOutput), & Flags=VF_WriteOut, & Num=p%numOuts,& @@ -774,7 +762,7 @@ subroutine MAP_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ! Initialize Variables and Jacobian data !------------------------------------------------------------------------- - CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return call MAP_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call MAP_CopyConstrState(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -1171,7 +1159,8 @@ SUBROUTINE map_set_input_file_contents(InitInp, p) END SUBROUTINE map_set_input_file_contents -SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, FlagFilter) +SUBROUTINE MAP_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(map_ParameterType), INTENT(INOUT) :: p !< Parameters @@ -1184,7 +1173,6 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. TYPE(map_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Filter variables by flag value INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] @@ -1195,8 +1183,6 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err CHARACTER(*), PARAMETER :: RoutineName = 'map_JacobianPInput' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc INTEGER(KIND=C_INT) :: status_from_MAP CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: message_from_MAP REAL(KIND=C_FLOAT) :: time @@ -1208,40 +1194,28 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err time = t interval = t / p%dt - - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter - else - IsFullLin = .true. - FlagFilterLoc = VF_None - end if ! Make a copy of the inputs to perturb call MAP_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call MAP_PackInputValues(p, u, m%Jac%u) + call MAP_PackInputAry(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, Vars%Ny, Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + do i = 1, size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%u(i)%Num + do j = 1, Vars%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call MAP_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MAP_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call MAP_CopyConstrState(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate absolute position of each node @@ -1266,11 +1240,11 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err ! compute y at u_op + delta u ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2); if (Failed()) return - call MAP_PackOutputValues(p, y, m%Jac%y_pos, IsFullLin) + call MAP_PackOutputAry(Vars, y, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call MAP_UnpackInputValues(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MAP_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call MAP_CopyConstrState(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate absolute position of each node @@ -1295,13 +1269,13 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err ! compute y at u_op - delta u ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2 ); if (Failed()) return - call MAP_PackOutputValues(p, y, m%Jac%y_neg, IsFullLin) + call MAP_PackOutputAry(Vars, y, m%Jac%y_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do end if @@ -1330,80 +1304,12 @@ logical function Failed() Failed = ErrStat >= AbortErrLev end function END SUBROUTINE MAP_JacobianPInput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE MAP_GetOP(t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, u_op, y_op) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(map_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(map_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(map_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(map_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(map_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(map_OutputType), INTENT(IN ) :: y !< Output at operating point - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - - CHARACTER(*), PARAMETER :: RoutineName = 'map_GetOP' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = '' - - !.................................. - if (present(u_op)) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call MAP_PackInputValues(p, u, u_op) - end if - - !.................................. - if (present(y_op)) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call MAP_PackOutputValues(p, y, y_op, .true.) - end if - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -END SUBROUTINE MAP_GetOP - -subroutine MAP_PackInputValues(p, u, Ary) - type(MAP_ParameterType), intent(in) :: p - type(MAP_InputType), intent(in) :: u - real(R8Ki), intent(out) :: Ary(:) - ! call MV_Pack(p%Vars%u, p%iVarPtFairDisplacement, u%PtFairDisplacement, Ary) -end subroutine - -subroutine MAP_UnpackInputValues(p, Ary, u) - type(MAP_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Ary(:) - type(MAP_InputType), intent(inout) :: u - ! call MV_Unpack(p%Vars%u, p%iVarPtFairDisplacement, Ary, u%PtFairDisplacement) -end subroutine - -subroutine MAP_PackOutputValues(p, y, Ary, PackWriteOutput) - type(MAP_ParameterType), intent(in) :: p - type(MAP_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: Ary(:) - logical, intent(in) :: PackWriteOutput - ! call MV_Pack(p%Vars%y, p%iVarPtFairleadLoad, y%ptFairleadLoad, Ary) - ! if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, Ary) -end subroutine !========================================================================================================== ! ========== MAP_ERROR_CHECKER ====== <-----------------------------------------------------------+ ! ! | - ! A convenient way to convert C-character arrays into a fortran string. The return argustment + ! A convenient way to convert C-character arrays into a fortran string. The return argument ! is a logical: False if program is safe; True if program fails in the MAP DLL SUBROUTINE MAP_ERROR_CHECKER(msg, stat, ErrMsg, ErrStat) CHARACTER(KIND=C_CHAR), DIMENSION(1024), INTENT(INOUT) :: msg diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 15044027c9..4fc0e0d354 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -38,13 +38,13 @@ module ModVar public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv public :: MV_FieldString, MV_IsLoad, IdxStr public :: DumpMatrix, MV_AddModule -public :: MV_PackArray, MV_UnpackArray, MV_PackMatrix, MV_EqualDL +public :: MV_XfrLocToGluAry, MV_XfrGluToModAry, MV_PackMatrix, MV_EqualDL integer(IntKi), parameter :: & LoadFields(*) = [FieldForce, FieldMoment], & TransFields(*) = [FieldTransDisp, FieldTransVel, FieldTransAcc], & AngularFields(*) = [FieldOrientation, FieldAngularVel, FieldAngularAcc, FieldAngularDisp], & - MotionFields(*) = [FieldOrientation, FieldTransDisp, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc] + MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc] interface MV_Pack module procedure MV_PackVarRank0R4, MV_PackVarRank1R4, MV_PackVarRank2R4 @@ -70,11 +70,11 @@ module ModVar module procedure MV_Unpack2Mesh end interface -logical, parameter :: UseSmallRotAngs = .true. +logical, parameter :: UseSmallRotAngles = .true. contains -subroutine MV_PackArray(VarAry, ModAry, GluAry) +subroutine MV_XfrLocToGluAry(VarAry, ModAry, GluAry) type(ModVarType), intent(in) :: VarAry(:) real(R8Ki), allocatable, intent(in) :: ModAry(:) real(R8Ki), intent(inout) :: GluAry(:) @@ -85,7 +85,7 @@ subroutine MV_PackArray(VarAry, ModAry, GluAry) end do end subroutine -subroutine MV_UnpackArray(VarAry, GluAry, ModAry) +subroutine MV_XfrGluToModAry(VarAry, GluAry, ModAry) type(ModVarType), intent(in) :: VarAry(:) real(R8Ki), allocatable, intent(in) :: GluAry(:) real(R8Ki), intent(inout) :: ModAry(:) @@ -114,118 +114,118 @@ subroutine MV_PackMatrix(RowVarAry, ColVarAry, ModMat, GluMat) ! MV_Pack2 !------------------------------------------------------------------------------- -subroutine MV_Pack2VarRank0R4(Var, Val, Ary) +subroutine MV_Pack2VarRank0R4(Var, SrcVal, DstAry) type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: Val - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1)) = real(Val, R8Ki) + real(R4Ki), intent(in) :: SrcVal + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iLoc(1)) = real(SrcVal, R8Ki) end subroutine -subroutine MV_Pack2VarRank0R8(Var, Val, Ary) +subroutine MV_Pack2VarRank0R8(Var, SrcVal, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Val - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1)) = Val + real(R8Ki), intent(in) :: SrcVal + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iLoc(1)) = SrcVal end subroutine -subroutine MV_Pack2VarRank1R4(Var, Vals, Ary) +subroutine MV_Pack2VarRank1R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: Vals(:) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = real(Vals(Var%iAry(1):Var%iAry(2)), R8Ki) + real(R4Ki), intent(in) :: SrcAry(:) + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iLoc(1):Var%iLoc(2)) = real(SrcAry(Var%iAry(1):Var%iAry(2)), R8Ki) end subroutine -subroutine MV_Pack2VarRank1R8(Var, Vals, Ary) +subroutine MV_Pack2VarRank1R8(Var, SrcAry, Ary) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Vals(:) + real(R8Ki), intent(in) :: SrcAry(:) real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = Vals(Var%iAry(1):Var%iAry(2)) + Ary(Var%iLoc(1):Var%iLoc(2)) = SrcAry(Var%iAry(1):Var%iAry(2)) end subroutine -subroutine MV_Pack2VarRank2R4(Var, Vals, Ary) +subroutine MV_Pack2VarRank2R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: Vals(:, :) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Vals(Var%iAry(1):Var%iAry(2), Var%jAry), R8Ki), .true.) + real(R4Ki), intent(in) :: SrcAry(:, :) + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry), R8Ki), .true.) end subroutine -subroutine MV_Pack2VarRank2R8(Var, Vals, Ary) +subroutine MV_Pack2VarRank2R8(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Vals(:, :) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry), .true.) + real(R8Ki), intent(in) :: SrcAry(:, :) + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry), .true.) end subroutine -subroutine MV_Pack2VarRank3R4(Var, Vals, Ary) +subroutine MV_Pack2VarRank3R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: Vals(:, :, :) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry), R8Ki), .true.) + real(R4Ki), intent(in) :: SrcAry(:, :, :) + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry), R8Ki), .true.) end subroutine -subroutine MV_Pack2VarRank3R8(Var, Vals, Ary) +subroutine MV_Pack2VarRank3R8(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Vals(:, :, :) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry), .true.) + real(R8Ki), intent(in) :: SrcAry(:, :, :) + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry), .true.) end subroutine -subroutine MV_Pack2VarRank4R4(Var, Vals, Ary) +subroutine MV_Pack2VarRank4R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: Vals(:, :, :, :) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), R8Ki), .true.) + real(R4Ki), intent(in) :: SrcAry(:, :, :, :) + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), R8Ki), .true.) end subroutine -subroutine MV_Pack2VarRank4R8(Var, Vals, Ary) +subroutine MV_Pack2VarRank4R8(Var, SrcAry, Ary) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Vals(:, :, :, :) + real(R8Ki), intent(in) :: SrcAry(:, :, :, :) real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), .true.) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), .true.) end subroutine -subroutine MV_Pack2VarRank5R4(Var, Vals, Ary) +subroutine MV_Pack2VarRank5R4(Var, SrcAry, Ary) type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: Vals(:, :, :, :, :) + real(R4Ki), intent(in) :: SrcAry(:, :, :, :, :) real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry), R8Ki), .true.) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry), R8Ki), .true.) end subroutine -subroutine MV_Pack2VarRank5R8(Var, Vals, Ary) +subroutine MV_Pack2VarRank5R8(Var, SrcAry, Ary) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Vals(:, :, :, :, :) + real(R8Ki), intent(in) :: SrcAry(:, :, :, :, :) real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry), .true.) + Ary(Var%iLoc(1):Var%iLoc(2)) = pack(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry), .true.) end subroutine -subroutine MV_Pack2Mesh(Var, Mesh, Ary) +subroutine MV_Pack2Mesh(Var, Mesh, DstAry) type(ModVarType), intent(in) :: Var type(MeshType), intent(in) :: Mesh - real(R8Ki), intent(inout) :: Ary(:) + real(R8Ki), intent(inout) :: DstAry(:) integer(IntKi) :: i, j, k select case (Var%Field) case (FieldForce) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Force, R8Ki), .true.) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Force, R8Ki), .true.) case (FieldMoment) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Moment, R8Ki), .true.) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Moment, R8Ki), .true.) case (FieldTransDisp) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationDisp, R8Ki), .true.) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationDisp, R8Ki), .true.) case (FieldOrientation) k = Var%iLoc(1) do j = 1, Var%Nodes - Ary(k:k + 2) = dcm_to_quat(Mesh%Orientation(:, :, j)) + DstAry(k:k + 2) = dcm_to_quat(Mesh%Orientation(:, :, j)) k = k + 3 end do case (FieldTransVel) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationVel, R8Ki), .true.) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationVel, R8Ki), .true.) case (FieldAngularVel) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%RotationVel, R8Ki), .true.) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%RotationVel, R8Ki), .true.) case (FieldTransAcc) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationAcc, R8Ki), .true.) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationAcc, R8Ki), .true.) case (FieldAngularAcc) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%RotationAcc, R8Ki), .true.) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%RotationAcc, R8Ki), .true.) case (FieldScalar) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Scalars, R8Ki), .true.) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Scalars, R8Ki), .true.) end select end subroutine @@ -233,134 +233,134 @@ subroutine MV_Pack2Mesh(Var, Mesh, Ary) ! MV_Unpack2 !------------------------------------------------------------------------------- -subroutine MV_Unpack2VarRank0R4(Var, Ary, Val) +subroutine MV_Unpack2VarRank0R4(Var, SrcAry, DstVal) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Val - Val = real(Ary(Var%iLoc(1)), R4Ki) + real(R8Ki), intent(in) :: SrcAry(:) + real(R4Ki), intent(inout) :: DstVal + DstVal = real(SrcAry(Var%iLoc(1)), R4Ki) end subroutine -subroutine MV_Unpack2VarRank0R8(Var, Ary, Val) +subroutine MV_Unpack2VarRank0R8(Var, SrcAry, DstVal) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Val - Val = Ary(Var%iLoc(1)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R8Ki), intent(inout) :: DstVal + DstVal = SrcAry(Var%iLoc(1)) end subroutine -subroutine MV_Unpack2VarRank1R4(Var, Ary, Vals) +subroutine MV_Unpack2VarRank1R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Vals(:) - Vals(Var%iAry(1):Var%iAry(2)) = real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki) + real(R8Ki), intent(in) :: SrcAry(:) + real(R4Ki), intent(inout) :: DstAry(:) + DstAry(Var%iAry(1):Var%iAry(2)) = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) end subroutine -subroutine MV_Unpack2VarRank1R8(Var, Ary, Vals) +subroutine MV_Unpack2VarRank1R8(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:) - Vals(Var%iAry(1):Var%iAry(2)) = Ary(Var%iLoc(1):Var%iLoc(2)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R8Ki), intent(inout) :: DstAry(:) + DstAry(Var%iAry(1):Var%iAry(2)) = SrcAry(Var%iLoc(1):Var%iLoc(2)) end subroutine -subroutine MV_Unpack2VarRank2R4(Var, Ary, Vals) +subroutine MV_Unpack2VarRank2R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Vals(:, :) - associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry)) - V = reshape(real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki), shape(V)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R4Ki), intent(inout) :: DstAry(:, :) + associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry)) + V = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) end associate end subroutine -subroutine MV_Unpack2VarRank2R8(Var, Ary, Vals) +subroutine MV_Unpack2VarRank2R8(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:, :) - associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry)) - V = reshape(Ary(Var%iLoc(1):Var%iLoc(2)), shape(V)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R8Ki), intent(inout) :: DstAry(:, :) + associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry)) + V = SrcAry(Var%iLoc(1):Var%iLoc(2)) end associate end subroutine -subroutine MV_Unpack2VarRank3R4(Var, Ary, Vals) +subroutine MV_Unpack2VarRank3R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Vals(:, :, :) - associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry)) - V = reshape(real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki), shape(V)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R4Ki), intent(inout) :: DstAry(:, :, :) + associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry)) + V = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) end associate end subroutine -subroutine MV_Unpack2VarRank3R8(Var, Ary, Vals) +subroutine MV_Unpack2VarRank3R8(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:, :, :) - associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry)) - V = reshape(Ary(Var%iLoc(1):Var%iLoc(2)), shape(V)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R8Ki), intent(inout) :: DstAry(:, :, :) + associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry)) + V = SrcAry(Var%iLoc(1):Var%iLoc(2)) end associate end subroutine -subroutine MV_Unpack2VarRank4R4(Var, Ary, Vals) +subroutine MV_Unpack2VarRank4R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Vals(:, :, :, :) - associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry)) - V = reshape(real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki), shape(V)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R4Ki), intent(inout) :: DstAry(:, :, :, :) + associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry)) + V = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) end associate end subroutine -subroutine MV_Unpack2VarRank4R8(Var, Ary, Vals) +subroutine MV_Unpack2VarRank4R8(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:, :, :, :) - associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry)) - V = reshape(Ary(Var%iLoc(1):Var%iLoc(2)), shape(V)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R8Ki), intent(inout) :: DstAry(:, :, :, :) + associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry)) + V = SrcAry(Var%iLoc(1):Var%iLoc(2)) end associate end subroutine -subroutine MV_Unpack2VarRank5R4(Var, Ary, Vals) +subroutine MV_Unpack2VarRank5R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Vals(:, :, :, :, :) - associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry)) - V = reshape(real(Ary(Var%iLoc(1):Var%iLoc(2)), R4Ki), shape(V)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R4Ki), intent(inout) :: DstAry(:, :, :, :, :) + associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry)) + V = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) end associate end subroutine -subroutine MV_Unpack2VarRank5R8(Var, Ary, Vals) +subroutine MV_Unpack2VarRank5R8(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:, :, :, :, :) - associate (V => Vals(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry)) - V = reshape(Ary(Var%iLoc(1):Var%iLoc(2)), shape(V)) + real(R8Ki), intent(in) :: SrcAry(:) + real(R8Ki), intent(inout) :: DstAry(:, :, :, :, :) + associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry)) + V = SrcAry(Var%iLoc(1):Var%iLoc(2)) end associate end subroutine -subroutine MV_Unpack2Mesh(Var, Vals, Mesh) +subroutine MV_Unpack2Mesh(Var, SrcAry, Mesh) type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: Vals(:) + real(R8Ki), intent(in) :: SrcAry(:) type(MeshType), intent(inout) :: Mesh integer(IntKi) :: i, j, k select case (Var%Field) case (FieldForce) - Mesh%Force = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Force)) + Mesh%Force = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Force)) case (FieldMoment) - Mesh%Moment = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Moment)) + Mesh%Moment = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Moment)) case (FieldTransDisp) - Mesh%TranslationDisp = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationDisp)) + Mesh%TranslationDisp = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationDisp)) case (FieldOrientation) k = Var%iLoc(1) do j = 1, Var%Nodes - Mesh%Orientation(:, :, j) = quat_to_dcm(Vals(k:k + 2)) + Mesh%Orientation(:, :, j) = quat_to_dcm(SrcAry(k:k + 2)) k = k + 3 end do case (FieldTransVel) - Mesh%TranslationVel = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationVel)) + Mesh%TranslationVel = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationVel)) case (FieldAngularVel) - Mesh%RotationVel = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%RotationVel)) + Mesh%RotationVel = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%RotationVel)) case (FieldTransAcc) - Mesh%TranslationAcc = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationAcc)) + Mesh%TranslationAcc = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationAcc)) case (FieldAngularAcc) - Mesh%RotationAcc = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%RotationAcc)) + Mesh%RotationAcc = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%RotationAcc)) case (FieldScalar) - Mesh%Scalars = reshape(Vals(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Scalars)) + Mesh%Scalars = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Scalars)) end select end subroutine @@ -638,15 +638,7 @@ subroutine MV_AddModule(ModDataAry, ModID, ModAbbr, Instance, ModDT, SolverDT, V call NWTC_Library_CopyModVarsType(Vars, ModData%Vars, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- - ! Initialize arrays - !---------------------------------------------------------------------------- - - ! Allocate source and destination mapping arrays - call AllocAry(ModData%iSrcMaps, 0, "ModData%iSrcMaps", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(ModData%iDstMaps, 0, "ModData%iDstMaps", ErrStat2, ErrMsg2); if (Failed()) return - - !---------------------------------------------------------------------------- - ! Calculate Module Substepping + ! Calculate Module Sub-stepping !---------------------------------------------------------------------------- ! If module time step is same as global time step, set substeps to 1 @@ -930,7 +922,10 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) real(R8Ki) :: Perturb real(R8Ki) :: quat(3), quat_p(3) + real(R8Ki) :: rv(3), dcm(3,3) integer(IntKi) :: i, j + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg ! Copy base array to perturbed array PerturbAry = BaseAry @@ -944,10 +939,18 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) ! If variable field is orientation, perturbation is in radians if (Var%Field == FieldOrientation) then j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) - quat_p = perturb_quat(Perturb, j + 1) ! Quaternion of perturbed angle i = i - j ! index of start of quaternion parameters (3) quat = BaseAry(i:i + 2) ! Current quat parameters value - quat = quat_compose(quat, quat_p) ! Compose perturbation and current rotation + if (MV_HasFlags(Var, VF_SmallAngle)) then + dcm = quat_to_dcm(quat) + rv = GetSmllRotAngs(dcm, ErrStat, ErrMsg) + rv(j+1) = rv(j+1) + Perturb + call SmllRotTrans('linearization perturbation', rv(1), rv(2), rv(3), dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + quat = dcm_to_quat(dcm) + else + quat_p = perturb_quat(Perturb, j + 1) ! Quaternion of perturbed angle + quat = quat_compose(quat, quat_p) ! Compose perturbation and current rotation + end if PerturbAry(i:i + 2) = quat ! Save perturbed quaternion in array else PerturbAry(i) = PerturbAry(i) + Perturb ! Add perturbation directly @@ -983,7 +986,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) quat_pos = PosAry(k:k + 2) ! If flag set to use small angle rotations - if (UseSmallRotAngs) then + if (UseSmallRotAngles) then ! If variable has flag to use small angles when computing difference if (MV_HasFlags(VarAry(i), VF_SmallAngle)) then @@ -1310,7 +1313,7 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, DL, Mesh, Flags, Perturbs, Active end do end subroutine -subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, DerivOrder, Perturb, LinNames, Active, iVar) +subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, DerivOrder, Perturb, LinNames, Active) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Field @@ -1321,18 +1324,12 @@ subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, Deri integer(IntKi), optional, intent(in) :: DerivOrder character(*), optional, intent(in) :: LinNames(:) logical, optional, intent(in) :: Active - integer(IntKi), optional, intent(out) :: iVar integer(IntKi) :: i type(ModVarType) :: Var - ! If variable index is present, initialize to zero in case variable is inactive - if (present(iVar)) iVar = 0 - ! If active argument specified and not active, return if (present(Active)) then - if (.not. Active) then - return - end if + if (.not. Active) return end if ! Initialize var with default values @@ -1383,9 +1380,6 @@ subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, Deri VarAry = [Var] end if - ! Set variable index if present - if (present(iVar)) iVar = size(VarAry) - end subroutine function MV_NumVals(VarAry, FlagFilter) result(Num) @@ -1426,7 +1420,7 @@ pure logical function MV_IsLoad(Var) ! all components of the data location are the same. pure logical function MV_EqualDL(DL1, DL2) type(DatLoc), intent(in) :: DL1, DL2 - MV_EqualDL = DL1%Num > 0 .and. DL2%Num > 0 .and. & + MV_EqualDL = DL1%Num /= 0 .and. DL2%Num /= 0 .and. & DL1%Num == DL2%Num .and. & DL1%i1 == DL2%i1 .and. & DL1%i2 == DL2%i2 .and. & @@ -1508,27 +1502,20 @@ function perturb_quat(theta, idir) result(q) integer(IntKi) :: ErrStat character(ErrMsgLen) :: ErrMsg - if (UseSmallRotAngs) then - select case (idir) - case (1) - call SmllRotTrans('linearization perturbation', theta, 0.0_R8Ki, 0.0_R8Ki, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) - q = dcm_to_quat(dcm) - case (2) - call SmllRotTrans('linearization perturbation', 0.0_R8Ki, theta, 0.0_R8Ki, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) - q = dcm_to_quat(dcm) - case (3) - call SmllRotTrans('linearization perturbation', 0.0_R8Ki, 0.0_R8Ki, theta, dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) - q = dcm_to_quat(dcm) - end select + select case (idir) + case (1) + rvec = [theta, 0.0_R8Ki, 0.0_R8Ki] + case (2) + rvec = [0.0_R8Ki, theta, 0.0_R8Ki] + case (3) + rvec = [0.0_R8Ki, 0.0_R8Ki, theta] + end select + + if (UseSmallRotAngles) then + call SmllRotTrans('linearization perturbation', rvec(1), rvec(2), rvec(3), dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + q = dcm_to_quat(dcm) else - select case (idir) - case (1) - q = rvec_to_quat([theta, 0.0_R8Ki, 0.0_R8Ki]) - case (2) - q = rvec_to_quat([0.0_R8Ki, theta, 0.0_R8Ki]) - case (3) - q = rvec_to_quat([0.0_R8Ki, 0.0_R8Ki, theta]) - end select + q = rvec_to_quat(rvec) end if end function diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 185ffa250f..4b8a3e1f91 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -65,11 +65,12 @@ param ^ - IntKi VF_Linearize - 8 - param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - param ^ - IntKi VF_SmallAngle - 32 - "Use small angles to calculate difference in linearization" - param ^ - IntKi VF_2PI - 64 - "Variable is an angle with range [0,2pi]" - -param ^ - IntKi VF_WriteOut - 128 - "Variable for write output" - -param ^ - IntKi VF_Solve - 256 - "Variable for solver" - -param ^ - IntKi VF_AeroMap - 512 - "Variable for aeromap" - -param ^ - IntKi VF_DerivOrder1 - 1024 - "Variable is derivative order 1 in linearization file" - -param ^ - IntKi VF_DerivOrder2 - 2048 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_WM_Rot - 128 - "Variable is a Wiener-Milenkovic rotation" - +param ^ - IntKi VF_WriteOut - 256 - "Variable for write output" - +param ^ - IntKi VF_Solve - 512 - "Variable for solver" - +param ^ - IntKi VF_AeroMap - 1024 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 2048 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 4096 - "Variable is derivative order 2 in linearization file" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - @@ -80,6 +81,8 @@ typedef ^ DatLoc IntKi Num - 0 - typedef ^ ^ IntKi i1 - 0 - "Index 1" typedef ^ ^ IntKi i2 - 0 - "Index 2" typedef ^ ^ IntKi i3 - 0 - "Index 3" +typedef ^ ^ IntKi i4 - 0 - "Index 4" +typedef ^ ^ IntKi i5 - 0 - "Index 5" typedef ^ ModVarType IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index d007f45746..cc2b592bbc 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -65,11 +65,12 @@ param ^ - IntKi VF_Linearize - 8 - param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - param ^ - IntKi VF_SmallAngle - 32 - "Use small angles to calculate difference in linearization" - param ^ - IntKi VF_2PI - 64 - "Variable is an angle with range [0,2pi]" - -param ^ - IntKi VF_WriteOut - 128 - "Variable for write output" - -param ^ - IntKi VF_Solve - 256 - "Variable for solver" - -param ^ - IntKi VF_AeroMap - 512 - "Variable for aeromap" - -param ^ - IntKi VF_DerivOrder1 - 1024 - "Variable is derivative order 1 in linearization file" - -param ^ - IntKi VF_DerivOrder2 - 2048 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_WM_Rot - 128 - "Variable is a Wiener-Milenkovic rotation" - +param ^ - IntKi VF_WriteOut - 256 - "Variable for write output" - +param ^ - IntKi VF_Solve - 512 - "Variable for solver" - +param ^ - IntKi VF_AeroMap - 1024 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 2048 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 4096 - "Variable is derivative order 2 in linearization file" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - @@ -80,6 +81,8 @@ typedef ^ DatLoc IntKi Num - 0 - typedef ^ ^ IntKi i1 - 0 - "Index 1" typedef ^ ^ IntKi i2 - 0 - "Index 2" typedef ^ ^ IntKi i3 - 0 - "Index 3" +typedef ^ ^ IntKi i4 - 0 - "Index 4" +typedef ^ ^ IntKi i5 - 0 - "Index 5" typedef ^ ModVarType IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 3cfe858adb..5987c1a772 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -554,6 +554,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err select case (ModData%ID) case (Module_AD) call AD_PackInputAry(ModData%Vars, T%AD%Input(InputIndex)%rotors(ModData%Ins), u_op) + call AD_PackExtInputAry(ModData%Vars, ThisTime, T%AD%p, u_op) case (Module_BD) call BD_PackInputAry(ModData%Vars, T%BD%Input(InputIndex, ModData%Ins), u_op) case (Module_ED) @@ -591,7 +592,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(u_glue)) call MV_PackArray(ModData%Vars%u, u_op, u_glue) + if (present(u_glue)) call MV_XfrLocToGluAry(ModData%Vars%u, u_op, u_glue) end if ! If outputs are requested @@ -643,7 +644,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(y_glue)) call MV_PackArray(ModData%Vars%y, y_op, y_glue) + if (present(y_glue)) call MV_XfrLocToGluAry(ModData%Vars%y, y_op, y_glue) end if ! If continuous states are requested @@ -659,7 +660,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err case (Module_AD) call AD_PackContStateAry(ModData%Vars, T%AD%x(StateIndex)%rotors(ModData%Ins), x_op) case (Module_BD) - call BD_PackContStateAry(ModData%Vars, T%BD%x(StateIndex, ModData%Ins), x_op) + call BD_PackContStateAry(ModData%Vars, T%BD%x(ModData%Ins, StateIndex), x_op) case (Module_ED) call ED_PackContStateAry(ModData%Vars, T%ED%x(StateIndex), x_op) case (Module_ExtPtfm) @@ -669,7 +670,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err case (Module_HD) call HydroDyn_PackContStateAry(ModData%Vars, T%HD%x(StateIndex), x_op) case (Module_IceD) - call IceD_PackContStateAry(ModData%Vars, T%IceD%x(StateIndex, ModData%Ins), x_op) + call IceD_PackContStateAry(ModData%Vars, T%IceD%x(ModData%Ins, StateIndex), x_op) case (Module_IceF) call IceFloe_PackContStateAry(ModData%Vars, T%IceF%x(StateIndex), x_op) case (Module_IfW) @@ -694,7 +695,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(x_glue)) call MV_PackArray(ModData%Vars%x, x_op, x_glue) + if (present(x_glue)) call MV_XfrLocToGluAry(ModData%Vars%x, x_op, x_glue) end if ! If continuous state derivatives are requested @@ -718,7 +719,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err T%AD%m%rotors(ModData%Ins), & T%AD%m%rotors(ModData%Ins)%dxdt_lin, & ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateAry(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) + call AD_PackContStateDerivAry(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) case (Module_BD) call BD_CalcContStateDeriv(ThisTime, T%BD%Input(InputIndex, ModData%Ins), & T%BD%p(ModData%Ins), & @@ -729,12 +730,12 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err T%BD%m(ModData%Ins), & T%BD%m(ModData%Ins)%dxdt_lin, & ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) + call BD_PackContStateDerivAry(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) case (Module_ED) call ED_CalcContStateDeriv(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), & T%ED%xd(StateIndex), T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), & T%ED%m, T%ED%m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(ModData%Vars, T%ED%m%dxdt_lin, dx_op) + call ED_PackContStateDerivAry(ModData%Vars, T%ED%m%dxdt_lin, dx_op) ! case (Module_ExtPtfm) ! call ExtPtfm_CalcContStatExtPtfmeriv(ThisTime, T%ExtPtfm%Input(InputIndex), & ! T%ExtPtfm%p, T%ExtPtfm%x(StateIndex), & @@ -749,37 +750,40 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), & T%HD%xd(StateIndex), T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), & T%HD%m, T%HD%m%dxdt_lin, ErrStat2, ErrMsg2) - call HydroDyn_PackContStateAry(ModData%Vars, T%HD%x(StateIndex), dx_op) + call HydroDyn_PackContStateDerivAry(ModData%Vars, T%HD%x(StateIndex), dx_op) ! case (Module_IceD) ! call IceD_CalcContStateDeriv(ThisTime, T%IceD%Input(InputIndex), T%IceD%p, T%IceD%x(StateIndex), & ! T%IceD%xd(StateIndex), T%IceD%z(StateIndex), T%IceD%OtherSt(StateIndex), & ! T%IceD%m, T%IceD%m%dxdt_lin, ErrStat2, ErrMsg2) -! call IceD_PackContStateAry(ModData%Vars, T%IceD%m%dxdt_lin, dx_op) +! call IceD_PackContStateDerivAry(ModData%Vars, T%IceD%m%dxdt_lin, dx_op) ! case (Module_IceF) -! call IceFloe_PackContStateAry(ModData%Vars, T%IceF%x(StateIndex), dx_op) +! call IceFloe_PackContStateDerivAry(ModData%Vars, T%IceF%x(StateIndex), dx_op) case (Module_IfW) - call InflowWind_PackContStateAry(ModData%Vars, T%IfW%x(StateIndex), dx_op) + call InflowWind_PackContStateDerivAry(ModData%Vars, T%IfW%x(StateIndex), dx_op) case (Module_MAP) - call MAP_PackContStateAry(ModData%Vars, T%MAP%x(StateIndex), dx_op) + call MAP_PackContStateDerivAry(ModData%Vars, T%MAP%x(StateIndex), dx_op) case (Module_MD) - call MD_PackContStateAry(ModData%Vars, T%MD%x(StateIndex), dx_op) + call MD_PackContStateDerivAry(ModData%Vars, T%MD%x(StateIndex), dx_op) case (Module_ExtInfw) - ! call ExtInfw_PackContStateAry(ModData%Vars, T%ExtInfw%x(StateIndex), dx_op) + ! call ExtInfw_PackContStateDerivAry(ModData%Vars, T%ExtInfw%x(StateIndex), dx_op) case (Module_Orca) - call Orca_PackContStateAry(ModData%Vars, T%Orca%x(StateIndex), dx_op) + call Orca_PackContStateDerivAry(ModData%Vars, T%Orca%x(StateIndex), dx_op) case (Module_SD) - call SD_PackContStateAry(ModData%Vars, T%SD%x(StateIndex), dx_op) + call SD_PackContStateDerivAry(ModData%Vars, T%SD%x(StateIndex), dx_op) case (Module_SeaSt) - call SeaSt_PackContStateAry(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) + call SeaSt_PackContStateDerivAry(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) case (Module_SrvD) - call SrvD_PackContStateAry(ModData%Vars, T%SrvD%x(StateIndex), dx_op) + call SrvD_CalcContStateDeriv(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), & + T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), T%SrvD%OtherSt(StateIndex), & + T%SrvD%m, T%SrvD%m%dxdt_lin, ErrStat2, ErrMsg2) + call SrvD_PackContStateDerivAry(ModData%Vars, T%SrvD%m%dxdt_lin, dx_op) case default call SetErrStat(ErrID_Fatal, "Continuous State Derivatives unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return end select ! If glue array is present, transfer from module to glue - if (present(dx_glue)) call MV_PackArray(ModData%Vars%x, dx_op, dx_glue) + if (present(dx_glue)) call MV_XfrLocToGluAry(ModData%Vars%x, dx_op, dx_glue) end if ! If constraint states are requested @@ -795,7 +799,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err case (Module_AD) call AD_PackContStateAry(ModData%Vars, T%AD%x(StateIndex)%rotors(ModData%Ins), z_op) case (Module_BD) - call BD_PackContStateAry(ModData%Vars, T%BD%x(StateIndex, ModData%Ins), z_op) + call BD_PackContStateAry(ModData%Vars, T%BD%x(ModData%Ins, StateIndex), z_op) case (Module_ED) call ED_PackContStateAry(ModData%Vars, T%ED%x(StateIndex), z_op) case (Module_ExtPtfm) @@ -805,7 +809,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err case (Module_HD) call HydroDyn_PackContStateAry(ModData%Vars, T%HD%x(StateIndex), z_op) case (Module_IceD) - call IceD_PackContStateAry(ModData%Vars, T%IceD%x(StateIndex, ModData%Ins), z_op) + call IceD_PackContStateAry(ModData%Vars, T%IceD%x(ModData%Ins, StateIndex), z_op) case (Module_IceF) call IceFloe_PackContStateAry(ModData%Vars, T%IceF%x(StateIndex), z_op) case (Module_IfW) @@ -830,7 +834,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(z_glue)) call MV_PackArray(ModData%Vars%z, z_op, z_glue) + if (present(z_glue)) call MV_XfrLocToGluAry(ModData%Vars%z, z_op, z_glue) end if contains @@ -865,7 +869,7 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & if (present(u_op)) then ! If glue array is present, transfer from module to glue - if (present(u_glue)) call MV_UnpackArray(ModData%Vars%u, u_glue, u_op) + if (present(u_glue)) call MV_XfrGluToModAry(ModData%Vars%u, u_glue, u_op) ! Select based on module ID select case (ModData%ID) @@ -912,7 +916,7 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & if (present(y_op)) then ! If glue array is present, transfer from module to glue - if (present(y_glue)) call MV_UnpackArray(ModData%Vars%y, y_glue, y_op) + if (present(y_glue)) call MV_XfrGluToModAry(ModData%Vars%y, y_glue, y_op) ! Select based on module ID select case (ModData%ID) @@ -959,14 +963,14 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & if (present(x_op)) then ! If glue array is present, transfer from module to glue - if (present(x_glue)) call MV_UnpackArray(ModData%Vars%x, x_glue, x_op) + if (present(x_glue)) call MV_XfrGluToModAry(ModData%Vars%x, x_glue, x_op) ! Select based on module ID select case (ModData%ID) case (Module_AD) call AD_UnpackContStateAry(ModData%Vars, x_op, T%AD%x(StateIndex)%rotors(ModData%Ins)) case (Module_BD) - call BD_UnpackContStateAry(ModData%Vars, x_op, T%BD%x(StateIndex, ModData%Ins)) + call BD_UnpackContStateAry(ModData%Vars, x_op, T%BD%x(ModData%Ins, StateIndex)) case (Module_ED) call ED_UnpackContStateAry(ModData%Vars, x_op, T%ED%x(StateIndex)) case (Module_ExtPtfm) @@ -976,7 +980,7 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & case (Module_HD) call HydroDyn_UnpackContStateAry(ModData%Vars, x_op, T%HD%x(StateIndex)) case (Module_IceD) - call IceD_UnpackContStateAry(ModData%Vars, x_op, T%IceD%x(StateIndex, ModData%Ins)) + call IceD_UnpackContStateAry(ModData%Vars, x_op, T%IceD%x(ModData%Ins, StateIndex)) case (Module_IceF) call IceFloe_UnpackContStateAry(ModData%Vars, x_op, T%IceF%x(StateIndex)) case (Module_IfW) @@ -1006,14 +1010,14 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & if (present(z_op)) then ! If glue array is present, transfer from module to glue - if (present(z_glue)) call MV_UnpackArray(ModData%Vars%z, z_glue, z_op) + if (present(z_glue)) call MV_XfrGluToModAry(ModData%Vars%z, z_glue, z_op) ! Select based on module ID select case (ModData%ID) case (Module_AD) call AD_UnpackContStateAry(ModData%Vars, z_op, T%AD%x(StateIndex)%rotors(ModData%Ins)) case (Module_BD) - call BD_UnpackContStateAry(ModData%Vars, z_op, T%BD%x(StateIndex, ModData%Ins)) + call BD_UnpackContStateAry(ModData%Vars, z_op, T%BD%x(ModData%Ins, StateIndex)) case (Module_ED) call ED_UnpackContStateAry(ModData%Vars, z_op, T%ED%x(StateIndex)) case (Module_ExtPtfm) @@ -1023,7 +1027,7 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & case (Module_HD) call HydroDyn_UnpackContStateAry(ModData%Vars, z_op, T%HD%x(StateIndex)) case (Module_IceD) - call IceD_UnpackContStateAry(ModData%Vars, z_op, T%IceD%x(StateIndex, ModData%Ins)) + call IceD_UnpackContStateAry(ModData%Vars, z_op, T%IceD%x(ModData%Ins, StateIndex)) case (Module_IceF) call IceFloe_UnpackContStateAry(ModData%Vars, z_op, T%IceF%x(StateIndex)) case (Module_IfW) @@ -1057,9 +1061,9 @@ logical function Failed() end subroutine subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdu, dXdu, dYduGlue, dXduGlue) - type(ModDataType), intent(in) :: ModData !< Module information + type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: StateIndex !< State + integer(IntKi), intent(in) :: StateIndex !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1081,12 +1085,12 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg T%AD%z(StateIndex), T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) - ! case (Module_BD) - ! call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%ModIns), T%BD%p(ModData%ModIns), & - ! T%BD%x(ModData%ModIns, StateIndex), T%BD%xd(ModData%ModIns, StateIndex), & - ! T%BD%z(ModData%ModIns, StateIndex), T%BD%OtherSt(ModData%ModIns, StateIndex), & - ! T%BD%y(ModData%ModIns), T%BD%m(ModData%ModIns), ErrStat2, ErrMsg2, & - ! dYdu=dYdu, dXdu=dXdu) + case (Module_BD) + call BD_JacobianPInput(ModData%Vars, ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, StateIndex), T%BD%xd(ModData%Ins, StateIndex), & + T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) case (Module_ED) call ED_JacobianPInput(ModData%Vars, ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & @@ -1095,35 +1099,35 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg ! case (Module_ExtPtfm) - ! case (Module_HD) - ! call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & - ! T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - ! dYdu=dYdu, dXdu=dXdu) + case (Module_HD) + call HD_JacobianPInput(ModData%Vars, ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & + T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) case (Module_IfW) call InflowWind_JacobianPInput(ModData%Vars, ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), & T%IfW%z(StateIndex), T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) - ! case (Module_MAP) - ! call MAP_JacobianPInput(ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(StateIndex), T%MAP%xd(StateIndex), & - ! T%MAP%z(StateIndex), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & - ! dYdu=dYdu, dXdu=dXdu) + case (Module_MAP) + call MAP_JacobianPInput(ModData%Vars, ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(StateIndex), T%MAP%xd(StateIndex), & + T%MAP%z(StateIndex), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) - ! case (Module_MD) - ! call MD_JacobianPInput(ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), & - ! T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & - ! dYdu=dYdu, dXdu=dXdu) + case (Module_MD) + call MD_JacobianPInput(ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), & + T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) - ! case (Module_SD) - ! call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), & - ! T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - ! dYdu=dYdu, dXdu=dXdu) + case (Module_SD) + call SD_JacobianPInput(ModData%Vars, ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), & + T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) - ! case (Module_SeaSt) - ! call SeaSt_JacobianPInput(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), & - ! T%SeaSt%z(StateIndex), T%SeaSt%OtherSt(StateIndex), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - ! dYdu=dYdu, dXdu=dXdu) + case (Module_SeaSt) + call SeaSt_JacobianPInput(ModData%Vars, ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), & + T%SeaSt%z(StateIndex), T%SeaSt%OtherSt(StateIndex), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) case (Module_SrvD) call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), & @@ -1147,9 +1151,9 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg end subroutine subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdx, dXdx, dYdxGlue, dXdxGlue) - type(ModDataType), intent(in) :: ModData !< Module info + type(ModDataType), intent(inout) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: StateIndex !< State + integer(IntKi), intent(in) :: StateIndex !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1173,12 +1177,12 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, Er T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) - ! case (Module_BD) - ! call BD_JacobianPContState(Vars, ThisTime, T%BD%Input(1, ModData%ModIns), T%BD%p(ModData%ModIns), & - ! T%BD%x(ModData%ModIns, StateIndex), T%BD%xd(ModData%ModIns, StateIndex), & - ! T%BD%z(ModData%ModIns, StateIndex), T%BD%OtherSt(ModData%ModIns, StateIndex), & - ! T%BD%y(ModData%ModIns), T%BD%m(ModData%ModIns), ErrStat2, ErrMsg2, & - ! dYdx=dYdx, dXdx=dXdx, StateRotation=ModData%Lin%StateRotation) + case (Module_BD) + call BD_JacobianPContState(ModData%Vars, ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, StateIndex), T%BD%xd(ModData%Ins, StateIndex), & + T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx, StateRotation=ModData%Lin%StateRotation) case (Module_ED) call ED_JacobianPContState(ModData%Vars, ThisTime, T%ED%Input(1), T%ED%p, & @@ -1189,15 +1193,15 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, Er ! case (Module_ExtPtfm) - ! case (Module_HD) - ! call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & - ! T%HD%x(StateIndex), T%HD%xd(StateIndex), & - ! T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), & - ! T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & - ! dYdx=dYdx, dXdx=dXdx) + case (Module_HD) + call HD_JacobianPContState(ModData%Vars, ThisTime, T%HD%Input(1), T%HD%p, & + T%HD%x(StateIndex), T%HD%xd(StateIndex), & + T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) case (Module_IfW) - call InflowWind_JacobianPContState(ThisTime, T%IfW%Input(1), T%IfW%p, & + call InflowWind_JacobianPContState(ModData%Vars, ThisTime, T%IfW%Input(1), T%IfW%p, & T%IfW%x(StateIndex), T%IfW%xd(StateIndex), & T%IfW%z(StateIndex), T%IfW%OtherSt(StateIndex), & T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & @@ -1208,26 +1212,26 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, Er ErrStat2 = ErrID_None ErrMsg2 = '' - ! case (Module_MD) - ! call MD_JacobianPContState(ThisTime, T%MD%Input(1), T%MD%p, & - ! T%MD%x(StateIndex), T%MD%xd(StateIndex), & - ! T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), & - ! T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & - ! dYdx=dYdx, dXdx=dXdx) - - ! case (Module_SD) - ! call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & - ! T%SD%x(StateIndex), T%SD%xd(StateIndex), & - ! T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), & - ! T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & - ! dYdx=dYdx, dXdx=dXdx) - - ! case (Module_SeaSt) - ! call SeaSt_JacobianPContState(ThisTime, T%SeaSt%Input(1), T%SeaSt%p, & - ! T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), & - ! T%SeaSt%z(StateIndex), T%SeaSt%OtherSt(StateIndex), & - ! T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & - ! dYdx=dYdx, dXdx=dXdx) + case (Module_MD) + call MD_JacobianPContState(ThisTime, T%MD%Input(1), T%MD%p, & + T%MD%x(StateIndex), T%MD%xd(StateIndex), & + T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), & + T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_SD) + call SD_JacobianPContState(ModData%Vars, ThisTime, T%SD%Input(1), T%SD%p, & + T%SD%x(StateIndex), T%SD%xd(StateIndex), & + T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_SeaSt) + call SeaSt_JacobianPContState(ModData%Vars, ThisTime, T%SeaSt%Input(1), T%SeaSt%p, & + T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), & + T%SeaSt%z(StateIndex), T%SeaSt%OtherSt(StateIndex), & + T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) case (Module_SrvD) call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(1), T%SrvD%p, & diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 9368cdf96a..8d97fce2d8 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -282,100 +282,103 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM end if end subroutine -function FAST_InputMeshName(ModData, MeshLoc) result(Name) - type(ModDataType), intent(in) :: ModData - type(DatLoc), intent(in) :: MeshLoc - character(32) :: Name +function FAST_InputMeshName(ModData, DL) result(Name) + type(ModDataType), intent(in) :: ModData + type(DatLoc), intent(in) :: DL + character(32) :: Name, tmp Name = "Unknown mesh in "//ModData%Abbr select case (ModData%ID) case (Module_AD) - Name = trim(ModData%Abbr)//"%"//AD_InputMeshName(MeshLoc) + tmp = AD_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%y%rotors("//trim(Num2LStr(ModData%Ins))//")"//tmp(2:) case (Module_BD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputMeshName(DL) case (Module_ED) - Name = trim(ModData%Abbr)//"%"//ED_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//ED_InputMeshName(DL) case (Module_ExtInfw) - Name = trim(ModData%Abbr)//"%"//ExtInfw_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//ExtInfw_InputMeshName(DL) case (Module_ExtPtfm) - Name = trim(ModData%Abbr)//"%"//ExtPtfm_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//ExtPtfm_InputMeshName(DL) case (Module_FEAM) - Name = trim(ModData%Abbr)//"%"//FEAM_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//FEAM_InputMeshName(DL) case (Module_HD) - Name = trim(ModData%Abbr)//"%"//HydroDyn_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//HydroDyn_InputMeshName(DL) case (Module_IceD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_InputMeshName(DL) case (Module_IceF) - Name = trim(ModData%Abbr)//"%"//IceFloe_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//IceFloe_InputMeshName(DL) case (Module_IfW) - Name = trim(ModData%Abbr)//"%"//InflowWind_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//InflowWind_InputMeshName(DL) case (Module_MAP) - Name = trim(ModData%Abbr)//"%"//MAP_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//MAP_InputMeshName(DL) case (Module_MD) - Name = trim(ModData%Abbr)//"%"//MD_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//MD_InputMeshName(DL) case (Module_Orca) - Name = trim(ModData%Abbr)//"%"//Orca_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//Orca_InputMeshName(DL) case (Module_SD) - Name = trim(ModData%Abbr)//"%"//SD_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//SD_InputMeshName(DL) case (Module_SeaSt) - Name = trim(ModData%Abbr)//"%"//SeaSt_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//SeaSt_InputMeshName(DL) case (Module_SrvD) - Name = trim(ModData%Abbr)//"%"//SrvD_InputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//SrvD_InputMeshName(DL) end select end function -function FAST_OutputMeshName(ModData, MeshLoc) result(Name) - type(ModDataType), intent(in) :: ModData - type(DatLoc), intent(in) :: MeshLoc - character(32) :: Name +function FAST_OutputMeshName(ModData, DL) result(Name) + type(ModDataType), intent(in) :: ModData + type(DatLoc), intent(in) :: DL + character(32) :: Name, tmp Name = "Unknown mesh in "//ModData%Abbr select case (ModData%ID) case (Module_AD) - Name = trim(ModData%Abbr)//"%"//AD_OutputMeshName(MeshLoc) + tmp = AD_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%y%rotors("//trim(Num2LStr(ModData%Ins))//")"//tmp(2:) case (Module_BD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputMeshName(DL) case (Module_ED) - Name = trim(ModData%Abbr)//"%"//ED_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//ED_OutputMeshName(DL) case (Module_ExtInfw) - Name = trim(ModData%Abbr)//"%"//ExtInfw_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//ExtInfw_OutputMeshName(DL) case (Module_ExtPtfm) - Name = trim(ModData%Abbr)//"%"//ExtPtfm_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//ExtPtfm_OutputMeshName(DL) case (Module_FEAM) - Name = trim(ModData%Abbr)//"%"//FEAM_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//FEAM_OutputMeshName(DL) case (Module_HD) - Name = trim(ModData%Abbr)//"%"//HydroDyn_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//HydroDyn_OutputMeshName(DL) case (Module_IceD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_OutputMeshName(DL) case (Module_IceF) - Name = trim(ModData%Abbr)//"%"//IceFloe_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//IceFloe_OutputMeshName(DL) case (Module_IfW) - Name = trim(ModData%Abbr)//"%"//InflowWind_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//InflowWind_OutputMeshName(DL) case (Module_MAP) - Name = trim(ModData%Abbr)//"%"//MAP_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//MAP_OutputMeshName(DL) case (Module_MD) - Name = trim(ModData%Abbr)//"%"//MD_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//MD_OutputMeshName(DL) case (Module_Orca) - Name = trim(ModData%Abbr)//"%"//Orca_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//Orca_OutputMeshName(DL) case (Module_SD) - Name = trim(ModData%Abbr)//"%"//SD_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//SD_OutputMeshName(DL) case (Module_SeaSt) - Name = trim(ModData%Abbr)//"%"//SeaSt_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//SeaSt_OutputMeshName(DL) case (Module_SrvD) - Name = trim(ModData%Abbr)//"%"//SrvD_OutputMeshName(MeshLoc) + Name = trim(ModData%Abbr)//"%"//SrvD_OutputMeshName(DL) end select end function subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) type(ModDataType), intent(inout) :: Mods(:) !< Module data - type(MappingType), allocatable, intent(inout) :: Mappings(:) + type(MappingType), allocatable, intent(inout) :: Mappings(:) type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_InitMappings' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, j, k - integer(IntKi) :: iMap, ModIns, iModIn, iModSrc, iModDst + character(*), parameter :: RoutineName = 'FAST_InitMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi) :: iMap, ModIns, iModIn, iModSrc, iModDst + type(MappingType), allocatable :: MappingsTmp(:) ErrStat = ErrID_None ErrMsg = '' @@ -685,47 +688,47 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(AD_y_BladeLoad, SrcMod%Ins, i), & ! AD%y%rotors(SrcMod%InsR)%BladeLoad(i) - SrcDispDL=DatLoc(AD_u_BladeMotion, SrcMod%Ins, i), & ! AD%u%rotors(SrcMod%InsR)%BladeMotion(i) - DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) - DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%InsR)%BladeLoad(i) + SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%InsR)%BladeMotion(i) + DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=(Turbine%p_FAST%CompElast == Module_ED) .and. (NotCompAeroMaps .or. (i == 1))) if (Failed()) return end do call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(AD_y_HubLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%HubLoad - SrcDispDL=DatLoc(AD_u_HubMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%HubMotion - DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad - DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + SrcDL=DatLoc(AD_y_HubLoad), & ! AD%y%rotors(SrcMod%Ins)%HubLoad + SrcDispDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(SrcMod%Ins)%HubMotion + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(AD_y_NacelleLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad - SrcDispDL=DatLoc(AD_u_NacelleMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion - DstDL=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads - DstDispDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + SrcDL=DatLoc(AD_y_NacelleLoad), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad + SrcDispDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion + DstDL=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(AD_y_TFinLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad - SrcDispDL=DatLoc(AD_u_TFinMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion - DstDL=DatLoc(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads - DstDispDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + SrcDL=DatLoc(AD_y_TFinLoad), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad + SrcDispDL=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion + DstDL=DatLoc(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads + DstDispDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(AD_y_TowerLoad, SrcMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad - SrcDispDL=DatLoc(AD_u_TowerMotion, SrcMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion - DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads - DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + SrcDL=DatLoc(AD_y_TowerLoad), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad + SrcDispDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion + DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads + DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -733,10 +736,10 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_BD) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce - SrcDispDL=DatLoc(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion - DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad - DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + SrcDL=DatLoc(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce + SrcDispDL=DatLoc(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -1573,11 +1576,6 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstMod=DstMod, DstDL=DatLoc(SrvD_u_HSS_Spd), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & - SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HSS_Spd), & - DstMod=DstMod, DstDL=DatLoc(SrvD_u_HSS_Spd), & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - ! Nacelle Structural Controller do j = 1, Turbine%SrvD%p%NumNStC call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & @@ -2024,7 +2022,7 @@ subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: iLocSrc(2), iLocDst(2), nLocSrc, nLocDst + integer(IntKi) :: iGluSrc(2), iGluDst(2), nLocSrc, nLocDst integer(IntKi) :: i, j, k type(MeshType), pointer :: SrcMesh, DstMesh type(MeshType), pointer :: SrcDispMesh, DstDispMesh @@ -2032,6 +2030,12 @@ subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' + ! Initialize dUdy to zero + ModGlue%Lin%dUdy = 0.0_R8Ki + + ! Initialize dUdu to identity matrix + call Eye2D(ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + ! Loop through variable maps do i = 1, size(ModGlue%ModMaps) @@ -2047,25 +2051,25 @@ subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) ! Get source and destination indices, skip if no variable index for either if (ModMap%iVarSrc(1) == 0 .or. ModMap%iVarDst(1) == 0) cycle - iLocSrc = ModSrc%Vars%y(ModMap%iVarSrc(1))%iLoc - iLocDst = ModDst%Vars%u(ModMap%iVarDst(1))%iLoc + iGluSrc = ModSrc%Vars%y(ModMap%iVarSrc(1))%iGlu + iGluDst = ModDst%Vars%u(ModMap%iVarDst(1))%iGlu ! Get number of source and destination locations - nLocSrc = iLocSrc(2) - iLocSrc(1) + 1 - nLocDst = iLocDst(2) - iLocDst(1) + 1 + nLocSrc = iGluSrc(2) - iGluSrc(1) + 1 + nLocDst = iGluDst(2) - iGluDst(1) + 1 ! If source has multiple locations, destination must have same number, connect 1-to-1 ! MapVariable checks that variables have same number if nLocSrc > 1 if (nLocSrc > 1) then do k = 0, nLocDst - 1 - ModGlue%Lin%dUdy(iLocDst(1) + k, iLocSrc(1) + k) = -1.0_R8Ki + ModGlue%Lin%dUdy(iGluDst(1) + k, iGluSrc(1) + k) = -1.0_R8Ki end do else if (nLocDst == 1) then ! Source and destination have one location - ModGlue%Lin%dUdy(iLocDst(1), iLocSrc(1)) = -1.0_R8Ki + ModGlue%Lin%dUdy(iGluDst(1), iGluSrc(1)) = -1.0_R8Ki else ! One source location to many destination locations - ModGlue%Lin%dUdy(iLocDst(1):iLocDst(2), iLocSrc(1)) = -1.0_R8Ki + ModGlue%Lin%dUdy(iGluDst(1):iGluDst(2), iGluSrc(1)) = -1.0_R8Ki end if case (Map_MotionMesh) @@ -2292,10 +2296,10 @@ subroutine SumBlock(VarArySrc, iVarSrc, VarAryDst, iVarDst, SrcM, DstM) if (iVarDst == 0 .or. iVarSrc == 0) return ! Get pointers to source and destination locations - associate (iLocSrc => VarArySrc(iVarSrc)%iLoc, iLocDst => VarAryDst(iVarDst)%iLoc) + associate (iGluSrc => VarArySrc(iVarSrc)%iGlu, iGluDst => VarAryDst(iVarDst)%iGlu) ! Subtracts the source matrix from the destination sub-matrix - associate (DstSubM => DstM(iLocDst(1):iLocDst(2), iLocSrc(1):iLocSrc(2))) + associate (DstSubM => DstM(iGluDst(1):iGluDst(2), iGluSrc(1):iGluSrc(2))) DstSubM = DstSubM - SrcM end associate diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 3643024cf6..c493e464e9 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -143,10 +143,10 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi ! Determine module name prefix for linearization if ((GlueModData%ID == Module_BD) .or. (count(ModDataAry%ID == GlueModData%ID) > 1)) then NamePrefix = trim(GlueModData%Abbr)//"_"//Num2LStr(GlueModData%Ins) - GlueModData%Abbr = "."//trim(GlueModData%Abbr)//Num2LStr(GlueModData%Ins) + GlueModData%Abbr = trim(GlueModData%Abbr)//Num2LStr(GlueModData%Ins) else NamePrefix = GlueModData%Abbr - GlueModData%Abbr = "."//GlueModData%Abbr + GlueModData%Abbr = GlueModData%Abbr end if ! Continuous state @@ -192,6 +192,8 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi ! Determine mappings which apply to the modules in this glue module !---------------------------------------------------------------------------- + allocate(ModGlue%ModMaps(0)) + ! Loop through mappings do i = 1, size(Mappings) @@ -204,6 +206,7 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi do j = 1, size(iModAry) if (iModAry(j) == Mapping%iModSrc) then ModMap%iModSrc = j + exit end if end do if (ModMap%iModSrc == 0) cycle @@ -213,16 +216,19 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi do j = 1, size(iModAry) if (iModAry(j) == Mapping%iModDst) then ModMap%iModDst = j + exit end if end do if (ModMap%iModDst == 0) cycle - ! Set mapping index + ! Set mapping index and clear variable indices ModMap%iMapping = i - - ! Init variable indices and find indices that apply to the source data location ModMap%iVarSrc = 0 ModMap%iVarSrcDisp = 0 + ModMap%iVarDst = 0 + ModMap%iVarDstDisp = 0 + + ! Init variable indices and find indices that apply to the source data location select case (Mapping%MapType) case (Map_Variable) @@ -237,20 +243,18 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi end do if (Mapping%MapType == Map_LoadMesh) then - do j = 1, size(ModSrc%Vars%y) - if (MV_EqualDL(ModSrc%Vars%y(j)%DL, Mapping%SrcDispDL)) ModMap%iVarSrcDisp(ModSrc%Vars%y(j)%Field) = j + do j = 1, size(ModSrc%Vars%u) + if (MV_EqualDL(ModSrc%Vars%u(j)%DL, Mapping%SrcDispDL)) ModMap%iVarSrcDisp(ModSrc%Vars%u(j)%Field) = j end do end if end select ! If no source variable indices found, cycle - if (sum(ModMap%iVarSrc) == 0) cycle - if (Mapping%MapType == Map_LoadMesh .and. sum(ModMap%iVarSrcDisp) == 0) cycle + if (all(ModMap%iVarSrc == 0)) cycle + if (Mapping%MapType == Map_LoadMesh .and. all(ModMap%iVarSrcDisp == 0)) cycle ! Init variable indices and find indices that apply to the destination data location - ModMap%iVarDst = 0 - ModMap%iVarDstDisp = 0 select case (Mapping%MapType) case (Map_Variable) @@ -261,27 +265,24 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi case (Map_LoadMesh, Map_MotionMesh) do j = 1, size(ModDst%Vars%u) - if (MV_EqualDL(ModDst%Vars%u(j)%DL, Mapping%DstDL)) ModMap%iVarDst(ModSrc%Vars%y(j)%Field) = j + if (MV_EqualDL(ModDst%Vars%u(j)%DL, Mapping%DstDL)) ModMap%iVarDst(ModDst%Vars%u(j)%Field) = j end do if (Mapping%MapType == Map_LoadMesh) then - do j = 1, size(ModDst%Vars%u) - if (MV_EqualDL(ModDst%Vars%u(j)%DL, Mapping%DstDispDL)) ModMap%iVarDstDisp(ModSrc%Vars%y(j)%Field) = j + do j = 1, size(ModDst%Vars%y) + if (MV_EqualDL(ModDst%Vars%y(j)%DL, Mapping%DstDispDL)) ModMap%iVarDstDisp(ModDst%Vars%y(j)%Field) = j end do end if end select ! If no destination variable indices found, cycle - if (sum(ModMap%iVarDst) == 0) cycle - if (Mapping%MapType == Map_LoadMesh .and. sum(ModMap%iVarDstDisp) == 0) cycle + if (all(ModMap%iVarDst == 0)) cycle + if (Mapping%MapType == Map_LoadMesh .and. all(ModMap%iVarDstDisp == 0)) cycle ! Add new module mapping to array - if (allocated(ModGlue%ModMaps)) then - ModGlue%ModMaps = [ModGlue%ModMaps, ModMap] - else - ModGlue%ModMaps = [ModMap] - end if + ModGlue%ModMaps = [ModGlue%ModMaps, ModMap] + end associate end do @@ -634,7 +635,7 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, if (size(ModData%Vars%y) == 0) cycle ! Get outputs - call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, y_op=m%ModGlue%Lin%y) + call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, y_op=m%ModGlue%Lin%y, y_glue=m%ModGlue%Lin%y) if (Failed()) return end associate @@ -926,8 +927,6 @@ subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_glob if (size(m%ModGlue%Lin%u) > 0) y%Lin%u(:, m%Lin%TimeIndex) = m%ModGlue%Lin%u ! Linearize mesh mappings to populate dUdy and dUdu - m%ModGlue%Lin%dUdy = 0.0_R8Ki - call Eye2D(m%ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return call FAST_LinearizeMappings(m%ModGlue, m%Mappings, Turbine, ErrStat2, ErrMsg2) if (Failed()) return @@ -1247,7 +1246,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters type(FAST_OutputFileType), intent(in) :: y_FAST !< Output variables real(DbKi), intent(in) :: t_global !< current time step (written in file) - integer(IntKi), intent(out) :: Un !< Unit number for file + integer(IntKi), intent(in) :: Un !< Unit number for file character(*), intent(in) :: LinRootName !< output file name integer(IntKi), intent(in) :: FilterFlag !< Variable flag for filtering integer(IntKi), intent(out) :: ErrStat !< Error status of the operation @@ -1269,7 +1268,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR ! Assemble output file name based on glue linearization abbreviation if (present(ModSuffix)) then - OutFileName = trim(LinRootName)//trim(ModSuffix)//".lin" + OutFileName = trim(LinRootName)//"."//trim(ModSuffix)//".lin" else OutFileName = trim(LinRootName)//".lin" end if @@ -1429,7 +1428,7 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer character(100) :: Fmt, FmtStr, FmtRot character(25) :: DerivStr, DerivUnitStr logical :: ShowRotLoc - real(R8Ki) :: DCM(3, 3) + real(R8Ki) :: DCM(3, 3), wm(3) integer(IntKi) :: i, j, RowColIdx ShowRotLoc = .false. @@ -1507,9 +1506,26 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer write (Un, FmtRot) RowColIdx + 2, dcm(3, 1), dcm(3, 2), dcm(3, 3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j + 2)) else if (IsDerivLoc) then + write (Un, Fmt) RowColIdx, op(i_op), VarRotFrame, VarDerivOrder, trim(DerivStr)//' '//trim(Var%LinNames(j))//trim(DerivUnitStr) + + else if (MV_HasFlags(Var, VF_WM_Rot)) then ! BeamDyn Wiener-Milenkovic orientation + + ! Skip writing if not the first value in orientation (3 values) + if (mod(j - 1, 3) /= 0) cycle + + ! Convert from quaternion in operating point to BeamDyn WM parameter + wm = -quat_to_wm(op(i_op:i_op + 2)) + + ! Write all components of WM parameters + write (Un, Fmt) RowColIdx, wm(1), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + write (Un, Fmt) RowColIdx, wm(2), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + write (Un, Fmt) RowColIdx, wm(3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + else + write (Un, Fmt) RowColIdx, op(i_op), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + end if end do diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index 8a97bab68b..eb7112f029 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -369,12 +369,16 @@ struct DataType std::string array_index; switch (field.rank) { + case 5: + array_index = ", DL%i" + std::to_string(index_num + 5) + array_index; + case 4: + array_index = ", DL%i" + std::to_string(index_num + 4) + array_index; case 3: - array_index = ", ML%i" + std::to_string(index_num + 3) + array_index; + array_index = ", DL%i" + std::to_string(index_num + 3) + array_index; case 2: - array_index = ", ML%i" + std::to_string(index_num + 2) + array_index; + array_index = ", DL%i" + std::to_string(index_num + 2) + array_index; case 1: - array_index = "(ML%i" + std::to_string(index_num + 1) + array_index + ")"; + array_index = "(DL%i" + std::to_string(index_num + 1) + array_index + ")"; } // If this field is a mesh, add field name to vector diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index ecec85d994..64ba679819 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -91,6 +91,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) this->gen_fortran_subs(w, mod); + w << "\n"; w << "!ENDOFREGISTRYGENERATEDFILE\n"; return; } @@ -331,7 +332,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) this->gen_fortran_subs(w, mod); // Write module footer - w << "END MODULE " << mod.name << "_Types\n"; + w << "\nEND MODULE " << mod.name << "_Types\n\n"; w << "!ENDOFREGISTRYGENERATEDFILE\n"; } @@ -404,13 +405,13 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) std::string indent("\n"); // Mesh pointer routine - w << indent << "function " << routine_name << "(" << tmp[1] << ", ML) result(Mesh)"; + w << indent << "function " << routine_name << "(" << tmp[1] << ", DL) result(Mesh)"; indent += " "; w << indent << "type(" << ddt.type_fortran << "), target, intent(in) :: " << tmp[1]; - w << indent << "type(DatLoc), intent(in) :: ML"; + w << indent << "type(DatLoc), intent(in) :: DL"; w << indent << "type(MeshType), pointer :: Mesh"; w << indent << "nullify(Mesh)"; - w << indent << "select case (ML%Num)"; + w << indent << "select case (DL%Num)"; for (int i = 0; i < mesh_paths.size(); ++i) { w << indent << "case (" << mesh_names[i] << ")"; @@ -424,18 +425,18 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) // Mesh name routine indent = "\n"; routine_name = mod.nickname + "_" + tmp[0] + "MeshName"; - w << indent << "function " << routine_name << "(ML) result(Name)"; + w << indent << "function " << routine_name << "(DL) result(Name)"; indent += " "; - w << indent << "type(DatLoc), intent(in) :: ML"; + w << indent << "type(DatLoc), intent(in) :: DL"; w << indent << "character(32) :: Name"; w << indent << "Name = \"\""; - w << indent << "select case (ML%Num)"; + w << indent << "select case (DL%Num)"; for (int i = 0; i < mesh_paths.size(); ++i) { std::string new_path(mesh_paths[i]); for (int j = 1; j < 5; ++j) { - auto ind_str = "ML%i" + std::to_string(j); + auto ind_str = "DL%i" + std::to_string(j); auto ind = new_path.find(ind_str); if (ind != std::string::npos) { @@ -454,37 +455,41 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) // Subroutines to pack and unpack arrays based on variables for (const auto &tmp : std::vector>{ {"ContinuousState", "x", "ContState"}, + {"ContinuousState", "x", "ContStateDeriv"}, {"ConstraintState", "z", "ConstrState"}, {"Input", "u", "Input"}, {"Output", "y", "Output"}, }) { - auto type_name = mod.nickname + "_" + tmp[0] + "Type"; + auto base_type = tmp[0]; + auto &abbr = tmp[1]; + auto short_type = tmp[2]; + auto type_name = mod.nickname + "_" + base_type + "Type"; if (tolower(mod.name).compare("aerodyn") == 0) { - type_name = std::string("Rot") + tmp[0] + "Type"; + type_name = std::string("Rot") + base_type + "Type"; } auto it = mod.data_types.find(type_name); if (it == mod.data_types.end()) continue; auto &ddt = it->second->derived; - auto &abbr = tmp[1]; // Get mesh names in derived type or subtypes and add parameters for identifying the mesh std::vector fields; ddt.get_field_names_paths(mod.nickname + "_" + abbr, abbr, 0, fields); - // Var packing routine - std::string routine_name = mod.nickname + "_Pack" + tmp[2] + "Var"; + // Vars packing routine + std::string routine_name = mod.nickname + "_Pack" + short_type + "Ary"; std::string indent("\n"); - std::string var_str = std::string("Var"); - w << indent << "subroutine " << routine_name << "(Var, " << abbr << ", ValAry)"; + w << indent << "subroutine " << routine_name << "(Vars, " << abbr << ", ValAry)"; indent += " "; w << indent << "type(" << ddt.type_fortran << "), intent(in) :: " << abbr; - w << indent << "type(ModVarType), intent(in) :: Var"; + w << indent << "type(ModVarsType), intent(in) :: Vars"; w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; w << indent << "integer(IntKi) :: i"; - w << indent << "associate (DL => Var%DL)"; + w << indent << "do i = 1, size(Vars%" << abbr << ")"; + indent += " "; + w << indent << "associate (Var => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; indent += " "; w << indent << "select case (Var%DL%Num)"; for (const auto &field : fields) @@ -500,7 +505,19 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) { comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; } - w << indent << " call MV_Pack2(Var, " << field_path << ", ValAry) ! " << comment; + if ((field.name.compare("BD_x_q") == 0) && (short_type.compare("ContState") == 0)) + { + // This is a hack to convert BeamDyn's WM orientations to quaternions + w << indent << " if (Var%Field == FieldOrientation) then"; + w << indent << " ValAry(Var%iLoc(1):Var%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, Var%jAry))) ! Convert WM parameters to quaternions"; + w << indent << " else"; + w << indent << " call MV_Pack2(Var, " << field_path << ", ValAry) ! " << comment; + w << indent << " end if"; + } + else + { + w << indent << " call MV_Pack2(Var, " << field_path << ", ValAry) ! " << comment; + } } w << indent << "case default"; w << indent << " ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki"; @@ -508,34 +525,27 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) indent.erase(indent.size() - 3); w << indent << "end associate"; indent.erase(indent.size() - 3); - w << indent << "end subroutine"; - w << indent; - - // Vars packing routine - indent = "\n"; - w << indent << "subroutine " << mod.nickname + "_Pack" + tmp[2] + "Ary" << "(Vars, " << abbr << ", ValAry)"; - indent += " "; - w << indent << "type(" << ddt.type_fortran << "), intent(in) :: " << abbr; - w << indent << "type(ModVarsType), intent(in) :: Vars"; - w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; - w << indent << "integer(IntKi) :: i"; - w << indent << "do i = 1, size(Vars%" << abbr << ")"; - w << indent << " call " << routine_name << "(Vars%" << abbr << "(i), " << abbr << ", ValAry)"; w << indent << "end do"; indent.erase(indent.size() - 3); w << indent << "end subroutine"; w << indent; - // Var unpacking routine - routine_name = mod.nickname + "_Unpack" + tmp[2] + "Var"; + // No unpack function for continuous state derivatives + if (abbr.compare("ContStateDeriv") == 0) + continue; + + // Vars unpacking routine indent = "\n"; - w << indent << "subroutine " << routine_name << "(Var, ValAry, " << abbr << ")"; + routine_name = mod.nickname + "_Unpack" + short_type + "Ary"; + w << indent << "subroutine " << routine_name << "(Vars, ValAry, " << abbr << ")"; indent += " "; - w << indent << "type(ModVarType), intent(in) :: Var"; + w << indent << "type(ModVarsType), intent(in) :: Vars"; w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << abbr; w << indent << "integer(IntKi) :: i"; - w << indent << "associate (DL => Var%DL)"; + w << indent << "do i = 1, size(Vars%" << abbr << ")"; + indent += " "; + w << indent << "associate (Var => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; indent += " "; w << indent << "select case (Var%DL%Num)"; for (const auto &field : fields) @@ -551,30 +561,28 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) { comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; } - w << indent << " call MV_Unpack2(Var, ValAry, " << field_path << ") ! " << comment; + if (field.name.compare("BD_x_q") == 0) + { + // This is a hack to convert BeamDyn's WM orientations to quaternions + w << indent << " if (Var%Field == FieldOrientation) then"; + w << indent << " x%q(4:6, Var%jAry) = wm_inv(quat_to_wm(ValAry(Var%iLoc(1):Var%iLoc(2)))) ! Convert quaternion to WM parameters"; + w << indent << " else"; + w << indent << " call MV_Unpack2(Var, ValAry, " << field_path << ") ! " << comment; + w << indent << " end if"; + } + else + { + w << indent << " call MV_Unpack2(Var, ValAry, " << field_path << ") ! " << comment; + } } w << indent << "end select"; indent.erase(indent.size() - 3); w << indent << "end associate"; indent.erase(indent.size() - 3); - w << indent << "end subroutine"; - w << indent; - - // Vars unpacking routine - indent = "\n"; - w << indent << "subroutine " << mod.nickname + "_Unpack" + tmp[2] + "Ary" << "(Vars, ValAry, " << abbr << ")"; - indent += " "; - w << indent << "type(ModVarsType), intent(in) :: Vars"; - w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; - w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << abbr; - w << indent << "integer(IntKi) :: i"; - w << indent << "do i = 1, size(Vars%" << abbr << ")"; - w << indent << " call " << routine_name << "(Vars%" << abbr << "(i), ValAry, " << abbr << ")"; w << indent << "end do"; indent.erase(indent.size() - 3); w << indent << "end subroutine"; w << indent; - w << indent; } } diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 714f829d1b..6ae3dce567 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -53,7 +53,6 @@ MODULE SeaState PUBLIC :: SeaSt_JacobianPContState ! Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx PUBLIC :: SeaSt_JacobianPDiscState ! Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd PUBLIC :: SeaSt_JacobianPConstrState ! Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz - PUBLIC :: SeaSt_GetOP ! operating points u_op, y_op, x_op, dx_op, xd_op, and z_op CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -338,7 +337,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Initialize module variables if we don't have a fatal error if (ErrStat < AbortErrLev) then - call SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + call SeaSt_InitVars(InitOut%Vars, u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) if (Failed()) return endif @@ -448,7 +447,8 @@ end subroutine SurfaceVisGenerate END SUBROUTINE SeaSt_Init -subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) +subroutine SeaSt_InitVars(Vars, u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables type(SeaSt_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(SeaSt_ParameterType), intent(inout) :: p !< Parameters type(SeaSt_ContinuousStateType), intent(inout) :: x !< Continuous state @@ -460,7 +460,7 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'ED_InitVars' + character(*), parameter :: RoutineName = 'SeaSt_InitVars' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -472,17 +472,6 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS ErrStat = ErrID_None ErrMsg = "" - ! Allocate space for variables (deallocate if already allocated) - if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating vars", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Associate pointer in init output - InitOut%Vars => p%Vars - !---------------------------------------------------------------------------- ! Continuous State Variables !---------------------------------------------------------------------------- @@ -492,7 +481,7 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS !---------------------------------------------------------------------------- ! Extended input - call MV_AddVar(p%Vars%u, "WaveElev0", FieldScalar, DatLoc(SeaSt_u_WaveElev0), & + call MV_AddVar(Vars%u, "WaveElev0", FieldScalar, DatLoc(SeaSt_u_WaveElev0), & Flags=VF_ExtLin, & Perturb=0.02_R8Ki * Pi / 180.0_R8Ki * max(1.0_R8Ki, p%WaveField%WtrDpth), & LinNames=['Extended input: wave elevation at platform ref point, m']) @@ -502,12 +491,13 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS !---------------------------------------------------------------------------- ! Extended output - call MV_AddVar(p%Vars%y, "WaveElev0", FieldScalar, DatLoc(SeaSt_y_WaveElev0), & + call MV_AddVar(Vars%y, "WaveElev0", FieldScalar, DatLoc(SeaSt_y_WaveElev0), & Flags=VF_ExtLin, & LinNames=['Extended output: wave elevation at platform ref point, m']) ! Output variables - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(SeaSt_y_WriteOutput), Num=p%NumOuts, & + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(SeaSt_y_WriteOutput), & + Num=p%NumOuts, & Flags=VF_WriteOut, & LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) @@ -515,15 +505,16 @@ subroutine SeaSt_InitVars(u, p, x, y, m, InitOut, InputFileData, Linearize, ErrS ! Initialize Variables and Jacobian data !---------------------------------------------------------------------------- - call MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return call SeaSt_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call SeaSt_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return contains - character(LinChanLen) function WriteOutputLinName(idx) + function WriteOutputLinName(idx) result(name) integer(IntKi), intent(in) :: idx - WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + character(LinChanLen) :: name + name = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) end function logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -821,7 +812,8 @@ END SUBROUTINE SeaSt_CalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/du, dX/du, dXd/du, and dZ/du -subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +subroutine SeaSt_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + type(ModVarsType), intent(in ) :: Vars !< Module variables real(DbKi), intent(in ) :: t !< Time in seconds at operating point type(SeaSt_InputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(SeaSt_ParameterType), intent(in ) :: p !< Parameters @@ -852,18 +844,18 @@ subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, E if (present(dYdu)) then if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return endif ! Initialize Jacobian to zero dYdu = 0.0_R8Ki - iVar_u_WaveElev0 = MV_FindVarDatLoc(p%Vars%u, DatLoc(SeaSt_u_WaveElev0)) - iVar_y_WaveElev0 = MV_FindVarDatLoc(p%Vars%y, DatLoc(SeaSt_y_WaveElev0)) + iVar_u_WaveElev0 = MV_FindVarDatLoc(Vars%u, DatLoc(SeaSt_u_WaveElev0)) + iVar_y_WaveElev0 = MV_FindVarDatLoc(Vars%y, DatLoc(SeaSt_y_WaveElev0)) ! Extended input to extended output (direct pass-through) if (iVar_u_WaveElev0 > 0 .and. iVar_y_WaveElev0 > 0) then - dYdu(p%Vars%y(iVar_y_WaveElev0)%iLoc(1), p%Vars%u(iVar_u_WaveElev0)%iLoc(1)) = 1.0_R8Ki + dYdu(Vars%y(iVar_y_WaveElev0)%iLoc(1), Vars%u(iVar_u_WaveElev0)%iLoc(1)) = 1.0_R8Ki end if ! It isn't possible to determine the relationship between the extended input and the WrOuts. So we leave them all zero. @@ -892,7 +884,8 @@ end subroutine SeaSt_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx !! No continuous states, so this doesn't do anything -subroutine SeaSt_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +subroutine SeaSt_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + type(ModVarsType), intent(in ) :: Vars !< Module variables real(DbKi), intent(in ) :: t !< Time in seconds at operating point type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(SeaSt_ParameterType), intent(in ) :: p !< Parameters @@ -933,7 +926,8 @@ end subroutine SeaSt_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd !! No discrete states, so this doesn't do anything -subroutine SeaSt_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +subroutine SeaSt_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd) + type(ModVarsType), intent(in ) :: Vars !< Module variables real(DbKi), intent(in ) :: t !< Time in seconds at operating point type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(SeaSt_ParameterType), intent(in ) :: p !< Parameters @@ -974,7 +968,8 @@ end subroutine SeaSt_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz !! No constraint states, so this doesn't do anything -subroutine SeaSt_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +subroutine SeaSt_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz) + type(ModVarsType), intent(in ) :: Vars !< Module variables real(DbKi), intent(in ) :: t !< Time in seconds at operating point type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(SeaSt_ParameterType), intent(in ) :: p !< Parameters @@ -1012,69 +1007,6 @@ subroutine SeaSt_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrS ! endif end subroutine SeaSt_JacobianPConstrState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Linearization operating points u_op, y_op, x_op, dx_op, xd_op, and z_op -subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - real(DbKi), intent(in ) :: t !< Time in seconds at operating point - type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - type(SeaSt_ParameterType), intent(in ) :: p !< Parameters - type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point - type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point - type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point - type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point - type(SeaSt_OutputType), intent(in ) :: y !< Output at operating point - type(SeaSt_MiscVarType), intent(inout) :: m !< Misc/optimization variables - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs - real(R8Ki), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs - real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states - real(R8Ki), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states - real(R8Ki), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states - real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states - - integer(IntKi) :: idxStart, idxEnd - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_GetOP' - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - - if (present(u_op)) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) - if (Failed()) return - end if - - ! no regular inputs, only extended input - - ! WaveElev0 is zero to be consistent with linearization requirements - call MV_Pack2(p%Vars%u(1), 0.0_R8Ki, u_op) - - ! NOTE: if more extended inputs are added, place them here - end if - - if (present(y_op)) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2) - if (Failed()) return - end if - - ! WaveElev0 is zero to be consistent with linearization requirements - call MV_Pack2(p%Vars%y(1), 0.0_R8Ki, y_op) - call MV_Pack2(p%Vars%y(2), y%WriteOutput, y_op) - - end if - -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine SeaSt_GetOP - !---------------------------------------------------------------------------------------------------------------------------------- END MODULE SeaState !********************************************************************************************************************************** diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 3e9ecd972d..ee6d77770f 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -97,7 +97,7 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveElevVisY {:} - - "Y locations of grid output" "m,-" typedef ^ ^ SiKi WaveElevVisGrid {:}{:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points." (m) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" -typedef ^ ^ ModVarsType *Vars - - - "Module Variables" +typedef ^ ^ ModVarsType Vars - - - "Module Variables" @@ -124,8 +124,7 @@ typedef ^ OtherStateType R8Ki Unu # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # -typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ^ DbKi WaveDT - - - "Wave DT" sec +typedef ^ ParameterType DbKi WaveDT - - - "Wave DT" sec typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - typedef ^ ^ INTEGER NGrid 3 - - "Number of grid entries in x, y, and z" typedef ^ ^ ReKi deltaGrid 3 - - "delta between grid points in x, y, and theta (for z)" m,m,rad diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 5f20fef592..ce57306b63 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -641,14 +641,15 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er integer(IntKi) :: ErrStat2 ! Temporary Error status character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message character(ChanLen) :: Desc - integer(IntKi) :: i, j, k, iUser + integer(IntKi) :: i, j, k character(36), parameter :: StCLabels(*) = [& ' local displacement state X m ', & - ' local displacement state Y m ', & - ' local displacement state Z m ', & ' local displacement state dX/dt m/s', & + ' local displacement state Y m ', & ' local displacement state dY/dt m/s', & + ' local displacement state Z m ', & ' local displacement state dZ/dt m/s'] + integer(IntKi), parameter :: StCInds(*) = [1, 3, 5, 2, 4, 6] real(R8Ki) :: xPerturb, uPerturbTrans, uPerturbAng, uPerturbs(6) ErrStat = ErrID_None @@ -673,45 +674,53 @@ subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, Er xPerturb = 0.2_R8Ki*Pi/180.0_R8Ki * max(real(TwoNorm(InitInp%NacRefPos - InitInp%TwrBaseRefPos), R8Ki), 1.0_R8Ki) ! Blade Structural Controller - do i = 1, p%NumBStC - do j = 1, p%NumBl + do j = 1, p%NumBStC + do i = 1, p%NumBl Desc = 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_BStC_StC_x), & - Num=6, & - Flags=VF_DerivOrder2+VF_RotFrame, & - LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & - Perturb=xPerturb) + do k = 1, size(StCInds) + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_BStC_StC_x, j), & + iAry=StCInds(k), jAry=i, & + Flags=VF_DerivOrder2+VF_RotFrame, & + LinNames=[trim(Desc)//StCLabels(StCInds(k))], & + Perturb=xPerturb) + end do end do end do ! Nacelle Structural Controller do j = 1, p%NumNStC Desc = 'Nacelle StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_NStC_StC_x), & - Num=6, & - Flags=VF_DerivOrder2, & - LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & - Perturb=xPerturb) + do k = 1, size(StCInds) + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_NStC_StC_x, j), & + iAry=StCInds(k), jAry=1, & + Flags=VF_DerivOrder2, & + LinNames=[trim(Desc)//StCLabels(StCInds(k))], & + Perturb=xPerturb) + end do enddo ! Tower Structural Controller do j = 1, p%NumTStC Desc = 'Tower StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_TStC_StC_x), & - Num=6, & - Flags=VF_DerivOrder2, & - LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & - Perturb=xPerturb) + do k = 1, size(StCInds) + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_TStC_StC_x, j), & + iAry=StCInds(k), jAry=1, & + Flags=VF_DerivOrder2, & + LinNames=[trim(Desc)//StCLabels(StCInds(k))], & + Perturb=xPerturb) + end do enddo ! Substructure Structural Controller do j = 1, p%NumSStC Desc = 'Substructure StC '//Num2LStr(j) - call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_SStC_StC_x), & - Num=6, & - Flags=VF_DerivOrder2, & - LinNames=[(trim(Desc)//StCLabels(k), k = 1, 6)], & - Perturb=xPerturb) + do k = 1, size(StCInds) + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_SStC_StC_x, j), & + iAry=StCInds(k), jAry=1, & + Flags=VF_DerivOrder2, & + LinNames=[trim(Desc)//StCLabels(StCInds(k))], & + Perturb=xPerturb) + end do enddo !---------------------------------------------------------------------------- diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 22e97d2477..f8842cdc7a 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -46,7 +46,6 @@ Module SubDyn PUBLIC :: SD_JacobianPInput ! PUBLIC :: SD_JacobianPDiscState ! PUBLIC :: SD_JacobianPConstrState ! - PUBLIC :: SD_GetOP ! PUBLIC :: SD_ProgDesc CONTAINS @@ -387,7 +386,7 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO END IF ! Initialize module variables - call SD_InitVars(Init, u, p, x, y, m, InitOut, InitInput%Linearize, ErrStat2, ErrMsg2); if(Failed()) return + call SD_InitVars(InitOut%Vars, Init, u, p, x, y, m, InitOut, InitInput%Linearize, ErrStat2, ErrMsg2); if(Failed()) return ! Tell GLUECODE the SubDyn timestep interval Interval = p%SDdeltaT @@ -414,7 +413,8 @@ END SUBROUTINE SD_Init !---------------------------------------------------------------------------------------------------------------------------------- !> SD_InitVars initializes the variables for this module for use by the solver and linearization -subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) +subroutine SD_InitVars(Vars, Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables type(SD_InitType), intent(in) :: Init !< Input data for initialization routine type(SD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(SD_ParameterType), intent(inout) :: p !< Parameters @@ -433,28 +433,17 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) integer(IntKi) :: i, j real(R8Ki) :: dx, dy, dz, maxDim - ! Allocate space for variables (deallocate if already allocated) - if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Add pointers to vars to initialization output - InitOut%Vars => p%Vars - !---------------------------------------------------------------------------- ! Continuous State Variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qm), & + call MV_AddVar(Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qm), & Num=p%nDOFM, & DerivOrder=0, & Perturb=2.0_ReKi*D2R_D, & LinNames=[('Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -', i=1, p%nDOFM)]) - call MV_AddVar(p%Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qmdot), & + call MV_AddVar(Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qmdot), & Num=p%nDOFM, & DerivOrder=0, & Perturb=2.0_ReKi*D2R_D, & @@ -469,7 +458,7 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) maxDim = max(dx, dy, dz) - call MV_AddMeshVar(p%Vars%u, "TPMesh", MotionFields, DatLoc(SD_u_TPMesh), & + call MV_AddMeshVar(Vars%u, "TPMesh", MotionFields, DatLoc(SD_u_TPMesh), & Mesh=u%TPMesh, & Perturbs=[2.0_R8Ki*D2R_D, & ! TranslationDisp 2.0_R8Ki*D2R_D, & ! Orientation @@ -478,7 +467,7 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) 2.0_R8Ki*D2R_D, & ! TranslationAcc 2.0_R8Ki*D2R_D]) ! RotationAcc - call MV_AddMeshVar(p%Vars%u, "LMesh", LoadFields, DatLoc(SD_u_LMesh), & + call MV_AddMeshVar(Vars%u, "LMesh", LoadFields, DatLoc(SD_u_LMesh), & Mesh=u%LMesh, & Perturbs=[170*maxDim**2, 14*maxDim**3]) ! Force, Moment @@ -487,12 +476,12 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! Mesh variables - call MV_AddMeshVar(p%Vars%y, 'Y1Mesh', LoadFields, DatLoc(SD_y_Y1Mesh), Mesh=y%Y1Mesh) - call MV_AddMeshVar(p%Vars%y, 'Y2Mesh', MotionFields, DatLoc(SD_y_Y2Mesh), Mesh=y%Y2Mesh) - call MV_AddMeshVar(p%Vars%y, 'Y3Mesh', MotionFields, DatLoc(SD_y_Y3Mesh), Mesh=y%Y3Mesh) + call MV_AddMeshVar(Vars%y, 'Y1Mesh', LoadFields, DatLoc(SD_y_Y1Mesh), Mesh=y%Y1Mesh) + call MV_AddMeshVar(Vars%y, 'Y2Mesh', MotionFields, DatLoc(SD_y_Y2Mesh), Mesh=y%Y2Mesh) + call MV_AddMeshVar(Vars%y, 'Y3Mesh', MotionFields, DatLoc(SD_y_Y3Mesh), Mesh=y%Y3Mesh) ! Output variables - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(SD_y_WriteOutput), & + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(SD_y_WriteOutput), & Num=p%NumOuts, & Flags=VF_WriteOut, & LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) @@ -501,7 +490,7 @@ subroutine SD_InitVars(Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Initialize Variables and Values !---------------------------------------------------------------------------- - CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return call SD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call SD_CopyContState(x, m%dxdt_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -519,77 +508,6 @@ logical function Failed() end function Failed end subroutine -subroutine SD_PackStateOP(p, x, op) - type(SD_ParameterType), intent(in) :: p - type(SD_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: op(:) - integer(IntKi) :: i - ! do i = 1, size(p%Vars%x) - ! associate(Var => p%Vars%x(i)) - ! select case(Var%jUsr) - ! case (1) - ! op(Var%iLoc(1):Var%iLoc(2)) = x%qm - ! case (2) - ! op(Var%iLoc(1):Var%iLoc(2)) = x%qmdot - ! end select - ! end associate - ! end do -end subroutine - -subroutine SD_UnpackStateOP(p, op, x) - type(SD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(SD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - ! do i = 1, size(p%Vars%x) - ! associate(Var => p%Vars%x(i)) - ! select case(Var%jUsr) - ! case (1) - ! x%qm = op(Var%iLoc(1):Var%iLoc(2)) - ! case (2) - ! x%qmdot = op(Var%iLoc(1):Var%iLoc(2)) - ! end select - ! end associate - ! end do -end subroutine - -subroutine SD_PackInputOP(p, u, op) - type(SD_ParameterType), intent(in) :: p - type(SD_InputType), intent(in) :: u - real(R8Ki), intent(out) :: op(:) - ! call MV_Pack(p%Vars%u, p%iVarTPMesh, u%TPMesh, op) - ! call MV_Pack(p%Vars%u, p%iVarLMesh, u%LMesh, op) -end subroutine - -subroutine SD_UnpackInputOP(p, op, u) - type(SD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(SD_InputType), intent(inout) :: u - ! call MV_Unpack(p%Vars%u, p%iVarTPMesh, op, u%TPMesh) - ! call MV_Unpack(p%Vars%u, p%iVarLMesh, op, u%LMesh) -end subroutine - -subroutine SD_PackOutputOP(p, y, op, PackWriteOutput) - type(SD_ParameterType), intent(in) :: p - type(SD_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: op(:) - logical, intent(in) :: PackWriteOutput - ! call MV_Pack(p%Vars%y, p%iVarY1Mesh, y%Y1Mesh, op) - ! call MV_Pack(p%Vars%y, p%iVarY2Mesh, y%Y2Mesh, op) - ! call MV_Pack(p%Vars%y, p%iVarY3Mesh, y%Y3Mesh, op) - ! if (PackWriteOutput) call MV_Pack(p%Vars%y, p%iVarWriteOutput, y%WriteOutput, op) -end subroutine - -subroutine SD_UnpackOutputOP(p, op, y) - type(SD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: op(:) - type(SD_OutputType), intent(out) :: y - ! call MV_Unpack(p%Vars%y, p%iVarY1Mesh, op, y%Y1Mesh) - ! call MV_Unpack(p%Vars%y, p%iVarY2Mesh, op, y%Y2Mesh) - ! call MV_Unpack(p%Vars%y, p%iVarY3Mesh, op, y%Y3Mesh) - ! call MV_Unpack(p%Vars%y, p%iVarWriteOutput, op, y%WriteOutput) -end subroutine - !---------------------------------------------------------------------------------------------------------------------------------- !> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. !! Continuous, discrete, constraint, and other states are updated for t + Interval. @@ -2121,7 +2039,8 @@ END SUBROUTINE SD_AM2 !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE SD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -2133,7 +2052,6 @@ SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] @@ -2142,99 +2060,82 @@ SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM character(*), parameter :: RoutineName = 'SD_JacobianPInput' integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc integer(IntKi) :: i, j, k, col ErrStat = ErrID_None ErrMsg = '' - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter - else - IsFullLin = .true. - FlagFilterLoc = VF_None - end if - ! Calculate OP values here call SD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return ! Make a copy of the inputs to perturb call SD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if(Failed()) return - call SD_PackInputOP(p, u, m%Jac%u) + call SD_PackInputAry(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return end if ! Loop through input variables - do i = 1, size(p%Vars%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + do i = 1, size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%u(i)%Num + do j = 1,Vars%u(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call SD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputOP(p, m%y_jac, m%Jac%y_pos, IsFullLin) + call SD_PackOutputAry(Vars, m%y_jac, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call SD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputOP(p, m%y_jac, m%Jac%y_neg, IsFullLin) + call SD_PackOutputAry(Vars, m%y_jac, m%Jac%y_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do end do end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - if (present(dXdu) .and. (p%Vars%Nx > 0)) then + if (present(dXdu) .and. (m%Jac%Nx > 0)) then if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return endif ! Loop through input variables - do i = 1,size(p%Vars%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%u(i), FlagFilterLoc)) cycle + do i = 1,size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%u(i)%Num + do j = 1,Vars%u(i)%Num ! Calculate positive perturbation and resulting continuous state derivatives - call MV_Perturb(p%Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call SD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackStateOP(p, m%dxdt_jac, m%Jac%x_pos) + call SD_PackContStateAry(Vars, m%dxdt_jac, m%Jac%x_pos) ! Calculate negative perturbation and resulting continuous state derivatives - call MV_Perturb(p%Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call SD_UnpackInputOP(p, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackStateOP(p, m%dxdt_jac, m%Jac%x_neg) + call SD_PackContStateAry(Vars, m%dxdt_jac, m%Jac%x_neg) ! Calculate column index - col = p%Vars%u(i)%iLoc(1) + j - 1 + col = Vars%u(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%u(i)%Perturb) + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do end do end if @@ -2256,7 +2157,8 @@ END SUBROUTINE SD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE SD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, FlagFilter, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE SD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -2268,7 +2170,6 @@ SUBROUTINE SD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi), OPTIONAL, INTENT(IN ) :: FlagFilter !< Flag filter for variable calculation REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] @@ -2277,8 +2178,6 @@ SUBROUTINE SD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E character(*), parameter :: RoutineName = 'SD_JacobianPContState' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc integer(IntKi) :: i, j, k, col ! Initialize ErrStat @@ -2286,55 +2185,43 @@ SUBROUTINE SD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ErrMsg = '' ! If no state variables, return - if (p%Vars%Nx == 0) return - - ! Set full linearization flag and local filter flag - if (present(FlagFilter)) then - IsFullLin = FlagFilter == VF_None - FlagFilterLoc = FlagFilter - else - IsFullLin = .true. - FlagFilterLoc = VF_None - end if + if (m%Jac%Nx == 0) return ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY call SD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if(Failed()) return - call SD_PackStateOP(p, x, m%Jac%x) + call SD_PackContStateAry(Vars, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return end if ! Loop through state variables - do i = 1,size(p%Vars%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + do i = 1,size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%x(i)%Num + do j = 1,Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call SD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputOP(p, m%y_jac, m%Jac%y_pos, IsFullLin) + call SD_PackOutputAry(Vars, m%y_jac, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call SD_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputOP(p, m%y_jac, m%Jac%y_neg, IsFullLin) + call SD_PackOutputAry(Vars, m%y_jac, m%Jac%y_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do end if @@ -2353,35 +2240,32 @@ SUBROUTINE SD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return end if ! Loop through state variables - do i = 1,size(p%Vars%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(p%Vars%x(i), FlagFilterLoc)) cycle + do i = 1,size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, p%Vars%x(i)%Num + do j = 1, Vars%x(i)%Num ! Calculate positive perturbation - call MV_Perturb(p%Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) - call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateOP(p, m%dxdt_jac, m%Jac%x_pos) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackContStateAry(Vars, m%dxdt_jac, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(p%Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackStateOP(p, m%Jac%x_perturb, m%x_perturb) - call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateOP(p, m%dxdt_jac, m%Jac%x_neg) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackContStateAry(Vars, m%dxdt_jac, m%Jac%x_neg) ! Calculate column index - col = p%Vars%x(i)%iLoc(1) + j - 1 + col = Vars%x(i)%iLoc(1) + j - 1 ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * p%Vars%x(i)%Perturb) + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) end do end do endif ! analytical or numerical @@ -2468,76 +2352,7 @@ SUBROUTINE SD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat IF ( PRESENT(dZdz) ) THEN END IF END SUBROUTINE SD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE SD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - - CHARACTER(*), PARAMETER :: RoutineName = 'SD_GetOP' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = '' - - if (present(u_op)) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - call SD_PackInputOP(p, u, u_op) - end if - - if (present(y_op)) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - call SD_PackOutputOP(p, y, y_op, .true.) - end if - - if (present(x_op)) then - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call SD_PackStateOP(p, x, x_op) - end if - - if (present(dx_op)) then - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if(failed()) return - end if - call SD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if(Failed()) return - call SD_PackStateOP(p, m%dxdt_jac, dx_op) - end if - if (present(xd_op)) then - end if - - if (present(z_op)) then - end if - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function Failed -END SUBROUTINE SD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !------------------------------------------------------------------------------------------------------ !> Perform Craig Bampton (CB) reduction and set parameters needed for States and Ouputs equations diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 20e8031c22..8dae507452 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -80,7 +80,7 @@ typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" +typedef ^ InitOutputType ModVarsType Vars - - - "Module Variables" # Linearization typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - @@ -161,7 +161,6 @@ typedef ^ OtherStateType SD_ContinuousStateType xdot {:} - - "previou typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated last" # ============================== Parameters ============================================================================================================================================ -typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ ParameterType IntKi iVarTPMesh - 0 - "Variable index for TPMesh" typedef ^ ParameterType IntKi iVarLMesh - 0 - "Variable index for LMesh" typedef ^ ParameterType IntKi iVarY1Mesh - 0 - "Variable index for Y1Mesh" From a59fa0ab63034397b80972827c9e3f7af651aa32 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 25 Jul 2024 19:14:11 +0000 Subject: [PATCH 159/319] Majority of linearization regression tests working --- modules/aerodyn/src/AeroAcoustics_Types.f90 | 404 ++++---- modules/aerodyn/src/AeroDyn.f90 | 12 +- modules/aerodyn/src/AeroDyn_Types.f90 | 448 ++++----- modules/aerodyn/src/AirfoilInfo_Types.f90 | 230 ++--- modules/aerodyn/src/BEMT_Types.f90 | 638 ++++++------ modules/aerodyn/src/DBEMT_Types.f90 | 334 +++---- modules/aerodyn/src/FVW_Types.f90 | 414 ++++---- modules/aerodyn/src/UnsteadyAero_Types.f90 | 372 ++++--- modules/beamdyn/src/BeamDyn_Types.f90 | 372 ++++--- modules/elastodyn/src/ElastoDyn.f90 | 61 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 676 ++++++------- .../src/ExternalInflow_Types.f90 | 300 +++--- modules/extloads/src/ExtLoadsDX_Types.f90 | 196 ++-- modules/extloads/src/ExtLoads_Types.f90 | 434 ++++----- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 308 +++--- modules/feamooring/src/FEAMooring_Types.f90 | 334 +++---- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 286 +++--- modules/hydrodyn/src/HydroDyn.f90 | 4 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 501 ++++------ modules/hydrodyn/src/Morison_Types.f90 | 304 +++--- modules/hydrodyn/src/SS_Excitation_Types.f90 | 298 +++--- modules/hydrodyn/src/SS_Radiation_Types.f90 | 298 +++--- modules/hydrodyn/src/WAMIT2_Types.f90 | 75 +- modules/hydrodyn/src/WAMIT_Types.f90 | 330 +++---- modules/icedyn/src/IceDyn_Types.f90 | 310 +++--- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 296 +++--- .../inflowwind/src/IfW_FlowField_Types.f90 | 2 + modules/inflowwind/src/InflowWind.f90 | 68 +- modules/inflowwind/src/InflowWind.txt | 5 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 2 + modules/inflowwind/src/InflowWind_Types.f90 | 492 ++++------ modules/inflowwind/src/Lidar_Types.f90 | 354 +++---- modules/map/src/MAP_Types.f90 | 480 ++++----- modules/moordyn/src/MoorDyn.f90 | 27 +- modules/moordyn/src/MoorDyn_Types.f90 | 372 ++++--- modules/nwtc-library/src/ModVar.f90 | 430 +------- .../nwtc-library/src/NWTC_Library_IncSubs.f90 | 1 + .../nwtc-library/src/NWTC_Library_Types.f90 | 21 +- modules/openfast-library/src/FAST_AeroMap.f90 | 80 +- modules/openfast-library/src/FAST_Funcs.f90 | 111 +-- modules/openfast-library/src/FAST_Mapping.f90 | 22 +- modules/openfast-library/src/FAST_ModGlue.f90 | 148 +-- modules/openfast-library/src/FAST_Subs.f90 | 36 +- modules/openfast-library/src/FAST_Types.f90 | 2 + .../openfast-library/src/Glue_Registry.txt | 2 +- modules/openfast-library/src/Glue_Types.f90 | 44 +- .../src/registry_gen_fortran.cpp | 106 +- .../src/OrcaFlexInterface_Types.f90 | 298 +++--- modules/seastate/src/Current_Types.f90 | 2 + .../seastate/src/SeaSt_WaveField_Types.f90 | 2 + modules/seastate/src/SeaState_Types.f90 | 370 +++---- modules/seastate/src/Waves2_Types.f90 | 2 + modules/seastate/src/Waves_Types.f90 | 2 + modules/servodyn/src/ServoDyn_Types.f90 | 922 +++++++++--------- modules/servodyn/src/StrucCtrl_Types.f90 | 346 +++---- modules/subdyn/src/SubDyn_Types.f90 | 430 ++++---- .../supercontroller/src/SCDataEx_Types.f90 | 158 ++- .../src/SuperController_Types.f90 | 308 +++--- 58 files changed, 6117 insertions(+), 7763 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 9a5a0d92bd..b4922766b7 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -3009,290 +3009,256 @@ subroutine AA_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputNode); if (RegCheckErr(RF, RoutineName)) return end subroutine -function AA_InputMeshPointer(u, ML) result(Mesh) - type(AA_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function AA_InputMeshPointer(u, DL) result(Mesh) + type(AA_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function AA_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function AA_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function AA_OutputMeshPointer(y, ML) result(Mesh) +function AA_OutputMeshPointer(y, DL) result(Mesh) type(AA_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function AA_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function AA_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine AA_PackContStateVar(Var, x, ValAry) - type(AA_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AA_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AA_PackContStateAry(Vars, x, ValAry) type(AA_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call AA_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AA_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AA_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AA_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AA_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine AA_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(AA_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call AA_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AA_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine AA_PackContStateDerivAry(Vars, x, ValAry) + type(AA_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AA_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine AA_PackConstrStateVar(Var, z, ValAry) - type(AA_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AA_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine AA_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AA_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine AA_PackConstrStateAry(Vars, z, ValAry) type(AA_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call AA_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (AA_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AA_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AA_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AA_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine AA_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(AA_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call AA_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (AA_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine AA_PackInputVar(Var, u, ValAry) - type(AA_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AA_u_RotGtoL) - call MV_Pack2(Var, u%RotGtoL, ValAry) ! Rank 4 Array - case (AA_u_AeroCent_G) - call MV_Pack2(Var, u%AeroCent_G, ValAry) ! Rank 3 Array - case (AA_u_Vrel) - call MV_Pack2(Var, u%Vrel, ValAry) ! Rank 2 Array - case (AA_u_AoANoise) - call MV_Pack2(Var, u%AoANoise, ValAry) ! Rank 2 Array - case (AA_u_Inflow) - call MV_Pack2(Var, u%Inflow, ValAry) ! Rank 3 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AA_PackInputAry(Vars, u, ValAry) - type(AA_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(AA_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call AA_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (AA_u_RotGtoL) + call MV_Pack(V, u%RotGtoL(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array + case (AA_u_AeroCent_G) + call MV_Pack(V, u%AeroCent_G(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (AA_u_Vrel) + call MV_Pack(V, u%Vrel(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (AA_u_AoANoise) + call MV_Pack(V, u%AoANoise(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (AA_u_Inflow) + call MV_Pack(V, u%Inflow(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AA_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AA_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AA_u_RotGtoL) - call MV_Unpack2(Var, ValAry, u%RotGtoL) ! Rank 4 Array - case (AA_u_AeroCent_G) - call MV_Unpack2(Var, ValAry, u%AeroCent_G) ! Rank 3 Array - case (AA_u_Vrel) - call MV_Unpack2(Var, ValAry, u%Vrel) ! Rank 2 Array - case (AA_u_AoANoise) - call MV_Unpack2(Var, ValAry, u%AoANoise) ! Rank 2 Array - case (AA_u_Inflow) - call MV_Unpack2(Var, ValAry, u%Inflow) ! Rank 3 Array - end select - end associate -end subroutine - subroutine AA_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(AA_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call AA_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (AA_u_RotGtoL) + call MV_Unpack(V, ValAry, u%RotGtoL(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array + case (AA_u_AeroCent_G) + call MV_Unpack(V, ValAry, u%AeroCent_G(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (AA_u_Vrel) + call MV_Unpack(V, ValAry, u%Vrel(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (AA_u_AoANoise) + call MV_Unpack(V, ValAry, u%AoANoise(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (AA_u_Inflow) + call MV_Unpack(V, ValAry, u%Inflow(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + end select + end associate end do end subroutine - -subroutine AA_PackOutputVar(Var, y, ValAry) - type(AA_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AA_y_SumSpecNoise) - call MV_Pack2(Var, y%SumSpecNoise, ValAry) ! Rank 3 Array - case (AA_y_SumSpecNoiseSep) - call MV_Pack2(Var, y%SumSpecNoiseSep, ValAry) ! Rank 3 Array - case (AA_y_OASPL) - call MV_Pack2(Var, y%OASPL, ValAry) ! Rank 3 Array - case (AA_y_OASPL_Mech) - call MV_Pack2(Var, y%OASPL_Mech, ValAry) ! Rank 4 Array - case (AA_y_DirectiviOutput) - call MV_Pack2(Var, y%DirectiviOutput, ValAry) ! Rank 1 Array - case (AA_y_OutLECoords) - call MV_Pack2(Var, y%OutLECoords, ValAry) ! Rank 4 Array - case (AA_y_PtotalFreq) - call MV_Pack2(Var, y%PtotalFreq, ValAry) ! Rank 2 Array - case (AA_y_WriteOutputForPE) - call MV_Pack2(Var, y%WriteOutputForPE, ValAry) ! Rank 1 Array - case (AA_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (AA_y_WriteOutputSep) - call MV_Pack2(Var, y%WriteOutputSep, ValAry) ! Rank 1 Array - case (AA_y_WriteOutputNode) - call MV_Pack2(Var, y%WriteOutputNode, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AA_PackOutputAry(Vars, y, ValAry) - type(AA_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(AA_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call AA_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (AA_y_SumSpecNoise) + call MV_Pack(V, y%SumSpecNoise(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + call MV_Pack(V, y%SumSpecNoiseSep(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (AA_y_OASPL) + call MV_Pack(V, y%OASPL(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (AA_y_OASPL_Mech) + call MV_Pack(V, y%OASPL_Mech(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array + case (AA_y_DirectiviOutput) + call MV_Pack(V, y%DirectiviOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AA_y_OutLECoords) + call MV_Pack(V, y%OutLECoords(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array + case (AA_y_PtotalFreq) + call MV_Pack(V, y%PtotalFreq(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (AA_y_WriteOutputForPE) + call MV_Pack(V, y%WriteOutputForPE(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AA_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AA_y_WriteOutputSep) + call MV_Pack(V, y%WriteOutputSep(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AA_y_WriteOutputNode) + call MV_Pack(V, y%WriteOutputNode(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AA_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AA_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AA_y_SumSpecNoise) - call MV_Unpack2(Var, ValAry, y%SumSpecNoise) ! Rank 3 Array - case (AA_y_SumSpecNoiseSep) - call MV_Unpack2(Var, ValAry, y%SumSpecNoiseSep) ! Rank 3 Array - case (AA_y_OASPL) - call MV_Unpack2(Var, ValAry, y%OASPL) ! Rank 3 Array - case (AA_y_OASPL_Mech) - call MV_Unpack2(Var, ValAry, y%OASPL_Mech) ! Rank 4 Array - case (AA_y_DirectiviOutput) - call MV_Unpack2(Var, ValAry, y%DirectiviOutput) ! Rank 1 Array - case (AA_y_OutLECoords) - call MV_Unpack2(Var, ValAry, y%OutLECoords) ! Rank 4 Array - case (AA_y_PtotalFreq) - call MV_Unpack2(Var, ValAry, y%PtotalFreq) ! Rank 2 Array - case (AA_y_WriteOutputForPE) - call MV_Unpack2(Var, ValAry, y%WriteOutputForPE) ! Rank 1 Array - case (AA_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (AA_y_WriteOutputSep) - call MV_Unpack2(Var, ValAry, y%WriteOutputSep) ! Rank 1 Array - case (AA_y_WriteOutputNode) - call MV_Unpack2(Var, ValAry, y%WriteOutputNode) ! Rank 1 Array - end select - end associate -end subroutine - subroutine AA_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(AA_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call AA_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (AA_y_SumSpecNoise) + call MV_Unpack(V, ValAry, y%SumSpecNoise(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + call MV_Unpack(V, ValAry, y%SumSpecNoiseSep(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (AA_y_OASPL) + call MV_Unpack(V, ValAry, y%OASPL(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (AA_y_OASPL_Mech) + call MV_Unpack(V, ValAry, y%OASPL_Mech(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array + case (AA_y_DirectiviOutput) + call MV_Unpack(V, ValAry, y%DirectiviOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AA_y_OutLECoords) + call MV_Unpack(V, ValAry, y%OutLECoords(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array + case (AA_y_PtotalFreq) + call MV_Unpack(V, ValAry, y%PtotalFreq(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (AA_y_WriteOutputForPE) + call MV_Unpack(V, ValAry, y%WriteOutputForPE(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AA_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AA_y_WriteOutputSep) + call MV_Unpack(V, ValAry, y%WriteOutputSep(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AA_y_WriteOutputNode) + call MV_Unpack(V, ValAry, y%WriteOutputNode(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE AeroAcoustics_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index e3064028dc..f13abc63b2 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -6658,11 +6658,11 @@ SUBROUTINE RotGetOP(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, OtherState do i = 1, size(Vars%u) select case (Vars%u(i)%DL%Num) case (AD_u_HWindSpeed) - call MV_Pack2(Vars%u(i), UF_op%VelH, u_op) + call MV_Pack(Vars%u(i), UF_op%VelH, u_op) case (AD_u_PLexp) - call MV_Pack2(Vars%u(i), UF_op%ShrV, u_op) + call MV_Pack(Vars%u(i), UF_op%ShrV, u_op) case (AD_u_PropagationDir) - call MV_Pack2(Vars%u(i), UF_op%AngleH + p_AD%FlowField%PropagationDir, u_op) + call MV_Pack(Vars%u(i), UF_op%AngleH + p_AD%FlowField%PropagationDir, u_op) end select end do end if @@ -6729,13 +6729,13 @@ subroutine AD_PackExtInputAry(Vars, t, p, ValAry) select case(Var%DL%Num) case (AD_u_HWindSpeed) call CalcExtOP() - call MV_Pack2(Var, op%VelH, ValAry) + call MV_Pack(Var, op%VelH, ValAry) case (AD_u_PLExp) call CalcExtOP() - call MV_Pack2(Var, op%ShrV, ValAry) + call MV_Pack(Var, op%ShrV, ValAry) case (AD_u_PropagationDir) call CalcExtOP() - call MV_Pack2(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + call MV_Pack(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) end select end associate end do diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 36395f86c4..18968d7d3c 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -6714,12 +6714,12 @@ SUBROUTINE AD_InflowType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, END IF ! check if allocated END SUBROUTINE -function AD_InputMeshPointer(u, ML) result(Mesh) - type(RotInputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function AD_InputMeshPointer(u, DL) result(Mesh) + type(RotInputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (AD_u_NacelleMotion) Mesh => u%NacelleMotion case (AD_u_TowerMotion) @@ -6727,19 +6727,19 @@ function AD_InputMeshPointer(u, ML) result(Mesh) case (AD_u_HubMotion) Mesh => u%HubMotion case (AD_u_BladeRootMotion) - Mesh => u%BladeRootMotion(ML%i1) + Mesh => u%BladeRootMotion(DL%i1) case (AD_u_BladeMotion) - Mesh => u%BladeMotion(ML%i1) + Mesh => u%BladeMotion(DL%i1) case (AD_u_TFinMotion) Mesh => u%TFinMotion end select end function -function AD_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function AD_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (AD_u_NacelleMotion) Name = "u%NacelleMotion" case (AD_u_TowerMotion) @@ -6747,20 +6747,20 @@ function AD_InputMeshName(ML) result(Name) case (AD_u_HubMotion) Name = "u%HubMotion" case (AD_u_BladeRootMotion) - Name = "u%BladeRootMotion("//trim(Num2LStr(ML%i1))//")" + Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" case (AD_u_BladeMotion) - Name = "u%BladeMotion("//trim(Num2LStr(ML%i1))//")" + Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" case (AD_u_TFinMotion) Name = "u%TFinMotion" end select end function -function AD_OutputMeshPointer(y, ML) result(Mesh) +function AD_OutputMeshPointer(y, DL) result(Mesh) type(RotOutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (AD_y_NacelleLoad) Mesh => y%NacelleLoad case (AD_y_HubLoad) @@ -6768,17 +6768,17 @@ function AD_OutputMeshPointer(y, ML) result(Mesh) case (AD_y_TowerLoad) Mesh => y%TowerLoad case (AD_y_BladeLoad) - Mesh => y%BladeLoad(ML%i1) + Mesh => y%BladeLoad(DL%i1) case (AD_y_TFinLoad) Mesh => y%TFinLoad end select end function -function AD_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function AD_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (AD_y_NacelleLoad) Name = "y%NacelleLoad" case (AD_y_HubLoad) @@ -6786,270 +6786,252 @@ function AD_OutputMeshName(ML) result(Name) case (AD_y_TowerLoad) Name = "y%TowerLoad" case (AD_y_BladeLoad) - Name = "y%BladeLoad("//trim(Num2LStr(ML%i1))//")" + Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" case (AD_y_TFinLoad) Name = "y%TFinLoad" end select end function -subroutine AD_PackContStateVar(Var, x, ValAry) - type(RotContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AD_x_BEMT_UA_element_x) - call MV_Pack2(Var, x%BEMT%UA%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind) - call MV_Pack2(Var, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind_1) - call MV_Pack2(Var, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array - case (AD_x_BEMT_V_w) - call MV_Pack2(Var, x%BEMT%V_w, ValAry) ! Rank 1 Array - case (AD_x_AA_DummyContState) - call MV_Pack2(Var, x%AA%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AD_PackContStateAry(Vars, x, ValAry) type(RotContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call AD_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + call MV_Pack(V, x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + call MV_Pack(V, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + call MV_Pack(V, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AD_x_BEMT_V_w) + call MV_Pack(V, x%BEMT%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AD_x_AA_DummyContState) + call MV_Pack(V, x%AA%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AD_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(RotContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AD_x_BEMT_UA_element_x) - call MV_Unpack2(Var, ValAry, x%BEMT%UA%element(DL%i1, DL%i2)%x) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind) - call MV_Unpack2(Var, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind_1) - call MV_Unpack2(Var, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array - case (AD_x_BEMT_V_w) - call MV_Unpack2(Var, ValAry, x%BEMT%V_w) ! Rank 1 Array - case (AD_x_AA_DummyContState) - call MV_Unpack2(Var, ValAry, x%AA%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine AD_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(RotContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call AD_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + call MV_Unpack(V, ValAry, x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + call MV_Unpack(V, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + call MV_Unpack(V, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AD_x_BEMT_V_w) + call MV_Unpack(V, ValAry, x%BEMT%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AD_x_AA_DummyContState) + call MV_Unpack(V, ValAry, x%AA%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine AD_PackContStateDerivAry(Vars, x, ValAry) + type(RotContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + call MV_Pack(V, x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + call MV_Pack(V, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + call MV_Pack(V, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AD_x_BEMT_V_w) + call MV_Pack(V, x%BEMT%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AD_x_AA_DummyContState) + call MV_Pack(V, x%AA%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine AD_PackConstrStateVar(Var, z, ValAry) - type(RotConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AD_z_BEMT_phi) - call MV_Pack2(Var, z%BEMT%phi, ValAry) ! Rank 2 Array - case (AD_z_AA_DummyConstrState) - call MV_Pack2(Var, z%AA%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine AD_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + call MV_Unpack(V, ValAry, x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + call MV_Unpack(V, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + call MV_Unpack(V, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AD_x_BEMT_V_w) + call MV_Unpack(V, ValAry, x%BEMT%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AD_x_AA_DummyContState) + call MV_Unpack(V, ValAry, x%AA%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine AD_PackConstrStateAry(Vars, z, ValAry) type(RotConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call AD_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (AD_z_BEMT_phi) + call MV_Pack(V, z%BEMT%phi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + call MV_Pack(V, z%AA%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AD_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(RotConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AD_z_BEMT_phi) - call MV_Unpack2(Var, ValAry, z%BEMT%phi) ! Rank 2 Array - case (AD_z_AA_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%AA%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine AD_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(RotConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call AD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (AD_z_BEMT_phi) + call MV_Unpack(V, ValAry, z%BEMT%phi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + call MV_Unpack(V, ValAry, z%AA%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine AD_PackInputVar(Var, u, ValAry) - type(RotInputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AD_u_NacelleMotion) - call MV_Pack2(Var, u%NacelleMotion, ValAry) ! Mesh - case (AD_u_TowerMotion) - call MV_Pack2(Var, u%TowerMotion, ValAry) ! Mesh - case (AD_u_HubMotion) - call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh - case (AD_u_BladeRootMotion) - call MV_Pack2(Var, u%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (AD_u_BladeMotion) - call MV_Pack2(Var, u%BladeMotion(DL%i1), ValAry) ! Mesh - case (AD_u_TFinMotion) - call MV_Pack2(Var, u%TFinMotion, ValAry) ! Mesh - case (AD_u_UserProp) - call MV_Pack2(Var, u%UserProp, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AD_PackInputAry(Vars, u, ValAry) - type(RotInputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(RotInputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call AD_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (AD_u_NacelleMotion) + call MV_Pack(V, u%NacelleMotion, ValAry) ! Mesh + case (AD_u_TowerMotion) + call MV_Pack(V, u%TowerMotion, ValAry) ! Mesh + case (AD_u_HubMotion) + call MV_Pack(V, u%HubMotion, ValAry) ! Mesh + case (AD_u_BladeRootMotion) + call MV_Pack(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (AD_u_BladeMotion) + call MV_Pack(V, u%BladeMotion(DL%i1), ValAry) ! Mesh + case (AD_u_TFinMotion) + call MV_Pack(V, u%TFinMotion, ValAry) ! Mesh + case (AD_u_UserProp) + call MV_Pack(V, u%UserProp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AD_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(RotInputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AD_u_NacelleMotion) - call MV_Unpack2(Var, ValAry, u%NacelleMotion) ! Mesh - case (AD_u_TowerMotion) - call MV_Unpack2(Var, ValAry, u%TowerMotion) ! Mesh - case (AD_u_HubMotion) - call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh - case (AD_u_BladeRootMotion) - call MV_Unpack2(Var, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh - case (AD_u_BladeMotion) - call MV_Unpack2(Var, ValAry, u%BladeMotion(DL%i1)) ! Mesh - case (AD_u_TFinMotion) - call MV_Unpack2(Var, ValAry, u%TFinMotion) ! Mesh - case (AD_u_UserProp) - call MV_Unpack2(Var, ValAry, u%UserProp) ! Rank 2 Array - end select - end associate -end subroutine - subroutine AD_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(RotInputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotInputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call AD_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (AD_u_NacelleMotion) + call MV_Unpack(V, ValAry, u%NacelleMotion) ! Mesh + case (AD_u_TowerMotion) + call MV_Unpack(V, ValAry, u%TowerMotion) ! Mesh + case (AD_u_HubMotion) + call MV_Unpack(V, ValAry, u%HubMotion) ! Mesh + case (AD_u_BladeRootMotion) + call MV_Unpack(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (AD_u_BladeMotion) + call MV_Unpack(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh + case (AD_u_TFinMotion) + call MV_Unpack(V, ValAry, u%TFinMotion) ! Mesh + case (AD_u_UserProp) + call MV_Unpack(V, ValAry, u%UserProp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine - -subroutine AD_PackOutputVar(Var, y, ValAry) - type(RotOutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AD_y_NacelleLoad) - call MV_Pack2(Var, y%NacelleLoad, ValAry) ! Mesh - case (AD_y_HubLoad) - call MV_Pack2(Var, y%HubLoad, ValAry) ! Mesh - case (AD_y_TowerLoad) - call MV_Pack2(Var, y%TowerLoad, ValAry) ! Mesh - case (AD_y_BladeLoad) - call MV_Pack2(Var, y%BladeLoad(DL%i1), ValAry) ! Mesh - case (AD_y_TFinLoad) - call MV_Pack2(Var, y%TFinLoad, ValAry) ! Mesh - case (AD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AD_PackOutputAry(Vars, y, ValAry) - type(RotOutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(RotOutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call AD_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (AD_y_NacelleLoad) + call MV_Pack(V, y%NacelleLoad, ValAry) ! Mesh + case (AD_y_HubLoad) + call MV_Pack(V, y%HubLoad, ValAry) ! Mesh + case (AD_y_TowerLoad) + call MV_Pack(V, y%TowerLoad, ValAry) ! Mesh + case (AD_y_BladeLoad) + call MV_Pack(V, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (AD_y_TFinLoad) + call MV_Pack(V, y%TFinLoad, ValAry) ! Mesh + case (AD_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AD_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(RotOutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AD_y_NacelleLoad) - call MV_Unpack2(Var, ValAry, y%NacelleLoad) ! Mesh - case (AD_y_HubLoad) - call MV_Unpack2(Var, ValAry, y%HubLoad) ! Mesh - case (AD_y_TowerLoad) - call MV_Unpack2(Var, ValAry, y%TowerLoad) ! Mesh - case (AD_y_BladeLoad) - call MV_Unpack2(Var, ValAry, y%BladeLoad(DL%i1)) ! Mesh - case (AD_y_TFinLoad) - call MV_Unpack2(Var, ValAry, y%TFinLoad) ! Mesh - case (AD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine AD_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(RotOutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotOutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call AD_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (AD_y_NacelleLoad) + call MV_Unpack(V, ValAry, y%NacelleLoad) ! Mesh + case (AD_y_HubLoad) + call MV_Unpack(V, ValAry, y%HubLoad) ! Mesh + case (AD_y_TowerLoad) + call MV_Unpack(V, ValAry, y%TowerLoad) ! Mesh + case (AD_y_BladeLoad) + call MV_Unpack(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (AD_y_TFinLoad) + call MV_Unpack(V, ValAry, y%TFinLoad) ! Mesh + case (AD_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE AeroDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 5ff6a0914f..e022d2fe42 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -1461,176 +1461,144 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat u_out%c_alphaUpperWrap = a1*u1%c_alphaUpperWrap + a2*u2%c_alphaUpperWrap + a3*u3%c_alphaUpperWrap END SUBROUTINE -function AFI_InputMeshPointer(u, ML) result(Mesh) +function AFI_InputMeshPointer(u, DL) result(Mesh) type(AFI_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function AFI_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function AFI_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function AFI_OutputMeshPointer(y, ML) result(Mesh) +function AFI_OutputMeshPointer(y, DL) result(Mesh) type(AFI_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function AFI_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function AFI_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine AFI_PackInputVar(Var, u, ValAry) - type(AFI_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AFI_u_AoA) - call MV_Pack2(Var, u%AoA, ValAry) ! Scalar - case (AFI_u_UserProp) - call MV_Pack2(Var, u%UserProp, ValAry) ! Scalar - case (AFI_u_Re) - call MV_Pack2(Var, u%Re, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AFI_PackInputAry(Vars, u, ValAry) - type(AFI_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(AFI_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call AFI_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (AFI_u_AoA) + call MV_Pack(V, u%AoA, ValAry) ! Scalar + case (AFI_u_UserProp) + call MV_Pack(V, u%UserProp, ValAry) ! Scalar + case (AFI_u_Re) + call MV_Pack(V, u%Re, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AFI_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AFI_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AFI_u_AoA) - call MV_Unpack2(Var, ValAry, u%AoA) ! Scalar - case (AFI_u_UserProp) - call MV_Unpack2(Var, ValAry, u%UserProp) ! Scalar - case (AFI_u_Re) - call MV_Unpack2(Var, ValAry, u%Re) ! Scalar - end select - end associate -end subroutine - subroutine AFI_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(AFI_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call AFI_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (AFI_u_AoA) + call MV_Unpack(V, ValAry, u%AoA) ! Scalar + case (AFI_u_UserProp) + call MV_Unpack(V, ValAry, u%UserProp) ! Scalar + case (AFI_u_Re) + call MV_Unpack(V, ValAry, u%Re) ! Scalar + end select + end associate end do end subroutine - -subroutine AFI_PackOutputVar(Var, y, ValAry) - type(AFI_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AFI_y_Cl) - call MV_Pack2(Var, y%Cl, ValAry) ! Scalar - case (AFI_y_Cd) - call MV_Pack2(Var, y%Cd, ValAry) ! Scalar - case (AFI_y_Cm) - call MV_Pack2(Var, y%Cm, ValAry) ! Scalar - case (AFI_y_Cpmin) - call MV_Pack2(Var, y%Cpmin, ValAry) ! Scalar - case (AFI_y_Cd0) - call MV_Pack2(Var, y%Cd0, ValAry) ! Scalar - case (AFI_y_Cm0) - call MV_Pack2(Var, y%Cm0, ValAry) ! Scalar - case (AFI_y_f_st) - call MV_Pack2(Var, y%f_st, ValAry) ! Scalar - case (AFI_y_FullySeparate) - call MV_Pack2(Var, y%FullySeparate, ValAry) ! Scalar - case (AFI_y_FullyAttached) - call MV_Pack2(Var, y%FullyAttached, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AFI_PackOutputAry(Vars, y, ValAry) - type(AFI_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(AFI_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call AFI_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (AFI_y_Cl) + call MV_Pack(V, y%Cl, ValAry) ! Scalar + case (AFI_y_Cd) + call MV_Pack(V, y%Cd, ValAry) ! Scalar + case (AFI_y_Cm) + call MV_Pack(V, y%Cm, ValAry) ! Scalar + case (AFI_y_Cpmin) + call MV_Pack(V, y%Cpmin, ValAry) ! Scalar + case (AFI_y_Cd0) + call MV_Pack(V, y%Cd0, ValAry) ! Scalar + case (AFI_y_Cm0) + call MV_Pack(V, y%Cm0, ValAry) ! Scalar + case (AFI_y_f_st) + call MV_Pack(V, y%f_st, ValAry) ! Scalar + case (AFI_y_FullySeparate) + call MV_Pack(V, y%FullySeparate, ValAry) ! Scalar + case (AFI_y_FullyAttached) + call MV_Pack(V, y%FullyAttached, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AFI_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AFI_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AFI_y_Cl) - call MV_Unpack2(Var, ValAry, y%Cl) ! Scalar - case (AFI_y_Cd) - call MV_Unpack2(Var, ValAry, y%Cd) ! Scalar - case (AFI_y_Cm) - call MV_Unpack2(Var, ValAry, y%Cm) ! Scalar - case (AFI_y_Cpmin) - call MV_Unpack2(Var, ValAry, y%Cpmin) ! Scalar - case (AFI_y_Cd0) - call MV_Unpack2(Var, ValAry, y%Cd0) ! Scalar - case (AFI_y_Cm0) - call MV_Unpack2(Var, ValAry, y%Cm0) ! Scalar - case (AFI_y_f_st) - call MV_Unpack2(Var, ValAry, y%f_st) ! Scalar - case (AFI_y_FullySeparate) - call MV_Unpack2(Var, ValAry, y%FullySeparate) ! Scalar - case (AFI_y_FullyAttached) - call MV_Unpack2(Var, ValAry, y%FullyAttached) ! Scalar - end select - end associate -end subroutine - subroutine AFI_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(AFI_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call AFI_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (AFI_y_Cl) + call MV_Unpack(V, ValAry, y%Cl) ! Scalar + case (AFI_y_Cd) + call MV_Unpack(V, ValAry, y%Cd) ! Scalar + case (AFI_y_Cm) + call MV_Unpack(V, ValAry, y%Cm) ! Scalar + case (AFI_y_Cpmin) + call MV_Unpack(V, ValAry, y%Cpmin) ! Scalar + case (AFI_y_Cd0) + call MV_Unpack(V, ValAry, y%Cd0) ! Scalar + case (AFI_y_Cm0) + call MV_Unpack(V, ValAry, y%Cm0) ! Scalar + case (AFI_y_f_st) + call MV_Unpack(V, ValAry, y%f_st) ! Scalar + case (AFI_y_FullySeparate) + call MV_Unpack(V, ValAry, y%FullySeparate) ! Scalar + case (AFI_y_FullyAttached) + call MV_Unpack(V, ValAry, y%FullyAttached) ! Scalar + end select + end associate end do end subroutine END MODULE AirfoilInfo_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 993dee9f85..5efcec001a 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -2700,402 +2700,380 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E END IF ! check if allocated END SUBROUTINE -function BEMT_InputMeshPointer(u, ML) result(Mesh) +function BEMT_InputMeshPointer(u, DL) result(Mesh) type(BEMT_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function BEMT_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function BEMT_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function BEMT_OutputMeshPointer(y, ML) result(Mesh) +function BEMT_OutputMeshPointer(y, DL) result(Mesh) type(BEMT_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function BEMT_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function BEMT_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine BEMT_PackContStateVar(Var, x, ValAry) - type(BEMT_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BEMT_x_UA_element_x) - call MV_Pack2(Var, x%UA%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind) - call MV_Pack2(Var, x%DBEMT%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind_1) - call MV_Pack2(Var, x%DBEMT%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array - case (BEMT_x_V_w) - call MV_Pack2(Var, x%V_w, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine BEMT_PackContStateAry(Vars, x, ValAry) type(BEMT_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call BEMT_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (BEMT_x_UA_element_x) + call MV_Pack(V, x%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + call MV_Pack(V, x%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + call MV_Pack(V, x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_x_V_w) + call MV_Pack(V, x%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine BEMT_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(BEMT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BEMT_x_UA_element_x) - call MV_Unpack2(Var, ValAry, x%UA%element(DL%i1, DL%i2)%x) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind) - call MV_Unpack2(Var, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind_1) - call MV_Unpack2(Var, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array - case (BEMT_x_V_w) - call MV_Unpack2(Var, ValAry, x%V_w) ! Rank 1 Array - end select - end associate -end subroutine - subroutine BEMT_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(BEMT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call BEMT_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (BEMT_x_UA_element_x) + call MV_Unpack(V, ValAry, x%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + call MV_Unpack(V, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + call MV_Unpack(V, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_x_V_w) + call MV_Unpack(V, ValAry, x%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine BEMT_PackContStateDerivAry(Vars, x, ValAry) + type(BEMT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (BEMT_x_UA_element_x) + call MV_Pack(V, x%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + call MV_Pack(V, x%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + call MV_Pack(V, x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_x_V_w) + call MV_Pack(V, x%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine BEMT_PackConstrStateVar(Var, z, ValAry) - type(BEMT_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BEMT_z_phi) - call MV_Pack2(Var, z%phi, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine BEMT_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (BEMT_x_UA_element_x) + call MV_Unpack(V, ValAry, x%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + call MV_Unpack(V, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + call MV_Unpack(V, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_x_V_w) + call MV_Unpack(V, ValAry, x%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine BEMT_PackConstrStateAry(Vars, z, ValAry) type(BEMT_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call BEMT_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (BEMT_z_phi) + call MV_Pack(V, z%phi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine BEMT_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(BEMT_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BEMT_z_phi) - call MV_Unpack2(Var, ValAry, z%phi) ! Rank 2 Array - end select - end associate -end subroutine - subroutine BEMT_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(BEMT_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call BEMT_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (BEMT_z_phi) + call MV_Unpack(V, ValAry, z%phi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine - -subroutine BEMT_PackInputVar(Var, u, ValAry) - type(BEMT_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BEMT_u_theta) - call MV_Pack2(Var, u%theta, ValAry) ! Rank 2 Array - case (BEMT_u_chi0) - call MV_Pack2(Var, u%chi0, ValAry) ! Scalar - case (BEMT_u_psiSkewOffset) - call MV_Pack2(Var, u%psiSkewOffset, ValAry) ! Scalar - case (BEMT_u_psi_s) - call MV_Pack2(Var, u%psi_s, ValAry) ! Rank 1 Array - case (BEMT_u_omega) - call MV_Pack2(Var, u%omega, ValAry) ! Scalar - case (BEMT_u_TSR) - call MV_Pack2(Var, u%TSR, ValAry) ! Scalar - case (BEMT_u_Vx) - call MV_Pack2(Var, u%Vx, ValAry) ! Rank 2 Array - case (BEMT_u_Vy) - call MV_Pack2(Var, u%Vy, ValAry) ! Rank 2 Array - case (BEMT_u_Vz) - call MV_Pack2(Var, u%Vz, ValAry) ! Rank 2 Array - case (BEMT_u_omega_z) - call MV_Pack2(Var, u%omega_z, ValAry) ! Rank 2 Array - case (BEMT_u_xVelCorr) - call MV_Pack2(Var, u%xVelCorr, ValAry) ! Rank 2 Array - case (BEMT_u_rLocal) - call MV_Pack2(Var, u%rLocal, ValAry) ! Rank 2 Array - case (BEMT_u_Un_disk) - call MV_Pack2(Var, u%Un_disk, ValAry) ! Scalar - case (BEMT_u_V0) - call MV_Pack2(Var, u%V0, ValAry) ! Rank 1 Array - case (BEMT_u_x_hat_disk) - call MV_Pack2(Var, u%x_hat_disk, ValAry) ! Rank 1 Array - case (BEMT_u_UserProp) - call MV_Pack2(Var, u%UserProp, ValAry) ! Rank 2 Array - case (BEMT_u_CantAngle) - call MV_Pack2(Var, u%CantAngle, ValAry) ! Rank 2 Array - case (BEMT_u_drdz) - call MV_Pack2(Var, u%drdz, ValAry) ! Rank 2 Array - case (BEMT_u_toeAngle) - call MV_Pack2(Var, u%toeAngle, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine BEMT_PackInputAry(Vars, u, ValAry) - type(BEMT_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(BEMT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call BEMT_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (BEMT_u_theta) + call MV_Pack(V, u%theta(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_chi0) + call MV_Pack(V, u%chi0, ValAry) ! Scalar + case (BEMT_u_psiSkewOffset) + call MV_Pack(V, u%psiSkewOffset, ValAry) ! Scalar + case (BEMT_u_psi_s) + call MV_Pack(V, u%psi_s(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_u_omega) + call MV_Pack(V, u%omega, ValAry) ! Scalar + case (BEMT_u_TSR) + call MV_Pack(V, u%TSR, ValAry) ! Scalar + case (BEMT_u_Vx) + call MV_Pack(V, u%Vx(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_Vy) + call MV_Pack(V, u%Vy(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_Vz) + call MV_Pack(V, u%Vz(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_omega_z) + call MV_Pack(V, u%omega_z(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_xVelCorr) + call MV_Pack(V, u%xVelCorr(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_rLocal) + call MV_Pack(V, u%rLocal(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_Un_disk) + call MV_Pack(V, u%Un_disk, ValAry) ! Scalar + case (BEMT_u_V0) + call MV_Pack(V, u%V0(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_u_x_hat_disk) + call MV_Pack(V, u%x_hat_disk(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (BEMT_u_UserProp) + call MV_Pack(V, u%UserProp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_CantAngle) + call MV_Pack(V, u%CantAngle(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_drdz) + call MV_Pack(V, u%drdz(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_u_toeAngle) + call MV_Pack(V, u%toeAngle(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine BEMT_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(BEMT_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BEMT_u_theta) - call MV_Unpack2(Var, ValAry, u%theta) ! Rank 2 Array - case (BEMT_u_chi0) - call MV_Unpack2(Var, ValAry, u%chi0) ! Scalar - case (BEMT_u_psiSkewOffset) - call MV_Unpack2(Var, ValAry, u%psiSkewOffset) ! Scalar - case (BEMT_u_psi_s) - call MV_Unpack2(Var, ValAry, u%psi_s) ! Rank 1 Array - case (BEMT_u_omega) - call MV_Unpack2(Var, ValAry, u%omega) ! Scalar - case (BEMT_u_TSR) - call MV_Unpack2(Var, ValAry, u%TSR) ! Scalar - case (BEMT_u_Vx) - call MV_Unpack2(Var, ValAry, u%Vx) ! Rank 2 Array - case (BEMT_u_Vy) - call MV_Unpack2(Var, ValAry, u%Vy) ! Rank 2 Array - case (BEMT_u_Vz) - call MV_Unpack2(Var, ValAry, u%Vz) ! Rank 2 Array - case (BEMT_u_omega_z) - call MV_Unpack2(Var, ValAry, u%omega_z) ! Rank 2 Array - case (BEMT_u_xVelCorr) - call MV_Unpack2(Var, ValAry, u%xVelCorr) ! Rank 2 Array - case (BEMT_u_rLocal) - call MV_Unpack2(Var, ValAry, u%rLocal) ! Rank 2 Array - case (BEMT_u_Un_disk) - call MV_Unpack2(Var, ValAry, u%Un_disk) ! Scalar - case (BEMT_u_V0) - call MV_Unpack2(Var, ValAry, u%V0) ! Rank 1 Array - case (BEMT_u_x_hat_disk) - call MV_Unpack2(Var, ValAry, u%x_hat_disk) ! Rank 1 Array - case (BEMT_u_UserProp) - call MV_Unpack2(Var, ValAry, u%UserProp) ! Rank 2 Array - case (BEMT_u_CantAngle) - call MV_Unpack2(Var, ValAry, u%CantAngle) ! Rank 2 Array - case (BEMT_u_drdz) - call MV_Unpack2(Var, ValAry, u%drdz) ! Rank 2 Array - case (BEMT_u_toeAngle) - call MV_Unpack2(Var, ValAry, u%toeAngle) ! Rank 2 Array - end select - end associate -end subroutine - subroutine BEMT_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(BEMT_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call BEMT_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (BEMT_u_theta) + call MV_Unpack(V, ValAry, u%theta(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_chi0) + call MV_Unpack(V, ValAry, u%chi0) ! Scalar + case (BEMT_u_psiSkewOffset) + call MV_Unpack(V, ValAry, u%psiSkewOffset) ! Scalar + case (BEMT_u_psi_s) + call MV_Unpack(V, ValAry, u%psi_s(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_u_omega) + call MV_Unpack(V, ValAry, u%omega) ! Scalar + case (BEMT_u_TSR) + call MV_Unpack(V, ValAry, u%TSR) ! Scalar + case (BEMT_u_Vx) + call MV_Unpack(V, ValAry, u%Vx(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_Vy) + call MV_Unpack(V, ValAry, u%Vy(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_Vz) + call MV_Unpack(V, ValAry, u%Vz(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_omega_z) + call MV_Unpack(V, ValAry, u%omega_z(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_xVelCorr) + call MV_Unpack(V, ValAry, u%xVelCorr(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_rLocal) + call MV_Unpack(V, ValAry, u%rLocal(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_Un_disk) + call MV_Unpack(V, ValAry, u%Un_disk) ! Scalar + case (BEMT_u_V0) + call MV_Unpack(V, ValAry, u%V0(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_u_x_hat_disk) + call MV_Unpack(V, ValAry, u%x_hat_disk(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (BEMT_u_UserProp) + call MV_Unpack(V, ValAry, u%UserProp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_CantAngle) + call MV_Unpack(V, ValAry, u%CantAngle(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_drdz) + call MV_Unpack(V, ValAry, u%drdz(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_u_toeAngle) + call MV_Unpack(V, ValAry, u%toeAngle(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine - -subroutine BEMT_PackOutputVar(Var, y, ValAry) - type(BEMT_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BEMT_y_Vrel) - call MV_Pack2(Var, y%Vrel, ValAry) ! Rank 2 Array - case (BEMT_y_phi) - call MV_Pack2(Var, y%phi, ValAry) ! Rank 2 Array - case (BEMT_y_axInduction) - call MV_Pack2(Var, y%axInduction, ValAry) ! Rank 2 Array - case (BEMT_y_tanInduction) - call MV_Pack2(Var, y%tanInduction, ValAry) ! Rank 2 Array - case (BEMT_y_axInduction_qs) - call MV_Pack2(Var, y%axInduction_qs, ValAry) ! Rank 2 Array - case (BEMT_y_tanInduction_qs) - call MV_Pack2(Var, y%tanInduction_qs, ValAry) ! Rank 2 Array - case (BEMT_y_k) - call MV_Pack2(Var, y%k, ValAry) ! Rank 2 Array - case (BEMT_y_k_p) - call MV_Pack2(Var, y%k_p, ValAry) ! Rank 2 Array - case (BEMT_y_F) - call MV_Pack2(Var, y%F, ValAry) ! Rank 2 Array - case (BEMT_y_Re) - call MV_Pack2(Var, y%Re, ValAry) ! Rank 2 Array - case (BEMT_y_AOA) - call MV_Pack2(Var, y%AOA, ValAry) ! Rank 2 Array - case (BEMT_y_Cx) - call MV_Pack2(Var, y%Cx, ValAry) ! Rank 2 Array - case (BEMT_y_Cy) - call MV_Pack2(Var, y%Cy, ValAry) ! Rank 2 Array - case (BEMT_y_Cz) - call MV_Pack2(Var, y%Cz, ValAry) ! Rank 2 Array - case (BEMT_y_Cmx) - call MV_Pack2(Var, y%Cmx, ValAry) ! Rank 2 Array - case (BEMT_y_Cmy) - call MV_Pack2(Var, y%Cmy, ValAry) ! Rank 2 Array - case (BEMT_y_Cmz) - call MV_Pack2(Var, y%Cmz, ValAry) ! Rank 2 Array - case (BEMT_y_Cm) - call MV_Pack2(Var, y%Cm, ValAry) ! Rank 2 Array - case (BEMT_y_Cl) - call MV_Pack2(Var, y%Cl, ValAry) ! Rank 2 Array - case (BEMT_y_Cd) - call MV_Pack2(Var, y%Cd, ValAry) ! Rank 2 Array - case (BEMT_y_chi) - call MV_Pack2(Var, y%chi, ValAry) ! Rank 2 Array - case (BEMT_y_Cpmin) - call MV_Pack2(Var, y%Cpmin, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine BEMT_PackOutputAry(Vars, y, ValAry) - type(BEMT_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(BEMT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call BEMT_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (BEMT_y_Vrel) + call MV_Pack(V, y%Vrel(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_phi) + call MV_Pack(V, y%phi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_axInduction) + call MV_Pack(V, y%axInduction(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_tanInduction) + call MV_Pack(V, y%tanInduction(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_axInduction_qs) + call MV_Pack(V, y%axInduction_qs(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + call MV_Pack(V, y%tanInduction_qs(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_k) + call MV_Pack(V, y%k(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_k_p) + call MV_Pack(V, y%k_p(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_F) + call MV_Pack(V, y%F(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Re) + call MV_Pack(V, y%Re(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_AOA) + call MV_Pack(V, y%AOA(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cx) + call MV_Pack(V, y%Cx(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cy) + call MV_Pack(V, y%Cy(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cz) + call MV_Pack(V, y%Cz(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cmx) + call MV_Pack(V, y%Cmx(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cmy) + call MV_Pack(V, y%Cmy(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cmz) + call MV_Pack(V, y%Cmz(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cm) + call MV_Pack(V, y%Cm(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cl) + call MV_Pack(V, y%Cl(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cd) + call MV_Pack(V, y%Cd(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_chi) + call MV_Pack(V, y%chi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BEMT_y_Cpmin) + call MV_Pack(V, y%Cpmin(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine BEMT_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(BEMT_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BEMT_y_Vrel) - call MV_Unpack2(Var, ValAry, y%Vrel) ! Rank 2 Array - case (BEMT_y_phi) - call MV_Unpack2(Var, ValAry, y%phi) ! Rank 2 Array - case (BEMT_y_axInduction) - call MV_Unpack2(Var, ValAry, y%axInduction) ! Rank 2 Array - case (BEMT_y_tanInduction) - call MV_Unpack2(Var, ValAry, y%tanInduction) ! Rank 2 Array - case (BEMT_y_axInduction_qs) - call MV_Unpack2(Var, ValAry, y%axInduction_qs) ! Rank 2 Array - case (BEMT_y_tanInduction_qs) - call MV_Unpack2(Var, ValAry, y%tanInduction_qs) ! Rank 2 Array - case (BEMT_y_k) - call MV_Unpack2(Var, ValAry, y%k) ! Rank 2 Array - case (BEMT_y_k_p) - call MV_Unpack2(Var, ValAry, y%k_p) ! Rank 2 Array - case (BEMT_y_F) - call MV_Unpack2(Var, ValAry, y%F) ! Rank 2 Array - case (BEMT_y_Re) - call MV_Unpack2(Var, ValAry, y%Re) ! Rank 2 Array - case (BEMT_y_AOA) - call MV_Unpack2(Var, ValAry, y%AOA) ! Rank 2 Array - case (BEMT_y_Cx) - call MV_Unpack2(Var, ValAry, y%Cx) ! Rank 2 Array - case (BEMT_y_Cy) - call MV_Unpack2(Var, ValAry, y%Cy) ! Rank 2 Array - case (BEMT_y_Cz) - call MV_Unpack2(Var, ValAry, y%Cz) ! Rank 2 Array - case (BEMT_y_Cmx) - call MV_Unpack2(Var, ValAry, y%Cmx) ! Rank 2 Array - case (BEMT_y_Cmy) - call MV_Unpack2(Var, ValAry, y%Cmy) ! Rank 2 Array - case (BEMT_y_Cmz) - call MV_Unpack2(Var, ValAry, y%Cmz) ! Rank 2 Array - case (BEMT_y_Cm) - call MV_Unpack2(Var, ValAry, y%Cm) ! Rank 2 Array - case (BEMT_y_Cl) - call MV_Unpack2(Var, ValAry, y%Cl) ! Rank 2 Array - case (BEMT_y_Cd) - call MV_Unpack2(Var, ValAry, y%Cd) ! Rank 2 Array - case (BEMT_y_chi) - call MV_Unpack2(Var, ValAry, y%chi) ! Rank 2 Array - case (BEMT_y_Cpmin) - call MV_Unpack2(Var, ValAry, y%Cpmin) ! Rank 2 Array - end select - end associate -end subroutine - subroutine BEMT_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(BEMT_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call BEMT_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (BEMT_y_Vrel) + call MV_Unpack(V, ValAry, y%Vrel(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_phi) + call MV_Unpack(V, ValAry, y%phi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_axInduction) + call MV_Unpack(V, ValAry, y%axInduction(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_tanInduction) + call MV_Unpack(V, ValAry, y%tanInduction(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_axInduction_qs) + call MV_Unpack(V, ValAry, y%axInduction_qs(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + call MV_Unpack(V, ValAry, y%tanInduction_qs(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_k) + call MV_Unpack(V, ValAry, y%k(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_k_p) + call MV_Unpack(V, ValAry, y%k_p(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_F) + call MV_Unpack(V, ValAry, y%F(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Re) + call MV_Unpack(V, ValAry, y%Re(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_AOA) + call MV_Unpack(V, ValAry, y%AOA(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cx) + call MV_Unpack(V, ValAry, y%Cx(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cy) + call MV_Unpack(V, ValAry, y%Cy(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cz) + call MV_Unpack(V, ValAry, y%Cz(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cmx) + call MV_Unpack(V, ValAry, y%Cmx(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cmy) + call MV_Unpack(V, ValAry, y%Cmy(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cmz) + call MV_Unpack(V, ValAry, y%Cmz(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cm) + call MV_Unpack(V, ValAry, y%Cm(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cl) + call MV_Unpack(V, ValAry, y%Cl(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cd) + call MV_Unpack(V, ValAry, y%Cd(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_chi) + call MV_Unpack(V, ValAry, y%chi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (BEMT_y_Cpmin) + call MV_Unpack(V, ValAry, y%Cpmin(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine END MODULE BEMT_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 33cb9ddea5..2705f8a402 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -1425,254 +1425,224 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, END IF ! check if allocated END SUBROUTINE -function DBEMT_InputMeshPointer(u, ML) result(Mesh) +function DBEMT_InputMeshPointer(u, DL) result(Mesh) type(DBEMT_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function DBEMT_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function DBEMT_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function DBEMT_OutputMeshPointer(y, ML) result(Mesh) +function DBEMT_OutputMeshPointer(y, DL) result(Mesh) type(DBEMT_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function DBEMT_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function DBEMT_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine DBEMT_PackContStateVar(Var, x, ValAry) - type(DBEMT_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (DBEMT_x_element_vind) - call MV_Pack2(Var, x%element(DL%i1, DL%i2)%vind, ValAry) ! Rank 1 Array - case (DBEMT_x_element_vind_1) - call MV_Pack2(Var, x%element(DL%i1, DL%i2)%vind_1, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine DBEMT_PackContStateAry(Vars, x, ValAry) type(DBEMT_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call DBEMT_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (DBEMT_x_element_vind) + call MV_Pack(V, x%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + call MV_Pack(V, x%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine DBEMT_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(DBEMT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (DBEMT_x_element_vind) - call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%vind) ! Rank 1 Array - case (DBEMT_x_element_vind_1) - call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%vind_1) ! Rank 1 Array - end select - end associate -end subroutine - subroutine DBEMT_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call DBEMT_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (DBEMT_x_element_vind) + call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine DBEMT_PackContStateDerivAry(Vars, x, ValAry) + type(DBEMT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (DBEMT_x_element_vind) + call MV_Pack(V, x%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + call MV_Pack(V, x%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine DBEMT_PackConstrStateVar(Var, z, ValAry) - type(DBEMT_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (DBEMT_z_DummyState) - call MV_Pack2(Var, z%DummyState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine DBEMT_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (DBEMT_x_element_vind) + call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine DBEMT_PackConstrStateAry(Vars, z, ValAry) type(DBEMT_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call DBEMT_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (DBEMT_z_DummyState) + call MV_Pack(V, z%DummyState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine DBEMT_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(DBEMT_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (DBEMT_z_DummyState) - call MV_Unpack2(Var, ValAry, z%DummyState) ! Scalar - end select - end associate -end subroutine - subroutine DBEMT_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call DBEMT_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (DBEMT_z_DummyState) + call MV_Unpack(V, ValAry, z%DummyState) ! Scalar + end select + end associate end do end subroutine - -subroutine DBEMT_PackInputVar(Var, u, ValAry) - type(DBEMT_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (DBEMT_u_AxInd_disk) - call MV_Pack2(Var, u%AxInd_disk, ValAry) ! Scalar - case (DBEMT_u_Un_disk) - call MV_Pack2(Var, u%Un_disk, ValAry) ! Scalar - case (DBEMT_u_R_disk) - call MV_Pack2(Var, u%R_disk, ValAry) ! Scalar - case (DBEMT_u_element_vind_s) - call MV_Pack2(Var, u%element(DL%i1, DL%i2)%vind_s, ValAry) ! Rank 1 Array - case (DBEMT_u_element_spanRatio) - call MV_Pack2(Var, u%element(DL%i1, DL%i2)%spanRatio, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine DBEMT_PackInputAry(Vars, u, ValAry) - type(DBEMT_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(DBEMT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call DBEMT_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (DBEMT_u_AxInd_disk) + call MV_Pack(V, u%AxInd_disk, ValAry) ! Scalar + case (DBEMT_u_Un_disk) + call MV_Pack(V, u%Un_disk, ValAry) ! Scalar + case (DBEMT_u_R_disk) + call MV_Pack(V, u%R_disk, ValAry) ! Scalar + case (DBEMT_u_element_vind_s) + call MV_Pack(V, u%element(DL%i1, DL%i2)%vind_s(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + call MV_Pack(V, u%element(DL%i1, DL%i2)%spanRatio, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine DBEMT_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(DBEMT_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (DBEMT_u_AxInd_disk) - call MV_Unpack2(Var, ValAry, u%AxInd_disk) ! Scalar - case (DBEMT_u_Un_disk) - call MV_Unpack2(Var, ValAry, u%Un_disk) ! Scalar - case (DBEMT_u_R_disk) - call MV_Unpack2(Var, ValAry, u%R_disk) ! Scalar - case (DBEMT_u_element_vind_s) - call MV_Unpack2(Var, ValAry, u%element(DL%i1, DL%i2)%vind_s) ! Rank 1 Array - case (DBEMT_u_element_spanRatio) - call MV_Unpack2(Var, ValAry, u%element(DL%i1, DL%i2)%spanRatio) ! Scalar - end select - end associate -end subroutine - subroutine DBEMT_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(DBEMT_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call DBEMT_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (DBEMT_u_AxInd_disk) + call MV_Unpack(V, ValAry, u%AxInd_disk) ! Scalar + case (DBEMT_u_Un_disk) + call MV_Unpack(V, ValAry, u%Un_disk) ! Scalar + case (DBEMT_u_R_disk) + call MV_Unpack(V, ValAry, u%R_disk) ! Scalar + case (DBEMT_u_element_vind_s) + call MV_Unpack(V, ValAry, u%element(DL%i1, DL%i2)%vind_s(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + call MV_Unpack(V, ValAry, u%element(DL%i1, DL%i2)%spanRatio) ! Scalar + end select + end associate end do end subroutine - -subroutine DBEMT_PackOutputVar(Var, y, ValAry) - type(DBEMT_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (DBEMT_y_vind) - call MV_Pack2(Var, y%vind, ValAry) ! Rank 3 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine DBEMT_PackOutputAry(Vars, y, ValAry) - type(DBEMT_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(DBEMT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call DBEMT_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (DBEMT_y_vind) + call MV_Pack(V, y%vind(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine DBEMT_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(DBEMT_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (DBEMT_y_vind) - call MV_Unpack2(Var, ValAry, y%vind) ! Rank 3 Array - end select - end associate -end subroutine - subroutine DBEMT_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(DBEMT_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call DBEMT_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (DBEMT_y_vind) + call MV_Unpack(V, ValAry, y%vind(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + end select + end associate end do end subroutine END MODULE DBEMT_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 230b91a91e..e3dda1a05f 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -4105,286 +4105,276 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er END IF ! check if allocated END SUBROUTINE -function FVW_InputMeshPointer(u, ML) result(Mesh) +function FVW_InputMeshPointer(u, DL) result(Mesh) type(FVW_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (FVW_u_WingsMesh) - Mesh => u%WingsMesh(ML%i1) + Mesh => u%WingsMesh(DL%i1) end select end function -function FVW_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function FVW_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (FVW_u_WingsMesh) - Name = "u%WingsMesh("//trim(Num2LStr(ML%i1))//")" + Name = "u%WingsMesh("//trim(Num2LStr(DL%i1))//")" end select end function -function FVW_OutputMeshPointer(y, ML) result(Mesh) +function FVW_OutputMeshPointer(y, DL) result(Mesh) type(FVW_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function FVW_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function FVW_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine FVW_PackContStateVar(Var, x, ValAry) - type(FVW_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FVW_x_W_Gamma_NW) - call MV_Pack2(Var, x%W(DL%i1)%Gamma_NW, ValAry) ! Rank 2 Array - case (FVW_x_W_Gamma_FW) - call MV_Pack2(Var, x%W(DL%i1)%Gamma_FW, ValAry) ! Rank 2 Array - case (FVW_x_W_Eps_NW) - call MV_Pack2(Var, x%W(DL%i1)%Eps_NW, ValAry) ! Rank 3 Array - case (FVW_x_W_Eps_FW) - call MV_Pack2(Var, x%W(DL%i1)%Eps_FW, ValAry) ! Rank 3 Array - case (FVW_x_W_r_NW) - call MV_Pack2(Var, x%W(DL%i1)%r_NW, ValAry) ! Rank 3 Array - case (FVW_x_W_r_FW) - call MV_Pack2(Var, x%W(DL%i1)%r_FW, ValAry) ! Rank 3 Array - case (FVW_x_UA_element_x) - call MV_Pack2(Var, x%UA(DL%i1)%element(DL%i2, DL%i3)%x, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine FVW_PackContStateAry(Vars, x, ValAry) type(FVW_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call FVW_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + call MV_Pack(V, x%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + call MV_Pack(V, x%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + call MV_Pack(V, x%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + call MV_Pack(V, x%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (FVW_x_W_r_NW) + call MV_Pack(V, x%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (FVW_x_W_r_FW) + call MV_Pack(V, x%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (FVW_x_UA_element_x) + call MV_Pack(V, x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine FVW_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(FVW_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FVW_x_W_Gamma_NW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Gamma_NW) ! Rank 2 Array - case (FVW_x_W_Gamma_FW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Gamma_FW) ! Rank 2 Array - case (FVW_x_W_Eps_NW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Eps_NW) ! Rank 3 Array - case (FVW_x_W_Eps_FW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%Eps_FW) ! Rank 3 Array - case (FVW_x_W_r_NW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%r_NW) ! Rank 3 Array - case (FVW_x_W_r_FW) - call MV_Unpack2(Var, ValAry, x%W(DL%i1)%r_FW) ! Rank 3 Array - case (FVW_x_UA_element_x) - call MV_Unpack2(Var, ValAry, x%UA(DL%i1)%element(DL%i2, DL%i3)%x) ! Rank 1 Array - end select - end associate -end subroutine - subroutine FVW_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(FVW_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call FVW_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (FVW_x_W_r_NW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (FVW_x_W_r_FW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (FVW_x_UA_element_x) + call MV_Unpack(V, ValAry, x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine FVW_PackContStateDerivAry(Vars, x, ValAry) + type(FVW_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + call MV_Pack(V, x%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + call MV_Pack(V, x%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + call MV_Pack(V, x%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + call MV_Pack(V, x%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (FVW_x_W_r_NW) + call MV_Pack(V, x%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (FVW_x_W_r_FW) + call MV_Pack(V, x%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (FVW_x_UA_element_x) + call MV_Pack(V, x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine FVW_PackConstrStateVar(Var, z, ValAry) - type(FVW_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FVW_z_W_Gamma_LL) - call MV_Pack2(Var, z%W(DL%i1)%Gamma_LL, ValAry) ! Rank 1 Array - case (FVW_z_residual) - call MV_Pack2(Var, z%residual, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine FVW_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (FVW_x_W_r_NW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (FVW_x_W_r_FW) + call MV_Unpack(V, ValAry, x%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (FVW_x_UA_element_x) + call MV_Unpack(V, ValAry, x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine FVW_PackConstrStateAry(Vars, z, ValAry) type(FVW_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call FVW_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (FVW_z_W_Gamma_LL) + call MV_Pack(V, z%W(DL%i1)%Gamma_LL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (FVW_z_residual) + call MV_Pack(V, z%residual, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine FVW_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(FVW_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FVW_z_W_Gamma_LL) - call MV_Unpack2(Var, ValAry, z%W(DL%i1)%Gamma_LL) ! Rank 1 Array - case (FVW_z_residual) - call MV_Unpack2(Var, ValAry, z%residual) ! Scalar - end select - end associate -end subroutine - subroutine FVW_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(FVW_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call FVW_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (FVW_z_W_Gamma_LL) + call MV_Unpack(V, ValAry, z%W(DL%i1)%Gamma_LL(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (FVW_z_residual) + call MV_Unpack(V, ValAry, z%residual) ! Scalar + end select + end associate end do end subroutine - -subroutine FVW_PackInputVar(Var, u, ValAry) - type(FVW_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FVW_u_rotors_HubOrientation) - call MV_Pack2(Var, u%rotors(DL%i1)%HubOrientation, ValAry) ! Rank 2 Array - case (FVW_u_rotors_HubPosition) - call MV_Pack2(Var, u%rotors(DL%i1)%HubPosition, ValAry) ! Rank 1 Array - case (FVW_u_W_Vwnd_LL) - call MV_Pack2(Var, u%W(DL%i1)%Vwnd_LL, ValAry) ! Rank 2 Array - case (FVW_u_W_omega_z) - call MV_Pack2(Var, u%W(DL%i1)%omega_z, ValAry) ! Rank 1 Array - case (FVW_u_WingsMesh) - call MV_Pack2(Var, u%WingsMesh(DL%i1), ValAry) ! Mesh - case (FVW_u_V_wind) - call MV_Pack2(Var, u%V_wind, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine FVW_PackInputAry(Vars, u, ValAry) - type(FVW_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(FVW_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call FVW_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (FVW_u_rotors_HubOrientation) + call MV_Pack(V, u%rotors(DL%i1)%HubOrientation(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + call MV_Pack(V, u%rotors(DL%i1)%HubPosition(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + call MV_Pack(V, u%W(DL%i1)%Vwnd_LL(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (FVW_u_W_omega_z) + call MV_Pack(V, u%W(DL%i1)%omega_z(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_Pack(V, u%WingsMesh(DL%i1), ValAry) ! Mesh + case (FVW_u_V_wind) + call MV_Pack(V, u%V_wind(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine FVW_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(FVW_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FVW_u_rotors_HubOrientation) - call MV_Unpack2(Var, ValAry, u%rotors(DL%i1)%HubOrientation) ! Rank 2 Array - case (FVW_u_rotors_HubPosition) - call MV_Unpack2(Var, ValAry, u%rotors(DL%i1)%HubPosition) ! Rank 1 Array - case (FVW_u_W_Vwnd_LL) - call MV_Unpack2(Var, ValAry, u%W(DL%i1)%Vwnd_LL) ! Rank 2 Array - case (FVW_u_W_omega_z) - call MV_Unpack2(Var, ValAry, u%W(DL%i1)%omega_z) ! Rank 1 Array - case (FVW_u_WingsMesh) - call MV_Unpack2(Var, ValAry, u%WingsMesh(DL%i1)) ! Mesh - case (FVW_u_V_wind) - call MV_Unpack2(Var, ValAry, u%V_wind) ! Rank 2 Array - end select - end associate -end subroutine - subroutine FVW_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(FVW_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call FVW_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (FVW_u_rotors_HubOrientation) + call MV_Unpack(V, ValAry, u%rotors(DL%i1)%HubOrientation(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + call MV_Unpack(V, ValAry, u%rotors(DL%i1)%HubPosition(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + call MV_Unpack(V, ValAry, u%W(DL%i1)%Vwnd_LL(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (FVW_u_W_omega_z) + call MV_Unpack(V, ValAry, u%W(DL%i1)%omega_z(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_Unpack(V, ValAry, u%WingsMesh(DL%i1)) ! Mesh + case (FVW_u_V_wind) + call MV_Unpack(V, ValAry, u%V_wind(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine - -subroutine FVW_PackOutputVar(Var, y, ValAry) - type(FVW_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FVW_y_W_Vind) - call MV_Pack2(Var, y%W(DL%i1)%Vind, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine FVW_PackOutputAry(Vars, y, ValAry) - type(FVW_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(FVW_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call FVW_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (FVW_y_W_Vind) + call MV_Pack(V, y%W(DL%i1)%Vind(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine FVW_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(FVW_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FVW_y_W_Vind) - call MV_Unpack2(Var, ValAry, y%W(DL%i1)%Vind) ! Rank 2 Array - end select - end associate -end subroutine - subroutine FVW_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(FVW_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call FVW_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (FVW_y_W_Vind) + call MV_Unpack(V, ValAry, y%W(DL%i1)%Vind(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine END MODULE FVW_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 0f7ab0bef0..daa4953e23 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -2536,274 +2536,240 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ! check if allocated END SUBROUTINE -function UA_InputMeshPointer(u, ML) result(Mesh) - type(UA_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function UA_InputMeshPointer(u, DL) result(Mesh) + type(UA_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function UA_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function UA_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function UA_OutputMeshPointer(y, ML) result(Mesh) +function UA_OutputMeshPointer(y, DL) result(Mesh) type(UA_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function UA_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function UA_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine UA_PackContStateVar(Var, x, ValAry) - type(UA_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (UA_x_element_x) - call MV_Pack2(Var, x%element(DL%i1, DL%i2)%x, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine UA_PackContStateAry(Vars, x, ValAry) type(UA_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call UA_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (UA_x_element_x) + call MV_Pack(V, x%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine UA_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(UA_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (UA_x_element_x) - call MV_Unpack2(Var, ValAry, x%element(DL%i1, DL%i2)%x) ! Rank 1 Array - end select - end associate -end subroutine - subroutine UA_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(UA_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call UA_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (UA_x_element_x) + call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine UA_PackContStateDerivAry(Vars, x, ValAry) + type(UA_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (UA_x_element_x) + call MV_Pack(V, x%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine UA_PackConstrStateVar(Var, z, ValAry) - type(UA_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (UA_z_DummyConstraintState) - call MV_Pack2(Var, z%DummyConstraintState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine UA_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (UA_x_element_x) + call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine UA_PackConstrStateAry(Vars, z, ValAry) type(UA_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call UA_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (UA_z_DummyConstraintState) + call MV_Pack(V, z%DummyConstraintState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine UA_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(UA_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (UA_z_DummyConstraintState) - call MV_Unpack2(Var, ValAry, z%DummyConstraintState) ! Scalar - end select - end associate -end subroutine - subroutine UA_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(UA_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call UA_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (UA_z_DummyConstraintState) + call MV_Unpack(V, ValAry, z%DummyConstraintState) ! Scalar + end select + end associate end do end subroutine - -subroutine UA_PackInputVar(Var, u, ValAry) - type(UA_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (UA_u_U) - call MV_Pack2(Var, u%U, ValAry) ! Scalar - case (UA_u_alpha) - call MV_Pack2(Var, u%alpha, ValAry) ! Scalar - case (UA_u_Re) - call MV_Pack2(Var, u%Re, ValAry) ! Scalar - case (UA_u_UserProp) - call MV_Pack2(Var, u%UserProp, ValAry) ! Scalar - case (UA_u_v_ac) - call MV_Pack2(Var, u%v_ac, ValAry) ! Rank 1 Array - case (UA_u_omega) - call MV_Pack2(Var, u%omega, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine UA_PackInputAry(Vars, u, ValAry) - type(UA_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(UA_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call UA_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (UA_u_U) + call MV_Pack(V, u%U, ValAry) ! Scalar + case (UA_u_alpha) + call MV_Pack(V, u%alpha, ValAry) ! Scalar + case (UA_u_Re) + call MV_Pack(V, u%Re, ValAry) ! Scalar + case (UA_u_UserProp) + call MV_Pack(V, u%UserProp, ValAry) ! Scalar + case (UA_u_v_ac) + call MV_Pack(V, u%v_ac(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (UA_u_omega) + call MV_Pack(V, u%omega, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine UA_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(UA_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (UA_u_U) - call MV_Unpack2(Var, ValAry, u%U) ! Scalar - case (UA_u_alpha) - call MV_Unpack2(Var, ValAry, u%alpha) ! Scalar - case (UA_u_Re) - call MV_Unpack2(Var, ValAry, u%Re) ! Scalar - case (UA_u_UserProp) - call MV_Unpack2(Var, ValAry, u%UserProp) ! Scalar - case (UA_u_v_ac) - call MV_Unpack2(Var, ValAry, u%v_ac) ! Rank 1 Array - case (UA_u_omega) - call MV_Unpack2(Var, ValAry, u%omega) ! Scalar - end select - end associate -end subroutine - subroutine UA_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(UA_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call UA_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (UA_u_U) + call MV_Unpack(V, ValAry, u%U) ! Scalar + case (UA_u_alpha) + call MV_Unpack(V, ValAry, u%alpha) ! Scalar + case (UA_u_Re) + call MV_Unpack(V, ValAry, u%Re) ! Scalar + case (UA_u_UserProp) + call MV_Unpack(V, ValAry, u%UserProp) ! Scalar + case (UA_u_v_ac) + call MV_Unpack(V, ValAry, u%v_ac(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (UA_u_omega) + call MV_Unpack(V, ValAry, u%omega) ! Scalar + end select + end associate end do end subroutine - -subroutine UA_PackOutputVar(Var, y, ValAry) - type(UA_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (UA_y_Cn) - call MV_Pack2(Var, y%Cn, ValAry) ! Scalar - case (UA_y_Cc) - call MV_Pack2(Var, y%Cc, ValAry) ! Scalar - case (UA_y_Cm) - call MV_Pack2(Var, y%Cm, ValAry) ! Scalar - case (UA_y_Cl) - call MV_Pack2(Var, y%Cl, ValAry) ! Scalar - case (UA_y_Cd) - call MV_Pack2(Var, y%Cd, ValAry) ! Scalar - case (UA_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine UA_PackOutputAry(Vars, y, ValAry) - type(UA_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(UA_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call UA_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (UA_y_Cn) + call MV_Pack(V, y%Cn, ValAry) ! Scalar + case (UA_y_Cc) + call MV_Pack(V, y%Cc, ValAry) ! Scalar + case (UA_y_Cm) + call MV_Pack(V, y%Cm, ValAry) ! Scalar + case (UA_y_Cl) + call MV_Pack(V, y%Cl, ValAry) ! Scalar + case (UA_y_Cd) + call MV_Pack(V, y%Cd, ValAry) ! Scalar + case (UA_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine UA_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(UA_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (UA_y_Cn) - call MV_Unpack2(Var, ValAry, y%Cn) ! Scalar - case (UA_y_Cc) - call MV_Unpack2(Var, ValAry, y%Cc) ! Scalar - case (UA_y_Cm) - call MV_Unpack2(Var, ValAry, y%Cm) ! Scalar - case (UA_y_Cl) - call MV_Unpack2(Var, ValAry, y%Cl) ! Scalar - case (UA_y_Cd) - call MV_Unpack2(Var, ValAry, y%Cd) ! Scalar - case (UA_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine UA_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(UA_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call UA_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (UA_y_Cn) + call MV_Unpack(V, ValAry, y%Cn) ! Scalar + case (UA_y_Cc) + call MV_Unpack(V, ValAry, y%Cc) ! Scalar + case (UA_y_Cm) + call MV_Unpack(V, ValAry, y%Cm) ! Scalar + case (UA_y_Cl) + call MV_Unpack(V, ValAry, y%Cl) ! Scalar + case (UA_y_Cd) + call MV_Unpack(V, ValAry, y%Cd) ! Scalar + case (UA_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE UnsteadyAero_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 55b9dcdac6..75c74b250a 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -3751,12 +3751,12 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ! check if allocated END SUBROUTINE -function BD_InputMeshPointer(u, ML) result(Mesh) - type(BD_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function BD_InputMeshPointer(u, DL) result(Mesh) + type(BD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (BD_u_RootMotion) Mesh => u%RootMotion case (BD_u_PointLoad) @@ -3768,11 +3768,11 @@ function BD_InputMeshPointer(u, ML) result(Mesh) end select end function -function BD_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function BD_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (BD_u_RootMotion) Name = "u%RootMotion" case (BD_u_PointLoad) @@ -3784,12 +3784,12 @@ function BD_InputMeshName(ML) result(Name) end select end function -function BD_OutputMeshPointer(y, ML) result(Mesh) +function BD_OutputMeshPointer(y, DL) result(Mesh) type(BD_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (BD_y_ReactionForce) Mesh => y%ReactionForce case (BD_y_BldMotion) @@ -3797,11 +3797,11 @@ function BD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function BD_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function BD_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (BD_y_ReactionForce) Name = "y%ReactionForce" case (BD_y_BldMotion) @@ -3809,232 +3809,214 @@ function BD_OutputMeshName(ML) result(Name) end select end function -subroutine BD_PackContStateVar(Var, x, ValAry) - type(BD_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BD_x_q) - call MV_Pack2(Var, x%q, ValAry) ! Rank 2 Array - case (BD_x_dqdt) - call MV_Pack2(Var, x%dqdt, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine BD_PackContStateAry(Vars, x, ValAry) type(BD_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call BD_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (BD_x_q) + if (V%Field == FieldOrientation) then + ValAry(V%iLoc(1):V%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, V%jAry))) ! Convert WM parameters to quaternions + else + call MV_Pack(V, x%q(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + end if + case (BD_x_dqdt) + call MV_Pack(V, x%dqdt(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine BD_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(BD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BD_x_q) - call MV_Unpack2(Var, ValAry, x%q) ! Rank 2 Array - case (BD_x_dqdt) - call MV_Unpack2(Var, ValAry, x%dqdt) ! Rank 2 Array - end select - end associate -end subroutine - subroutine BD_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(BD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call BD_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (BD_x_q) + if (V%Field == FieldOrientation) then + x%q(4:6, V%jAry) = wm_inv(quat_to_wm(ValAry(V%iLoc(1):V%iLoc(2)))) ! Convert quaternion to WM parameters + else + call MV_Unpack(V, ValAry, x%q(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end if + case (BD_x_dqdt) + call MV_Unpack(V, ValAry, x%dqdt(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine +subroutine BD_PackContStateDerivAry(Vars, x, ValAry) + type(BD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (BD_x_q) + call MV_Pack(V, x%q(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (BD_x_dqdt) + call MV_Pack(V, x%dqdt(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine BD_PackConstrStateVar(Var, z, ValAry) - type(BD_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine BD_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (BD_x_q) + if (V%Field == FieldOrientation) then + x%q(4:6, V%jAry) = wm_inv(quat_to_wm(ValAry(V%iLoc(1):V%iLoc(2)))) ! Convert quaternion to WM parameters + else + call MV_Unpack(V, ValAry, x%q(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end if + case (BD_x_dqdt) + call MV_Unpack(V, ValAry, x%dqdt(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate + end do end subroutine subroutine BD_PackConstrStateAry(Vars, z, ValAry) type(BD_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call BD_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (BD_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine BD_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(BD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine BD_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(BD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call BD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (BD_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine BD_PackInputVar(Var, u, ValAry) - type(BD_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BD_u_RootMotion) - call MV_Pack2(Var, u%RootMotion, ValAry) ! Mesh - case (BD_u_PointLoad) - call MV_Pack2(Var, u%PointLoad, ValAry) ! Mesh - case (BD_u_DistrLoad) - call MV_Pack2(Var, u%DistrLoad, ValAry) ! Mesh - case (BD_u_HubMotion) - call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine BD_PackInputAry(Vars, u, ValAry) - type(BD_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(BD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call BD_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (BD_u_RootMotion) + call MV_Pack(V, u%RootMotion, ValAry) ! Mesh + case (BD_u_PointLoad) + call MV_Pack(V, u%PointLoad, ValAry) ! Mesh + case (BD_u_DistrLoad) + call MV_Pack(V, u%DistrLoad, ValAry) ! Mesh + case (BD_u_HubMotion) + call MV_Pack(V, u%HubMotion, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine BD_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(BD_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BD_u_RootMotion) - call MV_Unpack2(Var, ValAry, u%RootMotion) ! Mesh - case (BD_u_PointLoad) - call MV_Unpack2(Var, ValAry, u%PointLoad) ! Mesh - case (BD_u_DistrLoad) - call MV_Unpack2(Var, ValAry, u%DistrLoad) ! Mesh - case (BD_u_HubMotion) - call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh - end select - end associate -end subroutine - subroutine BD_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(BD_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call BD_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (BD_u_RootMotion) + call MV_Unpack(V, ValAry, u%RootMotion) ! Mesh + case (BD_u_PointLoad) + call MV_Unpack(V, ValAry, u%PointLoad) ! Mesh + case (BD_u_DistrLoad) + call MV_Unpack(V, ValAry, u%DistrLoad) ! Mesh + case (BD_u_HubMotion) + call MV_Unpack(V, ValAry, u%HubMotion) ! Mesh + end select + end associate end do end subroutine - -subroutine BD_PackOutputVar(Var, y, ValAry) - type(BD_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BD_y_ReactionForce) - call MV_Pack2(Var, y%ReactionForce, ValAry) ! Mesh - case (BD_y_BldMotion) - call MV_Pack2(Var, y%BldMotion, ValAry) ! Mesh - case (BD_y_RootMxr) - call MV_Pack2(Var, y%RootMxr, ValAry) ! Scalar - case (BD_y_RootMyr) - call MV_Pack2(Var, y%RootMyr, ValAry) ! Scalar - case (BD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine BD_PackOutputAry(Vars, y, ValAry) - type(BD_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(BD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call BD_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (BD_y_ReactionForce) + call MV_Pack(V, y%ReactionForce, ValAry) ! Mesh + case (BD_y_BldMotion) + call MV_Pack(V, y%BldMotion, ValAry) ! Mesh + case (BD_y_RootMxr) + call MV_Pack(V, y%RootMxr, ValAry) ! Scalar + case (BD_y_RootMyr) + call MV_Pack(V, y%RootMyr, ValAry) ! Scalar + case (BD_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine BD_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(BD_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (BD_y_ReactionForce) - call MV_Unpack2(Var, ValAry, y%ReactionForce) ! Mesh - case (BD_y_BldMotion) - call MV_Unpack2(Var, ValAry, y%BldMotion) ! Mesh - case (BD_y_RootMxr) - call MV_Unpack2(Var, ValAry, y%RootMxr) ! Scalar - case (BD_y_RootMyr) - call MV_Unpack2(Var, ValAry, y%RootMyr) ! Scalar - case (BD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine BD_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(BD_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call BD_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (BD_y_ReactionForce) + call MV_Unpack(V, ValAry, y%ReactionForce) ! Mesh + case (BD_y_BldMotion) + call MV_Unpack(V, ValAry, y%BldMotion) ! Mesh + case (BD_y_RootMxr) + call MV_Unpack(V, ValAry, y%RootMxr) ! Scalar + case (BD_y_RootMyr) + call MV_Unpack(V, ValAry, y%RootMyr) ! Scalar + case (BD_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE BeamDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 408392573d..fde8771583 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -62,8 +62,8 @@ MODULE ElastoDyn ! (Xd), and constraint-state (Z) equations all with respect to the constraint ! states (z) - PUBLIC :: ED_GetOP ! Routine to pack the operating point values (for linearization) into arrays - PUBLIC :: ED_SetOP ! Routine to unpack the operating point values from arrays + PUBLIC :: ED_PackExtInputAry ! Routine to pack extended inputs for linearization + PUBLIC :: ED_UpdateAzimuth @@ -10808,31 +10808,40 @@ logical function Failed() end function END SUBROUTINE ED_GetOP -!---------------------------------------------------------------------------------------------------------------------------------- -!> ED_SetOP sets input and state values from an array. Inverse of ED_GetOP -subroutine ED_SetOP(Vars, u, p, x, xd, z, u_op, x_op, xd_op, z_op) - TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module information - TYPE(ED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ED_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point - TYPE(ED_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states at operating point - TYPE(ED_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - if (present(u_op)) call ED_UnpackInputAry(Vars, u_op, u) - if (present(x_op)) call ED_UnpackContStateAry(Vars, x_op, x) - ! if (present(xd_op)) call ED_UnpackDiscStateAry(Vars, xd, xd_op) - ! if (present(z_op)) call ED_UnpackDiscStateAry(Vars, z, z_op) - -END subroutine -!---------------------------------------------------------------------------------------------------------------------------------- +subroutine ED_PackExtInputAry(Vars, u, ValAry, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: Vars + type(ED_InputType), intent(in) :: u !< Inputs + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi),intent(out) :: ErrStat !< Error status of the operation + character(*),intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ED_PackExtInputAry' + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + ! Find variable index corresponding to blade pitch command collective + i = MV_FindVarDatLoc(Vars%u, DatLoc(ED_u_BlPitchComC)) + + ! If variable found + if (i > 0) then + + ! Copy to value array + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = u%BlPitchCom(1) + + ! Check that all blades have the same pitch command + do i = 2, size(u%BlPitchCom) + if (.not. EqualRealNos(u%BlPitchCom(1), u%BlPitchCom(i))) then + call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & + "the commanded blade pitch angles are not the same for each blade.", & + ErrStat, ErrMsg, RoutineName) + exit + end if + end do + end if +end subroutine -!---------------------------------------------------------------------------------------------------------------------------------- -! Tight Coupling -!---------------------------------------------------------------------------------------------------------------------------------- subroutine ED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) type(ED_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(ED_ParameterType), intent(inout) :: p !< Parameters diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 7ee13b8575..6872bd7191 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -7662,14 +7662,14 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs + a3*y3%LSShftFzs END SUBROUTINE -function ED_InputMeshPointer(u, ML) result(Mesh) - type(ED_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function ED_InputMeshPointer(u, DL) result(Mesh) + type(ED_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (ED_u_BladePtLoads) - Mesh => u%BladePtLoads(ML%i1) + Mesh => u%BladePtLoads(DL%i1) case (ED_u_PlatformPtMesh) Mesh => u%PlatformPtMesh case (ED_u_TowerPtLoads) @@ -7683,13 +7683,13 @@ function ED_InputMeshPointer(u, ML) result(Mesh) end select end function -function ED_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ED_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (ED_u_BladePtLoads) - Name = "u%BladePtLoads("//trim(Num2LStr(ML%i1))//")" + Name = "u%BladePtLoads("//trim(Num2LStr(DL%i1))//")" case (ED_u_PlatformPtMesh) Name = "u%PlatformPtMesh" case (ED_u_TowerPtLoads) @@ -7703,14 +7703,14 @@ function ED_InputMeshName(ML) result(Name) end select end function -function ED_OutputMeshPointer(y, ML) result(Mesh) +function ED_OutputMeshPointer(y, DL) result(Mesh) type(ED_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (ED_y_BladeLn2Mesh) - Mesh => y%BladeLn2Mesh(ML%i1) + Mesh => y%BladeLn2Mesh(DL%i1) case (ED_y_PlatformPtMesh) Mesh => y%PlatformPtMesh case (ED_y_TowerLn2Mesh) @@ -7718,7 +7718,7 @@ function ED_OutputMeshPointer(y, ML) result(Mesh) case (ED_y_HubPtMotion) Mesh => y%HubPtMotion case (ED_y_BladeRootMotion) - Mesh => y%BladeRootMotion(ML%i1) + Mesh => y%BladeRootMotion(DL%i1) case (ED_y_NacelleMotion) Mesh => y%NacelleMotion case (ED_y_TFinCMMotion) @@ -7726,13 +7726,13 @@ function ED_OutputMeshPointer(y, ML) result(Mesh) end select end function -function ED_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ED_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (ED_y_BladeLn2Mesh) - Name = "y%BladeLn2Mesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%BladeLn2Mesh("//trim(Num2LStr(DL%i1))//")" case (ED_y_PlatformPtMesh) Name = "y%PlatformPtMesh" case (ED_y_TowerLn2Mesh) @@ -7740,7 +7740,7 @@ function ED_OutputMeshName(ML) result(Name) case (ED_y_HubPtMotion) Name = "y%HubPtMotion" case (ED_y_BladeRootMotion) - Name = "y%BladeRootMotion("//trim(Num2LStr(ML%i1))//")" + Name = "y%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" case (ED_y_NacelleMotion) Name = "y%NacelleMotion" case (ED_y_TFinCMMotion) @@ -7748,384 +7748,354 @@ function ED_OutputMeshName(ML) result(Name) end select end function -subroutine ED_PackContStateVar(Var, x, ValAry) - type(ED_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ED_x_QT) - call MV_Pack2(Var, x%QT, ValAry) ! Rank 1 Array - case (ED_x_QDT) - call MV_Pack2(Var, x%QDT, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ED_PackContStateAry(Vars, x, ValAry) type(ED_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call ED_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ED_x_QT) + call MV_Pack(V, x%QT(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ED_x_QDT) + call MV_Pack(V, x%QDT(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ED_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ED_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ED_x_QT) - call MV_Unpack2(Var, ValAry, x%QT) ! Rank 1 Array - case (ED_x_QDT) - call MV_Unpack2(Var, ValAry, x%QDT) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ED_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ED_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call ED_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ED_x_QT) + call MV_Unpack(V, ValAry, x%QT(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ED_x_QDT) + call MV_Unpack(V, ValAry, x%QDT(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine ED_PackContStateDerivAry(Vars, x, ValAry) + type(ED_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ED_x_QT) + call MV_Pack(V, x%QT(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ED_x_QDT) + call MV_Pack(V, x%QDT(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine ED_PackConstrStateVar(Var, z, ValAry) - type(ED_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ED_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine ED_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ED_x_QT) + call MV_Unpack(V, ValAry, x%QT(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ED_x_QDT) + call MV_Unpack(V, ValAry, x%QDT(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine ED_PackConstrStateAry(Vars, z, ValAry) type(ED_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call ED_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (ED_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ED_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ED_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ED_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine ED_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ED_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call ED_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (ED_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine ED_PackInputVar(Var, u, ValAry) - type(ED_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ED_u_BladePtLoads) - call MV_Pack2(Var, u%BladePtLoads(DL%i1), ValAry) ! Mesh - case (ED_u_PlatformPtMesh) - call MV_Pack2(Var, u%PlatformPtMesh, ValAry) ! Mesh - case (ED_u_TowerPtLoads) - call MV_Pack2(Var, u%TowerPtLoads, ValAry) ! Mesh - case (ED_u_HubPtLoad) - call MV_Pack2(Var, u%HubPtLoad, ValAry) ! Mesh - case (ED_u_NacelleLoads) - call MV_Pack2(Var, u%NacelleLoads, ValAry) ! Mesh - case (ED_u_TFinCMLoads) - call MV_Pack2(Var, u%TFinCMLoads, ValAry) ! Mesh - case (ED_u_TwrAddedMass) - call MV_Pack2(Var, u%TwrAddedMass, ValAry) ! Rank 3 Array - case (ED_u_PtfmAddedMass) - call MV_Pack2(Var, u%PtfmAddedMass, ValAry) ! Rank 2 Array - case (ED_u_BlPitchCom) - call MV_Pack2(Var, u%BlPitchCom, ValAry) ! Rank 1 Array - case (ED_u_YawMom) - call MV_Pack2(Var, u%YawMom, ValAry) ! Scalar - case (ED_u_GenTrq) - call MV_Pack2(Var, u%GenTrq, ValAry) ! Scalar - case (ED_u_HSSBrTrqC) - call MV_Pack2(Var, u%HSSBrTrqC, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ED_PackInputAry(Vars, u, ValAry) - type(ED_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ED_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call ED_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ED_u_BladePtLoads) + call MV_Pack(V, u%BladePtLoads(DL%i1), ValAry) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_Pack(V, u%PlatformPtMesh, ValAry) ! Mesh + case (ED_u_TowerPtLoads) + call MV_Pack(V, u%TowerPtLoads, ValAry) ! Mesh + case (ED_u_HubPtLoad) + call MV_Pack(V, u%HubPtLoad, ValAry) ! Mesh + case (ED_u_NacelleLoads) + call MV_Pack(V, u%NacelleLoads, ValAry) ! Mesh + case (ED_u_TFinCMLoads) + call MV_Pack(V, u%TFinCMLoads, ValAry) ! Mesh + case (ED_u_TwrAddedMass) + call MV_Pack(V, u%TwrAddedMass(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ED_u_PtfmAddedMass) + call MV_Pack(V, u%PtfmAddedMass(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (ED_u_BlPitchCom) + call MV_Pack(V, u%BlPitchCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ED_u_YawMom) + call MV_Pack(V, u%YawMom, ValAry) ! Scalar + case (ED_u_GenTrq) + call MV_Pack(V, u%GenTrq, ValAry) ! Scalar + case (ED_u_HSSBrTrqC) + call MV_Pack(V, u%HSSBrTrqC, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ED_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ED_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ED_u_BladePtLoads) - call MV_Unpack2(Var, ValAry, u%BladePtLoads(DL%i1)) ! Mesh - case (ED_u_PlatformPtMesh) - call MV_Unpack2(Var, ValAry, u%PlatformPtMesh) ! Mesh - case (ED_u_TowerPtLoads) - call MV_Unpack2(Var, ValAry, u%TowerPtLoads) ! Mesh - case (ED_u_HubPtLoad) - call MV_Unpack2(Var, ValAry, u%HubPtLoad) ! Mesh - case (ED_u_NacelleLoads) - call MV_Unpack2(Var, ValAry, u%NacelleLoads) ! Mesh - case (ED_u_TFinCMLoads) - call MV_Unpack2(Var, ValAry, u%TFinCMLoads) ! Mesh - case (ED_u_TwrAddedMass) - call MV_Unpack2(Var, ValAry, u%TwrAddedMass) ! Rank 3 Array - case (ED_u_PtfmAddedMass) - call MV_Unpack2(Var, ValAry, u%PtfmAddedMass) ! Rank 2 Array - case (ED_u_BlPitchCom) - call MV_Unpack2(Var, ValAry, u%BlPitchCom) ! Rank 1 Array - case (ED_u_YawMom) - call MV_Unpack2(Var, ValAry, u%YawMom) ! Scalar - case (ED_u_GenTrq) - call MV_Unpack2(Var, ValAry, u%GenTrq) ! Scalar - case (ED_u_HSSBrTrqC) - call MV_Unpack2(Var, ValAry, u%HSSBrTrqC) ! Scalar - end select - end associate -end subroutine - subroutine ED_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ED_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call ED_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ED_u_BladePtLoads) + call MV_Unpack(V, ValAry, u%BladePtLoads(DL%i1)) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_Unpack(V, ValAry, u%PlatformPtMesh) ! Mesh + case (ED_u_TowerPtLoads) + call MV_Unpack(V, ValAry, u%TowerPtLoads) ! Mesh + case (ED_u_HubPtLoad) + call MV_Unpack(V, ValAry, u%HubPtLoad) ! Mesh + case (ED_u_NacelleLoads) + call MV_Unpack(V, ValAry, u%NacelleLoads) ! Mesh + case (ED_u_TFinCMLoads) + call MV_Unpack(V, ValAry, u%TFinCMLoads) ! Mesh + case (ED_u_TwrAddedMass) + call MV_Unpack(V, ValAry, u%TwrAddedMass(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ED_u_PtfmAddedMass) + call MV_Unpack(V, ValAry, u%PtfmAddedMass(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (ED_u_BlPitchCom) + call MV_Unpack(V, ValAry, u%BlPitchCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ED_u_YawMom) + call MV_Unpack(V, ValAry, u%YawMom) ! Scalar + case (ED_u_GenTrq) + call MV_Unpack(V, ValAry, u%GenTrq) ! Scalar + case (ED_u_HSSBrTrqC) + call MV_Unpack(V, ValAry, u%HSSBrTrqC) ! Scalar + end select + end associate end do end subroutine - -subroutine ED_PackOutputVar(Var, y, ValAry) - type(ED_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ED_y_BladeLn2Mesh) - call MV_Pack2(Var, y%BladeLn2Mesh(DL%i1), ValAry) ! Mesh - case (ED_y_PlatformPtMesh) - call MV_Pack2(Var, y%PlatformPtMesh, ValAry) ! Mesh - case (ED_y_TowerLn2Mesh) - call MV_Pack2(Var, y%TowerLn2Mesh, ValAry) ! Mesh - case (ED_y_HubPtMotion) - call MV_Pack2(Var, y%HubPtMotion, ValAry) ! Mesh - case (ED_y_BladeRootMotion) - call MV_Pack2(Var, y%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (ED_y_NacelleMotion) - call MV_Pack2(Var, y%NacelleMotion, ValAry) ! Mesh - case (ED_y_TFinCMMotion) - call MV_Pack2(Var, y%TFinCMMotion, ValAry) ! Mesh - case (ED_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (ED_y_BlPitch) - call MV_Pack2(Var, y%BlPitch, ValAry) ! Rank 1 Array - case (ED_y_Yaw) - call MV_Pack2(Var, y%Yaw, ValAry) ! Scalar - case (ED_y_YawRate) - call MV_Pack2(Var, y%YawRate, ValAry) ! Scalar - case (ED_y_LSS_Spd) - call MV_Pack2(Var, y%LSS_Spd, ValAry) ! Scalar - case (ED_y_HSS_Spd) - call MV_Pack2(Var, y%HSS_Spd, ValAry) ! Scalar - case (ED_y_RotSpeed) - call MV_Pack2(Var, y%RotSpeed, ValAry) ! Scalar - case (ED_y_TwrAccel) - call MV_Pack2(Var, y%TwrAccel, ValAry) ! Scalar - case (ED_y_YawAngle) - call MV_Pack2(Var, y%YawAngle, ValAry) ! Scalar - case (ED_y_RootMyc) - call MV_Pack2(Var, y%RootMyc, ValAry) ! Rank 1 Array - case (ED_y_YawBrTAxp) - call MV_Pack2(Var, y%YawBrTAxp, ValAry) ! Scalar - case (ED_y_YawBrTAyp) - call MV_Pack2(Var, y%YawBrTAyp, ValAry) ! Scalar - case (ED_y_LSSTipPxa) - call MV_Pack2(Var, y%LSSTipPxa, ValAry) ! Scalar - case (ED_y_RootMxc) - call MV_Pack2(Var, y%RootMxc, ValAry) ! Rank 1 Array - case (ED_y_LSSTipMxa) - call MV_Pack2(Var, y%LSSTipMxa, ValAry) ! Scalar - case (ED_y_LSSTipMya) - call MV_Pack2(Var, y%LSSTipMya, ValAry) ! Scalar - case (ED_y_LSSTipMza) - call MV_Pack2(Var, y%LSSTipMza, ValAry) ! Scalar - case (ED_y_LSSTipMys) - call MV_Pack2(Var, y%LSSTipMys, ValAry) ! Scalar - case (ED_y_LSSTipMzs) - call MV_Pack2(Var, y%LSSTipMzs, ValAry) ! Scalar - case (ED_y_YawBrMyn) - call MV_Pack2(Var, y%YawBrMyn, ValAry) ! Scalar - case (ED_y_YawBrMzn) - call MV_Pack2(Var, y%YawBrMzn, ValAry) ! Scalar - case (ED_y_NcIMURAxs) - call MV_Pack2(Var, y%NcIMURAxs, ValAry) ! Scalar - case (ED_y_NcIMURAys) - call MV_Pack2(Var, y%NcIMURAys, ValAry) ! Scalar - case (ED_y_NcIMURAzs) - call MV_Pack2(Var, y%NcIMURAzs, ValAry) ! Scalar - case (ED_y_RotPwr) - call MV_Pack2(Var, y%RotPwr, ValAry) ! Scalar - case (ED_y_LSShftFxa) - call MV_Pack2(Var, y%LSShftFxa, ValAry) ! Scalar - case (ED_y_LSShftFys) - call MV_Pack2(Var, y%LSShftFys, ValAry) ! Scalar - case (ED_y_LSShftFzs) - call MV_Pack2(Var, y%LSShftFzs, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ED_PackOutputAry(Vars, y, ValAry) - type(ED_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ED_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call ED_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_Pack(V, y%BladeLn2Mesh(DL%i1), ValAry) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_Pack(V, y%PlatformPtMesh, ValAry) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_Pack(V, y%TowerLn2Mesh, ValAry) ! Mesh + case (ED_y_HubPtMotion) + call MV_Pack(V, y%HubPtMotion, ValAry) ! Mesh + case (ED_y_BladeRootMotion) + call MV_Pack(V, y%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ED_y_NacelleMotion) + call MV_Pack(V, y%NacelleMotion, ValAry) ! Mesh + case (ED_y_TFinCMMotion) + call MV_Pack(V, y%TFinCMMotion, ValAry) ! Mesh + case (ED_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ED_y_BlPitch) + call MV_Pack(V, y%BlPitch(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ED_y_Yaw) + call MV_Pack(V, y%Yaw, ValAry) ! Scalar + case (ED_y_YawRate) + call MV_Pack(V, y%YawRate, ValAry) ! Scalar + case (ED_y_LSS_Spd) + call MV_Pack(V, y%LSS_Spd, ValAry) ! Scalar + case (ED_y_HSS_Spd) + call MV_Pack(V, y%HSS_Spd, ValAry) ! Scalar + case (ED_y_RotSpeed) + call MV_Pack(V, y%RotSpeed, ValAry) ! Scalar + case (ED_y_TwrAccel) + call MV_Pack(V, y%TwrAccel, ValAry) ! Scalar + case (ED_y_YawAngle) + call MV_Pack(V, y%YawAngle, ValAry) ! Scalar + case (ED_y_RootMyc) + call MV_Pack(V, y%RootMyc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ED_y_YawBrTAxp) + call MV_Pack(V, y%YawBrTAxp, ValAry) ! Scalar + case (ED_y_YawBrTAyp) + call MV_Pack(V, y%YawBrTAyp, ValAry) ! Scalar + case (ED_y_LSSTipPxa) + call MV_Pack(V, y%LSSTipPxa, ValAry) ! Scalar + case (ED_y_RootMxc) + call MV_Pack(V, y%RootMxc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ED_y_LSSTipMxa) + call MV_Pack(V, y%LSSTipMxa, ValAry) ! Scalar + case (ED_y_LSSTipMya) + call MV_Pack(V, y%LSSTipMya, ValAry) ! Scalar + case (ED_y_LSSTipMza) + call MV_Pack(V, y%LSSTipMza, ValAry) ! Scalar + case (ED_y_LSSTipMys) + call MV_Pack(V, y%LSSTipMys, ValAry) ! Scalar + case (ED_y_LSSTipMzs) + call MV_Pack(V, y%LSSTipMzs, ValAry) ! Scalar + case (ED_y_YawBrMyn) + call MV_Pack(V, y%YawBrMyn, ValAry) ! Scalar + case (ED_y_YawBrMzn) + call MV_Pack(V, y%YawBrMzn, ValAry) ! Scalar + case (ED_y_NcIMURAxs) + call MV_Pack(V, y%NcIMURAxs, ValAry) ! Scalar + case (ED_y_NcIMURAys) + call MV_Pack(V, y%NcIMURAys, ValAry) ! Scalar + case (ED_y_NcIMURAzs) + call MV_Pack(V, y%NcIMURAzs, ValAry) ! Scalar + case (ED_y_RotPwr) + call MV_Pack(V, y%RotPwr, ValAry) ! Scalar + case (ED_y_LSShftFxa) + call MV_Pack(V, y%LSShftFxa, ValAry) ! Scalar + case (ED_y_LSShftFys) + call MV_Pack(V, y%LSShftFys, ValAry) ! Scalar + case (ED_y_LSShftFzs) + call MV_Pack(V, y%LSShftFzs, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ED_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ED_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ED_y_BladeLn2Mesh) - call MV_Unpack2(Var, ValAry, y%BladeLn2Mesh(DL%i1)) ! Mesh - case (ED_y_PlatformPtMesh) - call MV_Unpack2(Var, ValAry, y%PlatformPtMesh) ! Mesh - case (ED_y_TowerLn2Mesh) - call MV_Unpack2(Var, ValAry, y%TowerLn2Mesh) ! Mesh - case (ED_y_HubPtMotion) - call MV_Unpack2(Var, ValAry, y%HubPtMotion) ! Mesh - case (ED_y_BladeRootMotion) - call MV_Unpack2(Var, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh - case (ED_y_NacelleMotion) - call MV_Unpack2(Var, ValAry, y%NacelleMotion) ! Mesh - case (ED_y_TFinCMMotion) - call MV_Unpack2(Var, ValAry, y%TFinCMMotion) ! Mesh - case (ED_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (ED_y_BlPitch) - call MV_Unpack2(Var, ValAry, y%BlPitch) ! Rank 1 Array - case (ED_y_Yaw) - call MV_Unpack2(Var, ValAry, y%Yaw) ! Scalar - case (ED_y_YawRate) - call MV_Unpack2(Var, ValAry, y%YawRate) ! Scalar - case (ED_y_LSS_Spd) - call MV_Unpack2(Var, ValAry, y%LSS_Spd) ! Scalar - case (ED_y_HSS_Spd) - call MV_Unpack2(Var, ValAry, y%HSS_Spd) ! Scalar - case (ED_y_RotSpeed) - call MV_Unpack2(Var, ValAry, y%RotSpeed) ! Scalar - case (ED_y_TwrAccel) - call MV_Unpack2(Var, ValAry, y%TwrAccel) ! Scalar - case (ED_y_YawAngle) - call MV_Unpack2(Var, ValAry, y%YawAngle) ! Scalar - case (ED_y_RootMyc) - call MV_Unpack2(Var, ValAry, y%RootMyc) ! Rank 1 Array - case (ED_y_YawBrTAxp) - call MV_Unpack2(Var, ValAry, y%YawBrTAxp) ! Scalar - case (ED_y_YawBrTAyp) - call MV_Unpack2(Var, ValAry, y%YawBrTAyp) ! Scalar - case (ED_y_LSSTipPxa) - call MV_Unpack2(Var, ValAry, y%LSSTipPxa) ! Scalar - case (ED_y_RootMxc) - call MV_Unpack2(Var, ValAry, y%RootMxc) ! Rank 1 Array - case (ED_y_LSSTipMxa) - call MV_Unpack2(Var, ValAry, y%LSSTipMxa) ! Scalar - case (ED_y_LSSTipMya) - call MV_Unpack2(Var, ValAry, y%LSSTipMya) ! Scalar - case (ED_y_LSSTipMza) - call MV_Unpack2(Var, ValAry, y%LSSTipMza) ! Scalar - case (ED_y_LSSTipMys) - call MV_Unpack2(Var, ValAry, y%LSSTipMys) ! Scalar - case (ED_y_LSSTipMzs) - call MV_Unpack2(Var, ValAry, y%LSSTipMzs) ! Scalar - case (ED_y_YawBrMyn) - call MV_Unpack2(Var, ValAry, y%YawBrMyn) ! Scalar - case (ED_y_YawBrMzn) - call MV_Unpack2(Var, ValAry, y%YawBrMzn) ! Scalar - case (ED_y_NcIMURAxs) - call MV_Unpack2(Var, ValAry, y%NcIMURAxs) ! Scalar - case (ED_y_NcIMURAys) - call MV_Unpack2(Var, ValAry, y%NcIMURAys) ! Scalar - case (ED_y_NcIMURAzs) - call MV_Unpack2(Var, ValAry, y%NcIMURAzs) ! Scalar - case (ED_y_RotPwr) - call MV_Unpack2(Var, ValAry, y%RotPwr) ! Scalar - case (ED_y_LSShftFxa) - call MV_Unpack2(Var, ValAry, y%LSShftFxa) ! Scalar - case (ED_y_LSShftFys) - call MV_Unpack2(Var, ValAry, y%LSShftFys) ! Scalar - case (ED_y_LSShftFzs) - call MV_Unpack2(Var, ValAry, y%LSShftFzs) ! Scalar - end select - end associate -end subroutine - subroutine ED_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ED_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call ED_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_Unpack(V, ValAry, y%BladeLn2Mesh(DL%i1)) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_Unpack(V, ValAry, y%PlatformPtMesh) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_Unpack(V, ValAry, y%TowerLn2Mesh) ! Mesh + case (ED_y_HubPtMotion) + call MV_Unpack(V, ValAry, y%HubPtMotion) ! Mesh + case (ED_y_BladeRootMotion) + call MV_Unpack(V, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh + case (ED_y_NacelleMotion) + call MV_Unpack(V, ValAry, y%NacelleMotion) ! Mesh + case (ED_y_TFinCMMotion) + call MV_Unpack(V, ValAry, y%TFinCMMotion) ! Mesh + case (ED_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ED_y_BlPitch) + call MV_Unpack(V, ValAry, y%BlPitch(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ED_y_Yaw) + call MV_Unpack(V, ValAry, y%Yaw) ! Scalar + case (ED_y_YawRate) + call MV_Unpack(V, ValAry, y%YawRate) ! Scalar + case (ED_y_LSS_Spd) + call MV_Unpack(V, ValAry, y%LSS_Spd) ! Scalar + case (ED_y_HSS_Spd) + call MV_Unpack(V, ValAry, y%HSS_Spd) ! Scalar + case (ED_y_RotSpeed) + call MV_Unpack(V, ValAry, y%RotSpeed) ! Scalar + case (ED_y_TwrAccel) + call MV_Unpack(V, ValAry, y%TwrAccel) ! Scalar + case (ED_y_YawAngle) + call MV_Unpack(V, ValAry, y%YawAngle) ! Scalar + case (ED_y_RootMyc) + call MV_Unpack(V, ValAry, y%RootMyc(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ED_y_YawBrTAxp) + call MV_Unpack(V, ValAry, y%YawBrTAxp) ! Scalar + case (ED_y_YawBrTAyp) + call MV_Unpack(V, ValAry, y%YawBrTAyp) ! Scalar + case (ED_y_LSSTipPxa) + call MV_Unpack(V, ValAry, y%LSSTipPxa) ! Scalar + case (ED_y_RootMxc) + call MV_Unpack(V, ValAry, y%RootMxc(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ED_y_LSSTipMxa) + call MV_Unpack(V, ValAry, y%LSSTipMxa) ! Scalar + case (ED_y_LSSTipMya) + call MV_Unpack(V, ValAry, y%LSSTipMya) ! Scalar + case (ED_y_LSSTipMza) + call MV_Unpack(V, ValAry, y%LSSTipMza) ! Scalar + case (ED_y_LSSTipMys) + call MV_Unpack(V, ValAry, y%LSSTipMys) ! Scalar + case (ED_y_LSSTipMzs) + call MV_Unpack(V, ValAry, y%LSSTipMzs) ! Scalar + case (ED_y_YawBrMyn) + call MV_Unpack(V, ValAry, y%YawBrMyn) ! Scalar + case (ED_y_YawBrMzn) + call MV_Unpack(V, ValAry, y%YawBrMzn) ! Scalar + case (ED_y_NcIMURAxs) + call MV_Unpack(V, ValAry, y%NcIMURAxs) ! Scalar + case (ED_y_NcIMURAys) + call MV_Unpack(V, ValAry, y%NcIMURAys) ! Scalar + case (ED_y_NcIMURAzs) + call MV_Unpack(V, ValAry, y%NcIMURAzs) ! Scalar + case (ED_y_RotPwr) + call MV_Unpack(V, ValAry, y%RotPwr) ! Scalar + case (ED_y_LSShftFxa) + call MV_Unpack(V, ValAry, y%LSShftFxa) ! Scalar + case (ED_y_LSShftFys) + call MV_Unpack(V, ValAry, y%LSShftFys) ! Scalar + case (ED_y_LSShftFzs) + call MV_Unpack(V, ValAry, y%LSShftFzs) ! Scalar + end select + end associate end do end subroutine END MODULE ElastoDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index 7f399f8e18..9440675200 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -2834,212 +2834,180 @@ SUBROUTINE ExtInfw_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat END IF ! check if allocated END SUBROUTINE -function ExtInfw_InputMeshPointer(u, ML) result(Mesh) +function ExtInfw_InputMeshPointer(u, DL) result(Mesh) type(ExtInfw_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function ExtInfw_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ExtInfw_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function ExtInfw_OutputMeshPointer(y, ML) result(Mesh) +function ExtInfw_OutputMeshPointer(y, DL) result(Mesh) type(ExtInfw_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function ExtInfw_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ExtInfw_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine ExtInfw_PackInputVar(Var, u, ValAry) - type(ExtInfw_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtInfw_u_pxVel) - call MV_Pack2(Var, u%pxVel, ValAry) ! Rank 1 Array - case (ExtInfw_u_pyVel) - call MV_Pack2(Var, u%pyVel, ValAry) ! Rank 1 Array - case (ExtInfw_u_pzVel) - call MV_Pack2(Var, u%pzVel, ValAry) ! Rank 1 Array - case (ExtInfw_u_pxForce) - call MV_Pack2(Var, u%pxForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_pyForce) - call MV_Pack2(Var, u%pyForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_pzForce) - call MV_Pack2(Var, u%pzForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_xdotForce) - call MV_Pack2(Var, u%xdotForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_ydotForce) - call MV_Pack2(Var, u%ydotForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_zdotForce) - call MV_Pack2(Var, u%zdotForce, ValAry) ! Rank 1 Array - case (ExtInfw_u_pOrientation) - call MV_Pack2(Var, u%pOrientation, ValAry) ! Rank 1 Array - case (ExtInfw_u_fx) - call MV_Pack2(Var, u%fx, ValAry) ! Rank 1 Array - case (ExtInfw_u_fy) - call MV_Pack2(Var, u%fy, ValAry) ! Rank 1 Array - case (ExtInfw_u_fz) - call MV_Pack2(Var, u%fz, ValAry) ! Rank 1 Array - case (ExtInfw_u_momentx) - call MV_Pack2(Var, u%momentx, ValAry) ! Rank 1 Array - case (ExtInfw_u_momenty) - call MV_Pack2(Var, u%momenty, ValAry) ! Rank 1 Array - case (ExtInfw_u_momentz) - call MV_Pack2(Var, u%momentz, ValAry) ! Rank 1 Array - case (ExtInfw_u_forceNodesChord) - call MV_Pack2(Var, u%forceNodesChord, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtInfw_PackInputAry(Vars, u, ValAry) - type(ExtInfw_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ExtInfw_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call ExtInfw_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ExtInfw_u_pxVel) + call MV_Pack(V, u%pxVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_pyVel) + call MV_Pack(V, u%pyVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_pzVel) + call MV_Pack(V, u%pzVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_pxForce) + call MV_Pack(V, u%pxForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_pyForce) + call MV_Pack(V, u%pyForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_pzForce) + call MV_Pack(V, u%pzForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_xdotForce) + call MV_Pack(V, u%xdotForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_ydotForce) + call MV_Pack(V, u%ydotForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_zdotForce) + call MV_Pack(V, u%zdotForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_pOrientation) + call MV_Pack(V, u%pOrientation(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_fx) + call MV_Pack(V, u%fx(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_fy) + call MV_Pack(V, u%fy(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_fz) + call MV_Pack(V, u%fz(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_momentx) + call MV_Pack(V, u%momentx(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_momenty) + call MV_Pack(V, u%momenty(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_momentz) + call MV_Pack(V, u%momentz(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + call MV_Pack(V, u%forceNodesChord(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtInfw_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtInfw_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtInfw_u_pxVel) - call MV_Unpack2(Var, ValAry, u%pxVel) ! Rank 1 Array - case (ExtInfw_u_pyVel) - call MV_Unpack2(Var, ValAry, u%pyVel) ! Rank 1 Array - case (ExtInfw_u_pzVel) - call MV_Unpack2(Var, ValAry, u%pzVel) ! Rank 1 Array - case (ExtInfw_u_pxForce) - call MV_Unpack2(Var, ValAry, u%pxForce) ! Rank 1 Array - case (ExtInfw_u_pyForce) - call MV_Unpack2(Var, ValAry, u%pyForce) ! Rank 1 Array - case (ExtInfw_u_pzForce) - call MV_Unpack2(Var, ValAry, u%pzForce) ! Rank 1 Array - case (ExtInfw_u_xdotForce) - call MV_Unpack2(Var, ValAry, u%xdotForce) ! Rank 1 Array - case (ExtInfw_u_ydotForce) - call MV_Unpack2(Var, ValAry, u%ydotForce) ! Rank 1 Array - case (ExtInfw_u_zdotForce) - call MV_Unpack2(Var, ValAry, u%zdotForce) ! Rank 1 Array - case (ExtInfw_u_pOrientation) - call MV_Unpack2(Var, ValAry, u%pOrientation) ! Rank 1 Array - case (ExtInfw_u_fx) - call MV_Unpack2(Var, ValAry, u%fx) ! Rank 1 Array - case (ExtInfw_u_fy) - call MV_Unpack2(Var, ValAry, u%fy) ! Rank 1 Array - case (ExtInfw_u_fz) - call MV_Unpack2(Var, ValAry, u%fz) ! Rank 1 Array - case (ExtInfw_u_momentx) - call MV_Unpack2(Var, ValAry, u%momentx) ! Rank 1 Array - case (ExtInfw_u_momenty) - call MV_Unpack2(Var, ValAry, u%momenty) ! Rank 1 Array - case (ExtInfw_u_momentz) - call MV_Unpack2(Var, ValAry, u%momentz) ! Rank 1 Array - case (ExtInfw_u_forceNodesChord) - call MV_Unpack2(Var, ValAry, u%forceNodesChord) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ExtInfw_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ExtInfw_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call ExtInfw_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ExtInfw_u_pxVel) + call MV_Unpack(V, ValAry, u%pxVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_pyVel) + call MV_Unpack(V, ValAry, u%pyVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_pzVel) + call MV_Unpack(V, ValAry, u%pzVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_pxForce) + call MV_Unpack(V, ValAry, u%pxForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_pyForce) + call MV_Unpack(V, ValAry, u%pyForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_pzForce) + call MV_Unpack(V, ValAry, u%pzForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_xdotForce) + call MV_Unpack(V, ValAry, u%xdotForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_ydotForce) + call MV_Unpack(V, ValAry, u%ydotForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_zdotForce) + call MV_Unpack(V, ValAry, u%zdotForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_pOrientation) + call MV_Unpack(V, ValAry, u%pOrientation(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_fx) + call MV_Unpack(V, ValAry, u%fx(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_fy) + call MV_Unpack(V, ValAry, u%fy(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_fz) + call MV_Unpack(V, ValAry, u%fz(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_momentx) + call MV_Unpack(V, ValAry, u%momentx(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_momenty) + call MV_Unpack(V, ValAry, u%momenty(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_momentz) + call MV_Unpack(V, ValAry, u%momentz(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + call MV_Unpack(V, ValAry, u%forceNodesChord(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine ExtInfw_PackOutputVar(Var, y, ValAry) - type(ExtInfw_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtInfw_y_u) - call MV_Pack2(Var, y%u, ValAry) ! Rank 1 Array - case (ExtInfw_y_v) - call MV_Pack2(Var, y%v, ValAry) ! Rank 1 Array - case (ExtInfw_y_w) - call MV_Pack2(Var, y%w, ValAry) ! Rank 1 Array - case (ExtInfw_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtInfw_PackOutputAry(Vars, y, ValAry) - type(ExtInfw_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ExtInfw_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call ExtInfw_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ExtInfw_y_u) + call MV_Pack(V, y%u(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_y_v) + call MV_Pack(V, y%v(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_y_w) + call MV_Pack(V, y%w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtInfw_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtInfw_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtInfw_y_u) - call MV_Unpack2(Var, ValAry, y%u) ! Rank 1 Array - case (ExtInfw_y_v) - call MV_Unpack2(Var, ValAry, y%v) ! Rank 1 Array - case (ExtInfw_y_w) - call MV_Unpack2(Var, ValAry, y%w) ! Rank 1 Array - case (ExtInfw_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ExtInfw_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ExtInfw_OutputType), intent(inout) :: y - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%y) - call ExtInfw_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ExtInfw_y_u) + call MV_Unpack(V, ValAry, y%u(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_y_v) + call MV_Unpack(V, ValAry, y%v(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_y_w) + call MV_Unpack(V, ValAry, y%w(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE ExternalInflow_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index 99a5ad20a9..a1d6c66bf4 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -1691,160 +1691,128 @@ SUBROUTINE ExtLdDX_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat END IF ! check if allocated END SUBROUTINE -function ExtLdDX_InputMeshPointer(u, ML) result(Mesh) +function ExtLdDX_InputMeshPointer(u, DL) result(Mesh) type(ExtLdDX_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function ExtLdDX_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ExtLdDX_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function ExtLdDX_OutputMeshPointer(y, ML) result(Mesh) +function ExtLdDX_OutputMeshPointer(y, DL) result(Mesh) type(ExtLdDX_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function ExtLdDX_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ExtLdDX_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine ExtLdDX_PackInputVar(Var, u, ValAry) - type(ExtLdDX_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLdDX_u_twrDef) - call MV_Pack2(Var, u%twrDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldDef) - call MV_Pack2(Var, u%bldDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_hubDef) - call MV_Pack2(Var, u%hubDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_nacDef) - call MV_Pack2(Var, u%nacDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldRootDef) - call MV_Pack2(Var, u%bldRootDef, ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldPitch) - call MV_Pack2(Var, u%bldPitch, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtLdDX_PackInputAry(Vars, u, ValAry) - type(ExtLdDX_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ExtLdDX_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call ExtLdDX_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ExtLdDX_u_twrDef) + call MV_Pack(V, u%twrDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldDef) + call MV_Pack(V, u%bldDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLdDX_u_hubDef) + call MV_Pack(V, u%hubDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLdDX_u_nacDef) + call MV_Pack(V, u%nacDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + call MV_Pack(V, u%bldRootDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + call MV_Pack(V, u%bldPitch(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtLdDX_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLdDX_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLdDX_u_twrDef) - call MV_Unpack2(Var, ValAry, u%twrDef) ! Rank 1 Array - case (ExtLdDX_u_bldDef) - call MV_Unpack2(Var, ValAry, u%bldDef) ! Rank 1 Array - case (ExtLdDX_u_hubDef) - call MV_Unpack2(Var, ValAry, u%hubDef) ! Rank 1 Array - case (ExtLdDX_u_nacDef) - call MV_Unpack2(Var, ValAry, u%nacDef) ! Rank 1 Array - case (ExtLdDX_u_bldRootDef) - call MV_Unpack2(Var, ValAry, u%bldRootDef) ! Rank 1 Array - case (ExtLdDX_u_bldPitch) - call MV_Unpack2(Var, ValAry, u%bldPitch) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ExtLdDX_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLdDX_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call ExtLdDX_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ExtLdDX_u_twrDef) + call MV_Unpack(V, ValAry, u%twrDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLdDX_u_bldDef) + call MV_Unpack(V, ValAry, u%bldDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLdDX_u_hubDef) + call MV_Unpack(V, ValAry, u%hubDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLdDX_u_nacDef) + call MV_Unpack(V, ValAry, u%nacDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + call MV_Unpack(V, ValAry, u%bldRootDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + call MV_Unpack(V, ValAry, u%bldPitch(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine ExtLdDX_PackOutputVar(Var, y, ValAry) - type(ExtLdDX_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLdDX_y_twrLd) - call MV_Pack2(Var, y%twrLd, ValAry) ! Rank 1 Array - case (ExtLdDX_y_bldLd) - call MV_Pack2(Var, y%bldLd, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtLdDX_PackOutputAry(Vars, y, ValAry) - type(ExtLdDX_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ExtLdDX_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call ExtLdDX_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ExtLdDX_y_twrLd) + call MV_Pack(V, y%twrLd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLdDX_y_bldLd) + call MV_Pack(V, y%bldLd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtLdDX_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLdDX_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLdDX_y_twrLd) - call MV_Unpack2(Var, ValAry, y%twrLd) ! Rank 1 Array - case (ExtLdDX_y_bldLd) - call MV_Unpack2(Var, ValAry, y%bldLd) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ExtLdDX_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ExtLdDX_OutputType), intent(inout) :: y - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%y) - call ExtLdDX_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ExtLdDX_y_twrLd) + call MV_Unpack(V, ValAry, y%twrLd(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLdDX_y_bldLd) + call MV_Unpack(V, ValAry, y%bldLd(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE ExtLoadsDX_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 09ee2cc51d..2a6d5718a4 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -1700,12 +1700,12 @@ SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, END IF ! check if allocated END SUBROUTINE -function ExtLd_InputMeshPointer(u, ML) result(Mesh) +function ExtLd_InputMeshPointer(u, DL) result(Mesh) type(ExtLd_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (ExtLd_u_TowerMotion) Mesh => u%TowerMotion case (ExtLd_u_HubMotion) @@ -1713,17 +1713,17 @@ function ExtLd_InputMeshPointer(u, ML) result(Mesh) case (ExtLd_u_NacelleMotion) Mesh => u%NacelleMotion case (ExtLd_u_BladeRootMotion) - Mesh => u%BladeRootMotion(ML%i1) + Mesh => u%BladeRootMotion(DL%i1) case (ExtLd_u_BladeMotion) - Mesh => u%BladeMotion(ML%i1) + Mesh => u%BladeMotion(DL%i1) end select end function -function ExtLd_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ExtLd_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (ExtLd_u_TowerMotion) Name = "u%TowerMotion" case (ExtLd_u_HubMotion) @@ -1731,303 +1731,269 @@ function ExtLd_InputMeshName(ML) result(Name) case (ExtLd_u_NacelleMotion) Name = "u%NacelleMotion" case (ExtLd_u_BladeRootMotion) - Name = "u%BladeRootMotion("//trim(Num2LStr(ML%i1))//")" + Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" case (ExtLd_u_BladeMotion) - Name = "u%BladeMotion("//trim(Num2LStr(ML%i1))//")" + Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" end select end function -function ExtLd_OutputMeshPointer(y, ML) result(Mesh) +function ExtLd_OutputMeshPointer(y, DL) result(Mesh) type(ExtLd_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (ExtLd_y_TowerLoad) Mesh => y%TowerLoad case (ExtLd_y_BladeLoad) - Mesh => y%BladeLoad(ML%i1) + Mesh => y%BladeLoad(DL%i1) case (ExtLd_y_TowerLoadAD) Mesh => y%TowerLoadAD case (ExtLd_y_BladeLoadAD) - Mesh => y%BladeLoadAD(ML%i1) + Mesh => y%BladeLoadAD(DL%i1) end select end function -function ExtLd_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ExtLd_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (ExtLd_y_TowerLoad) Name = "y%TowerLoad" case (ExtLd_y_BladeLoad) - Name = "y%BladeLoad("//trim(Num2LStr(ML%i1))//")" + Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" case (ExtLd_y_TowerLoadAD) Name = "y%TowerLoadAD" case (ExtLd_y_BladeLoadAD) - Name = "y%BladeLoadAD("//trim(Num2LStr(ML%i1))//")" + Name = "y%BladeLoadAD("//trim(Num2LStr(DL%i1))//")" end select end function -subroutine ExtLd_PackContStateVar(Var, x, ValAry) - type(ExtLd_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLd_x_blah) - call MV_Pack2(Var, x%blah, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtLd_PackContStateAry(Vars, x, ValAry) type(ExtLd_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call ExtLd_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ExtLd_x_blah) + call MV_Pack(V, x%blah, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtLd_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLd_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLd_x_blah) - call MV_Unpack2(Var, ValAry, x%blah) ! Scalar - end select - end associate -end subroutine - subroutine ExtLd_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call ExtLd_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ExtLd_x_blah) + call MV_Unpack(V, ValAry, x%blah) ! Scalar + end select + end associate end do end subroutine +subroutine ExtLd_PackContStateDerivAry(Vars, x, ValAry) + type(ExtLd_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ExtLd_x_blah) + call MV_Pack(V, x%blah, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine ExtLd_PackConstrStateVar(Var, z, ValAry) - type(ExtLd_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLd_z_blah) - call MV_Pack2(Var, z%blah, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine ExtLd_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ExtLd_x_blah) + call MV_Unpack(V, ValAry, x%blah) ! Scalar + end select + end associate + end do end subroutine subroutine ExtLd_PackConstrStateAry(Vars, z, ValAry) type(ExtLd_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call ExtLd_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (ExtLd_z_blah) + call MV_Pack(V, z%blah, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtLd_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLd_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLd_z_blah) - call MV_Unpack2(Var, ValAry, z%blah) ! Scalar - end select - end associate -end subroutine - subroutine ExtLd_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call ExtLd_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (ExtLd_z_blah) + call MV_Unpack(V, ValAry, z%blah) ! Scalar + end select + end associate end do end subroutine - -subroutine ExtLd_PackInputVar(Var, u, ValAry) - type(ExtLd_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLd_u_DX_u_twrDef) - call MV_Pack2(Var, u%DX_u%twrDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldDef) - call MV_Pack2(Var, u%DX_u%bldDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_hubDef) - call MV_Pack2(Var, u%DX_u%hubDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_nacDef) - call MV_Pack2(Var, u%DX_u%nacDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldRootDef) - call MV_Pack2(Var, u%DX_u%bldRootDef, ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldPitch) - call MV_Pack2(Var, u%DX_u%bldPitch, ValAry) ! Rank 1 Array - case (ExtLd_u_az) - call MV_Pack2(Var, u%az, ValAry) ! Scalar - case (ExtLd_u_TowerMotion) - call MV_Pack2(Var, u%TowerMotion, ValAry) ! Mesh - case (ExtLd_u_HubMotion) - call MV_Pack2(Var, u%HubMotion, ValAry) ! Mesh - case (ExtLd_u_NacelleMotion) - call MV_Pack2(Var, u%NacelleMotion, ValAry) ! Mesh - case (ExtLd_u_BladeRootMotion) - call MV_Pack2(Var, u%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (ExtLd_u_BladeMotion) - call MV_Pack2(Var, u%BladeMotion(DL%i1), ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtLd_PackInputAry(Vars, u, ValAry) - type(ExtLd_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ExtLd_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call ExtLd_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ExtLd_u_DX_u_twrDef) + call MV_Pack(V, u%DX_u%twrDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + call MV_Pack(V, u%DX_u%bldDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + call MV_Pack(V, u%DX_u%hubDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + call MV_Pack(V, u%DX_u%nacDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + call MV_Pack(V, u%DX_u%bldRootDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + call MV_Pack(V, u%DX_u%bldPitch(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLd_u_az) + call MV_Pack(V, u%az, ValAry) ! Scalar + case (ExtLd_u_TowerMotion) + call MV_Pack(V, u%TowerMotion, ValAry) ! Mesh + case (ExtLd_u_HubMotion) + call MV_Pack(V, u%HubMotion, ValAry) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_Pack(V, u%NacelleMotion, ValAry) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_Pack(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_Pack(V, u%BladeMotion(DL%i1), ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtLd_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLd_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLd_u_DX_u_twrDef) - call MV_Unpack2(Var, ValAry, u%DX_u%twrDef) ! Rank 1 Array - case (ExtLd_u_DX_u_bldDef) - call MV_Unpack2(Var, ValAry, u%DX_u%bldDef) ! Rank 1 Array - case (ExtLd_u_DX_u_hubDef) - call MV_Unpack2(Var, ValAry, u%DX_u%hubDef) ! Rank 1 Array - case (ExtLd_u_DX_u_nacDef) - call MV_Unpack2(Var, ValAry, u%DX_u%nacDef) ! Rank 1 Array - case (ExtLd_u_DX_u_bldRootDef) - call MV_Unpack2(Var, ValAry, u%DX_u%bldRootDef) ! Rank 1 Array - case (ExtLd_u_DX_u_bldPitch) - call MV_Unpack2(Var, ValAry, u%DX_u%bldPitch) ! Rank 1 Array - case (ExtLd_u_az) - call MV_Unpack2(Var, ValAry, u%az) ! Scalar - case (ExtLd_u_TowerMotion) - call MV_Unpack2(Var, ValAry, u%TowerMotion) ! Mesh - case (ExtLd_u_HubMotion) - call MV_Unpack2(Var, ValAry, u%HubMotion) ! Mesh - case (ExtLd_u_NacelleMotion) - call MV_Unpack2(Var, ValAry, u%NacelleMotion) ! Mesh - case (ExtLd_u_BladeRootMotion) - call MV_Unpack2(Var, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh - case (ExtLd_u_BladeMotion) - call MV_Unpack2(Var, ValAry, u%BladeMotion(DL%i1)) ! Mesh - end select - end associate -end subroutine - subroutine ExtLd_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLd_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call ExtLd_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ExtLd_u_DX_u_twrDef) + call MV_Unpack(V, ValAry, u%DX_u%twrDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + call MV_Unpack(V, ValAry, u%DX_u%bldDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + call MV_Unpack(V, ValAry, u%DX_u%hubDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + call MV_Unpack(V, ValAry, u%DX_u%nacDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + call MV_Unpack(V, ValAry, u%DX_u%bldRootDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + call MV_Unpack(V, ValAry, u%DX_u%bldPitch(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLd_u_az) + call MV_Unpack(V, ValAry, u%az) ! Scalar + case (ExtLd_u_TowerMotion) + call MV_Unpack(V, ValAry, u%TowerMotion) ! Mesh + case (ExtLd_u_HubMotion) + call MV_Unpack(V, ValAry, u%HubMotion) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_Unpack(V, ValAry, u%NacelleMotion) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_Unpack(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_Unpack(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh + end select + end associate end do end subroutine - -subroutine ExtLd_PackOutputVar(Var, y, ValAry) - type(ExtLd_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLd_y_DX_y_twrLd) - call MV_Pack2(Var, y%DX_y%twrLd, ValAry) ! Rank 1 Array - case (ExtLd_y_DX_y_bldLd) - call MV_Pack2(Var, y%DX_y%bldLd, ValAry) ! Rank 1 Array - case (ExtLd_y_TowerLoad) - call MV_Pack2(Var, y%TowerLoad, ValAry) ! Mesh - case (ExtLd_y_BladeLoad) - call MV_Pack2(Var, y%BladeLoad(DL%i1), ValAry) ! Mesh - case (ExtLd_y_TowerLoadAD) - call MV_Pack2(Var, y%TowerLoadAD, ValAry) ! Mesh - case (ExtLd_y_BladeLoadAD) - call MV_Pack2(Var, y%BladeLoadAD(DL%i1), ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtLd_PackOutputAry(Vars, y, ValAry) - type(ExtLd_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ExtLd_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call ExtLd_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ExtLd_y_DX_y_twrLd) + call MV_Pack(V, y%DX_y%twrLd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + call MV_Pack(V, y%DX_y%bldLd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_Pack(V, y%TowerLoad, ValAry) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_Pack(V, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (ExtLd_y_TowerLoadAD) + call MV_Pack(V, y%TowerLoadAD, ValAry) ! Mesh + case (ExtLd_y_BladeLoadAD) + call MV_Pack(V, y%BladeLoadAD(DL%i1), ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtLd_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLd_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtLd_y_DX_y_twrLd) - call MV_Unpack2(Var, ValAry, y%DX_y%twrLd) ! Rank 1 Array - case (ExtLd_y_DX_y_bldLd) - call MV_Unpack2(Var, ValAry, y%DX_y%bldLd) ! Rank 1 Array - case (ExtLd_y_TowerLoad) - call MV_Unpack2(Var, ValAry, y%TowerLoad) ! Mesh - case (ExtLd_y_BladeLoad) - call MV_Unpack2(Var, ValAry, y%BladeLoad(DL%i1)) ! Mesh - case (ExtLd_y_TowerLoadAD) - call MV_Unpack2(Var, ValAry, y%TowerLoadAD) ! Mesh - case (ExtLd_y_BladeLoadAD) - call MV_Unpack2(Var, ValAry, y%BladeLoadAD(DL%i1)) ! Mesh - end select - end associate -end subroutine - subroutine ExtLd_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLd_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call ExtLd_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ExtLd_y_DX_y_twrLd) + call MV_Unpack(V, ValAry, y%DX_y%twrLd(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + call MV_Unpack(V, ValAry, y%DX_y%bldLd(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_Unpack(V, ValAry, y%TowerLoad) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_Unpack(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (ExtLd_y_TowerLoadAD) + call MV_Unpack(V, ValAry, y%TowerLoadAD) ! Mesh + case (ExtLd_y_BladeLoadAD) + call MV_Unpack(V, ValAry, y%BladeLoadAD(DL%i1)) ! Mesh + end select + end associate end do end subroutine END MODULE ExtLoads_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 026e8ef81d..36fe4db45e 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -1877,250 +1877,220 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat END IF ! check if allocated END SUBROUTINE -function ExtPtfm_InputMeshPointer(u, ML) result(Mesh) +function ExtPtfm_InputMeshPointer(u, DL) result(Mesh) type(ExtPtfm_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (ExtPtfm_u_PtfmMesh) Mesh => u%PtfmMesh end select end function -function ExtPtfm_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ExtPtfm_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (ExtPtfm_u_PtfmMesh) Name = "u%PtfmMesh" end select end function -function ExtPtfm_OutputMeshPointer(y, ML) result(Mesh) +function ExtPtfm_OutputMeshPointer(y, DL) result(Mesh) type(ExtPtfm_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (ExtPtfm_y_PtfmMesh) Mesh => y%PtfmMesh end select end function -function ExtPtfm_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ExtPtfm_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (ExtPtfm_y_PtfmMesh) Name = "y%PtfmMesh" end select end function -subroutine ExtPtfm_PackContStateVar(Var, x, ValAry) - type(ExtPtfm_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtPtfm_x_qm) - call MV_Pack2(Var, x%qm, ValAry) ! Rank 1 Array - case (ExtPtfm_x_qmdot) - call MV_Pack2(Var, x%qmdot, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtPtfm_PackContStateAry(Vars, x, ValAry) type(ExtPtfm_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call ExtPtfm_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ExtPtfm_x_qm) + call MV_Pack(V, x%qm(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + call MV_Pack(V, x%qmdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtPtfm_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtPtfm_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtPtfm_x_qm) - call MV_Unpack2(Var, ValAry, x%qm) ! Rank 1 Array - case (ExtPtfm_x_qmdot) - call MV_Unpack2(Var, ValAry, x%qmdot) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ExtPtfm_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call ExtPtfm_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ExtPtfm_x_qm) + call MV_Unpack(V, ValAry, x%qm(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + call MV_Unpack(V, ValAry, x%qmdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine ExtPtfm_PackContStateDerivAry(Vars, x, ValAry) + type(ExtPtfm_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ExtPtfm_x_qm) + call MV_Pack(V, x%qm(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + call MV_Pack(V, x%qmdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine ExtPtfm_PackConstrStateVar(Var, z, ValAry) - type(ExtPtfm_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtPtfm_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine ExtPtfm_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ExtPtfm_x_qm) + call MV_Unpack(V, ValAry, x%qm(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + call MV_Unpack(V, ValAry, x%qmdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine ExtPtfm_PackConstrStateAry(Vars, z, ValAry) type(ExtPtfm_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call ExtPtfm_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (ExtPtfm_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtPtfm_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtPtfm_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtPtfm_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine ExtPtfm_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call ExtPtfm_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (ExtPtfm_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine ExtPtfm_PackInputVar(Var, u, ValAry) - type(ExtPtfm_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtPtfm_u_PtfmMesh) - call MV_Pack2(Var, u%PtfmMesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtPtfm_PackInputAry(Vars, u, ValAry) - type(ExtPtfm_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ExtPtfm_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call ExtPtfm_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_Pack(V, u%PtfmMesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtPtfm_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtPtfm_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtPtfm_u_PtfmMesh) - call MV_Unpack2(Var, ValAry, u%PtfmMesh) ! Mesh - end select - end associate -end subroutine - subroutine ExtPtfm_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ExtPtfm_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call ExtPtfm_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_Unpack(V, ValAry, u%PtfmMesh) ! Mesh + end select + end associate end do end subroutine - -subroutine ExtPtfm_PackOutputVar(Var, y, ValAry) - type(ExtPtfm_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtPtfm_y_PtfmMesh) - call MV_Pack2(Var, y%PtfmMesh, ValAry) ! Mesh - case (ExtPtfm_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ExtPtfm_PackOutputAry(Vars, y, ValAry) - type(ExtPtfm_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ExtPtfm_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call ExtPtfm_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_Pack(V, y%PtfmMesh, ValAry) ! Mesh + case (ExtPtfm_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ExtPtfm_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ExtPtfm_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ExtPtfm_y_PtfmMesh) - call MV_Unpack2(Var, ValAry, y%PtfmMesh) ! Mesh - case (ExtPtfm_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ExtPtfm_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_OutputType), intent(inout) :: y - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%y) - call ExtPtfm_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_Unpack(V, ValAry, y%PtfmMesh) ! Mesh + case (ExtPtfm_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE ExtPtfm_MCKF_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index e301e5bd17..530fd1f509 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -2510,12 +2510,12 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE -function FEAM_InputMeshPointer(u, ML) result(Mesh) +function FEAM_InputMeshPointer(u, DL) result(Mesh) type(FEAM_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (FEAM_u_HydroForceLineMesh) Mesh => u%HydroForceLineMesh case (FEAM_u_PtFairleadDisplacement) @@ -2523,11 +2523,11 @@ function FEAM_InputMeshPointer(u, ML) result(Mesh) end select end function -function FEAM_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function FEAM_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (FEAM_u_HydroForceLineMesh) Name = "u%HydroForceLineMesh" case (FEAM_u_PtFairleadDisplacement) @@ -2535,12 +2535,12 @@ function FEAM_InputMeshName(ML) result(Name) end select end function -function FEAM_OutputMeshPointer(y, ML) result(Mesh) +function FEAM_OutputMeshPointer(y, DL) result(Mesh) type(FEAM_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (FEAM_y_PtFairleadLoad) Mesh => y%PtFairleadLoad case (FEAM_y_LineMeshPosition) @@ -2548,11 +2548,11 @@ function FEAM_OutputMeshPointer(y, ML) result(Mesh) end select end function -function FEAM_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function FEAM_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (FEAM_y_PtFairleadLoad) Name = "y%PtFairleadLoad" case (FEAM_y_LineMeshPosition) @@ -2560,220 +2560,190 @@ function FEAM_OutputMeshName(ML) result(Name) end select end function -subroutine FEAM_PackContStateVar(Var, x, ValAry) - type(FEAM_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FEAM_x_GLU) - call MV_Pack2(Var, x%GLU, ValAry) ! Rank 2 Array - case (FEAM_x_GLDU) - call MV_Pack2(Var, x%GLDU, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine FEAM_PackContStateAry(Vars, x, ValAry) type(FEAM_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call FEAM_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (FEAM_x_GLU) + call MV_Pack(V, x%GLU(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (FEAM_x_GLDU) + call MV_Pack(V, x%GLDU(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine FEAM_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(FEAM_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FEAM_x_GLU) - call MV_Unpack2(Var, ValAry, x%GLU) ! Rank 2 Array - case (FEAM_x_GLDU) - call MV_Unpack2(Var, ValAry, x%GLDU) ! Rank 2 Array - end select - end associate -end subroutine - subroutine FEAM_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(FEAM_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call FEAM_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (FEAM_x_GLU) + call MV_Unpack(V, ValAry, x%GLU(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (FEAM_x_GLDU) + call MV_Unpack(V, ValAry, x%GLDU(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine +subroutine FEAM_PackContStateDerivAry(Vars, x, ValAry) + type(FEAM_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (FEAM_x_GLU) + call MV_Pack(V, x%GLU(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (FEAM_x_GLDU) + call MV_Pack(V, x%GLDU(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine FEAM_PackConstrStateVar(Var, z, ValAry) - type(FEAM_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FEAM_z_TSN) - call MV_Pack2(Var, z%TSN, ValAry) ! Rank 1 Array - case (FEAM_z_TZER) - call MV_Pack2(Var, z%TZER, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine FEAM_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (FEAM_x_GLU) + call MV_Unpack(V, ValAry, x%GLU(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (FEAM_x_GLDU) + call MV_Unpack(V, ValAry, x%GLDU(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate + end do end subroutine subroutine FEAM_PackConstrStateAry(Vars, z, ValAry) type(FEAM_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call FEAM_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (FEAM_z_TSN) + call MV_Pack(V, z%TSN(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (FEAM_z_TZER) + call MV_Pack(V, z%TZER(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine FEAM_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(FEAM_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FEAM_z_TSN) - call MV_Unpack2(Var, ValAry, z%TSN) ! Rank 1 Array - case (FEAM_z_TZER) - call MV_Unpack2(Var, ValAry, z%TZER) ! Rank 1 Array - end select - end associate -end subroutine - subroutine FEAM_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(FEAM_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call FEAM_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (FEAM_z_TSN) + call MV_Unpack(V, ValAry, z%TSN(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (FEAM_z_TZER) + call MV_Unpack(V, ValAry, z%TZER(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine FEAM_PackInputVar(Var, u, ValAry) - type(FEAM_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FEAM_u_HydroForceLineMesh) - call MV_Pack2(Var, u%HydroForceLineMesh, ValAry) ! Mesh - case (FEAM_u_PtFairleadDisplacement) - call MV_Pack2(Var, u%PtFairleadDisplacement, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine FEAM_PackInputAry(Vars, u, ValAry) - type(FEAM_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(FEAM_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call FEAM_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_Pack(V, u%HydroForceLineMesh, ValAry) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_Pack(V, u%PtFairleadDisplacement, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine FEAM_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(FEAM_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FEAM_u_HydroForceLineMesh) - call MV_Unpack2(Var, ValAry, u%HydroForceLineMesh) ! Mesh - case (FEAM_u_PtFairleadDisplacement) - call MV_Unpack2(Var, ValAry, u%PtFairleadDisplacement) ! Mesh - end select - end associate -end subroutine - subroutine FEAM_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(FEAM_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call FEAM_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_Unpack(V, ValAry, u%HydroForceLineMesh) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_Unpack(V, ValAry, u%PtFairleadDisplacement) ! Mesh + end select + end associate end do end subroutine - -subroutine FEAM_PackOutputVar(Var, y, ValAry) - type(FEAM_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FEAM_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (FEAM_y_PtFairleadLoad) - call MV_Pack2(Var, y%PtFairleadLoad, ValAry) ! Mesh - case (FEAM_y_LineMeshPosition) - call MV_Pack2(Var, y%LineMeshPosition, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine FEAM_PackOutputAry(Vars, y, ValAry) - type(FEAM_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(FEAM_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call FEAM_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (FEAM_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_Pack(V, y%PtFairleadLoad, ValAry) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_Pack(V, y%LineMeshPosition, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine FEAM_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(FEAM_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (FEAM_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (FEAM_y_PtFairleadLoad) - call MV_Unpack2(Var, ValAry, y%PtFairleadLoad) ! Mesh - case (FEAM_y_LineMeshPosition) - call MV_Unpack2(Var, ValAry, y%LineMeshPosition) ! Mesh - end select - end associate -end subroutine - subroutine FEAM_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(FEAM_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call FEAM_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (FEAM_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_Unpack(V, ValAry, y%PtFairleadLoad) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_Unpack(V, ValAry, y%LineMeshPosition) ! Mesh + end select + end associate end do end subroutine END MODULE FEAMooring_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 3452d44239..109795d740 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -977,234 +977,200 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt END IF ! check if allocated END SUBROUTINE -function Conv_Rdtn_InputMeshPointer(u, ML) result(Mesh) +function Conv_Rdtn_InputMeshPointer(u, DL) result(Mesh) type(Conv_Rdtn_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function Conv_Rdtn_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function Conv_Rdtn_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function Conv_Rdtn_OutputMeshPointer(y, ML) result(Mesh) +function Conv_Rdtn_OutputMeshPointer(y, DL) result(Mesh) type(Conv_Rdtn_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function Conv_Rdtn_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function Conv_Rdtn_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine Conv_Rdtn_PackContStateVar(Var, x, ValAry) - type(Conv_Rdtn_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Conv_Rdtn_PackContStateAry(Vars, x, ValAry) type(Conv_Rdtn_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call Conv_Rdtn_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Conv_Rdtn_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine Conv_Rdtn_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call Conv_Rdtn_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine Conv_Rdtn_PackContStateDerivAry(Vars, x, ValAry) + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine Conv_Rdtn_PackConstrStateVar(Var, z, ValAry) - type(Conv_Rdtn_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine Conv_Rdtn_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine Conv_Rdtn_PackConstrStateAry(Vars, z, ValAry) type(Conv_Rdtn_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call Conv_Rdtn_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Conv_Rdtn_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine Conv_Rdtn_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call Conv_Rdtn_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine Conv_Rdtn_PackInputVar(Var, u, ValAry) - type(Conv_Rdtn_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_u_Velocity) - call MV_Pack2(Var, u%Velocity, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Conv_Rdtn_PackInputAry(Vars, u, ValAry) - type(Conv_Rdtn_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(Conv_Rdtn_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call Conv_Rdtn_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_u_Velocity) + call MV_Pack(V, u%Velocity(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Conv_Rdtn_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Conv_Rdtn_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_u_Velocity) - call MV_Unpack2(Var, ValAry, u%Velocity) ! Rank 1 Array - end select - end associate -end subroutine - subroutine Conv_Rdtn_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_InputType), intent(inout) :: u - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%u) - call Conv_Rdtn_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_u_Velocity) + call MV_Unpack(V, ValAry, u%Velocity(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine Conv_Rdtn_PackOutputVar(Var, y, ValAry) - type(Conv_Rdtn_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_y_F_Rdtn) - call MV_Pack2(Var, y%F_Rdtn, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Conv_Rdtn_PackOutputAry(Vars, y, ValAry) - type(Conv_Rdtn_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(Conv_Rdtn_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call Conv_Rdtn_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + call MV_Pack(V, y%F_Rdtn(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Conv_Rdtn_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Conv_Rdtn_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Conv_Rdtn_y_F_Rdtn) - call MV_Unpack2(Var, ValAry, y%F_Rdtn) ! Rank 1 Array - end select - end associate -end subroutine - subroutine Conv_Rdtn_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_OutputType), intent(inout) :: y - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%y) - call Conv_Rdtn_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + call MV_Unpack(V, ValAry, y%F_Rdtn(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE Conv_Radiation_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 0c6678baa0..fa73b37e83 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -970,7 +970,7 @@ subroutine HydroDyn_InitVars(Vars, u, p, x, y, m, InitOut, InputFileData, Linear if (p%WAMIT(k)%SS_Exctn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) call MV_AddVar(Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", FieldScalar, & - DatLoc(HydroDyn_x_WAMIT_SS_Exctn_x), & + DatLoc(HydroDyn_x_WAMIT_SS_Exctn_x, k), & Flags=VF_DerivOrder1, & Num=p%WAMIT(k)%SS_Exctn%numStates, & Perturb=20000.0_R8Ki * D2R_D, & @@ -981,7 +981,7 @@ subroutine HydroDyn_InitVars(Vars, u, p, x, y, m, InitOut, InputFileData, Linear if (p%WAMIT(k)%SS_Rdtn%numStates == 0) cycle if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) call MV_AddVar(Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", FieldScalar, & - DatLoc(HydroDyn_x_WAMIT_SS_Rdtn_x), & + DatLoc(HydroDyn_x_WAMIT_SS_Rdtn_x, k), & Flags=VF_DerivOrder1, & Num=p%WAMIT(k)%SS_Rdtn%numStates, & Perturb=2.0_R8Ki * D2R_D , & diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 8d1c40ecee..ca8b2ede5d 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -99,7 +99,7 @@ MODULE HydroDyn_Types ! ======================= ! ========= HydroDyn_InitOutputType ======= TYPE, PUBLIC :: HydroDyn_InitOutputType - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] TYPE(Morison_InitOutputType) :: Morison !< Initialization output from the Morison module [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] @@ -144,7 +144,6 @@ MODULE HydroDyn_Types ! ======================= ! ========= HydroDyn_ParameterType ======= TYPE, PUBLIC :: HydroDyn_ParameterType - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] TYPE(WAMIT_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< Parameter data for the WAMIT module [-] @@ -719,7 +718,9 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod character(*), parameter :: RoutineName = 'HydroDyn_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' - DstInitOutputData%Vars => SrcInitOutputData%Vars + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return call Morison_CopyInitOutput(SrcInitOutputData%Morison, DstInitOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -821,7 +822,8 @@ subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' - nullify(InitOutputData%Vars) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Morison_DestroyInitOutput(InitOutputData%Morison, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WriteOutputHdr)) then @@ -853,15 +855,8 @@ subroutine HydroDyn_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) call Morison_PackInitOutput(RF, InData%Morison) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) @@ -881,27 +876,8 @@ subroutine HydroDyn_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars call Morison_UnpackInitOutput(RF, OutData%Morison) ! Morison call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -1348,18 +1324,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(SrcParamData%Vars)) then - if (.not. associated(DstParamData%Vars)) then - allocate(DstParamData%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if DstParamData%nWAMITObj = SrcParamData%nWAMITObj DstParamData%vecMultiplier = SrcParamData%vecMultiplier if (allocated(SrcParamData%WAMIT)) then @@ -1529,12 +1493,6 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(ParamData%Vars)) then - call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(ParamData%Vars) - ParamData%Vars => null() - end if if (allocated(ParamData%WAMIT)) then LB(1:1) = lbound(ParamData%WAMIT, kind=B8Ki) UB(1:1) = ubound(ParamData%WAMIT, kind=B8Ki) @@ -1596,13 +1554,6 @@ subroutine HydroDyn_PackParam(RF, Indata) integer(B8Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if call RegPack(RF, InData%nWAMITObj) call RegPack(RF, InData%vecMultiplier) call RegPack(RF, allocated(InData%WAMIT)) @@ -1679,24 +1630,6 @@ subroutine HydroDyn_UnPackParam(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if call RegUnpack(RF, OutData%nWAMITObj); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%vecMultiplier); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) @@ -2665,12 +2598,12 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta END IF ! check if allocated END SUBROUTINE -function HydroDyn_InputMeshPointer(u, ML) result(Mesh) +function HydroDyn_InputMeshPointer(u, DL) result(Mesh) type(HydroDyn_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (HydroDyn_u_Morison_Mesh) Mesh => u%Morison%Mesh case (HydroDyn_u_WAMITMesh) @@ -2680,11 +2613,11 @@ function HydroDyn_InputMeshPointer(u, ML) result(Mesh) end select end function -function HydroDyn_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function HydroDyn_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (HydroDyn_u_Morison_Mesh) Name = "u%Morison%Mesh" case (HydroDyn_u_WAMITMesh) @@ -2694,16 +2627,16 @@ function HydroDyn_InputMeshName(ML) result(Name) end select end function -function HydroDyn_OutputMeshPointer(y, ML) result(Mesh) +function HydroDyn_OutputMeshPointer(y, DL) result(Mesh) type(HydroDyn_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (HydroDyn_y_WAMIT_Mesh) - Mesh => y%WAMIT(ML%i1)%Mesh + Mesh => y%WAMIT(DL%i1)%Mesh case (HydroDyn_y_WAMIT2_Mesh) - Mesh => y%WAMIT2(ML%i1)%Mesh + Mesh => y%WAMIT2(DL%i1)%Mesh case (HydroDyn_y_Morison_Mesh) Mesh => y%Morison%Mesh case (HydroDyn_y_Morison_VisMesh) @@ -2713,15 +2646,15 @@ function HydroDyn_OutputMeshPointer(y, ML) result(Mesh) end select end function -function HydroDyn_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function HydroDyn_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (HydroDyn_y_WAMIT_Mesh) - Name = "y%WAMIT("//trim(Num2LStr(ML%i1))//")%Mesh" + Name = "y%WAMIT("//trim(Num2LStr(DL%i1))//")%Mesh" case (HydroDyn_y_WAMIT2_Mesh) - Name = "y%WAMIT2("//trim(Num2LStr(ML%i1))//")%Mesh" + Name = "y%WAMIT2("//trim(Num2LStr(DL%i1))//")%Mesh" case (HydroDyn_y_Morison_Mesh) Name = "y%Morison%Mesh" case (HydroDyn_y_Morison_VisMesh) @@ -2731,256 +2664,234 @@ function HydroDyn_OutputMeshName(ML) result(Name) end select end function -subroutine HydroDyn_PackContStateVar(Var, x, ValAry) - type(HydroDyn_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (HydroDyn_x_WAMIT_SS_Rdtn_x) - call MV_Pack2(Var, x%WAMIT(DL%i1)%SS_Rdtn%x, ValAry) ! Rank 1 Array - case (HydroDyn_x_WAMIT_SS_Exctn_x) - call MV_Pack2(Var, x%WAMIT(DL%i1)%SS_Exctn%x, ValAry) ! Rank 1 Array - case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) - call MV_Pack2(Var, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState, ValAry) ! Scalar - case (HydroDyn_x_Morison_DummyContState) - call MV_Pack2(Var, x%Morison%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine HydroDyn_PackContStateAry(Vars, x, ValAry) type(HydroDyn_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call HydroDyn_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + call MV_Pack(V, x%WAMIT(DL%i1)%SS_Rdtn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + call MV_Pack(V, x%WAMIT(DL%i1)%SS_Exctn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + call MV_Pack(V, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState, ValAry) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + call MV_Pack(V, x%Morison%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine HydroDyn_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(HydroDyn_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (HydroDyn_x_WAMIT_SS_Rdtn_x) - call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%SS_Rdtn%x) ! Rank 1 Array - case (HydroDyn_x_WAMIT_SS_Exctn_x) - call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%SS_Exctn%x) ! Rank 1 Array - case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) - call MV_Unpack2(Var, ValAry, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState) ! Scalar - case (HydroDyn_x_Morison_DummyContState) - call MV_Unpack2(Var, ValAry, x%Morison%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine HydroDyn_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call HydroDyn_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%SS_Rdtn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%SS_Exctn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + call MV_Unpack(V, ValAry, x%Morison%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine HydroDyn_PackContStateDerivAry(Vars, x, ValAry) + type(HydroDyn_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + call MV_Pack(V, x%WAMIT(DL%i1)%SS_Rdtn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + call MV_Pack(V, x%WAMIT(DL%i1)%SS_Exctn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + call MV_Pack(V, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState, ValAry) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + call MV_Pack(V, x%Morison%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine HydroDyn_PackConstrStateVar(Var, z, ValAry) - type(HydroDyn_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) - call MV_Pack2(Var, z%WAMIT%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) - call MV_Pack2(Var, z%WAMIT%SS_Rdtn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) - call MV_Pack2(Var, z%WAMIT%SS_Exctn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_Morison_DummyConstrState) - call MV_Pack2(Var, z%Morison%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine HydroDyn_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%SS_Rdtn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%SS_Exctn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + call MV_Unpack(V, ValAry, x%Morison%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine HydroDyn_PackConstrStateAry(Vars, z, ValAry) type(HydroDyn_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call HydroDyn_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + call MV_Pack(V, z%WAMIT%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + call MV_Pack(V, z%WAMIT%SS_Rdtn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + call MV_Pack(V, z%WAMIT%SS_Exctn%DummyConstrState, ValAry) ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + call MV_Pack(V, z%Morison%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine HydroDyn_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(HydroDyn_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%WAMIT%Conv_Rdtn%DummyConstrState) ! Scalar - case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%WAMIT%SS_Rdtn%DummyConstrState) ! Scalar - case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%WAMIT%SS_Exctn%DummyConstrState) ! Scalar - case (HydroDyn_z_Morison_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%Morison%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine HydroDyn_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call HydroDyn_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + call MV_Unpack(V, ValAry, z%WAMIT%Conv_Rdtn%DummyConstrState) ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + call MV_Unpack(V, ValAry, z%WAMIT%SS_Rdtn%DummyConstrState) ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + call MV_Unpack(V, ValAry, z%WAMIT%SS_Exctn%DummyConstrState) ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + call MV_Unpack(V, ValAry, z%Morison%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine HydroDyn_PackInputVar(Var, u, ValAry) - type(HydroDyn_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (HydroDyn_u_Morison_Mesh) - call MV_Pack2(Var, u%Morison%Mesh, ValAry) ! Mesh - case (HydroDyn_u_WAMITMesh) - call MV_Pack2(Var, u%WAMITMesh, ValAry) ! Mesh - case (HydroDyn_u_PRPMesh) - call MV_Pack2(Var, u%PRPMesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine HydroDyn_PackInputAry(Vars, u, ValAry) - type(HydroDyn_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(HydroDyn_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call HydroDyn_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_Pack(V, u%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_u_WAMITMesh) + call MV_Pack(V, u%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_Pack(V, u%PRPMesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine HydroDyn_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(HydroDyn_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (HydroDyn_u_Morison_Mesh) - call MV_Unpack2(Var, ValAry, u%Morison%Mesh) ! Mesh - case (HydroDyn_u_WAMITMesh) - call MV_Unpack2(Var, ValAry, u%WAMITMesh) ! Mesh - case (HydroDyn_u_PRPMesh) - call MV_Unpack2(Var, ValAry, u%PRPMesh) ! Mesh - end select - end associate -end subroutine - subroutine HydroDyn_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_InputType), intent(inout) :: u - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%u) - call HydroDyn_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_Unpack(V, ValAry, u%Morison%Mesh) ! Mesh + case (HydroDyn_u_WAMITMesh) + call MV_Unpack(V, ValAry, u%WAMITMesh) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_Unpack(V, ValAry, u%PRPMesh) ! Mesh + end select + end associate end do end subroutine - -subroutine HydroDyn_PackOutputVar(Var, y, ValAry) - type(HydroDyn_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (HydroDyn_y_WAMIT_Mesh) - call MV_Pack2(Var, y%WAMIT(DL%i1)%Mesh, ValAry) ! Mesh - case (HydroDyn_y_WAMIT2_Mesh) - call MV_Pack2(Var, y%WAMIT2(DL%i1)%Mesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_Mesh) - call MV_Pack2(Var, y%Morison%Mesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_VisMesh) - call MV_Pack2(Var, y%Morison%VisMesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_WriteOutput) - call MV_Pack2(Var, y%Morison%WriteOutput, ValAry) ! Rank 1 Array - case (HydroDyn_y_WAMITMesh) - call MV_Pack2(Var, y%WAMITMesh, ValAry) ! Mesh - case (HydroDyn_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine HydroDyn_PackOutputAry(Vars, y, ValAry) - type(HydroDyn_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(HydroDyn_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call HydroDyn_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_Pack(V, y%WAMIT(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_Pack(V, y%WAMIT2(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_Pack(V, y%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_Pack(V, y%Morison%VisMesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + call MV_Pack(V, y%Morison%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_Pack(V, y%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine HydroDyn_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(HydroDyn_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (HydroDyn_y_WAMIT_Mesh) - call MV_Unpack2(Var, ValAry, y%WAMIT(DL%i1)%Mesh) ! Mesh - case (HydroDyn_y_WAMIT2_Mesh) - call MV_Unpack2(Var, ValAry, y%WAMIT2(DL%i1)%Mesh) ! Mesh - case (HydroDyn_y_Morison_Mesh) - call MV_Unpack2(Var, ValAry, y%Morison%Mesh) ! Mesh - case (HydroDyn_y_Morison_VisMesh) - call MV_Unpack2(Var, ValAry, y%Morison%VisMesh) ! Mesh - case (HydroDyn_y_Morison_WriteOutput) - call MV_Unpack2(Var, ValAry, y%Morison%WriteOutput) ! Rank 1 Array - case (HydroDyn_y_WAMITMesh) - call MV_Unpack2(Var, ValAry, y%WAMITMesh) ! Mesh - case (HydroDyn_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine HydroDyn_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_OutputType), intent(inout) :: y - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%y) - call HydroDyn_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_Unpack(V, ValAry, y%WAMIT(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_Unpack(V, ValAry, y%WAMIT2(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_Unpack(V, ValAry, y%Morison%Mesh) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_Unpack(V, ValAry, y%Morison%VisMesh) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + call MV_Unpack(V, ValAry, y%Morison%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_Unpack(V, ValAry, y%WAMITMesh) ! Mesh + case (HydroDyn_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE HydroDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 5c10d5dff0..477ceb165c 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -4665,33 +4665,33 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat END IF ! check if allocated END SUBROUTINE -function Morison_InputMeshPointer(u, ML) result(Mesh) +function Morison_InputMeshPointer(u, DL) result(Mesh) type(Morison_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (Morison_u_Mesh) Mesh => u%Mesh end select end function -function Morison_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function Morison_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (Morison_u_Mesh) Name = "u%Mesh" end select end function -function Morison_OutputMeshPointer(y, ML) result(Mesh) +function Morison_OutputMeshPointer(y, DL) result(Mesh) type(Morison_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (Morison_y_Mesh) Mesh => y%Mesh case (Morison_y_VisMesh) @@ -4699,11 +4699,11 @@ function Morison_OutputMeshPointer(y, ML) result(Mesh) end select end function -function Morison_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function Morison_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (Morison_y_Mesh) Name = "y%Mesh" case (Morison_y_VisMesh) @@ -4711,208 +4711,174 @@ function Morison_OutputMeshName(ML) result(Name) end select end function -subroutine Morison_PackContStateVar(Var, x, ValAry) - type(Morison_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Morison_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Morison_PackContStateAry(Vars, x, ValAry) type(Morison_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call Morison_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Morison_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Morison_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Morison_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Morison_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine Morison_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Morison_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call Morison_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Morison_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine Morison_PackContStateDerivAry(Vars, x, ValAry) + type(Morison_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Morison_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine Morison_PackConstrStateVar(Var, z, ValAry) - type(Morison_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Morison_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine Morison_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Morison_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine Morison_PackConstrStateAry(Vars, z, ValAry) type(Morison_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call Morison_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (Morison_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Morison_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Morison_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Morison_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine Morison_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Morison_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call Morison_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (Morison_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine Morison_PackInputVar(Var, u, ValAry) - type(Morison_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Morison_u_Mesh) - call MV_Pack2(Var, u%Mesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Morison_PackInputAry(Vars, u, ValAry) - type(Morison_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(Morison_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call Morison_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (Morison_u_Mesh) + call MV_Pack(V, u%Mesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Morison_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Morison_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Morison_u_Mesh) - call MV_Unpack2(Var, ValAry, u%Mesh) ! Mesh - end select - end associate -end subroutine - subroutine Morison_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Morison_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call Morison_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (Morison_u_Mesh) + call MV_Unpack(V, ValAry, u%Mesh) ! Mesh + end select + end associate end do end subroutine - -subroutine Morison_PackOutputVar(Var, y, ValAry) - type(Morison_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Morison_y_Mesh) - call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh - case (Morison_y_VisMesh) - call MV_Pack2(Var, y%VisMesh, ValAry) ! Mesh - case (Morison_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Morison_PackOutputAry(Vars, y, ValAry) - type(Morison_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(Morison_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call Morison_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (Morison_y_Mesh) + call MV_Pack(V, y%Mesh, ValAry) ! Mesh + case (Morison_y_VisMesh) + call MV_Pack(V, y%VisMesh, ValAry) ! Mesh + case (Morison_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Morison_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Morison_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Morison_y_Mesh) - call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh - case (Morison_y_VisMesh) - call MV_Unpack2(Var, ValAry, y%VisMesh) ! Mesh - case (Morison_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine Morison_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Morison_OutputType), intent(inout) :: y - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%y) - call Morison_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (Morison_y_Mesh) + call MV_Unpack(V, ValAry, y%Mesh) ! Mesh + case (Morison_y_VisMesh) + call MV_Unpack(V, ValAry, y%VisMesh) ! Mesh + case (Morison_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE Morison_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 80442bda3d..3ad29cfb38 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -1158,238 +1158,204 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, END IF ! check if allocated END SUBROUTINE -function SS_Exc_InputMeshPointer(u, ML) result(Mesh) +function SS_Exc_InputMeshPointer(u, DL) result(Mesh) type(SS_Exc_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SS_Exc_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SS_Exc_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function SS_Exc_OutputMeshPointer(y, ML) result(Mesh) +function SS_Exc_OutputMeshPointer(y, DL) result(Mesh) type(SS_Exc_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SS_Exc_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SS_Exc_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine SS_Exc_PackContStateVar(Var, x, ValAry) - type(SS_Exc_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Exc_x_x) - call MV_Pack2(Var, x%x, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SS_Exc_PackContStateAry(Vars, x, ValAry) type(SS_Exc_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call SS_Exc_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SS_Exc_x_x) + call MV_Pack(V, x%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SS_Exc_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Exc_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Exc_x_x) - call MV_Unpack2(Var, ValAry, x%x) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SS_Exc_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call SS_Exc_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SS_Exc_x_x) + call MV_Unpack(V, ValAry, x%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine SS_Exc_PackContStateDerivAry(Vars, x, ValAry) + type(SS_Exc_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SS_Exc_x_x) + call MV_Pack(V, x%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine SS_Exc_PackConstrStateVar(Var, z, ValAry) - type(SS_Exc_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Exc_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine SS_Exc_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SS_Exc_x_x) + call MV_Unpack(V, ValAry, x%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine SS_Exc_PackConstrStateAry(Vars, z, ValAry) type(SS_Exc_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call SS_Exc_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SS_Exc_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SS_Exc_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Exc_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Exc_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine SS_Exc_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call SS_Exc_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SS_Exc_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine SS_Exc_PackInputVar(Var, u, ValAry) - type(SS_Exc_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Exc_u_PtfmPos) - call MV_Pack2(Var, u%PtfmPos, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SS_Exc_PackInputAry(Vars, u, ValAry) - type(SS_Exc_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SS_Exc_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call SS_Exc_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SS_Exc_u_PtfmPos) + call MV_Pack(V, u%PtfmPos(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SS_Exc_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Exc_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Exc_u_PtfmPos) - call MV_Unpack2(Var, ValAry, u%PtfmPos) ! Rank 2 Array - end select - end associate -end subroutine - subroutine SS_Exc_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Exc_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call SS_Exc_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SS_Exc_u_PtfmPos) + call MV_Unpack(V, ValAry, u%PtfmPos(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine - -subroutine SS_Exc_PackOutputVar(Var, y, ValAry) - type(SS_Exc_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Exc_y_y) - call MV_Pack2(Var, y%y, ValAry) ! Rank 1 Array - case (SS_Exc_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SS_Exc_PackOutputAry(Vars, y, ValAry) - type(SS_Exc_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SS_Exc_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call SS_Exc_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SS_Exc_y_y) + call MV_Pack(V, y%y(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SS_Exc_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Exc_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Exc_y_y) - call MV_Unpack2(Var, ValAry, y%y) ! Rank 1 Array - case (SS_Exc_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SS_Exc_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Exc_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call SS_Exc_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SS_Exc_y_y) + call MV_Unpack(V, ValAry, y%y(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE SS_Excitation_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 6ce22be8d6..578c020384 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -1079,238 +1079,204 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, END IF ! check if allocated END SUBROUTINE -function SS_Rad_InputMeshPointer(u, ML) result(Mesh) +function SS_Rad_InputMeshPointer(u, DL) result(Mesh) type(SS_Rad_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SS_Rad_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SS_Rad_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function SS_Rad_OutputMeshPointer(y, ML) result(Mesh) +function SS_Rad_OutputMeshPointer(y, DL) result(Mesh) type(SS_Rad_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SS_Rad_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SS_Rad_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine SS_Rad_PackContStateVar(Var, x, ValAry) - type(SS_Rad_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Rad_x_x) - call MV_Pack2(Var, x%x, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SS_Rad_PackContStateAry(Vars, x, ValAry) type(SS_Rad_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call SS_Rad_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SS_Rad_x_x) + call MV_Pack(V, x%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SS_Rad_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Rad_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Rad_x_x) - call MV_Unpack2(Var, ValAry, x%x) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SS_Rad_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call SS_Rad_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SS_Rad_x_x) + call MV_Unpack(V, ValAry, x%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine SS_Rad_PackContStateDerivAry(Vars, x, ValAry) + type(SS_Rad_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SS_Rad_x_x) + call MV_Pack(V, x%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine SS_Rad_PackConstrStateVar(Var, z, ValAry) - type(SS_Rad_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Rad_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine SS_Rad_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SS_Rad_x_x) + call MV_Unpack(V, ValAry, x%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine SS_Rad_PackConstrStateAry(Vars, z, ValAry) type(SS_Rad_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call SS_Rad_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SS_Rad_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SS_Rad_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Rad_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Rad_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine SS_Rad_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call SS_Rad_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SS_Rad_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine SS_Rad_PackInputVar(Var, u, ValAry) - type(SS_Rad_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Rad_u_dq) - call MV_Pack2(Var, u%dq, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SS_Rad_PackInputAry(Vars, u, ValAry) - type(SS_Rad_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SS_Rad_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call SS_Rad_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SS_Rad_u_dq) + call MV_Pack(V, u%dq(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SS_Rad_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Rad_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Rad_u_dq) - call MV_Unpack2(Var, ValAry, u%dq) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SS_Rad_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Rad_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call SS_Rad_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SS_Rad_u_dq) + call MV_Unpack(V, ValAry, u%dq(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine SS_Rad_PackOutputVar(Var, y, ValAry) - type(SS_Rad_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Rad_y_y) - call MV_Pack2(Var, y%y, ValAry) ! Rank 1 Array - case (SS_Rad_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SS_Rad_PackOutputAry(Vars, y, ValAry) - type(SS_Rad_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SS_Rad_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call SS_Rad_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SS_Rad_y_y) + call MV_Pack(V, y%y(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SS_Rad_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Rad_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SS_Rad_y_y) - call MV_Unpack2(Var, ValAry, y%y) ! Rank 1 Array - case (SS_Rad_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SS_Rad_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Rad_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call SS_Rad_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SS_Rad_y_y) + call MV_Unpack(V, ValAry, y%y(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE SS_Radiation_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index acd5caee2d..142efd3543 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -634,74 +634,59 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE -function WAMIT2_OutputMeshPointer(y, ML) result(Mesh) +function WAMIT2_OutputMeshPointer(y, DL) result(Mesh) type(WAMIT2_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (WAMIT2_y_Mesh) Mesh => y%Mesh end select end function -function WAMIT2_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function WAMIT2_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (WAMIT2_y_Mesh) Name = "y%Mesh" end select end function -subroutine WAMIT2_PackOutputVar(Var, y, ValAry) - type(WAMIT2_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT2_y_Mesh) - call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine WAMIT2_PackOutputAry(Vars, y, ValAry) - type(WAMIT2_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(WAMIT2_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call WAMIT2_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (WAMIT2_y_Mesh) + call MV_Pack(V, y%Mesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WAMIT2_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT2_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT2_y_Mesh) - call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh - end select - end associate -end subroutine - subroutine WAMIT2_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT2_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT2_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call WAMIT2_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (WAMIT2_y_Mesh) + call MV_Unpack(V, ValAry, y%Mesh) ! Mesh + end select + end associate end do end subroutine END MODULE WAMIT2_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index a1b42574d2..3029684733 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -1434,258 +1434,232 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE -function WAMIT_InputMeshPointer(u, ML) result(Mesh) +function WAMIT_InputMeshPointer(u, DL) result(Mesh) type(WAMIT_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (WAMIT_u_Mesh) Mesh => u%Mesh end select end function -function WAMIT_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function WAMIT_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (WAMIT_u_Mesh) Name = "u%Mesh" end select end function -function WAMIT_OutputMeshPointer(y, ML) result(Mesh) +function WAMIT_OutputMeshPointer(y, DL) result(Mesh) type(WAMIT_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (WAMIT_y_Mesh) Mesh => y%Mesh end select end function -function WAMIT_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function WAMIT_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (WAMIT_y_Mesh) Name = "y%Mesh" end select end function -subroutine WAMIT_PackContStateVar(Var, x, ValAry) - type(WAMIT_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT_x_SS_Rdtn_x) - call MV_Pack2(Var, x%SS_Rdtn%x, ValAry) ! Rank 1 Array - case (WAMIT_x_SS_Exctn_x) - call MV_Pack2(Var, x%SS_Exctn%x, ValAry) ! Rank 1 Array - case (WAMIT_x_Conv_Rdtn_DummyContState) - call MV_Pack2(Var, x%Conv_Rdtn%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine WAMIT_PackContStateAry(Vars, x, ValAry) type(WAMIT_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call WAMIT_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + call MV_Pack(V, x%SS_Rdtn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + call MV_Pack(V, x%SS_Exctn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + call MV_Pack(V, x%Conv_Rdtn%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WAMIT_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT_x_SS_Rdtn_x) - call MV_Unpack2(Var, ValAry, x%SS_Rdtn%x) ! Rank 1 Array - case (WAMIT_x_SS_Exctn_x) - call MV_Unpack2(Var, ValAry, x%SS_Exctn%x) ! Rank 1 Array - case (WAMIT_x_Conv_Rdtn_DummyContState) - call MV_Unpack2(Var, ValAry, x%Conv_Rdtn%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine WAMIT_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call WAMIT_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + call MV_Unpack(V, ValAry, x%SS_Rdtn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + call MV_Unpack(V, ValAry, x%SS_Exctn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + call MV_Unpack(V, ValAry, x%Conv_Rdtn%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine WAMIT_PackContStateDerivAry(Vars, x, ValAry) + type(WAMIT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + call MV_Pack(V, x%SS_Rdtn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + call MV_Pack(V, x%SS_Exctn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + call MV_Pack(V, x%Conv_Rdtn%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine WAMIT_PackConstrStateVar(Var, z, ValAry) - type(WAMIT_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT_z_Conv_Rdtn_DummyConstrState) - call MV_Pack2(Var, z%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar - case (WAMIT_z_SS_Rdtn_DummyConstrState) - call MV_Pack2(Var, z%SS_Rdtn%DummyConstrState, ValAry) ! Scalar - case (WAMIT_z_SS_Exctn_DummyConstrState) - call MV_Pack2(Var, z%SS_Exctn%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine WAMIT_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + call MV_Unpack(V, ValAry, x%SS_Rdtn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + call MV_Unpack(V, ValAry, x%SS_Exctn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + call MV_Unpack(V, ValAry, x%Conv_Rdtn%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine WAMIT_PackConstrStateAry(Vars, z, ValAry) type(WAMIT_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call WAMIT_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + call MV_Pack(V, z%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + call MV_Pack(V, z%SS_Rdtn%DummyConstrState, ValAry) ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + call MV_Pack(V, z%SS_Exctn%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WAMIT_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT_z_Conv_Rdtn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%Conv_Rdtn%DummyConstrState) ! Scalar - case (WAMIT_z_SS_Rdtn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%SS_Rdtn%DummyConstrState) ! Scalar - case (WAMIT_z_SS_Exctn_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%SS_Exctn%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine WAMIT_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call WAMIT_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + call MV_Unpack(V, ValAry, z%Conv_Rdtn%DummyConstrState) ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + call MV_Unpack(V, ValAry, z%SS_Rdtn%DummyConstrState) ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + call MV_Unpack(V, ValAry, z%SS_Exctn%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine WAMIT_PackInputVar(Var, u, ValAry) - type(WAMIT_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT_u_Mesh) - call MV_Pack2(Var, u%Mesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine WAMIT_PackInputAry(Vars, u, ValAry) - type(WAMIT_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(WAMIT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call WAMIT_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (WAMIT_u_Mesh) + call MV_Pack(V, u%Mesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WAMIT_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT_u_Mesh) - call MV_Unpack2(Var, ValAry, u%Mesh) ! Mesh - end select - end associate -end subroutine - subroutine WAMIT_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call WAMIT_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (WAMIT_u_Mesh) + call MV_Unpack(V, ValAry, u%Mesh) ! Mesh + end select + end associate end do end subroutine - -subroutine WAMIT_PackOutputVar(Var, y, ValAry) - type(WAMIT_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT_y_Mesh) - call MV_Pack2(Var, y%Mesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine WAMIT_PackOutputAry(Vars, y, ValAry) - type(WAMIT_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(WAMIT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call WAMIT_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (WAMIT_y_Mesh) + call MV_Pack(V, y%Mesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WAMIT_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WAMIT_y_Mesh) - call MV_Unpack2(Var, ValAry, y%Mesh) ! Mesh - end select - end associate -end subroutine - subroutine WAMIT_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call WAMIT_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (WAMIT_y_Mesh) + call MV_Unpack(V, ValAry, y%Mesh) ! Mesh + end select + end associate end do end subroutine END MODULE WAMIT_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 981a0d8f82..290e11de69 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -1747,250 +1747,220 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E END IF ! check if allocated END SUBROUTINE -function IceD_InputMeshPointer(u, ML) result(Mesh) +function IceD_InputMeshPointer(u, DL) result(Mesh) type(IceD_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (IceD_u_PointMesh) Mesh => u%PointMesh end select end function -function IceD_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function IceD_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (IceD_u_PointMesh) Name = "u%PointMesh" end select end function -function IceD_OutputMeshPointer(y, ML) result(Mesh) +function IceD_OutputMeshPointer(y, DL) result(Mesh) type(IceD_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (IceD_y_PointMesh) Mesh => y%PointMesh end select end function -function IceD_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function IceD_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (IceD_y_PointMesh) Name = "y%PointMesh" end select end function -subroutine IceD_PackContStateVar(Var, x, ValAry) - type(IceD_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceD_x_q) - call MV_Pack2(Var, x%q, ValAry) ! Scalar - case (IceD_x_dqdt) - call MV_Pack2(Var, x%dqdt, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine IceD_PackContStateAry(Vars, x, ValAry) type(IceD_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call IceD_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (IceD_x_q) + call MV_Pack(V, x%q, ValAry) ! Scalar + case (IceD_x_dqdt) + call MV_Pack(V, x%dqdt, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine IceD_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(IceD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceD_x_q) - call MV_Unpack2(Var, ValAry, x%q) ! Scalar - case (IceD_x_dqdt) - call MV_Unpack2(Var, ValAry, x%dqdt) ! Scalar - end select - end associate -end subroutine - subroutine IceD_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(IceD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call IceD_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (IceD_x_q) + call MV_Unpack(V, ValAry, x%q) ! Scalar + case (IceD_x_dqdt) + call MV_Unpack(V, ValAry, x%dqdt) ! Scalar + end select + end associate end do end subroutine +subroutine IceD_PackContStateDerivAry(Vars, x, ValAry) + type(IceD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (IceD_x_q) + call MV_Pack(V, x%q, ValAry) ! Scalar + case (IceD_x_dqdt) + call MV_Pack(V, x%dqdt, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine IceD_PackConstrStateVar(Var, z, ValAry) - type(IceD_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine IceD_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (IceD_x_q) + call MV_Unpack(V, ValAry, x%q) ! Scalar + case (IceD_x_dqdt) + call MV_Unpack(V, ValAry, x%dqdt) ! Scalar + end select + end associate + end do end subroutine subroutine IceD_PackConstrStateAry(Vars, z, ValAry) type(IceD_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call IceD_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (IceD_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine IceD_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(IceD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine IceD_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(IceD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call IceD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (IceD_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine IceD_PackInputVar(Var, u, ValAry) - type(IceD_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceD_u_PointMesh) - call MV_Pack2(Var, u%PointMesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine IceD_PackInputAry(Vars, u, ValAry) - type(IceD_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(IceD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call IceD_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (IceD_u_PointMesh) + call MV_Pack(V, u%PointMesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine IceD_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(IceD_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceD_u_PointMesh) - call MV_Unpack2(Var, ValAry, u%PointMesh) ! Mesh - end select - end associate -end subroutine - subroutine IceD_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(IceD_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call IceD_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (IceD_u_PointMesh) + call MV_Unpack(V, ValAry, u%PointMesh) ! Mesh + end select + end associate end do end subroutine - -subroutine IceD_PackOutputVar(Var, y, ValAry) - type(IceD_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceD_y_PointMesh) - call MV_Pack2(Var, y%PointMesh, ValAry) ! Mesh - case (IceD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine IceD_PackOutputAry(Vars, y, ValAry) - type(IceD_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(IceD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call IceD_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (IceD_y_PointMesh) + call MV_Pack(V, y%PointMesh, ValAry) ! Mesh + case (IceD_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine IceD_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(IceD_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceD_y_PointMesh) - call MV_Unpack2(Var, ValAry, y%PointMesh) ! Mesh - case (IceD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine IceD_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(IceD_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call IceD_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (IceD_y_PointMesh) + call MV_Unpack(V, ValAry, y%PointMesh) ! Mesh + case (IceD_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE IceDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 0df3890fe2..5071995252 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -1028,246 +1028,212 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat END IF ! check if allocated END SUBROUTINE -function IceFloe_InputMeshPointer(u, ML) result(Mesh) +function IceFloe_InputMeshPointer(u, DL) result(Mesh) type(IceFloe_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (IceFloe_u_iceMesh) Mesh => u%iceMesh end select end function -function IceFloe_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function IceFloe_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (IceFloe_u_iceMesh) Name = "u%iceMesh" end select end function -function IceFloe_OutputMeshPointer(y, ML) result(Mesh) +function IceFloe_OutputMeshPointer(y, DL) result(Mesh) type(IceFloe_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (IceFloe_y_iceMesh) Mesh => y%iceMesh end select end function -function IceFloe_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function IceFloe_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (IceFloe_y_iceMesh) Name = "y%iceMesh" end select end function -subroutine IceFloe_PackContStateVar(Var, x, ValAry) - type(IceFloe_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceFloe_x_DummyContStateVar) - call MV_Pack2(Var, x%DummyContStateVar, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine IceFloe_PackContStateAry(Vars, x, ValAry) type(IceFloe_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call IceFloe_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + call MV_Pack(V, x%DummyContStateVar, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine IceFloe_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(IceFloe_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceFloe_x_DummyContStateVar) - call MV_Unpack2(Var, ValAry, x%DummyContStateVar) ! Scalar - end select - end associate -end subroutine - subroutine IceFloe_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call IceFloe_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + call MV_Unpack(V, ValAry, x%DummyContStateVar) ! Scalar + end select + end associate end do end subroutine +subroutine IceFloe_PackContStateDerivAry(Vars, x, ValAry) + type(IceFloe_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + call MV_Pack(V, x%DummyContStateVar, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine IceFloe_PackConstrStateVar(Var, z, ValAry) - type(IceFloe_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceFloe_z_DummyConstrStateVar) - call MV_Pack2(Var, z%DummyConstrStateVar, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine IceFloe_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + call MV_Unpack(V, ValAry, x%DummyContStateVar) ! Scalar + end select + end associate + end do end subroutine subroutine IceFloe_PackConstrStateAry(Vars, z, ValAry) type(IceFloe_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call IceFloe_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (IceFloe_z_DummyConstrStateVar) + call MV_Pack(V, z%DummyConstrStateVar, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine IceFloe_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(IceFloe_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceFloe_z_DummyConstrStateVar) - call MV_Unpack2(Var, ValAry, z%DummyConstrStateVar) ! Scalar - end select - end associate -end subroutine - subroutine IceFloe_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call IceFloe_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (IceFloe_z_DummyConstrStateVar) + call MV_Unpack(V, ValAry, z%DummyConstrStateVar) ! Scalar + end select + end associate end do end subroutine - -subroutine IceFloe_PackInputVar(Var, u, ValAry) - type(IceFloe_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceFloe_u_iceMesh) - call MV_Pack2(Var, u%iceMesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine IceFloe_PackInputAry(Vars, u, ValAry) - type(IceFloe_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(IceFloe_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call IceFloe_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (IceFloe_u_iceMesh) + call MV_Pack(V, u%iceMesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine IceFloe_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(IceFloe_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceFloe_u_iceMesh) - call MV_Unpack2(Var, ValAry, u%iceMesh) ! Mesh - end select - end associate -end subroutine - subroutine IceFloe_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(IceFloe_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call IceFloe_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (IceFloe_u_iceMesh) + call MV_Unpack(V, ValAry, u%iceMesh) ! Mesh + end select + end associate end do end subroutine - -subroutine IceFloe_PackOutputVar(Var, y, ValAry) - type(IceFloe_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceFloe_y_iceMesh) - call MV_Pack2(Var, y%iceMesh, ValAry) ! Mesh - case (IceFloe_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine IceFloe_PackOutputAry(Vars, y, ValAry) - type(IceFloe_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(IceFloe_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call IceFloe_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (IceFloe_y_iceMesh) + call MV_Pack(V, y%iceMesh, ValAry) ! Mesh + case (IceFloe_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine IceFloe_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(IceFloe_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (IceFloe_y_iceMesh) - call MV_Unpack2(Var, ValAry, y%iceMesh) ! Mesh - case (IceFloe_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine IceFloe_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_OutputType), intent(inout) :: y - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%y) - call IceFloe_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (IceFloe_y_iceMesh) + call MV_Unpack(V, ValAry, y%iceMesh) ! Mesh + case (IceFloe_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE IceFloe_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 7e11f3efb7..c6660444a0 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -1086,5 +1086,7 @@ subroutine IfW_FlowField_UnPackFlowFieldType(RF, OutData) call IfW_FlowField_UnpackPointsFieldType(RF, OutData%Points) ! Points call IfW_FlowField_UnpackUserFieldType(RF, OutData%User) ! User end subroutine + END MODULE IfW_FlowField_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index d73375f43e..15cf43a747 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -454,7 +454,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons ! Module Variables !---------------------------------------------------------------------------- - call IfW_InitVars(InitInp, p, y, m, InitOutData, InitInp%Linearize, TmpErrStat, TmpErrMsg) + call IfW_InitVars(InitOutData%Vars, InitInp, p, y, m, InitOutData, InitInp%Linearize, TmpErrStat, TmpErrMsg) call SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) !---------------------------------------------------------------------------- @@ -538,15 +538,16 @@ logical function Failed() end function Failed END SUBROUTINE InflowWind_Init -subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) - type(InflowWind_InitInputType), intent(in) :: InitInp !< Initialization input - type(InflowWind_ParameterType), intent(inout) :: p !< Parameters - type(InflowWind_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; - type(InflowWind_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) - type(InflowWind_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine - logical, intent(in) :: Linearize !< Flag to initialize linearization variables - integer(IntKi), intent(out) :: ErrStat !< Error status of the operation - character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None +subroutine IfW_InitVars(Vars, InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables + type(InflowWind_InitInputType), intent(in) :: InitInp !< Initialization input + type(InflowWind_ParameterType), intent(inout) :: p !< Parameters + type(InflowWind_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(InflowWind_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(InflowWind_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None character(*), parameter :: RoutineName = 'MAP_InitVars' integer(IntKi) :: ErrStat2 ! Temporary Error status @@ -557,17 +558,6 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - ! Allocate space for variables (deallocate if already allocated) - if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Add pointers to vars to initialization output - InitOut%Vars => p%Vars - !---------------------------------------------------------------------------- ! Continuous State Variables !---------------------------------------------------------------------------- @@ -576,15 +566,15 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Input variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, DatLoc(InflowWind_u_HWindSpeed), & + call MV_AddVar(Vars%u, "HWindSpeed", FieldScalar, DatLoc(InflowWind_u_HWindSpeed), & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: horizontal wind speed (steady/uniform wind) (hub), m/s']) - call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, DatLoc(InflowWind_u_PLExp), & + call MV_AddVar(Vars%u, "PLExp", FieldScalar, DatLoc(InflowWind_u_PLExp), & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: vertical power-law shear exponent (hub), -']) - call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, DatLoc(InflowWind_u_PropagationDir), & + call MV_AddVar(Vars%u, "PropagationDir", FieldScalar, DatLoc(InflowWind_u_PropagationDir), & Flags=ior(VF_ExtLin, VF_Linearize), & LinNames=['Extended input: propagation direction (hub), rad']) @@ -592,19 +582,19 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Output variables !---------------------------------------------------------------------------- - call MV_AddVar(p%Vars%y, "HWindSpeed", FieldScalar, DatLoc(InflowWind_y_HWindSpeed), & + call MV_AddVar(Vars%y, "HWindSpeed", FieldScalar, DatLoc(InflowWind_y_HWindSpeed), & Flags=VF_ExtLin, & LinNames=['Extended output: horizontal wind speed (steady/uniform wind) (hub), m/s']) - call MV_AddVar(p%Vars%y, "PLExp", FieldScalar, DatLoc(InflowWind_y_PLExp), & + call MV_AddVar(Vars%y, "PLExp", FieldScalar, DatLoc(InflowWind_y_PLExp), & Flags=VF_ExtLin, & LinNames=['Extended output: vertical power-law shear exponent (hub), -']) - call MV_AddVar(p%Vars%y, "PropagationDir", FieldScalar, DatLoc(InflowWind_y_PropagationDir), & + call MV_AddVar(Vars%y, "PropagationDir", FieldScalar, DatLoc(InflowWind_y_PropagationDir), & Flags=VF_ExtLin, & LinNames=['Extended output: propagation direction (hub), rad']) - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(InflowWind_y_WriteOutput), & + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(InflowWind_y_WriteOutput), & Flags=VF_WriteOut, & Num=p%NumOuts, & LinNames=[(WriteOutputLinName(i), i = 1, p%NumOuts)]) @@ -613,7 +603,7 @@ subroutine IfW_InitVars(InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) ! Initialize Variables and Jacobian data !---------------------------------------------------------------------------- - CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return contains character(LinChanLen) function WriteOutputLinName(idx) @@ -957,7 +947,7 @@ END SUBROUTINE IfW_UniformWind_JacobianPInput !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code SUBROUTINE InflowWind_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) - TYPE(ModVarsType), INTENT(OUT ) :: Vars !< Module variables + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -992,7 +982,7 @@ END SUBROUTINE InflowWind_JacobianPContState !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code SUBROUTINE InflowWind_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) - TYPE(ModVarsType), INTENT(OUT ) :: Vars !< Module variables + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1027,7 +1017,7 @@ END SUBROUTINE InflowWind_JacobianPDiscState !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code SUBROUTINE InflowWind_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) - TYPE(ModVarsType), INTENT(OUT ) :: Vars !< Module variables + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1072,13 +1062,13 @@ subroutine InflowWind_PackExtInputAry(Vars, t, p, ValAry) select case(Var%DL%Num) case (InflowWind_u_HWindSpeed) call CalcExtOP() - call MV_Pack2(Var, op%VelH, ValAry) + call MV_Pack(Var, op%VelH, ValAry) case (InflowWind_u_PLExp) call CalcExtOP() - call MV_Pack2(Var, op%ShrV, ValAry) + call MV_Pack(Var, op%ShrV, ValAry) case (InflowWind_u_PropagationDir) call CalcExtOP() - call MV_Pack2(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + call MV_Pack(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) end select end associate end do @@ -1101,7 +1091,7 @@ subroutine CalcExtOP() end subroutine subroutine InflowWind_PackExtOutputAry(Vars, t, p, ValAry) - type(ModVarsType), intent(in) :: Vars !< Time + type(ModVarsType), intent(in) :: Vars real(DbKi), intent(in) :: t !< Time in seconds at operating point type(InflowWind_ParameterType), intent(in) :: p !< Parameters real(R8Ki), intent(inout) :: ValAry(:) @@ -1114,13 +1104,13 @@ subroutine InflowWind_PackExtOutputAry(Vars, t, p, ValAry) select case(Var%DL%Num) case (InflowWind_y_HWindSpeed) call CalcExtOP() - call MV_Pack2(Var, op%VelH, ValAry) + call MV_Pack(Var, op%VelH, ValAry) case (InflowWind_y_PLExp) call CalcExtOP() - call MV_Pack2(Var, op%ShrV, ValAry) + call MV_Pack(Var, op%ShrV, ValAry) case (InflowWind_y_PropagationDir) call CalcExtOP() - call MV_Pack2(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + call MV_Pack(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) end select end associate end do diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index b505f1851d..10d3c4f9c0 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -121,14 +121,13 @@ typedef ^ ^ LOGICAL RotFra typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - typedef ^ ^ FlowFieldType *FlowField - - - "Flow field data to represent all wind types" - -typedef ^ ^ ModVarsType *Vars - - - "Module Variables" +typedef ^ ^ ModVarsType Vars - - - "Module Variables" # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" -typedef ^ ^ CHARACTER(1024) RootFileName - - - "Root of the InflowWind input filename" - +typedef ^ ParameterType CHARACTER(1024) RootFileName - - - "Root of the InflowWind input filename" - typedef ^ ^ DbKi DT - - - "Time step for cont. state integration & disc. state update" seconds typedef ^ ^ ReKi WindViXYZprime :: - - "List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ )" meters typedef ^ ^ ReKi WindViXYZ :: - - "List of XYZ coordinates for wind velocity measurements, 3xNWindVel" meters diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 2d69550e5d..a2c3c12993 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -738,5 +738,7 @@ subroutine InflowWind_IO_UnPackPoints_InitInputType(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%NumWindPoints); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE InflowWind_IO_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index bedad1921d..b320e52e48 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -140,12 +140,11 @@ MODULE InflowWind_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data to represent all wind types [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE InflowWind_InitOutputType ! ======================= ! ========= InflowWind_ParameterType ======= TYPE, PUBLIC :: InflowWind_ParameterType - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] CHARACTER(1024) :: RootFileName !< Root of the InflowWind input filename [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZprime !< List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ ) [meters] @@ -738,7 +737,9 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if DstInitOutputData%FlowField => SrcInitOutputData%FlowField - DstInitOutputData%Vars => SrcInitOutputData%Vars + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -776,7 +777,8 @@ subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%IsLoad_u) end if nullify(InitOutputData%FlowField) - nullify(InitOutputData%Vars) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackInitOutput(RF, Indata) @@ -801,13 +803,7 @@ subroutine InflowWind_PackInitOutput(RF, Indata) call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -848,24 +844,7 @@ subroutine InflowWind_UnPackInitOutput(RF, OutData) else OutData%FlowField => null() end if - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -881,18 +860,6 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E character(*), parameter :: RoutineName = 'InflowWind_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(SrcParamData%Vars)) then - if (.not. associated(DstParamData%Vars)) then - allocate(DstParamData%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if DstParamData%RootFileName = SrcParamData%RootFileName DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%WindViXYZprime)) then @@ -990,12 +957,6 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'InflowWind_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(ParamData%Vars)) then - call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(ParamData%Vars) - ParamData%Vars => null() - end if if (allocated(ParamData%WindViXYZprime)) then deallocate(ParamData%WindViXYZprime) end if @@ -1035,13 +996,6 @@ subroutine InflowWind_PackParam(RF, Indata) integer(B8Ki) :: LB(2), UB(2) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if call RegPack(RF, InData%RootFileName) call RegPack(RF, InData%DT) call RegPackAlloc(RF, InData%WindViXYZprime) @@ -1082,24 +1036,6 @@ subroutine InflowWind_UnPackParam(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if call RegUnpack(RF, OutData%RootFileName); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WindViXYZprime); if (RegCheckErr(RF, RoutineName)) return @@ -1964,298 +1900,264 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE -function InflowWind_InputMeshPointer(u, ML) result(Mesh) +function InflowWind_InputMeshPointer(u, DL) result(Mesh) type(InflowWind_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function InflowWind_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function InflowWind_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function InflowWind_OutputMeshPointer(y, ML) result(Mesh) +function InflowWind_OutputMeshPointer(y, DL) result(Mesh) type(InflowWind_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function InflowWind_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function InflowWind_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine InflowWind_PackContStateVar(Var, x, ValAry) - type(InflowWind_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (InflowWind_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine InflowWind_PackContStateAry(Vars, x, ValAry) type(InflowWind_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call InflowWind_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (InflowWind_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine InflowWind_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(InflowWind_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (InflowWind_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine InflowWind_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call InflowWind_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (InflowWind_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine InflowWind_PackContStateDerivAry(Vars, x, ValAry) + type(InflowWind_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (InflowWind_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine InflowWind_PackConstrStateVar(Var, z, ValAry) - type(InflowWind_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (InflowWind_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine InflowWind_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (InflowWind_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine InflowWind_PackConstrStateAry(Vars, z, ValAry) type(InflowWind_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call InflowWind_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (InflowWind_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine InflowWind_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(InflowWind_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (InflowWind_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine InflowWind_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call InflowWind_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (InflowWind_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine InflowWind_PackInputVar(Var, u, ValAry) - type(InflowWind_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (InflowWind_u_PositionXYZ) - call MV_Pack2(Var, u%PositionXYZ, ValAry) ! Rank 2 Array - case (InflowWind_u_lidar_PulseLidEl) - call MV_Pack2(Var, u%lidar%PulseLidEl, ValAry) ! Scalar - case (InflowWind_u_lidar_PulseLidAz) - call MV_Pack2(Var, u%lidar%PulseLidAz, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementX) - call MV_Pack2(Var, u%lidar%HubDisplacementX, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementY) - call MV_Pack2(Var, u%lidar%HubDisplacementY, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementZ) - call MV_Pack2(Var, u%lidar%HubDisplacementZ, ValAry) ! Scalar - case (InflowWind_u_HubPosition) - call MV_Pack2(Var, u%HubPosition, ValAry) ! Rank 1 Array - case (InflowWind_u_HubOrientation) - call MV_Pack2(Var, u%HubOrientation, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine InflowWind_PackInputAry(Vars, u, ValAry) - type(InflowWind_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(InflowWind_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call InflowWind_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (InflowWind_u_PositionXYZ) + call MV_Pack(V, u%PositionXYZ(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + call MV_Pack(V, u%lidar%PulseLidEl, ValAry) ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + call MV_Pack(V, u%lidar%PulseLidAz, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + call MV_Pack(V, u%lidar%HubDisplacementX, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + call MV_Pack(V, u%lidar%HubDisplacementY, ValAry) ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + call MV_Pack(V, u%lidar%HubDisplacementZ, ValAry) ! Scalar + case (InflowWind_u_HubPosition) + call MV_Pack(V, u%HubPosition(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (InflowWind_u_HubOrientation) + call MV_Pack(V, u%HubOrientation(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine InflowWind_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(InflowWind_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (InflowWind_u_PositionXYZ) - call MV_Unpack2(Var, ValAry, u%PositionXYZ) ! Rank 2 Array - case (InflowWind_u_lidar_PulseLidEl) - call MV_Unpack2(Var, ValAry, u%lidar%PulseLidEl) ! Scalar - case (InflowWind_u_lidar_PulseLidAz) - call MV_Unpack2(Var, ValAry, u%lidar%PulseLidAz) ! Scalar - case (InflowWind_u_lidar_HubDisplacementX) - call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementX) ! Scalar - case (InflowWind_u_lidar_HubDisplacementY) - call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementY) ! Scalar - case (InflowWind_u_lidar_HubDisplacementZ) - call MV_Unpack2(Var, ValAry, u%lidar%HubDisplacementZ) ! Scalar - case (InflowWind_u_HubPosition) - call MV_Unpack2(Var, ValAry, u%HubPosition) ! Rank 1 Array - case (InflowWind_u_HubOrientation) - call MV_Unpack2(Var, ValAry, u%HubOrientation) ! Rank 2 Array - end select - end associate -end subroutine - subroutine InflowWind_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_InputType), intent(inout) :: u - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%u) - call InflowWind_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (InflowWind_u_PositionXYZ) + call MV_Unpack(V, ValAry, u%PositionXYZ(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + call MV_Unpack(V, ValAry, u%lidar%PulseLidEl) ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + call MV_Unpack(V, ValAry, u%lidar%PulseLidAz) ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + call MV_Unpack(V, ValAry, u%lidar%HubDisplacementX) ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + call MV_Unpack(V, ValAry, u%lidar%HubDisplacementY) ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + call MV_Unpack(V, ValAry, u%lidar%HubDisplacementZ) ! Scalar + case (InflowWind_u_HubPosition) + call MV_Unpack(V, ValAry, u%HubPosition(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (InflowWind_u_HubOrientation) + call MV_Unpack(V, ValAry, u%HubOrientation(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine - -subroutine InflowWind_PackOutputVar(Var, y, ValAry) - type(InflowWind_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (InflowWind_y_VelocityUVW) - call MV_Pack2(Var, y%VelocityUVW, ValAry) ! Rank 2 Array - case (InflowWind_y_AccelUVW) - call MV_Pack2(Var, y%AccelUVW, ValAry) ! Rank 2 Array - case (InflowWind_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (InflowWind_y_DiskVel) - call MV_Pack2(Var, y%DiskVel, ValAry) ! Rank 1 Array - case (InflowWind_y_HubVel) - call MV_Pack2(Var, y%HubVel, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_LidSpeed) - call MV_Pack2(Var, y%lidar%LidSpeed, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_WtTrunc) - call MV_Pack2(Var, y%lidar%WtTrunc, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsX) - call MV_Pack2(Var, y%lidar%MsrPositionsX, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsY) - call MV_Pack2(Var, y%lidar%MsrPositionsY, ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsZ) - call MV_Pack2(Var, y%lidar%MsrPositionsZ, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine InflowWind_PackOutputAry(Vars, y, ValAry) type(InflowWind_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call InflowWind_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (InflowWind_y_VelocityUVW) + call MV_Pack(V, y%VelocityUVW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (InflowWind_y_AccelUVW) + call MV_Pack(V, y%AccelUVW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (InflowWind_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (InflowWind_y_DiskVel) + call MV_Pack(V, y%DiskVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (InflowWind_y_HubVel) + call MV_Pack(V, y%HubVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + call MV_Pack(V, y%lidar%LidSpeed(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + call MV_Pack(V, y%lidar%WtTrunc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + call MV_Pack(V, y%lidar%MsrPositionsX(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + call MV_Pack(V, y%lidar%MsrPositionsY(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + call MV_Pack(V, y%lidar%MsrPositionsZ(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine InflowWind_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(InflowWind_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (InflowWind_y_VelocityUVW) - call MV_Unpack2(Var, ValAry, y%VelocityUVW) ! Rank 2 Array - case (InflowWind_y_AccelUVW) - call MV_Unpack2(Var, ValAry, y%AccelUVW) ! Rank 2 Array - case (InflowWind_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (InflowWind_y_DiskVel) - call MV_Unpack2(Var, ValAry, y%DiskVel) ! Rank 1 Array - case (InflowWind_y_HubVel) - call MV_Unpack2(Var, ValAry, y%HubVel) ! Rank 1 Array - case (InflowWind_y_lidar_LidSpeed) - call MV_Unpack2(Var, ValAry, y%lidar%LidSpeed) ! Rank 1 Array - case (InflowWind_y_lidar_WtTrunc) - call MV_Unpack2(Var, ValAry, y%lidar%WtTrunc) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsX) - call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsX) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsY) - call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsY) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsZ) - call MV_Unpack2(Var, ValAry, y%lidar%MsrPositionsZ) ! Rank 1 Array - end select - end associate -end subroutine - subroutine InflowWind_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_OutputType), intent(inout) :: y - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%y) - call InflowWind_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (InflowWind_y_VelocityUVW) + call MV_Unpack(V, ValAry, y%VelocityUVW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (InflowWind_y_AccelUVW) + call MV_Unpack(V, ValAry, y%AccelUVW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (InflowWind_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (InflowWind_y_DiskVel) + call MV_Unpack(V, ValAry, y%DiskVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (InflowWind_y_HubVel) + call MV_Unpack(V, ValAry, y%HubVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + call MV_Unpack(V, ValAry, y%lidar%LidSpeed(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + call MV_Unpack(V, ValAry, y%lidar%WtTrunc(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + call MV_Unpack(V, ValAry, y%lidar%MsrPositionsX(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + call MV_Unpack(V, ValAry, y%lidar%MsrPositionsY(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + call MV_Unpack(V, ValAry, y%lidar%MsrPositionsZ(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE InflowWind_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 799edb8eaf..08c1ba8ae1 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -1110,266 +1110,232 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, END IF ! check if allocated END SUBROUTINE -function Lidar_InputMeshPointer(u, ML) result(Mesh) +function Lidar_InputMeshPointer(u, DL) result(Mesh) type(Lidar_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function Lidar_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function Lidar_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function Lidar_OutputMeshPointer(y, ML) result(Mesh) +function Lidar_OutputMeshPointer(y, DL) result(Mesh) type(Lidar_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function Lidar_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function Lidar_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine Lidar_PackContStateVar(Var, x, ValAry) - type(Lidar_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Lidar_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Lidar_PackContStateAry(Vars, x, ValAry) type(Lidar_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call Lidar_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Lidar_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Lidar_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Lidar_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Lidar_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine Lidar_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Lidar_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call Lidar_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Lidar_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine Lidar_PackContStateDerivAry(Vars, x, ValAry) + type(Lidar_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Lidar_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine Lidar_PackConstrStateVar(Var, z, ValAry) - type(Lidar_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Lidar_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine Lidar_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Lidar_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine Lidar_PackConstrStateAry(Vars, z, ValAry) type(Lidar_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call Lidar_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (Lidar_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Lidar_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Lidar_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Lidar_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine Lidar_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Lidar_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call Lidar_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (Lidar_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine Lidar_PackInputVar(Var, u, ValAry) - type(Lidar_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Lidar_u_PulseLidEl) - call MV_Pack2(Var, u%PulseLidEl, ValAry) ! Scalar - case (Lidar_u_PulseLidAz) - call MV_Pack2(Var, u%PulseLidAz, ValAry) ! Scalar - case (Lidar_u_HubDisplacementX) - call MV_Pack2(Var, u%HubDisplacementX, ValAry) ! Scalar - case (Lidar_u_HubDisplacementY) - call MV_Pack2(Var, u%HubDisplacementY, ValAry) ! Scalar - case (Lidar_u_HubDisplacementZ) - call MV_Pack2(Var, u%HubDisplacementZ, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Lidar_PackInputAry(Vars, u, ValAry) - type(Lidar_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(Lidar_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call Lidar_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (Lidar_u_PulseLidEl) + call MV_Pack(V, u%PulseLidEl, ValAry) ! Scalar + case (Lidar_u_PulseLidAz) + call MV_Pack(V, u%PulseLidAz, ValAry) ! Scalar + case (Lidar_u_HubDisplacementX) + call MV_Pack(V, u%HubDisplacementX, ValAry) ! Scalar + case (Lidar_u_HubDisplacementY) + call MV_Pack(V, u%HubDisplacementY, ValAry) ! Scalar + case (Lidar_u_HubDisplacementZ) + call MV_Pack(V, u%HubDisplacementZ, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Lidar_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Lidar_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Lidar_u_PulseLidEl) - call MV_Unpack2(Var, ValAry, u%PulseLidEl) ! Scalar - case (Lidar_u_PulseLidAz) - call MV_Unpack2(Var, ValAry, u%PulseLidAz) ! Scalar - case (Lidar_u_HubDisplacementX) - call MV_Unpack2(Var, ValAry, u%HubDisplacementX) ! Scalar - case (Lidar_u_HubDisplacementY) - call MV_Unpack2(Var, ValAry, u%HubDisplacementY) ! Scalar - case (Lidar_u_HubDisplacementZ) - call MV_Unpack2(Var, ValAry, u%HubDisplacementZ) ! Scalar - end select - end associate -end subroutine - subroutine Lidar_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Lidar_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call Lidar_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (Lidar_u_PulseLidEl) + call MV_Unpack(V, ValAry, u%PulseLidEl) ! Scalar + case (Lidar_u_PulseLidAz) + call MV_Unpack(V, ValAry, u%PulseLidAz) ! Scalar + case (Lidar_u_HubDisplacementX) + call MV_Unpack(V, ValAry, u%HubDisplacementX) ! Scalar + case (Lidar_u_HubDisplacementY) + call MV_Unpack(V, ValAry, u%HubDisplacementY) ! Scalar + case (Lidar_u_HubDisplacementZ) + call MV_Unpack(V, ValAry, u%HubDisplacementZ) ! Scalar + end select + end associate end do end subroutine - -subroutine Lidar_PackOutputVar(Var, y, ValAry) - type(Lidar_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Lidar_y_LidSpeed) - call MV_Pack2(Var, y%LidSpeed, ValAry) ! Rank 1 Array - case (Lidar_y_WtTrunc) - call MV_Pack2(Var, y%WtTrunc, ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsX) - call MV_Pack2(Var, y%MsrPositionsX, ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsY) - call MV_Pack2(Var, y%MsrPositionsY, ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsZ) - call MV_Pack2(Var, y%MsrPositionsZ, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Lidar_PackOutputAry(Vars, y, ValAry) - type(Lidar_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(Lidar_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call Lidar_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (Lidar_y_LidSpeed) + call MV_Pack(V, y%LidSpeed(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (Lidar_y_WtTrunc) + call MV_Pack(V, y%WtTrunc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + call MV_Pack(V, y%MsrPositionsX(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + call MV_Pack(V, y%MsrPositionsY(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + call MV_Pack(V, y%MsrPositionsZ(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Lidar_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Lidar_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Lidar_y_LidSpeed) - call MV_Unpack2(Var, ValAry, y%LidSpeed) ! Rank 1 Array - case (Lidar_y_WtTrunc) - call MV_Unpack2(Var, ValAry, y%WtTrunc) ! Rank 1 Array - case (Lidar_y_MsrPositionsX) - call MV_Unpack2(Var, ValAry, y%MsrPositionsX) ! Rank 1 Array - case (Lidar_y_MsrPositionsY) - call MV_Unpack2(Var, ValAry, y%MsrPositionsY) ! Rank 1 Array - case (Lidar_y_MsrPositionsZ) - call MV_Unpack2(Var, ValAry, y%MsrPositionsZ) ! Rank 1 Array - end select - end associate -end subroutine - subroutine Lidar_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Lidar_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call Lidar_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (Lidar_y_LidSpeed) + call MV_Unpack(V, ValAry, y%LidSpeed(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (Lidar_y_WtTrunc) + call MV_Unpack(V, ValAry, y%WtTrunc(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + call MV_Unpack(V, ValAry, y%MsrPositionsX(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + call MV_Unpack(V, ValAry, y%MsrPositionsY(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + call MV_Unpack(V, ValAry, y%MsrPositionsZ(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE Lidar_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 9da3a9462c..c1269d4443 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -80,7 +80,7 @@ MODULE MAP_Types CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputHdr !< first line output file contents: output variable names [-] CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE MAP_InitOutputType ! ======================= ! ========= MAP_ContinuousStateType_C ======= @@ -193,7 +193,6 @@ MODULE MAP_Types END TYPE MAP_ParameterType_C TYPE, PUBLIC :: MAP_ParameterType TYPE( MAP_ParameterType_C ) :: C_obj - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(R8Ki) :: g = 0.0_R8Ki !< gravitational constant [[kg/m^2]] REAL(R8Ki) :: depth = 0.0_R8Ki !< distance to seabed [[m]] REAL(R8Ki) :: rho_sea = 0.0_R8Ki !< density of seawater [[m]] @@ -463,7 +462,9 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstInitOutputData%Vars => SrcInitOutputData%Vars + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -483,14 +484,14 @@ subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(InitOutputData%Vars) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(MAP_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackInitOutput' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) @@ -502,13 +503,7 @@ subroutine MAP_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%writeOutputHdr) call RegPackAlloc(RF, InData%writeOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -519,8 +514,6 @@ subroutine MAP_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%progName); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%progName = transfer(OutData%progName, OutData%C_obj%progName ) @@ -531,24 +524,7 @@ subroutine MAP_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine SUBROUTINE MAP_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) @@ -1927,24 +1903,9 @@ subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(SrcParamData%Vars)) then - if (.not. associated(DstParamData%Vars)) then - allocate(DstParamData%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if DstParamData%g = SrcParamData%g DstParamData%C_obj%g = SrcParamData%C_obj%g DstParamData%depth = SrcParamData%depth @@ -1963,36 +1924,20 @@ subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) type(MAP_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(ParamData%Vars)) then - call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(ParamData%Vars) - ParamData%Vars => null() - end if end subroutine subroutine MAP_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(MAP_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackParam' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if call RegPack(RF, InData%g) call RegPack(RF, InData%depth) call RegPack(RF, InData%rho_sea) @@ -2007,30 +1952,7 @@ subroutine MAP_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%g = OutData%g call RegUnpack(RF, OutData%depth); if (RegCheckErr(RF, RoutineName)) return @@ -3090,290 +3012,256 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE -function MAP_InputMeshPointer(u, ML) result(Mesh) +function MAP_InputMeshPointer(u, DL) result(Mesh) type(MAP_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (MAP_u_PtFairDisplacement) Mesh => u%PtFairDisplacement end select end function -function MAP_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function MAP_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (MAP_u_PtFairDisplacement) Name = "u%PtFairDisplacement" end select end function -function MAP_OutputMeshPointer(y, ML) result(Mesh) +function MAP_OutputMeshPointer(y, DL) result(Mesh) type(MAP_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (MAP_y_ptFairleadLoad) Mesh => y%ptFairleadLoad end select end function -function MAP_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function MAP_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (MAP_y_ptFairleadLoad) Name = "y%ptFairleadLoad" end select end function -subroutine MAP_PackContStateVar(Var, x, ValAry) - type(MAP_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MAP_x_dummy) - call MV_Pack2(Var, x%dummy, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine MAP_PackContStateAry(Vars, x, ValAry) type(MAP_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call MAP_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (MAP_x_dummy) + call MV_Pack(V, x%dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine MAP_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(MAP_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MAP_x_dummy) - call MV_Unpack2(Var, ValAry, x%dummy) ! Scalar - end select - end associate -end subroutine - subroutine MAP_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(MAP_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call MAP_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (MAP_x_dummy) + call MV_Unpack(V, ValAry, x%dummy) ! Scalar + end select + end associate end do end subroutine +subroutine MAP_PackContStateDerivAry(Vars, x, ValAry) + type(MAP_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (MAP_x_dummy) + call MV_Pack(V, x%dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine MAP_PackConstrStateVar(Var, z, ValAry) - type(MAP_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MAP_z_H) - call MV_Pack2(Var, z%H, ValAry) ! Rank 1 Array - case (MAP_z_V) - call MV_Pack2(Var, z%V, ValAry) ! Rank 1 Array - case (MAP_z_x) - call MV_Pack2(Var, z%x, ValAry) ! Rank 1 Array - case (MAP_z_y) - call MV_Pack2(Var, z%y, ValAry) ! Rank 1 Array - case (MAP_z_z) - call MV_Pack2(Var, z%z, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine MAP_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (MAP_x_dummy) + call MV_Unpack(V, ValAry, x%dummy) ! Scalar + end select + end associate + end do end subroutine subroutine MAP_PackConstrStateAry(Vars, z, ValAry) type(MAP_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call MAP_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (MAP_z_H) + call MV_Pack(V, z%H(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_z_V) + call MV_Pack(V, z%V(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_z_x) + call MV_Pack(V, z%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_z_y) + call MV_Pack(V, z%y(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_z_z) + call MV_Pack(V, z%z(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine MAP_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(MAP_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MAP_z_H) - call MV_Unpack2(Var, ValAry, z%H) ! Rank 1 Array - case (MAP_z_V) - call MV_Unpack2(Var, ValAry, z%V) ! Rank 1 Array - case (MAP_z_x) - call MV_Unpack2(Var, ValAry, z%x) ! Rank 1 Array - case (MAP_z_y) - call MV_Unpack2(Var, ValAry, z%y) ! Rank 1 Array - case (MAP_z_z) - call MV_Unpack2(Var, ValAry, z%z) ! Rank 1 Array - end select - end associate -end subroutine - subroutine MAP_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(MAP_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call MAP_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (MAP_z_H) + call MV_Unpack(V, ValAry, z%H(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_z_V) + call MV_Unpack(V, ValAry, z%V(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_z_x) + call MV_Unpack(V, ValAry, z%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_z_y) + call MV_Unpack(V, ValAry, z%y(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_z_z) + call MV_Unpack(V, ValAry, z%z(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine MAP_PackInputVar(Var, u, ValAry) - type(MAP_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MAP_u_x) - call MV_Pack2(Var, u%x, ValAry) ! Rank 1 Array - case (MAP_u_y) - call MV_Pack2(Var, u%y, ValAry) ! Rank 1 Array - case (MAP_u_z) - call MV_Pack2(Var, u%z, ValAry) ! Rank 1 Array - case (MAP_u_PtFairDisplacement) - call MV_Pack2(Var, u%PtFairDisplacement, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine MAP_PackInputAry(Vars, u, ValAry) - type(MAP_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(MAP_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call MAP_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (MAP_u_x) + call MV_Pack(V, u%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_u_y) + call MV_Pack(V, u%y(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_u_z) + call MV_Pack(V, u%z(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_Pack(V, u%PtFairDisplacement, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine MAP_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(MAP_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MAP_u_x) - call MV_Unpack2(Var, ValAry, u%x) ! Rank 1 Array - case (MAP_u_y) - call MV_Unpack2(Var, ValAry, u%y) ! Rank 1 Array - case (MAP_u_z) - call MV_Unpack2(Var, ValAry, u%z) ! Rank 1 Array - case (MAP_u_PtFairDisplacement) - call MV_Unpack2(Var, ValAry, u%PtFairDisplacement) ! Mesh - end select - end associate -end subroutine - subroutine MAP_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(MAP_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call MAP_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (MAP_u_x) + call MV_Unpack(V, ValAry, u%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_u_y) + call MV_Unpack(V, ValAry, u%y(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_u_z) + call MV_Unpack(V, ValAry, u%z(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_Unpack(V, ValAry, u%PtFairDisplacement) ! Mesh + end select + end associate end do end subroutine - -subroutine MAP_PackOutputVar(Var, y, ValAry) - type(MAP_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MAP_y_Fx) - call MV_Pack2(Var, y%Fx, ValAry) ! Rank 1 Array - case (MAP_y_Fy) - call MV_Pack2(Var, y%Fy, ValAry) ! Rank 1 Array - case (MAP_y_Fz) - call MV_Pack2(Var, y%Fz, ValAry) ! Rank 1 Array - case (MAP_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (MAP_y_wrtOutput) - call MV_Pack2(Var, y%wrtOutput, ValAry) ! Rank 1 Array - case (MAP_y_ptFairleadLoad) - call MV_Pack2(Var, y%ptFairleadLoad, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine MAP_PackOutputAry(Vars, y, ValAry) - type(MAP_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(MAP_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call MAP_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (MAP_y_Fx) + call MV_Pack(V, y%Fx(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_y_Fy) + call MV_Pack(V, y%Fy(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_y_Fz) + call MV_Pack(V, y%Fz(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_y_wrtOutput) + call MV_Pack(V, y%wrtOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_Pack(V, y%ptFairleadLoad, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine MAP_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(MAP_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MAP_y_Fx) - call MV_Unpack2(Var, ValAry, y%Fx) ! Rank 1 Array - case (MAP_y_Fy) - call MV_Unpack2(Var, ValAry, y%Fy) ! Rank 1 Array - case (MAP_y_Fz) - call MV_Unpack2(Var, ValAry, y%Fz) ! Rank 1 Array - case (MAP_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (MAP_y_wrtOutput) - call MV_Unpack2(Var, ValAry, y%wrtOutput) ! Rank 1 Array - case (MAP_y_ptFairleadLoad) - call MV_Unpack2(Var, ValAry, y%ptFairleadLoad) ! Mesh - end select - end associate -end subroutine - subroutine MAP_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(MAP_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call MAP_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (MAP_y_Fx) + call MV_Unpack(V, ValAry, y%Fx(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_y_Fy) + call MV_Unpack(V, ValAry, y%Fy(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_y_Fz) + call MV_Unpack(V, ValAry, y%Fz(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_y_wrtOutput) + call MV_Unpack(V, ValAry, y%wrtOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_Unpack(V, ValAry, y%ptFairleadLoad) ! Mesh + end select + end associate end do end subroutine END MODULE MAP_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index bf7c11062c..169201d98a 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -2974,15 +2974,17 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E allocate(p%Vars%u(0)) - call MV_AddMeshVar(p%Vars%u, "CoupledKinematics", MotionFields, & - DatLoc(MD_u_CoupledKinematics), & - Mesh=u%CoupledKinematics(1), & - Perturbs=[dl_slack_min, & ! FieldTransDisp - 0.1_R8Ki, & ! FieldOrientation - 0.1_R8Ki, & ! FieldTransVel - 0.1_R8Ki, & ! FieldAngularVel - 0.1_R8Ki, & ! FieldTransAcc - 0.1_R8Ki]) ! FieldAngularAcc + do i = 1, p%nTurbines + call MV_AddMeshVar(p%Vars%u, "CoupledKinematics", MotionFields, & + DatLoc(MD_u_CoupledKinematics, i), & + Mesh=u%CoupledKinematics(i), & + Perturbs=[dl_slack_min, & ! FieldTransDisp + 0.1_R8Ki, & ! FieldOrientation + 0.1_R8Ki, & ! FieldTransVel + 0.1_R8Ki, & ! FieldAngularVel + 0.1_R8Ki, & ! FieldTransAcc + 0.1_R8Ki]) ! FieldAngularAcc + end do ! This could be stored more efficiently, but maintains order compatible with previous implementation. if (allocated(u%DeltaL)) then @@ -3022,8 +3024,11 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! Output variables !------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, "LinNames_y", LoadFields, DatLoc(MD_y_CoupledLoads), & - Mesh=y%CoupledLoads(1)) + do i = 1, p%nTurbines + call MV_AddMeshVar(p%Vars%y, "LinNames_y", LoadFields, & + DatLoc(MD_y_CoupledLoads, i), & + Mesh=y%CoupledLoads(i)) + end do ! Write outputs call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(MD_y_WriteOutput), & diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index f2f2f13f04..d8358482d3 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -5120,286 +5120,252 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ! check if allocated END SUBROUTINE -function MD_InputMeshPointer(u, ML) result(Mesh) - type(MD_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function MD_InputMeshPointer(u, DL) result(Mesh) + type(MD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (MD_u_CoupledKinematics) - Mesh => u%CoupledKinematics(ML%i1) + Mesh => u%CoupledKinematics(DL%i1) end select end function -function MD_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function MD_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (MD_u_CoupledKinematics) - Name = "u%CoupledKinematics("//trim(Num2LStr(ML%i1))//")" + Name = "u%CoupledKinematics("//trim(Num2LStr(DL%i1))//")" end select end function -function MD_OutputMeshPointer(y, ML) result(Mesh) +function MD_OutputMeshPointer(y, DL) result(Mesh) type(MD_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (MD_y_CoupledLoads) - Mesh => y%CoupledLoads(ML%i1) + Mesh => y%CoupledLoads(DL%i1) case (MD_y_VisLinesMesh) - Mesh => y%VisLinesMesh(ML%i1) + Mesh => y%VisLinesMesh(DL%i1) case (MD_y_VisRodsMesh) - Mesh => y%VisRodsMesh(ML%i1) + Mesh => y%VisRodsMesh(DL%i1) case (MD_y_VisBodiesMesh) - Mesh => y%VisBodiesMesh(ML%i1) + Mesh => y%VisBodiesMesh(DL%i1) case (MD_y_VisAnchsMesh) - Mesh => y%VisAnchsMesh(ML%i1) + Mesh => y%VisAnchsMesh(DL%i1) end select end function -function MD_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function MD_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (MD_y_CoupledLoads) - Name = "y%CoupledLoads("//trim(Num2LStr(ML%i1))//")" + Name = "y%CoupledLoads("//trim(Num2LStr(DL%i1))//")" case (MD_y_VisLinesMesh) - Name = "y%VisLinesMesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%VisLinesMesh("//trim(Num2LStr(DL%i1))//")" case (MD_y_VisRodsMesh) - Name = "y%VisRodsMesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%VisRodsMesh("//trim(Num2LStr(DL%i1))//")" case (MD_y_VisBodiesMesh) - Name = "y%VisBodiesMesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%VisBodiesMesh("//trim(Num2LStr(DL%i1))//")" case (MD_y_VisAnchsMesh) - Name = "y%VisAnchsMesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%VisAnchsMesh("//trim(Num2LStr(DL%i1))//")" end select end function -subroutine MD_PackContStateVar(Var, x, ValAry) - type(MD_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MD_x_states) - call MV_Pack2(Var, x%states, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine MD_PackContStateAry(Vars, x, ValAry) type(MD_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call MD_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (MD_x_states) + call MV_Pack(V, x%states(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine MD_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(MD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MD_x_states) - call MV_Unpack2(Var, ValAry, x%states) ! Rank 1 Array - end select - end associate -end subroutine - subroutine MD_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(MD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call MD_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (MD_x_states) + call MV_Unpack(V, ValAry, x%states(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine MD_PackContStateDerivAry(Vars, x, ValAry) + type(MD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (MD_x_states) + call MV_Pack(V, x%states(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine MD_PackConstrStateVar(Var, z, ValAry) - type(MD_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MD_z_dummy) - call MV_Pack2(Var, z%dummy, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine MD_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (MD_x_states) + call MV_Unpack(V, ValAry, x%states(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine MD_PackConstrStateAry(Vars, z, ValAry) type(MD_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call MD_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (MD_z_dummy) + call MV_Pack(V, z%dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine MD_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(MD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MD_z_dummy) - call MV_Unpack2(Var, ValAry, z%dummy) ! Scalar - end select - end associate -end subroutine - subroutine MD_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(MD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call MD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (MD_z_dummy) + call MV_Unpack(V, ValAry, z%dummy) ! Scalar + end select + end associate end do end subroutine - -subroutine MD_PackInputVar(Var, u, ValAry) - type(MD_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MD_u_CoupledKinematics) - call MV_Pack2(Var, u%CoupledKinematics(DL%i1), ValAry) ! Mesh - case (MD_u_DeltaL) - call MV_Pack2(Var, u%DeltaL, ValAry) ! Rank 1 Array - case (MD_u_DeltaLdot) - call MV_Pack2(Var, u%DeltaLdot, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine MD_PackInputAry(Vars, u, ValAry) - type(MD_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(MD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call MD_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (MD_u_CoupledKinematics) + call MV_Pack(V, u%CoupledKinematics(DL%i1), ValAry) ! Mesh + case (MD_u_DeltaL) + call MV_Pack(V, u%DeltaL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MD_u_DeltaLdot) + call MV_Pack(V, u%DeltaLdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine MD_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(MD_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MD_u_CoupledKinematics) - call MV_Unpack2(Var, ValAry, u%CoupledKinematics(DL%i1)) ! Mesh - case (MD_u_DeltaL) - call MV_Unpack2(Var, ValAry, u%DeltaL) ! Rank 1 Array - case (MD_u_DeltaLdot) - call MV_Unpack2(Var, ValAry, u%DeltaLdot) ! Rank 1 Array - end select - end associate -end subroutine - subroutine MD_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(MD_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call MD_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (MD_u_CoupledKinematics) + call MV_Unpack(V, ValAry, u%CoupledKinematics(DL%i1)) ! Mesh + case (MD_u_DeltaL) + call MV_Unpack(V, ValAry, u%DeltaL(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MD_u_DeltaLdot) + call MV_Unpack(V, ValAry, u%DeltaLdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine MD_PackOutputVar(Var, y, ValAry) - type(MD_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MD_y_CoupledLoads) - call MV_Pack2(Var, y%CoupledLoads(DL%i1), ValAry) ! Mesh - case (MD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (MD_y_VisLinesMesh) - call MV_Pack2(Var, y%VisLinesMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisRodsMesh) - call MV_Pack2(Var, y%VisRodsMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisBodiesMesh) - call MV_Pack2(Var, y%VisBodiesMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisAnchsMesh) - call MV_Pack2(Var, y%VisAnchsMesh(DL%i1), ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine MD_PackOutputAry(Vars, y, ValAry) - type(MD_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(MD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call MD_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (MD_y_CoupledLoads) + call MV_Pack(V, y%CoupledLoads(DL%i1), ValAry) ! Mesh + case (MD_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_Pack(V, y%VisLinesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisRodsMesh) + call MV_Pack(V, y%VisRodsMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_Pack(V, y%VisBodiesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_Pack(V, y%VisAnchsMesh(DL%i1), ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine MD_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(MD_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (MD_y_CoupledLoads) - call MV_Unpack2(Var, ValAry, y%CoupledLoads(DL%i1)) ! Mesh - case (MD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (MD_y_VisLinesMesh) - call MV_Unpack2(Var, ValAry, y%VisLinesMesh(DL%i1)) ! Mesh - case (MD_y_VisRodsMesh) - call MV_Unpack2(Var, ValAry, y%VisRodsMesh(DL%i1)) ! Mesh - case (MD_y_VisBodiesMesh) - call MV_Unpack2(Var, ValAry, y%VisBodiesMesh(DL%i1)) ! Mesh - case (MD_y_VisAnchsMesh) - call MV_Unpack2(Var, ValAry, y%VisAnchsMesh(DL%i1)) ! Mesh - end select - end associate -end subroutine - subroutine MD_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(MD_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call MD_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (MD_y_CoupledLoads) + call MV_Unpack(V, ValAry, y%CoupledLoads(DL%i1)) ! Mesh + case (MD_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_Unpack(V, ValAry, y%VisLinesMesh(DL%i1)) ! Mesh + case (MD_y_VisRodsMesh) + call MV_Unpack(V, ValAry, y%VisRodsMesh(DL%i1)) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_Unpack(V, ValAry, y%VisBodiesMesh(DL%i1)) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_Unpack(V, ValAry, y%VisAnchsMesh(DL%i1)) ! Mesh + end select + end associate end do end subroutine END MODULE MoorDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 4fc0e0d354..09b529cc23 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -30,7 +30,7 @@ module ModVar implicit none private -public :: MV_InitVarsJac, MV_Pack, MV_Unpack, MV_Pack2, MV_Unpack2 +public :: MV_InitVarsJac, MV_Pack, MV_Unpack public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff, MV_ExtrapInterp, MV_AddDelta public :: MV_AddVar, MV_AddMeshVar public :: MV_HasFlags, MV_SetFlags, MV_ClearFlags, MV_NumVars, MV_NumVals, MV_FindVarDatLoc @@ -38,7 +38,7 @@ module ModVar public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv public :: MV_FieldString, MV_IsLoad, IdxStr public :: DumpMatrix, MV_AddModule -public :: MV_XfrLocToGluAry, MV_XfrGluToModAry, MV_PackMatrix, MV_EqualDL +public :: MV_EqualDL integer(IntKi), parameter :: & LoadFields(*) = [FieldForce, FieldMoment], & @@ -47,158 +47,54 @@ module ModVar MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc] interface MV_Pack - module procedure MV_PackVarRank0R4, MV_PackVarRank1R4, MV_PackVarRank2R4 - module procedure MV_PackVarRank0R8, MV_PackVarRank1R8, MV_PackVarRank2R8 + module procedure MV_PackVarRank0R4, MV_PackVarRank1R4 + module procedure MV_PackVarRank0R8, MV_PackVarRank1R8 module procedure MV_PackMesh end interface interface MV_Unpack - module procedure MV_UnpackVarRank0R4, MV_UnpackVarRank1R4, MV_UnpackVarRank2R4 - module procedure MV_UnpackVarRank0R8, MV_UnpackVarRank1R8, MV_UnpackVarRank2R8 + module procedure MV_UnpackVarRank0R4, MV_UnpackVarRank1R4 + module procedure MV_UnpackVarRank0R8, MV_UnpackVarRank1R8 module procedure MV_UnpackMesh end interface -interface MV_Pack2 - module procedure MV_Pack2VarRank0R4, MV_Pack2VarRank1R4, MV_Pack2VarRank2R4, MV_Pack2VarRank3R4, MV_Pack2VarRank4R4, MV_Pack2VarRank5R4 - module procedure MV_Pack2VarRank0R8, MV_Pack2VarRank1R8, MV_Pack2VarRank2R8, MV_Pack2VarRank3R8, MV_Pack2VarRank4R8, MV_Pack2VarRank5R8 - module procedure MV_Pack2Mesh -end interface - -interface MV_Unpack2 - module procedure MV_Unpack2VarRank0R4, MV_Unpack2VarRank1R4, MV_Unpack2VarRank2R4, MV_Unpack2VarRank3R4, MV_Unpack2VarRank4R4, MV_Unpack2VarRank5R4 - module procedure MV_Unpack2VarRank0R8, MV_Unpack2VarRank1R8, MV_Unpack2VarRank2R8, MV_Unpack2VarRank3R8, MV_Unpack2VarRank4R8, MV_Unpack2VarRank5R8 - module procedure MV_Unpack2Mesh -end interface - logical, parameter :: UseSmallRotAngles = .true. contains -subroutine MV_XfrLocToGluAry(VarAry, ModAry, GluAry) - type(ModVarType), intent(in) :: VarAry(:) - real(R8Ki), allocatable, intent(in) :: ModAry(:) - real(R8Ki), intent(inout) :: GluAry(:) - integer(IntKi) :: i - if (.not. allocated(ModAry) .or. size(VarAry) == 0) return - do i = 1, size(VarAry) - GluAry(VarAry(i)%iGlu(1):VarAry(i)%iGlu(2)) = ModAry(VarAry(i)%iLoc(1):VarAry(i)%iLoc(2)) - end do -end subroutine - -subroutine MV_XfrGluToModAry(VarAry, GluAry, ModAry) - type(ModVarType), intent(in) :: VarAry(:) - real(R8Ki), allocatable, intent(in) :: GluAry(:) - real(R8Ki), intent(inout) :: ModAry(:) - integer(IntKi) :: i - if (.not. allocated(GluAry) .or. size(VarAry) == 0) return - do i = 1, size(VarAry) - ModAry(VarAry(i)%iLoc(1):VarAry(i)%iLoc(2)) = GluAry(VarAry(i)%iGlu(1):VarAry(i)%iGlu(2)) - end do -end subroutine - -subroutine MV_PackMatrix(RowVarAry, ColVarAry, ModMat, GluMat) - type(ModVarType), intent(in) :: RowVarAry(:), ColVarAry(:) - real(R8Ki), allocatable, intent(in) :: ModMat(:, :) - real(R8Ki), intent(inout) :: GluMat(:, :) - integer(IntKi) :: i, j - if (.not. allocated(ModMat) .or. size(RowVarAry) == 0 .or. size(ColVarAry) == 0) return - do i = 1, size(ColVarAry) - do j = 1, size(RowVarAry) - GluMat(RowVarAry(j)%iGlu(1):RowVarAry(j)%iGlu(2), ColVarAry(i)%iGlu(1):ColVarAry(i)%iGlu(2)) = & - ModMat(RowVarAry(j)%iLoc(1):RowVarAry(j)%iLoc(2), ColVarAry(i)%iLoc(1):ColVarAry(i)%iLoc(2)) - end do - end do -end subroutine - !------------------------------------------------------------------------------- -! MV_Pack2 +! MV_Pack !------------------------------------------------------------------------------- -subroutine MV_Pack2VarRank0R4(Var, SrcVal, DstAry) +subroutine MV_PackVarRank0R4(Var, SrcVal, DstAry) type(ModVarType), intent(in) :: Var real(R4Ki), intent(in) :: SrcVal real(R8Ki), intent(inout) :: DstAry(:) DstAry(Var%iLoc(1)) = real(SrcVal, R8Ki) end subroutine -subroutine MV_Pack2VarRank0R8(Var, SrcVal, DstAry) +subroutine MV_PackVarRank0R8(Var, SrcVal, DstAry) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: SrcVal real(R8Ki), intent(inout) :: DstAry(:) DstAry(Var%iLoc(1)) = SrcVal end subroutine -subroutine MV_Pack2VarRank1R4(Var, SrcAry, DstAry) +subroutine MV_PackVarRank1R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var real(R4Ki), intent(in) :: SrcAry(:) real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1):Var%iLoc(2)) = real(SrcAry(Var%iAry(1):Var%iAry(2)), R8Ki) + DstAry(Var%iLoc(1):Var%iLoc(2)) = real(SrcAry, R8Ki) end subroutine -subroutine MV_Pack2VarRank1R8(Var, SrcAry, Ary) +subroutine MV_PackVarRank1R8(Var, SrcAry, Ary) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: SrcAry(:) real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = SrcAry(Var%iAry(1):Var%iAry(2)) -end subroutine - -subroutine MV_Pack2VarRank2R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: SrcAry(:, :) - real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry), R8Ki), .true.) -end subroutine - -subroutine MV_Pack2VarRank2R8(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:, :) - real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry), .true.) -end subroutine - -subroutine MV_Pack2VarRank3R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: SrcAry(:, :, :) - real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry), R8Ki), .true.) -end subroutine - -subroutine MV_Pack2VarRank3R8(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:, :, :) - real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry), .true.) -end subroutine - -subroutine MV_Pack2VarRank4R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: SrcAry(:, :, :, :) - real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), R8Ki), .true.) -end subroutine - -subroutine MV_Pack2VarRank4R8(Var, SrcAry, Ary) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:, :, :, :) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry), .true.) + Ary(Var%iLoc(1):Var%iLoc(2)) = SrcAry end subroutine -subroutine MV_Pack2VarRank5R4(Var, SrcAry, Ary) - type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: SrcAry(:, :, :, :, :) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(real(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry), R8Ki), .true.) -end subroutine - -subroutine MV_Pack2VarRank5R8(Var, SrcAry, Ary) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:, :, :, :, :) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = pack(SrcAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry), .true.) -end subroutine - -subroutine MV_Pack2Mesh(Var, Mesh, DstAry) +subroutine MV_PackMesh(Var, Mesh, DstAry) type(ModVarType), intent(in) :: Var type(MeshType), intent(in) :: Mesh real(R8Ki), intent(inout) :: DstAry(:) @@ -230,110 +126,38 @@ subroutine MV_Pack2Mesh(Var, Mesh, DstAry) end subroutine !------------------------------------------------------------------------------- -! MV_Unpack2 +! MV_Unpack !------------------------------------------------------------------------------- -subroutine MV_Unpack2VarRank0R4(Var, SrcAry, DstVal) +subroutine MV_UnpackVarRank0R4(Var, SrcAry, DstVal) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: SrcAry(:) real(R4Ki), intent(inout) :: DstVal DstVal = real(SrcAry(Var%iLoc(1)), R4Ki) end subroutine -subroutine MV_Unpack2VarRank0R8(Var, SrcAry, DstVal) +subroutine MV_UnpackVarRank0R8(Var, SrcAry, DstVal) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: SrcAry(:) real(R8Ki), intent(inout) :: DstVal DstVal = SrcAry(Var%iLoc(1)) end subroutine -subroutine MV_Unpack2VarRank1R4(Var, SrcAry, DstAry) +subroutine MV_UnpackVarRank1R4(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: SrcAry(:) real(R4Ki), intent(inout) :: DstAry(:) - DstAry(Var%iAry(1):Var%iAry(2)) = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) + DstAry = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) end subroutine -subroutine MV_Unpack2VarRank1R8(Var, SrcAry, DstAry) +subroutine MV_UnpackVarRank1R8(Var, SrcAry, DstAry) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: SrcAry(:) real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iAry(1):Var%iAry(2)) = SrcAry(Var%iLoc(1):Var%iLoc(2)) -end subroutine - -subroutine MV_Unpack2VarRank2R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R4Ki), intent(inout) :: DstAry(:, :) - associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry)) - V = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) - end associate -end subroutine - -subroutine MV_Unpack2VarRank2R8(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: DstAry(:, :) - associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry)) - V = SrcAry(Var%iLoc(1):Var%iLoc(2)) - end associate -end subroutine - -subroutine MV_Unpack2VarRank3R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R4Ki), intent(inout) :: DstAry(:, :, :) - associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry)) - V = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) - end associate -end subroutine - -subroutine MV_Unpack2VarRank3R8(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: DstAry(:, :, :) - associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry)) - V = SrcAry(Var%iLoc(1):Var%iLoc(2)) - end associate -end subroutine - -subroutine MV_Unpack2VarRank4R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R4Ki), intent(inout) :: DstAry(:, :, :, :) - associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry)) - V = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) - end associate -end subroutine - -subroutine MV_Unpack2VarRank4R8(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: DstAry(:, :, :, :) - associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry)) - V = SrcAry(Var%iLoc(1):Var%iLoc(2)) - end associate + DstAry = SrcAry(Var%iLoc(1):Var%iLoc(2)) end subroutine -subroutine MV_Unpack2VarRank5R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R4Ki), intent(inout) :: DstAry(:, :, :, :, :) - associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry)) - V = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) - end associate -end subroutine - -subroutine MV_Unpack2VarRank5R8(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: DstAry(:, :, :, :, :) - associate (V => DstAry(Var%iAry(1):Var%iAry(2), Var%jAry, Var%kAry, Var%mAry, Var%nAry)) - V = SrcAry(Var%iLoc(1):Var%iLoc(2)) - end associate -end subroutine - -subroutine MV_Unpack2Mesh(Var, SrcAry, Mesh) +subroutine MV_UnpackMesh(Var, SrcAry, Mesh) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: SrcAry(:) type(MeshType), intent(inout) :: Mesh @@ -711,207 +535,6 @@ subroutine GetModuleOrder(ModDataAry, ModIDs, ModOrder) ! Functions for packing and unpacking data by variable !------------------------------------------------------------------------------- -subroutine MV_PackVarRank0R4(VarAry, iVar, Val, Ary) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R4Ki), intent(in) :: Val - real(R8Ki), intent(inout) :: Ary(:) - if (iVar == 0) return - Ary(VarAry(iVar)%iLoc(1)) = real(Val, R8Ki) -end subroutine - -subroutine MV_PackVarRank0R8(VarAry, iVar, Val, Ary) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Val - real(R8Ki), intent(inout) :: Ary(:) - if (iVar == 0) return - Ary(VarAry(iVar)%iLoc(1)) = Val -end subroutine - -subroutine MV_PackVarRank1R4(VarAry, iVar, Vals, Ary) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R4Ki), intent(in) :: Vals(:) - real(R8Ki), intent(inout) :: Ary(:) - if (iVar == 0) return - associate (iLoc => VarAry(iVar)%iLoc) - Ary(iLoc(1):iLoc(2)) = real(Vals, R8Ki) - end associate -end subroutine - -subroutine MV_PackVarRank1R8(VarAry, iVar, Vals, Ary) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Vals(:) - real(R8Ki), intent(inout) :: Ary(:) - if (iVar == 0) return - associate (iLoc => VarAry(iVar)%iLoc) - Ary(iLoc(1):iLoc(2)) = Vals - end associate -end subroutine - -subroutine MV_PackVarRank2R4(VarAry, iVar, Vals, Ary) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R4Ki), intent(in) :: Vals(:, :) - real(R8Ki), intent(inout) :: Ary(:) - if (iVar == 0) return - associate (iLoc => VarAry(iVar)%iLoc) - Ary(iLoc(1):iLoc(2)) = pack(real(Vals, R8Ki), .true.) - end associate -end subroutine - -subroutine MV_PackVarRank2R8(VarAry, iVar, Vals, Ary) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Vals(:, :) - real(R8Ki), intent(inout) :: Ary(:) - if (iVar == 0) return - associate (iLoc => VarAry(iVar)%iLoc) - Ary(iLoc(1):iLoc(2)) = pack(Vals, .true.) - end associate -end subroutine - -subroutine MV_UnpackVarRank0R4(VarAry, iVar, Ary, Val) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Val - if (iVar == 0) return - Val = Ary(VarAry(iVar)%iLoc(1)) -end subroutine - -subroutine MV_UnpackVarRank0R8(VarAry, iVar, Ary, Vals) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals - if (iVar == 0) return - Vals = Ary(VarAry(iVar)%iLoc(1)) -end subroutine - -subroutine MV_UnpackVarRank1R4(VarAry, iVar, Ary, Vals) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Vals(:) - if (iVar == 0) return - associate (iLoc => VarAry(iVar)%iLoc) - Vals = real(Ary(iLoc(1):iLoc(2)), R4Ki) - end associate -end subroutine - -subroutine MV_UnpackVarRank1R8(VarAry, iVar, Ary, Vals) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:) - if (iVar == 0) return - associate (iLoc => VarAry(iVar)%iLoc) - Vals = Ary(iLoc(1):iLoc(2)) - end associate -end subroutine - -subroutine MV_UnpackVarRank2R4(VarAry, iVar, Ary, Vals) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Ary(:) - real(R4Ki), intent(inout) :: Vals(:, :) - if (iVar == 0) return - associate (iLoc => VarAry(iVar)%iLoc) - Vals = reshape(real(Ary(iLoc(1):iLoc(2)), R4Ki), shape(Vals)) - end associate -end subroutine - -subroutine MV_UnpackVarRank2R8(VarAry, iVar, Ary, Vals) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Ary(:) - real(R8Ki), intent(inout) :: Vals(:, :) - if (iVar == 0) return - associate (iLoc => VarAry(iVar)%iLoc) - Vals = reshape(Ary(iLoc(1):iLoc(2)), shape(Vals)) - end associate -end subroutine - -subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - type(MeshType), intent(in) :: Mesh - real(R8Ki), intent(inout) :: Values(:) - integer(IntKi) :: MeshID, i, j, k - if (iVar == 0) return - MeshID = VarAry(iVar)%MeshID - do i = iVar, size(VarAry) - if (VarAry(i)%MeshID /= MeshID) exit - associate (iLoc => VarAry(i)%iLoc) - select case (VarAry(i)%Field) - case (FieldForce) - Values(iLoc(1):iLoc(2)) = pack(Mesh%Force, .true.) - case (FieldMoment) - Values(iLoc(1):iLoc(2)) = pack(Mesh%Moment, .true.) - case (FieldTransDisp) - Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationDisp, .true.) - case (FieldOrientation) - k = iLoc(1) - do j = 1, VarAry(i)%Nodes - Values(k:k + 2) = dcm_to_quat(Mesh%Orientation(:, :, j)) - k = k + 3 - end do - case (FieldTransVel) - Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationVel, .true.) - case (FieldAngularVel) - Values(iLoc(1):iLoc(2)) = pack(Mesh%RotationVel, .true.) - case (FieldTransAcc) - Values(iLoc(1):iLoc(2)) = pack(Mesh%TranslationAcc, .true.) - case (FieldAngularAcc) - Values(iLoc(1):iLoc(2)) = pack(Mesh%RotationAcc, .true.) - case (FieldScalar) - Values(iLoc(1):iLoc(2)) = pack(Mesh%Scalars, .true.) - end select - end associate - end do -end subroutine - -subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) - type(ModVarType), intent(in) :: VarAry(:) - integer(IntKi), intent(in) :: iVar - real(R8Ki), intent(in) :: Values(:) - type(MeshType), intent(inout) :: Mesh - integer(IntKi) :: MeshID, i, j, k - if (iVar == 0) return - MeshID = VarAry(iVar)%MeshID - do i = iVar, size(VarAry) - if (VarAry(i)%MeshID /= MeshID) exit - associate (iLoc => VarAry(i)%iLoc) - select case (VarAry(i)%Field) - case (FieldForce) - Mesh%Force = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Force)) - case (FieldMoment) - Mesh%Moment = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Moment)) - case (FieldTransDisp) - Mesh%TranslationDisp = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationDisp)) - case (FieldOrientation) - k = iLoc(1) - do j = 1, VarAry(i)%Nodes - Mesh%Orientation(:, :, j) = quat_to_dcm(Values(k:k + 2)) - k = k + 3 - end do - case (FieldTransVel) - Mesh%TranslationVel = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationVel)) - case (FieldAngularVel) - Mesh%RotationVel = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%RotationVel)) - case (FieldTransAcc) - Mesh%TranslationAcc = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%TranslationAcc)) - case (FieldAngularAcc) - Mesh%RotationAcc = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%RotationAcc)) - case (FieldScalar) - Mesh%Scalars = reshape(Values(iLoc(1):iLoc(2)), shape(Mesh%Scalars)) - end select - end associate - end do -end subroutine subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) type(ModVarType), intent(in) :: Var @@ -1343,7 +966,11 @@ subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, Deri ! Set optional values if (present(Flags)) Var%Flags = Flags - if (present(iAry)) Var%iAry = [iAry, iAry + Var%Num - 1] + if (present(iAry)) then + Var%iAry = [iAry, iAry + Var%Num - 1] + else + Var%iAry = [1, Var%Num] + end if if (present(jAry)) Var%jAry = jAry if (present(kAry)) Var%kAry = kAry if (present(Perturb)) Var%Perturb = Perturb @@ -1354,9 +981,6 @@ subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, Deri end do end if - ! If number is greater than 1 but iAry is zero, assume that iAry should be [1,Num] - if ((Var%Num > 1) .and. (Var%iAry(1) == 0)) Var%iAry = [1, Var%Num] - ! Set Derivative Order if (present(DerivOrder)) then Var%DerivOrder = DerivOrder diff --git a/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 index 911e63e131..95437f702a 100644 --- a/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 +++ b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 @@ -574,4 +574,5 @@ subroutine NWTC_Library_UnPackMeshMapType(RF, OutData) call RegUnpackAlloc(RF, OutData%LoadLn2_M); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapLinearizationType(RF, OutData%dM) ! dM end subroutine + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 055bb61217..c2918325fb 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -54,11 +54,12 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: VF_ExtLin = 16 ! Variable for extended linearization [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_SmallAngle = 32 ! Use small angles to calculate difference in linearization [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_2PI = 64 ! Variable is an angle with range [0,2pi] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 128 ! Variable for write output [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 256 ! Variable for solver [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 512 ! Variable for aeromap [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 1024 ! Variable is derivative order 1 in linearization file [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 2048 ! Variable is derivative order 2 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WM_Rot = 128 ! Variable is a Wiener-Milenkovic rotation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 256 ! Variable for write output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 512 ! Variable for solver [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 1024 ! Variable for aeromap [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 2048 ! Variable is derivative order 1 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 4096 ! Variable is derivative order 2 in linearization file [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] @@ -120,6 +121,8 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: i1 = 0 !< Index 1 [-] INTEGER(IntKi) :: i2 = 0 !< Index 2 [-] INTEGER(IntKi) :: i3 = 0 !< Index 3 [-] + INTEGER(IntKi) :: i4 = 0 !< Index 4 [-] + INTEGER(IntKi) :: i5 = 0 !< Index 5 [-] END TYPE DatLoc ! ======================= ! ========= ModVarType ======= @@ -641,6 +644,8 @@ subroutine NWTC_Library_CopyDatLoc(SrcDatLocData, DstDatLocData, CtrlCode, ErrSt DstDatLocData%i1 = SrcDatLocData%i1 DstDatLocData%i2 = SrcDatLocData%i2 DstDatLocData%i3 = SrcDatLocData%i3 + DstDatLocData%i4 = SrcDatLocData%i4 + DstDatLocData%i5 = SrcDatLocData%i5 end subroutine subroutine NWTC_Library_DestroyDatLoc(DatLocData, ErrStat, ErrMsg) @@ -661,6 +666,8 @@ subroutine NWTC_Library_PackDatLoc(RF, Indata) call RegPack(RF, InData%i1) call RegPack(RF, InData%i2) call RegPack(RF, InData%i3) + call RegPack(RF, InData%i4) + call RegPack(RF, InData%i5) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -673,6 +680,8 @@ subroutine NWTC_Library_UnPackDatLoc(RF, OutData) call RegUnpack(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%i3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i5); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1678,5 +1687,7 @@ subroutine NWTC_Library_UnPackModDataType(RF, OutData) call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin end subroutine + END MODULE NWTC_Library_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 07fd8c447a..f858ec90e9 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -120,7 +120,7 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) ! TODO: Move into FAST_InitializeAll ! Initialize module data transfer mappings - call FAST_InitMappings(m%Modules, m%Mappings, T, ErrStat2, ErrMsg2) + call FAST_InitMappings(m%ModDataAry, m%Mappings, T, ErrStat2, ErrMsg2) if (Failed()) return ! Initialize steady flow field in AeroDyn @@ -139,9 +139,9 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) m%AM%iModAD = 0 ! Get indices of modules that are used by Aero Mapping (first instance only) - call GetModuleOrder(m%Modules, AeroMapModIDs, m%AM%iModOrder) + call GetModuleOrder(m%ModDataAry, AeroMapModIDs, m%AM%iModOrder) do i = 1, size(m%AM%iModOrder) - associate (ModData => m%Modules(m%AM%iModOrder(i))) + associate (ModData => m%ModDataAry(m%AM%iModOrder(i))) if (ModData%Ins == 1) then select case (ModData%ID) case (Module_ED) @@ -165,7 +165,7 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) ! Loop through module indices, copy states and inputs do i = 1, size(m%AM%iModOrder) - associate (ModData => m%Modules(m%AM%iModOrder(i))) + associate (ModData => m%ModDataAry(m%AM%iModOrder(i))) ! Copy current state to predicted state call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -177,7 +177,7 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) ! If linearization is enabled, set lin file module abbreviation for file name ! If module is BeamDyn or more than one instance, append instance number to abbreviation - if ((ModData%ID == Module_BD) .or. (count(m%Modules%ID == ModData%ID) > 1)) then + if ((ModData%ID == Module_BD) .or. (count(m%ModDataAry%ID == ModData%ID) > 1)) then ModData%Lin%Abbr = trim(ModData%Abbr)//Num2LStr(ModData%Ins) else ModData%Lin%Abbr = ModData%Abbr @@ -191,7 +191,7 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! Generate index for variables with AeroMap flag - call ModD_CombineModules(m%Modules, m%AM%iModOrder, VF_AeroMap, .true., m%AM%Mod, ErrStat2, ErrMsg2) + call ModD_CombineModules(m%ModDataAry, m%AM%iModOrder, VF_AeroMap, .true., m%AM%Mod, ErrStat2, ErrMsg2) if (Failed()) return !---------------------------------------------------------------------------- @@ -401,7 +401,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) ! Update module inputs call SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD) do i = 1, size(m%AM%iModOrder) - associate (ModData => m%Modules(m%AM%iModOrder(i))) + associate (ModData => m%ModDataAry(m%AM%iModOrder(i))) call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end associate @@ -436,13 +436,13 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) if (m%AM%iModBD > 0) then ! Calculate BeamDyn output - call FAST_CalcOutput(m%Modules(m%AM%iModBD), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call FAST_CalcOutput(m%ModDataAry(m%AM%iModBD), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) else ! Calculate ElastoDyn output - call FAST_CalcOutput(m%Modules(m%AM%iModED), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call FAST_CalcOutput(m%ModDataAry(m%AM%iModED), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if @@ -469,7 +469,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) ! Calculate AeroDyn Output !----------------------------------------- - call FAST_CalcOutput(m%Modules(m%AM%iModAD), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call FAST_CalcOutput(m%ModDataAry(m%AM%iModAD), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) then call ResetInputsAndStates() @@ -640,10 +640,10 @@ subroutine SS_UpdateInputsStates(m, delta, T, ErrStat, ErrMsg) do i = 1, size(iModOrder) iMod = iModOrder(i) if (iMod == 0) cycle - call FAST_GetOP(m%Modules(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & - u_op=m%Modules(iMod)%Lin%u, x_op=m%Modules(iMod)%Lin%x) + call FAST_GetOP(m%ModDataAry(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=m%ModDataAry(iMod)%Lin%u, x_op=m%ModDataAry(iMod)%Lin%x) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, m%Modules(iMod)%Lin%x, m%AM%Mod%Lin%x) + call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, m%ModDataAry(iMod)%Lin%x, m%AM%Mod%Lin%x) end do ! Remove conditioning from solution vector ! Add change in inputs to current inputs @@ -656,24 +656,24 @@ subroutine SS_UpdateInputsStates(m, delta, T, ErrStat, ErrMsg) do i = 1, size(iModOrder) iMod = iModOrder(i) if (iMod == 0) cycle - call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%x, m%Modules(iMod)%Lin%x, m%AM%Mod%Lin%x) - call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%u, m%Modules(iMod)%Lin%u, m%AM%u1) + call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%x, m%ModDataAry(iMod)%Lin%x, m%AM%Mod%Lin%x) + call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%u, m%ModDataAry(iMod)%Lin%u, m%AM%u1) - select case (m%Modules(iMod)%ID) + select case (m%ModDataAry(iMod)%ID) case (Module_ED) ! Copy blade1 flap and edge states to other blades do j = 2, T%ED%p%NumBl - associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(1)), & - VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(j))) - m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + associate (Var1 => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(1)), & + VarN => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(j))) + m%ModDataAry(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%ModDataAry(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) end associate - associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(1)), & - VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(j))) - m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + associate (Var1 => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(1)), & + VarN => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(j))) + m%ModDataAry(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%ModDataAry(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) end associate - associate (Var1 => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(1)), & - VarN => m%Modules(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(j))) - m%Modules(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%Modules(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) + associate (Var1 => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(1)), & + VarN => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(j))) + m%ModDataAry(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%ModDataAry(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) end associate end do case (Module_BD) @@ -681,8 +681,8 @@ subroutine SS_UpdateInputsStates(m, delta, T, ErrStat, ErrMsg) end select ! Populate values in module - call FAST_SetOP(m%Modules(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & - u_op=m%Modules(iMod)%Lin%u, x_op=m%Modules(iMod)%Lin%x) + call FAST_SetOP(m%ModDataAry(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=m%ModDataAry(iMod)%Lin%u, x_op=m%ModDataAry(iMod)%Lin%x) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do @@ -755,7 +755,7 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! Loop through modules do i = 1, size(m%AM%iModOrder) - associate (ModData => m%Modules(m%AM%iModOrder(i)), iMod => m%AM%iModOrder(i)) + associate (ModData => m%ModDataAry(m%AM%iModOrder(i)), iMod => m%AM%iModOrder(i)) ! Calculate dYdu and dXdu call FAST_JacobianPInput(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & @@ -823,7 +823,7 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err m%AM%Mod%Lin%dUdy = 0.0_R8Ki call Eye2D(m%AM%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_LinearizeMappings(T, m%Modules, m%Mappings, m%AM%iModOrder, m%AM%Mod%Xfr, ErrStat2, ErrMsg2, & + call FAST_LinearizeMappings(T, m%ModDataAry, m%Mappings, m%AM%iModOrder, m%AM%Mod%Xfr, ErrStat2, ErrMsg2, & m%AM%Mod%Lin%dUdu, m%AM%Mod%Lin%dUdy) if (Failed()) return @@ -989,7 +989,7 @@ subroutine SS_BD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - call FAST_InputSolve(m%Modules(m%AM%iModBD), m%Modules, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call FAST_InputSolve(m%ModDataAry(m%AM%iModBD), m%ModDataAry, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -1022,7 +1022,7 @@ subroutine SS_ED_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - call FAST_InputSolve(m%Modules(m%AM%iModED), m%Modules, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call FAST_InputSolve(m%ModDataAry(m%AM%iModED), m%ModDataAry, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -1058,7 +1058,7 @@ subroutine SS_AD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) ErrMsg = "" ! Get blade motion inputs - call FAST_InputSolve(m%Modules(m%AM%iModAD), m%Modules, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call FAST_InputSolve(m%ModDataAry(m%AM%iModAD), m%ModDataAry, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Set prescribed values for first blade @@ -1110,22 +1110,22 @@ subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, dx_vec, T, ErrStat, Er case (Module_ED) ! ElastoDyn - call FAST_GetOP(m%Modules(m%AM%iModED), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & - FlagFilter=VF_AeroMap, dx_op=m%Modules(m%AM%iModED)%Lin%dx) + call FAST_GetOP(m%ModDataAry(m%AM%iModED), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & + FlagFilter=VF_AeroMap, dx_op=m%ModDataAry(m%AM%iModED)%Lin%dx) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%Modules(m%AM%iModED)%Lin%dx, dx_vec) + call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%ModDataAry(m%AM%iModED)%Lin%dx, dx_vec) case (Module_BD) ! BeamDyn ! Set hub rotation speed Omega_Hub = [real(caseData%RotSpeed, R8Ki), 0.0_R8Ki, 0.0_R8Ki] - call FAST_GetOP(m%Modules(m%AM%iModBD), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & - FlagFilter=VF_AeroMap, dx_op=m%Modules(m%AM%iModBD)%Lin%dx) + call FAST_GetOP(m%ModDataAry(m%AM%iModBD), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & + FlagFilter=VF_AeroMap, dx_op=m%ModDataAry(m%AM%iModBD)%Lin%dx) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%Modules(m%AM%iModED)%Lin%dx, dx_vec) + call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%ModDataAry(m%AM%iModED)%Lin%dx, dx_vec) ! TODO: Make this work for BeamDyn ! do K = 1, T%p_FAST%nBeams @@ -1181,7 +1181,7 @@ subroutine SS_GetStates(m, x_vec, StateIndex, T, ErrStat, ErrMsg) ! If no inputs for this module, cycle if (.not. allocated(m%AM%Mod%Xfr(iMod)%x)) cycle - associate (ModData => m%Modules(iMod)) + associate (ModData => m%ModDataAry(iMod)) ! Get states and outputs call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, StateIndex, T, ErrStat2, ErrMsg2, x_op=ModData%Lin%x) @@ -1226,7 +1226,7 @@ subroutine SS_GetInputs(m, u_vec, InputIndex, T, ErrStat, ErrMsg) ! If no inputs for this module, cycle if (.not. allocated(m%AM%Mod%Xfr(iMod)%u)) cycle - associate (ModData => m%Modules(iMod)) + associate (ModData => m%ModDataAry(iMod)) ! Get states and outputs call FAST_GetOP(ModData, SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, u_op=ModData%Lin%u) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 5987c1a772..7bac60ab05 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -559,6 +559,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err call BD_PackInputAry(ModData%Vars, T%BD%Input(InputIndex, ModData%Ins), u_op) case (Module_ED) call ED_PackInputAry(ModData%Vars, T%ED%Input(InputIndex), u_op) + call ED_PackExtInputAry(ModData%Vars, T%ED%Input(InputIndex), u_op, ErrStat2, ErrMsg2); if (Failed()) return case (Module_ExtPtfm) call ExtPtfm_PackInputAry(ModData%Vars, T%ExtPtfm%Input(InputIndex), u_op) case (Module_FEAM) @@ -592,7 +593,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(u_glue)) call MV_XfrLocToGluAry(ModData%Vars%u, u_op, u_glue) + if (present(u_glue)) call XfrLocToGluAry(ModData%Vars%u, u_op, u_glue) end if ! If outputs are requested @@ -644,7 +645,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(y_glue)) call MV_XfrLocToGluAry(ModData%Vars%y, y_op, y_glue) + if (present(y_glue)) call XfrLocToGluAry(ModData%Vars%y, y_op, y_glue) end if ! If continuous states are requested @@ -695,7 +696,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(x_glue)) call MV_XfrLocToGluAry(ModData%Vars%x, x_op, x_glue) + if (present(x_glue)) call XfrLocToGluAry(ModData%Vars%x, x_op, x_glue) end if ! If continuous state derivatives are requested @@ -783,7 +784,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(dx_glue)) call MV_XfrLocToGluAry(ModData%Vars%x, dx_op, dx_glue) + if (present(dx_glue)) call XfrLocToGluAry(ModData%Vars%x, dx_op, dx_glue) end if ! If constraint states are requested @@ -834,7 +835,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end select ! If glue array is present, transfer from module to glue - if (present(z_glue)) call MV_XfrLocToGluAry(ModData%Vars%z, z_op, z_glue) + if (present(z_glue)) call XfrLocToGluAry(ModData%Vars%z, z_op, z_glue) end if contains @@ -845,7 +846,7 @@ logical function Failed() end subroutine subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & - u_op, y_op, x_op, z_op, u_glue, y_glue, x_glue, z_glue) + u_op, x_op, z_op, u_glue, x_glue, z_glue) type(ModDataType), intent(in) :: ModData !< Module information integer(IntKi), intent(in) :: InputIndex !< Input index integer(IntKi), intent(in) :: StateIndex !< State index @@ -853,7 +854,6 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg real(R8Ki), allocatable, optional, intent(inout) :: u_op(:), u_glue(:) !< values of linearized inputs - real(R8Ki), allocatable, optional, intent(inout) :: y_op(:), y_glue(:) !< values of linearized outputs real(R8Ki), allocatable, optional, intent(inout) :: x_op(:), x_glue(:) !< values of linearized continuous states real(R8Ki), allocatable, optional, intent(inout) :: z_op(:), z_glue(:) !< values of linearized constraint states @@ -869,7 +869,7 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & if (present(u_op)) then ! If glue array is present, transfer from module to glue - if (present(u_glue)) call MV_XfrGluToModAry(ModData%Vars%u, u_glue, u_op) + if (present(u_glue)) call XfrGluToModAry(ModData%Vars%u, u_glue, u_op) ! Select based on module ID select case (ModData%ID) @@ -912,58 +912,11 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & end if - ! If outputs are requested - if (present(y_op)) then - - ! If glue array is present, transfer from module to glue - if (present(y_glue)) call MV_XfrGluToModAry(ModData%Vars%y, y_glue, y_op) - - ! Select based on module ID - select case (ModData%ID) - case (Module_AD) - call AD_UnpackOutputAry(ModData%Vars, y_op, T%AD%y%rotors(ModData%Ins)) - case (Module_BD) - call BD_UnpackOutputAry(ModData%Vars, y_op, T%BD%y(ModData%Ins)) - case (Module_ED) - call ED_UnpackOutputAry(ModData%Vars, y_op, T%ED%y) - case (Module_ExtPtfm) - call ExtPtfm_UnpackOutputAry(ModData%Vars, y_op, T%ExtPtfm%y) - case (Module_FEAM) - call FEAM_UnpackOutputAry(ModData%Vars, y_op, T%FEAM%y) - case (Module_HD) - call HydroDyn_UnpackOutputAry(ModData%Vars, y_op, T%HD%y) - case (Module_IceD) - call IceD_UnpackOutputAry(ModData%Vars, y_op, T%IceD%y(ModData%Ins)) - case (Module_IceF) - call IceFloe_UnpackOutputAry(ModData%Vars, y_op, T%IceF%y) - case (Module_IfW) - call InflowWind_UnpackOutputAry(ModData%Vars, y_op, T%IfW%y) - case (Module_MAP) - call MAP_UnpackOutputAry(ModData%Vars, y_op, T%MAP%y) - case (Module_MD) - call MD_UnpackOutputAry(ModData%Vars, y_op, T%MD%y) - case (Module_ExtInfw) - call ExtInfw_UnpackOutputAry(ModData%Vars, y_op, T%ExtInfw%y) - case (Module_Orca) - call Orca_UnpackOutputAry(ModData%Vars, y_op, T%Orca%y) - case (Module_SD) - call SD_UnpackOutputAry(ModData%Vars, y_op, T%SD%y) - case (Module_SeaSt) - call SeaSt_UnpackOutputAry(ModData%Vars, y_op, T%SeaSt%y) - case (Module_SrvD) - call SrvD_UnpackOutputAry(ModData%Vars, y_op, T%SrvD%y) - case default - call SetErrStat(ErrID_Fatal, "Output unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) - return - end select - - end if - ! If continuous states are requested if (present(x_op)) then ! If glue array is present, transfer from module to glue - if (present(x_glue)) call MV_XfrGluToModAry(ModData%Vars%x, x_glue, x_op) + if (present(x_glue)) call XfrGluToModAry(ModData%Vars%x, x_glue, x_op) ! Select based on module ID select case (ModData%ID) @@ -1010,7 +963,7 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & if (present(z_op)) then ! If glue array is present, transfer from module to glue - if (present(z_glue)) call MV_XfrGluToModAry(ModData%Vars%z, z_glue, z_op) + if (present(z_glue)) call XfrGluToModAry(ModData%Vars%z, z_glue, z_op) ! Select based on module ID select case (ModData%ID) @@ -1143,10 +1096,10 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg if (ErrStat >= AbortErrLev) return ! If dYdu and dYduGlue are present, transfer from module matrix to glue matrix - if (present(dYdu) .and. present(dYduGlue)) call MV_PackMatrix(ModData%Vars%y, ModData%Vars%u, dYdu, dYduGlue) + if (present(dYdu) .and. present(dYduGlue)) call XfrModToGlueMatrix(ModData%Vars%y, ModData%Vars%u, dYdu, dYduGlue) ! If dXdu and dXduGlue are present, transfer from module matrix to glue matrix - if (present(dXdu) .and. present(dXduGlue)) call MV_PackMatrix(ModData%Vars%x, ModData%Vars%u, dXdu, dXduGlue) + if (present(dXdu) .and. present(dXduGlue)) call XfrModToGlueMatrix(ModData%Vars%x, ModData%Vars%u, dXdu, dXduGlue) end subroutine @@ -1249,10 +1202,10 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, Er if (ErrStat >= AbortErrLev) return ! If dYdx and dYdxGlue are present, transfer from module matrix to glue matrix - if (present(dYdx) .and. present(dYdxGlue)) call MV_PackMatrix(ModData%Vars%y, ModData%Vars%x, dYdx, dYdxGlue) + if (present(dYdx) .and. present(dYdxGlue)) call XfrModToGlueMatrix(ModData%Vars%y, ModData%Vars%x, dYdx, dYdxGlue) ! If dXdx and dXdxGlue are present, transfer from module matrix to glue matrix - if (present(dXdx) .and. present(dXdxGlue)) call MV_PackMatrix(ModData%Vars%x, ModData%Vars%x, dXdx, dXdxGlue) + if (present(dXdx) .and. present(dXdxGlue)) call XfrModToGlueMatrix(ModData%Vars%x, ModData%Vars%x, dXdx, dXdxGlue) end subroutine @@ -1908,4 +1861,40 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) end subroutine +subroutine XfrLocToGluAry(VarAry, ModAry, GluAry) + type(ModVarType), intent(in) :: VarAry(:) + real(R8Ki), allocatable, intent(in) :: ModAry(:) + real(R8Ki), intent(inout) :: GluAry(:) + integer(IntKi) :: i + if (.not. allocated(ModAry) .or. size(VarAry) == 0) return + do i = 1, size(VarAry) + GluAry(VarAry(i)%iGlu(1):VarAry(i)%iGlu(2)) = ModAry(VarAry(i)%iLoc(1):VarAry(i)%iLoc(2)) + end do +end subroutine + +subroutine XfrGluToModAry(VarAry, GluAry, ModAry) + type(ModVarType), intent(in) :: VarAry(:) + real(R8Ki), allocatable, intent(in) :: GluAry(:) + real(R8Ki), intent(inout) :: ModAry(:) + integer(IntKi) :: i + if (.not. allocated(GluAry) .or. size(VarAry) == 0) return + do i = 1, size(VarAry) + ModAry(VarAry(i)%iLoc(1):VarAry(i)%iLoc(2)) = GluAry(VarAry(i)%iGlu(1):VarAry(i)%iGlu(2)) + end do +end subroutine + +subroutine XfrModToGlueMatrix(RowVarAry, ColVarAry, ModMat, GluMat) + type(ModVarType), intent(in) :: RowVarAry(:), ColVarAry(:) + real(R8Ki), allocatable, intent(in) :: ModMat(:, :) + real(R8Ki), intent(inout) :: GluMat(:, :) + integer(IntKi) :: i, j + if (.not. allocated(ModMat) .or. size(RowVarAry) == 0 .or. size(ColVarAry) == 0) return + do i = 1, size(ColVarAry) + do j = 1, size(RowVarAry) + GluMat(RowVarAry(j)%iGlu(1):RowVarAry(j)%iGlu(2), ColVarAry(i)%iGlu(1):ColVarAry(i)%iGlu(2)) = & + ModMat(RowVarAry(j)%iLoc(1):RowVarAry(j)%iLoc(2), ColVarAry(i)%iLoc(1):ColVarAry(i)%iLoc(2)) + end do + end do +end subroutine + end module diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 8d97fce2d8..aef69a7c57 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -366,9 +366,9 @@ function FAST_OutputMeshName(ModData, DL) result(Name) end select end function -subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) +subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable, intent(out) :: Mappings(:) type(ModDataType), intent(inout) :: Mods(:) !< Module data - type(MappingType), allocatable, intent(inout) :: Mappings(:) type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -454,8 +454,16 @@ subroutine FAST_InitMappings(Mods, Mappings, Turbine, ErrStat, ErrMsg) DstMod => Mods(Mappings(iMap)%iModDst)) ! Add mapping index to sorce and destination module mapping arrays - SrcMod%iSrcMaps = [SrcMod%iSrcMaps, iMap] - DstMod%iDstMaps = [DstMod%iDstMaps, iMap] + if (allocated(SrcMod%iSrcMaps)) then + SrcMod%iSrcMaps = [SrcMod%iSrcMaps, iMap] + else + SrcMod%iSrcMaps = [iMap] + end if + if (allocated(DstMod%iDstMaps)) then + DstMod%iDstMaps = [DstMod%iDstMaps, iMap] + else + DstMod%iDstMaps = [iMap] + end if write (*, *) "Mapping: ", Mappings(iMap)%Desc @@ -2179,7 +2187,7 @@ subroutine Assemble_dUdu(Mapping, ModMap, VarsSrc, VarsDst, dUdu) type(MappingType), intent(in) :: Mapping type(ModMapType), intent(in) :: ModMap type(ModVarsType), intent(in) :: VarsSrc, VarsDst - real(R8Ki), intent(inout) :: dUdu(:,:) + real(R8Ki), intent(inout) :: dUdu(:, :) ! Effect of input Translation Displacement on input Translation Velocity if (allocated(Mapping%MeshMap%dM%tv_uD)) then @@ -2207,7 +2215,7 @@ subroutine Assemble_dUdy_Loads(Mapping, ModMap, VarsSrc, VarsDst, dUdy) type(MappingType), intent(inout) :: Mapping type(ModMapType), intent(in) :: ModMap type(ModVarsType), intent(in) :: VarsSrc, VarsDst - real(R8Ki), intent(inout) :: dUdy(:,:) + real(R8Ki), intent(inout) :: dUdy(:, :) ! Load identity if (allocated(Mapping%MeshMap%dM%li)) then @@ -2251,7 +2259,7 @@ subroutine Assemble_dUdy_Motions(Mapping, ModMap, VarsSrc, VarsDst, dUdy) type(MappingType), intent(in) :: Mapping type(ModMapType), intent(in) :: ModMap type(ModVarsType), intent(in) :: VarsSrc, VarsDst - real(R8Ki), intent(inout) :: dUdy(:,:) + real(R8Ki), intent(inout) :: dUdy(:, :) ! Motion identity if (allocated(Mapping%MeshMap%dM%mi)) then diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index c493e464e9..beec7bb287 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -38,13 +38,13 @@ module FAST_ModGlue contains -subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappings, ModGlue, ErrStat, ErrMsg) +subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilter, Linearize, ErrStat, ErrMsg) + type(ModGlueType), intent(out) :: ModGlue type(ModDataType), intent(inout) :: ModDataAry(:) integer(IntKi), intent(in) :: iModAry(:) integer(IntKi), intent(in) :: FlagFilter logical, intent(in) :: Linearize type(MappingType), intent(in) :: Mappings(:) !< Mesh and variable mappings - type(ModGlueType), intent(out) :: ModGlue integer(IntKi), intent(out) :: ErrStat character(ErrMsgLen), intent(out) :: ErrMsg @@ -192,34 +192,35 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi ! Determine mappings which apply to the modules in this glue module !---------------------------------------------------------------------------- - allocate(ModGlue%ModMaps(0)) + allocate (ModGlue%ModMaps(0)) ! Loop through mappings do i = 1, size(Mappings) + ! Find index of source module in glue module, cycle if not found + ModMap%iModSrc = 0 + do j = 1, size(iModAry) + if (iModAry(j) == Mappings(i)%iModSrc) then + ModMap%iModSrc = j + exit + end if + end do + if (ModMap%iModSrc == 0) cycle + + ! Find index of destination module in glue module, cycle if not found + ModMap%iModDst = 0 + do j = 1, size(iModAry) + if (iModAry(j) == Mappings(i)%iModDst) then + ModMap%iModDst = j + exit + end if + end do + if (ModMap%iModDst == 0) cycle + + ! Get source and destination modules from glue module data array associate (Mapping => Mappings(i), & - ModSrc => ModDataAry(Mappings(i)%iModSrc), & - ModDst => ModDataAry(Mappings(i)%iModDst)) - - ! Find index of source module in glue module, cycle if not found - ModMap%iModSrc = 0 - do j = 1, size(iModAry) - if (iModAry(j) == Mapping%iModSrc) then - ModMap%iModSrc = j - exit - end if - end do - if (ModMap%iModSrc == 0) cycle - - ! Find index of destination module in glue module, cycle if not found - ModMap%iModDst = 0 - do j = 1, size(iModAry) - if (iModAry(j) == Mapping%iModDst) then - ModMap%iModDst = j - exit - end if - end do - if (ModMap%iModDst == 0) cycle + ModSrc => ModGlue%ModDataAry(ModMap%iModSrc), & + ModDst => ModGlue%ModDataAry(ModMap%iModDst)) ! Set mapping index and clear variable indices ModMap%iMapping = i @@ -273,7 +274,7 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi if (MV_EqualDL(ModDst%Vars%y(j)%DL, Mapping%DstDispDL)) ModMap%iVarDstDisp(ModDst%Vars%y(j)%Field) = j end do end if - + end select ! If no destination variable indices found, cycle @@ -282,7 +283,7 @@ subroutine Glue_CombineModules(ModDataAry, iModAry, FlagFilter, Linearize, Mappi ! Add new module mapping to array ModGlue%ModMaps = [ModGlue%ModMaps, ModMap] - + end associate end do @@ -394,16 +395,16 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! If no modules were added, return error - if (.not. allocated(m%Modules)) then + if (.not. allocated(m%ModDataAry)) then call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) return end if ! Create array of indices for Mods array - modIdx = [(i, i=1, size(m%Modules))] + modIdx = [(i, i=1, size(m%ModDataAry))] ! Get array of module IDs - modIDs = [(m%Modules(i)%ID, i=1, size(m%Modules))] + modIDs = [(m%ModDataAry(i)%ID, i=1, size(m%ModDataAry))] ! Establish module index order for linearization allocate (p%Lin%iMod(0)) @@ -412,9 +413,9 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) end do ! Loop through modules, if module is not in index, return with error - do i = 1, size(m%Modules) + do i = 1, size(m%ModDataAry) if (.not. any(i == p%Lin%iMod)) then - call SetErrStat(ErrID_Fatal, "Module "//trim(m%Modules(i)%Abbr)// & + call SetErrStat(ErrID_Fatal, "Module "//trim(m%ModDataAry(i)%Abbr)// & " not supported in linearization", ErrStat, ErrMsg, RoutineName) return end if @@ -426,7 +427,7 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Loop through each module by index do i = 1, size(p%Lin%iMod) - associate (ModData => m%Modules(p%Lin%iMod(i))) + associate (ModData => m%ModDataAry(p%Lin%iMod(i))) ! Set linearize flag on all continuous state variables do j = 1, size(ModData%Vars%x) @@ -474,13 +475,13 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Mesh Mapping !---------------------------------------------------------------------------- - call FAST_InitMappings(m%Modules, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InitMappings(m%Mappings, m%ModDataAry, Turbine, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Glue Module !---------------------------------------------------------------------------- - call Glue_CombineModules(m%Modules, p%Lin%iMod, VF_None, p_FAST%Linearize, m%Mappings, m%ModGlue, ErrStat2, ErrMsg2); if (Failed()) return + call Glue_CombineModules(m%ModGlue, m%ModDataAry, m%Mappings, p%Lin%iMod, VF_None, p_FAST%Linearize, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Allocate linearization arrays and matrices @@ -523,46 +524,47 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) call AllocAry(y%Lin%z, m%ModGlue%Vars%Nz, p%Lin%NumTimes, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(y%Lin%u, m%ModGlue%Vars%Nu, p%Lin%NumTimes, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return - ! If steady state calculation is enabled - if (p_FAST%CalcSteady) then + end if - ! Disable saving of OPs during linearization as ModGlue_CalcSteady saves them automatically - p%Lin%SaveOPs = .false. + ! If linearization and steady state calculation is enabled + if (p_FAST%Linearize .and. p_FAST%CalcSteady) then - ! Initialize variables - m%CS%AzimuthDelta = TwoPi_D/p%Lin%NumTimes - m%CS%NumRotations = 0 - m%CS%IsConverged = .false. - m%CS%FoundSteady = .false. - m%CS%ForceLin = .false. + ! Disable saving of OPs during linearization as ModGlue_CalcSteady saves them automatically + p%Lin%SaveOPs = .false. - ! Calculate number of output values (ignoring write outputs) - m%CS%NumOutputs = 0 - do i = 1, size(m%ModGlue%Vars%y) - associate (Var => m%ModGlue%Vars%y(i)) - if (.not. MV_HasFlags(Var, VF_WriteOut)) m%CS%NumOutputs = m%CS%NumOutputs + Var%Num - end associate - end do + ! Initialize variables + m%CS%AzimuthDelta = TwoPi_D/p%Lin%NumTimes + m%CS%NumRotations = 0 + m%CS%IsConverged = .false. + m%CS%FoundSteady = .false. + m%CS%ForceLin = .false. - ! Allocate arrays - call AllocAry(y%Lin%Times, p%Lin%NumTimes, "Lin%Times", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%AzimuthTarget, p%Lin%NumTimes, "CS%AzimuthTarget", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%psi_buffer, p_FAST%LinInterpOrder + 1, "CS%psi_buffer", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_buffer, m%ModGlue%Vars%Ny, p_FAST%LinInterpOrder + 1, "CS%y_buffer", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_interp, m%ModGlue%Vars%Ny, "CS%y_interp", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_diff, m%ModGlue%Vars%Ny, "CS%y_diff", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_azimuth, m%ModGlue%Vars%Ny, p%Lin%NumTimes, "CS%y_azimuth", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%CS%y_ref, m%ModGlue%Vars%Ny, "CS%y_ref", ErrStat2, ErrMsg2); if (Failed()) return - - ! Initialize arrays to zero - m%CS%psi_buffer = 0.0_R8Ki - m%CS%y_buffer = 0.0_R8Ki - m%CS%y_interp = 0.0_R8Ki - m%CS%y_diff = 0.0_R8Ki - m%CS%y_azimuth = 0.0_R8Ki - m%CS%y_ref = 1.0_R8Ki + ! Calculate number of output values (ignoring write outputs) + m%CS%NumOutputs = 0 + do i = 1, size(m%ModGlue%Vars%y) + associate (Var => m%ModGlue%Vars%y(i)) + if (.not. MV_HasFlags(Var, VF_WriteOut)) m%CS%NumOutputs = m%CS%NumOutputs + Var%Num + end associate + end do + + ! Allocate arrays + call AllocAry(y%Lin%Times, p%Lin%NumTimes, "Lin%Times", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%AzimuthTarget, p%Lin%NumTimes, "CS%AzimuthTarget", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%psi_buffer, p_FAST%LinInterpOrder + 1, "CS%psi_buffer", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_buffer, m%ModGlue%Vars%Ny, p_FAST%LinInterpOrder + 1, "CS%y_buffer", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_interp, m%ModGlue%Vars%Ny, "CS%y_interp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_diff, m%ModGlue%Vars%Ny, "CS%y_diff", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_azimuth, m%ModGlue%Vars%Ny, p%Lin%NumTimes, "CS%y_azimuth", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_ref, m%ModGlue%Vars%Ny, "CS%y_ref", ErrStat2, ErrMsg2); if (Failed()) return + + ! Initialize arrays to zero + m%CS%psi_buffer = 0.0_R8Ki + m%CS%y_buffer = 0.0_R8Ki + m%CS%y_interp = 0.0_R8Ki + m%CS%y_diff = 0.0_R8Ki + m%CS%y_azimuth = 0.0_R8Ki + m%CS%y_ref = 1.0_R8Ki - end if end if contains @@ -814,7 +816,7 @@ logical function Failed() end function Failed end subroutine -subroutine ModGlue_Linearize_OP(Turbine, p, m, y, p_FAST, m_FAST, y_FAST, t_global, ErrStat, ErrMsg) +subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbine, ErrStat, ErrMsg) type(Glue_ParameterType), intent(inout) :: p !< Glue parameters type(Glue_MiscVarType), intent(inout) :: m !< Glue MiscVars @@ -987,7 +989,7 @@ subroutine ModGlue_SaveOperatingPoint(p, m, OPIndex, NewCopy, Turbine, ErrStat, ! Loop through modules by index do i = 1, size(p%Lin%iMod) - associate (ModData => m%Modules(p%Lin%iMod(i))) + associate (ModData => m%ModDataAry(p%Lin%iMod(i))) ! Copy current module state to linearization save location call FAST_CopyStates(ModData, Turbine, STATE_CURR, StateIndex, CtrlCode, ErrStat2, ErrMsg2) @@ -1031,7 +1033,7 @@ subroutine ModGlue_RestoreOperatingPoint(p, m, OPIndex, Turbine, ErrStat, ErrMsg ! Loop through modules by index do i = 1, size(p%Lin%iMod) - associate (ModData => m%Modules(p%Lin%iMod(i))) + associate (ModData => m%ModDataAry(p%Lin%iMod(i))) ! Copy current module state to linearization save location call FAST_CopyStates(ModData, Turbine, StateIndex, STATE_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 0bb8eab8ab..52253f60cb 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -289,7 +289,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to array of modules, return if errors occurred - CALL MV_AddModule(m_Glue%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & Init%OutData_ED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -385,7 +385,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName) ! Add module instance to array of modules, return on failure - CALL MV_AddModule(m_Glue%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & + CALL MV_AddModule(m_Glue%ModDataAry, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & p_FAST%DT, Init%OutData_BD(k)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -455,7 +455,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & Init%OutData_IfW%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -525,7 +525,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%Modules, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & Init%OutData_ExtInfw%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return @@ -580,7 +580,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to array, return on error - call MV_AddModule(m_Glue%Modules, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & + call MV_AddModule(m_Glue%ModDataAry, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & Init%OutData_SeaSt%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -689,7 +689,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! Initialize a module instance for each rotor do i = 1, size(Init%OutData_AD%rotors) - CALL MV_AddModule(m_Glue%Modules, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & Init%OutData_AD%rotors(i)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return end do @@ -715,7 +715,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%Modules, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & Init%OutData_ExtLd%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -785,7 +785,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & Init%OutData_HD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -838,7 +838,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & Init%OutData_SD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -932,7 +932,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & Init%OutData_MAP%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -964,7 +964,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & Init%OutData_MD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -989,7 +989,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & Init%OutData_FEAM%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return @@ -1007,7 +1007,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%Modules, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & Init%OutData_Orca%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return @@ -1227,7 +1227,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules - CALL MV_AddModule(m_Glue%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModDataAry, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & Init%OutData_SrvD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -8569,8 +8569,8 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) if ((t_global > next_lin_time) .or. EqualRealNos(t_global,next_lin_time)) then ! Perform linearization - call ModGlue_Linearize_OP(Turbine, Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & - Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) + call ModGlue_Linearize_OP(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -8631,8 +8631,8 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) IF (ErrStat >= AbortErrLev) RETURN ! Linearize at operating points - call ModGlue_Linearize_OP(Turbine, Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & - Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, ErrStat2, ErrMsg2) + call ModGlue_Linearize_OP(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index e1068f16db..1cf6719312 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -15723,5 +15723,7 @@ subroutine FAST_UnPackTurbineType(RF, OutData) call FAST_UnpackIceDyn_Data(RF, OutData%IceD) ! IceD call FAST_UnpackExtPtfm_Data(RF, OutData%ExtPtfm) ! ExtPtfm end subroutine + END MODULE FAST_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index 1248c7ea0e..e667aa360a 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -182,7 +182,7 @@ typedef ^ Glue_LinMisc IntKi TimeIndex - - - typedef ^ ^ IntKi AzimuthIndex - - - "" - typedef ^ ^ logical IsConverged - - - "" - -typedef ^ Glue_MiscVarType ModDataType Modules : - - "Module variable and value data" - +typedef ^ Glue_MiscVarType ModDataType ModDataAry : - - "Module variable and value data" - typedef ^ ^ MappingType Mappings : - - "Module mapping" - typedef ^ ^ ModGlueType ModGlue - - - "Glue code module" - typedef ^ ^ Glue_LinMisc Lin - - - "Linearization misc vars" diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 56e8117b75..adbaeafd0b 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -203,7 +203,7 @@ MODULE Glue_Types ! ======================= ! ========= Glue_MiscVarType ======= TYPE, PUBLIC :: Glue_MiscVarType - TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: Modules !< Module variable and value data [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModDataAry !< Module variable and value data [-] TYPE(MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mapping [-] TYPE(ModGlueType) :: ModGlue !< Glue code module [-] TYPE(Glue_LinMisc) :: Lin !< Linearization misc vars [-] @@ -1737,18 +1737,18 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%Modules)) then - LB(1:1) = lbound(SrcMiscData%Modules, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Modules, kind=B8Ki) - if (.not. allocated(DstMiscData%Modules)) then - allocate(DstMiscData%Modules(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%ModDataAry)) then + LB(1:1) = lbound(SrcMiscData%ModDataAry, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%ModDataAry, kind=B8Ki) + if (.not. allocated(DstMiscData%ModDataAry)) then + allocate(DstMiscData%ModDataAry(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Modules.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyModDataType(SrcMiscData%Modules(i1), DstMiscData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModDataType(SrcMiscData%ModDataAry(i1), DstMiscData%ModDataAry(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -2086,14 +2086,14 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%Modules)) then - LB(1:1) = lbound(MiscData%Modules, kind=B8Ki) - UB(1:1) = ubound(MiscData%Modules, kind=B8Ki) + if (allocated(MiscData%ModDataAry)) then + LB(1:1) = lbound(MiscData%ModDataAry, kind=B8Ki) + UB(1:1) = ubound(MiscData%ModDataAry, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_DestroyModDataType(MiscData%Modules(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModDataType(MiscData%ModDataAry(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%Modules) + deallocate(MiscData%ModDataAry) end if if (allocated(MiscData%Mappings)) then LB(1:1) = lbound(MiscData%Mappings, kind=B8Ki) @@ -2193,13 +2193,13 @@ subroutine Glue_PackMisc(RF, Indata) integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%Modules)) - if (allocated(InData%Modules)) then - call RegPackBounds(RF, 1, lbound(InData%Modules, kind=B8Ki), ubound(InData%Modules, kind=B8Ki)) - LB(1:1) = lbound(InData%Modules, kind=B8Ki) - UB(1:1) = ubound(InData%Modules, kind=B8Ki) + call RegPack(RF, allocated(InData%ModDataAry)) + if (allocated(InData%ModDataAry)) then + call RegPackBounds(RF, 1, lbound(InData%ModDataAry, kind=B8Ki), ubound(InData%ModDataAry, kind=B8Ki)) + LB(1:1) = lbound(InData%ModDataAry, kind=B8Ki) + UB(1:1) = ubound(InData%ModDataAry, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackModDataType(RF, InData%Modules(i1)) + call NWTC_Library_PackModDataType(RF, InData%ModDataAry(i1)) end do end if call RegPack(RF, allocated(InData%Mappings)) @@ -2255,17 +2255,17 @@ subroutine Glue_UnPackMisc(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%Modules)) deallocate(OutData%Modules) + if (allocated(OutData%ModDataAry)) deallocate(OutData%ModDataAry) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Modules(LB(1):UB(1)),stat=stat) + allocate(OutData%ModDataAry(LB(1):UB(1)),stat=stat) if (stat /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modules.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackModDataType(RF, OutData%Modules(i1)) ! Modules + call NWTC_Library_UnpackModDataType(RF, OutData%ModDataAry(i1)) ! Modules end do end if if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) @@ -2314,5 +2314,7 @@ subroutine Glue_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%UDiff); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE Glue_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 64ba679819..9d3484e50c 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -322,7 +322,8 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) { ++field_num; // w << " type(DatDesc), public, parameter :: " << std::setw(32) << std::left << field.name << " = DatDesc(" << field_num << ", " << field.rank << ", \"" << field.desc << "\")\n"; - w << " integer(IntKi), public, parameter :: " << std::setw(32) << std::left << field.name << " = " << std::setw(3) << std::right << field_num << " ! " << field.desc << "\n"; + w << " integer(IntKi), public, parameter :: " << std::setw(32) << std::left << field.name << " = " << std::setw(3) << std::right << field_num << " ! " << field.desc << "\n" + << std::left; } } @@ -407,9 +408,9 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) // Mesh pointer routine w << indent << "function " << routine_name << "(" << tmp[1] << ", DL) result(Mesh)"; indent += " "; - w << indent << "type(" << ddt.type_fortran << "), target, intent(in) :: " << tmp[1]; - w << indent << "type(DatLoc), intent(in) :: DL"; - w << indent << "type(MeshType), pointer :: Mesh"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), target, intent(in) " << ":: " << tmp[1]; + w << indent << "type(DatLoc), intent(in) :: DL"; + w << indent << "type(MeshType), pointer :: Mesh"; w << indent << "nullify(Mesh)"; w << indent << "select case (DL%Num)"; for (int i = 0; i < mesh_paths.size(); ++i) @@ -483,21 +484,21 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) std::string indent("\n"); w << indent << "subroutine " << routine_name << "(Vars, " << abbr << ", ValAry)"; indent += " "; - w << indent << "type(" << ddt.type_fortran << "), intent(in) :: " << abbr; - w << indent << "type(ModVarsType), intent(in) :: Vars"; - w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; - w << indent << "integer(IntKi) :: i"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(in) " << ":: " << abbr; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; + w << indent << "integer(IntKi) :: i"; w << indent << "do i = 1, size(Vars%" << abbr << ")"; indent += " "; - w << indent << "associate (Var => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; + w << indent << "associate (V => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; indent += " "; - w << indent << "select case (Var%DL%Num)"; + w << indent << "select case (DL%Num)"; for (const auto &field : fields) { w << indent << "case (" << field.name << ")"; std::string comment = "Scalar"; auto field_path = field.desc; - if ((field.data_type->tag == DataType::Tag::Derived)) + if (field.data_type->tag == DataType::Tag::Derived) { comment = "Mesh"; } @@ -505,22 +506,46 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) { comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; } + if ((field.name.compare("BD_x_q") == 0) && (short_type.compare("ContState") == 0)) { // This is a hack to convert BeamDyn's WM orientations to quaternions - w << indent << " if (Var%Field == FieldOrientation) then"; - w << indent << " ValAry(Var%iLoc(1):Var%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, Var%jAry))) ! Convert WM parameters to quaternions"; + w << indent << " if (V%Field == FieldOrientation) then"; + w << indent << " ValAry(V%iLoc(1):V%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, V%jAry))) ! Convert WM parameters to quaternions"; w << indent << " else"; - w << indent << " call MV_Pack2(Var, " << field_path << ", ValAry) ! " << comment; + w << indent << std::setw(71) << " call MV_Pack(V, " + field_path + "(V%iAry(1):V%iAry(2),V%jAry), ValAry) " << "! " + comment; w << indent << " end if"; } + else if (field.data_type->tag == DataType::Tag::Derived) + { + w << indent << std::setw(71) << " call MV_Pack(V, " + field_path + ", ValAry)" << "! Mesh"; + } else { - w << indent << " call MV_Pack2(Var, " << field_path << ", ValAry) ! " << comment; + std::string tmp{" call MV_Pack(V, " + field_path}; + switch (field.rank) + { + case 1: + tmp += "(V%iAry(1):V%iAry(2))"; + break; + case 2: + tmp += "(V%iAry(1):V%iAry(2),V%jAry)"; + break; + case 3: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry)"; + break; + case 4: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)"; + break; + case 5: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)"; + break; + } + w << indent << std::setw(71) << tmp + ", ValAry) " << "! " + comment; } } w << indent << "case default"; - w << indent << " ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki"; + w << indent << " ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki"; w << indent << "end select"; indent.erase(indent.size() - 3); w << indent << "end associate"; @@ -539,40 +564,59 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) routine_name = mod.nickname + "_Unpack" + short_type + "Ary"; w << indent << "subroutine " << routine_name << "(Vars, ValAry, " << abbr << ")"; indent += " "; - w << indent << "type(ModVarsType), intent(in) :: Vars"; - w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; - w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << abbr; - w << indent << "integer(IntKi) :: i"; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(inout) " << ":: " + abbr; + w << indent << "integer(IntKi) :: i"; w << indent << "do i = 1, size(Vars%" << abbr << ")"; indent += " "; - w << indent << "associate (Var => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; + w << indent << "associate (V => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; indent += " "; - w << indent << "select case (Var%DL%Num)"; + w << indent << "select case (DL%Num)"; for (const auto &field : fields) { w << indent << "case (" << field.name << ")"; std::string comment = "Scalar"; auto field_path = field.desc; - if ((field.data_type->tag == DataType::Tag::Derived)) - { - comment = "Mesh"; - } - else if (field.rank > 0) + if (field.rank > 0) { comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; } if (field.name.compare("BD_x_q") == 0) { // This is a hack to convert BeamDyn's WM orientations to quaternions - w << indent << " if (Var%Field == FieldOrientation) then"; - w << indent << " x%q(4:6, Var%jAry) = wm_inv(quat_to_wm(ValAry(Var%iLoc(1):Var%iLoc(2)))) ! Convert quaternion to WM parameters"; + w << indent << " if (V%Field == FieldOrientation) then"; + w << indent << " x%q(4:6, V%jAry) = wm_inv(quat_to_wm(ValAry(V%iLoc(1):V%iLoc(2)))) ! Convert quaternion to WM parameters"; w << indent << " else"; - w << indent << " call MV_Unpack2(Var, ValAry, " << field_path << ") ! " << comment; + w << indent << std::setw(71) << " call MV_Unpack(V, ValAry, " + field_path + "(V%iAry(1):V%iAry(2),V%jAry)) " << "! Rank 2 Array"; w << indent << " end if"; } + else if (field.data_type->tag == DataType::Tag::Derived) + { + w << indent << std::setw(71) << " call MV_Unpack(V, ValAry, " + field_path + ") " << "! Mesh"; + } else { - w << indent << " call MV_Unpack2(Var, ValAry, " << field_path << ") ! " << comment; + std::string tmp{" call MV_Unpack(V, ValAry, " + field_path}; + switch (field.rank) + { + case 1: + tmp += "(V%iAry(1):V%iAry(2))"; + break; + case 2: + tmp += "(V%iAry(1):V%iAry(2),V%jAry)"; + break; + case 3: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry)"; + break; + case 4: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)"; + break; + case 5: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)"; + break; + } + w << indent << std::setw(71) << tmp + ") " << "! " + comment; } } w << indent << "end select"; diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 0a08515224..a96800de28 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -1158,246 +1158,212 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E END IF ! check if allocated END SUBROUTINE -function Orca_InputMeshPointer(u, ML) result(Mesh) +function Orca_InputMeshPointer(u, DL) result(Mesh) type(Orca_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (Orca_u_PtfmMesh) Mesh => u%PtfmMesh end select end function -function Orca_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function Orca_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (Orca_u_PtfmMesh) Name = "u%PtfmMesh" end select end function -function Orca_OutputMeshPointer(y, ML) result(Mesh) +function Orca_OutputMeshPointer(y, DL) result(Mesh) type(Orca_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (Orca_y_PtfmMesh) Mesh => y%PtfmMesh end select end function -function Orca_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function Orca_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (Orca_y_PtfmMesh) Name = "y%PtfmMesh" end select end function -subroutine Orca_PackContStateVar(Var, x, ValAry) - type(Orca_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Orca_x_Dummy) - call MV_Pack2(Var, x%Dummy, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Orca_PackContStateAry(Vars, x, ValAry) type(Orca_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call Orca_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Orca_x_Dummy) + call MV_Pack(V, x%Dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Orca_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Orca_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Orca_x_Dummy) - call MV_Unpack2(Var, ValAry, x%Dummy) ! Scalar - end select - end associate -end subroutine - subroutine Orca_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Orca_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call Orca_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Orca_x_Dummy) + call MV_Unpack(V, ValAry, x%Dummy) ! Scalar + end select + end associate end do end subroutine +subroutine Orca_PackContStateDerivAry(Vars, x, ValAry) + type(Orca_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Orca_x_Dummy) + call MV_Pack(V, x%Dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine Orca_PackConstrStateVar(Var, z, ValAry) - type(Orca_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Orca_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine Orca_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (Orca_x_Dummy) + call MV_Unpack(V, ValAry, x%Dummy) ! Scalar + end select + end associate + end do end subroutine subroutine Orca_PackConstrStateAry(Vars, z, ValAry) type(Orca_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call Orca_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (Orca_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Orca_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Orca_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Orca_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine Orca_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(Orca_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call Orca_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (Orca_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine Orca_PackInputVar(Var, u, ValAry) - type(Orca_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Orca_u_PtfmMesh) - call MV_Pack2(Var, u%PtfmMesh, ValAry) ! Mesh - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Orca_PackInputAry(Vars, u, ValAry) - type(Orca_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(Orca_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call Orca_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (Orca_u_PtfmMesh) + call MV_Pack(V, u%PtfmMesh, ValAry) ! Mesh + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Orca_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Orca_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Orca_u_PtfmMesh) - call MV_Unpack2(Var, ValAry, u%PtfmMesh) ! Mesh - end select - end associate -end subroutine - subroutine Orca_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Orca_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call Orca_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (Orca_u_PtfmMesh) + call MV_Unpack(V, ValAry, u%PtfmMesh) ! Mesh + end select + end associate end do end subroutine - -subroutine Orca_PackOutputVar(Var, y, ValAry) - type(Orca_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Orca_y_PtfmMesh) - call MV_Pack2(Var, y%PtfmMesh, ValAry) ! Mesh - case (Orca_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine Orca_PackOutputAry(Vars, y, ValAry) - type(Orca_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(Orca_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call Orca_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (Orca_y_PtfmMesh) + call MV_Pack(V, y%PtfmMesh, ValAry) ! Mesh + case (Orca_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine Orca_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(Orca_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (Orca_y_PtfmMesh) - call MV_Unpack2(Var, ValAry, y%PtfmMesh) ! Mesh - case (Orca_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine Orca_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Orca_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call Orca_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (Orca_y_PtfmMesh) + call MV_Unpack(V, ValAry, y%PtfmMesh) ! Mesh + case (Orca_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE OrcaFlexInterface_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 1216965766..f96a24f0d3 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -233,5 +233,7 @@ subroutine Current_UnPackInitOutput(RF, OutData) call RegUnpack(RF, OutData%PCurrVxiPz0); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PCurrVyiPz0); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE Current_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 66ccc623fd..3d2a5b0257 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -572,5 +572,7 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NStepWave2); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE SeaSt_WaveField_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 8a70473da4..0a52f6eb43 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -116,7 +116,7 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< Y locations of grid output [m,-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points. [(m)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE SeaSt_InitOutputType ! ======================= ! ========= SeaSt_ContinuousStateType ======= @@ -141,7 +141,6 @@ MODULE SeaState_Types ! ======================= ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] @@ -628,7 +627,9 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElevVisGrid = SrcInitOutputData%WaveElevVisGrid end if DstInitOutputData%WaveField => SrcInitOutputData%WaveField - DstInitOutputData%Vars => SrcInitOutputData%Vars + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -658,7 +659,8 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%WaveElevVisGrid) end if nullify(InitOutputData%WaveField) - nullify(InitOutputData%Vars) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SeaSt_PackInitOutput(RF, Indata) @@ -681,13 +683,7 @@ subroutine SeaSt_PackInitOutput(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -726,24 +722,7 @@ subroutine SeaSt_UnPackInitOutput(RF, OutData) else OutData%WaveField => null() end if - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine SeaSt_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -911,18 +890,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'SeaSt_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(SrcParamData%Vars)) then - if (.not. associated(DstParamData%Vars)) then - allocate(DstParamData%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if DstParamData%WaveDT = SrcParamData%WaveDT DstParamData%NGridPts = SrcParamData%NGridPts DstParamData%NGrid = SrcParamData%NGrid @@ -1037,12 +1004,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(ParamData%Vars)) then - call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(ParamData%Vars) - ParamData%Vars => null() - end if if (allocated(ParamData%WaveElevxi)) then deallocate(ParamData%WaveElevxi) end if @@ -1083,13 +1044,6 @@ subroutine SeaSt_PackParam(RF, Indata) integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if call RegPack(RF, InData%WaveDT) call RegPack(RF, InData%NGridPts) call RegPack(RF, InData%NGrid) @@ -1138,24 +1092,6 @@ subroutine SeaSt_UnPackParam(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if call RegUnpack(RF, OutData%WaveDT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NGridPts); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NGrid); if (RegCheckErr(RF, RoutineName)) return @@ -1378,234 +1314,200 @@ subroutine SeaSt_UnPackMisc(RF, OutData) call SeaSt_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine -function SeaSt_InputMeshPointer(u, ML) result(Mesh) +function SeaSt_InputMeshPointer(u, DL) result(Mesh) type(SeaSt_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SeaSt_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SeaSt_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function SeaSt_OutputMeshPointer(y, ML) result(Mesh) +function SeaSt_OutputMeshPointer(y, DL) result(Mesh) type(SeaSt_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SeaSt_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SeaSt_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine SeaSt_PackContStateVar(Var, x, ValAry) - type(SeaSt_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SeaSt_x_UnusedStates) - call MV_Pack2(Var, x%UnusedStates, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SeaSt_PackContStateAry(Vars, x, ValAry) type(SeaSt_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call SeaSt_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + call MV_Pack(V, x%UnusedStates, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SeaSt_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SeaSt_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SeaSt_x_UnusedStates) - call MV_Unpack2(Var, ValAry, x%UnusedStates) ! Scalar - end select - end associate -end subroutine - subroutine SeaSt_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call SeaSt_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + call MV_Unpack(V, ValAry, x%UnusedStates) ! Scalar + end select + end associate end do end subroutine +subroutine SeaSt_PackContStateDerivAry(Vars, x, ValAry) + type(SeaSt_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + call MV_Pack(V, x%UnusedStates, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine SeaSt_PackConstrStateVar(Var, z, ValAry) - type(SeaSt_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SeaSt_z_UnusedStates) - call MV_Pack2(Var, z%UnusedStates, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine SeaSt_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + call MV_Unpack(V, ValAry, x%UnusedStates) ! Scalar + end select + end associate + end do end subroutine subroutine SeaSt_PackConstrStateAry(Vars, z, ValAry) type(SeaSt_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call SeaSt_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SeaSt_z_UnusedStates) + call MV_Pack(V, z%UnusedStates, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SeaSt_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SeaSt_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SeaSt_z_UnusedStates) - call MV_Unpack2(Var, ValAry, z%UnusedStates) ! Scalar - end select - end associate -end subroutine - subroutine SeaSt_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call SeaSt_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SeaSt_z_UnusedStates) + call MV_Unpack(V, ValAry, z%UnusedStates) ! Scalar + end select + end associate end do end subroutine - -subroutine SeaSt_PackInputVar(Var, u, ValAry) - type(SeaSt_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SeaSt_u_DummyInput) - call MV_Pack2(Var, u%DummyInput, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SeaSt_PackInputAry(Vars, u, ValAry) - type(SeaSt_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SeaSt_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call SeaSt_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SeaSt_u_DummyInput) + call MV_Pack(V, u%DummyInput, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SeaSt_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SeaSt_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SeaSt_u_DummyInput) - call MV_Unpack2(Var, ValAry, u%DummyInput) ! Scalar - end select - end associate -end subroutine - subroutine SeaSt_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SeaSt_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call SeaSt_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SeaSt_u_DummyInput) + call MV_Unpack(V, ValAry, u%DummyInput) ! Scalar + end select + end associate end do end subroutine - -subroutine SeaSt_PackOutputVar(Var, y, ValAry) - type(SeaSt_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SeaSt_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SeaSt_PackOutputAry(Vars, y, ValAry) - type(SeaSt_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SeaSt_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call SeaSt_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SeaSt_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SeaSt_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SeaSt_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SeaSt_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SeaSt_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SeaSt_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call SeaSt_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SeaSt_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE SeaState_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index ac9aa95039..f3fc051ff7 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -309,5 +309,7 @@ subroutine Waves2_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WaveVel2D); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveVel2S); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE Waves2_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index ca5550d38e..d5daa2a2d9 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -335,5 +335,7 @@ subroutine Waves_UnPackInitOutput(RF, OutData) call RegUnpack(RF, OutData%WaveNDir); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveTMax); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE Waves_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 434609d9db..60168ef732 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -7214,562 +7214,544 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E END IF ! check if allocated END SUBROUTINE -function SrvD_InputMeshPointer(u, ML) result(Mesh) +function SrvD_InputMeshPointer(u, DL) result(Mesh) type(SrvD_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (SrvD_u_PtfmMotionMesh) Mesh => u%PtfmMotionMesh case (SrvD_u_BStCMotionMesh) - Mesh => u%BStCMotionMesh(ML%i1, ML%i2) + Mesh => u%BStCMotionMesh(DL%i1, DL%i2) case (SrvD_u_NStCMotionMesh) - Mesh => u%NStCMotionMesh(ML%i1) + Mesh => u%NStCMotionMesh(DL%i1) case (SrvD_u_TStCMotionMesh) - Mesh => u%TStCMotionMesh(ML%i1) + Mesh => u%TStCMotionMesh(DL%i1) case (SrvD_u_SStCMotionMesh) - Mesh => u%SStCMotionMesh(ML%i1) + Mesh => u%SStCMotionMesh(DL%i1) end select end function -function SrvD_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SrvD_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (SrvD_u_PtfmMotionMesh) Name = "u%PtfmMotionMesh" case (SrvD_u_BStCMotionMesh) - Name = "u%BStCMotionMesh("//trim(Num2LStr(ML%i1))//", "//trim(Num2LStr(ML%i2))//")" + Name = "u%BStCMotionMesh("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")" case (SrvD_u_NStCMotionMesh) - Name = "u%NStCMotionMesh("//trim(Num2LStr(ML%i1))//")" + Name = "u%NStCMotionMesh("//trim(Num2LStr(DL%i1))//")" case (SrvD_u_TStCMotionMesh) - Name = "u%TStCMotionMesh("//trim(Num2LStr(ML%i1))//")" + Name = "u%TStCMotionMesh("//trim(Num2LStr(DL%i1))//")" case (SrvD_u_SStCMotionMesh) - Name = "u%SStCMotionMesh("//trim(Num2LStr(ML%i1))//")" + Name = "u%SStCMotionMesh("//trim(Num2LStr(DL%i1))//")" end select end function -function SrvD_OutputMeshPointer(y, ML) result(Mesh) +function SrvD_OutputMeshPointer(y, DL) result(Mesh) type(SrvD_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (SrvD_y_BStCLoadMesh) - Mesh => y%BStCLoadMesh(ML%i1, ML%i2) + Mesh => y%BStCLoadMesh(DL%i1, DL%i2) case (SrvD_y_NStCLoadMesh) - Mesh => y%NStCLoadMesh(ML%i1) + Mesh => y%NStCLoadMesh(DL%i1) case (SrvD_y_TStCLoadMesh) - Mesh => y%TStCLoadMesh(ML%i1) + Mesh => y%TStCLoadMesh(DL%i1) case (SrvD_y_SStCLoadMesh) - Mesh => y%SStCLoadMesh(ML%i1) + Mesh => y%SStCLoadMesh(DL%i1) end select end function -function SrvD_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SrvD_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (SrvD_y_BStCLoadMesh) - Name = "y%BStCLoadMesh("//trim(Num2LStr(ML%i1))//", "//trim(Num2LStr(ML%i2))//")" + Name = "y%BStCLoadMesh("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")" case (SrvD_y_NStCLoadMesh) - Name = "y%NStCLoadMesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%NStCLoadMesh("//trim(Num2LStr(DL%i1))//")" case (SrvD_y_TStCLoadMesh) - Name = "y%TStCLoadMesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%TStCLoadMesh("//trim(Num2LStr(DL%i1))//")" case (SrvD_y_SStCLoadMesh) - Name = "y%SStCLoadMesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%SStCLoadMesh("//trim(Num2LStr(DL%i1))//")" end select end function -subroutine SrvD_PackContStateVar(Var, x, ValAry) - type(SrvD_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SrvD_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - case (SrvD_x_BStC_StC_x) - call MV_Pack2(Var, x%BStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array - case (SrvD_x_NStC_StC_x) - call MV_Pack2(Var, x%NStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array - case (SrvD_x_TStC_StC_x) - call MV_Pack2(Var, x%TStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array - case (SrvD_x_SStC_StC_x) - call MV_Pack2(Var, x%SStC(DL%i1)%StC_x, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SrvD_PackContStateAry(Vars, x, ValAry) type(SrvD_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call SrvD_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SrvD_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case (SrvD_x_BStC_StC_x) + call MV_Pack(V, x%BStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + call MV_Pack(V, x%NStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + call MV_Pack(V, x%TStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + call MV_Pack(V, x%SStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SrvD_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SrvD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SrvD_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - case (SrvD_x_BStC_StC_x) - call MV_Unpack2(Var, ValAry, x%BStC(DL%i1)%StC_x) ! Rank 2 Array - case (SrvD_x_NStC_StC_x) - call MV_Unpack2(Var, ValAry, x%NStC(DL%i1)%StC_x) ! Rank 2 Array - case (SrvD_x_TStC_StC_x) - call MV_Unpack2(Var, ValAry, x%TStC(DL%i1)%StC_x) ! Rank 2 Array - case (SrvD_x_SStC_StC_x) - call MV_Unpack2(Var, ValAry, x%SStC(DL%i1)%StC_x) ! Rank 2 Array - end select - end associate -end subroutine - subroutine SrvD_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SrvD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call SrvD_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SrvD_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + case (SrvD_x_BStC_StC_x) + call MV_Unpack(V, ValAry, x%BStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + call MV_Unpack(V, ValAry, x%NStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + call MV_Unpack(V, ValAry, x%TStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + call MV_Unpack(V, ValAry, x%SStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine +subroutine SrvD_PackContStateDerivAry(Vars, x, ValAry) + type(SrvD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SrvD_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case (SrvD_x_BStC_StC_x) + call MV_Pack(V, x%BStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + call MV_Pack(V, x%NStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + call MV_Pack(V, x%TStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + call MV_Pack(V, x%SStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine SrvD_PackConstrStateVar(Var, z, ValAry) - type(SrvD_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SrvD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_BStC_DummyConstrState) - call MV_Pack2(Var, z%BStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_NStC_DummyConstrState) - call MV_Pack2(Var, z%NStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_TStC_DummyConstrState) - call MV_Pack2(Var, z%TStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_SStC_DummyConstrState) - call MV_Pack2(Var, z%SStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine SrvD_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SrvD_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + case (SrvD_x_BStC_StC_x) + call MV_Unpack(V, ValAry, x%BStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + call MV_Unpack(V, ValAry, x%NStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + call MV_Unpack(V, ValAry, x%TStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + call MV_Unpack(V, ValAry, x%SStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate + end do end subroutine subroutine SrvD_PackConstrStateAry(Vars, z, ValAry) type(SrvD_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call SrvD_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SrvD_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_BStC_DummyConstrState) + call MV_Pack(V, z%BStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_NStC_DummyConstrState) + call MV_Pack(V, z%NStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_TStC_DummyConstrState) + call MV_Pack(V, z%TStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case (SrvD_z_SStC_DummyConstrState) + call MV_Pack(V, z%SStC(DL%i1)%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SrvD_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SrvD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SrvD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - case (SrvD_z_BStC_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%BStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_NStC_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%NStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_TStC_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%TStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_SStC_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%SStC(DL%i1)%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine SrvD_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SrvD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call SrvD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SrvD_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + case (SrvD_z_BStC_DummyConstrState) + call MV_Unpack(V, ValAry, z%BStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_NStC_DummyConstrState) + call MV_Unpack(V, ValAry, z%NStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_TStC_DummyConstrState) + call MV_Unpack(V, ValAry, z%TStC(DL%i1)%DummyConstrState) ! Scalar + case (SrvD_z_SStC_DummyConstrState) + call MV_Unpack(V, ValAry, z%SStC(DL%i1)%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine SrvD_PackInputVar(Var, u, ValAry) - type(SrvD_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SrvD_u_BlPitch) - call MV_Pack2(Var, u%BlPitch, ValAry) ! Rank 1 Array - case (SrvD_u_Yaw) - call MV_Pack2(Var, u%Yaw, ValAry) ! Scalar - case (SrvD_u_YawRate) - call MV_Pack2(Var, u%YawRate, ValAry) ! Scalar - case (SrvD_u_LSS_Spd) - call MV_Pack2(Var, u%LSS_Spd, ValAry) ! Scalar - case (SrvD_u_HSS_Spd) - call MV_Pack2(Var, u%HSS_Spd, ValAry) ! Scalar - case (SrvD_u_RotSpeed) - call MV_Pack2(Var, u%RotSpeed, ValAry) ! Scalar - case (SrvD_u_ExternalYawPosCom) - call MV_Pack2(Var, u%ExternalYawPosCom, ValAry) ! Scalar - case (SrvD_u_ExternalYawRateCom) - call MV_Pack2(Var, u%ExternalYawRateCom, ValAry) ! Scalar - case (SrvD_u_ExternalBlPitchCom) - call MV_Pack2(Var, u%ExternalBlPitchCom, ValAry) ! Rank 1 Array - case (SrvD_u_ExternalGenTrq) - call MV_Pack2(Var, u%ExternalGenTrq, ValAry) ! Scalar - case (SrvD_u_ExternalElecPwr) - call MV_Pack2(Var, u%ExternalElecPwr, ValAry) ! Scalar - case (SrvD_u_ExternalHSSBrFrac) - call MV_Pack2(Var, u%ExternalHSSBrFrac, ValAry) ! Scalar - case (SrvD_u_ExternalBlAirfoilCom) - call MV_Pack2(Var, u%ExternalBlAirfoilCom, ValAry) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaL) - call MV_Pack2(Var, u%ExternalCableDeltaL, ValAry) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaLdot) - call MV_Pack2(Var, u%ExternalCableDeltaLdot, ValAry) ! Rank 1 Array - case (SrvD_u_TwrAccel) - call MV_Pack2(Var, u%TwrAccel, ValAry) ! Scalar - case (SrvD_u_YawErr) - call MV_Pack2(Var, u%YawErr, ValAry) ! Scalar - case (SrvD_u_WindDir) - call MV_Pack2(Var, u%WindDir, ValAry) ! Scalar - case (SrvD_u_RootMyc) - call MV_Pack2(Var, u%RootMyc, ValAry) ! Rank 1 Array - case (SrvD_u_YawBrTAxp) - call MV_Pack2(Var, u%YawBrTAxp, ValAry) ! Scalar - case (SrvD_u_YawBrTAyp) - call MV_Pack2(Var, u%YawBrTAyp, ValAry) ! Scalar - case (SrvD_u_LSSTipPxa) - call MV_Pack2(Var, u%LSSTipPxa, ValAry) ! Scalar - case (SrvD_u_RootMxc) - call MV_Pack2(Var, u%RootMxc, ValAry) ! Rank 1 Array - case (SrvD_u_LSSTipMxa) - call MV_Pack2(Var, u%LSSTipMxa, ValAry) ! Scalar - case (SrvD_u_LSSTipMya) - call MV_Pack2(Var, u%LSSTipMya, ValAry) ! Scalar - case (SrvD_u_LSSTipMza) - call MV_Pack2(Var, u%LSSTipMza, ValAry) ! Scalar - case (SrvD_u_LSSTipMys) - call MV_Pack2(Var, u%LSSTipMys, ValAry) ! Scalar - case (SrvD_u_LSSTipMzs) - call MV_Pack2(Var, u%LSSTipMzs, ValAry) ! Scalar - case (SrvD_u_YawBrMyn) - call MV_Pack2(Var, u%YawBrMyn, ValAry) ! Scalar - case (SrvD_u_YawBrMzn) - call MV_Pack2(Var, u%YawBrMzn, ValAry) ! Scalar - case (SrvD_u_NcIMURAxs) - call MV_Pack2(Var, u%NcIMURAxs, ValAry) ! Scalar - case (SrvD_u_NcIMURAys) - call MV_Pack2(Var, u%NcIMURAys, ValAry) ! Scalar - case (SrvD_u_NcIMURAzs) - call MV_Pack2(Var, u%NcIMURAzs, ValAry) ! Scalar - case (SrvD_u_RotPwr) - call MV_Pack2(Var, u%RotPwr, ValAry) ! Scalar - case (SrvD_u_HorWindV) - call MV_Pack2(Var, u%HorWindV, ValAry) ! Scalar - case (SrvD_u_YawAngle) - call MV_Pack2(Var, u%YawAngle, ValAry) ! Scalar - case (SrvD_u_LSShftFxa) - call MV_Pack2(Var, u%LSShftFxa, ValAry) ! Scalar - case (SrvD_u_LSShftFys) - call MV_Pack2(Var, u%LSShftFys, ValAry) ! Scalar - case (SrvD_u_LSShftFzs) - call MV_Pack2(Var, u%LSShftFzs, ValAry) ! Scalar - case (SrvD_u_fromSC) - call MV_Pack2(Var, u%fromSC, ValAry) ! Rank 1 Array - case (SrvD_u_fromSCglob) - call MV_Pack2(Var, u%fromSCglob, ValAry) ! Rank 1 Array - case (SrvD_u_Lidar) - call MV_Pack2(Var, u%Lidar, ValAry) ! Rank 1 Array - case (SrvD_u_PtfmMotionMesh) - call MV_Pack2(Var, u%PtfmMotionMesh, ValAry) ! Mesh - case (SrvD_u_BStCMotionMesh) - call MV_Pack2(Var, u%BStCMotionMesh(DL%i1, DL%i2), ValAry) ! Mesh - case (SrvD_u_NStCMotionMesh) - call MV_Pack2(Var, u%NStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_TStCMotionMesh) - call MV_Pack2(Var, u%TStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_SStCMotionMesh) - call MV_Pack2(Var, u%SStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_LidSpeed) - call MV_Pack2(Var, u%LidSpeed, ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsX) - call MV_Pack2(Var, u%MsrPositionsX, ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsY) - call MV_Pack2(Var, u%MsrPositionsY, ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsZ) - call MV_Pack2(Var, u%MsrPositionsZ, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SrvD_PackInputAry(Vars, u, ValAry) - type(SrvD_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SrvD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call SrvD_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SrvD_u_BlPitch) + call MV_Pack(V, u%BlPitch(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_Yaw) + call MV_Pack(V, u%Yaw, ValAry) ! Scalar + case (SrvD_u_YawRate) + call MV_Pack(V, u%YawRate, ValAry) ! Scalar + case (SrvD_u_LSS_Spd) + call MV_Pack(V, u%LSS_Spd, ValAry) ! Scalar + case (SrvD_u_HSS_Spd) + call MV_Pack(V, u%HSS_Spd, ValAry) ! Scalar + case (SrvD_u_RotSpeed) + call MV_Pack(V, u%RotSpeed, ValAry) ! Scalar + case (SrvD_u_ExternalYawPosCom) + call MV_Pack(V, u%ExternalYawPosCom, ValAry) ! Scalar + case (SrvD_u_ExternalYawRateCom) + call MV_Pack(V, u%ExternalYawRateCom, ValAry) ! Scalar + case (SrvD_u_ExternalBlPitchCom) + call MV_Pack(V, u%ExternalBlPitchCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + call MV_Pack(V, u%ExternalGenTrq, ValAry) ! Scalar + case (SrvD_u_ExternalElecPwr) + call MV_Pack(V, u%ExternalElecPwr, ValAry) ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + call MV_Pack(V, u%ExternalHSSBrFrac, ValAry) ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + call MV_Pack(V, u%ExternalBlAirfoilCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + call MV_Pack(V, u%ExternalCableDeltaL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + call MV_Pack(V, u%ExternalCableDeltaLdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_TwrAccel) + call MV_Pack(V, u%TwrAccel, ValAry) ! Scalar + case (SrvD_u_YawErr) + call MV_Pack(V, u%YawErr, ValAry) ! Scalar + case (SrvD_u_WindDir) + call MV_Pack(V, u%WindDir, ValAry) ! Scalar + case (SrvD_u_RootMyc) + call MV_Pack(V, u%RootMyc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + call MV_Pack(V, u%YawBrTAxp, ValAry) ! Scalar + case (SrvD_u_YawBrTAyp) + call MV_Pack(V, u%YawBrTAyp, ValAry) ! Scalar + case (SrvD_u_LSSTipPxa) + call MV_Pack(V, u%LSSTipPxa, ValAry) ! Scalar + case (SrvD_u_RootMxc) + call MV_Pack(V, u%RootMxc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + call MV_Pack(V, u%LSSTipMxa, ValAry) ! Scalar + case (SrvD_u_LSSTipMya) + call MV_Pack(V, u%LSSTipMya, ValAry) ! Scalar + case (SrvD_u_LSSTipMza) + call MV_Pack(V, u%LSSTipMza, ValAry) ! Scalar + case (SrvD_u_LSSTipMys) + call MV_Pack(V, u%LSSTipMys, ValAry) ! Scalar + case (SrvD_u_LSSTipMzs) + call MV_Pack(V, u%LSSTipMzs, ValAry) ! Scalar + case (SrvD_u_YawBrMyn) + call MV_Pack(V, u%YawBrMyn, ValAry) ! Scalar + case (SrvD_u_YawBrMzn) + call MV_Pack(V, u%YawBrMzn, ValAry) ! Scalar + case (SrvD_u_NcIMURAxs) + call MV_Pack(V, u%NcIMURAxs, ValAry) ! Scalar + case (SrvD_u_NcIMURAys) + call MV_Pack(V, u%NcIMURAys, ValAry) ! Scalar + case (SrvD_u_NcIMURAzs) + call MV_Pack(V, u%NcIMURAzs, ValAry) ! Scalar + case (SrvD_u_RotPwr) + call MV_Pack(V, u%RotPwr, ValAry) ! Scalar + case (SrvD_u_HorWindV) + call MV_Pack(V, u%HorWindV, ValAry) ! Scalar + case (SrvD_u_YawAngle) + call MV_Pack(V, u%YawAngle, ValAry) ! Scalar + case (SrvD_u_LSShftFxa) + call MV_Pack(V, u%LSShftFxa, ValAry) ! Scalar + case (SrvD_u_LSShftFys) + call MV_Pack(V, u%LSShftFys, ValAry) ! Scalar + case (SrvD_u_LSShftFzs) + call MV_Pack(V, u%LSShftFzs, ValAry) ! Scalar + case (SrvD_u_fromSC) + call MV_Pack(V, u%fromSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_fromSCglob) + call MV_Pack(V, u%fromSCglob(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_Lidar) + call MV_Pack(V, u%Lidar(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_Pack(V, u%PtfmMotionMesh, ValAry) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_Pack(V, u%BStCMotionMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_Pack(V, u%NStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_Pack(V, u%TStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_Pack(V, u%SStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_LidSpeed) + call MV_Pack(V, u%LidSpeed(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + call MV_Pack(V, u%MsrPositionsX(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + call MV_Pack(V, u%MsrPositionsY(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + call MV_Pack(V, u%MsrPositionsZ(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SrvD_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SrvD_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SrvD_u_BlPitch) - call MV_Unpack2(Var, ValAry, u%BlPitch) ! Rank 1 Array - case (SrvD_u_Yaw) - call MV_Unpack2(Var, ValAry, u%Yaw) ! Scalar - case (SrvD_u_YawRate) - call MV_Unpack2(Var, ValAry, u%YawRate) ! Scalar - case (SrvD_u_LSS_Spd) - call MV_Unpack2(Var, ValAry, u%LSS_Spd) ! Scalar - case (SrvD_u_HSS_Spd) - call MV_Unpack2(Var, ValAry, u%HSS_Spd) ! Scalar - case (SrvD_u_RotSpeed) - call MV_Unpack2(Var, ValAry, u%RotSpeed) ! Scalar - case (SrvD_u_ExternalYawPosCom) - call MV_Unpack2(Var, ValAry, u%ExternalYawPosCom) ! Scalar - case (SrvD_u_ExternalYawRateCom) - call MV_Unpack2(Var, ValAry, u%ExternalYawRateCom) ! Scalar - case (SrvD_u_ExternalBlPitchCom) - call MV_Unpack2(Var, ValAry, u%ExternalBlPitchCom) ! Rank 1 Array - case (SrvD_u_ExternalGenTrq) - call MV_Unpack2(Var, ValAry, u%ExternalGenTrq) ! Scalar - case (SrvD_u_ExternalElecPwr) - call MV_Unpack2(Var, ValAry, u%ExternalElecPwr) ! Scalar - case (SrvD_u_ExternalHSSBrFrac) - call MV_Unpack2(Var, ValAry, u%ExternalHSSBrFrac) ! Scalar - case (SrvD_u_ExternalBlAirfoilCom) - call MV_Unpack2(Var, ValAry, u%ExternalBlAirfoilCom) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaL) - call MV_Unpack2(Var, ValAry, u%ExternalCableDeltaL) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaLdot) - call MV_Unpack2(Var, ValAry, u%ExternalCableDeltaLdot) ! Rank 1 Array - case (SrvD_u_TwrAccel) - call MV_Unpack2(Var, ValAry, u%TwrAccel) ! Scalar - case (SrvD_u_YawErr) - call MV_Unpack2(Var, ValAry, u%YawErr) ! Scalar - case (SrvD_u_WindDir) - call MV_Unpack2(Var, ValAry, u%WindDir) ! Scalar - case (SrvD_u_RootMyc) - call MV_Unpack2(Var, ValAry, u%RootMyc) ! Rank 1 Array - case (SrvD_u_YawBrTAxp) - call MV_Unpack2(Var, ValAry, u%YawBrTAxp) ! Scalar - case (SrvD_u_YawBrTAyp) - call MV_Unpack2(Var, ValAry, u%YawBrTAyp) ! Scalar - case (SrvD_u_LSSTipPxa) - call MV_Unpack2(Var, ValAry, u%LSSTipPxa) ! Scalar - case (SrvD_u_RootMxc) - call MV_Unpack2(Var, ValAry, u%RootMxc) ! Rank 1 Array - case (SrvD_u_LSSTipMxa) - call MV_Unpack2(Var, ValAry, u%LSSTipMxa) ! Scalar - case (SrvD_u_LSSTipMya) - call MV_Unpack2(Var, ValAry, u%LSSTipMya) ! Scalar - case (SrvD_u_LSSTipMza) - call MV_Unpack2(Var, ValAry, u%LSSTipMza) ! Scalar - case (SrvD_u_LSSTipMys) - call MV_Unpack2(Var, ValAry, u%LSSTipMys) ! Scalar - case (SrvD_u_LSSTipMzs) - call MV_Unpack2(Var, ValAry, u%LSSTipMzs) ! Scalar - case (SrvD_u_YawBrMyn) - call MV_Unpack2(Var, ValAry, u%YawBrMyn) ! Scalar - case (SrvD_u_YawBrMzn) - call MV_Unpack2(Var, ValAry, u%YawBrMzn) ! Scalar - case (SrvD_u_NcIMURAxs) - call MV_Unpack2(Var, ValAry, u%NcIMURAxs) ! Scalar - case (SrvD_u_NcIMURAys) - call MV_Unpack2(Var, ValAry, u%NcIMURAys) ! Scalar - case (SrvD_u_NcIMURAzs) - call MV_Unpack2(Var, ValAry, u%NcIMURAzs) ! Scalar - case (SrvD_u_RotPwr) - call MV_Unpack2(Var, ValAry, u%RotPwr) ! Scalar - case (SrvD_u_HorWindV) - call MV_Unpack2(Var, ValAry, u%HorWindV) ! Scalar - case (SrvD_u_YawAngle) - call MV_Unpack2(Var, ValAry, u%YawAngle) ! Scalar - case (SrvD_u_LSShftFxa) - call MV_Unpack2(Var, ValAry, u%LSShftFxa) ! Scalar - case (SrvD_u_LSShftFys) - call MV_Unpack2(Var, ValAry, u%LSShftFys) ! Scalar - case (SrvD_u_LSShftFzs) - call MV_Unpack2(Var, ValAry, u%LSShftFzs) ! Scalar - case (SrvD_u_fromSC) - call MV_Unpack2(Var, ValAry, u%fromSC) ! Rank 1 Array - case (SrvD_u_fromSCglob) - call MV_Unpack2(Var, ValAry, u%fromSCglob) ! Rank 1 Array - case (SrvD_u_Lidar) - call MV_Unpack2(Var, ValAry, u%Lidar) ! Rank 1 Array - case (SrvD_u_PtfmMotionMesh) - call MV_Unpack2(Var, ValAry, u%PtfmMotionMesh) ! Mesh - case (SrvD_u_BStCMotionMesh) - call MV_Unpack2(Var, ValAry, u%BStCMotionMesh(DL%i1, DL%i2)) ! Mesh - case (SrvD_u_NStCMotionMesh) - call MV_Unpack2(Var, ValAry, u%NStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_TStCMotionMesh) - call MV_Unpack2(Var, ValAry, u%TStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_SStCMotionMesh) - call MV_Unpack2(Var, ValAry, u%SStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_LidSpeed) - call MV_Unpack2(Var, ValAry, u%LidSpeed) ! Rank 1 Array - case (SrvD_u_MsrPositionsX) - call MV_Unpack2(Var, ValAry, u%MsrPositionsX) ! Rank 1 Array - case (SrvD_u_MsrPositionsY) - call MV_Unpack2(Var, ValAry, u%MsrPositionsY) ! Rank 1 Array - case (SrvD_u_MsrPositionsZ) - call MV_Unpack2(Var, ValAry, u%MsrPositionsZ) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SrvD_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SrvD_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call SrvD_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SrvD_u_BlPitch) + call MV_Unpack(V, ValAry, u%BlPitch(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_Yaw) + call MV_Unpack(V, ValAry, u%Yaw) ! Scalar + case (SrvD_u_YawRate) + call MV_Unpack(V, ValAry, u%YawRate) ! Scalar + case (SrvD_u_LSS_Spd) + call MV_Unpack(V, ValAry, u%LSS_Spd) ! Scalar + case (SrvD_u_HSS_Spd) + call MV_Unpack(V, ValAry, u%HSS_Spd) ! Scalar + case (SrvD_u_RotSpeed) + call MV_Unpack(V, ValAry, u%RotSpeed) ! Scalar + case (SrvD_u_ExternalYawPosCom) + call MV_Unpack(V, ValAry, u%ExternalYawPosCom) ! Scalar + case (SrvD_u_ExternalYawRateCom) + call MV_Unpack(V, ValAry, u%ExternalYawRateCom) ! Scalar + case (SrvD_u_ExternalBlPitchCom) + call MV_Unpack(V, ValAry, u%ExternalBlPitchCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + call MV_Unpack(V, ValAry, u%ExternalGenTrq) ! Scalar + case (SrvD_u_ExternalElecPwr) + call MV_Unpack(V, ValAry, u%ExternalElecPwr) ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + call MV_Unpack(V, ValAry, u%ExternalHSSBrFrac) ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + call MV_Unpack(V, ValAry, u%ExternalBlAirfoilCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + call MV_Unpack(V, ValAry, u%ExternalCableDeltaL(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + call MV_Unpack(V, ValAry, u%ExternalCableDeltaLdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_TwrAccel) + call MV_Unpack(V, ValAry, u%TwrAccel) ! Scalar + case (SrvD_u_YawErr) + call MV_Unpack(V, ValAry, u%YawErr) ! Scalar + case (SrvD_u_WindDir) + call MV_Unpack(V, ValAry, u%WindDir) ! Scalar + case (SrvD_u_RootMyc) + call MV_Unpack(V, ValAry, u%RootMyc(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + call MV_Unpack(V, ValAry, u%YawBrTAxp) ! Scalar + case (SrvD_u_YawBrTAyp) + call MV_Unpack(V, ValAry, u%YawBrTAyp) ! Scalar + case (SrvD_u_LSSTipPxa) + call MV_Unpack(V, ValAry, u%LSSTipPxa) ! Scalar + case (SrvD_u_RootMxc) + call MV_Unpack(V, ValAry, u%RootMxc(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + call MV_Unpack(V, ValAry, u%LSSTipMxa) ! Scalar + case (SrvD_u_LSSTipMya) + call MV_Unpack(V, ValAry, u%LSSTipMya) ! Scalar + case (SrvD_u_LSSTipMza) + call MV_Unpack(V, ValAry, u%LSSTipMza) ! Scalar + case (SrvD_u_LSSTipMys) + call MV_Unpack(V, ValAry, u%LSSTipMys) ! Scalar + case (SrvD_u_LSSTipMzs) + call MV_Unpack(V, ValAry, u%LSSTipMzs) ! Scalar + case (SrvD_u_YawBrMyn) + call MV_Unpack(V, ValAry, u%YawBrMyn) ! Scalar + case (SrvD_u_YawBrMzn) + call MV_Unpack(V, ValAry, u%YawBrMzn) ! Scalar + case (SrvD_u_NcIMURAxs) + call MV_Unpack(V, ValAry, u%NcIMURAxs) ! Scalar + case (SrvD_u_NcIMURAys) + call MV_Unpack(V, ValAry, u%NcIMURAys) ! Scalar + case (SrvD_u_NcIMURAzs) + call MV_Unpack(V, ValAry, u%NcIMURAzs) ! Scalar + case (SrvD_u_RotPwr) + call MV_Unpack(V, ValAry, u%RotPwr) ! Scalar + case (SrvD_u_HorWindV) + call MV_Unpack(V, ValAry, u%HorWindV) ! Scalar + case (SrvD_u_YawAngle) + call MV_Unpack(V, ValAry, u%YawAngle) ! Scalar + case (SrvD_u_LSShftFxa) + call MV_Unpack(V, ValAry, u%LSShftFxa) ! Scalar + case (SrvD_u_LSShftFys) + call MV_Unpack(V, ValAry, u%LSShftFys) ! Scalar + case (SrvD_u_LSShftFzs) + call MV_Unpack(V, ValAry, u%LSShftFzs) ! Scalar + case (SrvD_u_fromSC) + call MV_Unpack(V, ValAry, u%fromSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_fromSCglob) + call MV_Unpack(V, ValAry, u%fromSCglob(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_Lidar) + call MV_Unpack(V, ValAry, u%Lidar(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_Unpack(V, ValAry, u%PtfmMotionMesh) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_Unpack(V, ValAry, u%BStCMotionMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_Unpack(V, ValAry, u%NStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_Unpack(V, ValAry, u%TStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_Unpack(V, ValAry, u%SStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_LidSpeed) + call MV_Unpack(V, ValAry, u%LidSpeed(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + call MV_Unpack(V, ValAry, u%MsrPositionsX(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + call MV_Unpack(V, ValAry, u%MsrPositionsY(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + call MV_Unpack(V, ValAry, u%MsrPositionsZ(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine SrvD_PackOutputVar(Var, y, ValAry) - type(SrvD_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SrvD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case (SrvD_y_BlPitchCom) - call MV_Pack2(Var, y%BlPitchCom, ValAry) ! Rank 1 Array - case (SrvD_y_BlAirfoilCom) - call MV_Pack2(Var, y%BlAirfoilCom, ValAry) ! Rank 1 Array - case (SrvD_y_YawMom) - call MV_Pack2(Var, y%YawMom, ValAry) ! Scalar - case (SrvD_y_GenTrq) - call MV_Pack2(Var, y%GenTrq, ValAry) ! Scalar - case (SrvD_y_HSSBrTrqC) - call MV_Pack2(Var, y%HSSBrTrqC, ValAry) ! Scalar - case (SrvD_y_ElecPwr) - call MV_Pack2(Var, y%ElecPwr, ValAry) ! Scalar - case (SrvD_y_TBDrCon) - call MV_Pack2(Var, y%TBDrCon, ValAry) ! Rank 1 Array - case (SrvD_y_Lidar) - call MV_Pack2(Var, y%Lidar, ValAry) ! Rank 1 Array - case (SrvD_y_CableDeltaL) - call MV_Pack2(Var, y%CableDeltaL, ValAry) ! Rank 1 Array - case (SrvD_y_CableDeltaLdot) - call MV_Pack2(Var, y%CableDeltaLdot, ValAry) ! Rank 1 Array - case (SrvD_y_BStCLoadMesh) - call MV_Pack2(Var, y%BStCLoadMesh(DL%i1, DL%i2), ValAry) ! Mesh - case (SrvD_y_NStCLoadMesh) - call MV_Pack2(Var, y%NStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_TStCLoadMesh) - call MV_Pack2(Var, y%TStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_SStCLoadMesh) - call MV_Pack2(Var, y%SStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_toSC) - call MV_Pack2(Var, y%toSC, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SrvD_PackOutputAry(Vars, y, ValAry) - type(SrvD_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SrvD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call SrvD_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SrvD_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_y_BlPitchCom) + call MV_Pack(V, y%BlPitchCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + call MV_Pack(V, y%BlAirfoilCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_y_YawMom) + call MV_Pack(V, y%YawMom, ValAry) ! Scalar + case (SrvD_y_GenTrq) + call MV_Pack(V, y%GenTrq, ValAry) ! Scalar + case (SrvD_y_HSSBrTrqC) + call MV_Pack(V, y%HSSBrTrqC, ValAry) ! Scalar + case (SrvD_y_ElecPwr) + call MV_Pack(V, y%ElecPwr, ValAry) ! Scalar + case (SrvD_y_TBDrCon) + call MV_Pack(V, y%TBDrCon(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_y_Lidar) + call MV_Pack(V, y%Lidar(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_y_CableDeltaL) + call MV_Pack(V, y%CableDeltaL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + call MV_Pack(V, y%CableDeltaLdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_Pack(V, y%BStCLoadMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_Pack(V, y%NStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_Pack(V, y%TStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_Pack(V, y%SStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_toSC) + call MV_Pack(V, y%toSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SrvD_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SrvD_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SrvD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - case (SrvD_y_BlPitchCom) - call MV_Unpack2(Var, ValAry, y%BlPitchCom) ! Rank 1 Array - case (SrvD_y_BlAirfoilCom) - call MV_Unpack2(Var, ValAry, y%BlAirfoilCom) ! Rank 1 Array - case (SrvD_y_YawMom) - call MV_Unpack2(Var, ValAry, y%YawMom) ! Scalar - case (SrvD_y_GenTrq) - call MV_Unpack2(Var, ValAry, y%GenTrq) ! Scalar - case (SrvD_y_HSSBrTrqC) - call MV_Unpack2(Var, ValAry, y%HSSBrTrqC) ! Scalar - case (SrvD_y_ElecPwr) - call MV_Unpack2(Var, ValAry, y%ElecPwr) ! Scalar - case (SrvD_y_TBDrCon) - call MV_Unpack2(Var, ValAry, y%TBDrCon) ! Rank 1 Array - case (SrvD_y_Lidar) - call MV_Unpack2(Var, ValAry, y%Lidar) ! Rank 1 Array - case (SrvD_y_CableDeltaL) - call MV_Unpack2(Var, ValAry, y%CableDeltaL) ! Rank 1 Array - case (SrvD_y_CableDeltaLdot) - call MV_Unpack2(Var, ValAry, y%CableDeltaLdot) ! Rank 1 Array - case (SrvD_y_BStCLoadMesh) - call MV_Unpack2(Var, ValAry, y%BStCLoadMesh(DL%i1, DL%i2)) ! Mesh - case (SrvD_y_NStCLoadMesh) - call MV_Unpack2(Var, ValAry, y%NStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_TStCLoadMesh) - call MV_Unpack2(Var, ValAry, y%TStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_SStCLoadMesh) - call MV_Unpack2(Var, ValAry, y%SStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_toSC) - call MV_Unpack2(Var, ValAry, y%toSC) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SrvD_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SrvD_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call SrvD_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SrvD_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_y_BlPitchCom) + call MV_Unpack(V, ValAry, y%BlPitchCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + call MV_Unpack(V, ValAry, y%BlAirfoilCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_y_YawMom) + call MV_Unpack(V, ValAry, y%YawMom) ! Scalar + case (SrvD_y_GenTrq) + call MV_Unpack(V, ValAry, y%GenTrq) ! Scalar + case (SrvD_y_HSSBrTrqC) + call MV_Unpack(V, ValAry, y%HSSBrTrqC) ! Scalar + case (SrvD_y_ElecPwr) + call MV_Unpack(V, ValAry, y%ElecPwr) ! Scalar + case (SrvD_y_TBDrCon) + call MV_Unpack(V, ValAry, y%TBDrCon(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_y_Lidar) + call MV_Unpack(V, ValAry, y%Lidar(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_y_CableDeltaL) + call MV_Unpack(V, ValAry, y%CableDeltaL(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + call MV_Unpack(V, ValAry, y%CableDeltaLdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_Unpack(V, ValAry, y%BStCLoadMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_Unpack(V, ValAry, y%NStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_Unpack(V, ValAry, y%TStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_Unpack(V, ValAry, y%SStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_toSC) + call MV_Unpack(V, ValAry, y%toSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE ServoDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 6f619e99ea..e9aabaa9d7 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -2312,266 +2312,232 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er END IF ! check if allocated END SUBROUTINE -function StC_InputMeshPointer(u, ML) result(Mesh) +function StC_InputMeshPointer(u, DL) result(Mesh) type(StC_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (StC_u_Mesh) - Mesh => u%Mesh(ML%i1) + Mesh => u%Mesh(DL%i1) end select end function -function StC_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function StC_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (StC_u_Mesh) - Name = "u%Mesh("//trim(Num2LStr(ML%i1))//")" + Name = "u%Mesh("//trim(Num2LStr(DL%i1))//")" end select end function -function StC_OutputMeshPointer(y, ML) result(Mesh) +function StC_OutputMeshPointer(y, DL) result(Mesh) type(StC_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (StC_y_Mesh) - Mesh => y%Mesh(ML%i1) + Mesh => y%Mesh(DL%i1) end select end function -function StC_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function StC_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (StC_y_Mesh) - Name = "y%Mesh("//trim(Num2LStr(ML%i1))//")" + Name = "y%Mesh("//trim(Num2LStr(DL%i1))//")" end select end function -subroutine StC_PackContStateVar(Var, x, ValAry) - type(StC_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (StC_x_StC_x) - call MV_Pack2(Var, x%StC_x, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine StC_PackContStateAry(Vars, x, ValAry) type(StC_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call StC_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (StC_x_StC_x) + call MV_Pack(V, x%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine StC_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(StC_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (StC_x_StC_x) - call MV_Unpack2(Var, ValAry, x%StC_x) ! Rank 2 Array - end select - end associate -end subroutine - subroutine StC_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(StC_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call StC_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (StC_x_StC_x) + call MV_Unpack(V, ValAry, x%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine +subroutine StC_PackContStateDerivAry(Vars, x, ValAry) + type(StC_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (StC_x_StC_x) + call MV_Pack(V, x%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine StC_PackConstrStateVar(Var, z, ValAry) - type(StC_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (StC_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine StC_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (StC_x_StC_x) + call MV_Unpack(V, ValAry, x%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate + end do end subroutine subroutine StC_PackConstrStateAry(Vars, z, ValAry) type(StC_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call StC_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (StC_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine StC_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(StC_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (StC_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine StC_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(StC_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call StC_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (StC_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine StC_PackInputVar(Var, u, ValAry) - type(StC_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (StC_u_Mesh) - call MV_Pack2(Var, u%Mesh(DL%i1), ValAry) ! Mesh - case (StC_u_CmdStiff) - call MV_Pack2(Var, u%CmdStiff, ValAry) ! Rank 2 Array - case (StC_u_CmdDamp) - call MV_Pack2(Var, u%CmdDamp, ValAry) ! Rank 2 Array - case (StC_u_CmdBrake) - call MV_Pack2(Var, u%CmdBrake, ValAry) ! Rank 2 Array - case (StC_u_CmdForce) - call MV_Pack2(Var, u%CmdForce, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine StC_PackInputAry(Vars, u, ValAry) - type(StC_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(StC_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call StC_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (StC_u_Mesh) + call MV_Pack(V, u%Mesh(DL%i1), ValAry) ! Mesh + case (StC_u_CmdStiff) + call MV_Pack(V, u%CmdStiff(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (StC_u_CmdDamp) + call MV_Pack(V, u%CmdDamp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (StC_u_CmdBrake) + call MV_Pack(V, u%CmdBrake(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (StC_u_CmdForce) + call MV_Pack(V, u%CmdForce(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine StC_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(StC_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (StC_u_Mesh) - call MV_Unpack2(Var, ValAry, u%Mesh(DL%i1)) ! Mesh - case (StC_u_CmdStiff) - call MV_Unpack2(Var, ValAry, u%CmdStiff) ! Rank 2 Array - case (StC_u_CmdDamp) - call MV_Unpack2(Var, ValAry, u%CmdDamp) ! Rank 2 Array - case (StC_u_CmdBrake) - call MV_Unpack2(Var, ValAry, u%CmdBrake) ! Rank 2 Array - case (StC_u_CmdForce) - call MV_Unpack2(Var, ValAry, u%CmdForce) ! Rank 2 Array - end select - end associate -end subroutine - subroutine StC_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(StC_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call StC_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (StC_u_Mesh) + call MV_Unpack(V, ValAry, u%Mesh(DL%i1)) ! Mesh + case (StC_u_CmdStiff) + call MV_Unpack(V, ValAry, u%CmdStiff(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (StC_u_CmdDamp) + call MV_Unpack(V, ValAry, u%CmdDamp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (StC_u_CmdBrake) + call MV_Unpack(V, ValAry, u%CmdBrake(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (StC_u_CmdForce) + call MV_Unpack(V, ValAry, u%CmdForce(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine - -subroutine StC_PackOutputVar(Var, y, ValAry) - type(StC_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (StC_y_Mesh) - call MV_Pack2(Var, y%Mesh(DL%i1), ValAry) ! Mesh - case (StC_y_MeasDisp) - call MV_Pack2(Var, y%MeasDisp, ValAry) ! Rank 2 Array - case (StC_y_MeasVel) - call MV_Pack2(Var, y%MeasVel, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine StC_PackOutputAry(Vars, y, ValAry) - type(StC_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(StC_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call StC_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (StC_y_Mesh) + call MV_Pack(V, y%Mesh(DL%i1), ValAry) ! Mesh + case (StC_y_MeasDisp) + call MV_Pack(V, y%MeasDisp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (StC_y_MeasVel) + call MV_Pack(V, y%MeasVel(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine StC_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(StC_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (StC_y_Mesh) - call MV_Unpack2(Var, ValAry, y%Mesh(DL%i1)) ! Mesh - case (StC_y_MeasDisp) - call MV_Unpack2(Var, ValAry, y%MeasDisp) ! Rank 2 Array - case (StC_y_MeasVel) - call MV_Unpack2(Var, ValAry, y%MeasVel) ! Rank 2 Array - end select - end associate -end subroutine - subroutine StC_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(StC_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call StC_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (StC_y_Mesh) + call MV_Unpack(V, ValAry, y%Mesh(DL%i1)) ! Mesh + case (StC_y_MeasDisp) + call MV_Unpack(V, ValAry, y%MeasDisp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (StC_y_MeasVel) + call MV_Unpack(V, ValAry, y%MeasVel(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine END MODULE StrucCtrl_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 0c1dee82da..7db7a2abdc 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -119,7 +119,7 @@ MODULE SubDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -214,7 +214,6 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_ParameterType ======= TYPE, PUBLIC :: SD_ParameterType - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] INTEGER(IntKi) :: iVarTPMesh = 0 !< Variable index for TPMesh [-] INTEGER(IntKi) :: iVarLMesh = 0 !< Variable index for LMesh [-] INTEGER(IntKi) :: iVarY1Mesh = 0 !< Variable index for Y1Mesh [-] @@ -1020,7 +1019,9 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstInitOutputData%Vars => SrcInitOutputData%Vars + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) @@ -1148,7 +1149,8 @@ subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(InitOutputData%Vars) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1182,18 +1184,11 @@ subroutine SD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(SD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitOutput' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) call RegPackAlloc(RF, InData%LinNames_y) call RegPackAlloc(RF, InData%LinNames_x) call RegPackAlloc(RF, InData%LinNames_u) @@ -1213,30 +1208,11 @@ subroutine SD_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return @@ -2107,18 +2083,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(SrcParamData%Vars)) then - if (.not. associated(DstParamData%Vars)) then - allocate(DstParamData%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if DstParamData%iVarTPMesh = SrcParamData%iVarTPMesh DstParamData%iVarLMesh = SrcParamData%iVarLMesh DstParamData%iVarY1Mesh = SrcParamData%iVarY1Mesh @@ -2890,12 +2854,6 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(ParamData%Vars)) then - call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(ParamData%Vars) - ParamData%Vars => null() - end if if (allocated(ParamData%Elems)) then deallocate(ParamData%Elems) end if @@ -3117,15 +3075,7 @@ subroutine SD_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'SD_PackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if call RegPack(RF, InData%iVarTPMesh) call RegPack(RF, InData%iVarLMesh) call RegPack(RF, InData%iVarY1Mesh) @@ -3296,27 +3246,7 @@ subroutine SD_UnPackParam(RF, OutData) integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if call RegUnpack(RF, OutData%iVarTPMesh); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarLMesh); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iVarY1Mesh); if (RegCheckErr(RF, RoutineName)) return @@ -4506,12 +4436,12 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ! check if allocated END SUBROUTINE -function SD_InputMeshPointer(u, ML) result(Mesh) - type(SD_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function SD_InputMeshPointer(u, DL) result(Mesh) + type(SD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (SD_u_TPMesh) Mesh => u%TPMesh case (SD_u_LMesh) @@ -4519,11 +4449,11 @@ function SD_InputMeshPointer(u, ML) result(Mesh) end select end function -function SD_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SD_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (SD_u_TPMesh) Name = "u%TPMesh" case (SD_u_LMesh) @@ -4531,12 +4461,12 @@ function SD_InputMeshName(ML) result(Name) end select end function -function SD_OutputMeshPointer(y, ML) result(Mesh) +function SD_OutputMeshPointer(y, DL) result(Mesh) type(SD_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (SD_y_Y1Mesh) Mesh => y%Y1Mesh case (SD_y_Y2Mesh) @@ -4546,11 +4476,11 @@ function SD_OutputMeshPointer(y, ML) result(Mesh) end select end function -function SD_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SD_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (SD_y_Y1Mesh) Name = "y%Y1Mesh" case (SD_y_Y2Mesh) @@ -4560,224 +4490,194 @@ function SD_OutputMeshName(ML) result(Name) end select end function -subroutine SD_PackContStateVar(Var, x, ValAry) - type(SD_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SD_x_qm) - call MV_Pack2(Var, x%qm, ValAry) ! Rank 1 Array - case (SD_x_qmdot) - call MV_Pack2(Var, x%qmdot, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SD_PackContStateAry(Vars, x, ValAry) type(SD_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call SD_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SD_x_qm) + call MV_Pack(V, x%qm(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SD_x_qmdot) + call MV_Pack(V, x%qmdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SD_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SD_x_qm) - call MV_Unpack2(Var, ValAry, x%qm) ! Rank 1 Array - case (SD_x_qmdot) - call MV_Unpack2(Var, ValAry, x%qmdot) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SD_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call SD_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SD_x_qm) + call MV_Unpack(V, ValAry, x%qm(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SD_x_qmdot) + call MV_Unpack(V, ValAry, x%qmdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine SD_PackContStateDerivAry(Vars, x, ValAry) + type(SD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SD_x_qm) + call MV_Pack(V, x%qm(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SD_x_qmdot) + call MV_Pack(V, x%qmdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine SD_PackConstrStateVar(Var, z, ValAry) - type(SD_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine SD_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SD_x_qm) + call MV_Unpack(V, ValAry, x%qm(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SD_x_qmdot) + call MV_Unpack(V, ValAry, x%qmdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine SD_PackConstrStateAry(Vars, z, ValAry) type(SD_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call SD_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SD_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SD_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine SD_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call SD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SD_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine SD_PackInputVar(Var, u, ValAry) - type(SD_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SD_u_TPMesh) - call MV_Pack2(Var, u%TPMesh, ValAry) ! Mesh - case (SD_u_LMesh) - call MV_Pack2(Var, u%LMesh, ValAry) ! Mesh - case (SD_u_CableDeltaL) - call MV_Pack2(Var, u%CableDeltaL, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SD_PackInputAry(Vars, u, ValAry) - type(SD_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call SD_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SD_u_TPMesh) + call MV_Pack(V, u%TPMesh, ValAry) ! Mesh + case (SD_u_LMesh) + call MV_Pack(V, u%LMesh, ValAry) ! Mesh + case (SD_u_CableDeltaL) + call MV_Pack(V, u%CableDeltaL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SD_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SD_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SD_u_TPMesh) - call MV_Unpack2(Var, ValAry, u%TPMesh) ! Mesh - case (SD_u_LMesh) - call MV_Unpack2(Var, ValAry, u%LMesh) ! Mesh - case (SD_u_CableDeltaL) - call MV_Unpack2(Var, ValAry, u%CableDeltaL) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SD_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SD_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call SD_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SD_u_TPMesh) + call MV_Unpack(V, ValAry, u%TPMesh) ! Mesh + case (SD_u_LMesh) + call MV_Unpack(V, ValAry, u%LMesh) ! Mesh + case (SD_u_CableDeltaL) + call MV_Unpack(V, ValAry, u%CableDeltaL(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine SD_PackOutputVar(Var, y, ValAry) - type(SD_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SD_y_Y1Mesh) - call MV_Pack2(Var, y%Y1Mesh, ValAry) ! Mesh - case (SD_y_Y2Mesh) - call MV_Pack2(Var, y%Y2Mesh, ValAry) ! Mesh - case (SD_y_Y3Mesh) - call MV_Pack2(Var, y%Y3Mesh, ValAry) ! Mesh - case (SD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SD_PackOutputAry(Vars, y, ValAry) - type(SD_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call SD_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SD_y_Y1Mesh) + call MV_Pack(V, y%Y1Mesh, ValAry) ! Mesh + case (SD_y_Y2Mesh) + call MV_Pack(V, y%Y2Mesh, ValAry) ! Mesh + case (SD_y_Y3Mesh) + call MV_Pack(V, y%Y3Mesh, ValAry) ! Mesh + case (SD_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SD_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SD_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SD_y_Y1Mesh) - call MV_Unpack2(Var, ValAry, y%Y1Mesh) ! Mesh - case (SD_y_Y2Mesh) - call MV_Unpack2(Var, ValAry, y%Y2Mesh) ! Mesh - case (SD_y_Y3Mesh) - call MV_Unpack2(Var, ValAry, y%Y3Mesh) ! Mesh - case (SD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SD_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SD_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call SD_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SD_y_Y1Mesh) + call MV_Unpack(V, ValAry, y%Y1Mesh) ! Mesh + case (SD_y_Y2Mesh) + call MV_Unpack(V, ValAry, y%Y2Mesh) ! Mesh + case (SD_y_Y3Mesh) + call MV_Unpack(V, ValAry, y%Y3Mesh) ! Mesh + case (SD_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE SubDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 70acafbbda..70a5e4903a 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -661,140 +661,108 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE -function SC_DX_InputMeshPointer(u, ML) result(Mesh) +function SC_DX_InputMeshPointer(u, DL) result(Mesh) type(SC_DX_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SC_DX_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SC_DX_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function SC_DX_OutputMeshPointer(y, ML) result(Mesh) +function SC_DX_OutputMeshPointer(y, DL) result(Mesh) type(SC_DX_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SC_DX_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SC_DX_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine SC_DX_PackInputVar(Var, u, ValAry) - type(SC_DX_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_DX_u_toSC) - call MV_Pack2(Var, u%toSC, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SC_DX_PackInputAry(Vars, u, ValAry) - type(SC_DX_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SC_DX_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call SC_DX_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SC_DX_u_toSC) + call MV_Pack(V, u%toSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SC_DX_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SC_DX_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_DX_u_toSC) - call MV_Unpack2(Var, ValAry, u%toSC) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SC_DX_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SC_DX_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call SC_DX_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SC_DX_u_toSC) + call MV_Unpack(V, ValAry, u%toSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine SC_DX_PackOutputVar(Var, y, ValAry) - type(SC_DX_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_DX_y_fromSC) - call MV_Pack2(Var, y%fromSC, ValAry) ! Rank 1 Array - case (SC_DX_y_fromSCglob) - call MV_Pack2(Var, y%fromSCglob, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SC_DX_PackOutputAry(Vars, y, ValAry) - type(SC_DX_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SC_DX_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call SC_DX_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SC_DX_y_fromSC) + call MV_Pack(V, y%fromSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SC_DX_y_fromSCglob) + call MV_Pack(V, y%fromSCglob(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SC_DX_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SC_DX_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_DX_y_fromSC) - call MV_Unpack2(Var, ValAry, y%fromSC) ! Rank 1 Array - case (SC_DX_y_fromSCglob) - call MV_Unpack2(Var, ValAry, y%fromSCglob) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SC_DX_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SC_DX_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call SC_DX_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SC_DX_y_fromSC) + call MV_Unpack(V, ValAry, y%fromSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SC_DX_y_fromSCglob) + call MV_Unpack(V, ValAry, y%fromSCglob(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE SCDataEx_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 297d4d088d..3ca2cd36b0 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -1829,242 +1829,208 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ! check if allocated END SUBROUTINE -function SC_InputMeshPointer(u, ML) result(Mesh) - type(SC_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function SC_InputMeshPointer(u, DL) result(Mesh) + type(SC_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SC_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SC_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function SC_OutputMeshPointer(y, ML) result(Mesh) +function SC_OutputMeshPointer(y, DL) result(Mesh) type(SC_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function SC_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function SC_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine SC_PackContStateVar(Var, x, ValAry) - type(SC_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_x_Dummy) - call MV_Pack2(Var, x%Dummy, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SC_PackContStateAry(Vars, x, ValAry) type(SC_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call SC_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SC_x_Dummy) + call MV_Pack(V, x%Dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SC_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SC_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_x_Dummy) - call MV_Unpack2(Var, ValAry, x%Dummy) ! Scalar - end select - end associate -end subroutine - subroutine SC_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SC_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call SC_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SC_x_Dummy) + call MV_Unpack(V, ValAry, x%Dummy) ! Scalar + end select + end associate end do end subroutine +subroutine SC_PackContStateDerivAry(Vars, x, ValAry) + type(SC_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SC_x_Dummy) + call MV_Pack(V, x%Dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine SC_PackConstrStateVar(Var, z, ValAry) - type(SC_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_z_Dummy) - call MV_Pack2(Var, z%Dummy, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine SC_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (SC_x_Dummy) + call MV_Unpack(V, ValAry, x%Dummy) ! Scalar + end select + end associate + end do end subroutine subroutine SC_PackConstrStateAry(Vars, z, ValAry) type(SC_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call SC_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SC_z_Dummy) + call MV_Pack(V, z%Dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SC_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SC_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_z_Dummy) - call MV_Unpack2(Var, ValAry, z%Dummy) ! Scalar - end select - end associate -end subroutine - subroutine SC_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(SC_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call SC_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (SC_z_Dummy) + call MV_Unpack(V, ValAry, z%Dummy) ! Scalar + end select + end associate end do end subroutine - -subroutine SC_PackInputVar(Var, u, ValAry) - type(SC_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_u_toSCglob) - call MV_Pack2(Var, u%toSCglob, ValAry) ! Rank 1 Array - case (SC_u_toSC) - call MV_Pack2(Var, u%toSC, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SC_PackInputAry(Vars, u, ValAry) - type(SC_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SC_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call SC_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SC_u_toSCglob) + call MV_Pack(V, u%toSCglob(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SC_u_toSC) + call MV_Pack(V, u%toSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SC_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SC_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_u_toSCglob) - call MV_Unpack2(Var, ValAry, u%toSCglob) ! Rank 1 Array - case (SC_u_toSC) - call MV_Unpack2(Var, ValAry, u%toSC) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SC_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SC_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call SC_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (SC_u_toSCglob) + call MV_Unpack(V, ValAry, u%toSCglob(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SC_u_toSC) + call MV_Unpack(V, ValAry, u%toSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine SC_PackOutputVar(Var, y, ValAry) - type(SC_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_y_fromSCglob) - call MV_Pack2(Var, y%fromSCglob, ValAry) ! Rank 1 Array - case (SC_y_fromSC) - call MV_Pack2(Var, y%fromSC, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine SC_PackOutputAry(Vars, y, ValAry) - type(SC_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(SC_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call SC_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SC_y_fromSCglob) + call MV_Pack(V, y%fromSCglob(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (SC_y_fromSC) + call MV_Pack(V, y%fromSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine SC_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(SC_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (SC_y_fromSCglob) - call MV_Unpack2(Var, ValAry, y%fromSCglob) ! Rank 1 Array - case (SC_y_fromSC) - call MV_Unpack2(Var, ValAry, y%fromSC) ! Rank 1 Array - end select - end associate -end subroutine - subroutine SC_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SC_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call SC_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (SC_y_fromSCglob) + call MV_Unpack(V, ValAry, y%fromSCglob(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (SC_y_fromSC) + call MV_Unpack(V, ValAry, y%fromSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE SuperController_Types + !ENDOFREGISTRYGENERATEDFILE From 14cf9e6f492ef58af4bb57fb475bfd4b858d2595 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 26 Jul 2024 13:42:19 +0000 Subject: [PATCH 160/319] Remove Glue_ModData from simulink CMakeLists.txt --- glue-codes/simulink/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index bc5b295322..5f387d02b2 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -60,7 +60,6 @@ matlab_add_mex( ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Funcs.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModGlue.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mapping.f90 - ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModData.f90 LINK_TO ${MEX_LIBS} ${MEX_LIBS} # DO NOT REMOVE (needed to ensure no unresolved symbols) From f0b3a7726c4031452a5cea71acd43be5863a05d4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 26 Jul 2024 14:18:38 +0000 Subject: [PATCH 161/319] Regenerate Types files --- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 2 + modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 610 +++++++++--------- modules/awae/src/AWAE_Types.f90 | 362 +++++------ modules/lindyn/src/LinDyn_Types.f90 | 300 ++++----- .../wakedynamics/src/WakeDynamics_Types.f90 | 452 ++++++------- 5 files changed, 818 insertions(+), 908 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 105e38c92a..3cbde801fe 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -1412,5 +1412,7 @@ subroutine AD_Dvr_UnPackAllData(RF, OutData) call RegUnpack(RF, OutData%errMsg); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%initialized); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE AeroDyn_Driver_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 4d4bc612cb..ba6204d824 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -1792,394 +1792,404 @@ subroutine ADI_UnPackFED_Data(RF, OutData) end if end subroutine -function ADI_InputMeshPointer(u, ML) result(Mesh) +function ADI_InputMeshPointer(u, DL) result(Mesh) type(ADI_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (ADI_u_AD_rotors_NacelleMotion) - Mesh => u%AD%rotors(ML%i1)%NacelleMotion + Mesh => u%AD%rotors(DL%i1)%NacelleMotion case (ADI_u_AD_rotors_TowerMotion) - Mesh => u%AD%rotors(ML%i1)%TowerMotion + Mesh => u%AD%rotors(DL%i1)%TowerMotion case (ADI_u_AD_rotors_HubMotion) - Mesh => u%AD%rotors(ML%i1)%HubMotion + Mesh => u%AD%rotors(DL%i1)%HubMotion case (ADI_u_AD_rotors_BladeRootMotion) - Mesh => u%AD%rotors(ML%i1)%BladeRootMotion(ML%i2) + Mesh => u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2) case (ADI_u_AD_rotors_BladeMotion) - Mesh => u%AD%rotors(ML%i1)%BladeMotion(ML%i2) + Mesh => u%AD%rotors(DL%i1)%BladeMotion(DL%i2) case (ADI_u_AD_rotors_TFinMotion) - Mesh => u%AD%rotors(ML%i1)%TFinMotion + Mesh => u%AD%rotors(DL%i1)%TFinMotion end select end function -function ADI_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ADI_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (ADI_u_AD_rotors_NacelleMotion) - Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%NacelleMotion" + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%NacelleMotion" case (ADI_u_AD_rotors_TowerMotion) - Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%TowerMotion" + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%TowerMotion" case (ADI_u_AD_rotors_HubMotion) - Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%HubMotion" + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%HubMotion" case (ADI_u_AD_rotors_BladeRootMotion) - Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%BladeRootMotion("//trim(Num2LStr(ML%i2))//")" + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeRootMotion("//trim(Num2LStr(DL%i2))//")" case (ADI_u_AD_rotors_BladeMotion) - Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%BladeMotion("//trim(Num2LStr(ML%i2))//")" + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeMotion("//trim(Num2LStr(DL%i2))//")" case (ADI_u_AD_rotors_TFinMotion) - Name = "u%AD%rotors("//trim(Num2LStr(ML%i1))//")%TFinMotion" + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%TFinMotion" end select end function -function ADI_OutputMeshPointer(y, ML) result(Mesh) +function ADI_OutputMeshPointer(y, DL) result(Mesh) type(ADI_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) case (ADI_y_AD_rotors_NacelleLoad) - Mesh => y%AD%rotors(ML%i1)%NacelleLoad + Mesh => y%AD%rotors(DL%i1)%NacelleLoad case (ADI_y_AD_rotors_HubLoad) - Mesh => y%AD%rotors(ML%i1)%HubLoad + Mesh => y%AD%rotors(DL%i1)%HubLoad case (ADI_y_AD_rotors_TowerLoad) - Mesh => y%AD%rotors(ML%i1)%TowerLoad + Mesh => y%AD%rotors(DL%i1)%TowerLoad case (ADI_y_AD_rotors_BladeLoad) - Mesh => y%AD%rotors(ML%i1)%BladeLoad(ML%i2) + Mesh => y%AD%rotors(DL%i1)%BladeLoad(DL%i2) case (ADI_y_AD_rotors_TFinLoad) - Mesh => y%AD%rotors(ML%i1)%TFinLoad + Mesh => y%AD%rotors(DL%i1)%TFinLoad end select end function -function ADI_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function ADI_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) case (ADI_y_AD_rotors_NacelleLoad) - Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%NacelleLoad" + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%NacelleLoad" case (ADI_y_AD_rotors_HubLoad) - Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%HubLoad" + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%HubLoad" case (ADI_y_AD_rotors_TowerLoad) - Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%TowerLoad" + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%TowerLoad" case (ADI_y_AD_rotors_BladeLoad) - Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%BladeLoad("//trim(Num2LStr(ML%i2))//")" + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeLoad("//trim(Num2LStr(DL%i2))//")" case (ADI_y_AD_rotors_TFinLoad) - Name = "y%AD%rotors("//trim(Num2LStr(ML%i1))//")%TFinLoad" + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%TFinLoad" end select end function -subroutine ADI_PackContStateVar(Var, x, ValAry) - type(ADI_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ADI_x_AD_rotors_BEMT_UA_element_x) - call MV_Pack2(Var, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x, ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) - call MV_Pack2(Var, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind, ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) - call MV_Pack2(Var, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1, ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_V_w) - call MV_Pack2(Var, x%AD%rotors(DL%i1)%BEMT%V_w, ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_AA_DummyContState) - call MV_Pack2(Var, x%AD%rotors(DL%i1)%AA%DummyContState, ValAry) ! Scalar - case (ADI_x_AD_FVW_W_Gamma_NW) - call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%Gamma_NW, ValAry) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Gamma_FW) - call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%Gamma_FW, ValAry) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Eps_NW) - call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%Eps_NW, ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_Eps_FW) - call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%Eps_FW, ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_NW) - call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%r_NW, ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_FW) - call MV_Pack2(Var, x%AD%FVW%W(DL%i1)%r_FW, ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_UA_element_x) - call MV_Pack2(Var, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ADI_PackContStateAry(Vars, x, ValAry) type(ADI_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call ADI_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + call MV_Pack(V, x%AD%rotors(DL%i1)%AA%DummyContState, ValAry) ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + call MV_Pack(V, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ADI_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ADI_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ADI_x_AD_rotors_BEMT_UA_element_x) - call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) - call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) - call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_V_w) - call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%BEMT%V_w) ! Rank 1 Array - case (ADI_x_AD_rotors_AA_DummyContState) - call MV_Unpack2(Var, ValAry, x%AD%rotors(DL%i1)%AA%DummyContState) ! Scalar - case (ADI_x_AD_FVW_W_Gamma_NW) - call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%Gamma_NW) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Gamma_FW) - call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%Gamma_FW) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Eps_NW) - call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%Eps_NW) ! Rank 3 Array - case (ADI_x_AD_FVW_W_Eps_FW) - call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%Eps_FW) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_NW) - call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%r_NW) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_FW) - call MV_Unpack2(Var, ValAry, x%AD%FVW%W(DL%i1)%r_FW) ! Rank 3 Array - case (ADI_x_AD_FVW_UA_element_x) - call MV_Unpack2(Var, ValAry, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ADI_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ADI_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call ADI_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%AA%DummyContState) ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + call MV_Unpack(V, ValAry, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine ADI_PackContStateDerivAry(Vars, x, ValAry) + type(ADI_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + call MV_Pack(V, x%AD%rotors(DL%i1)%AA%DummyContState, ValAry) ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + call MV_Pack(V, x%AD%FVW%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + call MV_Pack(V, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine ADI_PackConstrStateVar(Var, z, ValAry) - type(ADI_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ADI_z_AD_rotors_BEMT_phi) - call MV_Pack2(Var, z%AD%rotors(DL%i1)%BEMT%phi, ValAry) ! Rank 2 Array - case (ADI_z_AD_rotors_AA_DummyConstrState) - call MV_Pack2(Var, z%AD%rotors(DL%i1)%AA%DummyConstrState, ValAry) ! Scalar - case (ADI_z_AD_FVW_W_Gamma_LL) - call MV_Pack2(Var, z%AD%FVW%W(DL%i1)%Gamma_LL, ValAry) ! Rank 1 Array - case (ADI_z_AD_FVW_residual) - call MV_Pack2(Var, z%AD%FVW%residual, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine ADI_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%AA%DummyContState) ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + call MV_Unpack(V, ValAry, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine ADI_PackConstrStateAry(Vars, z, ValAry) type(ADI_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call ADI_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + call MV_Pack(V, z%AD%rotors(DL%i1)%BEMT%phi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (ADI_z_AD_rotors_AA_DummyConstrState) + call MV_Pack(V, z%AD%rotors(DL%i1)%AA%DummyConstrState, ValAry) ! Scalar + case (ADI_z_AD_FVW_W_Gamma_LL) + call MV_Pack(V, z%AD%FVW%W(DL%i1)%Gamma_LL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_z_AD_FVW_residual) + call MV_Pack(V, z%AD%FVW%residual, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ADI_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ADI_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ADI_z_AD_rotors_BEMT_phi) - call MV_Unpack2(Var, ValAry, z%AD%rotors(DL%i1)%BEMT%phi) ! Rank 2 Array - case (ADI_z_AD_rotors_AA_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%AD%rotors(DL%i1)%AA%DummyConstrState) ! Scalar - case (ADI_z_AD_FVW_W_Gamma_LL) - call MV_Unpack2(Var, ValAry, z%AD%FVW%W(DL%i1)%Gamma_LL) ! Rank 1 Array - case (ADI_z_AD_FVW_residual) - call MV_Unpack2(Var, ValAry, z%AD%FVW%residual) ! Scalar - end select - end associate -end subroutine - subroutine ADI_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(ADI_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call ADI_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + call MV_Unpack(V, ValAry, z%AD%rotors(DL%i1)%BEMT%phi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (ADI_z_AD_rotors_AA_DummyConstrState) + call MV_Unpack(V, ValAry, z%AD%rotors(DL%i1)%AA%DummyConstrState) ! Scalar + case (ADI_z_AD_FVW_W_Gamma_LL) + call MV_Unpack(V, ValAry, z%AD%FVW%W(DL%i1)%Gamma_LL(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_z_AD_FVW_residual) + call MV_Unpack(V, ValAry, z%AD%FVW%residual) ! Scalar + end select + end associate end do end subroutine - -subroutine ADI_PackInputVar(Var, u, ValAry) - type(ADI_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ADI_u_AD_rotors_NacelleMotion) - call MV_Pack2(Var, u%AD%rotors(DL%i1)%NacelleMotion, ValAry) ! Mesh - case (ADI_u_AD_rotors_TowerMotion) - call MV_Pack2(Var, u%AD%rotors(DL%i1)%TowerMotion, ValAry) ! Mesh - case (ADI_u_AD_rotors_HubMotion) - call MV_Pack2(Var, u%AD%rotors(DL%i1)%HubMotion, ValAry) ! Mesh - case (ADI_u_AD_rotors_BladeRootMotion) - call MV_Pack2(Var, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2), ValAry) ! Mesh - case (ADI_u_AD_rotors_BladeMotion) - call MV_Pack2(Var, u%AD%rotors(DL%i1)%BladeMotion(DL%i2), ValAry) ! Mesh - case (ADI_u_AD_rotors_TFinMotion) - call MV_Pack2(Var, u%AD%rotors(DL%i1)%TFinMotion, ValAry) ! Mesh - case (ADI_u_AD_rotors_UserProp) - call MV_Pack2(Var, u%AD%rotors(DL%i1)%UserProp, ValAry) ! Rank 2 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ADI_PackInputAry(Vars, u, ValAry) - type(ADI_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ADI_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call ADI_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + call MV_Pack(V, u%AD%rotors(DL%i1)%NacelleMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_TowerMotion) + call MV_Pack(V, u%AD%rotors(DL%i1)%TowerMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_HubMotion) + call MV_Pack(V, u%AD%rotors(DL%i1)%HubMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_BladeRootMotion) + call MV_Pack(V, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2), ValAry) ! Mesh + case (ADI_u_AD_rotors_BladeMotion) + call MV_Pack(V, u%AD%rotors(DL%i1)%BladeMotion(DL%i2), ValAry) ! Mesh + case (ADI_u_AD_rotors_TFinMotion) + call MV_Pack(V, u%AD%rotors(DL%i1)%TFinMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_UserProp) + call MV_Pack(V, u%AD%rotors(DL%i1)%UserProp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ADI_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ADI_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ADI_u_AD_rotors_NacelleMotion) - call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%NacelleMotion) ! Mesh - case (ADI_u_AD_rotors_TowerMotion) - call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%TowerMotion) ! Mesh - case (ADI_u_AD_rotors_HubMotion) - call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%HubMotion) ! Mesh - case (ADI_u_AD_rotors_BladeRootMotion) - call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2)) ! Mesh - case (ADI_u_AD_rotors_BladeMotion) - call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%BladeMotion(DL%i2)) ! Mesh - case (ADI_u_AD_rotors_TFinMotion) - call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%TFinMotion) ! Mesh - case (ADI_u_AD_rotors_UserProp) - call MV_Unpack2(Var, ValAry, u%AD%rotors(DL%i1)%UserProp) ! Rank 2 Array - end select - end associate -end subroutine - subroutine ADI_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ADI_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call ADI_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%NacelleMotion) ! Mesh + case (ADI_u_AD_rotors_TowerMotion) + call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%TowerMotion) ! Mesh + case (ADI_u_AD_rotors_HubMotion) + call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%HubMotion) ! Mesh + case (ADI_u_AD_rotors_BladeRootMotion) + call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2)) ! Mesh + case (ADI_u_AD_rotors_BladeMotion) + call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%BladeMotion(DL%i2)) ! Mesh + case (ADI_u_AD_rotors_TFinMotion) + call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%TFinMotion) ! Mesh + case (ADI_u_AD_rotors_UserProp) + call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%UserProp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + end select + end associate end do end subroutine - -subroutine ADI_PackOutputVar(Var, y, ValAry) - type(ADI_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ADI_y_AD_rotors_NacelleLoad) - call MV_Pack2(Var, y%AD%rotors(DL%i1)%NacelleLoad, ValAry) ! Mesh - case (ADI_y_AD_rotors_HubLoad) - call MV_Pack2(Var, y%AD%rotors(DL%i1)%HubLoad, ValAry) ! Mesh - case (ADI_y_AD_rotors_TowerLoad) - call MV_Pack2(Var, y%AD%rotors(DL%i1)%TowerLoad, ValAry) ! Mesh - case (ADI_y_AD_rotors_BladeLoad) - call MV_Pack2(Var, y%AD%rotors(DL%i1)%BladeLoad(DL%i2), ValAry) ! Mesh - case (ADI_y_AD_rotors_TFinLoad) - call MV_Pack2(Var, y%AD%rotors(DL%i1)%TFinLoad, ValAry) ! Mesh - case (ADI_y_AD_rotors_WriteOutput) - call MV_Pack2(Var, y%AD%rotors(DL%i1)%WriteOutput, ValAry) ! Rank 1 Array - case (ADI_y_HHVel) - call MV_Pack2(Var, y%HHVel, ValAry) ! Rank 2 Array - case (ADI_y_PLExp) - call MV_Pack2(Var, y%PLExp, ValAry) ! Scalar - case (ADI_y_IW_WriteOutput) - call MV_Pack2(Var, y%IW_WriteOutput, ValAry) ! Rank 1 Array - case (ADI_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine ADI_PackOutputAry(Vars, y, ValAry) - type(ADI_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ADI_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call ADI_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + call MV_Pack(V, y%AD%rotors(DL%i1)%NacelleLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_HubLoad) + call MV_Pack(V, y%AD%rotors(DL%i1)%HubLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_TowerLoad) + call MV_Pack(V, y%AD%rotors(DL%i1)%TowerLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_BladeLoad) + call MV_Pack(V, y%AD%rotors(DL%i1)%BladeLoad(DL%i2), ValAry) ! Mesh + case (ADI_y_AD_rotors_TFinLoad) + call MV_Pack(V, y%AD%rotors(DL%i1)%TFinLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_WriteOutput) + call MV_Pack(V, y%AD%rotors(DL%i1)%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_y_HHVel) + call MV_Pack(V, y%HHVel(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (ADI_y_PLExp) + call MV_Pack(V, y%PLExp, ValAry) ! Scalar + case (ADI_y_IW_WriteOutput) + call MV_Pack(V, y%IW_WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (ADI_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine ADI_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(ADI_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (ADI_y_AD_rotors_NacelleLoad) - call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%NacelleLoad) ! Mesh - case (ADI_y_AD_rotors_HubLoad) - call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%HubLoad) ! Mesh - case (ADI_y_AD_rotors_TowerLoad) - call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%TowerLoad) ! Mesh - case (ADI_y_AD_rotors_BladeLoad) - call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%BladeLoad(DL%i2)) ! Mesh - case (ADI_y_AD_rotors_TFinLoad) - call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%TFinLoad) ! Mesh - case (ADI_y_AD_rotors_WriteOutput) - call MV_Unpack2(Var, ValAry, y%AD%rotors(DL%i1)%WriteOutput) ! Rank 1 Array - case (ADI_y_HHVel) - call MV_Unpack2(Var, ValAry, y%HHVel) ! Rank 2 Array - case (ADI_y_PLExp) - call MV_Unpack2(Var, ValAry, y%PLExp) ! Scalar - case (ADI_y_IW_WriteOutput) - call MV_Unpack2(Var, ValAry, y%IW_WriteOutput) ! Rank 1 Array - case (ADI_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine ADI_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ADI_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call ADI_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%NacelleLoad) ! Mesh + case (ADI_y_AD_rotors_HubLoad) + call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%HubLoad) ! Mesh + case (ADI_y_AD_rotors_TowerLoad) + call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%TowerLoad) ! Mesh + case (ADI_y_AD_rotors_BladeLoad) + call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%BladeLoad(DL%i2)) ! Mesh + case (ADI_y_AD_rotors_TFinLoad) + call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%TFinLoad) ! Mesh + case (ADI_y_AD_rotors_WriteOutput) + call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_y_HHVel) + call MV_Unpack(V, ValAry, y%HHVel(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (ADI_y_PLExp) + call MV_Unpack(V, ValAry, y%PLExp) ! Scalar + case (ADI_y_IW_WriteOutput) + call MV_Unpack(V, ValAry, y%IW_WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (ADI_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE AeroDyn_Inflow_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index a6d5c44707..2eee773e8a 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -2609,270 +2609,236 @@ subroutine AWAE_UnPackInput(RF, OutData) call RegUnpackAlloc(RF, OutData%WAT_k); if (RegCheckErr(RF, RoutineName)) return end subroutine -function AWAE_InputMeshPointer(u, ML) result(Mesh) +function AWAE_InputMeshPointer(u, DL) result(Mesh) type(AWAE_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function AWAE_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function AWAE_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function AWAE_OutputMeshPointer(y, ML) result(Mesh) +function AWAE_OutputMeshPointer(y, DL) result(Mesh) type(AWAE_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function AWAE_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function AWAE_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine AWAE_PackContStateVar(Var, x, ValAry) - type(AWAE_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AWAE_x_IfW_DummyContState) - call MV_Pack2(Var, x%IfW(DL%i1)%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AWAE_PackContStateAry(Vars, x, ValAry) type(AWAE_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call AWAE_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + call MV_Pack(V, x%IfW(DL%i1)%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AWAE_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AWAE_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AWAE_x_IfW_DummyContState) - call MV_Unpack2(Var, ValAry, x%IfW(DL%i1)%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine AWAE_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(AWAE_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call AWAE_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + call MV_Unpack(V, ValAry, x%IfW(DL%i1)%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine AWAE_PackContStateDerivAry(Vars, x, ValAry) + type(AWAE_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + call MV_Pack(V, x%IfW(DL%i1)%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine AWAE_PackConstrStateVar(Var, z, ValAry) - type(AWAE_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AWAE_z_IfW_DummyConstrState) - call MV_Pack2(Var, z%IfW(DL%i1)%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine AWAE_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + call MV_Unpack(V, ValAry, x%IfW(DL%i1)%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine AWAE_PackConstrStateAry(Vars, z, ValAry) type(AWAE_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call AWAE_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (AWAE_z_IfW_DummyConstrState) + call MV_Pack(V, z%IfW(DL%i1)%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AWAE_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AWAE_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AWAE_z_IfW_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%IfW(DL%i1)%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine AWAE_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(AWAE_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call AWAE_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (AWAE_z_IfW_DummyConstrState) + call MV_Unpack(V, ValAry, z%IfW(DL%i1)%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine AWAE_PackInputVar(Var, u, ValAry) - type(AWAE_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AWAE_u_xhat_plane) - call MV_Pack2(Var, u%xhat_plane, ValAry) ! Rank 3 Array - case (AWAE_u_p_plane) - call MV_Pack2(Var, u%p_plane, ValAry) ! Rank 3 Array - case (AWAE_u_Vx_wake) - call MV_Pack2(Var, u%Vx_wake, ValAry) ! Rank 4 Array - case (AWAE_u_Vy_wake) - call MV_Pack2(Var, u%Vy_wake, ValAry) ! Rank 4 Array - case (AWAE_u_Vz_wake) - call MV_Pack2(Var, u%Vz_wake, ValAry) ! Rank 4 Array - case (AWAE_u_D_wake) - call MV_Pack2(Var, u%D_wake, ValAry) ! Rank 2 Array - case (AWAE_u_WAT_k) - call MV_Pack2(Var, u%WAT_k, ValAry) ! Rank 4 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AWAE_PackInputAry(Vars, u, ValAry) - type(AWAE_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(AWAE_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call AWAE_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (AWAE_u_xhat_plane) + call MV_Pack(V, u%xhat_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (AWAE_u_p_plane) + call MV_Pack(V, u%p_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (AWAE_u_Vx_wake) + call MV_Pack(V, u%Vx_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array + case (AWAE_u_Vy_wake) + call MV_Pack(V, u%Vy_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array + case (AWAE_u_Vz_wake) + call MV_Pack(V, u%Vz_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array + case (AWAE_u_D_wake) + call MV_Pack(V, u%D_wake(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (AWAE_u_WAT_k) + call MV_Pack(V, u%WAT_k(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AWAE_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AWAE_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AWAE_u_xhat_plane) - call MV_Unpack2(Var, ValAry, u%xhat_plane) ! Rank 3 Array - case (AWAE_u_p_plane) - call MV_Unpack2(Var, ValAry, u%p_plane) ! Rank 3 Array - case (AWAE_u_Vx_wake) - call MV_Unpack2(Var, ValAry, u%Vx_wake) ! Rank 4 Array - case (AWAE_u_Vy_wake) - call MV_Unpack2(Var, ValAry, u%Vy_wake) ! Rank 4 Array - case (AWAE_u_Vz_wake) - call MV_Unpack2(Var, ValAry, u%Vz_wake) ! Rank 4 Array - case (AWAE_u_D_wake) - call MV_Unpack2(Var, ValAry, u%D_wake) ! Rank 2 Array - case (AWAE_u_WAT_k) - call MV_Unpack2(Var, ValAry, u%WAT_k) ! Rank 4 Array - end select - end associate -end subroutine - subroutine AWAE_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(AWAE_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call AWAE_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (AWAE_u_xhat_plane) + call MV_Unpack(V, ValAry, u%xhat_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (AWAE_u_p_plane) + call MV_Unpack(V, ValAry, u%p_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (AWAE_u_Vx_wake) + call MV_Unpack(V, ValAry, u%Vx_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array + case (AWAE_u_Vy_wake) + call MV_Unpack(V, ValAry, u%Vy_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array + case (AWAE_u_Vz_wake) + call MV_Unpack(V, ValAry, u%Vz_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array + case (AWAE_u_D_wake) + call MV_Unpack(V, ValAry, u%D_wake(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (AWAE_u_WAT_k) + call MV_Unpack(V, ValAry, u%WAT_k(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array + end select + end associate end do end subroutine - -subroutine AWAE_PackOutputVar(Var, y, ValAry) - type(AWAE_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AWAE_y_Vdist_High_data) - call MV_Pack2(Var, y%Vdist_High(DL%i1)%data, ValAry) ! Rank 5 Array - case (AWAE_y_V_plane) - call MV_Pack2(Var, y%V_plane, ValAry) ! Rank 3 Array - case (AWAE_y_TI_amb) - call MV_Pack2(Var, y%TI_amb, ValAry) ! Rank 1 Array - case (AWAE_y_Vx_wind_disk) - call MV_Pack2(Var, y%Vx_wind_disk, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine AWAE_PackOutputAry(Vars, y, ValAry) - type(AWAE_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(AWAE_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call AWAE_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (AWAE_y_Vdist_High_data) + call MV_Pack(V, y%Vdist_High(DL%i1)%data(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry), ValAry) ! Rank 5 Array + case (AWAE_y_V_plane) + call MV_Pack(V, y%V_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (AWAE_y_TI_amb) + call MV_Pack(V, y%TI_amb(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (AWAE_y_Vx_wind_disk) + call MV_Pack(V, y%Vx_wind_disk(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine AWAE_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(AWAE_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (AWAE_y_Vdist_High_data) - call MV_Unpack2(Var, ValAry, y%Vdist_High(DL%i1)%data) ! Rank 5 Array - case (AWAE_y_V_plane) - call MV_Unpack2(Var, ValAry, y%V_plane) ! Rank 3 Array - case (AWAE_y_TI_amb) - call MV_Unpack2(Var, ValAry, y%TI_amb) ! Rank 1 Array - case (AWAE_y_Vx_wind_disk) - call MV_Unpack2(Var, ValAry, y%Vx_wind_disk) ! Rank 1 Array - end select - end associate -end subroutine - subroutine AWAE_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(AWAE_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call AWAE_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (AWAE_y_Vdist_High_data) + call MV_Unpack(V, ValAry, y%Vdist_High(DL%i1)%data(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)) ! Rank 5 Array + case (AWAE_y_V_plane) + call MV_Unpack(V, ValAry, y%V_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (AWAE_y_TI_amb) + call MV_Unpack(V, ValAry, y%TI_amb(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (AWAE_y_Vx_wind_disk) + call MV_Unpack(V, ValAry, y%Vx_wind_disk(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE AWAE_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/lindyn/src/LinDyn_Types.f90 b/modules/lindyn/src/LinDyn_Types.f90 index f55cab99cd..7dfd1ead99 100644 --- a/modules/lindyn/src/LinDyn_Types.f90 +++ b/modules/lindyn/src/LinDyn_Types.f90 @@ -1562,238 +1562,204 @@ SUBROUTINE LD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ! check if allocated END SUBROUTINE -function LD_InputMeshPointer(u, ML) result(Mesh) - type(LD_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function LD_InputMeshPointer(u, DL) result(Mesh) + type(LD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function LD_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function LD_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function LD_OutputMeshPointer(y, ML) result(Mesh) +function LD_OutputMeshPointer(y, DL) result(Mesh) type(LD_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function LD_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function LD_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine LD_PackContStateVar(Var, x, ValAry) - type(LD_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (LD_x_q) - call MV_Pack2(Var, x%q, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine LD_PackContStateAry(Vars, x, ValAry) type(LD_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call LD_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (LD_x_q) + call MV_Pack(V, x%q(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine LD_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(LD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (LD_x_q) - call MV_Unpack2(Var, ValAry, x%q) ! Rank 1 Array - end select - end associate -end subroutine - subroutine LD_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(LD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call LD_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (LD_x_q) + call MV_Unpack(V, ValAry, x%q(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine +subroutine LD_PackContStateDerivAry(Vars, x, ValAry) + type(LD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (LD_x_q) + call MV_Pack(V, x%q(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine LD_PackConstrStateVar(Var, z, ValAry) - type(LD_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (LD_z_Dummy) - call MV_Pack2(Var, z%Dummy, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine LD_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (LD_x_q) + call MV_Unpack(V, ValAry, x%q(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate + end do end subroutine subroutine LD_PackConstrStateAry(Vars, z, ValAry) type(LD_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call LD_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (LD_z_Dummy) + call MV_Pack(V, z%Dummy, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine LD_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(LD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (LD_z_Dummy) - call MV_Unpack2(Var, ValAry, z%Dummy) ! Scalar - end select - end associate -end subroutine - subroutine LD_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(LD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call LD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (LD_z_Dummy) + call MV_Unpack(V, ValAry, z%Dummy) ! Scalar + end select + end associate end do end subroutine - -subroutine LD_PackInputVar(Var, u, ValAry) - type(LD_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (LD_u_Fext) - call MV_Pack2(Var, u%Fext, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine LD_PackInputAry(Vars, u, ValAry) - type(LD_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(LD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call LD_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (LD_u_Fext) + call MV_Pack(V, u%Fext(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine LD_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(LD_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (LD_u_Fext) - call MV_Unpack2(Var, ValAry, u%Fext) ! Rank 1 Array - end select - end associate -end subroutine - subroutine LD_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(LD_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call LD_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (LD_u_Fext) + call MV_Unpack(V, ValAry, u%Fext(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine LD_PackOutputVar(Var, y, ValAry) - type(LD_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (LD_y_xdd) - call MV_Pack2(Var, y%xdd, ValAry) ! Rank 1 Array - case (LD_y_WriteOutput) - call MV_Pack2(Var, y%WriteOutput, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine LD_PackOutputAry(Vars, y, ValAry) - type(LD_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(LD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call LD_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (LD_y_xdd) + call MV_Pack(V, y%xdd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (LD_y_WriteOutput) + call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine LD_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(LD_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (LD_y_xdd) - call MV_Unpack2(Var, ValAry, y%xdd) ! Rank 1 Array - case (LD_y_WriteOutput) - call MV_Unpack2(Var, ValAry, y%WriteOutput) ! Rank 1 Array - end select - end associate -end subroutine - subroutine LD_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(LD_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call LD_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (LD_y_xdd) + call MV_Unpack(V, ValAry, y%xdd(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (LD_y_WriteOutput) + call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine END MODULE LinDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index f7edf7340d..52ed5e1ec2 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -1937,314 +1937,280 @@ subroutine WD_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WAT_k); if (RegCheckErr(RF, RoutineName)) return end subroutine -function WD_InputMeshPointer(u, ML) result(Mesh) - type(WD_InputType), target, intent(in) :: u - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh +function WD_InputMeshPointer(u, DL) result(Mesh) + type(WD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function WD_InputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function WD_InputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -function WD_OutputMeshPointer(y, ML) result(Mesh) +function WD_OutputMeshPointer(y, DL) result(Mesh) type(WD_OutputType), target, intent(in) :: y - type(DatLoc), intent(in) :: ML - type(MeshType), pointer :: Mesh + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh nullify(Mesh) - select case (ML%Num) + select case (DL%Num) end select end function -function WD_OutputMeshName(ML) result(Name) - type(DatLoc), intent(in) :: ML +function WD_OutputMeshName(DL) result(Name) + type(DatLoc), intent(in) :: DL character(32) :: Name Name = "" - select case (ML%Num) + select case (DL%Num) end select end function -subroutine WD_PackContStateVar(Var, x, ValAry) - type(WD_ContinuousStateType), intent(in) :: x - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WD_x_DummyContState) - call MV_Pack2(Var, x%DummyContState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine WD_PackContStateAry(Vars, x, ValAry) type(WD_ContinuousStateType), intent(in) :: x - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%x) - call WD_PackContStateVar(Vars%x(i), x, ValAry) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (WD_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WD_UnpackContStateVar(Var, ValAry, x) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WD_x_DummyContState) - call MV_Unpack2(Var, ValAry, x%DummyContState) ! Scalar - end select - end associate -end subroutine - subroutine WD_UnpackContStateAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(WD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%x) - call WD_UnpackContStateVar(Vars%x(i), ValAry, x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (WD_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate end do end subroutine +subroutine WD_PackContStateDerivAry(Vars, x, ValAry) + type(WD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (WD_x_DummyContState) + call MV_Pack(V, x%DummyContState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine -subroutine WD_PackConstrStateVar(Var, z, ValAry) - type(WD_ConstraintStateType), intent(in) :: z - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WD_z_DummyConstrState) - call MV_Pack2(Var, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate +subroutine WD_UnpackContStateDerivAry(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (V => Vars%x(i), DL => Vars%x(i)%DL) + select case (DL%Num) + case (WD_x_DummyContState) + call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar + end select + end associate + end do end subroutine subroutine WD_PackConstrStateAry(Vars, z, ValAry) type(WD_ConstraintStateType), intent(in) :: z - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%z) - call WD_PackConstrStateVar(Vars%z(i), z, ValAry) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (WD_z_DummyConstrState) + call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WD_UnpackConstrStateVar(Var, ValAry, z) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WD_z_DummyConstrState) - call MV_Unpack2(Var, ValAry, z%DummyConstrState) ! Scalar - end select - end associate -end subroutine - subroutine WD_UnpackConstrStateAry(Vars, ValAry, z) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) type(WD_ConstraintStateType), intent(inout) :: z - integer(IntKi) :: i + integer(IntKi) :: i do i = 1, size(Vars%z) - call WD_UnpackConstrStateVar(Vars%z(i), ValAry, z) + associate (V => Vars%z(i), DL => Vars%z(i)%DL) + select case (DL%Num) + case (WD_z_DummyConstrState) + call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar + end select + end associate end do end subroutine - -subroutine WD_PackInputVar(Var, u, ValAry) - type(WD_InputType), intent(in) :: u - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WD_u_xhat_disk) - call MV_Pack2(Var, u%xhat_disk, ValAry) ! Rank 1 Array - case (WD_u_YawErr) - call MV_Pack2(Var, u%YawErr, ValAry) ! Scalar - case (WD_u_psi_skew) - call MV_Pack2(Var, u%psi_skew, ValAry) ! Scalar - case (WD_u_chi_skew) - call MV_Pack2(Var, u%chi_skew, ValAry) ! Scalar - case (WD_u_p_hub) - call MV_Pack2(Var, u%p_hub, ValAry) ! Rank 1 Array - case (WD_u_V_plane) - call MV_Pack2(Var, u%V_plane, ValAry) ! Rank 2 Array - case (WD_u_Vx_wind_disk) - call MV_Pack2(Var, u%Vx_wind_disk, ValAry) ! Scalar - case (WD_u_TI_amb) - call MV_Pack2(Var, u%TI_amb, ValAry) ! Scalar - case (WD_u_D_rotor) - call MV_Pack2(Var, u%D_rotor, ValAry) ! Scalar - case (WD_u_Vx_rel_disk) - call MV_Pack2(Var, u%Vx_rel_disk, ValAry) ! Scalar - case (WD_u_Ct_azavg) - call MV_Pack2(Var, u%Ct_azavg, ValAry) ! Rank 1 Array - case (WD_u_Cq_azavg) - call MV_Pack2(Var, u%Cq_azavg, ValAry) ! Rank 1 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine WD_PackInputAry(Vars, u, ValAry) - type(WD_InputType), intent(in) :: u - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(WD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%u) - call WD_PackInputVar(Vars%u(i), u, ValAry) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (WD_u_xhat_disk) + call MV_Pack(V, u%xhat_disk(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WD_u_YawErr) + call MV_Pack(V, u%YawErr, ValAry) ! Scalar + case (WD_u_psi_skew) + call MV_Pack(V, u%psi_skew, ValAry) ! Scalar + case (WD_u_chi_skew) + call MV_Pack(V, u%chi_skew, ValAry) ! Scalar + case (WD_u_p_hub) + call MV_Pack(V, u%p_hub(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WD_u_V_plane) + call MV_Pack(V, u%V_plane(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (WD_u_Vx_wind_disk) + call MV_Pack(V, u%Vx_wind_disk, ValAry) ! Scalar + case (WD_u_TI_amb) + call MV_Pack(V, u%TI_amb, ValAry) ! Scalar + case (WD_u_D_rotor) + call MV_Pack(V, u%D_rotor, ValAry) ! Scalar + case (WD_u_Vx_rel_disk) + call MV_Pack(V, u%Vx_rel_disk, ValAry) ! Scalar + case (WD_u_Ct_azavg) + call MV_Pack(V, u%Ct_azavg(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WD_u_Cq_azavg) + call MV_Pack(V, u%Cq_azavg(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WD_UnpackInputVar(Var, ValAry, u) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WD_InputType), intent(inout) :: u - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WD_u_xhat_disk) - call MV_Unpack2(Var, ValAry, u%xhat_disk) ! Rank 1 Array - case (WD_u_YawErr) - call MV_Unpack2(Var, ValAry, u%YawErr) ! Scalar - case (WD_u_psi_skew) - call MV_Unpack2(Var, ValAry, u%psi_skew) ! Scalar - case (WD_u_chi_skew) - call MV_Unpack2(Var, ValAry, u%chi_skew) ! Scalar - case (WD_u_p_hub) - call MV_Unpack2(Var, ValAry, u%p_hub) ! Rank 1 Array - case (WD_u_V_plane) - call MV_Unpack2(Var, ValAry, u%V_plane) ! Rank 2 Array - case (WD_u_Vx_wind_disk) - call MV_Unpack2(Var, ValAry, u%Vx_wind_disk) ! Scalar - case (WD_u_TI_amb) - call MV_Unpack2(Var, ValAry, u%TI_amb) ! Scalar - case (WD_u_D_rotor) - call MV_Unpack2(Var, ValAry, u%D_rotor) ! Scalar - case (WD_u_Vx_rel_disk) - call MV_Unpack2(Var, ValAry, u%Vx_rel_disk) ! Scalar - case (WD_u_Ct_azavg) - call MV_Unpack2(Var, ValAry, u%Ct_azavg) ! Rank 1 Array - case (WD_u_Cq_azavg) - call MV_Unpack2(Var, ValAry, u%Cq_azavg) ! Rank 1 Array - end select - end associate -end subroutine - subroutine WD_UnpackInputAry(Vars, ValAry, u) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(WD_InputType), intent(inout) :: u - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_InputType), intent(inout) :: u + integer(IntKi) :: i do i = 1, size(Vars%u) - call WD_UnpackInputVar(Vars%u(i), ValAry, u) + associate (V => Vars%u(i), DL => Vars%u(i)%DL) + select case (DL%Num) + case (WD_u_xhat_disk) + call MV_Unpack(V, ValAry, u%xhat_disk(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WD_u_YawErr) + call MV_Unpack(V, ValAry, u%YawErr) ! Scalar + case (WD_u_psi_skew) + call MV_Unpack(V, ValAry, u%psi_skew) ! Scalar + case (WD_u_chi_skew) + call MV_Unpack(V, ValAry, u%chi_skew) ! Scalar + case (WD_u_p_hub) + call MV_Unpack(V, ValAry, u%p_hub(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WD_u_V_plane) + call MV_Unpack(V, ValAry, u%V_plane(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (WD_u_Vx_wind_disk) + call MV_Unpack(V, ValAry, u%Vx_wind_disk) ! Scalar + case (WD_u_TI_amb) + call MV_Unpack(V, ValAry, u%TI_amb) ! Scalar + case (WD_u_D_rotor) + call MV_Unpack(V, ValAry, u%D_rotor) ! Scalar + case (WD_u_Vx_rel_disk) + call MV_Unpack(V, ValAry, u%Vx_rel_disk) ! Scalar + case (WD_u_Ct_azavg) + call MV_Unpack(V, ValAry, u%Ct_azavg(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WD_u_Cq_azavg) + call MV_Unpack(V, ValAry, u%Cq_azavg(V%iAry(1):V%iAry(2))) ! Rank 1 Array + end select + end associate end do end subroutine - -subroutine WD_PackOutputVar(Var, y, ValAry) - type(WD_OutputType), intent(in) :: y - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WD_y_xhat_plane) - call MV_Pack2(Var, y%xhat_plane, ValAry) ! Rank 2 Array - case (WD_y_p_plane) - call MV_Pack2(Var, y%p_plane, ValAry) ! Rank 2 Array - case (WD_y_Vx_wake) - call MV_Pack2(Var, y%Vx_wake, ValAry) ! Rank 2 Array - case (WD_y_Vr_wake) - call MV_Pack2(Var, y%Vr_wake, ValAry) ! Rank 2 Array - case (WD_y_Vx_wake2) - call MV_Pack2(Var, y%Vx_wake2, ValAry) ! Rank 3 Array - case (WD_y_Vy_wake2) - call MV_Pack2(Var, y%Vy_wake2, ValAry) ! Rank 3 Array - case (WD_y_Vz_wake2) - call MV_Pack2(Var, y%Vz_wake2, ValAry) ! Rank 3 Array - case (WD_y_D_wake) - call MV_Pack2(Var, y%D_wake, ValAry) ! Rank 1 Array - case (WD_y_x_plane) - call MV_Pack2(Var, y%x_plane, ValAry) ! Rank 1 Array - case (WD_y_WAT_k) - call MV_Pack2(Var, y%WAT_k, ValAry) ! Rank 3 Array - case default - ValAry(Var%iLoc(1):Var%iLoc(2)) = 0.0_R8Ki - end select - end associate -end subroutine - subroutine WD_PackOutputAry(Vars, y, ValAry) - type(WD_OutputType), intent(in) :: y - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(inout) :: ValAry(:) - integer(IntKi) :: i + type(WD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i do i = 1, size(Vars%y) - call WD_PackOutputVar(Vars%y(i), y, ValAry) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (WD_y_xhat_plane) + call MV_Pack(V, y%xhat_plane(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (WD_y_p_plane) + call MV_Pack(V, y%p_plane(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (WD_y_Vx_wake) + call MV_Pack(V, y%Vx_wake(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (WD_y_Vr_wake) + call MV_Pack(V, y%Vr_wake(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array + case (WD_y_Vx_wake2) + call MV_Pack(V, y%Vx_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (WD_y_Vy_wake2) + call MV_Pack(V, y%Vy_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (WD_y_Vz_wake2) + call MV_Pack(V, y%Vz_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case (WD_y_D_wake) + call MV_Pack(V, y%D_wake(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WD_y_x_plane) + call MV_Pack(V, y%x_plane(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array + case (WD_y_WAT_k) + call MV_Pack(V, y%WAT_k(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array + case default + ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki + end select + end associate end do end subroutine -subroutine WD_UnpackOutputVar(Var, ValAry, y) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: ValAry(:) - type(WD_OutputType), intent(inout) :: y - integer(IntKi) :: i - associate (DL => Var%DL) - select case (Var%DL%Num) - case (WD_y_xhat_plane) - call MV_Unpack2(Var, ValAry, y%xhat_plane) ! Rank 2 Array - case (WD_y_p_plane) - call MV_Unpack2(Var, ValAry, y%p_plane) ! Rank 2 Array - case (WD_y_Vx_wake) - call MV_Unpack2(Var, ValAry, y%Vx_wake) ! Rank 2 Array - case (WD_y_Vr_wake) - call MV_Unpack2(Var, ValAry, y%Vr_wake) ! Rank 2 Array - case (WD_y_Vx_wake2) - call MV_Unpack2(Var, ValAry, y%Vx_wake2) ! Rank 3 Array - case (WD_y_Vy_wake2) - call MV_Unpack2(Var, ValAry, y%Vy_wake2) ! Rank 3 Array - case (WD_y_Vz_wake2) - call MV_Unpack2(Var, ValAry, y%Vz_wake2) ! Rank 3 Array - case (WD_y_D_wake) - call MV_Unpack2(Var, ValAry, y%D_wake) ! Rank 1 Array - case (WD_y_x_plane) - call MV_Unpack2(Var, ValAry, y%x_plane) ! Rank 1 Array - case (WD_y_WAT_k) - call MV_Unpack2(Var, ValAry, y%WAT_k) ! Rank 3 Array - end select - end associate -end subroutine - subroutine WD_UnpackOutputAry(Vars, ValAry, y) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(WD_OutputType), intent(inout) :: y - integer(IntKi) :: i + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_OutputType), intent(inout) :: y + integer(IntKi) :: i do i = 1, size(Vars%y) - call WD_UnpackOutputVar(Vars%y(i), ValAry, y) + associate (V => Vars%y(i), DL => Vars%y(i)%DL) + select case (DL%Num) + case (WD_y_xhat_plane) + call MV_Unpack(V, ValAry, y%xhat_plane(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (WD_y_p_plane) + call MV_Unpack(V, ValAry, y%p_plane(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (WD_y_Vx_wake) + call MV_Unpack(V, ValAry, y%Vx_wake(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (WD_y_Vr_wake) + call MV_Unpack(V, ValAry, y%Vr_wake(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array + case (WD_y_Vx_wake2) + call MV_Unpack(V, ValAry, y%Vx_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (WD_y_Vy_wake2) + call MV_Unpack(V, ValAry, y%Vy_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (WD_y_Vz_wake2) + call MV_Unpack(V, ValAry, y%Vz_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + case (WD_y_D_wake) + call MV_Unpack(V, ValAry, y%D_wake(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WD_y_x_plane) + call MV_Unpack(V, ValAry, y%x_plane(V%iAry(1):V%iAry(2))) ! Rank 1 Array + case (WD_y_WAT_k) + call MV_Unpack(V, ValAry, y%WAT_k(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array + end select + end associate end do end subroutine END MODULE WakeDynamics_Types + !ENDOFREGISTRYGENERATEDFILE From 653b97683a42e1e82ce8f4796d5625fce97cc410 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 26 Jul 2024 23:50:39 +0000 Subject: [PATCH 162/319] fix typo in fast_linearization_file.py --- reg_tests/lib/fast_linearization_file.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/lib/fast_linearization_file.py b/reg_tests/lib/fast_linearization_file.py index 0901ae4951..a7e89ffacd 100644 --- a/reg_tests/lib/fast_linearization_file.py +++ b/reg_tests/lib/fast_linearization_file.py @@ -175,7 +175,7 @@ def readMat(fid, n, m, name=''): elif line.find('D:')>=0: self['D'] = readMat(f, ny, nu, 'D') elif line.find('J:')>=0: - _, rows, _, cols = line.spit() + _, rows, _, cols = line.split() self['J'] = readMat(f, int(rows), int(cols), 'J') elif line.find('dUdu:')>=0: self['dUdu'] = readMat(f, nu, nu,'dUdu') From 7ab1028baebdf0627964641e4a72c423a072f3f5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 26 Jul 2024 23:51:24 +0000 Subject: [PATCH 163/319] Change dxdt_jac to dxdt_lin --- modules/moordyn/src/MoorDyn.f90 | 40 ++++++++++++------------ modules/moordyn/src/MoorDyn_Registry.txt | 4 +-- modules/moordyn/src/MoorDyn_Types.f90 | 20 ++++++------ modules/subdyn/src/SubDyn.f90 | 36 ++++++++++----------- modules/subdyn/src/SubDyn_Registry.txt | 4 +-- modules/subdyn/src/SubDyn_Types.f90 | 20 ++++++------ 6 files changed, 62 insertions(+), 62 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 6d3d7a1fd8..aa29de2bb1 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -3057,9 +3057,9 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return call MD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MD_CopyContState(x, m%dxdt_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call MD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MD_CopyOutput(y, m%y_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return contains character(LinChanLen) function WriteOutputLinName(idx) @@ -4251,14 +4251,14 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(VarsL, m%y_jac, m%Jac%y_pos) + call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(VarsL, m%y_jac, m%Jac%y_neg) + call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index col = VarsL%u(i)%iLoc(1) + j - 1 @@ -4289,14 +4289,14 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_jac, m%Jac%x_pos) + call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) - call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_jac, m%Jac%x_neg) + call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = VarsL%u(i)%iLoc(1) + j - 1 @@ -4386,14 +4386,14 @@ SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Calculate positive perturbation call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) - call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(VarsL, m%y_jac, m%Jac%y_pos) + call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) - call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(VarsL, m%y_jac, m%Jac%y_neg) + call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) ! Calculate column index col = VarsL%x(i)%iLoc(1) + j - 1 @@ -4425,14 +4425,14 @@ SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Calculate positive perturbation call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) - call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_jac, m%Jac%x_pos) + call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) - call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_jac, m%Jac%x_neg) + call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call MD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = VarsL%x(i)%iLoc(1) + j - 1 @@ -4590,8 +4590,8 @@ SUBROUTINE MD_GetOP(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, if (.not. allocated(dx_op)) then call AllocAry(dx_op, VarsL%Nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return end if - call MD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if(Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_jac, dx_op) + call MD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if(Failed()) return + call MD_PackContStateAry(VarsL, m%dxdt_lin, dx_op) end if ! Discrete states diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index ab53d91d0e..e2f520a359 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -424,9 +424,9 @@ typedef ^ ^ MeshType VisAnchsMesh {:} ## ============================== Define Misc variables here: ===================================================================================================================================== typedef ^ MiscVarType ModJacType Jac - - - "Jacobian values corresponding to module variables" - typedef ^ ^ MD_ContinuousStateType x_perturb - - - "States for calculating Jacobians" - -typedef ^ ^ MD_ContinuousStateType dxdt_jac - - - "States for calculating Jacobians" - +typedef ^ ^ MD_ContinuousStateType dxdt_lin - - - "States for calculating Jacobians" - typedef ^ ^ MD_InputType u_perturb - - - "Inputs for calculating Jacobians" - -typedef ^ ^ MD_OutputType y_jac - - - "Outputs for calculating Jacobians" - +typedef ^ ^ MD_OutputType y_lin - - - "Outputs for calculating Jacobians" - typedef ^ ^ MD_LineProp LineTypeList {:} - - "array of properties for each line type" - typedef ^ ^ MD_RodProp RodTypeList {:} - - "array of properties for each rod type" - typedef ^ ^ MD_Body GroundBody - - - "the single ground body which is the parent of all stationary points" - diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 48b46ca420..204b2c50e8 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -455,9 +455,9 @@ MODULE MoorDyn_Types TYPE, PUBLIC :: MD_MiscVarType TYPE(ModJacType) :: Jac !< Jacobian values corresponding to module variables [-] TYPE(MD_ContinuousStateType) :: x_perturb !< States for calculating Jacobians [-] - TYPE(MD_ContinuousStateType) :: dxdt_jac !< States for calculating Jacobians [-] + TYPE(MD_ContinuousStateType) :: dxdt_lin !< States for calculating Jacobians [-] TYPE(MD_InputType) :: u_perturb !< Inputs for calculating Jacobians [-] - TYPE(MD_OutputType) :: y_jac !< Outputs for calculating Jacobians [-] + TYPE(MD_OutputType) :: y_lin !< Outputs for calculating Jacobians [-] TYPE(MD_LineProp) , DIMENSION(:), ALLOCATABLE :: LineTypeList !< array of properties for each line type [-] TYPE(MD_RodProp) , DIMENSION(:), ALLOCATABLE :: RodTypeList !< array of properties for each rod type [-] TYPE(MD_Body) :: GroundBody !< the single ground body which is the parent of all stationary points [-] @@ -3978,13 +3978,13 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call MD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MD_CopyContState(SrcMiscData%dxdt_jac, DstMiscData%dxdt_jac, CtrlCode, ErrStat2, ErrMsg2) + call MD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call MD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MD_CopyOutput(SrcMiscData%y_jac, DstMiscData%y_jac, CtrlCode, ErrStat2, ErrMsg2) + call MD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%LineTypeList)) then @@ -4359,11 +4359,11 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MD_DestroyContState(MiscData%dxdt_jac, ErrStat2, ErrMsg2) + call MD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MD_DestroyOutput(MiscData%y_jac, ErrStat2, ErrMsg2) + call MD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%LineTypeList)) then LB(1:1) = lbound(MiscData%LineTypeList, kind=B8Ki) @@ -4502,9 +4502,9 @@ subroutine MD_PackMisc(RF, Indata) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackModJacType(RF, InData%Jac) call MD_PackContState(RF, InData%x_perturb) - call MD_PackContState(RF, InData%dxdt_jac) + call MD_PackContState(RF, InData%dxdt_lin) call MD_PackInput(RF, InData%u_perturb) - call MD_PackOutput(RF, InData%y_jac) + call MD_PackOutput(RF, InData%y_lin) call RegPack(RF, allocated(InData%LineTypeList)) if (allocated(InData%LineTypeList)) then call RegPackBounds(RF, 1, lbound(InData%LineTypeList, kind=B8Ki), ubound(InData%LineTypeList, kind=B8Ki)) @@ -4610,9 +4610,9 @@ subroutine MD_UnPackMisc(RF, OutData) if (RF%ErrStat /= ErrID_None) return call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call MD_UnpackContState(RF, OutData%x_perturb) ! x_perturb - call MD_UnpackContState(RF, OutData%dxdt_jac) ! dxdt_jac + call MD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin call MD_UnpackInput(RF, OutData%u_perturb) ! u_perturb - call MD_UnpackOutput(RF, OutData%y_jac) ! y_jac + call MD_UnpackOutput(RF, OutData%y_lin) ! y_lin if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index f8842cdc7a..b9a8000375 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -493,9 +493,9 @@ subroutine SD_InitVars(Vars, Init, u, p, x, y, m, InitOut, Linearize, ErrStat, E CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return call SD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call SD_CopyContState(x, m%dxdt_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call SD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call SD_CopyOutput(y, m%y_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return contains character(LinChanLen) function WriteOutputLinName(idx) @@ -2088,14 +2088,14 @@ SUBROUTINE SD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) - call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputAry(Vars, m%y_jac, m%Jac%y_pos) + call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) - call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputAry(Vars, m%y_jac, m%Jac%y_neg) + call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 @@ -2122,14 +2122,14 @@ SUBROUTINE SD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation and resulting continuous state derivatives call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) - call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackContStateAry(Vars, m%dxdt_jac, m%Jac%x_pos) + call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation and resulting continuous state derivatives call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) - call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackContStateAry(Vars, m%dxdt_jac, m%Jac%x_neg) + call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 @@ -2208,14 +2208,14 @@ SUBROUTINE SD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) - call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputAry(Vars, m%y_jac, m%Jac%y_pos) + call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) - call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_jac, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputAry(Vars, m%y_jac, m%Jac%y_neg) + call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index col = Vars%x(i)%iLoc(1) + j - 1 @@ -2252,14 +2252,14 @@ SUBROUTINE SD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) - call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackContStateAry(Vars, m%dxdt_jac, m%Jac%x_pos) + call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) - call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_jac, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackContStateAry(Vars, m%dxdt_jac, m%Jac%x_neg) + call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = Vars%x(i)%iLoc(1) + j - 1 diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 8dae507452..be865babb0 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -288,9 +288,9 @@ typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" typedef ^ MiscVarType SD_ContinuousStateType x_perturb - - - "" -typedef ^ MiscVarType SD_ContinuousStateType dxdt_jac - - - "" +typedef ^ MiscVarType SD_ContinuousStateType dxdt_lin - - - "" typedef ^ MiscVarType SD_InputType u_perturb - - - "" -typedef ^ MiscVarType SD_OutputType y_jac - - - "" +typedef ^ MiscVarType SD_OutputType y_lin - - - "" typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" typedef ^ MiscVarType ReKi u_TP 6 - - typedef ^ MiscVarType ReKi udot_TP 6 - - diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 7db7a2abdc..0d093daabd 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -338,9 +338,9 @@ MODULE SubDyn_Types TYPE, PUBLIC :: SD_MiscVarType TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] TYPE(SD_ContinuousStateType) :: x_perturb !< [-] - TYPE(SD_ContinuousStateType) :: dxdt_jac !< [-] + TYPE(SD_ContinuousStateType) :: dxdt_lin !< [-] TYPE(SD_InputType) :: u_perturb !< [-] - TYPE(SD_OutputType) :: y_jac !< [-] + TYPE(SD_OutputType) :: y_lin !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi @@ -3609,13 +3609,13 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SD_CopyContState(SrcMiscData%dxdt_jac, DstMiscData%dxdt_jac, CtrlCode, ErrStat2, ErrMsg2) + call SD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call SD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SD_CopyOutput(SrcMiscData%y_jac, DstMiscData%y_jac, CtrlCode, ErrStat2, ErrMsg2) + call SD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%qmdotdot)) then @@ -3926,11 +3926,11 @@ subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyContState(MiscData%dxdt_jac, ErrStat2, ErrMsg2) + call SD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyOutput(MiscData%y_jac, ErrStat2, ErrMsg2) + call SD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%qmdotdot)) then deallocate(MiscData%qmdotdot) @@ -4013,9 +4013,9 @@ subroutine SD_PackMisc(RF, Indata) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackModJacType(RF, InData%Jac) call SD_PackContState(RF, InData%x_perturb) - call SD_PackContState(RF, InData%dxdt_jac) + call SD_PackContState(RF, InData%dxdt_lin) call SD_PackInput(RF, InData%u_perturb) - call SD_PackOutput(RF, InData%y_jac) + call SD_PackOutput(RF, InData%y_lin) call RegPackAlloc(RF, InData%qmdotdot) call RegPack(RF, InData%u_TP) call RegPack(RF, InData%udot_TP) @@ -4058,9 +4058,9 @@ subroutine SD_UnPackMisc(RF, OutData) if (RF%ErrStat /= ErrID_None) return call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call SD_UnpackContState(RF, OutData%x_perturb) ! x_perturb - call SD_UnpackContState(RF, OutData%dxdt_jac) ! dxdt_jac + call SD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin call SD_UnpackInput(RF, OutData%u_perturb) ! u_perturb - call SD_UnpackOutput(RF, OutData%y_jac) ! y_jac + call SD_UnpackOutput(RF, OutData%y_lin) ! y_lin call RegUnpackAlloc(RF, OutData%qmdotdot); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%u_TP); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%udot_TP); if (RegCheckErr(RF, RoutineName)) return From 5f0d9a0e7d58e5f5152bd32b7bc1880699fc2cf2 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 26 Jul 2024 23:51:52 +0000 Subject: [PATCH 164/319] Reenable AeroMap --- glue-codes/openfast/src/FAST_Prog.f90 | 4 +- modules/aerodyn/src/AeroDyn.f90 | 145 +--- modules/elastodyn/src/ElastoDyn.f90 | 2 +- modules/nwtc-library/src/ModVar.f90 | 17 +- modules/openfast-library/CMakeLists.txt | 2 +- modules/openfast-library/src/FAST_AeroMap.f90 | 801 ++++++++---------- modules/openfast-library/src/FAST_Funcs.f90 | 95 ++- modules/openfast-library/src/FAST_ModGlue.f90 | 17 +- .../openfast-library/src/Glue_Registry.txt | 6 +- modules/openfast-library/src/Glue_Types.f90 | 46 +- 10 files changed, 459 insertions(+), 676 deletions(-) diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index 5064c05920..d41dd0e376 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -32,7 +32,7 @@ PROGRAM FAST USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs -! USE FAST_AeroMap, ONLY : FAST_RunSteadyStateDriver +USE FAST_AeroMap, ONLY : FAST_RunSteadyStateDriver IMPLICIT NONE @@ -80,7 +80,7 @@ PROGRAM FAST ELSE IF ( TRIM(FlagArg) == 'STEADYSTATE' ) THEN ! Do steady-state analysis, not time-marching -- this works for only 1 turbine (i.e., NumTurbines==1)! ! this runs the steady-state solver driver and ENDS the program: - ! CALL FAST_RunSteadyStateDriver( Turbine(1) ) + CALL FAST_RunSteadyStateDriver( Turbine(1) ) CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true., SkipRunTimeMsg = .TRUE. ) ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index f13abc63b2..3d893a3dad 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -60,8 +60,8 @@ module AeroDyn PUBLIC :: AD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - PUBLIC :: AD_GetOP !< Routine to pack the operating point values into arrays PUBLIC :: AD_PackExtInputAry !< Routine pack extended inputs + public :: AD_CalcWind_Rotor !< Routine to calculate rotor wind inputs contains !---------------------------------------------------------------------------------------------------------------------------------- @@ -6570,149 +6570,6 @@ end subroutine cleanup END SUBROUTINE RotJacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE AD_GetOP(Vars, iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op) - type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays - INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - integer(IntKi) :: StartNode - - if (iRotor < 1 .or. iRotor > size(p%rotors)) then - ErrStat = ErrID_Fatal - ErrMsg = "AD_GetOP: Invalid rotor index: "//trim(Num2LStr(iRotor))//", must be between 1 and "//Num2LStr(size(p%rotors)) - return - end if - - StartNode = 1 - call AD_CalcWind_Rotor(t, u%rotors(iRotor), p%FlowField, p%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), StartNode, ErrStat, ErrMsg) - if (ErrStat >= AbortErrLev) return - call RotGetOP(Vars, iRotor, t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), & - xd%rotors(iRotor), z%rotors(iRotor), OtherState%rotors(iRotor), y%rotors(iRotor), m%rotors(iRotor), & - ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op) - -END SUBROUTINE AD_GetOP - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE RotGetOP(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op) - use IfW_FlowField, only: FlowFieldType, Uniform_FieldType, UniformField_InterpLinear - TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays - INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at operating point (may change to inout if a mesh copy is required) - TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters - TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(RotDiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(RotOutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - INTEGER(IntKi) :: i - type(UniformField_Interp) :: UF_op - - ErrStat = ErrID_None - ErrMsg = '' - - ! Inputs - if (present(u_op)) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call AD_PackInputAry(Vars, u, u_op) - - if (associated(p_AD%FlowField)) then - if (p_AD%FlowField%FieldType == Uniform_FieldType) then - UF_op = UniformField_InterpLinear(p_AD%FlowField%Uniform, t) - do i = 1, size(Vars%u) - select case (Vars%u(i)%DL%Num) - case (AD_u_HWindSpeed) - call MV_Pack(Vars%u(i), UF_op%VelH, u_op) - case (AD_u_PLexp) - call MV_Pack(Vars%u(i), UF_op%ShrV, u_op) - case (AD_u_PropagationDir) - call MV_Pack(Vars%u(i), UF_op%AngleH + p_AD%FlowField%PropagationDir, u_op) - end select - end do - end if - end if - end if - - ! Outputs - if (present(y_op)) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call AD_PackOutputAry(Vars, y, y_op) - end if - - ! Continuous States - if (present(x_op)) then - if (.not. allocated(x_op)) then - call AllocAry(x_op, Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call AD_PackContStateAry(Vars, x, x_op) - end if - - ! Continous State Derivatives - if (present(dx_op)) then - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); If (Failed()) return - call AD_PackContStateAry(Vars, m%dxdt_lin, dx_op) - end if - - ! Discrete States - if (present(xd_op)) then - end if - - ! Constraint States - if (present(z_op)) then - if (.not. allocated(z_op)) then - call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call AD_PackConstrStateAry(Vars, z, z_op) - end if - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine RotGetOP - subroutine AD_PackExtInputAry(Vars, t, p, ValAry) use IfW_FlowField_Types, only : UniformField_Interp use IfW_FlowField, only : UniformField_InterpCubic, UniformField_InterpLinear diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index fde8771583..3a83596bd4 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -11221,7 +11221,7 @@ subroutine ED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, E call MV_InitVarsJac(Vars, m%Jac, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return - if (Linearize) then + if (Linearize .or. p%CompAeroMaps) then call ED_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call ED_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call ED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 09b529cc23..794992d9b1 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -841,7 +841,9 @@ subroutine MV_AddDelta(VarAry, DeltaAry, DataAry) real(R8Ki), intent(in) :: DeltaAry(:) ! Array of delta values real(R8Ki), intent(inout) :: DataAry(:) ! Array to be modified integer(IntKi) :: i, j, k - real(R8Ki) :: quat_base(3), quat_delta(3) + real(R8Ki) :: quat_base(3), quat_delta(3), rvec(3), dcm(3,3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 ! Loop through variables do i = 1, size(VarAry) @@ -855,9 +857,18 @@ subroutine MV_AddDelta(VarAry, DeltaAry, DataAry) ! Loop through nodes do j = 1, VarAry(i)%Nodes - ! Quaternions from negative and positive perturbations + ! Quaternion from data array quat_base = DataAry(k:k + 2) - quat_delta = rvec_to_quat(DeltaAry(k:k + 2)) + + ! Get rotation vector delta + rvec = DeltaAry(k:k + 2) + + if (UseSmallRotAngles) then + call SmllRotTrans('linearization perturbation', rvec(1), rvec(2), rvec(3), dcm, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + quat_delta = dcm_to_quat(dcm) + else + quat_delta = rvec_to_quat(rvec) + end if ! Calculate composition of base quaternion and delta quaternion DataAry(k:k + 2) = quat_compose(quat_base, quat_delta) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index d9ec40a64e..e8ed4417b5 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -76,7 +76,7 @@ add_library(openfast_postlib STATIC src/FAST_Funcs.f90 src/FAST_ModGlue.f90 src/FAST_Mapping.f90 - # src/FAST_AeroMap.f90 + src/FAST_AeroMap.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index f858ec90e9..7cbb3d9900 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -24,14 +24,12 @@ module FAST_AeroMap use FAST_Types use FAST_Funcs use FAST_Mapping +use FAST_ModGlue use FAST_Subs implicit none -! Define array of module IDs used in AeroMap -integer(IntKi), parameter :: AeroMapModIDs(*) = [Module_ED, Module_BD, Module_AD] - real(DbKi), parameter :: SS_t_global = 0.0_DbKi real(DbKi), parameter :: UJacSclFact_x = 1.0d3 @@ -52,7 +50,7 @@ subroutine FAST_RunSteadyStateDriver(Turbine) ProgName = TRIM(FAST_Ver%Name)//' Aero Map' FAST_Ver%Name = ProgName - call FAST_AeroMapDriver(Turbine%m_Glue, Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, Turbine, ErrStat, ErrMsg) + call FAST_AeroMapDriver(Turbine%m_Glue%AM, Turbine%m_Glue, Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, Turbine, ErrStat, ErrMsg) call CheckError(ErrStat, ErrMsg, 'FAST_AeroMapDriver') call ExitThisProgram_T(Turbine, ErrID_None, .true.) @@ -71,22 +69,23 @@ subroutine CheckError(ErrID, Msg, SimMsg) end subroutine CheckError end subroutine -subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) +subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) use InflowWind_IO, only: IfW_SteadyFlowField_Init - type(Glue_MiscVarType), intent(inout) :: m !< MiscVars for the glue code - type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters for the glue code - type(FAST_OutputFileType), intent(inout) :: y_FAST !< Output variables for the glue code + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(Glue_MiscVarType), intent(inout) :: m !< MiscVars for the glue code + type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters for the glue code + type(FAST_OutputFileType), intent(inout) :: y_FAST !< Output variables for the glue code type(FAST_MiscVarType), intent(inout) :: m_FAST - type(FAST_TurbineType), intent(inout) :: T !< all data for one instance of a turbine - character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + type(FAST_TurbineType), intent(inout) :: T !< all data for one instance of a turbine + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), parameter :: RoutineName = 'FAST_AeroMapDriver' character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: ErrStat2 logical, parameter :: CompAeroMaps = .true. real(DbKi), parameter :: t_initial = 0.0_DbKi - integer(IntKi), allocatable :: modIDs(:), modIdx(:), iModOrder(:) + integer(IntKi) :: iModED, iModBD, iModAD, iModOrder(2) integer(IntKi) :: i integer(IntKi) :: JacSize integer(IntKi) :: n_case !< loop counter @@ -107,65 +106,68 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) T%TurbID = 1 ! Initialize linearization file number (will be incremented before use) - m%AM%LinFileNum = 0 + AM%LinFileNum = 0 ! Standard Turbine initialization call FAST_InitializeAll(t_initial, T%m_Glue, T%p_FAST, T%y_FAST, T%m_FAST, & - T%ED, T%BD, T%SrvD, T%AD14, T%AD, & + T%ED, T%BD, T%SrvD, T%AD, & T%ExtLd, T%IfW, T%ExtInfw, T%SC_DX, & T%SeaSt, T%HD, T%SD, T%ExtPtfm, T%MAP, & T%FEAM, T%MD, T%Orca, T%IceF, T%IceD, & T%MeshMapData, CompAeroMaps, ErrStat2, ErrMsg2) if (Failed()) return - ! TODO: Move into FAST_InitializeAll ! Initialize module data transfer mappings - call FAST_InitMappings(m%ModDataAry, m%Mappings, T, ErrStat2, ErrMsg2) + call FAST_InitMappings(m%Mappings, m%ModDataAry, T, ErrStat2, ErrMsg2) if (Failed()) return ! Initialize steady flow field in AeroDyn call IfW_SteadyFlowField_Init(T%AD%p%FlowField, & - RefHt=100.0_ReKi, HWindSpeed=8.0_ReKi, PLExp=0.0_ReKi, & + RefHt=100.0_ReKi, & + HWindSpeed=8.0_ReKi, & + PLExp=0.0_ReKi, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return !---------------------------------------------------------------------------- - ! Modules + ! Module Order !---------------------------------------------------------------------------- - ! Initialize module indices - m%AM%iModED = 0 - m%AM%iModBD = 0 - m%AM%iModAD = 0 - ! Get indices of modules that are used by Aero Mapping (first instance only) - call GetModuleOrder(m%ModDataAry, AeroMapModIDs, m%AM%iModOrder) - do i = 1, size(m%AM%iModOrder) - associate (ModData => m%ModDataAry(m%AM%iModOrder(i))) + iModED = 0; iModBD = 0; iModAD = 0 + do i = 1, size(m%ModDataAry) + associate (ModData => m%ModDataAry(i)) if (ModData%Ins == 1) then select case (ModData%ID) case (Module_ED) - m%AM%iModED = i + iModED = i case (Module_BD) - m%AM%iModBD = i + iModBD = i case (Module_AD) - m%AM%iModAD = i + iModAD = i end select end if end associate end do ! If BeamDyn is active - if (m%AM%iModBD > 0) then - m%AM%iModED = 0 - m%AM%iModOrder = [m%AM%iModBD, m%AM%iModAD] - else if (m%AM%iModED > 0) then - m%AM%iModOrder = [m%AM%iModED, m%AM%iModAD] + if (iModBD > 0) then + iModOrder = [iModBD, iModAD] + else if (iModED > 0) then + iModOrder = [iModED, iModAD] end if - ! Loop through module indices, copy states and inputs - do i = 1, size(m%AM%iModOrder) - associate (ModData => m%ModDataAry(m%AM%iModOrder(i))) + !---------------------------------------------------------------------------- + ! Build AeroMap module + !---------------------------------------------------------------------------- + + ! Generate index for variables with AeroMap flag + call Glue_CombineModules(AM%Mod, m%ModDataAry, m%Mappings, iModOrder, VF_AeroMap, .true., ErrStat2, ErrMsg2) + if (Failed()) return + + ! Loop through modules in AM module + do i = 1, size(AM%Mod%ModDataAry) + associate (ModData => AM%Mod%ModDataAry(i)) ! Copy current state to predicted state call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -175,82 +177,66 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) if (Failed()) return - ! If linearization is enabled, set lin file module abbreviation for file name - ! If module is BeamDyn or more than one instance, append instance number to abbreviation - if ((ModData%ID == Module_BD) .or. (count(m%ModDataAry%ID == ModData%ID) > 1)) then - ModData%Lin%Abbr = trim(ModData%Abbr)//Num2LStr(ModData%Ins) - else - ModData%Lin%Abbr = ModData%Abbr - end if - end associate end do - !---------------------------------------------------------------------------- - ! Build AeroMap module - !---------------------------------------------------------------------------- - - ! Generate index for variables with AeroMap flag - call ModD_CombineModules(m%ModDataAry, m%AM%iModOrder, VF_AeroMap, .true., m%AM%Mod, ErrStat2, ErrMsg2) - if (Failed()) return - !---------------------------------------------------------------------------- ! Allocation !---------------------------------------------------------------------------- ! Allocate components of the Jacobian matrix - call AllocAry(m%AM%Jac11, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Nx, 'Jac11', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Jac12, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Nu, 'Jac12', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Jac21, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Nx, 'Jac21', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Jac22, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Nu, 'Jac22', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Jac11, AM%Mod%Vars%Nx, AM%Mod%Vars%Nx, 'Jac11', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Jac12, AM%Mod%Vars%Nx, AM%Mod%Vars%Nu, 'Jac12', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Jac21, AM%Mod%Vars%Nu, AM%Mod%Vars%Nx, 'Jac21', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Jac22, AM%Mod%Vars%Nu, AM%Mod%Vars%Nu, 'Jac22', ErrStat2, ErrMsg2); if (Failed()) return ! Jacobian size is number of states plus number of inputs - JacSize = m%AM%Mod%Vars%Nx + m%AM%Mod%Vars%Nu + JacSize = AM%Mod%Vars%Nx + AM%Mod%Vars%Nu ! Allocate Jacobian pivot vector - call AllocAry(m%AM%JacPivot, JacSize, 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%JacPivot, JacSize, 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2); if (Failed()) return ! Storage for residual and solution delta - call AllocAry(m%AM%Residual, JacSize, 'Residual', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%SolveDelta, JacSize, 'SolveDelta', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Residual, JacSize, 'Residual', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%SolveDelta, JacSize, 'SolveDelta', ErrStat2, ErrMsg2); if (Failed()) return ! Allocate Jacobian matrix - call AllocAry(m%AM%Mod%Lin%J, JacSize, JacSize, 'J', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%J, JacSize, JacSize, 'J', ErrStat2, ErrMsg2); if (Failed()) return ! Allocate Idx Jacobian storage - call AllocAry(m%AM%Mod%Lin%dYdu, m%AM%Mod%Vars%Ny, m%AM%Mod%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%dXdu, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%dYdx, m%AM%Mod%Vars%Ny, m%AM%Mod%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%dXdx, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%dXdy, m%AM%Mod%Vars%Nx, m%AM%Mod%Vars%Ny, 'dXdy', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%dUdu, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%dUdy, m%AM%Mod%Vars%Nu, m%AM%Mod%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%dYdu, AM%Mod%Vars%Ny, AM%Mod%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%dXdu, AM%Mod%Vars%Nx, AM%Mod%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%dYdx, AM%Mod%Vars%Ny, AM%Mod%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%dXdx, AM%Mod%Vars%Nx, AM%Mod%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%dXdy, AM%Mod%Vars%Nx, AM%Mod%Vars%Ny, 'dXdy', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%dUdu, AM%Mod%Vars%Nu, AM%Mod%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%dUdy, AM%Mod%Vars%Nu, AM%Mod%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return ! Allocate operating point arrays - call AllocAry(m%AM%Mod%Lin%x, m%AM%Mod%Vars%Nx, 'x', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%u, m%AM%Mod%Vars%Nu, 'u', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%dx, m%AM%Mod%Vars%Nx, 'dx', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%Mod%Lin%y, m%AM%Mod%Vars%Ny, 'y', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%x, AM%Mod%Vars%Nx, 'x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%u, AM%Mod%Vars%Nu, 'u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%dx, AM%Mod%Vars%Nx, 'dx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Mod%Lin%y, AM%Mod%Vars%Ny, 'y', ErrStat2, ErrMsg2); if (Failed()) return ! Allocate arrays to store inputs - call AllocAry(m%AM%u1, m%AM%Mod%Vars%Nu, 'u1', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%AM%u2, m%AM%Mod%Vars%Nu, 'u2', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%u1, AM%Mod%Vars%Nu, 'u1', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%u2, AM%Mod%Vars%Nu, 'u2', ErrStat2, ErrMsg2); if (Failed()) return ! Move hub orientation matrices to AeroMap structure - call move_alloc(T%MeshMapData%HubOrient, m%AM%HubOrientation) + call move_alloc(T%MeshMapData%HubOrient, AM%HubOrientation) !---------------------------------------------------------------------------- ! AeroMap structure initialization !---------------------------------------------------------------------------- ! Jacobian scaling factor - m%AM%JacScale = real(p_FAST%UJacSclFact, R8Ki) + AM%JacScale = real(p_FAST%UJacSclFact, R8Ki) ! Set tolerance so the error doesn't need to be divided by size of array later - m%AM%SolveTolerance = p_FAST%tolerSquared*JacSize**2 + AM%SolveTolerance = p_FAST%tolerSquared*JacSize**2 ! Allocate cases - allocate (m%AM%Cases(p_FAST%NumSSCases), stat=ErrStat2) + allocate (AM%Cases(p_FAST%NumSSCases), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating AeroMap cases", ErrStat, ErrMsg, RoutineName) return @@ -259,14 +245,14 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) ! Populate case data do n_case = 1, p_FAST%NumSSCases if (p_FAST%WindSpeedOrTSR == 1) then - m%AM%Cases(n_case)%WindSpeed = p_FAST%WS_TSR(n_case) - m%AM%Cases(n_case)%TSR = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/m%AM%Cases(n_case)%WindSpeed + AM%Cases(n_case)%WindSpeed = p_FAST%WS_TSR(n_case) + AM%Cases(n_case)%TSR = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/AM%Cases(n_case)%WindSpeed else - m%AM%Cases(n_case)%TSR = p_FAST%WS_TSR(n_case) - m%AM%Cases(n_case)%WindSpeed = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/m%AM%Cases(n_case)%TSR + AM%Cases(n_case)%TSR = p_FAST%WS_TSR(n_case) + AM%Cases(n_case)%WindSpeed = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/AM%Cases(n_case)%TSR end if - m%AM%Cases(n_case)%Pitch = p_FAST%Pitch(n_case) - m%AM%Cases(n_case)%RotSpeed = p_FAST%RotSpeed(n_case) + AM%Cases(n_case)%Pitch = p_FAST%Pitch(n_case) + AM%Cases(n_case)%RotSpeed = p_FAST%RotSpeed(n_case) end do !---------------------------------------------------------------------------- @@ -286,13 +272,13 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) end if ! Call steady-state solve for this pitch and rotor speed - call SS_Solve(m, m%AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) + call SS_Solve(AM, m, m%Mappings, AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) ! we didn't converge; let's try a different operating point and see if that helps: if (ErrStat2 >= ErrID_Severe) then ! Create copy of case data for second attempt - CaseDataTmp = m%AM%Cases(n_case) + CaseDataTmp = AM%Cases(n_case) ! Modify pitch, TSR, and WindSpeed CaseDataTmp%Pitch = CaseDataTmp%Pitch*0.5_ReKi @@ -303,11 +289,11 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) call WrScr('Retrying case '//trim(Num2LStr(n_case))//', first trying to get a better initial guess. Average error is '// & trim(Num2LStr(y_FAST%DriverWriteOutput(SS_Indx_Err)))//'.') - call SS_Solve(m, CaseDataTmp, p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) + call SS_Solve(AM, m, m%Mappings, CaseDataTmp, p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) ! if that worked, try the real case again: if (ErrStat2 < AbortErrLev) then - ! call SS_Solve(m, m%AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + ! call SS_Solve(m, AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) call WrOver(BlankLine) end if @@ -315,10 +301,10 @@ subroutine FAST_AeroMapDriver(m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) if (ErrStat2 > ErrID_None) then ErrMsg2 = trim(ErrMsg2)//" case "//trim(Num2LStr(n_case))// & - ' (tsr='//trim(Num2LStr(m%AM%Cases(n_case)%tsr))// & - ', wind speed='//trim(Num2LStr(m%AM%Cases(n_case)%windSpeed))//' m/s'// & - ', pitch='//trim(num2lstr(m%AM%Cases(n_case)%pitch*R2D))//' deg'// & - ', rotor speed='//trim(num2lstr(m%AM%Cases(n_case)%RotSpeed*RPS2RPM))//' rpm)' + ' (tsr='//trim(Num2LStr(AM%Cases(n_case)%tsr))// & + ', wind speed='//trim(Num2LStr(AM%Cases(n_case)%windSpeed))//' m/s'// & + ', pitch='//trim(num2lstr(AM%Cases(n_case)%pitch*R2D))//' deg'// & + ', rotor speed='//trim(num2lstr(AM%Cases(n_case)%RotSpeed*RPS2RPM))//' rpm)' call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if @@ -356,8 +342,10 @@ logical function Failed() !---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the Input-Output solve for the steady-state solver. !! Note that this has been customized for the physics in the problems and is not a general solution. -subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) +subroutine SS_Solve(AM, m, Mappings, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables + type(MappingType), intent(inout) :: Mappings(:) !< Transfer mappings type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case type(FAST_ParameterType), intent(in) :: p_FAST !< Glue-code simulation parameters type(FAST_OutputFileType), intent(inout) :: y_FAST !< Glue-code output file values @@ -371,18 +359,18 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None !bjj: store these so that we don't reallocate every time? - real(R8Ki) :: err - real(R8Ki) :: err_prev - real(R8Ki), allocatable :: u(:) - real(R8Ki), parameter :: reduction_factor = 0.1_R8Ki - - integer(IntKi) :: nb ! loop counter (blade number) - integer(IntKi) :: MaxIter ! maximum number of iterations - integer(IntKi) :: K ! Input-output-solve iteration counter - integer(IntKi) :: i, j - integer(IntKi) :: nx ! Number of state variables in Jacobian + real(R8Ki) :: err + real(R8Ki) :: err_prev + real(R8Ki), allocatable :: u(:) + real(R8Ki), parameter :: reduction_factor = 0.1_R8Ki + + integer(IntKi) :: nb ! loop counter (blade number) + integer(IntKi) :: MaxIter ! maximum number of iterations + integer(IntKi) :: iter ! Input-output-solve iteration counter + integer(IntKi) :: i, j + integer(IntKi) :: nx ! Number of state variables in Jacobian - logical :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput + logical :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput !bjj: note, that this routine may have a problem if there is remapping done @@ -393,21 +381,21 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) ! Some record keeping stuff: !---------------------------------------------------------------------------- - nx = m%AM%Mod%Vars%Nx + nx = AM%Mod%Vars%Nx ! Set the rotor speed in ElastoDyn T%ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed - ! Update module inputs + ! Set prescribed inputs from case data call SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD) - do i = 1, size(m%AM%iModOrder) - associate (ModData => m%ModDataAry(m%AM%iModOrder(i))) - call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end associate + + ! Copy inputs from current to previous index + do i = 1, size(AM%Mod%ModDataAry) + call FAST_CopyInput(AM%Mod%ModDataAry(i), T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - K = 0 + iter = 0 err = 1.0E3 err_prev = err @@ -426,42 +414,35 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) !------------------------------------------------------------------------- ! Set GetWriteOutput flag true if not the first iteration - GetWriteOutput = K > 0 + GetWriteOutput = iter > 0 !----------------------------------------- ! Calculate ElastoDyn / BeamDyn output !----------------------------------------- - ! If BeamDyn is active - if (m%AM%iModBD > 0) then - - ! Calculate BeamDyn output - call FAST_CalcOutput(m%ModDataAry(m%AM%iModBD), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - else - - ! Calculate ElastoDyn output - call FAST_CalcOutput(m%ModDataAry(m%AM%iModED), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - end if + call FAST_CalcOutput(AM%Mod%ModDataAry(1), Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !----------------------------------------- ! AeroDyn InputSolve !----------------------------------------- ! If first iteration - if (K == 0) then + if (iter == 0) then ! Perform AeroDyn input solve to get initial guess from structural module ! (this ensures that the pitch is accounted for in the fixed aero-map solve:): - call SS_AD_InputSolve(m, INPUT_CURR, T, ErrStat2, ErrMsg2) + call SS_AD_InputSolve(AM, Mappings, INPUT_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_AD_InputSolve_OtherBlades(AM, INPUT_CURR, T) + + ! Get initial states + call SS_GetStates(AM, AM%Mod%Lin%x, INPUT_CURR, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SS_AD_InputSolve_OtherBlades(m, INPUT_CURR, T) - ! set up x-u vector, using local initial guesses - call SS_GetInputs(m, m%AM%u1, INPUT_CURR, T, ErrStat2, ErrMsg2) + ! Get initial inputs + call SS_GetInputs(AM, AM%u1, INPUT_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if @@ -469,7 +450,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) ! Calculate AeroDyn Output !----------------------------------------- - call FAST_CalcOutput(m%ModDataAry(m%AM%iModAD), m%Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call FAST_CalcOutput(AM%Mod%ModDataAry(2), Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) then call ResetInputsAndStates() @@ -477,7 +458,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) end if ! If iteration is at or above maximum iteration, exit loop - if (K >= MaxIter) exit + if (iter >= MaxIter) exit !------------------------------------------------------------------------------------------------- ! Calculate residual and the Jacobian @@ -485,7 +466,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) ! Also, the residual uses values from y_FAST, so do this before calculating the jacobian !------------------------------------------------------------------------------------------------- - call SS_BuildResidual(caseData, m, T, ErrStat2, ErrMsg2) + call SS_BuildResidual(AM, caseData, Mappings, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) then call ResetInputsAndStates() @@ -493,8 +474,8 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) end if ! If Jacobian needs to be recalculated - if (mod(K, p_FAST%N_UJac) == 0) then - call SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) + if (mod(iter, p_FAST%N_UJac) == 0) then + call SS_BuildJacobian(AM, caseData, Mappings, p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) then call ResetInputsAndStates() @@ -508,11 +489,11 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) !------------------------------------------------------------------------- ! Copy negative of residual into solve - m%AM%SolveDelta = -m%AM%Residual + AM%SolveDelta = -AM%Residual ! Solve for changes in states and inputs - call LAPACK_getrs(TRANS="N", N=size(m%AM%Mod%Lin%J, 1), A=m%AM%Mod%Lin%J, & - IPIV=m%AM%JacPivot, B=m%AM%SolveDelta, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call LAPACK_getrs(TRANS="N", N=size(AM%Mod%Lin%J, 1), A=AM%Mod%Lin%J, & + IPIV=AM%JacPivot, B=AM%SolveDelta, ErrStat=ErrStat2, ErrMsg=ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -524,25 +505,25 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) err_prev = err ! Calculate new error - err = dot_product(m%AM%SolveDelta, m%AM%SolveDelta) + err = dot_product(AM%SolveDelta, AM%SolveDelta) ! Store normalized error in output - y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/size(m%AM%Mod%Lin%J, 1) + y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/size(AM%Mod%Lin%J, 1) ! Remove conditioning from solution vector - call PostconditionInputDelta(m%AM%SolveDelta(nx + 1:), m%AM%JacScale) + call PostconditionInputDelta(AM%SolveDelta(nx + 1:), AM%JacScale) ! If error is below tolerance - if (err <= m%AM%SolveTolerance) then - if (K == 0) then ! the error will be incorrect in this instance, but the outputs will be better - MaxIter = K + if (err <= AM%SolveTolerance) then + if (iter == 0) then ! the error will be incorrect in this instance, but the outputs will be better + MaxIter = iter else exit end if end if - if (K >= p_FAST%KMax) exit - if (K > 5 .and. err > 1.0E35) exit ! this is obviously not converging. Let's try something else. + if (iter >= p_FAST%KMax) exit + if (iter > 5 .and. err > 1.0E35) exit ! this is obviously not converging. Let's try something else. !------------------------------------------------------------------------- ! Modify inputs and states for next iteration @@ -551,17 +532,17 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) ! If current error is greater than previous error (solution diverging), ! reduce delta (take a smaller step) if (err > err_prev) then - m%AM%SolveDelta = m%AM%SolveDelta*reduction_factor + AM%SolveDelta = AM%SolveDelta*reduction_factor err_prev = err_prev*reduction_factor end if ! Update states and inputs based on solution - call SS_UpdateInputsStates(m, m%AM%SolveDelta, T, ErrStat2, ErrMsg2) + call SS_UpdateInputsStates(AM, AM%SolveDelta, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Increment iteration counter and set it in write output - K = K + 1 - y_FAST%DriverWriteOutput(SS_Indx_Iter) = k + iter = iter + 1 + y_FAST%DriverWriteOutput(SS_Indx_Iter) = iter end do ! K @@ -577,7 +558,7 @@ subroutine SS_Solve(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) contains subroutine ResetInputsAndStates() - if (err > m%AM%SolveTolerance) then + if (err > AM%SolveTolerance) then call SetErrStat(ErrID_Severe, 'Steady-state solver did not converge.', ErrStat, ErrMsg, RoutineName) @@ -588,19 +569,19 @@ subroutine ResetInputsAndStates() ! because loads occasionally get very large when it fails, manually set these to zero (otherwise ! roundoff can lead to non-zero values with the method below, which is most useful for states) if (p_FAST%CompElast == Module_BD) then - do K = 1, p_FAST%nBeams - T%BD%Input(1, k)%DistrLoad%Force = 0.0_ReKi - T%BD%Input(1, k)%DistrLoad%Moment = 0.0_ReKi + do iter = 1, p_FAST%nBeams + T%BD%Input(1, iter)%DistrLoad%Force = 0.0_ReKi + T%BD%Input(1, iter)%DistrLoad%Moment = 0.0_ReKi end do end if ! Find the values we have been modifying (in u... continuous states and inputs) - call SS_GetStates(m, m%AM%SolveDelta(:nx), STATE_CURR, T, ErrStat2, ErrMsg2) - call SS_GetInputs(m, m%AM%SolveDelta(nx + 1:), INPUT_CURR, T, ErrStat2, ErrMsg2) + call SS_GetStates(AM, AM%SolveDelta(:nx), STATE_CURR, T, ErrStat2, ErrMsg2) + call SS_GetInputs(AM, AM%SolveDelta(nx + 1:), INPUT_CURR, T, ErrStat2, ErrMsg2) ! Reset them to 0 (by adding -u) - m%AM%SolveDelta = -m%AM%SolveDelta - call SS_UpdateInputsStates(m, m%AM%SolveDelta, T, ErrStat2, ErrMsg2) + AM%SolveDelta = -AM%SolveDelta + call SS_UpdateInputsStates(AM, AM%SolveDelta, T, ErrStat2, ErrMsg2) end if end if @@ -609,8 +590,8 @@ end subroutine ResetInputsAndStates subroutine PostconditionInputDelta(u_delta, JacScale) real(R8Ki), intent(inout) :: u_delta(:) real(R8Ki), intent(in) :: JacScale - do i = 1, size(m%AM%Mod%Vars%u) - associate (Var => m%AM%Mod%Vars%u(i)) + do i = 1, size(AM%Mod%Vars%u) + associate (Var => AM%Mod%Vars%u(i)) if (MV_IsLoad(Var)) then u_delta(Var%iLoc(1):Var%iLoc(2)) = u_delta(Var%iLoc(1):Var%iLoc(2))*JacScale end if @@ -620,8 +601,9 @@ subroutine PostconditionInputDelta(u_delta, JacScale) end subroutine SS_Solve -subroutine SS_UpdateInputsStates(m, delta, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables +subroutine SS_UpdateInputsStates(AM, delta, T, ErrStat, ErrMsg) + use ElastoDyn_IO, only: DOF_BF, DOF_BE + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data type(FAST_TurbineType), intent(inout) :: T !< Turbine type real(R8Ki), intent(in) :: delta(:) !< Change in state and input arrays integer(IntKi), intent(out) :: ErrStat !< Error status of the operation @@ -631,82 +613,71 @@ subroutine SS_UpdateInputsStates(m, delta, T, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None integer(IntKi) :: i, j - integer(IntKi) :: iModOrder(3), iMod - - ! Set module order - iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] - - ! Update states and inputs in module - do i = 1, size(iModOrder) - iMod = iModOrder(i) - if (iMod == 0) cycle - call FAST_GetOP(m%ModDataAry(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & - u_op=m%ModDataAry(iMod)%Lin%u, x_op=m%ModDataAry(iMod)%Lin%x) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, m%ModDataAry(iMod)%Lin%x, m%AM%Mod%Lin%x) - end do ! Remove conditioning from solution vector ! Add change in inputs to current inputs - call MV_AddDelta(m%AM%Mod%Vars%u, delta(m%AM%Mod%Vars%Nx + 1:), m%AM%u1) + call MV_AddDelta(AM%Mod%Vars%u, delta(AM%Mod%Vars%Nx + 1:), AM%u1) ! Add change in continuous states to current states - call MV_AddDelta(m%AM%Mod%Vars%x, delta(:m%AM%Mod%Vars%Nx), m%AM%Mod%Lin%x) + call MV_AddDelta(AM%Mod%Vars%x, delta(:AM%Mod%Vars%Nx), AM%Mod%Lin%x) ! Update states and inputs in module - do i = 1, size(iModOrder) - iMod = iModOrder(i) - if (iMod == 0) cycle - call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%x, m%ModDataAry(iMod)%Lin%x, m%AM%Mod%Lin%x) - call ModD_UnpackAry(m%AM%Mod%Xfr(iMod)%u, m%ModDataAry(iMod)%Lin%u, m%AM%u1) - - select case (m%ModDataAry(iMod)%ID) - case (Module_ED) - ! Copy blade1 flap and edge states to other blades - do j = 2, T%ED%p%NumBl - associate (Var1 => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(1)), & - VarN => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeFlap1(j))) - m%ModDataAry(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%ModDataAry(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) - end associate - associate (Var1 => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(1)), & - VarN => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeEdge1(j))) - m%ModDataAry(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%ModDataAry(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) - end associate - associate (Var1 => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(1)), & - VarN => m%ModDataAry(iMod)%Vars%x(T%ED%p%iVarBladeFlap2(j))) - m%ModDataAry(iMod)%Lin%x(VarN%iLoc(1):VarN%iLoc(2)) = m%ModDataAry(iMod)%Lin%x(Var1%iLoc(1):Var1%iLoc(2)) - end associate - end do - case (Module_BD) - ! TODO: Copy B1 states to other blades - end select + do i = 1, size(AM%Mod%ModDataAry) + associate (ModData => AM%Mod%ModDataAry(i)) - ! Populate values in module - call FAST_SetOP(m%ModDataAry(iMod), SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & - u_op=m%ModDataAry(iMod)%Lin%u, x_op=m%ModDataAry(iMod)%Lin%x) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + ! Populate input and state values in module + call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=AM%u1, & + x_op=ModData%Lin%x, x_glue=AM%Mod%Lin%x) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Transfer results from blade 1 to other blades - if (m%AM%iModBD > 0) then - ! BeamDyn - call SS_BD_InputSolve_OtherBlades(m, INPUT_CURR, T) - else - ! ElastoDyn - call SS_ED_InputSolve_OtherBlades(m, INPUT_CURR, T) - end if - call SS_AD_InputSolve_OtherBlades(m, INPUT_CURR, T) + ! Select based on module + select case (ModData%ID) + case (Module_ED) + + ! Copy blade1 flap and edge states to other blades + do j = 2, T%ED%p%NumBl + T%ED%x(STATE_CURR)%QT(DOF_BF(j, 1)) = T%ED%x(STATE_CURR)%QT(DOF_BF(1, 1)) + T%ED%x(STATE_CURR)%QT(DOF_BF(j, 2)) = T%ED%x(STATE_CURR)%QT(DOF_BF(1, 2)) + T%ED%x(STATE_CURR)%QT(DOF_BE(j, 1)) = T%ED%x(STATE_CURR)%QT(DOF_BE(1, 1)) + end do + + ! Set velocities to zero + do j = 1, T%ED%p%NumBl + T%ED%x(STATE_CURR)%QDT(DOF_BF(j, 1)) = 0.0_R8Ki + T%ED%x(STATE_CURR)%QDT(DOF_BF(j, 2)) = 0.0_R8Ki + T%ED%x(STATE_CURR)%QDT(DOF_BE(j, 1)) = 0.0_R8Ki + end do + + ! Transfer loads from ED blade 1 to other blades + call SS_ED_InputSolve_OtherBlades(AM, INPUT_CURR, T) + + case (Module_BD) + ! TODO: Copy B1 states to other blades + + ! Transfer loads from BD blade 1 to other blades + call SS_BD_InputSolve_OtherBlades(AM, INPUT_CURR, T) + + case (Module_AD) + + ! Transfer AD blade 1 motion to other blades + call SS_AD_InputSolve_OtherBlades(AM, INPUT_CURR, T) + + end select + end associate + end do end subroutine -subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables - type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - type(FAST_ParameterType), intent(IN) :: p_FAST !< Parameters for the glue code - type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Output variables for the glue code - type(FAST_MiscVarType), intent(INOUT) :: m_FAST !< Miscellaneous variables - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation - character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None +subroutine SS_BuildJacobian(AM, caseData, Mappings, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap module + type(MappingType), intent(inout) :: Mappings(:) !< Module mapping + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + type(FAST_ParameterType), intent(IN) :: p_FAST !< Parameters for the glue code + type(FAST_OutputFileType), intent(INOUT) :: y_FAST !< Output variables for the glue code + type(FAST_MiscVarType), intent(INOUT) :: m_FAST !< Miscellaneous variables + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None character(*), parameter :: RoutineName = 'SS_BuildJacobian' integer(IntKi) :: ErrStat2 @@ -721,7 +692,7 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ErrMsg = "" ! Set number of states - nx = m%AM%Mod%Vars%Nx + nx = AM%Mod%Vars%Nx ! If output debugging is requested if (output_debugging) then @@ -731,8 +702,8 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err if (Failed()) return ! Build linearization root name - m%AM%LinFileNum = m%AM%LinFileNum + 1 - LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(m%AM%LinFileNum)) + AM%LinFileNum = AM%LinFileNum + 1 + LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(AM%LinFileNum)) ! These values get printed in the linearization output files, so we'll set them here: y_FAST%Lin%WindSpeed = caseData%WindSpeed @@ -741,30 +712,32 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err end if ! Initialize Jacobian - m%AM%Mod%Lin%J = 0.0_R8Ki + AM%Mod%Lin%J = 0.0_R8Ki !---------------------------------------------------------------------------- ! dXdy !---------------------------------------------------------------------------- - m%AM%Mod%Lin%dXdy = 0.0_R8Ki + AM%Mod%Lin%dXdy = 0.0_R8Ki !---------------------------------------------------------------------------- ! Module Jacobians !---------------------------------------------------------------------------- ! Loop through modules - do i = 1, size(m%AM%iModOrder) - associate (ModData => m%ModDataAry(m%AM%iModOrder(i)), iMod => m%AM%iModOrder(i)) + do i = 1, size(AM%Mod%ModDataAry) + associate (ModData => AM%Mod%ModDataAry(i)) ! Calculate dYdu and dXdu call FAST_JacobianPInput(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & - FlagFilter=VF_AeroMap, dYdu=ModData%Lin%dYdu, dXdu=ModData%Lin%dXdu) + dYdu=ModData%Lin%dYdu, dYduGlue=AM%Mod%Lin%dYdu, & + dXdu=ModData%Lin%dXdu, dXduGlue=AM%Mod%Lin%dXdu) if (Failed()) return ! Calculate dYdx and dXdx call FAST_JacobianPContState(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & - FlagFilter=VF_AeroMap, dYdx=ModData%Lin%dYdx, dXdx=ModData%Lin%dXdx) + dYdx=ModData%Lin%dYdx, dYdxGlue=AM%Mod%Lin%dYdx, & + dXdx=ModData%Lin%dXdx, dXdxGlue=AM%Mod%Lin%dXdx) if (Failed()) return ! If output debugging requested @@ -772,19 +745,17 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! Calculate operating point values call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & - FlagFilter=VF_AeroMap, u_op=ModData%Lin%u, y_op=ModData%Lin%y, x_op=ModData%Lin%x, dx_op=ModData%Lin%dx) + u_op=ModData%Lin%u, u_glue=AM%Mod%Lin%u, & + y_op=ModData%Lin%y, y_glue=AM%Mod%Lin%y, & + x_op=ModData%Lin%x, x_glue=AM%Mod%Lin%x, & + dx_op=ModData%Lin%dx, dx_glue=AM%Mod%Lin%dx) if (Failed()) return ! Write linearization matrices - call CalcWriteLinearMatrices(ModData, p_FAST, y_FAST, SS_t_global, Un, LinRootName, VF_AeroMap, .false., ErrStat2, ErrMsg2) + call CalcWriteLinearMatrices(ModData%Vars, ModData%Lin, p_FAST, y_FAST, SS_t_global, Un, & + LinRootName, VF_AeroMap, ErrStat2, ErrMsg2, ModData%Abbr) if (Failed()) return - ! Pack values into module - if (allocated(ModData%Lin%x)) call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, ModData%Lin%x, m%AM%Mod%Lin%x) - if (allocated(ModData%Lin%dx)) call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, ModData%Lin%dx, m%AM%Mod%Lin%dx) - if (allocated(ModData%Lin%u)) call ModD_PackAry(m%AM%Mod%Xfr(iMod)%u, ModData%Lin%u, m%AM%Mod%Lin%u) - if (allocated(ModData%Lin%y)) call ModD_PackAry(m%AM%Mod%Xfr(iMod)%y, ModData%Lin%y, m%AM%Mod%Lin%y) - end if ! If this module is BeamDyn, calculate dxdotdy @@ -808,12 +779,6 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! end do end if - ! Add module Jacobians to global Jacobians - if (allocated(ModData%Lin%dYdu)) call ModD_PackMatrix(m%AM%Mod%Xfr(iMod)%y, m%AM%Mod%Xfr(iMod)%u, ModData%Lin%dYdu, m%AM%Mod%Lin%dYdu) - if (allocated(ModData%Lin%dXdu)) call ModD_PackMatrix(m%AM%Mod%Xfr(iMod)%x, m%AM%Mod%Xfr(iMod)%u, ModData%Lin%dXdu, m%AM%Mod%Lin%dXdu) - if (allocated(ModData%Lin%dYdx)) call ModD_PackMatrix(m%AM%Mod%Xfr(iMod)%y, m%AM%Mod%Xfr(iMod)%x, ModData%Lin%dYdx, m%AM%Mod%Lin%dYdx) - if (allocated(ModData%Lin%dXdx)) call ModD_PackMatrix(m%AM%Mod%Xfr(iMod)%x, m%AM%Mod%Xfr(iMod)%x, ModData%Lin%dXdx, m%AM%Mod%Lin%dXdx) - end associate end do @@ -821,10 +786,9 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! Glue Jacobians !---------------------------------------------------------------------------- - m%AM%Mod%Lin%dUdy = 0.0_R8Ki - call Eye2D(m%AM%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_LinearizeMappings(T, m%ModDataAry, m%Mappings, m%AM%iModOrder, m%AM%Mod%Xfr, ErrStat2, ErrMsg2, & - m%AM%Mod%Lin%dUdu, m%AM%Mod%Lin%dUdy) + AM%Mod%Lin%dUdy = 0.0_R8Ki + call Eye2D(AM%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_LinearizeMappings(AM%Mod, Mappings, T, ErrStat2, ErrMsg2) if (Failed()) return !---------------------------------------------------------------------------- @@ -832,33 +796,34 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err !---------------------------------------------------------------------------- ! Calculate Jacobian block 11 = dX/dx - dX/dy * dY/dx - m%AM%Jac11 = m%AM%Mod%Lin%dXdx - call LAPACK_GEMM('N', 'N', -1.0_R8Ki, m%AM%Mod%Lin%dXdy, m%AM%Mod%Lin%dYdx, 1.0_R8Ki, m%AM%Jac11, ErrStat2, ErrMsg2) + AM%Jac11 = AM%Mod%Lin%dXdx + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, AM%Mod%Lin%dXdy, AM%Mod%Lin%dYdx, 1.0_R8Ki, AM%Jac11, ErrStat2, ErrMsg2) if (Failed()) return ! Calculate Jacobian block 12 = dX/du - dX/dy * dY/du - m%AM%Jac12 = m%AM%Mod%Lin%dXdu - call LAPACK_GEMM('N', 'N', -1.0_R8Ki, m%AM%Mod%Lin%dXdy, m%AM%Mod%Lin%dYdu, 1.0_R8Ki, m%AM%Jac12, ErrStat2, ErrMsg2) + AM%Jac12 = AM%Mod%Lin%dXdu + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, AM%Mod%Lin%dXdy, AM%Mod%Lin%dYdu, 1.0_R8Ki, AM%Jac12, ErrStat2, ErrMsg2) if (Failed()) return ! Calculate Jacobian block 21 = dU/dy * dY/dx - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%AM%Mod%Lin%dUdy, m%AM%Mod%Lin%dYdx, 0.0_R8Ki, m%AM%Jac21, ErrStat2, ErrMsg2) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, AM%Mod%Lin%dUdy, AM%Mod%Lin%dYdx, 0.0_R8Ki, AM%Jac21, ErrStat2, ErrMsg2) if (Failed()) return ! Calculate Jacobian block 22 = dU/du + dU/dy * dY/du - m%AM%Jac22 = m%AM%Mod%Lin%dUdu - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%AM%Mod%Lin%dUdy, m%AM%Mod%Lin%dYdu, 1.0_R8Ki, m%AM%Jac22, ErrStat2, ErrMsg2) + AM%Jac22 = AM%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, AM%Mod%Lin%dUdy, AM%Mod%Lin%dYdu, 1.0_R8Ki, AM%Jac22, ErrStat2, ErrMsg2) if (Failed()) return ! Assemble blocks to form full Jacobian - m%AM%Mod%Lin%J(:nx, :nx) = m%AM%Jac11 - m%AM%Mod%Lin%J(:nx, nx + 1:) = m%AM%Jac12 - m%AM%Mod%Lin%J(nx + 1:, :nx) = m%AM%Jac21 - m%AM%Mod%Lin%J(nx + 1:, nx + 1:) = m%AM%Jac22 + AM%Mod%Lin%J(:nx, :nx) = AM%Jac11 + AM%Mod%Lin%J(:nx, nx + 1:) = AM%Jac12 + AM%Mod%Lin%J(nx + 1:, :nx) = AM%Jac21 + AM%Mod%Lin%J(nx + 1:, nx + 1:) = AM%Jac22 ! If output debugging is enabled, write combined matrices and Jacobian if (output_debugging) then - call CalcWriteLinearMatrices(m%AM%Mod, p_FAST, y_FAST, SS_t_global, Un, LinRootName, VF_AeroMap, .false., ErrStat2, ErrMsg2) + call CalcWriteLinearMatrices(AM%Mod%Vars, AM%Mod%Lin, p_FAST, y_FAST, SS_t_global, Un, & + LinRootName, VF_AeroMap, ErrStat2, ErrMsg2, CalcGlue=.false.) if (Failed()) return end if @@ -866,35 +831,35 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! Condition Jacobian matrix !---------------------------------------------------------------------------- - ! Note: m%AM%JacScale is a scaling factor that gets similar magnitudes between loads and accelerations... + ! Note: AM%JacScale is a scaling factor that gets similar magnitudes between loads and accelerations... - associate (J => m%AM%Mod%Lin%J) + associate (J => AM%Mod%Lin%J) ! Loop through inputs - do r = 1, size(m%AM%Mod%Vars%u) - iLoc = m%AM%Mod%Vars%u(r)%iLoc + nx - if (MV_IsLoad(m%AM%Mod%Vars%u(r))) then + do r = 1, size(AM%Mod%Vars%u) + iLoc = AM%Mod%Vars%u(r)%iLoc + nx + if (MV_IsLoad(AM%Mod%Vars%u(r))) then ! Column is motion (state), row is load - J(iLoc(1):iLoc(2), 1:nx) = J(iLoc(1):iLoc(2), 1:nx)/m%AM%JacScale + J(iLoc(1):iLoc(2), 1:nx) = J(iLoc(1):iLoc(2), 1:nx)/AM%JacScale ! Row is motion (state), column is load - J(1:nx, iLoc(1):iLoc(2)) = J(1:nx, iLoc(1):iLoc(2))*m%AM%JacScale + J(1:nx, iLoc(1):iLoc(2)) = J(1:nx, iLoc(1):iLoc(2))*AM%JacScale end if end do ! Loop through input vars as columns - do c = 1, size(m%AM%Mod%Vars%u) - iCol = m%AM%Mod%Vars%u(c)%iLoc + nx - ColIsLoad = MV_IsLoad(m%AM%Mod%Vars%u(c)) + do c = 1, size(AM%Mod%Vars%u) + iCol = AM%Mod%Vars%u(c)%iLoc + nx + ColIsLoad = MV_IsLoad(AM%Mod%Vars%u(c)) ! Loop through input vars as rows - do r = 1, size(m%AM%Mod%Vars%u) - iRow = m%AM%Mod%Vars%u(r)%iLoc + nx - RowIsLoad = MV_IsLoad(m%AM%Mod%Vars%u(r)) + do r = 1, size(AM%Mod%Vars%u) + iRow = AM%Mod%Vars%u(r)%iLoc + nx + RowIsLoad = MV_IsLoad(AM%Mod%Vars%u(r)) if ((.not. RowIsLoad) .and. ColIsLoad) then ! Row is a motion, Col is a load - J(iRow(1):iRow(2), iCol(1):iCol(2)) = J(iRow(1):iRow(2), iCol(1):iCol(2))*m%AM%JacScale + J(iRow(1):iRow(2), iCol(1):iCol(2)) = J(iRow(1):iRow(2), iCol(1):iCol(2))*AM%JacScale else if (RowIsLoad .and. (.not. ColIsLoad)) then ! Row is a load, Col is a motion - J(iRow(1):iRow(2), iCol(1):iCol(2)) = J(iRow(1):iRow(2), iCol(1):iCol(2))/m%AM%JacScale + J(iRow(1):iRow(2), iCol(1):iCol(2)) = J(iRow(1):iRow(2), iCol(1):iCol(2))/AM%JacScale end if end do end do @@ -907,8 +872,8 @@ subroutine SS_BuildJacobian(m, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, Err ! The result is of the form Jmat = P * L * U !---------------------------------------------------------------------------- - call LAPACK_getrf(M=size(m%AM%Mod%Lin%J, 1), N=size(m%AM%Mod%Lin%J, 2), & - A=m%AM%Mod%Lin%J, IPIV=m%AM%JacPivot, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call LAPACK_getrf(M=size(AM%Mod%Lin%J, 1), N=size(AM%Mod%Lin%J, 2), & + A=AM%Mod%Lin%J, IPIV=AM%JacPivot, ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return contains @@ -925,9 +890,10 @@ end subroutine Cleanup end subroutine SS_BuildJacobian -subroutine SS_BuildResidual(caseData, m, T, ErrStat, ErrMsg) +subroutine SS_BuildResidual(AM, caseData, Mappings, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data type(AeroMapCase), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables + type(MappingType), intent(inout) :: Mappings(:) !< Module mapping type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -937,33 +903,39 @@ subroutine SS_BuildResidual(caseData, m, T, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j, iVarMod(2), iVarGbl(2) - integer, parameter :: InputIndex = INPUT_PREV integer, parameter :: StateIndex = STATE_PRED ErrStat = ErrID_None ErrMsg = "" - !note: prescribed inputs are already set in both InputIndex=1 and InputIndex=2 so we can ignore them here - ! Use current inputs to calculate CCSD in STATE_PRED - call SS_CalcContStateDeriv(m, caseData, INPUT_CURR, m%AM%Residual, T, ErrStat2, ErrMsg2) - call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Pointers to parts of residual array + associate (xResidual => AM%Residual(:AM%Mod%Vars%Nx), & ! States residual + uResidual => AM%Residual(AM%Mod%Vars%Nx + 1:)) ! Inputs residual - ! note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the SS_GetInputs - call SS_GetCalculatedInputs(m, InputIndex, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 - call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Note: prescribed inputs are already set in both INPUT_CURR and INPUT_PREV so we can ignore them here + call SS_CalcContStateDeriv(AM, caseData, INPUT_CURR, xResidual, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Calculate difference between prescribed and calculated inputs - call MV_ComputeDiff(m%AM%Mod%Vars%u, m%AM%u1, m%AM%u2, m%AM%Residual(m%AM%Mod%Vars%Nx + 1:)) + ! Note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the SS_GetInputs + call SS_GetCalculatedInputs(AM, AM%u2, Mappings, INPUT_PREV, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Condition residual for solve - call PreconditionInputResidual(m%AM%Residual(m%AM%Mod%Vars%Nx + 1:), m%AM%JacScale) + ! call PreconditionInputResidual(AM%u1, AM%JacScale) + ! call PreconditionInputResidual(AM%u2, AM%JacScale) + + ! Calculate difference between prescribed and calculated inputs + call MV_ComputeDiff(AM%Mod%Vars%u, AM%u1, AM%u2, uResidual) + + ! Condition residual for solve + call PreconditionInputResidual(uResidual, AM%JacScale) + end associate contains subroutine PreconditionInputResidual(u_residual, JacScale) real(R8Ki), intent(inout) :: u_residual(:) real(R8Ki), intent(in) :: JacScale - do i = 1, size(m%AM%Mod%Vars%u) - associate (Var => m%AM%Mod%Vars%u(i)) + do i = 1, size(AM%Mod%Vars%u) + associate (Var => AM%Mod%Vars%u(i)) if (MV_IsLoad(Var)) then u_residual(Var%iLoc(1):Var%iLoc(2)) = u_residual(Var%iLoc(1):Var%iLoc(2))/JacScale end if @@ -974,79 +946,42 @@ subroutine PreconditionInputResidual(u_residual, JacScale) !------------------------------------------------------------------------------- -!> SS_BD_InputSolve sets the blade load inputs required for BD. -subroutine SS_BD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables - integer(IntKi), intent(in) :: InputIndex !< Input index to transfer - type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type - integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation - character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - character(*), parameter :: RoutineName = 'SS_BD_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - call FAST_InputSolve(m%ModDataAry(m%AM%iModBD), m%ModDataAry, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - !> SS_BD_InputSolve_OtherBlades sets the blade-load ElastoDyn inputs from blade 1 to the other blades. -subroutine SS_BD_InputSolve_OtherBlades(m, InputIndex, T) - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables +subroutine SS_BD_InputSolve_OtherBlades(AM, InputIndex, T) + type(Glue_AeroMap), intent(in) :: AM !< AeroMap data integer(IntKi), intent(in) :: InputIndex !< Input index to transfer type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type integer(IntKi) :: j, k do k = 2, T%p_FAST%nBeams do j = 1, T%BD%Input(InputIndex, k)%DistrLoad%NNodes - T%BD%Input(InputIndex, k)%DistrLoad%Force(:, j) = matmul(T%BD%Input(InputIndex, 1)%DistrLoad%Force(:, j), m%AM%HubOrientation(:, :, k)) - T%BD%Input(InputIndex, k)%DistrLoad%Moment(:, j) = matmul(T%BD%Input(InputIndex, 1)%DistrLoad%Moment(:, j), m%AM%HubOrientation(:, :, k)) + T%BD%Input(InputIndex, k)%DistrLoad%Force(:, j) = matmul(T%BD%Input(InputIndex, 1)%DistrLoad%Force(:, j), AM%HubOrientation(:, :, k)) + T%BD%Input(InputIndex, k)%DistrLoad%Moment(:, j) = matmul(T%BD%Input(InputIndex, 1)%DistrLoad%Moment(:, j), AM%HubOrientation(:, :, k)) end do end do end subroutine -!> This routine sets the blade load inputs required for ED. -subroutine SS_ED_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables - integer(IntKi), intent(in) :: InputIndex !< Input index to transfer - type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type - integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation - character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - character(*), parameter :: RoutineName = 'SS_ED_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - call FAST_InputSolve(m%ModDataAry(m%AM%iModED), m%ModDataAry, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - !> SS_ED_InputSolve_OtherBlades sets the blade-load ElastoDyn inputs from blade 1 to the other blades. -subroutine SS_ED_InputSolve_OtherBlades(m, InputIndex, T) - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables +subroutine SS_ED_InputSolve_OtherBlades(AM, InputIndex, T) + type(Glue_AeroMap), intent(in) :: AM !< AeroMap data integer(IntKi), intent(in) :: InputIndex !< Input index to transfer - type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi) :: j, k associate (BladePtLoads => T%ED%Input(InputIndex)%BladePtLoads) do k = 2, size(BladePtLoads, 1) do j = 1, BladePtLoads(k)%NNodes - BladePtLoads(k)%Force(:, j) = matmul(BladePtLoads(1)%Force(:, j), m%AM%HubOrientation(:, :, k)) - BladePtLoads(k)%Moment(:, j) = matmul(BladePtLoads(1)%Moment(:, j), m%AM%HubOrientation(:, :, k)) + BladePtLoads(k)%Force(:, j) = matmul(BladePtLoads(1)%Force(:, j), AM%HubOrientation(:, :, k)) + BladePtLoads(k)%Moment(:, j) = matmul(BladePtLoads(1)%Moment(:, j), AM%HubOrientation(:, :, k)) end do end do end associate end subroutine !> SS_AD_InputSolve sets the blade-motion AeroDyn inputs for Blade 1. -subroutine SS_AD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables +subroutine SS_AD_InputSolve(AM, Mappings, InputIndex, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(MappingType), intent(inout) :: Mappings(:) !< Module mapping integer(IntKi), intent(in) :: InputIndex !< Input index to transfer - type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -1058,7 +993,7 @@ subroutine SS_AD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) ErrMsg = "" ! Get blade motion inputs - call FAST_InputSolve(m%ModDataAry(m%AM%iModAD), m%ModDataAry, m%Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call FAST_InputSolve(AM%Mod%ModDataAry(2), AM%Mod%ModDataAry, Mappings, InputIndex, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Set prescribed values for first blade @@ -1068,34 +1003,34 @@ subroutine SS_AD_InputSolve(m, InputIndex, T, ErrStat, ErrMsg) end subroutine !> SS_AD_InputSolve_OtherBlades sets the blade-motion AeroDyn inputs. -subroutine SS_AD_InputSolve_OtherBlades(m, InputIndex, T) - type(Glue_MiscVarType), intent(INOUT) :: m !< Miscellaneous variables +subroutine SS_AD_InputSolve_OtherBlades(AM, InputIndex, T) + type(Glue_AeroMap), intent(in) :: AM !< AeroMap data integer(IntKi), intent(in) :: InputIndex !< Input index to transfer type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type integer(IntKi) :: j, k associate (BladeMotion => T%AD%Input(InputIndex)%rotors(1)%BladeMotion) do k = 2, size(BladeMotion, 1) do j = 1, BladeMotion(k)%NNodes - BladeMotion(k)%TranslationDisp(:, j) = matmul(BladeMotion(1)%TranslationDisp(:, j), m%AM%HubOrientation(:, :, k)) - BladeMotion(k)%Orientation(:, :, j) = matmul(BladeMotion(1)%Orientation(:, :, j), m%AM%HubOrientation(:, :, k)) - BladeMotion(k)%TranslationVel(:, j) = matmul(BladeMotion(1)%TranslationVel(:, j), m%AM%HubOrientation(:, :, k)) + BladeMotion(k)%TranslationDisp(:, j) = matmul(BladeMotion(1)%TranslationDisp(:, j), AM%HubOrientation(:, :, k)) + BladeMotion(k)%Orientation(:, :, j) = matmul(BladeMotion(1)%Orientation(:, :, j), AM%HubOrientation(:, :, k)) + BladeMotion(k)%TranslationVel(:, j) = matmul(BladeMotion(1)%TranslationVel(:, j), AM%HubOrientation(:, :, k)) end do end do end associate end subroutine -subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, dx_vec, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables - type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - integer(IntKi), intent(in) :: InputIndex !< Index into input array - real(R8Ki), intent(inout) :: dx_vec(:) !< continuous state derivative vector - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat !< Error status - character(*), intent(out) :: ErrMsg !< Error message +subroutine SS_CalcContStateDeriv(AM, caseData, InputIndex, dxAry, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + integer(IntKi), intent(in) :: InputIndex !< Index into input array + real(R8Ki), intent(inout) :: dxAry(:) !< continuous state derivative vector + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message character(*), parameter :: RoutineName = 'SS_CalcContStateDeriv' - integer(IntKi) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None integer(IntKi) :: i, k integer(IntKi) :: BldMeshNode real(R8Ki) :: Omega_Hub(3) @@ -1105,28 +1040,21 @@ subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, dx_vec, T, ErrStat, Er ErrStat = ErrID_None ErrMsg = "" + ! Get the structural continuous state derivative + call FAST_GetOP(AM%Mod%ModDataAry(1), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & + dx_op=AM%Mod%ModDataAry(1)%Lin%dx, dx_glue=dxAry) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Select based on which module is simulating the blades - select case (T%p_FAST%CompElast) + select case (AM%Mod%ModDataAry(1)%ID) case (Module_ED) ! ElastoDyn - call FAST_GetOP(m%ModDataAry(m%AM%iModED), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & - FlagFilter=VF_AeroMap, dx_op=m%ModDataAry(m%AM%iModED)%Lin%dx) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%ModDataAry(m%AM%iModED)%Lin%dx, dx_vec) - case (Module_BD) ! BeamDyn ! Set hub rotation speed Omega_Hub = [real(caseData%RotSpeed, R8Ki), 0.0_R8Ki, 0.0_R8Ki] - call FAST_GetOP(m%ModDataAry(m%AM%iModBD), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & - FlagFilter=VF_AeroMap, dx_op=m%ModDataAry(m%AM%iModBD)%Lin%dx) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call ModD_PackAry(m%AM%Mod%Xfr(m%AM%iModED)%x, m%ModDataAry(m%AM%iModED)%Lin%dx, dx_vec) - ! TODO: Make this work for BeamDyn ! do K = 1, T%p_FAST%nBeams @@ -1152,9 +1080,9 @@ subroutine SS_CalcContStateDeriv(m, caseData, InputIndex, dx_vec, T, ErrStat, Er end subroutine -subroutine SS_GetStates(m, x_vec, StateIndex, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(inout) :: m !< Glue-code simulation parameters - real(R8Ki), intent(inout) :: x_vec(:) !< Array of input packed values +subroutine SS_GetStates(AM, xAry, StateIndex, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + real(R8Ki), intent(inout) :: xAry(:) !< Array of input packed values integer(IntKi), intent(in) :: StateIndex !< State array index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat !< Error status of the operation @@ -1163,33 +1091,16 @@ subroutine SS_GetStates(m, x_vec, StateIndex, T, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SS_GetStates' integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: i, j, k - integer(IntKi) :: iModOrder(3), iMod - - iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] + integer(IntKi) :: i ErrStat = ErrID_None ErrMsg = '' - ! Loop through modules - do i = 1, size(iModOrder) - iMod = iModOrder(i) - - ! Skip inactive modules - if (iMod == 0) cycle - - ! If no inputs for this module, cycle - if (.not. allocated(m%AM%Mod%Xfr(iMod)%x)) cycle - - associate (ModData => m%ModDataAry(iMod)) - - ! Get states and outputs - call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, StateIndex, T, ErrStat2, ErrMsg2, x_op=ModData%Lin%x) + ! Loop through modules and get AeroMap states + do i = 1, size(AM%Mod%ModDataAry) + associate (ModData => AM%Mod%ModDataAry(i)) + call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, StateIndex, T, ErrStat2, ErrMsg2, x_op=ModData%Lin%x, x_glue=xAry) if (Failed()) return - - ! Pack data into vector - call ModD_PackAry(m%AM%Mod%Xfr(iMod)%x, ModData%Lin%x, x_vec) - end associate end do @@ -1201,42 +1112,25 @@ logical function Failed() end subroutine !> SS_GetInputs packs the relevant parts of the modules' inputs for use in the steady-state solver. -subroutine SS_GetInputs(m, u_vec, InputIndex, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(inout) :: m !< Glue-code simulation parameters - real(R8Ki), intent(inout) :: u_vec(:) !< Array of input packed values +subroutine SS_GetInputs(AM, uAry, InputIndex, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap module + real(R8Ki), intent(inout) :: uAry(:) !< Array of input packed values integer(IntKi), intent(in) :: InputIndex !< Input array index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'SS_GetInputs' - integer(IntKi) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: i, iMod, iModOrder(3) - - iModOrder = [m%AM%iModED, m%AM%iModBD, m%AM%iModAD] - - ! Loop through modules - do i = 1, size(iModOrder) - iMod = iModOrder(i) - - ! Skip inactive modules - if (iMod == 0) cycle + character(*), parameter :: RoutineName = 'SS_GetInputs' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i - ! If no inputs for this module, cycle - if (.not. allocated(m%AM%Mod%Xfr(iMod)%u)) cycle - - associate (ModData => m%ModDataAry(iMod)) - - ! Get states and outputs - call FAST_GetOP(ModData, SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, u_op=ModData%Lin%u) + ! Loop through modules and get inputs + do i = 1, size(AM%Mod%ModDataAry) + associate (ModData => AM%Mod%ModDataAry(i)) + call FAST_GetOP(ModData, SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, u_op=ModData%Lin%u, u_glue=uAry) if (Failed()) return - - ! Pack data into vector - call ModD_PackAry(m%AM%Mod%Xfr(iMod)%u, ModData%Lin%u, u_vec) - end associate - end do contains @@ -1246,36 +1140,39 @@ logical function Failed() end function end subroutine -subroutine SS_GetCalculatedInputs(m, InputIndex, T, ErrStat, ErrMsg) - type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables - integer(IntKi), intent(in) :: InputIndex !< Index into input array - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat !< Error status - character(*), intent(out) :: ErrMsg !< Error message +subroutine SS_GetCalculatedInputs(AM, uAry, Mappings, InputIndex, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap module + real(R8Ki), intent(inout) :: uAry(:) !< Inputs + type(MappingType), intent(inout) :: Mappings(:) !< Transfer mapping data + integer(IntKi), intent(in) :: InputIndex !< Index into input array + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message character(*), parameter :: RoutineName = 'SS_GetCalculatedInputs' - integer(IntKi) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None ErrStat = ErrID_None ErrMsg = "" ! Transfer motions to AeroDyn first - call SS_AD_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_AD_InputSolve(AM, Mappings, InputIndex, T, ErrStat2, ErrMsg2) + if (Failed()) return ! Transfer loads to structural solver next - if (m%AM%iModBD > 0) then - call SS_BD_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - else if (m%AM%iModED > 0) then - call SS_ED_InputSolve(m, InputIndex, T, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if + call FAST_InputSolve(AM%Mod%ModDataAry(1), AM%Mod%ModDataAry, Mappings, InputIndex, T, ErrStat2, ErrMsg2) + if (Failed()) return ! Pack the transferred inputs into the vector - call SS_GetInputs(m, m%AM%u2, InputIndex, T, ErrStat2, ErrMsg2) + call SS_GetInputs(AM, uAry, InputIndex, T, ErrStat2, ErrMsg2) + if (Failed()) return +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function end subroutine subroutine SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 7bac60ab05..2b898a6238 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -521,6 +521,7 @@ subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, E subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, & u_op, y_op, x_op, dx_op, z_op, u_glue, y_glue, x_glue, dx_glue, z_glue) + use AeroDyn, only: AD_CalcWind_Rotor type(ModDataType), intent(in) :: ModData !< Module information real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: InputIndex !< Input index @@ -528,11 +529,16 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - real(R8Ki), allocatable, optional, intent(inout) :: u_op(:), u_glue(:) !< values of linearized inputs - real(R8Ki), allocatable, optional, intent(inout) :: y_op(:), y_glue(:) !< values of linearized outputs - real(R8Ki), allocatable, optional, intent(inout) :: x_op(:), x_glue(:) !< values of linearized continuous states - real(R8Ki), allocatable, optional, intent(inout) :: dx_op(:), dx_glue(:) !< values of first time derivatives of linearized continuous states - real(R8Ki), allocatable, optional, intent(inout) :: z_op(:), z_glue(:) !< values of linearized constraint states + real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs + real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states + real(R8Ki), optional, intent(inout) :: u_glue(:) + real(R8Ki), optional, intent(inout) :: y_glue(:) + real(R8Ki), optional, intent(inout) :: x_glue(:) + real(R8Ki), optional, intent(inout) :: dx_glue(:) + real(R8Ki), optional, intent(inout) :: z_glue(:) character(*), parameter :: RoutineName = 'FAST_GetOP' integer(IntKi) :: ErrStat2 @@ -543,7 +549,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err ErrMsg = '' ! If inputs are requested - if (present(u_op)) then + if (present(u_op) .and. (ModData%Vars%Nu > 0)) then if (.not. allocated(u_op)) then call AllocAry(u_op, ModData%Vars%Nu, "u_op", ErrStat2, ErrMsg2) @@ -597,7 +603,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end if ! If outputs are requested - if (present(y_op)) then + if (present(y_op) .and. (ModData%Vars%Ny > 0)) then if (.not. allocated(y_op)) then call AllocAry(y_op, ModData%Vars%Ny, "y_op", ErrStat2, ErrMsg2) @@ -649,7 +655,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end if ! If continuous states are requested - if (present(x_op)) then + if (present(x_op) .and. (ModData%Vars%Nx > 0)) then if (.not. allocated(x_op)) then call AllocAry(x_op, ModData%Vars%Nx, "x_op", ErrStat2, ErrMsg2) @@ -700,7 +706,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err end if ! If continuous state derivatives are requested - if (present(dx_op)) then + if (present(dx_op) .and. (ModData%Vars%Nx > 0)) then if (.not. allocated(dx_op)) then call AllocAry(dx_op, ModData%Vars%Nx, "dx_op", ErrStat2, ErrMsg2) @@ -710,17 +716,25 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err ! Select based on module ID select case (ModData%ID) case (Module_AD) + i = 1 + call AD_CalcWind_Rotor(ThisTime, T%AD%Input(InputIndex)%rotors(ModData%Ins), & + T%AD%p%FlowField, T%AD%p%rotors(ModData%Ins), & + T%AD%m%Inflow(InputIndex)%RotInflow(ModData%Ins), & + i, ErrStat2, ErrMsg2) + if (Failed()) return call RotCalcContStateDeriv(ThisTime, T%AD%Input(InputIndex)%rotors(ModData%Ins), & T%AD%m%Inflow(InputIndex)%RotInflow(ModData%Ins), & - T%AD%p%rotors(ModData%Ins), & - T%AD%p, T%AD%x(StateIndex)%rotors(ModData%Ins), & + T%AD%p%rotors(ModData%Ins), T%AD%p, & + T%AD%x(StateIndex)%rotors(ModData%Ins), & T%AD%xd(StateIndex)%rotors(ModData%Ins), & T%AD%z(StateIndex)%rotors(ModData%Ins), & T%AD%OtherSt(StateIndex)%rotors(ModData%Ins), & T%AD%m%rotors(ModData%Ins), & T%AD%m%rotors(ModData%Ins)%dxdt_lin, & - ErrStat2, ErrMsg2); if (Failed()) return + ErrStat2, ErrMsg2) + if (Failed()) return call AD_PackContStateDerivAry(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) + case (Module_BD) call BD_CalcContStateDeriv(ThisTime, T%BD%Input(InputIndex, ModData%Ins), & T%BD%p(ModData%Ins), & @@ -730,13 +744,17 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err T%BD%OtherSt(ModData%Ins, StateIndex), & T%BD%m(ModData%Ins), & T%BD%m(ModData%Ins)%dxdt_lin, & - ErrStat2, ErrMsg2); if (Failed()) return + ErrStat2, ErrMsg2) + if (Failed()) return call BD_PackContStateDerivAry(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) + case (Module_ED) call ED_CalcContStateDeriv(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), & T%ED%xd(StateIndex), T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), & - T%ED%m, T%ED%m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + T%ED%m, T%ED%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return call ED_PackContStateDerivAry(ModData%Vars, T%ED%m%dxdt_lin, dx_op) + ! case (Module_ExtPtfm) ! call ExtPtfm_CalcContStatExtPtfmeriv(ThisTime, T%ExtPtfm%Input(InputIndex), & ! T%ExtPtfm%p, T%ExtPtfm%x(StateIndex), & @@ -745,39 +763,62 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err ! T%ExtPtfm%m, T%ExtPtfm%m%dxdt_lin, & ! ErrStat2, ErrMsg2); if (Failed()) return ! call ExtPtfm_PackContStateAry(ModData%Vars, T%ExtPtfm%m%dxdt_lin, dx_op) + ! case (Module_FEAM) ! call FEAM_PackContStateAry(ModData%Vars, T%FEAM%x(StateIndex), dx_op) + case (Module_HD) call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), & T%HD%xd(StateIndex), T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), & T%HD%m, T%HD%m%dxdt_lin, ErrStat2, ErrMsg2) - call HydroDyn_PackContStateDerivAry(ModData%Vars, T%HD%x(StateIndex), dx_op) + if (Failed()) return + call HydroDyn_PackContStateDerivAry(ModData%Vars, T%HD%m%dxdt_lin, dx_op) + ! case (Module_IceD) ! call IceD_CalcContStateDeriv(ThisTime, T%IceD%Input(InputIndex), T%IceD%p, T%IceD%x(StateIndex), & ! T%IceD%xd(StateIndex), T%IceD%z(StateIndex), T%IceD%OtherSt(StateIndex), & ! T%IceD%m, T%IceD%m%dxdt_lin, ErrStat2, ErrMsg2) +! if (Failed()) return ! call IceD_PackContStateDerivAry(ModData%Vars, T%IceD%m%dxdt_lin, dx_op) + ! case (Module_IceF) ! call IceFloe_PackContStateDerivAry(ModData%Vars, T%IceF%x(StateIndex), dx_op) - case (Module_IfW) - call InflowWind_PackContStateDerivAry(ModData%Vars, T%IfW%x(StateIndex), dx_op) - case (Module_MAP) - call MAP_PackContStateDerivAry(ModData%Vars, T%MAP%x(StateIndex), dx_op) + +! case (Module_IfW) +! call InflowWind_PackContStateDerivAry(ModData%Vars, T%IfW%x(StateIndex), dx_op) + +! case (Module_MAP) +! call MAP_PackContStateDerivAry(ModData%Vars, T%MAP%x(StateIndex), dx_op) + case (Module_MD) - call MD_PackContStateDerivAry(ModData%Vars, T%MD%x(StateIndex), dx_op) - case (Module_ExtInfw) - ! call ExtInfw_PackContStateDerivAry(ModData%Vars, T%ExtInfw%x(StateIndex), dx_op) - case (Module_Orca) - call Orca_PackContStateDerivAry(ModData%Vars, T%Orca%x(StateIndex), dx_op) + call MD_CalcContStateDeriv(ThisTime, T%MD%Input(InputIndex), T%MD%p, T%MD%x(StateIndex), & + T%MD%xd(StateIndex), T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), & + T%MD%m, T%MD%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call MD_PackContStateDerivAry(ModData%Vars, T%MD%m%dxdt_lin, dx_op) + +! case (Module_ExtInfw) +! call ExtInfw_PackContStateDerivAry(ModData%Vars, T%ExtInfw%x(StateIndex), dx_op) + +! case (Module_Orca) +! call Orca_PackContStateDerivAry(ModData%Vars, T%Orca%x(StateIndex), dx_op) + case (Module_SD) - call SD_PackContStateDerivAry(ModData%Vars, T%SD%x(StateIndex), dx_op) - case (Module_SeaSt) - call SeaSt_PackContStateDerivAry(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) + call SD_CalcContStateDeriv(ThisTime, T%SD%Input(InputIndex), T%SD%p, T%SD%x(StateIndex), & + T%SD%xd(StateIndex), T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), & + T%SD%m, T%SD%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call SD_PackContStateDerivAry(ModData%Vars, T%SD%m%dxdt_lin, dx_op) + +! case (Module_SeaSt) +! call SeaSt_PackContStateDerivAry(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) + case (Module_SrvD) call SrvD_CalcContStateDeriv(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), & T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), T%SrvD%OtherSt(StateIndex), & T%SrvD%m, T%SrvD%m%dxdt_lin, ErrStat2, ErrMsg2) call SrvD_PackContStateDerivAry(ModData%Vars, T%SrvD%m%dxdt_lin, dx_op) + case default call SetErrStat(ErrID_Fatal, "Continuous State Derivatives unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index beec7bb287..f145f8d7c1 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -34,7 +34,7 @@ module FAST_ModGlue public :: ModGlue_Init public :: ModGlue_Linearize_OP, ModGlue_CalcSteady public :: ModGlue_SaveOperatingPoint, ModGlue_RestoreOperatingPoint -public :: CalcWriteLinearMatrices +public :: CalcWriteLinearMatrices, Glue_CombineModules contains @@ -119,6 +119,10 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte GlueModData%Vars%Ny = ModData%Vars%Ny ! Same as original module yNumVars = yNumVars + size(GlueModData%Vars%y) + ! Module Mappings + GlueModData%iSrcMaps = ModData%iSrcMaps + GlueModData%iDstMaps = ModData%iDstMaps + end associate end do @@ -1242,7 +1246,7 @@ subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) end subroutine -subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinRootName, FilterFlag, ErrStat, ErrMsg, ModSuffix) +subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinRootName, FilterFlag, ErrStat, ErrMsg, ModSuffix, CalcGlue) type(ModVarsType), intent(in) :: Vars !< Variable data type(ModLinType), intent(inout) :: Lin !< Linearization data type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters @@ -1254,6 +1258,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None character(*), optional, intent(in) :: ModSuffix !< Module suffix for file name + logical, optional, intent(in) :: CalcGlue !< Flag to calculate glue state matrices character(*), parameter :: RoutineName = 'WriteModuleLinearMatrices' integer(IntKi) :: ErrStat2 @@ -1264,6 +1269,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR integer(IntKi) :: Nx, Nxd, Nz, Nu, Ny character(50) :: Fmt logical, allocatable :: uUse(:), yUse(:), xUse(:) + logical :: CalcGlueLoc ErrStat = ErrID_None ErrMsg = "" @@ -1271,10 +1277,15 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR ! Assemble output file name based on glue linearization abbreviation if (present(ModSuffix)) then OutFileName = trim(LinRootName)//"."//trim(ModSuffix)//".lin" + CalcGlueLoc = .false. else OutFileName = trim(LinRootName)//".lin" + CalcGlueLoc = .true. end if + ! Set flag to calculate glue matrices based on optional parameter + if (present(CalcGlue)) CalcGlueLoc = CalcGlue + ! Open linearization file call OpenFOutFile(Un, OutFileName, ErrStat2, ErrMsg2); if (Failed()) return @@ -1386,7 +1397,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR ! If this is glue code module, calculate the glue code state matrices (A, B, C, D) ! Called here, after writing dUdu and dUdy, because those matrices are overwritten ! in the process of calculating the other state matrices - if (.not. present(ModSuffix)) then + if (CalcGlueLoc) then call CalcGlueStateMatrices(Vars, Lin, real(p_FAST%UJacSclFact, R8Ki), ErrStat2, ErrMsg2) if (Failed()) return end if diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index e667aa360a..ee061fe0ae 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -158,11 +158,7 @@ typedef ^ ^ ReKi TSR - - - typedef ^ ^ ReKi WindSpeed - - - "Windspeed for this case of the steady-state solve [>0]" "m/s" typedef ^ ^ ReKi Pitch - - - "Pitch angle for this case of the steady-state solve" "rad" -typedef ^ Glue_AeroMap ModDataType Mod - - - "Module combining all active modules" - -typedef ^ ^ IntKi iModOrder : - - "Index of module order for AeroMap modules" - -typedef ^ ^ IntKi iModED - - - "Index of ElastoDyn module" - -typedef ^ ^ IntKi iModBD - 0 - "Index of BeamDyn blade 1 module" - -typedef ^ ^ IntKi iModAD - - - "Index of AeroDyn module" - +typedef ^ Glue_AeroMap ModGlueType Mod - - - "Module combining all active modules" - typedef ^ ^ R8Ki Jac11 :: - - "Components of Jacobian matrix" - typedef ^ ^ R8Ki Jac12 :: - - "Components of Jacobian matrix" - typedef ^ ^ R8Ki Jac21 :: - - "Components of Jacobian matrix" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index adbaeafd0b..5efefdb0ed 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -173,11 +173,7 @@ MODULE Glue_Types ! ======================= ! ========= Glue_AeroMap ======= TYPE, PUBLIC :: Glue_AeroMap - TYPE(ModDataType) :: Mod !< Module combining all active modules [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOrder !< Index of module order for AeroMap modules [-] - INTEGER(IntKi) :: iModED = 0_IntKi !< Index of ElastoDyn module [-] - INTEGER(IntKi) :: iModBD = 0 !< Index of BeamDyn blade 1 module [-] - INTEGER(IntKi) :: iModAD = 0_IntKi !< Index of AeroDyn module [-] + TYPE(ModGlueType) :: Mod !< Module combining all active modules [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac11 !< Components of Jacobian matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac12 !< Components of Jacobian matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac21 !< Components of Jacobian matrix [-] @@ -1385,24 +1381,9 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E character(*), parameter :: RoutineName = 'Glue_CopyAeroMap' ErrStat = ErrID_None ErrMsg = '' - call NWTC_Library_CopyModDataType(SrcAeroMapData%Mod, DstAeroMapData%Mod, CtrlCode, ErrStat2, ErrMsg2) + call Glue_CopyModGlueType(SrcAeroMapData%Mod, DstAeroMapData%Mod, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcAeroMapData%iModOrder)) then - LB(1:1) = lbound(SrcAeroMapData%iModOrder, kind=B8Ki) - UB(1:1) = ubound(SrcAeroMapData%iModOrder, kind=B8Ki) - if (.not. allocated(DstAeroMapData%iModOrder)) then - allocate(DstAeroMapData%iModOrder(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%iModOrder.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstAeroMapData%iModOrder = SrcAeroMapData%iModOrder - end if - DstAeroMapData%iModED = SrcAeroMapData%iModED - DstAeroMapData%iModBD = SrcAeroMapData%iModBD - DstAeroMapData%iModAD = SrcAeroMapData%iModAD if (allocated(SrcAeroMapData%Jac11)) then LB(1:2) = lbound(SrcAeroMapData%Jac11, kind=B8Ki) UB(1:2) = ubound(SrcAeroMapData%Jac11, kind=B8Ki) @@ -1555,11 +1536,8 @@ subroutine Glue_DestroyAeroMap(AeroMapData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyAeroMap' ErrStat = ErrID_None ErrMsg = '' - call NWTC_Library_DestroyModDataType(AeroMapData%Mod, ErrStat2, ErrMsg2) + call Glue_DestroyModGlueType(AeroMapData%Mod, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(AeroMapData%iModOrder)) then - deallocate(AeroMapData%iModOrder) - end if if (allocated(AeroMapData%Jac11)) then deallocate(AeroMapData%Jac11) end if @@ -1608,11 +1586,7 @@ subroutine Glue_PackAeroMap(RF, Indata) integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return - call NWTC_Library_PackModDataType(RF, InData%Mod) - call RegPackAlloc(RF, InData%iModOrder) - call RegPack(RF, InData%iModED) - call RegPack(RF, InData%iModBD) - call RegPack(RF, InData%iModAD) + call Glue_PackModGlueType(RF, InData%Mod) call RegPackAlloc(RF, InData%Jac11) call RegPackAlloc(RF, InData%Jac12) call RegPackAlloc(RF, InData%Jac21) @@ -1647,11 +1621,7 @@ subroutine Glue_UnPackAeroMap(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackModDataType(RF, OutData%Mod) ! Mod - call RegUnpackAlloc(RF, OutData%iModOrder); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iModED); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iModBD); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iModAD); if (RegCheckErr(RF, RoutineName)) return + call Glue_UnpackModGlueType(RF, OutData%Mod) ! Mod call RegUnpackAlloc(RF, OutData%Jac11); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Jac12); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Jac21); if (RegCheckErr(RF, RoutineName)) return @@ -1743,7 +1713,7 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (.not. allocated(DstMiscData%ModDataAry)) then allocate(DstMiscData%ModDataAry(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Modules.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ModDataAry.', ErrStat, ErrMsg, RoutineName) return end if end if @@ -2261,11 +2231,11 @@ subroutine Glue_UnPackMisc(RF, OutData) call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ModDataAry(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modules.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModDataAry.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackModDataType(RF, OutData%ModDataAry(i1)) ! Modules + call NWTC_Library_UnpackModDataType(RF, OutData%ModDataAry(i1)) ! ModDataAry end do end if if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) From 72017b5a8b4af023fa3c63fc37b914661905f9cc Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 27 Jul 2024 11:44:40 +0000 Subject: [PATCH 165/319] Restore iSrcMaps and iDstMaps zero allocation --- modules/nwtc-library/src/ModVar.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 794992d9b1..30ed91ef08 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -491,6 +491,12 @@ subroutine MV_AddModule(ModDataAry, ModID, ModAbbr, Instance, ModDT, SolverDT, V end if end if + !---------------------------------------------------------------------------- + ! Allocate source and destination mapping indices + !---------------------------------------------------------------------------- + + allocate(ModData%iSrcMaps(0), ModData%iDstMaps(0)) + !---------------------------------------------------------------------------- ! Add module info to array !---------------------------------------------------------------------------- From 2695d5fc5a8b1363c36aeac21f4e47a61293a764 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 29 Jul 2024 15:44:14 +0000 Subject: [PATCH 166/319] Fix 5MW_OC4Semi_MD_Linear test case, generate field name functions --- modules/aerodyn/src/AeroAcoustics_Types.f90 | 103 ++-- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 177 +++--- modules/aerodyn/src/AeroDyn_Types.f90 | 137 +++-- modules/aerodyn/src/AirfoilInfo_Types.f90 | 58 +- modules/aerodyn/src/BEMT_Types.f90 | 165 ++++-- modules/aerodyn/src/DBEMT_Types.f90 | 87 +-- modules/aerodyn/src/FVW_Types.f90 | 113 ++-- modules/aerodyn/src/UnsteadyAero_Types.f90 | 95 ++-- modules/awae/src/AWAE_Types.f90 | 93 ++-- modules/beamdyn/src/BeamDyn.f90 | 4 +- modules/beamdyn/src/BeamDyn_Types.f90 | 109 ++-- modules/elastodyn/src/ElastoDyn.f90 | 240 ++------ modules/elastodyn/src/ElastoDyn_Types.f90 | 195 +++++-- .../src/ExternalInflow_Types.f90 | 76 ++- modules/extloads/src/ExtLoadsDX_Types.f90 | 50 +- modules/extloads/src/ExtLoads_Types.f90 | 125 +++-- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 85 +-- modules/feamooring/src/FEAMooring_Types.f90 | 95 ++-- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 75 +-- modules/hydrodyn/src/HydroDyn.f90 | 63 ++- modules/hydrodyn/src/HydroDyn.txt | 6 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 131 +++-- modules/hydrodyn/src/Morison_Types.f90 | 85 +-- modules/hydrodyn/src/SS_Excitation_Types.f90 | 77 +-- modules/hydrodyn/src/SS_Radiation_Types.f90 | 77 +-- modules/hydrodyn/src/WAMIT2_Types.f90 | 21 +- modules/hydrodyn/src/WAMIT_Types.f90 | 91 +-- modules/icedyn/src/IceDyn_Types.f90 | 85 +-- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 81 +-- modules/inflowwind/src/InflowWind_Types.f90 | 107 ++-- modules/inflowwind/src/Lidar_Types.f90 | 91 +-- modules/lindyn/src/LinDyn_Types.f90 | 77 +-- modules/map/src/MAP_Types.f90 | 103 ++-- modules/moordyn/src/MoorDyn.f90 | 300 +++------- modules/moordyn/src/MoorDyn_Registry.txt | 5 +- modules/moordyn/src/MoorDyn_Types.f90 | 187 +++---- modules/nwtc-library/src/ModVar.f90 | 107 ++-- .../nwtc-library/src/NWTC_Library_Types.f90 | 1 + .../src/Registry_NWTC_Library.txt | 1 + .../src/Registry_NWTC_Library_base.txt | 1 + modules/openfast-library/src/FAST_AeroMap.f90 | 8 +- modules/openfast-library/src/FAST_Funcs.f90 | 35 +- modules/openfast-library/src/FAST_Mapping.f90 | 188 ++++--- modules/openfast-library/src/FAST_ModGlue.f90 | 32 +- .../openfast-library/src/Glue_Registry.txt | 39 +- modules/openfast-library/src/Glue_Types.f90 | 40 +- .../src/registry_gen_fortran.cpp | 525 +++++++++--------- .../src/OrcaFlexInterface_Types.f90 | 81 +-- modules/seastate/src/SeaState.f90 | 41 ++ modules/seastate/src/SeaState_Types.f90 | 75 +-- modules/servodyn/src/ServoDyn_Types.f90 | 247 ++++++-- modules/servodyn/src/StrucCtrl_Types.f90 | 91 +-- modules/subdyn/src/SubDyn_Types.f90 | 99 ++-- .../supercontroller/src/SCDataEx_Types.f90 | 40 +- .../src/SuperController_Types.f90 | 79 +-- .../wakedynamics/src/WakeDynamics_Types.f90 | 115 ++-- 56 files changed, 3172 insertions(+), 2342 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index b4922766b7..52871cf06f 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -3018,14 +3018,6 @@ function AA_InputMeshPointer(u, DL) result(Mesh) end select end function -function AA_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function AA_OutputMeshPointer(y, DL) result(Mesh) type(AA_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -3035,14 +3027,6 @@ function AA_OutputMeshPointer(y, DL) result(Mesh) end select end function -function AA_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine AA_PackContStateAry(Vars, x, ValAry) type(AA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -3075,6 +3059,17 @@ subroutine AA_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function AA_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AA_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine AA_PackContStateDerivAry(Vars, x, ValAry) type(AA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -3092,21 +3087,6 @@ subroutine AA_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine AA_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(AA_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AA_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine AA_PackConstrStateAry(Vars, z, ValAry) type(AA_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -3139,6 +3119,17 @@ subroutine AA_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function AA_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AA_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine AA_PackInputAry(Vars, u, ValAry) type(AA_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -3187,6 +3178,25 @@ subroutine AA_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function AA_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AA_u_RotGtoL) + Name = "u%RotGtoL" + case (AA_u_AeroCent_G) + Name = "u%AeroCent_G" + case (AA_u_Vrel) + Name = "u%Vrel" + case (AA_u_AoANoise) + Name = "u%AoANoise" + case (AA_u_Inflow) + Name = "u%Inflow" + case default + Name = "Unknown Field" + end select +end function + subroutine AA_PackOutputAry(Vars, y, ValAry) type(AA_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -3259,6 +3269,37 @@ subroutine AA_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function AA_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AA_y_SumSpecNoise) + Name = "y%SumSpecNoise" + case (AA_y_SumSpecNoiseSep) + Name = "y%SumSpecNoiseSep" + case (AA_y_OASPL) + Name = "y%OASPL" + case (AA_y_OASPL_Mech) + Name = "y%OASPL_Mech" + case (AA_y_DirectiviOutput) + Name = "y%DirectiviOutput" + case (AA_y_OutLECoords) + Name = "y%OutLECoords" + case (AA_y_PtotalFreq) + Name = "y%PtotalFreq" + case (AA_y_WriteOutputForPE) + Name = "y%WriteOutputForPE" + case (AA_y_WriteOutput) + Name = "y%WriteOutput" + case (AA_y_WriteOutputSep) + Name = "y%WriteOutputSep" + case (AA_y_WriteOutputNode) + Name = "y%WriteOutputNode" + case default + Name = "Unknown Field" + end select +end function + END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index ba6204d824..b616e36a33 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -1813,26 +1813,6 @@ function ADI_InputMeshPointer(u, DL) result(Mesh) end select end function -function ADI_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (ADI_u_AD_rotors_NacelleMotion) - Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%NacelleMotion" - case (ADI_u_AD_rotors_TowerMotion) - Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%TowerMotion" - case (ADI_u_AD_rotors_HubMotion) - Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%HubMotion" - case (ADI_u_AD_rotors_BladeRootMotion) - Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeRootMotion("//trim(Num2LStr(DL%i2))//")" - case (ADI_u_AD_rotors_BladeMotion) - Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeMotion("//trim(Num2LStr(DL%i2))//")" - case (ADI_u_AD_rotors_TFinMotion) - Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%TFinMotion" - end select -end function - function ADI_OutputMeshPointer(y, DL) result(Mesh) type(ADI_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1852,24 +1832,6 @@ function ADI_OutputMeshPointer(y, DL) result(Mesh) end select end function -function ADI_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (ADI_y_AD_rotors_NacelleLoad) - Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%NacelleLoad" - case (ADI_y_AD_rotors_HubLoad) - Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%HubLoad" - case (ADI_y_AD_rotors_TowerLoad) - Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%TowerLoad" - case (ADI_y_AD_rotors_BladeLoad) - Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeLoad("//trim(Num2LStr(DL%i2))//")" - case (ADI_y_AD_rotors_TFinLoad) - Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%TFinLoad" - end select -end function - subroutine ADI_PackContStateAry(Vars, x, ValAry) type(ADI_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1946,6 +1908,39 @@ subroutine ADI_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function ADI_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%UA%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%x" + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%DBEMT%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%vind" + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%DBEMT%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%vind_1" + case (ADI_x_AD_rotors_BEMT_V_w) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%V_w" + case (ADI_x_AD_rotors_AA_DummyContState) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%AA%DummyContState" + case (ADI_x_AD_FVW_W_Gamma_NW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Gamma_NW" + case (ADI_x_AD_FVW_W_Gamma_FW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Gamma_FW" + case (ADI_x_AD_FVW_W_Eps_NW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Eps_NW" + case (ADI_x_AD_FVW_W_Eps_FW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Eps_FW" + case (ADI_x_AD_FVW_W_r_NW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%r_NW" + case (ADI_x_AD_FVW_W_r_FW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%r_FW" + case (ADI_x_AD_FVW_UA_element_x) + Name = "x%AD%FVW%UA("//trim(Num2LStr(DL%i1))//")%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%x" + case default + Name = "Unknown Field" + end select +end function + subroutine ADI_PackContStateDerivAry(Vars, x, ValAry) type(ADI_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1985,43 +1980,6 @@ subroutine ADI_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine ADI_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ADI_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ADI_x_AD_rotors_BEMT_UA_element_x) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_V_w) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_x_AD_rotors_AA_DummyContState) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%AA%DummyContState) ! Scalar - case (ADI_x_AD_FVW_W_Gamma_NW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Gamma_FW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Eps_NW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ADI_x_AD_FVW_W_Eps_FW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_NW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_FW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ADI_x_AD_FVW_UA_element_x) - call MV_Unpack(V, ValAry, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine ADI_PackConstrStateAry(Vars, z, ValAry) type(ADI_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2066,6 +2024,23 @@ subroutine ADI_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function ADI_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + Name = "z%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%phi" + case (ADI_z_AD_rotors_AA_DummyConstrState) + Name = "z%AD%rotors("//trim(Num2LStr(DL%i1))//")%AA%DummyConstrState" + case (ADI_z_AD_FVW_W_Gamma_LL) + Name = "z%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Gamma_LL" + case (ADI_z_AD_FVW_residual) + Name = "z%AD%FVW%residual" + case default + Name = "Unknown Field" + end select +end function + subroutine ADI_PackInputAry(Vars, u, ValAry) type(ADI_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2122,6 +2097,29 @@ subroutine ADI_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function ADI_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%NacelleMotion" + case (ADI_u_AD_rotors_TowerMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%TowerMotion" + case (ADI_u_AD_rotors_HubMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%HubMotion" + case (ADI_u_AD_rotors_BladeRootMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeRootMotion("//trim(Num2LStr(DL%i2))//")" + case (ADI_u_AD_rotors_BladeMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeMotion("//trim(Num2LStr(DL%i2))//")" + case (ADI_u_AD_rotors_TFinMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%TFinMotion" + case (ADI_u_AD_rotors_UserProp) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%UserProp" + case default + Name = "Unknown Field" + end select +end function + subroutine ADI_PackOutputAry(Vars, y, ValAry) type(ADI_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2190,6 +2188,35 @@ subroutine ADI_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function ADI_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%NacelleLoad" + case (ADI_y_AD_rotors_HubLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%HubLoad" + case (ADI_y_AD_rotors_TowerLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%TowerLoad" + case (ADI_y_AD_rotors_BladeLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeLoad("//trim(Num2LStr(DL%i2))//")" + case (ADI_y_AD_rotors_TFinLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%TFinLoad" + case (ADI_y_AD_rotors_WriteOutput) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%WriteOutput" + case (ADI_y_HHVel) + Name = "y%HHVel" + case (ADI_y_PLExp) + Name = "y%PLExp" + case (ADI_y_IW_WriteOutput) + Name = "y%IW_WriteOutput" + case (ADI_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE AeroDyn_Inflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 18968d7d3c..a90405e3ee 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -6735,26 +6735,6 @@ function AD_InputMeshPointer(u, DL) result(Mesh) end select end function -function AD_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (AD_u_NacelleMotion) - Name = "u%NacelleMotion" - case (AD_u_TowerMotion) - Name = "u%TowerMotion" - case (AD_u_HubMotion) - Name = "u%HubMotion" - case (AD_u_BladeRootMotion) - Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" - case (AD_u_BladeMotion) - Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" - case (AD_u_TFinMotion) - Name = "u%TFinMotion" - end select -end function - function AD_OutputMeshPointer(y, DL) result(Mesh) type(RotOutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -6774,24 +6754,6 @@ function AD_OutputMeshPointer(y, DL) result(Mesh) end select end function -function AD_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (AD_y_NacelleLoad) - Name = "y%NacelleLoad" - case (AD_y_HubLoad) - Name = "y%HubLoad" - case (AD_y_TowerLoad) - Name = "y%TowerLoad" - case (AD_y_BladeLoad) - Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" - case (AD_y_TFinLoad) - Name = "y%TFinLoad" - end select -end function - subroutine AD_PackContStateAry(Vars, x, ValAry) type(RotContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -6840,6 +6802,25 @@ subroutine AD_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function AD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + Name = "x%BEMT%UA%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%x" + case (AD_x_BEMT_DBEMT_element_vind) + Name = "x%BEMT%DBEMT%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind" + case (AD_x_BEMT_DBEMT_element_vind_1) + Name = "x%BEMT%DBEMT%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind_1" + case (AD_x_BEMT_V_w) + Name = "x%BEMT%V_w" + case (AD_x_AA_DummyContState) + Name = "x%AA%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine AD_PackContStateDerivAry(Vars, x, ValAry) type(RotContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -6865,29 +6846,6 @@ subroutine AD_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine AD_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(RotContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AD_x_BEMT_UA_element_x) - call MV_Unpack(V, ValAry, x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind) - call MV_Unpack(V, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind_1) - call MV_Unpack(V, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AD_x_BEMT_V_w) - call MV_Unpack(V, ValAry, x%BEMT%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AD_x_AA_DummyContState) - call MV_Unpack(V, ValAry, x%AA%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine AD_PackConstrStateAry(Vars, z, ValAry) type(RotConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -6924,6 +6882,19 @@ subroutine AD_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function AD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AD_z_BEMT_phi) + Name = "z%BEMT%phi" + case (AD_z_AA_DummyConstrState) + Name = "z%AA%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine AD_PackInputAry(Vars, u, ValAry) type(RotInputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -6980,6 +6951,29 @@ subroutine AD_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function AD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AD_u_NacelleMotion) + Name = "u%NacelleMotion" + case (AD_u_TowerMotion) + Name = "u%TowerMotion" + case (AD_u_HubMotion) + Name = "u%HubMotion" + case (AD_u_BladeRootMotion) + Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" + case (AD_u_BladeMotion) + Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" + case (AD_u_TFinMotion) + Name = "u%TFinMotion" + case (AD_u_UserProp) + Name = "u%UserProp" + case default + Name = "Unknown Field" + end select +end function + subroutine AD_PackOutputAry(Vars, y, ValAry) type(RotOutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -7032,6 +7026,27 @@ subroutine AD_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function AD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AD_y_NacelleLoad) + Name = "y%NacelleLoad" + case (AD_y_HubLoad) + Name = "y%HubLoad" + case (AD_y_TowerLoad) + Name = "y%TowerLoad" + case (AD_y_BladeLoad) + Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" + case (AD_y_TFinLoad) + Name = "y%TFinLoad" + case (AD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE AeroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index e022d2fe42..620e3e2ef1 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -1470,14 +1470,6 @@ function AFI_InputMeshPointer(u, DL) result(Mesh) end select end function -function AFI_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function AFI_OutputMeshPointer(y, DL) result(Mesh) type(AFI_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1487,14 +1479,6 @@ function AFI_OutputMeshPointer(y, DL) result(Mesh) end select end function -function AFI_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine AFI_PackInputAry(Vars, u, ValAry) type(AFI_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1535,6 +1519,21 @@ subroutine AFI_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function AFI_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AFI_u_AoA) + Name = "u%AoA" + case (AFI_u_UserProp) + Name = "u%UserProp" + case (AFI_u_Re) + Name = "u%Re" + case default + Name = "Unknown Field" + end select +end function + subroutine AFI_PackOutputAry(Vars, y, ValAry) type(AFI_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1599,6 +1598,33 @@ subroutine AFI_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function AFI_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AFI_y_Cl) + Name = "y%Cl" + case (AFI_y_Cd) + Name = "y%Cd" + case (AFI_y_Cm) + Name = "y%Cm" + case (AFI_y_Cpmin) + Name = "y%Cpmin" + case (AFI_y_Cd0) + Name = "y%Cd0" + case (AFI_y_Cm0) + Name = "y%Cm0" + case (AFI_y_f_st) + Name = "y%f_st" + case (AFI_y_FullySeparate) + Name = "y%FullySeparate" + case (AFI_y_FullyAttached) + Name = "y%FullyAttached" + case default + Name = "Unknown Field" + end select +end function + END MODULE AirfoilInfo_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 5efcec001a..6dec4e3971 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -2709,14 +2709,6 @@ function BEMT_InputMeshPointer(u, DL) result(Mesh) end select end function -function BEMT_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function BEMT_OutputMeshPointer(y, DL) result(Mesh) type(BEMT_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -2726,14 +2718,6 @@ function BEMT_OutputMeshPointer(y, DL) result(Mesh) end select end function -function BEMT_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine BEMT_PackContStateAry(Vars, x, ValAry) type(BEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2778,6 +2762,23 @@ subroutine BEMT_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function BEMT_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BEMT_x_UA_element_x) + Name = "x%UA%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%x" + case (BEMT_x_DBEMT_element_vind) + Name = "x%DBEMT%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind" + case (BEMT_x_DBEMT_element_vind_1) + Name = "x%DBEMT%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind_1" + case (BEMT_x_V_w) + Name = "x%V_w" + case default + Name = "Unknown Field" + end select +end function + subroutine BEMT_PackContStateDerivAry(Vars, x, ValAry) type(BEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2801,27 +2802,6 @@ subroutine BEMT_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine BEMT_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(BEMT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (BEMT_x_UA_element_x) - call MV_Unpack(V, ValAry, x%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind) - call MV_Unpack(V, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind_1) - call MV_Unpack(V, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_x_V_w) - call MV_Unpack(V, ValAry, x%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine BEMT_PackConstrStateAry(Vars, z, ValAry) type(BEMT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2854,6 +2834,17 @@ subroutine BEMT_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function BEMT_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BEMT_z_phi) + Name = "z%phi" + case default + Name = "Unknown Field" + end select +end function + subroutine BEMT_PackInputAry(Vars, u, ValAry) type(BEMT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2958,6 +2949,53 @@ subroutine BEMT_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function BEMT_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BEMT_u_theta) + Name = "u%theta" + case (BEMT_u_chi0) + Name = "u%chi0" + case (BEMT_u_psiSkewOffset) + Name = "u%psiSkewOffset" + case (BEMT_u_psi_s) + Name = "u%psi_s" + case (BEMT_u_omega) + Name = "u%omega" + case (BEMT_u_TSR) + Name = "u%TSR" + case (BEMT_u_Vx) + Name = "u%Vx" + case (BEMT_u_Vy) + Name = "u%Vy" + case (BEMT_u_Vz) + Name = "u%Vz" + case (BEMT_u_omega_z) + Name = "u%omega_z" + case (BEMT_u_xVelCorr) + Name = "u%xVelCorr" + case (BEMT_u_rLocal) + Name = "u%rLocal" + case (BEMT_u_Un_disk) + Name = "u%Un_disk" + case (BEMT_u_V0) + Name = "u%V0" + case (BEMT_u_x_hat_disk) + Name = "u%x_hat_disk" + case (BEMT_u_UserProp) + Name = "u%UserProp" + case (BEMT_u_CantAngle) + Name = "u%CantAngle" + case (BEMT_u_drdz) + Name = "u%drdz" + case (BEMT_u_toeAngle) + Name = "u%toeAngle" + case default + Name = "Unknown Field" + end select +end function + subroutine BEMT_PackOutputAry(Vars, y, ValAry) type(BEMT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -3074,6 +3112,59 @@ subroutine BEMT_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function BEMT_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BEMT_y_Vrel) + Name = "y%Vrel" + case (BEMT_y_phi) + Name = "y%phi" + case (BEMT_y_axInduction) + Name = "y%axInduction" + case (BEMT_y_tanInduction) + Name = "y%tanInduction" + case (BEMT_y_axInduction_qs) + Name = "y%axInduction_qs" + case (BEMT_y_tanInduction_qs) + Name = "y%tanInduction_qs" + case (BEMT_y_k) + Name = "y%k" + case (BEMT_y_k_p) + Name = "y%k_p" + case (BEMT_y_F) + Name = "y%F" + case (BEMT_y_Re) + Name = "y%Re" + case (BEMT_y_AOA) + Name = "y%AOA" + case (BEMT_y_Cx) + Name = "y%Cx" + case (BEMT_y_Cy) + Name = "y%Cy" + case (BEMT_y_Cz) + Name = "y%Cz" + case (BEMT_y_Cmx) + Name = "y%Cmx" + case (BEMT_y_Cmy) + Name = "y%Cmy" + case (BEMT_y_Cmz) + Name = "y%Cmz" + case (BEMT_y_Cm) + Name = "y%Cm" + case (BEMT_y_Cl) + Name = "y%Cl" + case (BEMT_y_Cd) + Name = "y%Cd" + case (BEMT_y_chi) + Name = "y%chi" + case (BEMT_y_Cpmin) + Name = "y%Cpmin" + case default + Name = "Unknown Field" + end select +end function + END MODULE BEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 2705f8a402..b6839a4358 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -1434,14 +1434,6 @@ function DBEMT_InputMeshPointer(u, DL) result(Mesh) end select end function -function DBEMT_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function DBEMT_OutputMeshPointer(y, DL) result(Mesh) type(DBEMT_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1451,14 +1443,6 @@ function DBEMT_OutputMeshPointer(y, DL) result(Mesh) end select end function -function DBEMT_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine DBEMT_PackContStateAry(Vars, x, ValAry) type(DBEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1495,6 +1479,19 @@ subroutine DBEMT_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function DBEMT_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (DBEMT_x_element_vind) + Name = "x%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind" + case (DBEMT_x_element_vind_1) + Name = "x%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind_1" + case default + Name = "Unknown Field" + end select +end function + subroutine DBEMT_PackContStateDerivAry(Vars, x, ValAry) type(DBEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1514,23 +1511,6 @@ subroutine DBEMT_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine DBEMT_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(DBEMT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (DBEMT_x_element_vind) - call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (DBEMT_x_element_vind_1) - call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine DBEMT_PackConstrStateAry(Vars, z, ValAry) type(DBEMT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1563,6 +1543,17 @@ subroutine DBEMT_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function DBEMT_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (DBEMT_z_DummyState) + Name = "z%DummyState" + case default + Name = "Unknown Field" + end select +end function + subroutine DBEMT_PackInputAry(Vars, u, ValAry) type(DBEMT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1611,6 +1602,25 @@ subroutine DBEMT_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function DBEMT_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (DBEMT_u_AxInd_disk) + Name = "u%AxInd_disk" + case (DBEMT_u_Un_disk) + Name = "u%Un_disk" + case (DBEMT_u_R_disk) + Name = "u%R_disk" + case (DBEMT_u_element_vind_s) + Name = "u%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind_s" + case (DBEMT_u_element_spanRatio) + Name = "u%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%spanRatio" + case default + Name = "Unknown Field" + end select +end function + subroutine DBEMT_PackOutputAry(Vars, y, ValAry) type(DBEMT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1643,6 +1653,17 @@ subroutine DBEMT_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function DBEMT_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (DBEMT_y_vind) + Name = "y%vind" + case default + Name = "Unknown Field" + end select +end function + END MODULE DBEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index e3dda1a05f..31904917d3 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -4116,16 +4116,6 @@ function FVW_InputMeshPointer(u, DL) result(Mesh) end select end function -function FVW_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (FVW_u_WingsMesh) - Name = "u%WingsMesh("//trim(Num2LStr(DL%i1))//")" - end select -end function - function FVW_OutputMeshPointer(y, DL) result(Mesh) type(FVW_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -4135,14 +4125,6 @@ function FVW_OutputMeshPointer(y, DL) result(Mesh) end select end function -function FVW_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine FVW_PackContStateAry(Vars, x, ValAry) type(FVW_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -4199,6 +4181,29 @@ subroutine FVW_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function FVW_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%Gamma_NW" + case (FVW_x_W_Gamma_FW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%Gamma_FW" + case (FVW_x_W_Eps_NW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%Eps_NW" + case (FVW_x_W_Eps_FW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%Eps_FW" + case (FVW_x_W_r_NW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%r_NW" + case (FVW_x_W_r_FW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%r_FW" + case (FVW_x_UA_element_x) + Name = "x%UA("//trim(Num2LStr(DL%i1))//")%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%x" + case default + Name = "Unknown Field" + end select +end function + subroutine FVW_PackContStateDerivAry(Vars, x, ValAry) type(FVW_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -4228,33 +4233,6 @@ subroutine FVW_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine FVW_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(FVW_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (FVW_x_W_Gamma_NW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (FVW_x_W_Gamma_FW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (FVW_x_W_Eps_NW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (FVW_x_W_Eps_FW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (FVW_x_W_r_NW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (FVW_x_W_r_FW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (FVW_x_UA_element_x) - call MV_Unpack(V, ValAry, x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine FVW_PackConstrStateAry(Vars, z, ValAry) type(FVW_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -4291,6 +4269,19 @@ subroutine FVW_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function FVW_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FVW_z_W_Gamma_LL) + Name = "z%W("//trim(Num2LStr(DL%i1))//")%Gamma_LL" + case (FVW_z_residual) + Name = "z%residual" + case default + Name = "Unknown Field" + end select +end function + subroutine FVW_PackInputAry(Vars, u, ValAry) type(FVW_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -4343,6 +4334,27 @@ subroutine FVW_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function FVW_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FVW_u_rotors_HubOrientation) + Name = "u%rotors("//trim(Num2LStr(DL%i1))//")%HubOrientation" + case (FVW_u_rotors_HubPosition) + Name = "u%rotors("//trim(Num2LStr(DL%i1))//")%HubPosition" + case (FVW_u_W_Vwnd_LL) + Name = "u%W("//trim(Num2LStr(DL%i1))//")%Vwnd_LL" + case (FVW_u_W_omega_z) + Name = "u%W("//trim(Num2LStr(DL%i1))//")%omega_z" + case (FVW_u_WingsMesh) + Name = "u%WingsMesh("//trim(Num2LStr(DL%i1))//")" + case (FVW_u_V_wind) + Name = "u%V_wind" + case default + Name = "Unknown Field" + end select +end function + subroutine FVW_PackOutputAry(Vars, y, ValAry) type(FVW_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -4375,6 +4387,17 @@ subroutine FVW_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function FVW_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FVW_y_W_Vind) + Name = "y%W("//trim(Num2LStr(DL%i1))//")%Vind" + case default + Name = "Unknown Field" + end select +end function + END MODULE FVW_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index daa4953e23..0ffdf0df05 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -2545,14 +2545,6 @@ function UA_InputMeshPointer(u, DL) result(Mesh) end select end function -function UA_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function UA_OutputMeshPointer(y, DL) result(Mesh) type(UA_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -2562,14 +2554,6 @@ function UA_OutputMeshPointer(y, DL) result(Mesh) end select end function -function UA_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine UA_PackContStateAry(Vars, x, ValAry) type(UA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2602,6 +2586,17 @@ subroutine UA_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function UA_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (UA_x_element_x) + Name = "x%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%x" + case default + Name = "Unknown Field" + end select +end function + subroutine UA_PackContStateDerivAry(Vars, x, ValAry) type(UA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2619,21 +2614,6 @@ subroutine UA_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine UA_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(UA_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (UA_x_element_x) - call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine UA_PackConstrStateAry(Vars, z, ValAry) type(UA_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2666,6 +2646,17 @@ subroutine UA_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function UA_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (UA_z_DummyConstraintState) + Name = "z%DummyConstraintState" + case default + Name = "Unknown Field" + end select +end function + subroutine UA_PackInputAry(Vars, u, ValAry) type(UA_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2718,6 +2709,27 @@ subroutine UA_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function UA_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (UA_u_U) + Name = "u%U" + case (UA_u_alpha) + Name = "u%alpha" + case (UA_u_Re) + Name = "u%Re" + case (UA_u_UserProp) + Name = "u%UserProp" + case (UA_u_v_ac) + Name = "u%v_ac" + case (UA_u_omega) + Name = "u%omega" + case default + Name = "Unknown Field" + end select +end function + subroutine UA_PackOutputAry(Vars, y, ValAry) type(UA_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2770,6 +2782,27 @@ subroutine UA_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function UA_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (UA_y_Cn) + Name = "y%Cn" + case (UA_y_Cc) + Name = "y%Cc" + case (UA_y_Cm) + Name = "y%Cm" + case (UA_y_Cl) + Name = "y%Cl" + case (UA_y_Cd) + Name = "y%Cd" + case (UA_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE UnsteadyAero_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 2eee773e8a..f2259a74aa 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -2618,14 +2618,6 @@ function AWAE_InputMeshPointer(u, DL) result(Mesh) end select end function -function AWAE_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function AWAE_OutputMeshPointer(y, DL) result(Mesh) type(AWAE_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -2635,14 +2627,6 @@ function AWAE_OutputMeshPointer(y, DL) result(Mesh) end select end function -function AWAE_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine AWAE_PackContStateAry(Vars, x, ValAry) type(AWAE_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2675,6 +2659,17 @@ subroutine AWAE_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function AWAE_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + Name = "x%IfW("//trim(Num2LStr(DL%i1))//")%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine AWAE_PackContStateDerivAry(Vars, x, ValAry) type(AWAE_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2692,21 +2687,6 @@ subroutine AWAE_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine AWAE_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(AWAE_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AWAE_x_IfW_DummyContState) - call MV_Unpack(V, ValAry, x%IfW(DL%i1)%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine AWAE_PackConstrStateAry(Vars, z, ValAry) type(AWAE_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2739,6 +2719,17 @@ subroutine AWAE_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function AWAE_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AWAE_z_IfW_DummyConstrState) + Name = "z%IfW("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine AWAE_PackInputAry(Vars, u, ValAry) type(AWAE_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2795,6 +2786,29 @@ subroutine AWAE_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function AWAE_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AWAE_u_xhat_plane) + Name = "u%xhat_plane" + case (AWAE_u_p_plane) + Name = "u%p_plane" + case (AWAE_u_Vx_wake) + Name = "u%Vx_wake" + case (AWAE_u_Vy_wake) + Name = "u%Vy_wake" + case (AWAE_u_Vz_wake) + Name = "u%Vz_wake" + case (AWAE_u_D_wake) + Name = "u%D_wake" + case (AWAE_u_WAT_k) + Name = "u%WAT_k" + case default + Name = "Unknown Field" + end select +end function + subroutine AWAE_PackOutputAry(Vars, y, ValAry) type(AWAE_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2839,6 +2853,23 @@ subroutine AWAE_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function AWAE_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AWAE_y_Vdist_High_data) + Name = "y%Vdist_High("//trim(Num2LStr(DL%i1))//")%data" + case (AWAE_y_V_plane) + Name = "y%V_plane" + case (AWAE_y_TI_amb) + Name = "y%TI_amb" + case (AWAE_y_Vx_wind_disk) + Name = "y%Vx_wind_disk" + case default + Name = "Unknown Field" + end select +end function + END MODULE AWAE_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index a0a4a28cc9..0b8c0ed61f 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -6051,7 +6051,7 @@ SUBROUTINE BD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Determine if write outputs need to be calculated (usually at end of output variables) NeedWriteOutput = .false. do i = size(Vars%y), 1, -1 - if (MV_HasFlags(Vars%y(i), VF_WriteOut)) then + if (MV_HasFlagsAll(Vars%y(i), VF_WriteOut)) then NeedWriteOutput = .true. exit end if @@ -6222,7 +6222,7 @@ SUBROUTINE BD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Determine if write outputs need to be calculated (usually at end of output variables) NeedWriteOutput = .false. do i = size(Vars%y), 1, -1 - if (MV_HasFlags(Vars%y(i), VF_WriteOut)) then + if (MV_HasFlagsAll(Vars%y(i), VF_WriteOut)) then NeedWriteOutput = .true. exit end if diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 75c74b250a..5de53aa546 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -3768,22 +3768,6 @@ function BD_InputMeshPointer(u, DL) result(Mesh) end select end function -function BD_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (BD_u_RootMotion) - Name = "u%RootMotion" - case (BD_u_PointLoad) - Name = "u%PointLoad" - case (BD_u_DistrLoad) - Name = "u%DistrLoad" - case (BD_u_HubMotion) - Name = "u%HubMotion" - end select -end function - function BD_OutputMeshPointer(y, DL) result(Mesh) type(BD_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -3797,18 +3781,6 @@ function BD_OutputMeshPointer(y, DL) result(Mesh) end select end function -function BD_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (BD_y_ReactionForce) - Name = "y%ReactionForce" - case (BD_y_BldMotion) - Name = "y%BldMotion" - end select -end function - subroutine BD_PackContStateAry(Vars, x, ValAry) type(BD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -3853,6 +3825,19 @@ subroutine BD_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function BD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BD_x_q) + Name = "x%q" + case (BD_x_dqdt) + Name = "x%dqdt" + case default + Name = "Unknown Field" + end select +end function + subroutine BD_PackContStateDerivAry(Vars, x, ValAry) type(BD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -3872,27 +3857,6 @@ subroutine BD_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine BD_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(BD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (BD_x_q) - if (V%Field == FieldOrientation) then - x%q(4:6, V%jAry) = wm_inv(quat_to_wm(ValAry(V%iLoc(1):V%iLoc(2)))) ! Convert quaternion to WM parameters - else - call MV_Unpack(V, ValAry, x%q(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end if - case (BD_x_dqdt) - call MV_Unpack(V, ValAry, x%dqdt(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate - end do -end subroutine - subroutine BD_PackConstrStateAry(Vars, z, ValAry) type(BD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -3925,6 +3889,17 @@ subroutine BD_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function BD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BD_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine BD_PackInputAry(Vars, u, ValAry) type(BD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -3969,6 +3944,23 @@ subroutine BD_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function BD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BD_u_RootMotion) + Name = "u%RootMotion" + case (BD_u_PointLoad) + Name = "u%PointLoad" + case (BD_u_DistrLoad) + Name = "u%DistrLoad" + case (BD_u_HubMotion) + Name = "u%HubMotion" + case default + Name = "Unknown Field" + end select +end function + subroutine BD_PackOutputAry(Vars, y, ValAry) type(BD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -4017,6 +4009,25 @@ subroutine BD_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function BD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BD_y_ReactionForce) + Name = "y%ReactionForce" + case (BD_y_BldMotion) + Name = "y%BldMotion" + case (BD_y_RootMxr) + Name = "y%RootMxr" + case (BD_y_RootMyr) + Name = "y%RootMyr" + case (BD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE BeamDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 3a83596bd4..e3dc31491c 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -10278,14 +10278,14 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, j, col + integer(IntKi) :: i, j, iCol integer(IntKi) :: iVarBlPitchCom, iVarBlPitchComC ErrStat = ErrID_None ErrMsg = '' - - m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function + ! To compute perturbations, we need to ignore the modulo function + m%IgnoreMod = .true. ! Initialize pitch command variable indices iVarBlPitchCom = 0 @@ -10296,7 +10296,6 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, iVarBlPitchCom = i case (ED_u_BlPitchComC) iVarBlPitchComC = i - cycle end select end do @@ -10321,6 +10320,9 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Loop through number of linearization perturbations in variable do j = 1, Vars%u(i)%Num + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) @@ -10333,11 +10335,8 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) - ! Calculate column index - col = Vars%u(i)%iLoc(1) + j - 1 - ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,iCol)) end do end do @@ -10370,6 +10369,9 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Loop through number of linearization perturbations in variable do j = 1, Vars%u(i)%Num + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) @@ -10382,11 +10384,8 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) - ! Calculate column index - col = Vars%u(i)%iLoc(1) + j - 1 - ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) + dXdu(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do end do @@ -10451,9 +10450,7 @@ SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc - INTEGER(IntKi) :: i, j, col + INTEGER(IntKi) :: i, j, iCol ErrStat = ErrID_None ErrMsg = '' @@ -10478,6 +10475,9 @@ SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Loop through number of linearization perturbations in variable do j = 1, Vars%x(i)%Num + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) @@ -10490,11 +10490,8 @@ SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) - ! Calculate column index - col = Vars%x(i)%iLoc(1) + j - 1 - ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,iCol)) end do end do @@ -10514,6 +10511,9 @@ SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Loop through number of linearization perturbations in variable do j = 1, Vars%x(i)%Num + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) @@ -10526,14 +10526,10 @@ SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) - ! Calculate column index - col = Vars%x(i)%iLoc(1) + j - 1 - ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) + dXdx(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) end do end do - end if if (present(dXddx)) then @@ -10589,45 +10585,25 @@ SUBROUTINE ED_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! functions (Z) with respect to the !! discrete states (xd) [intent in to avoid deallocation] - - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: + if (present(dYdxd)) then + end if - IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - - ! allocate and set dYdxd - - END IF - - IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - - ! allocate and set dXdxd - - END IF - - IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - - ! allocate and set dXddxd - - END IF - - IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - - ! allocate and set dZdxd - - END IF + ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: + if (present(dXdxd)) then + end if + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: + if (present(dXddxd)) then + end if + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: + if (present(dZdxd)) then + end if END SUBROUTINE ED_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- @@ -10659,154 +10635,28 @@ SUBROUTINE ED_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the constraint states (z) [intent in to avoid deallocation] - - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - - ! allocate and set dYdz - - END IF - - IF ( PRESENT( dXdz ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: - - ! allocate and set dXdz - - END IF - - IF ( PRESENT( dXddz ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: - - ! allocate and set dXddz - - END IF - - IF ( PRESENT( dZdz ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: - - ! allocate and set dZdz - - END IF - - -END SUBROUTINE ED_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ED_GetOP(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) - - type(ModVarsType), INTENT(IN ) :: Vars !< Module information - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ED_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - - CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - INTEGER(IntKi) :: i, k - - ErrStat = ErrID_None - ErrMsg = '' - - !.................................. - if (present(u_op)) then - - if (.not. allocated(u_op)) then - call AllocAry(u_op, Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return - u_op = 0.0_R8Ki - end if - - ! Pack input type into array - call ED_PackInputAry(Vars, u, u_op) - - ! If full linearization, check extended inputs - if (MV_FindVarDatLoc(Vars%u, DatLoc(ED_u_BlPitchComC)) > 0) then - do k = 2,p%NumBl - if (.not. EqualRealNos(u%BlPitchCom(1), u%BlPitchCom(k)) ) then - call SetErrStat(ErrID_Info, "Operating point of collective pitch extended input is invalid because "// & - "the commanded blade pitch angles are not the same for each blade.", ErrStat, ErrMsg, RoutineName) - exit - end if - end do - end if + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: + if (present(dYdz)) then end if - !.................................. - if (present(y_op)) then - - if (.not. allocated(y_op)) then - call AllocAry(y_op, Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return - y_op = 0.0_R8Ki - end if - - call ED_PackOutputAry(Vars, y, y_op) - + ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: + if (present(dXdz)) then end if - !.................................. - if (present(x_op)) then - - if (.not. allocated(x_op)) then - call AllocAry(x_op, Vars%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return - x_op = 0.0_R8Ki - end if - - call ED_PackContStateAry(Vars, x, x_op) - - end if - - !.................................. - if (present(dx_op)) then - - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, Vars%Nx, 'dx_op', ErrStat2, ErrMsg2); if (Failed()) return - dx_op = 0.0_R8Ki - end if - - call ED_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(Vars, m%dxdt_lin, dx_op) - + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: + if (present(dXddz)) then end if - !.................................. - if (present(xd_op)) then - end if - - !.................................. - if (present(z_op)) then + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: + if (present(dZdz)) then end if -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -END SUBROUTINE ED_GetOP +END SUBROUTINE ED_JacobianPConstrState +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ subroutine ED_PackExtInputAry(Vars, u, ValAry, ErrStat, ErrMsg) type(ModVarsType), intent(in) :: Vars diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 6872bd7191..c68d7cb383 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -7683,26 +7683,6 @@ function ED_InputMeshPointer(u, DL) result(Mesh) end select end function -function ED_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (ED_u_BladePtLoads) - Name = "u%BladePtLoads("//trim(Num2LStr(DL%i1))//")" - case (ED_u_PlatformPtMesh) - Name = "u%PlatformPtMesh" - case (ED_u_TowerPtLoads) - Name = "u%TowerPtLoads" - case (ED_u_HubPtLoad) - Name = "u%HubPtLoad" - case (ED_u_NacelleLoads) - Name = "u%NacelleLoads" - case (ED_u_TFinCMLoads) - Name = "u%TFinCMLoads" - end select -end function - function ED_OutputMeshPointer(y, DL) result(Mesh) type(ED_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -7726,28 +7706,6 @@ function ED_OutputMeshPointer(y, DL) result(Mesh) end select end function -function ED_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (ED_y_BladeLn2Mesh) - Name = "y%BladeLn2Mesh("//trim(Num2LStr(DL%i1))//")" - case (ED_y_PlatformPtMesh) - Name = "y%PlatformPtMesh" - case (ED_y_TowerLn2Mesh) - Name = "y%TowerLn2Mesh" - case (ED_y_HubPtMotion) - Name = "y%HubPtMotion" - case (ED_y_BladeRootMotion) - Name = "y%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" - case (ED_y_NacelleMotion) - Name = "y%NacelleMotion" - case (ED_y_TFinCMMotion) - Name = "y%TFinCMMotion" - end select -end function - subroutine ED_PackContStateAry(Vars, x, ValAry) type(ED_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -7784,6 +7742,19 @@ subroutine ED_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function ED_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ED_x_QT) + Name = "x%QT" + case (ED_x_QDT) + Name = "x%QDT" + case default + Name = "Unknown Field" + end select +end function + subroutine ED_PackContStateDerivAry(Vars, x, ValAry) type(ED_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -7803,23 +7774,6 @@ subroutine ED_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine ED_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ED_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ED_x_QT) - call MV_Unpack(V, ValAry, x%QT(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ED_x_QDT) - call MV_Unpack(V, ValAry, x%QDT(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine ED_PackConstrStateAry(Vars, z, ValAry) type(ED_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -7852,6 +7806,17 @@ subroutine ED_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function ED_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ED_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine ED_PackInputAry(Vars, u, ValAry) type(ED_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -7928,6 +7893,39 @@ subroutine ED_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function ED_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ED_u_BladePtLoads) + Name = "u%BladePtLoads("//trim(Num2LStr(DL%i1))//")" + case (ED_u_PlatformPtMesh) + Name = "u%PlatformPtMesh" + case (ED_u_TowerPtLoads) + Name = "u%TowerPtLoads" + case (ED_u_HubPtLoad) + Name = "u%HubPtLoad" + case (ED_u_NacelleLoads) + Name = "u%NacelleLoads" + case (ED_u_TFinCMLoads) + Name = "u%TFinCMLoads" + case (ED_u_TwrAddedMass) + Name = "u%TwrAddedMass" + case (ED_u_PtfmAddedMass) + Name = "u%PtfmAddedMass" + case (ED_u_BlPitchCom) + Name = "u%BlPitchCom" + case (ED_u_YawMom) + Name = "u%YawMom" + case (ED_u_GenTrq) + Name = "u%GenTrq" + case (ED_u_HSSBrTrqC) + Name = "u%HSSBrTrqC" + case default + Name = "Unknown Field" + end select +end function + subroutine ED_PackOutputAry(Vars, y, ValAry) type(ED_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -8096,6 +8094,85 @@ subroutine ED_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function ED_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + Name = "y%BladeLn2Mesh("//trim(Num2LStr(DL%i1))//")" + case (ED_y_PlatformPtMesh) + Name = "y%PlatformPtMesh" + case (ED_y_TowerLn2Mesh) + Name = "y%TowerLn2Mesh" + case (ED_y_HubPtMotion) + Name = "y%HubPtMotion" + case (ED_y_BladeRootMotion) + Name = "y%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" + case (ED_y_NacelleMotion) + Name = "y%NacelleMotion" + case (ED_y_TFinCMMotion) + Name = "y%TFinCMMotion" + case (ED_y_WriteOutput) + Name = "y%WriteOutput" + case (ED_y_BlPitch) + Name = "y%BlPitch" + case (ED_y_Yaw) + Name = "y%Yaw" + case (ED_y_YawRate) + Name = "y%YawRate" + case (ED_y_LSS_Spd) + Name = "y%LSS_Spd" + case (ED_y_HSS_Spd) + Name = "y%HSS_Spd" + case (ED_y_RotSpeed) + Name = "y%RotSpeed" + case (ED_y_TwrAccel) + Name = "y%TwrAccel" + case (ED_y_YawAngle) + Name = "y%YawAngle" + case (ED_y_RootMyc) + Name = "y%RootMyc" + case (ED_y_YawBrTAxp) + Name = "y%YawBrTAxp" + case (ED_y_YawBrTAyp) + Name = "y%YawBrTAyp" + case (ED_y_LSSTipPxa) + Name = "y%LSSTipPxa" + case (ED_y_RootMxc) + Name = "y%RootMxc" + case (ED_y_LSSTipMxa) + Name = "y%LSSTipMxa" + case (ED_y_LSSTipMya) + Name = "y%LSSTipMya" + case (ED_y_LSSTipMza) + Name = "y%LSSTipMza" + case (ED_y_LSSTipMys) + Name = "y%LSSTipMys" + case (ED_y_LSSTipMzs) + Name = "y%LSSTipMzs" + case (ED_y_YawBrMyn) + Name = "y%YawBrMyn" + case (ED_y_YawBrMzn) + Name = "y%YawBrMzn" + case (ED_y_NcIMURAxs) + Name = "y%NcIMURAxs" + case (ED_y_NcIMURAys) + Name = "y%NcIMURAys" + case (ED_y_NcIMURAzs) + Name = "y%NcIMURAzs" + case (ED_y_RotPwr) + Name = "y%RotPwr" + case (ED_y_LSShftFxa) + Name = "y%LSShftFxa" + case (ED_y_LSShftFys) + Name = "y%LSShftFys" + case (ED_y_LSShftFzs) + Name = "y%LSShftFzs" + case default + Name = "Unknown Field" + end select +end function + END MODULE ElastoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index 9440675200..78d46db4c0 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -2843,14 +2843,6 @@ function ExtInfw_InputMeshPointer(u, DL) result(Mesh) end select end function -function ExtInfw_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function ExtInfw_OutputMeshPointer(y, DL) result(Mesh) type(ExtInfw_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -2860,14 +2852,6 @@ function ExtInfw_OutputMeshPointer(y, DL) result(Mesh) end select end function -function ExtInfw_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine ExtInfw_PackInputAry(Vars, u, ValAry) type(ExtInfw_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2964,6 +2948,49 @@ subroutine ExtInfw_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function ExtInfw_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtInfw_u_pxVel) + Name = "u%pxVel" + case (ExtInfw_u_pyVel) + Name = "u%pyVel" + case (ExtInfw_u_pzVel) + Name = "u%pzVel" + case (ExtInfw_u_pxForce) + Name = "u%pxForce" + case (ExtInfw_u_pyForce) + Name = "u%pyForce" + case (ExtInfw_u_pzForce) + Name = "u%pzForce" + case (ExtInfw_u_xdotForce) + Name = "u%xdotForce" + case (ExtInfw_u_ydotForce) + Name = "u%ydotForce" + case (ExtInfw_u_zdotForce) + Name = "u%zdotForce" + case (ExtInfw_u_pOrientation) + Name = "u%pOrientation" + case (ExtInfw_u_fx) + Name = "u%fx" + case (ExtInfw_u_fy) + Name = "u%fy" + case (ExtInfw_u_fz) + Name = "u%fz" + case (ExtInfw_u_momentx) + Name = "u%momentx" + case (ExtInfw_u_momenty) + Name = "u%momenty" + case (ExtInfw_u_momentz) + Name = "u%momentz" + case (ExtInfw_u_forceNodesChord) + Name = "u%forceNodesChord" + case default + Name = "Unknown Field" + end select +end function + subroutine ExtInfw_PackOutputAry(Vars, y, ValAry) type(ExtInfw_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -3008,6 +3035,23 @@ subroutine ExtInfw_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function ExtInfw_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtInfw_y_u) + Name = "y%u" + case (ExtInfw_y_v) + Name = "y%v" + case (ExtInfw_y_w) + Name = "y%w" + case (ExtInfw_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE ExternalInflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index a1d6c66bf4..b7001cc954 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -1700,14 +1700,6 @@ function ExtLdDX_InputMeshPointer(u, DL) result(Mesh) end select end function -function ExtLdDX_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function ExtLdDX_OutputMeshPointer(y, DL) result(Mesh) type(ExtLdDX_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1717,14 +1709,6 @@ function ExtLdDX_OutputMeshPointer(y, DL) result(Mesh) end select end function -function ExtLdDX_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine ExtLdDX_PackInputAry(Vars, u, ValAry) type(ExtLdDX_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1777,6 +1761,27 @@ subroutine ExtLdDX_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function ExtLdDX_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLdDX_u_twrDef) + Name = "u%twrDef" + case (ExtLdDX_u_bldDef) + Name = "u%bldDef" + case (ExtLdDX_u_hubDef) + Name = "u%hubDef" + case (ExtLdDX_u_nacDef) + Name = "u%nacDef" + case (ExtLdDX_u_bldRootDef) + Name = "u%bldRootDef" + case (ExtLdDX_u_bldPitch) + Name = "u%bldPitch" + case default + Name = "Unknown Field" + end select +end function + subroutine ExtLdDX_PackOutputAry(Vars, y, ValAry) type(ExtLdDX_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1813,6 +1818,19 @@ subroutine ExtLdDX_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function ExtLdDX_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLdDX_y_twrLd) + Name = "y%twrLd" + case (ExtLdDX_y_bldLd) + Name = "y%bldLd" + case default + Name = "Unknown Field" + end select +end function + END MODULE ExtLoadsDX_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 2a6d5718a4..a9e649c26d 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -1719,24 +1719,6 @@ function ExtLd_InputMeshPointer(u, DL) result(Mesh) end select end function -function ExtLd_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (ExtLd_u_TowerMotion) - Name = "u%TowerMotion" - case (ExtLd_u_HubMotion) - Name = "u%HubMotion" - case (ExtLd_u_NacelleMotion) - Name = "u%NacelleMotion" - case (ExtLd_u_BladeRootMotion) - Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" - case (ExtLd_u_BladeMotion) - Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" - end select -end function - function ExtLd_OutputMeshPointer(y, DL) result(Mesh) type(ExtLd_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1754,22 +1736,6 @@ function ExtLd_OutputMeshPointer(y, DL) result(Mesh) end select end function -function ExtLd_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (ExtLd_y_TowerLoad) - Name = "y%TowerLoad" - case (ExtLd_y_BladeLoad) - Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" - case (ExtLd_y_TowerLoadAD) - Name = "y%TowerLoadAD" - case (ExtLd_y_BladeLoadAD) - Name = "y%BladeLoadAD("//trim(Num2LStr(DL%i1))//")" - end select -end function - subroutine ExtLd_PackContStateAry(Vars, x, ValAry) type(ExtLd_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1802,6 +1768,17 @@ subroutine ExtLd_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function ExtLd_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLd_x_blah) + Name = "x%blah" + case default + Name = "Unknown Field" + end select +end function + subroutine ExtLd_PackContStateDerivAry(Vars, x, ValAry) type(ExtLd_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1819,21 +1796,6 @@ subroutine ExtLd_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine ExtLd_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ExtLd_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ExtLd_x_blah) - call MV_Unpack(V, ValAry, x%blah) ! Scalar - end select - end associate - end do -end subroutine - subroutine ExtLd_PackConstrStateAry(Vars, z, ValAry) type(ExtLd_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1866,6 +1828,17 @@ subroutine ExtLd_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function ExtLd_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLd_z_blah) + Name = "z%blah" + case default + Name = "Unknown Field" + end select +end function + subroutine ExtLd_PackInputAry(Vars, u, ValAry) type(ExtLd_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1942,6 +1915,39 @@ subroutine ExtLd_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function ExtLd_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLd_u_DX_u_twrDef) + Name = "u%DX_u%twrDef" + case (ExtLd_u_DX_u_bldDef) + Name = "u%DX_u%bldDef" + case (ExtLd_u_DX_u_hubDef) + Name = "u%DX_u%hubDef" + case (ExtLd_u_DX_u_nacDef) + Name = "u%DX_u%nacDef" + case (ExtLd_u_DX_u_bldRootDef) + Name = "u%DX_u%bldRootDef" + case (ExtLd_u_DX_u_bldPitch) + Name = "u%DX_u%bldPitch" + case (ExtLd_u_az) + Name = "u%az" + case (ExtLd_u_TowerMotion) + Name = "u%TowerMotion" + case (ExtLd_u_HubMotion) + Name = "u%HubMotion" + case (ExtLd_u_NacelleMotion) + Name = "u%NacelleMotion" + case (ExtLd_u_BladeRootMotion) + Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" + case (ExtLd_u_BladeMotion) + Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" + case default + Name = "Unknown Field" + end select +end function + subroutine ExtLd_PackOutputAry(Vars, y, ValAry) type(ExtLd_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1994,6 +2000,27 @@ subroutine ExtLd_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function ExtLd_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLd_y_DX_y_twrLd) + Name = "y%DX_y%twrLd" + case (ExtLd_y_DX_y_bldLd) + Name = "y%DX_y%bldLd" + case (ExtLd_y_TowerLoad) + Name = "y%TowerLoad" + case (ExtLd_y_BladeLoad) + Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" + case (ExtLd_y_TowerLoadAD) + Name = "y%TowerLoadAD" + case (ExtLd_y_BladeLoadAD) + Name = "y%BladeLoadAD("//trim(Num2LStr(DL%i1))//")" + case default + Name = "Unknown Field" + end select +end function + END MODULE ExtLoads_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 36fe4db45e..e727777257 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -1888,16 +1888,6 @@ function ExtPtfm_InputMeshPointer(u, DL) result(Mesh) end select end function -function ExtPtfm_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (ExtPtfm_u_PtfmMesh) - Name = "u%PtfmMesh" - end select -end function - function ExtPtfm_OutputMeshPointer(y, DL) result(Mesh) type(ExtPtfm_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1909,16 +1899,6 @@ function ExtPtfm_OutputMeshPointer(y, DL) result(Mesh) end select end function -function ExtPtfm_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (ExtPtfm_y_PtfmMesh) - Name = "y%PtfmMesh" - end select -end function - subroutine ExtPtfm_PackContStateAry(Vars, x, ValAry) type(ExtPtfm_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1955,6 +1935,19 @@ subroutine ExtPtfm_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function ExtPtfm_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtPtfm_x_qm) + Name = "x%qm" + case (ExtPtfm_x_qmdot) + Name = "x%qmdot" + case default + Name = "Unknown Field" + end select +end function + subroutine ExtPtfm_PackContStateDerivAry(Vars, x, ValAry) type(ExtPtfm_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1974,23 +1967,6 @@ subroutine ExtPtfm_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine ExtPtfm_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(ExtPtfm_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ExtPtfm_x_qm) - call MV_Unpack(V, ValAry, x%qm(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtPtfm_x_qmdot) - call MV_Unpack(V, ValAry, x%qmdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine ExtPtfm_PackConstrStateAry(Vars, z, ValAry) type(ExtPtfm_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2023,6 +1999,17 @@ subroutine ExtPtfm_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function ExtPtfm_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtPtfm_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine ExtPtfm_PackInputAry(Vars, u, ValAry) type(ExtPtfm_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2055,6 +2042,17 @@ subroutine ExtPtfm_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function ExtPtfm_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + Name = "u%PtfmMesh" + case default + Name = "Unknown Field" + end select +end function + subroutine ExtPtfm_PackOutputAry(Vars, y, ValAry) type(ExtPtfm_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2091,6 +2089,19 @@ subroutine ExtPtfm_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function ExtPtfm_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + Name = "y%PtfmMesh" + case (ExtPtfm_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE ExtPtfm_MCKF_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 530fd1f509..aabbe3b598 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -2523,18 +2523,6 @@ function FEAM_InputMeshPointer(u, DL) result(Mesh) end select end function -function FEAM_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (FEAM_u_HydroForceLineMesh) - Name = "u%HydroForceLineMesh" - case (FEAM_u_PtFairleadDisplacement) - Name = "u%PtFairleadDisplacement" - end select -end function - function FEAM_OutputMeshPointer(y, DL) result(Mesh) type(FEAM_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -2548,18 +2536,6 @@ function FEAM_OutputMeshPointer(y, DL) result(Mesh) end select end function -function FEAM_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (FEAM_y_PtFairleadLoad) - Name = "y%PtFairleadLoad" - case (FEAM_y_LineMeshPosition) - Name = "y%LineMeshPosition" - end select -end function - subroutine FEAM_PackContStateAry(Vars, x, ValAry) type(FEAM_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2596,6 +2572,19 @@ subroutine FEAM_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function FEAM_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FEAM_x_GLU) + Name = "x%GLU" + case (FEAM_x_GLDU) + Name = "x%GLDU" + case default + Name = "Unknown Field" + end select +end function + subroutine FEAM_PackContStateDerivAry(Vars, x, ValAry) type(FEAM_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2615,23 +2604,6 @@ subroutine FEAM_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine FEAM_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(FEAM_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (FEAM_x_GLU) - call MV_Unpack(V, ValAry, x%GLU(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (FEAM_x_GLDU) - call MV_Unpack(V, ValAry, x%GLDU(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate - end do -end subroutine - subroutine FEAM_PackConstrStateAry(Vars, z, ValAry) type(FEAM_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2668,6 +2640,19 @@ subroutine FEAM_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function FEAM_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FEAM_z_TSN) + Name = "z%TSN" + case (FEAM_z_TZER) + Name = "z%TZER" + case default + Name = "Unknown Field" + end select +end function + subroutine FEAM_PackInputAry(Vars, u, ValAry) type(FEAM_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2704,6 +2689,19 @@ subroutine FEAM_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function FEAM_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + Name = "u%HydroForceLineMesh" + case (FEAM_u_PtFairleadDisplacement) + Name = "u%PtFairleadDisplacement" + case default + Name = "Unknown Field" + end select +end function + subroutine FEAM_PackOutputAry(Vars, y, ValAry) type(FEAM_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2744,6 +2742,21 @@ subroutine FEAM_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function FEAM_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FEAM_y_WriteOutput) + Name = "y%WriteOutput" + case (FEAM_y_PtFairleadLoad) + Name = "y%PtFairleadLoad" + case (FEAM_y_LineMeshPosition) + Name = "y%LineMeshPosition" + case default + Name = "Unknown Field" + end select +end function + END MODULE FEAMooring_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 109795d740..05d64f81f6 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -986,14 +986,6 @@ function Conv_Rdtn_InputMeshPointer(u, DL) result(Mesh) end select end function -function Conv_Rdtn_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function Conv_Rdtn_OutputMeshPointer(y, DL) result(Mesh) type(Conv_Rdtn_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1003,14 +995,6 @@ function Conv_Rdtn_OutputMeshPointer(y, DL) result(Mesh) end select end function -function Conv_Rdtn_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine Conv_Rdtn_PackContStateAry(Vars, x, ValAry) type(Conv_Rdtn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1043,6 +1027,17 @@ subroutine Conv_Rdtn_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function Conv_Rdtn_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine Conv_Rdtn_PackContStateDerivAry(Vars, x, ValAry) type(Conv_Rdtn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1060,21 +1055,6 @@ subroutine Conv_Rdtn_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine Conv_Rdtn_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine Conv_Rdtn_PackConstrStateAry(Vars, z, ValAry) type(Conv_Rdtn_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1107,6 +1087,17 @@ subroutine Conv_Rdtn_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function Conv_Rdtn_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine Conv_Rdtn_PackInputAry(Vars, u, ValAry) type(Conv_Rdtn_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1139,6 +1130,17 @@ subroutine Conv_Rdtn_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function Conv_Rdtn_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Conv_Rdtn_u_Velocity) + Name = "u%Velocity" + case default + Name = "Unknown Field" + end select +end function + subroutine Conv_Rdtn_PackOutputAry(Vars, y, ValAry) type(Conv_Rdtn_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1171,6 +1173,17 @@ subroutine Conv_Rdtn_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function Conv_Rdtn_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + Name = "y%F_Rdtn" + case default + Name = "Unknown Field" + end select +end function + END MODULE Conv_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index fa73b37e83..151eef9cfe 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -72,7 +72,8 @@ MODULE HydroDyn PUBLIC :: HD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - + PUBLIC :: HD_PackExtInputAry ! Pack extended inputs + CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -1692,11 +1693,23 @@ SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg = '' ! Get extended input variable indices - iVarWaveElev0 = MV_FindVarDatLoc(Vars%u, DatLoc(HydroDyn_u_WaveElev0)) - iVarHWindSpeed = MV_FindVarDatLoc(Vars%u, DatLoc(HydroDyn_u_HWindSpeed)) - iVarPLexp = MV_FindVarDatLoc(Vars%u, DatLoc(HydroDyn_u_PLexp)) - iVarPropagationDir = MV_FindVarDatLoc(Vars%u, DatLoc(HydroDyn_u_PropagationDir)) - + iVarWaveElev0 = 0 + iVarHWindSpeed = 0 + iVarPLexp = 0 + iVarPropagationDir = 0 + do i = 1, size(Vars%u) + select case (Vars%u(i)%DL%Num) + case (HydroDyn_u_WaveElev0) + iVarWaveElev0 = i + case (HydroDyn_u_HWindSpeed) + iVarHWindSpeed = i + case (HydroDyn_u_PLexp) + iVarPLexp = i + case (HydroDyn_u_PropagationDir) + iVarPropagationDir = i + end select + end do + ! make a copy of the inputs to perturb call HydroDyn_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -1715,7 +1728,7 @@ SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, do i = 1, size(Vars%u) ! If variable is extended input, skip - if (MV_HasFlags(Vars%u(i), VF_ExtLin)) cycle + if (MV_HasFlagsAll(Vars%u(i), VF_ExtLin)) cycle ! Loop through number of linearization perturbations in variable do j = 1, Vars%u(i)%Num @@ -1741,10 +1754,10 @@ SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, end do ! Set extended inputs - dYdu(:, Vars%u(iVarWaveElev0)%iLoc(1)) = 0.0_R8Ki - dYdu(:, Vars%u(iVarHWindSpeed)%iLoc(1)) = 0.0_R8Ki - dYdu(:, Vars%u(iVarPLexp)%iLoc(1)) = 0.0_R8Ki - dYdu(:, Vars%u(iVarPropagationDir)%iLoc(1)) = 0.0_R8Ki + if (iVarWaveElev0 > 0) dYdu(:, Vars%u(iVarWaveElev0)%iLoc(1)) = 0.0_R8Ki + if (iVarHWindSpeed > 0) dYdu(:, Vars%u(iVarHWindSpeed)%iLoc(1)) = 0.0_R8Ki + if (iVarPLexp > 0) dYdu(:, Vars%u(iVarPLexp)%iLoc(1)) = 0.0_R8Ki + if (iVarPropagationDir > 0) dYdu(:, Vars%u(iVarPropagationDir)%iLoc(1)) = 0.0_R8Ki END IF @@ -2099,5 +2112,33 @@ SUBROUTINE HD_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, Er END SUBROUTINE HD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +subroutine HD_PackExtInputAry(Vars, u, ValAry) + type(ModVarsType), intent(in) :: Vars !< Module variables + type(HydroDyn_InputType), intent(in) :: u !< Inputs + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + + ! Loop through Input variables + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + ! Select based on data location number + select case (Var%DL%Num) + case (HydroDyn_u_WaveElev0) + ! Wave elevation from SeaState + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + case (HydroDyn_u_HWindSpeed) + ! Current velocity from SeaState + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + case (HydroDyn_u_PLexp) + ! Current shear coefficient from SeaState + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + case (HydroDyn_u_PropagationDir) + ! Current propagation direction from SeaState + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine + END MODULE HydroDyn !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index c98b7bbdbc..393f6726a7 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -26,9 +26,9 @@ param HydroDyn/HydroDyn unused INTEGER param HydroDyn/HydroDyn unused INTEGER MaxUserOutputs - 5150 - " Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150" - param ^ ^ IntKi HydroDyn_u_WaveElev0 - -1 - "WaveElev0 Extended input DatLoc number" - -param ^ ^ IntKi HydroDyn_u_HWindSpeed - -1 - "HWindSpeed extended input DatLoc number" - -param ^ ^ IntKi HydroDyn_u_PLexp - -1 - "PLexp extended input DatLoc number" - -param ^ ^ IntKi HydroDyn_u_PropagationDir - -1 - "PropagationDir extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_HWindSpeed - -2 - "HWindSpeed extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_PLexp - -3 - "PLexp extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_PropagationDir - -4 - "PropagationDir extended input DatLoc number" - ######################### # ..... Input file data ........................................................................................................... diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index ca8b2ede5d..26c5d7593b 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -42,9 +42,9 @@ MODULE HydroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_WaveElev0 = -1 ! WaveElev0 Extended input DatLoc number [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_HWindSpeed = -1 ! HWindSpeed extended input DatLoc number [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PLexp = -1 ! PLexp extended input DatLoc number [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PropagationDir = -1 ! PropagationDir extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_HWindSpeed = -2 ! HWindSpeed extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PLexp = -3 ! PLexp extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PropagationDir = -4 ! PropagationDir extended input DatLoc number [-] ! ========= HydroDyn_InputFile ======= TYPE, PUBLIC :: HydroDyn_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -2613,20 +2613,6 @@ function HydroDyn_InputMeshPointer(u, DL) result(Mesh) end select end function -function HydroDyn_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (HydroDyn_u_Morison_Mesh) - Name = "u%Morison%Mesh" - case (HydroDyn_u_WAMITMesh) - Name = "u%WAMITMesh" - case (HydroDyn_u_PRPMesh) - Name = "u%PRPMesh" - end select -end function - function HydroDyn_OutputMeshPointer(y, DL) result(Mesh) type(HydroDyn_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -2646,24 +2632,6 @@ function HydroDyn_OutputMeshPointer(y, DL) result(Mesh) end select end function -function HydroDyn_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (HydroDyn_y_WAMIT_Mesh) - Name = "y%WAMIT("//trim(Num2LStr(DL%i1))//")%Mesh" - case (HydroDyn_y_WAMIT2_Mesh) - Name = "y%WAMIT2("//trim(Num2LStr(DL%i1))//")%Mesh" - case (HydroDyn_y_Morison_Mesh) - Name = "y%Morison%Mesh" - case (HydroDyn_y_Morison_VisMesh) - Name = "y%Morison%VisMesh" - case (HydroDyn_y_WAMITMesh) - Name = "y%WAMITMesh" - end select -end function - subroutine HydroDyn_PackContStateAry(Vars, x, ValAry) type(HydroDyn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2708,6 +2676,23 @@ subroutine HydroDyn_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function HydroDyn_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + Name = "x%WAMIT("//trim(Num2LStr(DL%i1))//")%SS_Rdtn%x" + case (HydroDyn_x_WAMIT_SS_Exctn_x) + Name = "x%WAMIT("//trim(Num2LStr(DL%i1))//")%SS_Exctn%x" + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + Name = "x%WAMIT("//trim(Num2LStr(DL%i1))//")%Conv_Rdtn%DummyContState" + case (HydroDyn_x_Morison_DummyContState) + Name = "x%Morison%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine HydroDyn_PackContStateDerivAry(Vars, x, ValAry) type(HydroDyn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2731,27 +2716,6 @@ subroutine HydroDyn_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine HydroDyn_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(HydroDyn_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (HydroDyn_x_WAMIT_SS_Rdtn_x) - call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%SS_Rdtn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (HydroDyn_x_WAMIT_SS_Exctn_x) - call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%SS_Exctn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) - call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState) ! Scalar - case (HydroDyn_x_Morison_DummyContState) - call MV_Unpack(V, ValAry, x%Morison%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine HydroDyn_PackConstrStateAry(Vars, z, ValAry) type(HydroDyn_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2796,6 +2760,23 @@ subroutine HydroDyn_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function HydroDyn_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + Name = "z%WAMIT%Conv_Rdtn%DummyConstrState" + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + Name = "z%WAMIT%SS_Rdtn%DummyConstrState" + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + Name = "z%WAMIT%SS_Exctn%DummyConstrState" + case (HydroDyn_z_Morison_DummyConstrState) + Name = "z%Morison%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine HydroDyn_PackInputAry(Vars, u, ValAry) type(HydroDyn_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2836,6 +2817,21 @@ subroutine HydroDyn_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function HydroDyn_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + Name = "u%Morison%Mesh" + case (HydroDyn_u_WAMITMesh) + Name = "u%WAMITMesh" + case (HydroDyn_u_PRPMesh) + Name = "u%PRPMesh" + case default + Name = "Unknown Field" + end select +end function + subroutine HydroDyn_PackOutputAry(Vars, y, ValAry) type(HydroDyn_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2892,6 +2888,29 @@ subroutine HydroDyn_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function HydroDyn_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + Name = "y%WAMIT("//trim(Num2LStr(DL%i1))//")%Mesh" + case (HydroDyn_y_WAMIT2_Mesh) + Name = "y%WAMIT2("//trim(Num2LStr(DL%i1))//")%Mesh" + case (HydroDyn_y_Morison_Mesh) + Name = "y%Morison%Mesh" + case (HydroDyn_y_Morison_VisMesh) + Name = "y%Morison%VisMesh" + case (HydroDyn_y_Morison_WriteOutput) + Name = "y%Morison%WriteOutput" + case (HydroDyn_y_WAMITMesh) + Name = "y%WAMITMesh" + case (HydroDyn_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE HydroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 477ceb165c..b35f1f4809 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -4676,16 +4676,6 @@ function Morison_InputMeshPointer(u, DL) result(Mesh) end select end function -function Morison_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (Morison_u_Mesh) - Name = "u%Mesh" - end select -end function - function Morison_OutputMeshPointer(y, DL) result(Mesh) type(Morison_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -4699,18 +4689,6 @@ function Morison_OutputMeshPointer(y, DL) result(Mesh) end select end function -function Morison_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (Morison_y_Mesh) - Name = "y%Mesh" - case (Morison_y_VisMesh) - Name = "y%VisMesh" - end select -end function - subroutine Morison_PackContStateAry(Vars, x, ValAry) type(Morison_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -4743,6 +4721,17 @@ subroutine Morison_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function Morison_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Morison_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine Morison_PackContStateDerivAry(Vars, x, ValAry) type(Morison_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -4760,21 +4749,6 @@ subroutine Morison_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine Morison_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Morison_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Morison_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine Morison_PackConstrStateAry(Vars, z, ValAry) type(Morison_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -4807,6 +4781,17 @@ subroutine Morison_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function Morison_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Morison_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine Morison_PackInputAry(Vars, u, ValAry) type(Morison_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -4839,6 +4824,17 @@ subroutine Morison_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function Morison_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Morison_u_Mesh) + Name = "u%Mesh" + case default + Name = "Unknown Field" + end select +end function + subroutine Morison_PackOutputAry(Vars, y, ValAry) type(Morison_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -4879,6 +4875,21 @@ subroutine Morison_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function Morison_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Morison_y_Mesh) + Name = "y%Mesh" + case (Morison_y_VisMesh) + Name = "y%VisMesh" + case (Morison_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE Morison_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 3ad29cfb38..c6585501e6 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -1167,14 +1167,6 @@ function SS_Exc_InputMeshPointer(u, DL) result(Mesh) end select end function -function SS_Exc_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function SS_Exc_OutputMeshPointer(y, DL) result(Mesh) type(SS_Exc_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1184,14 +1176,6 @@ function SS_Exc_OutputMeshPointer(y, DL) result(Mesh) end select end function -function SS_Exc_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine SS_Exc_PackContStateAry(Vars, x, ValAry) type(SS_Exc_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1224,6 +1208,17 @@ subroutine SS_Exc_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function SS_Exc_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Exc_x_x) + Name = "x%x" + case default + Name = "Unknown Field" + end select +end function + subroutine SS_Exc_PackContStateDerivAry(Vars, x, ValAry) type(SS_Exc_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1241,21 +1236,6 @@ subroutine SS_Exc_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine SS_Exc_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Exc_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SS_Exc_x_x) - call MV_Unpack(V, ValAry, x%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine SS_Exc_PackConstrStateAry(Vars, z, ValAry) type(SS_Exc_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1288,6 +1268,17 @@ subroutine SS_Exc_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function SS_Exc_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Exc_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine SS_Exc_PackInputAry(Vars, u, ValAry) type(SS_Exc_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1320,6 +1311,17 @@ subroutine SS_Exc_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function SS_Exc_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Exc_u_PtfmPos) + Name = "u%PtfmPos" + case default + Name = "Unknown Field" + end select +end function + subroutine SS_Exc_PackOutputAry(Vars, y, ValAry) type(SS_Exc_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1356,6 +1358,19 @@ subroutine SS_Exc_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function SS_Exc_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Exc_y_y) + Name = "y%y" + case (SS_Exc_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SS_Excitation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 578c020384..d09e0c5cd3 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -1088,14 +1088,6 @@ function SS_Rad_InputMeshPointer(u, DL) result(Mesh) end select end function -function SS_Rad_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function SS_Rad_OutputMeshPointer(y, DL) result(Mesh) type(SS_Rad_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1105,14 +1097,6 @@ function SS_Rad_OutputMeshPointer(y, DL) result(Mesh) end select end function -function SS_Rad_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine SS_Rad_PackContStateAry(Vars, x, ValAry) type(SS_Rad_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1145,6 +1129,17 @@ subroutine SS_Rad_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function SS_Rad_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Rad_x_x) + Name = "x%x" + case default + Name = "Unknown Field" + end select +end function + subroutine SS_Rad_PackContStateDerivAry(Vars, x, ValAry) type(SS_Rad_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1162,21 +1157,6 @@ subroutine SS_Rad_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine SS_Rad_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SS_Rad_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SS_Rad_x_x) - call MV_Unpack(V, ValAry, x%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine SS_Rad_PackConstrStateAry(Vars, z, ValAry) type(SS_Rad_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1209,6 +1189,17 @@ subroutine SS_Rad_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function SS_Rad_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Rad_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine SS_Rad_PackInputAry(Vars, u, ValAry) type(SS_Rad_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1241,6 +1232,17 @@ subroutine SS_Rad_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function SS_Rad_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Rad_u_dq) + Name = "u%dq" + case default + Name = "Unknown Field" + end select +end function + subroutine SS_Rad_PackOutputAry(Vars, y, ValAry) type(SS_Rad_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1277,6 +1279,19 @@ subroutine SS_Rad_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function SS_Rad_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Rad_y_y) + Name = "y%y" + case (SS_Rad_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SS_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 142efd3543..e4d87d5bb9 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -645,16 +645,6 @@ function WAMIT2_OutputMeshPointer(y, DL) result(Mesh) end select end function -function WAMIT2_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (WAMIT2_y_Mesh) - Name = "y%Mesh" - end select -end function - subroutine WAMIT2_PackOutputAry(Vars, y, ValAry) type(WAMIT2_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -687,6 +677,17 @@ subroutine WAMIT2_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function WAMIT2_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT2_y_Mesh) + Name = "y%Mesh" + case default + Name = "Unknown Field" + end select +end function + END MODULE WAMIT2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 3029684733..a1299a79af 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -1445,16 +1445,6 @@ function WAMIT_InputMeshPointer(u, DL) result(Mesh) end select end function -function WAMIT_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (WAMIT_u_Mesh) - Name = "u%Mesh" - end select -end function - function WAMIT_OutputMeshPointer(y, DL) result(Mesh) type(WAMIT_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1466,16 +1456,6 @@ function WAMIT_OutputMeshPointer(y, DL) result(Mesh) end select end function -function WAMIT_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (WAMIT_y_Mesh) - Name = "y%Mesh" - end select -end function - subroutine WAMIT_PackContStateAry(Vars, x, ValAry) type(WAMIT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1516,6 +1496,21 @@ subroutine WAMIT_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function WAMIT_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + Name = "x%SS_Rdtn%x" + case (WAMIT_x_SS_Exctn_x) + Name = "x%SS_Exctn%x" + case (WAMIT_x_Conv_Rdtn_DummyContState) + Name = "x%Conv_Rdtn%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine WAMIT_PackContStateDerivAry(Vars, x, ValAry) type(WAMIT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1537,25 +1532,6 @@ subroutine WAMIT_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine WAMIT_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(WAMIT_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (WAMIT_x_SS_Rdtn_x) - call MV_Unpack(V, ValAry, x%SS_Rdtn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WAMIT_x_SS_Exctn_x) - call MV_Unpack(V, ValAry, x%SS_Exctn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WAMIT_x_Conv_Rdtn_DummyContState) - call MV_Unpack(V, ValAry, x%Conv_Rdtn%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine WAMIT_PackConstrStateAry(Vars, z, ValAry) type(WAMIT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1596,6 +1572,21 @@ subroutine WAMIT_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function WAMIT_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + Name = "z%Conv_Rdtn%DummyConstrState" + case (WAMIT_z_SS_Rdtn_DummyConstrState) + Name = "z%SS_Rdtn%DummyConstrState" + case (WAMIT_z_SS_Exctn_DummyConstrState) + Name = "z%SS_Exctn%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine WAMIT_PackInputAry(Vars, u, ValAry) type(WAMIT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1628,6 +1619,17 @@ subroutine WAMIT_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function WAMIT_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT_u_Mesh) + Name = "u%Mesh" + case default + Name = "Unknown Field" + end select +end function + subroutine WAMIT_PackOutputAry(Vars, y, ValAry) type(WAMIT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1660,6 +1662,17 @@ subroutine WAMIT_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function WAMIT_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT_y_Mesh) + Name = "y%Mesh" + case default + Name = "Unknown Field" + end select +end function + END MODULE WAMIT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 290e11de69..bf8ebc01bd 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -1758,16 +1758,6 @@ function IceD_InputMeshPointer(u, DL) result(Mesh) end select end function -function IceD_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (IceD_u_PointMesh) - Name = "u%PointMesh" - end select -end function - function IceD_OutputMeshPointer(y, DL) result(Mesh) type(IceD_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1779,16 +1769,6 @@ function IceD_OutputMeshPointer(y, DL) result(Mesh) end select end function -function IceD_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (IceD_y_PointMesh) - Name = "y%PointMesh" - end select -end function - subroutine IceD_PackContStateAry(Vars, x, ValAry) type(IceD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1825,6 +1805,19 @@ subroutine IceD_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function IceD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceD_x_q) + Name = "x%q" + case (IceD_x_dqdt) + Name = "x%dqdt" + case default + Name = "Unknown Field" + end select +end function + subroutine IceD_PackContStateDerivAry(Vars, x, ValAry) type(IceD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1844,23 +1837,6 @@ subroutine IceD_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine IceD_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(IceD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (IceD_x_q) - call MV_Unpack(V, ValAry, x%q) ! Scalar - case (IceD_x_dqdt) - call MV_Unpack(V, ValAry, x%dqdt) ! Scalar - end select - end associate - end do -end subroutine - subroutine IceD_PackConstrStateAry(Vars, z, ValAry) type(IceD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1893,6 +1869,17 @@ subroutine IceD_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function IceD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceD_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine IceD_PackInputAry(Vars, u, ValAry) type(IceD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1925,6 +1912,17 @@ subroutine IceD_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function IceD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceD_u_PointMesh) + Name = "u%PointMesh" + case default + Name = "Unknown Field" + end select +end function + subroutine IceD_PackOutputAry(Vars, y, ValAry) type(IceD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1961,6 +1959,19 @@ subroutine IceD_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function IceD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceD_y_PointMesh) + Name = "y%PointMesh" + case (IceD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE IceDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 5071995252..afb26f4e20 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -1039,16 +1039,6 @@ function IceFloe_InputMeshPointer(u, DL) result(Mesh) end select end function -function IceFloe_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (IceFloe_u_iceMesh) - Name = "u%iceMesh" - end select -end function - function IceFloe_OutputMeshPointer(y, DL) result(Mesh) type(IceFloe_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1060,16 +1050,6 @@ function IceFloe_OutputMeshPointer(y, DL) result(Mesh) end select end function -function IceFloe_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (IceFloe_y_iceMesh) - Name = "y%iceMesh" - end select -end function - subroutine IceFloe_PackContStateAry(Vars, x, ValAry) type(IceFloe_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1102,6 +1082,17 @@ subroutine IceFloe_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function IceFloe_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + Name = "x%DummyContStateVar" + case default + Name = "Unknown Field" + end select +end function + subroutine IceFloe_PackContStateDerivAry(Vars, x, ValAry) type(IceFloe_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1119,21 +1110,6 @@ subroutine IceFloe_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine IceFloe_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(IceFloe_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (IceFloe_x_DummyContStateVar) - call MV_Unpack(V, ValAry, x%DummyContStateVar) ! Scalar - end select - end associate - end do -end subroutine - subroutine IceFloe_PackConstrStateAry(Vars, z, ValAry) type(IceFloe_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1166,6 +1142,17 @@ subroutine IceFloe_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function IceFloe_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceFloe_z_DummyConstrStateVar) + Name = "z%DummyConstrStateVar" + case default + Name = "Unknown Field" + end select +end function + subroutine IceFloe_PackInputAry(Vars, u, ValAry) type(IceFloe_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1198,6 +1185,17 @@ subroutine IceFloe_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function IceFloe_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceFloe_u_iceMesh) + Name = "u%iceMesh" + case default + Name = "Unknown Field" + end select +end function + subroutine IceFloe_PackOutputAry(Vars, y, ValAry) type(IceFloe_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1234,6 +1232,19 @@ subroutine IceFloe_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function IceFloe_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceFloe_y_iceMesh) + Name = "y%iceMesh" + case (IceFloe_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE IceFloe_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index b320e52e48..c9d9c4e2ba 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -1909,14 +1909,6 @@ function InflowWind_InputMeshPointer(u, DL) result(Mesh) end select end function -function InflowWind_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function InflowWind_OutputMeshPointer(y, DL) result(Mesh) type(InflowWind_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1926,14 +1918,6 @@ function InflowWind_OutputMeshPointer(y, DL) result(Mesh) end select end function -function InflowWind_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine InflowWind_PackContStateAry(Vars, x, ValAry) type(InflowWind_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1966,6 +1950,17 @@ subroutine InflowWind_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function InflowWind_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (InflowWind_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine InflowWind_PackContStateDerivAry(Vars, x, ValAry) type(InflowWind_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1983,21 +1978,6 @@ subroutine InflowWind_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine InflowWind_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(InflowWind_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (InflowWind_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine InflowWind_PackConstrStateAry(Vars, z, ValAry) type(InflowWind_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2030,6 +2010,17 @@ subroutine InflowWind_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function InflowWind_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (InflowWind_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine InflowWind_PackInputAry(Vars, u, ValAry) type(InflowWind_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2090,6 +2081,31 @@ subroutine InflowWind_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function InflowWind_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (InflowWind_u_PositionXYZ) + Name = "u%PositionXYZ" + case (InflowWind_u_lidar_PulseLidEl) + Name = "u%lidar%PulseLidEl" + case (InflowWind_u_lidar_PulseLidAz) + Name = "u%lidar%PulseLidAz" + case (InflowWind_u_lidar_HubDisplacementX) + Name = "u%lidar%HubDisplacementX" + case (InflowWind_u_lidar_HubDisplacementY) + Name = "u%lidar%HubDisplacementY" + case (InflowWind_u_lidar_HubDisplacementZ) + Name = "u%lidar%HubDisplacementZ" + case (InflowWind_u_HubPosition) + Name = "u%HubPosition" + case (InflowWind_u_HubOrientation) + Name = "u%HubOrientation" + case default + Name = "Unknown Field" + end select +end function + subroutine InflowWind_PackOutputAry(Vars, y, ValAry) type(InflowWind_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2158,6 +2174,35 @@ subroutine InflowWind_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function InflowWind_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (InflowWind_y_VelocityUVW) + Name = "y%VelocityUVW" + case (InflowWind_y_AccelUVW) + Name = "y%AccelUVW" + case (InflowWind_y_WriteOutput) + Name = "y%WriteOutput" + case (InflowWind_y_DiskVel) + Name = "y%DiskVel" + case (InflowWind_y_HubVel) + Name = "y%HubVel" + case (InflowWind_y_lidar_LidSpeed) + Name = "y%lidar%LidSpeed" + case (InflowWind_y_lidar_WtTrunc) + Name = "y%lidar%WtTrunc" + case (InflowWind_y_lidar_MsrPositionsX) + Name = "y%lidar%MsrPositionsX" + case (InflowWind_y_lidar_MsrPositionsY) + Name = "y%lidar%MsrPositionsY" + case (InflowWind_y_lidar_MsrPositionsZ) + Name = "y%lidar%MsrPositionsZ" + case default + Name = "Unknown Field" + end select +end function + END MODULE InflowWind_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 08c1ba8ae1..f9aa0330ab 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -1119,14 +1119,6 @@ function Lidar_InputMeshPointer(u, DL) result(Mesh) end select end function -function Lidar_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function Lidar_OutputMeshPointer(y, DL) result(Mesh) type(Lidar_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1136,14 +1128,6 @@ function Lidar_OutputMeshPointer(y, DL) result(Mesh) end select end function -function Lidar_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine Lidar_PackContStateAry(Vars, x, ValAry) type(Lidar_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1176,6 +1160,17 @@ subroutine Lidar_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function Lidar_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Lidar_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine Lidar_PackContStateDerivAry(Vars, x, ValAry) type(Lidar_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1193,21 +1188,6 @@ subroutine Lidar_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine Lidar_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Lidar_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Lidar_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine Lidar_PackConstrStateAry(Vars, z, ValAry) type(Lidar_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1240,6 +1220,17 @@ subroutine Lidar_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function Lidar_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Lidar_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine Lidar_PackInputAry(Vars, u, ValAry) type(Lidar_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1288,6 +1279,25 @@ subroutine Lidar_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function Lidar_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Lidar_u_PulseLidEl) + Name = "u%PulseLidEl" + case (Lidar_u_PulseLidAz) + Name = "u%PulseLidAz" + case (Lidar_u_HubDisplacementX) + Name = "u%HubDisplacementX" + case (Lidar_u_HubDisplacementY) + Name = "u%HubDisplacementY" + case (Lidar_u_HubDisplacementZ) + Name = "u%HubDisplacementZ" + case default + Name = "Unknown Field" + end select +end function + subroutine Lidar_PackOutputAry(Vars, y, ValAry) type(Lidar_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1336,6 +1346,25 @@ subroutine Lidar_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function Lidar_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Lidar_y_LidSpeed) + Name = "y%LidSpeed" + case (Lidar_y_WtTrunc) + Name = "y%WtTrunc" + case (Lidar_y_MsrPositionsX) + Name = "y%MsrPositionsX" + case (Lidar_y_MsrPositionsY) + Name = "y%MsrPositionsY" + case (Lidar_y_MsrPositionsZ) + Name = "y%MsrPositionsZ" + case default + Name = "Unknown Field" + end select +end function + END MODULE Lidar_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/lindyn/src/LinDyn_Types.f90 b/modules/lindyn/src/LinDyn_Types.f90 index 7dfd1ead99..9afa269f77 100644 --- a/modules/lindyn/src/LinDyn_Types.f90 +++ b/modules/lindyn/src/LinDyn_Types.f90 @@ -1571,14 +1571,6 @@ function LD_InputMeshPointer(u, DL) result(Mesh) end select end function -function LD_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function LD_OutputMeshPointer(y, DL) result(Mesh) type(LD_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1588,14 +1580,6 @@ function LD_OutputMeshPointer(y, DL) result(Mesh) end select end function -function LD_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine LD_PackContStateAry(Vars, x, ValAry) type(LD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1628,6 +1612,17 @@ subroutine LD_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function LD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (LD_x_q) + Name = "x%q" + case default + Name = "Unknown Field" + end select +end function + subroutine LD_PackContStateDerivAry(Vars, x, ValAry) type(LD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1645,21 +1640,6 @@ subroutine LD_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine LD_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(LD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (LD_x_q) - call MV_Unpack(V, ValAry, x%q(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine LD_PackConstrStateAry(Vars, z, ValAry) type(LD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1692,6 +1672,17 @@ subroutine LD_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function LD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (LD_z_Dummy) + Name = "z%Dummy" + case default + Name = "Unknown Field" + end select +end function + subroutine LD_PackInputAry(Vars, u, ValAry) type(LD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1724,6 +1715,17 @@ subroutine LD_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function LD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (LD_u_Fext) + Name = "u%Fext" + case default + Name = "Unknown Field" + end select +end function + subroutine LD_PackOutputAry(Vars, y, ValAry) type(LD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1760,6 +1762,19 @@ subroutine LD_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function LD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (LD_y_xdd) + Name = "y%xdd" + case (LD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE LinDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index c1269d4443..89e6d8b007 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -3023,16 +3023,6 @@ function MAP_InputMeshPointer(u, DL) result(Mesh) end select end function -function MAP_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (MAP_u_PtFairDisplacement) - Name = "u%PtFairDisplacement" - end select -end function - function MAP_OutputMeshPointer(y, DL) result(Mesh) type(MAP_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -3044,16 +3034,6 @@ function MAP_OutputMeshPointer(y, DL) result(Mesh) end select end function -function MAP_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (MAP_y_ptFairleadLoad) - Name = "y%ptFairleadLoad" - end select -end function - subroutine MAP_PackContStateAry(Vars, x, ValAry) type(MAP_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -3086,6 +3066,17 @@ subroutine MAP_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function MAP_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MAP_x_dummy) + Name = "x%dummy" + case default + Name = "Unknown Field" + end select +end function + subroutine MAP_PackContStateDerivAry(Vars, x, ValAry) type(MAP_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -3103,21 +3094,6 @@ subroutine MAP_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine MAP_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(MAP_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (MAP_x_dummy) - call MV_Unpack(V, ValAry, x%dummy) ! Scalar - end select - end associate - end do -end subroutine - subroutine MAP_PackConstrStateAry(Vars, z, ValAry) type(MAP_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -3166,6 +3142,25 @@ subroutine MAP_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function MAP_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MAP_z_H) + Name = "z%H" + case (MAP_z_V) + Name = "z%V" + case (MAP_z_x) + Name = "z%x" + case (MAP_z_y) + Name = "z%y" + case (MAP_z_z) + Name = "z%z" + case default + Name = "Unknown Field" + end select +end function + subroutine MAP_PackInputAry(Vars, u, ValAry) type(MAP_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -3210,6 +3205,23 @@ subroutine MAP_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function MAP_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MAP_u_x) + Name = "u%x" + case (MAP_u_y) + Name = "u%y" + case (MAP_u_z) + Name = "u%z" + case (MAP_u_PtFairDisplacement) + Name = "u%PtFairDisplacement" + case default + Name = "Unknown Field" + end select +end function + subroutine MAP_PackOutputAry(Vars, y, ValAry) type(MAP_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -3262,6 +3274,27 @@ subroutine MAP_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function MAP_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MAP_y_Fx) + Name = "y%Fx" + case (MAP_y_Fy) + Name = "y%Fy" + case (MAP_y_Fz) + Name = "y%Fz" + case (MAP_y_WriteOutput) + Name = "y%WriteOutput" + case (MAP_y_wrtOutput) + Name = "y%wrtOutput" + case (MAP_y_ptFairleadLoad) + Name = "y%ptFairleadLoad" + case default + Name = "Unknown Field" + end select +end function + END MODULE MAP_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index aa29de2bb1..c20a29d0aa 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -47,7 +47,6 @@ MODULE MoorDyn PUBLIC :: MD_JacobianPInput PUBLIC :: MD_JacobianPDiscState PUBLIC :: MD_JacobianPConstrState - PUBLIC :: MD_GetOP CONTAINS @@ -2622,7 +2621,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er z%dummy = 0 ! Initialize module variables - call MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2); if(Failed()) return + call MD_InitVars(InitOut%Vars, InitInp, u, p, x, z, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2); if(Failed()) return CALL WrScr(' MoorDyn initialization completed.') if (p%writeLog > 0) then @@ -2735,7 +2734,8 @@ END SUBROUTINE MD_Init !----------------------------------------------------------------------------------------------------------------------- !> This routine initializes module variables for use by the solver and linearization. - subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrMsg) + subroutine MD_InitVars(Vars, InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables type(MD_InitInputType), intent(in) :: InitInp !< Initialization input type(MD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(MD_ParameterType), intent(inout) :: p !< Parameters @@ -2766,17 +2766,6 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ErrStat = ErrID_None ErrMsg = "" - ! Allocate space for variables (deallocate if already allocated) - if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Add pointers to vars to initialization output - InitOut%Vars => p%Vars - !------------------------------------------------------------------------- ! Perturbation sizes !------------------------------------------------------------------------- @@ -2820,7 +2809,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If coupled pinned body if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, & + call MV_AddVar(Vars%x, LinStr, FieldAngularDisp, & DL=DatLoc(MD_x_states), & iAry=m%BodyStateIs1(l)+3, & Num=3, Flags=VF_DerivOrder2, & @@ -2828,14 +2817,14 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, & + call MV_AddVar(Vars%x, LinStr, FieldTransDisp, & DL=DatLoc(MD_x_states), & iAry=m%BodyStateIs1(l)+6, & Num=3, Flags=VF_DerivOrder2, & Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, & + call MV_AddVar(Vars%x, LinStr, FieldAngularDisp, & DL=DatLoc(MD_x_states), & iAry=m%BodyStateIs1(l)+9, & Num=3, Flags=VF_DerivOrder2, & @@ -2851,20 +2840,20 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If pinned rod if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldAngularDisp, DatLoc(MD_x_states), & iAry=m%RodStateIs1(l)+3, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.02_R8Ki, & LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & iAry=m%RodStateIs1(l)+6, & Num=3, Flags=VF_DerivOrder2, & Perturb=dl_slack_min, & LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularDisp, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldAngularDisp, DatLoc(MD_x_states), & iAry=m%RodStateIs1(l)+9, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.02_R8Ki, & @@ -2876,7 +2865,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) - call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & iAry=m%PointStateIs1(l)+3, & ! x%state index Num=3, Flags=VF_DerivOrder2, & Perturb=dl_slack_min, & @@ -2889,7 +2878,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E N = m%LineList(l)%N ! number of segments in the line do i = 0, N-2 LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) - call MV_AddVar(p%Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & iAry=m%LineStateIs1(l) + 3*N + 3*i - 3, & ! x%state index Num=3, Flags=VF_DerivOrder2, & Perturb=dl_slack_min, & @@ -2908,20 +2897,20 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If coupled pinned body if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & iAry=m%BodyStateIs1(l)+0, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & iAry=m%BodyStateIs1(l)+0, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & iAry=m%BodyStateIs1(l)+3, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & @@ -2936,20 +2925,20 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! If pinned rod if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & iAry=m%RodStateIs1(l)+0, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) else ! Add translation displacement - call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & iAry=m%RodStateIs1(l)+0, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) ! Add angular displacement - call MV_AddVar(p%Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & iAry=m%RodStateIs1(l)+3, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.02_R8Ki, & @@ -2961,7 +2950,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) - call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & iAry=m%PointStateIs1(l)+0, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & @@ -2974,7 +2963,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E N = m%LineList(l)%N ! number of segments in the line do i = 0, N-2 LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) - call MV_AddVar(p%Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & iAry=m%LineStateIs1(l) + 3*i + 0, & Num=3, Flags=VF_DerivOrder2, & Perturb=0.1_R8Ki, & @@ -2986,10 +2975,10 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! Input variables !------------------------------------------------------------------------- - allocate(p%Vars%u(0)) + allocate(Vars%u(0)) do i = 1, p%nTurbines - call MV_AddMeshVar(p%Vars%u, "CoupledKinematics", MotionFields, & + call MV_AddMeshVar(Vars%u, "CoupledKinematics", MotionFields, & DatLoc(MD_u_CoupledKinematics, i), & Mesh=u%CoupledKinematics(i), & Perturbs=[dl_slack_min, & ! FieldTransDisp @@ -3022,12 +3011,12 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E LinStr = '(lines: none)' end if - call MV_AddVar(p%Vars%u, "DeltaL "//trim(num2lstr(i)), FieldTransDisp, & + call MV_AddVar(Vars%u, "DeltaL "//trim(num2lstr(i)), FieldTransDisp, & DatLoc(MD_u_DeltaL), iAry=i, & Perturb=dl_slack_min, & LinNames=['CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr)]) - call MV_AddVar(p%Vars%u, "DeltaLdot "//trim(num2lstr(i)), FieldTransVel, & + call MV_AddVar(Vars%u, "DeltaLdot "//trim(num2lstr(i)), FieldTransVel, & DatLoc(MD_u_DeltaLdot), iAry=i, & Perturb=0.2_R8Ki, & LinNames=['CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr)]) @@ -3039,13 +3028,13 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E !------------------------------------------------------------------------- do i = 1, p%nTurbines - call MV_AddMeshVar(p%Vars%y, "LinNames_y", LoadFields, & + call MV_AddMeshVar(Vars%y, "LinNames_y", LoadFields, & DatLoc(MD_y_CoupledLoads, i), & Mesh=y%CoupledLoads(i)) end do ! Write outputs - call MV_AddVar(p%Vars%y, "WriteOutput", FieldScalar, DatLoc(MD_y_WriteOutput), & + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(MD_y_WriteOutput), & Flags=VF_WriteOut, & Num=p%numOuts,& LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) @@ -3054,7 +3043,7 @@ subroutine MD_InitVars(InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, E ! Initialize Variables and Jacobian data !------------------------------------------------------------------------- - CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return call MD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call MD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -4187,7 +4176,8 @@ END SUBROUTINE TimeStep !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE MD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -4199,7 +4189,6 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] @@ -4209,62 +4198,49 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM character(*), parameter :: RoutineName = 'MD_JacobianPInput' integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc - INTEGER(IntKi) :: i, j, col - type(ModVarsType), pointer :: VarsL + INTEGER(IntKi) :: i, j, iCol ErrStat = ErrID_None ErrMsg = '' - ! If vars were provided use them, otherwise use module variables - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - ! Get OP values here call MD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if(Failed()) return ! Copy inputs to perturb call MD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackInputAry(VarsL, u, m%Jac%u) + call MD_PackInputAry(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, VarsL%Ny, VarsL%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(VarsL%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(VarsL%u(i), FlagFilterLoc)) cycle + do i = 1, size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call MD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) - - ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + call MD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,iCol)) end do end do END IF @@ -4274,35 +4250,32 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, VarsL%Nx, VarsL%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables - do i = 1, size(VarsL%u) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(VarsL%u(i), FlagFilterLoc)) cycle + do i = 1, size(Vars%u) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%u(i)%Num + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(VarsL%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) + call MD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputAry(VarsL, m%Jac%u_perturb, m%u_perturb) + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) - - ! Calculate column index - col = VarsL%u(i)%iLoc(1) + j - 1 + call MD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array - dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%u(i)%Perturb) + dXdu(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do end do @@ -4325,7 +4298,8 @@ END SUBROUTINE MD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE MD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -4337,7 +4311,6 @@ SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] @@ -4347,62 +4320,48 @@ SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E character(*), parameter :: RoutineName = 'MD_JacobianPContState' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - logical :: IsFullLin - integer(IntKi) :: FlagFilterLoc - integer(IntKi) :: i, j, col - type(ModVarsType), pointer :: VarsL + integer(IntKi) :: i, j, iCol ErrStat = ErrID_None ErrMsg = '' - - ! If vars were provided use them, otherwise use module variables - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if ! Copy state values call MD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, x, m%Jac%x) + call MD_PackContStateAry(Vars, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, VarsL%Ny, VarsL%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(VarsL%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(VarsL%x(i), FlagFilterLoc)) cycle + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%x(i)%Num + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_pos) + call MD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(VarsL, m%y_lin, m%Jac%y_neg) - - ! Calculate column index - col = VarsL%x(i)%iLoc(1) + j - 1 + call MD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array - call MV_ComputeCentralDiff(VarsL%y, VarsL%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,iCol)) end do end do - end if ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: @@ -4410,35 +4369,32 @@ SUBROUTINE MD_JacobianPContState(t, u, p, x, xd, z, OtherState, y, m, ErrStat, E ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, VarsL%Nx, VarsL%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables - do i = 1, size(VarsL%x) - - ! If variable flag not in flag filter, skip - if (.not. MV_HasFlags(VarsL%x(i), FlagFilterLoc)) cycle + do i = 1, size(Vars%x) ! Loop through number of linearization perturbations in variable - do j = 1, VarsL%x(i)%Num + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 ! Calculate positive perturbation - call MV_Perturb(VarsL%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_pos) + call MD_PackContStateDerivAry(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation - call MV_Perturb(VarsL%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateAry(VarsL, m%Jac%x_perturb, m%x_perturb) + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call MD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_lin, m%Jac%x_neg) - - ! Calculate column index - col = VarsL%x(i)%iLoc(1) + j - 1 + call MD_PackContStateDerivAry(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array - dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * VarsL%x(i)%Perturb) + dXdx(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) end do end do end if @@ -4524,89 +4480,5 @@ SUBROUTINE MD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat IF ( PRESENT(dZdz) ) THEN END IF END SUBROUTINE MD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE MD_GetOP(t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, Vars, u_op, y_op, x_op, dx_op, xd_op, z_op) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(MD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - type(ModVarsType), TARGET, OPTIONAL, INTENT(IN ) :: Vars !< Module variables for packing arrays - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - CHARACTER(*), PARAMETER :: RoutineName = 'MD_GetOP' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - type(ModVarsType), pointer :: VarsL - - ErrStat = ErrID_None - ErrMsg = '' - - ! If vars were provided use them, otherwise use module variables - if (present(Vars)) then - VarsL => Vars - else - VarsL => p%Vars - end if - - ! Inputs - if (present(u_op)) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, VarsL%Nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - call MD_PackInputAry(VarsL, u, u_op) - end if - - ! Outputs - if (present(y_op)) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, VarsL%Ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - call MD_PackOutputAry(VarsL, y, y_op) - end if - - ! Continuous states - if (present(x_op)) then - if (.not. allocated(x_op)) then - call AllocAry(x_op, VarsL%Nx, 'x_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - call MD_PackContStateAry(VarsL, x, x_op) - end if - - ! Continuous state derivatives - if (present(dx_op)) then - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, VarsL%Nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return - end if - call MD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if(Failed()) return - call MD_PackContStateAry(VarsL, m%dxdt_lin, dx_op) - end if - - ! Discrete states - if (present(xd_op)) then - end if - - ! Constraint states - if (present(z_op)) then - end if - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function Failed -END SUBROUTINE MD_GetOP END MODULE MoorDyn diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index e2f520a359..cb99ad8137 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -305,7 +305,7 @@ typedef ^ ^ LOGICAL RotFrame_x {:} typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - typedef ^ ^ IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - -typedef ^ ^ ModVarsType *Vars - - - "Module Variables" - +typedef ^ ^ ModVarsType Vars - - - "Module Variables" - ## ============================== Define Continuous states here: ===================================================================================================================================== @@ -321,8 +321,7 @@ typedef ^ ConstraintStateType SiKi dummy - typedef ^ OtherStateType SiKi dummy - - - "Remove this variable if you have other states" - ## ============================== Parameters ============================================================================================================================================ -typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" "" -typedef ^ ^ IntKi nLineTypes - 0 - "number of line types" "" +typedef ^ ParameterType IntKi nLineTypes - 0 - "number of line types" "" typedef ^ ^ IntKi nRodTypes - 0 - "number of rod types" "" typedef ^ ^ IntKi nPoints - 0 - "number of Point objects" "" typedef ^ ^ IntKi nPointsExtra - 0 - "number of Point objects including space for extra ones that could arise from line failures" "" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 204b2c50e8..24b284643b 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -333,7 +333,7 @@ MODULE MoorDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE MD_InitOutputType ! ======================= ! ========= MD_ContinuousStateType ======= @@ -358,7 +358,6 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_ParameterType ======= TYPE, PUBLIC :: MD_ParameterType - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [] INTEGER(IntKi) :: nLineTypes = 0 !< number of line types [] INTEGER(IntKi) :: nRodTypes = 0 !< number of rod types [] INTEGER(IntKi) :: nPoints = 0 !< number of Point objects [] @@ -2527,7 +2526,9 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if - DstInitOutputData%Vars => SrcInitOutputData%Vars + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -2574,14 +2575,14 @@ subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%DerivOrder_x)) then deallocate(InitOutputData%DerivOrder_x) end if - nullify(InitOutputData%Vars) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(MD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInitOutput' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%writeOutputHdr) call RegPackAlloc(RF, InData%writeOutputUnt) @@ -2595,13 +2596,7 @@ subroutine MD_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%IsLoad_u) call RegPackAlloc(RF, InData%DerivOrder_x) - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2612,8 +2607,6 @@ subroutine MD_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -2627,24 +2620,7 @@ subroutine MD_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -2831,18 +2807,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'MD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(SrcParamData%Vars)) then - if (.not. associated(DstParamData%Vars)) then - allocate(DstParamData%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if DstParamData%nLineTypes = SrcParamData%nLineTypes DstParamData%nRodTypes = SrcParamData%nRodTypes DstParamData%nPoints = SrcParamData%nPoints @@ -3201,12 +3165,6 @@ subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'MD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (associated(ParamData%Vars)) then - call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(ParamData%Vars) - ParamData%Vars => null() - end if if (allocated(ParamData%nCpldBodies)) then deallocate(ParamData%nCpldBodies) end if @@ -3299,15 +3257,7 @@ subroutine MD_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'MD_PackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if call RegPack(RF, InData%nLineTypes) call RegPack(RF, InData%nRodTypes) call RegPack(RF, InData%nPoints) @@ -3408,27 +3358,7 @@ subroutine MD_UnPackParam(RF, OutData) integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if call RegUnpack(RF, OutData%nLineTypes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nRodTypes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nPoints); if (RegCheckErr(RF, RoutineName)) return @@ -5147,16 +5077,6 @@ function MD_InputMeshPointer(u, DL) result(Mesh) end select end function -function MD_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (MD_u_CoupledKinematics) - Name = "u%CoupledKinematics("//trim(Num2LStr(DL%i1))//")" - end select -end function - function MD_OutputMeshPointer(y, DL) result(Mesh) type(MD_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -5176,24 +5096,6 @@ function MD_OutputMeshPointer(y, DL) result(Mesh) end select end function -function MD_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (MD_y_CoupledLoads) - Name = "y%CoupledLoads("//trim(Num2LStr(DL%i1))//")" - case (MD_y_VisLinesMesh) - Name = "y%VisLinesMesh("//trim(Num2LStr(DL%i1))//")" - case (MD_y_VisRodsMesh) - Name = "y%VisRodsMesh("//trim(Num2LStr(DL%i1))//")" - case (MD_y_VisBodiesMesh) - Name = "y%VisBodiesMesh("//trim(Num2LStr(DL%i1))//")" - case (MD_y_VisAnchsMesh) - Name = "y%VisAnchsMesh("//trim(Num2LStr(DL%i1))//")" - end select -end function - subroutine MD_PackContStateAry(Vars, x, ValAry) type(MD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -5226,6 +5128,17 @@ subroutine MD_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function MD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MD_x_states) + Name = "x%states" + case default + Name = "Unknown Field" + end select +end function + subroutine MD_PackContStateDerivAry(Vars, x, ValAry) type(MD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -5243,21 +5156,6 @@ subroutine MD_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine MD_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(MD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (MD_x_states) - call MV_Unpack(V, ValAry, x%states(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine MD_PackConstrStateAry(Vars, z, ValAry) type(MD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -5290,6 +5188,17 @@ subroutine MD_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function MD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MD_z_dummy) + Name = "z%dummy" + case default + Name = "Unknown Field" + end select +end function + subroutine MD_PackInputAry(Vars, u, ValAry) type(MD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -5330,6 +5239,21 @@ subroutine MD_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function MD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MD_u_CoupledKinematics) + Name = "u%CoupledKinematics("//trim(Num2LStr(DL%i1))//")" + case (MD_u_DeltaL) + Name = "u%DeltaL" + case (MD_u_DeltaLdot) + Name = "u%DeltaLdot" + case default + Name = "Unknown Field" + end select +end function + subroutine MD_PackOutputAry(Vars, y, ValAry) type(MD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -5382,6 +5306,27 @@ subroutine MD_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function MD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MD_y_CoupledLoads) + Name = "y%CoupledLoads("//trim(Num2LStr(DL%i1))//")" + case (MD_y_WriteOutput) + Name = "y%WriteOutput" + case (MD_y_VisLinesMesh) + Name = "y%VisLinesMesh("//trim(Num2LStr(DL%i1))//")" + case (MD_y_VisRodsMesh) + Name = "y%VisRodsMesh("//trim(Num2LStr(DL%i1))//")" + case (MD_y_VisBodiesMesh) + Name = "y%VisBodiesMesh("//trim(Num2LStr(DL%i1))//")" + case (MD_y_VisAnchsMesh) + Name = "y%VisAnchsMesh("//trim(Num2LStr(DL%i1))//")" + case default + Name = "Unknown Field" + end select +end function + END MODULE MoorDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 30ed91ef08..bc8c6940a4 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -27,16 +27,18 @@ module ModVar use NWTC_IO use NWTC_Num use ModMesh + implicit none private public :: MV_InitVarsJac, MV_Pack, MV_Unpack -public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff, MV_ExtrapInterp, MV_AddDelta public :: MV_AddVar, MV_AddMeshVar -public :: MV_HasFlags, MV_SetFlags, MV_ClearFlags, MV_NumVars, MV_NumVals, MV_FindVarDatLoc +public :: MV_Perturb, MV_ComputeCentralDiff, MV_ComputeDiff, MV_ExtrapInterp, MV_AddDelta +public :: MV_HasFlagsAll, MV_HasFlagsAny, MV_SetFlags, MV_ClearFlags +public :: MV_NumVars, MV_NumVals, MV_FindVarDatLoc public :: LoadFields, MotionFields, TransFields, AngularFields public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv -public :: MV_FieldString, MV_IsLoad, IdxStr +public :: MV_FieldString, MV_IsLoad, MV_IsMotion, IdxStr public :: DumpMatrix, MV_AddModule public :: MV_EqualDL @@ -349,7 +351,7 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! If this variable belongs to a mesh - if (MV_HasFlags(Var, VF_Mesh)) then + if (MV_HasFlagsAll(Var, VF_Mesh)) then ! Size is the number of nodes in a mesh Var%Nodes = Var%Num @@ -362,7 +364,7 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) ! Set unit description for line mesh UnitDesc = '' - if (MV_HasFlags(Var, VF_Line)) UnitDesc = "/m" + if (MV_HasFlagsAll(Var, VF_Line)) UnitDesc = "/m" ! Switch based on field number select case (Var%Field) @@ -495,7 +497,7 @@ subroutine MV_AddModule(ModDataAry, ModID, ModAbbr, Instance, ModDT, SolverDT, V ! Allocate source and destination mapping indices !---------------------------------------------------------------------------- - allocate(ModData%iSrcMaps(0), ModData%iDstMaps(0)) + allocate (ModData%iSrcMaps(0), ModData%iDstMaps(0)) !---------------------------------------------------------------------------- ! Add module info to array @@ -541,7 +543,6 @@ subroutine GetModuleOrder(ModDataAry, ModIDs, ModOrder) ! Functions for packing and unpacking data by variable !------------------------------------------------------------------------------- - subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) type(ModVarType), intent(in) :: Var integer(IntKi), intent(in) :: iLin @@ -551,7 +552,7 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) real(R8Ki) :: Perturb real(R8Ki) :: quat(3), quat_p(3) - real(R8Ki) :: rv(3), dcm(3,3) + real(R8Ki) :: rv(3), dcm(3, 3) integer(IntKi) :: i, j integer(IntKi) :: ErrStat character(ErrMsgLen) :: ErrMsg @@ -570,10 +571,10 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) i = i - j ! index of start of quaternion parameters (3) quat = BaseAry(i:i + 2) ! Current quat parameters value - if (MV_HasFlags(Var, VF_SmallAngle)) then + if (MV_HasFlagsAll(Var, VF_SmallAngle)) then dcm = quat_to_dcm(quat) rv = GetSmllRotAngs(dcm, ErrStat, ErrMsg) - rv(j+1) = rv(j+1) + Perturb + rv(j + 1) = rv(j + 1) + Perturb call SmllRotTrans('linearization perturbation', rv(1), rv(2), rv(3), dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) quat = dcm_to_quat(dcm) else @@ -618,7 +619,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) if (UseSmallRotAngles) then ! If variable has flag to use small angles when computing difference - if (MV_HasFlags(VarAry(i), VF_SmallAngle)) then + if (MV_HasFlagsAll(VarAry(i), VF_SmallAngle)) then ang_pos = GetSmllRotAngs(quat_to_dcm(quat_pos), ErrStat, ErrMsg) ang_neg = GetSmllRotAngs(quat_to_dcm(quat_neg), ErrStat, ErrMsg) @@ -756,7 +757,7 @@ subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) case (FieldScalar) ! Scalar field ! If field is on the range [0,2PI], perform angular interp - if (MV_HasFlags(VarAry(i), VF_2PI)) then + if (MV_HasFlagsAll(VarAry(i), VF_2PI)) then k = VarAry(i)%iLoc(1) do j = 1, VarAry(i)%Num @@ -819,7 +820,7 @@ subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) case (FieldScalar) ! Scalar field ! If field is on the range [0,2PI], perform angular interp - if (MV_HasFlags(VarAry(i), VF_2PI)) then + if (MV_HasFlagsAll(VarAry(i), VF_2PI)) then k = VarAry(i)%iLoc(1) do j = 1, VarAry(i)%Num @@ -847,7 +848,7 @@ subroutine MV_AddDelta(VarAry, DeltaAry, DataAry) real(R8Ki), intent(in) :: DeltaAry(:) ! Array of delta values real(R8Ki), intent(inout) :: DataAry(:) ! Array to be modified integer(IntKi) :: i, j, k - real(R8Ki) :: quat_base(3), quat_delta(3), rvec(3), dcm(3,3) + real(R8Ki) :: quat_base(3), quat_delta(3), rvec(3), dcm(3, 3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1023,28 +1024,28 @@ subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, Deri end subroutine -function MV_NumVals(VarAry, FlagFilter) result(Num) +pure function MV_NumVals(VarAry, FlagFilter) result(Num) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), optional, intent(in) :: FlagFilter integer(IntKi) :: Num, i if (present(FlagFilter)) then Num = 0 do i = 1, size(VarAry) - if (MV_HasFlags(VarAry(i), FlagFilter)) Num = Num + VarAry(i)%Num + if (MV_HasFlagsAll(VarAry(i), FlagFilter)) Num = Num + VarAry(i)%Num end do else Num = sum(VarAry%Num) end if end function -function MV_NumVars(VarAry, FlagFilter) result(Num) +pure function MV_NumVars(VarAry, FlagFilter) result(Num) type(ModVarType), intent(in) :: VarAry(:) integer(IntKi), optional, intent(in) :: FlagFilter integer(IntKi) :: Num, i if (present(FlagFilter)) then Num = 0 do i = 1, size(VarAry) - if (MV_HasFlags(VarAry(i), FlagFilter)) Num = Num + 1 + if (MV_HasFlagsAll(VarAry(i), FlagFilter)) Num = Num + 1 end do else Num = size(VarAry) @@ -1054,7 +1055,23 @@ function MV_NumVars(VarAry, FlagFilter) result(Num) ! MV_IsLoad returns true if the variable field is FieldForce or FieldMoment pure logical function MV_IsLoad(Var) type(ModVarType), intent(in) :: Var - MV_IsLoad = Var%Field == FieldForce .or. Var%Field == FieldMoment + select case (Var%Field) + case (FieldForce, FieldMoment) + MV_IsLoad = .true. + case default + MV_IsLoad = .false. + end select +end function + +! MV_IsMotion returns true if the variable field is a motion +pure logical function MV_IsMotion(Var) + type(ModVarType), intent(in) :: Var + select case (Var%Field) + case (FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc) + MV_IsMotion = .true. + case default + MV_IsMotion = .false. + end select end function ! MV_EqualDL returns true if data location numbers are greater than zero and @@ -1087,12 +1104,18 @@ pure function MV_FindVarDatLoc(VarAry, DL) result(iVar) ! Flag Utilities !------------------------------------------------------------------------------- -!> MV_HasFlags returns true if Flags is VF_None or if variable contains all -!> flags in Flags. -pure logical function MV_HasFlags(Var, Flags) +!> MV_HasFlagsAll returns true if Flags is VF_None or variable contains all flags in Flags. +pure logical function MV_HasFlagsAll(Var, Flags) type(ModVarType), intent(in) :: Var integer(IntKi), intent(in) :: Flags - MV_HasFlags = iand(Var%Flags, Flags) == Flags + MV_HasFlagsAll = iand(Var%Flags, Flags) == Flags +end function + +!> MV_HasFlagsAny returns true if Flags is VF_None or variable contains any flags in Flags. +pure logical function MV_HasFlagsAny(Var, Flags) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: Flags + MV_HasFlagsAny = (Flags == VF_None) .or. (iand(Var%Flags, Flags) > 0) end function !> MV_SetFlags adds the given flags to the variable. @@ -1160,6 +1183,7 @@ function perturb_quat(theta, idir) result(q) end if end function +! quat_scalar returns the scalar part of the quaternion pure function quat_scalar(q) result(w) real(R8Ki), intent(in) :: q(3) real(R8Ki) :: im, w @@ -1167,36 +1191,23 @@ pure function quat_scalar(q) result(w) im = dot_product(q, q) if (im < 1.0_R8Ki) then w = sqrt(1.0_R8Ki - im) - else if (im > 1.0_R8Ki) then - w = 0.0_R8Ki else w = 0.0_R8Ki end if end function +! quat_canonical returns the imaginary part of the quaternion after ensuring +! that it's a unit quaternion with a positive real part. pure function quat_canonical(q0, q) result(qc) real(R8Ki), intent(in) :: q0, q(3) real(R8Ki) :: qc(3), m integer(IntKi) :: i - m = q0*q0 + dot_product(q, q) - qc = q/m + m = q0*q0 + q(1)*q(1) + q(2)*q(2) + q(3)*q(3) if (q0 < 0.0_R8Ki) then qc = -q/m else qc = q/m end if - ! if (q0 > 0.0_R8Ki) return - ! if (q0 < 0.0_R8Ki) then - ! qc = -qc - ! return - ! end if - ! do i = 1, 3 - ! if (q(i) > 0.0_R8Ki) return - ! if (q(i) < 0.0_R8Ki) then - ! qc = -qc - ! return - ! end if - ! end do end function function dcm_to_quat(dcm) result(q) @@ -1309,17 +1320,9 @@ pure function quat_to_dcm(q) result(dcm) s = 2.0_R8Ki/n end if - dcm(1, 1) = 1.0_R8Ki - s*(yy + zz) - dcm(2, 1) = s*(xy + wz) - dcm(3, 1) = s*(xz - wy) - - dcm(1, 2) = s*(xy - wz) - dcm(2, 2) = 1.0_R8Ki - s*(xx + zz) - dcm(3, 2) = s*(yz + wx) - - dcm(1, 3) = s*(xz + wy) - dcm(2, 3) = s*(yz - wx) - dcm(3, 3) = 1.0_R8Ki - s*(xx + yy) + dcm(:, 1) = [1.0_R8Ki - s*(yy + zz), s*(xy + wz), s*(xz - wy)] + dcm(:, 2) = [s*(xy - wz), 1.0_R8Ki - s*(xx + zz), s*(yz + wx)] + dcm(:, 3) = [s*(xz + wy), s*(yz - wx), 1.0_R8Ki - s*(xx + yy)] end function @@ -1357,8 +1360,8 @@ pure function quat_to_rvec(q) result(rvec) if (m < epsilon(m)) then rvec = 0.0_R8Ki else - qr = sqrt(1.0_R8Ki - m*m) ! Scalar part - theta = 2.0_R8Ki*atan2(m, qr) ! Angle + qr = sqrt(1.0_R8Ki - m*m) ! Scalar part + theta = 2.0_R8Ki*atan2(m, qr) ! Angle rvec = -theta*q/m ! Negative sign doesn't make sense, but needed for quaternions end if end function diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index c2918325fb..c595684c4e 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -60,6 +60,7 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 1024 ! Variable for aeromap [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 2048 ! Variable is derivative order 1 in linearization file [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 4096 ! Variable is derivative order 2 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mapping = 8192 ! Variable is used in a module-to-module transfer mapping [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 4b8a3e1f91..a3ccd582ee 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -71,6 +71,7 @@ param ^ - IntKi VF_Solve - 512 - param ^ - IntKi VF_AeroMap - 1024 - "Variable for aeromap" - param ^ - IntKi VF_DerivOrder1 - 2048 - "Variable is derivative order 1 in linearization file" - param ^ - IntKi VF_DerivOrder2 - 4096 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_Mapping - 8192 - "Variable is used in a module-to-module transfer mapping" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index cc2b592bbc..d85ba6aa88 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -71,6 +71,7 @@ param ^ - IntKi VF_Solve - 512 - param ^ - IntKi VF_AeroMap - 1024 - "Variable for aeromap" - param ^ - IntKi VF_DerivOrder1 - 2048 - "Variable is derivative order 1 in linearization file" - param ^ - IntKi VF_DerivOrder2 - 4096 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_Mapping - 8192 - "Variable is used in a module-to-module transfer mapping" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 7cbb3d9900..8162dda7b2 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -730,14 +730,14 @@ subroutine SS_BuildJacobian(AM, caseData, Mappings, p_FAST, y_FAST, m_FAST, T, E ! Calculate dYdu and dXdu call FAST_JacobianPInput(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & - dYdu=ModData%Lin%dYdu, dYduGlue=AM%Mod%Lin%dYdu, & - dXdu=ModData%Lin%dXdu, dXduGlue=AM%Mod%Lin%dXdu) + dYdu=ModData%Lin%dYdu, dYdu_glue=AM%Mod%Lin%dYdu, & + dXdu=ModData%Lin%dXdu, dXdu_glue=AM%Mod%Lin%dXdu) if (Failed()) return ! Calculate dYdx and dXdx call FAST_JacobianPContState(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & - dYdx=ModData%Lin%dYdx, dYdxGlue=AM%Mod%Lin%dYdx, & - dXdx=ModData%Lin%dXdx, dXdxGlue=AM%Mod%Lin%dXdx) + dYdx=ModData%Lin%dYdx, dYdx_glue=AM%Mod%Lin%dYdx, & + dXdx=ModData%Lin%dXdx, dXdx_glue=AM%Mod%Lin%dXdx) if (Failed()) return ! If output debugging requested diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 2b898a6238..b2349b395f 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -572,6 +572,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err call FEAM_PackInputAry(ModData%Vars, T%FEAM%Input(InputIndex), u_op) case (Module_HD) call HydroDyn_PackInputAry(ModData%Vars, T%HD%Input(InputIndex), u_op) + call HD_PackExtInputAry(ModData%Vars, T%HD%Input(InputIndex), u_op) case (Module_IceD) call IceD_PackInputAry(ModData%Vars, T%IceD%Input(InputIndex, ModData%Ins), u_op) case (Module_IceF) @@ -591,6 +592,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err call SD_PackInputAry(ModData%Vars, T%SD%Input(InputIndex), u_op) case (Module_SeaSt) call SeaSt_PackInputAry(ModData%Vars, T%SeaSt%Input(InputIndex), u_op) + call SeaSt_PackExtInputAry(ModData%Vars, T%SeaSt%Input(InputIndex), u_op) case (Module_SrvD) call SrvD_PackInputAry(ModData%Vars, T%SrvD%Input(InputIndex), u_op) case default @@ -642,6 +644,7 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err case (Module_SD) call SD_PackOutputAry(ModData%Vars, T%SD%y, y_op) case (Module_SeaSt) + call SeaSt_PackExtOutputAry(ModData%Vars, T%SeaSt%y, y_op) call SeaSt_PackOutputAry(ModData%Vars, T%SeaSt%y, y_op) case (Module_SrvD) call SrvD_PackOutputAry(ModData%Vars, T%SrvD%y, y_op) @@ -1054,15 +1057,15 @@ logical function Failed() end function end subroutine -subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdu, dXdu, dYduGlue, dXduGlue) +subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdu, dXdu, dYdu_glue, dXdu_glue) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: StateIndex !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :), dYduGlue(:, :) - real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:, :), dXduGlue(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :), dYdu_glue(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:, :), dXdu_glue(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPInput' integer(IntKi) :: ErrStat2 @@ -1109,7 +1112,7 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg dYdu=dYdu, dXdu=dXdu) case (Module_MD) - call MD_JacobianPInput(ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), & + call MD_JacobianPInput(ModData%Vars, ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), & T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) @@ -1136,23 +1139,23 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - ! If dYdu and dYduGlue are present, transfer from module matrix to glue matrix - if (present(dYdu) .and. present(dYduGlue)) call XfrModToGlueMatrix(ModData%Vars%y, ModData%Vars%u, dYdu, dYduGlue) + ! If dYdu and dYdu_glue are present, transfer from module matrix to glue matrix + if (present(dYdu) .and. present(dYdu_glue)) call XfrModToGlueMatrix(ModData%Vars%y, ModData%Vars%u, dYdu, dYdu_glue) - ! If dXdu and dXduGlue are present, transfer from module matrix to glue matrix - if (present(dXdu) .and. present(dXduGlue)) call XfrModToGlueMatrix(ModData%Vars%x, ModData%Vars%u, dXdu, dXduGlue) + ! If dXdu and dXdu_glue are present, transfer from module matrix to glue matrix + if (present(dXdu) .and. present(dXdu_glue)) call XfrModToGlueMatrix(ModData%Vars%x, ModData%Vars%u, dXdu, dXdu_glue) end subroutine -subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdx, dXdx, dYdxGlue, dXdxGlue) +subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdx, dXdx, dYdx_glue, dXdx_glue) type(ModDataType), intent(inout) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: StateIndex !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dYdxGlue(:, :) - real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:, :), dXdxGlue(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dYdx_glue(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:, :), dXdx_glue(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPContState' integer(IntKi) :: ErrStat2 @@ -1207,7 +1210,7 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, Er ErrMsg2 = '' case (Module_MD) - call MD_JacobianPContState(ThisTime, T%MD%Input(1), T%MD%p, & + call MD_JacobianPContState(ModData%Vars, ThisTime, T%MD%Input(1), T%MD%p, & T%MD%x(StateIndex), T%MD%xd(StateIndex), & T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), & T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & @@ -1242,11 +1245,11 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - ! If dYdx and dYdxGlue are present, transfer from module matrix to glue matrix - if (present(dYdx) .and. present(dYdxGlue)) call XfrModToGlueMatrix(ModData%Vars%y, ModData%Vars%x, dYdx, dYdxGlue) + ! If dYdx and dYdx_glue are present, transfer from module matrix to glue matrix + if (present(dYdx) .and. present(dYdx_glue)) call XfrModToGlueMatrix(ModData%Vars%y, ModData%Vars%x, dYdx, dYdx_glue) - ! If dXdx and dXdxGlue are present, transfer from module matrix to glue matrix - if (present(dXdx) .and. present(dXdxGlue)) call XfrModToGlueMatrix(ModData%Vars%x, ModData%Vars%x, dXdx, dXdxGlue) + ! If dXdx and dXdx_glue are present, transfer from module matrix to glue matrix + if (present(dXdx) .and. present(dXdx_glue)) call XfrModToGlueMatrix(ModData%Vars%x, ModData%Vars%x, dXdx, dXdx_glue) end subroutine diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index aef69a7c57..ab4d2c2902 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -282,87 +282,143 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM end if end subroutine -function FAST_InputMeshName(ModData, DL) result(Name) +function FAST_InputFieldName(ModData, DL) result(Name) type(ModDataType), intent(in) :: ModData type(DatLoc), intent(in) :: DL character(32) :: Name, tmp - Name = "Unknown mesh in "//ModData%Abbr select case (ModData%ID) case (Module_AD) - tmp = AD_InputMeshName(DL) - Name = trim(ModData%Abbr)//"%y%rotors("//trim(Num2LStr(ModData%Ins))//")"//tmp(2:) + Name = trim(ModData%Abbr)//"%u%rotors("//trim(Num2LStr(ModData%Ins))//")" + select case (DL%Num) + case (1:) + tmp = AD_OutputFieldName(DL) + Name = trim(Name)//tmp(2:) + case (AD_u_HWindSpeed) + Name = 'AD%u%HWindSpeed (Ext)' + case (AD_u_PLExp) + Name = 'AD%u%PLExp (Ext)' + case (AD_u_PropagationDir) + Name = 'AD%u%PropagationDir (Ext)' + end select case (Module_BD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputMeshName(DL) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputFieldName(DL) case (Module_ED) - Name = trim(ModData%Abbr)//"%"//ED_InputMeshName(DL) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//ED_InputFieldName(DL) + case (ED_u_BlPitchComC) + Name = 'ED%u%BlPitchComC (Ext)' + end select case (Module_ExtInfw) - Name = trim(ModData%Abbr)//"%"//ExtInfw_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//ExtInfw_InputFieldName(DL) case (Module_ExtPtfm) - Name = trim(ModData%Abbr)//"%"//ExtPtfm_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//ExtPtfm_InputFieldName(DL) case (Module_FEAM) - Name = trim(ModData%Abbr)//"%"//FEAM_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//FEAM_InputFieldName(DL) case (Module_HD) - Name = trim(ModData%Abbr)//"%"//HydroDyn_InputMeshName(DL) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//HydroDyn_InputFieldName(DL) + case (HydroDyn_u_WaveElev0) + Name = 'HD%u%WaveElev0 (Ext)' + case (HydroDyn_u_HWindSpeed) + Name = 'HD%u%HWindSpeed (Ext)' + case (HydroDyn_u_PLexp) + Name = 'HD%u%PLexp (Ext)' + case (HydroDyn_u_PropagationDir) + Name = 'HD%u%PropagationDir (Ext)' + end select case (Module_IceD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_InputMeshName(DL) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_InputFieldName(DL) case (Module_IceF) - Name = trim(ModData%Abbr)//"%"//IceFloe_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//IceFloe_InputFieldName(DL) case (Module_IfW) - Name = trim(ModData%Abbr)//"%"//InflowWind_InputMeshName(DL) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//InflowWind_InputFieldName(DL) + case (InflowWind_u_HWindSpeed) + Name = 'IfW%u%HWindSpeed (Ext)' + case (InflowWind_u_PLexp) + Name = 'IfW%u%PLexp (Ext)' + case (InflowWind_u_PropagationDir) + Name = 'IfW%u%PropagationDir (Ext)' + end select case (Module_MAP) - Name = trim(ModData%Abbr)//"%"//MAP_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//MAP_InputFieldName(DL) case (Module_MD) - Name = trim(ModData%Abbr)//"%"//MD_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//MD_InputFieldName(DL) case (Module_Orca) - Name = trim(ModData%Abbr)//"%"//Orca_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//Orca_InputFieldName(DL) case (Module_SD) - Name = trim(ModData%Abbr)//"%"//SD_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//SD_InputFieldName(DL) case (Module_SeaSt) - Name = trim(ModData%Abbr)//"%"//SeaSt_InputMeshName(DL) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//SeaSt_InputFieldName(DL) + case (SeaSt_u_WaveElev0) + Name = 'SeaSt%u%WaveElev0 (Ext)' + end select case (Module_SrvD) - Name = trim(ModData%Abbr)//"%"//SrvD_InputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//SrvD_InputFieldName(DL) + case default + Name = "Unknown field "//Num2LStr(DL%Num)//" in "//ModData%Abbr end select end function -function FAST_OutputMeshName(ModData, DL) result(Name) +function FAST_OutputFieldName(ModData, DL) result(Name) type(ModDataType), intent(in) :: ModData type(DatLoc), intent(in) :: DL character(32) :: Name, tmp - Name = "Unknown mesh in "//ModData%Abbr select case (ModData%ID) case (Module_AD) - tmp = AD_OutputMeshName(DL) + tmp = AD_OutputFieldName(DL) Name = trim(ModData%Abbr)//"%y%rotors("//trim(Num2LStr(ModData%Ins))//")"//tmp(2:) case (Module_BD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputFieldName(DL) case (Module_ED) - Name = trim(ModData%Abbr)//"%"//ED_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//ED_OutputFieldName(DL) case (Module_ExtInfw) - Name = trim(ModData%Abbr)//"%"//ExtInfw_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//ExtInfw_OutputFieldName(DL) case (Module_ExtPtfm) - Name = trim(ModData%Abbr)//"%"//ExtPtfm_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//ExtPtfm_OutputFieldName(DL) case (Module_FEAM) - Name = trim(ModData%Abbr)//"%"//FEAM_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//FEAM_OutputFieldName(DL) case (Module_HD) - Name = trim(ModData%Abbr)//"%"//HydroDyn_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//HydroDyn_OutputFieldName(DL) case (Module_IceD) - Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_OutputFieldName(DL) case (Module_IceF) - Name = trim(ModData%Abbr)//"%"//IceFloe_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//IceFloe_OutputFieldName(DL) case (Module_IfW) - Name = trim(ModData%Abbr)//"%"//InflowWind_OutputMeshName(DL) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//InflowWind_OutputFieldName(DL) + case (InflowWind_y_HWindSpeed) + Name = 'IfW%y%HWindSpeed (Ext)' + case (InflowWind_y_PLexp) + Name = 'IfW%y%PLexp (Ext)' + case (InflowWind_y_PropagationDir) + Name = 'IfW%y%PropagationDir (Ext)' + end select case (Module_MAP) - Name = trim(ModData%Abbr)//"%"//MAP_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//MAP_OutputFieldName(DL) case (Module_MD) - Name = trim(ModData%Abbr)//"%"//MD_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//MD_OutputFieldName(DL) case (Module_Orca) - Name = trim(ModData%Abbr)//"%"//Orca_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//Orca_OutputFieldName(DL) case (Module_SD) - Name = trim(ModData%Abbr)//"%"//SD_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//SD_OutputFieldName(DL) case (Module_SeaSt) - Name = trim(ModData%Abbr)//"%"//SeaSt_OutputMeshName(DL) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//SeaSt_OutputFieldName(DL) + case (SeaSt_y_WaveElev0) + Name = 'SeaSt%y%WaveElev0 (Ext)' + end select case (Module_SrvD) - Name = trim(ModData%Abbr)//"%"//SrvD_OutputMeshName(DL) + Name = trim(ModData%Abbr)//"%"//SrvD_OutputFieldName(DL) + case default + Name = "Unknown field "//Num2LStr(DL%Num)//" in "//ModData%Abbr end select end function @@ -560,21 +616,21 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_IfW) - call MapVariable(Mappings, "IfW HWindSpeed -> AD HWindSpeed", & + call MapVariable(Mappings, & SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(InflowWind_y_HWindSpeed), & DstDL=DatLoc(AD_u_HWindSpeed), & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return - call MapVariable(Mappings, "IfW PLExp -> AD PLExp", & + call MapVariable(Mappings, & SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(InflowWind_y_PLExp), & DstDL=DatLoc(AD_u_PLExp), & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return - call MapVariable(Mappings, "IfW PropagationDir -> AD PropagationDir", & + call MapVariable(Mappings, & SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(InflowWind_y_PropagationDir), & DstDL=DatLoc(AD_u_PropagationDir), & @@ -873,17 +929,17 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_SrvD) - call MapVariable(Mappings, "SrvD BlPitchCom -> ED BlPitchCom", & + call MapVariable(Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_BlPitchCom), & DstMod=DstMod, DstDL=DatLoc(ED_u_BlPitchCom), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - call MapVariable(Mappings, "SrvD YawMom -> ED YawMom", & + call MapVariable(Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_YawMom), & DstMod=DstMod, DstDL=DatLoc(ED_u_YawMom), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - call MapVariable(Mappings, "SrvD GenTrq -> ED GenTrq", & + call MapVariable(Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_GenTrq), & DstMod=DstMod, DstDL=DatLoc(ED_u_GenTrq), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return @@ -1153,7 +1209,7 @@ subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_SeaSt) - call MapVariable(Mappings, "SEA WaveElev0 -> HD WaveElev0", & + call MapVariable(Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(SeaSt_y_WaveElev0), & DstMod=DstMod, DstDL=DatLoc(HydroDyn_u_WaveElev0), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return @@ -1569,17 +1625,17 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapCustom(Mappings, Custom_ED_to_SrvD, SrcMod, DstMod) - call MapVariable(Mappings, "ED Yaw -> SrvD Yaw", & + call MapVariable(Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_Yaw), & DstMod=DstMod, DstDL=DatLoc(SrvD_u_Yaw), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - call MapVariable(Mappings, "ED YawRate -> SrvD YawRate", & + call MapVariable(Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_YawRate), & DstMod=DstMod, DstDL=DatLoc(SrvD_u_YawRate), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - call MapVariable(Mappings, "ED HSS_Spd -> SrvD HSS_Spd", & + call MapVariable(Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HSS_Spd), & DstMod=DstMod, DstDL=DatLoc(SrvD_u_HSS_Spd), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return @@ -1681,19 +1737,19 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & ! Check that all meshes in mapping have nonzero identifiers if (SrcMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputMeshName(SrcMod, SrcDL))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputFieldName(SrcMod, SrcDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return else if (SrcDispMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcDispMesh "'//trim(FAST_InputMeshName(SrcMod, SrcDispDL))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'SrcDispMesh "'//trim(FAST_InputFieldName(SrcMod, SrcDispDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return else if (DstMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputMeshName(DstMod, DstDL))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputFieldName(DstMod, DstDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return else if (DstDispMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstDispMesh "'//trim(FAST_OutputMeshName(DstMod, DstDispDL))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'DstDispMesh "'//trim(FAST_OutputFieldName(DstMod, DstDispDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return end if @@ -1702,10 +1758,10 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & call FAST_OutputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return ! Create mapping description - Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcDL))//" -> "// & - trim(FAST_InputMeshName(DstMod, DstDL))// & - " ["//trim(FAST_InputMeshName(SrcMod, SrcDispDL))// & - " -> "//trim(FAST_OutputMeshName(DstMod, DstDispDL))//"]" + Mapping%Desc = trim(FAST_OutputFieldName(SrcMod, SrcDL))//" -> "// & + trim(FAST_InputFieldName(DstMod, DstDL))// & + " ["//trim(FAST_InputFieldName(SrcMod, SrcDispDL))// & + " -> "//trim(FAST_OutputFieldName(DstMod, DstDispDL))//"]" ! Initialize mapping structure Mapping%MapType = Map_LoadMesh @@ -1823,18 +1879,18 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcDL, DstMod, DstDL, ErrSta ! Check that all meshes in mapping have nonzero identifiers if (SrcMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputMeshName(SrcMod, SrcDL))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputFieldName(SrcMod, SrcDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return else if (DstMesh%ID == 0) then - call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputMeshName(DstMod, DstDL))//'" not in module variables', & + call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputFieldName(DstMod, DstDL))//'" not in module variables', & ErrStat, ErrMsg, RoutineName) return end if ! Create mapping description - Mapping%Desc = trim(FAST_OutputMeshName(SrcMod, SrcDL))//" -> "// & - trim(FAST_InputMeshName(DstMod, DstDL)) + Mapping%Desc = trim(FAST_OutputFieldName(SrcMod, SrcDL))//" -> "// & + trim(FAST_InputFieldName(DstMod, DstDL)) ! Initialize mapping structure Mapping%MapType = Map_MotionMesh @@ -1864,9 +1920,8 @@ logical function Failed() end function end subroutine -subroutine MapVariable(Maps, Key, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Active) +subroutine MapVariable(Maps, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Active) type(MappingType), allocatable :: Maps(:) - character(*), intent(in) :: Key type(ModDataType), intent(in) :: SrcMod, DstMod type(DatLoc), intent(in) :: SrcDL, DstDL integer(IntKi), intent(out) :: ErrStat @@ -1889,25 +1944,28 @@ subroutine MapVariable(Maps, Key, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, ! If either variable index is zero, return error if (iVarSrc == 0) then ErrStat = ErrID_Fatal - ErrMsg = "Source variable in mapping '"//Key//"' is not active" + ErrMsg = "Source variable "//trim(Num2LStr(SrcDL%Num))//" in module '"//trim(SrcMod%Abbr)//"' is not active" return else if (iVarDst == 0) then ErrStat = ErrID_Fatal - ErrMsg = "Destination variable in mapping '"//Key//"' is not active" + ErrMsg = "Destination variable "//trim(Num2LStr(DstDL%Num))//" in module '"//trim(DstMod%Abbr)//"' is not active" return end if + ! Create mapping description + Mapping%Desc = trim(FAST_OutputFieldName(SrcMod, SrcDL))//" -> "// & + trim(FAST_InputFieldName(DstMod, DstDL)) + ! Verify that variables have compatible sizes ! If source variable has size 1, it can be mapped to multiple destination variables if ((SrcMod%Vars%y(iVarSrc)%Num > 1) .and. & (SrcMod%Vars%y(iVarSrc)%Num /= DstMod%Vars%u(iVarDst)%Num)) then ErrStat = ErrID_Fatal - ErrMsg = "Variables in mapping '"//Key//"' have different sizes" + ErrMsg = "Variables in mapping '"//trim(Mapping%Desc)//"' have incompatible sizes" return end if ! Initialize mapping structure - Mapping%Desc = Key Mapping%MapType = Map_Variable Mapping%iModSrc = SrcMod%iMod Mapping%iModDst = DstMod%iMod diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index f145f8d7c1..d5bffa09b4 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -317,7 +317,7 @@ subroutine CopyVariables(VarAryIn, VarAryOut, iVal) do k = 1, size(VarAryIn) ! If variable doesn't have flag, cycle - if (.not. MV_HasFlags(VarAryIn(k), FlagFilter)) cycle + if (.not. MV_HasFlagsAll(VarAryIn(k), FlagFilter)) cycle associate (Var => VarAryOut(iVar)) @@ -460,7 +460,7 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) end do case (LIN_STANDARD) ! Set linearize flag for write output variables do j = 1, size(ModData%Vars%y) - if (MV_HasFlags(ModData%Vars%y(j), VF_WriteOut)) then + if (MV_HasFlagsAll(ModData%Vars%y(j), VF_WriteOut)) then call MV_SetFlags(ModData%Vars%y(j), VF_Linearize) else call MV_ClearFlags(ModData%Vars%y(j), VF_Linearize) @@ -547,7 +547,7 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) m%CS%NumOutputs = 0 do i = 1, size(m%ModGlue%Vars%y) associate (Var => m%ModGlue%Vars%y(i)) - if (.not. MV_HasFlags(Var, VF_WriteOut)) m%CS%NumOutputs = m%CS%NumOutputs + Var%Num + if (.not. MV_HasFlagsAll(Var, VF_WriteOut)) m%CS%NumOutputs = m%CS%NumOutputs + Var%Num end associate end do @@ -797,7 +797,7 @@ function CalcOutputErrorAtAzimuth() result(eps_squared) associate (Var => m%ModGlue%Vars%y(i)) ! Skip write outputs - if (MV_HasFlags(Var, VF_WriteOut)) cycle + if (MV_HasFlagsAll(Var, VF_WriteOut)) cycle ! Loop through values in variable do j = Var%iLoc(1), Var%iLoc(2) @@ -898,14 +898,14 @@ subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbi ! Derivatives with respect to input call FAST_JacobianPInput(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - dYdu=ModData%Lin%dYdu, dYduGlue=m%ModGlue%Lin%dYdu, & - dXdu=ModData%Lin%dXdu, dXduGlue=m%ModGlue%Lin%dXdu) + dYdu=ModData%Lin%dYdu, dYdu_glue=m%ModGlue%Lin%dYdu, & + dXdu=ModData%Lin%dXdu, dXdu_glue=m%ModGlue%Lin%dXdu) if (Failed()) return ! Derivatives with respect to continuous state call FAST_JacobianPContState(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - dYdx=ModData%Lin%dYdx, dYdxGlue=m%ModGlue%Lin%dYdx, & - dXdx=ModData%Lin%dXdx, dXdxGlue=m%ModGlue%Lin%dXdx) + dYdx=ModData%Lin%dYdx, dYdx_glue=m%ModGlue%Lin%dYdx, & + dXdx=ModData%Lin%dXdx, dXdx_glue=m%ModGlue%Lin%dXdx) if (Failed()) return ! Operating point values (must come after Jacobian routines because @@ -1357,7 +1357,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR xUse = .false. do i = 1, size(Vars%x) associate (Var => Vars%x(i)) - if (MV_HasFlags(Var, FilterFlag)) xUse(Var%iLoc(1):Var%iLoc(2)) = .true. + if (MV_HasFlagsAll(Var, FilterFlag)) xUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do @@ -1366,7 +1366,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR uUse = .false. do i = 1, size(Vars%u) associate (Var => Vars%u(i)) - if (MV_HasFlags(Var, FilterFlag)) uUse(Var%iLoc(1):Var%iLoc(2)) = .true. + if (MV_HasFlagsAll(Var, FilterFlag)) uUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do @@ -1375,7 +1375,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR yUse = .false. do i = 1, size(Vars%y) associate (Var => Vars%y(i)) - if (MV_HasFlags(Var, FilterFlag)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. + if (MV_HasFlagsAll(Var, FilterFlag)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. end associate end do @@ -1481,15 +1481,15 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer associate (Var => VarAry(i)) ! If variable does not have the filter flag, continue - if (.not. MV_HasFlags(Var, FlagFilter)) cycle + if (.not. MV_HasFlagsAll(Var, FlagFilter)) cycle ! Is variable in the rotating frame? - VarRotFrame = MV_HasFlags(Var, VF_RotFrame) + VarRotFrame = MV_HasFlagsAll(Var, VF_RotFrame) ! Get variable derivative order - if (MV_HasFlags(Var, VF_DerivOrder2)) then + if (MV_HasFlagsAll(Var, VF_DerivOrder2)) then VarDerivOrder = 2 - else if (MV_HasFlags(Var, VF_DerivOrder1)) then + else if (MV_HasFlagsAll(Var, VF_DerivOrder1)) then VarDerivOrder = 1 else VarDerivOrder = 0 @@ -1522,7 +1522,7 @@ subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDer write (Un, Fmt) RowColIdx, op(i_op), VarRotFrame, VarDerivOrder, trim(DerivStr)//' '//trim(Var%LinNames(j))//trim(DerivUnitStr) - else if (MV_HasFlags(Var, VF_WM_Rot)) then ! BeamDyn Wiener-Milenkovic orientation + else if (MV_HasFlagsAll(Var, VF_WM_Rot)) then ! BeamDyn Wiener-Milenkovic orientation ! Skip writing if not the first value in orientation (3 values) if (mod(j - 1, 3) /= 0) cycle diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index ee061fe0ae..e4887b1d9f 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -45,39 +45,20 @@ typedef ^ ^ IntKi SrcMeshID - 0 - typedef ^ ^ IntKi DstMeshID - 0 - "Destination mesh identifier" - typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - -typedef ^ ^ DatLoc SrcDL - - - "Source mesh locator (number and indices)" - -typedef ^ ^ DatLoc DstDL - - - "Destination mesh locator (number and indices)" - -typedef ^ ^ DatLoc SrcDispDL - - - "Source displacement mesh locator (number and indices)" - -typedef ^ ^ DatLoc DstDispDL - - - "Destination displacement mesh locator (number and indices)" - -typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - +typedef ^ ^ DatLoc SrcDL - - - "Source mesh locator (number and indices)" - +typedef ^ ^ DatLoc DstDL - - - "Destination mesh locator (number and indices)" - +typedef ^ ^ DatLoc SrcDispDL - - - "Source displacement mesh locator (number and indices)" - +typedef ^ ^ DatLoc DstDispDL - - - "Destination displacement mesh locator (number and indices)" - +typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Variable, 4=Custom)" - typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - -typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - -typedef ^ ^ logical Ready - F - "Flag indicating Source has been ready to be transferred" - -typedef ^ ^ logical DstUsesSibling - F - "Flag indicating the destination displacement mesh is a sibling of the destination load mesh" - -typedef ^ ^ MeshType TmpLoadMesh - - - "Temporary load mesh for intermediate transfers" - -typedef ^ ^ MeshType TmpMotionMesh - - - "Temporary motion mesh for intermediate transfers" - +typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type to auxiliary mesh (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - +typedef ^ ^ logical Ready - F - "Flag indicating source data is ready to be transferred" - +typedef ^ ^ logical DstUsesSibling - F - "Flag indicating the destination displacement mesh is a sibling of the source destination load mesh" - typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - typedef ^ ^ MeshMapType MeshMapAux - - - "Auxiliary mesh mapping for destination load meshes without sibling motion mesh" - -#typedef ^ ^ IntKi iVarSrcTransDisp - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarSrcTransVel - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarSrcTransAcc - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarSrcOrientation - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarSrcAngularVel - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarSrcAngularAcc - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarSrcForce - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarSrcMoment - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarSrcDispTransDisp - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstTransDisp - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstTransVel - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstTransAcc - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstOrientation - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstAngularVel - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstAngularAcc - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstForce - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstMoment - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstDispTransDisp - - - "Var index for linearized mesh mapping" -#typedef ^ ^ IntKi iVarDstDispOrientation - - - "Var index for linearized mesh mapping" +typedef ^ ^ MeshType TmpLoadMesh - - - "Temporary load mesh for intermediate transfers" - +typedef ^ ^ MeshType TmpMotionMesh - - - "Temporary motion mesh for intermediate transfers" - #---------------------------------------------------------------------------------------------------------------------------------- # Glue Parameters diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 5efefdb0ed..eaabc8e778 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -74,16 +74,16 @@ MODULE Glue_Types TYPE(DatLoc) :: DstDL !< Destination mesh locator (number and indices) [-] TYPE(DatLoc) :: SrcDispDL !< Source displacement mesh locator (number and indices) [-] TYPE(DatLoc) :: DstDispDL !< Destination displacement mesh locator (number and indices) [-] - INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] + INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Variable, 4=Custom) [-] INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] - INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] - LOGICAL :: Ready = .false. !< Flag indicating Source has been ready to be transferred [-] - LOGICAL :: DstUsesSibling = .false. !< Flag indicating the destination displacement mesh is a sibling of the destination load mesh [-] - TYPE(MeshType) :: TmpLoadMesh !< Temporary load mesh for intermediate transfers [-] - TYPE(MeshType) :: TmpMotionMesh !< Temporary motion mesh for intermediate transfers [-] + INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type to auxiliary mesh (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] + LOGICAL :: Ready = .false. !< Flag indicating source data is ready to be transferred [-] + LOGICAL :: DstUsesSibling = .false. !< Flag indicating the destination displacement mesh is a sibling of the source destination load mesh [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] TYPE(MeshMapType) :: MeshMapAux !< Auxiliary mesh mapping for destination load meshes without sibling motion mesh [-] + TYPE(MeshType) :: TmpLoadMesh !< Temporary load mesh for intermediate transfers [-] + TYPE(MeshType) :: TmpMotionMesh !< Temporary motion mesh for intermediate transfers [-] END TYPE MappingType ! ======================= ! ========= Glue_LinParam ======= @@ -494,12 +494,6 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode DstMappingTypeData%XfrTypeAux = SrcMappingTypeData%XfrTypeAux DstMappingTypeData%Ready = SrcMappingTypeData%Ready DstMappingTypeData%DstUsesSibling = SrcMappingTypeData%DstUsesSibling - call MeshCopy(SrcMappingTypeData%TmpLoadMesh, DstMappingTypeData%TmpLoadMesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcMappingTypeData%TmpMotionMesh, DstMappingTypeData%TmpMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcMappingTypeData%TmpMatrix)) then LB(1:2) = lbound(SrcMappingTypeData%TmpMatrix, kind=B8Ki) UB(1:2) = ubound(SrcMappingTypeData%TmpMatrix, kind=B8Ki) @@ -518,6 +512,12 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode call NWTC_Library_CopyMeshMapType(SrcMappingTypeData%MeshMapAux, DstMappingTypeData%MeshMapAux, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMappingTypeData%TmpLoadMesh, DstMappingTypeData%TmpLoadMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMappingTypeData%TmpMotionMesh, DstMappingTypeData%TmpMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) @@ -537,10 +537,6 @@ subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call NWTC_Library_DestroyDatLoc(MappingTypeData%DstDispDL, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( MappingTypeData%TmpLoadMesh, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( MappingTypeData%TmpMotionMesh, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MappingTypeData%TmpMatrix)) then deallocate(MappingTypeData%TmpMatrix) end if @@ -548,6 +544,10 @@ subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call NWTC_Library_DestroyMeshMapType(MappingTypeData%MeshMapAux, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MappingTypeData%TmpLoadMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MappingTypeData%TmpMotionMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Glue_PackMappingType(RF, Indata) @@ -575,11 +575,11 @@ subroutine Glue_PackMappingType(RF, Indata) call RegPack(RF, InData%XfrTypeAux) call RegPack(RF, InData%Ready) call RegPack(RF, InData%DstUsesSibling) - call MeshPack(RF, InData%TmpLoadMesh) - call MeshPack(RF, InData%TmpMotionMesh) call RegPackAlloc(RF, InData%TmpMatrix) call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) call NWTC_Library_PackMeshMapType(RF, InData%MeshMapAux) + call MeshPack(RF, InData%TmpLoadMesh) + call MeshPack(RF, InData%TmpMotionMesh) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -611,11 +611,11 @@ subroutine Glue_UnPackMappingType(RF, OutData) call RegUnpack(RF, OutData%XfrTypeAux); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ready); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstUsesSibling); if (RegCheckErr(RF, RoutineName)) return - call MeshUnpack(RF, OutData%TmpLoadMesh) ! TmpLoadMesh - call MeshUnpack(RF, OutData%TmpMotionMesh) ! TmpMotionMesh call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMapAux) ! MeshMapAux + call MeshUnpack(RF, OutData%TmpLoadMesh) ! TmpLoadMesh + call MeshUnpack(RF, OutData%TmpMotionMesh) ! TmpMotionMesh end subroutine subroutine Glue_CopyLinParam(SrcLinParamData, DstLinParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 9d3484e50c..faf1af8752 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -11,12 +11,13 @@ void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_ std::string type_kind, const bool useModPrefix); void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, const bool gen_c_code); -void gen_destroy(std::ostream &out, const Module &mod, const DataType::Derived &ddt, +void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, const bool gen_c_code); -void gen_pack(std::ostream &out, const Module &mod, const DataType::Derived &ddt, +void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, const bool gen_c_code); -void gen_unpack(std::ostream &out, const Module &mod, const DataType::Derived &ddt, +void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, bool gen_c_code); +void gen_var_routines(std::ostream &w, const Module &mod); void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &ddt); void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &ddt); @@ -381,253 +382,7 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) gen_ExtrapInterp(w, mod, "InflowType", "DbKi", 1); } - // Subroutines to generate mesh pointer functions - for (const auto &tmp : std::vector>{ - {"Input", "u"}, - {"Output", "y"}, - }) - { - auto type_name = mod.nickname + "_" + tmp[0] + "Type"; - if (tolower(mod.name).compare("aerodyn") == 0) - { - type_name = std::string("Rot") + tmp[0] + "Type"; - } - auto it = mod.data_types.find(type_name); - if (it == mod.data_types.end()) - { - continue; - } - auto &ddt = it->second->derived; - - // Get mesh names in derived type or subtypes and add parameters for identifying the mesh - std::vector mesh_names, mesh_paths; - ddt.get_mesh_names_paths(mod.nickname + "_" + tmp[1], tmp[1], 0, mesh_names, mesh_paths); - std::string routine_name = mod.nickname + "_" + tmp[0] + "MeshPointer"; - std::string indent("\n"); - - // Mesh pointer routine - w << indent << "function " << routine_name << "(" << tmp[1] << ", DL) result(Mesh)"; - indent += " "; - w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), target, intent(in) " << ":: " << tmp[1]; - w << indent << "type(DatLoc), intent(in) :: DL"; - w << indent << "type(MeshType), pointer :: Mesh"; - w << indent << "nullify(Mesh)"; - w << indent << "select case (DL%Num)"; - for (int i = 0; i < mesh_paths.size(); ++i) - { - w << indent << "case (" << mesh_names[i] << ")"; - w << indent << " Mesh => " << mesh_paths[i]; - } - w << indent << "end select"; - indent.erase(indent.size() - 3); - w << indent << "end function"; - w << indent; - - // Mesh name routine - indent = "\n"; - routine_name = mod.nickname + "_" + tmp[0] + "MeshName"; - w << indent << "function " << routine_name << "(DL) result(Name)"; - indent += " "; - w << indent << "type(DatLoc), intent(in) :: DL"; - w << indent << "character(32) :: Name"; - w << indent << "Name = \"\""; - w << indent << "select case (DL%Num)"; - for (int i = 0; i < mesh_paths.size(); ++i) - { - std::string new_path(mesh_paths[i]); - for (int j = 1; j < 5; ++j) - { - auto ind_str = "DL%i" + std::to_string(j); - auto ind = new_path.find(ind_str); - if (ind != std::string::npos) - { - new_path = new_path.substr(0, ind) + "\"//trim(Num2LStr(" + ind_str + "))//\"" + new_path.substr(ind + 5); - } - } - w << indent << "case (" << mesh_names[i] << ")"; - w << indent << " Name = \"" << new_path << "\""; - } - w << indent << "end select"; - indent.erase(indent.size() - 3); - w << indent << "end function"; - w << indent; - } - - // Subroutines to pack and unpack arrays based on variables - for (const auto &tmp : std::vector>{ - {"ContinuousState", "x", "ContState"}, - {"ContinuousState", "x", "ContStateDeriv"}, - {"ConstraintState", "z", "ConstrState"}, - {"Input", "u", "Input"}, - {"Output", "y", "Output"}, - }) - { - auto base_type = tmp[0]; - auto &abbr = tmp[1]; - auto short_type = tmp[2]; - auto type_name = mod.nickname + "_" + base_type + "Type"; - if (tolower(mod.name).compare("aerodyn") == 0) - { - type_name = std::string("Rot") + base_type + "Type"; - } - auto it = mod.data_types.find(type_name); - if (it == mod.data_types.end()) - continue; - auto &ddt = it->second->derived; - - // Get mesh names in derived type or subtypes and add parameters for identifying the mesh - std::vector fields; - ddt.get_field_names_paths(mod.nickname + "_" + abbr, abbr, 0, fields); - - // Vars packing routine - std::string routine_name = mod.nickname + "_Pack" + short_type + "Ary"; - std::string indent("\n"); - w << indent << "subroutine " << routine_name << "(Vars, " << abbr << ", ValAry)"; - indent += " "; - w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(in) " << ":: " << abbr; - w << indent << "type(ModVarsType), intent(in) :: Vars"; - w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; - w << indent << "integer(IntKi) :: i"; - w << indent << "do i = 1, size(Vars%" << abbr << ")"; - indent += " "; - w << indent << "associate (V => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; - indent += " "; - w << indent << "select case (DL%Num)"; - for (const auto &field : fields) - { - w << indent << "case (" << field.name << ")"; - std::string comment = "Scalar"; - auto field_path = field.desc; - if (field.data_type->tag == DataType::Tag::Derived) - { - comment = "Mesh"; - } - else if (field.rank > 0) - { - comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; - } - - if ((field.name.compare("BD_x_q") == 0) && (short_type.compare("ContState") == 0)) - { - // This is a hack to convert BeamDyn's WM orientations to quaternions - w << indent << " if (V%Field == FieldOrientation) then"; - w << indent << " ValAry(V%iLoc(1):V%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, V%jAry))) ! Convert WM parameters to quaternions"; - w << indent << " else"; - w << indent << std::setw(71) << " call MV_Pack(V, " + field_path + "(V%iAry(1):V%iAry(2),V%jAry), ValAry) " << "! " + comment; - w << indent << " end if"; - } - else if (field.data_type->tag == DataType::Tag::Derived) - { - w << indent << std::setw(71) << " call MV_Pack(V, " + field_path + ", ValAry)" << "! Mesh"; - } - else - { - std::string tmp{" call MV_Pack(V, " + field_path}; - switch (field.rank) - { - case 1: - tmp += "(V%iAry(1):V%iAry(2))"; - break; - case 2: - tmp += "(V%iAry(1):V%iAry(2),V%jAry)"; - break; - case 3: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry)"; - break; - case 4: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)"; - break; - case 5: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)"; - break; - } - w << indent << std::setw(71) << tmp + ", ValAry) " << "! " + comment; - } - } - w << indent << "case default"; - w << indent << " ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki"; - w << indent << "end select"; - indent.erase(indent.size() - 3); - w << indent << "end associate"; - indent.erase(indent.size() - 3); - w << indent << "end do"; - indent.erase(indent.size() - 3); - w << indent << "end subroutine"; - w << indent; - - // No unpack function for continuous state derivatives - if (abbr.compare("ContStateDeriv") == 0) - continue; - - // Vars unpacking routine - indent = "\n"; - routine_name = mod.nickname + "_Unpack" + short_type + "Ary"; - w << indent << "subroutine " << routine_name << "(Vars, ValAry, " << abbr << ")"; - indent += " "; - w << indent << "type(ModVarsType), intent(in) :: Vars"; - w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; - w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(inout) " << ":: " + abbr; - w << indent << "integer(IntKi) :: i"; - w << indent << "do i = 1, size(Vars%" << abbr << ")"; - indent += " "; - w << indent << "associate (V => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; - indent += " "; - w << indent << "select case (DL%Num)"; - for (const auto &field : fields) - { - w << indent << "case (" << field.name << ")"; - std::string comment = "Scalar"; - auto field_path = field.desc; - if (field.rank > 0) - { - comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; - } - if (field.name.compare("BD_x_q") == 0) - { - // This is a hack to convert BeamDyn's WM orientations to quaternions - w << indent << " if (V%Field == FieldOrientation) then"; - w << indent << " x%q(4:6, V%jAry) = wm_inv(quat_to_wm(ValAry(V%iLoc(1):V%iLoc(2)))) ! Convert quaternion to WM parameters"; - w << indent << " else"; - w << indent << std::setw(71) << " call MV_Unpack(V, ValAry, " + field_path + "(V%iAry(1):V%iAry(2),V%jAry)) " << "! Rank 2 Array"; - w << indent << " end if"; - } - else if (field.data_type->tag == DataType::Tag::Derived) - { - w << indent << std::setw(71) << " call MV_Unpack(V, ValAry, " + field_path + ") " << "! Mesh"; - } - else - { - std::string tmp{" call MV_Unpack(V, ValAry, " + field_path}; - switch (field.rank) - { - case 1: - tmp += "(V%iAry(1):V%iAry(2))"; - break; - case 2: - tmp += "(V%iAry(1):V%iAry(2),V%jAry)"; - break; - case 3: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry)"; - break; - case 4: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)"; - break; - case 5: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)"; - break; - } - w << indent << std::setw(71) << tmp + ") " << "! " + comment; - } - } - w << indent << "end select"; - indent.erase(indent.size() - 3); - w << indent << "end associate"; - indent.erase(indent.size() - 3); - w << indent << "end do"; - indent.erase(indent.size() - 3); - w << indent << "end subroutine"; - w << indent; - } + gen_var_routines(w, mod); } void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, @@ -1925,3 +1680,273 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d w << indent << "END SUBROUTINE"; w << indent; } + +void gen_var_routines(std::ostream &w, const Module &mod) +{ + //-------------------------------------------------------------------------- + // Subroutines to get mesh pointer functions + //-------------------------------------------------------------------------- + + for (const auto &tmp : std::vector>{ + {"Input", "u"}, + {"Output", "y"}, + }) + { + auto type_name = mod.nickname + "_" + tmp[0] + "Type"; + if (tolower(mod.name).compare("aerodyn") == 0) + { + type_name = std::string("Rot") + tmp[0] + "Type"; + } + auto it = mod.data_types.find(type_name); + if (it == mod.data_types.end()) + { + continue; + } + auto &ddt = it->second->derived; + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::vector mesh_names, mesh_paths; + ddt.get_mesh_names_paths(mod.nickname + "_" + tmp[1], tmp[1], 0, mesh_names, mesh_paths); + std::string routine_name = mod.nickname + "_" + tmp[0] + "MeshPointer"; + std::string indent("\n"); + + // Mesh pointer routine + w << indent << "function " << routine_name << "(" << tmp[1] << ", DL) result(Mesh)"; + indent += " "; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), target, intent(in) " << ":: " << tmp[1]; + w << indent << "type(DatLoc), intent(in) :: DL"; + w << indent << "type(MeshType), pointer :: Mesh"; + w << indent << "nullify(Mesh)"; + w << indent << "select case (DL%Num)"; + for (int i = 0; i < mesh_paths.size(); ++i) + { + w << indent << "case (" << mesh_names[i] << ")"; + w << indent << " Mesh => " << mesh_paths[i]; + } + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end function"; + w << indent; + } + + //-------------------------------------------------------------------------- + // Subroutines to pack and unpack arrays based on variables + //-------------------------------------------------------------------------- + + for (const auto &tmp : std::vector>{ + {"ContinuousState", "x", "ContState"}, + {"ContinuousState", "x", "ContStateDeriv"}, + {"ConstraintState", "z", "ConstrState"}, + {"Input", "u", "Input"}, + {"Output", "y", "Output"}, + }) + { + auto base_type = tmp[0]; + auto &abbr = tmp[1]; + auto short_type = tmp[2]; + auto type_name = mod.nickname + "_" + base_type + "Type"; + if (tolower(mod.name).compare("aerodyn") == 0) + { + type_name = std::string("Rot") + base_type + "Type"; + } + auto it = mod.data_types.find(type_name); + if (it == mod.data_types.end()) + continue; + auto &ddt = it->second->derived; + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::vector fields; + ddt.get_field_names_paths(mod.nickname + "_" + abbr, abbr, 0, fields); + + //-------------------------------- + // Vars packing routine + //-------------------------------- + + std::string routine_name = mod.nickname + "_Pack" + short_type + "Ary"; + std::string indent("\n"); + w << indent << "subroutine " << routine_name << "(Vars, " << abbr << ", ValAry)"; + indent += " "; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(in) " << ":: " << abbr; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; + w << indent << "integer(IntKi) :: i"; + w << indent << "do i = 1, size(Vars%" << abbr << ")"; + indent += " "; + w << indent << "associate (V => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; + indent += " "; + w << indent << "select case (DL%Num)"; + for (const auto &field : fields) + { + w << indent << "case (" << field.name << ")"; + std::string comment = "Scalar"; + auto field_path = field.desc; + if (field.data_type->tag == DataType::Tag::Derived) + { + comment = "Mesh"; + } + else if (field.rank > 0) + { + comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; + } + + if ((field.name.compare("BD_x_q") == 0) && (short_type.compare("ContState") == 0)) + { + // This is a hack to convert BeamDyn's WM orientations to quaternions + w << indent << " if (V%Field == FieldOrientation) then"; + w << indent << " ValAry(V%iLoc(1):V%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, V%jAry))) ! Convert WM parameters to quaternions"; + w << indent << " else"; + w << indent << std::setw(71) << " call MV_Pack(V, " + field_path + "(V%iAry(1):V%iAry(2),V%jAry), ValAry) " << "! " + comment; + w << indent << " end if"; + } + else if (field.data_type->tag == DataType::Tag::Derived) + { + w << indent << std::setw(71) << " call MV_Pack(V, " + field_path + ", ValAry)" << "! Mesh"; + } + else + { + std::string tmp{" call MV_Pack(V, " + field_path}; + switch (field.rank) + { + case 1: + tmp += "(V%iAry(1):V%iAry(2))"; + break; + case 2: + tmp += "(V%iAry(1):V%iAry(2),V%jAry)"; + break; + case 3: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry)"; + break; + case 4: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)"; + break; + case 5: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)"; + break; + } + w << indent << std::setw(71) << tmp + ", ValAry) " << "! " + comment; + } + } + w << indent << "case default"; + w << indent << " ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki"; + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end associate"; + indent.erase(indent.size() - 3); + w << indent << "end do"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + //-------------------------------- + // Skip for Continuous state derivatives + //-------------------------------- + + if (short_type.compare("ContStateDeriv") == 0) + continue; + + //-------------------------------- + // Vars unpacking routine + //-------------------------------- + + indent = "\n"; + routine_name = mod.nickname + "_Unpack" + short_type + "Ary"; + w << indent << "subroutine " << routine_name << "(Vars, ValAry, " << abbr << ")"; + indent += " "; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(inout) " << ":: " + abbr; + w << indent << "integer(IntKi) :: i"; + w << indent << "do i = 1, size(Vars%" << abbr << ")"; + indent += " "; + w << indent << "associate (V => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; + indent += " "; + w << indent << "select case (DL%Num)"; + for (const auto &field : fields) + { + w << indent << "case (" << field.name << ")"; + std::string comment = "Scalar"; + auto field_path = field.desc; + if (field.rank > 0) + { + comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; + } + if (field.name.compare("BD_x_q") == 0) + { + // This is a hack to convert BeamDyn's WM orientations to quaternions + w << indent << " if (V%Field == FieldOrientation) then"; + w << indent << " x%q(4:6, V%jAry) = wm_inv(quat_to_wm(ValAry(V%iLoc(1):V%iLoc(2)))) ! Convert quaternion to WM parameters"; + w << indent << " else"; + w << indent << std::setw(71) << " call MV_Unpack(V, ValAry, " + field_path + "(V%iAry(1):V%iAry(2),V%jAry)) " << "! Rank 2 Array"; + w << indent << " end if"; + } + else if (field.data_type->tag == DataType::Tag::Derived) + { + w << indent << std::setw(71) << " call MV_Unpack(V, ValAry, " + field_path + ") " << "! Mesh"; + } + else + { + std::string tmp{" call MV_Unpack(V, ValAry, " + field_path}; + switch (field.rank) + { + case 1: + tmp += "(V%iAry(1):V%iAry(2))"; + break; + case 2: + tmp += "(V%iAry(1):V%iAry(2),V%jAry)"; + break; + case 3: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry)"; + break; + case 4: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)"; + break; + case 5: + tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)"; + break; + } + w << indent << std::setw(71) << tmp + ") " << "! " + comment; + } + } + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end associate"; + indent.erase(indent.size() - 3); + w << indent << "end do"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + //-------------------------------- + // Field name routines + //-------------------------------- + + indent = "\n"; + routine_name = mod.nickname + "_" + tmp[0] + "FieldName"; + w << indent << "function " << routine_name << "(DL) result(Name)"; + indent += " "; + w << indent << "type(DatLoc), intent(in) :: DL"; + w << indent << "character(32) :: Name"; + w << indent << "select case (DL%Num)"; + for (const auto &field : fields) + { + std::string new_path(field.desc); + for (int j = 1; j < 5; ++j) + { + auto ind_str = "DL%i" + std::to_string(j); + auto ind = new_path.find(ind_str); + if (ind != std::string::npos) + { + new_path = new_path.substr(0, ind) + "\"//trim(Num2LStr(" + ind_str + "))//\"" + new_path.substr(ind + 5); + } + } + w << indent << "case (" << field.name << ")"; + w << indent << " Name = \"" << new_path << "\""; + } + w << indent << "case default"; + w << indent << " Name = \"Unknown Field\""; + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end function"; + w << indent; + } +} diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index a96800de28..af52f3778c 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -1169,16 +1169,6 @@ function Orca_InputMeshPointer(u, DL) result(Mesh) end select end function -function Orca_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (Orca_u_PtfmMesh) - Name = "u%PtfmMesh" - end select -end function - function Orca_OutputMeshPointer(y, DL) result(Mesh) type(Orca_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1190,16 +1180,6 @@ function Orca_OutputMeshPointer(y, DL) result(Mesh) end select end function -function Orca_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (Orca_y_PtfmMesh) - Name = "y%PtfmMesh" - end select -end function - subroutine Orca_PackContStateAry(Vars, x, ValAry) type(Orca_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1232,6 +1212,17 @@ subroutine Orca_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function Orca_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Orca_x_Dummy) + Name = "x%Dummy" + case default + Name = "Unknown Field" + end select +end function + subroutine Orca_PackContStateDerivAry(Vars, x, ValAry) type(Orca_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1249,21 +1240,6 @@ subroutine Orca_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine Orca_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(Orca_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Orca_x_Dummy) - call MV_Unpack(V, ValAry, x%Dummy) ! Scalar - end select - end associate - end do -end subroutine - subroutine Orca_PackConstrStateAry(Vars, z, ValAry) type(Orca_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1296,6 +1272,17 @@ subroutine Orca_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function Orca_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Orca_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine Orca_PackInputAry(Vars, u, ValAry) type(Orca_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1328,6 +1315,17 @@ subroutine Orca_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function Orca_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Orca_u_PtfmMesh) + Name = "u%PtfmMesh" + case default + Name = "Unknown Field" + end select +end function + subroutine Orca_PackOutputAry(Vars, y, ValAry) type(Orca_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1364,6 +1362,19 @@ subroutine Orca_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function Orca_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Orca_y_PtfmMesh) + Name = "y%PtfmMesh" + case (Orca_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE OrcaFlexInterface_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 6ae3dce567..c9c75d3708 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -53,6 +53,9 @@ MODULE SeaState PUBLIC :: SeaSt_JacobianPContState ! Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx PUBLIC :: SeaSt_JacobianPDiscState ! Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd PUBLIC :: SeaSt_JacobianPConstrState ! Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz + + PUBLIC :: SeaSt_PackExtInputAry ! Pack extended inputs + PUBLIC :: SeaSt_PackExtOutputAry ! Pack extended outputs CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -1007,6 +1010,44 @@ subroutine SeaSt_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ! endif end subroutine SeaSt_JacobianPConstrState +subroutine SeaSt_PackExtInputAry(Vars, u, ValAry) + type(ModVarsType), intent(in) :: Vars !< Module variables + type(SeaSt_InputType), intent(in) :: u !< Inputs + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + + ! Loop through Input variables + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + ! Select based on data location number + select case (Var%DL%Num) + case (SeaSt_u_WaveElev0) + ! WaveElev0 is zero to be consistent with linearization requirements + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine + +subroutine SeaSt_PackExtOutputAry(Vars, y, ValAry) + type(ModVarsType), intent(in) :: Vars !< Module variables + type(SeaSt_OutputType), intent(in) :: y !< Outputs + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + + ! Loop through output variables + do i = 1, size(Vars%y) + associate (Var => Vars%y(i)) + ! Select based on data location number + select case (Var%DL%Num) + case (SeaSt_y_WaveElev0) + ! WaveElev0 is zero to be consistent with linearization requirements + ValAry(Vars%y(i)%iLoc(1):Vars%y(i)%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE SeaState !********************************************************************************************************************************** diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 0a52f6eb43..80d24ef51a 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -1323,14 +1323,6 @@ function SeaSt_InputMeshPointer(u, DL) result(Mesh) end select end function -function SeaSt_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function SeaSt_OutputMeshPointer(y, DL) result(Mesh) type(SeaSt_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1340,14 +1332,6 @@ function SeaSt_OutputMeshPointer(y, DL) result(Mesh) end select end function -function SeaSt_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine SeaSt_PackContStateAry(Vars, x, ValAry) type(SeaSt_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1380,6 +1364,17 @@ subroutine SeaSt_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function SeaSt_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SeaSt_x_UnusedStates) + Name = "x%UnusedStates" + case default + Name = "Unknown Field" + end select +end function + subroutine SeaSt_PackContStateDerivAry(Vars, x, ValAry) type(SeaSt_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1397,21 +1392,6 @@ subroutine SeaSt_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine SeaSt_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SeaSt_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SeaSt_x_UnusedStates) - call MV_Unpack(V, ValAry, x%UnusedStates) ! Scalar - end select - end associate - end do -end subroutine - subroutine SeaSt_PackConstrStateAry(Vars, z, ValAry) type(SeaSt_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1444,6 +1424,17 @@ subroutine SeaSt_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function SeaSt_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SeaSt_z_UnusedStates) + Name = "z%UnusedStates" + case default + Name = "Unknown Field" + end select +end function + subroutine SeaSt_PackInputAry(Vars, u, ValAry) type(SeaSt_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1476,6 +1467,17 @@ subroutine SeaSt_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function SeaSt_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SeaSt_u_DummyInput) + Name = "u%DummyInput" + case default + Name = "Unknown Field" + end select +end function + subroutine SeaSt_PackOutputAry(Vars, y, ValAry) type(SeaSt_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -1508,6 +1510,17 @@ subroutine SeaSt_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function SeaSt_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SeaSt_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SeaState_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 60168ef732..0b8d4cb5fb 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -7233,24 +7233,6 @@ function SrvD_InputMeshPointer(u, DL) result(Mesh) end select end function -function SrvD_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (SrvD_u_PtfmMotionMesh) - Name = "u%PtfmMotionMesh" - case (SrvD_u_BStCMotionMesh) - Name = "u%BStCMotionMesh("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")" - case (SrvD_u_NStCMotionMesh) - Name = "u%NStCMotionMesh("//trim(Num2LStr(DL%i1))//")" - case (SrvD_u_TStCMotionMesh) - Name = "u%TStCMotionMesh("//trim(Num2LStr(DL%i1))//")" - case (SrvD_u_SStCMotionMesh) - Name = "u%SStCMotionMesh("//trim(Num2LStr(DL%i1))//")" - end select -end function - function SrvD_OutputMeshPointer(y, DL) result(Mesh) type(SrvD_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -7268,22 +7250,6 @@ function SrvD_OutputMeshPointer(y, DL) result(Mesh) end select end function -function SrvD_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (SrvD_y_BStCLoadMesh) - Name = "y%BStCLoadMesh("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")" - case (SrvD_y_NStCLoadMesh) - Name = "y%NStCLoadMesh("//trim(Num2LStr(DL%i1))//")" - case (SrvD_y_TStCLoadMesh) - Name = "y%TStCLoadMesh("//trim(Num2LStr(DL%i1))//")" - case (SrvD_y_SStCLoadMesh) - Name = "y%SStCLoadMesh("//trim(Num2LStr(DL%i1))//")" - end select -end function - subroutine SrvD_PackContStateAry(Vars, x, ValAry) type(SrvD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -7332,6 +7298,25 @@ subroutine SrvD_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function SrvD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SrvD_x_DummyContState) + Name = "x%DummyContState" + case (SrvD_x_BStC_StC_x) + Name = "x%BStC("//trim(Num2LStr(DL%i1))//")%StC_x" + case (SrvD_x_NStC_StC_x) + Name = "x%NStC("//trim(Num2LStr(DL%i1))//")%StC_x" + case (SrvD_x_TStC_StC_x) + Name = "x%TStC("//trim(Num2LStr(DL%i1))//")%StC_x" + case (SrvD_x_SStC_StC_x) + Name = "x%SStC("//trim(Num2LStr(DL%i1))//")%StC_x" + case default + Name = "Unknown Field" + end select +end function + subroutine SrvD_PackContStateDerivAry(Vars, x, ValAry) type(SrvD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -7357,29 +7342,6 @@ subroutine SrvD_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine SrvD_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SrvD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SrvD_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - case (SrvD_x_BStC_StC_x) - call MV_Unpack(V, ValAry, x%BStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (SrvD_x_NStC_StC_x) - call MV_Unpack(V, ValAry, x%NStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (SrvD_x_TStC_StC_x) - call MV_Unpack(V, ValAry, x%TStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (SrvD_x_SStC_StC_x) - call MV_Unpack(V, ValAry, x%SStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate - end do -end subroutine - subroutine SrvD_PackConstrStateAry(Vars, z, ValAry) type(SrvD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -7428,6 +7390,25 @@ subroutine SrvD_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function SrvD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SrvD_z_DummyConstrState) + Name = "z%DummyConstrState" + case (SrvD_z_BStC_DummyConstrState) + Name = "z%BStC("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case (SrvD_z_NStC_DummyConstrState) + Name = "z%NStC("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case (SrvD_z_TStC_DummyConstrState) + Name = "z%TStC("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case (SrvD_z_SStC_DummyConstrState) + Name = "z%SStC("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine SrvD_PackInputAry(Vars, u, ValAry) type(SrvD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -7660,6 +7641,117 @@ subroutine SrvD_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function SrvD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SrvD_u_BlPitch) + Name = "u%BlPitch" + case (SrvD_u_Yaw) + Name = "u%Yaw" + case (SrvD_u_YawRate) + Name = "u%YawRate" + case (SrvD_u_LSS_Spd) + Name = "u%LSS_Spd" + case (SrvD_u_HSS_Spd) + Name = "u%HSS_Spd" + case (SrvD_u_RotSpeed) + Name = "u%RotSpeed" + case (SrvD_u_ExternalYawPosCom) + Name = "u%ExternalYawPosCom" + case (SrvD_u_ExternalYawRateCom) + Name = "u%ExternalYawRateCom" + case (SrvD_u_ExternalBlPitchCom) + Name = "u%ExternalBlPitchCom" + case (SrvD_u_ExternalGenTrq) + Name = "u%ExternalGenTrq" + case (SrvD_u_ExternalElecPwr) + Name = "u%ExternalElecPwr" + case (SrvD_u_ExternalHSSBrFrac) + Name = "u%ExternalHSSBrFrac" + case (SrvD_u_ExternalBlAirfoilCom) + Name = "u%ExternalBlAirfoilCom" + case (SrvD_u_ExternalCableDeltaL) + Name = "u%ExternalCableDeltaL" + case (SrvD_u_ExternalCableDeltaLdot) + Name = "u%ExternalCableDeltaLdot" + case (SrvD_u_TwrAccel) + Name = "u%TwrAccel" + case (SrvD_u_YawErr) + Name = "u%YawErr" + case (SrvD_u_WindDir) + Name = "u%WindDir" + case (SrvD_u_RootMyc) + Name = "u%RootMyc" + case (SrvD_u_YawBrTAxp) + Name = "u%YawBrTAxp" + case (SrvD_u_YawBrTAyp) + Name = "u%YawBrTAyp" + case (SrvD_u_LSSTipPxa) + Name = "u%LSSTipPxa" + case (SrvD_u_RootMxc) + Name = "u%RootMxc" + case (SrvD_u_LSSTipMxa) + Name = "u%LSSTipMxa" + case (SrvD_u_LSSTipMya) + Name = "u%LSSTipMya" + case (SrvD_u_LSSTipMza) + Name = "u%LSSTipMza" + case (SrvD_u_LSSTipMys) + Name = "u%LSSTipMys" + case (SrvD_u_LSSTipMzs) + Name = "u%LSSTipMzs" + case (SrvD_u_YawBrMyn) + Name = "u%YawBrMyn" + case (SrvD_u_YawBrMzn) + Name = "u%YawBrMzn" + case (SrvD_u_NcIMURAxs) + Name = "u%NcIMURAxs" + case (SrvD_u_NcIMURAys) + Name = "u%NcIMURAys" + case (SrvD_u_NcIMURAzs) + Name = "u%NcIMURAzs" + case (SrvD_u_RotPwr) + Name = "u%RotPwr" + case (SrvD_u_HorWindV) + Name = "u%HorWindV" + case (SrvD_u_YawAngle) + Name = "u%YawAngle" + case (SrvD_u_LSShftFxa) + Name = "u%LSShftFxa" + case (SrvD_u_LSShftFys) + Name = "u%LSShftFys" + case (SrvD_u_LSShftFzs) + Name = "u%LSShftFzs" + case (SrvD_u_fromSC) + Name = "u%fromSC" + case (SrvD_u_fromSCglob) + Name = "u%fromSCglob" + case (SrvD_u_Lidar) + Name = "u%Lidar" + case (SrvD_u_PtfmMotionMesh) + Name = "u%PtfmMotionMesh" + case (SrvD_u_BStCMotionMesh) + Name = "u%BStCMotionMesh("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")" + case (SrvD_u_NStCMotionMesh) + Name = "u%NStCMotionMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_u_TStCMotionMesh) + Name = "u%TStCMotionMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_u_SStCMotionMesh) + Name = "u%SStCMotionMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_u_LidSpeed) + Name = "u%LidSpeed" + case (SrvD_u_MsrPositionsX) + Name = "u%MsrPositionsX" + case (SrvD_u_MsrPositionsY) + Name = "u%MsrPositionsY" + case (SrvD_u_MsrPositionsZ) + Name = "u%MsrPositionsZ" + case default + Name = "Unknown Field" + end select +end function + subroutine SrvD_PackOutputAry(Vars, y, ValAry) type(SrvD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -7752,6 +7844,47 @@ subroutine SrvD_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function SrvD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SrvD_y_WriteOutput) + Name = "y%WriteOutput" + case (SrvD_y_BlPitchCom) + Name = "y%BlPitchCom" + case (SrvD_y_BlAirfoilCom) + Name = "y%BlAirfoilCom" + case (SrvD_y_YawMom) + Name = "y%YawMom" + case (SrvD_y_GenTrq) + Name = "y%GenTrq" + case (SrvD_y_HSSBrTrqC) + Name = "y%HSSBrTrqC" + case (SrvD_y_ElecPwr) + Name = "y%ElecPwr" + case (SrvD_y_TBDrCon) + Name = "y%TBDrCon" + case (SrvD_y_Lidar) + Name = "y%Lidar" + case (SrvD_y_CableDeltaL) + Name = "y%CableDeltaL" + case (SrvD_y_CableDeltaLdot) + Name = "y%CableDeltaLdot" + case (SrvD_y_BStCLoadMesh) + Name = "y%BStCLoadMesh("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")" + case (SrvD_y_NStCLoadMesh) + Name = "y%NStCLoadMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_y_TStCLoadMesh) + Name = "y%TStCLoadMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_y_SStCLoadMesh) + Name = "y%SStCLoadMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_y_toSC) + Name = "y%toSC" + case default + Name = "Unknown Field" + end select +end function + END MODULE ServoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index e9aabaa9d7..b2ee959c7f 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -2323,16 +2323,6 @@ function StC_InputMeshPointer(u, DL) result(Mesh) end select end function -function StC_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (StC_u_Mesh) - Name = "u%Mesh("//trim(Num2LStr(DL%i1))//")" - end select -end function - function StC_OutputMeshPointer(y, DL) result(Mesh) type(StC_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -2344,16 +2334,6 @@ function StC_OutputMeshPointer(y, DL) result(Mesh) end select end function -function StC_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (StC_y_Mesh) - Name = "y%Mesh("//trim(Num2LStr(DL%i1))//")" - end select -end function - subroutine StC_PackContStateAry(Vars, x, ValAry) type(StC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2386,6 +2366,17 @@ subroutine StC_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function StC_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (StC_x_StC_x) + Name = "x%StC_x" + case default + Name = "Unknown Field" + end select +end function + subroutine StC_PackContStateDerivAry(Vars, x, ValAry) type(StC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2403,21 +2394,6 @@ subroutine StC_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine StC_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(StC_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (StC_x_StC_x) - call MV_Unpack(V, ValAry, x%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate - end do -end subroutine - subroutine StC_PackConstrStateAry(Vars, z, ValAry) type(StC_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2450,6 +2426,17 @@ subroutine StC_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function StC_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (StC_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine StC_PackInputAry(Vars, u, ValAry) type(StC_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2498,6 +2485,25 @@ subroutine StC_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function StC_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (StC_u_Mesh) + Name = "u%Mesh("//trim(Num2LStr(DL%i1))//")" + case (StC_u_CmdStiff) + Name = "u%CmdStiff" + case (StC_u_CmdDamp) + Name = "u%CmdDamp" + case (StC_u_CmdBrake) + Name = "u%CmdBrake" + case (StC_u_CmdForce) + Name = "u%CmdForce" + case default + Name = "Unknown Field" + end select +end function + subroutine StC_PackOutputAry(Vars, y, ValAry) type(StC_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2538,6 +2544,21 @@ subroutine StC_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function StC_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (StC_y_Mesh) + Name = "y%Mesh("//trim(Num2LStr(DL%i1))//")" + case (StC_y_MeasDisp) + Name = "y%MeasDisp" + case (StC_y_MeasVel) + Name = "y%MeasVel" + case default + Name = "Unknown Field" + end select +end function + END MODULE StrucCtrl_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 0d093daabd..b368cff795 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -4449,18 +4449,6 @@ function SD_InputMeshPointer(u, DL) result(Mesh) end select end function -function SD_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (SD_u_TPMesh) - Name = "u%TPMesh" - case (SD_u_LMesh) - Name = "u%LMesh" - end select -end function - function SD_OutputMeshPointer(y, DL) result(Mesh) type(SD_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -4476,20 +4464,6 @@ function SD_OutputMeshPointer(y, DL) result(Mesh) end select end function -function SD_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - case (SD_y_Y1Mesh) - Name = "y%Y1Mesh" - case (SD_y_Y2Mesh) - Name = "y%Y2Mesh" - case (SD_y_Y3Mesh) - Name = "y%Y3Mesh" - end select -end function - subroutine SD_PackContStateAry(Vars, x, ValAry) type(SD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -4526,6 +4500,19 @@ subroutine SD_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function SD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SD_x_qm) + Name = "x%qm" + case (SD_x_qmdot) + Name = "x%qmdot" + case default + Name = "Unknown Field" + end select +end function + subroutine SD_PackContStateDerivAry(Vars, x, ValAry) type(SD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -4545,23 +4532,6 @@ subroutine SD_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine SD_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SD_x_qm) - call MV_Unpack(V, ValAry, x%qm(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SD_x_qmdot) - call MV_Unpack(V, ValAry, x%qmdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate - end do -end subroutine - subroutine SD_PackConstrStateAry(Vars, z, ValAry) type(SD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -4594,6 +4564,17 @@ subroutine SD_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function SD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SD_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine SD_PackInputAry(Vars, u, ValAry) type(SD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -4634,6 +4615,21 @@ subroutine SD_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function SD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SD_u_TPMesh) + Name = "u%TPMesh" + case (SD_u_LMesh) + Name = "u%LMesh" + case (SD_u_CableDeltaL) + Name = "u%CableDeltaL" + case default + Name = "Unknown Field" + end select +end function + subroutine SD_PackOutputAry(Vars, y, ValAry) type(SD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -4678,6 +4674,23 @@ subroutine SD_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function SD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SD_y_Y1Mesh) + Name = "y%Y1Mesh" + case (SD_y_Y2Mesh) + Name = "y%Y2Mesh" + case (SD_y_Y3Mesh) + Name = "y%Y3Mesh" + case (SD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SubDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 70a5e4903a..d9dccf582f 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -670,14 +670,6 @@ function SC_DX_InputMeshPointer(u, DL) result(Mesh) end select end function -function SC_DX_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function SC_DX_OutputMeshPointer(y, DL) result(Mesh) type(SC_DX_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -687,14 +679,6 @@ function SC_DX_OutputMeshPointer(y, DL) result(Mesh) end select end function -function SC_DX_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine SC_DX_PackInputAry(Vars, u, ValAry) type(SC_DX_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -727,6 +711,17 @@ subroutine SC_DX_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function SC_DX_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_DX_u_toSC) + Name = "u%toSC" + case default + Name = "Unknown Field" + end select +end function + subroutine SC_DX_PackOutputAry(Vars, y, ValAry) type(SC_DX_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -763,6 +758,19 @@ subroutine SC_DX_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function SC_DX_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_DX_y_fromSC) + Name = "y%fromSC" + case (SC_DX_y_fromSCglob) + Name = "y%fromSCglob" + case default + Name = "Unknown Field" + end select +end function + END MODULE SCDataEx_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 3ca2cd36b0..46fb54eda1 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -1838,14 +1838,6 @@ function SC_InputMeshPointer(u, DL) result(Mesh) end select end function -function SC_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function SC_OutputMeshPointer(y, DL) result(Mesh) type(SC_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1855,14 +1847,6 @@ function SC_OutputMeshPointer(y, DL) result(Mesh) end select end function -function SC_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine SC_PackContStateAry(Vars, x, ValAry) type(SC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1895,6 +1879,17 @@ subroutine SC_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function SC_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_x_Dummy) + Name = "x%Dummy" + case default + Name = "Unknown Field" + end select +end function + subroutine SC_PackContStateDerivAry(Vars, x, ValAry) type(SC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -1912,21 +1907,6 @@ subroutine SC_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine SC_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(SC_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SC_x_Dummy) - call MV_Unpack(V, ValAry, x%Dummy) ! Scalar - end select - end associate - end do -end subroutine - subroutine SC_PackConstrStateAry(Vars, z, ValAry) type(SC_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -1959,6 +1939,17 @@ subroutine SC_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function SC_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_z_Dummy) + Name = "z%Dummy" + case default + Name = "Unknown Field" + end select +end function + subroutine SC_PackInputAry(Vars, u, ValAry) type(SC_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -1995,6 +1986,19 @@ subroutine SC_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function SC_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_u_toSCglob) + Name = "u%toSCglob" + case (SC_u_toSC) + Name = "u%toSC" + case default + Name = "Unknown Field" + end select +end function + subroutine SC_PackOutputAry(Vars, y, ValAry) type(SC_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2031,6 +2035,19 @@ subroutine SC_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function SC_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_y_fromSCglob) + Name = "y%fromSCglob" + case (SC_y_fromSC) + Name = "y%fromSC" + case default + Name = "Unknown Field" + end select +end function + END MODULE SuperController_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 52ed5e1ec2..0b85acf14c 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -1946,14 +1946,6 @@ function WD_InputMeshPointer(u, DL) result(Mesh) end select end function -function WD_InputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - function WD_OutputMeshPointer(y, DL) result(Mesh) type(WD_OutputType), target, intent(in) :: y type(DatLoc), intent(in) :: DL @@ -1963,14 +1955,6 @@ function WD_OutputMeshPointer(y, DL) result(Mesh) end select end function -function WD_OutputMeshName(DL) result(Name) - type(DatLoc), intent(in) :: DL - character(32) :: Name - Name = "" - select case (DL%Num) - end select -end function - subroutine WD_PackContStateAry(Vars, x, ValAry) type(WD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2003,6 +1987,17 @@ subroutine WD_UnpackContStateAry(Vars, ValAry, x) end do end subroutine +function WD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WD_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + subroutine WD_PackContStateDerivAry(Vars, x, ValAry) type(WD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars @@ -2020,21 +2015,6 @@ subroutine WD_PackContStateDerivAry(Vars, x, ValAry) end do end subroutine -subroutine WD_UnpackContStateDerivAry(Vars, ValAry, x) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: ValAry(:) - type(WD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (WD_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate - end do -end subroutine - subroutine WD_PackConstrStateAry(Vars, z, ValAry) type(WD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars @@ -2067,6 +2047,17 @@ subroutine WD_UnpackConstrStateAry(Vars, ValAry, z) end do end subroutine +function WD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WD_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + subroutine WD_PackInputAry(Vars, u, ValAry) type(WD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars @@ -2143,6 +2134,39 @@ subroutine WD_UnpackInputAry(Vars, ValAry, u) end do end subroutine +function WD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WD_u_xhat_disk) + Name = "u%xhat_disk" + case (WD_u_YawErr) + Name = "u%YawErr" + case (WD_u_psi_skew) + Name = "u%psi_skew" + case (WD_u_chi_skew) + Name = "u%chi_skew" + case (WD_u_p_hub) + Name = "u%p_hub" + case (WD_u_V_plane) + Name = "u%V_plane" + case (WD_u_Vx_wind_disk) + Name = "u%Vx_wind_disk" + case (WD_u_TI_amb) + Name = "u%TI_amb" + case (WD_u_D_rotor) + Name = "u%D_rotor" + case (WD_u_Vx_rel_disk) + Name = "u%Vx_rel_disk" + case (WD_u_Ct_azavg) + Name = "u%Ct_azavg" + case (WD_u_Cq_azavg) + Name = "u%Cq_azavg" + case default + Name = "Unknown Field" + end select +end function + subroutine WD_PackOutputAry(Vars, y, ValAry) type(WD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars @@ -2211,6 +2235,35 @@ subroutine WD_UnpackOutputAry(Vars, ValAry, y) end do end subroutine +function WD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WD_y_xhat_plane) + Name = "y%xhat_plane" + case (WD_y_p_plane) + Name = "y%p_plane" + case (WD_y_Vx_wake) + Name = "y%Vx_wake" + case (WD_y_Vr_wake) + Name = "y%Vr_wake" + case (WD_y_Vx_wake2) + Name = "y%Vx_wake2" + case (WD_y_Vy_wake2) + Name = "y%Vy_wake2" + case (WD_y_Vz_wake2) + Name = "y%Vz_wake2" + case (WD_y_D_wake) + Name = "y%D_wake" + case (WD_y_x_plane) + Name = "y%x_plane" + case (WD_y_WAT_k) + Name = "y%WAT_k" + case default + Name = "Unknown Field" + end select +end function + END MODULE WakeDynamics_Types !ENDOFREGISTRYGENERATEDFILE From fe88291b9a1bcb66eaba7a79521cc6a712de783e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Aug 2024 20:55:39 +0000 Subject: [PATCH 167/319] Tight coupling appears to be working for at least some regression tests. They don't pass, but OpenFAST isn't crashing --- docs/source/user/glue/modvar.dot | 11 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 321 ++-- modules/aerodyn/src/AeroDyn.f90 | 46 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 485 ++--- modules/aerodyn/src/AeroDyn_Types.f90 | 353 ++-- modules/aerodyn/src/AirfoilInfo_Types.f90 | 172 +- modules/aerodyn/src/BEMT_Types.f90 | 557 +++--- modules/aerodyn/src/DBEMT_Types.f90 | 253 ++- modules/aerodyn/src/FVW_Types.f90 | 329 ++-- modules/aerodyn/src/UnsteadyAero_Types.f90 | 289 +-- modules/awae/src/AWAE_Types.f90 | 281 +-- modules/beamdyn/src/BeamDyn.f90 | 39 +- modules/beamdyn/src/BeamDyn_Types.f90 | 293 +-- modules/elastodyn/src/ElastoDyn.f90 | 40 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 581 +++--- .../src/ExternalInflow_Types.f90 | 244 +-- modules/extloads/src/ExtLoadsDX_Types.f90 | 140 +- modules/extloads/src/ExtLoads_Types.f90 | 337 ++-- modules/extptfm/src/ExtPtfm_MCKF.f90 | 168 +- modules/extptfm/src/ExtPtfm_MCKF_Registry.txt | 30 +- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 511 +++--- modules/feamooring/src/FEAMooring_Types.f90 | 253 ++- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 209 ++- modules/hydrodyn/src/HydroDyn.f90 | 20 +- modules/hydrodyn/src/HydroDyn_DriverSubs.f90 | 6 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 333 ++-- modules/hydrodyn/src/Morison_Types.f90 | 225 ++- modules/hydrodyn/src/SS_Excitation_Types.f90 | 217 ++- modules/hydrodyn/src/SS_Radiation_Types.f90 | 217 ++- modules/hydrodyn/src/WAMIT2_Types.f90 | 46 +- modules/hydrodyn/src/WAMIT_Types.f90 | 249 ++- modules/icedyn/src/IceDyn_Types.f90 | 229 ++- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 217 ++- modules/inflowwind/src/InflowWind.f90 | 12 +- modules/inflowwind/src/InflowWind_Types.f90 | 337 ++-- modules/inflowwind/src/Lidar_Types.f90 | 273 +-- modules/lindyn/src/LinDyn_Types.f90 | 217 ++- modules/map/src/MAP_Types.f90 | 305 ++-- modules/map/src/map.f90 | 10 +- modules/moordyn/src/MoorDyn.f90 | 40 +- modules/moordyn/src/MoorDyn_Types.f90 | 265 +-- modules/nwtc-library/src/ModVar.f90 | 154 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 102 +- .../src/Registry_NWTC_Library.txt | 19 +- .../src/Registry_NWTC_Library_base.txt | 19 +- modules/openfast-library/CMakeLists.txt | 1 + modules/openfast-library/src/FAST_AeroMap.f90 | 64 +- modules/openfast-library/src/FAST_Funcs.f90 | 1394 +++++++------- modules/openfast-library/src/FAST_Mapping.f90 | 948 +++++----- modules/openfast-library/src/FAST_ModGlue.f90 | 179 +- modules/openfast-library/src/FAST_Mods.f90 | 6 +- .../openfast-library/src/FAST_Registry.txt | 5 +- modules/openfast-library/src/FAST_Solver.f90 | 56 +- .../openfast-library/src/FAST_SolverTC.f90 | 1610 +++++++++++++++++ modules/openfast-library/src/FAST_Subs.f90 | 346 ++-- modules/openfast-library/src/FAST_Types.f90 | 40 + .../openfast-library/src/Glue_Registry.txt | 97 +- modules/openfast-library/src/Glue_Types.f90 | 1411 +++++++-------- .../src/registry_gen_fortran.cpp | 88 +- .../src/OrcaFlexInterface_Types.f90 | 217 ++- modules/seastate/src/SeaState_Types.f90 | 209 ++- modules/servodyn/src/ServoDyn_Types.f90 | 809 +++++---- modules/servodyn/src/StrucCtrl_Types.f90 | 257 ++- modules/subdyn/src/SubDyn.f90 | 38 +- modules/subdyn/src/SubDyn_Types.f90 | 261 ++- .../supercontroller/src/SCDataEx_Types.f90 | 100 +- .../src/SuperController_Types.f90 | 225 ++- .../wakedynamics/src/WakeDynamics_Types.f90 | 369 ++-- 68 files changed, 11071 insertions(+), 7113 deletions(-) create mode 100644 modules/openfast-library/src/FAST_SolverTC.f90 diff --git a/docs/source/user/glue/modvar.dot b/docs/source/user/glue/modvar.dot index 37c989767a..380b57089b 100644 --- a/docs/source/user/glue/modvar.dot +++ b/docs/source/user/glue/modvar.dot @@ -25,11 +25,12 @@ digraph UML_Class_diagram { DerivOrderIntKi iLoc(2)IntKi iGlu(2)IntKi - iAry(2)IntKi - jAryIntKi - kAryIntKi - mAryIntKi - MeshIDIntKi + iLBIntKi + iUBIntKi + jIntKi + kIntKi + mIntKi + nIntKi PerturbR8Ki >] diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 52871cf06f..5ad5640167 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -3027,38 +3027,52 @@ function AA_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine AA_PackContStateAry(Vars, x, ValAry) +subroutine AA_VarsPackContState(Vars, x, ValAry) type(AA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AA_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AA_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine AA_UnpackContStateAry(Vars, ValAry, x) +subroutine AA_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(AA_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AA_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AA_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate + call AA_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine AA_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function AA_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3070,55 +3084,76 @@ function AA_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine AA_PackContStateDerivAry(Vars, x, ValAry) +subroutine AA_VarsPackContStateDeriv(Vars, x, ValAry) type(AA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AA_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AA_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine AA_PackConstrStateAry(Vars, z, ValAry) +subroutine AA_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(AA_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsPackConstrState(Vars, z, ValAry) type(AA_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (AA_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AA_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine AA_UnpackConstrStateAry(Vars, ValAry, z) +subroutine AA_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(AA_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AA_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (AA_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call AA_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine AA_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function AA_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3130,54 +3165,68 @@ function AA_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine AA_PackInputAry(Vars, u, ValAry) +subroutine AA_VarsPackInput(Vars, u, ValAry) type(AA_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (AA_u_RotGtoL) - call MV_Pack(V, u%RotGtoL(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array - case (AA_u_AeroCent_G) - call MV_Pack(V, u%AeroCent_G(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (AA_u_Vrel) - call MV_Pack(V, u%Vrel(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (AA_u_AoANoise) - call MV_Pack(V, u%AoANoise(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (AA_u_Inflow) - call MV_Pack(V, u%Inflow(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AA_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine AA_UnpackInputAry(Vars, ValAry, u) +subroutine AA_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(AA_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_u_RotGtoL) + VarVals = u%RotGtoL(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AA_u_AeroCent_G) + VarVals = u%AeroCent_G(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AA_u_Vrel) + VarVals = u%Vrel(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AA_u_AoANoise) + VarVals = u%AoANoise(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AA_u_Inflow) + VarVals = u%Inflow(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AA_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (AA_u_RotGtoL) - call MV_Unpack(V, ValAry, u%RotGtoL(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array - case (AA_u_AeroCent_G) - call MV_Unpack(V, ValAry, u%AeroCent_G(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (AA_u_Vrel) - call MV_Unpack(V, ValAry, u%Vrel(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (AA_u_AoANoise) - call MV_Unpack(V, ValAry, u%AoANoise(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (AA_u_Inflow) - call MV_Unpack(V, ValAry, u%Inflow(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - end select - end associate + call AA_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine AA_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AA_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_u_RotGtoL) + u%RotGtoL(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AA_u_AeroCent_G) + u%AeroCent_G(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AA_u_Vrel) + u%Vrel(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AA_u_AoANoise) + u%AoANoise(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AA_u_Inflow) + u%Inflow(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + end select + end associate +end subroutine + function AA_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3197,78 +3246,92 @@ function AA_InputFieldName(DL) result(Name) end select end function -subroutine AA_PackOutputAry(Vars, y, ValAry) +subroutine AA_VarsPackOutput(Vars, y, ValAry) type(AA_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (AA_y_SumSpecNoise) - call MV_Pack(V, y%SumSpecNoise(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (AA_y_SumSpecNoiseSep) - call MV_Pack(V, y%SumSpecNoiseSep(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (AA_y_OASPL) - call MV_Pack(V, y%OASPL(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (AA_y_OASPL_Mech) - call MV_Pack(V, y%OASPL_Mech(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array - case (AA_y_DirectiviOutput) - call MV_Pack(V, y%DirectiviOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AA_y_OutLECoords) - call MV_Pack(V, y%OutLECoords(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array - case (AA_y_PtotalFreq) - call MV_Pack(V, y%PtotalFreq(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (AA_y_WriteOutputForPE) - call MV_Pack(V, y%WriteOutputForPE(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AA_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AA_y_WriteOutputSep) - call MV_Pack(V, y%WriteOutputSep(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AA_y_WriteOutputNode) - call MV_Pack(V, y%WriteOutputNode(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AA_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine AA_UnpackOutputAry(Vars, ValAry, y) +subroutine AA_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(AA_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_y_SumSpecNoise) + VarVals = y%SumSpecNoise(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + VarVals = y%SumSpecNoiseSep(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AA_y_OASPL) + VarVals = y%OASPL(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AA_y_OASPL_Mech) + VarVals = y%OASPL_Mech(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AA_y_DirectiviOutput) + VarVals = y%DirectiviOutput(V%iLB:V%iUB) ! Rank 1 Array + case (AA_y_OutLECoords) + VarVals = y%OutLECoords(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AA_y_PtotalFreq) + VarVals = y%PtotalFreq(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AA_y_WriteOutputForPE) + VarVals = y%WriteOutputForPE(V%iLB:V%iUB) ! Rank 1 Array + case (AA_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (AA_y_WriteOutputSep) + VarVals = y%WriteOutputSep(V%iLB:V%iUB) ! Rank 1 Array + case (AA_y_WriteOutputNode) + VarVals = y%WriteOutputNode(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AA_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (AA_y_SumSpecNoise) - call MV_Unpack(V, ValAry, y%SumSpecNoise(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (AA_y_SumSpecNoiseSep) - call MV_Unpack(V, ValAry, y%SumSpecNoiseSep(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (AA_y_OASPL) - call MV_Unpack(V, ValAry, y%OASPL(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (AA_y_OASPL_Mech) - call MV_Unpack(V, ValAry, y%OASPL_Mech(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array - case (AA_y_DirectiviOutput) - call MV_Unpack(V, ValAry, y%DirectiviOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AA_y_OutLECoords) - call MV_Unpack(V, ValAry, y%OutLECoords(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array - case (AA_y_PtotalFreq) - call MV_Unpack(V, ValAry, y%PtotalFreq(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (AA_y_WriteOutputForPE) - call MV_Unpack(V, ValAry, y%WriteOutputForPE(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AA_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AA_y_WriteOutputSep) - call MV_Unpack(V, ValAry, y%WriteOutputSep(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AA_y_WriteOutputNode) - call MV_Unpack(V, ValAry, y%WriteOutputNode(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call AA_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine AA_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AA_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_y_SumSpecNoise) + y%SumSpecNoise(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + y%SumSpecNoiseSep(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AA_y_OASPL) + y%OASPL(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AA_y_OASPL_Mech) + y%OASPL_Mech(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AA_y_DirectiviOutput) + y%DirectiviOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AA_y_OutLECoords) + y%OutLECoords(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AA_y_PtotalFreq) + y%PtotalFreq(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AA_y_WriteOutputForPE) + y%WriteOutputForPE(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AA_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AA_y_WriteOutputSep) + y%WriteOutputSep(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AA_y_WriteOutputNode) + y%WriteOutputNode(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function AA_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 3d893a3dad..7d28a2d782 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -60,7 +60,7 @@ module AeroDyn PUBLIC :: AD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - PUBLIC :: AD_PackExtInputAry !< Routine pack extended inputs + PUBLIC :: AD_VarsPackExtInput !< Routine pack extended inputs public :: AD_CalcWind_Rotor !< Routine to calculate rotor wind inputs contains @@ -5960,7 +5960,7 @@ SUBROUTINE Rot_JacobianPInput(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, ! Copy inputs and pack them for perturbation call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackInputAry(Vars, u, m%Jac%u) + call AD_VarsPackInput(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -5983,27 +5983,27 @@ SUBROUTINE Rot_JacobianPInput(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call AD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, 1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call AD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call AD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, -1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call AD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 @@ -6031,21 +6031,21 @@ SUBROUTINE Rot_JacobianPInput(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call AD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, 1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call AD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call AD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call AD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, -1, FF_ptr) StartNode = 1 call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call AD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 @@ -6201,7 +6201,7 @@ SUBROUTINE RotJacobianPContState(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, ! Copy and pack states for perturbation call AD_CopyRotContinuousStateType(m%x_init, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateAry(Vars, m%x_init, m%Jac%x) + call AD_VarsPackContState(Vars, m%x_init, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then @@ -6219,15 +6219,15 @@ SUBROUTINE RotJacobianPContState(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call AD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call AD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call AD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2) ; if (Failed()) return - call AD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call AD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index col = Vars%x(i)%iLoc(1) + j - 1 @@ -6255,15 +6255,15 @@ SUBROUTINE RotJacobianPContState(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call AD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call AD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call AD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call AD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call AD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call AD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = Vars%x(i)%iLoc(1) + j - 1 @@ -6570,7 +6570,7 @@ end subroutine cleanup END SUBROUTINE RotJacobianPConstrState -subroutine AD_PackExtInputAry(Vars, t, p, ValAry) +subroutine AD_VarsPackExtInput(Vars, t, p, ValAry) use IfW_FlowField_Types, only : UniformField_Interp use IfW_FlowField, only : UniformField_InterpCubic, UniformField_InterpLinear type(ModVarsType), intent(in) :: Vars @@ -6586,13 +6586,13 @@ subroutine AD_PackExtInputAry(Vars, t, p, ValAry) select case(Var%DL%Num) case (AD_u_HWindSpeed) call CalcExtOP() - call MV_Pack(Var, op%VelH, ValAry) + ValAry(Var%iLoc(1)) = op%VelH case (AD_u_PLExp) call CalcExtOP() - call MV_Pack(Var, op%ShrV, ValAry) + ValAry(Var%iLoc(1)) = op%ShrV case (AD_u_PropagationDir) call CalcExtOP() - call MV_Pack(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + ValAry(Var%iLoc(1)) = op%AngleH + p%FlowField%PropagationDir end select end associate end do diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index b616e36a33..3c7f3665f8 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -1832,82 +1832,96 @@ function ADI_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine ADI_PackContStateAry(Vars, x, ValAry) +subroutine ADI_VarsPackContState(Vars, x, ValAry) type(ADI_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ADI_x_AD_rotors_BEMT_UA_element_x) - call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) - call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) - call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_V_w) - call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_AA_DummyContState) - call MV_Pack(V, x%AD%rotors(DL%i1)%AA%DummyContState, ValAry) ! Scalar - case (ADI_x_AD_FVW_W_Gamma_NW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Gamma_FW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Eps_NW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_Eps_FW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_NW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_FW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_UA_element_x) - call MV_Pack(V, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ADI_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine ADI_UnpackContStateAry(Vars, ValAry, x) +subroutine ADI_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + VarVals = x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + VarVals = x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + VarVals = x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + VarVals = x%AD%rotors(DL%i1)%BEMT%V_w(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + VarVals(1) = x%AD%rotors(DL%i1)%AA%DummyContState ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + VarVals = x%AD%FVW%W(DL%i1)%Gamma_NW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + VarVals = x%AD%FVW%W(DL%i1)%Gamma_FW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + VarVals = x%AD%FVW%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + VarVals = x%AD%FVW%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + VarVals = x%AD%FVW%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + VarVals = x%AD%FVW%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + VarVals = x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ADI_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ADI_x_AD_rotors_BEMT_UA_element_x) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_V_w) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%BEMT%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_x_AD_rotors_AA_DummyContState) - call MV_Unpack(V, ValAry, x%AD%rotors(DL%i1)%AA%DummyContState) ! Scalar - case (ADI_x_AD_FVW_W_Gamma_NW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Gamma_FW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Eps_NW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ADI_x_AD_FVW_W_Eps_FW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_NW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_FW) - call MV_Unpack(V, ValAry, x%AD%FVW%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ADI_x_AD_FVW_UA_element_x) - call MV_Unpack(V, ValAry, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ADI_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine ADI_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + x%AD%rotors(DL%i1)%BEMT%V_w(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + x%AD%rotors(DL%i1)%AA%DummyContState = VarVals(1) ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + x%AD%FVW%W(DL%i1)%Gamma_NW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + x%AD%FVW%W(DL%i1)%Gamma_FW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + x%AD%FVW%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + x%AD%FVW%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + x%AD%FVW%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + x%AD%FVW%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ADI_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1941,89 +1955,110 @@ function ADI_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine ADI_PackContStateDerivAry(Vars, x, ValAry) +subroutine ADI_VarsPackContStateDeriv(Vars, x, ValAry) type(ADI_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ADI_x_AD_rotors_BEMT_UA_element_x) - call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) - call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) - call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_BEMT_V_w) - call MV_Pack(V, x%AD%rotors(DL%i1)%BEMT%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_x_AD_rotors_AA_DummyContState) - call MV_Pack(V, x%AD%rotors(DL%i1)%AA%DummyContState, ValAry) ! Scalar - case (ADI_x_AD_FVW_W_Gamma_NW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Gamma_FW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (ADI_x_AD_FVW_W_Eps_NW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_Eps_FW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_NW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_W_r_FW) - call MV_Pack(V, x%AD%FVW%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ADI_x_AD_FVW_UA_element_x) - call MV_Pack(V, x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ADI_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine ADI_PackConstrStateAry(Vars, z, ValAry) +subroutine ADI_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + VarVals = x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + VarVals = x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + VarVals = x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + VarVals = x%AD%rotors(DL%i1)%BEMT%V_w(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + VarVals(1) = x%AD%rotors(DL%i1)%AA%DummyContState ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + VarVals = x%AD%FVW%W(DL%i1)%Gamma_NW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + VarVals = x%AD%FVW%W(DL%i1)%Gamma_FW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + VarVals = x%AD%FVW%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + VarVals = x%AD%FVW%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + VarVals = x%AD%FVW%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + VarVals = x%AD%FVW%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + VarVals = x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsPackConstrState(Vars, z, ValAry) type(ADI_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (ADI_z_AD_rotors_BEMT_phi) - call MV_Pack(V, z%AD%rotors(DL%i1)%BEMT%phi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (ADI_z_AD_rotors_AA_DummyConstrState) - call MV_Pack(V, z%AD%rotors(DL%i1)%AA%DummyConstrState, ValAry) ! Scalar - case (ADI_z_AD_FVW_W_Gamma_LL) - call MV_Pack(V, z%AD%FVW%W(DL%i1)%Gamma_LL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_z_AD_FVW_residual) - call MV_Pack(V, z%AD%FVW%residual, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ADI_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine ADI_UnpackConstrStateAry(Vars, ValAry, z) +subroutine ADI_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + VarVals = z%AD%rotors(DL%i1)%BEMT%phi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_z_AD_rotors_AA_DummyConstrState) + VarVals(1) = z%AD%rotors(DL%i1)%AA%DummyConstrState ! Scalar + case (ADI_z_AD_FVW_W_Gamma_LL) + VarVals = z%AD%FVW%W(DL%i1)%Gamma_LL(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_z_AD_FVW_residual) + VarVals(1) = z%AD%FVW%residual ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ADI_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (ADI_z_AD_rotors_BEMT_phi) - call MV_Unpack(V, ValAry, z%AD%rotors(DL%i1)%BEMT%phi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (ADI_z_AD_rotors_AA_DummyConstrState) - call MV_Unpack(V, ValAry, z%AD%rotors(DL%i1)%AA%DummyConstrState) ! Scalar - case (ADI_z_AD_FVW_W_Gamma_LL) - call MV_Unpack(V, ValAry, z%AD%FVW%W(DL%i1)%Gamma_LL(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_z_AD_FVW_residual) - call MV_Unpack(V, ValAry, z%AD%FVW%residual) ! Scalar - end select - end associate + call ADI_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine ADI_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + z%AD%rotors(DL%i1)%BEMT%phi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ADI_z_AD_rotors_AA_DummyConstrState) + z%AD%rotors(DL%i1)%AA%DummyConstrState = VarVals(1) ! Scalar + case (ADI_z_AD_FVW_W_Gamma_LL) + z%AD%FVW%W(DL%i1)%Gamma_LL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_z_AD_FVW_residual) + z%AD%FVW%residual = VarVals(1) ! Scalar + end select + end associate +end subroutine + function ADI_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2041,62 +2076,76 @@ function ADI_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine ADI_PackInputAry(Vars, u, ValAry) +subroutine ADI_VarsPackInput(Vars, u, ValAry) type(ADI_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ADI_u_AD_rotors_NacelleMotion) - call MV_Pack(V, u%AD%rotors(DL%i1)%NacelleMotion, ValAry) ! Mesh - case (ADI_u_AD_rotors_TowerMotion) - call MV_Pack(V, u%AD%rotors(DL%i1)%TowerMotion, ValAry) ! Mesh - case (ADI_u_AD_rotors_HubMotion) - call MV_Pack(V, u%AD%rotors(DL%i1)%HubMotion, ValAry) ! Mesh - case (ADI_u_AD_rotors_BladeRootMotion) - call MV_Pack(V, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2), ValAry) ! Mesh - case (ADI_u_AD_rotors_BladeMotion) - call MV_Pack(V, u%AD%rotors(DL%i1)%BladeMotion(DL%i2), ValAry) ! Mesh - case (ADI_u_AD_rotors_TFinMotion) - call MV_Pack(V, u%AD%rotors(DL%i1)%TFinMotion, ValAry) ! Mesh - case (ADI_u_AD_rotors_UserProp) - call MV_Pack(V, u%AD%rotors(DL%i1)%UserProp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ADI_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine ADI_UnpackInputAry(Vars, ValAry, u) +subroutine ADI_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%NacelleMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_TowerMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%TowerMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_HubMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%HubMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_BladeRootMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2), ValAry) ! Mesh + case (ADI_u_AD_rotors_BladeMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%BladeMotion(DL%i2), ValAry) ! Mesh + case (ADI_u_AD_rotors_TFinMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%TFinMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_UserProp) + VarVals = u%AD%rotors(DL%i1)%UserProp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ADI_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ADI_u_AD_rotors_NacelleMotion) - call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%NacelleMotion) ! Mesh - case (ADI_u_AD_rotors_TowerMotion) - call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%TowerMotion) ! Mesh - case (ADI_u_AD_rotors_HubMotion) - call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%HubMotion) ! Mesh - case (ADI_u_AD_rotors_BladeRootMotion) - call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2)) ! Mesh - case (ADI_u_AD_rotors_BladeMotion) - call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%BladeMotion(DL%i2)) ! Mesh - case (ADI_u_AD_rotors_TFinMotion) - call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%TFinMotion) ! Mesh - case (ADI_u_AD_rotors_UserProp) - call MV_Unpack(V, ValAry, u%AD%rotors(DL%i1)%UserProp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call ADI_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine ADI_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%NacelleMotion) ! Mesh + case (ADI_u_AD_rotors_TowerMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%TowerMotion) ! Mesh + case (ADI_u_AD_rotors_HubMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%HubMotion) ! Mesh + case (ADI_u_AD_rotors_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2)) ! Mesh + case (ADI_u_AD_rotors_BladeMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%BladeMotion(DL%i2)) ! Mesh + case (ADI_u_AD_rotors_TFinMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%TFinMotion) ! Mesh + case (ADI_u_AD_rotors_UserProp) + u%AD%rotors(DL%i1)%UserProp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function ADI_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2120,74 +2169,88 @@ function ADI_InputFieldName(DL) result(Name) end select end function -subroutine ADI_PackOutputAry(Vars, y, ValAry) +subroutine ADI_VarsPackOutput(Vars, y, ValAry) type(ADI_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ADI_y_AD_rotors_NacelleLoad) - call MV_Pack(V, y%AD%rotors(DL%i1)%NacelleLoad, ValAry) ! Mesh - case (ADI_y_AD_rotors_HubLoad) - call MV_Pack(V, y%AD%rotors(DL%i1)%HubLoad, ValAry) ! Mesh - case (ADI_y_AD_rotors_TowerLoad) - call MV_Pack(V, y%AD%rotors(DL%i1)%TowerLoad, ValAry) ! Mesh - case (ADI_y_AD_rotors_BladeLoad) - call MV_Pack(V, y%AD%rotors(DL%i1)%BladeLoad(DL%i2), ValAry) ! Mesh - case (ADI_y_AD_rotors_TFinLoad) - call MV_Pack(V, y%AD%rotors(DL%i1)%TFinLoad, ValAry) ! Mesh - case (ADI_y_AD_rotors_WriteOutput) - call MV_Pack(V, y%AD%rotors(DL%i1)%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_y_HHVel) - call MV_Pack(V, y%HHVel(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (ADI_y_PLExp) - call MV_Pack(V, y%PLExp, ValAry) ! Scalar - case (ADI_y_IW_WriteOutput) - call MV_Pack(V, y%IW_WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ADI_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ADI_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine ADI_UnpackOutputAry(Vars, ValAry, y) +subroutine ADI_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%NacelleLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_HubLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%HubLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_TowerLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%TowerLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_BladeLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%BladeLoad(DL%i2), ValAry) ! Mesh + case (ADI_y_AD_rotors_TFinLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%TFinLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_WriteOutput) + VarVals = y%AD%rotors(DL%i1)%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_y_HHVel) + VarVals = y%HHVel(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_y_PLExp) + VarVals(1) = y%PLExp ! Scalar + case (ADI_y_IW_WriteOutput) + VarVals = y%IW_WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ADI_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ADI_y_AD_rotors_NacelleLoad) - call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%NacelleLoad) ! Mesh - case (ADI_y_AD_rotors_HubLoad) - call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%HubLoad) ! Mesh - case (ADI_y_AD_rotors_TowerLoad) - call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%TowerLoad) ! Mesh - case (ADI_y_AD_rotors_BladeLoad) - call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%BladeLoad(DL%i2)) ! Mesh - case (ADI_y_AD_rotors_TFinLoad) - call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%TFinLoad) ! Mesh - case (ADI_y_AD_rotors_WriteOutput) - call MV_Unpack(V, ValAry, y%AD%rotors(DL%i1)%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_y_HHVel) - call MV_Unpack(V, ValAry, y%HHVel(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (ADI_y_PLExp) - call MV_Unpack(V, ValAry, y%PLExp) ! Scalar - case (ADI_y_IW_WriteOutput) - call MV_Unpack(V, ValAry, y%IW_WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ADI_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ADI_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine ADI_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%NacelleLoad) ! Mesh + case (ADI_y_AD_rotors_HubLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%HubLoad) ! Mesh + case (ADI_y_AD_rotors_TowerLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%TowerLoad) ! Mesh + case (ADI_y_AD_rotors_BladeLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%BladeLoad(DL%i2)) ! Mesh + case (ADI_y_AD_rotors_TFinLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%TFinLoad) ! Mesh + case (ADI_y_AD_rotors_WriteOutput) + y%AD%rotors(DL%i1)%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_y_HHVel) + y%HHVel(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ADI_y_PLExp) + y%PLExp = VarVals(1) ! Scalar + case (ADI_y_IW_WriteOutput) + y%IW_WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ADI_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index a90405e3ee..2e5ddb8900 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -6754,54 +6754,68 @@ function AD_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine AD_PackContStateAry(Vars, x, ValAry) +subroutine AD_VarsPackContState(Vars, x, ValAry) type(RotContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AD_x_BEMT_UA_element_x) - call MV_Pack(V, x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind) - call MV_Pack(V, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind_1) - call MV_Pack(V, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AD_x_BEMT_V_w) - call MV_Pack(V, x%BEMT%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AD_x_AA_DummyContState) - call MV_Pack(V, x%AA%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AD_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine AD_UnpackContStateAry(Vars, ValAry, x) +subroutine AD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(RotContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + VarVals = x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + VarVals = x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + VarVals = x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_V_w) + VarVals = x%BEMT%V_w(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_AA_DummyContState) + VarVals(1) = x%AA%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(RotContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AD_x_BEMT_UA_element_x) - call MV_Unpack(V, ValAry, x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind) - call MV_Unpack(V, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind_1) - call MV_Unpack(V, ValAry, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AD_x_BEMT_V_w) - call MV_Unpack(V, ValAry, x%BEMT%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AD_x_AA_DummyContState) - call MV_Unpack(V, ValAry, x%AA%DummyContState) ! Scalar - end select - end associate + call AD_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine AD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(RotContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AD_x_BEMT_V_w) + x%BEMT%V_w(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AD_x_AA_DummyContState) + x%AA%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function AD_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -6821,67 +6835,88 @@ function AD_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine AD_PackContStateDerivAry(Vars, x, ValAry) +subroutine AD_VarsPackContStateDeriv(Vars, x, ValAry) type(RotContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AD_x_BEMT_UA_element_x) - call MV_Pack(V, x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind) - call MV_Pack(V, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AD_x_BEMT_DBEMT_element_vind_1) - call MV_Pack(V, x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AD_x_BEMT_V_w) - call MV_Pack(V, x%BEMT%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AD_x_AA_DummyContState) - call MV_Pack(V, x%AA%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AD_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine AD_PackConstrStateAry(Vars, z, ValAry) +subroutine AD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(RotContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + VarVals = x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + VarVals = x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + VarVals = x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_V_w) + VarVals = x%BEMT%V_w(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_AA_DummyContState) + VarVals(1) = x%AA%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsPackConstrState(Vars, z, ValAry) type(RotConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (AD_z_BEMT_phi) - call MV_Pack(V, z%BEMT%phi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (AD_z_AA_DummyConstrState) - call MV_Pack(V, z%AA%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AD_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine AD_UnpackConstrStateAry(Vars, ValAry, z) +subroutine AD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(RotConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_z_BEMT_phi) + VarVals = z%BEMT%phi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + VarVals(1) = z%AA%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(RotConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (AD_z_BEMT_phi) - call MV_Unpack(V, ValAry, z%BEMT%phi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (AD_z_AA_DummyConstrState) - call MV_Unpack(V, ValAry, z%AA%DummyConstrState) ! Scalar - end select - end associate + call AD_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine AD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(RotConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_z_BEMT_phi) + z%BEMT%phi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + z%AA%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function AD_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -6895,62 +6930,76 @@ function AD_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine AD_PackInputAry(Vars, u, ValAry) +subroutine AD_VarsPackInput(Vars, u, ValAry) type(RotInputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (AD_u_NacelleMotion) - call MV_Pack(V, u%NacelleMotion, ValAry) ! Mesh - case (AD_u_TowerMotion) - call MV_Pack(V, u%TowerMotion, ValAry) ! Mesh - case (AD_u_HubMotion) - call MV_Pack(V, u%HubMotion, ValAry) ! Mesh - case (AD_u_BladeRootMotion) - call MV_Pack(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (AD_u_BladeMotion) - call MV_Pack(V, u%BladeMotion(DL%i1), ValAry) ! Mesh - case (AD_u_TFinMotion) - call MV_Pack(V, u%TFinMotion, ValAry) ! Mesh - case (AD_u_UserProp) - call MV_Pack(V, u%UserProp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AD_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine AD_UnpackInputAry(Vars, ValAry, u) +subroutine AD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(RotInputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_u_NacelleMotion) + call MV_PackMesh(V, u%NacelleMotion, ValAry) ! Mesh + case (AD_u_TowerMotion) + call MV_PackMesh(V, u%TowerMotion, ValAry) ! Mesh + case (AD_u_HubMotion) + call MV_PackMesh(V, u%HubMotion, ValAry) ! Mesh + case (AD_u_BladeRootMotion) + call MV_PackMesh(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (AD_u_BladeMotion) + call MV_PackMesh(V, u%BladeMotion(DL%i1), ValAry) ! Mesh + case (AD_u_TFinMotion) + call MV_PackMesh(V, u%TFinMotion, ValAry) ! Mesh + case (AD_u_UserProp) + VarVals = u%UserProp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(RotInputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (AD_u_NacelleMotion) - call MV_Unpack(V, ValAry, u%NacelleMotion) ! Mesh - case (AD_u_TowerMotion) - call MV_Unpack(V, ValAry, u%TowerMotion) ! Mesh - case (AD_u_HubMotion) - call MV_Unpack(V, ValAry, u%HubMotion) ! Mesh - case (AD_u_BladeRootMotion) - call MV_Unpack(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh - case (AD_u_BladeMotion) - call MV_Unpack(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh - case (AD_u_TFinMotion) - call MV_Unpack(V, ValAry, u%TFinMotion) ! Mesh - case (AD_u_UserProp) - call MV_Unpack(V, ValAry, u%UserProp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call AD_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine AD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(RotInputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_u_NacelleMotion) + call MV_UnpackMesh(V, ValAry, u%NacelleMotion) ! Mesh + case (AD_u_TowerMotion) + call MV_UnpackMesh(V, ValAry, u%TowerMotion) ! Mesh + case (AD_u_HubMotion) + call MV_UnpackMesh(V, ValAry, u%HubMotion) ! Mesh + case (AD_u_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (AD_u_BladeMotion) + call MV_UnpackMesh(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh + case (AD_u_TFinMotion) + call MV_UnpackMesh(V, ValAry, u%TFinMotion) ! Mesh + case (AD_u_UserProp) + u%UserProp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function AD_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -6974,58 +7023,72 @@ function AD_InputFieldName(DL) result(Name) end select end function -subroutine AD_PackOutputAry(Vars, y, ValAry) +subroutine AD_VarsPackOutput(Vars, y, ValAry) type(RotOutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (AD_y_NacelleLoad) - call MV_Pack(V, y%NacelleLoad, ValAry) ! Mesh - case (AD_y_HubLoad) - call MV_Pack(V, y%HubLoad, ValAry) ! Mesh - case (AD_y_TowerLoad) - call MV_Pack(V, y%TowerLoad, ValAry) ! Mesh - case (AD_y_BladeLoad) - call MV_Pack(V, y%BladeLoad(DL%i1), ValAry) ! Mesh - case (AD_y_TFinLoad) - call MV_Pack(V, y%TFinLoad, ValAry) ! Mesh - case (AD_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AD_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine AD_UnpackOutputAry(Vars, ValAry, y) +subroutine AD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(RotOutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_y_NacelleLoad) + call MV_PackMesh(V, y%NacelleLoad, ValAry) ! Mesh + case (AD_y_HubLoad) + call MV_PackMesh(V, y%HubLoad, ValAry) ! Mesh + case (AD_y_TowerLoad) + call MV_PackMesh(V, y%TowerLoad, ValAry) ! Mesh + case (AD_y_BladeLoad) + call MV_PackMesh(V, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (AD_y_TFinLoad) + call MV_PackMesh(V, y%TFinLoad, ValAry) ! Mesh + case (AD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(RotOutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (AD_y_NacelleLoad) - call MV_Unpack(V, ValAry, y%NacelleLoad) ! Mesh - case (AD_y_HubLoad) - call MV_Unpack(V, ValAry, y%HubLoad) ! Mesh - case (AD_y_TowerLoad) - call MV_Unpack(V, ValAry, y%TowerLoad) ! Mesh - case (AD_y_BladeLoad) - call MV_Unpack(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh - case (AD_y_TFinLoad) - call MV_Unpack(V, ValAry, y%TFinLoad) ! Mesh - case (AD_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call AD_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine AD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(RotOutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_y_NacelleLoad) + call MV_UnpackMesh(V, ValAry, y%NacelleLoad) ! Mesh + case (AD_y_HubLoad) + call MV_UnpackMesh(V, ValAry, y%HubLoad) ! Mesh + case (AD_y_TowerLoad) + call MV_UnpackMesh(V, ValAry, y%TowerLoad) ! Mesh + case (AD_y_BladeLoad) + call MV_UnpackMesh(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (AD_y_TFinLoad) + call MV_UnpackMesh(V, ValAry, y%TFinLoad) ! Mesh + case (AD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function AD_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 620e3e2ef1..9806eb7237 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -1479,46 +1479,60 @@ function AFI_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine AFI_PackInputAry(Vars, u, ValAry) +subroutine AFI_VarsPackInput(Vars, u, ValAry) type(AFI_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (AFI_u_AoA) - call MV_Pack(V, u%AoA, ValAry) ! Scalar - case (AFI_u_UserProp) - call MV_Pack(V, u%UserProp, ValAry) ! Scalar - case (AFI_u_Re) - call MV_Pack(V, u%Re, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AFI_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine AFI_UnpackInputAry(Vars, ValAry, u) +subroutine AFI_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(AFI_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AFI_u_AoA) + VarVals(1) = u%AoA ! Scalar + case (AFI_u_UserProp) + VarVals(1) = u%UserProp ! Scalar + case (AFI_u_Re) + VarVals(1) = u%Re ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AFI_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AFI_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (AFI_u_AoA) - call MV_Unpack(V, ValAry, u%AoA) ! Scalar - case (AFI_u_UserProp) - call MV_Unpack(V, ValAry, u%UserProp) ! Scalar - case (AFI_u_Re) - call MV_Unpack(V, ValAry, u%Re) ! Scalar - end select - end associate + call AFI_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine AFI_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AFI_u_AoA) + u%AoA = VarVals(1) ! Scalar + case (AFI_u_UserProp) + u%UserProp = VarVals(1) ! Scalar + case (AFI_u_Re) + u%Re = VarVals(1) ! Scalar + end select + end associate +end subroutine + function AFI_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1534,70 +1548,84 @@ function AFI_InputFieldName(DL) result(Name) end select end function -subroutine AFI_PackOutputAry(Vars, y, ValAry) +subroutine AFI_VarsPackOutput(Vars, y, ValAry) type(AFI_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (AFI_y_Cl) - call MV_Pack(V, y%Cl, ValAry) ! Scalar - case (AFI_y_Cd) - call MV_Pack(V, y%Cd, ValAry) ! Scalar - case (AFI_y_Cm) - call MV_Pack(V, y%Cm, ValAry) ! Scalar - case (AFI_y_Cpmin) - call MV_Pack(V, y%Cpmin, ValAry) ! Scalar - case (AFI_y_Cd0) - call MV_Pack(V, y%Cd0, ValAry) ! Scalar - case (AFI_y_Cm0) - call MV_Pack(V, y%Cm0, ValAry) ! Scalar - case (AFI_y_f_st) - call MV_Pack(V, y%f_st, ValAry) ! Scalar - case (AFI_y_FullySeparate) - call MV_Pack(V, y%FullySeparate, ValAry) ! Scalar - case (AFI_y_FullyAttached) - call MV_Pack(V, y%FullyAttached, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AFI_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine AFI_UnpackOutputAry(Vars, ValAry, y) +subroutine AFI_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(AFI_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AFI_y_Cl) + VarVals(1) = y%Cl ! Scalar + case (AFI_y_Cd) + VarVals(1) = y%Cd ! Scalar + case (AFI_y_Cm) + VarVals(1) = y%Cm ! Scalar + case (AFI_y_Cpmin) + VarVals(1) = y%Cpmin ! Scalar + case (AFI_y_Cd0) + VarVals(1) = y%Cd0 ! Scalar + case (AFI_y_Cm0) + VarVals(1) = y%Cm0 ! Scalar + case (AFI_y_f_st) + VarVals(1) = y%f_st ! Scalar + case (AFI_y_FullySeparate) + VarVals(1) = y%FullySeparate ! Scalar + case (AFI_y_FullyAttached) + VarVals(1) = y%FullyAttached ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AFI_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AFI_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (AFI_y_Cl) - call MV_Unpack(V, ValAry, y%Cl) ! Scalar - case (AFI_y_Cd) - call MV_Unpack(V, ValAry, y%Cd) ! Scalar - case (AFI_y_Cm) - call MV_Unpack(V, ValAry, y%Cm) ! Scalar - case (AFI_y_Cpmin) - call MV_Unpack(V, ValAry, y%Cpmin) ! Scalar - case (AFI_y_Cd0) - call MV_Unpack(V, ValAry, y%Cd0) ! Scalar - case (AFI_y_Cm0) - call MV_Unpack(V, ValAry, y%Cm0) ! Scalar - case (AFI_y_f_st) - call MV_Unpack(V, ValAry, y%f_st) ! Scalar - case (AFI_y_FullySeparate) - call MV_Unpack(V, ValAry, y%FullySeparate) ! Scalar - case (AFI_y_FullyAttached) - call MV_Unpack(V, ValAry, y%FullyAttached) ! Scalar - end select - end associate + call AFI_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine AFI_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AFI_y_Cl) + y%Cl = VarVals(1) ! Scalar + case (AFI_y_Cd) + y%Cd = VarVals(1) ! Scalar + case (AFI_y_Cm) + y%Cm = VarVals(1) ! Scalar + case (AFI_y_Cpmin) + y%Cpmin = VarVals(1) ! Scalar + case (AFI_y_Cd0) + y%Cd0 = VarVals(1) ! Scalar + case (AFI_y_Cm0) + y%Cm0 = VarVals(1) ! Scalar + case (AFI_y_f_st) + y%f_st = VarVals(1) ! Scalar + case (AFI_y_FullySeparate) + y%FullySeparate = VarVals(1) ! Scalar + case (AFI_y_FullyAttached) + y%FullyAttached = VarVals(1) ! Scalar + end select + end associate +end subroutine + function AFI_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 6dec4e3971..00d7924ea1 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -2718,50 +2718,64 @@ function BEMT_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine BEMT_PackContStateAry(Vars, x, ValAry) +subroutine BEMT_VarsPackContState(Vars, x, ValAry) type(BEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (BEMT_x_UA_element_x) - call MV_Pack(V, x%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind) - call MV_Pack(V, x%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind_1) - call MV_Pack(V, x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_x_V_w) - call MV_Pack(V, x%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BEMT_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine BEMT_UnpackContStateAry(Vars, ValAry, x) +subroutine BEMT_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_x_UA_element_x) + VarVals = x%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + VarVals = x%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + VarVals = x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_V_w) + VarVals = x%V_w(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BEMT_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (BEMT_x_UA_element_x) - call MV_Unpack(V, ValAry, x%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind) - call MV_Unpack(V, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind_1) - call MV_Unpack(V, ValAry, x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_x_V_w) - call MV_Unpack(V, ValAry, x%V_w(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call BEMT_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine BEMT_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_x_UA_element_x) + x%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + x%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_x_V_w) + x%V_w(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function BEMT_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2779,61 +2793,82 @@ function BEMT_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine BEMT_PackContStateDerivAry(Vars, x, ValAry) +subroutine BEMT_VarsPackContStateDeriv(Vars, x, ValAry) type(BEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (BEMT_x_UA_element_x) - call MV_Pack(V, x%UA%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind) - call MV_Pack(V, x%DBEMT%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_x_DBEMT_element_vind_1) - call MV_Pack(V, x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_x_V_w) - call MV_Pack(V, x%V_w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BEMT_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine BEMT_PackConstrStateAry(Vars, z, ValAry) +subroutine BEMT_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_x_UA_element_x) + VarVals = x%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + VarVals = x%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + VarVals = x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_V_w) + VarVals = x%V_w(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsPackConstrState(Vars, z, ValAry) type(BEMT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (BEMT_z_phi) - call MV_Pack(V, z%phi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BEMT_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine BEMT_UnpackConstrStateAry(Vars, ValAry, z) +subroutine BEMT_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_z_phi) + VarVals = z%phi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BEMT_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (BEMT_z_phi) - call MV_Unpack(V, ValAry, z%phi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call BEMT_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine BEMT_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_z_phi) + z%phi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function BEMT_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2845,110 +2880,124 @@ function BEMT_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine BEMT_PackInputAry(Vars, u, ValAry) +subroutine BEMT_VarsPackInput(Vars, u, ValAry) type(BEMT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (BEMT_u_theta) - call MV_Pack(V, u%theta(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_chi0) - call MV_Pack(V, u%chi0, ValAry) ! Scalar - case (BEMT_u_psiSkewOffset) - call MV_Pack(V, u%psiSkewOffset, ValAry) ! Scalar - case (BEMT_u_psi_s) - call MV_Pack(V, u%psi_s(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_u_omega) - call MV_Pack(V, u%omega, ValAry) ! Scalar - case (BEMT_u_TSR) - call MV_Pack(V, u%TSR, ValAry) ! Scalar - case (BEMT_u_Vx) - call MV_Pack(V, u%Vx(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_Vy) - call MV_Pack(V, u%Vy(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_Vz) - call MV_Pack(V, u%Vz(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_omega_z) - call MV_Pack(V, u%omega_z(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_xVelCorr) - call MV_Pack(V, u%xVelCorr(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_rLocal) - call MV_Pack(V, u%rLocal(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_Un_disk) - call MV_Pack(V, u%Un_disk, ValAry) ! Scalar - case (BEMT_u_V0) - call MV_Pack(V, u%V0(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_u_x_hat_disk) - call MV_Pack(V, u%x_hat_disk(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (BEMT_u_UserProp) - call MV_Pack(V, u%UserProp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_CantAngle) - call MV_Pack(V, u%CantAngle(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_drdz) - call MV_Pack(V, u%drdz(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_u_toeAngle) - call MV_Pack(V, u%toeAngle(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BEMT_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine BEMT_UnpackInputAry(Vars, ValAry, u) +subroutine BEMT_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_u_theta) + VarVals = u%theta(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_chi0) + VarVals(1) = u%chi0 ! Scalar + case (BEMT_u_psiSkewOffset) + VarVals(1) = u%psiSkewOffset ! Scalar + case (BEMT_u_psi_s) + VarVals = u%psi_s(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_u_omega) + VarVals(1) = u%omega ! Scalar + case (BEMT_u_TSR) + VarVals(1) = u%TSR ! Scalar + case (BEMT_u_Vx) + VarVals = u%Vx(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_Vy) + VarVals = u%Vy(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_Vz) + VarVals = u%Vz(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_omega_z) + VarVals = u%omega_z(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_xVelCorr) + VarVals = u%xVelCorr(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_rLocal) + VarVals = u%rLocal(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_Un_disk) + VarVals(1) = u%Un_disk ! Scalar + case (BEMT_u_V0) + VarVals = u%V0(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_u_x_hat_disk) + VarVals = u%x_hat_disk(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_u_UserProp) + VarVals = u%UserProp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_CantAngle) + VarVals = u%CantAngle(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_drdz) + VarVals = u%drdz(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_toeAngle) + VarVals = u%toeAngle(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BEMT_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (BEMT_u_theta) - call MV_Unpack(V, ValAry, u%theta(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_chi0) - call MV_Unpack(V, ValAry, u%chi0) ! Scalar - case (BEMT_u_psiSkewOffset) - call MV_Unpack(V, ValAry, u%psiSkewOffset) ! Scalar - case (BEMT_u_psi_s) - call MV_Unpack(V, ValAry, u%psi_s(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_u_omega) - call MV_Unpack(V, ValAry, u%omega) ! Scalar - case (BEMT_u_TSR) - call MV_Unpack(V, ValAry, u%TSR) ! Scalar - case (BEMT_u_Vx) - call MV_Unpack(V, ValAry, u%Vx(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_Vy) - call MV_Unpack(V, ValAry, u%Vy(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_Vz) - call MV_Unpack(V, ValAry, u%Vz(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_omega_z) - call MV_Unpack(V, ValAry, u%omega_z(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_xVelCorr) - call MV_Unpack(V, ValAry, u%xVelCorr(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_rLocal) - call MV_Unpack(V, ValAry, u%rLocal(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_Un_disk) - call MV_Unpack(V, ValAry, u%Un_disk) ! Scalar - case (BEMT_u_V0) - call MV_Unpack(V, ValAry, u%V0(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_u_x_hat_disk) - call MV_Unpack(V, ValAry, u%x_hat_disk(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (BEMT_u_UserProp) - call MV_Unpack(V, ValAry, u%UserProp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_CantAngle) - call MV_Unpack(V, ValAry, u%CantAngle(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_drdz) - call MV_Unpack(V, ValAry, u%drdz(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_u_toeAngle) - call MV_Unpack(V, ValAry, u%toeAngle(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call BEMT_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine BEMT_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_u_theta) + u%theta(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_chi0) + u%chi0 = VarVals(1) ! Scalar + case (BEMT_u_psiSkewOffset) + u%psiSkewOffset = VarVals(1) ! Scalar + case (BEMT_u_psi_s) + u%psi_s(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_u_omega) + u%omega = VarVals(1) ! Scalar + case (BEMT_u_TSR) + u%TSR = VarVals(1) ! Scalar + case (BEMT_u_Vx) + u%Vx(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_Vy) + u%Vy(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_Vz) + u%Vz(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_omega_z) + u%omega_z(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_xVelCorr) + u%xVelCorr(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_rLocal) + u%rLocal(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_Un_disk) + u%Un_disk = VarVals(1) ! Scalar + case (BEMT_u_V0) + u%V0(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_u_x_hat_disk) + u%x_hat_disk(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_u_UserProp) + u%UserProp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_CantAngle) + u%CantAngle(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_drdz) + u%drdz(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_toeAngle) + u%toeAngle(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function BEMT_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2996,122 +3045,136 @@ function BEMT_InputFieldName(DL) result(Name) end select end function -subroutine BEMT_PackOutputAry(Vars, y, ValAry) +subroutine BEMT_VarsPackOutput(Vars, y, ValAry) type(BEMT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (BEMT_y_Vrel) - call MV_Pack(V, y%Vrel(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_phi) - call MV_Pack(V, y%phi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_axInduction) - call MV_Pack(V, y%axInduction(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_tanInduction) - call MV_Pack(V, y%tanInduction(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_axInduction_qs) - call MV_Pack(V, y%axInduction_qs(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_tanInduction_qs) - call MV_Pack(V, y%tanInduction_qs(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_k) - call MV_Pack(V, y%k(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_k_p) - call MV_Pack(V, y%k_p(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_F) - call MV_Pack(V, y%F(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Re) - call MV_Pack(V, y%Re(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_AOA) - call MV_Pack(V, y%AOA(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cx) - call MV_Pack(V, y%Cx(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cy) - call MV_Pack(V, y%Cy(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cz) - call MV_Pack(V, y%Cz(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cmx) - call MV_Pack(V, y%Cmx(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cmy) - call MV_Pack(V, y%Cmy(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cmz) - call MV_Pack(V, y%Cmz(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cm) - call MV_Pack(V, y%Cm(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cl) - call MV_Pack(V, y%Cl(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cd) - call MV_Pack(V, y%Cd(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_chi) - call MV_Pack(V, y%chi(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BEMT_y_Cpmin) - call MV_Pack(V, y%Cpmin(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BEMT_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine BEMT_UnpackOutputAry(Vars, ValAry, y) +subroutine BEMT_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_y_Vrel) + VarVals = y%Vrel(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_phi) + VarVals = y%phi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_axInduction) + VarVals = y%axInduction(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_tanInduction) + VarVals = y%tanInduction(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_axInduction_qs) + VarVals = y%axInduction_qs(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + VarVals = y%tanInduction_qs(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_k) + VarVals = y%k(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_k_p) + VarVals = y%k_p(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_F) + VarVals = y%F(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Re) + VarVals = y%Re(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_AOA) + VarVals = y%AOA(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cx) + VarVals = y%Cx(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cy) + VarVals = y%Cy(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cz) + VarVals = y%Cz(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cmx) + VarVals = y%Cmx(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cmy) + VarVals = y%Cmy(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cmz) + VarVals = y%Cmz(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cm) + VarVals = y%Cm(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cl) + VarVals = y%Cl(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cd) + VarVals = y%Cd(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_chi) + VarVals = y%chi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cpmin) + VarVals = y%Cpmin(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BEMT_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (BEMT_y_Vrel) - call MV_Unpack(V, ValAry, y%Vrel(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_phi) - call MV_Unpack(V, ValAry, y%phi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_axInduction) - call MV_Unpack(V, ValAry, y%axInduction(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_tanInduction) - call MV_Unpack(V, ValAry, y%tanInduction(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_axInduction_qs) - call MV_Unpack(V, ValAry, y%axInduction_qs(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_tanInduction_qs) - call MV_Unpack(V, ValAry, y%tanInduction_qs(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_k) - call MV_Unpack(V, ValAry, y%k(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_k_p) - call MV_Unpack(V, ValAry, y%k_p(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_F) - call MV_Unpack(V, ValAry, y%F(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Re) - call MV_Unpack(V, ValAry, y%Re(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_AOA) - call MV_Unpack(V, ValAry, y%AOA(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cx) - call MV_Unpack(V, ValAry, y%Cx(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cy) - call MV_Unpack(V, ValAry, y%Cy(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cz) - call MV_Unpack(V, ValAry, y%Cz(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cmx) - call MV_Unpack(V, ValAry, y%Cmx(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cmy) - call MV_Unpack(V, ValAry, y%Cmy(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cmz) - call MV_Unpack(V, ValAry, y%Cmz(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cm) - call MV_Unpack(V, ValAry, y%Cm(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cl) - call MV_Unpack(V, ValAry, y%Cl(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cd) - call MV_Unpack(V, ValAry, y%Cd(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_chi) - call MV_Unpack(V, ValAry, y%chi(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (BEMT_y_Cpmin) - call MV_Unpack(V, ValAry, y%Cpmin(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call BEMT_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine BEMT_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_y_Vrel) + y%Vrel(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_phi) + y%phi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_axInduction) + y%axInduction(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_tanInduction) + y%tanInduction(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_axInduction_qs) + y%axInduction_qs(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + y%tanInduction_qs(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_k) + y%k(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_k_p) + y%k_p(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_F) + y%F(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Re) + y%Re(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_AOA) + y%AOA(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cx) + y%Cx(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cy) + y%Cy(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cz) + y%Cz(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cmx) + y%Cmx(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cmy) + y%Cmy(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cmz) + y%Cmz(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cm) + y%Cm(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cl) + y%Cl(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cd) + y%Cd(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_chi) + y%chi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cpmin) + y%Cpmin(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function BEMT_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index b6839a4358..442339533f 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -1443,42 +1443,56 @@ function DBEMT_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine DBEMT_PackContStateAry(Vars, x, ValAry) +subroutine DBEMT_VarsPackContState(Vars, x, ValAry) type(DBEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (DBEMT_x_element_vind) - call MV_Pack(V, x%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (DBEMT_x_element_vind_1) - call MV_Pack(V, x%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call DBEMT_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine DBEMT_UnpackContStateAry(Vars, ValAry, x) +subroutine DBEMT_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_x_element_vind) + VarVals = x%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + VarVals = x%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (DBEMT_x_element_vind) - call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (DBEMT_x_element_vind_1) - call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call DBEMT_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine DBEMT_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_x_element_vind) + x%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (DBEMT_x_element_vind_1) + x%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function DBEMT_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1492,57 +1506,78 @@ function DBEMT_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine DBEMT_PackContStateDerivAry(Vars, x, ValAry) +subroutine DBEMT_VarsPackContStateDeriv(Vars, x, ValAry) type(DBEMT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (DBEMT_x_element_vind) - call MV_Pack(V, x%element(DL%i1, DL%i2)%vind(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (DBEMT_x_element_vind_1) - call MV_Pack(V, x%element(DL%i1, DL%i2)%vind_1(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call DBEMT_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine DBEMT_PackConstrStateAry(Vars, z, ValAry) +subroutine DBEMT_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_x_element_vind) + VarVals = x%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + VarVals = x%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsPackConstrState(Vars, z, ValAry) type(DBEMT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (DBEMT_z_DummyState) - call MV_Pack(V, z%DummyState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call DBEMT_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine DBEMT_UnpackConstrStateAry(Vars, ValAry, z) +subroutine DBEMT_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_z_DummyState) + VarVals(1) = z%DummyState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (DBEMT_z_DummyState) - call MV_Unpack(V, ValAry, z%DummyState) ! Scalar - end select - end associate + call DBEMT_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine DBEMT_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_z_DummyState) + z%DummyState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function DBEMT_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1554,54 +1589,68 @@ function DBEMT_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine DBEMT_PackInputAry(Vars, u, ValAry) +subroutine DBEMT_VarsPackInput(Vars, u, ValAry) type(DBEMT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (DBEMT_u_AxInd_disk) - call MV_Pack(V, u%AxInd_disk, ValAry) ! Scalar - case (DBEMT_u_Un_disk) - call MV_Pack(V, u%Un_disk, ValAry) ! Scalar - case (DBEMT_u_R_disk) - call MV_Pack(V, u%R_disk, ValAry) ! Scalar - case (DBEMT_u_element_vind_s) - call MV_Pack(V, u%element(DL%i1, DL%i2)%vind_s(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (DBEMT_u_element_spanRatio) - call MV_Pack(V, u%element(DL%i1, DL%i2)%spanRatio, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call DBEMT_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine DBEMT_UnpackInputAry(Vars, ValAry, u) +subroutine DBEMT_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_u_AxInd_disk) + VarVals(1) = u%AxInd_disk ! Scalar + case (DBEMT_u_Un_disk) + VarVals(1) = u%Un_disk ! Scalar + case (DBEMT_u_R_disk) + VarVals(1) = u%R_disk ! Scalar + case (DBEMT_u_element_vind_s) + VarVals = u%element(DL%i1, DL%i2)%vind_s(V%iLB:V%iUB) ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + VarVals(1) = u%element(DL%i1, DL%i2)%spanRatio ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (DBEMT_u_AxInd_disk) - call MV_Unpack(V, ValAry, u%AxInd_disk) ! Scalar - case (DBEMT_u_Un_disk) - call MV_Unpack(V, ValAry, u%Un_disk) ! Scalar - case (DBEMT_u_R_disk) - call MV_Unpack(V, ValAry, u%R_disk) ! Scalar - case (DBEMT_u_element_vind_s) - call MV_Unpack(V, ValAry, u%element(DL%i1, DL%i2)%vind_s(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (DBEMT_u_element_spanRatio) - call MV_Unpack(V, ValAry, u%element(DL%i1, DL%i2)%spanRatio) ! Scalar - end select - end associate + call DBEMT_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine DBEMT_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_u_AxInd_disk) + u%AxInd_disk = VarVals(1) ! Scalar + case (DBEMT_u_Un_disk) + u%Un_disk = VarVals(1) ! Scalar + case (DBEMT_u_R_disk) + u%R_disk = VarVals(1) ! Scalar + case (DBEMT_u_element_vind_s) + u%element(DL%i1, DL%i2)%vind_s(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + u%element(DL%i1, DL%i2)%spanRatio = VarVals(1) ! Scalar + end select + end associate +end subroutine + function DBEMT_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1621,38 +1670,52 @@ function DBEMT_InputFieldName(DL) result(Name) end select end function -subroutine DBEMT_PackOutputAry(Vars, y, ValAry) +subroutine DBEMT_VarsPackOutput(Vars, y, ValAry) type(DBEMT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (DBEMT_y_vind) - call MV_Pack(V, y%vind(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call DBEMT_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine DBEMT_UnpackOutputAry(Vars, ValAry, y) +subroutine DBEMT_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_y_vind) + VarVals = y%vind(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(DBEMT_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (DBEMT_y_vind) - call MV_Unpack(V, ValAry, y%vind(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - end select - end associate + call DBEMT_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine DBEMT_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_y_vind) + y%vind(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + end select + end associate +end subroutine + function DBEMT_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 31904917d3..53070b8d31 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -4125,62 +4125,76 @@ function FVW_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine FVW_PackContStateAry(Vars, x, ValAry) +subroutine FVW_VarsPackContState(Vars, x, ValAry) type(FVW_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (FVW_x_W_Gamma_NW) - call MV_Pack(V, x%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (FVW_x_W_Gamma_FW) - call MV_Pack(V, x%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (FVW_x_W_Eps_NW) - call MV_Pack(V, x%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (FVW_x_W_Eps_FW) - call MV_Pack(V, x%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (FVW_x_W_r_NW) - call MV_Pack(V, x%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (FVW_x_W_r_FW) - call MV_Pack(V, x%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (FVW_x_UA_element_x) - call MV_Pack(V, x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FVW_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine FVW_UnpackContStateAry(Vars, ValAry, x) +subroutine FVW_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + VarVals = x%W(DL%i1)%Gamma_NW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + VarVals = x%W(DL%i1)%Gamma_FW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + VarVals = x%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + VarVals = x%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_r_NW) + VarVals = x%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_r_FW) + VarVals = x%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_UA_element_x) + VarVals = x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FVW_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (FVW_x_W_Gamma_NW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (FVW_x_W_Gamma_FW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (FVW_x_W_Eps_NW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (FVW_x_W_Eps_FW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (FVW_x_W_r_NW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (FVW_x_W_r_FW) - call MV_Unpack(V, ValAry, x%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (FVW_x_UA_element_x) - call MV_Unpack(V, ValAry, x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call FVW_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine FVW_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + x%W(DL%i1)%Gamma_NW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + x%W(DL%i1)%Gamma_FW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FVW_x_W_Eps_NW) + x%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (FVW_x_W_Eps_FW) + x%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (FVW_x_W_r_NW) + x%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (FVW_x_W_r_FW) + x%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (FVW_x_UA_element_x) + x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function FVW_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4204,71 +4218,92 @@ function FVW_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine FVW_PackContStateDerivAry(Vars, x, ValAry) +subroutine FVW_VarsPackContStateDeriv(Vars, x, ValAry) type(FVW_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (FVW_x_W_Gamma_NW) - call MV_Pack(V, x%W(DL%i1)%Gamma_NW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (FVW_x_W_Gamma_FW) - call MV_Pack(V, x%W(DL%i1)%Gamma_FW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (FVW_x_W_Eps_NW) - call MV_Pack(V, x%W(DL%i1)%Eps_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (FVW_x_W_Eps_FW) - call MV_Pack(V, x%W(DL%i1)%Eps_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (FVW_x_W_r_NW) - call MV_Pack(V, x%W(DL%i1)%r_NW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (FVW_x_W_r_FW) - call MV_Pack(V, x%W(DL%i1)%r_FW(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (FVW_x_UA_element_x) - call MV_Pack(V, x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FVW_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine FVW_PackConstrStateAry(Vars, z, ValAry) +subroutine FVW_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + VarVals = x%W(DL%i1)%Gamma_NW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + VarVals = x%W(DL%i1)%Gamma_FW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + VarVals = x%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + VarVals = x%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_r_NW) + VarVals = x%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_r_FW) + VarVals = x%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_UA_element_x) + VarVals = x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsPackConstrState(Vars, z, ValAry) type(FVW_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (FVW_z_W_Gamma_LL) - call MV_Pack(V, z%W(DL%i1)%Gamma_LL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (FVW_z_residual) - call MV_Pack(V, z%residual, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FVW_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine FVW_UnpackConstrStateAry(Vars, ValAry, z) +subroutine FVW_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_z_W_Gamma_LL) + VarVals = z%W(DL%i1)%Gamma_LL(V%iLB:V%iUB) ! Rank 1 Array + case (FVW_z_residual) + VarVals(1) = z%residual ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FVW_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (FVW_z_W_Gamma_LL) - call MV_Unpack(V, ValAry, z%W(DL%i1)%Gamma_LL(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (FVW_z_residual) - call MV_Unpack(V, ValAry, z%residual) ! Scalar - end select - end associate + call FVW_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine FVW_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_z_W_Gamma_LL) + z%W(DL%i1)%Gamma_LL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FVW_z_residual) + z%residual = VarVals(1) ! Scalar + end select + end associate +end subroutine + function FVW_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4282,58 +4317,72 @@ function FVW_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine FVW_PackInputAry(Vars, u, ValAry) +subroutine FVW_VarsPackInput(Vars, u, ValAry) type(FVW_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (FVW_u_rotors_HubOrientation) - call MV_Pack(V, u%rotors(DL%i1)%HubOrientation(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (FVW_u_rotors_HubPosition) - call MV_Pack(V, u%rotors(DL%i1)%HubPosition(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (FVW_u_W_Vwnd_LL) - call MV_Pack(V, u%W(DL%i1)%Vwnd_LL(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (FVW_u_W_omega_z) - call MV_Pack(V, u%W(DL%i1)%omega_z(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (FVW_u_WingsMesh) - call MV_Pack(V, u%WingsMesh(DL%i1), ValAry) ! Mesh - case (FVW_u_V_wind) - call MV_Pack(V, u%V_wind(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FVW_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine FVW_UnpackInputAry(Vars, ValAry, u) +subroutine FVW_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_u_rotors_HubOrientation) + VarVals = u%rotors(DL%i1)%HubOrientation(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + VarVals = u%rotors(DL%i1)%HubPosition(V%iLB:V%iUB) ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + VarVals = u%W(DL%i1)%Vwnd_LL(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_u_W_omega_z) + VarVals = u%W(DL%i1)%omega_z(V%iLB:V%iUB) ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_PackMesh(V, u%WingsMesh(DL%i1), ValAry) ! Mesh + case (FVW_u_V_wind) + VarVals = u%V_wind(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FVW_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (FVW_u_rotors_HubOrientation) - call MV_Unpack(V, ValAry, u%rotors(DL%i1)%HubOrientation(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (FVW_u_rotors_HubPosition) - call MV_Unpack(V, ValAry, u%rotors(DL%i1)%HubPosition(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (FVW_u_W_Vwnd_LL) - call MV_Unpack(V, ValAry, u%W(DL%i1)%Vwnd_LL(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (FVW_u_W_omega_z) - call MV_Unpack(V, ValAry, u%W(DL%i1)%omega_z(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (FVW_u_WingsMesh) - call MV_Unpack(V, ValAry, u%WingsMesh(DL%i1)) ! Mesh - case (FVW_u_V_wind) - call MV_Unpack(V, ValAry, u%V_wind(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call FVW_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine FVW_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_u_rotors_HubOrientation) + u%rotors(DL%i1)%HubOrientation(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + u%rotors(DL%i1)%HubPosition(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + u%W(DL%i1)%Vwnd_LL(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FVW_u_W_omega_z) + u%W(DL%i1)%omega_z(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_UnpackMesh(V, ValAry, u%WingsMesh(DL%i1)) ! Mesh + case (FVW_u_V_wind) + u%V_wind(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function FVW_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4355,38 +4404,52 @@ function FVW_InputFieldName(DL) result(Name) end select end function -subroutine FVW_PackOutputAry(Vars, y, ValAry) +subroutine FVW_VarsPackOutput(Vars, y, ValAry) type(FVW_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (FVW_y_W_Vind) - call MV_Pack(V, y%W(DL%i1)%Vind(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FVW_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine FVW_UnpackOutputAry(Vars, ValAry, y) +subroutine FVW_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_y_W_Vind) + VarVals = y%W(DL%i1)%Vind(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FVW_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (FVW_y_W_Vind) - call MV_Unpack(V, ValAry, y%W(DL%i1)%Vind(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call FVW_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine FVW_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_y_W_Vind) + y%W(DL%i1)%Vind(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function FVW_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 0ffdf0df05..36fbf50c4d 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -2554,38 +2554,52 @@ function UA_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine UA_PackContStateAry(Vars, x, ValAry) +subroutine UA_VarsPackContState(Vars, x, ValAry) type(UA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (UA_x_element_x) - call MV_Pack(V, x%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call UA_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine UA_UnpackContStateAry(Vars, ValAry, x) +subroutine UA_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(UA_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_x_element_x) + VarVals = x%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(UA_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (UA_x_element_x) - call MV_Unpack(V, ValAry, x%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call UA_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine UA_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_x_element_x) + x%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function UA_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2597,55 +2611,76 @@ function UA_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine UA_PackContStateDerivAry(Vars, x, ValAry) +subroutine UA_VarsPackContStateDeriv(Vars, x, ValAry) type(UA_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (UA_x_element_x) - call MV_Pack(V, x%element(DL%i1, DL%i2)%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call UA_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine UA_PackConstrStateAry(Vars, z, ValAry) +subroutine UA_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(UA_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_x_element_x) + VarVals = x%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsPackConstrState(Vars, z, ValAry) type(UA_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (UA_z_DummyConstraintState) - call MV_Pack(V, z%DummyConstraintState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call UA_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine UA_UnpackConstrStateAry(Vars, ValAry, z) +subroutine UA_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(UA_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_z_DummyConstraintState) + VarVals(1) = z%DummyConstraintState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(UA_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (UA_z_DummyConstraintState) - call MV_Unpack(V, ValAry, z%DummyConstraintState) ! Scalar - end select - end associate + call UA_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine UA_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_z_DummyConstraintState) + z%DummyConstraintState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function UA_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2657,58 +2692,72 @@ function UA_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine UA_PackInputAry(Vars, u, ValAry) +subroutine UA_VarsPackInput(Vars, u, ValAry) type(UA_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (UA_u_U) - call MV_Pack(V, u%U, ValAry) ! Scalar - case (UA_u_alpha) - call MV_Pack(V, u%alpha, ValAry) ! Scalar - case (UA_u_Re) - call MV_Pack(V, u%Re, ValAry) ! Scalar - case (UA_u_UserProp) - call MV_Pack(V, u%UserProp, ValAry) ! Scalar - case (UA_u_v_ac) - call MV_Pack(V, u%v_ac(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (UA_u_omega) - call MV_Pack(V, u%omega, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call UA_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine UA_UnpackInputAry(Vars, ValAry, u) +subroutine UA_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(UA_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_u_U) + VarVals(1) = u%U ! Scalar + case (UA_u_alpha) + VarVals(1) = u%alpha ! Scalar + case (UA_u_Re) + VarVals(1) = u%Re ! Scalar + case (UA_u_UserProp) + VarVals(1) = u%UserProp ! Scalar + case (UA_u_v_ac) + VarVals = u%v_ac(V%iLB:V%iUB) ! Rank 1 Array + case (UA_u_omega) + VarVals(1) = u%omega ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(UA_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (UA_u_U) - call MV_Unpack(V, ValAry, u%U) ! Scalar - case (UA_u_alpha) - call MV_Unpack(V, ValAry, u%alpha) ! Scalar - case (UA_u_Re) - call MV_Unpack(V, ValAry, u%Re) ! Scalar - case (UA_u_UserProp) - call MV_Unpack(V, ValAry, u%UserProp) ! Scalar - case (UA_u_v_ac) - call MV_Unpack(V, ValAry, u%v_ac(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (UA_u_omega) - call MV_Unpack(V, ValAry, u%omega) ! Scalar - end select - end associate + call UA_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine UA_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(UA_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_u_U) + u%U = VarVals(1) ! Scalar + case (UA_u_alpha) + u%alpha = VarVals(1) ! Scalar + case (UA_u_Re) + u%Re = VarVals(1) ! Scalar + case (UA_u_UserProp) + u%UserProp = VarVals(1) ! Scalar + case (UA_u_v_ac) + u%v_ac(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (UA_u_omega) + u%omega = VarVals(1) ! Scalar + end select + end associate +end subroutine + function UA_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2730,58 +2779,72 @@ function UA_InputFieldName(DL) result(Name) end select end function -subroutine UA_PackOutputAry(Vars, y, ValAry) +subroutine UA_VarsPackOutput(Vars, y, ValAry) type(UA_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (UA_y_Cn) - call MV_Pack(V, y%Cn, ValAry) ! Scalar - case (UA_y_Cc) - call MV_Pack(V, y%Cc, ValAry) ! Scalar - case (UA_y_Cm) - call MV_Pack(V, y%Cm, ValAry) ! Scalar - case (UA_y_Cl) - call MV_Pack(V, y%Cl, ValAry) ! Scalar - case (UA_y_Cd) - call MV_Pack(V, y%Cd, ValAry) ! Scalar - case (UA_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call UA_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine UA_UnpackOutputAry(Vars, ValAry, y) +subroutine UA_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(UA_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_y_Cn) + VarVals(1) = y%Cn ! Scalar + case (UA_y_Cc) + VarVals(1) = y%Cc ! Scalar + case (UA_y_Cm) + VarVals(1) = y%Cm ! Scalar + case (UA_y_Cl) + VarVals(1) = y%Cl ! Scalar + case (UA_y_Cd) + VarVals(1) = y%Cd ! Scalar + case (UA_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(UA_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (UA_y_Cn) - call MV_Unpack(V, ValAry, y%Cn) ! Scalar - case (UA_y_Cc) - call MV_Unpack(V, ValAry, y%Cc) ! Scalar - case (UA_y_Cm) - call MV_Unpack(V, ValAry, y%Cm) ! Scalar - case (UA_y_Cl) - call MV_Unpack(V, ValAry, y%Cl) ! Scalar - case (UA_y_Cd) - call MV_Unpack(V, ValAry, y%Cd) ! Scalar - case (UA_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call UA_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine UA_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(UA_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_y_Cn) + y%Cn = VarVals(1) ! Scalar + case (UA_y_Cc) + y%Cc = VarVals(1) ! Scalar + case (UA_y_Cm) + y%Cm = VarVals(1) ! Scalar + case (UA_y_Cl) + y%Cl = VarVals(1) ! Scalar + case (UA_y_Cd) + y%Cd = VarVals(1) ! Scalar + case (UA_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function UA_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index f2259a74aa..8f1cab4c0e 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -2627,38 +2627,52 @@ function AWAE_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine AWAE_PackContStateAry(Vars, x, ValAry) +subroutine AWAE_VarsPackContState(Vars, x, ValAry) type(AWAE_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AWAE_x_IfW_DummyContState) - call MV_Pack(V, x%IfW(DL%i1)%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AWAE_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine AWAE_UnpackContStateAry(Vars, ValAry, x) +subroutine AWAE_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + VarVals(1) = x%IfW(DL%i1)%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AWAE_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AWAE_x_IfW_DummyContState) - call MV_Unpack(V, ValAry, x%IfW(DL%i1)%DummyContState) ! Scalar - end select - end associate + call AWAE_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine AWAE_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + x%IfW(DL%i1)%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function AWAE_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2670,55 +2684,76 @@ function AWAE_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine AWAE_PackContStateDerivAry(Vars, x, ValAry) +subroutine AWAE_VarsPackContStateDeriv(Vars, x, ValAry) type(AWAE_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (AWAE_x_IfW_DummyContState) - call MV_Pack(V, x%IfW(DL%i1)%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AWAE_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine AWAE_PackConstrStateAry(Vars, z, ValAry) +subroutine AWAE_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + VarVals(1) = x%IfW(DL%i1)%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsPackConstrState(Vars, z, ValAry) type(AWAE_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (AWAE_z_IfW_DummyConstrState) - call MV_Pack(V, z%IfW(DL%i1)%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AWAE_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine AWAE_UnpackConstrStateAry(Vars, ValAry, z) +subroutine AWAE_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_z_IfW_DummyConstrState) + VarVals(1) = z%IfW(DL%i1)%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AWAE_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (AWAE_z_IfW_DummyConstrState) - call MV_Unpack(V, ValAry, z%IfW(DL%i1)%DummyConstrState) ! Scalar - end select - end associate + call AWAE_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine AWAE_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_z_IfW_DummyConstrState) + z%IfW(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function AWAE_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2730,62 +2765,76 @@ function AWAE_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine AWAE_PackInputAry(Vars, u, ValAry) +subroutine AWAE_VarsPackInput(Vars, u, ValAry) type(AWAE_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (AWAE_u_xhat_plane) - call MV_Pack(V, u%xhat_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (AWAE_u_p_plane) - call MV_Pack(V, u%p_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (AWAE_u_Vx_wake) - call MV_Pack(V, u%Vx_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array - case (AWAE_u_Vy_wake) - call MV_Pack(V, u%Vy_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array - case (AWAE_u_Vz_wake) - call MV_Pack(V, u%Vz_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array - case (AWAE_u_D_wake) - call MV_Pack(V, u%D_wake(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (AWAE_u_WAT_k) - call MV_Pack(V, u%WAT_k(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry), ValAry) ! Rank 4 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AWAE_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine AWAE_UnpackInputAry(Vars, ValAry, u) +subroutine AWAE_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_u_xhat_plane) + VarVals = u%xhat_plane(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AWAE_u_p_plane) + VarVals = u%p_plane(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AWAE_u_Vx_wake) + VarVals = u%Vx_wake(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AWAE_u_Vy_wake) + VarVals = u%Vy_wake(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AWAE_u_Vz_wake) + VarVals = u%Vz_wake(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AWAE_u_D_wake) + VarVals = u%D_wake(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AWAE_u_WAT_k) + VarVals = u%WAT_k(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AWAE_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (AWAE_u_xhat_plane) - call MV_Unpack(V, ValAry, u%xhat_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (AWAE_u_p_plane) - call MV_Unpack(V, ValAry, u%p_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (AWAE_u_Vx_wake) - call MV_Unpack(V, ValAry, u%Vx_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array - case (AWAE_u_Vy_wake) - call MV_Unpack(V, ValAry, u%Vy_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array - case (AWAE_u_Vz_wake) - call MV_Unpack(V, ValAry, u%Vz_wake(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array - case (AWAE_u_D_wake) - call MV_Unpack(V, ValAry, u%D_wake(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (AWAE_u_WAT_k) - call MV_Unpack(V, ValAry, u%WAT_k(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)) ! Rank 4 Array - end select - end associate + call AWAE_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine AWAE_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_u_xhat_plane) + u%xhat_plane(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AWAE_u_p_plane) + u%p_plane(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AWAE_u_Vx_wake) + u%Vx_wake(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AWAE_u_Vy_wake) + u%Vy_wake(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AWAE_u_Vz_wake) + u%Vz_wake(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AWAE_u_D_wake) + u%D_wake(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AWAE_u_WAT_k) + u%WAT_k(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + end select + end associate +end subroutine + function AWAE_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2809,50 +2858,64 @@ function AWAE_InputFieldName(DL) result(Name) end select end function -subroutine AWAE_PackOutputAry(Vars, y, ValAry) +subroutine AWAE_VarsPackOutput(Vars, y, ValAry) type(AWAE_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (AWAE_y_Vdist_High_data) - call MV_Pack(V, y%Vdist_High(DL%i1)%data(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry), ValAry) ! Rank 5 Array - case (AWAE_y_V_plane) - call MV_Pack(V, y%V_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (AWAE_y_TI_amb) - call MV_Pack(V, y%TI_amb(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (AWAE_y_Vx_wind_disk) - call MV_Pack(V, y%Vx_wind_disk(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call AWAE_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine AWAE_UnpackOutputAry(Vars, ValAry, y) +subroutine AWAE_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_y_Vdist_High_data) + VarVals = y%Vdist_High(DL%i1)%data(V%iLB:V%iUB, V%j, V%k, V%m, V%n) ! Rank 5 Array + case (AWAE_y_V_plane) + VarVals = y%V_plane(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AWAE_y_TI_amb) + VarVals = y%TI_amb(V%iLB:V%iUB) ! Rank 1 Array + case (AWAE_y_Vx_wind_disk) + VarVals = y%Vx_wind_disk(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(AWAE_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (AWAE_y_Vdist_High_data) - call MV_Unpack(V, ValAry, y%Vdist_High(DL%i1)%data(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)) ! Rank 5 Array - case (AWAE_y_V_plane) - call MV_Unpack(V, ValAry, y%V_plane(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (AWAE_y_TI_amb) - call MV_Unpack(V, ValAry, y%TI_amb(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (AWAE_y_Vx_wind_disk) - call MV_Unpack(V, ValAry, y%Vx_wind_disk(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call AWAE_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine AWAE_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_y_Vdist_High_data) + y%Vdist_High(DL%i1)%data(V%iLB:V%iUB, V%j, V%k, V%m, V%n) = VarVals ! Rank 5 Array + case (AWAE_y_V_plane) + y%V_plane(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AWAE_y_TI_amb) + y%TI_amb(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AWAE_y_Vx_wind_disk) + y%Vx_wind_disk(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function AWAE_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 0b8c0ed61f..4edcbd1255 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -248,7 +248,8 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ! Module Variables !............................................................................................ - call BD_InitVars(u, p, x, y, MiscVar, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2) + ! call BD_InitVars(u, p, x, y, MiscVar, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2) + call BD_InitVars(u, p, x, y, MiscVar, InitOut, .true., ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !............................................................................................ @@ -6038,7 +6039,7 @@ SUBROUTINE BD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Make a copy of the inputs to perturb call BD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackInputAry(Vars, u, m%Jac%u) + call BD_VarsPackInput(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -6068,15 +6069,15 @@ SUBROUTINE BD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return - call BD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call BD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return - call BD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call BD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) @@ -6104,15 +6105,15 @@ SUBROUTINE BD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call BD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call BD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call BD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) @@ -6189,7 +6190,7 @@ SUBROUTINE BD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Copy state values call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateAry(Vars, x, m%Jac%x) + call BD_VarsPackContState(Vars, x, m%Jac%x) ! If rotate states is enabled if (p%RotStates) then @@ -6239,15 +6240,15 @@ SUBROUTINE BD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return - call BD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call BD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return - call BD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call BD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) @@ -6284,15 +6285,15 @@ SUBROUTINE BD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateDerivAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call BD_VarsPackContStateDeriv(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call BD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call BD_PackContStateDerivAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call BD_VarsPackContStateDeriv(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 5de53aa546..15ea8691a5 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -3781,50 +3781,64 @@ function BD_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine BD_PackContStateAry(Vars, x, ValAry) +subroutine BD_VarsPackContState(Vars, x, ValAry) type(BD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (BD_x_q) - if (V%Field == FieldOrientation) then - ValAry(V%iLoc(1):V%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, V%jAry))) ! Convert WM parameters to quaternions - else - call MV_Pack(V, x%q(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - end if - case (BD_x_dqdt) - call MV_Pack(V, x%dqdt(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BD_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine BD_UnpackContStateAry(Vars, ValAry, x) +subroutine BD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(BD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_x_q) + if (V%Field == FieldOrientation) then + VarVals = wm_to_quat(wm_inv(x%q(4:6, V%j))) ! Convert WM parameters to quaternions + else + VarVals = x%q(V%iLB:V%iUB,V%j) ! Rank 2 Array + end if + case (BD_x_dqdt) + VarVals = x%dqdt(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (BD_x_q) - if (V%Field == FieldOrientation) then - x%q(4:6, V%jAry) = wm_inv(quat_to_wm(ValAry(V%iLoc(1):V%iLoc(2)))) ! Convert quaternion to WM parameters - else - call MV_Unpack(V, ValAry, x%q(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end if - case (BD_x_dqdt) - call MV_Unpack(V, ValAry, x%dqdt(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call BD_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine BD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_x_q) + if (V%Field == FieldOrientation) then + x%q(4:6, V%j) = wm_inv(quat_to_wm(VarVals)) ! Convert quaternion to WM parameters + else + x%q(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end if + case (BD_x_dqdt) + x%dqdt(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function BD_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3838,57 +3852,78 @@ function BD_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine BD_PackContStateDerivAry(Vars, x, ValAry) +subroutine BD_VarsPackContStateDeriv(Vars, x, ValAry) type(BD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (BD_x_q) - call MV_Pack(V, x%q(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (BD_x_dqdt) - call MV_Pack(V, x%dqdt(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BD_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine BD_PackConstrStateAry(Vars, z, ValAry) +subroutine BD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(BD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_x_q) + VarVals = x%q(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BD_x_dqdt) + VarVals = x%dqdt(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsPackConstrState(Vars, z, ValAry) type(BD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (BD_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BD_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine BD_UnpackConstrStateAry(Vars, ValAry, z) +subroutine BD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(BD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (BD_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call BD_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine BD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function BD_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3900,50 +3935,64 @@ function BD_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine BD_PackInputAry(Vars, u, ValAry) +subroutine BD_VarsPackInput(Vars, u, ValAry) type(BD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (BD_u_RootMotion) - call MV_Pack(V, u%RootMotion, ValAry) ! Mesh - case (BD_u_PointLoad) - call MV_Pack(V, u%PointLoad, ValAry) ! Mesh - case (BD_u_DistrLoad) - call MV_Pack(V, u%DistrLoad, ValAry) ! Mesh - case (BD_u_HubMotion) - call MV_Pack(V, u%HubMotion, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BD_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine BD_UnpackInputAry(Vars, ValAry, u) +subroutine BD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(BD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_u_RootMotion) + call MV_PackMesh(V, u%RootMotion, ValAry) ! Mesh + case (BD_u_PointLoad) + call MV_PackMesh(V, u%PointLoad, ValAry) ! Mesh + case (BD_u_DistrLoad) + call MV_PackMesh(V, u%DistrLoad, ValAry) ! Mesh + case (BD_u_HubMotion) + call MV_PackMesh(V, u%HubMotion, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (BD_u_RootMotion) - call MV_Unpack(V, ValAry, u%RootMotion) ! Mesh - case (BD_u_PointLoad) - call MV_Unpack(V, ValAry, u%PointLoad) ! Mesh - case (BD_u_DistrLoad) - call MV_Unpack(V, ValAry, u%DistrLoad) ! Mesh - case (BD_u_HubMotion) - call MV_Unpack(V, ValAry, u%HubMotion) ! Mesh - end select - end associate + call BD_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine BD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_u_RootMotion) + call MV_UnpackMesh(V, ValAry, u%RootMotion) ! Mesh + case (BD_u_PointLoad) + call MV_UnpackMesh(V, ValAry, u%PointLoad) ! Mesh + case (BD_u_DistrLoad) + call MV_UnpackMesh(V, ValAry, u%DistrLoad) ! Mesh + case (BD_u_HubMotion) + call MV_UnpackMesh(V, ValAry, u%HubMotion) ! Mesh + end select + end associate +end subroutine + function BD_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3961,54 +4010,68 @@ function BD_InputFieldName(DL) result(Name) end select end function -subroutine BD_PackOutputAry(Vars, y, ValAry) +subroutine BD_VarsPackOutput(Vars, y, ValAry) type(BD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (BD_y_ReactionForce) - call MV_Pack(V, y%ReactionForce, ValAry) ! Mesh - case (BD_y_BldMotion) - call MV_Pack(V, y%BldMotion, ValAry) ! Mesh - case (BD_y_RootMxr) - call MV_Pack(V, y%RootMxr, ValAry) ! Scalar - case (BD_y_RootMyr) - call MV_Pack(V, y%RootMyr, ValAry) ! Scalar - case (BD_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call BD_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine BD_UnpackOutputAry(Vars, ValAry, y) +subroutine BD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(BD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_y_ReactionForce) + call MV_PackMesh(V, y%ReactionForce, ValAry) ! Mesh + case (BD_y_BldMotion) + call MV_PackMesh(V, y%BldMotion, ValAry) ! Mesh + case (BD_y_RootMxr) + VarVals(1) = y%RootMxr ! Scalar + case (BD_y_RootMyr) + VarVals(1) = y%RootMyr ! Scalar + case (BD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(BD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (BD_y_ReactionForce) - call MV_Unpack(V, ValAry, y%ReactionForce) ! Mesh - case (BD_y_BldMotion) - call MV_Unpack(V, ValAry, y%BldMotion) ! Mesh - case (BD_y_RootMxr) - call MV_Unpack(V, ValAry, y%RootMxr) ! Scalar - case (BD_y_RootMyr) - call MV_Unpack(V, ValAry, y%RootMyr) ! Scalar - case (BD_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call BD_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine BD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_y_ReactionForce) + call MV_UnpackMesh(V, ValAry, y%ReactionForce) ! Mesh + case (BD_y_BldMotion) + call MV_UnpackMesh(V, ValAry, y%BldMotion) ! Mesh + case (BD_y_RootMxr) + y%RootMxr = VarVals(1) ! Scalar + case (BD_y_RootMyr) + y%RootMyr = VarVals(1) ! Scalar + case (BD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function BD_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index e3dc31491c..cacee95057 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -345,7 +345,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Module Variables !............................................................................................ - CALL ED_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + CALL ED_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, .true., ErrStat2, ErrMsg2) CALL CheckError( ErrStat2, ErrMsg2 ) !............................................................................................ @@ -10301,7 +10301,7 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Update copy of the inputs to perturb call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackInputAry(Vars, u, m%Jac%u) + call ED_VarsPackInput(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -10325,15 +10325,15 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call ED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call ED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call ED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call ED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,iCol)) @@ -10374,15 +10374,15 @@ SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call ED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call ED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call ED_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call ED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call ED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array dXdu(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) @@ -10459,7 +10459,7 @@ SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Copy state values call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(Vars, x, m%Jac%x) + call ED_VarsPackContState(Vars, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then @@ -10480,15 +10480,15 @@ SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call ED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call ED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call ED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call ED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,iCol)) @@ -10516,15 +10516,15 @@ SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call ED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call ED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call ED_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call ED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call ED_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call ED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array dXdx(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) @@ -10889,7 +10889,7 @@ subroutine ED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, E ! Add variable (only active variables are in x) call MV_AddVar(Vars%x, Vars%x(i)%Name, Field, & - DatLoc(ED_x_QDT), iAry=Vars%x(i)%iAry(1), & + DatLoc(ED_x_QDT), iAry=Vars%x(i)%iLB, & Flags=Vars%x(i)%Flags, & Perturb=Vars%x(i)%Perturb, & LinNames=['First time derivative of '//trim(Vars%x(i)%LinNames(1))//'/s']) diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index c68d7cb383..1d63736658 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -7706,42 +7706,56 @@ function ED_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine ED_PackContStateAry(Vars, x, ValAry) +subroutine ED_VarsPackContState(Vars, x, ValAry) type(ED_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ED_x_QT) - call MV_Pack(V, x%QT(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ED_x_QDT) - call MV_Pack(V, x%QDT(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ED_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine ED_UnpackContStateAry(Vars, ValAry, x) +subroutine ED_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_x_QT) + VarVals = x%QT(V%iLB:V%iUB) ! Rank 1 Array + case (ED_x_QDT) + VarVals = x%QDT(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ED_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ED_x_QT) - call MV_Unpack(V, ValAry, x%QT(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ED_x_QDT) - call MV_Unpack(V, ValAry, x%QDT(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ED_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine ED_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_x_QT) + x%QT(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_x_QDT) + x%QDT(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ED_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -7755,57 +7769,78 @@ function ED_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine ED_PackContStateDerivAry(Vars, x, ValAry) +subroutine ED_VarsPackContStateDeriv(Vars, x, ValAry) type(ED_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ED_x_QT) - call MV_Pack(V, x%QT(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ED_x_QDT) - call MV_Pack(V, x%QDT(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ED_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine ED_PackConstrStateAry(Vars, z, ValAry) +subroutine ED_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_x_QT) + VarVals = x%QT(V%iLB:V%iUB) ! Rank 1 Array + case (ED_x_QDT) + VarVals = x%QDT(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsPackConstrState(Vars, z, ValAry) type(ED_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (ED_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ED_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine ED_UnpackConstrStateAry(Vars, ValAry, z) +subroutine ED_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ED_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ED_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (ED_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call ED_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine ED_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function ED_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -7817,82 +7852,96 @@ function ED_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine ED_PackInputAry(Vars, u, ValAry) +subroutine ED_VarsPackInput(Vars, u, ValAry) type(ED_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ED_u_BladePtLoads) - call MV_Pack(V, u%BladePtLoads(DL%i1), ValAry) ! Mesh - case (ED_u_PlatformPtMesh) - call MV_Pack(V, u%PlatformPtMesh, ValAry) ! Mesh - case (ED_u_TowerPtLoads) - call MV_Pack(V, u%TowerPtLoads, ValAry) ! Mesh - case (ED_u_HubPtLoad) - call MV_Pack(V, u%HubPtLoad, ValAry) ! Mesh - case (ED_u_NacelleLoads) - call MV_Pack(V, u%NacelleLoads, ValAry) ! Mesh - case (ED_u_TFinCMLoads) - call MV_Pack(V, u%TFinCMLoads, ValAry) ! Mesh - case (ED_u_TwrAddedMass) - call MV_Pack(V, u%TwrAddedMass(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (ED_u_PtfmAddedMass) - call MV_Pack(V, u%PtfmAddedMass(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (ED_u_BlPitchCom) - call MV_Pack(V, u%BlPitchCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ED_u_YawMom) - call MV_Pack(V, u%YawMom, ValAry) ! Scalar - case (ED_u_GenTrq) - call MV_Pack(V, u%GenTrq, ValAry) ! Scalar - case (ED_u_HSSBrTrqC) - call MV_Pack(V, u%HSSBrTrqC, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ED_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine ED_UnpackInputAry(Vars, ValAry, u) +subroutine ED_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ED_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_u_BladePtLoads) + call MV_PackMesh(V, u%BladePtLoads(DL%i1), ValAry) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_PackMesh(V, u%PlatformPtMesh, ValAry) ! Mesh + case (ED_u_TowerPtLoads) + call MV_PackMesh(V, u%TowerPtLoads, ValAry) ! Mesh + case (ED_u_HubPtLoad) + call MV_PackMesh(V, u%HubPtLoad, ValAry) ! Mesh + case (ED_u_NacelleLoads) + call MV_PackMesh(V, u%NacelleLoads, ValAry) ! Mesh + case (ED_u_TFinCMLoads) + call MV_PackMesh(V, u%TFinCMLoads, ValAry) ! Mesh + case (ED_u_TwrAddedMass) + VarVals = u%TwrAddedMass(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ED_u_PtfmAddedMass) + VarVals = u%PtfmAddedMass(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ED_u_BlPitchCom) + VarVals = u%BlPitchCom(V%iLB:V%iUB) ! Rank 1 Array + case (ED_u_YawMom) + VarVals(1) = u%YawMom ! Scalar + case (ED_u_GenTrq) + VarVals(1) = u%GenTrq ! Scalar + case (ED_u_HSSBrTrqC) + VarVals(1) = u%HSSBrTrqC ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ED_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ED_u_BladePtLoads) - call MV_Unpack(V, ValAry, u%BladePtLoads(DL%i1)) ! Mesh - case (ED_u_PlatformPtMesh) - call MV_Unpack(V, ValAry, u%PlatformPtMesh) ! Mesh - case (ED_u_TowerPtLoads) - call MV_Unpack(V, ValAry, u%TowerPtLoads) ! Mesh - case (ED_u_HubPtLoad) - call MV_Unpack(V, ValAry, u%HubPtLoad) ! Mesh - case (ED_u_NacelleLoads) - call MV_Unpack(V, ValAry, u%NacelleLoads) ! Mesh - case (ED_u_TFinCMLoads) - call MV_Unpack(V, ValAry, u%TFinCMLoads) ! Mesh - case (ED_u_TwrAddedMass) - call MV_Unpack(V, ValAry, u%TwrAddedMass(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (ED_u_PtfmAddedMass) - call MV_Unpack(V, ValAry, u%PtfmAddedMass(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (ED_u_BlPitchCom) - call MV_Unpack(V, ValAry, u%BlPitchCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ED_u_YawMom) - call MV_Unpack(V, ValAry, u%YawMom) ! Scalar - case (ED_u_GenTrq) - call MV_Unpack(V, ValAry, u%GenTrq) ! Scalar - case (ED_u_HSSBrTrqC) - call MV_Unpack(V, ValAry, u%HSSBrTrqC) ! Scalar - end select - end associate + call ED_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine ED_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ED_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_u_BladePtLoads) + call MV_UnpackMesh(V, ValAry, u%BladePtLoads(DL%i1)) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_UnpackMesh(V, ValAry, u%PlatformPtMesh) ! Mesh + case (ED_u_TowerPtLoads) + call MV_UnpackMesh(V, ValAry, u%TowerPtLoads) ! Mesh + case (ED_u_HubPtLoad) + call MV_UnpackMesh(V, ValAry, u%HubPtLoad) ! Mesh + case (ED_u_NacelleLoads) + call MV_UnpackMesh(V, ValAry, u%NacelleLoads) ! Mesh + case (ED_u_TFinCMLoads) + call MV_UnpackMesh(V, ValAry, u%TFinCMLoads) ! Mesh + case (ED_u_TwrAddedMass) + u%TwrAddedMass(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ED_u_PtfmAddedMass) + u%PtfmAddedMass(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ED_u_BlPitchCom) + u%BlPitchCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_u_YawMom) + u%YawMom = VarVals(1) ! Scalar + case (ED_u_GenTrq) + u%GenTrq = VarVals(1) ! Scalar + case (ED_u_HSSBrTrqC) + u%HSSBrTrqC = VarVals(1) ! Scalar + end select + end associate +end subroutine + function ED_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -7926,174 +7975,188 @@ function ED_InputFieldName(DL) result(Name) end select end function -subroutine ED_PackOutputAry(Vars, y, ValAry) +subroutine ED_VarsPackOutput(Vars, y, ValAry) type(ED_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ED_y_BladeLn2Mesh) - call MV_Pack(V, y%BladeLn2Mesh(DL%i1), ValAry) ! Mesh - case (ED_y_PlatformPtMesh) - call MV_Pack(V, y%PlatformPtMesh, ValAry) ! Mesh - case (ED_y_TowerLn2Mesh) - call MV_Pack(V, y%TowerLn2Mesh, ValAry) ! Mesh - case (ED_y_HubPtMotion) - call MV_Pack(V, y%HubPtMotion, ValAry) ! Mesh - case (ED_y_BladeRootMotion) - call MV_Pack(V, y%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (ED_y_NacelleMotion) - call MV_Pack(V, y%NacelleMotion, ValAry) ! Mesh - case (ED_y_TFinCMMotion) - call MV_Pack(V, y%TFinCMMotion, ValAry) ! Mesh - case (ED_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ED_y_BlPitch) - call MV_Pack(V, y%BlPitch(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ED_y_Yaw) - call MV_Pack(V, y%Yaw, ValAry) ! Scalar - case (ED_y_YawRate) - call MV_Pack(V, y%YawRate, ValAry) ! Scalar - case (ED_y_LSS_Spd) - call MV_Pack(V, y%LSS_Spd, ValAry) ! Scalar - case (ED_y_HSS_Spd) - call MV_Pack(V, y%HSS_Spd, ValAry) ! Scalar - case (ED_y_RotSpeed) - call MV_Pack(V, y%RotSpeed, ValAry) ! Scalar - case (ED_y_TwrAccel) - call MV_Pack(V, y%TwrAccel, ValAry) ! Scalar - case (ED_y_YawAngle) - call MV_Pack(V, y%YawAngle, ValAry) ! Scalar - case (ED_y_RootMyc) - call MV_Pack(V, y%RootMyc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ED_y_YawBrTAxp) - call MV_Pack(V, y%YawBrTAxp, ValAry) ! Scalar - case (ED_y_YawBrTAyp) - call MV_Pack(V, y%YawBrTAyp, ValAry) ! Scalar - case (ED_y_LSSTipPxa) - call MV_Pack(V, y%LSSTipPxa, ValAry) ! Scalar - case (ED_y_RootMxc) - call MV_Pack(V, y%RootMxc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ED_y_LSSTipMxa) - call MV_Pack(V, y%LSSTipMxa, ValAry) ! Scalar - case (ED_y_LSSTipMya) - call MV_Pack(V, y%LSSTipMya, ValAry) ! Scalar - case (ED_y_LSSTipMza) - call MV_Pack(V, y%LSSTipMza, ValAry) ! Scalar - case (ED_y_LSSTipMys) - call MV_Pack(V, y%LSSTipMys, ValAry) ! Scalar - case (ED_y_LSSTipMzs) - call MV_Pack(V, y%LSSTipMzs, ValAry) ! Scalar - case (ED_y_YawBrMyn) - call MV_Pack(V, y%YawBrMyn, ValAry) ! Scalar - case (ED_y_YawBrMzn) - call MV_Pack(V, y%YawBrMzn, ValAry) ! Scalar - case (ED_y_NcIMURAxs) - call MV_Pack(V, y%NcIMURAxs, ValAry) ! Scalar - case (ED_y_NcIMURAys) - call MV_Pack(V, y%NcIMURAys, ValAry) ! Scalar - case (ED_y_NcIMURAzs) - call MV_Pack(V, y%NcIMURAzs, ValAry) ! Scalar - case (ED_y_RotPwr) - call MV_Pack(V, y%RotPwr, ValAry) ! Scalar - case (ED_y_LSShftFxa) - call MV_Pack(V, y%LSShftFxa, ValAry) ! Scalar - case (ED_y_LSShftFys) - call MV_Pack(V, y%LSShftFys, ValAry) ! Scalar - case (ED_y_LSShftFzs) - call MV_Pack(V, y%LSShftFzs, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ED_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine ED_UnpackOutputAry(Vars, ValAry, y) +subroutine ED_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ED_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_PackMesh(V, y%BladeLn2Mesh(DL%i1), ValAry) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_PackMesh(V, y%PlatformPtMesh, ValAry) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_PackMesh(V, y%TowerLn2Mesh, ValAry) ! Mesh + case (ED_y_HubPtMotion) + call MV_PackMesh(V, y%HubPtMotion, ValAry) ! Mesh + case (ED_y_BladeRootMotion) + call MV_PackMesh(V, y%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ED_y_NacelleMotion) + call MV_PackMesh(V, y%NacelleMotion, ValAry) ! Mesh + case (ED_y_TFinCMMotion) + call MV_PackMesh(V, y%TFinCMMotion, ValAry) ! Mesh + case (ED_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (ED_y_BlPitch) + VarVals = y%BlPitch(V%iLB:V%iUB) ! Rank 1 Array + case (ED_y_Yaw) + VarVals(1) = y%Yaw ! Scalar + case (ED_y_YawRate) + VarVals(1) = y%YawRate ! Scalar + case (ED_y_LSS_Spd) + VarVals(1) = y%LSS_Spd ! Scalar + case (ED_y_HSS_Spd) + VarVals(1) = y%HSS_Spd ! Scalar + case (ED_y_RotSpeed) + VarVals(1) = y%RotSpeed ! Scalar + case (ED_y_TwrAccel) + VarVals(1) = y%TwrAccel ! Scalar + case (ED_y_YawAngle) + VarVals(1) = y%YawAngle ! Scalar + case (ED_y_RootMyc) + VarVals = y%RootMyc(V%iLB:V%iUB) ! Rank 1 Array + case (ED_y_YawBrTAxp) + VarVals(1) = y%YawBrTAxp ! Scalar + case (ED_y_YawBrTAyp) + VarVals(1) = y%YawBrTAyp ! Scalar + case (ED_y_LSSTipPxa) + VarVals(1) = y%LSSTipPxa ! Scalar + case (ED_y_RootMxc) + VarVals = y%RootMxc(V%iLB:V%iUB) ! Rank 1 Array + case (ED_y_LSSTipMxa) + VarVals(1) = y%LSSTipMxa ! Scalar + case (ED_y_LSSTipMya) + VarVals(1) = y%LSSTipMya ! Scalar + case (ED_y_LSSTipMza) + VarVals(1) = y%LSSTipMza ! Scalar + case (ED_y_LSSTipMys) + VarVals(1) = y%LSSTipMys ! Scalar + case (ED_y_LSSTipMzs) + VarVals(1) = y%LSSTipMzs ! Scalar + case (ED_y_YawBrMyn) + VarVals(1) = y%YawBrMyn ! Scalar + case (ED_y_YawBrMzn) + VarVals(1) = y%YawBrMzn ! Scalar + case (ED_y_NcIMURAxs) + VarVals(1) = y%NcIMURAxs ! Scalar + case (ED_y_NcIMURAys) + VarVals(1) = y%NcIMURAys ! Scalar + case (ED_y_NcIMURAzs) + VarVals(1) = y%NcIMURAzs ! Scalar + case (ED_y_RotPwr) + VarVals(1) = y%RotPwr ! Scalar + case (ED_y_LSShftFxa) + VarVals(1) = y%LSShftFxa ! Scalar + case (ED_y_LSShftFys) + VarVals(1) = y%LSShftFys ! Scalar + case (ED_y_LSShftFzs) + VarVals(1) = y%LSShftFzs ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ED_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ED_y_BladeLn2Mesh) - call MV_Unpack(V, ValAry, y%BladeLn2Mesh(DL%i1)) ! Mesh - case (ED_y_PlatformPtMesh) - call MV_Unpack(V, ValAry, y%PlatformPtMesh) ! Mesh - case (ED_y_TowerLn2Mesh) - call MV_Unpack(V, ValAry, y%TowerLn2Mesh) ! Mesh - case (ED_y_HubPtMotion) - call MV_Unpack(V, ValAry, y%HubPtMotion) ! Mesh - case (ED_y_BladeRootMotion) - call MV_Unpack(V, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh - case (ED_y_NacelleMotion) - call MV_Unpack(V, ValAry, y%NacelleMotion) ! Mesh - case (ED_y_TFinCMMotion) - call MV_Unpack(V, ValAry, y%TFinCMMotion) ! Mesh - case (ED_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ED_y_BlPitch) - call MV_Unpack(V, ValAry, y%BlPitch(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ED_y_Yaw) - call MV_Unpack(V, ValAry, y%Yaw) ! Scalar - case (ED_y_YawRate) - call MV_Unpack(V, ValAry, y%YawRate) ! Scalar - case (ED_y_LSS_Spd) - call MV_Unpack(V, ValAry, y%LSS_Spd) ! Scalar - case (ED_y_HSS_Spd) - call MV_Unpack(V, ValAry, y%HSS_Spd) ! Scalar - case (ED_y_RotSpeed) - call MV_Unpack(V, ValAry, y%RotSpeed) ! Scalar - case (ED_y_TwrAccel) - call MV_Unpack(V, ValAry, y%TwrAccel) ! Scalar - case (ED_y_YawAngle) - call MV_Unpack(V, ValAry, y%YawAngle) ! Scalar - case (ED_y_RootMyc) - call MV_Unpack(V, ValAry, y%RootMyc(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ED_y_YawBrTAxp) - call MV_Unpack(V, ValAry, y%YawBrTAxp) ! Scalar - case (ED_y_YawBrTAyp) - call MV_Unpack(V, ValAry, y%YawBrTAyp) ! Scalar - case (ED_y_LSSTipPxa) - call MV_Unpack(V, ValAry, y%LSSTipPxa) ! Scalar - case (ED_y_RootMxc) - call MV_Unpack(V, ValAry, y%RootMxc(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ED_y_LSSTipMxa) - call MV_Unpack(V, ValAry, y%LSSTipMxa) ! Scalar - case (ED_y_LSSTipMya) - call MV_Unpack(V, ValAry, y%LSSTipMya) ! Scalar - case (ED_y_LSSTipMza) - call MV_Unpack(V, ValAry, y%LSSTipMza) ! Scalar - case (ED_y_LSSTipMys) - call MV_Unpack(V, ValAry, y%LSSTipMys) ! Scalar - case (ED_y_LSSTipMzs) - call MV_Unpack(V, ValAry, y%LSSTipMzs) ! Scalar - case (ED_y_YawBrMyn) - call MV_Unpack(V, ValAry, y%YawBrMyn) ! Scalar - case (ED_y_YawBrMzn) - call MV_Unpack(V, ValAry, y%YawBrMzn) ! Scalar - case (ED_y_NcIMURAxs) - call MV_Unpack(V, ValAry, y%NcIMURAxs) ! Scalar - case (ED_y_NcIMURAys) - call MV_Unpack(V, ValAry, y%NcIMURAys) ! Scalar - case (ED_y_NcIMURAzs) - call MV_Unpack(V, ValAry, y%NcIMURAzs) ! Scalar - case (ED_y_RotPwr) - call MV_Unpack(V, ValAry, y%RotPwr) ! Scalar - case (ED_y_LSShftFxa) - call MV_Unpack(V, ValAry, y%LSShftFxa) ! Scalar - case (ED_y_LSShftFys) - call MV_Unpack(V, ValAry, y%LSShftFys) ! Scalar - case (ED_y_LSShftFzs) - call MV_Unpack(V, ValAry, y%LSShftFzs) ! Scalar - end select - end associate + call ED_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine ED_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ED_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_UnpackMesh(V, ValAry, y%BladeLn2Mesh(DL%i1)) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_UnpackMesh(V, ValAry, y%PlatformPtMesh) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_UnpackMesh(V, ValAry, y%TowerLn2Mesh) ! Mesh + case (ED_y_HubPtMotion) + call MV_UnpackMesh(V, ValAry, y%HubPtMotion) ! Mesh + case (ED_y_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh + case (ED_y_NacelleMotion) + call MV_UnpackMesh(V, ValAry, y%NacelleMotion) ! Mesh + case (ED_y_TFinCMMotion) + call MV_UnpackMesh(V, ValAry, y%TFinCMMotion) ! Mesh + case (ED_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_y_BlPitch) + y%BlPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_y_Yaw) + y%Yaw = VarVals(1) ! Scalar + case (ED_y_YawRate) + y%YawRate = VarVals(1) ! Scalar + case (ED_y_LSS_Spd) + y%LSS_Spd = VarVals(1) ! Scalar + case (ED_y_HSS_Spd) + y%HSS_Spd = VarVals(1) ! Scalar + case (ED_y_RotSpeed) + y%RotSpeed = VarVals(1) ! Scalar + case (ED_y_TwrAccel) + y%TwrAccel = VarVals(1) ! Scalar + case (ED_y_YawAngle) + y%YawAngle = VarVals(1) ! Scalar + case (ED_y_RootMyc) + y%RootMyc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_y_YawBrTAxp) + y%YawBrTAxp = VarVals(1) ! Scalar + case (ED_y_YawBrTAyp) + y%YawBrTAyp = VarVals(1) ! Scalar + case (ED_y_LSSTipPxa) + y%LSSTipPxa = VarVals(1) ! Scalar + case (ED_y_RootMxc) + y%RootMxc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_y_LSSTipMxa) + y%LSSTipMxa = VarVals(1) ! Scalar + case (ED_y_LSSTipMya) + y%LSSTipMya = VarVals(1) ! Scalar + case (ED_y_LSSTipMza) + y%LSSTipMza = VarVals(1) ! Scalar + case (ED_y_LSSTipMys) + y%LSSTipMys = VarVals(1) ! Scalar + case (ED_y_LSSTipMzs) + y%LSSTipMzs = VarVals(1) ! Scalar + case (ED_y_YawBrMyn) + y%YawBrMyn = VarVals(1) ! Scalar + case (ED_y_YawBrMzn) + y%YawBrMzn = VarVals(1) ! Scalar + case (ED_y_NcIMURAxs) + y%NcIMURAxs = VarVals(1) ! Scalar + case (ED_y_NcIMURAys) + y%NcIMURAys = VarVals(1) ! Scalar + case (ED_y_NcIMURAzs) + y%NcIMURAzs = VarVals(1) ! Scalar + case (ED_y_RotPwr) + y%RotPwr = VarVals(1) ! Scalar + case (ED_y_LSShftFxa) + y%LSShftFxa = VarVals(1) ! Scalar + case (ED_y_LSShftFys) + y%LSShftFys = VarVals(1) ! Scalar + case (ED_y_LSShftFzs) + y%LSShftFzs = VarVals(1) ! Scalar + end select + end associate +end subroutine + function ED_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index 78d46db4c0..8228dd4132 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -2852,102 +2852,116 @@ function ExtInfw_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine ExtInfw_PackInputAry(Vars, u, ValAry) +subroutine ExtInfw_VarsPackInput(Vars, u, ValAry) type(ExtInfw_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ExtInfw_u_pxVel) - call MV_Pack(V, u%pxVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_pyVel) - call MV_Pack(V, u%pyVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_pzVel) - call MV_Pack(V, u%pzVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_pxForce) - call MV_Pack(V, u%pxForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_pyForce) - call MV_Pack(V, u%pyForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_pzForce) - call MV_Pack(V, u%pzForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_xdotForce) - call MV_Pack(V, u%xdotForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_ydotForce) - call MV_Pack(V, u%ydotForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_zdotForce) - call MV_Pack(V, u%zdotForce(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_pOrientation) - call MV_Pack(V, u%pOrientation(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_fx) - call MV_Pack(V, u%fx(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_fy) - call MV_Pack(V, u%fy(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_fz) - call MV_Pack(V, u%fz(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_momentx) - call MV_Pack(V, u%momentx(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_momenty) - call MV_Pack(V, u%momenty(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_momentz) - call MV_Pack(V, u%momentz(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_u_forceNodesChord) - call MV_Pack(V, u%forceNodesChord(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtInfw_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine ExtInfw_UnpackInputAry(Vars, ValAry, u) +subroutine ExtInfw_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ExtInfw_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtInfw_u_pxVel) + VarVals = u%pxVel(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pyVel) + VarVals = u%pyVel(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pzVel) + VarVals = u%pzVel(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pxForce) + VarVals = u%pxForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pyForce) + VarVals = u%pyForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pzForce) + VarVals = u%pzForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_xdotForce) + VarVals = u%xdotForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_ydotForce) + VarVals = u%ydotForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_zdotForce) + VarVals = u%zdotForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pOrientation) + VarVals = u%pOrientation(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_fx) + VarVals = u%fx(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_fy) + VarVals = u%fy(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_fz) + VarVals = u%fz(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_momentx) + VarVals = u%momentx(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_momenty) + VarVals = u%momenty(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_momentz) + VarVals = u%momentz(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + VarVals = u%forceNodesChord(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtInfw_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtInfw_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ExtInfw_u_pxVel) - call MV_Unpack(V, ValAry, u%pxVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_pyVel) - call MV_Unpack(V, ValAry, u%pyVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_pzVel) - call MV_Unpack(V, ValAry, u%pzVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_pxForce) - call MV_Unpack(V, ValAry, u%pxForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_pyForce) - call MV_Unpack(V, ValAry, u%pyForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_pzForce) - call MV_Unpack(V, ValAry, u%pzForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_xdotForce) - call MV_Unpack(V, ValAry, u%xdotForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_ydotForce) - call MV_Unpack(V, ValAry, u%ydotForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_zdotForce) - call MV_Unpack(V, ValAry, u%zdotForce(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_pOrientation) - call MV_Unpack(V, ValAry, u%pOrientation(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_fx) - call MV_Unpack(V, ValAry, u%fx(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_fy) - call MV_Unpack(V, ValAry, u%fy(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_fz) - call MV_Unpack(V, ValAry, u%fz(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_momentx) - call MV_Unpack(V, ValAry, u%momentx(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_momenty) - call MV_Unpack(V, ValAry, u%momenty(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_momentz) - call MV_Unpack(V, ValAry, u%momentz(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_u_forceNodesChord) - call MV_Unpack(V, ValAry, u%forceNodesChord(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ExtInfw_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine ExtInfw_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtInfw_u_pxVel) + u%pxVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pyVel) + u%pyVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pzVel) + u%pzVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pxForce) + u%pxForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pyForce) + u%pyForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pzForce) + u%pzForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_xdotForce) + u%xdotForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_ydotForce) + u%ydotForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_zdotForce) + u%zdotForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pOrientation) + u%pOrientation(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_fx) + u%fx(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_fy) + u%fy(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_fz) + u%fz(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_momentx) + u%momentx(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_momenty) + u%momenty(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_momentz) + u%momentz(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + u%forceNodesChord(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ExtInfw_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2991,50 +3005,64 @@ function ExtInfw_InputFieldName(DL) result(Name) end select end function -subroutine ExtInfw_PackOutputAry(Vars, y, ValAry) +subroutine ExtInfw_VarsPackOutput(Vars, y, ValAry) type(ExtInfw_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ExtInfw_y_u) - call MV_Pack(V, y%u(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_y_v) - call MV_Pack(V, y%v(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_y_w) - call MV_Pack(V, y%w(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtInfw_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtInfw_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine ExtInfw_UnpackOutputAry(Vars, ValAry, y) +subroutine ExtInfw_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ExtInfw_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtInfw_y_u) + VarVals = y%u(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_y_v) + VarVals = y%v(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_y_w) + VarVals = y%w(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtInfw_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtInfw_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ExtInfw_y_u) - call MV_Unpack(V, ValAry, y%u(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_y_v) - call MV_Unpack(V, ValAry, y%v(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_y_w) - call MV_Unpack(V, ValAry, y%w(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtInfw_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ExtInfw_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine ExtInfw_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtInfw_y_u) + y%u(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_y_v) + y%v(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_y_w) + y%w(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ExtInfw_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index b7001cc954..274c6ebf12 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -1709,58 +1709,72 @@ function ExtLdDX_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine ExtLdDX_PackInputAry(Vars, u, ValAry) +subroutine ExtLdDX_VarsPackInput(Vars, u, ValAry) type(ExtLdDX_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ExtLdDX_u_twrDef) - call MV_Pack(V, u%twrDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldDef) - call MV_Pack(V, u%bldDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLdDX_u_hubDef) - call MV_Pack(V, u%hubDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLdDX_u_nacDef) - call MV_Pack(V, u%nacDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldRootDef) - call MV_Pack(V, u%bldRootDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLdDX_u_bldPitch) - call MV_Pack(V, u%bldPitch(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtLdDX_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine ExtLdDX_UnpackInputAry(Vars, ValAry, u) +subroutine ExtLdDX_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLdDX_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLdDX_u_twrDef) + VarVals = u%twrDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_bldDef) + VarVals = u%bldDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_hubDef) + VarVals = u%hubDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_nacDef) + VarVals = u%nacDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + VarVals = u%bldRootDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + VarVals = u%bldPitch(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLdDX_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLdDX_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ExtLdDX_u_twrDef) - call MV_Unpack(V, ValAry, u%twrDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLdDX_u_bldDef) - call MV_Unpack(V, ValAry, u%bldDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLdDX_u_hubDef) - call MV_Unpack(V, ValAry, u%hubDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLdDX_u_nacDef) - call MV_Unpack(V, ValAry, u%nacDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLdDX_u_bldRootDef) - call MV_Unpack(V, ValAry, u%bldRootDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLdDX_u_bldPitch) - call MV_Unpack(V, ValAry, u%bldPitch(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ExtLdDX_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine ExtLdDX_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLdDX_u_twrDef) + u%twrDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_bldDef) + u%bldDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_hubDef) + u%hubDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_nacDef) + u%nacDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + u%bldRootDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + u%bldPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ExtLdDX_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1782,42 +1796,56 @@ function ExtLdDX_InputFieldName(DL) result(Name) end select end function -subroutine ExtLdDX_PackOutputAry(Vars, y, ValAry) +subroutine ExtLdDX_VarsPackOutput(Vars, y, ValAry) type(ExtLdDX_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ExtLdDX_y_twrLd) - call MV_Pack(V, y%twrLd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLdDX_y_bldLd) - call MV_Pack(V, y%bldLd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtLdDX_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine ExtLdDX_UnpackOutputAry(Vars, ValAry, y) +subroutine ExtLdDX_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLdDX_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLdDX_y_twrLd) + VarVals = y%twrLd(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_y_bldLd) + VarVals = y%bldLd(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLdDX_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLdDX_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ExtLdDX_y_twrLd) - call MV_Unpack(V, ValAry, y%twrLd(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLdDX_y_bldLd) - call MV_Unpack(V, ValAry, y%bldLd(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ExtLdDX_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine ExtLdDX_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLdDX_y_twrLd) + y%twrLd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_y_bldLd) + y%bldLd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ExtLdDX_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index a9e649c26d..a5a24df582 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -1736,38 +1736,52 @@ function ExtLd_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine ExtLd_PackContStateAry(Vars, x, ValAry) +subroutine ExtLd_VarsPackContState(Vars, x, ValAry) type(ExtLd_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ExtLd_x_blah) - call MV_Pack(V, x%blah, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtLd_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine ExtLd_UnpackContStateAry(Vars, ValAry, x) +subroutine ExtLd_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_x_blah) + VarVals(1) = x%blah ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ExtLd_x_blah) - call MV_Unpack(V, ValAry, x%blah) ! Scalar - end select - end associate + call ExtLd_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine ExtLd_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_x_blah) + x%blah = VarVals(1) ! Scalar + end select + end associate +end subroutine + function ExtLd_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1779,55 +1793,76 @@ function ExtLd_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine ExtLd_PackContStateDerivAry(Vars, x, ValAry) +subroutine ExtLd_VarsPackContStateDeriv(Vars, x, ValAry) type(ExtLd_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ExtLd_x_blah) - call MV_Pack(V, x%blah, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtLd_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine ExtLd_PackConstrStateAry(Vars, z, ValAry) +subroutine ExtLd_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_x_blah) + VarVals(1) = x%blah ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsPackConstrState(Vars, z, ValAry) type(ExtLd_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (ExtLd_z_blah) - call MV_Pack(V, z%blah, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtLd_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine ExtLd_UnpackConstrStateAry(Vars, ValAry, z) +subroutine ExtLd_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_z_blah) + VarVals(1) = z%blah ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (ExtLd_z_blah) - call MV_Unpack(V, ValAry, z%blah) ! Scalar - end select - end associate + call ExtLd_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine ExtLd_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_z_blah) + z%blah = VarVals(1) ! Scalar + end select + end associate +end subroutine + function ExtLd_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1839,82 +1874,96 @@ function ExtLd_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine ExtLd_PackInputAry(Vars, u, ValAry) +subroutine ExtLd_VarsPackInput(Vars, u, ValAry) type(ExtLd_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ExtLd_u_DX_u_twrDef) - call MV_Pack(V, u%DX_u%twrDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldDef) - call MV_Pack(V, u%DX_u%bldDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_hubDef) - call MV_Pack(V, u%DX_u%hubDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_nacDef) - call MV_Pack(V, u%DX_u%nacDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldRootDef) - call MV_Pack(V, u%DX_u%bldRootDef(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLd_u_DX_u_bldPitch) - call MV_Pack(V, u%DX_u%bldPitch(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLd_u_az) - call MV_Pack(V, u%az, ValAry) ! Scalar - case (ExtLd_u_TowerMotion) - call MV_Pack(V, u%TowerMotion, ValAry) ! Mesh - case (ExtLd_u_HubMotion) - call MV_Pack(V, u%HubMotion, ValAry) ! Mesh - case (ExtLd_u_NacelleMotion) - call MV_Pack(V, u%NacelleMotion, ValAry) ! Mesh - case (ExtLd_u_BladeRootMotion) - call MV_Pack(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh - case (ExtLd_u_BladeMotion) - call MV_Pack(V, u%BladeMotion(DL%i1), ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtLd_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine ExtLd_UnpackInputAry(Vars, ValAry, u) +subroutine ExtLd_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_u_DX_u_twrDef) + VarVals = u%DX_u%twrDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + VarVals = u%DX_u%bldDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + VarVals = u%DX_u%hubDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + VarVals = u%DX_u%nacDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + VarVals = u%DX_u%bldRootDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + VarVals = u%DX_u%bldPitch(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_az) + VarVals(1) = u%az ! Scalar + case (ExtLd_u_TowerMotion) + call MV_PackMesh(V, u%TowerMotion, ValAry) ! Mesh + case (ExtLd_u_HubMotion) + call MV_PackMesh(V, u%HubMotion, ValAry) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_PackMesh(V, u%NacelleMotion, ValAry) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_PackMesh(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_PackMesh(V, u%BladeMotion(DL%i1), ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ExtLd_u_DX_u_twrDef) - call MV_Unpack(V, ValAry, u%DX_u%twrDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLd_u_DX_u_bldDef) - call MV_Unpack(V, ValAry, u%DX_u%bldDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLd_u_DX_u_hubDef) - call MV_Unpack(V, ValAry, u%DX_u%hubDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLd_u_DX_u_nacDef) - call MV_Unpack(V, ValAry, u%DX_u%nacDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLd_u_DX_u_bldRootDef) - call MV_Unpack(V, ValAry, u%DX_u%bldRootDef(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLd_u_DX_u_bldPitch) - call MV_Unpack(V, ValAry, u%DX_u%bldPitch(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLd_u_az) - call MV_Unpack(V, ValAry, u%az) ! Scalar - case (ExtLd_u_TowerMotion) - call MV_Unpack(V, ValAry, u%TowerMotion) ! Mesh - case (ExtLd_u_HubMotion) - call MV_Unpack(V, ValAry, u%HubMotion) ! Mesh - case (ExtLd_u_NacelleMotion) - call MV_Unpack(V, ValAry, u%NacelleMotion) ! Mesh - case (ExtLd_u_BladeRootMotion) - call MV_Unpack(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh - case (ExtLd_u_BladeMotion) - call MV_Unpack(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh - end select - end associate + call ExtLd_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine ExtLd_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_u_DX_u_twrDef) + u%DX_u%twrDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + u%DX_u%bldDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + u%DX_u%hubDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + u%DX_u%nacDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + u%DX_u%bldRootDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + u%DX_u%bldPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_az) + u%az = VarVals(1) ! Scalar + case (ExtLd_u_TowerMotion) + call MV_UnpackMesh(V, ValAry, u%TowerMotion) ! Mesh + case (ExtLd_u_HubMotion) + call MV_UnpackMesh(V, ValAry, u%HubMotion) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_UnpackMesh(V, ValAry, u%NacelleMotion) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_UnpackMesh(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh + end select + end associate +end subroutine + function ExtLd_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1948,58 +1997,72 @@ function ExtLd_InputFieldName(DL) result(Name) end select end function -subroutine ExtLd_PackOutputAry(Vars, y, ValAry) +subroutine ExtLd_VarsPackOutput(Vars, y, ValAry) type(ExtLd_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ExtLd_y_DX_y_twrLd) - call MV_Pack(V, y%DX_y%twrLd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLd_y_DX_y_bldLd) - call MV_Pack(V, y%DX_y%bldLd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtLd_y_TowerLoad) - call MV_Pack(V, y%TowerLoad, ValAry) ! Mesh - case (ExtLd_y_BladeLoad) - call MV_Pack(V, y%BladeLoad(DL%i1), ValAry) ! Mesh - case (ExtLd_y_TowerLoadAD) - call MV_Pack(V, y%TowerLoadAD, ValAry) ! Mesh - case (ExtLd_y_BladeLoadAD) - call MV_Pack(V, y%BladeLoadAD(DL%i1), ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtLd_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine ExtLd_UnpackOutputAry(Vars, ValAry, y) +subroutine ExtLd_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_y_DX_y_twrLd) + VarVals = y%DX_y%twrLd(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + VarVals = y%DX_y%bldLd(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_PackMesh(V, y%TowerLoad, ValAry) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_PackMesh(V, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (ExtLd_y_TowerLoadAD) + call MV_PackMesh(V, y%TowerLoadAD, ValAry) ! Mesh + case (ExtLd_y_BladeLoadAD) + call MV_PackMesh(V, y%BladeLoadAD(DL%i1), ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtLd_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ExtLd_y_DX_y_twrLd) - call MV_Unpack(V, ValAry, y%DX_y%twrLd(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLd_y_DX_y_bldLd) - call MV_Unpack(V, ValAry, y%DX_y%bldLd(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtLd_y_TowerLoad) - call MV_Unpack(V, ValAry, y%TowerLoad) ! Mesh - case (ExtLd_y_BladeLoad) - call MV_Unpack(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh - case (ExtLd_y_TowerLoadAD) - call MV_Unpack(V, ValAry, y%TowerLoadAD) ! Mesh - case (ExtLd_y_BladeLoadAD) - call MV_Unpack(V, ValAry, y%BladeLoadAD(DL%i1)) ! Mesh - end select - end associate + call ExtLd_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine ExtLd_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_y_DX_y_twrLd) + y%DX_y%twrLd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + y%DX_y%bldLd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_UnpackMesh(V, ValAry, y%TowerLoad) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_UnpackMesh(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (ExtLd_y_TowerLoadAD) + call MV_UnpackMesh(V, ValAry, y%TowerLoadAD) ! Mesh + case (ExtLd_y_BladeLoadAD) + call MV_UnpackMesh(V, ValAry, y%BladeLoadAD(DL%i1)) ! Mesh + end select + end associate +end subroutine + function ExtLd_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/extptfm/src/ExtPtfm_MCKF.f90 b/modules/extptfm/src/ExtPtfm_MCKF.f90 index 0af5205be2..ad6e4a1fe9 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF.f90 @@ -245,6 +245,10 @@ SUBROUTINE ExtPtfm_Init( InitInp, u, p, x, xd, z, OtherState, y, m, dt_gluecode, InitOut%IsLoad_u = .false. ! the inputs are not loads but kinematics end if + ! --- Module variables + call ExtPtfm_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, InitInp%Linearize, ErrStat, ErrMsg) + if (Failed()) return + ! --- Summary file if (InputFileData%SumPrint) then call ExtPtfm_PrintSum(x, p, m, InitInp%RootName, ErrStat, ErrMsg); if(Failed()) return @@ -257,6 +261,96 @@ logical function Failed() end function Failed END SUBROUTINE ExtPtfm_Init +subroutine ExtPtfm_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(ExtPtfm_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ExtPtfm_ParameterType), intent(inout) :: p !< Parameters + type(ExtPtfm_ContinuousStateType), intent(inout) :: x !< Continuous state + type(ExtPtfm_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ExtPtfm_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(ExtPtfm_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ExtPtfm_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + integer(IntKi), allocatable :: BladeMeshFields(:) + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: Flags, Field + + ErrStat = ErrID_None + ErrMsg = "" + + ! Clear module variables type + call NWTC_Library_DestroyModVarsType(Vars, ErrStat2, ErrMsg2); if (Failed()) return + + !--------------------------------------------------------------------------- + ! Continuous State Variables + !--------------------------------------------------------------------------- + + do i = 1, p%nCB + call MV_AddVar(Vars%x, "Mode"//trim(Num2LStr(p%ActiveCBDOF(i))), FieldTransDisp, & + DL=DatLoc(ExtPtfm_x_qm), iAry=i, & + LinNames=['Mode '//trim(Num2LStr(p%ActiveCBDOF(i)))//' displacement, -']) + end do + + do i = 1, p%nCB + call MV_AddVar(Vars%x, "Mode"//trim(Num2LStr(p%ActiveCBDOF(i))), FieldTransVel, & + DL=DatLoc(ExtPtfm_x_qm), iAry=i, & + LinNames=['Mode '//trim(Num2LStr(p%ActiveCBDOF(i)))//' velocity, -']) + end do + + !--------------------------------------------------------------------------- + ! Input variables + !--------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%u, 'Interface node', MotionFields, & + DatLoc(ExtPtfm_u_PtfmMesh), & + Mesh=u%PtfmMesh, & + Flags=VF_SmallAngle) + + !--------------------------------------------------------------------------- + ! Output variables + !--------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%y, "Interface node", LoadFields, & + DL=DatLoc(ExtPtfm_y_PtfmMesh), & + Mesh=y%PtfmMesh) + + call MV_AddVar(Vars%y, p%OutParam(i)%Name, FieldScalar, & + DL=DatLoc(ExtPtfm_y_WriteOutput), & + Num=p%NumOuts, & + Flags=VF_WriteOut, & + LinNames=[(WriteOutLinName(i), i=1, p%NumOuts)]) + + !--------------------------------------------------------------------------- + ! Initialization dependent on linearization + !--------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + if (Linearize) then + call ExtPtfm_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + end if + +contains + function WriteOutLinName(iParam) result(Name) + integer(IntKi), intent(in) :: iParam + character(LinChanLen) :: Name + Name = trim(p%OutParam(iParam)%Name)//', '//p%OutParam(iParam)%Units + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE SetStateMatrices( p, ErrStat, ErrMsg) @@ -872,8 +966,8 @@ END SUBROUTINE ExtPtfm_CalcConstrStateResidual !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE ExtPtfm_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. +SUBROUTINE ExtPtfm_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters @@ -896,41 +990,67 @@ SUBROUTINE ExtPtfm_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with !! respect to the inputs (u) [intent in to avoid deallocation] - INTEGER(IntKi) :: i,j ! Loop index - INTEGER(IntKi) :: idx ! Index of output channel in AllOuts - ! Initialize ErrStat + INTEGER(IntKi) :: i, j ! Loop index + logical :: CalcOutputs + ErrStat = ErrID_None ErrMsg = '' + + ! allocate and set dYdu if (present(dYdu)) then - ! allocate and set dYdu + if (.not. allocated(dYdu)) then - call AllocAry(dYdu, N_OUTPUTS+p%NumOuts, N_INPUTS, 'dYdu', ErrStat, ErrMsg); if(Failed()) return - do i=1,size(dYdu,1); do j=1,size(dYdu,2); dYdu(i,j)=0.0_ReKi; enddo;enddo + call AllocAry(dYdu, N_OUTPUTS+p%NumOuts, N_INPUTS, 'dYdu', ErrStat, ErrMsg) + if(Failed()) return + dYdu = 0.0_ReKi end if - dYdu(1:6,1:N_INPUTS) = p%DMat(1:6,1:N_INPUTS) - !dYdu is zero except if WriteOutput is the interface loads - do i = 1,p%NumOuts - idx = p%OutParam(i)%Indx - if (idx==ID_PtfFx) then; dYdu(6+i,1:N_INPUTS) = p%DMat(1,1:N_INPUTS) - elseif (idx==ID_PtfFy) then; dYdu(6+i,1:N_INPUTS) = p%DMat(2,1:N_INPUTS) - elseif (idx==ID_PtfFx) then; dYdu(6+i,1:N_INPUTS) = p%DMat(3,1:N_INPUTS) - elseif (idx==ID_PtfMz) then; dYdu(6+i,1:N_INPUTS) = p%DMat(4,1:N_INPUTS) - elseif (idx==ID_PtfMy) then; dYdu(6+i,1:N_INPUTS) = p%DMat(5,1:N_INPUTS) - elseif (idx==ID_PtfMz) then; dYdu(6+i,1:N_INPUTS) = p%DMat(6,1:N_INPUTS) - else ; dYdu(6+i,1:N_INPUTS) = 0.0_ReKi - endif + + dYdu(1:6, 1:N_INPUTS) = p%DMat(1:6, 1:N_INPUTS) + + ! Check if outputs need to be processed + CalcOutputs = .false. + do i = 1, size(Vars%y) + if (MV_HasFlagsAll(Vars%y(i), VF_WriteOut)) CalcOutputs = .true. end do - end if + + ! dYdu is zero except if WriteOutput is the interface loads + if (CalcOutputs) then + do i = 1, p%NumOuts + select case (p%OutParam(i)%Indx) + case (ID_PtfFx) + dYdu(6+i,1:N_INPUTS) = p%DMat(1,1:N_INPUTS) + case (ID_PtfFy) + dYdu(6+i,1:N_INPUTS) = p%DMat(2,1:N_INPUTS) + case (ID_PtfFz) + dYdu(6+i,1:N_INPUTS) = p%DMat(3,1:N_INPUTS) + case (ID_PtfMx) + dYdu(6+i,1:N_INPUTS) = p%DMat(4,1:N_INPUTS) + case (ID_PtfMy) + dYdu(6+i,1:N_INPUTS) = p%DMat(5,1:N_INPUTS) + case (ID_PtfMz) + dYdu(6+i,1:N_INPUTS) = p%DMat(6,1:N_INPUTS) + case default + dYdu(6+i,1:N_INPUTS) = 0.0_ReKi + end select + end do + end if + end if + + ! allocate and set dXdu if (present(dXdu)) then - ! allocate and set dXdu + if (.not. allocated(dXdu)) then - call AllocAry(dXdu, 2*p%nCB, N_INPUTS, 'dXdu', ErrStat, ErrMsg); if(Failed()) return - do i=1,size(dXdu,1); do j=1,size(dXdu,2); dXdu(i,j)=0.0_ReKi; enddo;enddo + call AllocAry(dXdu, 2*p%nCB, N_INPUTS, 'dXdu', ErrStat, ErrMsg) + if(Failed()) return + dXdu = 0.0_ReKi end if + dXdu(1:2*p%nCB,1:N_INPUTS) = p%BMat(1:2*p%nCB,1:N_INPUTS) end if + if (present(dXddu)) then end if + if (present(dZdu)) then end if CONTAINS diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt b/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt index 7b8f425a72..a65b5405b8 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt +++ b/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt @@ -54,8 +54,8 @@ typedef ^ ^ LOGICAL RotFrame_y { typedef ^ ^ LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - -typedef ^ ^ IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - - +typedef ^ ^ IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - +typedef ^ ^ ModVarsType Vars - - - "Module variables" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -74,18 +74,6 @@ typedef ^ ^ IntKi n #typedef ^ OtherStateType IntKi DummyOtherState - - - "Remove this variable if you have other states" - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi xFlat {:} - - "Flattened vector of states" -typedef ^ MiscVarType ReKi uFlat {18} - - "Flattened vector of inputs" -typedef ^ MiscVarType ReKi F_at_t {:} - - "The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion)." "N, N-m" -typedef ^ MiscVarType IntKi Indx - - - "Index into times, to speed up interpolation" - -typedef ^ MiscVarType LOGICAL EquilStart - - - "Flag to determine the equilibrium position of the CB DOF at initialization (first call)" - -typedef ^ ^ ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" -typedef ^ ^ ExtPtfm_ContinuousStateType dxdt_lin - - - "continuous state derivatives" - - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -129,3 +117,17 @@ typedef ^ InputType MeshType PtfmMesh - typedef ^ OutputType MeshType PtfmMesh - - - "Loads at the platform reference point" - typedef ^ ^ ReKi WriteOutput {:} - - "Example of data to be written to an output file" "s,-" +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType ReKi xFlat {:} - - "Flattened vector of states" +typedef ^ MiscVarType ReKi uFlat {18} - - "Flattened vector of inputs" +typedef ^ MiscVarType ReKi F_at_t {:} - - "The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion)." "N, N-m" +typedef ^ MiscVarType IntKi Indx - - - "Index into times, to speed up interpolation" - +typedef ^ MiscVarType LOGICAL EquilStart - - - "Flag to determine the equilibrium position of the CB DOF at initialization (first call)" - +typedef ^ ^ ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" +typedef ^ ^ ModJacType Jac - - - "Data structure for calculating module Jacobians" - +typedef ^ ^ ExtPtfm_ContinuousStateType x_perturb - - - "" - +typedef ^ ^ ExtPtfm_ContinuousStateType dxdt_lin - - - "continuous state derivatives" - +typedef ^ ^ ExtPtfm_InputType u_perturb - - - "" - +typedef ^ ^ ExtPtfm_OutputType y_lin - - - "" - diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index e727777257..b27ccc6177 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -74,6 +74,7 @@ MODULE ExtPtfm_MCKF_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] + TYPE(ModVarsType) :: Vars !< Module variables [-] END TYPE ExtPtfm_InitOutputType ! ======================= ! ========= ExtPtfm_ContinuousStateType ======= @@ -98,17 +99,6 @@ MODULE ExtPtfm_MCKF_Types INTEGER(IntKi) :: n = 0_IntKi !< Tracks time step for which OtherState was updated last [-] END TYPE ExtPtfm_OtherStateType ! ======================= -! ========= ExtPtfm_MiscVarType ======= - TYPE, PUBLIC :: ExtPtfm_MiscVarType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xFlat !< Flattened vector of states [-] - REAL(ReKi) , DIMENSION(1:18) :: uFlat = 0.0_ReKi !< Flattened vector of inputs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_at_t !< The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion). [N, N-m] - INTEGER(IntKi) :: Indx = 0_IntKi !< Index into times, to speed up interpolation [-] - LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] - TYPE(ExtPtfm_ContinuousStateType) :: dxdt_lin !< continuous state derivatives [-] - END TYPE ExtPtfm_MiscVarType -! ======================= ! ========= ExtPtfm_ParameterType ======= TYPE, PUBLIC :: ExtPtfm_ParameterType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mass !< Mass matrix [kg, kg-m, kg-m^2] @@ -154,6 +144,21 @@ MODULE ExtPtfm_MCKF_Types TYPE(MeshType) :: PtfmMesh !< Loads at the platform reference point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Example of data to be written to an output file [s,-] END TYPE ExtPtfm_OutputType +! ======================= +! ========= ExtPtfm_MiscVarType ======= + TYPE, PUBLIC :: ExtPtfm_MiscVarType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xFlat !< Flattened vector of states [-] + REAL(ReKi) , DIMENSION(1:18) :: uFlat = 0.0_ReKi !< Flattened vector of inputs [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_at_t !< The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion). [N, N-m] + INTEGER(IntKi) :: Indx = 0_IntKi !< Index into times, to speed up interpolation [-] + LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] + TYPE(ModJacType) :: Jac !< Data structure for calculating module Jacobians [-] + TYPE(ExtPtfm_ContinuousStateType) :: x_perturb !< [-] + TYPE(ExtPtfm_ContinuousStateType) :: dxdt_lin !< continuous state derivatives [-] + TYPE(ExtPtfm_InputType) :: u_perturb !< [-] + TYPE(ExtPtfm_OutputType) :: y_lin !< [-] + END TYPE ExtPtfm_MiscVarType ! ======================= integer(IntKi), public, parameter :: ExtPtfm_x_qm = 1 ! ExtPtfm%qm integer(IntKi), public, parameter :: ExtPtfm_x_qmdot = 2 ! ExtPtfm%qmdot @@ -490,6 +495,9 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -533,6 +541,8 @@ subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%DerivOrder_x)) then deallocate(InitOutputData%DerivOrder_x) end if + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ExtPtfm_PackInitOutput(RF, Indata) @@ -551,6 +561,7 @@ subroutine ExtPtfm_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%IsLoad_u) call RegPackAlloc(RF, InData%DerivOrder_x) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -573,6 +584,7 @@ subroutine ExtPtfm_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -824,116 +836,6 @@ subroutine ExtPtfm_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(ExtPtfm_MiscVarType), intent(in) :: SrcMiscData - type(ExtPtfm_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcMiscData%xFlat)) then - LB(1:1) = lbound(SrcMiscData%xFlat, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%xFlat, kind=B8Ki) - if (.not. allocated(DstMiscData%xFlat)) then - allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%xFlat = SrcMiscData%xFlat - end if - DstMiscData%uFlat = SrcMiscData%uFlat - if (allocated(SrcMiscData%F_at_t)) then - LB(1:1) = lbound(SrcMiscData%F_at_t, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_at_t, kind=B8Ki) - if (.not. allocated(DstMiscData%F_at_t)) then - allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%F_at_t = SrcMiscData%F_at_t - end if - DstMiscData%Indx = SrcMiscData%Indx - DstMiscData%EquilStart = SrcMiscData%EquilStart - if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) - if (.not. allocated(DstMiscData%AllOuts)) then - allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%AllOuts = SrcMiscData%AllOuts - end if - call ExtPtfm_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(ExtPtfm_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ExtPtfm_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(MiscData%xFlat)) then - deallocate(MiscData%xFlat) - end if - if (allocated(MiscData%F_at_t)) then - deallocate(MiscData%F_at_t) - end if - if (allocated(MiscData%AllOuts)) then - deallocate(MiscData%AllOuts) - end if - call ExtPtfm_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine ExtPtfm_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ExtPtfm_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%xFlat) - call RegPack(RF, InData%uFlat) - call RegPackAlloc(RF, InData%F_at_t) - call RegPack(RF, InData%Indx) - call RegPack(RF, InData%EquilStart) - call RegPackAlloc(RF, InData%AllOuts) - call ExtPtfm_PackContState(RF, InData%dxdt_lin) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ExtPtfm_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ExtPtfm_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%xFlat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%uFlat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_at_t); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return - call ExtPtfm_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin -end subroutine - subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(ExtPtfm_ParameterType), intent(in) :: SrcParamData type(ExtPtfm_ParameterType), intent(inout) :: DstParamData @@ -1555,6 +1457,144 @@ subroutine ExtPtfm_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(inout) :: SrcMiscData + type(ExtPtfm_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%xFlat)) then + LB(1:1) = lbound(SrcMiscData%xFlat, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%xFlat, kind=B8Ki) + if (.not. allocated(DstMiscData%xFlat)) then + allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xFlat = SrcMiscData%xFlat + end if + DstMiscData%uFlat = SrcMiscData%uFlat + if (allocated(SrcMiscData%F_at_t)) then + LB(1:1) = lbound(SrcMiscData%F_at_t, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_at_t, kind=B8Ki) + if (.not. allocated(DstMiscData%F_at_t)) then + allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_at_t = SrcMiscData%F_at_t + end if + DstMiscData%Indx = SrcMiscData%Indx + DstMiscData%EquilStart = SrcMiscData%EquilStart + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%xFlat)) then + deallocate(MiscData%xFlat) + end if + if (allocated(MiscData%F_at_t)) then + deallocate(MiscData%F_at_t) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ExtPtfm_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xFlat) + call RegPack(RF, InData%uFlat) + call RegPackAlloc(RF, InData%F_at_t) + call RegPack(RF, InData%Indx) + call RegPack(RF, InData%EquilStart) + call RegPackAlloc(RF, InData%AllOuts) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call ExtPtfm_PackContState(RF, InData%x_perturb) + call ExtPtfm_PackContState(RF, InData%dxdt_lin) + call ExtPtfm_PackInput(RF, InData%u_perturb) + call ExtPtfm_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xFlat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%uFlat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_at_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call ExtPtfm_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call ExtPtfm_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call ExtPtfm_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call ExtPtfm_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + subroutine ExtPtfm_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time @@ -1899,42 +1939,56 @@ function ExtPtfm_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine ExtPtfm_PackContStateAry(Vars, x, ValAry) +subroutine ExtPtfm_VarsPackContState(Vars, x, ValAry) type(ExtPtfm_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ExtPtfm_x_qm) - call MV_Pack(V, x%qm(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtPtfm_x_qmdot) - call MV_Pack(V, x%qmdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtPtfm_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine ExtPtfm_UnpackContStateAry(Vars, ValAry, x) +subroutine ExtPtfm_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_x_qm) + VarVals = x%qm(V%iLB:V%iUB) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + VarVals = x%qmdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ExtPtfm_x_qm) - call MV_Unpack(V, ValAry, x%qm(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (ExtPtfm_x_qmdot) - call MV_Unpack(V, ValAry, x%qmdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ExtPtfm_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine ExtPtfm_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_x_qm) + x%qm(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtPtfm_x_qmdot) + x%qmdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ExtPtfm_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1948,57 +2002,78 @@ function ExtPtfm_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine ExtPtfm_PackContStateDerivAry(Vars, x, ValAry) +subroutine ExtPtfm_VarsPackContStateDeriv(Vars, x, ValAry) type(ExtPtfm_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (ExtPtfm_x_qm) - call MV_Pack(V, x%qm(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (ExtPtfm_x_qmdot) - call MV_Pack(V, x%qmdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtPtfm_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine ExtPtfm_PackConstrStateAry(Vars, z, ValAry) +subroutine ExtPtfm_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_x_qm) + VarVals = x%qm(V%iLB:V%iUB) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + VarVals = x%qmdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsPackConstrState(Vars, z, ValAry) type(ExtPtfm_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (ExtPtfm_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtPtfm_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine ExtPtfm_UnpackConstrStateAry(Vars, ValAry, z) +subroutine ExtPtfm_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (ExtPtfm_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call ExtPtfm_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine ExtPtfm_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function ExtPtfm_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2010,38 +2085,52 @@ function ExtPtfm_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine ExtPtfm_PackInputAry(Vars, u, ValAry) +subroutine ExtPtfm_VarsPackInput(Vars, u, ValAry) type(ExtPtfm_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ExtPtfm_u_PtfmMesh) - call MV_Pack(V, u%PtfmMesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtPtfm_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine ExtPtfm_UnpackInputAry(Vars, ValAry, u) +subroutine ExtPtfm_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_PackMesh(V, u%PtfmMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (ExtPtfm_u_PtfmMesh) - call MV_Unpack(V, ValAry, u%PtfmMesh) ! Mesh - end select - end associate + call ExtPtfm_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine ExtPtfm_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_UnpackMesh(V, ValAry, u%PtfmMesh) ! Mesh + end select + end associate +end subroutine + function ExtPtfm_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2053,42 +2142,56 @@ function ExtPtfm_InputFieldName(DL) result(Name) end select end function -subroutine ExtPtfm_PackOutputAry(Vars, y, ValAry) +subroutine ExtPtfm_VarsPackOutput(Vars, y, ValAry) type(ExtPtfm_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ExtPtfm_y_PtfmMesh) - call MV_Pack(V, y%PtfmMesh, ValAry) ! Mesh - case (ExtPtfm_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call ExtPtfm_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine ExtPtfm_UnpackOutputAry(Vars, ValAry, y) +subroutine ExtPtfm_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_PackMesh(V, y%PtfmMesh, ValAry) ! Mesh + case (ExtPtfm_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(ExtPtfm_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (ExtPtfm_y_PtfmMesh) - call MV_Unpack(V, ValAry, y%PtfmMesh) ! Mesh - case (ExtPtfm_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call ExtPtfm_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine ExtPtfm_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_UnpackMesh(V, ValAry, y%PtfmMesh) ! Mesh + case (ExtPtfm_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function ExtPtfm_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index aabbe3b598..73e02a8803 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -2536,42 +2536,56 @@ function FEAM_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine FEAM_PackContStateAry(Vars, x, ValAry) +subroutine FEAM_VarsPackContState(Vars, x, ValAry) type(FEAM_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (FEAM_x_GLU) - call MV_Pack(V, x%GLU(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (FEAM_x_GLDU) - call MV_Pack(V, x%GLDU(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FEAM_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine FEAM_UnpackContStateAry(Vars, ValAry, x) +subroutine FEAM_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_x_GLU) + VarVals = x%GLU(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FEAM_x_GLDU) + VarVals = x%GLDU(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FEAM_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (FEAM_x_GLU) - call MV_Unpack(V, ValAry, x%GLU(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (FEAM_x_GLDU) - call MV_Unpack(V, ValAry, x%GLDU(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call FEAM_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine FEAM_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_x_GLU) + x%GLU(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FEAM_x_GLDU) + x%GLDU(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function FEAM_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2585,61 +2599,82 @@ function FEAM_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine FEAM_PackContStateDerivAry(Vars, x, ValAry) +subroutine FEAM_VarsPackContStateDeriv(Vars, x, ValAry) type(FEAM_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (FEAM_x_GLU) - call MV_Pack(V, x%GLU(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (FEAM_x_GLDU) - call MV_Pack(V, x%GLDU(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FEAM_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine FEAM_PackConstrStateAry(Vars, z, ValAry) +subroutine FEAM_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_x_GLU) + VarVals = x%GLU(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FEAM_x_GLDU) + VarVals = x%GLDU(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsPackConstrState(Vars, z, ValAry) type(FEAM_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (FEAM_z_TSN) - call MV_Pack(V, z%TSN(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (FEAM_z_TZER) - call MV_Pack(V, z%TZER(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FEAM_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine FEAM_UnpackConstrStateAry(Vars, ValAry, z) +subroutine FEAM_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_z_TSN) + VarVals = z%TSN(V%iLB:V%iUB) ! Rank 1 Array + case (FEAM_z_TZER) + VarVals = z%TZER(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FEAM_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (FEAM_z_TSN) - call MV_Unpack(V, ValAry, z%TSN(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (FEAM_z_TZER) - call MV_Unpack(V, ValAry, z%TZER(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call FEAM_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine FEAM_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_z_TSN) + z%TSN(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FEAM_z_TZER) + z%TZER(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function FEAM_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2653,42 +2688,56 @@ function FEAM_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine FEAM_PackInputAry(Vars, u, ValAry) +subroutine FEAM_VarsPackInput(Vars, u, ValAry) type(FEAM_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (FEAM_u_HydroForceLineMesh) - call MV_Pack(V, u%HydroForceLineMesh, ValAry) ! Mesh - case (FEAM_u_PtFairleadDisplacement) - call MV_Pack(V, u%PtFairleadDisplacement, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FEAM_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine FEAM_UnpackInputAry(Vars, ValAry, u) +subroutine FEAM_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_PackMesh(V, u%HydroForceLineMesh, ValAry) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_PackMesh(V, u%PtFairleadDisplacement, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FEAM_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (FEAM_u_HydroForceLineMesh) - call MV_Unpack(V, ValAry, u%HydroForceLineMesh) ! Mesh - case (FEAM_u_PtFairleadDisplacement) - call MV_Unpack(V, ValAry, u%PtFairleadDisplacement) ! Mesh - end select - end associate + call FEAM_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine FEAM_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_UnpackMesh(V, ValAry, u%HydroForceLineMesh) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_UnpackMesh(V, ValAry, u%PtFairleadDisplacement) ! Mesh + end select + end associate +end subroutine + function FEAM_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2702,46 +2751,60 @@ function FEAM_InputFieldName(DL) result(Name) end select end function -subroutine FEAM_PackOutputAry(Vars, y, ValAry) +subroutine FEAM_VarsPackOutput(Vars, y, ValAry) type(FEAM_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (FEAM_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (FEAM_y_PtFairleadLoad) - call MV_Pack(V, y%PtFairleadLoad, ValAry) ! Mesh - case (FEAM_y_LineMeshPosition) - call MV_Pack(V, y%LineMeshPosition, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call FEAM_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine FEAM_UnpackOutputAry(Vars, ValAry, y) +subroutine FEAM_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_PackMesh(V, y%PtFairleadLoad, ValAry) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_PackMesh(V, y%LineMeshPosition, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(FEAM_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (FEAM_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (FEAM_y_PtFairleadLoad) - call MV_Unpack(V, ValAry, y%PtFairleadLoad) ! Mesh - case (FEAM_y_LineMeshPosition) - call MV_Unpack(V, ValAry, y%LineMeshPosition) ! Mesh - end select - end associate + call FEAM_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine FEAM_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_UnpackMesh(V, ValAry, y%PtFairleadLoad) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_UnpackMesh(V, ValAry, y%LineMeshPosition) ! Mesh + end select + end associate +end subroutine + function FEAM_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 05d64f81f6..92992e8f53 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -995,38 +995,52 @@ function Conv_Rdtn_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine Conv_Rdtn_PackContStateAry(Vars, x, ValAry) +subroutine Conv_Rdtn_VarsPackContState(Vars, x, ValAry) type(Conv_Rdtn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Conv_Rdtn_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine Conv_Rdtn_UnpackContStateAry(Vars, ValAry, x) +subroutine Conv_Rdtn_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate + call Conv_Rdtn_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine Conv_Rdtn_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Conv_Rdtn_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1038,55 +1052,76 @@ function Conv_Rdtn_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine Conv_Rdtn_PackContStateDerivAry(Vars, x, ValAry) +subroutine Conv_Rdtn_VarsPackContStateDeriv(Vars, x, ValAry) type(Conv_Rdtn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Conv_Rdtn_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine Conv_Rdtn_PackConstrStateAry(Vars, z, ValAry) +subroutine Conv_Rdtn_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsPackConstrState(Vars, z, ValAry) type(Conv_Rdtn_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Conv_Rdtn_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine Conv_Rdtn_UnpackConstrStateAry(Vars, ValAry, z) +subroutine Conv_Rdtn_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call Conv_Rdtn_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine Conv_Rdtn_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Conv_Rdtn_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1098,38 +1133,52 @@ function Conv_Rdtn_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine Conv_Rdtn_PackInputAry(Vars, u, ValAry) +subroutine Conv_Rdtn_VarsPackInput(Vars, u, ValAry) type(Conv_Rdtn_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_u_Velocity) - call MV_Pack(V, u%Velocity(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Conv_Rdtn_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine Conv_Rdtn_UnpackInputAry(Vars, ValAry, u) +subroutine Conv_Rdtn_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_u_Velocity) + VarVals = u%Velocity(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_u_Velocity) - call MV_Unpack(V, ValAry, u%Velocity(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call Conv_Rdtn_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine Conv_Rdtn_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_u_Velocity) + u%Velocity(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function Conv_Rdtn_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1141,38 +1190,52 @@ function Conv_Rdtn_InputFieldName(DL) result(Name) end select end function -subroutine Conv_Rdtn_PackOutputAry(Vars, y, ValAry) +subroutine Conv_Rdtn_VarsPackOutput(Vars, y, ValAry) type(Conv_Rdtn_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_y_F_Rdtn) - call MV_Pack(V, y%F_Rdtn(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Conv_Rdtn_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine Conv_Rdtn_UnpackOutputAry(Vars, ValAry, y) +subroutine Conv_Rdtn_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + VarVals = y%F_Rdtn(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Conv_Rdtn_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (Conv_Rdtn_y_F_Rdtn) - call MV_Unpack(V, ValAry, y%F_Rdtn(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call Conv_Rdtn_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine Conv_Rdtn_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + y%F_Rdtn(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function Conv_Rdtn_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 151eef9cfe..835fbb1b7f 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -1714,7 +1714,7 @@ SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, call HydroDyn_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Pack inputs into array - call HydroDyn_PackInputAry(Vars, u, m%Jac%u); if (Failed()) return + call HydroDyn_VarsPackInput(Vars, u, m%Jac%u); if (Failed()) return ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -1735,15 +1735,15 @@ SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call HydroDyn_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call HydroDyn_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call HydroDyn_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call HydroDyn_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 @@ -1914,7 +1914,7 @@ SUBROUTINE HD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Copy State values to perturb call HydroDyn_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackContStateAry(Vars, x, m%Jac%x) + call HydroDyn_VarsPackContState(Vars, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then @@ -1932,15 +1932,15 @@ SUBROUTINE HD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call HydroDyn_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call HydroDyn_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call HydroDyn_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call HydroDyn_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call HydroDyn_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index col = Vars%x(i)%iLoc(1) + j - 1 diff --git a/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 b/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 index a9cc5e2c77..5f50422861 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 @@ -804,7 +804,7 @@ SUBROUTINE SetHDInputs(time, n, u_HD, mappingData, drvrData, ErrStat, ErrMsg) integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message character(*), parameter :: RoutineName = 'SetHDInputs_Constant' - real(R8Ki) :: yInterp(size(drvrData%PRPin,2)) + real(R8Ki), allocatable :: yInterp(:) integer(intKi) :: indxHigh, indxMid, indxLow integer(intKi) :: i @@ -813,6 +813,10 @@ SUBROUTINE SetHDInputs(time, n, u_HD, mappingData, drvrData, ErrStat, ErrMsg) ! PRPInputsMod 2: Reads time series of positions, velocities, and accelerations for the platform reference point IF ( drvrData%PRPInputsMod == 2 ) THEN + + call AllocAry(yInterp, size(drvrData%PRPin,2), "yInterp", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InterpStpMat( time, drvrData%PRPinTime, drvrData%PRPin, mappingData%Ind, size(drvrData%PRPinTime), yInterp ) u_HD%PRPMesh%TranslationDisp(:,1) = yInterp(1:3) diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 26c5d7593b..48f94a6d4f 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -2632,50 +2632,64 @@ function HydroDyn_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine HydroDyn_PackContStateAry(Vars, x, ValAry) +subroutine HydroDyn_VarsPackContState(Vars, x, ValAry) type(HydroDyn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (HydroDyn_x_WAMIT_SS_Rdtn_x) - call MV_Pack(V, x%WAMIT(DL%i1)%SS_Rdtn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (HydroDyn_x_WAMIT_SS_Exctn_x) - call MV_Pack(V, x%WAMIT(DL%i1)%SS_Exctn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) - call MV_Pack(V, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState, ValAry) ! Scalar - case (HydroDyn_x_Morison_DummyContState) - call MV_Pack(V, x%Morison%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call HydroDyn_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine HydroDyn_UnpackContStateAry(Vars, ValAry, x) +subroutine HydroDyn_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + VarVals = x%WAMIT(DL%i1)%SS_Rdtn%x(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + VarVals = x%WAMIT(DL%i1)%SS_Exctn%x(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + VarVals(1) = x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState ! Scalar + case (HydroDyn_x_Morison_DummyContState) + VarVals(1) = x%Morison%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (HydroDyn_x_WAMIT_SS_Rdtn_x) - call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%SS_Rdtn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (HydroDyn_x_WAMIT_SS_Exctn_x) - call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%SS_Exctn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) - call MV_Unpack(V, ValAry, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState) ! Scalar - case (HydroDyn_x_Morison_DummyContState) - call MV_Unpack(V, ValAry, x%Morison%DummyContState) ! Scalar - end select - end associate + call HydroDyn_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine HydroDyn_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + x%WAMIT(DL%i1)%SS_Rdtn%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + x%WAMIT(DL%i1)%SS_Exctn%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState = VarVals(1) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + x%Morison%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function HydroDyn_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2693,73 +2707,94 @@ function HydroDyn_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine HydroDyn_PackContStateDerivAry(Vars, x, ValAry) +subroutine HydroDyn_VarsPackContStateDeriv(Vars, x, ValAry) type(HydroDyn_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (HydroDyn_x_WAMIT_SS_Rdtn_x) - call MV_Pack(V, x%WAMIT(DL%i1)%SS_Rdtn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (HydroDyn_x_WAMIT_SS_Exctn_x) - call MV_Pack(V, x%WAMIT(DL%i1)%SS_Exctn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) - call MV_Pack(V, x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState, ValAry) ! Scalar - case (HydroDyn_x_Morison_DummyContState) - call MV_Pack(V, x%Morison%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call HydroDyn_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine HydroDyn_PackConstrStateAry(Vars, z, ValAry) +subroutine HydroDyn_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + VarVals = x%WAMIT(DL%i1)%SS_Rdtn%x(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + VarVals = x%WAMIT(DL%i1)%SS_Exctn%x(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + VarVals(1) = x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState ! Scalar + case (HydroDyn_x_Morison_DummyContState) + VarVals(1) = x%Morison%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsPackConstrState(Vars, z, ValAry) type(HydroDyn_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) - call MV_Pack(V, z%WAMIT%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) - call MV_Pack(V, z%WAMIT%SS_Rdtn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) - call MV_Pack(V, z%WAMIT%SS_Exctn%DummyConstrState, ValAry) ! Scalar - case (HydroDyn_z_Morison_DummyConstrState) - call MV_Pack(V, z%Morison%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call HydroDyn_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine HydroDyn_UnpackConstrStateAry(Vars, ValAry, z) +subroutine HydroDyn_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + VarVals(1) = z%WAMIT%Conv_Rdtn%DummyConstrState ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + VarVals(1) = z%WAMIT%SS_Rdtn%DummyConstrState ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + VarVals(1) = z%WAMIT%SS_Exctn%DummyConstrState ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + VarVals(1) = z%Morison%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) - call MV_Unpack(V, ValAry, z%WAMIT%Conv_Rdtn%DummyConstrState) ! Scalar - case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) - call MV_Unpack(V, ValAry, z%WAMIT%SS_Rdtn%DummyConstrState) ! Scalar - case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) - call MV_Unpack(V, ValAry, z%WAMIT%SS_Exctn%DummyConstrState) ! Scalar - case (HydroDyn_z_Morison_DummyConstrState) - call MV_Unpack(V, ValAry, z%Morison%DummyConstrState) ! Scalar - end select - end associate + call HydroDyn_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine HydroDyn_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + z%WAMIT%Conv_Rdtn%DummyConstrState = VarVals(1) ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + z%WAMIT%SS_Rdtn%DummyConstrState = VarVals(1) ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + z%WAMIT%SS_Exctn%DummyConstrState = VarVals(1) ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + z%Morison%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function HydroDyn_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2777,46 +2812,60 @@ function HydroDyn_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine HydroDyn_PackInputAry(Vars, u, ValAry) +subroutine HydroDyn_VarsPackInput(Vars, u, ValAry) type(HydroDyn_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (HydroDyn_u_Morison_Mesh) - call MV_Pack(V, u%Morison%Mesh, ValAry) ! Mesh - case (HydroDyn_u_WAMITMesh) - call MV_Pack(V, u%WAMITMesh, ValAry) ! Mesh - case (HydroDyn_u_PRPMesh) - call MV_Pack(V, u%PRPMesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call HydroDyn_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine HydroDyn_UnpackInputAry(Vars, ValAry, u) +subroutine HydroDyn_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_PackMesh(V, u%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_u_WAMITMesh) + call MV_PackMesh(V, u%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_PackMesh(V, u%PRPMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (HydroDyn_u_Morison_Mesh) - call MV_Unpack(V, ValAry, u%Morison%Mesh) ! Mesh - case (HydroDyn_u_WAMITMesh) - call MV_Unpack(V, ValAry, u%WAMITMesh) ! Mesh - case (HydroDyn_u_PRPMesh) - call MV_Unpack(V, ValAry, u%PRPMesh) ! Mesh - end select - end associate + call HydroDyn_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine HydroDyn_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_UnpackMesh(V, ValAry, u%Morison%Mesh) ! Mesh + case (HydroDyn_u_WAMITMesh) + call MV_UnpackMesh(V, ValAry, u%WAMITMesh) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_UnpackMesh(V, ValAry, u%PRPMesh) ! Mesh + end select + end associate +end subroutine + function HydroDyn_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2832,62 +2881,76 @@ function HydroDyn_InputFieldName(DL) result(Name) end select end function -subroutine HydroDyn_PackOutputAry(Vars, y, ValAry) +subroutine HydroDyn_VarsPackOutput(Vars, y, ValAry) type(HydroDyn_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (HydroDyn_y_WAMIT_Mesh) - call MV_Pack(V, y%WAMIT(DL%i1)%Mesh, ValAry) ! Mesh - case (HydroDyn_y_WAMIT2_Mesh) - call MV_Pack(V, y%WAMIT2(DL%i1)%Mesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_Mesh) - call MV_Pack(V, y%Morison%Mesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_VisMesh) - call MV_Pack(V, y%Morison%VisMesh, ValAry) ! Mesh - case (HydroDyn_y_Morison_WriteOutput) - call MV_Pack(V, y%Morison%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (HydroDyn_y_WAMITMesh) - call MV_Pack(V, y%WAMITMesh, ValAry) ! Mesh - case (HydroDyn_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call HydroDyn_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine HydroDyn_UnpackOutputAry(Vars, ValAry, y) +subroutine HydroDyn_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_PackMesh(V, y%WAMIT(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_PackMesh(V, y%WAMIT2(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_PackMesh(V, y%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_PackMesh(V, y%Morison%VisMesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + VarVals = y%Morison%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_PackMesh(V, y%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(HydroDyn_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (HydroDyn_y_WAMIT_Mesh) - call MV_Unpack(V, ValAry, y%WAMIT(DL%i1)%Mesh) ! Mesh - case (HydroDyn_y_WAMIT2_Mesh) - call MV_Unpack(V, ValAry, y%WAMIT2(DL%i1)%Mesh) ! Mesh - case (HydroDyn_y_Morison_Mesh) - call MV_Unpack(V, ValAry, y%Morison%Mesh) ! Mesh - case (HydroDyn_y_Morison_VisMesh) - call MV_Unpack(V, ValAry, y%Morison%VisMesh) ! Mesh - case (HydroDyn_y_Morison_WriteOutput) - call MV_Unpack(V, ValAry, y%Morison%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (HydroDyn_y_WAMITMesh) - call MV_Unpack(V, ValAry, y%WAMITMesh) ! Mesh - case (HydroDyn_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call HydroDyn_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine HydroDyn_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_UnpackMesh(V, ValAry, y%WAMIT(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_UnpackMesh(V, ValAry, y%WAMIT2(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_UnpackMesh(V, ValAry, y%Morison%Mesh) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_UnpackMesh(V, ValAry, y%Morison%VisMesh) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + y%Morison%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_UnpackMesh(V, ValAry, y%WAMITMesh) ! Mesh + case (HydroDyn_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function HydroDyn_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index b35f1f4809..b67b53cea4 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -4689,38 +4689,52 @@ function Morison_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine Morison_PackContStateAry(Vars, x, ValAry) +subroutine Morison_VarsPackContState(Vars, x, ValAry) type(Morison_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Morison_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Morison_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine Morison_UnpackContStateAry(Vars, ValAry, x) +subroutine Morison_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Morison_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Morison_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate + call Morison_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine Morison_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Morison_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4732,55 +4746,76 @@ function Morison_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine Morison_PackContStateDerivAry(Vars, x, ValAry) +subroutine Morison_VarsPackContStateDeriv(Vars, x, ValAry) type(Morison_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Morison_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Morison_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine Morison_PackConstrStateAry(Vars, z, ValAry) +subroutine Morison_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsPackConstrState(Vars, z, ValAry) type(Morison_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (Morison_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Morison_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine Morison_UnpackConstrStateAry(Vars, ValAry, z) +subroutine Morison_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Morison_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (Morison_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call Morison_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine Morison_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Morison_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4792,38 +4827,52 @@ function Morison_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine Morison_PackInputAry(Vars, u, ValAry) +subroutine Morison_VarsPackInput(Vars, u, ValAry) type(Morison_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (Morison_u_Mesh) - call MV_Pack(V, u%Mesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Morison_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine Morison_UnpackInputAry(Vars, ValAry, u) +subroutine Morison_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_u_Mesh) + call MV_PackMesh(V, u%Mesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Morison_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (Morison_u_Mesh) - call MV_Unpack(V, ValAry, u%Mesh) ! Mesh - end select - end associate + call Morison_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine Morison_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_u_Mesh) + call MV_UnpackMesh(V, ValAry, u%Mesh) ! Mesh + end select + end associate +end subroutine + function Morison_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4835,46 +4884,60 @@ function Morison_InputFieldName(DL) result(Name) end select end function -subroutine Morison_PackOutputAry(Vars, y, ValAry) +subroutine Morison_VarsPackOutput(Vars, y, ValAry) type(Morison_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (Morison_y_Mesh) - call MV_Pack(V, y%Mesh, ValAry) ! Mesh - case (Morison_y_VisMesh) - call MV_Pack(V, y%VisMesh, ValAry) ! Mesh - case (Morison_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Morison_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine Morison_UnpackOutputAry(Vars, ValAry, y) +subroutine Morison_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_y_Mesh) + call MV_PackMesh(V, y%Mesh, ValAry) ! Mesh + case (Morison_y_VisMesh) + call MV_PackMesh(V, y%VisMesh, ValAry) ! Mesh + case (Morison_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Morison_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (Morison_y_Mesh) - call MV_Unpack(V, ValAry, y%Mesh) ! Mesh - case (Morison_y_VisMesh) - call MV_Unpack(V, ValAry, y%VisMesh) ! Mesh - case (Morison_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call Morison_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine Morison_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_y_Mesh) + call MV_UnpackMesh(V, ValAry, y%Mesh) ! Mesh + case (Morison_y_VisMesh) + call MV_UnpackMesh(V, ValAry, y%VisMesh) ! Mesh + case (Morison_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function Morison_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index c6585501e6..4459e057da 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -1176,38 +1176,52 @@ function SS_Exc_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine SS_Exc_PackContStateAry(Vars, x, ValAry) +subroutine SS_Exc_VarsPackContState(Vars, x, ValAry) type(SS_Exc_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SS_Exc_x_x) - call MV_Pack(V, x%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Exc_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine SS_Exc_UnpackContStateAry(Vars, ValAry, x) +subroutine SS_Exc_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_x_x) + VarVals = x%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SS_Exc_x_x) - call MV_Unpack(V, ValAry, x%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SS_Exc_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine SS_Exc_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_x_x) + x%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SS_Exc_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1219,55 +1233,76 @@ function SS_Exc_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine SS_Exc_PackContStateDerivAry(Vars, x, ValAry) +subroutine SS_Exc_VarsPackContStateDeriv(Vars, x, ValAry) type(SS_Exc_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SS_Exc_x_x) - call MV_Pack(V, x%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Exc_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine SS_Exc_PackConstrStateAry(Vars, z, ValAry) +subroutine SS_Exc_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_x_x) + VarVals = x%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsPackConstrState(Vars, z, ValAry) type(SS_Exc_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SS_Exc_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Exc_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine SS_Exc_UnpackConstrStateAry(Vars, ValAry, z) +subroutine SS_Exc_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SS_Exc_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call SS_Exc_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine SS_Exc_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SS_Exc_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1279,38 +1314,52 @@ function SS_Exc_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine SS_Exc_PackInputAry(Vars, u, ValAry) +subroutine SS_Exc_VarsPackInput(Vars, u, ValAry) type(SS_Exc_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SS_Exc_u_PtfmPos) - call MV_Pack(V, u%PtfmPos(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Exc_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine SS_Exc_UnpackInputAry(Vars, ValAry, u) +subroutine SS_Exc_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_u_PtfmPos) + VarVals = u%PtfmPos(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SS_Exc_u_PtfmPos) - call MV_Unpack(V, ValAry, u%PtfmPos(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call SS_Exc_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine SS_Exc_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_u_PtfmPos) + u%PtfmPos(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function SS_Exc_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1322,42 +1371,56 @@ function SS_Exc_InputFieldName(DL) result(Name) end select end function -subroutine SS_Exc_PackOutputAry(Vars, y, ValAry) +subroutine SS_Exc_VarsPackOutput(Vars, y, ValAry) type(SS_Exc_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SS_Exc_y_y) - call MV_Pack(V, y%y(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SS_Exc_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Exc_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine SS_Exc_UnpackOutputAry(Vars, ValAry, y) +subroutine SS_Exc_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_y_y) + VarVals = y%y(V%iLB:V%iUB) ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Exc_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SS_Exc_y_y) - call MV_Unpack(V, ValAry, y%y(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SS_Exc_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SS_Exc_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine SS_Exc_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_y_y) + y%y(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SS_Exc_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index d09e0c5cd3..3f9c769378 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -1097,38 +1097,52 @@ function SS_Rad_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine SS_Rad_PackContStateAry(Vars, x, ValAry) +subroutine SS_Rad_VarsPackContState(Vars, x, ValAry) type(SS_Rad_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SS_Rad_x_x) - call MV_Pack(V, x%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Rad_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine SS_Rad_UnpackContStateAry(Vars, ValAry, x) +subroutine SS_Rad_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_x_x) + VarVals = x%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SS_Rad_x_x) - call MV_Unpack(V, ValAry, x%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SS_Rad_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine SS_Rad_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_x_x) + x%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SS_Rad_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1140,55 +1154,76 @@ function SS_Rad_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine SS_Rad_PackContStateDerivAry(Vars, x, ValAry) +subroutine SS_Rad_VarsPackContStateDeriv(Vars, x, ValAry) type(SS_Rad_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SS_Rad_x_x) - call MV_Pack(V, x%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Rad_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine SS_Rad_PackConstrStateAry(Vars, z, ValAry) +subroutine SS_Rad_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_x_x) + VarVals = x%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsPackConstrState(Vars, z, ValAry) type(SS_Rad_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SS_Rad_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Rad_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine SS_Rad_UnpackConstrStateAry(Vars, ValAry, z) +subroutine SS_Rad_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SS_Rad_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call SS_Rad_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine SS_Rad_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SS_Rad_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1200,38 +1235,52 @@ function SS_Rad_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine SS_Rad_PackInputAry(Vars, u, ValAry) +subroutine SS_Rad_VarsPackInput(Vars, u, ValAry) type(SS_Rad_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SS_Rad_u_dq) - call MV_Pack(V, u%dq(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Rad_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine SS_Rad_UnpackInputAry(Vars, ValAry, u) +subroutine SS_Rad_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_u_dq) + VarVals = u%dq(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SS_Rad_u_dq) - call MV_Unpack(V, ValAry, u%dq(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SS_Rad_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine SS_Rad_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_u_dq) + u%dq(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SS_Rad_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1243,42 +1292,56 @@ function SS_Rad_InputFieldName(DL) result(Name) end select end function -subroutine SS_Rad_PackOutputAry(Vars, y, ValAry) +subroutine SS_Rad_VarsPackOutput(Vars, y, ValAry) type(SS_Rad_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SS_Rad_y_y) - call MV_Pack(V, y%y(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SS_Rad_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SS_Rad_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine SS_Rad_UnpackOutputAry(Vars, ValAry, y) +subroutine SS_Rad_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_y_y) + VarVals = y%y(V%iLB:V%iUB) ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SS_Rad_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SS_Rad_y_y) - call MV_Unpack(V, ValAry, y%y(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SS_Rad_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SS_Rad_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine SS_Rad_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_y_y) + y%y(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SS_Rad_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index e4d87d5bb9..bbccd7ebf6 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -645,38 +645,52 @@ function WAMIT2_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine WAMIT2_PackOutputAry(Vars, y, ValAry) +subroutine WAMIT2_VarsPackOutput(Vars, y, ValAry) type(WAMIT2_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (WAMIT2_y_Mesh) - call MV_Pack(V, y%Mesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WAMIT2_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine WAMIT2_UnpackOutputAry(Vars, ValAry, y) +subroutine WAMIT2_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT2_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT2_y_Mesh) + call MV_PackMesh(V, y%Mesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT2_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT2_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (WAMIT2_y_Mesh) - call MV_Unpack(V, ValAry, y%Mesh) ! Mesh - end select - end associate + call WAMIT2_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine WAMIT2_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT2_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT2_y_Mesh) + call MV_UnpackMesh(V, ValAry, y%Mesh) ! Mesh + end select + end associate +end subroutine + function WAMIT2_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index a1299a79af..4e1aa5307c 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -1456,46 +1456,60 @@ function WAMIT_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine WAMIT_PackContStateAry(Vars, x, ValAry) +subroutine WAMIT_VarsPackContState(Vars, x, ValAry) type(WAMIT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (WAMIT_x_SS_Rdtn_x) - call MV_Pack(V, x%SS_Rdtn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WAMIT_x_SS_Exctn_x) - call MV_Pack(V, x%SS_Exctn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WAMIT_x_Conv_Rdtn_DummyContState) - call MV_Pack(V, x%Conv_Rdtn%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WAMIT_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine WAMIT_UnpackContStateAry(Vars, ValAry, x) +subroutine WAMIT_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + VarVals = x%SS_Rdtn%x(V%iLB:V%iUB) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + VarVals = x%SS_Exctn%x(V%iLB:V%iUB) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + VarVals(1) = x%Conv_Rdtn%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (WAMIT_x_SS_Rdtn_x) - call MV_Unpack(V, ValAry, x%SS_Rdtn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WAMIT_x_SS_Exctn_x) - call MV_Unpack(V, ValAry, x%SS_Exctn%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WAMIT_x_Conv_Rdtn_DummyContState) - call MV_Unpack(V, ValAry, x%Conv_Rdtn%DummyContState) ! Scalar - end select - end associate + call WAMIT_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine WAMIT_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + x%SS_Rdtn%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + x%SS_Exctn%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + x%Conv_Rdtn%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function WAMIT_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1511,67 +1525,88 @@ function WAMIT_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine WAMIT_PackContStateDerivAry(Vars, x, ValAry) +subroutine WAMIT_VarsPackContStateDeriv(Vars, x, ValAry) type(WAMIT_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (WAMIT_x_SS_Rdtn_x) - call MV_Pack(V, x%SS_Rdtn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WAMIT_x_SS_Exctn_x) - call MV_Pack(V, x%SS_Exctn%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WAMIT_x_Conv_Rdtn_DummyContState) - call MV_Pack(V, x%Conv_Rdtn%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WAMIT_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine WAMIT_PackConstrStateAry(Vars, z, ValAry) +subroutine WAMIT_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + VarVals = x%SS_Rdtn%x(V%iLB:V%iUB) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + VarVals = x%SS_Exctn%x(V%iLB:V%iUB) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + VarVals(1) = x%Conv_Rdtn%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsPackConstrState(Vars, z, ValAry) type(WAMIT_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (WAMIT_z_Conv_Rdtn_DummyConstrState) - call MV_Pack(V, z%Conv_Rdtn%DummyConstrState, ValAry) ! Scalar - case (WAMIT_z_SS_Rdtn_DummyConstrState) - call MV_Pack(V, z%SS_Rdtn%DummyConstrState, ValAry) ! Scalar - case (WAMIT_z_SS_Exctn_DummyConstrState) - call MV_Pack(V, z%SS_Exctn%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WAMIT_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine WAMIT_UnpackConstrStateAry(Vars, ValAry, z) +subroutine WAMIT_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + VarVals(1) = z%Conv_Rdtn%DummyConstrState ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + VarVals(1) = z%SS_Rdtn%DummyConstrState ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + VarVals(1) = z%SS_Exctn%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (WAMIT_z_Conv_Rdtn_DummyConstrState) - call MV_Unpack(V, ValAry, z%Conv_Rdtn%DummyConstrState) ! Scalar - case (WAMIT_z_SS_Rdtn_DummyConstrState) - call MV_Unpack(V, ValAry, z%SS_Rdtn%DummyConstrState) ! Scalar - case (WAMIT_z_SS_Exctn_DummyConstrState) - call MV_Unpack(V, ValAry, z%SS_Exctn%DummyConstrState) ! Scalar - end select - end associate + call WAMIT_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine WAMIT_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + z%Conv_Rdtn%DummyConstrState = VarVals(1) ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + z%SS_Rdtn%DummyConstrState = VarVals(1) ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + z%SS_Exctn%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function WAMIT_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1587,38 +1622,52 @@ function WAMIT_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine WAMIT_PackInputAry(Vars, u, ValAry) +subroutine WAMIT_VarsPackInput(Vars, u, ValAry) type(WAMIT_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (WAMIT_u_Mesh) - call MV_Pack(V, u%Mesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WAMIT_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine WAMIT_UnpackInputAry(Vars, ValAry, u) +subroutine WAMIT_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_u_Mesh) + call MV_PackMesh(V, u%Mesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (WAMIT_u_Mesh) - call MV_Unpack(V, ValAry, u%Mesh) ! Mesh - end select - end associate + call WAMIT_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine WAMIT_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_u_Mesh) + call MV_UnpackMesh(V, ValAry, u%Mesh) ! Mesh + end select + end associate +end subroutine + function WAMIT_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1630,38 +1679,52 @@ function WAMIT_InputFieldName(DL) result(Name) end select end function -subroutine WAMIT_PackOutputAry(Vars, y, ValAry) +subroutine WAMIT_VarsPackOutput(Vars, y, ValAry) type(WAMIT_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (WAMIT_y_Mesh) - call MV_Pack(V, y%Mesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WAMIT_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine WAMIT_UnpackOutputAry(Vars, ValAry, y) +subroutine WAMIT_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_y_Mesh) + call MV_PackMesh(V, y%Mesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WAMIT_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (WAMIT_y_Mesh) - call MV_Unpack(V, ValAry, y%Mesh) ! Mesh - end select - end associate + call WAMIT_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine WAMIT_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_y_Mesh) + call MV_UnpackMesh(V, ValAry, y%Mesh) ! Mesh + end select + end associate +end subroutine + function WAMIT_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index bf8ebc01bd..3a10f6903e 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -1769,42 +1769,56 @@ function IceD_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine IceD_PackContStateAry(Vars, x, ValAry) +subroutine IceD_VarsPackContState(Vars, x, ValAry) type(IceD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (IceD_x_q) - call MV_Pack(V, x%q, ValAry) ! Scalar - case (IceD_x_dqdt) - call MV_Pack(V, x%dqdt, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceD_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine IceD_UnpackContStateAry(Vars, ValAry, x) +subroutine IceD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_x_q) + VarVals(1) = x%q ! Scalar + case (IceD_x_dqdt) + VarVals(1) = x%dqdt ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (IceD_x_q) - call MV_Unpack(V, ValAry, x%q) ! Scalar - case (IceD_x_dqdt) - call MV_Unpack(V, ValAry, x%dqdt) ! Scalar - end select - end associate + call IceD_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine IceD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_x_q) + x%q = VarVals(1) ! Scalar + case (IceD_x_dqdt) + x%dqdt = VarVals(1) ! Scalar + end select + end associate +end subroutine + function IceD_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1818,57 +1832,78 @@ function IceD_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine IceD_PackContStateDerivAry(Vars, x, ValAry) +subroutine IceD_VarsPackContStateDeriv(Vars, x, ValAry) type(IceD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (IceD_x_q) - call MV_Pack(V, x%q, ValAry) ! Scalar - case (IceD_x_dqdt) - call MV_Pack(V, x%dqdt, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceD_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine IceD_PackConstrStateAry(Vars, z, ValAry) +subroutine IceD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_x_q) + VarVals(1) = x%q ! Scalar + case (IceD_x_dqdt) + VarVals(1) = x%dqdt ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsPackConstrState(Vars, z, ValAry) type(IceD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (IceD_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceD_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine IceD_UnpackConstrStateAry(Vars, ValAry, z) +subroutine IceD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (IceD_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call IceD_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine IceD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function IceD_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1880,38 +1915,52 @@ function IceD_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine IceD_PackInputAry(Vars, u, ValAry) +subroutine IceD_VarsPackInput(Vars, u, ValAry) type(IceD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (IceD_u_PointMesh) - call MV_Pack(V, u%PointMesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceD_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine IceD_UnpackInputAry(Vars, ValAry, u) +subroutine IceD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_u_PointMesh) + call MV_PackMesh(V, u%PointMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (IceD_u_PointMesh) - call MV_Unpack(V, ValAry, u%PointMesh) ! Mesh - end select - end associate + call IceD_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine IceD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_u_PointMesh) + call MV_UnpackMesh(V, ValAry, u%PointMesh) ! Mesh + end select + end associate +end subroutine + function IceD_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1923,42 +1972,56 @@ function IceD_InputFieldName(DL) result(Name) end select end function -subroutine IceD_PackOutputAry(Vars, y, ValAry) +subroutine IceD_VarsPackOutput(Vars, y, ValAry) type(IceD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (IceD_y_PointMesh) - call MV_Pack(V, y%PointMesh, ValAry) ! Mesh - case (IceD_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceD_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine IceD_UnpackOutputAry(Vars, ValAry, y) +subroutine IceD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_y_PointMesh) + call MV_PackMesh(V, y%PointMesh, ValAry) ! Mesh + case (IceD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (IceD_y_PointMesh) - call MV_Unpack(V, ValAry, y%PointMesh) ! Mesh - case (IceD_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call IceD_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine IceD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_y_PointMesh) + call MV_UnpackMesh(V, ValAry, y%PointMesh) ! Mesh + case (IceD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function IceD_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index afb26f4e20..61ec75f176 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -1050,38 +1050,52 @@ function IceFloe_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine IceFloe_PackContStateAry(Vars, x, ValAry) +subroutine IceFloe_VarsPackContState(Vars, x, ValAry) type(IceFloe_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (IceFloe_x_DummyContStateVar) - call MV_Pack(V, x%DummyContStateVar, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceFloe_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine IceFloe_UnpackContStateAry(Vars, ValAry, x) +subroutine IceFloe_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + VarVals(1) = x%DummyContStateVar ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (IceFloe_x_DummyContStateVar) - call MV_Unpack(V, ValAry, x%DummyContStateVar) ! Scalar - end select - end associate + call IceFloe_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine IceFloe_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + x%DummyContStateVar = VarVals(1) ! Scalar + end select + end associate +end subroutine + function IceFloe_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1093,55 +1107,76 @@ function IceFloe_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine IceFloe_PackContStateDerivAry(Vars, x, ValAry) +subroutine IceFloe_VarsPackContStateDeriv(Vars, x, ValAry) type(IceFloe_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (IceFloe_x_DummyContStateVar) - call MV_Pack(V, x%DummyContStateVar, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceFloe_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine IceFloe_PackConstrStateAry(Vars, z, ValAry) +subroutine IceFloe_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + VarVals(1) = x%DummyContStateVar ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsPackConstrState(Vars, z, ValAry) type(IceFloe_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (IceFloe_z_DummyConstrStateVar) - call MV_Pack(V, z%DummyConstrStateVar, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceFloe_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine IceFloe_UnpackConstrStateAry(Vars, ValAry, z) +subroutine IceFloe_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_z_DummyConstrStateVar) + VarVals(1) = z%DummyConstrStateVar ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (IceFloe_z_DummyConstrStateVar) - call MV_Unpack(V, ValAry, z%DummyConstrStateVar) ! Scalar - end select - end associate + call IceFloe_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine IceFloe_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_z_DummyConstrStateVar) + z%DummyConstrStateVar = VarVals(1) ! Scalar + end select + end associate +end subroutine + function IceFloe_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1153,38 +1188,52 @@ function IceFloe_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine IceFloe_PackInputAry(Vars, u, ValAry) +subroutine IceFloe_VarsPackInput(Vars, u, ValAry) type(IceFloe_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (IceFloe_u_iceMesh) - call MV_Pack(V, u%iceMesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceFloe_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine IceFloe_UnpackInputAry(Vars, ValAry, u) +subroutine IceFloe_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_u_iceMesh) + call MV_PackMesh(V, u%iceMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (IceFloe_u_iceMesh) - call MV_Unpack(V, ValAry, u%iceMesh) ! Mesh - end select - end associate + call IceFloe_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine IceFloe_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_u_iceMesh) + call MV_UnpackMesh(V, ValAry, u%iceMesh) ! Mesh + end select + end associate +end subroutine + function IceFloe_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1196,42 +1245,56 @@ function IceFloe_InputFieldName(DL) result(Name) end select end function -subroutine IceFloe_PackOutputAry(Vars, y, ValAry) +subroutine IceFloe_VarsPackOutput(Vars, y, ValAry) type(IceFloe_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (IceFloe_y_iceMesh) - call MV_Pack(V, y%iceMesh, ValAry) ! Mesh - case (IceFloe_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call IceFloe_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine IceFloe_UnpackOutputAry(Vars, ValAry, y) +subroutine IceFloe_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_y_iceMesh) + call MV_PackMesh(V, y%iceMesh, ValAry) ! Mesh + case (IceFloe_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(IceFloe_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (IceFloe_y_iceMesh) - call MV_Unpack(V, ValAry, y%iceMesh) ! Mesh - case (IceFloe_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call IceFloe_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine IceFloe_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_y_iceMesh) + call MV_UnpackMesh(V, ValAry, y%iceMesh) ! Mesh + case (IceFloe_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function IceFloe_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index 15cf43a747..12e359cf6b 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -1062,13 +1062,13 @@ subroutine InflowWind_PackExtInputAry(Vars, t, p, ValAry) select case(Var%DL%Num) case (InflowWind_u_HWindSpeed) call CalcExtOP() - call MV_Pack(Var, op%VelH, ValAry) + ValAry(Var%iLoc(1)) = op%VelH case (InflowWind_u_PLExp) call CalcExtOP() - call MV_Pack(Var, op%ShrV, ValAry) + ValAry(Var%iLoc(1)) = op%ShrV case (InflowWind_u_PropagationDir) call CalcExtOP() - call MV_Pack(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + ValAry(Var%iLoc(1)) = op%AngleH + p%FlowField%PropagationDir end select end associate end do @@ -1104,13 +1104,13 @@ subroutine InflowWind_PackExtOutputAry(Vars, t, p, ValAry) select case(Var%DL%Num) case (InflowWind_y_HWindSpeed) call CalcExtOP() - call MV_Pack(Var, op%VelH, ValAry) + ValAry(Var%iLoc(1)) = op%VelH case (InflowWind_y_PLExp) call CalcExtOP() - call MV_Pack(Var, op%ShrV, ValAry) + ValAry(Var%iLoc(1)) = op%ShrV case (InflowWind_y_PropagationDir) call CalcExtOP() - call MV_Pack(Var, op%AngleH + p%FlowField%PropagationDir, ValAry) + ValAry(Var%iLoc(1)) = op%AngleH + p%FlowField%PropagationDir end select end associate end do diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index c9d9c4e2ba..a900b921c2 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -1918,38 +1918,52 @@ function InflowWind_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine InflowWind_PackContStateAry(Vars, x, ValAry) +subroutine InflowWind_VarsPackContState(Vars, x, ValAry) type(InflowWind_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (InflowWind_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call InflowWind_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine InflowWind_UnpackContStateAry(Vars, ValAry, x) +subroutine InflowWind_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (InflowWind_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate + call InflowWind_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine InflowWind_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function InflowWind_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1961,55 +1975,76 @@ function InflowWind_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine InflowWind_PackContStateDerivAry(Vars, x, ValAry) +subroutine InflowWind_VarsPackContStateDeriv(Vars, x, ValAry) type(InflowWind_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (InflowWind_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call InflowWind_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine InflowWind_PackConstrStateAry(Vars, z, ValAry) +subroutine InflowWind_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsPackConstrState(Vars, z, ValAry) type(InflowWind_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (InflowWind_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call InflowWind_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine InflowWind_UnpackConstrStateAry(Vars, ValAry, z) +subroutine InflowWind_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (InflowWind_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call InflowWind_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine InflowWind_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function InflowWind_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2021,66 +2056,80 @@ function InflowWind_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine InflowWind_PackInputAry(Vars, u, ValAry) +subroutine InflowWind_VarsPackInput(Vars, u, ValAry) type(InflowWind_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (InflowWind_u_PositionXYZ) - call MV_Pack(V, u%PositionXYZ(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (InflowWind_u_lidar_PulseLidEl) - call MV_Pack(V, u%lidar%PulseLidEl, ValAry) ! Scalar - case (InflowWind_u_lidar_PulseLidAz) - call MV_Pack(V, u%lidar%PulseLidAz, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementX) - call MV_Pack(V, u%lidar%HubDisplacementX, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementY) - call MV_Pack(V, u%lidar%HubDisplacementY, ValAry) ! Scalar - case (InflowWind_u_lidar_HubDisplacementZ) - call MV_Pack(V, u%lidar%HubDisplacementZ, ValAry) ! Scalar - case (InflowWind_u_HubPosition) - call MV_Pack(V, u%HubPosition(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (InflowWind_u_HubOrientation) - call MV_Pack(V, u%HubOrientation(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call InflowWind_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine InflowWind_UnpackInputAry(Vars, ValAry, u) +subroutine InflowWind_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_u_PositionXYZ) + VarVals = u%PositionXYZ(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + VarVals(1) = u%lidar%PulseLidEl ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + VarVals(1) = u%lidar%PulseLidAz ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + VarVals(1) = u%lidar%HubDisplacementX ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + VarVals(1) = u%lidar%HubDisplacementY ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + VarVals(1) = u%lidar%HubDisplacementZ ! Scalar + case (InflowWind_u_HubPosition) + VarVals = u%HubPosition(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_u_HubOrientation) + VarVals = u%HubOrientation(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (InflowWind_u_PositionXYZ) - call MV_Unpack(V, ValAry, u%PositionXYZ(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (InflowWind_u_lidar_PulseLidEl) - call MV_Unpack(V, ValAry, u%lidar%PulseLidEl) ! Scalar - case (InflowWind_u_lidar_PulseLidAz) - call MV_Unpack(V, ValAry, u%lidar%PulseLidAz) ! Scalar - case (InflowWind_u_lidar_HubDisplacementX) - call MV_Unpack(V, ValAry, u%lidar%HubDisplacementX) ! Scalar - case (InflowWind_u_lidar_HubDisplacementY) - call MV_Unpack(V, ValAry, u%lidar%HubDisplacementY) ! Scalar - case (InflowWind_u_lidar_HubDisplacementZ) - call MV_Unpack(V, ValAry, u%lidar%HubDisplacementZ) ! Scalar - case (InflowWind_u_HubPosition) - call MV_Unpack(V, ValAry, u%HubPosition(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (InflowWind_u_HubOrientation) - call MV_Unpack(V, ValAry, u%HubOrientation(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call InflowWind_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine InflowWind_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_u_PositionXYZ) + u%PositionXYZ(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + u%lidar%PulseLidEl = VarVals(1) ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + u%lidar%PulseLidAz = VarVals(1) ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + u%lidar%HubDisplacementX = VarVals(1) ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + u%lidar%HubDisplacementY = VarVals(1) ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + u%lidar%HubDisplacementZ = VarVals(1) ! Scalar + case (InflowWind_u_HubPosition) + u%HubPosition(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_u_HubOrientation) + u%HubOrientation(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function InflowWind_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2106,74 +2155,88 @@ function InflowWind_InputFieldName(DL) result(Name) end select end function -subroutine InflowWind_PackOutputAry(Vars, y, ValAry) +subroutine InflowWind_VarsPackOutput(Vars, y, ValAry) type(InflowWind_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (InflowWind_y_VelocityUVW) - call MV_Pack(V, y%VelocityUVW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (InflowWind_y_AccelUVW) - call MV_Pack(V, y%AccelUVW(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (InflowWind_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (InflowWind_y_DiskVel) - call MV_Pack(V, y%DiskVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (InflowWind_y_HubVel) - call MV_Pack(V, y%HubVel(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_LidSpeed) - call MV_Pack(V, y%lidar%LidSpeed(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_WtTrunc) - call MV_Pack(V, y%lidar%WtTrunc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsX) - call MV_Pack(V, y%lidar%MsrPositionsX(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsY) - call MV_Pack(V, y%lidar%MsrPositionsY(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsZ) - call MV_Pack(V, y%lidar%MsrPositionsZ(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call InflowWind_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine InflowWind_UnpackOutputAry(Vars, ValAry, y) +subroutine InflowWind_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_y_VelocityUVW) + VarVals = y%VelocityUVW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (InflowWind_y_AccelUVW) + VarVals = y%AccelUVW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (InflowWind_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_DiskVel) + VarVals = y%DiskVel(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_HubVel) + VarVals = y%HubVel(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + VarVals = y%lidar%LidSpeed(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + VarVals = y%lidar%WtTrunc(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + VarVals = y%lidar%MsrPositionsX(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + VarVals = y%lidar%MsrPositionsY(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + VarVals = y%lidar%MsrPositionsZ(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(InflowWind_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (InflowWind_y_VelocityUVW) - call MV_Unpack(V, ValAry, y%VelocityUVW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (InflowWind_y_AccelUVW) - call MV_Unpack(V, ValAry, y%AccelUVW(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (InflowWind_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (InflowWind_y_DiskVel) - call MV_Unpack(V, ValAry, y%DiskVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (InflowWind_y_HubVel) - call MV_Unpack(V, ValAry, y%HubVel(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (InflowWind_y_lidar_LidSpeed) - call MV_Unpack(V, ValAry, y%lidar%LidSpeed(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (InflowWind_y_lidar_WtTrunc) - call MV_Unpack(V, ValAry, y%lidar%WtTrunc(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsX) - call MV_Unpack(V, ValAry, y%lidar%MsrPositionsX(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsY) - call MV_Unpack(V, ValAry, y%lidar%MsrPositionsY(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (InflowWind_y_lidar_MsrPositionsZ) - call MV_Unpack(V, ValAry, y%lidar%MsrPositionsZ(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call InflowWind_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine InflowWind_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_y_VelocityUVW) + y%VelocityUVW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (InflowWind_y_AccelUVW) + y%AccelUVW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (InflowWind_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_DiskVel) + y%DiskVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_HubVel) + y%HubVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + y%lidar%LidSpeed(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + y%lidar%WtTrunc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + y%lidar%MsrPositionsX(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + y%lidar%MsrPositionsY(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + y%lidar%MsrPositionsZ(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function InflowWind_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index f9aa0330ab..001121953e 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -1128,38 +1128,52 @@ function Lidar_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine Lidar_PackContStateAry(Vars, x, ValAry) +subroutine Lidar_VarsPackContState(Vars, x, ValAry) type(Lidar_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Lidar_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Lidar_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine Lidar_UnpackContStateAry(Vars, ValAry, x) +subroutine Lidar_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Lidar_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Lidar_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate + call Lidar_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine Lidar_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Lidar_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1171,55 +1185,76 @@ function Lidar_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine Lidar_PackContStateDerivAry(Vars, x, ValAry) +subroutine Lidar_VarsPackContStateDeriv(Vars, x, ValAry) type(Lidar_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Lidar_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Lidar_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine Lidar_PackConstrStateAry(Vars, z, ValAry) +subroutine Lidar_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsPackConstrState(Vars, z, ValAry) type(Lidar_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (Lidar_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Lidar_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine Lidar_UnpackConstrStateAry(Vars, ValAry, z) +subroutine Lidar_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Lidar_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (Lidar_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call Lidar_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine Lidar_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Lidar_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1231,54 +1266,68 @@ function Lidar_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine Lidar_PackInputAry(Vars, u, ValAry) +subroutine Lidar_VarsPackInput(Vars, u, ValAry) type(Lidar_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (Lidar_u_PulseLidEl) - call MV_Pack(V, u%PulseLidEl, ValAry) ! Scalar - case (Lidar_u_PulseLidAz) - call MV_Pack(V, u%PulseLidAz, ValAry) ! Scalar - case (Lidar_u_HubDisplacementX) - call MV_Pack(V, u%HubDisplacementX, ValAry) ! Scalar - case (Lidar_u_HubDisplacementY) - call MV_Pack(V, u%HubDisplacementY, ValAry) ! Scalar - case (Lidar_u_HubDisplacementZ) - call MV_Pack(V, u%HubDisplacementZ, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Lidar_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine Lidar_UnpackInputAry(Vars, ValAry, u) +subroutine Lidar_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_u_PulseLidEl) + VarVals(1) = u%PulseLidEl ! Scalar + case (Lidar_u_PulseLidAz) + VarVals(1) = u%PulseLidAz ! Scalar + case (Lidar_u_HubDisplacementX) + VarVals(1) = u%HubDisplacementX ! Scalar + case (Lidar_u_HubDisplacementY) + VarVals(1) = u%HubDisplacementY ! Scalar + case (Lidar_u_HubDisplacementZ) + VarVals(1) = u%HubDisplacementZ ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Lidar_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (Lidar_u_PulseLidEl) - call MV_Unpack(V, ValAry, u%PulseLidEl) ! Scalar - case (Lidar_u_PulseLidAz) - call MV_Unpack(V, ValAry, u%PulseLidAz) ! Scalar - case (Lidar_u_HubDisplacementX) - call MV_Unpack(V, ValAry, u%HubDisplacementX) ! Scalar - case (Lidar_u_HubDisplacementY) - call MV_Unpack(V, ValAry, u%HubDisplacementY) ! Scalar - case (Lidar_u_HubDisplacementZ) - call MV_Unpack(V, ValAry, u%HubDisplacementZ) ! Scalar - end select - end associate + call Lidar_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine Lidar_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_u_PulseLidEl) + u%PulseLidEl = VarVals(1) ! Scalar + case (Lidar_u_PulseLidAz) + u%PulseLidAz = VarVals(1) ! Scalar + case (Lidar_u_HubDisplacementX) + u%HubDisplacementX = VarVals(1) ! Scalar + case (Lidar_u_HubDisplacementY) + u%HubDisplacementY = VarVals(1) ! Scalar + case (Lidar_u_HubDisplacementZ) + u%HubDisplacementZ = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Lidar_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1298,54 +1347,68 @@ function Lidar_InputFieldName(DL) result(Name) end select end function -subroutine Lidar_PackOutputAry(Vars, y, ValAry) +subroutine Lidar_VarsPackOutput(Vars, y, ValAry) type(Lidar_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (Lidar_y_LidSpeed) - call MV_Pack(V, y%LidSpeed(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (Lidar_y_WtTrunc) - call MV_Pack(V, y%WtTrunc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsX) - call MV_Pack(V, y%MsrPositionsX(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsY) - call MV_Pack(V, y%MsrPositionsY(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (Lidar_y_MsrPositionsZ) - call MV_Pack(V, y%MsrPositionsZ(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Lidar_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine Lidar_UnpackOutputAry(Vars, ValAry, y) +subroutine Lidar_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_y_LidSpeed) + VarVals = y%LidSpeed(V%iLB:V%iUB) ! Rank 1 Array + case (Lidar_y_WtTrunc) + VarVals = y%WtTrunc(V%iLB:V%iUB) ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + VarVals = y%MsrPositionsX(V%iLB:V%iUB) ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + VarVals = y%MsrPositionsY(V%iLB:V%iUB) ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + VarVals = y%MsrPositionsZ(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Lidar_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (Lidar_y_LidSpeed) - call MV_Unpack(V, ValAry, y%LidSpeed(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (Lidar_y_WtTrunc) - call MV_Unpack(V, ValAry, y%WtTrunc(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (Lidar_y_MsrPositionsX) - call MV_Unpack(V, ValAry, y%MsrPositionsX(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (Lidar_y_MsrPositionsY) - call MV_Unpack(V, ValAry, y%MsrPositionsY(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (Lidar_y_MsrPositionsZ) - call MV_Unpack(V, ValAry, y%MsrPositionsZ(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call Lidar_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine Lidar_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_y_LidSpeed) + y%LidSpeed(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (Lidar_y_WtTrunc) + y%WtTrunc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + y%MsrPositionsX(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + y%MsrPositionsY(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + y%MsrPositionsZ(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function Lidar_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/lindyn/src/LinDyn_Types.f90 b/modules/lindyn/src/LinDyn_Types.f90 index 9afa269f77..93ad8d48c2 100644 --- a/modules/lindyn/src/LinDyn_Types.f90 +++ b/modules/lindyn/src/LinDyn_Types.f90 @@ -1580,38 +1580,52 @@ function LD_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine LD_PackContStateAry(Vars, x, ValAry) +subroutine LD_VarsPackContState(Vars, x, ValAry) type(LD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (LD_x_q) - call MV_Pack(V, x%q(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call LD_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine LD_UnpackContStateAry(Vars, ValAry, x) +subroutine LD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(LD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_x_q) + VarVals = x%q(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(LD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (LD_x_q) - call MV_Unpack(V, ValAry, x%q(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call LD_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine LD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_x_q) + x%q(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function LD_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1623,55 +1637,76 @@ function LD_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine LD_PackContStateDerivAry(Vars, x, ValAry) +subroutine LD_VarsPackContStateDeriv(Vars, x, ValAry) type(LD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (LD_x_q) - call MV_Pack(V, x%q(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call LD_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine LD_PackConstrStateAry(Vars, z, ValAry) +subroutine LD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(LD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_x_q) + VarVals = x%q(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsPackConstrState(Vars, z, ValAry) type(LD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (LD_z_Dummy) - call MV_Pack(V, z%Dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call LD_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine LD_UnpackConstrStateAry(Vars, ValAry, z) +subroutine LD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(LD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_z_Dummy) + VarVals(1) = z%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(LD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (LD_z_Dummy) - call MV_Unpack(V, ValAry, z%Dummy) ! Scalar - end select - end associate + call LD_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine LD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_z_Dummy) + z%Dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + function LD_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1683,38 +1718,52 @@ function LD_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine LD_PackInputAry(Vars, u, ValAry) +subroutine LD_VarsPackInput(Vars, u, ValAry) type(LD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (LD_u_Fext) - call MV_Pack(V, u%Fext(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call LD_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine LD_UnpackInputAry(Vars, ValAry, u) +subroutine LD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(LD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_u_Fext) + VarVals = u%Fext(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(LD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (LD_u_Fext) - call MV_Unpack(V, ValAry, u%Fext(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call LD_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine LD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(LD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_u_Fext) + u%Fext(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function LD_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1726,42 +1775,56 @@ function LD_InputFieldName(DL) result(Name) end select end function -subroutine LD_PackOutputAry(Vars, y, ValAry) +subroutine LD_VarsPackOutput(Vars, y, ValAry) type(LD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (LD_y_xdd) - call MV_Pack(V, y%xdd(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (LD_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call LD_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine LD_UnpackOutputAry(Vars, ValAry, y) +subroutine LD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(LD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_y_xdd) + VarVals = y%xdd(V%iLB:V%iUB) ! Rank 1 Array + case (LD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(LD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (LD_y_xdd) - call MV_Unpack(V, ValAry, y%xdd(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (LD_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call LD_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine LD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(LD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_y_xdd) + y%xdd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (LD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function LD_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 89e6d8b007..6ec523a35d 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -3034,38 +3034,52 @@ function MAP_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine MAP_PackContStateAry(Vars, x, ValAry) +subroutine MAP_VarsPackContState(Vars, x, ValAry) type(MAP_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (MAP_x_dummy) - call MV_Pack(V, x%dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MAP_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine MAP_UnpackContStateAry(Vars, ValAry, x) +subroutine MAP_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_x_dummy) + VarVals(1) = x%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MAP_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (MAP_x_dummy) - call MV_Unpack(V, ValAry, x%dummy) ! Scalar - end select - end associate + call MAP_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine MAP_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_x_dummy) + x%dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + function MAP_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3077,71 +3091,92 @@ function MAP_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine MAP_PackContStateDerivAry(Vars, x, ValAry) +subroutine MAP_VarsPackContStateDeriv(Vars, x, ValAry) type(MAP_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (MAP_x_dummy) - call MV_Pack(V, x%dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MAP_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine MAP_PackConstrStateAry(Vars, z, ValAry) +subroutine MAP_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_x_dummy) + VarVals(1) = x%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsPackConstrState(Vars, z, ValAry) type(MAP_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (MAP_z_H) - call MV_Pack(V, z%H(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_z_V) - call MV_Pack(V, z%V(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_z_x) - call MV_Pack(V, z%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_z_y) - call MV_Pack(V, z%y(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_z_z) - call MV_Pack(V, z%z(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MAP_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine MAP_UnpackConstrStateAry(Vars, ValAry, z) +subroutine MAP_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_z_H) + VarVals = z%H(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_z_V) + VarVals = z%V(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_z_x) + VarVals = z%x(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_z_y) + VarVals = z%y(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_z_z) + VarVals = z%z(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MAP_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (MAP_z_H) - call MV_Unpack(V, ValAry, z%H(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_z_V) - call MV_Unpack(V, ValAry, z%V(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_z_x) - call MV_Unpack(V, ValAry, z%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_z_y) - call MV_Unpack(V, ValAry, z%y(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_z_z) - call MV_Unpack(V, ValAry, z%z(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call MAP_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine MAP_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_z_H) + z%H(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_z_V) + z%V(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_z_x) + z%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_z_y) + z%y(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_z_z) + z%z(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function MAP_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3161,50 +3196,64 @@ function MAP_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine MAP_PackInputAry(Vars, u, ValAry) +subroutine MAP_VarsPackInput(Vars, u, ValAry) type(MAP_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (MAP_u_x) - call MV_Pack(V, u%x(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_u_y) - call MV_Pack(V, u%y(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_u_z) - call MV_Pack(V, u%z(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_u_PtFairDisplacement) - call MV_Pack(V, u%PtFairDisplacement, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MAP_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine MAP_UnpackInputAry(Vars, ValAry, u) +subroutine MAP_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_u_x) + VarVals = u%x(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_u_y) + VarVals = u%y(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_u_z) + VarVals = u%z(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_PackMesh(V, u%PtFairDisplacement, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MAP_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (MAP_u_x) - call MV_Unpack(V, ValAry, u%x(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_u_y) - call MV_Unpack(V, ValAry, u%y(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_u_z) - call MV_Unpack(V, ValAry, u%z(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_u_PtFairDisplacement) - call MV_Unpack(V, ValAry, u%PtFairDisplacement) ! Mesh - end select - end associate + call MAP_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine MAP_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_u_x) + u%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_u_y) + u%y(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_u_z) + u%z(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_UnpackMesh(V, ValAry, u%PtFairDisplacement) ! Mesh + end select + end associate +end subroutine + function MAP_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -3222,58 +3271,72 @@ function MAP_InputFieldName(DL) result(Name) end select end function -subroutine MAP_PackOutputAry(Vars, y, ValAry) +subroutine MAP_VarsPackOutput(Vars, y, ValAry) type(MAP_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (MAP_y_Fx) - call MV_Pack(V, y%Fx(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_y_Fy) - call MV_Pack(V, y%Fy(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_y_Fz) - call MV_Pack(V, y%Fz(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_y_wrtOutput) - call MV_Pack(V, y%wrtOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MAP_y_ptFairleadLoad) - call MV_Pack(V, y%ptFairleadLoad, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MAP_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine MAP_UnpackOutputAry(Vars, ValAry, y) +subroutine MAP_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_y_Fx) + VarVals = y%Fx(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_Fy) + VarVals = y%Fy(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_Fz) + VarVals = y%Fz(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_wrtOutput) + VarVals = y%wrtOutput(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_PackMesh(V, y%ptFairleadLoad, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MAP_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (MAP_y_Fx) - call MV_Unpack(V, ValAry, y%Fx(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_y_Fy) - call MV_Unpack(V, ValAry, y%Fy(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_y_Fz) - call MV_Unpack(V, ValAry, y%Fz(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_y_wrtOutput) - call MV_Unpack(V, ValAry, y%wrtOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MAP_y_ptFairleadLoad) - call MV_Unpack(V, ValAry, y%ptFairleadLoad) ! Mesh - end select - end associate + call MAP_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine MAP_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_y_Fx) + y%Fx(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_Fy) + y%Fy(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_Fz) + y%Fz(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_wrtOutput) + y%wrtOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_UnpackMesh(V, ValAry, y%ptFairleadLoad) ! Mesh + end select + end associate +end subroutine + function MAP_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index b36e094b71..d2c2d7a4af 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -1197,7 +1197,7 @@ SUBROUTINE MAP_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat ! Make a copy of the inputs to perturb call MAP_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call MAP_PackInputAry(Vars, u, m%Jac%u) + call MAP_VarsPackInput(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -1215,7 +1215,7 @@ SUBROUTINE MAP_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call MAP_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call MAP_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call MAP_CopyConstrState(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate absolute position of each node @@ -1240,11 +1240,11 @@ SUBROUTINE MAP_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat ! compute y at u_op + delta u ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2); if (Failed()) return - call MAP_PackOutputAry(Vars, y, m%Jac%y_pos) + call MAP_VarsPackOutput(Vars, y, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call MAP_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call MAP_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call MAP_CopyConstrState(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate absolute position of each node @@ -1269,7 +1269,7 @@ SUBROUTINE MAP_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat ! compute y at u_op - delta u ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2 ); if (Failed()) return - call MAP_PackOutputAry(Vars, y, m%Jac%y_neg) + call MAP_VarsPackOutput(Vars, y, m%Jac%y_neg) ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index c20a29d0aa..e254a7c0a5 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -2864,7 +2864,7 @@ subroutine MD_InitVars(Vars, InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrS ! Free Points do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) - LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) + LinStr = 'Point '//Num2LStr(m%FreePointIs(l)) call MV_AddVar(Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & iAry=m%PointStateIs1(l)+3, & ! x%state index Num=3, Flags=VF_DerivOrder2, & @@ -2949,7 +2949,7 @@ subroutine MD_InitVars(Vars, InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrS ! Free Points do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) - LinStr = 'Point '//Num2LStr(m%FreeRodIs(l)) + LinStr = 'Point '//Num2LStr(m%FreePointIs(l)) call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & iAry=m%PointStateIs1(l)+0, & Num=3, Flags=VF_DerivOrder2, & @@ -4208,7 +4208,7 @@ SUBROUTINE MD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Copy inputs to perturb call MD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackInputAry(Vars, u, m%Jac%u) + call MD_VarsPackInput(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -4229,15 +4229,15 @@ SUBROUTINE MD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call MD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call MD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call MD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call MD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,iCol)) @@ -4264,15 +4264,15 @@ SUBROUTINE MD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call MD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call MD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call MD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call MD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call MD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array dXdu(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) @@ -4327,7 +4327,7 @@ SUBROUTINE MD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Copy state values call MD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateAry(Vars, x, m%Jac%x) + call MD_VarsPackContState(Vars, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then @@ -4348,15 +4348,15 @@ SUBROUTINE MD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call MD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call MD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call MD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call MD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Get partial derivative via central difference and store in full linearization array call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,iCol)) @@ -4383,15 +4383,15 @@ SUBROUTINE MD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call MD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateDerivAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call MD_VarsPackContStateDeriv(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call MD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call MD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call MD_PackContStateDerivAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call MD_VarsPackContStateDeriv(Vars, m%dxdt_lin, m%Jac%x_neg) ! Get partial derivative via central difference and store in full linearization array dXdx(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 24b284643b..6908e51670 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -5096,38 +5096,52 @@ function MD_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine MD_PackContStateAry(Vars, x, ValAry) +subroutine MD_VarsPackContState(Vars, x, ValAry) type(MD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (MD_x_states) - call MV_Pack(V, x%states(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MD_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine MD_UnpackContStateAry(Vars, ValAry, x) +subroutine MD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(MD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_x_states) + VarVals = x%states(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (MD_x_states) - call MV_Unpack(V, ValAry, x%states(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call MD_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine MD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_x_states) + x%states(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function MD_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -5139,55 +5153,76 @@ function MD_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine MD_PackContStateDerivAry(Vars, x, ValAry) +subroutine MD_VarsPackContStateDeriv(Vars, x, ValAry) type(MD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (MD_x_states) - call MV_Pack(V, x%states(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MD_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine MD_PackConstrStateAry(Vars, z, ValAry) +subroutine MD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(MD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_x_states) + VarVals = x%states(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsPackConstrState(Vars, z, ValAry) type(MD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (MD_z_dummy) - call MV_Pack(V, z%dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MD_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine MD_UnpackConstrStateAry(Vars, ValAry, z) +subroutine MD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(MD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_z_dummy) + VarVals(1) = z%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (MD_z_dummy) - call MV_Unpack(V, ValAry, z%dummy) ! Scalar - end select - end associate + call MD_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine MD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_z_dummy) + z%dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + function MD_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -5199,46 +5234,60 @@ function MD_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine MD_PackInputAry(Vars, u, ValAry) +subroutine MD_VarsPackInput(Vars, u, ValAry) type(MD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (MD_u_CoupledKinematics) - call MV_Pack(V, u%CoupledKinematics(DL%i1), ValAry) ! Mesh - case (MD_u_DeltaL) - call MV_Pack(V, u%DeltaL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MD_u_DeltaLdot) - call MV_Pack(V, u%DeltaLdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MD_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine MD_UnpackInputAry(Vars, ValAry, u) +subroutine MD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(MD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_u_CoupledKinematics) + call MV_PackMesh(V, u%CoupledKinematics(DL%i1), ValAry) ! Mesh + case (MD_u_DeltaL) + VarVals = u%DeltaL(V%iLB:V%iUB) ! Rank 1 Array + case (MD_u_DeltaLdot) + VarVals = u%DeltaLdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (MD_u_CoupledKinematics) - call MV_Unpack(V, ValAry, u%CoupledKinematics(DL%i1)) ! Mesh - case (MD_u_DeltaL) - call MV_Unpack(V, ValAry, u%DeltaL(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MD_u_DeltaLdot) - call MV_Unpack(V, ValAry, u%DeltaLdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call MD_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine MD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_u_CoupledKinematics) + call MV_UnpackMesh(V, ValAry, u%CoupledKinematics(DL%i1)) ! Mesh + case (MD_u_DeltaL) + u%DeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MD_u_DeltaLdot) + u%DeltaLdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function MD_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -5254,58 +5303,72 @@ function MD_InputFieldName(DL) result(Name) end select end function -subroutine MD_PackOutputAry(Vars, y, ValAry) +subroutine MD_VarsPackOutput(Vars, y, ValAry) type(MD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (MD_y_CoupledLoads) - call MV_Pack(V, y%CoupledLoads(DL%i1), ValAry) ! Mesh - case (MD_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (MD_y_VisLinesMesh) - call MV_Pack(V, y%VisLinesMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisRodsMesh) - call MV_Pack(V, y%VisRodsMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisBodiesMesh) - call MV_Pack(V, y%VisBodiesMesh(DL%i1), ValAry) ! Mesh - case (MD_y_VisAnchsMesh) - call MV_Pack(V, y%VisAnchsMesh(DL%i1), ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call MD_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine MD_UnpackOutputAry(Vars, ValAry, y) +subroutine MD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(MD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_y_CoupledLoads) + call MV_PackMesh(V, y%CoupledLoads(DL%i1), ValAry) ! Mesh + case (MD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_PackMesh(V, y%VisLinesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisRodsMesh) + call MV_PackMesh(V, y%VisRodsMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_PackMesh(V, y%VisBodiesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_PackMesh(V, y%VisAnchsMesh(DL%i1), ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(MD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (MD_y_CoupledLoads) - call MV_Unpack(V, ValAry, y%CoupledLoads(DL%i1)) ! Mesh - case (MD_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (MD_y_VisLinesMesh) - call MV_Unpack(V, ValAry, y%VisLinesMesh(DL%i1)) ! Mesh - case (MD_y_VisRodsMesh) - call MV_Unpack(V, ValAry, y%VisRodsMesh(DL%i1)) ! Mesh - case (MD_y_VisBodiesMesh) - call MV_Unpack(V, ValAry, y%VisBodiesMesh(DL%i1)) ! Mesh - case (MD_y_VisAnchsMesh) - call MV_Unpack(V, ValAry, y%VisAnchsMesh(DL%i1)) ! Mesh - end select - end associate + call MD_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine MD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_y_CoupledLoads) + call MV_UnpackMesh(V, ValAry, y%CoupledLoads(DL%i1)) ! Mesh + case (MD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_UnpackMesh(V, ValAry, y%VisLinesMesh(DL%i1)) ! Mesh + case (MD_y_VisRodsMesh) + call MV_UnpackMesh(V, ValAry, y%VisRodsMesh(DL%i1)) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_UnpackMesh(V, ValAry, y%VisBodiesMesh(DL%i1)) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_UnpackMesh(V, ValAry, y%VisAnchsMesh(DL%i1)) ! Mesh + end select + end associate +end subroutine + function MD_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index bc8c6940a4..745de1227a 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -31,71 +31,28 @@ module ModVar implicit none private -public :: MV_InitVarsJac, MV_Pack, MV_Unpack +public :: MV_InitVarsJac public :: MV_AddVar, MV_AddMeshVar public :: MV_Perturb, MV_ComputeCentralDiff, MV_ComputeDiff, MV_ExtrapInterp, MV_AddDelta public :: MV_HasFlagsAll, MV_HasFlagsAny, MV_SetFlags, MV_ClearFlags public :: MV_NumVars, MV_NumVals, MV_FindVarDatLoc public :: LoadFields, MotionFields, TransFields, AngularFields -public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv +public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv, quat_compose public :: MV_FieldString, MV_IsLoad, MV_IsMotion, IdxStr public :: DumpMatrix, MV_AddModule public :: MV_EqualDL +public :: MV_PackMesh, MV_UnpackMesh -integer(IntKi), parameter :: & - LoadFields(*) = [FieldForce, FieldMoment], & - TransFields(*) = [FieldTransDisp, FieldTransVel, FieldTransAcc], & - AngularFields(*) = [FieldOrientation, FieldAngularVel, FieldAngularAcc, FieldAngularDisp], & - MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc] +integer(IntKi), parameter :: LoadFields(*) = [FieldForce, FieldMoment] +integer(IntKi), parameter :: TransFields(*) = [FieldTransDisp, FieldTransVel, FieldTransAcc] +integer(IntKi), parameter :: AngularFields(*) = [FieldOrientation, FieldAngularVel, FieldAngularAcc, FieldAngularDisp] +integer(IntKi), parameter :: MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, & + FieldAngularVel, FieldTransAcc, FieldAngularAcc] -interface MV_Pack - module procedure MV_PackVarRank0R4, MV_PackVarRank1R4 - module procedure MV_PackVarRank0R8, MV_PackVarRank1R8 - module procedure MV_PackMesh -end interface - -interface MV_Unpack - module procedure MV_UnpackVarRank0R4, MV_UnpackVarRank1R4 - module procedure MV_UnpackVarRank0R8, MV_UnpackVarRank1R8 - module procedure MV_UnpackMesh -end interface - -logical, parameter :: UseSmallRotAngles = .true. +logical, parameter :: UseSmallRotAngles = .false. contains -!------------------------------------------------------------------------------- -! MV_Pack -!------------------------------------------------------------------------------- - -subroutine MV_PackVarRank0R4(Var, SrcVal, DstAry) - type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: SrcVal - real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1)) = real(SrcVal, R8Ki) -end subroutine - -subroutine MV_PackVarRank0R8(Var, SrcVal, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcVal - real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1)) = SrcVal -end subroutine - -subroutine MV_PackVarRank1R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R4Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: DstAry(:) - DstAry(Var%iLoc(1):Var%iLoc(2)) = real(SrcAry, R8Ki) -end subroutine - -subroutine MV_PackVarRank1R8(Var, SrcAry, Ary) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: Ary(:) - Ary(Var%iLoc(1):Var%iLoc(2)) = SrcAry -end subroutine - subroutine MV_PackMesh(Var, Mesh, DstAry) type(ModVarType), intent(in) :: Var type(MeshType), intent(in) :: Mesh @@ -127,38 +84,6 @@ subroutine MV_PackMesh(Var, Mesh, DstAry) end select end subroutine -!------------------------------------------------------------------------------- -! MV_Unpack -!------------------------------------------------------------------------------- - -subroutine MV_UnpackVarRank0R4(Var, SrcAry, DstVal) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R4Ki), intent(inout) :: DstVal - DstVal = real(SrcAry(Var%iLoc(1)), R4Ki) -end subroutine - -subroutine MV_UnpackVarRank0R8(Var, SrcAry, DstVal) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: DstVal - DstVal = SrcAry(Var%iLoc(1)) -end subroutine - -subroutine MV_UnpackVarRank1R4(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R4Ki), intent(inout) :: DstAry(:) - DstAry = real(SrcAry(Var%iLoc(1):Var%iLoc(2)), R4Ki) -end subroutine - -subroutine MV_UnpackVarRank1R8(Var, SrcAry, DstAry) - type(ModVarType), intent(in) :: Var - real(R8Ki), intent(in) :: SrcAry(:) - real(R8Ki), intent(inout) :: DstAry(:) - DstAry = SrcAry(Var%iLoc(1):Var%iLoc(2)) -end subroutine - subroutine MV_UnpackMesh(Var, SrcAry, Mesh) type(ModVarType), intent(in) :: Var real(R8Ki), intent(in) :: SrcAry(:) @@ -284,26 +209,26 @@ subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) Jac%Ny = Vars%Ny ! Allocate Jacobian data arrays - if (Linearize) then - if (Jac%Nx > 0) then - call AllocAry(Jac%x, Jac%Nx, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%x_perturb, Jac%Nx, "Lin%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%x_pos, Jac%Nx, "Lin%x_pos", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%x_neg, Jac%Nx, "Lin%x_neg", ErrStat2, ErrMsg2); if (Failed()) return - end if - if (Jac%Nz > 0) then - call AllocAry(Jac%z, Jac%Nz, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return - end if - if (Jac%Nu > 0) then - call AllocAry(Jac%u, Jac%Nu, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%u_perturb, Jac%Nu, "Lin%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return - end if - if (Jac%Ny > 0) then - call AllocAry(Jac%y, Jac%Ny, "Lin%y", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%y_pos, Jac%Ny, "Lin%y_pos", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Jac%y_neg, Jac%Ny, "Lin%y_neg", ErrStat2, ErrMsg2); if (Failed()) return - end if + ! if (Linearize) then + if (Jac%Nx > 0) then + call AllocAry(Jac%x, Jac%Nx, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_perturb, Jac%Nx, "Lin%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_pos, Jac%Nx, "Lin%x_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_neg, Jac%Nx, "Lin%x_neg", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Jac%Nz > 0) then + call AllocAry(Jac%z, Jac%Nz, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Jac%Nu > 0) then + call AllocAry(Jac%u, Jac%Nu, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%u_perturb, Jac%Nu, "Lin%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return end if + if (Jac%Ny > 0) then + call AllocAry(Jac%y, Jac%Ny, "Lin%y", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%y_pos, Jac%Ny, "Lin%y_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%y_neg, Jac%Ny, "Lin%y_neg", ErrStat2, ErrMsg2); if (Failed()) return + end if + ! end if contains @@ -360,7 +285,7 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) Var%Num = Var%Nodes*3 ! If linearization enabled - if (Linearize) then + if (.true.) then ! Set unit description for line mesh UnitDesc = '' @@ -396,7 +321,7 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) ! Linearization !---------------------------------------------------------------------------- - if (Linearize) then + if (.true.) then if (.not. allocated(Var%LinNames)) then call SetErrStat(ErrID_Fatal, "LinNames not allocated for "//Var%Name, ErrStat, ErrMsg, RoutineName) return @@ -493,12 +418,6 @@ subroutine MV_AddModule(ModDataAry, ModID, ModAbbr, Instance, ModDT, SolverDT, V end if end if - !---------------------------------------------------------------------------- - ! Allocate source and destination mapping indices - !---------------------------------------------------------------------------- - - allocate (ModData%iSrcMaps(0), ModData%iDstMaps(0)) - !---------------------------------------------------------------------------- ! Add module info to array !---------------------------------------------------------------------------- @@ -948,9 +867,6 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, DL, Mesh, Flags, Perturbs, Active Num=Mesh%Nnodes, & Flags=FlagsLocal, & Perturb=PerturbsLocal(i)) - - ! Save mesh ID - VarAry(size(VarAry))%MeshID = Mesh%ID end do end subroutine @@ -985,12 +901,14 @@ subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, Deri ! Set optional values if (present(Flags)) Var%Flags = Flags if (present(iAry)) then - Var%iAry = [iAry, iAry + Var%Num - 1] + Var%iLB = iAry + Var%iUB = iAry + Var%Num - 1 else - Var%iAry = [1, Var%Num] + Var%iLB = 1 + Var%iUB = Var%Num end if - if (present(jAry)) Var%jAry = jAry - if (present(kAry)) Var%kAry = kAry + if (present(jAry)) Var%j = jAry + if (present(kAry)) Var%k = kAry if (present(Perturb)) Var%Perturb = Perturb if (present(LinNames)) then allocate (Var%LinNames(size(LinNames))) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index c595684c4e..b7d9d98024 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -56,7 +56,7 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: VF_2PI = 64 ! Variable is an angle with range [0,2pi] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WM_Rot = 128 ! Variable is a Wiener-Milenkovic rotation [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 256 ! Variable for write output [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 512 ! Variable for solver [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 512 ! Variable for tight coupling solver [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 1024 ! Variable for aeromap [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 2048 ! Variable is derivative order 1 in linearization file [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 4096 ! Variable is derivative order 2 in linearization file [-] @@ -135,12 +135,13 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: DerivOrder = 0 !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0 !< indices in module arrays [-] INTEGER(IntKi) , DIMENSION(1:2) :: iGlu = 0 !< indices in module arrays [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iAry = 0 !< first user defined index for variable [-] - INTEGER(IntKi) :: jAry = 0 !< second user defined index for variable [-] - INTEGER(IntKi) :: kAry = 0 !< third user defined index for variable [-] - INTEGER(IntKi) :: mAry = 0 !< fourth user defined index for variable [-] - INTEGER(IntKi) :: nAry = 0 !< fifth user defined index for variable [-] - INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iq = 0 !< solver state row indices [-] + INTEGER(IntKi) :: iLB = 0 !< first user defined index lower bound for variable [-] + INTEGER(IntKi) :: iUB = 0 !< first user defined index upper bound for variable [-] + INTEGER(IntKi) :: j = 0 !< second user defined index for variable [-] + INTEGER(IntKi) :: k = 0 !< third user defined index for variable [-] + INTEGER(IntKi) :: m = 0 !< fourth user defined index for variable [-] + INTEGER(IntKi) :: n = 0 !< fifth user defined index for variable [-] REAL(R8Ki) :: Perturb = 0 !< perturbation amount for linearization [-] TYPE(DatLoc) :: DL !< data location [-] character(VarNameLen) :: Name !< [-] @@ -200,13 +201,11 @@ MODULE NWTC_Library_Types ! ========= ModDataType ======= TYPE, PUBLIC :: ModDataType character(ChanLen) :: Abbr !< Module name abbreviation [-] - INTEGER(IntKi) :: ID = 0 !< Module identification number [-] INTEGER(IntKi) :: iMod = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] REAL(R8Ki) :: DT = 0 !< Module time step [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSrcMaps !< Indices of mappings where module is the source [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iDstMaps !< Indices of mappings where module is the destination [-] TYPE(ModVarsType) :: Vars !< Module variables type [-] TYPE(ModLinType) :: Lin !< Module linearization arrays and matrices [-] END TYPE ModDataType @@ -704,12 +703,13 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc DstModVarTypeData%iGlu = SrcModVarTypeData%iGlu - DstModVarTypeData%iAry = SrcModVarTypeData%iAry - DstModVarTypeData%jAry = SrcModVarTypeData%jAry - DstModVarTypeData%kAry = SrcModVarTypeData%kAry - DstModVarTypeData%mAry = SrcModVarTypeData%mAry - DstModVarTypeData%nAry = SrcModVarTypeData%nAry - DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID + DstModVarTypeData%iq = SrcModVarTypeData%iq + DstModVarTypeData%iLB = SrcModVarTypeData%iLB + DstModVarTypeData%iUB = SrcModVarTypeData%iUB + DstModVarTypeData%j = SrcModVarTypeData%j + DstModVarTypeData%k = SrcModVarTypeData%k + DstModVarTypeData%m = SrcModVarTypeData%m + DstModVarTypeData%n = SrcModVarTypeData%n DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb call NWTC_Library_CopyDatLoc(SrcModVarTypeData%DL, DstModVarTypeData%DL, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -757,12 +757,13 @@ subroutine NWTC_Library_PackModVarType(RF, Indata) call RegPack(RF, InData%DerivOrder) call RegPack(RF, InData%iLoc) call RegPack(RF, InData%iGlu) - call RegPack(RF, InData%iAry) - call RegPack(RF, InData%jAry) - call RegPack(RF, InData%kAry) - call RegPack(RF, InData%mAry) - call RegPack(RF, InData%nAry) - call RegPack(RF, InData%MeshID) + call RegPack(RF, InData%iq) + call RegPack(RF, InData%iLB) + call RegPack(RF, InData%iUB) + call RegPack(RF, InData%j) + call RegPack(RF, InData%k) + call RegPack(RF, InData%m) + call RegPack(RF, InData%n) call RegPack(RF, InData%Perturb) call NWTC_Library_PackDatLoc(RF, InData%DL) call RegPack(RF, InData%Name) @@ -785,12 +786,13 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) call RegUnpack(RF, OutData%DerivOrder); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iGlu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iAry); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%jAry); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%kAry); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%mAry); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nAry); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%j); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Perturb); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackDatLoc(RF, OutData%DL) ! DL call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return @@ -1586,42 +1588,17 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' ErrStat = ErrID_None ErrMsg = '' DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr - DstModDataTypeData%ID = SrcModDataTypeData%ID DstModDataTypeData%iMod = SrcModDataTypeData%iMod + DstModDataTypeData%ID = SrcModDataTypeData%ID DstModDataTypeData%Ins = SrcModDataTypeData%Ins DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps DstModDataTypeData%DT = SrcModDataTypeData%DT - if (allocated(SrcModDataTypeData%iSrcMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%iSrcMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%iSrcMaps, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%iSrcMaps)) then - allocate(DstModDataTypeData%iSrcMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iSrcMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%iSrcMaps = SrcModDataTypeData%iSrcMaps - end if - if (allocated(SrcModDataTypeData%iDstMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%iDstMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%iDstMaps, kind=B8Ki) - if (.not. allocated(DstModDataTypeData%iDstMaps)) then - allocate(DstModDataTypeData%iDstMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iDstMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%iDstMaps = SrcModDataTypeData%iDstMaps - end if call NWTC_Library_CopyModVarsType(SrcModDataTypeData%Vars, DstModDataTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1639,12 +1616,6 @@ subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModDataTypeData%iSrcMaps)) then - deallocate(ModDataTypeData%iSrcMaps) - end if - if (allocated(ModDataTypeData%iDstMaps)) then - deallocate(ModDataTypeData%iDstMaps) - end if call NWTC_Library_DestroyModVarsType(ModDataTypeData%Vars, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call NWTC_Library_DestroyModLinType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) @@ -1657,13 +1628,11 @@ subroutine NWTC_Library_PackModDataType(RF, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Abbr) - call RegPack(RF, InData%ID) call RegPack(RF, InData%iMod) + call RegPack(RF, InData%ID) call RegPack(RF, InData%Ins) call RegPack(RF, InData%SubSteps) call RegPack(RF, InData%DT) - call RegPackAlloc(RF, InData%iSrcMaps) - call RegPackAlloc(RF, InData%iDstMaps) call NWTC_Library_PackModVarsType(RF, InData%Vars) call NWTC_Library_PackModLinType(RF, InData%Lin) if (RegCheckErr(RF, RoutineName)) return @@ -1673,18 +1642,13 @@ subroutine NWTC_Library_UnPackModDataType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iSrcMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iDstMaps); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin end subroutine diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index a3ccd582ee..faae51f748 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -67,7 +67,7 @@ param ^ - IntKi VF_SmallAngle - 32 - param ^ - IntKi VF_2PI - 64 - "Variable is an angle with range [0,2pi]" - param ^ - IntKi VF_WM_Rot - 128 - "Variable is a Wiener-Milenkovic rotation" - param ^ - IntKi VF_WriteOut - 256 - "Variable for write output" - -param ^ - IntKi VF_Solve - 512 - "Variable for solver" - +param ^ - IntKi VF_Solve - 512 - "Variable for tight coupling solver" - param ^ - IntKi VF_AeroMap - 1024 - "Variable for aeromap" - param ^ - IntKi VF_DerivOrder1 - 2048 - "Variable is derivative order 1 in linearization file" - param ^ - IntKi VF_DerivOrder2 - 4096 - "Variable is derivative order 2 in linearization file" - @@ -92,12 +92,13 @@ typedef ^ ^ IntKi Flags - 0 - typedef ^ ^ IntKi DerivOrder - 0 - "" - typedef ^ ^ IntKi iLoc 2 0 - "indices in module arrays" - typedef ^ ^ IntKi iGlu 2 0 - "indices in module arrays" - -typedef ^ ^ IntKi iAry 2 0 - "first user defined index for variable" - -typedef ^ ^ IntKi jAry - 0 - "second user defined index for variable" - -typedef ^ ^ IntKi kAry - 0 - "third user defined index for variable" - -typedef ^ ^ IntKi mAry - 0 - "fourth user defined index for variable" - -typedef ^ ^ IntKi nAry - 0 - "fifth user defined index for variable" - -typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - +typedef ^ ^ IntKi iq 2 0 - "solver state row indices" - +typedef ^ ^ IntKi iLB - 0 - "first user defined index lower bound for variable" - +typedef ^ ^ IntKi iUB - 0 - "first user defined index upper bound for variable" - +typedef ^ ^ IntKi j - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi k - 0 - "third user defined index for variable" - +typedef ^ ^ IntKi m - 0 - "fourth user defined index for variable" - +typedef ^ ^ IntKi n - 0 - "fifth user defined index for variable" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ DatLoc DL - - - "data location" - typedef ^ ^ character(VarNameLen) Name - - - "" - @@ -145,13 +146,11 @@ typedef ^ ^ R8Ki dUdy :: - - typedef ^ ^ R8Ki StateRotation :: - - "" - typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - -typedef ^ ^ IntKi ID - 0 - "Module identification number" - typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - typedef ^ ^ R8Ki DT - 0 - "Module time step" - -typedef ^ ^ IntKi iSrcMaps : - - "Indices of mappings where module is the source" -typedef ^ ^ IntKi iDstMaps : - - "Indices of mappings where module is the destination" typedef ^ ^ ModVarsType Vars - - - "Module variables type" - typedef ^ ^ ModLinType Lin - - - "Module linearization arrays and matrices" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index d85ba6aa88..9e83f698a5 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -67,7 +67,7 @@ param ^ - IntKi VF_SmallAngle - 32 - param ^ - IntKi VF_2PI - 64 - "Variable is an angle with range [0,2pi]" - param ^ - IntKi VF_WM_Rot - 128 - "Variable is a Wiener-Milenkovic rotation" - param ^ - IntKi VF_WriteOut - 256 - "Variable for write output" - -param ^ - IntKi VF_Solve - 512 - "Variable for solver" - +param ^ - IntKi VF_Solve - 512 - "Variable for tight coupling solver" - param ^ - IntKi VF_AeroMap - 1024 - "Variable for aeromap" - param ^ - IntKi VF_DerivOrder1 - 2048 - "Variable is derivative order 1 in linearization file" - param ^ - IntKi VF_DerivOrder2 - 4096 - "Variable is derivative order 2 in linearization file" - @@ -92,12 +92,13 @@ typedef ^ ^ IntKi Flags - 0 - typedef ^ ^ IntKi DerivOrder - 0 - "" - typedef ^ ^ IntKi iLoc 2 0 - "indices in module arrays" - typedef ^ ^ IntKi iGlu 2 0 - "indices in module arrays" - -typedef ^ ^ IntKi iAry 2 0 - "first user defined index for variable" - -typedef ^ ^ IntKi jAry - 0 - "second user defined index for variable" - -typedef ^ ^ IntKi kAry - 0 - "third user defined index for variable" - -typedef ^ ^ IntKi mAry - 0 - "fourth user defined index for variable" - -typedef ^ ^ IntKi nAry - 0 - "fifth user defined index for variable" - -typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - +typedef ^ ^ IntKi iq 2 0 - "solver state row indices" - +typedef ^ ^ IntKi iLB - 0 - "first user defined index lower bound for variable" - +typedef ^ ^ IntKi iUB - 0 - "first user defined index upper bound for variable" - +typedef ^ ^ IntKi j - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi k - 0 - "third user defined index for variable" - +typedef ^ ^ IntKi m - 0 - "fourth user defined index for variable" - +typedef ^ ^ IntKi n - 0 - "fifth user defined index for variable" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - typedef ^ ^ DatLoc DL - - - "data location" - typedef ^ ^ character(VarNameLen) Name - - - "" - @@ -145,12 +146,10 @@ typedef ^ ^ R8Ki dUdy :: - - typedef ^ ^ R8Ki StateRotation :: - - "" - typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - -typedef ^ ^ IntKi ID - 0 - "Module identification number" - typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - typedef ^ ^ R8Ki DT - 0 - "Module time step" - -typedef ^ ^ IntKi iSrcMaps : - - "Indices of mappings where module is the source" -typedef ^ ^ IntKi iDstMaps : - - "Indices of mappings where module is the destination" typedef ^ ^ ModVarsType Vars - - - "Module variables type" - typedef ^ ^ ModLinType Lin - - - "Module linearization arrays and matrices" diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index e8ed4417b5..9a3794f2b4 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -77,6 +77,7 @@ add_library(openfast_postlib STATIC src/FAST_ModGlue.f90 src/FAST_Mapping.f90 src/FAST_AeroMap.f90 + src/FAST_SolverTC.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 8162dda7b2..35251b8cb5 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -34,6 +34,8 @@ module FAST_AeroMap real(DbKi), parameter :: UJacSclFact_x = 1.0d3 logical, parameter :: output_debugging = .false. +integer(IntKi), parameter :: iModStruct = 1 +integer(IntKi), parameter :: iModAero = 2 contains @@ -118,7 +120,7 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) if (Failed()) return ! Initialize module data transfer mappings - call FAST_InitMappings(m%Mappings, m%ModDataAry, T, ErrStat2, ErrMsg2) + call FAST_InitMappings(m%Mappings, m%ModData, T, ErrStat2, ErrMsg2) if (Failed()) return ! Initialize steady flow field in AeroDyn @@ -129,14 +131,17 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return + ! Set number of driver outputs + T%y_FAST%DriverWriteOutputNum = 6 + !---------------------------------------------------------------------------- ! Module Order !---------------------------------------------------------------------------- ! Get indices of modules that are used by Aero Mapping (first instance only) iModED = 0; iModBD = 0; iModAD = 0 - do i = 1, size(m%ModDataAry) - associate (ModData => m%ModDataAry(i)) + do i = 1, size(m%ModData) + associate (ModData => m%ModData(i)) if (ModData%Ins == 1) then select case (ModData%ID) case (Module_ED) @@ -162,12 +167,12 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! Generate index for variables with AeroMap flag - call Glue_CombineModules(AM%Mod, m%ModDataAry, m%Mappings, iModOrder, VF_AeroMap, .true., ErrStat2, ErrMsg2) + call Glue_CombineModules(AM%Mod, m%ModData, m%Mappings, iModOrder, VF_AeroMap, .true., ErrStat2, ErrMsg2) if (Failed()) return ! Loop through modules in AM module - do i = 1, size(AM%Mod%ModDataAry) - associate (ModData => AM%Mod%ModDataAry(i)) + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) ! Copy current state to predicted state call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -390,8 +395,8 @@ subroutine SS_Solve(AM, m, Mappings, caseData, p_FAST, y_FAST, m_FAST, T, ErrSta call SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD) ! Copy inputs from current to previous index - do i = 1, size(AM%Mod%ModDataAry) - call FAST_CopyInput(AM%Mod%ModDataAry(i), T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) + do i = 1, size(AM%Mod%ModData) + call FAST_CopyInput(AM%Mod%ModData(i), T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do @@ -420,7 +425,7 @@ subroutine SS_Solve(AM, m, Mappings, caseData, p_FAST, y_FAST, m_FAST, T, ErrSta ! Calculate ElastoDyn / BeamDyn output !----------------------------------------- - call FAST_CalcOutput(AM%Mod%ModDataAry(1), Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call FAST_CalcOutput(AM%Mod%ModData(1), Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !----------------------------------------- @@ -450,7 +455,7 @@ subroutine SS_Solve(AM, m, Mappings, caseData, p_FAST, y_FAST, m_FAST, T, ErrSta ! Calculate AeroDyn Output !----------------------------------------- - call FAST_CalcOutput(AM%Mod%ModDataAry(2), Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call FAST_CalcOutput(AM%Mod%ModData(2), Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) then call ResetInputsAndStates() @@ -621,8 +626,8 @@ subroutine SS_UpdateInputsStates(AM, delta, T, ErrStat, ErrMsg) call MV_AddDelta(AM%Mod%Vars%x, delta(:AM%Mod%Vars%Nx), AM%Mod%Lin%x) ! Update states and inputs in module - do i = 1, size(AM%Mod%ModDataAry) - associate (ModData => AM%Mod%ModDataAry(i)) + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) ! Populate input and state values in module call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & @@ -725,17 +730,17 @@ subroutine SS_BuildJacobian(AM, caseData, Mappings, p_FAST, y_FAST, m_FAST, T, E !---------------------------------------------------------------------------- ! Loop through modules - do i = 1, size(AM%Mod%ModDataAry) - associate (ModData => AM%Mod%ModDataAry(i)) + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) ! Calculate dYdu and dXdu - call FAST_JacobianPInput(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & + call FAST_JacobianPInput(ModData, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & dYdu=ModData%Lin%dYdu, dYdu_glue=AM%Mod%Lin%dYdu, & dXdu=ModData%Lin%dXdu, dXdu_glue=AM%Mod%Lin%dXdu) if (Failed()) return ! Calculate dYdx and dXdx - call FAST_JacobianPContState(ModData, SS_t_global, STATE_CURR, T, ErrStat2, ErrMsg2, & + call FAST_JacobianPContState(ModData, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & dYdx=ModData%Lin%dYdx, dYdx_glue=AM%Mod%Lin%dYdx, & dXdx=ModData%Lin%dXdx, dXdx_glue=AM%Mod%Lin%dXdx) if (Failed()) return @@ -917,7 +922,7 @@ subroutine SS_BuildResidual(AM, caseData, Mappings, T, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the SS_GetInputs - call SS_GetCalculatedInputs(AM, AM%u2, Mappings, INPUT_PREV, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 + call SS_GetCalculatedInputs(AM, AM%u2, Mappings, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! call PreconditionInputResidual(AM%u1, AM%JacScale) @@ -993,7 +998,7 @@ subroutine SS_AD_InputSolve(AM, Mappings, InputIndex, T, ErrStat, ErrMsg) ErrMsg = "" ! Get blade motion inputs - call FAST_InputSolve(AM%Mod%ModDataAry(2), AM%Mod%ModDataAry, Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call FAST_InputSolve(iModAero, AM%Mod%ModData, Mappings, InputIndex, T, ErrStat2, ErrMsg2, AM%Mod%VarMaps) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Set prescribed values for first blade @@ -1041,12 +1046,12 @@ subroutine SS_CalcContStateDeriv(AM, caseData, InputIndex, dxAry, T, ErrStat, Er ErrMsg = "" ! Get the structural continuous state derivative - call FAST_GetOP(AM%Mod%ModDataAry(1), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & - dx_op=AM%Mod%ModDataAry(1)%Lin%dx, dx_glue=dxAry) + call FAST_GetOP(AM%Mod%ModData(iModStruct), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & + dx_op=AM%Mod%ModData(iModStruct)%Lin%dx, dx_glue=dxAry) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Select based on which module is simulating the blades - select case (AM%Mod%ModDataAry(1)%ID) + select case (AM%Mod%ModData(iModStruct)%ID) case (Module_ED) ! ElastoDyn @@ -1097,8 +1102,8 @@ subroutine SS_GetStates(AM, xAry, StateIndex, T, ErrStat, ErrMsg) ErrMsg = '' ! Loop through modules and get AeroMap states - do i = 1, size(AM%Mod%ModDataAry) - associate (ModData => AM%Mod%ModDataAry(i)) + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, StateIndex, T, ErrStat2, ErrMsg2, x_op=ModData%Lin%x, x_glue=xAry) if (Failed()) return end associate @@ -1126,8 +1131,8 @@ subroutine SS_GetInputs(AM, uAry, InputIndex, T, ErrStat, ErrMsg) integer(IntKi) :: i ! Loop through modules and get inputs - do i = 1, size(AM%Mod%ModDataAry) - associate (ModData => AM%Mod%ModDataAry(i)) + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) call FAST_GetOP(ModData, SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, u_op=ModData%Lin%u, u_glue=uAry) if (Failed()) return end associate @@ -1140,11 +1145,10 @@ logical function Failed() end function end subroutine -subroutine SS_GetCalculatedInputs(AM, uAry, Mappings, InputIndex, T, ErrStat, ErrMsg) +subroutine SS_GetCalculatedInputs(AM, uAry, Mappings, T, ErrStat, ErrMsg) type(Glue_AeroMap), intent(inout) :: AM !< AeroMap module real(R8Ki), intent(inout) :: uAry(:) !< Inputs type(MappingType), intent(inout) :: Mappings(:) !< Transfer mapping data - integer(IntKi), intent(in) :: InputIndex !< Index into input array type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat !< Error status character(*), intent(out) :: ErrMsg !< Error message @@ -1157,15 +1161,15 @@ subroutine SS_GetCalculatedInputs(AM, uAry, Mappings, InputIndex, T, ErrStat, Er ErrMsg = "" ! Transfer motions to AeroDyn first - call SS_AD_InputSolve(AM, Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call SS_AD_InputSolve(AM, Mappings, INPUT_PREV, T, ErrStat2, ErrMsg2) if (Failed()) return ! Transfer loads to structural solver next - call FAST_InputSolve(AM%Mod%ModDataAry(1), AM%Mod%ModDataAry, Mappings, InputIndex, T, ErrStat2, ErrMsg2) + call FAST_InputSolve(iModStruct, AM%Mod%ModData, Mappings, INPUT_PREV, T, ErrStat2, ErrMsg2, AM%Mod%VarMaps) if (Failed()) return ! Pack the transferred inputs into the vector - call SS_GetInputs(AM, uAry, InputIndex, T, ErrStat2, ErrMsg2) + call SS_GetInputs(AM, uAry, INPUT_PREV, T, ErrStat2, ErrMsg2) if (Failed()) return contains diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index b2349b395f..401a1247d9 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -2,7 +2,7 @@ ! FAST_Funcs provides the glue code a uniform interface to module functions. !............................................................................... ! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! Copyright (C) 2024 National Renewable Energy Laboratory ! ! This file is part of FAST. ! @@ -27,6 +27,8 @@ module FAST_Funcs use AeroDyn use BeamDyn use ElastoDyn +use ExtPtfm_MCKF +use FEAMooring use HydroDyn use InflowWind use MAP @@ -34,6 +36,9 @@ module FAST_Funcs use SeaState use ServoDyn use SubDyn +use IceDyn +use IceFloe +use OrcaFlexInterface implicit none @@ -60,77 +65,83 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) select case (ModData%ID) case (Module_AD) - - call AD_Input_ExtrapInterp(T%AD%Input, T%AD%InputTimes, T%AD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 + if (ModData%Ins /= 1) return ! Perform extrap interp for first instance only, this advances all rotors + call AD_Input_ExtrapInterp(T%AD%Input(1:), T%AD%InputTimes, T%AD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 call AD_CopyInput(T%AD%Input(j), T%AD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%AD%InputTimes(j + 1) = T%AD%InputTimes(j) end do - call AD_CopyInput(T%AD%u, T%AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%AD%InputTimes(1) = t_global_next + call ShiftInputTimes(T%AD%InputTimes) case (Module_BD) - - call BD_Input_ExtrapInterp(T%BD%Input(:, ModData%Ins), T%BD%InputTimes(:, ModData%Ins), T%BD%u(ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 + call BD_Input_ExtrapInterp(T%BD%Input(1:, ModData%Ins), T%BD%InputTimes(:, ModData%Ins), T%BD%Input(0, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 call BD_CopyInput(T%BD%Input(j, ModData%Ins), T%BD%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%BD%InputTimes(j + 1, ModData%Ins) = T%BD%InputTimes(j, ModData%Ins) end do - call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input(1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%BD%InputTimes(1, ModData%Ins) = t_global_next + call ShiftInputTimes(T%BD%InputTimes(:, ModData%Ins)) case (Module_ED) - - call ED_Input_ExtrapInterp(T%ED%Input, T%ED%InputTimes, T%ED%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 + call ED_Input_ExtrapInterp(T%ED%Input(1:), T%ED%InputTimes, T%ED%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 call ED_CopyInput(T%ED%Input(j), T%ED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%ED%InputTimes(j + 1) = T%ED%InputTimes(j) end do - call ED_CopyInput(T%ED%u, T%ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%ED%InputTimes(1) = t_global_next + call ShiftInputTimes(T%ED%InputTimes) -! case (Module_ExtPtfm) -! case (Module_FEAM) - case (Module_HD) + case (Module_ExtPtfm) + call ExtPtfm_Input_ExtrapInterp(T%ExtPtfm%Input(1:), T%ExtPtfm%InputTimes, T%ExtPtfm%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call ExtPtfm_CopyInput(T%ExtPtfm%Input(j), T%ExtPtfm%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%ExtPtfm%InputTimes) - ! TODO: Fix inconsistent function name (HydroDyn_CopyInput) - call HydroDyn_Input_ExtrapInterp(T%HD%Input, T%HD%InputTimes, T%HD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 + case (Module_FEAM) + call FEAM_Input_ExtrapInterp(T%FEAM%Input(1:), T%FEAM%InputTimes, T%FEAM%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call FEAM_CopyInput(T%FEAM%Input(j), T%FEAM%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%FEAM%InputTimes) + + case (Module_HD) + call HydroDyn_Input_ExtrapInterp(T%HD%Input(1:), T%HD%InputTimes, T%HD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 call HydroDyn_CopyInput(T%HD%Input(j), T%HD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - T%HD%InputTimes(j + 1) = T%HD%InputTimes(j) end do - call HydroDyn_CopyInput(T%HD%u, T%HD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - T%HD%InputTimes(1) = t_global_next + call ShiftInputTimes(T%HD%InputTimes) ! case (Module_IceD) ! case (Module_IceF) case (Module_IfW) - - call InflowWind_Input_ExtrapInterp(T%IfW%Input, T%IfW%InputTimes, T%IfW%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 + call InflowWind_Input_ExtrapInterp(T%IfW%Input(1:), T%IfW%InputTimes, T%IfW%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 call InflowWind_CopyInput(T%IfW%Input(j), T%IfW%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%IfW%InputTimes(j + 1) = T%IfW%InputTimes(j) end do - call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%IfW%InputTimes(1) = t_global_next + call ShiftInputTimes(T%IfW%InputTimes) + + case (Module_MAP) + call MAP_Input_ExtrapInterp(T%MAP%Input(1:), T%MAP%InputTimes, T%MAP%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call MAP_CopyInput(T%MAP%Input(j), T%MAP%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%MAP%InputTimes) + + case (Module_MD) + call MD_Input_ExtrapInterp(T%MD%Input(1:), T%MD%InputTimes, T%MD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call MD_CopyInput(T%MD%Input(j), T%MD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%MD%InputTimes) -! case (Module_MAP) -! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) case (Module_SD) - - call SD_Input_ExtrapInterp(T%SD%Input, T%SD%InputTimes, T%SD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 + call SD_Input_ExtrapInterp(T%SD%Input(1:), T%SD%InputTimes, T%SD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 call SD_CopyInput(T%SD%Input(j), T%SD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - T%SD%InputTimes(j + 1) = T%SD%InputTimes(j) end do - call SD_CopyInput(T%SD%u, T%SD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - T%SD%InputTimes(1) = t_global_next + call ShiftInputTimes(T%SD%InputTimes) case (Module_SeaSt) - ! call SeaSt_Input_ExtrapInterp(T%SeaSt%Input, T%SeaSt%InputTimes, T%SeaSt%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + ! call SeaSt_Input_ExtrapInterp(T%SeaSt%Input(1:), T%SeaSt%InputTimes, T%SeaSt%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return ! do j = T%p_FAST%InterpOrder, 1, -1 ! call SeaSt_CopyInput(T%SeaSt%Input(j), T%SeaSt%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! T%SeaSt%InputTimes(j + 1) = T%SeaSt%InputTimes(j) @@ -140,29 +151,35 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) case (Module_SrvD) - call SrvD_Input_ExtrapInterp(T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 + call SrvD_Input_ExtrapInterp(T%SrvD%Input(1:), T%SrvD%InputTimes, T%SrvD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 call SrvD_CopyInput(T%SrvD%Input(j), T%SrvD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - T%SrvD%InputTimes(j + 1) = T%SrvD%InputTimes(j) end do - call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - T%SrvD%InputTimes(1) = t_global_next + call ShiftInputTimes(T%SrvD%InputTimes) case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return end select contains + subroutine ShiftInputTimes(InputTimes) + real(R8Ki) :: InputTimes(:) + integer(IntKi) :: k + do j = T%p_FAST%InterpOrder, 1, -1 + InputTimes(j + 1) = InputTimes(j) + end do + InputTimes(1) = t_global_next + end subroutine logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function end subroutine -subroutine FAST_InitIO(Mods, ThisTime, DT, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mods(:) !< Module data - real(DbKi), intent(in) :: ThisTime !< Initial simulation time (almost always 0) +subroutine FAST_InitIO(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModAry(:) !< Module data + real(DbKi), intent(in) :: ThisTime !< Initial simulation time (almost always 0) real(DbKi), intent(in) :: DT !< Glue code time step size type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -171,92 +188,74 @@ subroutine FAST_InitIO(Mods, ThisTime, DT, T, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_InitIO' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - real(DbKi) :: t_global_next ! Simulation time for computing outputs + real(DbKi) :: t_global_next ! Simulation time for computing outputs + real(DbKi), allocatable :: InputTimes(:) ! Input times array integer(IntKi) :: i, j, k ErrStat = ErrID_None ErrMsg = '' - ! Loop through modules - do i = 1, size(Mods) - - ! Copy state from current to predicted and initialze meshes - call FAST_CopyStates(Mods(i), T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - - ! Select based on module ID - select case (Mods(i)%ID) - - case (Module_AD) - - T%AD%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call AD_CopyInput(T%AD%Input(1), T%AD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call AD_CopyInput(T%AD%Input(1), T%AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - - case (Module_BD) - - T%BD%InputTimes(:, Mods(i)%Ins) = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call BD_CopyInput(T%BD%Input(1, Mods(i)%Ins), T%BD%Input(k, Mods(i)%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call BD_CopyInput(T%BD%Input(1, Mods(i)%Ins), T%BD%u(Mods(i)%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - - case (Module_ED) - - T%ED%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call ED_CopyInput(T%ED%Input(1), T%ED%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call ED_CopyInput(T%ED%Input(1), T%ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - -! case (Module_ExtPtfm) -! case (Module_FEAM) - case (Module_HD) - - T%HD%InputTimes(:) = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call HydroDyn_CopyInput(T%HD%Input(1), T%HD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call HydroDyn_CopyInput(T%HD%Input(1), T%HD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + ! Calculate input times array + InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] -! case (Module_IceD) -! case (Module_IceF) - - case (Module_IfW) + ! Loop through modules + do i = 1, size(ModAry) + associate (ModData => ModAry(i)) - ! TODO: Fix inconsistent function name - T%IfW%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + ! Copy state from current (1) to predicted (2), saved current (3), and saved predicted (4) + do k = 2, 4 + call FAST_CopyStates(ModData, T, STATE_CURR, k, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return end do - call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return -! case (Module_MAP) -! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) - case (Module_SD) - - T%SD%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + ! Copy input from current to interpolation locations do k = 2, T%p_FAST%InterpOrder + 1 - call SD_CopyInput(T%SD%Input(1), T%SD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call FAST_CopyInput(ModData, T, INPUT_CURR, k, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return end do - call SD_CopyInput(T%SD%Input(1), T%SD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - -! case (Module_SeaSt) - case (Module_SrvD) - T%SrvD%InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + ! Copy input from current to temporary location + call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_TEMP, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return - case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mods(i)%ID)), ErrStat, ErrMsg, RoutineName) - return - end select + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + T%AD%InputTimes = InputTimes + case (Module_BD) + T%BD%InputTimes(:, ModData%Ins) = InputTimes + case (Module_ED) + T%ED%InputTimes = InputTimes + case (Module_ExtPtfm) + T%ExtPtfm%InputTimes = InputTimes + case (Module_FEAM) + case (Module_HD) + T%HD%InputTimes = InputTimes + case (Module_IceD) + T%IceD%InputTimes(:, ModData%Ins) = InputTimes + case (Module_IceF) + T%IceF%InputTimes = InputTimes + case (Module_IfW) + T%IfW%InputTimes = InputTimes + case (Module_MAP) + T%MAP%InputTimes = InputTimes + case (Module_MD) + T%MD%InputTimes = InputTimes +! case (Module_ExtInfw) +! T%ExtInfw%InputTimes = InputTimes + case (Module_Orca) + T%Orca%InputTimes = InputTimes + case (Module_SD) + T%SD%InputTimes = InputTimes + case (Module_SeaSt) + T%SeaSt%InputTimes = InputTimes + case (Module_SrvD) + T%SrvD%InputTimes = InputTimes + case default + call SetErrStat(ErrID_Fatal, "Unknown module "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + end associate end do contains @@ -266,12 +265,10 @@ logical function Failed() end function end subroutine -subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ErrMsg) +subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) integer(IntKi), intent(in) :: n_t_global !< Integer time step - real(R8Ki), intent(inout) :: x_TC(:) !< Tight coupling state array - real(R8Ki), intent(inout) :: q_TC(:, :) !< Tight coupling state matrix type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -287,18 +284,17 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ErrStat = ErrID_None ErrMsg = '' - ! Copy from current to predicted state (MESH_UPDATECOPY) - call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! Select based on module ID select case (ModData%ID) case (Module_AD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return do j_ss = 1, ModData%SubSteps n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial - call AD_UpdateStates(t_module, n_t_module, T%AD%Input, T%AD%InputTimes, & + call AD_UpdateStates(t_module, n_t_module, T%AD%Input(1:), T%AD%InputTimes, & T%AD%p, T%AD%x(STATE_PRED), T%AD%xd(STATE_PRED), & T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), & T%AD%m, ErrStat2, ErrMsg2) @@ -306,121 +302,169 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS end do case (Module_BD) - - associate (p_BD => T%BD%p(ModData%Ins), & - m_BD => T%BD%m(ModData%Ins), & - u_BD => T%BD%Input(1, ModData%Ins), & - x_BD => T%BD%x(ModData%Ins, STATE_PRED), & - os_BD => T%BD%OtherSt(ModData%Ins, STATE_PRED)) - - ! Transfer tight coupling states to module - ! call BD_PackContStateQuatOP(p_BD, x_BD, m_BD%Jac%x) - ! call XferGblToLoc1D(ModData%ixs, x_TC, m_BD%Jac%x) - ! call BD_UnpackContStateQuatOP(p_BD, m_BD%Jac%x, x_BD) - - ! TODO: Fix state reset - ! Set BD accelerations and algorithmic accelerations from q matrix - ! do j = 1, size(p_BD%Vars%x) - ! select case (p_BD%Vars%x(j)%Field) - ! case (FieldTransDisp) - ! os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 3) - ! os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 4) - ! case (FieldOrientation) - ! os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 3) - ! os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 4) - ! end select - ! end do - - ! Update the global reference - ! call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg) - ! if (Failed()) return - - ! Update q matrix accelerations and algorithmic accelerations from BD - ! do j = 1, size(p_BD%Vars%x) - ! select case (p_BD%Vars%x(j)%Field) - ! case (FieldTransDisp) - ! q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) - ! q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) - ! case (FieldOrientation) - ! q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) - ! q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) - ! end select - ! end do - - ! Transfer updated states to solver - ! call BD_PackContStateQuatOP(p_BD, x_BD, m_BD%Jac%x) - ! call XferLocToGbl1D(ModData%ixs, m_BD%Jac%x, x_TC) - end associate + ! State update is handled by solver as part of tight coupling case (Module_ED) + ! State update is handled by solver as part of tight coupling - associate (p_ED => T%ED%p, m_ED => T%ED%m, & - u_ED => T%ED%Input(1), x_ED => T%ED%x(STATE_PRED)) + ! associate (p_ED => T%ED%p, m_ED => T%ED%m, & + ! u_ED => T%ED%Input(1), x_ED => T%ED%x(STATE_PRED)) - ! Transfer tight coupling states to module - ! call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) - ! call ED_UnpackContStateOP(p_ED, m_ED%Jac%x, x_ED) + ! Transfer tight coupling states to module + ! call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) + ! call ED_UnpackContStateOP(p_ED, m_ED%Jac%x, x_ED) - ! Update the azimuth angle - ! call ED_UpdateAzimuth(p_ED, x_ED, T%p_FAST%DT) + ! Update the azimuth angle + call ED_UpdateAzimuth(T%ED%p, T%ED%x(STATE_PRED), ModData%DT) - ! Transfer updated states to solver - ! call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) + ! Transfer updated states to solver + ! call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) - end associate + ! end associate + + case (Module_ExtPtfm) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call ExtPtfm_UpdateStates(t_module, n_t_module, T%ExtPtfm%Input(1:), T%ExtPtfm%InputTimes, & + T%ExtPtfm%p, T%ExtPtfm%x(STATE_PRED), T%ExtPtfm%xd(STATE_PRED), & + T%ExtPtfm%z(STATE_PRED), T%ExtPtfm%OtherSt(STATE_PRED), & + T%ExtPtfm%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_FEAM) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call FEAM_UpdateStates(t_module, n_t_module, T%FEAM%Input(1:), T%FEAM%InputTimes, T%FEAM%p, & + T%FEAM%x(STATE_PRED), T%FEAM%xd(STATE_PRED), & + T%FEAM%z(STATE_PRED), T%FEAM%OtherSt(STATE_PRED), & + T%FEAM%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do -! case (Module_ExtPtfm) -! case (Module_FEAM) case (Module_HD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return do j_ss = 1, ModData%SubSteps n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial - call HydroDyn_UpdateStates(t_module, n_t_module, T%HD%Input, T%HD%InputTimes, T%HD%p, & + call HydroDyn_UpdateStates(t_module, n_t_module, T%HD%Input(1:), T%HD%InputTimes, T%HD%p, & T%HD%x(STATE_PRED), T%HD%xd(STATE_PRED), & T%HD%z(STATE_PRED), T%HD%OtherSt(STATE_PRED), & T%HD%m, ErrStat2, ErrMsg2) if (Failed()) return end do -! case (Module_IceD) -! case (Module_IceF) + case (Module_IceD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call IceD_UpdateStates(t_module, n_t_module, T%IceD%Input(1:, ModData%Ins), & + T%IceD%InputTimes(1:, ModData%Ins), T%IceD%p(ModData%Ins), & + T%IceD%x(ModData%Ins, STATE_PRED), T%IceD%xd(ModData%Ins, STATE_PRED), & + T%IceD%z(ModData%Ins, STATE_PRED), T%IceD%OtherSt(ModData%Ins, STATE_PRED), & + T%IceD%m(ModData%Ins), ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_IceF) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call IceFloe_UpdateStates(t_module, n_t_module, T%IceF%Input(1:), T%IceF%InputTimes, T%IceF%p, & + T%IceF%x(STATE_PRED), T%IceF%xd(STATE_PRED), & + T%IceF%z(STATE_PRED), T%IceF%OtherSt(STATE_PRED), & + T%IceF%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + case (Module_IfW) + ! InflowWind does not have states - ! do j_ss = 1, ModData%SubSteps - ! n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 - ! t_module = n_t_module*ModData%DT + t_initial - ! call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, & - ! T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & - ! T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), & - ! T%IfW%m, ErrStat2, ErrMsg2) - ! if (Failed()) return - ! end do + case (Module_MAP) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call MD_UpdateStates(t_module, n_t_module, T%MD%Input(1:), T%MD%InputTimes, T%MD%p, & + T%MD%x(STATE_PRED), T%MD%xd(STATE_PRED), & + T%MD%z(STATE_PRED), T%MD%OtherSt(STATE_PRED), & + T%MD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_MD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call MD_UpdateStates(t_module, n_t_module, T%MD%Input(1:), T%MD%InputTimes, T%MD%p, & + T%MD%x(STATE_PRED), T%MD%xd(STATE_PRED), & + T%MD%z(STATE_PRED), T%MD%OtherSt(STATE_PRED), & + T%MD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do -! case (Module_MAP) -! case (Module_MD) ! case (Module_OpFM) -! case (Module_Orca) - case (Module_SD) - associate (p_SD => T%SD%p, m_SD => T%SD%m, & - u_SD => T%SD%Input(1), x_SD => T%SD%x(STATE_PRED)) + case (Module_Orca) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return - ! TODO: Add Lin struct to SubDyn - ! Transfer tight coupling states to module - ! call SD_PackStateValues(p_SD, x_SD, m_SD%Lin%x) - ! call XferGblToLoc1D(ModData%ixs, x_TC, m_SD%Lin%x) - ! call SD_UnpackStateValues(p_SD, m_SD%Lin%x, x_SD) + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call Orca_UpdateStates(t_module, n_t_module, T%Orca%Input(1:), T%Orca%InputTimes, T%Orca%p, & + T%Orca%x(STATE_PRED), T%Orca%xd(STATE_PRED), & + T%Orca%z(STATE_PRED), T%Orca%OtherSt(STATE_PRED), & + T%Orca%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do - end associate + case (Module_SD) + ! State update is handled by solver as part of tight coupling + + case (Module_SeaSt) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call SeaSt_UpdateStates(t_module, n_t_module, T%SeaSt%Input(1:), T%SeaSt%InputTimes, T%SeaSt%p, & + T%SeaSt%x(STATE_PRED), T%SeaSt%xd(STATE_PRED), & + T%SeaSt%z(STATE_PRED), T%SeaSt%OtherSt(STATE_PRED), & + T%SeaSt%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do -! case (Module_SeaSt) case (Module_SrvD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return do j_ss = 1, ModData%SubSteps n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial - call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, & + call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input(1:), T%SrvD%InputTimes, T%SrvD%p, & T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), & T%SrvD%m, ErrStat2, ErrMsg2) @@ -428,7 +472,7 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS end do case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return end select @@ -439,12 +483,12 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, CalcWriteOutput) +subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrStat, ErrMsg, CalcWriteOutput) type(ModDataType), intent(in) :: ModData !< Module data - type(MappingType), intent(inout) :: Maps(:) !< Output->Input mappings + type(MappingType), intent(inout) :: Mappings(:) !< Output->Input mappings real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: InputIndex !< Input index - integer(IntKi), intent(in) :: StateIndex !< State index + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -469,44 +513,67 @@ subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, E select case (ModData%ID) case (Module_AD) - call AD_CalcOutput(ThisTime, T%AD%Input(InputIndex), T%AD%p, T%AD%x(StateIndex), T%AD%xd(StateIndex), T%AD%z(StateIndex), & - T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, CalcWriteOutput) + call AD_CalcOutput(ThisTime, T%AD%Input(iInput), T%AD%p, & + T%AD%x(iState), T%AD%xd(iState), T%AD%z(iState), T%AD%OtherSt(iState), & + T%AD%y, T%AD%m, ErrStat2, ErrMsg2, CalcWriteOutput) case (Module_BD) - call BD_CalcOutput(ThisTime, T%BD%Input(InputIndex, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, StateIndex), & - T%BD%xd(ModData%Ins, StateIndex), T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & + call BD_CalcOutput(ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, iState), T%BD%xd(ModData%Ins, iState), & + T%BD%z(ModData%Ins, iState), T%BD%OtherSt(ModData%Ins, iState), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, CalcWriteOutput) case (Module_ED) - call ED_CalcOutput(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & - T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), T%ED%y, T%ED%m, ErrStat2, ErrMsg2) -! case (Module_ExtPtfm) -! case (Module_FEAM) + call ED_CalcOutput(ThisTime, T%ED%Input(iInput), T%ED%p, & + T%ED%x(iState), T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & + T%ED%y, T%ED%m, ErrStat2, ErrMsg2) + + case (Module_ExtPtfm) + call ExtPtfm_CalcOutput(ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, & + T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), T%ExtPtfm%z(iState), T%ExtPtfm%OtherSt(iState), & + T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2) + + case (Module_FEAM) + call FEAM_CalcOutput(ThisTime, T%FEAM%Input(iInput), T%FEAM%p, & + T%FEAM%x(iState), T%FEAM%xd(iState), T%FEAM%z(iState), T%FEAM%OtherSt(iState), & + T%FEAM%y, T%FEAM%m, ErrStat2, ErrMsg2) + case (Module_HD) - call HydroDyn_CalcOutput(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & - T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2) + call HydroDyn_CalcOutput(ThisTime, T%HD%Input(iInput), T%HD%p, & + T%HD%x(iState), T%HD%xd(iState), T%HD%z(iState), T%HD%OtherSt(iState), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2) ! case (Module_IceD) ! case (Module_IceF) case (Module_IfW) - call InflowWind_CalcOutput(ThisTime, T%IfW%Input(InputIndex), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), T%IfW%z(StateIndex), & - T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) + call InflowWind_CalcOutput(ThisTime, T%IfW%Input(iInput), T%IfW%p, & + T%IfW%x(iState), T%IfW%xd(iState), T%IfW%z(iState), T%IfW%OtherSt(iState), & + T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) + + case (Module_MAP) + call MAP_CalcOutput(ThisTime, T%MAP%Input(iInput), T%MAP%p, & + T%MAP%x(iState), T%MAP%xd(iState), T%MAP%z(iState), T%MAP%OtherSt, & + T%MAP%y, ErrStat2, ErrMsg2) -! case (Module_MAP) -! case (Module_MD) + case (Module_MD) + call MD_CalcOutput(ThisTime, T%MD%Input(iInput), T%MD%p, & + T%MD%x(iState), T%MD%xd(iState), T%MD%z(iState), T%MD%OtherSt(iState), & + T%MD%y, T%MD%m, ErrStat2, ErrMsg2) ! case (Module_OpFM) ! case (Module_Orca) case (Module_SD) - call SD_CalcOutput(ThisTime, T%SD%Input(InputIndex), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), T%SD%z(StateIndex), & - T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2) + call SD_CalcOutput(ThisTime, T%SD%Input(iInput), T%SD%p, & + T%SD%x(iState), T%SD%xd(iState), T%SD%z(iState), T%SD%OtherSt(iState), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2) ! case (Module_SeaSt) case (Module_SrvD) - call SrvD_CalcOutput(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), & - T%SrvD%OtherSt(StateIndex), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) + call SrvD_CalcOutput(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, & + T%SrvD%x(iState), T%SrvD%xd(iState), T%SrvD%z(iState), T%SrvD%OtherSt(iState), & + T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return end select @@ -514,18 +581,20 @@ subroutine FAST_CalcOutput(ModData, Maps, ThisTime, InputIndex, StateIndex, T, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - ! Set updated flag in mappings where this module is the source - Maps(ModData%iSrcMaps)%Ready = .true. + ! Set ready flag in mappings where this module is the source + do i = 1, size(Mappings) + if (Mappings(i)%iModSrc == ModData%iMod) Mappings(i)%Ready = .true. + end do end subroutine -subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, ErrMsg, & +subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & u_op, y_op, x_op, dx_op, z_op, u_glue, y_glue, x_glue, dx_glue, z_glue) use AeroDyn, only: AD_CalcWind_Rotor type(ModDataType), intent(in) :: ModData !< Module information real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: InputIndex !< Input index - integer(IntKi), intent(in) :: StateIndex !< State index + integer(IntKi), intent(in) :: iIndex !< Input index + integer(IntKi), intent(in) :: iState !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -559,42 +628,42 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_PackInputAry(ModData%Vars, T%AD%Input(InputIndex)%rotors(ModData%Ins), u_op) - call AD_PackExtInputAry(ModData%Vars, ThisTime, T%AD%p, u_op) + call AD_VarsPackInput(ModData%Vars, T%AD%Input(iIndex)%rotors(ModData%Ins), u_op) + call AD_VarsPackExtInput(ModData%Vars, ThisTime, T%AD%p, u_op) case (Module_BD) - call BD_PackInputAry(ModData%Vars, T%BD%Input(InputIndex, ModData%Ins), u_op) + call BD_VarsPackInput(ModData%Vars, T%BD%Input(iIndex, ModData%Ins), u_op) case (Module_ED) - call ED_PackInputAry(ModData%Vars, T%ED%Input(InputIndex), u_op) - call ED_PackExtInputAry(ModData%Vars, T%ED%Input(InputIndex), u_op, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackInput(ModData%Vars, T%ED%Input(iIndex), u_op) + call ED_PackExtInputAry(ModData%Vars, T%ED%Input(iIndex), u_op, ErrStat2, ErrMsg2); if (Failed()) return case (Module_ExtPtfm) - call ExtPtfm_PackInputAry(ModData%Vars, T%ExtPtfm%Input(InputIndex), u_op) + call ExtPtfm_VarsPackInput(ModData%Vars, T%ExtPtfm%Input(iIndex), u_op) case (Module_FEAM) - call FEAM_PackInputAry(ModData%Vars, T%FEAM%Input(InputIndex), u_op) + call FEAM_VarsPackInput(ModData%Vars, T%FEAM%Input(iIndex), u_op) case (Module_HD) - call HydroDyn_PackInputAry(ModData%Vars, T%HD%Input(InputIndex), u_op) - call HD_PackExtInputAry(ModData%Vars, T%HD%Input(InputIndex), u_op) + call HydroDyn_VarsPackInput(ModData%Vars, T%HD%Input(iIndex), u_op) + call HD_PackExtInputAry(ModData%Vars, T%HD%Input(iIndex), u_op) case (Module_IceD) - call IceD_PackInputAry(ModData%Vars, T%IceD%Input(InputIndex, ModData%Ins), u_op) + call IceD_VarsPackInput(ModData%Vars, T%IceD%Input(iIndex, ModData%Ins), u_op) case (Module_IceF) - call IceFloe_PackInputAry(ModData%Vars, T%IceF%Input(InputIndex), u_op) + call IceFloe_VarsPackInput(ModData%Vars, T%IceF%Input(iIndex), u_op) case (Module_IfW) - call InflowWind_PackInputAry(ModData%Vars, T%IfW%Input(InputIndex), u_op) + call InflowWind_VarsPackInput(ModData%Vars, T%IfW%Input(iIndex), u_op) call InflowWind_PackExtInputAry(ModData%Vars, ThisTime, T%IfW%p, u_op) case (Module_MAP) - call MAP_PackInputAry(ModData%Vars, T%MAP%Input(InputIndex), u_op) + call MAP_VarsPackInput(ModData%Vars, T%MAP%Input(iIndex), u_op) case (Module_MD) - call MD_PackInputAry(ModData%Vars, T%MD%Input(InputIndex), u_op) + call MD_VarsPackInput(ModData%Vars, T%MD%Input(iIndex), u_op) case (Module_ExtInfw) - ! call ExtInfw_PackInputAry(ModData%Vars, T%ExtInfw%Input(InputIndex), u_op) + ! call ExtInfw_VarsPackInput(ModData%Vars, T%ExtInfw%Input(iIndex), u_op) case (Module_Orca) - call Orca_PackInputAry(ModData%Vars, T%Orca%Input(InputIndex), u_op) + call Orca_VarsPackInput(ModData%Vars, T%Orca%Input(iIndex), u_op) case (Module_SD) - call SD_PackInputAry(ModData%Vars, T%SD%Input(InputIndex), u_op) + call SD_VarsPackInput(ModData%Vars, T%SD%Input(iIndex), u_op) case (Module_SeaSt) - call SeaSt_PackInputAry(ModData%Vars, T%SeaSt%Input(InputIndex), u_op) - call SeaSt_PackExtInputAry(ModData%Vars, T%SeaSt%Input(InputIndex), u_op) + call SeaSt_VarsPackInput(ModData%Vars, T%SeaSt%Input(iIndex), u_op) + call SeaSt_PackExtInputAry(ModData%Vars, T%SeaSt%Input(iIndex), u_op) case (Module_SrvD) - call SrvD_PackInputAry(ModData%Vars, T%SrvD%Input(InputIndex), u_op) + call SrvD_VarsPackInput(ModData%Vars, T%SrvD%Input(iIndex), u_op) case default call SetErrStat(ErrID_Fatal, "Input unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -615,39 +684,39 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_PackOutputAry(ModData%Vars, T%AD%y%rotors(ModData%Ins), y_op) + call AD_VarsPackOutput(ModData%Vars, T%AD%y%rotors(ModData%Ins), y_op) case (Module_BD) - call BD_PackOutputAry(ModData%Vars, T%BD%y(ModData%Ins), y_op) + call BD_VarsPackOutput(ModData%Vars, T%BD%y(ModData%Ins), y_op) case (Module_ED) - call ED_PackOutputAry(ModData%Vars, T%ED%y, y_op) + call ED_VarsPackOutput(ModData%Vars, T%ED%y, y_op) case (Module_ExtPtfm) - call ExtPtfm_PackOutputAry(ModData%Vars, T%ExtPtfm%y, y_op) + call ExtPtfm_VarsPackOutput(ModData%Vars, T%ExtPtfm%y, y_op) case (Module_FEAM) - call FEAM_PackOutputAry(ModData%Vars, T%FEAM%y, y_op) + call FEAM_VarsPackOutput(ModData%Vars, T%FEAM%y, y_op) case (Module_HD) - call HydroDyn_PackOutputAry(ModData%Vars, T%HD%y, y_op) + call HydroDyn_VarsPackOutput(ModData%Vars, T%HD%y, y_op) case (Module_IceD) - call IceD_PackOutputAry(ModData%Vars, T%IceD%y(ModData%Ins), y_op) + call IceD_VarsPackOutput(ModData%Vars, T%IceD%y(ModData%Ins), y_op) case (Module_IceF) - call IceFloe_PackOutputAry(ModData%Vars, T%IceF%y, y_op) + call IceFloe_VarsPackOutput(ModData%Vars, T%IceF%y, y_op) case (Module_IfW) - call InflowWind_PackOutputAry(ModData%Vars, T%IfW%y, y_op) + call InflowWind_VarsPackOutput(ModData%Vars, T%IfW%y, y_op) call InflowWind_PackExtOutputAry(ModData%Vars, ThisTime, T%IfW%p, y_op) case (Module_MAP) - call MAP_PackOutputAry(ModData%Vars, T%MAP%y, y_op) + call MAP_VarsPackOutput(ModData%Vars, T%MAP%y, y_op) case (Module_MD) - call MD_PackOutputAry(ModData%Vars, T%MD%y, y_op) + call MD_VarsPackOutput(ModData%Vars, T%MD%y, y_op) case (Module_ExtInfw) - call ExtInfw_PackOutputAry(ModData%Vars, T%ExtInfw%y, y_op) + call ExtInfw_VarsPackOutput(ModData%Vars, T%ExtInfw%y, y_op) case (Module_Orca) - call Orca_PackOutputAry(ModData%Vars, T%Orca%y, y_op) + call Orca_VarsPackOutput(ModData%Vars, T%Orca%y, y_op) case (Module_SD) - call SD_PackOutputAry(ModData%Vars, T%SD%y, y_op) + call SD_VarsPackOutput(ModData%Vars, T%SD%y, y_op) case (Module_SeaSt) call SeaSt_PackExtOutputAry(ModData%Vars, T%SeaSt%y, y_op) - call SeaSt_PackOutputAry(ModData%Vars, T%SeaSt%y, y_op) + call SeaSt_VarsPackOutput(ModData%Vars, T%SeaSt%y, y_op) case (Module_SrvD) - call SrvD_PackOutputAry(ModData%Vars, T%SrvD%y, y_op) + call SrvD_VarsPackOutput(ModData%Vars, T%SrvD%y, y_op) case default call SetErrStat(ErrID_Fatal, "Output unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -668,37 +737,37 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_PackContStateAry(ModData%Vars, T%AD%x(StateIndex)%rotors(ModData%Ins), x_op) + call AD_VarsPackContState(ModData%Vars, T%AD%x(iState)%rotors(ModData%Ins), x_op) case (Module_BD) - call BD_PackContStateAry(ModData%Vars, T%BD%x(ModData%Ins, StateIndex), x_op) + call BD_VarsPackContState(ModData%Vars, T%BD%x(ModData%Ins, iState), x_op) case (Module_ED) - call ED_PackContStateAry(ModData%Vars, T%ED%x(StateIndex), x_op) + call ED_VarsPackContState(ModData%Vars, T%ED%x(iState), x_op) case (Module_ExtPtfm) - call ExtPtfm_PackContStateAry(ModData%Vars, T%ExtPtfm%x(StateIndex), x_op) + call ExtPtfm_VarsPackContState(ModData%Vars, T%ExtPtfm%x(iState), x_op) case (Module_FEAM) - call FEAM_PackContStateAry(ModData%Vars, T%FEAM%x(StateIndex), x_op) + call FEAM_VarsPackContState(ModData%Vars, T%FEAM%x(iState), x_op) case (Module_HD) - call HydroDyn_PackContStateAry(ModData%Vars, T%HD%x(StateIndex), x_op) + call HydroDyn_VarsPackContState(ModData%Vars, T%HD%x(iState), x_op) case (Module_IceD) - call IceD_PackContStateAry(ModData%Vars, T%IceD%x(ModData%Ins, StateIndex), x_op) + call IceD_VarsPackContState(ModData%Vars, T%IceD%x(ModData%Ins, iState), x_op) case (Module_IceF) - call IceFloe_PackContStateAry(ModData%Vars, T%IceF%x(StateIndex), x_op) + call IceFloe_VarsPackContState(ModData%Vars, T%IceF%x(iState), x_op) case (Module_IfW) - call InflowWind_PackContStateAry(ModData%Vars, T%IfW%x(StateIndex), x_op) + call InflowWind_VarsPackContState(ModData%Vars, T%IfW%x(iState), x_op) case (Module_MAP) - call MAP_PackContStateAry(ModData%Vars, T%MAP%x(StateIndex), x_op) + call MAP_VarsPackContState(ModData%Vars, T%MAP%x(iState), x_op) case (Module_MD) - call MD_PackContStateAry(ModData%Vars, T%MD%x(StateIndex), x_op) + call MD_VarsPackContState(ModData%Vars, T%MD%x(iState), x_op) case (Module_ExtInfw) - ! call ExtInfw_PackContStateAry(ModData%Vars, T%ExtInfw%x(StateIndex), x_op) + ! call ExtInfw_VarsPackContState(ModData%Vars, T%ExtInfw%x(StateIndex), x_op) case (Module_Orca) - call Orca_PackContStateAry(ModData%Vars, T%Orca%x(StateIndex), x_op) + call Orca_VarsPackContState(ModData%Vars, T%Orca%x(iState), x_op) case (Module_SD) - call SD_PackContStateAry(ModData%Vars, T%SD%x(StateIndex), x_op) + call SD_VarsPackContState(ModData%Vars, T%SD%x(iState), x_op) case (Module_SeaSt) - call SeaSt_PackContStateAry(ModData%Vars, T%SeaSt%x(StateIndex), x_op) + call SeaSt_VarsPackContState(ModData%Vars, T%SeaSt%x(iState), x_op) case (Module_SrvD) - call SrvD_PackContStateAry(ModData%Vars, T%SrvD%x(StateIndex), x_op) + call SrvD_VarsPackContState(ModData%Vars, T%SrvD%x(iState), x_op) case default call SetErrStat(ErrID_Fatal, "Continuous State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -720,107 +789,107 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err select case (ModData%ID) case (Module_AD) i = 1 - call AD_CalcWind_Rotor(ThisTime, T%AD%Input(InputIndex)%rotors(ModData%Ins), & + call AD_CalcWind_Rotor(ThisTime, T%AD%Input(iIndex)%rotors(ModData%Ins), & T%AD%p%FlowField, T%AD%p%rotors(ModData%Ins), & - T%AD%m%Inflow(InputIndex)%RotInflow(ModData%Ins), & + T%AD%m%Inflow(iIndex)%RotInflow(ModData%Ins), & i, ErrStat2, ErrMsg2) if (Failed()) return - call RotCalcContStateDeriv(ThisTime, T%AD%Input(InputIndex)%rotors(ModData%Ins), & - T%AD%m%Inflow(InputIndex)%RotInflow(ModData%Ins), & + call RotCalcContStateDeriv(ThisTime, T%AD%Input(iIndex)%rotors(ModData%Ins), & + T%AD%m%Inflow(iIndex)%RotInflow(ModData%Ins), & T%AD%p%rotors(ModData%Ins), T%AD%p, & - T%AD%x(StateIndex)%rotors(ModData%Ins), & - T%AD%xd(StateIndex)%rotors(ModData%Ins), & - T%AD%z(StateIndex)%rotors(ModData%Ins), & - T%AD%OtherSt(StateIndex)%rotors(ModData%Ins), & + T%AD%x(iState)%rotors(ModData%Ins), & + T%AD%xd(iState)%rotors(ModData%Ins), & + T%AD%z(iState)%rotors(ModData%Ins), & + T%AD%OtherSt(iState)%rotors(ModData%Ins), & T%AD%m%rotors(ModData%Ins), & T%AD%m%rotors(ModData%Ins)%dxdt_lin, & ErrStat2, ErrMsg2) if (Failed()) return - call AD_PackContStateDerivAry(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) + call AD_VarsPackContStateDeriv(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) case (Module_BD) - call BD_CalcContStateDeriv(ThisTime, T%BD%Input(InputIndex, ModData%Ins), & + call BD_CalcContStateDeriv(ThisTime, T%BD%Input(iIndex, ModData%Ins), & T%BD%p(ModData%Ins), & - T%BD%x(ModData%Ins, StateIndex), & - T%BD%xd(ModData%Ins, StateIndex), & - T%BD%z(ModData%Ins, StateIndex), & - T%BD%OtherSt(ModData%Ins, StateIndex), & + T%BD%x(ModData%Ins, iState), & + T%BD%xd(ModData%Ins, iState), & + T%BD%z(ModData%Ins, iState), & + T%BD%OtherSt(ModData%Ins, iState), & T%BD%m(ModData%Ins), & T%BD%m(ModData%Ins)%dxdt_lin, & ErrStat2, ErrMsg2) if (Failed()) return - call BD_PackContStateDerivAry(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) + call BD_VarsPackContStateDeriv(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) case (Module_ED) - call ED_CalcContStateDeriv(ThisTime, T%ED%Input(InputIndex), T%ED%p, T%ED%x(StateIndex), & - T%ED%xd(StateIndex), T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), & + call ED_CalcContStateDeriv(ThisTime, T%ED%Input(iIndex), T%ED%p, T%ED%x(iState), & + T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & T%ED%m, T%ED%m%dxdt_lin, ErrStat2, ErrMsg2) if (Failed()) return - call ED_PackContStateDerivAry(ModData%Vars, T%ED%m%dxdt_lin, dx_op) + call ED_VarsPackContStateDeriv(ModData%Vars, T%ED%m%dxdt_lin, dx_op) -! case (Module_ExtPtfm) -! call ExtPtfm_CalcContStatExtPtfmeriv(ThisTime, T%ExtPtfm%Input(InputIndex), & -! T%ExtPtfm%p, T%ExtPtfm%x(StateIndex), & -! T%ExtPtfm%xd(StateIndex), T%ExtPtfm%z(StateIndex), & -! T%ExtPtfm%OtherSt(StateIndex), & -! T%ExtPtfm%m, T%ExtPtfm%m%dxdt_lin, & -! ErrStat2, ErrMsg2); if (Failed()) return -! call ExtPtfm_PackContStateAry(ModData%Vars, T%ExtPtfm%m%dxdt_lin, dx_op) + case (Module_ExtPtfm) + call ExtPtfm_CalcContStateDeriv(ThisTime, T%ExtPtfm%Input(iIndex), & + T%ExtPtfm%p, T%ExtPtfm%x(iState), & + T%ExtPtfm%xd(iState), T%ExtPtfm%z(iState), & + T%ExtPtfm%OtherSt(iState), & + T%ExtPtfm%m, T%ExtPtfm%m%dxdt_lin, & + ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_VarsPackContState(ModData%Vars, T%ExtPtfm%m%dxdt_lin, dx_op) ! case (Module_FEAM) -! call FEAM_PackContStateAry(ModData%Vars, T%FEAM%x(StateIndex), dx_op) +! call FEAM_VarsPackContState(ModData%Vars, T%FEAM%x(StateIndex), dx_op) case (Module_HD) - call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(InputIndex), T%HD%p, T%HD%x(StateIndex), & - T%HD%xd(StateIndex), T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), & + call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(iIndex), T%HD%p, T%HD%x(iState), & + T%HD%xd(iState), T%HD%z(iState), T%HD%OtherSt(iState), & T%HD%m, T%HD%m%dxdt_lin, ErrStat2, ErrMsg2) if (Failed()) return - call HydroDyn_PackContStateDerivAry(ModData%Vars, T%HD%m%dxdt_lin, dx_op) + call HydroDyn_VarsPackContStateDeriv(ModData%Vars, T%HD%m%dxdt_lin, dx_op) ! case (Module_IceD) ! call IceD_CalcContStateDeriv(ThisTime, T%IceD%Input(InputIndex), T%IceD%p, T%IceD%x(StateIndex), & ! T%IceD%xd(StateIndex), T%IceD%z(StateIndex), T%IceD%OtherSt(StateIndex), & ! T%IceD%m, T%IceD%m%dxdt_lin, ErrStat2, ErrMsg2) ! if (Failed()) return -! call IceD_PackContStateDerivAry(ModData%Vars, T%IceD%m%dxdt_lin, dx_op) +! call IceD_VarsPackContStateDeriv(ModData%Vars, T%IceD%m%dxdt_lin, dx_op) ! case (Module_IceF) -! call IceFloe_PackContStateDerivAry(ModData%Vars, T%IceF%x(StateIndex), dx_op) +! call IceFloe_VarsPackContStateDeriv(ModData%Vars, T%IceF%x(StateIndex), dx_op) ! case (Module_IfW) -! call InflowWind_PackContStateDerivAry(ModData%Vars, T%IfW%x(StateIndex), dx_op) +! call InflowWind_VarsPackContStateDeriv(ModData%Vars, T%IfW%x(StateIndex), dx_op) ! case (Module_MAP) -! call MAP_PackContStateDerivAry(ModData%Vars, T%MAP%x(StateIndex), dx_op) +! call MAP_VarsPackContStateDeriv(ModData%Vars, T%MAP%x(StateIndex), dx_op) case (Module_MD) - call MD_CalcContStateDeriv(ThisTime, T%MD%Input(InputIndex), T%MD%p, T%MD%x(StateIndex), & - T%MD%xd(StateIndex), T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), & + call MD_CalcContStateDeriv(ThisTime, T%MD%Input(iIndex), T%MD%p, T%MD%x(iState), & + T%MD%xd(iState), T%MD%z(iState), T%MD%OtherSt(iState), & T%MD%m, T%MD%m%dxdt_lin, ErrStat2, ErrMsg2) if (Failed()) return - call MD_PackContStateDerivAry(ModData%Vars, T%MD%m%dxdt_lin, dx_op) + call MD_VarsPackContStateDeriv(ModData%Vars, T%MD%m%dxdt_lin, dx_op) ! case (Module_ExtInfw) -! call ExtInfw_PackContStateDerivAry(ModData%Vars, T%ExtInfw%x(StateIndex), dx_op) +! call ExtInfw_VarsPackContStateDeriv(ModData%Vars, T%ExtInfw%x(StateIndex), dx_op) ! case (Module_Orca) -! call Orca_PackContStateDerivAry(ModData%Vars, T%Orca%x(StateIndex), dx_op) +! call Orca_VarsPackContStateDeriv(ModData%Vars, T%Orca%x(StateIndex), dx_op) case (Module_SD) - call SD_CalcContStateDeriv(ThisTime, T%SD%Input(InputIndex), T%SD%p, T%SD%x(StateIndex), & - T%SD%xd(StateIndex), T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), & + call SD_CalcContStateDeriv(ThisTime, T%SD%Input(iIndex), T%SD%p, T%SD%x(iState), & + T%SD%xd(iState), T%SD%z(iState), T%SD%OtherSt(iState), & T%SD%m, T%SD%m%dxdt_lin, ErrStat2, ErrMsg2) if (Failed()) return - call SD_PackContStateDerivAry(ModData%Vars, T%SD%m%dxdt_lin, dx_op) + call SD_VarsPackContStateDeriv(ModData%Vars, T%SD%m%dxdt_lin, dx_op) ! case (Module_SeaSt) -! call SeaSt_PackContStateDerivAry(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) +! call SeaSt_VarsPackContStateDeriv(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) case (Module_SrvD) - call SrvD_CalcContStateDeriv(ThisTime, T%SrvD%Input(InputIndex), T%SrvD%p, T%SrvD%x(StateIndex), & - T%SrvD%xd(StateIndex), T%SrvD%z(StateIndex), T%SrvD%OtherSt(StateIndex), & + call SrvD_CalcContStateDeriv(ThisTime, T%SrvD%Input(iIndex), T%SrvD%p, T%SrvD%x(iState), & + T%SrvD%xd(iState), T%SrvD%z(iState), T%SrvD%OtherSt(iState), & T%SrvD%m, T%SrvD%m%dxdt_lin, ErrStat2, ErrMsg2) - call SrvD_PackContStateDerivAry(ModData%Vars, T%SrvD%m%dxdt_lin, dx_op) + call SrvD_VarsPackContStateDeriv(ModData%Vars, T%SrvD%m%dxdt_lin, dx_op) case default call SetErrStat(ErrID_Fatal, "Continuous State Derivatives unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) @@ -842,37 +911,37 @@ subroutine FAST_GetOP(ModData, ThisTime, InputIndex, StateIndex, T, ErrStat, Err ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_PackContStateAry(ModData%Vars, T%AD%x(StateIndex)%rotors(ModData%Ins), z_op) + call AD_VarsPackContState(ModData%Vars, T%AD%x(iState)%rotors(ModData%Ins), z_op) case (Module_BD) - call BD_PackContStateAry(ModData%Vars, T%BD%x(ModData%Ins, StateIndex), z_op) + call BD_VarsPackContState(ModData%Vars, T%BD%x(ModData%Ins, iState), z_op) case (Module_ED) - call ED_PackContStateAry(ModData%Vars, T%ED%x(StateIndex), z_op) + call ED_VarsPackContState(ModData%Vars, T%ED%x(iState), z_op) case (Module_ExtPtfm) - call ExtPtfm_PackContStateAry(ModData%Vars, T%ExtPtfm%x(StateIndex), z_op) + call ExtPtfm_VarsPackContState(ModData%Vars, T%ExtPtfm%x(iState), z_op) case (Module_FEAM) - call FEAM_PackContStateAry(ModData%Vars, T%FEAM%x(StateIndex), z_op) + call FEAM_VarsPackContState(ModData%Vars, T%FEAM%x(iState), z_op) case (Module_HD) - call HydroDyn_PackContStateAry(ModData%Vars, T%HD%x(StateIndex), z_op) + call HydroDyn_VarsPackContState(ModData%Vars, T%HD%x(iState), z_op) case (Module_IceD) - call IceD_PackContStateAry(ModData%Vars, T%IceD%x(ModData%Ins, StateIndex), z_op) + call IceD_VarsPackContState(ModData%Vars, T%IceD%x(ModData%Ins, iState), z_op) case (Module_IceF) - call IceFloe_PackContStateAry(ModData%Vars, T%IceF%x(StateIndex), z_op) + call IceFloe_VarsPackContState(ModData%Vars, T%IceF%x(iState), z_op) case (Module_IfW) - call InflowWind_PackContStateAry(ModData%Vars, T%IfW%x(StateIndex), z_op) + call InflowWind_VarsPackContState(ModData%Vars, T%IfW%x(iState), z_op) case (Module_MAP) - call MAP_PackContStateAry(ModData%Vars, T%MAP%x(StateIndex), z_op) + call MAP_VarsPackContState(ModData%Vars, T%MAP%x(iState), z_op) case (Module_MD) - call MD_PackContStateAry(ModData%Vars, T%MD%x(StateIndex), z_op) + call MD_VarsPackContState(ModData%Vars, T%MD%x(iState), z_op) case (Module_ExtInfw) - ! call ExtInfw_PackContStateAry(ModData%Vars, T%ExtInfw%x(StateIndex), z_op) + ! call ExtInfw_VarsPackContState(ModData%Vars, T%ExtInfw%x(StateIndex), z_op) case (Module_Orca) - call Orca_PackContStateAry(ModData%Vars, T%Orca%x(StateIndex), z_op) + call Orca_VarsPackContState(ModData%Vars, T%Orca%x(iState), z_op) case (Module_SD) - call SD_PackContStateAry(ModData%Vars, T%SD%x(StateIndex), z_op) + call SD_VarsPackContState(ModData%Vars, T%SD%x(iState), z_op) case (Module_SeaSt) - call SeaSt_PackContStateAry(ModData%Vars, T%SeaSt%x(StateIndex), z_op) + call SeaSt_VarsPackContState(ModData%Vars, T%SeaSt%x(iState), z_op) case (Module_SrvD) - call SrvD_PackContStateAry(ModData%Vars, T%SrvD%x(StateIndex), z_op) + call SrvD_VarsPackContState(ModData%Vars, T%SrvD%x(iState), z_op) case default call SetErrStat(ErrID_Fatal, "Constraint State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -889,11 +958,11 @@ logical function Failed() end function end subroutine -subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & +subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & u_op, x_op, z_op, u_glue, x_glue, z_glue) type(ModDataType), intent(in) :: ModData !< Module information - integer(IntKi), intent(in) :: InputIndex !< Input index - integer(IntKi), intent(in) :: StateIndex !< State index + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -918,37 +987,37 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_UnpackInputAry(ModData%Vars, u_op, T%AD%Input(InputIndex)%rotors(ModData%Ins)) + call AD_VarsUnpackInput(ModData%Vars, u_op, T%AD%Input(iInput)%rotors(ModData%Ins)) case (Module_BD) - call BD_UnpackInputAry(ModData%Vars, u_op, T%BD%Input(InputIndex, ModData%Ins)) + call BD_VarsUnpackInput(ModData%Vars, u_op, T%BD%Input(iInput, ModData%Ins)) case (Module_ED) - call ED_UnpackInputAry(ModData%Vars, u_op, T%ED%Input(InputIndex)) + call ED_VarsUnpackInput(ModData%Vars, u_op, T%ED%Input(iInput)) case (Module_ExtPtfm) - call ExtPtfm_UnpackInputAry(ModData%Vars, u_op, T%ExtPtfm%Input(InputIndex)) + call ExtPtfm_VarsUnpackInput(ModData%Vars, u_op, T%ExtPtfm%Input(iInput)) case (Module_FEAM) - call FEAM_UnpackInputAry(ModData%Vars, u_op, T%FEAM%Input(InputIndex)) + call FEAM_VarsUnpackInput(ModData%Vars, u_op, T%FEAM%Input(iInput)) case (Module_HD) - call HydroDyn_UnpackInputAry(ModData%Vars, u_op, T%HD%Input(InputIndex)) + call HydroDyn_VarsUnpackInput(ModData%Vars, u_op, T%HD%Input(iInput)) case (Module_IceD) - call IceD_UnpackInputAry(ModData%Vars, u_op, T%IceD%Input(InputIndex, ModData%Ins)) + call IceD_VarsUnpackInput(ModData%Vars, u_op, T%IceD%Input(iInput, ModData%Ins)) case (Module_IceF) - call IceFloe_UnpackInputAry(ModData%Vars, u_op, T%IceF%Input(InputIndex)) + call IceFloe_VarsUnpackInput(ModData%Vars, u_op, T%IceF%Input(iInput)) case (Module_IfW) - call InflowWind_UnpackInputAry(ModData%Vars, u_op, T%IfW%Input(InputIndex)) + call InflowWind_VarsUnpackInput(ModData%Vars, u_op, T%IfW%Input(iInput)) case (Module_MAP) - call MAP_UnpackInputAry(ModData%Vars, u_op, T%MAP%Input(InputIndex)) + call MAP_VarsUnpackInput(ModData%Vars, u_op, T%MAP%Input(iInput)) case (Module_MD) - call MD_UnpackInputAry(ModData%Vars, u_op, T%MD%Input(InputIndex)) + call MD_VarsUnpackInput(ModData%Vars, u_op, T%MD%Input(iInput)) case (Module_ExtInfw) - ! call ExtInfw_UnpackInputAry(ModData%Vu_op, ars, T%ExtInfw%Input(InputIndex)) + ! call ExtInfw_VarsUnpackInput(ModData%Vu_op, ars, T%ExtInfw%Input(InputIndex)) case (Module_Orca) - call Orca_UnpackInputAry(ModData%Vars, u_op, T%Orca%Input(InputIndex)) + call Orca_VarsUnpackInput(ModData%Vars, u_op, T%Orca%Input(iInput)) case (Module_SD) - call SD_UnpackInputAry(ModData%Vars, u_op, T%SD%Input(InputIndex)) + call SD_VarsUnpackInput(ModData%Vars, u_op, T%SD%Input(iInput)) case (Module_SeaSt) - call SeaSt_UnpackInputAry(ModData%Vars, u_op, T%SeaSt%Input(InputIndex)) + call SeaSt_VarsUnpackInput(ModData%Vars, u_op, T%SeaSt%Input(iInput)) case (Module_SrvD) - call SrvD_UnpackInputAry(ModData%Vars, u_op, T%SrvD%Input(InputIndex)) + call SrvD_VarsUnpackInput(ModData%Vars, u_op, T%SrvD%Input(iInput)) case default call SetErrStat(ErrID_Fatal, "Input unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -965,37 +1034,37 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_UnpackContStateAry(ModData%Vars, x_op, T%AD%x(StateIndex)%rotors(ModData%Ins)) + call AD_VarsUnpackContState(ModData%Vars, x_op, T%AD%x(iState)%rotors(ModData%Ins)) case (Module_BD) - call BD_UnpackContStateAry(ModData%Vars, x_op, T%BD%x(ModData%Ins, StateIndex)) + call BD_VarsUnpackContState(ModData%Vars, x_op, T%BD%x(ModData%Ins, iState)) case (Module_ED) - call ED_UnpackContStateAry(ModData%Vars, x_op, T%ED%x(StateIndex)) + call ED_VarsUnpackContState(ModData%Vars, x_op, T%ED%x(iState)) case (Module_ExtPtfm) - call ExtPtfm_UnpackContStateAry(ModData%Vars, x_op, T%ExtPtfm%x(StateIndex)) + call ExtPtfm_VarsUnpackContState(ModData%Vars, x_op, T%ExtPtfm%x(iState)) case (Module_FEAM) - call FEAM_UnpackContStateAry(ModData%Vars, x_op, T%FEAM%x(StateIndex)) + call FEAM_VarsUnpackContState(ModData%Vars, x_op, T%FEAM%x(iState)) case (Module_HD) - call HydroDyn_UnpackContStateAry(ModData%Vars, x_op, T%HD%x(StateIndex)) + call HydroDyn_VarsUnpackContState(ModData%Vars, x_op, T%HD%x(iState)) case (Module_IceD) - call IceD_UnpackContStateAry(ModData%Vars, x_op, T%IceD%x(ModData%Ins, StateIndex)) + call IceD_VarsUnpackContState(ModData%Vars, x_op, T%IceD%x(ModData%Ins, iState)) case (Module_IceF) - call IceFloe_UnpackContStateAry(ModData%Vars, x_op, T%IceF%x(StateIndex)) + call IceFloe_VarsUnpackContState(ModData%Vars, x_op, T%IceF%x(iState)) case (Module_IfW) - call InflowWind_UnpackContStateAry(ModData%Vars, x_op, T%IfW%x(StateIndex)) + call InflowWind_VarsUnpackContState(ModData%Vars, x_op, T%IfW%x(iState)) case (Module_MAP) - call MAP_UnpackContStateAry(ModData%Vars, x_op, T%MAP%x(StateIndex)) + call MAP_VarsUnpackContState(ModData%Vars, x_op, T%MAP%x(iState)) case (Module_MD) - call MD_UnpackContStateAry(ModData%Vars, x_op, T%MD%x(StateIndex)) + call MD_VarsUnpackContState(ModData%Vars, x_op, T%MD%x(iState)) case (Module_ExtInfw) - ! call ExtInfw_UnpackContStateAry(ModData%Varsx_op,, T%ExtInfw%x(StateIndex)) + ! call ExtInfw_VarsUnpackContState(ModData%Varsx_op,, T%ExtInfw%x(StateIndex)) case (Module_Orca) - call Orca_UnpackContStateAry(ModData%Vars, x_op, T%Orca%x(StateIndex)) + call Orca_VarsUnpackContState(ModData%Vars, x_op, T%Orca%x(iState)) case (Module_SD) - call SD_UnpackContStateAry(ModData%Vars, x_op, T%SD%x(StateIndex)) + call SD_VarsUnpackContState(ModData%Vars, x_op, T%SD%x(iState)) case (Module_SeaSt) - call SeaSt_UnpackContStateAry(ModData%Vars, x_op, T%SeaSt%x(StateIndex)) + call SeaSt_VarsUnpackContState(ModData%Vars, x_op, T%SeaSt%x(iState)) case (Module_SrvD) - call SrvD_UnpackContStateAry(ModData%Vars, x_op, T%SrvD%x(StateIndex)) + call SrvD_VarsUnpackContState(ModData%Vars, x_op, T%SrvD%x(iState)) case default call SetErrStat(ErrID_Fatal, "Continuous State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -1012,37 +1081,37 @@ subroutine FAST_SetOP(ModData, InputIndex, StateIndex, T, ErrStat, ErrMsg, & ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_UnpackContStateAry(ModData%Vars, z_op, T%AD%x(StateIndex)%rotors(ModData%Ins)) + call AD_VarsUnpackContState(ModData%Vars, z_op, T%AD%x(iState)%rotors(ModData%Ins)) case (Module_BD) - call BD_UnpackContStateAry(ModData%Vars, z_op, T%BD%x(ModData%Ins, StateIndex)) + call BD_VarsUnpackContState(ModData%Vars, z_op, T%BD%x(ModData%Ins, iState)) case (Module_ED) - call ED_UnpackContStateAry(ModData%Vars, z_op, T%ED%x(StateIndex)) + call ED_VarsUnpackContState(ModData%Vars, z_op, T%ED%x(iState)) case (Module_ExtPtfm) - call ExtPtfm_UnpackContStateAry(ModData%Vars, z_op, T%ExtPtfm%x(StateIndex)) + call ExtPtfm_VarsUnpackContState(ModData%Vars, z_op, T%ExtPtfm%x(iState)) case (Module_FEAM) - call FEAM_UnpackContStateAry(ModData%Vars, z_op, T%FEAM%x(StateIndex)) + call FEAM_VarsUnpackContState(ModData%Vars, z_op, T%FEAM%x(iState)) case (Module_HD) - call HydroDyn_UnpackContStateAry(ModData%Vars, z_op, T%HD%x(StateIndex)) + call HydroDyn_VarsUnpackContState(ModData%Vars, z_op, T%HD%x(iState)) case (Module_IceD) - call IceD_UnpackContStateAry(ModData%Vars, z_op, T%IceD%x(ModData%Ins, StateIndex)) + call IceD_VarsUnpackContState(ModData%Vars, z_op, T%IceD%x(ModData%Ins, iState)) case (Module_IceF) - call IceFloe_UnpackContStateAry(ModData%Vars, z_op, T%IceF%x(StateIndex)) + call IceFloe_VarsUnpackContState(ModData%Vars, z_op, T%IceF%x(iState)) case (Module_IfW) - call InflowWind_UnpackContStateAry(ModData%Vars, z_op, T%IfW%x(StateIndex)) + call InflowWind_VarsUnpackContState(ModData%Vars, z_op, T%IfW%x(iState)) case (Module_MAP) - call MAP_UnpackContStateAry(ModData%Vars, z_op, T%MAP%x(StateIndex)) + call MAP_VarsUnpackContState(ModData%Vars, z_op, T%MAP%x(iState)) case (Module_MD) - call MD_UnpackContStateAry(ModData%Vars, z_op, T%MD%x(StateIndex)) + call MD_VarsUnpackContState(ModData%Vars, z_op, T%MD%x(iState)) case (Module_ExtInfw) - ! call ExtInfw_UnpackContStateAry(ModData%z_op,Vars, T%ExtInfw%x(StateIndex)) + ! call ExtInfw_VarsUnpackContState(ModData%z_op,Vars, T%ExtInfw%x(StateIndex)) case (Module_Orca) - call Orca_UnpackContStateAry(ModData%Vars, z_op, T%Orca%x(StateIndex)) + call Orca_VarsUnpackContState(ModData%Vars, z_op, T%Orca%x(iState)) case (Module_SD) - call SD_UnpackContStateAry(ModData%Vars, z_op, T%SD%x(StateIndex)) + call SD_VarsUnpackContState(ModData%Vars, z_op, T%SD%x(iState)) case (Module_SeaSt) - call SeaSt_UnpackContStateAry(ModData%Vars, z_op, T%SeaSt%x(StateIndex)) + call SeaSt_VarsUnpackContState(ModData%Vars, z_op, T%SeaSt%x(iState)) case (Module_SrvD) - call SrvD_UnpackContStateAry(ModData%Vars, z_op, T%SrvD%x(StateIndex)) + call SrvD_VarsUnpackContState(ModData%Vars, z_op, T%SrvD%x(iState)) case default call SetErrStat(ErrID_Fatal, "Constraint State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -1057,15 +1126,18 @@ logical function Failed() end function end subroutine -subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdu, dXdu, dYdu_glue, dXdu_glue) +subroutine FAST_JacobianPInput(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, dYdu, dXdu, dYdu_glue, dXdu_glue) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: StateIndex !< State + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :), dYdu_glue(:, :) - real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:, :), dXdu_glue(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:, :) + real(R8Ki), optional, intent(inout) :: dYdu_glue(:, :) + real(R8Ki), optional, intent(inout) :: dXdu_glue(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPInput' integer(IntKi) :: ErrStat2 @@ -1078,57 +1150,60 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg select case (ModData%ID) case (Module_AD) - call AD_JacobianPInput(ModData%Vars, ModData%Ins, ThisTime, T%AD%Input(1), T%AD%p, T%AD%x(StateIndex), T%AD%xd(StateIndex), & - T%AD%z(StateIndex), T%AD%OtherSt(StateIndex), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & + call AD_JacobianPInput(ModData%Vars, ModData%Ins, ThisTime, T%AD%Input(iInput), T%AD%p, T%AD%x(iState), T%AD%xd(iState), & + T%AD%z(iState), T%AD%OtherSt(iState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_BD) - call BD_JacobianPInput(ModData%Vars, ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & - T%BD%x(ModData%Ins, StateIndex), T%BD%xd(ModData%Ins, StateIndex), & - T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & + call BD_JacobianPInput(ModData%Vars, ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, iState), T%BD%xd(ModData%Ins, iState), & + T%BD%z(ModData%Ins, iState), T%BD%OtherSt(ModData%Ins, iState), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_ED) - call ED_JacobianPInput(ModData%Vars, ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(StateIndex), T%ED%xd(StateIndex), & - T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + call ED_JacobianPInput(ModData%Vars, ThisTime, T%ED%Input(iInput), T%ED%p, T%ED%x(iState), T%ED%xd(iState), & + T%ED%z(iState), T%ED%OtherSt(iState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) -! case (Module_ExtPtfm) + case (Module_ExtPtfm) + call ExtPtfm_JacobianPInput(ModData%Vars, ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), & + T%ExtPtfm%z(iState), T%ExtPtfm%OtherSt(iState), T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) case (Module_HD) - call HD_JacobianPInput(ModData%Vars, ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(StateIndex), T%HD%xd(StateIndex), & - T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + call HD_JacobianPInput(ModData%Vars, ThisTime, T%HD%Input(iInput), T%HD%p, T%HD%x(iState), T%HD%xd(iState), & + T%HD%z(iState), T%HD%OtherSt(iState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_IfW) - call InflowWind_JacobianPInput(ModData%Vars, ThisTime, T%IfW%Input(1), T%IfW%p, T%IfW%x(StateIndex), T%IfW%xd(StateIndex), & - T%IfW%z(StateIndex), T%IfW%OtherSt(StateIndex), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + call InflowWind_JacobianPInput(ModData%Vars, ThisTime, T%IfW%Input(iInput), T%IfW%p, T%IfW%x(iState), T%IfW%xd(iState), & + T%IfW%z(iState), T%IfW%OtherSt(iState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_MAP) - call MAP_JacobianPInput(ModData%Vars, ThisTime, T%MAP%Input(1), T%MAP%p, T%MAP%x(StateIndex), T%MAP%xd(StateIndex), & - T%MAP%z(StateIndex), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & + call MAP_JacobianPInput(ModData%Vars, ThisTime, T%MAP%Input(iInput), T%MAP%p, T%MAP%x(iState), T%MAP%xd(iState), & + T%MAP%z(iState), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_MD) - call MD_JacobianPInput(ModData%Vars, ThisTime, T%MD%Input(1), T%MD%p, T%MD%x(StateIndex), T%MD%xd(StateIndex), & - T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + call MD_JacobianPInput(ModData%Vars, ThisTime, T%MD%Input(iInput), T%MD%p, T%MD%x(iState), T%MD%xd(iState), & + T%MD%z(iState), T%MD%OtherSt(iState), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_SD) - call SD_JacobianPInput(ModData%Vars, ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(StateIndex), T%SD%xd(StateIndex), & - T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + call SD_JacobianPInput(ModData%Vars, ThisTime, T%SD%Input(iInput), T%SD%p, T%SD%x(iState), T%SD%xd(iState), & + T%SD%z(iState), T%SD%OtherSt(iState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_SeaSt) - call SeaSt_JacobianPInput(ModData%Vars, ThisTime, T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), & - T%SeaSt%z(StateIndex), T%SeaSt%OtherSt(StateIndex), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + call SeaSt_JacobianPInput(ModData%Vars, ThisTime, T%SeaSt%Input(iInput), T%SeaSt%p, T%SeaSt%x(iState), T%SeaSt%xd(iState), & + T%SeaSt%z(iState), T%SeaSt%OtherSt(iState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_SrvD) - call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), & - T%SrvD%z(StateIndex), T%SrvD%OtherSt(StateIndex), T%SrvD%y, T%SrvD%m, & + call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, T%SrvD%x(iState), T%SrvD%xd(iState), & + T%SrvD%z(iState), T%SrvD%OtherSt(iState), T%SrvD%y, T%SrvD%m, & ErrStat2, ErrMsg2, dYdu=dYdu, dXdu=dXdu) case default @@ -1147,15 +1222,18 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg end subroutine -subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, ErrMsg, dYdx, dXdx, dYdx_glue, dXdx_glue) +subroutine FAST_JacobianPContState(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, dYdx, dXdx, dYdx_glue, dXdx_glue) type(ModDataType), intent(inout) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: StateIndex !< State + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dYdx_glue(:, :) - real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:, :), dXdx_glue(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:, :) + real(R8Ki), optional, intent(inout) :: dYdx_glue(:, :) + real(R8Ki), optional, intent(inout) :: dXdx_glue(:, :) character(*), parameter :: RoutineName = 'FAST_JacobianPContState' integer(IntKi) :: ErrStat2 @@ -1168,39 +1246,44 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, Er select case (ModData%ID) case (Module_AD) - call AD_JacobianPContState(ModData%Vars, ModData%Ins, ThisTime, T%AD%Input(1), T%AD%p, & - T%AD%x(StateIndex), T%AD%xd(StateIndex), & - T%AD%z(StateIndex), T%AD%OtherSt(StateIndex), & + call AD_JacobianPContState(ModData%Vars, ModData%Ins, ThisTime, T%AD%Input(iInput), T%AD%p, & + T%AD%x(iState), T%AD%xd(iState), & + T%AD%z(iState), T%AD%OtherSt(iState), & T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) case (Module_BD) - call BD_JacobianPContState(ModData%Vars, ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & - T%BD%x(ModData%Ins, StateIndex), T%BD%xd(ModData%Ins, StateIndex), & - T%BD%z(ModData%Ins, StateIndex), T%BD%OtherSt(ModData%Ins, StateIndex), & + call BD_JacobianPContState(ModData%Vars, ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, iState), T%BD%xd(ModData%Ins, iState), & + T%BD%z(ModData%Ins, iState), T%BD%OtherSt(ModData%Ins, iState), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx, StateRotation=ModData%Lin%StateRotation) case (Module_ED) - call ED_JacobianPContState(ModData%Vars, ThisTime, T%ED%Input(1), T%ED%p, & - T%ED%x(StateIndex), T%ED%xd(StateIndex), & - T%ED%z(StateIndex), T%ED%OtherSt(StateIndex), & + call ED_JacobianPContState(ModData%Vars, ThisTime, T%ED%Input(iInput), T%ED%p, & + T%ED%x(iState), T%ED%xd(iState), & + T%ED%z(iState), T%ED%OtherSt(iState), & T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) -! case (Module_ExtPtfm) + case (Module_ExtPtfm) + call ExtPtfm_JacobianPContState(ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, & + T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), & + T%ExtPtfm%z(iState), T%ExtPtfm%OtherSt(iState), & + T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) case (Module_HD) - call HD_JacobianPContState(ModData%Vars, ThisTime, T%HD%Input(1), T%HD%p, & - T%HD%x(StateIndex), T%HD%xd(StateIndex), & - T%HD%z(StateIndex), T%HD%OtherSt(StateIndex), & + call HD_JacobianPContState(ModData%Vars, ThisTime, T%HD%Input(iInput), T%HD%p, & + T%HD%x(iState), T%HD%xd(iState), & + T%HD%z(iState), T%HD%OtherSt(iState), & T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) case (Module_IfW) - call InflowWind_JacobianPContState(ModData%Vars, ThisTime, T%IfW%Input(1), T%IfW%p, & - T%IfW%x(StateIndex), T%IfW%xd(StateIndex), & - T%IfW%z(StateIndex), T%IfW%OtherSt(StateIndex), & + call InflowWind_JacobianPContState(ModData%Vars, ThisTime, T%IfW%Input(iInput), T%IfW%p, & + T%IfW%x(iState), T%IfW%xd(iState), & + T%IfW%z(iState), T%IfW%OtherSt(iState), & T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) @@ -1210,30 +1293,30 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, StateIndex, T, ErrStat, Er ErrMsg2 = '' case (Module_MD) - call MD_JacobianPContState(ModData%Vars, ThisTime, T%MD%Input(1), T%MD%p, & - T%MD%x(StateIndex), T%MD%xd(StateIndex), & - T%MD%z(StateIndex), T%MD%OtherSt(StateIndex), & + call MD_JacobianPContState(ModData%Vars, ThisTime, T%MD%Input(iInput), T%MD%p, & + T%MD%x(iState), T%MD%xd(iState), & + T%MD%z(iState), T%MD%OtherSt(iState), & T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) case (Module_SD) - call SD_JacobianPContState(ModData%Vars, ThisTime, T%SD%Input(1), T%SD%p, & - T%SD%x(StateIndex), T%SD%xd(StateIndex), & - T%SD%z(StateIndex), T%SD%OtherSt(StateIndex), & + call SD_JacobianPContState(ModData%Vars, ThisTime, T%SD%Input(iInput), T%SD%p, & + T%SD%x(iState), T%SD%xd(iState), & + T%SD%z(iState), T%SD%OtherSt(iState), & T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) case (Module_SeaSt) - call SeaSt_JacobianPContState(ModData%Vars, ThisTime, T%SeaSt%Input(1), T%SeaSt%p, & - T%SeaSt%x(StateIndex), T%SeaSt%xd(StateIndex), & - T%SeaSt%z(StateIndex), T%SeaSt%OtherSt(StateIndex), & + call SeaSt_JacobianPContState(ModData%Vars, ThisTime, T%SeaSt%Input(iInput), T%SeaSt%p, & + T%SeaSt%x(iState), T%SeaSt%xd(iState), & + T%SeaSt%z(iState), T%SeaSt%OtherSt(iState), & T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) case (Module_SrvD) - call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(1), T%SrvD%p, & - T%SrvD%x(StateIndex), T%SrvD%xd(StateIndex), & - T%SrvD%z(StateIndex), T%SrvD%OtherSt(StateIndex), & + call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, & + T%SrvD%x(iState), T%SrvD%xd(iState), & + T%SrvD%z(iState), T%SrvD%OtherSt(iState), & T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) @@ -1263,10 +1346,10 @@ subroutine FAST_SaveStates(ModData, T, ErrStat, ErrMsg) call FAST_CopyStates(ModData, T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) end subroutine -subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) +subroutine FAST_CopyStates(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData !< Module data type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(in) :: Src, Dst !< State indices + integer(IntKi), intent(in) :: iSrc, iDst !< State indices integer(IntKi), intent(in) :: CtrlCode !< Mesh copy code integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1288,24 +1371,24 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) case (Module_AD) - call AD_CopyContState(T%AD%x(Src), T%AD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call AD_CopyDiscState(T%AD%xd(Src), T%AD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call AD_CopyConstrState(T%AD%z(Src), T%AD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call AD_CopyOtherState(T%AD%OtherSt(Src), T%AD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyContState(T%AD%x(iSrc), T%AD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyDiscState(T%AD%xd(iSrc), T%AD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyConstrState(T%AD%z(iSrc), T%AD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyOtherState(T%AD%OtherSt(iSrc), T%AD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_BD) - call BD_CopyContState(T%BD%x(ModData%Ins, Src), T%BD%x(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyDiscState(T%BD%xd(ModData%Ins, Src), T%BD%xd(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyConstrState(T%BD%z(ModData%Ins, Src), T%BD%z(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyOtherState(T%BD%OtherSt(ModData%Ins, Src), T%BD%OtherSt(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyContState(T%BD%x(ModData%Ins, iSrc), T%BD%x(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyDiscState(T%BD%xd(ModData%Ins, iSrc), T%BD%xd(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyConstrState(T%BD%z(ModData%Ins, iSrc), T%BD%z(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyOtherState(T%BD%OtherSt(ModData%Ins, iSrc), T%BD%OtherSt(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_ED) - call ED_CopyContState(T%ED%x(Src), T%ED%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyDiscState(T%ED%xd(Src), T%ED%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyConstrState(T%ED%z(Src), T%ED%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyOtherState(T%ED%OtherSt(Src), T%ED%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyContState(T%ED%x(iSrc), T%ED%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(iSrc), T%ED%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(iSrc), T%ED%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(iSrc), T%ED%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_ExtInfw) @@ -1316,45 +1399,45 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) case (Module_ExtLd) - call ExtLd_CopyContState(T%ExtLd%x(Src), T%ExtLd%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ExtLd_CopyDiscState(T%ExtLd%xd(Src), T%ExtLd%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ExtLd_CopyConstrState(T%ExtLd%z(Src), T%ExtLd%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ExtLd_CopyOtherState(T%ExtLd%OtherSt(Src), T%ExtLd%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyContState(T%ExtLd%x(iSrc), T%ExtLd%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyDiscState(T%ExtLd%xd(iSrc), T%ExtLd%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyConstrState(T%ExtLd%z(iSrc), T%ExtLd%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyOtherState(T%ExtLd%OtherSt(iSrc), T%ExtLd%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_ExtPtfm) - call ExtPtfm_CopyContState(T%ExtPtfm%x(Src), T%ExtPtfm%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ExtPtfm_CopyDiscState(T%ExtPtfm%xd(Src), T%ExtPtfm%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ExtPtfm_CopyConstrState(T%ExtPtfm%z(Src), T%ExtPtfm%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ExtPtfm_CopyOtherState(T%ExtPtfm%OtherSt(Src), T%ExtPtfm%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyContState(T%ExtPtfm%x(iSrc), T%ExtPtfm%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyDiscState(T%ExtPtfm%xd(iSrc), T%ExtPtfm%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyConstrState(T%ExtPtfm%z(iSrc), T%ExtPtfm%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyOtherState(T%ExtPtfm%OtherSt(iSrc), T%ExtPtfm%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_FEAM) - call FEAM_CopyContState(T%FEAM%x(Src), T%FEAM%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call FEAM_CopyDiscState(T%FEAM%xd(Src), T%FEAM%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call FEAM_CopyConstrState(T%FEAM%z(Src), T%FEAM%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call FEAM_CopyOtherState(T%FEAM%OtherSt(Src), T%FEAM%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyContState(T%FEAM%x(iSrc), T%FEAM%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyDiscState(T%FEAM%xd(iSrc), T%FEAM%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyConstrState(T%FEAM%z(iSrc), T%FEAM%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyOtherState(T%FEAM%OtherSt(iSrc), T%FEAM%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_HD) - call HydroDyn_CopyContState(T%HD%x(Src), T%HD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - ! call HydroDyn_CopyDiscState(T%HD%xd(Src), T%HD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - ! call HydroDyn_CopyConstrState(T%HD%z(Src), T%HD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - ! call HydroDyn_CopyOtherState(T%HD%OtherSt(Src), T%HD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyContState(T%HD%x(iSrc), T%HD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyDiscState(T%HD%xd(iSrc), T%HD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyConstrState(T%HD%z(iSrc), T%HD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyOtherState(T%HD%OtherSt(iSrc), T%HD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_IceD) - call IceD_CopyContState(T%IceD%x(Src, ModData%Ins), T%IceD%x(Dst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call IceD_CopyDiscState(T%IceD%xd(Src, ModData%Ins), T%IceD%xd(Dst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call IceD_CopyConstrState(T%IceD%z(Src, ModData%Ins), T%IceD%z(Dst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call IceD_CopyOtherState(T%IceD%OtherSt(Src, ModData%Ins), T%IceD%OtherSt(Dst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyContState(T%IceD%x(iSrc, ModData%Ins), T%IceD%x(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyDiscState(T%IceD%xd(iSrc, ModData%Ins), T%IceD%xd(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyConstrState(T%IceD%z(iSrc, ModData%Ins), T%IceD%z(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyOtherState(T%IceD%OtherSt(iSrc, ModData%Ins), T%IceD%OtherSt(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_IceF) - call IceFloe_CopyContState(T%IceF%x(Src), T%IceF%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call IceFloe_CopyDiscState(T%IceF%xd(Src), T%IceF%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call IceFloe_CopyConstrState(T%IceF%z(Src), T%IceF%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call IceFloe_CopyOtherState(T%IceF%OtherSt(Src), T%IceF%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyContState(T%IceF%x(iSrc), T%IceF%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyDiscState(T%IceF%xd(iSrc), T%IceF%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyConstrState(T%IceF%z(iSrc), T%IceF%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyOtherState(T%IceF%OtherSt(iSrc), T%IceF%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_IfW) @@ -1365,45 +1448,45 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) case (Module_MAP) - call MAP_CopyContState(T%MAP%x(Src), T%MAP%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call MAP_CopyDiscState(T%MAP%xd(Src), T%MAP%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call MAP_CopyConstrState(T%MAP%z(Src), T%MAP%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MAP_CopyContState(T%MAP%x(iSrc), T%MAP%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MAP_CopyDiscState(T%MAP%xd(iSrc), T%MAP%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MAP_CopyConstrState(T%MAP%z(iSrc), T%MAP%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return ! call MAP_CopyOtherState(T%MAP%OtherSt(Src), T%MAP%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_MD) - call MD_CopyContState(T%MD%x(Src), T%MD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call MD_CopyDiscState(T%MD%xd(Src), T%MD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call MD_CopyConstrState(T%MD%z(Src), T%MD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call MD_CopyOtherState(T%MD%OtherSt(Src), T%MD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyContState(T%MD%x(iSrc), T%MD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyDiscState(T%MD%xd(iSrc), T%MD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyConstrState(T%MD%z(iSrc), T%MD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyOtherState(T%MD%OtherSt(iSrc), T%MD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_Orca) - call Orca_CopyContState(T%Orca%x(Src), T%Orca%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call Orca_CopyDiscState(T%Orca%xd(Src), T%Orca%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call Orca_CopyConstrState(T%Orca%z(Src), T%Orca%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call Orca_CopyOtherState(T%Orca%OtherSt(Src), T%Orca%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyContState(T%Orca%x(iSrc), T%Orca%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyDiscState(T%Orca%xd(iSrc), T%Orca%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyConstrState(T%Orca%z(iSrc), T%Orca%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyOtherState(T%Orca%OtherSt(iSrc), T%Orca%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_SD) - call SD_CopyContState(T%SD%x(Src), T%SD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SD_CopyDiscState(T%SD%xd(Src), T%SD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SD_CopyConstrState(T%SD%z(Src), T%SD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SD_CopyOtherState(T%SD%OtherSt(Src), T%SD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyContState(T%SD%x(iSrc), T%SD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyDiscState(T%SD%xd(iSrc), T%SD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyConstrState(T%SD%z(iSrc), T%SD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyOtherState(T%SD%OtherSt(iSrc), T%SD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_SeaSt) - call SeaSt_CopyContState(T%SeaSt%x(Src), T%SeaSt%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SeaSt_CopyDiscState(T%SeaSt%xd(Src), T%SeaSt%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SeaSt_CopyConstrState(T%SeaSt%z(Src), T%SeaSt%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SeaSt_CopyOtherState(T%SeaSt%OtherSt(Src), T%SeaSt%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyContState(T%SeaSt%x(iSrc), T%SeaSt%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyDiscState(T%SeaSt%xd(iSrc), T%SeaSt%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyConstrState(T%SeaSt%z(iSrc), T%SeaSt%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyOtherState(T%SeaSt%OtherSt(iSrc), T%SeaSt%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_SrvD) - call SrvD_CopyContState(T%SrvD%x(Src), T%SrvD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SrvD_CopyDiscState(T%SrvD%xd(Src), T%SrvD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SrvD_CopyConstrState(T%SrvD%z(Src), T%SrvD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call SrvD_CopyOtherState(T%SrvD%OtherSt(Src), T%SrvD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyContState(T%SrvD%x(iSrc), T%SrvD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyDiscState(T%SrvD%xd(iSrc), T%SrvD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyConstrState(T%SrvD%z(iSrc), T%SrvD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyOtherState(T%SrvD%OtherSt(iSrc), T%SrvD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case default call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(ModData%Abbr), ErrStat, ErrMsg, RoutineName) @@ -1450,25 +1533,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call AD_CopyInput(T%AD%Input_Saved(-iSrc), T%AD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call AD_CopyInput(T%AD%Input_Saved(-iSrc), T%AD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call AD_CopyInput(T%AD%Input_Saved(-iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call AD_CopyInput(T%AD%u, T%AD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call AD_CopyInput(T%AD%u, T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call AD_CopyInput(T%AD%Input(iSrc), T%AD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1480,25 +1552,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call BD_CopyInput(T%BD%Input_Saved(-iSrc, ModData%Ins), T%BD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (0) - call BD_CopyInput(T%BD%Input_Saved(-iSrc, ModData%Ins), T%BD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call BD_CopyInput(T%BD%Input_Saved(-iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (0) - call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1510,25 +1571,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call ED_CopyInput(T%ED%Input_Saved(-iSrc), T%ED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call ED_CopyInput(T%ED%Input_Saved(-iSrc), T%ED%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call ED_CopyInput(T%ED%Input_Saved(-iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call ED_CopyInput(T%ED%u, T%ED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call ED_CopyInput(T%ED%u, T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call ED_CopyInput(T%ED%Input(iSrc), T%ED%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1540,25 +1590,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call ExtPtfm_CopyInput(T%ExtPtfm%Input_Saved(-iSrc), T%ExtPtfm%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call ExtPtfm_CopyInput(T%ExtPtfm%Input_Saved(-iSrc), T%ExtPtfm%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call ExtPtfm_CopyInput(T%ExtPtfm%Input_Saved(-iSrc), T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call ExtPtfm_CopyInput(T%ExtPtfm%u, T%ExtPtfm%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call ExtPtfm_CopyInput(T%ExtPtfm%u, T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1570,25 +1609,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call FEAM_CopyInput(T%FEAM%Input_Saved(-iSrc), T%FEAM%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call FEAM_CopyInput(T%FEAM%Input_Saved(-iSrc), T%FEAM%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call FEAM_CopyInput(T%FEAM%Input_Saved(-iSrc), T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call FEAM_CopyInput(T%FEAM%u, T%FEAM%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call FEAM_CopyInput(T%FEAM%u, T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1600,25 +1628,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call HydroDyn_CopyInput(T%HD%Input_Saved(-iSrc), T%HD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call HydroDyn_CopyInput(T%HD%Input_Saved(-iSrc), T%HD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call HydroDyn_CopyInput(T%HD%Input_Saved(-iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call HydroDyn_CopyInput(T%HD%u, T%HD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call HydroDyn_CopyInput(T%HD%u, T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1630,25 +1647,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call IceD_CopyInput(T%IceD%Input_Saved(-iSrc, ModData%Ins), T%IceD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (0) - call IceD_CopyInput(T%IceD%Input_Saved(-iSrc, ModData%Ins), T%IceD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call IceD_CopyInput(T%IceD%Input_Saved(-iSrc, ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call IceD_CopyInput(T%IceD%u(ModData%Ins), T%IceD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call IceD_CopyInput(T%IceD%u(ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (0) - call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%u(ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1660,25 +1666,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call IceFloe_CopyInput(T%IceF%Input_Saved(-iSrc), T%IceF%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call IceFloe_CopyInput(T%IceF%Input_Saved(-iSrc), T%IceF%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call IceFloe_CopyInput(T%IceF%Input_Saved(-iSrc), T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call IceFloe_CopyInput(T%IceF%u, T%IceF%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call IceFloe_CopyInput(T%IceF%u, T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1690,25 +1685,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call InflowWind_CopyInput(T%IfW%Input_Saved(-iSrc), T%IfW%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call InflowWind_CopyInput(T%IfW%Input_Saved(-iSrc), T%IfW%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call InflowWind_CopyInput(T%IfW%Input_Saved(-iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call InflowWind_CopyInput(T%IfW%u, T%IfW%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1720,25 +1704,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call MAP_CopyInput(T%MAP%Input_Saved(-iSrc), T%MAP%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call MAP_CopyInput(T%MAP%Input_Saved(-iSrc), T%MAP%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call MAP_CopyInput(T%MAP%Input_Saved(-iSrc), T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call MAP_CopyInput(T%MAP%u, T%MAP%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call MAP_CopyInput(T%MAP%u, T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1750,25 +1723,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call MD_CopyInput(T%MD%Input_Saved(-iSrc), T%MD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call MD_CopyInput(T%MD%Input_Saved(-iSrc), T%MD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call MD_CopyInput(T%MD%Input_Saved(-iSrc), T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call MD_CopyInput(T%MD%u, T%MD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call MD_CopyInput(T%MD%u, T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call MD_CopyInput(T%MD%Input(iSrc), T%MD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call MD_CopyInput(T%MD%Input(iSrc), T%MD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call MD_CopyInput(T%MD%Input(iSrc), T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1782,25 +1744,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call Orca_CopyInput(T%Orca%Input_Saved(-iSrc), T%Orca%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call Orca_CopyInput(T%Orca%Input_Saved(-iSrc), T%Orca%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call Orca_CopyInput(T%Orca%Input_Saved(-iSrc), T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call Orca_CopyInput(T%Orca%u, T%Orca%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call Orca_CopyInput(T%Orca%u, T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1812,25 +1763,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call SD_CopyInput(T%SD%Input_Saved(-iSrc), T%SD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call SD_CopyInput(T%SD%Input_Saved(-iSrc), T%SD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call SD_CopyInput(T%SD%Input_Saved(-iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call SD_CopyInput(T%SD%u, T%SD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call SD_CopyInput(T%SD%u, T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call SD_CopyInput(T%SD%Input(iSrc), T%SD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1842,25 +1782,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call SeaSt_CopyInput(T%SeaSt%Input_Saved(-iSrc), T%SeaSt%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call SeaSt_CopyInput(T%SeaSt%Input_Saved(-iSrc), T%SeaSt%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call SeaSt_CopyInput(T%SeaSt%Input_Saved(-iSrc), T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call SeaSt_CopyInput(T%SeaSt%u, T%SeaSt%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call SeaSt_CopyInput(T%SeaSt%u, T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select @@ -1872,25 +1801,14 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (iDst) case (:-1) call SrvD_CopyInput(T%SrvD%Input_Saved(-iSrc), T%SrvD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call SrvD_CopyInput(T%SrvD%Input_Saved(-iSrc), T%SrvD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call SrvD_CopyInput(T%SrvD%Input_Saved(-iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select - case (0) - select case (iDst) - case (:-1) - call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (1:) - call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (1:) + case (0:) select case (iDst) case (:-1) call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0) - call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%u, CtrlCode, Errstat2, ErrMsg2) - case (1:) + case (0:) call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) end select end select diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index ab4d2c2902..4d674e479e 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -49,12 +49,12 @@ module FAST_Mapping contains -subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, InputIndex, ErrStat, ErrMsg) +subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, iInput, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData - type(DatLoc), intent(in) :: MeshLoc + type(DatLoc), intent(in) :: MeshLoc type(FAST_TurbineType), target, intent(in) :: Turbine type(MeshType), pointer, intent(out) :: Mesh - integer(IntKi), intent(in) :: InputIndex + integer(IntKi), intent(in) :: iInput integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -65,143 +65,38 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, InputIndex, Er select case (ModData%ID) case (Module_AD) - select case (InputIndex) - case (:-1) - Mesh => AD_InputMeshPointer(Turbine%AD%Input_Saved(-InputIndex)%rotors(ModData%Ins), MeshLoc) - case (0) - Mesh => AD_InputMeshPointer(Turbine%AD%u%rotors(ModData%Ins), MeshLoc) - case (1:) - Mesh => AD_InputMeshPointer(Turbine%AD%Input(InputIndex)%rotors(ModData%Ins), MeshLoc) - end select + Mesh => AD_InputMeshPointer(Turbine%AD%Input(iInput)%rotors(ModData%Ins), MeshLoc) case (Module_BD) - select case (InputIndex) - case (:-1) - Mesh => BD_InputMeshPointer(Turbine%BD%Input_Saved(-InputIndex, ModData%Ins), MeshLoc) - case (0) - Mesh => BD_InputMeshPointer(Turbine%BD%u(ModData%Ins), MeshLoc) - case (1:) - Mesh => BD_InputMeshPointer(Turbine%BD%Input(InputIndex, ModData%Ins), MeshLoc) - end select + Mesh => BD_InputMeshPointer(Turbine%BD%Input(iInput, ModData%Ins), MeshLoc) case (Module_ED) - select case (InputIndex) - case (:-1) - Mesh => ED_InputMeshPointer(Turbine%ED%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => ED_InputMeshPointer(Turbine%ED%u, MeshLoc) - case (1:) - Mesh => ED_InputMeshPointer(Turbine%ED%Input(InputIndex), MeshLoc) - end select + Mesh => ED_InputMeshPointer(Turbine%ED%Input(iInput), MeshLoc) case (Module_ExtInfw) - ! ExtInfw doesn't have the typical input structure, using u for both + ! ExtInfw doesn't have the typical input structure, using u Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) case (Module_ExtPtfm) - select case (InputIndex) - case (:-1) - Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%u, MeshLoc) - case (1:) - Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input(InputIndex), MeshLoc) - end select + Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input(iInput), MeshLoc) case (Module_FEAM) - select case (InputIndex) - case (:-1) - Mesh => FEAM_InputMeshPointer(Turbine%FEAM%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => FEAM_InputMeshPointer(Turbine%FEAM%u, MeshLoc) - case (1:) - Mesh => FEAM_InputMeshPointer(Turbine%FEAM%Input(InputIndex), MeshLoc) - end select + Mesh => FEAM_InputMeshPointer(Turbine%FEAM%Input(iInput), MeshLoc) case (Module_HD) - select case (InputIndex) - case (:-1) - Mesh => HydroDyn_InputMeshPointer(Turbine%HD%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => HydroDyn_InputMeshPointer(Turbine%HD%u, MeshLoc) - case (1:) - Mesh => HydroDyn_InputMeshPointer(Turbine%HD%Input(InputIndex), MeshLoc) - end select + Mesh => HydroDyn_InputMeshPointer(Turbine%HD%Input(iInput), MeshLoc) case (Module_IceD) - select case (InputIndex) - case (:-1) - Mesh => IceD_InputMeshPointer(Turbine%IceD%Input_Saved(-InputIndex, ModData%Ins), MeshLoc) - case (0) - Mesh => IceD_InputMeshPointer(Turbine%IceD%u(ModData%Ins), MeshLoc) - case (1:) - Mesh => IceD_InputMeshPointer(Turbine%IceD%Input(InputIndex, ModData%Ins), MeshLoc) - end select + Mesh => IceD_InputMeshPointer(Turbine%IceD%Input(iInput, ModData%Ins), MeshLoc) case (Module_IceF) - select case (InputIndex) - case (:-1) - Mesh => IceFloe_InputMeshPointer(Turbine%IceF%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => IceFloe_InputMeshPointer(Turbine%IceF%u, MeshLoc) - case (1:) - Mesh => IceFloe_InputMeshPointer(Turbine%IceF%Input(InputIndex), MeshLoc) - end select + Mesh => IceFloe_InputMeshPointer(Turbine%IceF%Input(iInput), MeshLoc) case (Module_IfW) - select case (InputIndex) - case (:-1) - Mesh => InflowWind_InputMeshPointer(Turbine%IfW%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => InflowWind_InputMeshPointer(Turbine%IfW%u, MeshLoc) - case (1:) - Mesh => InflowWind_InputMeshPointer(Turbine%IfW%Input(InputIndex), MeshLoc) - end select + Mesh => InflowWind_InputMeshPointer(Turbine%IfW%Input(iInput), MeshLoc) case (Module_MAP) - select case (InputIndex) - case (:-1) - Mesh => MAP_InputMeshPointer(Turbine%MAP%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => MAP_InputMeshPointer(Turbine%MAP%u, MeshLoc) - case (1:) - Mesh => MAP_InputMeshPointer(Turbine%MAP%Input(InputIndex), MeshLoc) - end select + Mesh => MAP_InputMeshPointer(Turbine%MAP%Input(iInput), MeshLoc) case (Module_MD) - select case (InputIndex) - case (:-1) - Mesh => MD_InputMeshPointer(Turbine%MD%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => MD_InputMeshPointer(Turbine%MD%u, MeshLoc) - case (1:) - Mesh => MD_InputMeshPointer(Turbine%MD%Input(InputIndex), MeshLoc) - end select + Mesh => MD_InputMeshPointer(Turbine%MD%Input(iInput), MeshLoc) case (Module_Orca) - select case (InputIndex) - case (:-1) - Mesh => Orca_InputMeshPointer(Turbine%Orca%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => Orca_InputMeshPointer(Turbine%Orca%u, MeshLoc) - case (1:) - Mesh => Orca_InputMeshPointer(Turbine%Orca%Input(InputIndex), MeshLoc) - end select + Mesh => Orca_InputMeshPointer(Turbine%Orca%Input(iInput), MeshLoc) case (Module_SD) - select case (InputIndex) - case (:-1) - Mesh => SD_InputMeshPointer(Turbine%SD%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => SD_InputMeshPointer(Turbine%SD%u, MeshLoc) - case (1:) - Mesh => SD_InputMeshPointer(Turbine%SD%Input(InputIndex), MeshLoc) - end select + Mesh => SD_InputMeshPointer(Turbine%SD%Input(iInput), MeshLoc) case (Module_SeaSt) - select case (InputIndex) - case (:-1) - Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%u, MeshLoc) - case (1:) - Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input(InputIndex), MeshLoc) - end select + Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input(iInput), MeshLoc) case (Module_SrvD) - select case (InputIndex) - case (:-1) - Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input_Saved(-InputIndex), MeshLoc) - case (0) - Mesh => SrvD_InputMeshPointer(Turbine%SrvD%u, MeshLoc) - case (1:) - Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input(InputIndex), MeshLoc) - end select + Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input(iInput), MeshLoc) case default ErrStat = ErrID_Fatal ErrMsg = "Unsupported module: "//ModData%Abbr @@ -220,12 +115,12 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, InputIndex, Er end subroutine subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData - type(DatLoc), intent(in) :: MeshLoc - type(FAST_TurbineType), target, intent(in) :: Turbine - type(MeshType), pointer, intent(out) :: Mesh - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg + type(ModDataType), intent(in) :: ModData + type(DatLoc), intent(in) :: MeshLoc + type(FAST_TurbineType), target, intent(inout) :: Turbine + type(MeshType), pointer, intent(out) :: Mesh + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg ErrStat = ErrID_None ErrMsg = "" @@ -285,13 +180,13 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM function FAST_InputFieldName(ModData, DL) result(Name) type(ModDataType), intent(in) :: ModData type(DatLoc), intent(in) :: DL - character(32) :: Name, tmp + character(42) :: Name, tmp select case (ModData%ID) case (Module_AD) Name = trim(ModData%Abbr)//"%u%rotors("//trim(Num2LStr(ModData%Ins))//")" select case (DL%Num) case (1:) - tmp = AD_OutputFieldName(DL) + tmp = AD_InputFieldName(DL) Name = trim(Name)//tmp(2:) case (AD_u_HWindSpeed) Name = 'AD%u%HWindSpeed (Ext)' @@ -368,7 +263,7 @@ function FAST_InputFieldName(ModData, DL) result(Name) function FAST_OutputFieldName(ModData, DL) result(Name) type(ModDataType), intent(in) :: ModData type(DatLoc), intent(in) :: DL - character(32) :: Name, tmp + character(42) :: Name, tmp select case (ModData%ID) case (Module_AD) tmp = AD_OutputFieldName(DL) @@ -502,25 +397,14 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) ! Reorder the mappings so that motion maps come before the load maps Mappings = [pack(Mappings, Mappings%MapType == Map_MotionMesh), & pack(Mappings, Mappings%MapType == Map_LoadMesh), & - pack(Mappings, Mappings%MapType == Map_Variable)] + pack(Mappings, Mappings%MapType == Map_Variable), & + pack(Mappings, Mappings%MapType == Map_Custom)] ! Loop through mappings do iMap = 1, size(Mappings) associate (SrcMod => Mods(Mappings(iMap)%iModSrc), & DstMod => Mods(Mappings(iMap)%iModDst)) - ! Add mapping index to sorce and destination module mapping arrays - if (allocated(SrcMod%iSrcMaps)) then - SrcMod%iSrcMaps = [SrcMod%iSrcMaps, iMap] - else - SrcMod%iSrcMaps = [iMap] - end if - if (allocated(DstMod%iDstMaps)) then - DstMod%iDstMaps = [DstMod%iDstMaps, iMap] - else - DstMod%iDstMaps = [iMap] - end if - write (*, *) "Mapping: ", Mappings(iMap)%Desc end associate @@ -535,7 +419,7 @@ logical function Failed() subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -557,9 +441,9 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_BD) - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion - DstDL=DatLoc(AD_u_BladeMotion, SrcMod%Ins), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(SrcMod%Ins) + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeMotion, SrcMod%Ins), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(SrcMod%Ins) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps .or. (SrcMod%Ins == 1)) if (Failed()) return @@ -568,48 +452,48 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) if (Turbine%p_FAST%CompElast == Module_ED) then do i = 1, size(Turbine%ED%y%BladeLn2Mesh) - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) - DstDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps .or. (i == 1)) if (Failed()) return end do end if - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - DstDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstMod=DstMod, DstDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return do i = 1, size(Turbine%ED%y%BladeRootMotion) - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) - DstDL=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return end do - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion - DstDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion - DstDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion - DstDL=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(DstMod%Ins)%TFinMotion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(DstMod%Ins)%TFinMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=NotCompAeroMaps) if (Failed()) return @@ -617,24 +501,24 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_IfW) call MapVariable(Mappings, & - SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(InflowWind_y_HWindSpeed), & - DstDL=DatLoc(AD_u_HWindSpeed), & - ErrStat=ErrStat2, ErrMsg=ErrMsg2) + SrcMod=SrcMod, SrcDL=DatLoc(InflowWind_y_HWindSpeed), & + DstMod=DstMod, DstDL=DatLoc(AD_u_HWindSpeed), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%Linearize) if (Failed()) return call MapVariable(Mappings, & - SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(InflowWind_y_PLExp), & - DstDL=DatLoc(AD_u_PLExp), & - ErrStat=ErrStat2, ErrMsg=ErrMsg2) + SrcMod=SrcMod, SrcDL=DatLoc(InflowWind_y_PLExp), & + DstMod=DstMod, DstDL=DatLoc(AD_u_PLExp), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%Linearize) if (Failed()) return call MapVariable(Mappings, & - SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(InflowWind_y_PropagationDir), & - DstDL=DatLoc(AD_u_PropagationDir), & - ErrStat=ErrStat2, ErrMsg=ErrMsg2) + SrcMod=SrcMod, SrcDL=DatLoc(InflowWind_y_PropagationDir), & + DstMod=DstMod, DstDL=DatLoc(AD_u_PropagationDir), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%Linearize) if (Failed()) return case (Module_SrvD) @@ -652,7 +536,7 @@ logical function Failed() subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -728,7 +612,7 @@ logical function Failed() subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1003,7 +887,7 @@ logical function Failed() subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1077,7 +961,7 @@ logical function Failed() subroutine InitMappings_ExtPtfm(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1094,18 +978,10 @@ subroutine InitMappings_ExtPtfm(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrM case (Module_ED) - if (Turbine%p_FAST%CompSub /= Module_SD) then - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstDL=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - end if - - case (Module_SD) - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh - DstDL=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end select @@ -1119,7 +995,7 @@ logical function Failed() subroutine InitMappings_FEAM(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1173,7 +1049,7 @@ logical function Failed() subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1236,7 +1112,7 @@ logical function Failed() subroutine InitMappings_IceD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1275,7 +1151,7 @@ logical function Failed() subroutine InitMappings_IceF(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1314,7 +1190,7 @@ logical function Failed() subroutine InitMappings_IfW(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1342,7 +1218,7 @@ logical function Failed() subroutine InitMappings_MAP(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1381,7 +1257,7 @@ logical function Failed() subroutine InitMappings_MD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1425,7 +1301,7 @@ logical function Failed() subroutine InitMappings_Orca(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1456,7 +1332,7 @@ logical function Failed() subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1564,7 +1440,7 @@ logical function Failed() subroutine InitMappings_SeaSt(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1592,7 +1468,7 @@ logical function Failed() subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1605,8 +1481,6 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' - ! MeshMapCreate( PlatformMotion, SrvD%u%PtfmMotionMesh, MeshMapData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) - select case (SrcMod%ID) case (Module_BD) @@ -1702,8 +1576,8 @@ logical function Failed() subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & DstMod, DstDL, DstDispDL, ErrStat, ErrMsg, Active) type(FAST_TurbineType), target :: Turbine - type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod type(DatLoc), intent(in) :: SrcDL, DstDL type(DatLoc), intent(in) :: SrcDispDL, DstDispDL integer(IntKi), intent(out) :: ErrStat @@ -1783,15 +1657,15 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & ! Create a copy of destination mesh in mapping for load summation call MeshCopy(DstMesh, Mapping%TmpLoadMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! Get mapping indices for linearized mesh mapping - ! call InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) + ! Set VF_Mapping on variables in this mapping + call SetMapVarFlags(Mapping, SrcMod, DstMod) ! If the destination displacement mesh is not a sibling of the load mesh Mapping%DstUsesSibling = IsSiblingMesh(DstMesh, DstDispMesh) if (.not. Mapping%DstUsesSibling) then - ! Print warning - call WrScr('Warning: load mesh transfer "'//trim(Mapping%Desc)//'" does not use sibling mesh') + ! Indicate non-sibling destination displacement mesh in description + Mapping%Desc = trim(Mapping%Desc)//'*' ! Create temporary motion mesh as cousin of load mesh, this will be used for an intermediate transfer ! of the destination motion to the destination load locations @@ -1849,9 +1723,9 @@ pure logical function IsSiblingMesh(MeshA, MeshB) subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Active) type(FAST_TurbineType), target :: Turbine - type(MappingType), allocatable :: Mappings(:) - type(ModDataType), intent(in) :: SrcMod, DstMod - type(DatLoc), intent(in) :: SrcDL, DstDL + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(DatLoc), intent(in) :: SrcDL, DstDL integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, optional, intent(in) :: Active @@ -1859,7 +1733,7 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcDL, DstMod, DstDL, ErrSta character(*), parameter :: RoutineName = 'MapMotionMesh' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - type(MappingType) :: Mapping + type(MappingType) :: Mapping type(MeshType), pointer :: SrcMesh, DstMesh ErrStat = ErrID_None @@ -1904,12 +1778,12 @@ subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcDL, DstMod, DstDL, ErrSta Mapping%DstDL = DstDL Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) + ! Set VF_Mapping on variables in this mapping + call SetMapVarFlags(Mapping, SrcMod, DstMod) + ! Create mesh mapping call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - ! Get mapping indices for linearized mesh mapping - ! call InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh) - ! Add mapping to array of mappings Mappings = [Mappings, Mapping] @@ -1922,7 +1796,7 @@ logical function Failed() subroutine MapVariable(Maps, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Active) type(MappingType), allocatable :: Maps(:) - type(ModDataType), intent(in) :: SrcMod, DstMod + type(ModDataType), intent(inout) :: SrcMod, DstMod type(DatLoc), intent(in) :: SrcDL, DstDL integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1976,17 +1850,29 @@ subroutine MapVariable(Maps, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Acti Mapping%SrcDL = SrcDL Mapping%DstDL = DstDL + ! Set VF_Mapping on variables in this mapping + call SetMapVarFlags(Mapping, SrcMod, DstMod) + + ! Copy source and destination variables and modify for packing/unpacking + Mapping%SrcVar = SrcMod%Vars%y(iVarSrc) + Mapping%DstVar = DstMod%Vars%u(iVarDst) + Mapping%SrcVar%iLoc = [1, Mapping%SrcVar%Num] + Mapping%DstVar%iLoc = [1, Mapping%DstVar%Num] + + ! Allocate variable data storage + call AllocAry(Mapping%VarData, max(Mapping%SrcVar%Num, Mapping%DstVar%Num), "VarData", ErrStat, ErrMsg) + Maps = [Maps, Mapping] end subroutine !> MapCustom creates a custom mapping that is not included in linearization. !! Each custom mapping needs an entry in FAST_InputSolve to actually perform the transfer. subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) - type(MappingType), allocatable :: Maps(:) - character(*), intent(in) :: Desc - type(ModDataType), intent(in) :: SrcMod, DstMod - logical, optional, intent(in) :: Active - type(MappingType) :: Mapping + type(MappingType), allocatable :: Maps(:) + character(*), intent(in) :: Desc + type(ModDataType), intent(inout) :: SrcMod, DstMod + logical, optional, intent(in) :: Active + type(MappingType) :: Mapping if (present(Active)) then if (.not. Active) return @@ -2005,9 +1891,58 @@ subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) Maps = [Maps, Mapping] end subroutine +subroutine SetMapVarFlags(Mapping, SrcMod, DstMod) + type(MappingType), intent(in) :: Mapping + type(ModDataType), intent(inout) :: SrcMod, DstMod + integer(IntKi) :: i + + ! Set mapping flag on source variables + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) call MV_SetFlags(Var, VF_Mapping) + end associate + end do + + ! Set mapping flag on destination variables + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) call MV_SetFlags(Var, VF_Mapping) + end associate + end do + + ! If this a load mesh mapping + if (Mapping%MapType == Map_LoadMesh) then + + ! Set mapping flag on source displacement mesh variables + do i = 1, size(SrcMod%Vars%u) + associate (Var => SrcMod%Vars%u(i)) + if (MV_EqualDL(Mapping%SrcDispDL, Var%DL)) then + select case (Var%Field) + case (FieldTransDisp) + call MV_SetFlags(Var, VF_Mapping) + end select + end if + end associate + end do + + ! Set mapping flag on destination displacement mesh variables + do i = 1, size(DstMod%Vars%y) + associate (Var => DstMod%Vars%y(i)) + if (MV_EqualDL(Mapping%DstDispDL, Var%DL)) then + select case (Var%Field) + case (FieldTransDisp, FieldOrientation) + call MV_SetFlags(Var, VF_Mapping) + end select + end if + end associate + end do + end if + +end subroutine + ! subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) ! type(MappingType), intent(inout) :: Mapping -! type(ModDataType), intent(in) :: SrcMod, DstMod +! type(ModDataType), intent(inout) :: SrcMod, DstMod ! type(MeshType), intent(in) :: SrcMesh, DstMesh ! type(MeshType), optional, intent(in) :: SrcDispMesh, DstDispMesh @@ -2103,12 +2038,12 @@ subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) call Eye2D(ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return ! Loop through variable maps - do i = 1, size(ModGlue%ModMaps) + do i = 1, size(ModGlue%VarMaps) - associate (ModMap => ModGlue%ModMaps(i), & - Mapping => Mappings(ModGlue%ModMaps(i)%iMapping), & - ModSrc => ModGlue%ModDataAry(ModGlue%ModMaps(i)%iModSrc), & - ModDst => ModGlue%ModDataAry(ModGlue%ModMaps(i)%iModDst)) + associate (ModMap => ModGlue%VarMaps(i), & + Mapping => Mappings(ModGlue%VarMaps(i)%iMapping), & + ModSrc => ModGlue%ModData(ModGlue%VarMaps(i)%iModSrc), & + ModDst => ModGlue%ModData(ModGlue%VarMaps(i)%iModDst)) ! Select based on type of mapping select case (Mapping%MapType) @@ -2172,7 +2107,7 @@ subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) else ! Transfer destination displacement mesh to temporary motion mesh (cousin of destination load mesh) - call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return + call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return ! Linearize the motion mesh transfer call LinearizeMeshTransfer(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return @@ -2218,32 +2153,9 @@ subroutine LinearizeMeshTransfer(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp) end select end subroutine - ! MeshTransfer calls the specific transfer function based on - ! transfer type (Point_to_Point, Point_to_Line2, etc.) - subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp) - integer(IntKi), intent(in) :: Typ - type(MeshType), intent(in) :: Src - type(MeshType), intent(inout) :: Dst - type(MeshMapType), intent(inout) :: MeshMap - type(MeshType), optional, intent(in) :: SrcDisp, DstDisp - select case (Typ) - case (Xfr_Point_to_Point) - call Transfer_Point_to_Point(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) - case (Xfr_Point_to_Line2) - call Transfer_Point_to_Line2(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) - case (Xfr_Line2_to_Point) - call Transfer_Line2_to_Point(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) - case (Xfr_Line2_to_Line2) - call Transfer_Line2_to_Line2(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) - case default - ErrStat2 = ErrID_Fatal - ErrMsg2 = "TransferMeshTransfer: unknown transfer type: "//Num2LStr(Typ) - end select - end subroutine - subroutine Assemble_dUdu(Mapping, ModMap, VarsSrc, VarsDst, dUdu) type(MappingType), intent(in) :: Mapping - type(ModMapType), intent(in) :: ModMap + type(VarMapType), intent(in) :: ModMap type(ModVarsType), intent(in) :: VarsSrc, VarsDst real(R8Ki), intent(inout) :: dUdu(:, :) @@ -2271,7 +2183,7 @@ subroutine Assemble_dUdu(Mapping, ModMap, VarsSrc, VarsDst, dUdu) !! | M_fm M_li | | M^S | subroutine Assemble_dUdy_Loads(Mapping, ModMap, VarsSrc, VarsDst, dUdy) type(MappingType), intent(inout) :: Mapping - type(ModMapType), intent(in) :: ModMap + type(VarMapType), intent(in) :: ModMap type(ModVarsType), intent(in) :: VarsSrc, VarsDst real(R8Ki), intent(inout) :: dUdy(:, :) @@ -2315,7 +2227,7 @@ subroutine Assemble_dUdy_Loads(Mapping, ModMap, VarsSrc, VarsDst, dUdy) !! u^S, theta^S, v^S, omega^S, a^S, alpha^S subroutine Assemble_dUdy_Motions(Mapping, ModMap, VarsSrc, VarsDst, dUdy) type(MappingType), intent(in) :: Mapping - type(ModMapType), intent(in) :: ModMap + type(VarMapType), intent(in) :: ModMap type(ModVarsType), intent(in) :: VarsSrc, VarsDst real(R8Ki), intent(inout) :: dUdy(:, :) @@ -2378,153 +2290,314 @@ logical function Failed() end function end subroutine -subroutine FAST_InputSolve(ModData, Mods, Mappings, InputIndex, Turbine, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData !< Module data - type(ModDataType), intent(in) :: Mods(:) !< Module data - type(MappingType), intent(inout) :: Mappings(:) !< Mesh and variable mappings - integer(IntKi), intent(in) :: InputIndex !< Input index to store data - type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type +subroutine VarUnpackInput(ModData, Var, ValAry, T, iInput, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine data + integer(IntKi), intent(in) :: iInput integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg + ErrStat = ErrID_None + ErrMsg = '' + select case (ModData%ID) + case (Module_AD) + call AD_VarUnpackInput(Var, ValAry, T%AD%Input(iInput)%rotors(ModData%Ins)) + case (Module_BD) + call BD_VarUnpackInput(Var, ValAry, T%BD%Input(iInput, ModData%Ins)) + case (Module_ED) + call ED_VarUnpackInput(Var, ValAry, T%ED%Input(iInput)) + case (Module_ExtPtfm) + call ExtPtfm_VarUnpackInput(Var, ValAry, T%ExtPtfm%Input(iInput)) + case (Module_FEAM) + call FEAM_VarUnpackInput(Var, ValAry, T%FEAM%Input(iInput)) + case (Module_HD) + call HydroDyn_VarUnpackInput(Var, ValAry, T%HD%Input(iInput)) + case (Module_IceD) + call IceD_VarUnpackInput(Var, ValAry, T%IceD%Input(iInput, ModData%Ins)) + case (Module_IceF) + call IceFloe_VarUnpackInput(Var, ValAry, T%IceF%Input(iInput)) + case (Module_IfW) + call InflowWind_VarUnpackInput(Var, ValAry, T%IfW%Input(iInput)) + case (Module_MAP) + call MAP_VarUnpackInput(Var, ValAry, T%MAP%Input(iInput)) + case (Module_MD) + call MD_VarUnpackInput(Var, ValAry, T%MD%Input(iInput)) + case (Module_ExtInfw) + call ExtInfw_VarUnpackInput(Var, ValAry, T%ExtInfw%u) + case (Module_Orca) + call Orca_VarUnpackInput(Var, ValAry, T%Orca%Input(iInput)) + case (Module_SD) + call SD_VarUnpackInput(Var, ValAry, T%SD%Input(iInput)) + case (Module_SeaSt) + call SeaSt_VarUnpackInput(Var, ValAry, T%SeaSt%Input(iInput)) + case (Module_SrvD) + call SrvD_VarUnpackInput(Var, ValAry, T%SrvD%Input(iInput)) + case default + call SetErrStat(ErrID_Fatal, "Unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, "VarPackInput") + end select +end subroutine - character(*), parameter :: RoutineName = 'FAST_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - type(MeshType), pointer :: SrcMesh, DstMesh - type(MeshType), pointer :: SrcDispMesh, DstDispMesh - integer(IntKi) :: i, j, k +subroutine VarPackOutput(ModData, Var, ValAry, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + type(FAST_TurbineType), intent(in) :: T !< Turbine data + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + ErrStat = ErrID_None + ErrMsg = '' + select case (ModData%ID) + case (Module_AD) + call AD_VarPackOutput(Var, T%AD%y%rotors(ModData%Ins), ValAry) + case (Module_BD) + call BD_VarPackOutput(Var, T%BD%y(ModData%Ins), ValAry) + case (Module_ED) + call ED_VarPackOutput(Var, T%ED%y, ValAry) + case (Module_ExtPtfm) + call ExtPtfm_VarPackOutput(Var, T%ExtPtfm%y, ValAry) + case (Module_FEAM) + call FEAM_VarPackOutput(Var, T%FEAM%y, ValAry) + case (Module_HD) + call HydroDyn_VarPackOutput(Var, T%HD%y, ValAry) + case (Module_IceD) + call IceD_VarPackOutput(Var, T%IceD%y(ModData%Ins), ValAry) + case (Module_IceF) + call IceFloe_VarPackOutput(Var, T%IceF%y, ValAry) + case (Module_IfW) + call InflowWind_VarPackOutput(Var, T%IfW%y, ValAry) + case (Module_MAP) + call MAP_VarPackOutput(Var, T%MAP%y, ValAry) + case (Module_MD) + call MD_VarPackOutput(Var, T%MD%y, ValAry) + case (Module_ExtInfw) + call ExtInfw_VarPackOutput(Var, T%ExtInfw%y, ValAry) + case (Module_Orca) + call Orca_VarPackOutput(Var, T%Orca%y, ValAry) + case (Module_SD) + call SD_VarPackOutput(Var, T%SD%y, ValAry) + case (Module_SeaSt) + call SeaSt_VarPackOutput(Var, T%SeaSt%y, ValAry) + case (Module_SrvD) + call SrvD_VarPackOutput(Var, T%SrvD%y, ValAry) + case default + call SetErrStat(ErrID_Fatal, "Unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, "VarPackOutput") + end select +end subroutine + +subroutine FAST_InputSolve(iModDst, ModAry, MapAry, iInput, Turbine, ErrStat, ErrMsg, VarMapAry) + integer(IntKi), intent(in) :: iModDst !< Destination module index in module data array + type(ModDataType), intent(in) :: ModAry(:) !< Module data + type(MappingType), intent(inout) :: MapAry(:) !< Mesh and variable mappings + integer(IntKi), intent(in) :: iInput !< Input index to store data + type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + type(VarMapType), optional, intent(in) :: VarMapAry(:) + + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i ErrStat = ErrID_None ErrMsg = '' - ! Loop through mappings where the ModData module is the destination - do i = 1, size(ModData%iDstMaps) - associate (Mapping => Mappings(ModData%iDstMaps(i))) + if (present(VarMapAry)) then - ! Select based on type of mapping - select case (Mapping%MapType) + ! Loop through mappings + do i = 1, size(VarMapAry) - case (Map_Custom) + ! Skip mappings where this isn't the destination module + if (iModDst /= VarMapAry(i)%iModDst) cycle + call InputSolveMapping(MapAry(VarMapAry(i)%iMapping), ModAry(VarMapAry(i)%iModSrc), ModAry(VarMapAry(i)%iModDst)) + end do + + else - call Custom_InputSolve(Turbine, Mapping, InputIndex, ErrStat2, ErrMsg2) - if (Failed()) return + ! Loop through mappings + do i = 1, size(MapAry) - case (Map_Variable) + ! Skip mappings where this isn't the destination module + if (iModDst /= MapAry(i)%iModDst) cycle + + ! If this is a load mesh mapping, clear the loads + if (MapAry(i)%MapType == Map_LoadMesh) call ZeroDstLoadMesh(MapAry(i), ModAry(MapAry(i)%iModDst)) + end do - case (Map_MotionMesh) + do i = 1, size(MapAry) - ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDL, DstMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return - - ! Perform transfer based on type - select case (Mapping%XfrType) - case (Xfr_Point_to_Point) - call Transfer_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) - case (Xfr_Point_to_Line2) - call Transfer_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) - case (Xfr_Line2_to_Point) - call Transfer_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) - case (Xfr_Line2_to_Line2) - call Transfer_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) - end select + ! Skip mappings where this isn't the destination module + if (iModDst /= MapAry(i)%iModDst) cycle + + call InputSolveMapping(MapAry(i), ModAry(MapAry(i)%iModSrc), ModAry(MapAry(i)%iModDst)) + end do + end if + +contains + + subroutine ZeroDstLoadMesh(Mapping, ModDst) + type(MappingType), intent(inout) :: Mapping + type(ModDataType), intent(in) :: ModDst + type(MeshType), pointer :: DstMesh + + ! Get pointer to destination load mesh + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, iInput, ErrStat2, ErrMsg2) + if (Failed()) return + + ! If mesh has force, set it to zero + if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = 0.0_ReKi + + ! If mesh has moment, set it to zero + if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = 0.0_ReKi + + end subroutine + + subroutine InputSolveMapping(Mapping, ModSrc, ModDst) + type(MappingType), intent(inout) :: Mapping + type(ModDataType), intent(in) :: ModSrc, ModDst + type(MeshType), pointer :: SrcMesh, DstMesh + type(MeshType), pointer :: SrcDispMesh, DstDispMesh + + ! Return if mapping is not ready + if (.not. Mapping%Ready) return + + ! Select based on type of mapping + select case (Mapping%MapType) + + case (Map_Custom) + + call Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + case (Map_Variable) + + ! Pack module output value into array + call VarPackOutput(ModSrc, Mapping%SrcVar, Mapping%VarData, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! If fewer source values than destination values, copy first value to all values + if (Mapping%SrcVar%Num < Mapping%DstVar%Num) then + Mapping%VarData = Mapping%VarData(1) + end if + + ! Unpack array into module input + call VarUnpackInput(ModDst, Mapping%DstVar, Mapping%VarData, Turbine, iInput, ErrStat2, ErrMsg2) + if (Failed()) return + + case (Map_MotionMesh) + + ! Get source and destination meshes + call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, iInput, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Perform transfer based on type + call TransferMesh(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Map_LoadMesh) + + ! Get source and destination meshes + call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, iInput, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Get source and destination displacement meshes + ! Note: source displacement mesh always references current input index + call FAST_InputMeshPointer(ModSrc, Turbine, Mapping%SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_OutputMeshPointer(ModDst, Turbine, Mapping%DstDispDL, DstDispMesh, ErrStat2, ErrMsg2) + if (Failed()) return + + ! If DstDispMesh is a sibling of DstMesh + if (Mapping%DstUsesSibling) then + + ! Transfer the load mesh + ! call TransferMesh(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh, ErrStat2, ErrMsg2) + ! if (Failed()) return + + ! Transfer the load mesh to the temporary mesh + call TransferMesh(Mapping%XfrType, SrcMesh, Mapping%TmpLoadMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh, ErrStat2, ErrMsg2) if (Failed()) return - case (Map_LoadMesh) + else - ! Get source and destination meshes - call FAST_OutputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDL, DstMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return + ! Transfer destination displacement mesh to temporary motion mesh (cousin of destination load mesh) + call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return - ! Get source and destination displacement meshes - call FAST_InputMeshPointer(Mods(Mapping%iModSrc), Turbine, Mapping%SrcDispDL, SrcDispMesh, InputIndex, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(Mods(Mapping%iModDst), Turbine, Mapping%DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - - ! Perform transfer based on type - select case (Mapping%XfrType) - case (Xfr_Point_to_Point) - call Transfer_Point_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) - case (Xfr_Point_to_Line2) - call Transfer_Point_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) - case (Xfr_Line2_to_Point) - call Transfer_Line2_to_Point(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) - case (Xfr_Line2_to_Line2) - call Transfer_Line2_to_Line2(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2, SrcDispMesh, DstDispMesh) - end select + ! Transfer the load mesh using the temporary motion mesh as the destination displacement mesh + ! call TransferMesh(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh, ErrStat2, ErrMsg2) + ! if (Failed()) return + + ! Transfer to temporary load mesh using the temporary motion mesh as the destination displacement mesh + call TransferMesh(Mapping%XfrType, SrcMesh, Mapping%TmpLoadMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh, ErrStat2, ErrMsg2) if (Failed()) return - end select + end if - end associate - end do + ! Add loads from temporary mesh to destination mesh + if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = DstMesh%Force + Mapping%TmpLoadMesh%Force + if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = DstMesh%Moment + Mapping%TmpLoadMesh%Moment + + end select + + end subroutine -contains logical function Failed() Failed = ErrStat2 /= ErrID_None if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, & - RoutineName//':Module='//trim(ModData%Abbr)//', Instance='//Num2LStr(ModData%Ins)) + RoutineName//':Module='//trim(ModAry(iModDst)%Abbr)// & + ', Instance='//Num2LStr(ModAry(iModDst)%Ins)) end function end subroutine -subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - type(MappingType), intent(in) :: Mapping - integer(IntKi), intent(in) :: InputIndex - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg +! TransferMesh calls the specific transfer function based on +! transfer type (Point_to_Point, Point_to_Line2, etc.) +subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: Typ + type(MeshType), intent(in) :: Src + type(MeshType), intent(inout) :: Dst + type(MeshMapType), intent(inout) :: MeshMap + type(MeshType), optional, intent(in) :: SrcDisp, DstDisp + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + select case (Typ) + case (Xfr_Point_to_Point) + call Transfer_Point_to_Point(Src, Dst, MeshMap, ErrStat, ErrMsg, SrcDisp, DstDisp) + case (Xfr_Point_to_Line2) + call Transfer_Point_to_Line2(Src, Dst, MeshMap, ErrStat, ErrMsg, SrcDisp, DstDisp) + case (Xfr_Line2_to_Point) + call Transfer_Line2_to_Point(Src, Dst, MeshMap, ErrStat, ErrMsg, SrcDisp, DstDisp) + case (Xfr_Line2_to_Line2) + call Transfer_Line2_to_Line2(Src, Dst, MeshMap, ErrStat, ErrMsg, SrcDisp, DstDisp) + case default + ErrStat = ErrID_Fatal + ErrMsg = "TransferMesh: unknown transfer type: "//Num2LStr(Typ) + end select +end subroutine + +subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg) + type(MappingType), intent(in) :: Mapping + type(ModDataType), intent(in) :: ModSrc, ModDst + integer(IntKi), intent(in) :: iInput + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg character(*), parameter :: RoutineName = 'Custom_InputSolve' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j, k real(ReKi) :: z, u, v, mean_vel - type(AD_InputType), pointer :: u_AD - type(ED_InputType), pointer :: u_ED - type(ExtLd_InputType), pointer :: u_ExtLd - type(InflowWind_InputType), pointer :: u_IfW - type(MD_InputType), pointer :: u_MD - type(SD_InputType), pointer :: u_SD - type(SrvD_InputType), pointer :: u_SrvD ErrStat = ErrID_None ErrMsg = '' - select case (Mapping%DstModID) - - case (Module_AD) - if (InputIndex > 0) then - u_AD => T%AD%Input(InputIndex) - else - u_AD => T%AD%u - end if - case (Module_ED) - if (InputIndex > 0) then - u_ED => T%ED%Input(InputIndex) - else - u_ED => T%ED%u - end if - case (Module_ExtLd) - u_ExtLd => T%ExtLd%u - case (Module_IfW) - if (InputIndex > 0) then - u_IfW => T%IfW%Input(InputIndex) - else - u_IfW => T%IfW%u - end if - case (Module_SD) - if (InputIndex > 0) then - u_SD => T%SD%Input(InputIndex) - else - u_SD => T%SD%u - end if - case (Module_SrvD) - if (InputIndex > 0) then - u_SrvD => T%SrvD%Input(InputIndex) - else - u_SrvD => T%SrvD%u - end if - end select - ! Select based on mapping description select case (Mapping%Desc) @@ -2541,8 +2614,8 @@ subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) ! This is passed to AD15 to be interpolated with the airfoil table userprop column ! (might be used for airfoil flap angles for example) ! Must be same units as given in airfoil (no unit conversions handled in code)ß - do i = 1, size(T%AD%u%rotors(1)%UserProp, dim=2) ! Blade - u_AD%rotors(1)%UserProp(:, i) = T%SrvD%y%BlAirfoilCom(i) + do i = 1, size(T%AD%Input(iInput)%rotors(ModDst%Ins)%UserProp, dim=2) ! Blade + T%AD%Input(iInput)%rotors(ModDst%Ins)%UserProp(:, i) = T%SrvD%y%BlAirfoilCom(i) end do !------------------------------------------------------------------------------- @@ -2551,8 +2624,8 @@ subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) case (Custom_ED_to_ExtLd) - u_ExtLd%az = T%ED%y%LSSTipPxa - u_ExtLd%DX_u%bldPitch(:) = T%ED%y%BlPitch + T%ExtLd%u%az = T%ED%y%LSSTipPxa + T%ExtLd%u%DX_u%bldPitch(:) = T%ED%y%BlPitch !------------------------------------------------------------------------------- ! InflowWind Inputs @@ -2561,19 +2634,19 @@ subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) case (Custom_ED_to_IfW) ! This section should be refactored so that IfW uses a hub point mesh - u_IfW%HubPosition = T%ED%y%HubPtMotion%Position(:, 1) + & - T%ED%y%HubPtMotion%TranslationDisp(:, 1) - u_IfW%HubOrientation = T%ED%y%HubPtMotion%Orientation(:, :, 1) + T%IfW%Input(iInput)%HubPosition = T%ED%y%HubPtMotion%Position(:, 1) + & + T%ED%y%HubPtMotion%TranslationDisp(:, 1) + T%IfW%Input(iInput)%HubOrientation = T%ED%y%HubPtMotion%Orientation(:, :, 1) ! Set Lidar position directly from hub motion mesh - u_IfW%lidar%HubDisplacementX = T%ED%y%HubPtMotion%TranslationDisp(1, 1) - u_IfW%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) - u_IfW%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementX = T%ED%y%HubPtMotion%TranslationDisp(1, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) case (Custom_SrvD_to_IfW) ! Set hub position so ServoDyn can get hub wind speed - u_IfW%PositionXYZ(:, 1) = T%ED%y%HubPtMotion%Position(:, 1) + T%IfW%Input(iInput)%PositionXYZ(:, 1) = T%ED%y%HubPtMotion%Position(:, 1) !------------------------------------------------------------------------------- ! MoorDyn Inputs @@ -2581,12 +2654,12 @@ subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) case (Custom_SrvD_to_MD) - if (allocated(u_MD%DeltaL) .and. allocated(T%SrvD%y%CableDeltaL)) then - u_MD%DeltaL = T%SrvD%y%CableDeltaL ! these should be sized identically during init + if (allocated(T%MD%Input(iInput)%DeltaL) .and. allocated(T%SrvD%y%CableDeltaL)) then + T%MD%Input(iInput)%DeltaL = T%SrvD%y%CableDeltaL ! these should be sized identically during init end if - if (allocated(u_MD%DeltaLdot) .and. allocated(T%SrvD%y%CableDeltaLdot)) then - u_MD%DeltaLdot = T%SrvD%y%CableDeltaLdot ! these should be sized identically during init + if (allocated(T%MD%Input(iInput)%DeltaLdot) .and. allocated(T%SrvD%y%CableDeltaLdot)) then + T%MD%Input(iInput)%DeltaLdot = T%SrvD%y%CableDeltaLdot ! these should be sized identically during init end if !------------------------------------------------------------------------------- @@ -2595,8 +2668,8 @@ subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) case (Custom_SrvD_to_SD) - if (allocated(u_SD%CableDeltaL) .and. allocated(T%SrvD%y%CableDeltaL)) then - u_SD%CableDeltaL = T%SrvD%y%CableDeltaL ! these should be sized identically during init + if (allocated(T%SD%Input(iInput)%CableDeltaL) .and. allocated(T%SrvD%y%CableDeltaL)) then + T%SD%Input(iInput)%CableDeltaL = T%SrvD%y%CableDeltaL ! these should be sized identically during init end if !------------------------------------------------------------------------------- @@ -2605,70 +2678,67 @@ subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) case (Custom_BD_to_SrvD) - u_SrvD%RootMxc(Mapping%SrcIns) = T%BD%y(Mapping%SrcIns)%RootMxr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) + & - T%BD%y(Mapping%SrcIns)%RootMyr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) - u_SrvD%RootMyc(Mapping%SrcIns) = -T%BD%y(Mapping%SrcIns)%RootMxr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) + & - T%BD%y(Mapping%SrcIns)%RootMyr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) + T%SrvD%Input(iInput)%RootMxc(Mapping%SrcIns) = T%BD%y(Mapping%SrcIns)%RootMxr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) + T%SrvD%Input(iInput)%RootMyc(Mapping%SrcIns) = -T%BD%y(Mapping%SrcIns)%RootMxr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) case (Custom_ED_to_SrvD) ! Blade root moment if not using BeamDyn if (T%p_FAST%CompElast /= Module_BD) then - u_SrvD%RootMxc = T%ED%y%RootMxc ! fixed-size arrays: always size 3 - u_SrvD%RootMyc = T%ED%y%RootMyc ! fixed-size arrays: always size 3 + T%SrvD%Input(iInput)%RootMxc = T%ED%y%RootMxc ! fixed-size arrays: always size 3 + T%SrvD%Input(iInput)%RootMyc = T%ED%y%RootMyc ! fixed-size arrays: always size 3 end if - u_SrvD%YawAngle = T%ED%y%YawAngle ! nacelle yaw plus platform yaw - u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + T%SrvD%Input(iInput)%YawAngle = T%ED%y%YawAngle ! nacelle yaw plus platform yaw + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) - u_SrvD%Yaw = T%ED%y%Yaw ! nacelle yaw - u_SrvD%YawRate = T%ED%y%YawRate - u_SrvD%BlPitch = T%ED%y%BlPitch - u_SrvD%LSS_Spd = T%ED%y%LSS_Spd - u_SrvD%HSS_Spd = T%ED%y%HSS_Spd - u_SrvD%RotSpeed = T%ED%y%RotSpeed + T%SrvD%Input(iInput)%BlPitch = T%ED%y%BlPitch + T%SrvD%Input(iInput)%LSS_Spd = T%ED%y%LSS_Spd + T%SrvD%Input(iInput)%RotSpeed = T%ED%y%RotSpeed - u_SrvD%YawBrTAxp = T%ED%y%YawBrTAxp - u_SrvD%YawBrTAyp = T%ED%y%YawBrTAyp - u_SrvD%LSSTipPxa = T%ED%y%LSSTipPxa + T%SrvD%Input(iInput)%YawBrTAxp = T%ED%y%YawBrTAxp + T%SrvD%Input(iInput)%YawBrTAyp = T%ED%y%YawBrTAyp + T%SrvD%Input(iInput)%LSSTipPxa = T%ED%y%LSSTipPxa - u_SrvD%LSSTipMxa = T%ED%y%LSSTipMxa - u_SrvD%LSSTipMya = T%ED%y%LSSTipMya - u_SrvD%LSSTipMza = T%ED%y%LSSTipMza - u_SrvD%LSSTipMys = T%ED%y%LSSTipMys - u_SrvD%LSSTipMzs = T%ED%y%LSSTipMzs + T%SrvD%Input(iInput)%LSSTipMxa = T%ED%y%LSSTipMxa + T%SrvD%Input(iInput)%LSSTipMya = T%ED%y%LSSTipMya + T%SrvD%Input(iInput)%LSSTipMza = T%ED%y%LSSTipMza + T%SrvD%Input(iInput)%LSSTipMys = T%ED%y%LSSTipMys + T%SrvD%Input(iInput)%LSSTipMzs = T%ED%y%LSSTipMzs - u_SrvD%YawBrMyn = T%ED%y%YawBrMyn - u_SrvD%YawBrMzn = T%ED%y%YawBrMzn - u_SrvD%NcIMURAxs = T%ED%y%NcIMURAxs - u_SrvD%NcIMURAys = T%ED%y%NcIMURAys - u_SrvD%NcIMURAzs = T%ED%y%NcIMURAzs + T%SrvD%Input(iInput)%YawBrMyn = T%ED%y%YawBrMyn + T%SrvD%Input(iInput)%YawBrMzn = T%ED%y%YawBrMzn + T%SrvD%Input(iInput)%NcIMURAxs = T%ED%y%NcIMURAxs + T%SrvD%Input(iInput)%NcIMURAys = T%ED%y%NcIMURAys + T%SrvD%Input(iInput)%NcIMURAzs = T%ED%y%NcIMURAzs - u_SrvD%RotPwr = T%ED%y%RotPwr + T%SrvD%Input(iInput)%RotPwr = T%ED%y%RotPwr - u_SrvD%LSShftFxa = T%ED%y%LSShftFxa - u_SrvD%LSShftFys = T%ED%y%LSShftFys - u_SrvD%LSShftFzs = T%ED%y%LSShftFzs + T%SrvD%Input(iInput)%LSShftFxa = T%ED%y%LSShftFxa + T%SrvD%Input(iInput)%LSShftFys = T%ED%y%LSShftFys + T%SrvD%Input(iInput)%LSShftFzs = T%ED%y%LSShftFzs case (Custom_IfW_to_SrvD) - u_SrvD%WindDir = atan2(T%IfW%y%VelocityUVW(2, 1), T%IfW%y%VelocityUVW(1, 1)) - u_SrvD%HorWindV = sqrt(T%IfW%y%VelocityUVW(1, 1)**2 + T%IfW%y%VelocityUVW(2, 1)**2) - if (allocated(T%IfW%y%lidar%LidSpeed)) u_SrvD%LidSpeed = T%IfW%y%lidar%LidSpeed - if (allocated(T%IfW%y%lidar%MsrPositionsX)) u_SrvD%MsrPositionsX = T%IfW%y%lidar%MsrPositionsX - if (allocated(T%IfW%y%lidar%MsrPositionsY)) u_SrvD%MsrPositionsY = T%IfW%y%lidar%MsrPositionsY - if (allocated(T%IfW%y%lidar%MsrPositionsZ)) u_SrvD%MsrPositionsZ = T%IfW%y%lidar%MsrPositionsZ - u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + T%SrvD%Input(iInput)%WindDir = atan2(T%IfW%y%VelocityUVW(2, 1), T%IfW%y%VelocityUVW(1, 1)) + T%SrvD%Input(iInput)%HorWindV = sqrt(T%IfW%y%VelocityUVW(1, 1)**2 + T%IfW%y%VelocityUVW(2, 1)**2) + if (allocated(T%IfW%y%lidar%LidSpeed)) T%SrvD%Input(iInput)%LidSpeed = T%IfW%y%lidar%LidSpeed + if (allocated(T%IfW%y%lidar%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = T%IfW%y%lidar%MsrPositionsX + if (allocated(T%IfW%y%lidar%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = T%IfW%y%lidar%MsrPositionsY + if (allocated(T%IfW%y%lidar%MsrPositionsZ)) T%SrvD%Input(iInput)%MsrPositionsZ = T%IfW%y%lidar%MsrPositionsZ + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) case (Custom_ExtInfw_to_SrvD) - u_SrvD%WindDir = ATAN2(T%ExtInfw%y%v(1), T%ExtInfw%y%u(1)) - u_SrvD%HorWindV = SQRT(T%ExtInfw%y%u(1)**2 + T%ExtInfw%y%v(1)**2) - if (allocated(u_SrvD%LidSpeed)) u_SrvD%LidSpeed = 0.0 - if (allocated(u_SrvD%MsrPositionsX)) u_SrvD%MsrPositionsX = 0.0 - if (allocated(u_SrvD%MsrPositionsY)) u_SrvD%MsrPositionsY = 0.0 - if (allocated(u_SrvD%MsrPositionsz)) u_SrvD%MsrPositionsz = 0.0 - u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + T%SrvD%Input(iInput)%WindDir = ATAN2(T%ExtInfw%y%v(1), T%ExtInfw%y%u(1)) + T%SrvD%Input(iInput)%HorWindV = SQRT(T%ExtInfw%y%u(1)**2 + T%ExtInfw%y%v(1)**2) + if (allocated(T%SrvD%Input(iInput)%LidSpeed)) T%SrvD%Input(iInput)%LidSpeed = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsz)) T%SrvD%Input(iInput)%MsrPositionsz = 0.0 + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) case (Custom_ExtLd_to_SrvD) @@ -2677,13 +2747,13 @@ subroutine Custom_InputSolve(T, Mapping, InputIndex, ErrStat, ErrMsg) mean_vel = T%ExtLd%p%vel_mean*((z/T%ExtLd%p%z_ref)**T%ExtLd%p%shear_exp) u = -mean_vel*sin(T%ExtLd%p%wind_dir*pi/180.0) v = -mean_vel*cos(T%ExtLd%p%wind_dir*pi/180.0) - u_SrvD%HorWindV = mean_vel - u_SrvD%WindDir = atan2(v, u) - if (allocated(u_SrvD%LidSpeed)) u_SrvD%LidSpeed = 0.0 - if (allocated(u_SrvD%MsrPositionsX)) u_SrvD%MsrPositionsX = 0.0 - if (allocated(u_SrvD%MsrPositionsY)) u_SrvD%MsrPositionsY = 0.0 - if (allocated(u_SrvD%MsrPositionsz)) u_SrvD%MsrPositionsz = 0.0 - u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + T%SrvD%Input(iInput)%HorWindV = mean_vel + T%SrvD%Input(iInput)%WindDir = atan2(v, u) + if (allocated(T%SrvD%Input(iInput)%LidSpeed)) T%SrvD%Input(iInput)%LidSpeed = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsz)) T%SrvD%Input(iInput)%MsrPositionsz = 0.0 + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) !------------------------------------------------------------------------------- ! Unknown Mapping diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index d5bffa09b4..5e0b30b79d 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -40,7 +40,7 @@ module FAST_ModGlue subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilter, Linearize, ErrStat, ErrMsg) type(ModGlueType), intent(out) :: ModGlue - type(ModDataType), intent(inout) :: ModDataAry(:) + type(ModDataType), intent(in) :: ModDataAry(:) integer(IntKi), intent(in) :: iModAry(:) integer(IntKi), intent(in) :: FlagFilter logical, intent(in) :: Linearize @@ -58,7 +58,7 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte integer(IntKi) :: xNumVars, zNumVars, uNumVars, yNumVars integer(IntKi) :: ix, iz, iu, iy character(20) :: NamePrefix - type(ModMapType) :: ModMap + type(VarMapType) :: ModMap ! Initialize error return ErrStat = ErrID_None @@ -75,7 +75,7 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte !---------------------------------------------------------------------------- ! Allocate module info array based on number of modules in iMod - allocate (ModGlue%ModDataAry(size(iModAry)), stat=ErrStat2) + allocate (ModGlue%ModData(size(iModAry)), stat=ErrStat2) if (FailedAlloc("ModOut%VarsAry")) return !---------------------------------------------------------------------------- @@ -89,12 +89,12 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte ! Loop through each module and sum the number of variables that will be in ! the combined module do i = 1, size(iModAry) - associate (ModData => ModDataAry(iModAry(i)), GlueModData => ModGlue%ModDataAry(i)) + associate (ModData => ModDataAry(iModAry(i)), GlueModData => ModGlue%ModData(i)) ! Copy values from source module info GlueModData%Abbr = ModData%Abbr GlueModData%ID = ModData%ID - GlueModData%iMod = i + GlueModData%iMod = ModData%iMod ! Keep original module index for input solve GlueModData%Ins = ModData%Ins GlueModData%DT = ModData%DT GlueModData%SubSteps = ModData%SubSteps @@ -119,10 +119,6 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte GlueModData%Vars%Ny = ModData%Vars%Ny ! Same as original module yNumVars = yNumVars + size(GlueModData%Vars%y) - ! Module Mappings - GlueModData%iSrcMaps = ModData%iSrcMaps - GlueModData%iDstMaps = ModData%iDstMaps - end associate end do @@ -140,9 +136,9 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte ! Loop through module info in glue module ix = 0; iz = 0; iu = 0; iy = 0 - do i = 1, size(ModGlue%ModDataAry) + do i = 1, size(ModGlue%ModData) - associate (GlueModData => ModGlue%ModDataAry(i)) + associate (GlueModData => ModGlue%ModData(i)) ! Determine module name prefix for linearization if ((GlueModData%ID == Module_BD) .or. (count(ModDataAry%ID == GlueModData%ID) > 1)) then @@ -196,7 +192,7 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte ! Determine mappings which apply to the modules in this glue module !---------------------------------------------------------------------------- - allocate (ModGlue%ModMaps(0)) + allocate (ModGlue%VarMaps(0)) ! Loop through mappings do i = 1, size(Mappings) @@ -223,8 +219,8 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte ! Get source and destination modules from glue module data array associate (Mapping => Mappings(i), & - ModSrc => ModGlue%ModDataAry(ModMap%iModSrc), & - ModDst => ModGlue%ModDataAry(ModMap%iModDst)) + ModSrc => ModGlue%ModData(ModMap%iModSrc), & + ModDst => ModGlue%ModData(ModMap%iModDst)) ! Set mapping index and clear variable indices ModMap%iMapping = i @@ -286,11 +282,65 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte if (Mapping%MapType == Map_LoadMesh .and. all(ModMap%iVarDstDisp == 0)) cycle ! Add new module mapping to array - ModGlue%ModMaps = [ModGlue%ModMaps, ModMap] + ModGlue%VarMaps = [ModGlue%VarMaps, ModMap] end associate end do + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + if (.not. Linearize) return + + ! Allocate linearization arrays + if (ModGlue%Vars%Nx > 0) then + call AllocAry(ModGlue%Lin%x, ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nx > 0) then + call AllocAry(ModGlue%Lin%dx, ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nz > 0) then + call AllocAry(ModGlue%Lin%z, ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nu > 0) then + call AllocAry(ModGlue%Lin%u, ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Ny > 0) then + call AllocAry(ModGlue%Lin%y, ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Allocate full Jacobian matrices + if (ModGlue%Vars%Ny > 0 .and. ModGlue%Vars%Nu > 0) then + call AllocAry(ModGlue%Lin%dYdu, ModGlue%Vars%Ny, ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nx > 0 .and. ModGlue%Vars%Nu > 0) then + call AllocAry(ModGlue%Lin%dXdu, ModGlue%Vars%Nx, ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Ny > 0 .and. ModGlue%Vars%Nx > 0) then + call AllocAry(ModGlue%Lin%dYdx, ModGlue%Vars%Ny, ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nx > 0 .and. ModGlue%Vars%Nx > 0) then + call AllocAry(ModGlue%Lin%dXdx, ModGlue%Vars%Nx, ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nu > 0 .and. ModGlue%Vars%Nu > 0) then + call AllocAry(ModGlue%Lin%dUdu, ModGlue%Vars%Nu, ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nu > 0 .and. ModGlue%Vars%Ny > 0) then + call AllocAry(ModGlue%Lin%dUdy, ModGlue%Vars%Nu, ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2) + if (Failed()) return + end if + contains subroutine CopyVariables(VarAryIn, VarAryOut, iVal) @@ -301,7 +351,10 @@ subroutine CopyVariables(VarAryIn, VarAryOut, iVal) integer(IntKi) :: NumVars, NumVals, iVar ! Get number of variables that have flag - NumVars = MV_NumVars(VarAryIn, FlagFilter) + NumVars = 0 + do k = 1, size(VarAryIn) + if (MV_HasFlagsAny(VarAryIn(k), FlagFilter)) NumVars = NumVars + 1 + end do ! Allocate output array of variables allocate (VarAryOut(NumVars), stat=ErrStat2) @@ -317,7 +370,7 @@ subroutine CopyVariables(VarAryIn, VarAryOut, iVal) do k = 1, size(VarAryIn) ! If variable doesn't have flag, cycle - if (.not. MV_HasFlagsAll(VarAryIn(k), FlagFilter)) cycle + if (.not. MV_HasFlagsAny(VarAryIn(k), FlagFilter)) cycle associate (Var => VarAryOut(iVar)) @@ -399,16 +452,16 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! If no modules were added, return error - if (.not. allocated(m%ModDataAry)) then + if (.not. allocated(m%ModData)) then call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) return end if ! Create array of indices for Mods array - modIdx = [(i, i=1, size(m%ModDataAry))] + modIdx = [(i, i=1, size(m%ModData))] ! Get array of module IDs - modIDs = [(m%ModDataAry(i)%ID, i=1, size(m%ModDataAry))] + modIDs = [(m%ModData(i)%ID, i=1, size(m%ModData))] ! Establish module index order for linearization allocate (p%Lin%iMod(0)) @@ -417,13 +470,15 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) end do ! Loop through modules, if module is not in index, return with error - do i = 1, size(m%ModDataAry) - if (.not. any(i == p%Lin%iMod)) then - call SetErrStat(ErrID_Fatal, "Module "//trim(m%ModDataAry(i)%Abbr)// & - " not supported in linearization", ErrStat, ErrMsg, RoutineName) - return - end if - end do + if (p_FAST%Linearize) then + do i = 1, size(m%ModData) + if (.not. any(i == p%Lin%iMod)) then + call SetErrStat(ErrID_Fatal, "Module "//trim(m%ModData(i)%Abbr)// & + " not supported in linearization", ErrStat, ErrMsg, RoutineName) + return + end if + end do + end if !---------------------------------------------------------------------------- ! Set Variable Flags for linearization @@ -431,7 +486,7 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Loop through each module by index do i = 1, size(p%Lin%iMod) - associate (ModData => m%ModDataAry(p%Lin%iMod(i))) + associate (ModData => m%ModData(p%Lin%iMod(i))) ! Set linearize flag on all continuous state variables do j = 1, size(ModData%Vars%x) @@ -475,17 +530,11 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) end associate end do - !---------------------------------------------------------------------------- - ! Mesh Mapping - !---------------------------------------------------------------------------- - - call FAST_InitMappings(m%Mappings, m%ModDataAry, Turbine, ErrStat2, ErrMsg2); if (Failed()) return - !---------------------------------------------------------------------------- ! Glue Module !---------------------------------------------------------------------------- - call Glue_CombineModules(m%ModGlue, m%ModDataAry, m%Mappings, p%Lin%iMod, VF_None, p_FAST%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + call Glue_CombineModules(m%ModGlue, m%ModData, m%Mappings, p%Lin%iMod, VF_None, p_FAST%Linearize, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Allocate linearization arrays and matrices @@ -508,21 +557,6 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Set flag to save operating points during linearization if mode shapes requested p%Lin%SaveOPs = p_FAST%WrVTK == VTK_ModeShapes - ! Allocate linearization arrays - call AllocAry(m%ModGlue%Lin%x, m%ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%dx, m%ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%z, m%ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%u, m%ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%y, m%ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2); if (Failed()) return - - ! Allocate full Jacobian matrices - call AllocAry(m%ModGlue%Lin%dYdu, m%ModGlue%Vars%Ny, m%ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%dXdu, m%ModGlue%Vars%Nx, m%ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%dYdx, m%ModGlue%Vars%Ny, m%ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%dXdx, m%ModGlue%Vars%Nx, m%ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%dUdu, m%ModGlue%Vars%Nu, m%ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%ModGlue%Lin%dUdy, m%ModGlue%Vars%Nu, m%ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return - ! Initialize arrays to store operating point states and input call AllocAry(y%Lin%x, m%ModGlue%Vars%Nx, p%Lin%NumTimes, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(y%Lin%z, m%ModGlue%Vars%Nz, p%Lin%NumTimes, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return @@ -634,8 +668,8 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ! Loop through modules and collect output - do j = 1, size(m%ModGlue%ModDataAry) - associate (ModData => m%ModGlue%ModDataAry(j)) + do j = 1, size(m%ModGlue%ModData) + associate (ModData => m%ModGlue%ModData(j)) ! Skip of module has no outputs if (size(ModData%Vars%y) == 0) cycle @@ -893,17 +927,17 @@ subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbi m%ModGlue%Lin%dXdx = 0.0_R8Ki ! Loop through linearization modules by index - do i = 1, size(m%ModGlue%ModDataAry) - associate (ModData => m%ModGlue%ModDataAry(i)) + do i = 1, size(m%ModGlue%ModData) + associate (ModData => m%ModGlue%ModData(i)) ! Derivatives with respect to input - call FAST_JacobianPInput(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + call FAST_JacobianPInput(ModData, t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & dYdu=ModData%Lin%dYdu, dYdu_glue=m%ModGlue%Lin%dYdu, & dXdu=ModData%Lin%dXdu, dXdu_glue=m%ModGlue%Lin%dXdu) if (Failed()) return ! Derivatives with respect to continuous state - call FAST_JacobianPContState(ModData, t_global, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + call FAST_JacobianPContState(ModData, t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & dYdx=ModData%Lin%dYdx, dYdx_glue=m%ModGlue%Lin%dYdx, & dXdx=ModData%Lin%dXdx, dXdx_glue=m%ModGlue%Lin%dXdx) if (Failed()) return @@ -928,9 +962,9 @@ subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbi end do ! Copy arrays into linearization operating points - if (size(m%ModGlue%Lin%x) > 0) y%Lin%x(:, m%Lin%TimeIndex) = m%ModGlue%Lin%x - if (size(m%ModGlue%Lin%z) > 0) y%Lin%z(:, m%Lin%TimeIndex) = m%ModGlue%Lin%z - if (size(m%ModGlue%Lin%u) > 0) y%Lin%u(:, m%Lin%TimeIndex) = m%ModGlue%Lin%u + if (allocated(m%ModGlue%Lin%x)) y%Lin%x(:, m%Lin%TimeIndex) = m%ModGlue%Lin%x + if (allocated(m%ModGlue%Lin%z)) y%Lin%z(:, m%Lin%TimeIndex) = m%ModGlue%Lin%z + if (allocated(m%ModGlue%Lin%u)) y%Lin%u(:, m%Lin%TimeIndex) = m%ModGlue%Lin%u ! Linearize mesh mappings to populate dUdy and dUdu call FAST_LinearizeMappings(m%ModGlue, m%Mappings, Turbine, ErrStat2, ErrMsg2) @@ -993,7 +1027,7 @@ subroutine ModGlue_SaveOperatingPoint(p, m, OPIndex, NewCopy, Turbine, ErrStat, ! Loop through modules by index do i = 1, size(p%Lin%iMod) - associate (ModData => m%ModDataAry(p%Lin%iMod(i))) + associate (ModData => m%ModData(p%Lin%iMod(i))) ! Copy current module state to linearization save location call FAST_CopyStates(ModData, Turbine, STATE_CURR, StateIndex, CtrlCode, ErrStat2, ErrMsg2) @@ -1037,7 +1071,7 @@ subroutine ModGlue_RestoreOperatingPoint(p, m, OPIndex, Turbine, ErrStat, ErrMsg ! Loop through modules by index do i = 1, size(p%Lin%iMod) - associate (ModData => m%ModDataAry(p%Lin%iMod(i))) + associate (ModData => m%ModData(p%Lin%iMod(i))) ! Copy current module state to linearization save location call FAST_CopyStates(ModData, Turbine, StateIndex, STATE_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) @@ -1246,7 +1280,7 @@ subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) end subroutine -subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinRootName, FilterFlag, ErrStat, ErrMsg, ModSuffix, CalcGlue) +subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinRootName, FilterFlag, ErrStat, ErrMsg, ModSuffix, CalcGlue, FullOutput) type(ModVarsType), intent(in) :: Vars !< Variable data type(ModLinType), intent(inout) :: Lin !< Linearization data type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters @@ -1259,6 +1293,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None character(*), optional, intent(in) :: ModSuffix !< Module suffix for file name logical, optional, intent(in) :: CalcGlue !< Flag to calculate glue state matrices + logical, optional, intent(in) :: FullOutput !< Flag to output all Jacobians character(*), parameter :: RoutineName = 'WriteModuleLinearMatrices' integer(IntKi) :: ErrStat2 @@ -1269,7 +1304,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR integer(IntKi) :: Nx, Nxd, Nz, Nu, Ny character(50) :: Fmt logical, allocatable :: uUse(:), yUse(:), xUse(:) - logical :: CalcGlueLoc + logical :: CalcGlueLoc, FullOutputLoc ErrStat = ErrID_None ErrMsg = "" @@ -1283,6 +1318,12 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR CalcGlueLoc = .true. end if + if (present(FullOutput)) then + FullOutputLoc = FullOutput + else + FullOutputLoc = p_FAST%LinOutJac + end if + ! Set flag to calculate glue matrices based on optional parameter if (present(CalcGlue)) CalcGlueLoc = CalcGlue @@ -1329,25 +1370,27 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR write (Un, '()') !print a blank line - if (Nx > 0) then + if (Nx > 0 .and. allocated(Lin%x)) then write (Un, '(A)') 'Order of continuous states:' call WrLinFile_txt_Table(Vars%x, FilterFlag, p_FAST, Un, "Row/Column", Lin%x) + end if + if (Nx > 0 .and. allocated(Lin%dx)) then write (Un, '(A)') 'Order of continuous state derivatives:' call WrLinFile_txt_Table(Vars%x, FilterFlag, p_FAST, Un, "Row/Column", Lin%dx, IsDeriv=.true.) end if - if (Nz > 0) then + if (Nz > 0 .and. allocated(Lin%z)) then write (Un, '(A)') 'Order of constraint states:' call WrLinFile_txt_Table(Vars%z, FilterFlag, p_FAST, Un, "Row/Column", Lin%z) end if - if (Nu > 0) then + if (Nu > 0 .and. allocated(Lin%u)) then write (Un, '(A)') 'Order of inputs:' call WrLinFile_txt_Table(Vars%u, FilterFlag, p_FAST, Un, "Column ", Lin%u, ShowRot=.true.) end if - if (Ny > 0) then + if (Ny > 0 .and. allocated(Lin%y)) then write (Un, '(A)') 'Order of outputs:' call WrLinFile_txt_Table(Vars%y, FilterFlag, p_FAST, Un, "Row ", Lin%y, ShowRot=.true.) end if @@ -1380,7 +1423,7 @@ subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinR end do ! If Jacobian matrix output is requested - if (p_FAST%LinOutJac) then + if (FullOutputLoc) then write (Un, '(/,A,/)') 'Jacobian matrices:' if (allocated(Lin%dUdu)) call WrPartialMatrix(Lin%dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=uUse, UseCol=uUse) if (allocated(Lin%dUdy)) call WrPartialMatrix(Lin%dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=uUse, UseCol=yUse) diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 9c8fda1b9a..5567963d7a 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -76,9 +76,13 @@ MODULE FAST_ModTypes LOGICAL, PARAMETER :: BD_Solve_Option1 = .TRUE. !< Tight coupling module IDs - INTEGER(IntKi), PARAMETER :: TC_Modules(*) = & + integer(IntKi), parameter :: TC_Modules(*) = & [Module_ED, Module_BD, Module_SD] + !< Option 1 module IDs + integer(IntKi), parameter :: O1_Modules(*) = & + [Module_ExtPtfm, Module_HD, Module_MD, Module_Orca] + !< Linearization module ID array (order determines Jacobian layout) integer(IntKi), parameter :: LinMods(*) = & [Module_IfW, Module_SeaSt, Module_SrvD, Module_ED, Module_BD, Module_AD, & diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 7c78195ae8..f5ee4c024d 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -394,9 +394,10 @@ typedef ^ FAST_OutputFileType IntKi VTK_LastWaveIndx - - - "last index into wave typedef ^ FAST_OutputFileType FAST_LinFileType Lin - - - "linearization data for output" typedef ^ FAST_OutputFileType IntKi ActualChanLen - - - "width of the column headers output in the text and/or binary file" - typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" +typedef ^ FAST_OutputFileType IntKi DriverWriteOutputNum - 0 - "Number of values in driver write output" typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {6} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed" -#typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" -#typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnit {:} - - "units of data output from the driver" +typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" +typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnt {:} - - "units of data output from the driver" # ..... IceDyn data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 963063a99c..ab68e98519 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -5508,7 +5508,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( MODULE_ED ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( MODULE_ED ) + t_initial - CALL ED_UpdateStates( t_module, n_t_module, ED%Input, ED%InputTimes, ED%p, ED%x(STATE_PRED), ED%xd(STATE_PRED), & + CALL ED_UpdateStates( t_module, n_t_module, ED%Input(1:), ED%InputTimes, ED%p, ED%x(STATE_PRED), ED%xd(STATE_PRED), & ED%z(STATE_PRED), ED%OtherSt(STATE_PRED), ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -5537,7 +5537,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_BD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_BD ) + t_initial - CALL BD_UpdateStates( t_module, n_t_module, BD%Input(:,k), BD%InputTimes(:,k), BD%p(k), BD%x(k,STATE_PRED), & + CALL BD_UpdateStates( t_module, n_t_module, BD%Input(1:,k), BD%InputTimes(:,k), BD%p(k), BD%x(k,STATE_PRED), & BD%xd(k,STATE_PRED), BD%z(k,STATE_PRED), BD%OtherSt(k,STATE_PRED), BD%m(k), ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':B'//trim(num2lstr(k))) END DO !j_ss @@ -5568,7 +5568,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr ! n_t_module = n_t_global*p_FAST%n_substeps( MODULE_IfW ) + j_ss - 1 ! t_module = n_t_module*p_FAST%dt_module( MODULE_IfW ) + t_initial ! -! CALL InflowWind_UpdateStates( t_module, n_t_module, IfW%Input, IfW%InputTimes, IfW%p, IfW%x(STATE_PRED), IfW%xd(STATE_PRED), & +! CALL InflowWind_UpdateStates( t_module, n_t_module, IfW%Input(1:), IfW%InputTimes, IfW%p, IfW%x(STATE_PRED), IfW%xd(STATE_PRED), & ! IfW%z(STATE_PRED), IfW%OtherSt(STATE_PRED), IfW%m, ErrStat2, ErrMsg2 ) ! CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! END DO !j_ss @@ -5594,7 +5594,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( MODULE_AD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( MODULE_AD ) + t_initial - CALL AD_UpdateStates( t_module, n_t_module, AD%Input, AD%InputTimes, AD%p, AD%x(STATE_PRED), & + CALL AD_UpdateStates( t_module, n_t_module, AD%Input(1:), AD%InputTimes, AD%p, AD%x(STATE_PRED), & AD%xd(STATE_PRED), AD%z(STATE_PRED), AD%OtherSt(STATE_PRED), AD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5619,7 +5619,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_SrvD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_SrvD ) + t_initial - CALL SrvD_UpdateStates( t_module, n_t_module, SrvD%Input, SrvD%InputTimes, SrvD%p, SrvD%x(STATE_PRED), SrvD%xd(STATE_PRED), & + CALL SrvD_UpdateStates( t_module, n_t_module, SrvD%Input(1:), SrvD%InputTimes, SrvD%p, SrvD%x(STATE_PRED), SrvD%xd(STATE_PRED), & SrvD%z(STATE_PRED), SrvD%OtherSt(STATE_PRED), SrvD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -5642,7 +5642,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_HD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_HD ) + t_initial - CALL HydroDyn_UpdateStates( t_module, n_t_module, HD%Input, HD%InputTimes, HD%p, HD%x(STATE_PRED), HD%xd(STATE_PRED), & + CALL HydroDyn_UpdateStates( t_module, n_t_module, HD%Input(1:), HD%InputTimes, HD%p, HD%x(STATE_PRED), HD%xd(STATE_PRED), & HD%z(STATE_PRED), HD%OtherSt(STATE_PRED), HD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5665,7 +5665,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_SD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_SD ) + t_initial - CALL SD_UpdateStates( t_module, n_t_module, SD%Input, SD%InputTimes, SD%p, SD%x(STATE_PRED), SD%xd(STATE_PRED), & + CALL SD_UpdateStates( t_module, n_t_module, SD%Input(1:), SD%InputTimes, SD%p, SD%x(STATE_PRED), SD%xd(STATE_PRED), & SD%z(STATE_PRED), SD%OtherSt(STATE_PRED), SD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5684,7 +5684,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_ExtPtfm ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_ExtPtfm ) + t_initial - CALL ExtPtfm_UpdateStates( t_module, n_t_module, ExtPtfm%Input, ExtPtfm%InputTimes, ExtPtfm%p, ExtPtfm%x(STATE_PRED), & + CALL ExtPtfm_UpdateStates( t_module, n_t_module, ExtPtfm%Input(1:), ExtPtfm%InputTimes, ExtPtfm%p, ExtPtfm%x(STATE_PRED), & ExtPtfm%xd(STATE_PRED), ExtPtfm%z(STATE_PRED), ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5708,7 +5708,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_MAP ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_MAP ) + t_initial - CALL MAP_UpdateStates( t_module, n_t_module, MAPp%Input, MAPp%InputTimes, MAPp%p, MAPp%x(STATE_PRED), MAPp%xd(STATE_PRED), MAPp%z(STATE_PRED), MAPp%OtherSt, ErrStat2, ErrMsg2 ) + CALL MAP_UpdateStates( t_module, n_t_module, MAPp%Input(1:), MAPp%InputTimes, MAPp%p, MAPp%x(STATE_PRED), MAPp%xd(STATE_PRED), MAPp%z(STATE_PRED), MAPp%OtherSt, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5726,7 +5726,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_MD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_MD ) + t_initial - CALL MD_UpdateStates( t_module, n_t_module, MD%Input, MD%InputTimes, MD%p, MD%x(STATE_PRED), MD%xd(STATE_PRED), & + CALL MD_UpdateStates( t_module, n_t_module, MD%Input(1:), MD%InputTimes, MD%p, MD%x(STATE_PRED), MD%xd(STATE_PRED), & MD%z(STATE_PRED), MD%OtherSt(STATE_PRED), MD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5745,7 +5745,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_FEAM ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_FEAM ) + t_initial - CALL FEAM_UpdateStates( t_module, n_t_module, FEAM%Input, FEAM%InputTimes, FEAM%p, FEAM%x(STATE_PRED), FEAM%xd(STATE_PRED), & + CALL FEAM_UpdateStates( t_module, n_t_module, FEAM%Input(1:), FEAM%InputTimes, FEAM%p, FEAM%x(STATE_PRED), FEAM%xd(STATE_PRED), & FEAM%z(STATE_PRED), FEAM%OtherSt(STATE_PRED), FEAM%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5764,7 +5764,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_Orca ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_Orca ) + t_initial - CALL Orca_UpdateStates( t_module, n_t_module, Orca%Input, Orca%InputTimes, Orca%p, Orca%x(STATE_PRED), & + CALL Orca_UpdateStates( t_module, n_t_module, Orca%Input(1:), Orca%InputTimes, Orca%p, Orca%x(STATE_PRED), & Orca%xd(STATE_PRED), Orca%z(STATE_PRED), Orca%OtherSt(STATE_PRED), Orca%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5787,7 +5787,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_IceF ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_IceF ) + t_initial - CALL IceFloe_UpdateStates( t_module, n_t_module, IceF%Input, IceF%InputTimes, IceF%p, IceF%x(STATE_PRED), & + CALL IceFloe_UpdateStates( t_module, n_t_module, IceF%Input(1:), IceF%InputTimes, IceF%p, IceF%x(STATE_PRED), & IceF%xd(STATE_PRED), IceF%z(STATE_PRED), IceF%OtherSt(STATE_PRED), IceF%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5808,7 +5808,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr n_t_module = n_t_global*p_FAST%n_substeps( Module_IceD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_IceD ) + t_initial - CALL IceD_UpdateStates( t_module, n_t_module, IceD%Input(:,i), IceD%InputTimes(:,i), IceD%p(i), IceD%x(i,STATE_PRED), & + CALL IceD_UpdateStates( t_module, n_t_module, IceD%Input(1:,i), IceD%InputTimes(1:,i), IceD%p(i), IceD%x(i,STATE_PRED), & IceD%xd(i,STATE_PRED), IceD%z(i,STATE_PRED), IceD%OtherSt(i,STATE_PRED), IceD%m(i), ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5866,7 +5866,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ErrMsg = "" ! ElastoDyn - CALL ED_Input_ExtrapInterp(ED%Input, ED%InputTimes, ED%u, t_global_next, ErrStat2, ErrMsg2) + CALL ED_Input_ExtrapInterp(ED%Input(1:), ED%InputTimes, ED%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) DO j = p_FAST%InterpOrder, 1, -1 @@ -5885,7 +5885,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A DO k = 1,p_FAST%nBeams - CALL BD_Input_ExtrapInterp(BD%Input(:,k), BD%InputTimes(:,k), BD%u(k), t_global_next, ErrStat2, ErrMsg2) + CALL BD_Input_ExtrapInterp(BD%Input(1:,k), BD%InputTimes(1:,k), BD%u(k), t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of BD%Input @@ -5907,7 +5907,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! AeroDyn IF ( (p_FAST%CompAero == Module_AD ) .or. (p_FAST%CompAero == Module_ExtLd ) ) THEN - CALL AD_Input_ExtrapInterp(AD%Input, AD%InputTimes, AD%u, t_global_next, ErrStat2, ErrMsg2) + CALL AD_Input_ExtrapInterp(AD%Input(1:), AD%InputTimes, AD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of AD%Input @@ -5931,7 +5931,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! InflowWind IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL InflowWind_Input_ExtrapInterp(IfW%Input, IfW%InputTimes, IfW%u, t_global_next, ErrStat2, ErrMsg2) + CALL InflowWind_Input_ExtrapInterp(IfW%Input(1:), IfW%InputTimes, IfW%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of IfW%Input @@ -5952,7 +5952,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! ServoDyn IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_Input_ExtrapInterp(SrvD%Input, SrvD%InputTimes, SrvD%u, t_global_next, ErrStat2, ErrMsg2) + CALL SrvD_Input_ExtrapInterp(SrvD%Input(1:), SrvD%InputTimes, SrvD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of SrvD%Input @@ -5976,7 +5976,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! HydroDyn IF ( p_FAST%CompHydro == Module_HD ) THEN - CALL HydroDyn_Input_ExtrapInterp(HD%Input, HD%InputTimes, HD%u, t_global_next, ErrStat2, ErrMsg2) + CALL HydroDyn_Input_ExtrapInterp(HD%Input(1:), HD%InputTimes, HD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of HD%Input @@ -5998,7 +5998,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! SubDyn/ExtPtfm_MCKF IF ( p_FAST%CompSub == Module_SD ) THEN - CALL SD_Input_ExtrapInterp(SD%Input, SD%InputTimes, SD%u, t_global_next, ErrStat2, ErrMsg2) + CALL SD_Input_ExtrapInterp(SD%Input(1:), SD%InputTimes, SD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of SD%Input @@ -6015,7 +6015,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - CALL ExtPtfm_Input_ExtrapInterp(ExtPtfm%Input, ExtPtfm%InputTimes, ExtPtfm%u, t_global_next, ErrStat2, ErrMsg2) + CALL ExtPtfm_Input_ExtrapInterp(ExtPtfm%Input(1:), ExtPtfm%InputTimes, ExtPtfm%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of ExtPtfm%Input @@ -6036,7 +6036,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN - CALL MAP_Input_ExtrapInterp(MAPp%Input, MAPp%InputTimes, MAPp%u, t_global_next, ErrStat2, ErrMsg2) + CALL MAP_Input_ExtrapInterp(MAPp%Input(1:), MAPp%InputTimes, MAPp%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of MAPp%Input @@ -6054,7 +6054,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - CALL MD_Input_ExtrapInterp(MD%Input, MD%InputTimes, MD%u, t_global_next, ErrStat2, ErrMsg2) + CALL MD_Input_ExtrapInterp(MD%Input(1:), MD%InputTimes, MD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of MD%Input @@ -6072,7 +6072,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! FEAM ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - CALL FEAM_Input_ExtrapInterp(FEAM%Input, FEAM%InputTimes, FEAM%u, t_global_next, ErrStat2, ErrMsg2) + CALL FEAM_Input_ExtrapInterp(FEAM%Input(1:), FEAM%InputTimes, FEAM%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of FEAM%Input @@ -6090,7 +6090,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! OrcaFlex ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - CALL Orca_Input_ExtrapInterp(Orca%Input, Orca%InputTimes, Orca%u, t_global_next, ErrStat2, ErrMsg2) + CALL Orca_Input_ExtrapInterp(Orca%Input(1:), Orca%InputTimes, Orca%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of Orca%Input @@ -6113,7 +6113,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ! IceFloe IF ( p_FAST%CompIce == Module_IceF ) THEN - CALL IceFloe_Input_ExtrapInterp(IceF%Input, IceF%InputTimes, IceF%u, t_global_next, ErrStat2, ErrMsg2) + CALL IceFloe_Input_ExtrapInterp(IceF%Input(1:), IceF%InputTimes, IceF%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of IceF%Input @@ -6133,7 +6133,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A DO i = 1,p_FAST%numIceLegs - CALL IceD_Input_ExtrapInterp(IceD%Input(:,i), IceD%InputTimes(:,i), IceD%u(i), t_global_next, ErrStat2, ErrMsg2) + CALL IceD_Input_ExtrapInterp(IceD%Input(1:,i), IceD%InputTimes(:,i), IceD%u(i), t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of IceD%Input diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 new file mode 100644 index 0000000000..bfe27768b1 --- /dev/null +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -0,0 +1,1610 @@ +module FAST_SolverTC + +use NWTC_LAPACK +use FAST_Solver +use FAST_ModTypes +use FAST_Mapping +use FAST_ModGlue +use FAST_Funcs +use ElastoDyn +use BeamDyn +use SubDyn +use AeroDyn +use ServoDyn +use SC_DataEx + +implicit none + +private + +! Public functions +public Solver_Init, Solver_Step0, Solver_Step + +! Debugging +logical, parameter :: DebugSolver = .false. +integer(IntKi) :: DebugUn = -1 +character(*), parameter :: DebugFile = 'solver.dbg' +logical, parameter :: DebugJacobian = .false. +integer(IntKi) :: MatrixUn = -1 + +contains + +subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) + type(FAST_ParameterType), intent(in) :: p_FAST !< FAST parameters + type(Glue_TCParam), intent(inout) :: p !< Glue Parameters + type(Glue_TCMisc), intent(out) :: m !< Glue miscellaneous variables + type(ModDataType), intent(inout) :: GlueModData(:) !< Glue module data + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings + type(FAST_TurbineType), intent(inout) :: Turbine !< all data for one instance of a turbine + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Solver_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi), allocatable :: modIDs(:), modInds(:), iMod(:) + + !---------------------------------------------------------------------------- + ! Initialize data in TC structure + !---------------------------------------------------------------------------- + + ! Solver time step + p%h = p_FAST%DT + + ! Number of steps to advance between Jacobian updates + if (p_FAST%DT_UJac/p_FAST%DT + 1 < huge(1_IntKi)) then + p%NStep_UJac = ceiling(p_FAST%DT_UJac/p_FAST%DT, IntKi) + else + p%NStep_UJac = huge(1_IntKi) + end if + + ! Number of convergence iterations between Jacobian updates + ! TODO: read from input file + p%NIter_UJac = 100 + + ! Generalized alpha damping coefficient + ! TODO: read from input file + p%RhoInf = 0.0_R8Ki + + ! Max number of convergence iterations + ! TODO: read from input file + p%MaxConvIter = 6 + + ! Convergence tolerance + ! TODO: read from input file + p%ConvTol = 1.0e-5_R8Ki + + ! Jacobian conditioning + p%Scale_UJac = p_FAST%UJacSclFact + + ! Generalized alpha integration constants + p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) + p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) + p%Gamma = 0.5_R8Ki - p%AlphaM + p%AlphaF + p%Beta = (1.0_R8Ki - p%AlphaM + p%AlphaF)**2.0_R8Ki/4.0_R8Ki + + ! Precalculate some coefficients + p%BetaPrime = p%h*p%h*p%Beta*(1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) + p%GammaPrime = p%h*p%Gamma*(1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) + + !---------------------------------------------------------------------------- + ! Module ordering for solve + !---------------------------------------------------------------------------- + + ! Create array of indices for Mods array + modInds = [(i, i=1, size(GlueModData))] + + ! Get array of module IDs + modIDs = [(GlueModData(i)%ID, i=1, size(GlueModData))] + + ! Indices of all modules in Step 0 initialization order + p%iModInit = [pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_SrvD)] ! ServoDyn is last + + ! Indices of tight coupling modules + p%iModTC = [pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD)] + + ! Indices of Option 1 modules + p%iModOpt1 = [pack(modInds, ModIDs == Module_ExtPtfm), & + pack(modInds, ModIDs == Module_HD), & + pack(modInds, ModIDs == Module_MD), & + pack(modInds, ModIDs == Module_Orca)] + + ! Indices of Option 2 modules + p%iModOpt2 = [pack(modInds, ModIDs == Module_SrvD), & + pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_FEAM), & + pack(modInds, ModIDs == Module_IceD), & + pack(modInds, ModIDs == Module_IceF), & + pack(modInds, ModIDs == Module_MAP), & + pack(modInds, ModIDs == Module_MD)] + + ! Indices of modules to perform InputSolves after the Option 1 solve + p%iModPost = [pack(modInds, ModIDs == Module_SrvD), & + pack(modInds, ModIDs == Module_MD), & + pack(modInds, ModIDs == Module_ExtInfw)] + + !---------------------------------------------------------------------------- + ! Set solve flags and combine relevant modules into TC module + !---------------------------------------------------------------------------- + + ! Set VF_Solve flag on Jacobian variables use by the tight coupling solver + call SetVarSolveFlags() + + ! Combination of TC and Option 1 module indices + iMod = [p%iModTC, p%iModOpt1] + + ! Build tight coupling module using solve variables from TC and Option 1 modules + call Glue_CombineModules(m%Mod, GlueModData, GlueModMaps, iMod, & + VF_Solve, .true., ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Recalculate glue variable locations to simplify Jacobian construction + !---------------------------------------------------------------------------- + + call CalcVarGlobalIndices(p, m%Mod, p%NumQ, p%NumJ, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Allocate state, input, and output storage + !---------------------------------------------------------------------------- + + ! Calculated inputs array + call AllocAry(m%uCalc, m%Mod%Vars%Nu, "m%uCalc", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%UOrig, m%Mod%Vars%Nu, "m%UOrig", ErrStat2, ErrMsg2); if (Failed()) return + + ! Generalized alpha state arrays + call AllocAry(m%State%q_prev, p%NumQ, "m%State%q_prev", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%State%x, p%NumQ, "m%State%q_delta", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%State%q, p%NumQ, "m%State%q", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%State%v, p%NumQ, "m%State%v", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%State%vd, p%NumQ, "m%State%vd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%State%a, p%NumQ, "m%State%a", ErrStat2, ErrMsg2); if (Failed()) return + m%State%q_prev = 0.0_R8Ki + m%State%x = 0.0_R8Ki + m%State%q = 0.0_R8Ki + m%State%v = 0.0_R8Ki + m%State%vd = 0.0_R8Ki + m%State%a = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! Allocate solver Jacobian matrix and right hand side + !---------------------------------------------------------------------------- + + ! Allocate Jacobian matrix, RHS/X matrix, Pivot array + call AllocAry(m%Mod%Lin%J, p%NumJ, p%NumJ, "m%J", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%T, p%NumJ, 3, "m%T", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%XB, p%NumJ, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%IPIV, p%NumJ, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return + m%Mod%Lin%J = 0.0_R8Ki + + ! Initialize iterations and steps until Jacobian is calculated to zero + ! so it is calculated in first step + m%IterUntilUJac = 0 + m%StepsUntilUJac = 0 + + !---------------------------------------------------------------------------- + ! Solver Outputs + !---------------------------------------------------------------------------- + + Turbine%y_FAST%DriverWriteOutputNum = 3 + Turbine%y_FAST%DriverWriteOutputHdr = [character(ChanLen) :: 'ConvIter', 'ConvError', 'NumUJac'] + Turbine%y_FAST%DriverWriteOutputUnt = [character(ChanLen) :: '(-)', '(-)', '(-)'] + + !---------------------------------------------------------------------------- + ! Write debug info to file + !---------------------------------------------------------------------------- + + if (DebugSolver) then + call GetNewUnit(DebugUn, ErrStat2, ErrMsg2); if (Failed()) return + call OpenFOutFile(DebugUn, DebugFile, ErrStat2, ErrMsg2); if (Failed()) return + call Solver_Init_Debug(p, m, GlueModData, GlueModMaps) + end if + +contains + + subroutine SetVarSolveFlags() + ! Loop through tight coupling modules and add VF_Solve flag to + do i = 1, size(p%iModTC) + associate (ModData => GlueModData(p%iModTC(i))) + do j = 1, size(ModData%Vars%x) + call MV_SetFlags(ModData%Vars%x(j), VF_Solve) ! Continuous state variables + end do + ! do j = 1, size(ModData%Vars%u) + ! call MV_SetFlags(ModData%Vars%u(j), VF_Solve) ! Input variables + ! end do + ! do j = 1, size(ModData%Vars%y) + ! if (MV_HasFlagsAny(ModData%Vars%y(j), VF_ExtLin + VF_WriteOut)) cycle + ! call MV_SetFlags(ModData%Vars%y(j), VF_Solve) ! Output variables + ! end do + end associate + end do + + ! do i = 1, size(p%iModOpt1) + ! associate (ModData => GlueModData(p%iModOpt1(i))) + ! do j = 1, size(ModData%Vars%u) + ! call MV_SetFlags(ModData%Vars%u(j), VF_Solve) ! Input variables + ! end do + ! do j = 1, size(ModData%Vars%y) + ! if (MV_HasFlagsAny(ModData%Vars%y(j), VF_ExtLin + VF_WriteOut)) cycle + ! call MV_SetFlags(ModData%Vars%y(j), VF_Solve) ! Output variables + ! end do + ! end associate + ! end do + + ! Loop through module mappings + do j = 1, size(GlueModMaps) + associate (Mapping => GlueModMaps(j), & + SrcMod => GlueModData(GlueModMaps(j)%iModSrc), & + DstMod => GlueModData(GlueModMaps(j)%iModDst)) + + if (Mapping%MapType == Map_Custom) cycle + + ! If source module is in tight coupling or option 1 + if (any(SrcMod%ID == TC_Modules) .or. any(SrcMod%ID == O1_Modules)) then + + ! Set mapping flag on source variables + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) call MV_SetFlags(Var, VF_Solve) + end associate + end do + + ! Set mapping flag on source displacement mesh variables + if (Mapping%MapType == Map_LoadMesh) then + do i = 1, size(SrcMod%Vars%u) + associate (Var => SrcMod%Vars%u(i)) + if (MV_EqualDL(Mapping%SrcDispDL, Var%DL)) call MV_SetFlags(Var, VF_Solve) + end associate + end do + end if + end if + + ! If destination module is in tight coupling or option 1 + if (any(DstMod%ID == TC_Modules) .or. any(DstMod%ID == O1_Modules)) then + + ! Set mapping flag on destination variables + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) call MV_SetFlags(Var, VF_Solve) + end associate + end do + + ! Set mapping flag on destination displacement mesh variables + if (Mapping%MapType == Map_LoadMesh) then + do i = 1, size(DstMod%Vars%y) + associate (Var => DstMod%Vars%y(i)) + if (MV_EqualDL(Mapping%DstDispDL, Var%DL)) call MV_SetFlags(Var, VF_Solve) + end associate + end do + end if + end if + end associate + end do + end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine CalcVarGlobalIndices(p, ModTC, NumQ, NumJ, ErrStat, ErrMsg) + type(Glue_TCParam), intent(inout) :: p !< Parameters + type(ModGlueType), intent(inout) :: ModTC !< Module data + integer(IntKi), intent(out) :: NumJ !< Number of rows in Jacobian + integer(IntKi), intent(out) :: NumQ !< Number of rows in state matrix + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'CalcVarGlobalIndices' + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + integer(IntKi) :: i, j, k, num, iGlu + integer(IntKi) :: ix, iu, iy + + ErrStat = ErrID_None + ErrMsg = '' + + ! Initialize indices to zero + p%iX1 = 0 + p%iX2 = 0 + p%iUT = 0 + p%iU1 = 0 + p%iUL = 0 + p%iyT = 0 + p%iy1 = 0 + p%iJX = 0 + p%iJU = 0 + p%iJUT = 0 + p%iJL = 0 + + ! Loop through modules in data array and zero glue locations + do i = 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (allocated(Vars%x)) then + do j = 1, size(Vars%x) + Vars%x(j)%iGlu = 0 + end do + end if + if (allocated(Vars%u)) then + do j = 1, size(Vars%u) + Vars%u(j)%iGlu = 0 + end do + end if + if (allocated(Vars%y)) then + do j = 1, size(Vars%y) + Vars%y(j)%iGlu = 0 + end do + end if + end associate + end do + + !---------------------------------------------------------------------------- + ! Calculate TC state glue locations (displacements then velocities) + !---------------------------------------------------------------------------- + + ! Initialize glue index + iGlu = 0 + + ! Set indices for displacement variables + do i = 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%x)) cycle + do j = 1, size(Vars%x) + if (Vars%x(j)%DerivOrder == 0) then + Vars%x(j)%iGlu = [iGlu + 1, iGlu + Vars%x(j)%Num] + iGlu = Vars%x(j)%iGlu(2) + end if + end do + end associate + end do + + ! Start and end indices of displacement variables + p%iX1 = [1, iGlu] + + ! Set indices for velocity variables + do i = 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%x)) cycle + do j = 1, size(Vars%x) + if (Vars%x(j)%DerivOrder == 1) then + Vars%x(j)%iGlu = [iGlu + 1, iGlu + Vars%x(j)%Num] + iGlu = Vars%x(j)%iGlu(2) + end if + end do + end associate + end do + + ! Start and end indices of velocity variables + if (iGlu > p%iX1(2)) p%iX2 = [p%iX1(2) + 1, iGlu] + + !---------------------------------------------------------------------------- + ! Calculate input variable glue locations (group load and non-load) + !---------------------------------------------------------------------------- + + ! Initialize glue index + iGlu = 0 + + ! ! Set indices of Tight Coupling input variables + ! do i = 1, size(p%iModTC) + ! associate (Vars => ModTC%ModData(i)%Vars) + ! if (.not. allocated(Vars%u)) cycle + ! do j = 1, size(Vars%u) + ! Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + ! iGlu = Vars%u(j)%iGlu(2) + ! end do + ! end associate + ! end do + + ! if (iGlu > 0) p%iUT = [1, iGlu] + + ! ! Set indices of Option 1 input variables + ! do i = size(p%iModTC) + 1, size(ModTC%ModData) + ! associate (Vars => ModTC%ModData(i)%Vars) + ! if (.not. allocated(Vars%u)) cycle + ! do j = 1, size(Vars%u) + ! Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + ! iGlu = Vars%u(j)%iGlu(2) + ! end do + ! end associate + ! end do + + ! if (iGlu > p%iUT(2)) p%iU1 = [p%iUT(2) + 1, iGlu] + + ! Set indices of Tight Coupling input variables (non-load) + do i = 1, size(p%iModTC) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%u)) cycle + do j = 1, size(Vars%u) + if (.not. MV_IsLoad(Vars%u(j))) then + Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + iGlu = Vars%u(j)%iGlu(2) + end if + end do + end associate + end do + + ! Set start index of load values + p%iUL(1) = iGlu + 1 + + ! Set indices of Tight Coupling input variables (load) + do i = 1, size(p%iModTC) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%u)) cycle + do j = 1, size(Vars%u) + if (MV_IsLoad(Vars%u(j))) then + Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + iGlu = Vars%u(j)%iGlu(2) + end if + end do + end associate + end do + + ! Set start/end indices for tight coupling inputs + if (iGlu > 0) p%iUT = [1, iGlu] + + ! Set indices of Option 1 input variables (load) + do i = size(p%iModTC) + 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%u)) cycle + do j = 1, size(Vars%u) + if (MV_IsLoad(Vars%u(j))) then + Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + iGlu = Vars%u(j)%iGlu(2) + end if + end do + end associate + end do + + ! Set end index of load values + if (iGlu >= p%iUL(1)) p%iUL(2) = iGlu + + ! Set indices of Option 1 input variables (non-load) + do i = size(p%iModTC) + 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%u)) cycle + do j = 1, size(Vars%u) + if (.not. MV_IsLoad(Vars%u(j))) then + Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + iGlu = Vars%u(j)%iGlu(2) + end if + end do + end associate + end do + + ! Set start/end indices for Option 1 inputs + if (iGlu > p%iUT(2)) p%iU1 = [p%iUT(2) + 1, iGlu] + + !---------------------------------------------------------------------------- + ! Calculate output variable categories and indices + !---------------------------------------------------------------------------- + + ! Initialize glue index + iGlu = 0 + + ! Set indices of Tight Coupling output variables + do i = 1, size(p%iModTC) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%y)) cycle + do j = 1, size(Vars%y) + Vars%y(j)%iGlu = [iGlu + 1, iGlu + Vars%y(j)%Num] + iGlu = Vars%y(j)%iGlu(2) + end do + end associate + end do + + ! Save number of tight coupling inputs + if (iGlu > 0) p%iyT = [1, iGlu] + + ! Set indices of Option 1 output variables + do i = size(p%iModTC) + 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%y)) cycle + do j = 1, size(Vars%y) + Vars%y(j)%iGlu = [iGlu + 1, iGlu + Vars%y(j)%Num] + iGlu = Vars%y(j)%iGlu(2) + end do + end associate + end do + + ! Calculate number of option 1 outputs + if (iGlu > p%iyT(2)) p%iy1 = [p%iyT(2) + 1, iGlu] + + !---------------------------------------------------------------------------- + ! Allocate q storage for generalized alpha algorithm + ! This matrix stores equation state in an (N,4) array where: + ! - N is the number of equations (rows) + ! - Column 1 is position + ! - Column 2 is velocity + ! - Column 3 is acceleration + ! - Column 4 is generalized alpha algorithmic acceleration + !---------------------------------------------------------------------------- + + ! Initialize number of q states (ignore derivatives) + NumQ = 0 + + ! Loop through tight coupling modules in glue module + do i = 1, size(p%iModTC) + + associate (xVars => ModTC%ModData(i)%Vars%x) + + ! Loop through state variables + do j = 1, size(xVars) + + ! Skip variables which already have a q index + if (xVars(j)%iq(1) > 0) cycle + + ! Set q index for variable and update number + xVars(j)%iq = [NumQ + 1, NumQ + xVars(j)%Num] + NumQ = NumQ + xVars(j)%Num + + ! Loop through remaining vars if the names match + do k = j + 1, size(xVars) + + ! If names are different then they don't match, skip + if (xVars(j)%Name /= xVars(k)%Name) cycle + + ! If field is not the same or a derivative of current field, skip + select case (xVars(j)%Field) + case (FieldTransDisp, FieldTransVel, FieldTransAcc) + if (all(xVars(k)%Field /= TransFields)) cycle + case (FieldOrientation, FieldAngularDisp, FieldAngularVel, FieldAngularAcc) + if (all(xVars(k)%Field /= AngularFields)) cycle + case (FieldForce, FieldMoment) + cycle + end select + + ! Copy q row indices + xVars(k)%iq = xVars(j)%iq + + end do + end do + end associate + end do + + !---------------------------------------------------------------------------- + ! Populate combined variable arrays + !---------------------------------------------------------------------------- + + ix = 0; iu = 0; iy = 0 + do i = 1, size(ModTC%ModData) + associate (ModData => ModTC%ModData(i)) + + if (allocated(ModData%Vars%x)) then + do j = 1, size(ModData%Vars%x) + ix = ix + 1 + ModTC%Vars%x(ix)%iLoc = ModData%Vars%x(j)%iGlu + ModTC%Vars%x(ix)%iq = ModData%Vars%x(j)%iq + end do + end if + + if (allocated(ModData%Vars%u)) then + do j = 1, size(ModData%Vars%u) + iu = iu + 1 + ModTC%Vars%u(iu)%iLoc = ModData%Vars%u(j)%iGlu + end do + end if + + if (allocated(ModData%Vars%y)) then + do j = 1, size(ModData%Vars%y) + iy = iy + 1 + ModTC%Vars%y(iy)%iLoc = ModData%Vars%y(j)%iGlu + end do + end if + + end associate + end do + + !---------------------------------------------------------------------------- + ! Jacobian indices and ranges + !---------------------------------------------------------------------------- + + ! Calculate size of Jacobian matrix + NumJ = NumQ + ModTC%Vars%Nu + + ! Get start and end indices for state part of Jacobian + p%iJX = [1, NumQ] + + ! Get start and end indices for tight coupling input part of Jacobian + if (p%iUT(1) > 0) p%iJUT = NumQ + p%iUT + + ! Get start and end indices for input part of Jacobian + if (p%iUT(1) > 0 .or. p%iU1(2) > 0) p%iJU = NumQ + [1, max(p%iUT(2), p%iU1(2))] + + ! Get Jacobian indices containing loads + if (p%iUL(1) > 0) p%iJL = NumQ + p%iUL + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(ModDataType), intent(inout) :: GlueModData(:) !< Glue module data + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Solver_Step0' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + logical, parameter :: IsSolve = .true. + integer(IntKi) :: i, j, k + real(R8Ki) :: ConvError + logical :: converged + integer(IntKi), parameter :: n_t_global = -1 ! loop counter + integer(IntKi), parameter :: n_t_global_next = 0 ! loop counter + real(DbKi) :: t_initial ! next simulation time + real(DbKi) :: t_global_next ! next simulation time + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Miscellaneous initial step setup + !---------------------------------------------------------------------------- + + t_initial = Turbine%m_FAST%t_global + t_global_next = t_initial + n_t_global_next*p%h + Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, Turbine%p_FAST%TStart, Turbine%p_FAST%n_DT_Out) + + ! Set flag to warn about convergence errors + m%ConvWarn = .true. + + !---------------------------------------------------------------------------- + ! Calculate initial accelerations + !---------------------------------------------------------------------------- + + ! Transfer initial state from modules to solver + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) + if (Failed()) return + end associate + end do + + ! Transfer initial module state to GA state + call TransferXtoQ(m%Mod%Vars, m%Mod%Lin%x, m%State) + + ! Reset mapping ready for transfer flag + GlueModMaps%Ready = .false. + + ! Loop until initial accelerations are converged, or max iterations are reached. + ! TODO: may need a separate variable for max initial acceleration convergence iterations + converged = .false. + k = 0 + do while ((.not. converged) .and. (k <= 2*p%MaxConvIter)) + + ! Transfer inputs and calculate outputs for all modules (use current state) + do i = 1, size(p%iModInit) + call FAST_InputSolve(p%iModInit(i), GlueModData, GlueModMaps, INPUT_CURR, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_CalcOutput(GlueModData(p%iModInit(i)), GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Calculate continuous state derivatives for tight coupling modules (use current state) + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_initial, INPUT_CURR, STATE_CURR, & + Turbine, ErrStat2, ErrMsg2, & + dx_op=m%Mod%ModData(i)%Lin%dx, dx_glue=m%Mod%Lin%dx) + if (Failed()) return + end do + + ! Copy acceleration (derivative of velocity) to acceleration array. + associate (Vars => m%Mod%Vars) + do i = 1, size(Vars%x) + select case (Vars%x(i)%DerivOrder) + case (1) ! Velocity + m%State%vd(Vars%x(i)%iq(1):Vars%x(i)%iq(2)) = m%Mod%Lin%dx(Vars%x(i)%iLoc(1):Vars%x(i)%iLoc(2)) + end select + end do + end associate + + ! Calculate convergence error as L2 norm of diff between current and new accelerations + ConvError = TwoNorm(m%State%vd - m%State%a) + + ! Update algorithmic acceleration + m%State%a = m%State%vd + + ! If difference is less than convergence tolerance, set flag and exit loop + if ((k > 1) .and. (ConvError < p%ConvTol)) converged = .true. + + ! Increment iteration counter + k = k + 1 + end do + + ! Print warning if not converged + if (.not. converged) then + call WrScr("Solver: initial accel not converged, diff="// & + trim(Num2LStr(ConvError))//", tol="//trim(Num2LStr(p%ConvTol))) + end if + + ! Copy current state to previous state + call Glue_CopyTC_State(m%State, m%StatePrev, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Initialize IO and states for all modules (also copies STATE_CURR to STATE_PRED) + call FAST_InitIO(GlueModData, t_initial, p%h, Turbine, ErrStat, ErrMsg) + if(ErrStat >= AbortErrLev) return + + ! Reset the Remap flags for all modules + call FAST_ResetRemapFlags(GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) + if(ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Set Outputs + !---------------------------------------------------------------------------- + + Turbine%y_FAST%DriverWriteOutput(1) = real(k, ReKi) ! ConvIter + Turbine%y_FAST%DriverWriteOutput(2) = real(ConvError, ReKi) ! ConvError + Turbine%y_FAST%DriverWriteOutput(3) = 0.0_ReKi ! NumUJac + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: n_t_global !< global time step + real(DbKi), intent(in) :: t_initial !< Initial simulation time + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(ModDataType), intent(inout) :: GlueModData(:) !< Glue module data + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Solver_Step' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + logical, parameter :: IsSolve = .true. + integer(IntKi) :: iterConv, iterCorr, iterTotal + integer(IntKi) :: NumUJac, NumCorrections + real(ReKi) :: delta_norm + real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + integer(IntKi) :: n_t_global_next ! n_t_global + 1 + integer(IntKi) :: i, j + logical :: ConvUJac ! Jacobian updated for convergence + real(R8Ki) :: ErrPrev + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Miscellaneous step updates + !---------------------------------------------------------------------------- + + ! Calculate the next global time step number and time + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next*p%h + + ! Determine if output should be written in this step + Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, Turbine%p_FAST%TStart, Turbine%p_FAST%n_DT_Out) + + ! Decrement number of time steps before updating the Jacobian + m%StepsUntilUJac = m%StepsUntilUJac - 1 + + ! Set Jacobian updated for convergence flag to false + ConvUJac = .false. + + ! Init counters for number of Jacobian updates and number of convergence iterations + NumUJac = 0 + iterTotal = 0 + + !---------------------------------------------------------------------------- + ! Extrapolate/interpolate inputs for all modules + !---------------------------------------------------------------------------- + + ! Loop through all modules and extrapolate inputs + do i = 1, size(GlueModData) + associate (ModData => GlueModData(i)) + call FAST_ExtrapInterp(ModData, t_global_next, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + !---------------------------------------------------------------------------- + ! Prediction - guess solution state variables at end of time step + !---------------------------------------------------------------------------- + + call PredictNextState(p, m%StatePrev, m%Mod%Vars) + + !---------------------------------------------------------------------------- + ! Correction Iterations + !---------------------------------------------------------------------------- + + ! Loop through correction iterations + iterCorr = 0 + NumCorrections = p%NumCrctn + do while (iterCorr <= NumCorrections) + + ! Reset mapping ready flags + GlueModMaps%Ready = .false. + + ! Copy TC solver states from previous to current + call Glue_CopyTC_State(m%StatePrev, m%State, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Transfer current states to linearization array + call TransferQtoX(m%Mod%Vars, m%State, m%Mod%Lin%x) + + ! Loop through tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) + ! Copy state from current to predicted + call FAST_CopyStates(ModData, Turbine, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Transfer solver states to module + call FAST_SetOP(ModData, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) + if (Failed()) return + end associate + end do + + !------------------------------------------------------------------------- + ! Option 2 Solve + !------------------------------------------------------------------------- + + ! Loop through Option 2 modules + do i = 1, size(p%iModOpt2) + associate (ModData => GlueModData(p%iModOpt2(i))) + call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_UpdateStates(ModData, t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_CalcOutput(ModData, GlueModMaps, t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + !------------------------------------------------------------------------- + ! Option 1 Solve + !------------------------------------------------------------------------- + + ! Get inputs and update states for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_UpdateStates(GlueModData(p%iModOpt1(i)), t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + !------------------------------------------------------------------------- + ! Convergence Iterations + !------------------------------------------------------------------------- + + ! Pack TC and Option 1 inputs into u array + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate + end do + + ! Loop through convergence iterations + do iterConv = 0, p%MaxConvIter + + ! Increment total number of convergence iterations in step + iterTotal = iterTotal + 1 + + ! Decrement number of iterations before updating the Jacobian + m%IterUntilUJac = m%IterUntilUJac - 1 + + !---------------------------------------------------------------------- + ! Calculate outputs for TC & Opt1 modules + !---------------------------------------------------------------------- + + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_CalcOutput(ModData, GlueModMaps, t_global_next, INPUT_CURR, STATE_PRED, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + !---------------------------------------------------------------------- + ! Convergence iteration check + !---------------------------------------------------------------------- + + ! If convergence iteration has reached or exceeded limit + if (iterConv >= p%MaxConvIter) then + + ! If Jacobian has not been updated for convergence + if (.not. ConvUJac) then + + ! Set counter to trigger a Jacobian update on next convergence iteration + m%IterUntilUJac = 0 + + ! If at the maximum number of correction iterations, + ! increase limit to retry the step after the Jacobian is updated + if (iterCorr == NumCorrections) NumCorrections = NumCorrections + 1 + + ! Set flag indicating that the jacobian has been updated for convergence + ConvUJac = .true. + + else + + ! Otherwise, correction iteration with Jacobian update has been tried, + ! display warning that convergence failed and move to next step + call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & + " iterations on step "//trim(Num2LStr(n_t_global_next))// & + " (error="//trim(Num2LStr(delta_norm))// & + ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & + ErrStat, ErrMsg, RoutineName) + end if + + ! Exit convergence loop to next correction iteration or next step + exit + end if + + !---------------------------------------------------------------------- + ! Update Jacobian + !---------------------------------------------------------------------- + + ! If number of iterations or steps until Jacobian is to be updated + ! is zero or less, or first solution step, then rebuild the Jacobian. + ! Note: BuildJacobian resets these counters. + if ((m%IterUntilUJac <= 0) .or. & + (m%StepsUntilUJac <= 0) .or. & + (n_t_global_next == 1)) then + NumUJac = NumUJac + 1 + call BuildJacobian(p, m, GlueModMaps, t_global_next, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------- + ! Formulate right hand side (X_2^tight, U^tight, U^Option1) + !---------------------------------------------------------------------- + + ! Calculate continuous state derivatives for tight coupling modules + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + dx_op=m%Mod%ModData(i)%Lin%dx, dx_glue=m%Mod%Lin%dx) + if (Failed()) return + end do + + ! Input solve for tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => GlueModData(p%iModTC(i))) + call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + ! Input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + associate (ModData => GlueModData(p%iModOpt1(i))) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + ! Transfer collect inputs into uCalc + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_global_next, INPUT_TEMP, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%uCalc) + if (Failed()) return + end do + + !---------------------------------------------------------------------- + ! Populate residual vector and apply conditioning to loads + !---------------------------------------------------------------------- + + ! Calculate difference between calculated and predicted accelerations + m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%State%vd + + ! Calculate difference in U for all Option 1 modules (un - u_tmp) + ! and add to RHS for TC and Option 1 modules + if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB(p%iJU(1):p%iJU(2), 1)) + + ! Apply conditioning factor to loads in RHS + do i = p%iJL(1), p%iJL(2) + m%XB(i, 1) = m%XB(i, 1)/p%Scale_UJac + end do + + !---------------------------------------------------------------------- + ! Solve for state and input perturbations + !---------------------------------------------------------------------- + + ! Solve Jacobian and RHS + call LAPACK_getrs('N', size(m%Mod%Lin%J, 1), m%Mod%Lin%J, m%IPIV, m%XB, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------- + ! Check perturbations for convergence and exit if below tolerance + !---------------------------------------------------------------------- + + ! Calculate average L2 norm of change in states and inputs + delta_norm = TwoNorm(m%XB(:, 1))/size(m%XB) + + ! Write step debug info if requested + if (DebugSolver) call Solver_Step_Debug(p, m, n_t_global_next, iterCorr, iterConv, delta_norm) + + ! If at least one convergence iteration has been done and + ! the RHS norm is less than convergence tolerance, exit loop + if ((iterConv > 0) .and. (delta_norm < p%ConvTol)) exit + + ! Remove conditioning + do i = p%iJL(1), p%iJL(2) + m%XB(i, 1) = m%XB(i, 1)*p%Scale_UJac + end do + + !---------------------------------------------------------------------- + ! Update State for Tight Coupling modules + !---------------------------------------------------------------------- + + call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%State) + + ! Transfer States to linearization array + call TransferQtoX(m%Mod%Vars, m%State, m%Mod%Lin%x) + + !---------------------------------------------------------------------- + ! Update inputs for Tight Coupling and Option 1 modules + !---------------------------------------------------------------------- + + ! Add change in inputs + if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) + if (p%iJU(1) > 0) m%UOrig = m%UOrig + m%XB(p%iJU(1):p%iJU(2), 1) + + !---------------------------------------------------------------------- + ! Transfer updated TC and Option 1 states and inputs to modules + !---------------------------------------------------------------------- + + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_SetOP(ModData, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate + end do + end do + + ! Increment correction iteration counter + iterCorr = iterCorr + 1 + + ! Perform input solve for modules post Option 1 convergence + do i = 1, size(p%iModPost) + call FAST_InputSolve(p%iModPost(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Reset mesh remap + call FAST_ResetRemapFlags(GlueModData, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + !---------------------------------------------------------------------------- + ! Update states for next step + !---------------------------------------------------------------------------- + + ! Update algorithmic acceleration + m%State%a = m%State%a + (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM)*m%State%vd + + ! Copy current state to previous state + call Glue_CopyTC_State(m%State, m%StatePrev, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Copy the final predicted states from step t_global_next to actual states for that step + do i = 1, size(GlueModData) + call FAST_SaveStates(GlueModData(i), Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + !---------------------------------------------------------------------------- + ! Set Outputs + !---------------------------------------------------------------------------- + + Turbine%y_FAST%DriverWriteOutput(1) = real(iterTotal, ReKi) ! ConvIter + Turbine%y_FAST%DriverWriteOutput(2) = real(delta_norm, ReKi) ! ConvError + Turbine%y_FAST%DriverWriteOutput(3) = real(NumUJac, ReKi) ! NumUJac + + !---------------------------------------------------------------------------- + ! Update the global time + !---------------------------------------------------------------------------- + + Turbine%m_FAST%t_global = t_global_next + +contains + logical function Failed() + if (ErrStat2 /= ErrID_None) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings at glue level + real(DbKi), intent(in) :: ThisTime !< Time + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BuildJacobian' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: phi, rv(3), T(3, 3), tmp1, tmp2, T2(3, 3) + integer(IntKi) :: i, j, k, idx + + ErrStat = ErrID_None + ErrMsg = '' + + ! Reset Jacobian update countdown values + m%IterUntilUJac = p%NIter_UJac + m%StepsUntilUJac = p%NStep_UJac + + if (size(m%Mod%Lin%J) == 0) return + + !---------------------------------------------------------------------------- + ! Get module Jacobians and assemble + ! A: rows = x; columns = x (dXdx) + ! B: rows = x; columns = u (dXdu) + ! C: rows = y; columns = x (dYdx) + ! D: rows = y; columns = u (dYdu) + !---------------------------------------------------------------------------- + + ! Initialize Jacobian matrices + if (allocated(m%Mod%Lin%dYdx)) m%Mod%Lin%dYdx = 0.0_R8Ki + if (allocated(m%Mod%Lin%dXdx)) m%Mod%Lin%dXdx = 0.0_R8Ki + if (allocated(m%Mod%Lin%dXdu)) m%Mod%Lin%dXdu = 0.0_R8Ki + if (allocated(m%Mod%Lin%dYdu)) m%Mod%Lin%dYdu = 0.0_R8Ki + if (allocated(m%Mod%Lin%dUdy)) m%Mod%Lin%dUdy = 0.0_R8Ki + if (allocated(m%Mod%Lin%dUdu)) then + call Eye2D(m%Mod%Lin%dUdu, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Loop through modules tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) + + ! Calculate dYdx, dXdx for tight coupling modules + call FAST_JacobianPContState(ModData, ThisTime, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + dXdx=ModData%Lin%dXdx, dXdx_glue=m%Mod%Lin%dXdx, & + dYdx=ModData%Lin%dYdx, dYdx_glue=m%Mod%Lin%dYdx) + if (Failed()) return + + ! Calculate Jacobians wrt inputs + call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + dXdu=ModData%Lin%dXdu, dXdu_glue=m%Mod%Lin%dXdu, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) + if (Failed()) return + end associate + end do + + ! Loop through Option 1 modules and calculate dYdu + do i = size(p%iModTC) + 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) + if (Failed()) return + end associate + end do + + ! Calculate dUdu and dUdy for TC and Option 1 modules + if (allocated(m%Mod%Lin%dUdy) .and. allocated(m%Mod%Lin%dUdu)) then + call FAST_LinearizeMappings(m%Mod, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! Assemble Jacobian + !---------------------------------------------------------------------------- + + ! If velocity or acceleration indices are zero, return + if (p%iX1(1) == 0 .or. p%iX2(1) == 0) return + + ! Group (1,1) + associate (J11 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJX(1):p%iJX(2)), & + dX2dx2 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)), & + dX2dx1 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX1(1):p%iX1(2))) + J11 = -p%GammaPrime*dX2dx2 - p%BetaPrime*dX2dx1 + do i = p%iJX(1), p%iJX(2) + J11(i, i) = J11(i, i) + 1.0_R8Ki + end do + end associate + + ! Group (2,1) + if (p%iyT(1) > 0 .and. p%iUT(1) > 0) then + associate (J21 => m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)), & + dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & + dYTdx2 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2)), & + dYTdx1 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) + ! J21 = C1*matmul(dUTdyT, dYTdx2) + C2*matmul(dUTdyT, dYTdx1) + call LAPACK_GEMM('N', 'N', p%GammaPrime, dUTdyT, dYTdx2, 0.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', p%BetaPrime, dUTdyT, dYTdx1, 1.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return + end associate + end if + + ! Group (1,2) + if (p%iUT(1) > 0) then + associate (J12 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJUT(1):p%iJUT(2)), & + dX2duT => m%Mod%Lin%dXdu(p%iX2(1):p%iX2(2), p%iUT(1):p%iUT(2))) + J12 = -dX2duT + end associate + end if + + ! Group (2,2) - Inputs = dUdu + matmul(dUdy, dYdu) + if (m%Mod%Vars%Nu > 0) then + associate (J22 => m%Mod%Lin%J(p%iJU(1):p%iJU(2), p%iJU(1):p%iJU(2))) + ! J22 = m%Mod%Lin%dUdu + matmul(m%Mod%Lin%dUdy, m%Mod%Lin%dYdu) + J22 = m%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, J22, ErrStat2, ErrMsg2); if (Failed()) return + end associate + end if + + ! Write debug matrices if requested + if (DebugJacobian) then + + ! Get module outputs + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, ThisTime, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + y_op=ModData%Lin%y, y_glue=m%Mod%Lin%y) + if (Failed()) return + end associate + end do + + ! Write debug info + call BuildJacobian_Debug(m, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! TODO: see if this actually works with option 1 modules + if (.true.) then + do i = 1, size(m%Mod%Vars%u) + if (m%Mod%Vars%u(i)%Field /= FieldOrientation) cycle + associate (Var => m%Mod%Vars%u(i)) + k = Var%iLoc(1) + idx = p%NumQ + k + do j = 1, Var%Nodes + + rv = m%UOrig(k:k + 2) + phi = dot_product(rv, rv) + + if (phi < 1.0e-10_R8Ki) cycle + + tmp1 = (cos(phi) - 1.0_R8Ki)/(phi*phi) + tmp2 = (1.0_R8Ki - sin(phi)/phi)/(phi*phi) + + T = VecTilde(rv) + T = tmp2*matmul(T, T) + tmp1*T + T(1, 1) = T(1, 1) + 1.0_R8Ki + T(2, 2) = T(2, 2) + 1.0_R8Ki + T(3, 3) = T(3, 3) + 1.0_R8Ki + + associate (Jsub => m%Mod%Lin%J(:, idx:idx + 2)) + m%T = Jsub + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%T, T, 0.0_R8Ki, Jsub, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + + k = k + 3 + end do + end associate + end do + end if + + ! Condition jacobian matrix before factoring + do j = 1, p%NumJ + do i = p%iJL(1), p%iJL(2) + m%Mod%Lin%J(i, j) = m%Mod%Lin%J(i, j)/p%Scale_UJac + end do + end do + do j = p%iJL(1), p%iJL(2) + do i = 1, p%NumJ + m%Mod%Lin%J(i, j) = m%Mod%Lin%J(i, j)*p%Scale_UJac + end do + end do + ! if (p%iJL(1) > 0) then + ! m%Mod%Lin%J(p%iJL(1):p%iJL(2), :) = m%Mod%Lin%J(p%iJL(1):p%iJL(2), :)/p%Scale_UJac + ! m%Mod%Lin%J(:, p%iJL(1):p%iJL(2)) = m%Mod%Lin%J(:, p%iJL(1):p%iJL(2))*p%Scale_UJac + ! end if + + ! Factor jacobian matrix + call LAPACK_getrf(size(m%Mod%Lin%J, 1), size(m%Mod%Lin%J, 1), m%Mod%Lin%J, m%IPIV, ErrStat2, ErrMsg2) + if (Failed()) return + +contains + function VecTilde(Vec) result(Matrix) + real(R8Ki), intent(in) :: Vec(3) + real(R8Ki) :: Matrix(3, 3) + Matrix(:, 1) = [0.0_R8Ki, Vec(3), -Vec(2)] + Matrix(:, 2) = [-Vec(3), 0.0_R8Ki, Vec(1)] + Matrix(:, 3) = [Vec(2), -Vec(1), 0.0_R8Ki] + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +!------------------------------------------------------------------------------- +! Utility functions +!------------------------------------------------------------------------------- + +subroutine PredictNextState(p, State, Vars) + type(Glue_TCParam), intent(in) :: p + type(TC_State), intent(inout) :: State + type(ModVarsType), intent(in) :: Vars + real(R8Ki) :: v_p, vd_p, a_p + integer(IntKi) :: i + + ! Loop through values and calculate acceleration, algo acceleration, velocity, and delta displacement + do i = 1, size(State%q) + + ! Store previous velocity, acceleration, and algorithmic acceleration + v_p = State%v(i) + vd_p = State%vd(i) + a_p = State%a(i) + + ! Set acceleration to zero + State%vd(i) = 0.0_R8Ki + + ! Calculate new algorithmic acceleration + State%a(i) = (p%AlphaF*vd_p - p%AlphaM*a_p)/(1.0_R8Ki - p%AlphaM) + + ! Calculate new velocity + State%v(i) = v_p + p%h*(1.0_R8Ki - p%Gamma)*a_p + p%Gamma*p%h*State%a(i) + + ! Copy current displacement to previous displacement + State%q_prev(i) = State%q(i) + + ! Predict change in displacement + State%x(i) = p%h*v_p + p%h*p%h*(0.5_R8Ki - p%Beta)*a_p + p%Beta*p%h*p%h*State%a(i) + end do + + ! Calculate new displacements from delta + call CalculateStateQ(State, Vars, p%h) +end subroutine + +subroutine CalculateStateQ(State, Vars, h) + type(TC_State), intent(inout) :: State + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: h + integer(IntKi) :: i, j, iq + real(R8Ki) :: quat_prev(3), quat_delta(3), quat_new(3) + + ! Calculate new displacement (valid for all states except orientation) + State%q = State%q_prev + State%x + + ! Loop through variables and compose rotations + do i = 1, size(Vars%x) + select case (Vars%x(i)%Field) + case (FieldOrientation) + iq = Vars%x(i)%iq(1) + do j = 1, Vars%x(i)%Nodes + quat_delta = rvec_to_quat(State%x(iq:iq + 2)) + quat_prev = State%q_prev(iq:iq + 2) + quat_new = quat_compose(quat_prev, quat_delta) + State%q(iq:iq + 2) = quat_new + iq = iq + 3 + end do + end select + end do +end subroutine + +subroutine UpdateStatePrediction(p, Vars, delta_vd, State) + type(Glue_TCParam), intent(in) :: p + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: delta_vd(:) + type(TC_State), intent(inout) :: State + + ! Update x by delta x + State%x = State%x + p%BetaPrime*delta_vd + + ! Update velocity + State%v = State%v + p%GammaPrime*delta_vd + + ! Update acceleration + State%vd = State%vd + delta_vd + + ! Update displacement calculation + call CalculateStateQ(State, Vars, p%h) + +end subroutine + +subroutine TransferXtoQ(Vars, x, State) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: x(:) + type(TC_State), intent(inout) :: State + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i)) + select case (Var%DerivOrder) + case (0) ! Displacement + State%q(Var%iq(1):Var%iq(2)) = x(Var%iLoc(1):Var%iLoc(2)) + case (1) ! Velocity + State%v(Var%iq(1):Var%iq(2)) = x(Var%iLoc(1):Var%iLoc(2)) + end select + end associate + end do +end subroutine + +subroutine TransferQtoX(Vars, State, x) + type(ModVarsType), intent(in) :: Vars + type(TC_State), intent(in) :: State + real(R8Ki), intent(inout) :: x(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + associate (Var => Vars%x(i)) + select case (Var%DerivOrder) + case (0) ! Displacement + x(Var%iLoc(1):Var%iLoc(2)) = State%q(Var%iq(1):Var%iq(2)) + case (1) ! Velocity + x(Var%iLoc(1):Var%iLoc(2)) = State%v(Var%iq(1):Var%iq(2)) + end select + end associate + end do +end subroutine + +pure function NeedWriteOutput(n_t_global, t_global, t_initial, n_DT_Out) result(WriteNeeded) + integer(IntKi), intent(in) :: n_t_global !< Current global time step + real(DbKi), intent(in) :: t_initial !< Initial time + real(DbKi), intent(in) :: t_global !< Current global time + integer(IntKi), intent(in) :: n_DT_Out !< Write output every n steps + logical :: WriteNeeded !< Function result; if true, WriteOutput values are needed on this time step + + ! note that if TStart isn't an multiple of DT_out, we will not necessarily start output to the file at TStart + if (t_global >= t_initial) then + WriteNeeded = MOD(n_t_global, n_DT_Out) == 0 + else + WriteNeeded = .false. + end if +end function + +!------------------------------------------------------------------------------- +! Debugging routines +!------------------------------------------------------------------------------- + +subroutine Solver_Init_Debug(p, m, GlueModData, GlueModMaps) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(in) :: m !< Misc variables + type(ModDataType), intent(in) :: GlueModData(:) !< Module data + type(MappingType), intent(in) :: GlueModMaps(:) !< Module mappings at glue level + integer(IntKi) :: i, j + + write (DebugUn, '(A,*(I6))') " p%iJX2 = ", p%iJX + write (DebugUn, '(A,*(I6))') " p%iJUT = ", p%iJUT + write (DebugUn, '(A,*(I6))') " p%iJU = ", p%iJU + write (DebugUn, '(A,*(I6))') " p%iJL = ", p%iJL + write (DebugUn, '(A,*(I6))') " p%iX2 = ", p%iX2 + write (DebugUn, '(A,*(I6))') " p%iX1 = ", p%iX1 + write (DebugUn, '(A,*(I6))') " p%iUT = ", p%iUT + write (DebugUn, '(A,*(I6))') " p%iU1 = ", p%iU1 + write (DebugUn, '(A,*(I6))') " p%iyT = ", p%iyT + write (DebugUn, '(A,*(I6))') " p%iy1 = ", p%iy1 + write (DebugUn, *) "shape(m%dYdx) = ", shape(m%Mod%Lin%dYdx) + write (DebugUn, *) "shape(m%dYdu) = ", shape(m%Mod%Lin%dYdu) + write (DebugUn, *) "shape(m%dXdx) = ", shape(m%Mod%Lin%dXdx) + write (DebugUn, *) "shape(m%dXdu) = ", shape(m%Mod%Lin%dXdu) + write (DebugUn, *) "shape(m%dUdu) = ", shape(m%Mod%Lin%dUdu) + write (DebugUn, *) "shape(m%dUdy) = ", shape(m%Mod%Lin%dUdy) + + do j = 1, size(m%Mod%Vars%x) + write (DebugUn, *) "Var = X "//trim(m%Mod%Vars%x(j)%Name)// & + " ("//trim(MV_FieldString(m%Mod%Vars%x(j)%Field))//")" + write (DebugUn, '(A,*(I6))') " X iLoc = ", m%Mod%Vars%x(j)%iLoc + write (DebugUn, '(A,*(I6))') " X iq = ", m%Mod%Vars%x(j)%iGlu + end do + do j = 1, size(m%Mod%Vars%u) + write (DebugUn, *) "Var = U "//trim(m%Mod%Vars%u(j)%Name)// & + " ("//trim(MV_FieldString(m%Mod%Vars%u(j)%Field))//")" + write (DebugUn, '(A,*(I6))') " U iLoc = ", m%Mod%Vars%u(j)%iLoc + end do + do j = 1, size(m%Mod%Vars%y) + write (DebugUn, *) "Var = Y "//trim(m%Mod%Vars%y(j)%Name)// & + " ("//trim(MV_FieldString(m%Mod%Vars%y(j)%Field))//")" + write (DebugUn, '(A,*(I6))') " Y iLoc = ", m%Mod%Vars%y(j)%iLoc + end do + + do i = 1, size(GlueModMaps) + associate (SrcMod => GlueModData(GlueModMaps(i)%iModSrc), & + DstMod => GlueModData(GlueModMaps(i)%iModDst)) + write (DebugUn, *) "Mapping = "//GlueModMaps(i)%Desc + write (DebugUn, *) " Src = "//trim(SrcMod%Abbr)//' Ins:'//trim(num2lstr(SrcMod%Ins))//' iMod:'//trim(num2lstr(SrcMod%iMod)) + write (DebugUn, *) " Dst = "//trim(DstMod%Abbr)//' Ins:'//trim(num2lstr(DstMod%Ins))//' iMod:'//trim(num2lstr(DstMod%iMod)) + end associate + end do +end subroutine + +subroutine Solver_Step_Debug(p, m, step, iterCorr, iterConv, delta_norm) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(in) :: m !< Misc variables + integer(IntKi), intent(in) :: step + integer(IntKi), intent(in) :: iterCorr + integer(IntKi), intent(in) :: iterConv + real(R8Ki), intent(in) :: delta_norm + + write (DebugUn, *) "step = ", step + write (DebugUn, *) "iterCorr = ", iterCorr + write (DebugUn, *) "iterConv = ", iterConv + if (p%iJX(1) > 0) write (DebugUn, '(A,*(ES16.7))') " delta_x = ", m%XB(p%iJX(1):p%iJX(2), 1) + if (p%iJU(1) > 0) write (DebugUn, '(A,*(ES16.7))') " delta_u = ", m%XB(p%iJU(1):p%iJU(2), 1) + if (allocated(m%uCalc)) write (DebugUn, '(A,*(ES16.7))') " uCalc = ", m%uCalc + if (allocated(m%Mod%Lin%x)) write (DebugUn, '(A,*(ES16.7))') " x = ", m%Mod%Lin%x + if (allocated(m%Mod%Lin%u)) write (DebugUn, '(A,*(ES16.7))') " u = ", m%Mod%Lin%u + write (DebugUn, *) "delta_norm = ", delta_norm +end subroutine + +subroutine BuildJacobian_Debug(m, T, ErrStat, ErrMsg) + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(FAST_TurbineType), intent(in) :: T !< Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BuildJacobian_Debug' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + if (MatrixUn == -1) then + call GetNewUnit(MatrixUn, ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Write module matrices to file + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call CalcWriteLinearMatrices(ModData%Vars, ModData%Lin, T%p_FAST, T%y_FAST, 0.0_R8Ki, MatrixUn, "SolverTC", VF_None, ErrStat2, ErrMsg2, & + CalcGlue=.false., ModSuffix=ModData%Abbr, FullOutput=.true.) + if (Failed()) return + end associate + end do + + ! Write glue code matrices to file + call CalcWriteLinearMatrices(m%Mod%Vars, m%Mod%Lin, T%p_FAST, T%y_FAST, 0.0_R8Ki, MatrixUn, "SolverTC", VF_None, ErrStat2, ErrMsg2, CalcGlue=.false., FullOutput=.true.) + if (Failed()) return + + ! call DumpMatrix(MatrixUn, "dUdu.bin", m%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dUdy.bin", m%Mod%Lin%dUdy, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dXdu.bin", m%Mod%Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dXdx.bin", m%Mod%Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dYdu.bin", m%Mod%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dYdx.bin", m%Mod%Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "ED-dXdu.bin", T%ED%m%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "ED-dXdx.bin", T%ED%m%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "ED-dYdu.bin", T%ED%m%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "ED-dYdx.bin", T%ED%m%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "BD-dXdu.bin", T%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "BD-dXdx.bin", T%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "BD-dYdu.bin", T%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "BD-dYdx.bin", T%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "J.bin", m%Mod%Lin%J, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 1b0fc7027b..32c20161fa 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -35,7 +35,9 @@ MODULE FAST_Subs !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> a wrapper routine to call FAST_Initialize at the full-turbine simulation level (makes easier to write top-level driver) SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, InFile, ExternInitData ) - + USE FAST_SolverTC, only: Solver_Init + USE FAST_Mapping, only: FAST_InitMappings, FAST_ResetRemapFlags + USE FAST_Funcs, only: FAST_InitIO REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: TurbID !< turbine Identifier (1-NumTurbines) TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine @@ -69,8 +71,20 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In if(ErrStat >= AbortErrLev) return - call ModGlue_Init(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & - Turbine%p_FAST, Turbine%m_FAST, Turbine, ErrStat, ErrMsg) + ! Initialize mappings between modules + call FAST_InitMappings(Turbine%m_Glue%Mappings, Turbine%m_Glue%ModData, Turbine, ErrStat, ErrMsg) + if(ErrStat >= AbortErrLev) return + + ! Initialize solver + call Solver_Init(Turbine%p_FAST, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat, ErrMsg) + if(ErrStat >= AbortErrLev) return + + ! Initialize overall glue module for linearization + if (Turbine%p_FAST%Linearize) then + call ModGlue_Init(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine, ErrStat, ErrMsg) + end if END SUBROUTINE FAST_InitializeAll_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -127,9 +141,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD INTEGER(IntKi) :: IceDim ! dimension we're pre-allocating for number of IceDyn legs/instances INTEGER(IntKi) :: I ! generic loop counter INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: InputArySize ! Number of inputs in module data input arrays - INTEGER(IntKi) :: InputSavedArySize ! Number of inputs in module data input saved arrays - INTEGER(IntKi) :: StateArySize ! Number of states in module data state arrays + INTEGER(IntKi) :: NumInput ! Number of inputs in module data input arrays + INTEGER(IntKi) :: NumInputSave ! Number of inputs in module data input saved arrays + INTEGER(IntKi) :: NumStates ! Number of states in module data state arrays logical :: CallStart REAL(R8Ki) :: theta(3) ! angles for hub orientation matrix for aeromaps @@ -239,14 +253,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Module data input arrays are interpolation order plus 1 - InputArySize = p_FAST%InterpOrder + 1 + NumInput = p_FAST%InterpOrder + 1 ! Input saved arrays have storage for InputArray size + linearization - InputSavedArySize = InputArySize + p_FAST%NLinTimes + NumInputSave = NumInput + p_FAST%NLinTimes ! Module data state arrays include data at linearization times after ! STATE_CURR, STATE_PRED, STATE_SAVED_CURR, and STATE_SAVED_PRED - StateArySize = NumStateTimes + p_FAST%NLinTimes + NumStates = NumStateTimes + p_FAST%NLinTimes !---------------------------------------------------------------------------- ! Linearization @@ -259,14 +273,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(ED%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("ED%Input")) return - allocate(ED%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return - allocate(ED%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return - allocate(ED%Output_bak (InputArySize ), stat=ErrStat2); if (FailedAlloc("ED%Output_bak")) return - allocate(ED%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("ED%x")) return - allocate(ED%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return - allocate(ED%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("ED%z")) return - allocate(ED%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return + allocate(ED%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("ED%Input")) return + allocate(ED%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return + allocate(ED%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return + allocate(ED%x (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%x")) return + allocate(ED%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return + allocate(ED%z (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%z")) return + allocate(ED%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return ! Set initialization input Init%InData_ED%Linearize = p_FAST%Linearize @@ -289,7 +302,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to array of modules, return if errors occurred - CALL MV_AddModule(m_Glue%ModDataAry, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & Init%OutData_ED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -323,13 +336,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD end if ! Allocate module data arrays - allocate(BD%Input (InputArySize, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input")) return - allocate(BD%InputTimes (InputArySize, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%InputTimes")) return - allocate(BD%Input_Saved (InputSavedArySize, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input_Saved")) return - allocate(BD%x (p_FAST%nBeams, StateArySize ), stat=ErrStat2); if (FailedAlloc("BD%x")) return - allocate(BD%xd (p_FAST%nBeams, StateArySize ), stat=ErrStat2); if (FailedAlloc("BD%xd")) return - allocate(BD%z (p_FAST%nBeams, StateArySize ), stat=ErrStat2); if (FailedAlloc("BD%z")) return - allocate(BD%OtherSt (p_FAST%nBeams, StateArySize ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return + allocate(BD%Input (0:NumInput, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input")) return + allocate(BD%InputTimes (NumInput, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%InputTimes")) return + allocate(BD%Input_Saved (NumInputSave, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input_Saved")) return + allocate(BD%x (p_FAST%nBeams, NumStates ), stat=ErrStat2); if (FailedAlloc("BD%x")) return + allocate(BD%xd (p_FAST%nBeams, NumStates ), stat=ErrStat2); if (FailedAlloc("BD%xd")) return + allocate(BD%z (p_FAST%nBeams, NumStates ), stat=ErrStat2); if (FailedAlloc("BD%z")) return + allocate(BD%OtherSt (p_FAST%nBeams, NumStates ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return allocate(BD%p (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%p")) return allocate(BD%u (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%u")) return allocate(BD%y (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%y")) return @@ -385,7 +398,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName) ! Add module instance to array of modules, return on failure - CALL MV_AddModule(m_Glue%ModDataAry, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & + CALL MV_AddModule(m_Glue%ModData, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & p_FAST%DT, Init%OutData_BD(k)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -397,13 +410,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(IfW%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return - allocate(IfW%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return - allocate(IfW%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("IfW%Input_Saved")) return - allocate(IfW%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return - allocate(IfW%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return - allocate(IfW%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return - allocate(IfW%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return + allocate(IfW%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return + allocate(IfW%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return + allocate(IfW%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("IfW%Input_Saved")) return + allocate(IfW%x (NumStates ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return + allocate(IfW%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return + allocate(IfW%z (NumStates ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return + allocate(IfW%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return select case(p_FAST%CompInflow) case (Module_IfW) @@ -455,7 +468,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%ModDataAry, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & Init%OutData_IfW%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -525,7 +538,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%ModDataAry, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & Init%OutData_ExtInfw%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return @@ -545,13 +558,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SeaSt%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return - allocate(SeaSt%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return - allocate(SeaSt%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("SeaSt%Input_Saved")) return - allocate(SeaSt%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return - allocate(SeaSt%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return - allocate(SeaSt%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return - allocate(SeaSt%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return + allocate(SeaSt%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return + allocate(SeaSt%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return + allocate(SeaSt%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("SeaSt%Input_Saved")) return + allocate(SeaSt%x (NumStates ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return + allocate(SeaSt%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return + allocate(SeaSt%z (NumStates ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return + allocate(SeaSt%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return if ( p_FAST%CompSeaSt == Module_SeaSt ) then @@ -580,7 +593,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to array, return on error - call MV_AddModule(m_Glue%ModDataAry, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & + call MV_AddModule(m_Glue%ModData, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & Init%OutData_SeaSt%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -601,13 +614,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(AD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("AD%Input")) return - allocate(AD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return - allocate(AD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("AD%Input_Saved")) return - allocate(AD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD%x")) return - allocate(AD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return - allocate(AD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD%z")) return - allocate(AD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return + allocate(AD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("AD%Input")) return + allocate(AD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return + allocate(AD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("AD%Input_Saved")) return + allocate(AD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%x")) return + allocate(AD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return + allocate(AD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%z")) return + allocate(AD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN @@ -689,7 +702,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! Initialize a module instance for each rotor do i = 1, size(Init%OutData_AD%rotors) - CALL MV_AddModule(m_Glue%ModDataAry, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & Init%OutData_AD%rotors(i)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return end do @@ -715,7 +728,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%ModDataAry, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & Init%OutData_ExtLd%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -757,13 +770,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(HD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("HD%Input")) return - allocate(HD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("HD%InputTimes")) return - allocate(HD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("HD%Input_Saved")) return - allocate(HD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("HD%x")) return - allocate(HD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("HD%xd")) return - allocate(HD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("HD%z")) return - allocate(HD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("HD%OtherSt")) return + allocate(HD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("HD%Input")) return + allocate(HD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("HD%InputTimes")) return + allocate(HD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("HD%Input_Saved")) return + allocate(HD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("HD%x")) return + allocate(HD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("HD%xd")) return + allocate(HD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("HD%z")) return + allocate(HD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("HD%OtherSt")) return IF (p_FAST%CompHydro == Module_HD) THEN @@ -785,7 +798,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%ModDataAry, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & Init%OutData_HD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -798,22 +811,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("SD%Input")) return - allocate(SD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("SD%InputTimes")) return - allocate(SD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("SD%Input_Saved")) return - allocate(SD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("SD%x")) return - allocate(SD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("SD%xd")) return - allocate(SD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("SD%z")) return - allocate(SD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("SD%OtherSt")) return + allocate(SD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("SD%Input")) return + allocate(SD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("SD%InputTimes")) return + allocate(SD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("SD%Input_Saved")) return + allocate(SD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("SD%x")) return + allocate(SD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("SD%xd")) return + allocate(SD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("SD%z")) return + allocate(SD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("SD%OtherSt")) return ! Allocate module data arrays - allocate(ExtPtfm%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input")) return - allocate(ExtPtfm%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%InputTimes")) return - allocate(ExtPtfm%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input_Saved")) return - allocate(ExtPtfm%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%x")) return - allocate(ExtPtfm%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%xd")) return - allocate(ExtPtfm%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%z")) return - allocate(ExtPtfm%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%OtherSt")) return + allocate(ExtPtfm%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input")) return + allocate(ExtPtfm%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%InputTimes")) return + allocate(ExtPtfm%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input_Saved")) return + allocate(ExtPtfm%x (NumStates ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%x")) return + allocate(ExtPtfm%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%xd")) return + allocate(ExtPtfm%z (NumStates ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%z")) return + allocate(ExtPtfm%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%OtherSt")) return select case (p_FAST%CompSub) @@ -838,7 +851,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%ModDataAry, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & Init%OutData_SD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -859,6 +872,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(MODULE_ExtPtfm, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return + CALL MV_AddModule(m_Glue%ModData, MODULE_ExtPtfm, 'ExtPtfm', 1, p_FAST%dt_module(MODULE_ExtPtfm), p_FAST%DT, & + Init%OutData_ExtPtfm%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. end select @@ -868,40 +885,40 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(MAPp%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%Input")) return - allocate(MAPp%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%InputTimes")) return - allocate(MAPp%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("MAPp%Input_Saved")) return - allocate(MAPp%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%x")) return - allocate(MAPp%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%xd")) return - allocate(MAPp%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%z")) return + allocate(MAPp%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("MAPp%Input")) return + allocate(MAPp%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("MAPp%InputTimes")) return + allocate(MAPp%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("MAPp%Input_Saved")) return + allocate(MAPp%x (NumStates ), stat=ErrStat2); if (FailedAlloc("MAPp%x")) return + allocate(MAPp%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("MAPp%xd")) return + allocate(MAPp%z (NumStates ), stat=ErrStat2); if (FailedAlloc("MAPp%z")) return ! allocate(MAPp%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%OtherSt")) return ! Allocate module data arrays - allocate(MD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("MD%Input")) return - allocate(MD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("MD%InputTimes")) return - allocate(MD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("MD%Input_Saved")) return - allocate(MD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("MD%x")) return - allocate(MD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("MD%xd")) return - allocate(MD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("MD%z")) return - allocate(MD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("MD%OtherSt")) return + allocate(MD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("MD%Input")) return + allocate(MD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("MD%InputTimes")) return + allocate(MD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("MD%Input_Saved")) return + allocate(MD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("MD%x")) return + allocate(MD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("MD%xd")) return + allocate(MD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("MD%z")) return + allocate(MD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("MD%OtherSt")) return ! Allocate module data arrays - allocate(FEAM%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%Input")) return - allocate(FEAM%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%InputTimes")) return - allocate(FEAM%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("FEAM%Input_Saved")) return - allocate(FEAM%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%x")) return - allocate(FEAM%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%xd")) return - allocate(FEAM%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%z")) return - allocate(FEAM%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("FEAM%OtherSt")) return + allocate(FEAM%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("FEAM%Input")) return + allocate(FEAM%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("FEAM%InputTimes")) return + allocate(FEAM%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("FEAM%Input_Saved")) return + allocate(FEAM%x (NumStates ), stat=ErrStat2); if (FailedAlloc("FEAM%x")) return + allocate(FEAM%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("FEAM%xd")) return + allocate(FEAM%z (NumStates ), stat=ErrStat2); if (FailedAlloc("FEAM%z")) return + allocate(FEAM%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("FEAM%OtherSt")) return ! Allocate module data arrays - allocate(Orca%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("Orca%Input")) return - allocate(Orca%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("Orca%InputTimes")) return - allocate(Orca%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("Orca%Input_Saved")) return - allocate(Orca%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("Orca%x")) return - allocate(Orca%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("Orca%xd")) return - allocate(Orca%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("Orca%z")) return - allocate(Orca%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("Orca%OtherSt")) return + allocate(Orca%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("Orca%Input")) return + allocate(Orca%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("Orca%InputTimes")) return + allocate(Orca%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("Orca%Input_Saved")) return + allocate(Orca%x (NumStates ), stat=ErrStat2); if (FailedAlloc("Orca%x")) return + allocate(Orca%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("Orca%xd")) return + allocate(Orca%z (NumStates ), stat=ErrStat2); if (FailedAlloc("Orca%z")) return + allocate(Orca%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("Orca%OtherSt")) return select case (p_FAST%CompMooring) @@ -932,7 +949,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%ModDataAry, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & Init%OutData_MAP%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -964,7 +981,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%ModDataAry, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & Init%OutData_MD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -989,7 +1006,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%ModDataAry, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & Init%OutData_FEAM%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return @@ -1007,7 +1024,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) if (Failed()) return - CALL MV_AddModule(m_Glue%ModDataAry, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & Init%OutData_Orca%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return @@ -1022,13 +1039,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !------------------------------------- ! Allocate module data arrays - allocate(IceF%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("IceF%Input")) return - allocate(IceF%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("IceF%InputTimes")) return - allocate(IceF%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("IceF%Input_Saved")) return - allocate(IceF%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("IceF%x")) return - allocate(IceF%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("IceF%xd")) return - allocate(IceF%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("IceF%z")) return - allocate(IceF%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("IceF%OtherSt")) return + allocate(IceF%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("IceF%Input")) return + allocate(IceF%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("IceF%InputTimes")) return + allocate(IceF%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("IceF%Input_Saved")) return + allocate(IceF%x (NumStates ), stat=ErrStat2); if (FailedAlloc("IceF%x")) return + allocate(IceF%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("IceF%xd")) return + allocate(IceF%z (NumStates ), stat=ErrStat2); if (FailedAlloc("IceF%z")) return + allocate(IceF%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("IceF%OtherSt")) return IF (p_FAST%CompIce == Module_IceF) THEN @@ -1064,13 +1081,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD IF (p_FAST%CompIce == Module_IceD) IceDim = IceD_MaxLegs ! Allocate module data arrays - allocate(IceD%Input (InputArySize, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input")) return - allocate(IceD%InputTimes (InputArySize, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%InputTimes")) return - allocate(IceD%Input_Saved (InputSavedArySize, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input_Saved")) return - allocate(IceD%x (IceDim, StateArySize), stat=ErrStat2); if (FailedAlloc("IceD%x")) return - allocate(IceD%xd (IceDim, StateArySize), stat=ErrStat2); if (FailedAlloc("IceD%xd")) return - allocate(IceD%z (IceDim, StateArySize), stat=ErrStat2); if (FailedAlloc("IceD%z")) return - allocate(IceD%OtherSt (IceDim, StateArySize), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return + allocate(IceD%Input (0:NumInput, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input")) return + allocate(IceD%InputTimes (NumInput, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%InputTimes")) return + allocate(IceD%Input_Saved (NumInputSave, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input_Saved")) return + allocate(IceD%x (IceDim, NumStates), stat=ErrStat2); if (FailedAlloc("IceD%x")) return + allocate(IceD%xd (IceDim, NumStates), stat=ErrStat2); if (FailedAlloc("IceD%xd")) return + allocate(IceD%z (IceDim, NumStates), stat=ErrStat2); if (FailedAlloc("IceD%z")) return + allocate(IceD%OtherSt (IceDim, NumStates), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return allocate(IceD%p (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%p")) return allocate(IceD%u (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%u")) return allocate(IceD%y (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%y")) return @@ -1133,13 +1150,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SrvD%Input (InputArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%Input")) return - allocate(SrvD%InputTimes (InputArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%InputTimes")) return - allocate(SrvD%Input_Saved (InputSavedArySize), stat=ErrStat2); if (FailedAlloc("SrvD%Input_Saved")) return - allocate(SrvD%x (StateArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%x")) return - allocate(SrvD%xd (StateArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%xd")) return - allocate(SrvD%z (StateArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%z")) return - allocate(SrvD%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("SrvD%OtherSt")) return + allocate(SrvD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("SrvD%Input")) return + allocate(SrvD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("SrvD%InputTimes")) return + allocate(SrvD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("SrvD%Input_Saved")) return + allocate(SrvD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("SrvD%x")) return + allocate(SrvD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("SrvD%xd")) return + allocate(SrvD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("SrvD%z")) return + allocate(SrvD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("SrvD%OtherSt")) return IF ( p_FAST%CompServo == Module_SrvD ) THEN @@ -1227,7 +1244,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return ! Add module to list of modules - CALL MV_AddModule(m_Glue%ModDataAry, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + CALL MV_AddModule(m_Glue%ModData, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & Init%OutData_SrvD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return @@ -4524,16 +4541,36 @@ END SUBROUTINE FAST_WrSum !> Routine that calls FAST_Solution0 for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) + USE FAST_SolverTC, only: Solver_Step0 TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(*), parameter :: RoutineName = 'FAST_Solution0_T' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + if (Turbine%p_FAST%WrSttsTime) then + call SimStatus_FirstTime(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%SimStrtTime, Turbine%m_FAST%UsrTime2, Turbine%m_FAST%t_global, & + Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if - CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + ! Get initial conditions for solver + CALL Solver_Step0(Turbine%p_Glue%TC, Turbine%m_Glue%TC, Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + CALL WriteOutputToFile(0, Turbine%m_FAST%t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & + Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & + Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& + ! Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_Solution0_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -6616,17 +6653,52 @@ END SUBROUTINE FAST_Store_SubStep !> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - + USE FAST_SolverTC, only: Solver_Step REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(R8Ki) :: t_global_next - CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + ! Calculate next global time + t_global_next = t_initial + (n_t_global+1)*Turbine%p_FAST%DT + + ! Advance simulation one step and calculate outputs + CALL Solver_Step(n_t_global, t_initial, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Write output data to file + !---------------------------------------------------------------------------- + + CALL WriteOutputToFile(n_t_global + 1, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & + Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & + Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): + !---------------------------------------------------------------------------- + + if (Turbine%p_FAST%WrSttsTime) then + if (MOD(n_t_global + 1, Turbine%p_FAST%n_SttsTime) == 0) then + call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + end if + + ! CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + ! Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_Solution_T !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 1cf6719312..3935fcc840 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -392,7 +392,10 @@ MODULE FAST_Types TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] + INTEGER(IntKi) :: DriverWriteOutputNum = 0 !< Number of values in driver write output [-] REAL(ReKi) , DIMENSION(1:6) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: DriverWriteOutputHdr !< headers of data output from the driver [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: DriverWriteOutputUnt !< units of data output from the driver [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -6042,7 +6045,32 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, call FAST_CopyLinStateSave(SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstOutputFileTypeData%DriverWriteOutputNum = SrcOutputFileTypeData%DriverWriteOutputNum DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput + if (allocated(SrcOutputFileTypeData%DriverWriteOutputHdr)) then + LB(1:1) = lbound(SrcOutputFileTypeData%DriverWriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcOutputFileTypeData%DriverWriteOutputHdr, kind=B8Ki) + if (.not. allocated(DstOutputFileTypeData%DriverWriteOutputHdr)) then + allocate(DstOutputFileTypeData%DriverWriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%DriverWriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%DriverWriteOutputHdr = SrcOutputFileTypeData%DriverWriteOutputHdr + end if + if (allocated(SrcOutputFileTypeData%DriverWriteOutputUnt)) then + LB(1:1) = lbound(SrcOutputFileTypeData%DriverWriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcOutputFileTypeData%DriverWriteOutputUnt, kind=B8Ki) + if (.not. allocated(DstOutputFileTypeData%DriverWriteOutputUnt)) then + allocate(DstOutputFileTypeData%DriverWriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%DriverWriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%DriverWriteOutputUnt = SrcOutputFileTypeData%DriverWriteOutputUnt + end if end subroutine subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) @@ -6078,6 +6106,12 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputFileTypeData%DriverWriteOutputHdr)) then + deallocate(OutputFileTypeData%DriverWriteOutputHdr) + end if + if (allocated(OutputFileTypeData%DriverWriteOutputUnt)) then + deallocate(OutputFileTypeData%DriverWriteOutputUnt) + end if end subroutine subroutine FAST_PackOutputFileType(RF, Indata) @@ -6110,7 +6144,10 @@ subroutine FAST_PackOutputFileType(RF, Indata) call FAST_PackLinFileType(RF, InData%Lin) call RegPack(RF, InData%ActualChanLen) call FAST_PackLinStateSave(RF, InData%op) + call RegPack(RF, InData%DriverWriteOutputNum) call RegPack(RF, InData%DriverWriteOutput) + call RegPackAlloc(RF, InData%DriverWriteOutputHdr) + call RegPackAlloc(RF, InData%DriverWriteOutputUnt) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6146,7 +6183,10 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) call FAST_UnpackLinFileType(RF, OutData%Lin) ! Lin call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return call FAST_UnpackLinStateSave(RF, OutData%op) ! op + call RegUnpack(RF, OutData%DriverWriteOutputNum); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DriverWriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DriverWriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DriverWriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index e4887b1d9f..1f09badcd5 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -20,19 +20,19 @@ param ^ - IntKi Map_MotionMesh - 2 - param ^ - IntKi Map_Variable - 3 - "Individual variable mapping type" - param ^ - IntKi Map_Custom - 4 - "Custom mapping not used for linearization" - -typedef ^ ModMapType IntKi iMapping - 0 - "Mapping index" -typedef ^ ^ IntKi iModSrc - 0 - "Source module index" -typedef ^ ^ IntKi iModDst - 0 - "Destination module index" -typedef ^ ^ IntKi iVarSrc 10 0 - "Source variable indices" -typedef ^ ^ IntKi iVarSrcDisp 10 0 - "Source variable indices" -typedef ^ ^ IntKi iVarDst 10 0 - "Destination variable indices" -typedef ^ ^ IntKi iVarDstDisp 10 0 - "Destination variable indices" +typedef ^ VarMapType IntKi iMapping - 0 - "Mapping index" +typedef ^ ^ IntKi iModSrc - 0 - "Source module index in module array" +typedef ^ ^ IntKi iModDst - 0 - "Destination module index in module array" +typedef ^ ^ IntKi iVarSrc 10 0 - "Source variable indices (Vars%y)" +typedef ^ ^ IntKi iVarSrcDisp 10 0 - "Source variable indices (Vars%u)" +typedef ^ ^ IntKi iVarDst 10 0 - "Destination variable indices (Vars%u)" +typedef ^ ^ IntKi iVarDstDisp 10 0 - "Destination variable indices (Vars%y)" typedef ^ ModGlueType character(ChanLen) Name - - - "Glue name" - -typedef ^ ^ ModDataType ModDataAry : - - "Array of module info" - +typedef ^ ^ ModDataType ModData : - - "Array of module info" - typedef ^ ^ ModVarsType Vars - - - "Combined module variables" - typedef ^ ^ ModLinType Lin - - - "Glue linearization data" - -typedef ^ ^ ModMapType ModMaps : - - "Var mapping" +typedef ^ ^ VarMapType VarMaps : - - "Var mapping" typedef ^ MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - typedef ^ ^ IntKi iModSrc - 0 - "Source module index in ModData array" - @@ -41,10 +41,6 @@ typedef ^ ^ IntKi SrcModID - 0 - typedef ^ ^ IntKi DstModID - 0 - "Destination module ID" - typedef ^ ^ IntKi SrcIns - 0 - "Source module Instance" - typedef ^ ^ IntKi DstIns - 0 - "Destination module Instance" - -typedef ^ ^ IntKi SrcMeshID - 0 - "Source mesh identifier" - -typedef ^ ^ IntKi DstMeshID - 0 - "Destination mesh identifier" - -typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - -typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - typedef ^ ^ DatLoc SrcDL - - - "Source mesh locator (number and indices)" - typedef ^ ^ DatLoc DstDL - - - "Destination mesh locator (number and indices)" - typedef ^ ^ DatLoc SrcDispDL - - - "Source displacement mesh locator (number and indices)" - @@ -55,6 +51,9 @@ typedef ^ ^ IntKi XfrTypeAux - 0 - typedef ^ ^ logical Ready - F - "Flag indicating source data is ready to be transferred" - typedef ^ ^ logical DstUsesSibling - F - "Flag indicating the destination displacement mesh is a sibling of the source destination load mesh" - typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - +typedef ^ ^ R8Ki VarData : - - "Data array for variable mapping" - +typedef ^ ^ ModVarType SrcVar - - - "Source variable for variable mapping" - +typedef ^ ^ ModVarType DstVar - - - "Destination variable for variable mapping" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - typedef ^ ^ MeshMapType MeshMapAux - - - "Auxiliary mesh mapping for destination load meshes without sibling motion mesh" - typedef ^ ^ MeshType TmpLoadMesh - - - "Temporary load mesh for intermediate transfers" - @@ -69,40 +68,42 @@ typedef ^ ^ IntKi InterpOrder - - - typedef ^ ^ logical SaveOPs - - - "flag to save operating points during linearization" - typedef ^ ^ IntKi iMod : - - "ModData index order for linearization" - -typedef ^ Glue_ParameterType Glue_LinParam Lin - - - "Linearization parameters" -typedef ^ ^ R8Ki DT - - - "solution time step" - +typedef ^ Glue_TCParam R8Ki h - - - "solution time step" - typedef ^ ^ R8Ki ConvTol - - - "Solution convergence tolerance" - typedef ^ ^ IntKi NumCrctn - - - "" - typedef ^ ^ IntKi MaxConvIter - - - "" - typedef ^ ^ IntKi NIter_UJac - - - "Number of solution iterations between updating the Jacobian" - typedef ^ ^ IntKi NStep_UJac - - - "Number of global time steps between updating the Jacobian" - typedef ^ ^ R8Ki Scale_UJac - - - "" - -typedef ^ ^ R8Ki AccBlend - 1 - "" - typedef ^ ^ R8Ki RhoInf - - - "Rho infinity used for calculating Generalized-alpha coefficients" - typedef ^ ^ R8Ki AlphaM - - - "Generalized-alpha alpha_m coefficient" - typedef ^ ^ R8Ki AlphaF - - - "Generalized-alpha alpha_f coefficient" - typedef ^ ^ R8Ki Beta - - - "Generalized-alpha beta coefficient" - typedef ^ ^ R8Ki Gamma - - - "Generalized-alpha gamma coefficient" - -typedef ^ ^ R8Ki C 7 - - "Generalized-alpha coefficient array" - +typedef ^ ^ R8Ki BetaPrime - - - "Generalized-alpha beta prime" - +typedef ^ ^ R8Ki GammaPrime - - - "Generalized-alpha gamma prime" - +typedef ^ ^ IntKi NumJ - - - "Number of values in Jacobian" - +typedef ^ ^ IntKi NumQ - - - "Number of values in state arrays" - typedef ^ ^ IntKi iX1 2 - - "" - typedef ^ ^ IntKi iX2 2 - - "" - typedef ^ ^ IntKi iUT 2 - - "" - typedef ^ ^ IntKi iU1 2 - - "" - +typedef ^ ^ IntKi iUL 2 - - "Input load indices" - typedef ^ ^ IntKi iyT 2 - - "" - typedef ^ ^ IntKi iy1 2 - - "" - typedef ^ ^ IntKi iJX 2 - - "Indices of Jacobian q variables" - typedef ^ ^ IntKi iJU 2 - - "Indices of Jacobian input variables" - typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - -typedef ^ ^ IntKi iJL : - - "Indices of Jacobian load variables" - -typedef ^ ^ IntKi ixqd :: - - "" - +typedef ^ ^ IntKi iJL 2 - - "Indices of Jacobian load variables" - typedef ^ ^ IntKi iModInit : - - "ModData index order for step 0 initialization" - typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - -typedef ^ ^ IntKi iModBD : - - "ModData index order for BD modules" - typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - -typedef ^ ^ IntKi iModOpt1US : - - "ModData index order for option 1 modules to update states" - typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - typedef ^ ^ IntKi iModPost : - - "ModData index order for post option 1 modules" - +typedef ^ Glue_ParameterType Glue_LinParam Lin - - - "Linearization parameters" +typedef ^ ^ Glue_TCParam TC - - - "Tight Coupling solver parameters" + #---------------------------------------------------------------------------------------------------------------------------------- # Output Data #---------------------------------------------------------------------------------------------------------------------------------- @@ -139,7 +140,8 @@ typedef ^ ^ ReKi TSR - - - typedef ^ ^ ReKi WindSpeed - - - "Windspeed for this case of the steady-state solve [>0]" "m/s" typedef ^ ^ ReKi Pitch - - - "Pitch angle for this case of the steady-state solve" "rad" -typedef ^ Glue_AeroMap ModGlueType Mod - - - "Module combining all active modules" - +typedef ^ Glue_AeroMap IntKi iModOrder : - - "Module indices in global ModDataAry" +typedef ^ ^ ModGlueType Mod - - - "Module combining all active modules" - typedef ^ ^ R8Ki Jac11 :: - - "Components of Jacobian matrix" - typedef ^ ^ R8Ki Jac12 :: - - "Components of Jacobian matrix" - typedef ^ ^ R8Ki Jac21 :: - - "Components of Jacobian matrix" - @@ -155,41 +157,34 @@ typedef ^ ^ R8Ki SolveDelta : - - typedef ^ ^ AeroMapCase Cases : - - "cases to run for aero mapping" - typedef ^ ^ IntKi LinFileNum - 1 - "Linearization file number" - +typedef ^ TC_State R8Ki q_prev : - - "Generalized alpha previous step displacement" - +typedef ^ ^ R8Ki x : - - "Generalized alpha change in displacement" - +typedef ^ ^ R8Ki q : - - "Generalized alpha predicted displacement" - +typedef ^ ^ R8Ki v : - - "Generalized alpha velocities" - +typedef ^ ^ R8Ki vd : - - "Generalized alpha acceleration" - +typedef ^ ^ R8Ki a : - - "Generalized alpha algorithmic acceleration" - + +typedef ^ Glue_TCMisc ModGlueType Mod - - - "Glue module combining tight coupling modules" - +typedef ^ ^ TC_State State - - - "Tight Coupling state" +typedef ^ ^ TC_State StatePrev - - - "Tight Coupling previous state for correction iterations" +typedef ^ ^ R8Ki UCalc : - - "" - +typedef ^ ^ R8Ki UOrig : - - "" - +typedef ^ ^ R8Ki T :: - - "Tangent matrix" - +typedef ^ ^ R8Ki XB :: - - "" - +typedef ^ ^ IntKi IPIV : - - "" - +typedef ^ ^ IntKi IterTotal - 0 - "" - +typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - +typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - +typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - + typedef ^ Glue_LinMisc IntKi TimeIndex - - - "" - typedef ^ ^ IntKi AzimuthIndex - - - "" - typedef ^ ^ logical IsConverged - - - "" - -typedef ^ Glue_MiscVarType ModDataType ModDataAry : - - "Module variable and value data" - +typedef ^ Glue_MiscVarType ModDataType ModData : - - "Module variable and value data" - typedef ^ ^ MappingType Mappings : - - "Module mapping" - typedef ^ ^ ModGlueType ModGlue - - - "Glue code module" - typedef ^ ^ Glue_LinMisc Lin - - - "Linearization misc vars" typedef ^ ^ Glue_CalcSteady CS - - - "CalcSteady calculation data" typedef ^ ^ Glue_AeroMap AM - - - "AeroMap data" -typedef ^ ^ R8Ki q :: - - "" - -typedef ^ ^ R8Ki qn :: - - "" - -typedef ^ ^ R8Ki x : - - "" - -typedef ^ ^ R8Ki xn : - - "" - -typedef ^ ^ R8Ki dxdt : - - "" - -typedef ^ ^ R8Ki u : - - "" - -typedef ^ ^ R8Ki un : - - "" - -typedef ^ ^ R8Ki u_tmp : - - "" - -typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki dYdx :: - - "" - -typedef ^ ^ R8Ki dYdu :: - - "" - -typedef ^ ^ R8Ki dXdx :: - - "" - -typedef ^ ^ R8Ki dXdu :: - - "" - -typedef ^ ^ R8Ki dUdu :: - - "" - -typedef ^ ^ R8Ki dUdy :: - - "" - -typedef ^ ^ R8Ki dUdyHat :: - - "" - -typedef ^ ^ R8Ki XB :: - - "" - -typedef ^ ^ R8Ki G :: - - "Used to merge state matrices" - -typedef ^ ^ R8Ki Jac :: - - "" - -typedef ^ ^ IntKi IPIV : - - "" - -typedef ^ ^ IntKi IterTotal - 0 - "" - -typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - -typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - -typedef ^ ^ R8Ki dq :: - - "Change in q" - -typedef ^ ^ R8Ki dx : - - "Change in x" - -typedef ^ ^ R8Ki du : - - "" - -typedef ^ ^ R8Ki UDiff : - - "" - -typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - +typedef ^ ^ Glue_TCMisc TC - - - "Tight Coupling Miscellaneous data" diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index eaabc8e778..aa62df3c65 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -37,24 +37,24 @@ MODULE Glue_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Variable = 3 ! Individual variable mapping type [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Custom = 4 ! Custom mapping not used for linearization [-] -! ========= ModMapType ======= - TYPE, PUBLIC :: ModMapType +! ========= VarMapType ======= + TYPE, PUBLIC :: VarMapType INTEGER(IntKi) :: iMapping = 0 !< Mapping index [-] - INTEGER(IntKi) :: iModSrc = 0 !< Source module index [-] - INTEGER(IntKi) :: iModDst = 0 !< Destination module index [-] - INTEGER(IntKi) , DIMENSION(1:10) :: iVarSrc = 0 !< Source variable indices [-] - INTEGER(IntKi) , DIMENSION(1:10) :: iVarSrcDisp = 0 !< Source variable indices [-] - INTEGER(IntKi) , DIMENSION(1:10) :: iVarDst = 0 !< Destination variable indices [-] - INTEGER(IntKi) , DIMENSION(1:10) :: iVarDstDisp = 0 !< Destination variable indices [-] - END TYPE ModMapType + INTEGER(IntKi) :: iModSrc = 0 !< Source module index in module array [-] + INTEGER(IntKi) :: iModDst = 0 !< Destination module index in module array [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarSrc = 0 !< Source variable indices (Vars%y) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarSrcDisp = 0 !< Source variable indices (Vars%u) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarDst = 0 !< Destination variable indices (Vars%u) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarDstDisp = 0 !< Destination variable indices (Vars%y) [-] + END TYPE VarMapType ! ======================= ! ========= ModGlueType ======= TYPE, PUBLIC :: ModGlueType character(ChanLen) :: Name !< Glue name [-] - TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModDataAry !< Array of module info [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModData !< Array of module info [-] TYPE(ModVarsType) :: Vars !< Combined module variables [-] TYPE(ModLinType) :: Lin !< Glue linearization data [-] - TYPE(ModMapType) , DIMENSION(:), ALLOCATABLE :: ModMaps !< Var mapping [-] + TYPE(VarMapType) , DIMENSION(:), ALLOCATABLE :: VarMaps !< Var mapping [-] END TYPE ModGlueType ! ======================= ! ========= MappingType ======= @@ -66,10 +66,6 @@ MODULE Glue_Types INTEGER(IntKi) :: DstModID = 0 !< Destination module ID [-] INTEGER(IntKi) :: SrcIns = 0 !< Source module Instance [-] INTEGER(IntKi) :: DstIns = 0 !< Destination module Instance [-] - INTEGER(IntKi) :: SrcMeshID = 0 !< Source mesh identifier [-] - INTEGER(IntKi) :: DstMeshID = 0 !< Destination mesh identifier [-] - INTEGER(IntKi) :: SrcDispMeshID = 0 !< Source displacement mesh identifier [-] - INTEGER(IntKi) :: DstDispMeshID = 0 !< Destination displacement mesh identifier [-] TYPE(DatLoc) :: SrcDL !< Source mesh locator (number and indices) [-] TYPE(DatLoc) :: DstDL !< Destination mesh locator (number and indices) [-] TYPE(DatLoc) :: SrcDispDL !< Source displacement mesh locator (number and indices) [-] @@ -80,6 +76,9 @@ MODULE Glue_Types LOGICAL :: Ready = .false. !< Flag indicating source data is ready to be transferred [-] LOGICAL :: DstUsesSibling = .false. !< Flag indicating the destination displacement mesh is a sibling of the source destination load mesh [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: VarData !< Data array for variable mapping [-] + TYPE(ModVarType) :: SrcVar !< Source variable for variable mapping [-] + TYPE(ModVarType) :: DstVar !< Destination variable for variable mapping [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] TYPE(MeshMapType) :: MeshMapAux !< Auxiliary mesh mapping for destination load meshes without sibling motion mesh [-] TYPE(MeshType) :: TmpLoadMesh !< Temporary load mesh for intermediate transfers [-] @@ -94,41 +93,46 @@ MODULE Glue_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] END TYPE Glue_LinParam ! ======================= -! ========= Glue_ParameterType ======= - TYPE, PUBLIC :: Glue_ParameterType - TYPE(Glue_LinParam) :: Lin !< Linearization parameters [-] - REAL(R8Ki) :: DT = 0.0_R8Ki !< solution time step [-] +! ========= Glue_TCParam ======= + TYPE, PUBLIC :: Glue_TCParam + REAL(R8Ki) :: h = 0.0_R8Ki !< solution time step [-] REAL(R8Ki) :: ConvTol = 0.0_R8Ki !< Solution convergence tolerance [-] INTEGER(IntKi) :: NumCrctn = 0_IntKi !< [-] INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< [-] INTEGER(IntKi) :: NIter_UJac = 0_IntKi !< Number of solution iterations between updating the Jacobian [-] INTEGER(IntKi) :: NStep_UJac = 0_IntKi !< Number of global time steps between updating the Jacobian [-] REAL(R8Ki) :: Scale_UJac = 0.0_R8Ki !< [-] - REAL(R8Ki) :: AccBlend = 1 !< [-] REAL(R8Ki) :: RhoInf = 0.0_R8Ki !< Rho infinity used for calculating Generalized-alpha coefficients [-] REAL(R8Ki) :: AlphaM = 0.0_R8Ki !< Generalized-alpha alpha_m coefficient [-] REAL(R8Ki) :: AlphaF = 0.0_R8Ki !< Generalized-alpha alpha_f coefficient [-] REAL(R8Ki) :: Beta = 0.0_R8Ki !< Generalized-alpha beta coefficient [-] REAL(R8Ki) :: Gamma = 0.0_R8Ki !< Generalized-alpha gamma coefficient [-] - REAL(R8Ki) , DIMENSION(1:7) :: C = 0.0_R8Ki !< Generalized-alpha coefficient array [-] + REAL(R8Ki) :: BetaPrime = 0.0_R8Ki !< Generalized-alpha beta prime [-] + REAL(R8Ki) :: GammaPrime = 0.0_R8Ki !< Generalized-alpha gamma prime [-] + INTEGER(IntKi) :: NumJ = 0_IntKi !< Number of values in Jacobian [-] + INTEGER(IntKi) :: NumQ = 0_IntKi !< Number of values in state arrays [-] INTEGER(IntKi) , DIMENSION(1:2) :: iX1 = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iX2 = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iUT = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iU1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUL = 0_IntKi !< Input load indices [-] INTEGER(IntKi) , DIMENSION(1:2) :: iyT = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iy1 = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iJX = 0_IntKi !< Indices of Jacobian q variables [-] INTEGER(IntKi) , DIMENSION(1:2) :: iJU = 0_IntKi !< Indices of Jacobian input variables [-] INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJL !< Indices of Jacobian load variables [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJL = 0_IntKi !< Indices of Jacobian load variables [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModInit !< ModData index order for step 0 initialization [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModBD !< ModData index order for BD modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1US !< ModData index order for option 1 modules to update states [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModPost !< ModData index order for post option 1 modules [-] + END TYPE Glue_TCParam +! ======================= +! ========= Glue_ParameterType ======= + TYPE, PUBLIC :: Glue_ParameterType + TYPE(Glue_LinParam) :: Lin !< Linearization parameters [-] + TYPE(Glue_TCParam) :: TC !< Tight Coupling solver parameters [-] END TYPE Glue_ParameterType ! ======================= ! ========= Glue_LinSave ======= @@ -173,6 +177,7 @@ MODULE Glue_Types ! ======================= ! ========= Glue_AeroMap ======= TYPE, PUBLIC :: Glue_AeroMap + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOrder !< Module indices in global ModDataAry [-] TYPE(ModGlueType) :: Mod !< Module combining all active modules [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac11 !< Components of Jacobian matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac12 !< Components of Jacobian matrix [-] @@ -190,6 +195,32 @@ MODULE Glue_Types INTEGER(IntKi) :: LinFileNum = 1 !< Linearization file number [-] END TYPE Glue_AeroMap ! ======================= +! ========= TC_State ======= + TYPE, PUBLIC :: TC_State + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: q_prev !< Generalized alpha previous step displacement [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< Generalized alpha change in displacement [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: q !< Generalized alpha predicted displacement [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: v !< Generalized alpha velocities [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: vd !< Generalized alpha acceleration [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: a !< Generalized alpha algorithmic acceleration [-] + END TYPE TC_State +! ======================= +! ========= Glue_TCMisc ======= + TYPE, PUBLIC :: Glue_TCMisc + TYPE(ModGlueType) :: Mod !< Glue module combining tight coupling modules [-] + TYPE(TC_State) :: State !< Tight Coupling state [-] + TYPE(TC_State) :: StatePrev !< Tight Coupling previous state for correction iterations [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UCalc !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UOrig !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T !< Tangent matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] + INTEGER(IntKi) :: IterTotal = 0 !< [-] + INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] + INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] + LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] + END TYPE Glue_TCMisc +! ======================= ! ========= Glue_LinMisc ======= TYPE, PUBLIC :: Glue_LinMisc INTEGER(IntKi) :: TimeIndex = 0_IntKi !< [-] @@ -199,76 +230,49 @@ MODULE Glue_Types ! ======================= ! ========= Glue_MiscVarType ======= TYPE, PUBLIC :: Glue_MiscVarType - TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModDataAry !< Module variable and value data [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModData !< Module variable and value data [-] TYPE(MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mapping [-] TYPE(ModGlueType) :: ModGlue !< Glue code module [-] TYPE(Glue_LinMisc) :: Lin !< Linearization misc vars [-] TYPE(Glue_CalcSteady) :: CS !< CalcSteady calculation data [-] TYPE(Glue_AeroMap) :: AM !< AeroMap data [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: q !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: qn !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: un !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_tmp !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdyHat !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: G !< Used to merge state matrices [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] - INTEGER(IntKi) :: IterTotal = 0 !< [-] - INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] - INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dq !< Change in q [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< Change in x [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UDiff !< [-] - LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] + TYPE(Glue_TCMisc) :: TC !< Tight Coupling Miscellaneous data [-] END TYPE Glue_MiscVarType ! ======================= contains -subroutine Glue_CopyModMapType(SrcModMapTypeData, DstModMapTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModMapType), intent(in) :: SrcModMapTypeData - type(ModMapType), intent(inout) :: DstModMapTypeData +subroutine Glue_CopyVarMapType(SrcVarMapTypeData, DstVarMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarMapType), intent(in) :: SrcVarMapTypeData + type(VarMapType), intent(inout) :: DstVarMapTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Glue_CopyModMapType' + character(*), parameter :: RoutineName = 'Glue_CopyVarMapType' ErrStat = ErrID_None ErrMsg = '' - DstModMapTypeData%iMapping = SrcModMapTypeData%iMapping - DstModMapTypeData%iModSrc = SrcModMapTypeData%iModSrc - DstModMapTypeData%iModDst = SrcModMapTypeData%iModDst - DstModMapTypeData%iVarSrc = SrcModMapTypeData%iVarSrc - DstModMapTypeData%iVarSrcDisp = SrcModMapTypeData%iVarSrcDisp - DstModMapTypeData%iVarDst = SrcModMapTypeData%iVarDst - DstModMapTypeData%iVarDstDisp = SrcModMapTypeData%iVarDstDisp + DstVarMapTypeData%iMapping = SrcVarMapTypeData%iMapping + DstVarMapTypeData%iModSrc = SrcVarMapTypeData%iModSrc + DstVarMapTypeData%iModDst = SrcVarMapTypeData%iModDst + DstVarMapTypeData%iVarSrc = SrcVarMapTypeData%iVarSrc + DstVarMapTypeData%iVarSrcDisp = SrcVarMapTypeData%iVarSrcDisp + DstVarMapTypeData%iVarDst = SrcVarMapTypeData%iVarDst + DstVarMapTypeData%iVarDstDisp = SrcVarMapTypeData%iVarDstDisp end subroutine -subroutine Glue_DestroyModMapType(ModMapTypeData, ErrStat, ErrMsg) - type(ModMapType), intent(inout) :: ModMapTypeData +subroutine Glue_DestroyVarMapType(VarMapTypeData, ErrStat, ErrMsg) + type(VarMapType), intent(inout) :: VarMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Glue_DestroyModMapType' + character(*), parameter :: RoutineName = 'Glue_DestroyVarMapType' ErrStat = ErrID_None ErrMsg = '' end subroutine -subroutine Glue_PackModMapType(RF, Indata) +subroutine Glue_PackVarMapType(RF, Indata) type(RegFile), intent(inout) :: RF - type(ModMapType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Glue_PackModMapType' + type(VarMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackVarMapType' if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%iMapping) call RegPack(RF, InData%iModSrc) @@ -280,10 +284,10 @@ subroutine Glue_PackModMapType(RF, Indata) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Glue_UnPackModMapType(RF, OutData) +subroutine Glue_UnPackVarMapType(RF, OutData) type(RegFile), intent(inout) :: RF - type(ModMapType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Glue_UnPackModMapType' + type(VarMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackVarMapType' if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%iMapping); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iModSrc); if (RegCheckErr(RF, RoutineName)) return @@ -308,18 +312,18 @@ subroutine Glue_CopyModGlueType(SrcModGlueTypeData, DstModGlueTypeData, CtrlCode ErrStat = ErrID_None ErrMsg = '' DstModGlueTypeData%Name = SrcModGlueTypeData%Name - if (allocated(SrcModGlueTypeData%ModDataAry)) then - LB(1:1) = lbound(SrcModGlueTypeData%ModDataAry, kind=B8Ki) - UB(1:1) = ubound(SrcModGlueTypeData%ModDataAry, kind=B8Ki) - if (.not. allocated(DstModGlueTypeData%ModDataAry)) then - allocate(DstModGlueTypeData%ModDataAry(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModGlueTypeData%ModData)) then + LB(1:1) = lbound(SrcModGlueTypeData%ModData, kind=B8Ki) + UB(1:1) = ubound(SrcModGlueTypeData%ModData, kind=B8Ki) + if (.not. allocated(DstModGlueTypeData%ModData)) then + allocate(DstModGlueTypeData%ModData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModGlueTypeData%ModDataAry.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModGlueTypeData%ModData.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyModDataType(SrcModGlueTypeData%ModDataAry(i1), DstModGlueTypeData%ModDataAry(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModDataType(SrcModGlueTypeData%ModData(i1), DstModGlueTypeData%ModData(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -330,18 +334,18 @@ subroutine Glue_CopyModGlueType(SrcModGlueTypeData, DstModGlueTypeData, CtrlCode call NWTC_Library_CopyModLinType(SrcModGlueTypeData%Lin, DstModGlueTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcModGlueTypeData%ModMaps)) then - LB(1:1) = lbound(SrcModGlueTypeData%ModMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModGlueTypeData%ModMaps, kind=B8Ki) - if (.not. allocated(DstModGlueTypeData%ModMaps)) then - allocate(DstModGlueTypeData%ModMaps(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModGlueTypeData%VarMaps)) then + LB(1:1) = lbound(SrcModGlueTypeData%VarMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModGlueTypeData%VarMaps, kind=B8Ki) + if (.not. allocated(DstModGlueTypeData%VarMaps)) then + allocate(DstModGlueTypeData%VarMaps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModGlueTypeData%ModMaps.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModGlueTypeData%VarMaps.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call Glue_CopyModMapType(SrcModGlueTypeData%ModMaps(i1), DstModGlueTypeData%ModMaps(i1), CtrlCode, ErrStat2, ErrMsg2) + call Glue_CopyVarMapType(SrcModGlueTypeData%VarMaps(i1), DstModGlueTypeData%VarMaps(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -359,27 +363,27 @@ subroutine Glue_DestroyModGlueType(ModGlueTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyModGlueType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModGlueTypeData%ModDataAry)) then - LB(1:1) = lbound(ModGlueTypeData%ModDataAry, kind=B8Ki) - UB(1:1) = ubound(ModGlueTypeData%ModDataAry, kind=B8Ki) + if (allocated(ModGlueTypeData%ModData)) then + LB(1:1) = lbound(ModGlueTypeData%ModData, kind=B8Ki) + UB(1:1) = ubound(ModGlueTypeData%ModData, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_DestroyModDataType(ModGlueTypeData%ModDataAry(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModDataType(ModGlueTypeData%ModData(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ModGlueTypeData%ModDataAry) + deallocate(ModGlueTypeData%ModData) end if call NWTC_Library_DestroyModVarsType(ModGlueTypeData%Vars, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call NWTC_Library_DestroyModLinType(ModGlueTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ModGlueTypeData%ModMaps)) then - LB(1:1) = lbound(ModGlueTypeData%ModMaps, kind=B8Ki) - UB(1:1) = ubound(ModGlueTypeData%ModMaps, kind=B8Ki) + if (allocated(ModGlueTypeData%VarMaps)) then + LB(1:1) = lbound(ModGlueTypeData%VarMaps, kind=B8Ki) + UB(1:1) = ubound(ModGlueTypeData%VarMaps, kind=B8Ki) do i1 = LB(1), UB(1) - call Glue_DestroyModMapType(ModGlueTypeData%ModMaps(i1), ErrStat2, ErrMsg2) + call Glue_DestroyVarMapType(ModGlueTypeData%VarMaps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ModGlueTypeData%ModMaps) + deallocate(ModGlueTypeData%VarMaps) end if end subroutine @@ -391,24 +395,24 @@ subroutine Glue_PackModGlueType(RF, Indata) integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Name) - call RegPack(RF, allocated(InData%ModDataAry)) - if (allocated(InData%ModDataAry)) then - call RegPackBounds(RF, 1, lbound(InData%ModDataAry, kind=B8Ki), ubound(InData%ModDataAry, kind=B8Ki)) - LB(1:1) = lbound(InData%ModDataAry, kind=B8Ki) - UB(1:1) = ubound(InData%ModDataAry, kind=B8Ki) + call RegPack(RF, allocated(InData%ModData)) + if (allocated(InData%ModData)) then + call RegPackBounds(RF, 1, lbound(InData%ModData, kind=B8Ki), ubound(InData%ModData, kind=B8Ki)) + LB(1:1) = lbound(InData%ModData, kind=B8Ki) + UB(1:1) = ubound(InData%ModData, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackModDataType(RF, InData%ModDataAry(i1)) + call NWTC_Library_PackModDataType(RF, InData%ModData(i1)) end do end if call NWTC_Library_PackModVarsType(RF, InData%Vars) call NWTC_Library_PackModLinType(RF, InData%Lin) - call RegPack(RF, allocated(InData%ModMaps)) - if (allocated(InData%ModMaps)) then - call RegPackBounds(RF, 1, lbound(InData%ModMaps, kind=B8Ki), ubound(InData%ModMaps, kind=B8Ki)) - LB(1:1) = lbound(InData%ModMaps, kind=B8Ki) - UB(1:1) = ubound(InData%ModMaps, kind=B8Ki) + call RegPack(RF, allocated(InData%VarMaps)) + if (allocated(InData%VarMaps)) then + call RegPackBounds(RF, 1, lbound(InData%VarMaps, kind=B8Ki), ubound(InData%VarMaps, kind=B8Ki)) + LB(1:1) = lbound(InData%VarMaps, kind=B8Ki) + UB(1:1) = ubound(InData%VarMaps, kind=B8Ki) do i1 = LB(1), UB(1) - call Glue_PackModMapType(RF, InData%ModMaps(i1)) + call Glue_PackVarMapType(RF, InData%VarMaps(i1)) end do end if if (RegCheckErr(RF, RoutineName)) return @@ -424,32 +428,32 @@ subroutine Glue_UnPackModGlueType(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%ModDataAry)) deallocate(OutData%ModDataAry) + if (allocated(OutData%ModData)) deallocate(OutData%ModData) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%ModDataAry(LB(1):UB(1)),stat=stat) + allocate(OutData%ModData(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModDataAry.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModData.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackModDataType(RF, OutData%ModDataAry(i1)) ! ModDataAry + call NWTC_Library_UnpackModDataType(RF, OutData%ModData(i1)) ! ModData end do end if call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin - if (allocated(OutData%ModMaps)) deallocate(OutData%ModMaps) + if (allocated(OutData%VarMaps)) deallocate(OutData%VarMaps) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%ModMaps(LB(1):UB(1)),stat=stat) + allocate(OutData%VarMaps(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModMaps.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VarMaps.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Glue_UnpackModMapType(RF, OutData%ModMaps(i1)) ! ModMaps + call Glue_UnpackVarMapType(RF, OutData%VarMaps(i1)) ! VarMaps end do end if end subroutine @@ -473,10 +477,6 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode DstMappingTypeData%DstModID = SrcMappingTypeData%DstModID DstMappingTypeData%SrcIns = SrcMappingTypeData%SrcIns DstMappingTypeData%DstIns = SrcMappingTypeData%DstIns - DstMappingTypeData%SrcMeshID = SrcMappingTypeData%SrcMeshID - DstMappingTypeData%DstMeshID = SrcMappingTypeData%DstMeshID - DstMappingTypeData%SrcDispMeshID = SrcMappingTypeData%SrcDispMeshID - DstMappingTypeData%DstDispMeshID = SrcMappingTypeData%DstDispMeshID call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcDL, DstMappingTypeData%SrcDL, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -506,6 +506,24 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode end if DstMappingTypeData%TmpMatrix = SrcMappingTypeData%TmpMatrix end if + if (allocated(SrcMappingTypeData%VarData)) then + LB(1:1) = lbound(SrcMappingTypeData%VarData, kind=B8Ki) + UB(1:1) = ubound(SrcMappingTypeData%VarData, kind=B8Ki) + if (.not. allocated(DstMappingTypeData%VarData)) then + allocate(DstMappingTypeData%VarData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMappingTypeData%VarData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMappingTypeData%VarData = SrcMappingTypeData%VarData + end if + call NWTC_Library_CopyModVarType(SrcMappingTypeData%SrcVar, DstMappingTypeData%SrcVar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModVarType(SrcMappingTypeData%DstVar, DstMappingTypeData%DstVar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return call NWTC_Library_CopyMeshMapType(SrcMappingTypeData%MeshMap, DstMappingTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -540,6 +558,13 @@ subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) if (allocated(MappingTypeData%TmpMatrix)) then deallocate(MappingTypeData%TmpMatrix) end if + if (allocated(MappingTypeData%VarData)) then + deallocate(MappingTypeData%VarData) + end if + call NWTC_Library_DestroyModVarType(MappingTypeData%SrcVar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarType(MappingTypeData%DstVar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call NWTC_Library_DestroyMeshMapType(MappingTypeData%MeshMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call NWTC_Library_DestroyMeshMapType(MappingTypeData%MeshMapAux, ErrStat2, ErrMsg2) @@ -562,10 +587,6 @@ subroutine Glue_PackMappingType(RF, Indata) call RegPack(RF, InData%DstModID) call RegPack(RF, InData%SrcIns) call RegPack(RF, InData%DstIns) - call RegPack(RF, InData%SrcMeshID) - call RegPack(RF, InData%DstMeshID) - call RegPack(RF, InData%SrcDispMeshID) - call RegPack(RF, InData%DstDispMeshID) call NWTC_Library_PackDatLoc(RF, InData%SrcDL) call NWTC_Library_PackDatLoc(RF, InData%DstDL) call NWTC_Library_PackDatLoc(RF, InData%SrcDispDL) @@ -576,6 +597,9 @@ subroutine Glue_PackMappingType(RF, Indata) call RegPack(RF, InData%Ready) call RegPack(RF, InData%DstUsesSibling) call RegPackAlloc(RF, InData%TmpMatrix) + call RegPackAlloc(RF, InData%VarData) + call NWTC_Library_PackModVarType(RF, InData%SrcVar) + call NWTC_Library_PackModVarType(RF, InData%DstVar) call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) call NWTC_Library_PackMeshMapType(RF, InData%MeshMapAux) call MeshPack(RF, InData%TmpLoadMesh) @@ -598,10 +622,6 @@ subroutine Glue_UnPackMappingType(RF, OutData) call RegUnpack(RF, OutData%DstModID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SrcIns); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstIns); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SrcMeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstMeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SrcDispMeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DstDispMeshID); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackDatLoc(RF, OutData%SrcDL) ! SrcDL call NWTC_Library_UnpackDatLoc(RF, OutData%DstDL) ! DstDL call NWTC_Library_UnpackDatLoc(RF, OutData%SrcDispDL) ! SrcDispDL @@ -612,6 +632,9 @@ subroutine Glue_UnPackMappingType(RF, OutData) call RegUnpack(RF, OutData%Ready); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstUsesSibling); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VarData); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarType(RF, OutData%SrcVar) ! SrcVar + call NWTC_Library_UnpackModVarType(RF, OutData%DstVar) ! DstVar call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMapAux) ! MeshMapAux call MeshUnpack(RF, OutData%TmpLoadMesh) ! TmpLoadMesh @@ -684,278 +707,265 @@ subroutine Glue_UnPackLinParam(RF, OutData) call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Glue_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(Glue_ParameterType), intent(in) :: SrcParamData - type(Glue_ParameterType), intent(inout) :: DstParamData +subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, ErrMsg) + type(Glue_TCParam), intent(in) :: SrcTCParamData + type(Glue_TCParam), intent(inout) :: DstTCParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_CopyParam' + character(*), parameter :: RoutineName = 'Glue_CopyTCParam' ErrStat = ErrID_None ErrMsg = '' - call Glue_CopyLinParam(SrcParamData%Lin, DstParamData%Lin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstParamData%DT = SrcParamData%DT - DstParamData%ConvTol = SrcParamData%ConvTol - DstParamData%NumCrctn = SrcParamData%NumCrctn - DstParamData%MaxConvIter = SrcParamData%MaxConvIter - DstParamData%NIter_UJac = SrcParamData%NIter_UJac - DstParamData%NStep_UJac = SrcParamData%NStep_UJac - DstParamData%Scale_UJac = SrcParamData%Scale_UJac - DstParamData%AccBlend = SrcParamData%AccBlend - DstParamData%RhoInf = SrcParamData%RhoInf - DstParamData%AlphaM = SrcParamData%AlphaM - DstParamData%AlphaF = SrcParamData%AlphaF - DstParamData%Beta = SrcParamData%Beta - DstParamData%Gamma = SrcParamData%Gamma - DstParamData%C = SrcParamData%C - DstParamData%iX1 = SrcParamData%iX1 - DstParamData%iX2 = SrcParamData%iX2 - DstParamData%iUT = SrcParamData%iUT - DstParamData%iU1 = SrcParamData%iU1 - DstParamData%iyT = SrcParamData%iyT - DstParamData%iy1 = SrcParamData%iy1 - DstParamData%iJX = SrcParamData%iJX - DstParamData%iJU = SrcParamData%iJU - DstParamData%iJUT = SrcParamData%iJUT - if (allocated(SrcParamData%iJL)) then - LB(1:1) = lbound(SrcParamData%iJL, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iJL, kind=B8Ki) - if (.not. allocated(DstParamData%iJL)) then - allocate(DstParamData%iJL(LB(1):UB(1)), stat=ErrStat2) + DstTCParamData%h = SrcTCParamData%h + DstTCParamData%ConvTol = SrcTCParamData%ConvTol + DstTCParamData%NumCrctn = SrcTCParamData%NumCrctn + DstTCParamData%MaxConvIter = SrcTCParamData%MaxConvIter + DstTCParamData%NIter_UJac = SrcTCParamData%NIter_UJac + DstTCParamData%NStep_UJac = SrcTCParamData%NStep_UJac + DstTCParamData%Scale_UJac = SrcTCParamData%Scale_UJac + DstTCParamData%RhoInf = SrcTCParamData%RhoInf + DstTCParamData%AlphaM = SrcTCParamData%AlphaM + DstTCParamData%AlphaF = SrcTCParamData%AlphaF + DstTCParamData%Beta = SrcTCParamData%Beta + DstTCParamData%Gamma = SrcTCParamData%Gamma + DstTCParamData%BetaPrime = SrcTCParamData%BetaPrime + DstTCParamData%GammaPrime = SrcTCParamData%GammaPrime + DstTCParamData%NumJ = SrcTCParamData%NumJ + DstTCParamData%NumQ = SrcTCParamData%NumQ + DstTCParamData%iX1 = SrcTCParamData%iX1 + DstTCParamData%iX2 = SrcTCParamData%iX2 + DstTCParamData%iUT = SrcTCParamData%iUT + DstTCParamData%iU1 = SrcTCParamData%iU1 + DstTCParamData%iUL = SrcTCParamData%iUL + DstTCParamData%iyT = SrcTCParamData%iyT + DstTCParamData%iy1 = SrcTCParamData%iy1 + DstTCParamData%iJX = SrcTCParamData%iJX + DstTCParamData%iJU = SrcTCParamData%iJU + DstTCParamData%iJUT = SrcTCParamData%iJUT + DstTCParamData%iJL = SrcTCParamData%iJL + if (allocated(SrcTCParamData%iModInit)) then + LB(1:1) = lbound(SrcTCParamData%iModInit, kind=B8Ki) + UB(1:1) = ubound(SrcTCParamData%iModInit, kind=B8Ki) + if (.not. allocated(DstTCParamData%iModInit)) then + allocate(DstTCParamData%iModInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iJL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModInit.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%iJL = SrcParamData%iJL + DstTCParamData%iModInit = SrcTCParamData%iModInit end if - if (allocated(SrcParamData%ixqd)) then - LB(1:2) = lbound(SrcParamData%ixqd, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%ixqd, kind=B8Ki) - if (.not. allocated(DstParamData%ixqd)) then - allocate(DstParamData%ixqd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcTCParamData%iModTC)) then + LB(1:1) = lbound(SrcTCParamData%iModTC, kind=B8Ki) + UB(1:1) = ubound(SrcTCParamData%iModTC, kind=B8Ki) + if (.not. allocated(DstTCParamData%iModTC)) then + allocate(DstTCParamData%iModTC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ixqd.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModTC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%ixqd = SrcParamData%ixqd + DstTCParamData%iModTC = SrcTCParamData%iModTC end if - if (allocated(SrcParamData%iModInit)) then - LB(1:1) = lbound(SrcParamData%iModInit, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iModInit, kind=B8Ki) - if (.not. allocated(DstParamData%iModInit)) then - allocate(DstParamData%iModInit(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcTCParamData%iModOpt1)) then + LB(1:1) = lbound(SrcTCParamData%iModOpt1, kind=B8Ki) + UB(1:1) = ubound(SrcTCParamData%iModOpt1, kind=B8Ki) + if (.not. allocated(DstTCParamData%iModOpt1)) then + allocate(DstTCParamData%iModOpt1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModInit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModOpt1.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%iModInit = SrcParamData%iModInit + DstTCParamData%iModOpt1 = SrcTCParamData%iModOpt1 end if - if (allocated(SrcParamData%iModTC)) then - LB(1:1) = lbound(SrcParamData%iModTC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iModTC, kind=B8Ki) - if (.not. allocated(DstParamData%iModTC)) then - allocate(DstParamData%iModTC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcTCParamData%iModOpt2)) then + LB(1:1) = lbound(SrcTCParamData%iModOpt2, kind=B8Ki) + UB(1:1) = ubound(SrcTCParamData%iModOpt2, kind=B8Ki) + if (.not. allocated(DstTCParamData%iModOpt2)) then + allocate(DstTCParamData%iModOpt2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModTC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModOpt2.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%iModTC = SrcParamData%iModTC + DstTCParamData%iModOpt2 = SrcTCParamData%iModOpt2 end if - if (allocated(SrcParamData%iModBD)) then - LB(1:1) = lbound(SrcParamData%iModBD, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iModBD, kind=B8Ki) - if (.not. allocated(DstParamData%iModBD)) then - allocate(DstParamData%iModBD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcTCParamData%iModPost)) then + LB(1:1) = lbound(SrcTCParamData%iModPost, kind=B8Ki) + UB(1:1) = ubound(SrcTCParamData%iModPost, kind=B8Ki) + if (.not. allocated(DstTCParamData%iModPost)) then + allocate(DstTCParamData%iModPost(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModBD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModPost.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%iModBD = SrcParamData%iModBD - end if - if (allocated(SrcParamData%iModOpt1)) then - LB(1:1) = lbound(SrcParamData%iModOpt1, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iModOpt1, kind=B8Ki) - if (.not. allocated(DstParamData%iModOpt1)) then - allocate(DstParamData%iModOpt1(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModOpt1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iModOpt1 = SrcParamData%iModOpt1 - end if - if (allocated(SrcParamData%iModOpt1US)) then - LB(1:1) = lbound(SrcParamData%iModOpt1US, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iModOpt1US, kind=B8Ki) - if (.not. allocated(DstParamData%iModOpt1US)) then - allocate(DstParamData%iModOpt1US(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModOpt1US.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iModOpt1US = SrcParamData%iModOpt1US - end if - if (allocated(SrcParamData%iModOpt2)) then - LB(1:1) = lbound(SrcParamData%iModOpt2, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iModOpt2, kind=B8Ki) - if (.not. allocated(DstParamData%iModOpt2)) then - allocate(DstParamData%iModOpt2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModOpt2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iModOpt2 = SrcParamData%iModOpt2 - end if - if (allocated(SrcParamData%iModPost)) then - LB(1:1) = lbound(SrcParamData%iModPost, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%iModPost, kind=B8Ki) - if (.not. allocated(DstParamData%iModPost)) then - allocate(DstParamData%iModPost(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%iModPost.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%iModPost = SrcParamData%iModPost + DstTCParamData%iModPost = SrcTCParamData%iModPost end if end subroutine -subroutine Glue_DestroyParam(ParamData, ErrStat, ErrMsg) - type(Glue_ParameterType), intent(inout) :: ParamData +subroutine Glue_DestroyTCParam(TCParamData, ErrStat, ErrMsg) + type(Glue_TCParam), intent(inout) :: TCParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Glue_DestroyParam' + character(*), parameter :: RoutineName = 'Glue_DestroyTCParam' ErrStat = ErrID_None ErrMsg = '' - call Glue_DestroyLinParam(ParamData%Lin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ParamData%iJL)) then - deallocate(ParamData%iJL) - end if - if (allocated(ParamData%ixqd)) then - deallocate(ParamData%ixqd) - end if - if (allocated(ParamData%iModInit)) then - deallocate(ParamData%iModInit) - end if - if (allocated(ParamData%iModTC)) then - deallocate(ParamData%iModTC) - end if - if (allocated(ParamData%iModBD)) then - deallocate(ParamData%iModBD) + if (allocated(TCParamData%iModInit)) then + deallocate(TCParamData%iModInit) end if - if (allocated(ParamData%iModOpt1)) then - deallocate(ParamData%iModOpt1) + if (allocated(TCParamData%iModTC)) then + deallocate(TCParamData%iModTC) end if - if (allocated(ParamData%iModOpt1US)) then - deallocate(ParamData%iModOpt1US) + if (allocated(TCParamData%iModOpt1)) then + deallocate(TCParamData%iModOpt1) end if - if (allocated(ParamData%iModOpt2)) then - deallocate(ParamData%iModOpt2) + if (allocated(TCParamData%iModOpt2)) then + deallocate(TCParamData%iModOpt2) end if - if (allocated(ParamData%iModPost)) then - deallocate(ParamData%iModPost) + if (allocated(TCParamData%iModPost)) then + deallocate(TCParamData%iModPost) end if end subroutine -subroutine Glue_PackParam(RF, Indata) +subroutine Glue_PackTCParam(RF, Indata) type(RegFile), intent(inout) :: RF - type(Glue_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Glue_PackParam' + type(Glue_TCParam), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackTCParam' if (RF%ErrStat >= AbortErrLev) return - call Glue_PackLinParam(RF, InData%Lin) - call RegPack(RF, InData%DT) + call RegPack(RF, InData%h) call RegPack(RF, InData%ConvTol) call RegPack(RF, InData%NumCrctn) call RegPack(RF, InData%MaxConvIter) call RegPack(RF, InData%NIter_UJac) call RegPack(RF, InData%NStep_UJac) call RegPack(RF, InData%Scale_UJac) - call RegPack(RF, InData%AccBlend) call RegPack(RF, InData%RhoInf) call RegPack(RF, InData%AlphaM) call RegPack(RF, InData%AlphaF) call RegPack(RF, InData%Beta) call RegPack(RF, InData%Gamma) - call RegPack(RF, InData%C) + call RegPack(RF, InData%BetaPrime) + call RegPack(RF, InData%GammaPrime) + call RegPack(RF, InData%NumJ) + call RegPack(RF, InData%NumQ) call RegPack(RF, InData%iX1) call RegPack(RF, InData%iX2) call RegPack(RF, InData%iUT) call RegPack(RF, InData%iU1) + call RegPack(RF, InData%iUL) call RegPack(RF, InData%iyT) call RegPack(RF, InData%iy1) call RegPack(RF, InData%iJX) call RegPack(RF, InData%iJU) call RegPack(RF, InData%iJUT) - call RegPackAlloc(RF, InData%iJL) - call RegPackAlloc(RF, InData%ixqd) + call RegPack(RF, InData%iJL) call RegPackAlloc(RF, InData%iModInit) call RegPackAlloc(RF, InData%iModTC) - call RegPackAlloc(RF, InData%iModBD) call RegPackAlloc(RF, InData%iModOpt1) - call RegPackAlloc(RF, InData%iModOpt1US) call RegPackAlloc(RF, InData%iModOpt2) call RegPackAlloc(RF, InData%iModPost) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Glue_UnPackParam(RF, OutData) +subroutine Glue_UnPackTCParam(RF, OutData) type(RegFile), intent(inout) :: RF - type(Glue_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Glue_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + type(Glue_TCParam), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackTCParam' + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call Glue_UnpackLinParam(RF, OutData%Lin) ! Lin - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NIter_UJac); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NStep_UJac); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Scale_UJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AccBlend); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%AlphaM); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%AlphaF); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Beta); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Gamma); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BetaPrime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GammaPrime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumQ); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iX1); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iX2); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iUT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iU1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUL); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iyT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iy1); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iJX); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iJU); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iJUT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iJL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ixqd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModInit); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModTC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModBD); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModOpt1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModOpt1US); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModOpt2); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModPost); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine Glue_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(in) :: SrcParamData + type(Glue_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_CopyLinParam(SrcParamData%Lin, DstParamData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyTCParam(SrcParamData%TC, DstParamData%TC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Glue_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyLinParam(ParamData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyTCParam(ParamData%TC, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Glue_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call Glue_PackLinParam(RF, InData%Lin) + call Glue_PackTCParam(RF, InData%TC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call Glue_UnpackLinParam(RF, OutData%Lin) ! Lin + call Glue_UnpackTCParam(RF, OutData%TC) ! TC +end subroutine + subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, ErrMsg) type(Glue_LinSave), intent(in) :: SrcLinSaveData type(Glue_LinSave), intent(inout) :: DstLinSaveData @@ -1381,6 +1391,18 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E character(*), parameter :: RoutineName = 'Glue_CopyAeroMap' ErrStat = ErrID_None ErrMsg = '' + if (allocated(SrcAeroMapData%iModOrder)) then + LB(1:1) = lbound(SrcAeroMapData%iModOrder, kind=B8Ki) + UB(1:1) = ubound(SrcAeroMapData%iModOrder, kind=B8Ki) + if (.not. allocated(DstAeroMapData%iModOrder)) then + allocate(DstAeroMapData%iModOrder(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%iModOrder.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%iModOrder = SrcAeroMapData%iModOrder + end if call Glue_CopyModGlueType(SrcAeroMapData%Mod, DstAeroMapData%Mod, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1536,6 +1558,9 @@ subroutine Glue_DestroyAeroMap(AeroMapData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Glue_DestroyAeroMap' ErrStat = ErrID_None ErrMsg = '' + if (allocated(AeroMapData%iModOrder)) then + deallocate(AeroMapData%iModOrder) + end if call Glue_DestroyModGlueType(AeroMapData%Mod, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroMapData%Jac11)) then @@ -1586,6 +1611,7 @@ subroutine Glue_PackAeroMap(RF, Indata) integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%iModOrder) call Glue_PackModGlueType(RF, InData%Mod) call RegPackAlloc(RF, InData%Jac11) call RegPackAlloc(RF, InData%Jac12) @@ -1621,6 +1647,7 @@ subroutine Glue_UnPackAeroMap(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%iModOrder); if (RegCheckErr(RF, RoutineName)) return call Glue_UnpackModGlueType(RF, OutData%Mod) ! Mod call RegUnpackAlloc(RF, OutData%Jac11); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Jac12); if (RegCheckErr(RF, RoutineName)) return @@ -1650,6 +1677,309 @@ subroutine Glue_UnPackAeroMap(RF, OutData) call RegUnpack(RF, OutData%LinFileNum); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine Glue_CopyTC_State(SrcTC_StateData, DstTC_StateData, CtrlCode, ErrStat, ErrMsg) + type(TC_State), intent(in) :: SrcTC_StateData + type(TC_State), intent(inout) :: DstTC_StateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyTC_State' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcTC_StateData%q_prev)) then + LB(1:1) = lbound(SrcTC_StateData%q_prev, kind=B8Ki) + UB(1:1) = ubound(SrcTC_StateData%q_prev, kind=B8Ki) + if (.not. allocated(DstTC_StateData%q_prev)) then + allocate(DstTC_StateData%q_prev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%q_prev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%q_prev = SrcTC_StateData%q_prev + end if + if (allocated(SrcTC_StateData%x)) then + LB(1:1) = lbound(SrcTC_StateData%x, kind=B8Ki) + UB(1:1) = ubound(SrcTC_StateData%x, kind=B8Ki) + if (.not. allocated(DstTC_StateData%x)) then + allocate(DstTC_StateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%x = SrcTC_StateData%x + end if + if (allocated(SrcTC_StateData%q)) then + LB(1:1) = lbound(SrcTC_StateData%q, kind=B8Ki) + UB(1:1) = ubound(SrcTC_StateData%q, kind=B8Ki) + if (.not. allocated(DstTC_StateData%q)) then + allocate(DstTC_StateData%q(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%q = SrcTC_StateData%q + end if + if (allocated(SrcTC_StateData%v)) then + LB(1:1) = lbound(SrcTC_StateData%v, kind=B8Ki) + UB(1:1) = ubound(SrcTC_StateData%v, kind=B8Ki) + if (.not. allocated(DstTC_StateData%v)) then + allocate(DstTC_StateData%v(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%v.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%v = SrcTC_StateData%v + end if + if (allocated(SrcTC_StateData%vd)) then + LB(1:1) = lbound(SrcTC_StateData%vd, kind=B8Ki) + UB(1:1) = ubound(SrcTC_StateData%vd, kind=B8Ki) + if (.not. allocated(DstTC_StateData%vd)) then + allocate(DstTC_StateData%vd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%vd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%vd = SrcTC_StateData%vd + end if + if (allocated(SrcTC_StateData%a)) then + LB(1:1) = lbound(SrcTC_StateData%a, kind=B8Ki) + UB(1:1) = ubound(SrcTC_StateData%a, kind=B8Ki) + if (.not. allocated(DstTC_StateData%a)) then + allocate(DstTC_StateData%a(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%a.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%a = SrcTC_StateData%a + end if +end subroutine + +subroutine Glue_DestroyTC_State(TC_StateData, ErrStat, ErrMsg) + type(TC_State), intent(inout) :: TC_StateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyTC_State' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TC_StateData%q_prev)) then + deallocate(TC_StateData%q_prev) + end if + if (allocated(TC_StateData%x)) then + deallocate(TC_StateData%x) + end if + if (allocated(TC_StateData%q)) then + deallocate(TC_StateData%q) + end if + if (allocated(TC_StateData%v)) then + deallocate(TC_StateData%v) + end if + if (allocated(TC_StateData%vd)) then + deallocate(TC_StateData%vd) + end if + if (allocated(TC_StateData%a)) then + deallocate(TC_StateData%a) + end if +end subroutine + +subroutine Glue_PackTC_State(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TC_State), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackTC_State' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%q_prev) + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%q) + call RegPackAlloc(RF, InData%v) + call RegPackAlloc(RF, InData%vd) + call RegPackAlloc(RF, InData%a) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackTC_State(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TC_State), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackTC_State' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%q_prev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%a); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrMsg) + type(Glue_TCMisc), intent(in) :: SrcTCMiscData + type(Glue_TCMisc), intent(inout) :: DstTCMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyTCMisc' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_CopyModGlueType(SrcTCMiscData%Mod, DstTCMiscData%Mod, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyTC_State(SrcTCMiscData%State, DstTCMiscData%State, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyTC_State(SrcTCMiscData%StatePrev, DstTCMiscData%StatePrev, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcTCMiscData%UCalc)) then + LB(1:1) = lbound(SrcTCMiscData%UCalc, kind=B8Ki) + UB(1:1) = ubound(SrcTCMiscData%UCalc, kind=B8Ki) + if (.not. allocated(DstTCMiscData%UCalc)) then + allocate(DstTCMiscData%UCalc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%UCalc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%UCalc = SrcTCMiscData%UCalc + end if + if (allocated(SrcTCMiscData%UOrig)) then + LB(1:1) = lbound(SrcTCMiscData%UOrig, kind=B8Ki) + UB(1:1) = ubound(SrcTCMiscData%UOrig, kind=B8Ki) + if (.not. allocated(DstTCMiscData%UOrig)) then + allocate(DstTCMiscData%UOrig(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%UOrig.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%UOrig = SrcTCMiscData%UOrig + end if + if (allocated(SrcTCMiscData%T)) then + LB(1:2) = lbound(SrcTCMiscData%T, kind=B8Ki) + UB(1:2) = ubound(SrcTCMiscData%T, kind=B8Ki) + if (.not. allocated(DstTCMiscData%T)) then + allocate(DstTCMiscData%T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%T = SrcTCMiscData%T + end if + if (allocated(SrcTCMiscData%XB)) then + LB(1:2) = lbound(SrcTCMiscData%XB, kind=B8Ki) + UB(1:2) = ubound(SrcTCMiscData%XB, kind=B8Ki) + if (.not. allocated(DstTCMiscData%XB)) then + allocate(DstTCMiscData%XB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%XB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%XB = SrcTCMiscData%XB + end if + if (allocated(SrcTCMiscData%IPIV)) then + LB(1:1) = lbound(SrcTCMiscData%IPIV, kind=B8Ki) + UB(1:1) = ubound(SrcTCMiscData%IPIV, kind=B8Ki) + if (.not. allocated(DstTCMiscData%IPIV)) then + allocate(DstTCMiscData%IPIV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%IPIV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%IPIV = SrcTCMiscData%IPIV + end if + DstTCMiscData%IterTotal = SrcTCMiscData%IterTotal + DstTCMiscData%IterUntilUJac = SrcTCMiscData%IterUntilUJac + DstTCMiscData%StepsUntilUJac = SrcTCMiscData%StepsUntilUJac + DstTCMiscData%ConvWarn = SrcTCMiscData%ConvWarn +end subroutine + +subroutine Glue_DestroyTCMisc(TCMiscData, ErrStat, ErrMsg) + type(Glue_TCMisc), intent(inout) :: TCMiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyTCMisc' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyModGlueType(TCMiscData%Mod, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyTC_State(TCMiscData%State, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyTC_State(TCMiscData%StatePrev, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(TCMiscData%UCalc)) then + deallocate(TCMiscData%UCalc) + end if + if (allocated(TCMiscData%UOrig)) then + deallocate(TCMiscData%UOrig) + end if + if (allocated(TCMiscData%T)) then + deallocate(TCMiscData%T) + end if + if (allocated(TCMiscData%XB)) then + deallocate(TCMiscData%XB) + end if + if (allocated(TCMiscData%IPIV)) then + deallocate(TCMiscData%IPIV) + end if +end subroutine + +subroutine Glue_PackTCMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_TCMisc), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackTCMisc' + if (RF%ErrStat >= AbortErrLev) return + call Glue_PackModGlueType(RF, InData%Mod) + call Glue_PackTC_State(RF, InData%State) + call Glue_PackTC_State(RF, InData%StatePrev) + call RegPackAlloc(RF, InData%UCalc) + call RegPackAlloc(RF, InData%UOrig) + call RegPackAlloc(RF, InData%T) + call RegPackAlloc(RF, InData%XB) + call RegPackAlloc(RF, InData%IPIV) + call RegPack(RF, InData%IterTotal) + call RegPack(RF, InData%IterUntilUJac) + call RegPack(RF, InData%StepsUntilUJac) + call RegPack(RF, InData%ConvWarn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackTCMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_TCMisc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackTCMisc' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call Glue_UnpackModGlueType(RF, OutData%Mod) ! Mod + call Glue_UnpackTC_State(RF, OutData%State) ! State + call Glue_UnpackTC_State(RF, OutData%StatePrev) ! StatePrev + call RegUnpackAlloc(RF, OutData%UCalc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UOrig); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%XB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IPIV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IterTotal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IterUntilUJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StepsUntilUJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine Glue_CopyLinMisc(SrcLinMiscData, DstLinMiscData, CtrlCode, ErrStat, ErrMsg) type(Glue_LinMisc), intent(in) :: SrcLinMiscData type(Glue_LinMisc), intent(inout) :: DstLinMiscData @@ -1700,25 +2030,25 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%ModDataAry)) then - LB(1:1) = lbound(SrcMiscData%ModDataAry, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ModDataAry, kind=B8Ki) - if (.not. allocated(DstMiscData%ModDataAry)) then - allocate(DstMiscData%ModDataAry(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%ModData)) then + LB(1:1) = lbound(SrcMiscData%ModData, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%ModData, kind=B8Ki) + if (.not. allocated(DstMiscData%ModData)) then + allocate(DstMiscData%ModData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ModDataAry.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ModData.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyModDataType(SrcMiscData%ModDataAry(i1), DstMiscData%ModDataAry(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModDataType(SrcMiscData%ModData(i1), DstMiscData%ModData(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -1751,319 +2081,30 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call Glue_CopyAeroMap(SrcMiscData%AM, DstMiscData%AM, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%q)) then - LB(1:2) = lbound(SrcMiscData%q, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%q, kind=B8Ki) - if (.not. allocated(DstMiscData%q)) then - allocate(DstMiscData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%q.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%q = SrcMiscData%q - end if - if (allocated(SrcMiscData%qn)) then - LB(1:2) = lbound(SrcMiscData%qn, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%qn, kind=B8Ki) - if (.not. allocated(DstMiscData%qn)) then - allocate(DstMiscData%qn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qn.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%qn = SrcMiscData%qn - end if - if (allocated(SrcMiscData%x)) then - LB(1:1) = lbound(SrcMiscData%x, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%x, kind=B8Ki) - if (.not. allocated(DstMiscData%x)) then - allocate(DstMiscData%x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%x = SrcMiscData%x - end if - if (allocated(SrcMiscData%xn)) then - LB(1:1) = lbound(SrcMiscData%xn, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%xn, kind=B8Ki) - if (.not. allocated(DstMiscData%xn)) then - allocate(DstMiscData%xn(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xn.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%xn = SrcMiscData%xn - end if - if (allocated(SrcMiscData%dxdt)) then - LB(1:1) = lbound(SrcMiscData%dxdt, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%dxdt, kind=B8Ki) - if (.not. allocated(DstMiscData%dxdt)) then - allocate(DstMiscData%dxdt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dxdt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dxdt = SrcMiscData%dxdt - end if - if (allocated(SrcMiscData%u)) then - LB(1:1) = lbound(SrcMiscData%u, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u, kind=B8Ki) - if (.not. allocated(DstMiscData%u)) then - allocate(DstMiscData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%u = SrcMiscData%u - end if - if (allocated(SrcMiscData%un)) then - LB(1:1) = lbound(SrcMiscData%un, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%un, kind=B8Ki) - if (.not. allocated(DstMiscData%un)) then - allocate(DstMiscData%un(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%un.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%un = SrcMiscData%un - end if - if (allocated(SrcMiscData%u_tmp)) then - LB(1:1) = lbound(SrcMiscData%u_tmp, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u_tmp, kind=B8Ki) - if (.not. allocated(DstMiscData%u_tmp)) then - allocate(DstMiscData%u_tmp(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_tmp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%u_tmp = SrcMiscData%u_tmp - end if - if (allocated(SrcMiscData%y)) then - LB(1:1) = lbound(SrcMiscData%y, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y, kind=B8Ki) - if (.not. allocated(DstMiscData%y)) then - allocate(DstMiscData%y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%y = SrcMiscData%y - end if - if (allocated(SrcMiscData%dYdx)) then - LB(1:2) = lbound(SrcMiscData%dYdx, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dYdx, kind=B8Ki) - if (.not. allocated(DstMiscData%dYdx)) then - allocate(DstMiscData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dYdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dYdx = SrcMiscData%dYdx - end if - if (allocated(SrcMiscData%dYdu)) then - LB(1:2) = lbound(SrcMiscData%dYdu, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dYdu, kind=B8Ki) - if (.not. allocated(DstMiscData%dYdu)) then - allocate(DstMiscData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dYdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dYdu = SrcMiscData%dYdu - end if - if (allocated(SrcMiscData%dXdx)) then - LB(1:2) = lbound(SrcMiscData%dXdx, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dXdx, kind=B8Ki) - if (.not. allocated(DstMiscData%dXdx)) then - allocate(DstMiscData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dXdx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dXdx = SrcMiscData%dXdx - end if - if (allocated(SrcMiscData%dXdu)) then - LB(1:2) = lbound(SrcMiscData%dXdu, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dXdu, kind=B8Ki) - if (.not. allocated(DstMiscData%dXdu)) then - allocate(DstMiscData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dXdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dXdu = SrcMiscData%dXdu - end if - if (allocated(SrcMiscData%dUdu)) then - LB(1:2) = lbound(SrcMiscData%dUdu, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dUdu, kind=B8Ki) - if (.not. allocated(DstMiscData%dUdu)) then - allocate(DstMiscData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dUdu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dUdu = SrcMiscData%dUdu - end if - if (allocated(SrcMiscData%dUdy)) then - LB(1:2) = lbound(SrcMiscData%dUdy, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dUdy, kind=B8Ki) - if (.not. allocated(DstMiscData%dUdy)) then - allocate(DstMiscData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dUdy.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dUdy = SrcMiscData%dUdy - end if - if (allocated(SrcMiscData%dUdyHat)) then - LB(1:2) = lbound(SrcMiscData%dUdyHat, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dUdyHat, kind=B8Ki) - if (.not. allocated(DstMiscData%dUdyHat)) then - allocate(DstMiscData%dUdyHat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dUdyHat.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dUdyHat = SrcMiscData%dUdyHat - end if - if (allocated(SrcMiscData%XB)) then - LB(1:2) = lbound(SrcMiscData%XB, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%XB, kind=B8Ki) - if (.not. allocated(DstMiscData%XB)) then - allocate(DstMiscData%XB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%XB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%XB = SrcMiscData%XB - end if - if (allocated(SrcMiscData%G)) then - LB(1:2) = lbound(SrcMiscData%G, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%G, kind=B8Ki) - if (.not. allocated(DstMiscData%G)) then - allocate(DstMiscData%G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%G.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%G = SrcMiscData%G - end if - if (allocated(SrcMiscData%Jac)) then - LB(1:2) = lbound(SrcMiscData%Jac, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Jac, kind=B8Ki) - if (.not. allocated(DstMiscData%Jac)) then - allocate(DstMiscData%Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Jac.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%Jac = SrcMiscData%Jac - end if - if (allocated(SrcMiscData%IPIV)) then - LB(1:1) = lbound(SrcMiscData%IPIV, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%IPIV, kind=B8Ki) - if (.not. allocated(DstMiscData%IPIV)) then - allocate(DstMiscData%IPIV(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%IPIV.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%IPIV = SrcMiscData%IPIV - end if - DstMiscData%IterTotal = SrcMiscData%IterTotal - DstMiscData%IterUntilUJac = SrcMiscData%IterUntilUJac - DstMiscData%StepsUntilUJac = SrcMiscData%StepsUntilUJac - if (allocated(SrcMiscData%dq)) then - LB(1:2) = lbound(SrcMiscData%dq, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dq, kind=B8Ki) - if (.not. allocated(DstMiscData%dq)) then - allocate(DstMiscData%dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dq.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dq = SrcMiscData%dq - end if - if (allocated(SrcMiscData%dx)) then - LB(1:1) = lbound(SrcMiscData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%dx, kind=B8Ki) - if (.not. allocated(DstMiscData%dx)) then - allocate(DstMiscData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dx = SrcMiscData%dx - end if - if (allocated(SrcMiscData%du)) then - LB(1:1) = lbound(SrcMiscData%du, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%du, kind=B8Ki) - if (.not. allocated(DstMiscData%du)) then - allocate(DstMiscData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%du = SrcMiscData%du - end if - if (allocated(SrcMiscData%UDiff)) then - LB(1:1) = lbound(SrcMiscData%UDiff, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UDiff, kind=B8Ki) - if (.not. allocated(DstMiscData%UDiff)) then - allocate(DstMiscData%UDiff(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UDiff.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UDiff = SrcMiscData%UDiff - end if - DstMiscData%ConvWarn = SrcMiscData%ConvWarn + call Glue_CopyTCMisc(SrcMiscData%TC, DstMiscData%TC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%ModDataAry)) then - LB(1:1) = lbound(MiscData%ModDataAry, kind=B8Ki) - UB(1:1) = ubound(MiscData%ModDataAry, kind=B8Ki) + if (allocated(MiscData%ModData)) then + LB(1:1) = lbound(MiscData%ModData, kind=B8Ki) + UB(1:1) = ubound(MiscData%ModData, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_DestroyModDataType(MiscData%ModDataAry(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModDataType(MiscData%ModData(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%ModDataAry) + deallocate(MiscData%ModData) end if if (allocated(MiscData%Mappings)) then LB(1:1) = lbound(MiscData%Mappings, kind=B8Ki) @@ -2082,94 +2123,24 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Glue_DestroyAeroMap(MiscData%AM, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%q)) then - deallocate(MiscData%q) - end if - if (allocated(MiscData%qn)) then - deallocate(MiscData%qn) - end if - if (allocated(MiscData%x)) then - deallocate(MiscData%x) - end if - if (allocated(MiscData%xn)) then - deallocate(MiscData%xn) - end if - if (allocated(MiscData%dxdt)) then - deallocate(MiscData%dxdt) - end if - if (allocated(MiscData%u)) then - deallocate(MiscData%u) - end if - if (allocated(MiscData%un)) then - deallocate(MiscData%un) - end if - if (allocated(MiscData%u_tmp)) then - deallocate(MiscData%u_tmp) - end if - if (allocated(MiscData%y)) then - deallocate(MiscData%y) - end if - if (allocated(MiscData%dYdx)) then - deallocate(MiscData%dYdx) - end if - if (allocated(MiscData%dYdu)) then - deallocate(MiscData%dYdu) - end if - if (allocated(MiscData%dXdx)) then - deallocate(MiscData%dXdx) - end if - if (allocated(MiscData%dXdu)) then - deallocate(MiscData%dXdu) - end if - if (allocated(MiscData%dUdu)) then - deallocate(MiscData%dUdu) - end if - if (allocated(MiscData%dUdy)) then - deallocate(MiscData%dUdy) - end if - if (allocated(MiscData%dUdyHat)) then - deallocate(MiscData%dUdyHat) - end if - if (allocated(MiscData%XB)) then - deallocate(MiscData%XB) - end if - if (allocated(MiscData%G)) then - deallocate(MiscData%G) - end if - if (allocated(MiscData%Jac)) then - deallocate(MiscData%Jac) - end if - if (allocated(MiscData%IPIV)) then - deallocate(MiscData%IPIV) - end if - if (allocated(MiscData%dq)) then - deallocate(MiscData%dq) - end if - if (allocated(MiscData%dx)) then - deallocate(MiscData%dx) - end if - if (allocated(MiscData%du)) then - deallocate(MiscData%du) - end if - if (allocated(MiscData%UDiff)) then - deallocate(MiscData%UDiff) - end if + call Glue_DestroyTCMisc(MiscData%TC, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Glue_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(Glue_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%ModDataAry)) - if (allocated(InData%ModDataAry)) then - call RegPackBounds(RF, 1, lbound(InData%ModDataAry, kind=B8Ki), ubound(InData%ModDataAry, kind=B8Ki)) - LB(1:1) = lbound(InData%ModDataAry, kind=B8Ki) - UB(1:1) = ubound(InData%ModDataAry, kind=B8Ki) + call RegPack(RF, allocated(InData%ModData)) + if (allocated(InData%ModData)) then + call RegPackBounds(RF, 1, lbound(InData%ModData, kind=B8Ki), ubound(InData%ModData, kind=B8Ki)) + LB(1:1) = lbound(InData%ModData, kind=B8Ki) + UB(1:1) = ubound(InData%ModData, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackModDataType(RF, InData%ModDataAry(i1)) + call NWTC_Library_PackModDataType(RF, InData%ModData(i1)) end do end if call RegPack(RF, allocated(InData%Mappings)) @@ -2185,34 +2156,7 @@ subroutine Glue_PackMisc(RF, Indata) call Glue_PackLinMisc(RF, InData%Lin) call Glue_PackCalcSteady(RF, InData%CS) call Glue_PackAeroMap(RF, InData%AM) - call RegPackAlloc(RF, InData%q) - call RegPackAlloc(RF, InData%qn) - call RegPackAlloc(RF, InData%x) - call RegPackAlloc(RF, InData%xn) - call RegPackAlloc(RF, InData%dxdt) - call RegPackAlloc(RF, InData%u) - call RegPackAlloc(RF, InData%un) - call RegPackAlloc(RF, InData%u_tmp) - call RegPackAlloc(RF, InData%y) - call RegPackAlloc(RF, InData%dYdx) - call RegPackAlloc(RF, InData%dYdu) - call RegPackAlloc(RF, InData%dXdx) - call RegPackAlloc(RF, InData%dXdu) - call RegPackAlloc(RF, InData%dUdu) - call RegPackAlloc(RF, InData%dUdy) - call RegPackAlloc(RF, InData%dUdyHat) - call RegPackAlloc(RF, InData%XB) - call RegPackAlloc(RF, InData%G) - call RegPackAlloc(RF, InData%Jac) - call RegPackAlloc(RF, InData%IPIV) - call RegPack(RF, InData%IterTotal) - call RegPack(RF, InData%IterUntilUJac) - call RegPack(RF, InData%StepsUntilUJac) - call RegPackAlloc(RF, InData%dq) - call RegPackAlloc(RF, InData%dx) - call RegPackAlloc(RF, InData%du) - call RegPackAlloc(RF, InData%UDiff) - call RegPack(RF, InData%ConvWarn) + call Glue_PackTCMisc(RF, InData%TC) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2220,22 +2164,22 @@ subroutine Glue_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Glue_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%ModDataAry)) deallocate(OutData%ModDataAry) + if (allocated(OutData%ModData)) deallocate(OutData%ModData) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%ModDataAry(LB(1):UB(1)),stat=stat) + allocate(OutData%ModData(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModDataAry.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModData.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackModDataType(RF, OutData%ModDataAry(i1)) ! ModDataAry + call NWTC_Library_UnpackModDataType(RF, OutData%ModData(i1)) ! ModData end do end if if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) @@ -2255,34 +2199,7 @@ subroutine Glue_UnPackMisc(RF, OutData) call Glue_UnpackLinMisc(RF, OutData%Lin) ! Lin call Glue_UnpackCalcSteady(RF, OutData%CS) ! CS call Glue_UnpackAeroMap(RF, OutData%AM) ! AM - call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%qn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dxdt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%un); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u_tmp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dUdyHat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%XB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%G); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%IPIV); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IterTotal); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IterUntilUJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%StepsUntilUJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UDiff); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return + call Glue_UnpackTCMisc(RF, OutData%TC) ! TC end subroutine END MODULE Glue_Types diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index faf1af8752..39f54bba09 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -1762,7 +1762,7 @@ void gen_var_routines(std::ostream &w, const Module &mod) // Vars packing routine //-------------------------------- - std::string routine_name = mod.nickname + "_Pack" + short_type + "Ary"; + std::string routine_name = mod.nickname + "_VarsPack" + short_type; std::string indent("\n"); w << indent << "subroutine " << routine_name << "(Vars, " << abbr << ", ValAry)"; indent += " "; @@ -1771,8 +1771,22 @@ void gen_var_routines(std::ostream &w, const Module &mod) w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; w << indent << "integer(IntKi) :: i"; w << indent << "do i = 1, size(Vars%" << abbr << ")"; + w << indent << " call " << mod.nickname + "_VarPack" + short_type + "(Vars%" << abbr << "(i), " << abbr << ", ValAry)"; + w << indent << "end do"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + //-------------------------------- + // Var packing routine + //-------------------------------- + + w << indent << "subroutine " << mod.nickname + "_VarPack" + short_type + "(V, " << abbr << ", ValAry)"; indent += " "; - w << indent << "associate (V => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; + w << indent << "type(ModVarType), intent(in) :: V"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(in) " << ":: " << abbr; + w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; + w << indent << "associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2)))"; indent += " "; w << indent << "select case (DL%Num)"; for (const auto &field : fields) @@ -1793,47 +1807,48 @@ void gen_var_routines(std::ostream &w, const Module &mod) { // This is a hack to convert BeamDyn's WM orientations to quaternions w << indent << " if (V%Field == FieldOrientation) then"; - w << indent << " ValAry(V%iLoc(1):V%iLoc(2)) = wm_to_quat(wm_inv(x%q(4:6, V%jAry))) ! Convert WM parameters to quaternions"; + w << indent << " VarVals = wm_to_quat(wm_inv(x%q(4:6, V%j))) ! Convert WM parameters to quaternions"; w << indent << " else"; - w << indent << std::setw(71) << " call MV_Pack(V, " + field_path + "(V%iAry(1):V%iAry(2),V%jAry), ValAry) " << "! " + comment; + w << indent << std::setw(71) << " VarVals = " + field_path + "(V%iLB:V%iUB,V%j)" << "! " + comment; w << indent << " end if"; } else if (field.data_type->tag == DataType::Tag::Derived) { - w << indent << std::setw(71) << " call MV_Pack(V, " + field_path + ", ValAry)" << "! Mesh"; + w << indent << std::setw(71) <<" call MV_PackMesh(V, " + field_path + ", ValAry)" << " ! Mesh"; } else { - std::string tmp{" call MV_Pack(V, " + field_path}; + std::string tmp; switch (field.rank) { + case 0: + tmp = "VarVals(1) = " + field_path; + break; case 1: - tmp += "(V%iAry(1):V%iAry(2))"; + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB)"; break; case 2: - tmp += "(V%iAry(1):V%iAry(2),V%jAry)"; + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB,V%j)"; break; case 3: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry)"; + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB, V%j, V%k)"; break; case 4: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)"; + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB, V%j, V%k, V%m)"; break; case 5: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)"; + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB, V%j, V%k, V%m, V%n)"; break; } - w << indent << std::setw(71) << tmp + ", ValAry) " << "! " + comment; + w << indent << std::setw(71) << " " + tmp << " ! " + comment; } } w << indent << "case default"; - w << indent << " ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki"; + w << indent << " VarVals = 0.0_R8Ki"; w << indent << "end select"; indent.erase(indent.size() - 3); w << indent << "end associate"; indent.erase(indent.size() - 3); - w << indent << "end do"; - indent.erase(indent.size() - 3); w << indent << "end subroutine"; w << indent; @@ -1849,7 +1864,7 @@ void gen_var_routines(std::ostream &w, const Module &mod) //-------------------------------- indent = "\n"; - routine_name = mod.nickname + "_Unpack" + short_type + "Ary"; + routine_name = mod.nickname + "_VarsUnpack" + short_type; w << indent << "subroutine " << routine_name << "(Vars, ValAry, " << abbr << ")"; indent += " "; w << indent << "type(ModVarsType), intent(in) :: Vars"; @@ -1857,8 +1872,22 @@ void gen_var_routines(std::ostream &w, const Module &mod) w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(inout) " << ":: " + abbr; w << indent << "integer(IntKi) :: i"; w << indent << "do i = 1, size(Vars%" << abbr << ")"; + w << indent << " call " << mod.nickname + "_VarUnpack" + short_type + "(Vars%" << abbr << "(i), ValAry, " << abbr << ")"; + w << indent << "end do"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + //-------------------------------- + // Var unpacking routine + //-------------------------------- + + w << indent << "subroutine " << mod.nickname + "_VarUnpack" + short_type + "(V, ValAry, " << abbr << ")"; indent += " "; - w << indent << "associate (V => Vars%" << abbr << "(i), DL => Vars%" << abbr << "(i)%DL)"; + w << indent << "type(ModVarType), intent(in) :: V"; + w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(inout) " << ":: " << abbr; + w << indent << "associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2)))"; indent += " "; w << indent << "select case (DL%Num)"; for (const auto &field : fields) @@ -1874,45 +1903,46 @@ void gen_var_routines(std::ostream &w, const Module &mod) { // This is a hack to convert BeamDyn's WM orientations to quaternions w << indent << " if (V%Field == FieldOrientation) then"; - w << indent << " x%q(4:6, V%jAry) = wm_inv(quat_to_wm(ValAry(V%iLoc(1):V%iLoc(2)))) ! Convert quaternion to WM parameters"; + w << indent << " x%q(4:6, V%j) = wm_inv(quat_to_wm(VarVals)) ! Convert quaternion to WM parameters"; w << indent << " else"; - w << indent << std::setw(71) << " call MV_Unpack(V, ValAry, " + field_path + "(V%iAry(1):V%iAry(2),V%jAry)) " << "! Rank 2 Array"; + w << indent << std::setw(71) << " " + field_path + "(V%iLB:V%iUB, V%j) = VarVals" << " ! Rank 2 Array"; w << indent << " end if"; } else if (field.data_type->tag == DataType::Tag::Derived) { - w << indent << std::setw(71) << " call MV_Unpack(V, ValAry, " + field_path + ") " << "! Mesh"; + w << indent << std::setw(71) <<" call MV_UnpackMesh(V, ValAry, " + field_path + ")" << " ! Mesh"; } else { - std::string tmp{" call MV_Unpack(V, ValAry, " + field_path}; + std::string tmp; switch (field.rank) { + case 0: + tmp = field_path + " = VarVals(1)"; + break; case 1: - tmp += "(V%iAry(1):V%iAry(2))"; + tmp = field_path + "(V%iLB:V%iUB) = VarVals"; break; case 2: - tmp += "(V%iAry(1):V%iAry(2),V%jAry)"; + tmp = field_path + "(V%iLB:V%iUB, V%j) = VarVals"; break; case 3: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry)"; + tmp = field_path + "(V%iLB:V%iUB, V%j, V%k) = VarVals"; break; case 4: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry)"; + tmp = field_path + "(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals"; break; case 5: - tmp += "(V%iAry(1):V%iAry(2), V%jAry, V%kAry, V%mAry, V%nAry)"; + tmp = field_path + "(V%iLB:V%iUB, V%j, V%k, V%m, V%n) = VarVals"; break; } - w << indent << std::setw(71) << tmp + ") " << "! " + comment; + w << indent << std::setw(71) << " " + tmp << " ! " + comment; } } w << indent << "end select"; indent.erase(indent.size() - 3); w << indent << "end associate"; indent.erase(indent.size() - 3); - w << indent << "end do"; - indent.erase(indent.size() - 3); w << indent << "end subroutine"; w << indent; diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index af52f3778c..fa335d6bfd 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -1180,38 +1180,52 @@ function Orca_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine Orca_PackContStateAry(Vars, x, ValAry) +subroutine Orca_VarsPackContState(Vars, x, ValAry) type(Orca_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Orca_x_Dummy) - call MV_Pack(V, x%Dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Orca_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine Orca_UnpackContStateAry(Vars, ValAry, x) +subroutine Orca_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_x_Dummy) + VarVals(1) = x%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Orca_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Orca_x_Dummy) - call MV_Unpack(V, ValAry, x%Dummy) ! Scalar - end select - end associate + call Orca_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine Orca_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_x_Dummy) + x%Dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Orca_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1223,55 +1237,76 @@ function Orca_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine Orca_PackContStateDerivAry(Vars, x, ValAry) +subroutine Orca_VarsPackContStateDeriv(Vars, x, ValAry) type(Orca_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (Orca_x_Dummy) - call MV_Pack(V, x%Dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Orca_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine Orca_PackConstrStateAry(Vars, z, ValAry) +subroutine Orca_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_x_Dummy) + VarVals(1) = x%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsPackConstrState(Vars, z, ValAry) type(Orca_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (Orca_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Orca_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine Orca_UnpackConstrStateAry(Vars, ValAry, z) +subroutine Orca_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Orca_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (Orca_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call Orca_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine Orca_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function Orca_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1283,38 +1318,52 @@ function Orca_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine Orca_PackInputAry(Vars, u, ValAry) +subroutine Orca_VarsPackInput(Vars, u, ValAry) type(Orca_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (Orca_u_PtfmMesh) - call MV_Pack(V, u%PtfmMesh, ValAry) ! Mesh - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Orca_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine Orca_UnpackInputAry(Vars, ValAry, u) +subroutine Orca_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_u_PtfmMesh) + call MV_PackMesh(V, u%PtfmMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Orca_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (Orca_u_PtfmMesh) - call MV_Unpack(V, ValAry, u%PtfmMesh) ! Mesh - end select - end associate + call Orca_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine Orca_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_u_PtfmMesh) + call MV_UnpackMesh(V, ValAry, u%PtfmMesh) ! Mesh + end select + end associate +end subroutine + function Orca_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1326,42 +1375,56 @@ function Orca_InputFieldName(DL) result(Name) end select end function -subroutine Orca_PackOutputAry(Vars, y, ValAry) +subroutine Orca_VarsPackOutput(Vars, y, ValAry) type(Orca_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (Orca_y_PtfmMesh) - call MV_Pack(V, y%PtfmMesh, ValAry) ! Mesh - case (Orca_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call Orca_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine Orca_UnpackOutputAry(Vars, ValAry, y) +subroutine Orca_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_y_PtfmMesh) + call MV_PackMesh(V, y%PtfmMesh, ValAry) ! Mesh + case (Orca_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(Orca_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (Orca_y_PtfmMesh) - call MV_Unpack(V, ValAry, y%PtfmMesh) ! Mesh - case (Orca_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call Orca_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine Orca_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_y_PtfmMesh) + call MV_UnpackMesh(V, ValAry, y%PtfmMesh) ! Mesh + case (Orca_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function Orca_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 80d24ef51a..d023c8db99 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -1332,38 +1332,52 @@ function SeaSt_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine SeaSt_PackContStateAry(Vars, x, ValAry) +subroutine SeaSt_VarsPackContState(Vars, x, ValAry) type(SeaSt_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SeaSt_x_UnusedStates) - call MV_Pack(V, x%UnusedStates, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SeaSt_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine SeaSt_UnpackContStateAry(Vars, ValAry, x) +subroutine SeaSt_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + VarVals(1) = x%UnusedStates ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SeaSt_x_UnusedStates) - call MV_Unpack(V, ValAry, x%UnusedStates) ! Scalar - end select - end associate + call SeaSt_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine SeaSt_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + x%UnusedStates = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SeaSt_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1375,55 +1389,76 @@ function SeaSt_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine SeaSt_PackContStateDerivAry(Vars, x, ValAry) +subroutine SeaSt_VarsPackContStateDeriv(Vars, x, ValAry) type(SeaSt_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SeaSt_x_UnusedStates) - call MV_Pack(V, x%UnusedStates, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SeaSt_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine SeaSt_PackConstrStateAry(Vars, z, ValAry) +subroutine SeaSt_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + VarVals(1) = x%UnusedStates ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsPackConstrState(Vars, z, ValAry) type(SeaSt_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SeaSt_z_UnusedStates) - call MV_Pack(V, z%UnusedStates, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SeaSt_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine SeaSt_UnpackConstrStateAry(Vars, ValAry, z) +subroutine SeaSt_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_z_UnusedStates) + VarVals(1) = z%UnusedStates ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SeaSt_z_UnusedStates) - call MV_Unpack(V, ValAry, z%UnusedStates) ! Scalar - end select - end associate + call SeaSt_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine SeaSt_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_z_UnusedStates) + z%UnusedStates = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SeaSt_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1435,38 +1470,52 @@ function SeaSt_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine SeaSt_PackInputAry(Vars, u, ValAry) +subroutine SeaSt_VarsPackInput(Vars, u, ValAry) type(SeaSt_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SeaSt_u_DummyInput) - call MV_Pack(V, u%DummyInput, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SeaSt_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine SeaSt_UnpackInputAry(Vars, ValAry, u) +subroutine SeaSt_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_u_DummyInput) + VarVals(1) = u%DummyInput ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SeaSt_u_DummyInput) - call MV_Unpack(V, ValAry, u%DummyInput) ! Scalar - end select - end associate + call SeaSt_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine SeaSt_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_u_DummyInput) + u%DummyInput = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SeaSt_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1478,38 +1527,52 @@ function SeaSt_InputFieldName(DL) result(Name) end select end function -subroutine SeaSt_PackOutputAry(Vars, y, ValAry) +subroutine SeaSt_VarsPackOutput(Vars, y, ValAry) type(SeaSt_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SeaSt_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SeaSt_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine SeaSt_UnpackOutputAry(Vars, ValAry, y) +subroutine SeaSt_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SeaSt_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SeaSt_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SeaSt_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine SeaSt_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SeaSt_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 0b8d4cb5fb..b96c39d82e 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -7250,54 +7250,68 @@ function SrvD_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine SrvD_PackContStateAry(Vars, x, ValAry) +subroutine SrvD_VarsPackContState(Vars, x, ValAry) type(SrvD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SrvD_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case (SrvD_x_BStC_StC_x) - call MV_Pack(V, x%BStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (SrvD_x_NStC_StC_x) - call MV_Pack(V, x%NStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (SrvD_x_TStC_StC_x) - call MV_Pack(V, x%TStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (SrvD_x_SStC_StC_x) - call MV_Pack(V, x%SStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SrvD_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine SrvD_UnpackContStateAry(Vars, ValAry, x) +subroutine SrvD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case (SrvD_x_BStC_StC_x) + VarVals = x%BStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + VarVals = x%NStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + VarVals = x%TStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + VarVals = x%SStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SrvD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SrvD_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - case (SrvD_x_BStC_StC_x) - call MV_Unpack(V, ValAry, x%BStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (SrvD_x_NStC_StC_x) - call MV_Unpack(V, ValAry, x%NStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (SrvD_x_TStC_StC_x) - call MV_Unpack(V, ValAry, x%TStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (SrvD_x_SStC_StC_x) - call MV_Unpack(V, ValAry, x%SStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call SrvD_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine SrvD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + case (SrvD_x_BStC_StC_x) + x%BStC(DL%i1)%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + x%NStC(DL%i1)%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + x%TStC(DL%i1)%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + x%SStC(DL%i1)%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function SrvD_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -7317,79 +7331,100 @@ function SrvD_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine SrvD_PackContStateDerivAry(Vars, x, ValAry) +subroutine SrvD_VarsPackContStateDeriv(Vars, x, ValAry) type(SrvD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SrvD_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case (SrvD_x_BStC_StC_x) - call MV_Pack(V, x%BStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (SrvD_x_NStC_StC_x) - call MV_Pack(V, x%NStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (SrvD_x_TStC_StC_x) - call MV_Pack(V, x%TStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (SrvD_x_SStC_StC_x) - call MV_Pack(V, x%SStC(DL%i1)%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SrvD_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine SrvD_PackConstrStateAry(Vars, z, ValAry) +subroutine SrvD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case (SrvD_x_BStC_StC_x) + VarVals = x%BStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + VarVals = x%NStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + VarVals = x%TStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + VarVals = x%SStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsPackConstrState(Vars, z, ValAry) type(SrvD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SrvD_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_BStC_DummyConstrState) - call MV_Pack(V, z%BStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_NStC_DummyConstrState) - call MV_Pack(V, z%NStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_TStC_DummyConstrState) - call MV_Pack(V, z%TStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case (SrvD_z_SStC_DummyConstrState) - call MV_Pack(V, z%SStC(DL%i1)%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SrvD_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine SrvD_UnpackConstrStateAry(Vars, ValAry, z) +subroutine SrvD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case (SrvD_z_BStC_DummyConstrState) + VarVals(1) = z%BStC(DL%i1)%DummyConstrState ! Scalar + case (SrvD_z_NStC_DummyConstrState) + VarVals(1) = z%NStC(DL%i1)%DummyConstrState ! Scalar + case (SrvD_z_TStC_DummyConstrState) + VarVals(1) = z%TStC(DL%i1)%DummyConstrState ! Scalar + case (SrvD_z_SStC_DummyConstrState) + VarVals(1) = z%SStC(DL%i1)%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SrvD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SrvD_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - case (SrvD_z_BStC_DummyConstrState) - call MV_Unpack(V, ValAry, z%BStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_NStC_DummyConstrState) - call MV_Unpack(V, ValAry, z%NStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_TStC_DummyConstrState) - call MV_Unpack(V, ValAry, z%TStC(DL%i1)%DummyConstrState) ! Scalar - case (SrvD_z_SStC_DummyConstrState) - call MV_Unpack(V, ValAry, z%SStC(DL%i1)%DummyConstrState) ! Scalar - end select - end associate + call SrvD_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine SrvD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + case (SrvD_z_BStC_DummyConstrState) + z%BStC(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + case (SrvD_z_NStC_DummyConstrState) + z%NStC(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + case (SrvD_z_TStC_DummyConstrState) + z%TStC(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + case (SrvD_z_SStC_DummyConstrState) + z%SStC(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SrvD_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -7409,238 +7444,252 @@ function SrvD_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine SrvD_PackInputAry(Vars, u, ValAry) +subroutine SrvD_VarsPackInput(Vars, u, ValAry) type(SrvD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SrvD_u_BlPitch) - call MV_Pack(V, u%BlPitch(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_Yaw) - call MV_Pack(V, u%Yaw, ValAry) ! Scalar - case (SrvD_u_YawRate) - call MV_Pack(V, u%YawRate, ValAry) ! Scalar - case (SrvD_u_LSS_Spd) - call MV_Pack(V, u%LSS_Spd, ValAry) ! Scalar - case (SrvD_u_HSS_Spd) - call MV_Pack(V, u%HSS_Spd, ValAry) ! Scalar - case (SrvD_u_RotSpeed) - call MV_Pack(V, u%RotSpeed, ValAry) ! Scalar - case (SrvD_u_ExternalYawPosCom) - call MV_Pack(V, u%ExternalYawPosCom, ValAry) ! Scalar - case (SrvD_u_ExternalYawRateCom) - call MV_Pack(V, u%ExternalYawRateCom, ValAry) ! Scalar - case (SrvD_u_ExternalBlPitchCom) - call MV_Pack(V, u%ExternalBlPitchCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_ExternalGenTrq) - call MV_Pack(V, u%ExternalGenTrq, ValAry) ! Scalar - case (SrvD_u_ExternalElecPwr) - call MV_Pack(V, u%ExternalElecPwr, ValAry) ! Scalar - case (SrvD_u_ExternalHSSBrFrac) - call MV_Pack(V, u%ExternalHSSBrFrac, ValAry) ! Scalar - case (SrvD_u_ExternalBlAirfoilCom) - call MV_Pack(V, u%ExternalBlAirfoilCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaL) - call MV_Pack(V, u%ExternalCableDeltaL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaLdot) - call MV_Pack(V, u%ExternalCableDeltaLdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_TwrAccel) - call MV_Pack(V, u%TwrAccel, ValAry) ! Scalar - case (SrvD_u_YawErr) - call MV_Pack(V, u%YawErr, ValAry) ! Scalar - case (SrvD_u_WindDir) - call MV_Pack(V, u%WindDir, ValAry) ! Scalar - case (SrvD_u_RootMyc) - call MV_Pack(V, u%RootMyc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_YawBrTAxp) - call MV_Pack(V, u%YawBrTAxp, ValAry) ! Scalar - case (SrvD_u_YawBrTAyp) - call MV_Pack(V, u%YawBrTAyp, ValAry) ! Scalar - case (SrvD_u_LSSTipPxa) - call MV_Pack(V, u%LSSTipPxa, ValAry) ! Scalar - case (SrvD_u_RootMxc) - call MV_Pack(V, u%RootMxc(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_LSSTipMxa) - call MV_Pack(V, u%LSSTipMxa, ValAry) ! Scalar - case (SrvD_u_LSSTipMya) - call MV_Pack(V, u%LSSTipMya, ValAry) ! Scalar - case (SrvD_u_LSSTipMza) - call MV_Pack(V, u%LSSTipMza, ValAry) ! Scalar - case (SrvD_u_LSSTipMys) - call MV_Pack(V, u%LSSTipMys, ValAry) ! Scalar - case (SrvD_u_LSSTipMzs) - call MV_Pack(V, u%LSSTipMzs, ValAry) ! Scalar - case (SrvD_u_YawBrMyn) - call MV_Pack(V, u%YawBrMyn, ValAry) ! Scalar - case (SrvD_u_YawBrMzn) - call MV_Pack(V, u%YawBrMzn, ValAry) ! Scalar - case (SrvD_u_NcIMURAxs) - call MV_Pack(V, u%NcIMURAxs, ValAry) ! Scalar - case (SrvD_u_NcIMURAys) - call MV_Pack(V, u%NcIMURAys, ValAry) ! Scalar - case (SrvD_u_NcIMURAzs) - call MV_Pack(V, u%NcIMURAzs, ValAry) ! Scalar - case (SrvD_u_RotPwr) - call MV_Pack(V, u%RotPwr, ValAry) ! Scalar - case (SrvD_u_HorWindV) - call MV_Pack(V, u%HorWindV, ValAry) ! Scalar - case (SrvD_u_YawAngle) - call MV_Pack(V, u%YawAngle, ValAry) ! Scalar - case (SrvD_u_LSShftFxa) - call MV_Pack(V, u%LSShftFxa, ValAry) ! Scalar - case (SrvD_u_LSShftFys) - call MV_Pack(V, u%LSShftFys, ValAry) ! Scalar - case (SrvD_u_LSShftFzs) - call MV_Pack(V, u%LSShftFzs, ValAry) ! Scalar - case (SrvD_u_fromSC) - call MV_Pack(V, u%fromSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_fromSCglob) - call MV_Pack(V, u%fromSCglob(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_Lidar) - call MV_Pack(V, u%Lidar(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_PtfmMotionMesh) - call MV_Pack(V, u%PtfmMotionMesh, ValAry) ! Mesh - case (SrvD_u_BStCMotionMesh) - call MV_Pack(V, u%BStCMotionMesh(DL%i1, DL%i2), ValAry) ! Mesh - case (SrvD_u_NStCMotionMesh) - call MV_Pack(V, u%NStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_TStCMotionMesh) - call MV_Pack(V, u%TStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_SStCMotionMesh) - call MV_Pack(V, u%SStCMotionMesh(DL%i1), ValAry) ! Mesh - case (SrvD_u_LidSpeed) - call MV_Pack(V, u%LidSpeed(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsX) - call MV_Pack(V, u%MsrPositionsX(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsY) - call MV_Pack(V, u%MsrPositionsY(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_u_MsrPositionsZ) - call MV_Pack(V, u%MsrPositionsZ(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SrvD_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine SrvD_UnpackInputAry(Vars, ValAry, u) +subroutine SrvD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_u_BlPitch) + VarVals = u%BlPitch(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_Yaw) + VarVals(1) = u%Yaw ! Scalar + case (SrvD_u_YawRate) + VarVals(1) = u%YawRate ! Scalar + case (SrvD_u_LSS_Spd) + VarVals(1) = u%LSS_Spd ! Scalar + case (SrvD_u_HSS_Spd) + VarVals(1) = u%HSS_Spd ! Scalar + case (SrvD_u_RotSpeed) + VarVals(1) = u%RotSpeed ! Scalar + case (SrvD_u_ExternalYawPosCom) + VarVals(1) = u%ExternalYawPosCom ! Scalar + case (SrvD_u_ExternalYawRateCom) + VarVals(1) = u%ExternalYawRateCom ! Scalar + case (SrvD_u_ExternalBlPitchCom) + VarVals = u%ExternalBlPitchCom(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + VarVals(1) = u%ExternalGenTrq ! Scalar + case (SrvD_u_ExternalElecPwr) + VarVals(1) = u%ExternalElecPwr ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + VarVals(1) = u%ExternalHSSBrFrac ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + VarVals = u%ExternalBlAirfoilCom(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + VarVals = u%ExternalCableDeltaL(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + VarVals = u%ExternalCableDeltaLdot(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_TwrAccel) + VarVals(1) = u%TwrAccel ! Scalar + case (SrvD_u_YawErr) + VarVals(1) = u%YawErr ! Scalar + case (SrvD_u_WindDir) + VarVals(1) = u%WindDir ! Scalar + case (SrvD_u_RootMyc) + VarVals = u%RootMyc(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + VarVals(1) = u%YawBrTAxp ! Scalar + case (SrvD_u_YawBrTAyp) + VarVals(1) = u%YawBrTAyp ! Scalar + case (SrvD_u_LSSTipPxa) + VarVals(1) = u%LSSTipPxa ! Scalar + case (SrvD_u_RootMxc) + VarVals = u%RootMxc(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + VarVals(1) = u%LSSTipMxa ! Scalar + case (SrvD_u_LSSTipMya) + VarVals(1) = u%LSSTipMya ! Scalar + case (SrvD_u_LSSTipMza) + VarVals(1) = u%LSSTipMza ! Scalar + case (SrvD_u_LSSTipMys) + VarVals(1) = u%LSSTipMys ! Scalar + case (SrvD_u_LSSTipMzs) + VarVals(1) = u%LSSTipMzs ! Scalar + case (SrvD_u_YawBrMyn) + VarVals(1) = u%YawBrMyn ! Scalar + case (SrvD_u_YawBrMzn) + VarVals(1) = u%YawBrMzn ! Scalar + case (SrvD_u_NcIMURAxs) + VarVals(1) = u%NcIMURAxs ! Scalar + case (SrvD_u_NcIMURAys) + VarVals(1) = u%NcIMURAys ! Scalar + case (SrvD_u_NcIMURAzs) + VarVals(1) = u%NcIMURAzs ! Scalar + case (SrvD_u_RotPwr) + VarVals(1) = u%RotPwr ! Scalar + case (SrvD_u_HorWindV) + VarVals(1) = u%HorWindV ! Scalar + case (SrvD_u_YawAngle) + VarVals(1) = u%YawAngle ! Scalar + case (SrvD_u_LSShftFxa) + VarVals(1) = u%LSShftFxa ! Scalar + case (SrvD_u_LSShftFys) + VarVals(1) = u%LSShftFys ! Scalar + case (SrvD_u_LSShftFzs) + VarVals(1) = u%LSShftFzs ! Scalar + case (SrvD_u_fromSC) + VarVals = u%fromSC(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_fromSCglob) + VarVals = u%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_Lidar) + VarVals = u%Lidar(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_PackMesh(V, u%PtfmMotionMesh, ValAry) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_PackMesh(V, u%BStCMotionMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_PackMesh(V, u%NStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_PackMesh(V, u%TStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_PackMesh(V, u%SStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_LidSpeed) + VarVals = u%LidSpeed(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + VarVals = u%MsrPositionsX(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + VarVals = u%MsrPositionsY(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + VarVals = u%MsrPositionsZ(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SrvD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SrvD_u_BlPitch) - call MV_Unpack(V, ValAry, u%BlPitch(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_Yaw) - call MV_Unpack(V, ValAry, u%Yaw) ! Scalar - case (SrvD_u_YawRate) - call MV_Unpack(V, ValAry, u%YawRate) ! Scalar - case (SrvD_u_LSS_Spd) - call MV_Unpack(V, ValAry, u%LSS_Spd) ! Scalar - case (SrvD_u_HSS_Spd) - call MV_Unpack(V, ValAry, u%HSS_Spd) ! Scalar - case (SrvD_u_RotSpeed) - call MV_Unpack(V, ValAry, u%RotSpeed) ! Scalar - case (SrvD_u_ExternalYawPosCom) - call MV_Unpack(V, ValAry, u%ExternalYawPosCom) ! Scalar - case (SrvD_u_ExternalYawRateCom) - call MV_Unpack(V, ValAry, u%ExternalYawRateCom) ! Scalar - case (SrvD_u_ExternalBlPitchCom) - call MV_Unpack(V, ValAry, u%ExternalBlPitchCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_ExternalGenTrq) - call MV_Unpack(V, ValAry, u%ExternalGenTrq) ! Scalar - case (SrvD_u_ExternalElecPwr) - call MV_Unpack(V, ValAry, u%ExternalElecPwr) ! Scalar - case (SrvD_u_ExternalHSSBrFrac) - call MV_Unpack(V, ValAry, u%ExternalHSSBrFrac) ! Scalar - case (SrvD_u_ExternalBlAirfoilCom) - call MV_Unpack(V, ValAry, u%ExternalBlAirfoilCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaL) - call MV_Unpack(V, ValAry, u%ExternalCableDeltaL(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_ExternalCableDeltaLdot) - call MV_Unpack(V, ValAry, u%ExternalCableDeltaLdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_TwrAccel) - call MV_Unpack(V, ValAry, u%TwrAccel) ! Scalar - case (SrvD_u_YawErr) - call MV_Unpack(V, ValAry, u%YawErr) ! Scalar - case (SrvD_u_WindDir) - call MV_Unpack(V, ValAry, u%WindDir) ! Scalar - case (SrvD_u_RootMyc) - call MV_Unpack(V, ValAry, u%RootMyc(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_YawBrTAxp) - call MV_Unpack(V, ValAry, u%YawBrTAxp) ! Scalar - case (SrvD_u_YawBrTAyp) - call MV_Unpack(V, ValAry, u%YawBrTAyp) ! Scalar - case (SrvD_u_LSSTipPxa) - call MV_Unpack(V, ValAry, u%LSSTipPxa) ! Scalar - case (SrvD_u_RootMxc) - call MV_Unpack(V, ValAry, u%RootMxc(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_LSSTipMxa) - call MV_Unpack(V, ValAry, u%LSSTipMxa) ! Scalar - case (SrvD_u_LSSTipMya) - call MV_Unpack(V, ValAry, u%LSSTipMya) ! Scalar - case (SrvD_u_LSSTipMza) - call MV_Unpack(V, ValAry, u%LSSTipMza) ! Scalar - case (SrvD_u_LSSTipMys) - call MV_Unpack(V, ValAry, u%LSSTipMys) ! Scalar - case (SrvD_u_LSSTipMzs) - call MV_Unpack(V, ValAry, u%LSSTipMzs) ! Scalar - case (SrvD_u_YawBrMyn) - call MV_Unpack(V, ValAry, u%YawBrMyn) ! Scalar - case (SrvD_u_YawBrMzn) - call MV_Unpack(V, ValAry, u%YawBrMzn) ! Scalar - case (SrvD_u_NcIMURAxs) - call MV_Unpack(V, ValAry, u%NcIMURAxs) ! Scalar - case (SrvD_u_NcIMURAys) - call MV_Unpack(V, ValAry, u%NcIMURAys) ! Scalar - case (SrvD_u_NcIMURAzs) - call MV_Unpack(V, ValAry, u%NcIMURAzs) ! Scalar - case (SrvD_u_RotPwr) - call MV_Unpack(V, ValAry, u%RotPwr) ! Scalar - case (SrvD_u_HorWindV) - call MV_Unpack(V, ValAry, u%HorWindV) ! Scalar - case (SrvD_u_YawAngle) - call MV_Unpack(V, ValAry, u%YawAngle) ! Scalar - case (SrvD_u_LSShftFxa) - call MV_Unpack(V, ValAry, u%LSShftFxa) ! Scalar - case (SrvD_u_LSShftFys) - call MV_Unpack(V, ValAry, u%LSShftFys) ! Scalar - case (SrvD_u_LSShftFzs) - call MV_Unpack(V, ValAry, u%LSShftFzs) ! Scalar - case (SrvD_u_fromSC) - call MV_Unpack(V, ValAry, u%fromSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_fromSCglob) - call MV_Unpack(V, ValAry, u%fromSCglob(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_Lidar) - call MV_Unpack(V, ValAry, u%Lidar(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_PtfmMotionMesh) - call MV_Unpack(V, ValAry, u%PtfmMotionMesh) ! Mesh - case (SrvD_u_BStCMotionMesh) - call MV_Unpack(V, ValAry, u%BStCMotionMesh(DL%i1, DL%i2)) ! Mesh - case (SrvD_u_NStCMotionMesh) - call MV_Unpack(V, ValAry, u%NStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_TStCMotionMesh) - call MV_Unpack(V, ValAry, u%TStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_SStCMotionMesh) - call MV_Unpack(V, ValAry, u%SStCMotionMesh(DL%i1)) ! Mesh - case (SrvD_u_LidSpeed) - call MV_Unpack(V, ValAry, u%LidSpeed(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_MsrPositionsX) - call MV_Unpack(V, ValAry, u%MsrPositionsX(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_MsrPositionsY) - call MV_Unpack(V, ValAry, u%MsrPositionsY(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_u_MsrPositionsZ) - call MV_Unpack(V, ValAry, u%MsrPositionsZ(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SrvD_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine SrvD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_u_BlPitch) + u%BlPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_Yaw) + u%Yaw = VarVals(1) ! Scalar + case (SrvD_u_YawRate) + u%YawRate = VarVals(1) ! Scalar + case (SrvD_u_LSS_Spd) + u%LSS_Spd = VarVals(1) ! Scalar + case (SrvD_u_HSS_Spd) + u%HSS_Spd = VarVals(1) ! Scalar + case (SrvD_u_RotSpeed) + u%RotSpeed = VarVals(1) ! Scalar + case (SrvD_u_ExternalYawPosCom) + u%ExternalYawPosCom = VarVals(1) ! Scalar + case (SrvD_u_ExternalYawRateCom) + u%ExternalYawRateCom = VarVals(1) ! Scalar + case (SrvD_u_ExternalBlPitchCom) + u%ExternalBlPitchCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + u%ExternalGenTrq = VarVals(1) ! Scalar + case (SrvD_u_ExternalElecPwr) + u%ExternalElecPwr = VarVals(1) ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + u%ExternalHSSBrFrac = VarVals(1) ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + u%ExternalBlAirfoilCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + u%ExternalCableDeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + u%ExternalCableDeltaLdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_TwrAccel) + u%TwrAccel = VarVals(1) ! Scalar + case (SrvD_u_YawErr) + u%YawErr = VarVals(1) ! Scalar + case (SrvD_u_WindDir) + u%WindDir = VarVals(1) ! Scalar + case (SrvD_u_RootMyc) + u%RootMyc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + u%YawBrTAxp = VarVals(1) ! Scalar + case (SrvD_u_YawBrTAyp) + u%YawBrTAyp = VarVals(1) ! Scalar + case (SrvD_u_LSSTipPxa) + u%LSSTipPxa = VarVals(1) ! Scalar + case (SrvD_u_RootMxc) + u%RootMxc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + u%LSSTipMxa = VarVals(1) ! Scalar + case (SrvD_u_LSSTipMya) + u%LSSTipMya = VarVals(1) ! Scalar + case (SrvD_u_LSSTipMza) + u%LSSTipMza = VarVals(1) ! Scalar + case (SrvD_u_LSSTipMys) + u%LSSTipMys = VarVals(1) ! Scalar + case (SrvD_u_LSSTipMzs) + u%LSSTipMzs = VarVals(1) ! Scalar + case (SrvD_u_YawBrMyn) + u%YawBrMyn = VarVals(1) ! Scalar + case (SrvD_u_YawBrMzn) + u%YawBrMzn = VarVals(1) ! Scalar + case (SrvD_u_NcIMURAxs) + u%NcIMURAxs = VarVals(1) ! Scalar + case (SrvD_u_NcIMURAys) + u%NcIMURAys = VarVals(1) ! Scalar + case (SrvD_u_NcIMURAzs) + u%NcIMURAzs = VarVals(1) ! Scalar + case (SrvD_u_RotPwr) + u%RotPwr = VarVals(1) ! Scalar + case (SrvD_u_HorWindV) + u%HorWindV = VarVals(1) ! Scalar + case (SrvD_u_YawAngle) + u%YawAngle = VarVals(1) ! Scalar + case (SrvD_u_LSShftFxa) + u%LSShftFxa = VarVals(1) ! Scalar + case (SrvD_u_LSShftFys) + u%LSShftFys = VarVals(1) ! Scalar + case (SrvD_u_LSShftFzs) + u%LSShftFzs = VarVals(1) ! Scalar + case (SrvD_u_fromSC) + u%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_fromSCglob) + u%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_Lidar) + u%Lidar(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_UnpackMesh(V, ValAry, u%PtfmMotionMesh) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_UnpackMesh(V, ValAry, u%BStCMotionMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_UnpackMesh(V, ValAry, u%NStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_UnpackMesh(V, ValAry, u%TStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_UnpackMesh(V, ValAry, u%SStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_LidSpeed) + u%LidSpeed(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + u%MsrPositionsX(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + u%MsrPositionsY(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + u%MsrPositionsZ(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SrvD_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -7752,98 +7801,112 @@ function SrvD_InputFieldName(DL) result(Name) end select end function -subroutine SrvD_PackOutputAry(Vars, y, ValAry) +subroutine SrvD_VarsPackOutput(Vars, y, ValAry) type(SrvD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SrvD_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_y_BlPitchCom) - call MV_Pack(V, y%BlPitchCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_y_BlAirfoilCom) - call MV_Pack(V, y%BlAirfoilCom(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_y_YawMom) - call MV_Pack(V, y%YawMom, ValAry) ! Scalar - case (SrvD_y_GenTrq) - call MV_Pack(V, y%GenTrq, ValAry) ! Scalar - case (SrvD_y_HSSBrTrqC) - call MV_Pack(V, y%HSSBrTrqC, ValAry) ! Scalar - case (SrvD_y_ElecPwr) - call MV_Pack(V, y%ElecPwr, ValAry) ! Scalar - case (SrvD_y_TBDrCon) - call MV_Pack(V, y%TBDrCon(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_y_Lidar) - call MV_Pack(V, y%Lidar(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_y_CableDeltaL) - call MV_Pack(V, y%CableDeltaL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_y_CableDeltaLdot) - call MV_Pack(V, y%CableDeltaLdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SrvD_y_BStCLoadMesh) - call MV_Pack(V, y%BStCLoadMesh(DL%i1, DL%i2), ValAry) ! Mesh - case (SrvD_y_NStCLoadMesh) - call MV_Pack(V, y%NStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_TStCLoadMesh) - call MV_Pack(V, y%TStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_SStCLoadMesh) - call MV_Pack(V, y%SStCLoadMesh(DL%i1), ValAry) ! Mesh - case (SrvD_y_toSC) - call MV_Pack(V, y%toSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SrvD_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine SrvD_UnpackOutputAry(Vars, ValAry, y) +subroutine SrvD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_BlPitchCom) + VarVals = y%BlPitchCom(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + VarVals = y%BlAirfoilCom(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_YawMom) + VarVals(1) = y%YawMom ! Scalar + case (SrvD_y_GenTrq) + VarVals(1) = y%GenTrq ! Scalar + case (SrvD_y_HSSBrTrqC) + VarVals(1) = y%HSSBrTrqC ! Scalar + case (SrvD_y_ElecPwr) + VarVals(1) = y%ElecPwr ! Scalar + case (SrvD_y_TBDrCon) + VarVals = y%TBDrCon(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_Lidar) + VarVals = y%Lidar(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_CableDeltaL) + VarVals = y%CableDeltaL(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + VarVals = y%CableDeltaLdot(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_PackMesh(V, y%BStCLoadMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_PackMesh(V, y%NStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_PackMesh(V, y%TStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_PackMesh(V, y%SStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_toSC) + VarVals = y%toSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SrvD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SrvD_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_y_BlPitchCom) - call MV_Unpack(V, ValAry, y%BlPitchCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_y_BlAirfoilCom) - call MV_Unpack(V, ValAry, y%BlAirfoilCom(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_y_YawMom) - call MV_Unpack(V, ValAry, y%YawMom) ! Scalar - case (SrvD_y_GenTrq) - call MV_Unpack(V, ValAry, y%GenTrq) ! Scalar - case (SrvD_y_HSSBrTrqC) - call MV_Unpack(V, ValAry, y%HSSBrTrqC) ! Scalar - case (SrvD_y_ElecPwr) - call MV_Unpack(V, ValAry, y%ElecPwr) ! Scalar - case (SrvD_y_TBDrCon) - call MV_Unpack(V, ValAry, y%TBDrCon(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_y_Lidar) - call MV_Unpack(V, ValAry, y%Lidar(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_y_CableDeltaL) - call MV_Unpack(V, ValAry, y%CableDeltaL(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_y_CableDeltaLdot) - call MV_Unpack(V, ValAry, y%CableDeltaLdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SrvD_y_BStCLoadMesh) - call MV_Unpack(V, ValAry, y%BStCLoadMesh(DL%i1, DL%i2)) ! Mesh - case (SrvD_y_NStCLoadMesh) - call MV_Unpack(V, ValAry, y%NStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_TStCLoadMesh) - call MV_Unpack(V, ValAry, y%TStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_SStCLoadMesh) - call MV_Unpack(V, ValAry, y%SStCLoadMesh(DL%i1)) ! Mesh - case (SrvD_y_toSC) - call MV_Unpack(V, ValAry, y%toSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SrvD_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine SrvD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_BlPitchCom) + y%BlPitchCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + y%BlAirfoilCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_YawMom) + y%YawMom = VarVals(1) ! Scalar + case (SrvD_y_GenTrq) + y%GenTrq = VarVals(1) ! Scalar + case (SrvD_y_HSSBrTrqC) + y%HSSBrTrqC = VarVals(1) ! Scalar + case (SrvD_y_ElecPwr) + y%ElecPwr = VarVals(1) ! Scalar + case (SrvD_y_TBDrCon) + y%TBDrCon(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_Lidar) + y%Lidar(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_CableDeltaL) + y%CableDeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + y%CableDeltaLdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_UnpackMesh(V, ValAry, y%BStCLoadMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_UnpackMesh(V, ValAry, y%NStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_UnpackMesh(V, ValAry, y%TStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_UnpackMesh(V, ValAry, y%SStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_toSC) + y%toSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SrvD_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index b2ee959c7f..2b5d9827c1 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -2334,38 +2334,52 @@ function StC_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine StC_PackContStateAry(Vars, x, ValAry) +subroutine StC_VarsPackContState(Vars, x, ValAry) type(StC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (StC_x_StC_x) - call MV_Pack(V, x%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call StC_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine StC_UnpackContStateAry(Vars, ValAry, x) +subroutine StC_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(StC_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_x_StC_x) + VarVals = x%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(StC_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (StC_x_StC_x) - call MV_Unpack(V, ValAry, x%StC_x(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call StC_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine StC_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_x_StC_x) + x%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function StC_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2377,55 +2391,76 @@ function StC_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine StC_PackContStateDerivAry(Vars, x, ValAry) +subroutine StC_VarsPackContStateDeriv(Vars, x, ValAry) type(StC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (StC_x_StC_x) - call MV_Pack(V, x%StC_x(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call StC_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine StC_PackConstrStateAry(Vars, z, ValAry) +subroutine StC_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(StC_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_x_StC_x) + VarVals = x%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsPackConstrState(Vars, z, ValAry) type(StC_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (StC_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call StC_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine StC_UnpackConstrStateAry(Vars, ValAry, z) +subroutine StC_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(StC_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(StC_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (StC_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call StC_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine StC_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function StC_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2437,54 +2472,68 @@ function StC_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine StC_PackInputAry(Vars, u, ValAry) +subroutine StC_VarsPackInput(Vars, u, ValAry) type(StC_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (StC_u_Mesh) - call MV_Pack(V, u%Mesh(DL%i1), ValAry) ! Mesh - case (StC_u_CmdStiff) - call MV_Pack(V, u%CmdStiff(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (StC_u_CmdDamp) - call MV_Pack(V, u%CmdDamp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (StC_u_CmdBrake) - call MV_Pack(V, u%CmdBrake(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (StC_u_CmdForce) - call MV_Pack(V, u%CmdForce(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call StC_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine StC_UnpackInputAry(Vars, ValAry, u) +subroutine StC_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(StC_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_u_Mesh) + call MV_PackMesh(V, u%Mesh(DL%i1), ValAry) ! Mesh + case (StC_u_CmdStiff) + VarVals = u%CmdStiff(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (StC_u_CmdDamp) + VarVals = u%CmdDamp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (StC_u_CmdBrake) + VarVals = u%CmdBrake(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (StC_u_CmdForce) + VarVals = u%CmdForce(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(StC_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (StC_u_Mesh) - call MV_Unpack(V, ValAry, u%Mesh(DL%i1)) ! Mesh - case (StC_u_CmdStiff) - call MV_Unpack(V, ValAry, u%CmdStiff(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (StC_u_CmdDamp) - call MV_Unpack(V, ValAry, u%CmdDamp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (StC_u_CmdBrake) - call MV_Unpack(V, ValAry, u%CmdBrake(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (StC_u_CmdForce) - call MV_Unpack(V, ValAry, u%CmdForce(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call StC_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine StC_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(StC_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_u_Mesh) + call MV_UnpackMesh(V, ValAry, u%Mesh(DL%i1)) ! Mesh + case (StC_u_CmdStiff) + u%CmdStiff(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (StC_u_CmdDamp) + u%CmdDamp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (StC_u_CmdBrake) + u%CmdBrake(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (StC_u_CmdForce) + u%CmdForce(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function StC_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2504,46 +2553,60 @@ function StC_InputFieldName(DL) result(Name) end select end function -subroutine StC_PackOutputAry(Vars, y, ValAry) +subroutine StC_VarsPackOutput(Vars, y, ValAry) type(StC_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (StC_y_Mesh) - call MV_Pack(V, y%Mesh(DL%i1), ValAry) ! Mesh - case (StC_y_MeasDisp) - call MV_Pack(V, y%MeasDisp(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (StC_y_MeasVel) - call MV_Pack(V, y%MeasVel(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call StC_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine StC_UnpackOutputAry(Vars, ValAry, y) +subroutine StC_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(StC_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_y_Mesh) + call MV_PackMesh(V, y%Mesh(DL%i1), ValAry) ! Mesh + case (StC_y_MeasDisp) + VarVals = y%MeasDisp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (StC_y_MeasVel) + VarVals = y%MeasVel(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(StC_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (StC_y_Mesh) - call MV_Unpack(V, ValAry, y%Mesh(DL%i1)) ! Mesh - case (StC_y_MeasDisp) - call MV_Unpack(V, ValAry, y%MeasDisp(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (StC_y_MeasVel) - call MV_Unpack(V, ValAry, y%MeasVel(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - end select - end associate + call StC_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine StC_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(StC_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_y_Mesh) + call MV_UnpackMesh(V, ValAry, y%Mesh(DL%i1)) ! Mesh + case (StC_y_MeasDisp) + y%MeasDisp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (StC_y_MeasVel) + y%MeasVel(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + function StC_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index b9a8000375..d3d9f29a1d 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -445,7 +445,7 @@ subroutine SD_InitVars(Vars, Init, u, p, x, y, m, InitOut, Linearize, ErrStat, E call MV_AddVar(Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qmdot), & Num=p%nDOFM, & - DerivOrder=0, & + DerivOrder=1, & Perturb=2.0_ReKi*D2R_D, & LinNames=[('First time derivative of Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -/s', i=1, p%nDOFM)]) @@ -2070,7 +2070,7 @@ SUBROUTINE SD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Make a copy of the inputs to perturb call SD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if(Failed()) return - call SD_PackInputAry(Vars, u, m%Jac%u) + call SD_VarsPackInput(Vars, u, m%Jac%u) ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: if (present(dYdu)) then @@ -2087,15 +2087,15 @@ SUBROUTINE SD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call SD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call SD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call SD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call SD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 @@ -2121,15 +2121,15 @@ SUBROUTINE SD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation and resulting continuous state derivatives call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) - call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call SD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call SD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation and resulting continuous state derivatives call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) - call SD_UnpackInputAry(Vars, m%Jac%u_perturb, m%u_perturb) + call SD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call SD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = Vars%u(i)%iLoc(1) + j - 1 @@ -2189,7 +2189,7 @@ SUBROUTINE SD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY call SD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if(Failed()) return - call SD_PackContStateAry(Vars, x, m%Jac%x) + call SD_VarsPackContState(Vars, x, m%Jac%x) ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: if (present(dYdx)) then @@ -2207,15 +2207,15 @@ SUBROUTINE SD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputAry(Vars, m%y_lin, m%Jac%y_pos) + call SD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackOutputAry(Vars, m%y_lin, m%Jac%y_neg) + call SD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index col = Vars%x(i)%iLoc(1) + j - 1 @@ -2251,15 +2251,15 @@ SUBROUTINE SD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrS ! Calculate positive perturbation call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) - call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_pos) + call SD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) ! Calculate negative perturbation call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) - call SD_UnpackContStateAry(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return - call SD_PackContStateAry(Vars, m%dxdt_lin, m%Jac%x_neg) + call SD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) ! Calculate column index col = Vars%x(i)%iLoc(1) + j - 1 diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index b368cff795..07f8ca2623 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -4464,42 +4464,56 @@ function SD_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine SD_PackContStateAry(Vars, x, ValAry) +subroutine SD_VarsPackContState(Vars, x, ValAry) type(SD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SD_x_qm) - call MV_Pack(V, x%qm(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SD_x_qmdot) - call MV_Pack(V, x%qmdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SD_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine SD_UnpackContStateAry(Vars, ValAry, x) +subroutine SD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_x_qm) + VarVals = x%qm(V%iLB:V%iUB) ! Rank 1 Array + case (SD_x_qmdot) + VarVals = x%qmdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SD_x_qm) - call MV_Unpack(V, ValAry, x%qm(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SD_x_qmdot) - call MV_Unpack(V, ValAry, x%qmdot(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SD_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine SD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_x_qm) + x%qm(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SD_x_qmdot) + x%qmdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SD_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4513,57 +4527,78 @@ function SD_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine SD_PackContStateDerivAry(Vars, x, ValAry) +subroutine SD_VarsPackContStateDeriv(Vars, x, ValAry) type(SD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SD_x_qm) - call MV_Pack(V, x%qm(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SD_x_qmdot) - call MV_Pack(V, x%qmdot(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SD_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine SD_PackConstrStateAry(Vars, z, ValAry) +subroutine SD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_x_qm) + VarVals = x%qm(V%iLB:V%iUB) ! Rank 1 Array + case (SD_x_qmdot) + VarVals = x%qmdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsPackConstrState(Vars, z, ValAry) type(SD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SD_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SD_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine SD_UnpackConstrStateAry(Vars, ValAry, z) +subroutine SD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SD_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call SD_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine SD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SD_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4575,46 +4610,60 @@ function SD_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine SD_PackInputAry(Vars, u, ValAry) +subroutine SD_VarsPackInput(Vars, u, ValAry) type(SD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SD_u_TPMesh) - call MV_Pack(V, u%TPMesh, ValAry) ! Mesh - case (SD_u_LMesh) - call MV_Pack(V, u%LMesh, ValAry) ! Mesh - case (SD_u_CableDeltaL) - call MV_Pack(V, u%CableDeltaL(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SD_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine SD_UnpackInputAry(Vars, ValAry, u) +subroutine SD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_u_TPMesh) + call MV_PackMesh(V, u%TPMesh, ValAry) ! Mesh + case (SD_u_LMesh) + call MV_PackMesh(V, u%LMesh, ValAry) ! Mesh + case (SD_u_CableDeltaL) + VarVals = u%CableDeltaL(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SD_u_TPMesh) - call MV_Unpack(V, ValAry, u%TPMesh) ! Mesh - case (SD_u_LMesh) - call MV_Unpack(V, ValAry, u%LMesh) ! Mesh - case (SD_u_CableDeltaL) - call MV_Unpack(V, ValAry, u%CableDeltaL(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SD_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine SD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_u_TPMesh) + call MV_UnpackMesh(V, ValAry, u%TPMesh) ! Mesh + case (SD_u_LMesh) + call MV_UnpackMesh(V, ValAry, u%LMesh) ! Mesh + case (SD_u_CableDeltaL) + u%CableDeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SD_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -4630,50 +4679,64 @@ function SD_InputFieldName(DL) result(Name) end select end function -subroutine SD_PackOutputAry(Vars, y, ValAry) +subroutine SD_VarsPackOutput(Vars, y, ValAry) type(SD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SD_y_Y1Mesh) - call MV_Pack(V, y%Y1Mesh, ValAry) ! Mesh - case (SD_y_Y2Mesh) - call MV_Pack(V, y%Y2Mesh, ValAry) ! Mesh - case (SD_y_Y3Mesh) - call MV_Pack(V, y%Y3Mesh, ValAry) ! Mesh - case (SD_y_WriteOutput) - call MV_Pack(V, y%WriteOutput(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SD_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine SD_UnpackOutputAry(Vars, ValAry, y) +subroutine SD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_y_Y1Mesh) + call MV_PackMesh(V, y%Y1Mesh, ValAry) ! Mesh + case (SD_y_Y2Mesh) + call MV_PackMesh(V, y%Y2Mesh, ValAry) ! Mesh + case (SD_y_Y3Mesh) + call MV_PackMesh(V, y%Y3Mesh, ValAry) ! Mesh + case (SD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SD_y_Y1Mesh) - call MV_Unpack(V, ValAry, y%Y1Mesh) ! Mesh - case (SD_y_Y2Mesh) - call MV_Unpack(V, ValAry, y%Y2Mesh) ! Mesh - case (SD_y_Y3Mesh) - call MV_Unpack(V, ValAry, y%Y3Mesh) ! Mesh - case (SD_y_WriteOutput) - call MV_Unpack(V, ValAry, y%WriteOutput(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SD_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine SD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_y_Y1Mesh) + call MV_UnpackMesh(V, ValAry, y%Y1Mesh) ! Mesh + case (SD_y_Y2Mesh) + call MV_UnpackMesh(V, ValAry, y%Y2Mesh) ! Mesh + case (SD_y_Y3Mesh) + call MV_UnpackMesh(V, ValAry, y%Y3Mesh) ! Mesh + case (SD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SD_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index d9dccf582f..12aa81300b 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -679,38 +679,52 @@ function SC_DX_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine SC_DX_PackInputAry(Vars, u, ValAry) +subroutine SC_DX_VarsPackInput(Vars, u, ValAry) type(SC_DX_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SC_DX_u_toSC) - call MV_Pack(V, u%toSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SC_DX_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine SC_DX_UnpackInputAry(Vars, ValAry, u) +subroutine SC_DX_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SC_DX_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_DX_u_toSC) + VarVals = u%toSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_DX_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_DX_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SC_DX_u_toSC) - call MV_Unpack(V, ValAry, u%toSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SC_DX_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine SC_DX_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_DX_u_toSC) + u%toSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SC_DX_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -722,42 +736,56 @@ function SC_DX_InputFieldName(DL) result(Name) end select end function -subroutine SC_DX_PackOutputAry(Vars, y, ValAry) +subroutine SC_DX_VarsPackOutput(Vars, y, ValAry) type(SC_DX_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SC_DX_y_fromSC) - call MV_Pack(V, y%fromSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SC_DX_y_fromSCglob) - call MV_Pack(V, y%fromSCglob(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SC_DX_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine SC_DX_UnpackOutputAry(Vars, ValAry, y) +subroutine SC_DX_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SC_DX_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_DX_y_fromSC) + VarVals = y%fromSC(V%iLB:V%iUB) ! Rank 1 Array + case (SC_DX_y_fromSCglob) + VarVals = y%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_DX_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_DX_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SC_DX_y_fromSC) - call MV_Unpack(V, ValAry, y%fromSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SC_DX_y_fromSCglob) - call MV_Unpack(V, ValAry, y%fromSCglob(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SC_DX_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine SC_DX_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_DX_y_fromSC) + y%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SC_DX_y_fromSCglob) + y%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SC_DX_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 46fb54eda1..97ec33492f 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -1847,38 +1847,52 @@ function SC_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine SC_PackContStateAry(Vars, x, ValAry) +subroutine SC_VarsPackContState(Vars, x, ValAry) type(SC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SC_x_Dummy) - call MV_Pack(V, x%Dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SC_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine SC_UnpackContStateAry(Vars, ValAry, x) +subroutine SC_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SC_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_x_Dummy) + VarVals(1) = x%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SC_x_Dummy) - call MV_Unpack(V, ValAry, x%Dummy) ! Scalar - end select - end associate + call SC_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine SC_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_x_Dummy) + x%Dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SC_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1890,55 +1904,76 @@ function SC_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine SC_PackContStateDerivAry(Vars, x, ValAry) +subroutine SC_VarsPackContStateDeriv(Vars, x, ValAry) type(SC_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (SC_x_Dummy) - call MV_Pack(V, x%Dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SC_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine SC_PackConstrStateAry(Vars, z, ValAry) +subroutine SC_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SC_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_x_Dummy) + VarVals(1) = x%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsPackConstrState(Vars, z, ValAry) type(SC_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SC_z_Dummy) - call MV_Pack(V, z%Dummy, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SC_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine SC_UnpackConstrStateAry(Vars, ValAry, z) +subroutine SC_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SC_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_z_Dummy) + VarVals(1) = z%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (SC_z_Dummy) - call MV_Unpack(V, ValAry, z%Dummy) ! Scalar - end select - end associate + call SC_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine SC_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_z_Dummy) + z%Dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + function SC_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1950,42 +1985,56 @@ function SC_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine SC_PackInputAry(Vars, u, ValAry) +subroutine SC_VarsPackInput(Vars, u, ValAry) type(SC_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SC_u_toSCglob) - call MV_Pack(V, u%toSCglob(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SC_u_toSC) - call MV_Pack(V, u%toSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SC_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine SC_UnpackInputAry(Vars, ValAry, u) +subroutine SC_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SC_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_u_toSCglob) + VarVals = u%toSCglob(V%iLB:V%iUB) ! Rank 1 Array + case (SC_u_toSC) + VarVals = u%toSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (SC_u_toSCglob) - call MV_Unpack(V, ValAry, u%toSCglob(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SC_u_toSC) - call MV_Unpack(V, ValAry, u%toSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SC_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine SC_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_u_toSCglob) + u%toSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SC_u_toSC) + u%toSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SC_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1999,42 +2048,56 @@ function SC_InputFieldName(DL) result(Name) end select end function -subroutine SC_PackOutputAry(Vars, y, ValAry) +subroutine SC_VarsPackOutput(Vars, y, ValAry) type(SC_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SC_y_fromSCglob) - call MV_Pack(V, y%fromSCglob(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (SC_y_fromSC) - call MV_Pack(V, y%fromSC(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call SC_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine SC_UnpackOutputAry(Vars, ValAry, y) +subroutine SC_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SC_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_y_fromSCglob) + VarVals = y%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array + case (SC_y_fromSC) + VarVals = y%fromSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(SC_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (SC_y_fromSCglob) - call MV_Unpack(V, ValAry, y%fromSCglob(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (SC_y_fromSC) - call MV_Unpack(V, ValAry, y%fromSC(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call SC_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine SC_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_y_fromSCglob) + y%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SC_y_fromSC) + y%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function SC_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 0b85acf14c..6a373bd9d3 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -1955,38 +1955,52 @@ function WD_OutputMeshPointer(y, DL) result(Mesh) end select end function -subroutine WD_PackContStateAry(Vars, x, ValAry) +subroutine WD_VarsPackContState(Vars, x, ValAry) type(WD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (WD_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WD_VarPackContState(Vars%x(i), x, ValAry) end do end subroutine -subroutine WD_UnpackContStateAry(Vars, ValAry, x) +subroutine WD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(WD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsUnpackContState(Vars, ValAry, x) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WD_ContinuousStateType), intent(inout) :: x integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (WD_x_DummyContState) - call MV_Unpack(V, ValAry, x%DummyContState) ! Scalar - end select - end associate + call WD_VarUnpackContState(Vars%x(i), ValAry, x) end do end subroutine +subroutine WD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function WD_ContinuousStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -1998,55 +2012,76 @@ function WD_ContinuousStateFieldName(DL) result(Name) end select end function -subroutine WD_PackContStateDerivAry(Vars, x, ValAry) +subroutine WD_VarsPackContStateDeriv(Vars, x, ValAry) type(WD_ContinuousStateType), intent(in) :: x type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%x) - associate (V => Vars%x(i), DL => Vars%x(i)%DL) - select case (DL%Num) - case (WD_x_DummyContState) - call MV_Pack(V, x%DummyContState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WD_VarPackContStateDeriv(Vars%x(i), x, ValAry) end do end subroutine -subroutine WD_PackConstrStateAry(Vars, z, ValAry) +subroutine WD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(WD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsPackConstrState(Vars, z, ValAry) type(WD_ConstraintStateType), intent(in) :: z type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (WD_z_DummyConstrState) - call MV_Pack(V, z%DummyConstrState, ValAry) ! Scalar - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WD_VarPackConstrState(Vars%z(i), z, ValAry) end do end subroutine -subroutine WD_UnpackConstrStateAry(Vars, ValAry, z) +subroutine WD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(WD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsUnpackConstrState(Vars, ValAry, z) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WD_ConstraintStateType), intent(inout) :: z integer(IntKi) :: i do i = 1, size(Vars%z) - associate (V => Vars%z(i), DL => Vars%z(i)%DL) - select case (DL%Num) - case (WD_z_DummyConstrState) - call MV_Unpack(V, ValAry, z%DummyConstrState) ! Scalar - end select - end associate + call WD_VarUnpackConstrState(Vars%z(i), ValAry, z) end do end subroutine +subroutine WD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + function WD_ConstraintStateFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2058,82 +2093,96 @@ function WD_ConstraintStateFieldName(DL) result(Name) end select end function -subroutine WD_PackInputAry(Vars, u, ValAry) +subroutine WD_VarsPackInput(Vars, u, ValAry) type(WD_InputType), intent(in) :: u type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (WD_u_xhat_disk) - call MV_Pack(V, u%xhat_disk(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WD_u_YawErr) - call MV_Pack(V, u%YawErr, ValAry) ! Scalar - case (WD_u_psi_skew) - call MV_Pack(V, u%psi_skew, ValAry) ! Scalar - case (WD_u_chi_skew) - call MV_Pack(V, u%chi_skew, ValAry) ! Scalar - case (WD_u_p_hub) - call MV_Pack(V, u%p_hub(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WD_u_V_plane) - call MV_Pack(V, u%V_plane(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (WD_u_Vx_wind_disk) - call MV_Pack(V, u%Vx_wind_disk, ValAry) ! Scalar - case (WD_u_TI_amb) - call MV_Pack(V, u%TI_amb, ValAry) ! Scalar - case (WD_u_D_rotor) - call MV_Pack(V, u%D_rotor, ValAry) ! Scalar - case (WD_u_Vx_rel_disk) - call MV_Pack(V, u%Vx_rel_disk, ValAry) ! Scalar - case (WD_u_Ct_azavg) - call MV_Pack(V, u%Ct_azavg(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WD_u_Cq_azavg) - call MV_Pack(V, u%Cq_azavg(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WD_VarPackInput(Vars%u(i), u, ValAry) end do end subroutine -subroutine WD_UnpackInputAry(Vars, ValAry, u) +subroutine WD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(WD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_u_xhat_disk) + VarVals = u%xhat_disk(V%iLB:V%iUB) ! Rank 1 Array + case (WD_u_YawErr) + VarVals(1) = u%YawErr ! Scalar + case (WD_u_psi_skew) + VarVals(1) = u%psi_skew ! Scalar + case (WD_u_chi_skew) + VarVals(1) = u%chi_skew ! Scalar + case (WD_u_p_hub) + VarVals = u%p_hub(V%iLB:V%iUB) ! Rank 1 Array + case (WD_u_V_plane) + VarVals = u%V_plane(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_u_Vx_wind_disk) + VarVals(1) = u%Vx_wind_disk ! Scalar + case (WD_u_TI_amb) + VarVals(1) = u%TI_amb ! Scalar + case (WD_u_D_rotor) + VarVals(1) = u%D_rotor ! Scalar + case (WD_u_Vx_rel_disk) + VarVals(1) = u%Vx_rel_disk ! Scalar + case (WD_u_Ct_azavg) + VarVals = u%Ct_azavg(V%iLB:V%iUB) ! Rank 1 Array + case (WD_u_Cq_azavg) + VarVals = u%Cq_azavg(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsUnpackInput(Vars, ValAry, u) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WD_InputType), intent(inout) :: u integer(IntKi) :: i do i = 1, size(Vars%u) - associate (V => Vars%u(i), DL => Vars%u(i)%DL) - select case (DL%Num) - case (WD_u_xhat_disk) - call MV_Unpack(V, ValAry, u%xhat_disk(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WD_u_YawErr) - call MV_Unpack(V, ValAry, u%YawErr) ! Scalar - case (WD_u_psi_skew) - call MV_Unpack(V, ValAry, u%psi_skew) ! Scalar - case (WD_u_chi_skew) - call MV_Unpack(V, ValAry, u%chi_skew) ! Scalar - case (WD_u_p_hub) - call MV_Unpack(V, ValAry, u%p_hub(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WD_u_V_plane) - call MV_Unpack(V, ValAry, u%V_plane(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (WD_u_Vx_wind_disk) - call MV_Unpack(V, ValAry, u%Vx_wind_disk) ! Scalar - case (WD_u_TI_amb) - call MV_Unpack(V, ValAry, u%TI_amb) ! Scalar - case (WD_u_D_rotor) - call MV_Unpack(V, ValAry, u%D_rotor) ! Scalar - case (WD_u_Vx_rel_disk) - call MV_Unpack(V, ValAry, u%Vx_rel_disk) ! Scalar - case (WD_u_Ct_azavg) - call MV_Unpack(V, ValAry, u%Ct_azavg(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WD_u_Cq_azavg) - call MV_Unpack(V, ValAry, u%Cq_azavg(V%iAry(1):V%iAry(2))) ! Rank 1 Array - end select - end associate + call WD_VarUnpackInput(Vars%u(i), ValAry, u) end do end subroutine +subroutine WD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_u_xhat_disk) + u%xhat_disk(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_u_YawErr) + u%YawErr = VarVals(1) ! Scalar + case (WD_u_psi_skew) + u%psi_skew = VarVals(1) ! Scalar + case (WD_u_chi_skew) + u%chi_skew = VarVals(1) ! Scalar + case (WD_u_p_hub) + u%p_hub(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_u_V_plane) + u%V_plane(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_u_Vx_wind_disk) + u%Vx_wind_disk = VarVals(1) ! Scalar + case (WD_u_TI_amb) + u%TI_amb = VarVals(1) ! Scalar + case (WD_u_D_rotor) + u%D_rotor = VarVals(1) ! Scalar + case (WD_u_Vx_rel_disk) + u%Vx_rel_disk = VarVals(1) ! Scalar + case (WD_u_Ct_azavg) + u%Ct_azavg(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_u_Cq_azavg) + u%Cq_azavg(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + function WD_InputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name @@ -2167,74 +2216,88 @@ function WD_InputFieldName(DL) result(Name) end select end function -subroutine WD_PackOutputAry(Vars, y, ValAry) +subroutine WD_VarsPackOutput(Vars, y, ValAry) type(WD_OutputType), intent(in) :: y type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(inout) :: ValAry(:) integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (WD_y_xhat_plane) - call MV_Pack(V, y%xhat_plane(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (WD_y_p_plane) - call MV_Pack(V, y%p_plane(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (WD_y_Vx_wake) - call MV_Pack(V, y%Vx_wake(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (WD_y_Vr_wake) - call MV_Pack(V, y%Vr_wake(V%iAry(1):V%iAry(2),V%jAry), ValAry) ! Rank 2 Array - case (WD_y_Vx_wake2) - call MV_Pack(V, y%Vx_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (WD_y_Vy_wake2) - call MV_Pack(V, y%Vy_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (WD_y_Vz_wake2) - call MV_Pack(V, y%Vz_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case (WD_y_D_wake) - call MV_Pack(V, y%D_wake(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WD_y_x_plane) - call MV_Pack(V, y%x_plane(V%iAry(1):V%iAry(2)), ValAry) ! Rank 1 Array - case (WD_y_WAT_k) - call MV_Pack(V, y%WAT_k(V%iAry(1):V%iAry(2), V%jAry, V%kAry), ValAry) ! Rank 3 Array - case default - ValAry(V%iLoc(1):V%iLoc(2)) = 0.0_R8Ki - end select - end associate + call WD_VarPackOutput(Vars%y(i), y, ValAry) end do end subroutine -subroutine WD_UnpackOutputAry(Vars, ValAry, y) +subroutine WD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(WD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_y_xhat_plane) + VarVals = y%xhat_plane(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_y_p_plane) + VarVals = y%p_plane(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_y_Vx_wake) + VarVals = y%Vx_wake(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_y_Vr_wake) + VarVals = y%Vr_wake(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_y_Vx_wake2) + VarVals = y%Vx_wake2(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (WD_y_Vy_wake2) + VarVals = y%Vy_wake2(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (WD_y_Vz_wake2) + VarVals = y%Vz_wake2(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (WD_y_D_wake) + VarVals = y%D_wake(V%iLB:V%iUB) ! Rank 1 Array + case (WD_y_x_plane) + VarVals = y%x_plane(V%iLB:V%iUB) ! Rank 1 Array + case (WD_y_WAT_k) + VarVals = y%WAT_k(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsUnpackOutput(Vars, ValAry, y) type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: ValAry(:) type(WD_OutputType), intent(inout) :: y integer(IntKi) :: i do i = 1, size(Vars%y) - associate (V => Vars%y(i), DL => Vars%y(i)%DL) - select case (DL%Num) - case (WD_y_xhat_plane) - call MV_Unpack(V, ValAry, y%xhat_plane(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (WD_y_p_plane) - call MV_Unpack(V, ValAry, y%p_plane(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (WD_y_Vx_wake) - call MV_Unpack(V, ValAry, y%Vx_wake(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (WD_y_Vr_wake) - call MV_Unpack(V, ValAry, y%Vr_wake(V%iAry(1):V%iAry(2),V%jAry)) ! Rank 2 Array - case (WD_y_Vx_wake2) - call MV_Unpack(V, ValAry, y%Vx_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (WD_y_Vy_wake2) - call MV_Unpack(V, ValAry, y%Vy_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (WD_y_Vz_wake2) - call MV_Unpack(V, ValAry, y%Vz_wake2(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - case (WD_y_D_wake) - call MV_Unpack(V, ValAry, y%D_wake(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WD_y_x_plane) - call MV_Unpack(V, ValAry, y%x_plane(V%iAry(1):V%iAry(2))) ! Rank 1 Array - case (WD_y_WAT_k) - call MV_Unpack(V, ValAry, y%WAT_k(V%iAry(1):V%iAry(2), V%jAry, V%kAry)) ! Rank 3 Array - end select - end associate + call WD_VarUnpackOutput(Vars%y(i), ValAry, y) end do end subroutine +subroutine WD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_y_xhat_plane) + y%xhat_plane(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_y_p_plane) + y%p_plane(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_y_Vx_wake) + y%Vx_wake(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_y_Vr_wake) + y%Vr_wake(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_y_Vx_wake2) + y%Vx_wake2(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (WD_y_Vy_wake2) + y%Vy_wake2(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (WD_y_Vz_wake2) + y%Vz_wake2(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (WD_y_D_wake) + y%D_wake(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_y_x_plane) + y%x_plane(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_y_WAT_k) + y%WAT_k(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + end select + end associate +end subroutine + function WD_OutputFieldName(DL) result(Name) type(DatLoc), intent(in) :: DL character(32) :: Name From 01117896a56f80407392020579799eaf8e8be0f8 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 9 Aug 2024 21:16:28 +0000 Subject: [PATCH 168/319] Don't clear load mesh if mapping isn't ready --- modules/openfast-library/src/FAST_Mapping.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 4d674e479e..6b861573cc 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -2419,6 +2419,8 @@ subroutine FAST_InputSolve(iModDst, ModAry, MapAry, iInput, Turbine, ErrStat, Er ! Loop through mappings do i = 1, size(MapAry) + if (.not. MapAry(i)%Ready) cycle + ! Skip mappings where this isn't the destination module if (iModDst /= MapAry(i)%iModDst) cycle From 819d504c553afdf8a3944cd2a032fda8d690d6bc Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 16 Aug 2024 14:36:32 +0000 Subject: [PATCH 169/319] BeamDyn, ModMesh, NWTC_Num performance improvements --- modules/beamdyn/src/BeamDyn.f90 | 718 ++++++++++--------- modules/beamdyn/src/BeamDyn_Subs.f90 | 55 +- modules/nwtc-library/src/ModMesh.f90 | 114 +-- modules/nwtc-library/src/ModMesh_Mapping.f90 | 40 +- modules/nwtc-library/src/NWTC_Num.f90 | 8 +- 5 files changed, 499 insertions(+), 436 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 4edcbd1255..97a7c5cd03 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -1654,7 +1654,7 @@ subroutine Init_MiscVars( p, u, y, m, ErrStat, ErrMsg ) ! Array for storing the position information for the quadrature points. CALL AllocAry(m%qp%uuu, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uuu displacement at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry(m%qp%uup, p%dof_node/2,p%nqp,p%elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(m%qp%uup, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%vvv, p%dof_node ,p%nqp,p%elem_total, 'm%qp%vvv velocity at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%vvp, p%dof_node ,p%nqp,p%elem_total, 'm%qp%vvp velocity prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%aaa, p%dof_node ,p%nqp,p%elem_total, 'm%qp%aaa acceleration at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1683,7 +1683,7 @@ subroutine Init_MiscVars( p, u, y, m, ErrStat, ErrMsg ) ! Inertial force terms CALL AllocAry(m%qp%Gi, 6,6, p%nqp,p%elem_total, 'm%qp%Gi gyroscopic at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%Ki, 6,6, p%nqp,p%elem_total, 'm%qp%Ki stiffness at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry(m%qp%Mi, 6,6, p%nqp,p%elem_total, 'm%qp%Mi mass at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(m%qp%Mi, p%nqp, 6,6, p%elem_total, 'm%qp%Mi mass at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Elastic force terms: \f$ \underline{\underline{\mathcal{O}}} \f$, etc. from equation (19-21) of NREL CP-2C00-60759. CALL AllocAry(m%qp%Oe, 6,6, p%nqp,p%elem_total, 'm%qp%Oe term at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2364,48 +2364,44 @@ SUBROUTINE BD_DisplacementQP( nelem, p, x, m ) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables + INTEGER(IntKi) :: ErrStat !< index to current element + CHARACTER(ErrMsgLen) :: ErrMsg !< index to current element INTEGER(IntKi) :: idx_qp !< index to the current quadrature point INTEGER(IntKi) :: elem_start !< Node point of first node in current element - INTEGER(IntKi) :: idx_node - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DisplacementQP' - - - DO idx_qp=1,p%nqp - ! Node point before start of this element - elem_start = p%node_elem_idx( nelem,1 ) - - !> ### Calculate the the displacement fields in an element - !! Using equations (27) and (28) \n - !! \f$ \underline{u}\left( \xi \right) = - !! \sum_{i=1}^{p+1} h^i\left( \xi \right) \underline{\hat{u}}^i - !! \f$ \n - !! and \n - !! \f$ \underline{u}^\prime \left( \xi \right) = - !! \sum_{k=1}^{p+1} h^{k\prime} \left( \xi \right) \underline{\hat{u}}^i - !! \f$ - !! - !! | Variable | Value | - !! | :---------: | :------------------------------------------------------------------------- | - !! | \f$ \xi \f$ | Element natural coordinate \f$ \in [-1,1] \f$ | - !! | \f$ k \f$ | Node number of a \f$ p^\text{th} \f$ order Langrangian-interpolant | - !! | \f$ h^i \left( \xi \right ) \f$ | Component of the shape function matrix, \f$ \underline{\underline{N}} \f$ | - !! | \f$ h^{k\prime} \left( \xi \right ) \f$ | \f$ \frac{\mathrm{d}}{\mathrm{d}x_1} h^i \left( \xi \right) \f$ | - !! | \f$ \underline{\hat{u}}^i \f$ | \f$ k^\text{th} \f$ nodal value | + !> ### Calculate the the displacement fields in an element + !! Using equations (27) and (28) \n + !! \f$ \underline{u}\left( \xi \right) = + !! \sum_{i=1}^{p+1} h^i\left( \xi \right) \underline{\hat{u}}^i + !! \f$ \n + !! and \n + !! \f$ \underline{u}^\prime \left( \xi \right) = + !! \sum_{k=1}^{p+1} h^{k\prime} \left( \xi \right) \underline{\hat{u}}^i + !! \f$ + !! + !! | Variable | Value | + !! | :---------: | :------------------------------------------------------------------------- | + !! | \f$ \xi \f$ | Element natural coordinate \f$ \in [-1,1] \f$ | + !! | \f$ k \f$ | Node number of a \f$ p^\text{th} \f$ order Langrangian-interpolant | + !! | \f$ h^i \left( \xi \right ) \f$ | Component of the shape function matrix, \f$ \underline{\underline{N}} \f$ | + !! | \f$ h^{k\prime} \left( \xi \right ) \f$ | \f$ \frac{\mathrm{d}}{\mathrm{d}x_1} h^i \left( \xi \right) \f$ | + !! | \f$ \underline{\hat{u}}^i \f$ | \f$ k^\text{th} \f$ nodal value | + + ! Node point before start of this element + elem_start = p%node_elem_idx(nelem,1) - ! Initialize values for summation - m%qp%uuu(:,idx_qp,nelem) = 0.0_BDKi ! displacement field \f$ \underline{u} \left( \xi \right) \f$ - m%qp%uup(:,idx_qp,nelem) = 0.0_BDKi ! displacement field \f$ \underline{u}^\prime \left( \xi \right) \f$ + ! Use matrix multiplication to interpolate position and position derivative to quadrature points + call LAPACK_DGEMM('N','N', 1.0_BDKi, x%q(1:3,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%uuu(1:3,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, x%q(1:3,elem_start:elem_start+p%nodes_per_elem-1), p%ShpDer, 0.0_BDKi, m%qp%uup(1:3,:,nelem), ErrStat, ErrMsg) - DO idx_node=1,p%nodes_per_elem - m%qp%uuu(1:3,idx_qp,nelem) = m%qp%uuu(1:3,idx_qp,nelem) + p%Shp(idx_node,idx_qp) *x%q(1:3,elem_start - 1 + idx_node) - m%qp%uup(1:3,idx_qp,nelem) = m%qp%uup(1:3,idx_qp,nelem) + p%ShpDer(idx_node,idx_qp)/p%Jacobian(idx_qp,nelem)*x%q(1:3,elem_start - 1 + idx_node) - ENDDO + ! Apply Jacobian to get position derivative with respect to X-axis + do idx_qp = 1, p%nqp + m%qp%uup(1:3,idx_qp,nelem) = m%qp%uup(1:3,idx_qp,nelem) / p%Jacobian(idx_qp,nelem) + end do - !> Calculate \f$ \underline{E}_1 = x_0^\prime + u^\prime \f$ (equation 23). Note E_1 is along the z direction. - m%qp%E1(1:3,idx_qp,nelem) = p%E10(1:3,idx_qp,nelem) + m%qp%uup(1:3,idx_qp,nelem) + !> Calculate \f$ \underline{E}_1 = x_0^\prime + u^\prime \f$ (equation 23). Note E_1 is along the z direction. + m%qp%E1(1:3,:,nelem) = p%E10(1:3,:,nelem) + m%qp%uup(1:3,:,nelem) - ENDDO END SUBROUTINE BD_DisplacementQP @@ -2422,6 +2418,8 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables + INTEGER(IntKi) :: ErrStat !< index to current element + CHARACTER(ErrMsgLen) :: ErrMsg !< index to current element INTEGER(IntKi) :: idx_qp !< index to the current quadrature point INTEGER(IntKi) :: elem_start !< Node point of first node in current element INTEGER(IntKi) :: idx_node !< index to current GLL point in element @@ -2430,8 +2428,6 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) REAL(BDKi) :: cc(3) REAL(BDKi) :: temp33(3,3) REAL(BDKi) :: DCM_root(3,3) !< DCM for first node - CHARACTER(*), PARAMETER :: RoutineName = 'BD_RotationalInterpQP' - !> ## Calculate the interpolated rotational displacements !! To calculate this, the algorithm given in http://www.nrel.gov/docs/fy14osti/60759.pdf @@ -2486,6 +2482,15 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) ENDDO + ! Use matrix multiplication to interpolate rotation and rotation derivative to quadrature points + ! These rotations do not include the root node rotation at this point (added later in function) + call LAPACK_DGEMM('N','N', 1.0_BDKi, m%Nrrr(:,:,nelem), p%Shp, 0.0_BDKi, m%qp%uuu(4:6,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, m%Nrrr(:,:,nelem), p%ShpDer, 0.0_BDKi, m%qp%uup(4:6,:,nelem), ErrStat, ErrMsg) + + ! Apply Jacobian to get rotation derivative with respect to X-axis + do idx_qp = 1, p%nqp + m%qp%uup(4:6,idx_qp,nelem) = m%qp%uup(4:6,idx_qp,nelem) / p%Jacobian(idx_qp,nelem) + end do ! QP rotational interpolation DO idx_qp=1,p%nqp @@ -2511,16 +2516,9 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) !! | \f$ h^{k\prime} \left( \xi \right ) \f$ | \f$ \frac{\mathrm{d}}{\mathrm{d}x_1} h^i \left( \xi \right) \f$ | !! | \f$ \underline{\hat{r}}^i \f$ | \f$ k^\text{th} \f$ nodal value | - - ! Initialize values for summations - rrr = 0.0_BDKi ! intermediate rotation field for calculation - rrp = 0.0_BDKi - - ! Note: `m%Nrrr` is \f$ \underline{\hat{r}}^i \f$ - DO idx_node=1,p%nodes_per_elem - rrr(1:3) = rrr(1:3) + p%Shp(idx_node,idx_qp) *m%Nrrr(1:3,idx_node,nelem) - rrp(1:3) = rrp(1:3) + p%ShpDer(idx_node,idx_qp)/p%Jacobian(idx_qp,nelem)*m%Nrrr(1:3,idx_node,nelem) - ENDDO + ! Get rotation and rotation derivative at quadrature point (root rotation is not included) + rrr = m%qp%uuu(4:6,idx_qp,nelem) + rrp = m%qp%uup(4:6,idx_qp,nelem) !> **Step 3:** Restore the rigid body rotation at node \f$ \xi \f$ with \n !! \f$ \underline{c}(\xi) = \underline{\hat{c}}^1 \oplus \underline{r}(\xi) \f$ \n @@ -2568,55 +2566,77 @@ SUBROUTINE BD_StifAtDeformedQP( nelem, p, m ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables INTEGER(IntKi) :: idx_qp !< index counter for quadrature point - INTEGER(IntKi) :: temp_id2 !< Index to last node of previous element - INTEGER(IntKi) :: i,j !< generic counters - REAL(BDKi) :: tempR6(6,6) - REAL(BDKi) :: tempBeta6(6,6) + INTEGER(IntKi) :: idx_Stif0 !< Index to last node of previous element + + ! Initial stiffness matrix index + idx_Stif0 = (nelem-1)*p%nqp + ! Loop through quadrature points + do idx_qp = 1, p%nqp - ! see Bauchau 2011 Flexible Multibody Dynamics p 692-693, section 17.7.2 + ! Initial stiffness matrix index + idx_Stif0 = idx_Stif0 + 1 - ! extract the mass and stiffness matrices for the current element - temp_id2 = (nelem-1)*p%nqp + ! Calculate stiffness and damping matrices for this quadrature point + call Calc_Stif_betaC(m%qp%RR0(:,:,idx_qp,nelem), & + p%Stif0_QP(:,:,idx_Stif0), & + m%qp%Stif(:,:,idx_qp,nelem), & + m%qp%betaC(:,:,idx_qp,nelem)) + end do - DO idx_qp=1,p%nqp +contains + subroutine Calc_Stif_betaC(RR0, Stif0, Stif, betaC) + REAL(BDKi), intent(in) :: RR0(:,:), Stif0(:,:) + REAL(BDKi), intent(inout) :: Stif(:,:), betaC(:,:) + REAL(BDKi) :: tempR6(6,6) + REAL(BDKi) :: tempR6_T(6,6) + REAL(BDKi) :: tempBeta6(6,6) + REAL(BDKi) :: tempBeta_diag(6) + INTEGER(IntKi) :: i, j + + ! see Bauchau 2011 Flexible Multibody Dynamics p 692-693, section 17.7.2 !> RR0 is the rotation tensor at quadrature point \f$ \left(\underline{\underline{R}}\underline{\underline{R}}_0\right) \f$ (3x3) - - ! Setup the temporary matrix for modifying the stiffness matrix. RR0 is changing with time. + + ! Setup the temporary matrix for modifying the stiffness matrix. RR0 is changing with time. tempR6 = 0.0_BDKi - tempBeta6 = 0.0_BDKi - tempR6(1:3,1:3) = m%qp%RR0(:,:,idx_qp,nelem) ! upper left -- translation - tempR6(4:6,4:6) = m%qp%RR0(:,:,idx_qp,nelem) ! lower right -- rotation - !NOTE: Bauchau has the lower right corner multiplied by H - - ! Move damping ratio from material frame to the calculation reference frame - ! This is the following: - ! tempBEta6=matmul(tempR6,matmul(diag(p%beta),transpose(tempR6))) - do j=1,6 - do i=1,6 - ! diagonal of p%beta * TRANSPOSE(tempR6) - tempBeta6(i,j) = p%beta(i)*tempR6(j,i) - enddo - enddo - tempBeta6 = matmul(tempR6,tempBeta6) - - - !> Modify the Mass matrix so it is in the calculation reference frame - !! \f$ \begin{bmatrix} - !! \left(\underline{\underline{R}} \underline{\underline{R}}_0\right) & 0 \\ - !! 0 & \left(\underline{\underline{R}} \underline{\underline{R}}_0\right) - !! \end{bmatrix} - !! \underline{\underline{C}} - !! \begin{bmatrix} - !! \left(\underline{\underline{R}} \underline{\underline{R}}_0\right)^T & 0 \\ - !! 0 & \left(\underline{\underline{R}} \underline{\underline{R}}_0\right)^T - !! \end{bmatrix} \f$ - m%qp%Stif(:,:,idx_qp,nelem) = MATMUL(tempR6,MATMUL(p%Stif0_QP(1:6,1:6,temp_id2+idx_qp),TRANSPOSE(tempR6))) - - ! Now apply the damping - m%qp%betaC(:,:,idx_qp,nelem) = matmul(tempBeta6,m%qp%Stif(:,:,idx_qp,nelem)) - ENDDO + tempR6(1:3,1:3) = RR0 ! upper left -- translation + tempR6(4:6,4:6) = RR0 ! lower right -- rotation + !NOTE: Bauchau has the lower right corner multiplied by H + ! Compute the transpose of tempR6 + tempR6_T = TRANSPOSE(tempR6) + + ! Move damping ratio from material frame to the calculation reference frame + ! This is the following: + ! tempBeta6 = matmul(tempR6, matmul(diag(p%beta), transpose(tempR6))) + + ! Compute tempBeta_diag = beta * tempR6_T (for diagonal elements only) + do j = 1, 6 + tempBeta_diag(j) = p%beta(j) * tempR6_T(j, j) + end do + + ! Compute tempBeta6 using tempBeta_diag + do j = 1, 6 + do i = 1, 6 + tempBeta6(i, j) = tempR6(i, j) * tempBeta_diag(j) + end do + end do + + !> Modify the Mass matrix so it is in the calculation reference frame + !! \f$ \begin{bmatrix} + !! \left(\underline{\underline{R}} \underline{\underline{R}}_0\right) & 0 \\ + !! 0 & \left(\underline{\underline{R}} \underline{\underline{R}}_0\right) + !! \end{bmatrix} + !! \underline{\underline{C}} + !! \begin{bmatrix} + !! \left(\underline{\underline{R}} \underline{\underline{R}}_0\right)^T & 0 \\ + !! 0 & \left(\underline{\underline{R}} \underline{\underline{R}}_0\right)^T + !! \end{bmatrix} \f$ + Stif = matmul(tempR6, matmul(Stif0, tempR6_T)) + + ! Now apply the damping + betaC = matmul(tempBeta6, Stif) + end subroutine END SUBROUTINE BD_StifAtDeformedQP @@ -2634,23 +2654,35 @@ SUBROUTINE BD_QPData_mEta_rho( p, m ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables INTEGER(IntKi) :: nelem !< index to current element number + INTEGER(IntKi) :: qp_start !< index to start qp indexing for element INTEGER(IntKi) :: idx_qp !< index to the current quadrature point - DO nelem=1,p%elem_total - DO idx_qp=1,p%nqp + do nelem = 1, p%elem_total + qp_start = (nelem-1)*p%nqp + do idx_qp = 1, p%nqp + call Calc_RR0mEta_rho(m%qp%RR0(:,:,idx_qp,nelem), & + p%Mass0_QP(:,:,qp_start+idx_qp), & + m%qp%RR0mEta(:,idx_qp,nelem), & + m%qp%rho(:,:,idx_qp,nelem)) + end do + end do + +contains + subroutine Calc_RR0mEta_rho(RR0, Mass0, RR0mEta, rho) + real(BDKi), intent(in) :: RR0(:,:), Mass0(:,:) + real(BDKi), intent(out) :: RR0mEta(:), rho(:,:) + !> Calculate the new center of mass times mass at the deflected location !! as \f$ \left(\underline{\underline{R}}\underline{\underline{R}}_0\right) m \underline{\eta} \f$ - m%qp%RR0mEta(:,idx_qp,nelem) = MATMUL(m%qp%RR0(:,:,idx_qp,nelem),p%qp%mEta(:,idx_qp,nelem)) + m%qp%RR0mEta(:,idx_qp,nelem) = MATMUL(RR0, p%qp%mEta(:,idx_qp,nelem)) !> Calculate \f$ \rho = \left(\underline{\underline{R}}\underline{\underline{R}}_0\right) !! \underline{\underline{M}}_{2,2} !! \left(\underline{\underline{R}}\underline{\underline{R}}_0\right)^T \f$ where !! \f$ \underline{\underline{M}}_{2,2} \f$ is the inertial terms of the undeflected mass matrix at this quadrature point - m%qp%rho(:,:,idx_qp,nelem) = p%Mass0_QP(4:6,4:6,(nelem-1)*p%nqp+idx_qp) - m%qp%rho(:,:,idx_qp,nelem) = MATMUL(m%qp%RR0(:,:,idx_qp,nelem),MATMUL(m%qp%rho(:,:,idx_qp,nelem),TRANSPOSE(m%qp%RR0(:,:,idx_qp,nelem)))) - ENDDO - ENDDO + rho = MATMUL(RR0, MATMUL(Mass0(4:6,4:6), TRANSPOSE(RR0))) + end subroutine END SUBROUTINE BD_QPData_mEta_rho @@ -2667,99 +2699,117 @@ SUBROUTINE BD_ElasticForce(nelem,p,m,fact) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables. LOGICAL, INTENT(IN ) :: fact !< Boolean to calculate the Jacobian - REAL(BDKi) :: cet !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term - REAL(BDKi) :: k1s - REAL(BDKi) :: Wrk33(3,3) - REAL(BDKi) :: tildeE(3,3) - REAL(BDKi) :: C21(3,3) - REAL(BDKi) :: epsi(3,3) - REAL(BDKi) :: mu(3,3) + INTEGER(IntKi) :: idx_qp !< Index to quadrature point currently being calculated if (.not. fact) then - do idx_qp=1,p%nqp - call Calc_Fc_Fd() + call Calc_Fc_Fd(m%qp%RR0(:,:,idx_qp,nelem), & + m%qp%uuu(:,idx_qp,nelem), & + m%qp%E1(:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Fd(:,idx_qp,nelem)) end do - else - do idx_qp=1,p%nqp - - call Calc_Fc_Fd() - - - !> ###Calculate the \f$ \underline{\underline{\mathcal{O}}} \f$ from equation (19) - !! - !! \f$ \underline{\underline{\mathcal{O}}} = - !! \begin{bmatrix} - !! \underline{\underline{0}} & \underline{\underline{C}}_{11} \tilde{E}_1 - \tilde{F} \\ - !! \underline{\underline{0}} & \underline{\underline{C}}_{21} \tilde{E}_1 - \tilde{M} - !! \end{bmatrix} - !! = \begin{bmatrix} - !! \underline{\underline{0}} & \psi_E - \tilde{F} \\ - !! \underline{\underline{0}} & \mu - \tilde{M} - !! \end{bmatrix} - !! \f$ - Wrk33(:,:) = OuterProduct(m%qp%RR0(1:3,3,idx_qp,nelem), m%qp%RR0(1:3,3,idx_qp,nelem)) ! z-direction in IEC coords - C21(:,:) = m%qp%Stif(4:6,1:3,idx_qp,nelem) + cet*k1s*Wrk33(:,:) - - tildeE = SkewSymMat(m%qp%E1(:,idx_qp,nelem)) - epsi(:,:) = MATMUL(m%qp%Stif(1:3,1:3,idx_qp,nelem),tildeE) ! Stif is RR0 * p%Stif0_QP * RR0^T - mu(:,:) = MATMUL(C21,tildeE) - - m%qp%Oe(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Oe(1:3,4:6,idx_qp,nelem) = epsi(1:3,1:3) - SkewSymMat(m%qp%Fc(1:3,idx_qp,nelem)) - m%qp%Oe(4:6,4:6,idx_qp,nelem) = mu(1:3,1:3) - SkewSymMat(m%qp%Fc(4:6,idx_qp,nelem)) - - - !> ###Calculated \f$ \underline{\underline{\mathcal{P}}} \f$ from equation (20) - !! - !! \f$ \underline{\underline{\mathcal{P}}} = - !! \begin{bmatrix} - !! \underline{\underline{0}} & \underline{\underline{0}} \\ - !! \left(\underline{\underline{\bar{C}}}_{11} \tilde{E}_1 \right)^T + \tilde{F} - !! \left(\underline{\underline{\bar{C}}}_{11} \tilde{E}_1 \right)^T - !! \end{bmatrix} - !! = \begin{bmatrix} - !! \underline{\underline{0}} & \underline{\underline{0}} \\ - !! \psi_E^T + \tilde{F} & \mu^T - !! \end{bmatrix} \f$ - m%qp%Pe(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Pe(4:6,1:3,idx_qp,nelem) = TRANSPOSE(epsi) + SkewSymMat(m%qp%Fc(1:3,idx_qp,nelem)) - m%qp%Pe(4:6,4:6,idx_qp,nelem) = TRANSPOSE(mu) - - !> ###Calculated \f$ \underline{\underline{\mathcal{Q}}} \f$ from equation (21) - !! - !! \f{eqnarray*}{ - !! \underline{\underline{\mathcal{Q}}} - !! & =& \underline{\underline{\Upsilon}} \underline{\underline{\mathcal{O}}} - !! = \begin{bmatrix} 0 & 0 \\ - !! \tilde{E}_1^T & 0 \end{bmatrix} - !! \underline{\underline{\mathcal{O}}} \\ - !! \begin{bmatrix} 0 & 0 \\ - !! 0 & \underline{\underline{\mathcal{Q}}}_{22} \end{bmatrix} - !! & =& \tilde{E}_1^T \underline{\underline{\mathcal{O}}}_{12} - !! = - \tilde{E}_1 \underline{\underline{\mathcal{O}}}_{12} - !! \f}\n - !! Note: \f$ \tilde{E}_1^T = - \tilde{E}_1 \f$ - m%qp%Qe(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Qe(4:6,4:6,idx_qp,nelem) = -MATMUL(tildeE,m%qp%Oe(1:3,4:6,idx_qp,nelem)) + call Calc_Fc_Fd(m%qp%RR0(:,:,idx_qp,nelem), & + m%qp%uuu(:,idx_qp,nelem), & + m%qp%E1(:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Fd(:,idx_qp,nelem)) + + call Calc_Oe_Pe_Qe(m%qp%RR0(:,:,idx_qp,nelem), & + m%qp%Stif(:,:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Oe(:,:,idx_qp,nelem), & + m%qp%Pe(:,:,idx_qp,nelem), & + m%qp%Qe(:,:,idx_qp,nelem)) end do - - ENDIF + end if contains - subroutine Calc_Fc_Fd() - REAL(BDKi) :: e1s - REAL(BDKi) :: eee(6) !< intermediate array for calculation Strain and curvature terms of Fc - REAL(BDKi) :: fff(6) !< intermediate array for calculation of the elastic force, Fc - REAL(BDKi) :: R(3,3) !< rotation matrix at quatrature point - REAL(BDKi) :: Rx0p(3) !< \f$ \underline{R} \underline{x}^\prime_0 \f$ - !REAL(BDKi) :: Wrk(3) - + subroutine Calc_Oe_Pe_Qe(RR0, Stif, Fc, Oe, Pe, Qe) + REAL(BDKi), intent(in) :: RR0(:,:), Stif(:,:), Fc(:) + REAL(BDKi), intent(inout) :: Oe(:,:), Pe(:,:), Qe(:,:) + REAL(BDKi) :: Wrk33(3,3) + REAL(BDKi) :: tildeE(3,3) + REAL(BDKi) :: C21(3,3) + REAL(BDKi) :: epsi(3,3) + REAL(BDKi) :: mu(3,3) + REAL(BDKi) :: cet !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term + REAL(BDKi) :: k1s + + !> ###Calculate the \f$ \underline{\underline{\mathcal{O}}} \f$ from equation (19) + !! + !! \f$ \underline{\underline{\mathcal{O}}} = + !! \begin{bmatrix} + !! \underline{\underline{0}} & \underline{\underline{C}}_{11} \tilde{E}_1 - \tilde{F} \\ + !! \underline{\underline{0}} & \underline{\underline{C}}_{21} \tilde{E}_1 - \tilde{M} + !! \end{bmatrix} + !! = \begin{bmatrix} + !! \underline{\underline{0}} & \psi_E - \tilde{F} \\ + !! \underline{\underline{0}} & \mu - \tilde{M} + !! \end{bmatrix} + !! \f$ + Wrk33 = OuterProduct(RR0(1:3,3), RR0(1:3,3)) ! z-direction in IEC coords + C21 = Stif(4:6,1:3) + cet*k1s*Wrk33(:,:) + + tildeE = SkewSymMat(m%qp%E1(:,idx_qp,nelem)) + epsi = MATMUL(Stif(1:3,1:3),tildeE) ! Stif is RR0 * p%Stif0_QP * RR0^T + mu = MATMUL(C21,tildeE) + + Oe = 0.0_BDKi + Oe(1:3,4:6) = epsi(1:3,1:3) - SkewSymMat(Fc(1:3)) + Oe(4:6,4:6) = mu(1:3,1:3) - SkewSymMat(Fc(4:6)) + + + !> ###Calculated \f$ \underline{\underline{\mathcal{P}}} \f$ from equation (20) + !! + !! \f$ \underline{\underline{\mathcal{P}}} = + !! \begin{bmatrix} + !! \underline{\underline{0}} & \underline{\underline{0}} \\ + !! \left(\underline{\underline{\bar{C}}}_{11} \tilde{E}_1 \right)^T + \tilde{F} + !! \left(\underline{\underline{\bar{C}}}_{11} \tilde{E}_1 \right)^T + !! \end{bmatrix} + !! = \begin{bmatrix} + !! \underline{\underline{0}} & \underline{\underline{0}} \\ + !! \psi_E^T + \tilde{F} & \mu^T + !! \end{bmatrix} \f$ + Pe = 0.0_BDKi + Pe(4:6,1:3) = TRANSPOSE(epsi) + SkewSymMat(Fc(1:3)) + Pe(4:6,4:6) = TRANSPOSE(mu) + + !> ###Calculated \f$ \underline{\underline{\mathcal{Q}}} \f$ from equation (21) + !! + !! \f{eqnarray*}{ + !! \underline{\underline{\mathcal{Q}}} + !! & =& \underline{\underline{\Upsilon}} \underline{\underline{\mathcal{O}}} + !! = \begin{bmatrix} 0 & 0 \\ + !! \tilde{E}_1^T & 0 \end{bmatrix} + !! \underline{\underline{\mathcal{O}}} \\ + !! \begin{bmatrix} 0 & 0 \\ + !! 0 & \underline{\underline{\mathcal{Q}}}_{22} \end{bmatrix} + !! & =& \tilde{E}_1^T \underline{\underline{\mathcal{O}}}_{12} + !! = - \tilde{E}_1 \underline{\underline{\mathcal{O}}}_{12} + !! \f}\n + !! Note: \f$ \tilde{E}_1^T = - \tilde{E}_1 \f$ + Qe(:,:) = 0.0_BDKi + Qe(4:6,4:6) = -MATMUL(tildeE,Oe(1:3,4:6)) + end subroutine + + subroutine Calc_Fc_Fd(RR0, uuu, E1, Fc, Fd) + REAL(BDKi), intent(in) :: RR0(:,:), uuu(:), E1(:) + REAL(BDKi), intent(inout) :: Fc(:), Fd(:) + REAL(BDKi) :: e1s + REAL(BDKi) :: eee(6) !< intermediate array for calculation Strain and curvature terms of Fc + REAL(BDKi) :: fff(6) !< intermediate array for calculation of the elastic force, Fc + REAL(BDKi) :: R(3,3) !< rotation matrix at quatrature point + REAL(BDKi) :: Rx0p(3) !< \f$ \underline{R} \underline{x}^\prime_0 \f$ + REAL(BDKi) :: Wrk(3) + REAL(BDKi) :: cet !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term + REAL(BDKi) :: k1s !> ### Calculate the 1D strain, \f$ \underline{\epsilon} \f$, equation (5) !! \f$ \underline{\epsilon} = \underline{x}^\prime_0 + \underline{u}^\prime - @@ -2772,9 +2822,9 @@ subroutine Calc_Fc_Fd() !! Note: \f$ \underline{\underline{R}}\underline{\underline{R}}_0 \f$ is used to go from the material basis into the inertial basis !! and the transpose for the other direction. ! eee(1:3) = m%qp%E1(1:3,idx_qp,nelem) - m%qp%RR0(1:3,3,idx_qp,nelem) ! Using RR0 z direction in IEC coords - call BD_CrvMatrixR(m%qp%uuu(4:6,idx_qp,nelem), R) ! Get rotation at QP as a matrix + call BD_CrvMatrixR(uuu(4:6), R) ! Get rotation at QP as a matrix Rx0p = matmul(R,p%E10(:,idx_qp,nelem)) ! Calculate rotated initial tangent - eee(1:3) = m%qp%E1(1:3,idx_qp,nelem) - Rx0p ! Use rotated initial tangent in place of RR0*i1 to eliminate likely mismatch between R0*i1 and x0' + eee(1:3) = E1(1:3) - Rx0p ! Use rotated initial tangent in place of RR0*i1 to eliminate likely mismatch between R0*i1 and x0' !> ### Set the 1D sectional curvature, \f$ \underline{\kappa} \f$, equation (5) !! \f$ \underline{\kappa} = \underline{k} + \underline{\underline{R}}\underline{k}_i \f$ @@ -2839,11 +2889,11 @@ subroutine Calc_Fc_Fd() ! Strain into the material basis (eq (39) of Dymore manual) !Wrk(:) = MATMUL(TRANSPOSE(m%qp%RR0(:,:,idx_qp,nelem)),eee(1:3)) !e1s = Wrk(3) !epsilon_{1} in material basis (for major axis of blade, which is z in the IEC formulation) - e1s = dot_product( m%qp%RR0(:,3,idx_qp,nelem), eee(1:3) ) + e1s = dot_product( RR0(:,3), eee(1:3) ) !Wrk(:) = MATMUL(TRANSPOSE(m%qp%RR0(:,:,idx_qp,nelem)),eee(4:6)) !k1s = Wrk(3) !kappa_{1} in material basis (for major axis of blade, which is z in the IEC formulation) - k1s = dot_product( m%qp%RR0(:,3,idx_qp,nelem), eee(4:6) ) + k1s = dot_product( RR0(:,3), eee(4:6) ) !> Add extension twist coupling terms to the \f$ \underline{F}^c_{a} \f$\n @@ -2862,8 +2912,8 @@ subroutine Calc_Fc_Fd() !! \f$ C_{et} = C_{4,4} + C_{5,5} \f$ ! Refer Section 1.4 in "Dymore User's Manual - Formulation and finite element implementation of beam elements". cet= p%Stif0_QP(4,4,(nelem-1)*p%nqp+idx_qp) + p%Stif0_QP(5,5,(nelem-1)*p%nqp+idx_qp) ! Dymore theory (22) - m%qp%Fc(1:3,idx_qp,nelem) = fff(1:3) + 0.5_BDKi*cet*k1s*k1s*m%qp%RR0(1:3,3,idx_qp,nelem) ! Dymore theory (25a). Note z-axis is the length of blade. - m%qp%Fc(4:6,idx_qp,nelem) = fff(4:6) + cet*e1s*k1s*m%qp%RR0(1:3,3,idx_qp,nelem) ! Dymore theory (25b). Note z-axis is the length of blade. + Fc(1:3) = fff(1:3) + 0.5_BDKi*cet*k1s*k1s*RR0(1:3,3) ! Dymore theory (25a). Note z-axis is the length of blade. + Fc(4:6) = fff(4:6) + cet*e1s*k1s*RR0(1:3,3) ! Dymore theory (25b). Note z-axis is the length of blade. !> ###Calculate \f$ \underline{\mathcal{F}}^d \f$, equation (16) !! \f$ \underline{F}^d = @@ -2874,9 +2924,9 @@ subroutine Calc_Fc_Fd() !! = \begin{bmatrix} \underline{0} \\ !! \left(\underline{\mathcal{F}}^c \times \underline{E}_1 \right)^T !! \end{bmatrix} \f$ - m%qp%Fd(1:3,idx_qp,nelem) = 0.0_BDKi + Fd(1:3) = 0.0_BDKi ! ADP uu0 ref: If E1 is referenced against a different curve than Stif0_QP, there will be strange coupling terms here. - m%qp%Fd(4:6,idx_qp,nelem) = cross_product(m%qp%Fc(1:3,idx_qp,nelem), m%qp%E1(:,idx_qp,nelem)) + Fd(4:6) = cross_product(Fc(1:3), E1(:)) end subroutine Calc_Fc_Fd END SUBROUTINE BD_ElasticForce @@ -2897,32 +2947,29 @@ SUBROUTINE BD_QPDataVelocity( p, x, m ) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi) :: ErrStat !< index to current element + CHARACTER(ErrMsgLen) :: ErrMsg !< index to current element INTEGER(IntKi) :: nelem !< index to current element INTEGER(IntKi) :: idx_qp !< index to quadrature point - INTEGER(IntKi) :: idx_node !< index to the GLL node INTEGER(IntKi) :: elem_start !< Starting quadrature point of current element - DO nelem=1,p%elem_total - - elem_start = p%node_elem_idx(nelem,1) - - DO idx_qp=1,p%nqp + ! Calculate the velocity term, velocity prime (derivative of velocity with respect to X-axis), and acceleration terms - !> Calculate the values for the + ! Loop through elements + do nelem = 1, p%elem_total - ! Initialize to zero for summation - m%qp%vvv(:,idx_qp,nelem) = 0.0_BDKi - m%qp%vvp(:,idx_qp,nelem) = 0.0_BDKi + ! Get start index of quadrature points for given element + elem_start = p%node_elem_idx(nelem,1) - ! Calculate the velocity term, velocity prime (derivative of velocity with respect to X-axis), and acceleration terms - DO idx_node=1,p%nodes_per_elem - m%qp%vvv(:,idx_qp,nelem) = m%qp%vvv(:,idx_qp,nelem) + p%Shp(idx_node,idx_qp) * x%dqdt(:,elem_start-1+idx_node) - m%qp%vvp(:,idx_qp,nelem) = m%qp%vvp(:,idx_qp,nelem) + p%ShpDer(idx_node,idx_qp)/p%Jacobian(idx_qp,nelem) * x%dqdt(:,elem_start-1+idx_node) - ENDDO + ! Use matrix multiplication to interpolate velocity and velocity derivative to quadrature points + call LAPACK_DGEMM('N','N', 1.0_BDKi, x%dqdt(:,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%vvv(:,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, x%dqdt(:,elem_start:elem_start+p%nodes_per_elem-1), p%ShpDer, 0.0_BDKi, m%qp%vvp(:,:,nelem), ErrStat, ErrMsg) - ENDDO - - ENDDO + ! Apply Jacobian to get velocity derivative with respect to X-axis + do idx_qp = 1, p%nqp + m%qp%vvp(:,idx_qp,nelem) = m%qp%vvp(:,idx_qp,nelem) / p%Jacobian(idx_qp,nelem) + end do + end do END SUBROUTINE BD_QPDataVelocity @@ -2942,30 +2989,22 @@ SUBROUTINE BD_QPDataAcceleration( p, OtherState, m ) TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t on input; at t+dt on outputs TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi) :: ErrStat !< index to current element + CHARACTER(ErrMsgLen) :: ErrMsg !< index to current element INTEGER(IntKi) :: nelem !< index of current element INTEGER(IntKi) :: idx_qp !< index of current quadrature point INTEGER(IntKi) :: idx_node INTEGER(IntKi) :: elem_start - - - ! Initialize to zero for summation - m%qp%aaa = 0.0_BDKi - - ! Calculate the acceleration term at t+dt (OtherState%acc is at t+dt) - - DO nelem=1,p%elem_total + ! Loop through elements + do nelem = 1, p%elem_total elem_start = p%node_elem_idx(nelem,1) - DO idx_qp=1,p%nqp - DO idx_node=1,p%nodes_per_elem - m%qp%aaa(:,idx_qp,nelem) = m%qp%aaa(:,idx_qp,nelem) + p%Shp(idx_node,idx_qp) * OtherState%acc(:,elem_start-1+idx_node) - END DO - END DO + ! Interpolate the acceleration term at t+dt (OtherState%acc is at t+dt) to quadrature points + call LAPACK_DGEMM('N','N', 1.0_BDKi, OtherState%acc(:,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%aaa(:,:,nelem), ErrStat, ErrMsg) - END DO - + end do END SUBROUTINE BD_QPDataAcceleration @@ -3053,23 +3092,18 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables LOGICAL, INTENT(IN ) :: fact - REAL(BDKi) :: SS_ome(3,3) - REAL(BDKi) :: ffd(6) - REAL(BDKi) :: D11(3,3) - REAL(BDKi) :: D12(3,3) - REAL(BDKi) :: D21(3,3) - REAL(BDKi) :: D22(3,3) - REAL(BDKi) :: b11(3,3) - REAL(BDKi) :: b12(3,3) - REAL(BDKi) :: alpha(3,3) - INTEGER(IntKi) :: idx_qp !< index of current quadrature point - - + IF (.NOT. fact) then ! skip all but Fc and Fd terms - DO idx_qp=1,p%nqp - call Calc_FC_FD_ffd() ! this modifies m%qp%Fc and m%qp%Fd + DO idx_qp=1,p%nqp + ! this modifies m%qp%Fc and m%qp%Fd + CALL Calc_FC_FD_ffd(m%qp%E1(:,idx_qp,nelem), & + m%qp%vvv(:,idx_qp,nelem), & + m%qp%vvp(:,idx_qp,nelem), & + m%qp%betaC(:,:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Fd(:,idx_qp,nelem)) END DO ! bjj: we don't use these values when fact is FALSE, so let's save time and ignore them here, too. @@ -3082,72 +3116,100 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) ! m%qp%Yd(:,:,:,nelem) = 0.0_BDKi ELSE -!FIXME: sometime we can condense this with vector arithmetic and removing some variables that aren't needed. DO idx_qp=1,p%nqp - CALL Calc_FC_FD_ffd() ! this sets local variable ffd and modifies m%qp%Fc and m%qp%Fd - - D11 = m%qp%betaC(1:3,1:3,idx_qp,nelem) - D12 = m%qp%betaC(1:3,4:6,idx_qp,nelem) - D21 = m%qp%betaC(4:6,1:3,idx_qp,nelem) - D22 = m%qp%betaC(4:6,4:6,idx_qp,nelem) - - b11(1:3,1:3) = -MATMUL(SkewSymMat(m%qp%E1(:,idx_qp,nelem)),D11) - b12(1:3,1:3) = -MATMUL(SkewSymMat(m%qp%E1(:,idx_qp,nelem)),D12) - - SS_ome = SkewSymMat( m%qp%vvv(4:6,idx_qp,nelem) ) - - ! Compute stiffness matrix Sd - m%qp%Sd(1:3,1:3,idx_qp,nelem) = -MATMUL(D11,SS_ome) - m%qp%Sd(1:3,4:6,idx_qp,nelem) = -MATMUL(D12,SS_ome) - m%qp%Sd(4:6,1:3,idx_qp,nelem) = -MATMUL(D21,SS_ome) - m%qp%Sd(4:6,4:6,idx_qp,nelem) = -MATMUL(D22,SS_ome) - - ! Compute stiffness matrix Pd - m%qp%Pd(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Pd(4:6,1:3,idx_qp,nelem) = SkewSymMat(ffd(1:3)) - MATMUL(b11,SS_ome) - m%qp%Pd(4:6,4:6,idx_qp,nelem) = -MATMUL(b12,SS_ome) - - ! Compute stiffness matrix Od - m%qp%Od(:,1:3,idx_qp,nelem) = 0.0_BDKi - alpha = SkewSymMat(m%qp%vvp(1:3,idx_qp,nelem)) - MATMUL(SS_ome,SkewSymMat(m%qp%E1(:,idx_qp,nelem))) - m%qp%Od(1:3,4:6,idx_qp,nelem) = MATMUL(D11,alpha) - SkewSymMat(ffd(1:3)) - m%qp%Od(4:6,4:6,idx_qp,nelem) = MATMUL(D21,alpha) - SkewSymMat(ffd(4:6)) - - ! Compute stiffness matrix Qd - m%qp%Qd(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Qd(4:6,4:6,idx_qp,nelem) = -MATMUL(SkewSymMat(m%qp%E1(:,idx_qp,nelem)),m%qp%Od(1:3,4:6,idx_qp,nelem)) - ! Compute gyroscopic matrix Gd - m%qp%Gd(:,1:3,idx_qp,nelem) = 0.0_BDKi - m%qp%Gd(1:3,4:6,idx_qp,nelem) = TRANSPOSE(b11) - m%qp%Gd(4:6,4:6,idx_qp,nelem) = TRANSPOSE(b12) - - ! Compute gyroscopic matrix Xd - m%qp%Xd(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Xd(4:6,4:6,idx_qp,nelem) = -MATMUL(SkewSymMat(m%qp%E1(:,idx_qp,nelem)),m%qp%Gd(1:3,4:6,idx_qp,nelem)) - - ! Compute gyroscopic matrix Yd - m%qp%Yd(1:3,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Yd(4:6,1:3,idx_qp,nelem) = b11 - m%qp%Yd(4:6,4:6,idx_qp,nelem) = b12 + ! this sets local variable ffd and modifies m%qp%Fc and m%qp%Fd + CALL Calc_FC_FD_ffd(m%qp%E1(:,idx_qp,nelem), & + m%qp%vvv(:,idx_qp,nelem), & + m%qp%vvp(:,idx_qp,nelem), & + m%qp%betaC(:,:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Fd(:,idx_qp,nelem)) + + call Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(m%qp%E1(:,idx_qp,nelem), & + m%qp%vvp(:,idx_qp,nelem), & + m%qp%betaC(:,:,idx_qp,nelem), & + m%qp%Sd(:,:,idx_qp,nelem), & + m%qp%Od(:,:,idx_qp,nelem), & + m%qp%Qd(:,:,idx_qp,nelem), & + m%qp%Gd(:,:,idx_qp,nelem), & + m%qp%Xd(:,:,idx_qp,nelem), & + m%qp%Yd(:,:,idx_qp,nelem), & + m%qp%Pd(:,:,idx_qp,nelem)) END DO ENDIF CONTAINS - SUBROUTINE Calc_FC_FD_ffd() - REAL(BDKi) :: eed(6) - + subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, Sd, Od, Qd, Gd, Xd, Yd, Pd) + REAL(BDKi), intent(in) :: E1(:), vvp(:), betaC(:,:) + REAL(BDKi), intent(inout) :: Sd(:,:), Od(:,:), Qd(:,:), Gd(:,:), Xd(:,:), Yd(:,:), Pd(:,:) + REAL(BDKi) :: D11(3,3), D12(3,3), D21(3,3), D22(3,3) + REAL(BDKi) :: b11(3,3), b12(3,3) + REAL(BDKi) :: alpha(3,3) + REAL(BDKi) :: SS_ome(3,3) + REAL(BDKi) :: ffd(6) + + D11 = betaC(1:3,1:3) + D12 = betaC(1:3,4:6) + D21 = betaC(4:6,1:3) + D22 = betaC(4:6,4:6) + + b11(1:3,1:3) = -MATMUL(SkewSymMat(E1),D11) + b12(1:3,1:3) = -MATMUL(SkewSymMat(E1),D12) + + SS_ome = SkewSymMat( m%qp%vvv(4:6,idx_qp,nelem) ) + + ! Compute stiffness matrix Sd + Sd(1:3,1:3) = -MATMUL(D11,SS_ome) + Sd(1:3,4:6) = -MATMUL(D12,SS_ome) + Sd(4:6,1:3) = -MATMUL(D21,SS_ome) + Sd(4:6,4:6) = -MATMUL(D22,SS_ome) + + ! Compute stiffness matrix Pd + Pd = 0.0_BDKi + Pd(4:6,1:3) = SkewSymMat(ffd(1:3)) - MATMUL(b11,SS_ome) + Pd(4:6,4:6) = -MATMUL(b12,SS_ome) + + ! Compute stiffness matrix Od + alpha = SkewSymMat(vvp(1:3)) - MATMUL(SS_ome,SkewSymMat(E1)) + Od(:,1:3) = 0.0_BDKi + Od(1:3,4:6) = MATMUL(D11,alpha) - SkewSymMat(ffd(1:3)) + Od(4:6,4:6) = MATMUL(D21,alpha) - SkewSymMat(ffd(4:6)) + + ! Compute stiffness matrix Qd + Qd = 0.0_BDKi + Qd(4:6,4:6) = -MATMUL(SkewSymMat(E1),Od(1:3,4:6)) + + ! Compute gyroscopic matrix Gd + Gd(:,1:3) = 0.0_BDKi + Gd(1:3,4:6) = TRANSPOSE(b11) + Gd(4:6,4:6) = TRANSPOSE(b12) + + ! Compute gyroscopic matrix Xd + Xd = 0.0_BDKi + Xd(4:6,4:6) = -MATMUL(SkewSymMat(E1),Gd(1:3,4:6)) + + ! Compute gyroscopic matrix Yd + Yd(1:3,:) = 0.0_BDKi + Yd(4:6,1:3) = b11 + Yd(4:6,4:6) = b12 + end subroutine + + SUBROUTINE Calc_FC_FD_ffd(E1, vvv, vvp, betaC, Fc, Fd) + REAL(BDKi), intent(in) :: E1(:), vvv(:), vvp(:), betaC(:,:) + REAL(BDKi), intent(inout) :: Fc(:), Fd(:) + REAL(BDKi) :: eed(6), ffd(6) + ! Compute strain rates - eed = m%qp%vvp(1:6,idx_qp,nelem) - eed(1:3) = eed(1:3) + cross_product(m%qp%E1(:,idx_qp,nelem),m%qp%vvv(4:6,idx_qp,nelem)) + eed = vvp + eed(1:3) = eed(1:3) + cross_product(E1,vvv(4:6)) ! Compute dissipative force - ffd(1:6) = MATMUL(m%qp%betaC(:,:,idx_qp,nelem),eed) + ffd(1:6) = MATMUL(betaC(:,:),eed) - m%qp%Fc(1:6,idx_qp,nelem) = m%qp%Fc(1:6,idx_qp,nelem) + ffd - m%qp%Fd(4:6,idx_qp,nelem) = m%qp%Fd(4:6,idx_qp,nelem) + cross_product(ffd(1:3),m%qp%E1(:,idx_qp,nelem)) - + Fc(1:6) = Fc(1:6) + ffd + Fd(4:6) = Fd(4:6) + cross_product(ffd(1:3),E1) END SUBROUTINE Calc_FC_FD_ffd END SUBROUTINE BD_DissipativeForce @@ -3264,21 +3326,21 @@ SUBROUTINE BD_InertialMassMatrix( nelem, p, m ) INTEGER(IntKi) :: i INTEGER(IntKi) :: idx_qp !< index of current quadrature point - do idx_qp=1,p%nqp + m%qp%Mi(:,:,:,nelem) = 0.0_BDKi - m%qp%Mi(:,:,idx_qp,nelem) = 0.0_BDKi + do idx_qp=1,p%nqp ! Set diagonal values for mass DO i=1,3 - m%qp%Mi(i,i,idx_qp,nelem) = p%qp%mmm(idx_qp,nelem) + m%qp%Mi(idx_qp,i,i,nelem) = p%qp%mmm(idx_qp,nelem) ENDDO ! set mass-inertia coupling terms - m%qp%Mi(1:3,4:6,idx_qp,nelem) = -SkewSymMat(m%qp%RR0mEta(:,idx_qp,nelem)) - m%qp%Mi(4:6,1:3,idx_qp,nelem) = SkewSymMat(m%qp%RR0mEta(:,idx_qp,nelem)) + m%qp%Mi(idx_qp,1:3,4:6,nelem) = -SkewSymMat(m%qp%RR0mEta(:,idx_qp,nelem)) + m%qp%Mi(idx_qp,4:6,1:3,nelem) = SkewSymMat(m%qp%RR0mEta(:,idx_qp,nelem)) ! Set inertia terms - m%qp%Mi(4:6,4:6,idx_qp,nelem) = m%qp%rho(:,:,idx_qp,nelem) + m%qp%Mi(idx_qp,4:6,4:6,nelem) = m%qp%rho(:,:,idx_qp,nelem) end do @@ -3775,19 +3837,10 @@ SUBROUTINE Integrate_ElementForce(nelem, p, m) INTEGER(IntKi) :: idx_dof1 CHARACTER(*), PARAMETER :: RoutineName = 'Integrate_ElementForce' - DO i=1,p%nodes_per_elem - DO idx_dof1=1,p%dof_node - - m%elf(idx_dof1,i) = 0.0_BDKi - - DO idx_qp = 1,p%nqp ! dot_product( m%qp%Fc (idx_dof1,:,nelem), p%QPtw_ShpDer( :,i)) - m%elf(idx_dof1,i) = m%elf(idx_dof1,i) - m%qp%Fc (idx_dof1,idx_qp,nelem)*p%QPtw_ShpDer(idx_qp,i) - END DO - - DO idx_qp = 1,p%nqp ! dot_product(m%qp%Ftemp(idx_dof1,:,nelem), p%QPtw_Shp_Jac(:,i,nelem) ) - m%elf(idx_dof1,i) = m%elf(idx_dof1,i) - m%qp%Ftemp(idx_dof1,idx_qp,nelem)*p%QPtw_Shp_Jac(idx_qp,i,nelem) - END DO - + DO i = 1, p%nodes_per_elem + DO idx_dof1 = 1, p%dof_node + m%elf(idx_dof1,i) = -(dot_product(m%qp%Fc(idx_dof1,:,nelem), p%QPtw_ShpDer(:,i)) + & + dot_product(m%qp%Ftemp(idx_dof1,:,nelem), p%QPtw_Shp_Jac(:,i,nelem))) ENDDO ENDDO @@ -3800,31 +3853,28 @@ SUBROUTINE Integrate_ElementMass(nelem, p, m) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi) :: idx_qp - INTEGER(IntKi) :: i - INTEGER(IntKi) :: j - INTEGER(IntKi) :: idx_dof1, idx_dof2 CHARACTER(*), PARAMETER :: RoutineName = 'Integrate_ElementMass' - - DO j=1,p%nodes_per_elem - DO idx_dof2=1,p%dof_node - - DO i=1,p%nodes_per_elem - DO idx_dof1=1,p%dof_node - - m%elm(idx_dof1,i,idx_dof2,j) = 0.0_BDKi - - DO idx_qp = 1,p%nqp - m%elm(idx_dof1,i,idx_dof2,j) = m%elm(idx_dof1,i,idx_dof2,j) + m%qp%Mi(idx_dof1,idx_dof2,idx_qp,nelem)*p%QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) - END DO - - END DO - END DO - + INTEGER(IntKi) :: ErrStat + CHARACTER(ErrMsgLen) :: ErrMsg + INTEGER(IntKi) :: j + INTEGER(IntKi) :: idx_dof2 + ! INTEGER(IntKi) :: idx_qp + ! INTEGER(IntKi) :: i + ! INTEGER(IntKi) :: idx_dof1 + + DO j = 1, p%nodes_per_elem + DO idx_dof2 = 1, p%dof_node + ! DO i = 1, p%nodes_per_elem + ! DO idx_dof1 = 1, p%dof_node + ! do idx_qp = 1, p%nqp + ! m%elm(idx_dof1,i,idx_dof2,j) = m%elm(idx_dof1,i,idx_dof2,j) + (m%qp%Mi(idx_qp,idx_dof1,idx_dof2,nelem),p%QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem)) + ! end do + ! END DO + ! END DO + call LAPACK_gemm('T', 'N', 1.0_R8Ki, m%qp%Mi(:,:,idx_dof2,nelem), p%QPtw_Shp_Shp_Jac(:,:,j,nelem), 0.0_R8Ki, m%elm(:,:,idx_dof2,j), ErrStat, ErrMsg) END DO END DO - END SUBROUTINE Integrate_ElementMass @@ -5586,10 +5636,7 @@ SUBROUTINE BD_CalcForceAcc( u, p, OtherState, m, ErrStat, ErrMsg ) ! Add point forces at GLL points to RHS of equation. - DO j=1,p%node_total - m%RHS(1:3,j) = m%RHS(1:3,j) + m%PointLoadLcl(1:3,j) - m%RHS(4:6,j) = m%RHS(4:6,j) + m%PointLoadLcl(4:6,j) - ENDDO + m%RHS = m%RHS + m%PointLoadLcl ! Now set the root reaction force. @@ -6580,6 +6627,7 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) + real(R8Ki) :: NodeRot_old(3) real(R8Ki) :: GlbPos_old(3), GlbPos_new(3) integer(IntKi) :: i, j, temp_id @@ -6619,8 +6667,8 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) matmul(GlbRot_new, p%uuN0(1:3, j, i))) ! Update the node orientation rotation of the node - call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, x%q(4:6, temp_id), FLAG_R1R2) - + NodeRot_old = x%q(4:6, temp_id) + call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, NodeRot_old, FLAG_R1R2) end do end do diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index 519a40e589..c1b9796a07 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -242,32 +242,31 @@ SUBROUTINE BD_CrvCompose( rr, pp, qq, flag) REAL(BDKi), INTENT( OUT):: rr(3) !< Composed rotation REAL(BDKi), INTENT(IN ):: pp(3) !< Input rotation 1 REAL(BDKi), INTENT(IN ):: qq(3) !< Input rotation 2 - INTEGER ,INTENT(IN ):: flag !< Option flag + INTEGER, INTENT(IN ):: flag !< Option flag - REAL(BDKi) :: pp0 - REAL(BDKi) :: p(3) - REAL(BDKi) :: qq0 - REAL(BDKi) :: q(3) + REAL(BDKi) :: pp0, p(3) + REAL(BDKi) :: qq0, q(3) REAL(BDKi) :: tr1 - REAL(BDKi) :: Delta1 - REAL(BDKi) :: Delta2 + REAL(BDKi) :: Delta1, Delta2 REAL(BDKi) :: dd1 REAL(BDKi) :: dd2 - ! Set the local values pp and qq allowing for the transpose - - IF(flag==FLAG_R1TR2 .OR. flag==FLAG_R1TR2T) THEN ! "transpose" (negative) of first rotation parameter - p = -pp - ELSE - p = pp - ENDIF - - IF(flag==FLAG_R1R2T .OR. flag==FLAG_R1TR2T) THEN ! "transpose" (negative) of second rotation parameter - q = -qq - ELSE - q = qq - ENDIF + ! Set the local values pp (R1) and qq (R2) and apply transpose based on flag value + select case (flag) + case (FLAG_R1R2) + p = pp ! R1 + q = qq ! R2 + case (FLAG_R1R2T) + p = pp ! R1 + q = -qq ! R2^T + case (FLAG_R1TR2) + p = -pp ! R1^T + q = qq ! R2 + case (FLAG_R1TR2T) + p = -pp ! R1^T + q = -qq ! R2^T + end select !> ## Composing the resulting Wiener-Milenkovic parameter !! @@ -289,7 +288,6 @@ SUBROUTINE BD_CrvCompose( rr, pp, qq, flag) !! !! - ! Calculate pp0 and qq0. See Bauchau for the mathematics here (equations 8 to 9 and interviening text) pp0 = 2.0_BDKi - dot_product(p,p) / 8.0_BDKi ! p_0 @@ -297,19 +295,16 @@ SUBROUTINE BD_CrvCompose( rr, pp, qq, flag) Delta1 = (4.0_BDKi - pp0) * (4.0_BDKi - qq0) ! Delta_1 in Bauchau Delta2 = pp0 * qq0 - dot_product(p,q) ! Delta_2 in Bauchau - dd1 = Delta1 + Delta2 ! Denomimator term for \Delta_2 >= 0 - dd2 = Delta1 - Delta2 ! Denomimator term for \Delta_2 < 0 - ! Rescaling to remove singularities at +/- 2 \pi - ! Note: changed this to test on \Delta_2 (instead of dd1 > dd2) for better consistency with documentation. - IF ( Delta2 >= 0.0_BDKi ) THEN - tr1 = 4.0_BDKi / dd1 + ! Rescaling to remove singularities at +/- 2 \pi + ! Note: changed this to test on \Delta_2 (instead of dd1 > dd2) for better consistency with documentation. + IF (Delta2 >= 0.0_BDKi) THEN + tr1 = 4.0_BDKi / (Delta1 + Delta2) ELSE - tr1 = -4.0_BDKi / dd2 + tr1 = -4.0_BDKi / (Delta1 - Delta2) ENDIF - rr = tr1 * (qq0*p + pp0*q + cross_product(p,q)) - + rr = tr1 * (qq0*p + pp0*q + Cross_Product(p,q)) END SUBROUTINE BD_CrvCompose diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index f4487e033c..3d9c5eadeb 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -1791,33 +1791,73 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & IF (.NOT. SrcMesh%Initialized) RETURN !bjj: maybe we should first CALL MeshDestroy(DestMesh,ErrStat, ErrMess) - IF ( CtrlCode .EQ. MESH_NEWCOPY .OR. CtrlCode .EQ. MESH_SIBLING .OR. CtrlCode .EQ. MESH_COUSIN ) THEN - - IF (CtrlCode .EQ. MESH_NEWCOPY) THEN - IOS_l = SrcMesh%IOS - Force_l = SrcMesh%FieldMask(MASKID_FORCE) - Moment_l = SrcMesh%FieldMask(MASKID_MOMENT) - Orientation_l = SrcMesh%FieldMask(MASKID_ORIENTATION) - TranslationDisp_l = SrcMesh%FieldMask(MASKID_TRANSLATIONDISP) - TranslationVel_l = SrcMesh%FieldMask(MASKID_TRANSLATIONVEL) - RotationVel_l = SrcMesh%FieldMask(MASKID_ROTATIONVEL) - TranslationAcc_l = SrcMesh%FieldMask(MASKID_TRANSLATIONACC) - RotationAcc_l = SrcMesh%FieldMask(MASKID_ROTATIONACC) - nScalars_l = SrcMesh%nScalars - ELSE ! Sibling or cousin - IOS_l = SrcMesh%IOS ; IF ( PRESENT(IOS) ) IOS_l = IOS - Force_l = .FALSE. ; IF ( PRESENT(Force) ) Force_l = Force - Moment_l = .FALSE. ; IF ( PRESENT(Moment) ) Moment_l = Moment - Orientation_l = .FALSE. ; IF ( PRESENT(Orientation) ) Orientation_l = Orientation - TranslationDisp_l = .FALSE. ; IF ( PRESENT(TranslationDisp) ) TranslationDisp_l = TranslationDisp - TranslationVel_l = .FALSE. ; IF ( PRESENT(TranslationVel) ) TranslationVel_l = TranslationVel - RotationVel_l = .FALSE. ; IF ( PRESENT(RotationVel) ) RotationVel_l = RotationVel - TranslationAcc_l = .FALSE. ; IF ( PRESENT(TranslationAcc) ) TranslationAcc_l = TranslationAcc - RotationAcc_l = .FALSE. ; IF ( PRESENT(RotationAcc) ) RotationAcc_l = RotationAcc - nScalars_l = 0 ; IF ( PRESENT(nScalars) ) nScalars_l = nScalars - END IF - - IF ( CtrlCode .EQ. MESH_NEWCOPY .OR. CtrlCode .EQ. MESH_COUSIN ) THEN + select case (CtrlCode) + case (MESH_NEWCOPY) + IOS_l = SrcMesh%IOS + Force_l = SrcMesh%FieldMask(MASKID_FORCE) + Moment_l = SrcMesh%FieldMask(MASKID_MOMENT) + Orientation_l = SrcMesh%FieldMask(MASKID_ORIENTATION) + TranslationDisp_l = SrcMesh%FieldMask(MASKID_TRANSLATIONDISP) + TranslationVel_l = SrcMesh%FieldMask(MASKID_TRANSLATIONVEL) + RotationVel_l = SrcMesh%FieldMask(MASKID_ROTATIONVEL) + TranslationAcc_l = SrcMesh%FieldMask(MASKID_TRANSLATIONACC) + RotationAcc_l = SrcMesh%FieldMask(MASKID_ROTATIONACC) + nScalars_l = SrcMesh%nScalars + case (MESH_SIBLING, MESH_COUSIN) + IF ( PRESENT(IOS) ) then + IOS_l = IOS + else + IOS_l = SrcMesh%IOS + end if + IF ( PRESENT(Force) ) then + Force_l = Force + else + Force_l = .FALSE. + end if + IF ( PRESENT(Moment) ) then + Moment_l = Moment + else + Moment_l = .FALSE. + end if + IF ( PRESENT(Orientation) ) then + Orientation_l = Orientation + else + Orientation_l = .FALSE. + end if + IF ( PRESENT(TranslationDisp) ) then + TranslationDisp_l = TranslationDisp + else + TranslationDisp_l = .FALSE. + end if + IF ( PRESENT(TranslationVel) ) then + TranslationVel_l = TranslationVel + else + TranslationVel_l = .FALSE. + end if + IF ( PRESENT(RotationVel) ) then + RotationVel_l = RotationVel + else + RotationVel_l = .FALSE. + end if + IF ( PRESENT(TranslationAcc) ) then + TranslationAcc_l = TranslationAcc + else + TranslationAcc_l = .FALSE. + end if + IF ( PRESENT(RotationAcc) ) then + RotationAcc_l = RotationAcc + else + RotationAcc_l = .FALSE. + end if + IF ( PRESENT(nScalars) ) then + nScalars_l = nScalars + else + nScalars_l = 0 + end if + end select + + select case (CtrlCode) + case (MESH_NEWCOPY, MESH_COUSIN) CALL MeshCreate( DestMesh, IOS=IOS_l, Nnodes=SrcMesh%Nnodes, ErrStat=ErrStat, ErrMess=ErrMess & ,Force=Force_l & @@ -1894,7 +1934,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%RemapFlag = SrcMesh%RemapFlag - ELSE IF ( CtrlCode .EQ. MESH_SIBLING ) THEN + case (MESH_SIBLING) !bjj: we should make sure the mesh has been committed, otherwise the element lists haven't been created, yet (and thus not shared) IF ( ASSOCIATED(SrcMesh%SiblingMesh) ) THEN ErrStat = ErrID_Fatal @@ -1936,17 +1976,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%maxelemlist = SrcMesh%maxelemlist DestMesh%nextelem = SrcMesh%nextelem - - ENDIF - - DO i = 1, NELEMKINDS - IF ( ASSOCIATED(SrcMesh%ElemTable) ) THEN - ENDIF - IF ( ASSOCIATED(DestMesh%ElemTable) ) THEN - ENDIF - ENDDO - - ELSE IF ( CtrlCode .EQ. MESH_UPDATECOPY ) THEN + case (MESH_UPDATECOPY) IF ( SrcMesh%nNodes .NE. DestMesh%nNodes ) THEN ErrStat = ErrID_Fatal @@ -1954,7 +1984,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & RETURN ENDIF - ELSE IF ( CtrlCode .EQ. MESH_UPDATEREFERENCE ) THEN + case (MESH_UPDATEREFERENCE) IF ( SrcMesh%nNodes .NE. DestMesh%nNodes ) THEN ErrStat = ErrID_Fatal @@ -1966,11 +1996,11 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%RefOrientation = SrcMesh%RefOrientation DestMesh%RemapFlag = SrcMesh%RemapFlag - ELSE + case default ErrStat = ErrID_Fatal ErrMess = 'MeshCopy: Invalid CtrlCode.' RETURN - ENDIF + end select ! These aren't shared between siblings, so they get copied, no matter what the CtrlCode: diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index 69cec3db98..fd63f374f3 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -3263,38 +3263,28 @@ FUNCTION GetLoadsScaleFactor( Src ) ! LOCAL: INTEGER :: I, j - REAL(ReKi) :: MaxLoad + REAL(ReKi) :: MaxLoad, MaxForce, MaxMoment + IF ( Src%FIELDMASK( MASKID_FORCE ) ) then + MaxForce = maxval(abs(src%Force)) + else + MaxForce = 0.0_ReKi + end if - GetLoadsScaleFactor = 1.0 - MaxLoad = 0.0 - - IF ( Src%FIELDMASK( MASKID_FORCE ) ) THEN - - DO I=1,Src%Nnodes - DO J=1,3 - MaxLoad = MAX(MaxLoad, ABS(Src%Force(j,I) ) ) - END DO - END DO - - END IF - + IF ( Src%FIELDMASK( MASKID_MOMENT ) ) then + MaxMoment = maxval(abs(src%Moment)) + else + MaxMoment = 0.0_ReKi + end if + + MaxLoad = max(MaxForce, MaxMoment) - IF ( Src%FIELDMASK( MASKID_MOMENT ) ) THEN - - DO I=1,Src%Nnodes - DO J=1,3 - MaxLoad = MAX(MaxLoad, ABS(Src%Moment(j,I) ) ) - END DO - END DO - - END IF - IF ( MaxLoad > 10. ) THEN GetLoadsScaleFactor = 10**MIN( NINT(log10(MaxLoad)), 15 ) ! Let's not get carried away and cause overflow; 10E15 is as far as we'll go + else + GetLoadsScaleFactor = 1.0_ReKi END IF - END FUNCTION GetLoadsScaleFactor !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE CreateLoadMap_P_to_P( Src, Dest, MeshMap, ErrStat, ErrMsg ) diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 1a13202796..0a5bf95040 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -492,7 +492,7 @@ END SUBROUTINE ConvertUnitsToEngr !> This function computes the cross product of two 3-element arrays (resulting in a vector): \n !! cross_product = Vector1 \f$\times\f$ Vector2 \n !! Use cross_product (nwtc_num::cross_product) instead of directly calling a specific routine in the generic interface. - FUNCTION Cross_ProductR4(Vector1, Vector2) result(CProd) + PURE FUNCTION Cross_ProductR4(Vector1, Vector2) result(CProd) ! Argument declarations. @@ -512,7 +512,7 @@ FUNCTION Cross_ProductR4(Vector1, Vector2) result(CProd) END FUNCTION Cross_ProductR4 !======================================================================= !> \copydoc nwtc_num::cross_productr4 - FUNCTION Cross_ProductR4R8(Vector1, Vector2) result(CProd) + PURE FUNCTION Cross_ProductR4R8(Vector1, Vector2) result(CProd) ! Argument declarations. @@ -532,7 +532,7 @@ FUNCTION Cross_ProductR4R8(Vector1, Vector2) result(CProd) END FUNCTION Cross_ProductR4R8 !======================================================================= !> \copydoc nwtc_num::cross_productr4 - FUNCTION Cross_ProductR8(Vector1, Vector2) result(CProd) + PURE FUNCTION Cross_ProductR8(Vector1, Vector2) result(CProd) ! Argument declarations. @@ -552,7 +552,7 @@ FUNCTION Cross_ProductR8(Vector1, Vector2) result(CProd) END FUNCTION Cross_ProductR8 !======================================================================= !> \copydoc nwtc_num::cross_productr4 - FUNCTION Cross_ProductR8R4(Vector1, Vector2) result(CProd) + PURE FUNCTION Cross_ProductR8R4(Vector1, Vector2) result(CProd) ! Argument declarations. From b57c17ec1ee280b8f7ab763ded41775e3ac66904 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 16 Aug 2024 17:26:00 +0000 Subject: [PATCH 170/319] Tight coupling appears to be working for the IEA15 --- modules/beamdyn/src/BeamDyn.f90 | 4 +- modules/openfast-library/src/FAST_AeroMap.f90 | 3 - modules/openfast-library/src/FAST_Funcs.f90 | 83 +++--- .../openfast-library/src/FAST_Registry.txt | 5 +- .../openfast-library/src/FAST_SolverTC.f90 | 273 ++++++++++-------- modules/openfast-library/src/FAST_Subs.f90 | 15 +- modules/openfast-library/src/FAST_Types.f90 | 40 --- .../openfast-library/src/Glue_Registry.txt | 1 - modules/openfast-library/src/Glue_Types.f90 | 18 -- 9 files changed, 201 insertions(+), 241 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 97a7c5cd03..49a9e20f29 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -58,7 +58,7 @@ MODULE BeamDyn ! follow the moving BladeRootMotion mesh. This requires changing the states after an UpdateStates call to be relative to ! the new BladeRootMotion mesh orientation and position. ! Update the reference frame after each State update (or use the old method)? - LOGICAL, PARAMETER :: ChangeRefFrame = .false. + LOGICAL, PARAMETER :: ChangeRefFrame = .true. CONTAINS @@ -923,7 +923,7 @@ subroutine SetParameters(InitInp, InputFileData, p, OtherState, ErrStat, ErrMsg) p%RotStates = InputFileData%RotStates ! Rotate states in linearization? - if (ChangeRefFrame) p%RotStates = .true. + ! if (ChangeRefFrame) p%RotStates = .true. p%rhoinf = InputFileData%rhoinf ! Numerical damping coefficient: [0,1]. No numerical damping if rhoinf = 1; maximum numerical damping if rhoinf = 0. p%dt = InputFileData%DTBeam ! Time step size diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 35251b8cb5..93f9f250d9 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -131,9 +131,6 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return - ! Set number of driver outputs - T%y_FAST%DriverWriteOutputNum = 6 - !---------------------------------------------------------------------------- ! Module Order !---------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 401a1247d9..ccf4442540 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -307,21 +307,6 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) case (Module_ED) ! State update is handled by solver as part of tight coupling - ! associate (p_ED => T%ED%p, m_ED => T%ED%m, & - ! u_ED => T%ED%Input(1), x_ED => T%ED%x(STATE_PRED)) - - ! Transfer tight coupling states to module - ! call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) - ! call ED_UnpackContStateOP(p_ED, m_ED%Jac%x, x_ED) - - ! Update the azimuth angle - call ED_UpdateAzimuth(T%ED%p, T%ED%x(STATE_PRED), ModData%DT) - - ! Transfer updated states to solver - ! call ED_PackContStateOP(p_ED, x_ED, m_ED%Jac%x) - - ! end associate - case (Module_ExtPtfm) call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return @@ -834,10 +819,10 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & T%ExtPtfm%OtherSt(iState), & T%ExtPtfm%m, T%ExtPtfm%m%dxdt_lin, & ErrStat2, ErrMsg2); if (Failed()) return - call ExtPtfm_VarsPackContState(ModData%Vars, T%ExtPtfm%m%dxdt_lin, dx_op) + call ExtPtfm_VarsPackContStateDeriv(ModData%Vars, T%ExtPtfm%m%dxdt_lin, dx_op) ! case (Module_FEAM) -! call FEAM_VarsPackContState(ModData%Vars, T%FEAM%x(StateIndex), dx_op) +! call FEAM_VarsPackContStateDeriv(ModData%Vars, T%FEAM%x(StateIndex), dx_op) case (Module_HD) call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(iIndex), T%HD%p, T%HD%x(iState), & @@ -911,37 +896,37 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_VarsPackContState(ModData%Vars, T%AD%x(iState)%rotors(ModData%Ins), z_op) + call AD_VarsPackConstrState(ModData%Vars, T%AD%z(iState)%rotors(ModData%Ins), z_op) case (Module_BD) - call BD_VarsPackContState(ModData%Vars, T%BD%x(ModData%Ins, iState), z_op) + call BD_VarsPackConstrState(ModData%Vars, T%BD%z(ModData%Ins, iState), z_op) case (Module_ED) - call ED_VarsPackContState(ModData%Vars, T%ED%x(iState), z_op) + call ED_VarsPackConstrState(ModData%Vars, T%ED%z(iState), z_op) case (Module_ExtPtfm) - call ExtPtfm_VarsPackContState(ModData%Vars, T%ExtPtfm%x(iState), z_op) + call ExtPtfm_VarsPackConstrState(ModData%Vars, T%ExtPtfm%z(iState), z_op) case (Module_FEAM) - call FEAM_VarsPackContState(ModData%Vars, T%FEAM%x(iState), z_op) + call FEAM_VarsPackConstrState(ModData%Vars, T%FEAM%z(iState), z_op) case (Module_HD) - call HydroDyn_VarsPackContState(ModData%Vars, T%HD%x(iState), z_op) + call HydroDyn_VarsPackConstrState(ModData%Vars, T%HD%z(iState), z_op) case (Module_IceD) - call IceD_VarsPackContState(ModData%Vars, T%IceD%x(ModData%Ins, iState), z_op) + call IceD_VarsPackConstrState(ModData%Vars, T%IceD%z(ModData%Ins, iState), z_op) case (Module_IceF) - call IceFloe_VarsPackContState(ModData%Vars, T%IceF%x(iState), z_op) + call IceFloe_VarsPackConstrState(ModData%Vars, T%IceF%z(iState), z_op) case (Module_IfW) - call InflowWind_VarsPackContState(ModData%Vars, T%IfW%x(iState), z_op) + call InflowWind_VarsPackConstrState(ModData%Vars, T%IfW%z(iState), z_op) case (Module_MAP) - call MAP_VarsPackContState(ModData%Vars, T%MAP%x(iState), z_op) + call MAP_VarsPackConstrState(ModData%Vars, T%MAP%z(iState), z_op) case (Module_MD) - call MD_VarsPackContState(ModData%Vars, T%MD%x(iState), z_op) + call MD_VarsPackConstrState(ModData%Vars, T%MD%z(iState), z_op) case (Module_ExtInfw) - ! call ExtInfw_VarsPackContState(ModData%Vars, T%ExtInfw%x(StateIndex), z_op) + ! call ExtInfw_VarsPackConstrState(ModData%Vars, T%ExtInfw%z(StateIndex), z_op) case (Module_Orca) - call Orca_VarsPackContState(ModData%Vars, T%Orca%x(iState), z_op) + call Orca_VarsPackConstrState(ModData%Vars, T%Orca%z(iState), z_op) case (Module_SD) - call SD_VarsPackContState(ModData%Vars, T%SD%x(iState), z_op) + call SD_VarsPackConstrState(ModData%Vars, T%SD%z(iState), z_op) case (Module_SeaSt) - call SeaSt_VarsPackContState(ModData%Vars, T%SeaSt%x(iState), z_op) + call SeaSt_VarsPackConstrState(ModData%Vars, T%SeaSt%z(iState), z_op) case (Module_SrvD) - call SrvD_VarsPackContState(ModData%Vars, T%SrvD%x(iState), z_op) + call SrvD_VarsPackConstrState(ModData%Vars, T%SrvD%z(iState), z_op) case default call SetErrStat(ErrID_Fatal, "Constraint State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -1081,37 +1066,37 @@ subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_VarsUnpackContState(ModData%Vars, z_op, T%AD%x(iState)%rotors(ModData%Ins)) + call AD_VarsUnpackConstrState(ModData%Vars, z_op, T%AD%z(iState)%rotors(ModData%Ins)) case (Module_BD) - call BD_VarsUnpackContState(ModData%Vars, z_op, T%BD%x(ModData%Ins, iState)) + call BD_VarsUnpackConstrState(ModData%Vars, z_op, T%BD%z(ModData%Ins, iState)) case (Module_ED) - call ED_VarsUnpackContState(ModData%Vars, z_op, T%ED%x(iState)) + call ED_VarsUnpackConstrState(ModData%Vars, z_op, T%ED%z(iState)) case (Module_ExtPtfm) - call ExtPtfm_VarsUnpackContState(ModData%Vars, z_op, T%ExtPtfm%x(iState)) + call ExtPtfm_VarsUnpackConstrState(ModData%Vars, z_op, T%ExtPtfm%z(iState)) case (Module_FEAM) - call FEAM_VarsUnpackContState(ModData%Vars, z_op, T%FEAM%x(iState)) + call FEAM_VarsUnpackConstrState(ModData%Vars, z_op, T%FEAM%z(iState)) case (Module_HD) - call HydroDyn_VarsUnpackContState(ModData%Vars, z_op, T%HD%x(iState)) + call HydroDyn_VarsUnpackConstrState(ModData%Vars, z_op, T%HD%z(iState)) case (Module_IceD) - call IceD_VarsUnpackContState(ModData%Vars, z_op, T%IceD%x(ModData%Ins, iState)) + call IceD_VarsUnpackConstrState(ModData%Vars, z_op, T%IceD%z(ModData%Ins, iState)) case (Module_IceF) - call IceFloe_VarsUnpackContState(ModData%Vars, z_op, T%IceF%x(iState)) + call IceFloe_VarsUnpackConstrState(ModData%Vars, z_op, T%IceF%z(iState)) case (Module_IfW) - call InflowWind_VarsUnpackContState(ModData%Vars, z_op, T%IfW%x(iState)) + call InflowWind_VarsUnpackConstrState(ModData%Vars, z_op, T%IfW%z(iState)) case (Module_MAP) - call MAP_VarsUnpackContState(ModData%Vars, z_op, T%MAP%x(iState)) + call MAP_VarsUnpackConstrState(ModData%Vars, z_op, T%MAP%z(iState)) case (Module_MD) - call MD_VarsUnpackContState(ModData%Vars, z_op, T%MD%x(iState)) + call MD_VarsUnpackConstrState(ModData%Vars, z_op, T%MD%z(iState)) case (Module_ExtInfw) - ! call ExtInfw_VarsUnpackContState(ModData%z_op,Vars, T%ExtInfw%x(StateIndex)) + ! call ExtInfw_VarsUnpackConstrState(ModData%z_op,Vars, T%ExtInfw%z(StateIndex)) case (Module_Orca) - call Orca_VarsUnpackContState(ModData%Vars, z_op, T%Orca%x(iState)) + call Orca_VarsUnpackConstrState(ModData%Vars, z_op, T%Orca%z(iState)) case (Module_SD) - call SD_VarsUnpackContState(ModData%Vars, z_op, T%SD%x(iState)) + call SD_VarsUnpackConstrState(ModData%Vars, z_op, T%SD%z(iState)) case (Module_SeaSt) - call SeaSt_VarsUnpackContState(ModData%Vars, z_op, T%SeaSt%x(iState)) + call SeaSt_VarsUnpackConstrState(ModData%Vars, z_op, T%SeaSt%z(iState)) case (Module_SrvD) - call SrvD_VarsUnpackContState(ModData%Vars, z_op, T%SrvD%x(iState)) + call SrvD_VarsUnpackConstrState(ModData%Vars, z_op, T%SrvD%z(iState)) case default call SetErrStat(ErrID_Fatal, "Constraint State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index f5ee4c024d..accb34b017 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -394,10 +394,9 @@ typedef ^ FAST_OutputFileType IntKi VTK_LastWaveIndx - - - "last index into wave typedef ^ FAST_OutputFileType FAST_LinFileType Lin - - - "linearization data for output" typedef ^ FAST_OutputFileType IntKi ActualChanLen - - - "width of the column headers output in the text and/or binary file" - typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" -typedef ^ FAST_OutputFileType IntKi DriverWriteOutputNum - 0 - "Number of values in driver write output" typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {6} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed" -typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" -typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnt {:} - - "units of data output from the driver" +#typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" +#typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnt {:} - - "units of data output from the driver" # ..... IceDyn data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index bfe27768b1..f93ff8660a 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -61,11 +61,11 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Number of convergence iterations between Jacobian updates ! TODO: read from input file - p%NIter_UJac = 100 + p%NIter_UJac = 10000 ! Generalized alpha damping coefficient ! TODO: read from input file - p%RhoInf = 0.0_R8Ki + p%RhoInf = 0.5_R8Ki ! Max number of convergence iterations ! TODO: read from input file @@ -73,7 +73,7 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Convergence tolerance ! TODO: read from input file - p%ConvTol = 1.0e-5_R8Ki + p%ConvTol = 1.0e-4_R8Ki ! Jacobian conditioning p%Scale_UJac = p_FAST%UJacSclFact @@ -163,7 +163,6 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Calculated inputs array call AllocAry(m%uCalc, m%Mod%Vars%Nu, "m%uCalc", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%UOrig, m%Mod%Vars%Nu, "m%UOrig", ErrStat2, ErrMsg2); if (Failed()) return ! Generalized alpha state arrays call AllocAry(m%State%q_prev, p%NumQ, "m%State%q_prev", ErrStat2, ErrMsg2); if (Failed()) return @@ -195,14 +194,6 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, m%IterUntilUJac = 0 m%StepsUntilUJac = 0 - !---------------------------------------------------------------------------- - ! Solver Outputs - !---------------------------------------------------------------------------- - - Turbine%y_FAST%DriverWriteOutputNum = 3 - Turbine%y_FAST%DriverWriteOutputHdr = [character(ChanLen) :: 'ConvIter', 'ConvError', 'NumUJac'] - Turbine%y_FAST%DriverWriteOutputUnt = [character(ChanLen) :: '(-)', '(-)', '(-)'] - !---------------------------------------------------------------------------- ! Write debug info to file !---------------------------------------------------------------------------- @@ -222,34 +213,16 @@ subroutine SetVarSolveFlags() do j = 1, size(ModData%Vars%x) call MV_SetFlags(ModData%Vars%x(j), VF_Solve) ! Continuous state variables end do - ! do j = 1, size(ModData%Vars%u) - ! call MV_SetFlags(ModData%Vars%u(j), VF_Solve) ! Input variables - ! end do - ! do j = 1, size(ModData%Vars%y) - ! if (MV_HasFlagsAny(ModData%Vars%y(j), VF_ExtLin + VF_WriteOut)) cycle - ! call MV_SetFlags(ModData%Vars%y(j), VF_Solve) ! Output variables - ! end do end associate end do - ! do i = 1, size(p%iModOpt1) - ! associate (ModData => GlueModData(p%iModOpt1(i))) - ! do j = 1, size(ModData%Vars%u) - ! call MV_SetFlags(ModData%Vars%u(j), VF_Solve) ! Input variables - ! end do - ! do j = 1, size(ModData%Vars%y) - ! if (MV_HasFlagsAny(ModData%Vars%y(j), VF_ExtLin + VF_WriteOut)) cycle - ! call MV_SetFlags(ModData%Vars%y(j), VF_Solve) ! Output variables - ! end do - ! end associate - ! end do - ! Loop through module mappings do j = 1, size(GlueModMaps) associate (Mapping => GlueModMaps(j), & SrcMod => GlueModData(GlueModMaps(j)%iModSrc), & DstMod => GlueModData(GlueModMaps(j)%iModDst)) + ! Skip custom mapping types if (Mapping%MapType == Map_Custom) cycle ! If source module is in tight coupling or option 1 @@ -676,15 +649,17 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg ! Transfer initial state from modules to solver do i = 1, size(m%Mod%ModData) associate (ModData => m%Mod%ModData(i)) + + ! Get continuous state operating points call FAST_GetOP(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) if (Failed()) return + + ! Transfer initial module state to GA state + call TransferXtoQ(ModData, m%Mod%Lin%x, m%State) end associate end do - ! Transfer initial module state to GA state - call TransferXtoQ(m%Mod%Vars, m%Mod%Lin%x, m%State) - ! Reset mapping ready for transfer flag GlueModMaps%Ready = .false. @@ -728,7 +703,16 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg ! Update algorithmic acceleration m%State%a = m%State%vd - ! If difference is less than convergence tolerance, set flag and exit loop + ! Transfer acceleration to BeamDyn if module is active + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) + if (ModData%ID == Module_BD) then + call SetBDAccel(ModData, m%State, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + end if + end associate + end do + + ! If difference is less than convergence tolerance, set flag to exit loop if ((k > 1) .and. (ConvError < p%ConvTol)) converged = .true. ! Increment iteration counter @@ -747,11 +731,11 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg ! Initialize IO and states for all modules (also copies STATE_CURR to STATE_PRED) call FAST_InitIO(GlueModData, t_initial, p%h, Turbine, ErrStat, ErrMsg) - if(ErrStat >= AbortErrLev) return + if (ErrStat >= AbortErrLev) return ! Reset the Remap flags for all modules call FAST_ResetRemapFlags(GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) - if(ErrStat >= AbortErrLev) return + if (ErrStat >= AbortErrLev) return !---------------------------------------------------------------------------- ! Set Outputs @@ -788,9 +772,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu real(ReKi) :: delta_norm real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 - integer(IntKi) :: i, j + integer(IntKi) :: i, j, k + integer(IntKi) :: iMod logical :: ConvUJac ! Jacobian updated for convergence - real(R8Ki) :: ErrPrev + real(R8Ki) :: RotDiff(3, 3) ErrStat = ErrID_None ErrMsg = '' @@ -828,6 +813,49 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu end associate end do + !---------------------------------------------------------------------------- + ! Reset BD States + !---------------------------------------------------------------------------- + + ! Perform additional state manipulation on a per-module basis + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) + select case (ModData%ID) + case (Module_ED) + + ! Update the azimuth angle + call ED_UpdateAzimuth(Turbine%ED%p, Turbine%ED%x(STATE_CURR), ModData%DT) + + case (Module_BD) + + ! Transfer acceleration from TC state to BeamDyn + call SetBDAccel(ModData, m%StatePrev, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + + ! Reset BeamDyn states so they are relative to the root node + call BD_UpdateGlobalRef(Turbine%BD%Input(INPUT_CURR, ModData%Ins), & + Turbine%BD%p(ModData%Ins), & + Turbine%BD%x(ModData%Ins, STATE_CURR), & + Turbine%BD%OtherSt(ModData%Ins, STATE_CURR), & + ErrStat2, ErrMsg2) + if (Failed()) return + + ! Transfer acceleration from BeamDyn to state + call GetBDAccel(ModData, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR), m%StatePrev) + + case default + cycle + end select + + ! Collect updated states + call FAST_GetOP(ModData, t_global_next, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) + if (Failed()) return + + ! Transfer current states to linearization array + call TransferXtoQ(ModData, m%Mod%Lin%x, m%StatePrev) + end associate + end do + !---------------------------------------------------------------------------- ! Prediction - guess solution state variables at end of time step !---------------------------------------------------------------------------- @@ -850,12 +878,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu call Glue_CopyTC_State(m%StatePrev, m%State, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return - ! Transfer current states to linearization array - call TransferQtoX(m%Mod%Vars, m%State, m%Mod%Lin%x) - ! Loop through tight coupling modules do i = 1, size(p%iModTC) associate (ModData => m%Mod%ModData(i)) + + ! Transfer current states to linearization array + call TransferQtoX(ModData, m%State, m%Mod%Lin%x) + ! Copy state from current to predicted call FAST_CopyStates(ModData, Turbine, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return @@ -874,15 +903,25 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! Loop through Option 2 modules do i = 1, size(p%iModOpt2) associate (ModData => GlueModData(p%iModOpt2(i))) + + ! Solve for inputs call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) if (Failed()) return + + ! Update states call FAST_UpdateStates(ModData, t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) if (Failed()) return + + ! Calculate outputs call FAST_CalcOutput(ModData, GlueModMaps, t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end associate end do + ! -4.9345743494052119 -9.4942092091626126E-003 91.498545759647968 + ! -4.9345900476124651 -1.8983439772237952E-002 91.498449503167748 + ! write (*, *) Turbine%BD%y(1)%BldMotion%Position(:, 1) + Turbine%BD%y(1)%BldMotion%TranslationDisp(:, 1) + !------------------------------------------------------------------------- ! Option 1 Solve !------------------------------------------------------------------------- @@ -896,7 +935,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu end do !------------------------------------------------------------------------- - ! Convergence Iterations + ! Pack inputs and modify states !------------------------------------------------------------------------- ! Pack TC and Option 1 inputs into u array @@ -908,6 +947,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu end associate end do + !------------------------------------------------------------------------- + ! Convergence Iterations + !------------------------------------------------------------------------- + ! Loop through convergence iterations do iterConv = 0, p%MaxConvIter @@ -1043,7 +1086,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! Calculate average L2 norm of change in states and inputs delta_norm = TwoNorm(m%XB(:, 1))/size(m%XB) - + ! Write step debug info if requested if (DebugSolver) call Solver_Step_Debug(p, m, n_t_global_next, iterCorr, iterConv, delta_norm) @@ -1062,16 +1105,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%State) - ! Transfer States to linearization array - call TransferQtoX(m%Mod%Vars, m%State, m%Mod%Lin%x) - !---------------------------------------------------------------------- ! Update inputs for Tight Coupling and Option 1 modules !---------------------------------------------------------------------- ! Add change in inputs if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) - if (p%iJU(1) > 0) m%UOrig = m%UOrig + m%XB(p%iJU(1):p%iJU(2), 1) + ! if (p%iJU(1) > 0) m%UDelta = m%UDelta + m%XB(p%iJU(1):p%iJU(2), 1) !---------------------------------------------------------------------- ! Transfer updated TC and Option 1 states and inputs to modules @@ -1079,12 +1119,24 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu do i = 1, size(m%Mod%ModData) associate (ModData => m%Mod%ModData(i)) + + ! Transfer States to linearization array + call TransferQtoX(ModData, m%State, m%Mod%Lin%x) + + ! Transfer states and inputs to modules call FAST_SetOP(ModData, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x, & u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) if (Failed()) return end associate end do + + ! Transfer acceleration to BD other states + do i = 1, size(p%iModTC) + if (m%Mod%ModData(i)%ID == Module_BD) then + call SetBDAccel(m%Mod%ModData(i), m%State, Turbine%BD%OtherSt(m%Mod%ModData(i)%Ins, STATE_PRED)) + end if + end do end do ! Increment correction iteration counter @@ -1278,70 +1330,17 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) if (Failed()) return end if - ! TODO: see if this actually works with option 1 modules - if (.true.) then - do i = 1, size(m%Mod%Vars%u) - if (m%Mod%Vars%u(i)%Field /= FieldOrientation) cycle - associate (Var => m%Mod%Vars%u(i)) - k = Var%iLoc(1) - idx = p%NumQ + k - do j = 1, Var%Nodes - - rv = m%UOrig(k:k + 2) - phi = dot_product(rv, rv) - - if (phi < 1.0e-10_R8Ki) cycle - - tmp1 = (cos(phi) - 1.0_R8Ki)/(phi*phi) - tmp2 = (1.0_R8Ki - sin(phi)/phi)/(phi*phi) - - T = VecTilde(rv) - T = tmp2*matmul(T, T) + tmp1*T - T(1, 1) = T(1, 1) + 1.0_R8Ki - T(2, 2) = T(2, 2) + 1.0_R8Ki - T(3, 3) = T(3, 3) + 1.0_R8Ki - - associate (Jsub => m%Mod%Lin%J(:, idx:idx + 2)) - m%T = Jsub - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%T, T, 0.0_R8Ki, Jsub, ErrStat2, ErrMsg2) - if (Failed()) return - end associate - - k = k + 3 - end do - end associate - end do - end if - ! Condition jacobian matrix before factoring - do j = 1, p%NumJ - do i = p%iJL(1), p%iJL(2) - m%Mod%Lin%J(i, j) = m%Mod%Lin%J(i, j)/p%Scale_UJac - end do - end do - do j = p%iJL(1), p%iJL(2) - do i = 1, p%NumJ - m%Mod%Lin%J(i, j) = m%Mod%Lin%J(i, j)*p%Scale_UJac - end do - end do - ! if (p%iJL(1) > 0) then - ! m%Mod%Lin%J(p%iJL(1):p%iJL(2), :) = m%Mod%Lin%J(p%iJL(1):p%iJL(2), :)/p%Scale_UJac - ! m%Mod%Lin%J(:, p%iJL(1):p%iJL(2)) = m%Mod%Lin%J(:, p%iJL(1):p%iJL(2))*p%Scale_UJac - ! end if + if (p%iJL(1) > 0) then + m%Mod%Lin%J(p%iJL(1):p%iJL(2), :) = m%Mod%Lin%J(p%iJL(1):p%iJL(2), :)/p%Scale_UJac + m%Mod%Lin%J(:, p%iJL(1):p%iJL(2)) = m%Mod%Lin%J(:, p%iJL(1):p%iJL(2))*p%Scale_UJac + end if ! Factor jacobian matrix - call LAPACK_getrf(size(m%Mod%Lin%J, 1), size(m%Mod%Lin%J, 1), m%Mod%Lin%J, m%IPIV, ErrStat2, ErrMsg2) + call LAPACK_getrf(size(m%Mod%Lin%J, 1), size(m%Mod%Lin%J, 2), m%Mod%Lin%J, m%IPIV, ErrStat2, ErrMsg2) if (Failed()) return contains - function VecTilde(Vec) result(Matrix) - real(R8Ki), intent(in) :: Vec(3) - real(R8Ki) :: Matrix(3, 3) - Matrix(:, 1) = [0.0_R8Ki, Vec(3), -Vec(2)] - Matrix(:, 2) = [-Vec(3), 0.0_R8Ki, Vec(1)] - Matrix(:, 3) = [Vec(2), -Vec(1), 0.0_R8Ki] - end function - logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev @@ -1433,35 +1432,67 @@ subroutine UpdateStatePrediction(p, Vars, delta_vd, State) end subroutine -subroutine TransferXtoQ(Vars, x, State) - type(ModVarsType), intent(in) :: Vars - real(R8Ki), intent(in) :: x(:) - type(TC_State), intent(inout) :: State - integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (Var => Vars%x(i)) +subroutine TransferXtoQ(ModData, x, State) + type(ModDataType), intent(in) :: ModData + real(R8Ki), intent(in) :: x(:) + type(TC_State), intent(inout) :: State + integer(IntKi) :: i + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) select case (Var%DerivOrder) case (0) ! Displacement - State%q(Var%iq(1):Var%iq(2)) = x(Var%iLoc(1):Var%iLoc(2)) + State%q(Var%iq(1):Var%iq(2)) = x(Var%iGlu(1):Var%iGlu(2)) case (1) ! Velocity - State%v(Var%iq(1):Var%iq(2)) = x(Var%iLoc(1):Var%iLoc(2)) + State%v(Var%iq(1):Var%iq(2)) = x(Var%iGlu(1):Var%iGlu(2)) end select end associate end do end subroutine -subroutine TransferQtoX(Vars, State, x) - type(ModVarsType), intent(in) :: Vars +subroutine TransferQtoX(ModData, State, x) + type(ModDataType), intent(in) :: ModData type(TC_State), intent(in) :: State real(R8Ki), intent(inout) :: x(:) integer(IntKi) :: i - do i = 1, size(Vars%x) - associate (Var => Vars%x(i)) + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) select case (Var%DerivOrder) case (0) ! Displacement - x(Var%iLoc(1):Var%iLoc(2)) = State%q(Var%iq(1):Var%iq(2)) + x(Var%iGlu(1):Var%iGlu(2)) = State%q(Var%iq(1):Var%iq(2)) case (1) ! Velocity - x(Var%iLoc(1):Var%iLoc(2)) = State%v(Var%iq(1):Var%iq(2)) + x(Var%iGlu(1):Var%iGlu(2)) = State%v(Var%iq(1):Var%iq(2)) + end select + end associate + end do +end subroutine + +subroutine SetBDAccel(ModData, State, BD_OtherSt) + type(ModDataType), intent(in) :: ModData + type(TC_State), intent(in) :: State + type(BD_OtherStateType), intent(inout) :: BD_OtherSt + integer(IntKi) :: i + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) + select case (Var%Field) + case (FieldTransVel, FieldAngularVel) + BD_OtherSt%acc(Var%iLB:Var%iUB, Var%j) = State%vd(Var%iq(1):Var%iq(2)) + BD_OtherSt%xcc(Var%iLB:Var%iUB, Var%j) = State%a(Var%iq(1):Var%iq(2)) + end select + end associate + end do +end subroutine + +subroutine GetBDAccel(ModData, BD_OtherSt, State) + type(ModDataType), intent(in) :: ModData + type(BD_OtherStateType), intent(in) :: BD_OtherSt + type(TC_State), intent(inout) :: State + integer(IntKi) :: i + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) + select case (Var%Field) + case (FieldTransVel, FieldAngularVel) + State%vd(Var%iq(1):Var%iq(2)) = BD_OtherSt%acc(Var%iLB:Var%iUB, Var%j) + State%a(Var%iq(1):Var%iq(2)) = BD_OtherSt%xcc(Var%iLB:Var%iUB, Var%j) end select end associate end do diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 32c20161fa..af251a60a7 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -2070,7 +2070,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) if (p_FAST%CompAeroMaps) then y_FAST%numOuts(Module_Glue) = 1 + size(y_FAST%DriverWriteOutput) else - y_FAST%numOuts(Module_Glue) = 1 ! time + y_FAST%numOuts(Module_Glue) = 4 ! time, ConvIter, ConvError, NumUJac end if @@ -2103,11 +2103,18 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%ChannelNames(SS_Indx_WS+1) = 'WindSpeed' y_FAST%ChannelUnits(SS_Indx_WS+1) = '(m/s)' - else y_FAST%ChannelNames(1) = 'Time' y_FAST%ChannelUnits(1) = '(s)' + y_FAST%ChannelNames(2) = 'ConvIter' + y_FAST%ChannelUnits(2) = '(-)' + + y_FAST%ChannelNames(3) = 'ConvError' + y_FAST%ChannelUnits(3) = '(-)' + + y_FAST%ChannelNames(4) = 'NumUJac' + y_FAST%ChannelUnits(4) = '(-)' end if indxNext = y_FAST%numOuts(Module_Glue) + 1 @@ -7596,8 +7603,8 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, y_A indxNext = 1 IF (y_FAST%numOuts(Module_Glue) > 1) THEN ! if we output more than just the time channel.... - indxLast = indxNext + SIZE(y_FAST%DriverWriteOutput) - 1 - OutputAry(indxNext:indxLast) = y_FAST%DriverWriteOutput + indxLast = y_FAST%numOuts(Module_Glue) - 1 + OutputAry(indxNext:indxLast) = y_FAST%DriverWriteOutput(1:y_FAST%numOuts(Module_Glue)-1) indxNext = IndxLast + 1 END IF diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 3935fcc840..1cf6719312 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -392,10 +392,7 @@ MODULE FAST_Types TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] - INTEGER(IntKi) :: DriverWriteOutputNum = 0 !< Number of values in driver write output [-] REAL(ReKi) , DIMENSION(1:6) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: DriverWriteOutputHdr !< headers of data output from the driver [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: DriverWriteOutputUnt !< units of data output from the driver [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -6045,32 +6042,7 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, call FAST_CopyLinStateSave(SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstOutputFileTypeData%DriverWriteOutputNum = SrcOutputFileTypeData%DriverWriteOutputNum DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput - if (allocated(SrcOutputFileTypeData%DriverWriteOutputHdr)) then - LB(1:1) = lbound(SrcOutputFileTypeData%DriverWriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%DriverWriteOutputHdr, kind=B8Ki) - if (.not. allocated(DstOutputFileTypeData%DriverWriteOutputHdr)) then - allocate(DstOutputFileTypeData%DriverWriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%DriverWriteOutputHdr.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputFileTypeData%DriverWriteOutputHdr = SrcOutputFileTypeData%DriverWriteOutputHdr - end if - if (allocated(SrcOutputFileTypeData%DriverWriteOutputUnt)) then - LB(1:1) = lbound(SrcOutputFileTypeData%DriverWriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%DriverWriteOutputUnt, kind=B8Ki) - if (.not. allocated(DstOutputFileTypeData%DriverWriteOutputUnt)) then - allocate(DstOutputFileTypeData%DriverWriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%DriverWriteOutputUnt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputFileTypeData%DriverWriteOutputUnt = SrcOutputFileTypeData%DriverWriteOutputUnt - end if end subroutine subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) @@ -6106,12 +6078,6 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputFileTypeData%DriverWriteOutputHdr)) then - deallocate(OutputFileTypeData%DriverWriteOutputHdr) - end if - if (allocated(OutputFileTypeData%DriverWriteOutputUnt)) then - deallocate(OutputFileTypeData%DriverWriteOutputUnt) - end if end subroutine subroutine FAST_PackOutputFileType(RF, Indata) @@ -6144,10 +6110,7 @@ subroutine FAST_PackOutputFileType(RF, Indata) call FAST_PackLinFileType(RF, InData%Lin) call RegPack(RF, InData%ActualChanLen) call FAST_PackLinStateSave(RF, InData%op) - call RegPack(RF, InData%DriverWriteOutputNum) call RegPack(RF, InData%DriverWriteOutput) - call RegPackAlloc(RF, InData%DriverWriteOutputHdr) - call RegPackAlloc(RF, InData%DriverWriteOutputUnt) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6183,10 +6146,7 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) call FAST_UnpackLinFileType(RF, OutData%Lin) ! Lin call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return call FAST_UnpackLinStateSave(RF, OutData%op) ! op - call RegUnpack(RF, OutData%DriverWriteOutputNum); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DriverWriteOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DriverWriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DriverWriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index 1f09badcd5..8afa5ae9de 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -168,7 +168,6 @@ typedef ^ Glue_TCMisc ModGlueType Mod - - - typedef ^ ^ TC_State State - - - "Tight Coupling state" typedef ^ ^ TC_State StatePrev - - - "Tight Coupling previous state for correction iterations" typedef ^ ^ R8Ki UCalc : - - "" - -typedef ^ ^ R8Ki UOrig : - - "" - typedef ^ ^ R8Ki T :: - - "Tangent matrix" - typedef ^ ^ R8Ki XB :: - - "" - typedef ^ ^ IntKi IPIV : - - "" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index aa62df3c65..a49bfd1760 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -211,7 +211,6 @@ MODULE Glue_Types TYPE(TC_State) :: State !< Tight Coupling state [-] TYPE(TC_State) :: StatePrev !< Tight Coupling previous state for correction iterations [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UCalc !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UOrig !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T !< Tangent matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] @@ -1852,18 +1851,6 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM end if DstTCMiscData%UCalc = SrcTCMiscData%UCalc end if - if (allocated(SrcTCMiscData%UOrig)) then - LB(1:1) = lbound(SrcTCMiscData%UOrig, kind=B8Ki) - UB(1:1) = ubound(SrcTCMiscData%UOrig, kind=B8Ki) - if (.not. allocated(DstTCMiscData%UOrig)) then - allocate(DstTCMiscData%UOrig(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%UOrig.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTCMiscData%UOrig = SrcTCMiscData%UOrig - end if if (allocated(SrcTCMiscData%T)) then LB(1:2) = lbound(SrcTCMiscData%T, kind=B8Ki) UB(1:2) = ubound(SrcTCMiscData%T, kind=B8Ki) @@ -1924,9 +1911,6 @@ subroutine Glue_DestroyTCMisc(TCMiscData, ErrStat, ErrMsg) if (allocated(TCMiscData%UCalc)) then deallocate(TCMiscData%UCalc) end if - if (allocated(TCMiscData%UOrig)) then - deallocate(TCMiscData%UOrig) - end if if (allocated(TCMiscData%T)) then deallocate(TCMiscData%T) end if @@ -1947,7 +1931,6 @@ subroutine Glue_PackTCMisc(RF, Indata) call Glue_PackTC_State(RF, InData%State) call Glue_PackTC_State(RF, InData%StatePrev) call RegPackAlloc(RF, InData%UCalc) - call RegPackAlloc(RF, InData%UOrig) call RegPackAlloc(RF, InData%T) call RegPackAlloc(RF, InData%XB) call RegPackAlloc(RF, InData%IPIV) @@ -1970,7 +1953,6 @@ subroutine Glue_UnPackTCMisc(RF, OutData) call Glue_UnpackTC_State(RF, OutData%State) ! State call Glue_UnpackTC_State(RF, OutData%StatePrev) ! StatePrev call RegUnpackAlloc(RF, OutData%UCalc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UOrig); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%T); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%XB); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IPIV); if (RegCheckErr(RF, RoutineName)) return From 0f6706386bd19960de51f00507e1d2fd65f1d405 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Aug 2024 20:18:56 +0000 Subject: [PATCH 171/319] Fix bug in BeamDyn performance commit --- modules/beamdyn/src/BeamDyn.f90 | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 49a9e20f29..ced271063e 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -2699,9 +2699,9 @@ SUBROUTINE BD_ElasticForce(nelem,p,m,fact) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables. LOGICAL, INTENT(IN ) :: fact !< Boolean to calculate the Jacobian - - - INTEGER(IntKi) :: idx_qp !< Index to quadrature point currently being calculated + REAL(BDKi) :: cet !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term + REAL(BDKi) :: k1s + INTEGER(IntKi) :: idx_qp !< Index to quadrature point currently being calculated if (.not. fact) then @@ -2738,8 +2738,6 @@ subroutine Calc_Oe_Pe_Qe(RR0, Stif, Fc, Oe, Pe, Qe) REAL(BDKi) :: C21(3,3) REAL(BDKi) :: epsi(3,3) REAL(BDKi) :: mu(3,3) - REAL(BDKi) :: cet !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term - REAL(BDKi) :: k1s !> ###Calculate the \f$ \underline{\underline{\mathcal{O}}} \f$ from equation (19) !! @@ -2808,8 +2806,6 @@ subroutine Calc_Fc_Fd(RR0, uuu, E1, Fc, Fd) REAL(BDKi) :: R(3,3) !< rotation matrix at quatrature point REAL(BDKi) :: Rx0p(3) !< \f$ \underline{R} \underline{x}^\prime_0 \f$ REAL(BDKi) :: Wrk(3) - REAL(BDKi) :: cet !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term - REAL(BDKi) :: k1s !> ### Calculate the 1D strain, \f$ \underline{\epsilon} \f$, equation (5) !! \f$ \underline{\epsilon} = \underline{x}^\prime_0 + \underline{u}^\prime - From d18c96de152d383bd515f9d4d0dec9599f4736fb Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Aug 2024 20:19:24 +0000 Subject: [PATCH 172/319] Set SrvD hub wind speed from IfW hub speed --- modules/openfast-library/src/FAST_Mapping.f90 | 28 +++++++++++++++---- 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 6b861573cc..ff31e9863d 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -41,6 +41,7 @@ module FAST_Mapping Custom_SrvD_to_IfW = 'SrvD -> IfW', & Custom_BD_to_SrvD = 'BD -> SrvD', & Custom_ED_to_SrvD = 'ED -> SrvD', & + Custom_SrvD_to_ED = 'SrvD -> ED', & Custom_IfW_to_SrvD = 'IfW -> SrvD', & Custom_ExtInfw_to_SrvD = 'ExtInfw -> SrvD', & Custom_SrvD_to_SD = 'SrvD -> SD', & @@ -828,6 +829,13 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstMod=DstMod, DstDL=DatLoc(ED_u_GenTrq), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + ! call MapVariable(Mappings, & + ! SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_HssBrTrqC), & + ! DstMod=DstMod, DstDL=DatLoc(ED_u_HssBrTrqC), & + ! ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + call MapCustom(Mappings, Custom_SrvD_to_ED, SrcMod, DstMod) + ! Blade Structural Controller (if ElastoDyn is used for blades) do j = 1, Turbine%SrvD%p%NumBStC do i = 1, Turbine%ED%p%NumBl @@ -1206,7 +1214,7 @@ subroutine InitMappings_IfW(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) case (Module_ED) call MapCustom(Mappings, Custom_ED_to_IfW, SrcMod, DstMod) case (Module_SrvD) - call MapCustom(Mappings, Custom_SrvD_to_IfW, SrcMod=SrcMod, DstMod=DstMod) + call MapCustom(Mappings, Custom_SrvD_to_IfW, SrcMod, DstMod) end select contains @@ -2620,6 +2628,17 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg T%AD%Input(iInput)%rotors(ModDst%Ins)%UserProp(:, i) = T%SrvD%y%BlAirfoilCom(i) end do +!------------------------------------------------------------------------------- +! ElastoDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_ED) + + T%ED%Input(iInput)%GenTrq = T%SrvD%y%GenTrq + T%ED%Input(iInput)%HSSBrTrqC = T%SrvD%y%HSSBrTrqC + T%ED%Input(iInput)%BlPitchCom = T%SrvD%y%BlPitchCom + T%ED%Input(iInput)%YawMom = T%SrvD%y%YawMom + !------------------------------------------------------------------------------- ! ExtLoads Inputs !------------------------------------------------------------------------------- @@ -2647,9 +2666,6 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg case (Custom_SrvD_to_IfW) - ! Set hub position so ServoDyn can get hub wind speed - T%IfW%Input(iInput)%PositionXYZ(:, 1) = T%ED%y%HubPtMotion%Position(:, 1) - !------------------------------------------------------------------------------- ! MoorDyn Inputs !------------------------------------------------------------------------------- @@ -2724,8 +2740,8 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg case (Custom_IfW_to_SrvD) - T%SrvD%Input(iInput)%WindDir = atan2(T%IfW%y%VelocityUVW(2, 1), T%IfW%y%VelocityUVW(1, 1)) - T%SrvD%Input(iInput)%HorWindV = sqrt(T%IfW%y%VelocityUVW(1, 1)**2 + T%IfW%y%VelocityUVW(2, 1)**2) + T%SrvD%Input(iInput)%WindDir = atan2(T%IfW%y%HubVel(2), T%IfW%y%HubVel(1)) + T%SrvD%Input(iInput)%HorWindV = sqrt(T%IfW%y%HubVel(1)**2 + T%IfW%y%HubVel(2)**2) if (allocated(T%IfW%y%lidar%LidSpeed)) T%SrvD%Input(iInput)%LidSpeed = T%IfW%y%lidar%LidSpeed if (allocated(T%IfW%y%lidar%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = T%IfW%y%lidar%MsrPositionsX if (allocated(T%IfW%y%lidar%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = T%IfW%y%lidar%MsrPositionsY From f664cc552c3f646a3adb26672d920b92a6395a81 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Aug 2024 20:19:46 +0000 Subject: [PATCH 173/319] Add commented option for performance profiling in OpenfastFortranOptions.cmake --- cmake/OpenfastFortranOptions.cmake | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index f09837fbcf..554c175b85 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -139,6 +139,10 @@ macro(set_fast_gfortran) set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS},--stack,${stack_size}") endif() + # Profiling + # set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -pg") + # set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -pg") + check_f2008_features() endmacro(set_fast_gfortran) From dd7e4f4e01e874901f76b3bd21f0f5824f4c1a38 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Aug 2024 17:45:15 +0000 Subject: [PATCH 174/319] Use small rotation angles in ModVar --- modules/nwtc-library/src/ModVar.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 745de1227a..8d172601a1 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -49,7 +49,7 @@ module ModVar integer(IntKi), parameter :: MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, & FieldAngularVel, FieldTransAcc, FieldAngularAcc] -logical, parameter :: UseSmallRotAngles = .false. +logical, parameter :: UseSmallRotAngles = .true. contains From 56d830b5573596438e759e0edda70b7d7e2e0531 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Aug 2024 17:46:12 +0000 Subject: [PATCH 175/319] Make SolverTC work with no states --- .../openfast-library/src/FAST_SolverTC.f90 | 99 +++++++------------ 1 file changed, 37 insertions(+), 62 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index f93ff8660a..d483ff0b4c 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -65,7 +65,7 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Generalized alpha damping coefficient ! TODO: read from input file - p%RhoInf = 0.5_R8Ki + p%RhoInf = 1.0_R8Ki ! Max number of convergence iterations ! TODO: read from input file @@ -223,7 +223,7 @@ subroutine SetVarSolveFlags() DstMod => GlueModData(GlueModMaps(j)%iModDst)) ! Skip custom mapping types - if (Mapping%MapType == Map_Custom) cycle + if (Mapping%MapType == Map_Variable .or. Mapping%MapType == Map_Custom) cycle ! If source module is in tight coupling or option 1 if (any(SrcMod%ID == TC_Modules) .or. any(SrcMod%ID == O1_Modules)) then @@ -346,7 +346,7 @@ subroutine CalcVarGlobalIndices(p, ModTC, NumQ, NumJ, ErrStat, ErrMsg) end do ! Start and end indices of displacement variables - p%iX1 = [1, iGlu] + if (iGlu > 0) p%iX1 = [1, iGlu] ! Set indices for velocity variables do i = 1, size(ModTC%ModData) @@ -371,32 +371,6 @@ subroutine CalcVarGlobalIndices(p, ModTC, NumQ, NumJ, ErrStat, ErrMsg) ! Initialize glue index iGlu = 0 - ! ! Set indices of Tight Coupling input variables - ! do i = 1, size(p%iModTC) - ! associate (Vars => ModTC%ModData(i)%Vars) - ! if (.not. allocated(Vars%u)) cycle - ! do j = 1, size(Vars%u) - ! Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] - ! iGlu = Vars%u(j)%iGlu(2) - ! end do - ! end associate - ! end do - - ! if (iGlu > 0) p%iUT = [1, iGlu] - - ! ! Set indices of Option 1 input variables - ! do i = size(p%iModTC) + 1, size(ModTC%ModData) - ! associate (Vars => ModTC%ModData(i)%Vars) - ! if (.not. allocated(Vars%u)) cycle - ! do j = 1, size(Vars%u) - ! Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] - ! iGlu = Vars%u(j)%iGlu(2) - ! end do - ! end associate - ! end do - - ! if (iGlu > p%iUT(2)) p%iU1 = [p%iUT(2) + 1, iGlu] - ! Set indices of Tight Coupling input variables (non-load) do i = 1, size(p%iModTC) associate (Vars => ModTC%ModData(i)%Vars) @@ -589,7 +563,7 @@ subroutine CalcVarGlobalIndices(p, ModTC, NumQ, NumJ, ErrStat, ErrMsg) NumJ = NumQ + ModTC%Vars%Nu ! Get start and end indices for state part of Jacobian - p%iJX = [1, NumQ] + if (NumQ > 0) p%iJX = [1, NumQ] ! Get start and end indices for tight coupling input part of Jacobian if (p%iUT(1) > 0) p%iJUT = NumQ + p%iUT @@ -1061,7 +1035,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu !---------------------------------------------------------------------- ! Calculate difference between calculated and predicted accelerations - m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%State%vd + if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%State%vd ! Calculate difference in U for all Option 1 modules (un - u_tmp) ! and add to RHS for TC and Option 1 modules @@ -1103,7 +1077,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! Update State for Tight Coupling modules !---------------------------------------------------------------------- - call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%State) + if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%State) !---------------------------------------------------------------------- ! Update inputs for Tight Coupling and Option 1 modules @@ -1111,7 +1085,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! Add change in inputs if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) - ! if (p%iJU(1) > 0) m%UDelta = m%UDelta + m%XB(p%iJU(1):p%iJU(2), 1) !---------------------------------------------------------------------- ! Transfer updated TC and Option 1 states and inputs to modules @@ -1271,41 +1244,43 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) ! Assemble Jacobian !---------------------------------------------------------------------------- - ! If velocity or acceleration indices are zero, return - if (p%iX1(1) == 0 .or. p%iX2(1) == 0) return + ! If states in Jacobian + if (p%iJX(1) > 0) then - ! Group (1,1) - associate (J11 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJX(1):p%iJX(2)), & - dX2dx2 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)), & - dX2dx1 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX1(1):p%iX1(2))) - J11 = -p%GammaPrime*dX2dx2 - p%BetaPrime*dX2dx1 - do i = p%iJX(1), p%iJX(2) - J11(i, i) = J11(i, i) + 1.0_R8Ki - end do - end associate - - ! Group (2,1) - if (p%iyT(1) > 0 .and. p%iUT(1) > 0) then - associate (J21 => m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)), & - dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & - dYTdx2 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2)), & - dYTdx1 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) - ! J21 = C1*matmul(dUTdyT, dYTdx2) + C2*matmul(dUTdyT, dYTdx1) - call LAPACK_GEMM('N', 'N', p%GammaPrime, dUTdyT, dYTdx2, 0.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return - call LAPACK_GEMM('N', 'N', p%BetaPrime, dUTdyT, dYTdx1, 1.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return + ! Group (1,1) + associate (J11 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJX(1):p%iJX(2)), & + dX2dx2 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)), & + dX2dx1 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX1(1):p%iX1(2))) + J11 = -p%GammaPrime*dX2dx2 - p%BetaPrime*dX2dx1 + do i = p%iJX(1), p%iJX(2) + J11(i, i) = J11(i, i) + 1.0_R8Ki + end do end associate - end if - ! Group (1,2) - if (p%iUT(1) > 0) then - associate (J12 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJUT(1):p%iJUT(2)), & - dX2duT => m%Mod%Lin%dXdu(p%iX2(1):p%iX2(2), p%iUT(1):p%iUT(2))) - J12 = -dX2duT - end associate + ! Group (2,1) + if (p%iyT(1) > 0 .and. p%iUT(1) > 0) then + associate (J21 => m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)), & + dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & + dYTdx2 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2)), & + dYTdx1 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) + ! J21 = C1*matmul(dUTdyT, dYTdx2) + C2*matmul(dUTdyT, dYTdx1) + call LAPACK_GEMM('N', 'N', p%GammaPrime, dUTdyT, dYTdx2, 0.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', p%BetaPrime, dUTdyT, dYTdx1, 1.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return + end associate + end if + + ! Group (1,2) + if (p%iUT(1) > 0) then + associate (J12 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJUT(1):p%iJUT(2)), & + dX2duT => m%Mod%Lin%dXdu(p%iX2(1):p%iX2(2), p%iUT(1):p%iUT(2))) + J12 = -dX2duT + end associate + end if + end if ! Group (2,2) - Inputs = dUdu + matmul(dUdy, dYdu) - if (m%Mod%Vars%Nu > 0) then + if (p%iJU(1) > 0) then associate (J22 => m%Mod%Lin%J(p%iJU(1):p%iJU(2), p%iJU(1):p%iJU(2))) ! J22 = m%Mod%Lin%dUdu + matmul(m%Mod%Lin%dUdy, m%Mod%Lin%dYdu) J22 = m%Mod%Lin%dUdu From 427af969f2bef6dd6a61ae44cee77dc899cedbe7 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Aug 2024 17:47:04 +0000 Subject: [PATCH 176/319] Add error in SrvD to exit if HSSBrMode is not 0. The brake doesn't currently work in tight coupling --- modules/servodyn/src/ServoDyn.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index ce57306b63..b28284ffa4 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -5011,6 +5011,11 @@ END SUBROUTINE Torque_ValidateData !> This routine performs the checks on inputs for the high-speed shaft brake. SUBROUTINE HSSBr_ValidateData( ) + ! TODO: Implement brake in tight-coupling scheme + IF (InputFileData%HSSBrMode /= ControlMode_NONE) then + CALL SetErrStat( ErrID_Fatal, 'HSSBrMode must be 0 for tight-coupling.', ErrStat, ErrMsg, RoutineName ) + end if + ! Some special checks based on whether inputs will come from external source (e.g., Simulink, LabVIEW) IF ( .NOT. Cmpl4SFun .AND. .NOT. Cmpl4LV ) THEN From e36a35cdd73109fc5cbafe36bb177986d50a4a8d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Aug 2024 17:48:08 +0000 Subject: [PATCH 177/319] Change errorPlotting.py and pass_fail.py to ignore TC channels (ConvErr, ConvIter, NumUJac) --- reg_tests/lib/errorPlotting.py | 17 +++++++++++++++++ reg_tests/lib/pass_fail.py | 23 +++++++++++++++++++++-- 2 files changed, 38 insertions(+), 2 deletions(-) diff --git a/reg_tests/lib/errorPlotting.py b/reg_tests/lib/errorPlotting.py index 7de955b21b..37b10fe188 100644 --- a/reg_tests/lib/errorPlotting.py +++ b/reg_tests/lib/errorPlotting.py @@ -42,6 +42,23 @@ def _validateAndExpandInputs(argv): def _parseSolution(solution): try: data, info, _ = load_output(solution) + + # Remove solution iteration columns + for col in 'ConvIter ConvError NumUJac'.split(): + + # If column exists, get index + try: + i = info['attribute_names'].index(col) + except ValueError as e: + continue + + # Remove column from data array + data = np.delete(data, i, axis=1) + + # Remove column from attribute names and units + del info['attribute_names'][i] + del info['attribute_units'][i] + return (data, info) except Exception as e: rtl.exitWithError("Error: {}".format(e)) diff --git a/reg_tests/lib/pass_fail.py b/reg_tests/lib/pass_fail.py index 1a9e0f1e75..2c8be35b62 100644 --- a/reg_tests/lib/pass_fail.py +++ b/reg_tests/lib/pass_fail.py @@ -26,7 +26,26 @@ def readFASTOut(fastoutput): try: - return load_output(fastoutput) + # Load output file + data, info, _ = load_output(fastoutput) + + # Remove solution iteration columns + for col in 'ConvIter ConvError NumUJac'.split(): + + # If column exists, get index + try: + i = info['attribute_names'].index(col) + except ValueError as e: + continue + + # Remove column from data array + data = np.delete(data, i, axis=1) + + # Remove column from attribute names and units + del info['attribute_names'][i] + del info['attribute_units'][i] + + return data, info, 1 except Exception as e: rtl.exitWithError("Error: {}".format(e)) @@ -65,7 +84,7 @@ def passing_channels(test, baseline, RTOL_MAGNITUDE, ATOL_MAGNITUDE) -> np.ndarr where_not_nan = ~np.isnan(test) where_not_inf = ~np.isinf(test) - passing_channels = np.all(where_close * where_not_nan * where_not_inf, axis=1) + passing_channels = np.all(where_close & where_not_nan & where_not_inf, axis=1) return passing_channels def maxnorm(data, axis=0): From 12b0d8d3af3765a693a4cd405ece5d706e4838b3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Aug 2024 20:10:55 +0000 Subject: [PATCH 178/319] Set mapping from SeaSt_y_WaveElev0 to HydroDyn_u_WaveElev0 to only be active if linearization is enabled. --- modules/openfast-library/src/FAST_Mapping.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index ff31e9863d..69d5c05189 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1096,7 +1096,8 @@ subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapVariable(Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(SeaSt_y_WaveElev0), & DstMod=DstMod, DstDL=DatLoc(HydroDyn_u_WaveElev0), & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%Linearize); if (Failed()) return case (Module_SD) From e460460c5731c8aff8ff30ca348f8578b78bbf31 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Aug 2024 20:11:32 +0000 Subject: [PATCH 179/319] Remove duplicate array allocation in AeroMap --- modules/openfast-library/src/FAST_AeroMap.f90 | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 93f9f250d9..5fdd629998 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -206,19 +206,7 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) call AllocAry(AM%Mod%Lin%J, JacSize, JacSize, 'J', ErrStat2, ErrMsg2); if (Failed()) return ! Allocate Idx Jacobian storage - call AllocAry(AM%Mod%Lin%dYdu, AM%Mod%Vars%Ny, AM%Mod%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(AM%Mod%Lin%dXdu, AM%Mod%Vars%Nx, AM%Mod%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(AM%Mod%Lin%dYdx, AM%Mod%Vars%Ny, AM%Mod%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(AM%Mod%Lin%dXdx, AM%Mod%Vars%Nx, AM%Mod%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(AM%Mod%Lin%dXdy, AM%Mod%Vars%Nx, AM%Mod%Vars%Ny, 'dXdy', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(AM%Mod%Lin%dUdu, AM%Mod%Vars%Nu, AM%Mod%Vars%Nu, "dUdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(AM%Mod%Lin%dUdy, AM%Mod%Vars%Nu, AM%Mod%Vars%Ny, "dUdy", ErrStat2, ErrMsg2); if (Failed()) return - - ! Allocate operating point arrays - call AllocAry(AM%Mod%Lin%x, AM%Mod%Vars%Nx, 'x', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(AM%Mod%Lin%u, AM%Mod%Vars%Nu, 'u', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(AM%Mod%Lin%dx, AM%Mod%Vars%Nx, 'dx', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(AM%Mod%Lin%y, AM%Mod%Vars%Ny, 'y', ErrStat2, ErrMsg2); if (Failed()) return ! Allocate arrays to store inputs call AllocAry(AM%u1, AM%Mod%Vars%Nu, 'u1', ErrStat2, ErrMsg2); if (Failed()) return From 625ba1e6aecf9a166add25a9e0e1824d7dac8f07 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Aug 2024 20:24:15 +0000 Subject: [PATCH 180/319] Change Vars used in Option 1 in SolverTC --- .../openfast-library/src/FAST_SolverTC.f90 | 70 +++++++++++++++++-- 1 file changed, 64 insertions(+), 6 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index d483ff0b4c..cbe3b3ef2c 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -114,7 +114,6 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Indices of Option 1 modules p%iModOpt1 = [pack(modInds, ModIDs == Module_ExtPtfm), & pack(modInds, ModIDs == Module_HD), & - pack(modInds, ModIDs == Module_MD), & pack(modInds, ModIDs == Module_Orca)] ! Indices of Option 2 modules @@ -225,8 +224,11 @@ subroutine SetVarSolveFlags() ! Skip custom mapping types if (Mapping%MapType == Map_Variable .or. Mapping%MapType == Map_Custom) cycle - ! If source module is in tight coupling or option 1 - if (any(SrcMod%ID == TC_Modules) .or. any(SrcMod%ID == O1_Modules)) then + ! Skip mappings where source and destination are not in tight coupling + if (all(SrcMod%ID /= TC_Modules) .and. all(DstMod%ID /= TC_Modules)) cycle + + ! If source module is in tight coupling + if (any(SrcMod%ID == TC_Modules)) then ! Set mapping flag on source variables do i = 1, size(SrcMod%Vars%y) @@ -245,8 +247,36 @@ subroutine SetVarSolveFlags() end if end if - ! If destination module is in tight coupling or option 1 - if (any(DstMod%ID == TC_Modules) .or. any(DstMod%ID == O1_Modules)) then + ! If source module is in option 1 + if (any(SrcMod%ID == O1_Modules)) then + + ! Set mapping flag on source variables + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (.not. MV_EqualDL(Mapping%SrcDL, Var%DL)) cycle + select case (Var%Field) + case (FieldForce, FieldMoment) + call MV_SetFlags(Var, VF_Solve) + end select + end associate + end do + + ! Set mapping flag on source displacement mesh variables + if (Mapping%MapType == Map_LoadMesh) then + do i = 1, size(SrcMod%Vars%u) + associate (Var => SrcMod%Vars%u(i)) + if (.not. MV_EqualDL(Mapping%SrcDispDL, Var%DL)) cycle + select case (Var%Field) + case (FieldForce, FieldMoment) + call MV_SetFlags(Var, VF_Solve) + end select + end associate + end do + end if + end if + + ! If destination module is in tight coupling + if (any(DstMod%ID == TC_Modules) ) then ! Set mapping flag on destination variables do i = 1, size(DstMod%Vars%u) @@ -264,6 +294,34 @@ subroutine SetVarSolveFlags() end do end if end if + + ! If destination module is in option 1 + if (any(DstMod%ID == O1_Modules)) then + + ! Set mapping flag on destination variables + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (.not. MV_EqualDL(Mapping%DstDL, Var%DL)) cycle + select case (Var%Field) + case (FieldTransAcc, FieldAngularAcc) + call MV_SetFlags(Var, VF_Solve) + end select + end associate + end do + + ! Set mapping flag on destination displacement mesh variables + if (Mapping%MapType == Map_LoadMesh) then + do i = 1, size(DstMod%Vars%y) + associate (Var => DstMod%Vars%y(i)) + if (.not. MV_EqualDL(Mapping%DstDispDL, Var%DL)) cycle + select case (Var%Field) + case (FieldTransAcc, FieldAngularAcc) + call MV_SetFlags(Var, VF_Solve) + end select + end associate + end do + end if + end if end associate end do end subroutine @@ -743,7 +801,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu logical, parameter :: IsSolve = .true. integer(IntKi) :: iterConv, iterCorr, iterTotal integer(IntKi) :: NumUJac, NumCorrections - real(ReKi) :: delta_norm + real(R8Ki) :: delta_norm real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 integer(IntKi) :: i, j, k From 0b4894fcba2e0ac207ee879eecb3351234a47608 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Aug 2024 20:54:00 +0000 Subject: [PATCH 181/319] Fix beamdyn_utest incorrect size of m%qp%upp --- modules/beamdyn/tests/test_tools.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/beamdyn/tests/test_tools.F90 b/modules/beamdyn/tests/test_tools.F90 index f8c520fdc0..7030862c2d 100644 --- a/modules/beamdyn/tests/test_tools.F90 +++ b/modules/beamdyn/tests/test_tools.F90 @@ -286,7 +286,7 @@ type(BD_MiscVarType) function simpleMiscVarType(nqp, dof_node, elem_total, nodes call AllocAry(m%DistrLoad_QP, 6, nqp, elem_total, 'DistrLoad_QP', ErrStat, ErrMsg) call AllocAry(m%qp%uuu, dof_node, nqp, elem_total, 'm%qp%uuu displacement at quadrature point', ErrStat, ErrMsg) - call AllocAry(m%qp%uup, dof_node / 2, nqp, elem_total, 'm%qp%uup displacement prime at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%uup, dof_node, nqp, elem_total, 'm%qp%uup displacement prime at quadrature point', ErrStat, ErrMsg) ! E1, kappa -- used in force calculations call AllocAry(m%qp%E1, dof_node / 2, nqp, elem_total, 'm%qp%E1 at quadrature point', ErrStat, ErrMsg) From 37b6f3443e8530bf1a68ef45b2b518cf7c9235d5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Aug 2024 12:56:48 +0000 Subject: [PATCH 182/319] Fix more bugs in BeamDyn performance improvements --- modules/beamdyn/src/BeamDyn.f90 | 82 +++++++++++++++++++-------------- 1 file changed, 48 insertions(+), 34 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index ced271063e..32d2449c5c 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -2610,17 +2610,16 @@ subroutine Calc_Stif_betaC(RR0, Stif0, Stif, betaC) ! This is the following: ! tempBeta6 = matmul(tempR6, matmul(diag(p%beta), transpose(tempR6))) - ! Compute tempBeta_diag = beta * tempR6_T (for diagonal elements only) - do j = 1, 6 - tempBeta_diag(j) = p%beta(j) * tempR6_T(j, j) - end do - - ! Compute tempBeta6 using tempBeta_diag - do j = 1, 6 - do i = 1, 6 - tempBeta6(i, j) = tempR6(i, j) * tempBeta_diag(j) - end do - end do + ! Move damping ratio from material frame to the calculation reference frame + ! This is the following: + ! tempBEta6=matmul(tempR6,matmul(diag(p%beta),transpose(tempR6))) + do j=1,6 + do i=1,6 + ! diagonal of p%beta * TRANSPOSE(tempR6) + tempBeta6(i,j) = p%beta(i)*tempR6(j,i) + enddo + enddo + tempBeta6 = matmul(tempR6,tempBeta6) !> Modify the Mass matrix so it is in the calculation reference frame !! \f$ \begin{bmatrix} @@ -2699,8 +2698,8 @@ SUBROUTINE BD_ElasticForce(nelem,p,m,fact) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables. LOGICAL, INTENT(IN ) :: fact !< Boolean to calculate the Jacobian - REAL(BDKi) :: cet !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term - REAL(BDKi) :: k1s + REAL(BDKi) :: cet_t !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term + REAL(BDKi) :: k1s_t INTEGER(IntKi) :: idx_qp !< Index to quadrature point currently being calculated @@ -2708,21 +2707,33 @@ SUBROUTINE BD_ElasticForce(nelem,p,m,fact) do idx_qp=1,p%nqp call Calc_Fc_Fd(m%qp%RR0(:,:,idx_qp,nelem), & m%qp%uuu(:,idx_qp,nelem), & + p%E10(:,idx_qp,nelem), & m%qp%E1(:,idx_qp,nelem), & + m%qp%kappa(1:3,idx_qp,nelem), & + p%Stif0_QP(:,:,(nelem-1)*p%nqp+idx_qp), & + m%qp%Stif(:,:,idx_qp,nelem), & m%qp%Fc(:,idx_qp,nelem), & - m%qp%Fd(:,idx_qp,nelem)) + m%qp%Fd(:,idx_qp,nelem), & + cet_t, k1s_t) end do else do idx_qp=1,p%nqp call Calc_Fc_Fd(m%qp%RR0(:,:,idx_qp,nelem), & m%qp%uuu(:,idx_qp,nelem), & + p%E10(:,idx_qp,nelem), & m%qp%E1(:,idx_qp,nelem), & + m%qp%kappa(1:3,idx_qp,nelem), & + p%Stif0_QP(:,:,(nelem-1)*p%nqp+idx_qp), & + m%qp%Stif(:,:,idx_qp,nelem), & m%qp%Fc(:,idx_qp,nelem), & - m%qp%Fd(:,idx_qp,nelem)) + m%qp%Fd(:,idx_qp,nelem), & + cet_t, k1s_t) call Calc_Oe_Pe_Qe(m%qp%RR0(:,:,idx_qp,nelem), & m%qp%Stif(:,:,idx_qp,nelem), & + m%qp%E1(:,idx_qp,nelem), & m%qp%Fc(:,idx_qp,nelem), & + cet_t, k1s_t, & m%qp%Oe(:,:,idx_qp,nelem), & m%qp%Pe(:,:,idx_qp,nelem), & m%qp%Qe(:,:,idx_qp,nelem)) @@ -2730,8 +2741,8 @@ SUBROUTINE BD_ElasticForce(nelem,p,m,fact) end if contains - subroutine Calc_Oe_Pe_Qe(RR0, Stif, Fc, Oe, Pe, Qe) - REAL(BDKi), intent(in) :: RR0(:,:), Stif(:,:), Fc(:) + subroutine Calc_Oe_Pe_Qe(RR0, Stif, E1, Fc, cet, k1s, Oe, Pe, Qe) + REAL(BDKi), intent(in) :: RR0(:,:), Stif(:,:), E1(:), Fc(:), cet, k1s REAL(BDKi), intent(inout) :: Oe(:,:), Pe(:,:), Qe(:,:) REAL(BDKi) :: Wrk33(3,3) REAL(BDKi) :: tildeE(3,3) @@ -2754,7 +2765,7 @@ subroutine Calc_Oe_Pe_Qe(RR0, Stif, Fc, Oe, Pe, Qe) Wrk33 = OuterProduct(RR0(1:3,3), RR0(1:3,3)) ! z-direction in IEC coords C21 = Stif(4:6,1:3) + cet*k1s*Wrk33(:,:) - tildeE = SkewSymMat(m%qp%E1(:,idx_qp,nelem)) + tildeE = SkewSymMat(E1) epsi = MATMUL(Stif(1:3,1:3),tildeE) ! Stif is RR0 * p%Stif0_QP * RR0^T mu = MATMUL(C21,tildeE) @@ -2797,9 +2808,9 @@ subroutine Calc_Oe_Pe_Qe(RR0, Stif, Fc, Oe, Pe, Qe) Qe(4:6,4:6) = -MATMUL(tildeE,Oe(1:3,4:6)) end subroutine - subroutine Calc_Fc_Fd(RR0, uuu, E1, Fc, Fd) - REAL(BDKi), intent(in) :: RR0(:,:), uuu(:), E1(:) - REAL(BDKi), intent(inout) :: Fc(:), Fd(:) + subroutine Calc_Fc_Fd(RR0, uuu, E10, E1, kappa, Stif0, Stif, Fc, Fd, cet, k1s) + REAL(BDKi), intent(in) :: RR0(:,:), uuu(:), E10(:), E1(:), kappa(:), Stif0(:,:), Stif(:,:) + REAL(BDKi), intent(out) :: Fc(:), Fd(:), cet, k1s REAL(BDKi) :: e1s REAL(BDKi) :: eee(6) !< intermediate array for calculation Strain and curvature terms of Fc REAL(BDKi) :: fff(6) !< intermediate array for calculation of the elastic force, Fc @@ -2819,7 +2830,7 @@ subroutine Calc_Fc_Fd(RR0, uuu, E1, Fc, Fd) !! and the transpose for the other direction. ! eee(1:3) = m%qp%E1(1:3,idx_qp,nelem) - m%qp%RR0(1:3,3,idx_qp,nelem) ! Using RR0 z direction in IEC coords call BD_CrvMatrixR(uuu(4:6), R) ! Get rotation at QP as a matrix - Rx0p = matmul(R,p%E10(:,idx_qp,nelem)) ! Calculate rotated initial tangent + Rx0p = matmul(R,E10) ! Calculate rotated initial tangent eee(1:3) = E1(1:3) - Rx0p ! Use rotated initial tangent in place of RR0*i1 to eliminate likely mismatch between R0*i1 and x0' !> ### Set the 1D sectional curvature, \f$ \underline{\kappa} \f$, equation (5) @@ -2840,7 +2851,7 @@ subroutine Calc_Fc_Fd(RR0, uuu, E1, Fc, Fd) !! \f$ !! In other words, \f$ \tilde{k} = \left(\underline{\underline{R}}^\prime\underline{\underline{R}}^T \right) \f$. !! Note: \f$ \underline{\kappa} \f$ was already calculated in the BD_DisplacementQP routine - eee(4:6) = m%qp%kappa(1:3,idx_qp,nelem) + eee(4:6) = kappa(1:3) !FIXME: note that the k_i terms may not be documented correctly here. @@ -2872,7 +2883,7 @@ subroutine Calc_Fc_Fd(RR0, uuu, E1, Fc, Fd) !! \underline{k} !! \end{array} \right\} \f$ !! - fff(1:6) = MATMUL(m%qp%Stif(:,:,idx_qp,nelem),eee) + fff(1:6) = MATMUL(Stif,eee) !> ###Calculate the extension twist coupling. @@ -2907,7 +2918,7 @@ subroutine Calc_Fc_Fd(RR0, uuu, E1, Fc, Fd) !! Note that with coverting to the FAST / IEC coordinate system, we now are using the Ixx and Iyy terms which are located at !! \f$ C_{et} = C_{4,4} + C_{5,5} \f$ ! Refer Section 1.4 in "Dymore User's Manual - Formulation and finite element implementation of beam elements". - cet= p%Stif0_QP(4,4,(nelem-1)*p%nqp+idx_qp) + p%Stif0_QP(5,5,(nelem-1)*p%nqp+idx_qp) ! Dymore theory (22) + cet = Stif0(4,4) + Stif0(5,5) ! Dymore theory (22) Fc(1:3) = fff(1:3) + 0.5_BDKi*cet*k1s*k1s*RR0(1:3,3) ! Dymore theory (25a). Note z-axis is the length of blade. Fc(4:6) = fff(4:6) + cet*e1s*k1s*RR0(1:3,3) ! Dymore theory (25b). Note z-axis is the length of blade. @@ -3089,6 +3100,7 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) LOGICAL, INTENT(IN ) :: fact INTEGER(IntKi) :: idx_qp !< index of current quadrature point + REAL(BDKi) :: ffd_t(6) IF (.NOT. fact) then ! skip all but Fc and Fd terms @@ -3099,7 +3111,8 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) m%qp%vvp(:,idx_qp,nelem), & m%qp%betaC(:,:,idx_qp,nelem), & m%qp%Fc(:,idx_qp,nelem), & - m%qp%Fd(:,idx_qp,nelem)) + m%qp%Fd(:,idx_qp,nelem), & + ffd_t) END DO ! bjj: we don't use these values when fact is FALSE, so let's save time and ignore them here, too. @@ -3121,11 +3134,13 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) m%qp%vvp(:,idx_qp,nelem), & m%qp%betaC(:,:,idx_qp,nelem), & m%qp%Fc(:,idx_qp,nelem), & - m%qp%Fd(:,idx_qp,nelem)) + m%qp%Fd(:,idx_qp,nelem), & + ffd_t) call Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(m%qp%E1(:,idx_qp,nelem), & m%qp%vvp(:,idx_qp,nelem), & m%qp%betaC(:,:,idx_qp,nelem), & + ffd_t, & m%qp%Sd(:,:,idx_qp,nelem), & m%qp%Od(:,:,idx_qp,nelem), & m%qp%Qd(:,:,idx_qp,nelem), & @@ -3137,14 +3152,13 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) ENDIF CONTAINS - subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, Sd, Od, Qd, Gd, Xd, Yd, Pd) - REAL(BDKi), intent(in) :: E1(:), vvp(:), betaC(:,:) - REAL(BDKi), intent(inout) :: Sd(:,:), Od(:,:), Qd(:,:), Gd(:,:), Xd(:,:), Yd(:,:), Pd(:,:) + subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, ffd, Sd, Od, Qd, Gd, Xd, Yd, Pd) + REAL(BDKi), intent(in) :: E1(:), vvp(:), betaC(:,:), ffd(:) + REAL(BDKi), intent(out) :: Sd(:,:), Od(:,:), Qd(:,:), Gd(:,:), Xd(:,:), Yd(:,:), Pd(:,:) REAL(BDKi) :: D11(3,3), D12(3,3), D21(3,3), D22(3,3) REAL(BDKi) :: b11(3,3), b12(3,3) REAL(BDKi) :: alpha(3,3) REAL(BDKi) :: SS_ome(3,3) - REAL(BDKi) :: ffd(6) D11 = betaC(1:3,1:3) D12 = betaC(1:3,4:6) @@ -3192,10 +3206,10 @@ subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, Sd, Od, Qd, Gd, Xd, Yd, Pd) Yd(4:6,4:6) = b12 end subroutine - SUBROUTINE Calc_FC_FD_ffd(E1, vvv, vvp, betaC, Fc, Fd) + SUBROUTINE Calc_FC_FD_ffd(E1, vvv, vvp, betaC, Fc, Fd, ffd) REAL(BDKi), intent(in) :: E1(:), vvv(:), vvp(:), betaC(:,:) - REAL(BDKi), intent(inout) :: Fc(:), Fd(:) - REAL(BDKi) :: eed(6), ffd(6) + REAL(BDKi), intent(out) :: Fc(:), Fd(:), ffd(:) + REAL(BDKi) :: eed(6) ! Compute strain rates eed = vvp From 4c93cf7a3e7eccbd74a81e6dd2609f4e0828302a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Aug 2024 18:42:13 +0000 Subject: [PATCH 183/319] Update executePythonRegressionCase.py for TC outputs --- reg_tests/executePythonRegressionCase.py | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/reg_tests/executePythonRegressionCase.py b/reg_tests/executePythonRegressionCase.py index 13ecb5218f..84fdb9cd7d 100644 --- a/reg_tests/executePythonRegressionCase.py +++ b/reg_tests/executePythonRegressionCase.py @@ -144,10 +144,18 @@ baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") rtl.validateFileOrExit(baselineOutFile) -testInfo = { - "attribute_names": output_channel_names -} +testInfo = {"attribute_names": output_channel_names} testData = openfastlib.output_values + +# Remove columns that shouldn't be compared +for col in 'ConvIter ConvError NumUJac'.split(): + try: + i = testInfo['attribute_names'].index(col) + del testInfo['attribute_names'][i] + testData = np.delete(testData, i, axis=1) + except ValueError as e: + continue + baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) From 699bcb0a5a87a4ce83185bee89cffa47eca0ce1c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Aug 2024 18:43:13 +0000 Subject: [PATCH 184/319] Reworked TC Solver initialization method --- .../openfast-library/src/FAST_SolverTC.f90 | 485 ++++++++++++------ 1 file changed, 328 insertions(+), 157 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index cbe3b3ef2c..0f6f09d51b 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -49,23 +49,9 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Initialize data in TC structure !---------------------------------------------------------------------------- - ! Solver time step - p%h = p_FAST%DT - - ! Number of steps to advance between Jacobian updates - if (p_FAST%DT_UJac/p_FAST%DT + 1 < huge(1_IntKi)) then - p%NStep_UJac = ceiling(p_FAST%DT_UJac/p_FAST%DT, IntKi) - else - p%NStep_UJac = huge(1_IntKi) - end if - - ! Number of convergence iterations between Jacobian updates - ! TODO: read from input file - p%NIter_UJac = 10000 - ! Generalized alpha damping coefficient ! TODO: read from input file - p%RhoInf = 1.0_R8Ki + p%RhoInf = 0.0_R8Ki ! Max number of convergence iterations ! TODO: read from input file @@ -75,6 +61,21 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! TODO: read from input file p%ConvTol = 1.0e-4_R8Ki + ! Solver time step + p%h = p_FAST%DT + + ! If time between Jacobian updates is less than the time step + if (p_FAST%DT_UJac < p_FAST%DT) then + p%NStep_UJac = huge(1_IntKi) ! Disable step based Jacobian updates + p%NIter_UJac = ceiling(p_FAST%DT_UJac/p_FAST%DT*real(p%MaxConvIter, R8Ki), IntKi) + else if (p_FAST%DT_UJac/p_FAST%DT + 1 < huge(1_IntKi)) then + p%NStep_UJac = ceiling(p_FAST%DT_UJac/p_FAST%DT, IntKi) + p%NIter_UJac = huge(1_IntKi) ! Disable iteration based Jacobian updates + else + p%NStep_UJac = huge(1_IntKi) ! Disable step based Jacobian updates + p%NIter_UJac = huge(1_IntKi) ! Disable iteration based Jacobian updates + end if + ! Jacobian conditioning p%Scale_UJac = p_FAST%UJacSclFact @@ -103,7 +104,16 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, pack(modInds, ModIDs == Module_BD), & pack(modInds, ModIDs == Module_SD), & pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_SeaSt), & pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_FEAM), & + pack(modInds, ModIDs == Module_IceD), & + pack(modInds, ModIDs == Module_IceF), & + pack(modInds, ModIDs == Module_MAP), & + pack(modInds, ModIDs == Module_MD), & + pack(modInds, ModIDs == Module_ExtPtfm), & + pack(modInds, ModIDs == Module_HD), & + pack(modInds, ModIDs == Module_Orca), & pack(modInds, ModIDs == Module_SrvD)] ! ServoDyn is last ! Indices of tight coupling modules @@ -114,6 +124,7 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Indices of Option 1 modules p%iModOpt1 = [pack(modInds, ModIDs == Module_ExtPtfm), & pack(modInds, ModIDs == Module_HD), & + pack(modInds, ModIDs == Module_MD), & pack(modInds, ModIDs == Module_Orca)] ! Indices of Option 2 modules @@ -122,6 +133,7 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, pack(modInds, ModIDs == Module_BD), & pack(modInds, ModIDs == Module_SD), & pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_SeaSt), & pack(modInds, ModIDs == Module_AD), & pack(modInds, ModIDs == Module_FEAM), & pack(modInds, ModIDs == Module_IceD), & @@ -131,7 +143,6 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Indices of modules to perform InputSolves after the Option 1 solve p%iModPost = [pack(modInds, ModIDs == Module_SrvD), & - pack(modInds, ModIDs == Module_MD), & pack(modInds, ModIDs == Module_ExtInfw)] !---------------------------------------------------------------------------- @@ -164,18 +175,18 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, call AllocAry(m%uCalc, m%Mod%Vars%Nu, "m%uCalc", ErrStat2, ErrMsg2); if (Failed()) return ! Generalized alpha state arrays - call AllocAry(m%State%q_prev, p%NumQ, "m%State%q_prev", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%State%x, p%NumQ, "m%State%q_delta", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%State%q, p%NumQ, "m%State%q", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%State%v, p%NumQ, "m%State%v", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%State%vd, p%NumQ, "m%State%vd", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%State%a, p%NumQ, "m%State%a", ErrStat2, ErrMsg2); if (Failed()) return - m%State%q_prev = 0.0_R8Ki - m%State%x = 0.0_R8Ki - m%State%q = 0.0_R8Ki - m%State%v = 0.0_R8Ki - m%State%vd = 0.0_R8Ki - m%State%a = 0.0_R8Ki + call AllocAry(m%StateCurr%q_prev, p%NumQ, "m%StateCurr%q_prev", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%x, p%NumQ, "m%StateCurr%q_delta", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%q, p%NumQ, "m%StateCurr%q", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%v, p%NumQ, "m%StateCurr%v", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%vd, p%NumQ, "m%StateCurr%vd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%a, p%NumQ, "m%StateCurr%a", ErrStat2, ErrMsg2); if (Failed()) return + m%StateCurr%q_prev = 0.0_R8Ki + m%StateCurr%x = 0.0_R8Ki + m%StateCurr%q = 0.0_R8Ki + m%StateCurr%v = 0.0_R8Ki + m%StateCurr%vd = 0.0_R8Ki + m%StateCurr%a = 0.0_R8Ki !---------------------------------------------------------------------------- ! Allocate solver Jacobian matrix and right hand side @@ -183,16 +194,10 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ! Allocate Jacobian matrix, RHS/X matrix, Pivot array call AllocAry(m%Mod%Lin%J, p%NumJ, p%NumJ, "m%J", ErrStat, ErrMsg); if (Failed()) return - call AllocAry(m%T, p%NumJ, 3, "m%T", ErrStat, ErrMsg); if (Failed()) return call AllocAry(m%XB, p%NumJ, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return call AllocAry(m%IPIV, p%NumJ, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return m%Mod%Lin%J = 0.0_R8Ki - ! Initialize iterations and steps until Jacobian is calculated to zero - ! so it is calculated in first step - m%IterUntilUJac = 0 - m%StepsUntilUJac = 0 - !---------------------------------------------------------------------------- ! Write debug info to file !---------------------------------------------------------------------------- @@ -276,7 +281,7 @@ subroutine SetVarSolveFlags() end if ! If destination module is in tight coupling - if (any(DstMod%ID == TC_Modules) ) then + if (any(DstMod%ID == TC_Modules)) then ! Set mapping flag on destination variables do i = 1, size(DstMod%Vars%u) @@ -651,14 +656,14 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'Solver_Step0' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - logical, parameter :: IsSolve = .true. integer(IntKi) :: i, j, k - real(R8Ki) :: ConvError - logical :: converged integer(IntKi), parameter :: n_t_global = -1 ! loop counter integer(IntKi), parameter :: n_t_global_next = 0 ! loop counter real(DbKi) :: t_initial ! next simulation time real(DbKi) :: t_global_next ! next simulation time + logical :: IsConverged + integer(IntKi) :: ConvIter, CorrIter, TotalIter + real(R8Ki) :: ConvError ErrStat = ErrID_None ErrMsg = '' @@ -688,77 +693,251 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg if (Failed()) return ! Transfer initial module state to GA state - call TransferXtoQ(ModData, m%Mod%Lin%x, m%State) + call TransferXtoQ(ModData, m%Mod%Lin%x, m%StateCurr) + + ! Transfer accelerations from BeamDyn + if (ModData%ID == Module_BD) then + call GetBDAccel(ModData, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR), m%StateCurr) + end if + end associate end do + ! Initialize + m%StateCurr%q_prev = m%StateCurr%q + m%StateCurr%x = 0.0_R8Ki + ! Reset mapping ready for transfer flag GlueModMaps%Ready = .false. - ! Loop until initial accelerations are converged, or max iterations are reached. - ! TODO: may need a separate variable for max initial acceleration convergence iterations - converged = .false. - k = 0 - do while ((.not. converged) .and. (k <= 2*p%MaxConvIter)) + !---------------------------------------------------------------------------- + ! Perform iterations to initialize inputs and acceleration + ! States are not modified + !---------------------------------------------------------------------------- - ! Transfer inputs and calculate outputs for all modules (use current state) - do i = 1, size(p%iModInit) - call FAST_InputSolve(p%iModInit(i), GlueModData, GlueModMaps, INPUT_CURR, & - Turbine, ErrStat2, ErrMsg2) - if (Failed()) return - call FAST_CalcOutput(GlueModData(p%iModInit(i)), GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, & - Turbine, ErrStat2, ErrMsg2) + ! Initialize temporary input structure for TC and Option1 modules + do i = 1, size(m%Mod%ModData) + call FAST_CopyInput(m%Mod%ModData(i), Turbine, INPUT_CURR, INPUT_TEMP, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + TotalIter = 0 + + ! Copy TC solver states from current to predicted + call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Do two input correction iterations + do CorrIter = 1, 3 + + ! Set converged flag to false + IsConverged = .false. + + !------------------------------------------------------------------------- + ! InputSolve and CalcOutput for all modules, pack TC and Option 1 inputs + !------------------------------------------------------------------------- + + ! Do input solve and calculate outputs for Option 2 modules (except ServoDyn) + do i = 2, size(p%iModOpt2) + associate (ModData => GlueModData(p%iModOpt2(i))) + + ! Solve for inputs + call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate outputs + call FAST_CalcOutput(ModData, GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + + ! Do input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end do - ! Calculate continuous state derivatives for tight coupling modules (use current state) + ! Pack TC and Option 1 inputs into u array do i = 1, size(m%Mod%ModData) - call FAST_GetOP(m%Mod%ModData(i), t_initial, INPUT_CURR, STATE_CURR, & - Turbine, ErrStat2, ErrMsg2, & - dx_op=m%Mod%ModData(i)%Lin%dx, dx_glue=m%Mod%Lin%dx) - if (Failed()) return + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate end do - ! Copy acceleration (derivative of velocity) to acceleration array. - associate (Vars => m%Mod%Vars) - do i = 1, size(Vars%x) - select case (Vars%x(i)%DerivOrder) - case (1) ! Velocity - m%State%vd(Vars%x(i)%iq(1):Vars%x(i)%iq(2)) = m%Mod%Lin%dx(Vars%x(i)%iLoc(1):Vars%x(i)%iLoc(2)) - end select + !------------------------------------------------------------------------- + ! Convergence Iterations for TC and Option 1 modules + !------------------------------------------------------------------------- + + ! Loop through convergence iterations + do ConvIter = 0, p%MaxConvIter + + ! Increment total number of convergence iterations in step + TotalIter = TotalIter + 1 + + !---------------------------------------------------------------------- + ! Calculate outputs for TC & Opt1 modules + !---------------------------------------------------------------------- + + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_CalcOutput(ModData, GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate end do - end associate - ! Calculate convergence error as L2 norm of diff between current and new accelerations - ConvError = TwoNorm(m%State%vd - m%State%a) + !---------------------------------------------------------------------- + ! Convergence iteration check + !---------------------------------------------------------------------- - ! Update algorithmic acceleration - m%State%a = m%State%vd + ! If convergence iteration has reached or exceeded limit, exit loop + if (ConvIter >= p%MaxConvIter) exit - ! Transfer acceleration to BeamDyn if module is active - do i = 1, size(p%iModTC) - associate (ModData => m%Mod%ModData(i)) - if (ModData%ID == Module_BD) then - call SetBDAccel(ModData, m%State, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) - end if - end associate + !---------------------------------------------------------------------- + ! Update Jacobian + !---------------------------------------------------------------------- + + call BuildJacobian(p, m, GlueModMaps, t_initial, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------- + ! Formulate right hand side (X_2^tight, U^tight, U^Option1) + !---------------------------------------------------------------------- + + ! Calculate continuous state derivatives for tight coupling modules + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + dx_op=m%Mod%ModData(i)%Lin%dx, dx_glue=m%Mod%Lin%dx) + if (Failed()) return + end do + + ! Input solve for tight coupling modules + do i = 1, size(p%iModTC) + call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Collect TC and Option 1 inputs into uCalc + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_initial, INPUT_TEMP, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%uCalc) + if (Failed()) return + end do + + !---------------------------------------------------------------------- + ! Populate residual vector and apply conditioning to loads + !---------------------------------------------------------------------- + + ! Calculate difference between calculated and predicted accelerations + if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%StatePred%vd + + ! Calculate difference in U for all Option 1 modules (un - u_tmp) + ! and add to RHS for TC and Option 1 modules + if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB(p%iJU(1):p%iJU(2), 1)) + + ! Apply conditioning factor to loads in RHS + if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)/p%Scale_UJac + + !---------------------------------------------------------------------- + ! Solve for state and input perturbations + !---------------------------------------------------------------------- + + ! Solve Jacobian and RHS + call LAPACK_getrs('N', p%NumJ, m%Mod%Lin%J, m%IPIV, m%XB, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------- + ! Check perturbations for convergence and exit if below tolerance + !---------------------------------------------------------------------- + + ! Calculate average L2 norm of change in states and inputs + ConvError = TwoNorm(m%XB(:, 1))/size(m%XB) + + ! If at least one convergence iteration has been done and the RHS norm + ! is less than convergence tolerance, set flag and exit convergence loop + if ((ConvIter > 0) .and. (ConvError < p%ConvTol)) then + IsConverged = .true. + exit + end if + + ! Remove load conditioning on inputs + if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)*p%Scale_UJac + + !---------------------------------------------------------------------- + ! Update acceleration and inputs + !---------------------------------------------------------------------- + + ! Update State acceleration prediction (do not change other states) + if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%StatePred) + ! if (p%iJX(1) > 0) m%StatePred%vd = m%StatePred%vd + m%XB(p%iJX(1):p%iJX(2), 1) + + ! Add change in inputs + if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) + + ! Transfer updated inputs to modules + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + + ! Transfer States to linearization array + call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) + + ! Transfer states and inputs to modules + call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + + ! Transfer accelerations to BeamDyn + if (ModData%ID == Module_BD) then + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + end if + + end associate + end do + end do ! Convergence loop + + ! Perform input solve for modules post Option 1 convergence + do i = 1, size(p%iModPost) + call FAST_InputSolve(p%iModPost(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return end do - ! If difference is less than convergence tolerance, set flag to exit loop - if ((k > 1) .and. (ConvError < p%ConvTol)) converged = .true. + ! Calculate output for ServoDyn + if (CorrIter == 2) then + call FAST_CalcOutput(GlueModData(p%iModOpt2(1)), GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if - ! Increment iteration counter - k = k + 1 - end do + end do ! Input correction loop ! Print warning if not converged - if (.not. converged) then - call WrScr("Solver: initial accel not converged, diff="// & + if (.not. IsConverged) then + call WrScr("Solver: initial step not converged, error="// & trim(Num2LStr(ConvError))//", tol="//trim(Num2LStr(p%ConvTol))) end if + !---------------------------------------------------------------------------- + ! Post convergence calculations + !---------------------------------------------------------------------------- + + ! Set algorithmic acceleration from actual acceleration + m%StatePred%a = (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM)*m%StatePred%vd + + !---------------------------------------------------------------------------- + ! Post-convergence initialization + !---------------------------------------------------------------------------- + ! Copy current state to previous state - call Glue_CopyTC_State(m%State, m%StatePrev, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call Glue_CopyTC_State(m%StatePred, m%StateCurr, MESH_NEWCOPY, ErrStat2, ErrMsg2) if (Failed()) return ! Initialize IO and states for all modules (also copies STATE_CURR to STATE_PRED) @@ -773,9 +952,9 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg ! Set Outputs !---------------------------------------------------------------------------- - Turbine%y_FAST%DriverWriteOutput(1) = real(k, ReKi) ! ConvIter + Turbine%y_FAST%DriverWriteOutput(1) = real(TotalIter, ReKi) ! ConvIter Turbine%y_FAST%DriverWriteOutput(2) = real(ConvError, ReKi) ! ConvError - Turbine%y_FAST%DriverWriteOutput(3) = 0.0_ReKi ! NumUJac + Turbine%y_FAST%DriverWriteOutput(3) = real(TotalIter, ReKi) ! NumUJac contains logical function Failed() @@ -799,9 +978,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 logical, parameter :: IsSolve = .true. - integer(IntKi) :: iterConv, iterCorr, iterTotal + integer(IntKi) :: ConvIter, CorrIter, TotalIter integer(IntKi) :: NumUJac, NumCorrections - real(R8Ki) :: delta_norm + real(R8Ki) :: ConvError real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 integer(IntKi) :: i, j, k @@ -824,14 +1003,14 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, Turbine%p_FAST%TStart, Turbine%p_FAST%n_DT_Out) ! Decrement number of time steps before updating the Jacobian - m%StepsUntilUJac = m%StepsUntilUJac - 1 + m%UJacStepsRemain = m%UJacStepsRemain - 1 ! Set Jacobian updated for convergence flag to false ConvUJac = .false. ! Init counters for number of Jacobian updates and number of convergence iterations NumUJac = 0 - iterTotal = 0 + TotalIter = 0 !---------------------------------------------------------------------------- ! Extrapolate/interpolate inputs for all modules @@ -861,7 +1040,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu case (Module_BD) ! Transfer acceleration from TC state to BeamDyn - call SetBDAccel(ModData, m%StatePrev, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + call SetBDAccel(ModData, m%StateCurr, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) ! Reset BeamDyn states so they are relative to the root node call BD_UpdateGlobalRef(Turbine%BD%Input(INPUT_CURR, ModData%Ins), & @@ -872,7 +1051,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu if (Failed()) return ! Transfer acceleration from BeamDyn to state - call GetBDAccel(ModData, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR), m%StatePrev) + call GetBDAccel(ModData, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR), m%StateCurr) case default cycle @@ -884,38 +1063,35 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu if (Failed()) return ! Transfer current states to linearization array - call TransferXtoQ(ModData, m%Mod%Lin%x, m%StatePrev) + call TransferXtoQ(ModData, m%Mod%Lin%x, m%StateCurr) end associate end do - !---------------------------------------------------------------------------- - ! Prediction - guess solution state variables at end of time step - !---------------------------------------------------------------------------- - - call PredictNextState(p, m%StatePrev, m%Mod%Vars) - !---------------------------------------------------------------------------- ! Correction Iterations !---------------------------------------------------------------------------- ! Loop through correction iterations - iterCorr = 0 + CorrIter = 0 NumCorrections = p%NumCrctn - do while (iterCorr <= NumCorrections) + do while (CorrIter <= NumCorrections) ! Reset mapping ready flags GlueModMaps%Ready = .false. - ! Copy TC solver states from previous to current - call Glue_CopyTC_State(m%StatePrev, m%State, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + ! Copy TC solver states from current to predicted + call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return + ! Update state prediction + call PredictNextState(p, m%StatePred, m%Mod%Vars) + ! Loop through tight coupling modules do i = 1, size(p%iModTC) associate (ModData => m%Mod%ModData(i)) ! Transfer current states to linearization array - call TransferQtoX(ModData, m%State, m%Mod%Lin%x) + call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) ! Copy state from current to predicted call FAST_CopyStates(ModData, Turbine, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) @@ -925,6 +1101,11 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu call FAST_SetOP(ModData, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) if (Failed()) return + + ! Transfer accelerations to BeamDyn + if (ModData%ID == Module_BD) then + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + end if end associate end do @@ -950,10 +1131,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu end associate end do - ! -4.9345743494052119 -9.4942092091626126E-003 91.498545759647968 - ! -4.9345900476124651 -1.8983439772237952E-002 91.498449503167748 - ! write (*, *) Turbine%BD%y(1)%BldMotion%Position(:, 1) + Turbine%BD%y(1)%BldMotion%TranslationDisp(:, 1) - !------------------------------------------------------------------------- ! Option 1 Solve !------------------------------------------------------------------------- @@ -984,13 +1161,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu !------------------------------------------------------------------------- ! Loop through convergence iterations - do iterConv = 0, p%MaxConvIter + do ConvIter = 0, p%MaxConvIter ! Increment total number of convergence iterations in step - iterTotal = iterTotal + 1 + TotalIter = TotalIter + 1 ! Decrement number of iterations before updating the Jacobian - m%IterUntilUJac = m%IterUntilUJac - 1 + m%UJacIterRemain = m%UJacIterRemain - 1 !---------------------------------------------------------------------- ! Calculate outputs for TC & Opt1 modules @@ -1009,17 +1186,17 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu !---------------------------------------------------------------------- ! If convergence iteration has reached or exceeded limit - if (iterConv >= p%MaxConvIter) then + if (ConvIter >= p%MaxConvIter) then ! If Jacobian has not been updated for convergence if (.not. ConvUJac) then ! Set counter to trigger a Jacobian update on next convergence iteration - m%IterUntilUJac = 0 + m%UJacIterRemain = 0 ! If at the maximum number of correction iterations, ! increase limit to retry the step after the Jacobian is updated - if (iterCorr == NumCorrections) NumCorrections = NumCorrections + 1 + if (CorrIter == NumCorrections) NumCorrections = NumCorrections + 1 ! Set flag indicating that the jacobian has been updated for convergence ConvUJac = .true. @@ -1030,7 +1207,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! display warning that convergence failed and move to next step call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & " iterations on step "//trim(Num2LStr(n_t_global_next))// & - " (error="//trim(Num2LStr(delta_norm))// & + " (error="//trim(Num2LStr(ConvError))// & ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & ErrStat, ErrMsg, RoutineName) end if @@ -1046,11 +1223,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! If number of iterations or steps until Jacobian is to be updated ! is zero or less, or first solution step, then rebuild the Jacobian. ! Note: BuildJacobian resets these counters. - if ((m%IterUntilUJac <= 0) .or. & - (m%StepsUntilUJac <= 0) .or. & - (n_t_global_next == 1)) then + if ((m%UJacIterRemain <= 0) .or. (m%UJacStepsRemain <= 0)) then NumUJac = NumUJac + 1 - call BuildJacobian(p, m, GlueModMaps, t_global_next, Turbine, ErrStat2, ErrMsg2) + call BuildJacobian(p, m, GlueModMaps, t_global_next, STATE_PRED, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end if @@ -1093,23 +1268,21 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu !---------------------------------------------------------------------- ! Calculate difference between calculated and predicted accelerations - if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%State%vd + if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%StatePred%vd ! Calculate difference in U for all Option 1 modules (un - u_tmp) ! and add to RHS for TC and Option 1 modules if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB(p%iJU(1):p%iJU(2), 1)) ! Apply conditioning factor to loads in RHS - do i = p%iJL(1), p%iJL(2) - m%XB(i, 1) = m%XB(i, 1)/p%Scale_UJac - end do + if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)/p%Scale_UJac !---------------------------------------------------------------------- ! Solve for state and input perturbations !---------------------------------------------------------------------- ! Solve Jacobian and RHS - call LAPACK_getrs('N', size(m%Mod%Lin%J, 1), m%Mod%Lin%J, m%IPIV, m%XB, ErrStat2, ErrMsg2) + call LAPACK_getrs('N', p%NumJ, m%Mod%Lin%J, m%IPIV, m%XB, ErrStat2, ErrMsg2) if (Failed()) return !---------------------------------------------------------------------- @@ -1117,25 +1290,23 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu !---------------------------------------------------------------------- ! Calculate average L2 norm of change in states and inputs - delta_norm = TwoNorm(m%XB(:, 1))/size(m%XB) + ConvError = TwoNorm(m%XB(:, 1))/size(m%XB) ! Write step debug info if requested - if (DebugSolver) call Solver_Step_Debug(p, m, n_t_global_next, iterCorr, iterConv, delta_norm) + if (DebugSolver) call Solver_Step_Debug(p, m, n_t_global_next, CorrIter, ConvIter, ConvError) ! If at least one convergence iteration has been done and ! the RHS norm is less than convergence tolerance, exit loop - if ((iterConv > 0) .and. (delta_norm < p%ConvTol)) exit + if ((ConvIter > 0) .and. (ConvError < p%ConvTol)) exit - ! Remove conditioning - do i = p%iJL(1), p%iJL(2) - m%XB(i, 1) = m%XB(i, 1)*p%Scale_UJac - end do + ! Remove load condition conditioning on input changes + if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)*p%Scale_UJac !---------------------------------------------------------------------- ! Update State for Tight Coupling modules !---------------------------------------------------------------------- - if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%State) + if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%StatePred) !---------------------------------------------------------------------- ! Update inputs for Tight Coupling and Option 1 modules @@ -1152,26 +1323,25 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu associate (ModData => m%Mod%ModData(i)) ! Transfer States to linearization array - call TransferQtoX(ModData, m%State, m%Mod%Lin%x) + call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) ! Transfer states and inputs to modules call FAST_SetOP(ModData, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x, & u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) if (Failed()) return - end associate - end do - ! Transfer acceleration to BD other states - do i = 1, size(p%iModTC) - if (m%Mod%ModData(i)%ID == Module_BD) then - call SetBDAccel(m%Mod%ModData(i), m%State, Turbine%BD%OtherSt(m%Mod%ModData(i)%Ins, STATE_PRED)) - end if + ! Transfer accelerations to BeamDyn + if (ModData%ID == Module_BD) then + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_PRED)) + end if + + end associate end do end do ! Increment correction iteration counter - iterCorr = iterCorr + 1 + CorrIter = CorrIter + 1 ! Perform input solve for modules post Option 1 convergence do i = 1, size(p%iModPost) @@ -1189,10 +1359,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu !---------------------------------------------------------------------------- ! Update algorithmic acceleration - m%State%a = m%State%a + (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM)*m%State%vd + m%StatePred%a = m%StatePred%a + (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM)*m%StatePred%vd - ! Copy current state to previous state - call Glue_CopyTC_State(m%State, m%StatePrev, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + ! Copy predicted state to current state + call Glue_CopyTC_State(m%StatePred, m%StateCurr, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return ! Copy the final predicted states from step t_global_next to actual states for that step @@ -1205,8 +1375,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! Set Outputs !---------------------------------------------------------------------------- - Turbine%y_FAST%DriverWriteOutput(1) = real(iterTotal, ReKi) ! ConvIter - Turbine%y_FAST%DriverWriteOutput(2) = real(delta_norm, ReKi) ! ConvError + Turbine%y_FAST%DriverWriteOutput(1) = real(TotalIter, ReKi) ! ConvIter + Turbine%y_FAST%DriverWriteOutput(2) = real(ConvError, ReKi) ! ConvError Turbine%y_FAST%DriverWriteOutput(3) = real(NumUJac, ReKi) ! NumUJac !---------------------------------------------------------------------------- @@ -1222,11 +1392,12 @@ logical function Failed() end function end subroutine -subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) +subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat, ErrMsg) type(Glue_TCParam), intent(in) :: p !< Parameters type(Glue_TCMisc), intent(inout) :: m !< Misc variables type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings at glue level real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iState !< State index type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1241,8 +1412,8 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) ErrMsg = '' ! Reset Jacobian update countdown values - m%IterUntilUJac = p%NIter_UJac - m%StepsUntilUJac = p%NStep_UJac + m%UJacIterRemain = p%NIter_UJac + m%UJacStepsRemain = p%NStep_UJac if (size(m%Mod%Lin%J) == 0) return @@ -1270,13 +1441,13 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) associate (ModData => m%Mod%ModData(i)) ! Calculate dYdx, dXdx for tight coupling modules - call FAST_JacobianPContState(ModData, ThisTime, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + call FAST_JacobianPContState(ModData, ThisTime, INPUT_CURR, iState, Turbine, ErrStat2, ErrMsg2, & dXdx=ModData%Lin%dXdx, dXdx_glue=m%Mod%Lin%dXdx, & dYdx=ModData%Lin%dYdx, dYdx_glue=m%Mod%Lin%dYdx) if (Failed()) return ! Calculate Jacobians wrt inputs - call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, iState, Turbine, ErrStat2, ErrMsg2, & dXdu=ModData%Lin%dXdu, dXdu_glue=m%Mod%Lin%dXdu, & dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) if (Failed()) return @@ -1286,7 +1457,7 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) ! Loop through Option 1 modules and calculate dYdu do i = size(p%iModTC) + 1, size(m%Mod%ModData) associate (ModData => m%Mod%ModData(i)) - call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, iState, Turbine, ErrStat2, ErrMsg2, & dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) if (Failed()) return end associate @@ -1307,8 +1478,8 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) ! Group (1,1) associate (J11 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJX(1):p%iJX(2)), & - dX2dx2 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)), & - dX2dx1 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX1(1):p%iX1(2))) + dX2dx2 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)), & + dX2dx1 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX1(1):p%iX1(2))) J11 = -p%GammaPrime*dX2dx2 - p%BetaPrime*dX2dx1 do i = p%iJX(1), p%iJX(2) J11(i, i) = J11(i, i) + 1.0_R8Ki @@ -1318,9 +1489,9 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) ! Group (2,1) if (p%iyT(1) > 0 .and. p%iUT(1) > 0) then associate (J21 => m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)), & - dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & - dYTdx2 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2)), & - dYTdx1 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) + dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & + dYTdx2 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2)), & + dYTdx1 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) ! J21 = C1*matmul(dUTdyT, dYTdx2) + C2*matmul(dUTdyT, dYTdx1) call LAPACK_GEMM('N', 'N', p%GammaPrime, dUTdyT, dYTdx2, 0.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return call LAPACK_GEMM('N', 'N', p%BetaPrime, dUTdyT, dYTdx1, 1.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return @@ -1330,7 +1501,7 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, Turbine, ErrStat, ErrMsg) ! Group (1,2) if (p%iUT(1) > 0) then associate (J12 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJUT(1):p%iJUT(2)), & - dX2duT => m%Mod%Lin%dXdu(p%iX2(1):p%iX2(2), p%iUT(1):p%iUT(2))) + dX2duT => m%Mod%Lin%dXdu(p%iX2(1):p%iX2(2), p%iUT(1):p%iUT(2))) J12 = -dX2duT end associate end if From 07ae8bbbec17b3a928ead1697ae426e222237dcf Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Aug 2024 20:06:59 +0000 Subject: [PATCH 185/319] FAST_Func: Add SeaSt CalcOutput, fix MAP_UpdateStates --- modules/openfast-library/src/FAST_Funcs.f90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index ccf4442540..4ca5dcef7f 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -302,10 +302,10 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) end do case (Module_BD) - ! State update is handled by solver as part of tight coupling + ! State update is handled by tight coupling solver case (Module_ED) - ! State update is handled by solver as part of tight coupling + ! State update is handled by tight coupling solver case (Module_ExtPtfm) call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) @@ -388,10 +388,10 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) do j_ss = 1, ModData%SubSteps n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial - call MD_UpdateStates(t_module, n_t_module, T%MD%Input(1:), T%MD%InputTimes, T%MD%p, & - T%MD%x(STATE_PRED), T%MD%xd(STATE_PRED), & - T%MD%z(STATE_PRED), T%MD%OtherSt(STATE_PRED), & - T%MD%m, ErrStat2, ErrMsg2) + call MAP_UpdateStates(t_module, n_t_module, T%MAP%Input(1:), T%MAP%InputTimes, T%MAP%p, & + T%MAP%x(STATE_PRED), T%MAP%xd(STATE_PRED), & + T%MAP%z(STATE_PRED), T%MAP%OtherSt, & + ErrStat2, ErrMsg2) if (Failed()) return end do @@ -426,7 +426,7 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) end do case (Module_SD) - ! State update is handled by solver as part of tight coupling + ! State update is handled by tight coupling solver case (Module_SeaSt) call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) @@ -551,7 +551,11 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt T%SD%x(iState), T%SD%xd(iState), T%SD%z(iState), T%SD%OtherSt(iState), & T%SD%y, T%SD%m, ErrStat2, ErrMsg2) -! case (Module_SeaSt) + case (Module_SeaSt) + call SeaSt_CalcOutput(ThisTime, T%SeaSt%Input(iInput), T%SeaSt%p, & + T%SeaSt%x(iState), T%SeaSt%xd(iState), T%SeaSt%z(iState), T%SeaSt%OtherSt(iState), & + T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2) + case (Module_SrvD) call SrvD_CalcOutput(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, & T%SrvD%x(iState), T%SrvD%xd(iState), T%SrvD%z(iState), T%SrvD%OtherSt(iState), & From 04f488a665fe11e57e00e9dfbac339c0d03ea882 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Aug 2024 20:07:55 +0000 Subject: [PATCH 186/319] Specify name in Glue_CombineModules --- modules/openfast-library/src/FAST_ModGlue.f90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 5e0b30b79d..b86448231d 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -38,7 +38,7 @@ module FAST_ModGlue contains -subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilter, Linearize, ErrStat, ErrMsg) +subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilter, Linearize, ErrStat, ErrMsg, Name) type(ModGlueType), intent(out) :: ModGlue type(ModDataType), intent(in) :: ModDataAry(:) integer(IntKi), intent(in) :: iModAry(:) @@ -47,6 +47,7 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte type(MappingType), intent(in) :: Mappings(:) !< Mesh and variable mappings integer(IntKi), intent(out) :: ErrStat character(ErrMsgLen), intent(out) :: ErrMsg + character(*), optional, intent(in) :: Name character(*), parameter :: RoutineName = 'Glue_CombineModules' integer(IntKi) :: ErrStat2 @@ -70,6 +71,13 @@ subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilte return end if + ! Set module name + if (present(Name)) then + ModGlue%Name = Name + else + ModGlue%Name = '' + end if + !---------------------------------------------------------------------------- ! Allocate module data array !---------------------------------------------------------------------------- From 3e171d41e64de80e0feac3d7f4619ffe04b545ab Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Aug 2024 20:08:09 +0000 Subject: [PATCH 187/319] Rename some vars in Glue_Registry.txt --- .../openfast-library/src/Glue_Registry.txt | 9 ++-- modules/openfast-library/src/Glue_Types.f90 | 54 +++++++------------ 2 files changed, 22 insertions(+), 41 deletions(-) diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index 8afa5ae9de..5a811232c9 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -165,15 +165,14 @@ typedef ^ ^ R8Ki vd : - - typedef ^ ^ R8Ki a : - - "Generalized alpha algorithmic acceleration" - typedef ^ Glue_TCMisc ModGlueType Mod - - - "Glue module combining tight coupling modules" - -typedef ^ ^ TC_State State - - - "Tight Coupling state" -typedef ^ ^ TC_State StatePrev - - - "Tight Coupling previous state for correction iterations" +typedef ^ ^ TC_State StateCurr - - - "Tight Coupling current state" +typedef ^ ^ TC_State StatePred - - - "Tight Coupling predicted state" typedef ^ ^ R8Ki UCalc : - - "" - -typedef ^ ^ R8Ki T :: - - "Tangent matrix" - typedef ^ ^ R8Ki XB :: - - "" - typedef ^ ^ IntKi IPIV : - - "" - typedef ^ ^ IntKi IterTotal - 0 - "" - -typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - -typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - +typedef ^ ^ IntKi UJacIterRemain - 0 - "Number of convergence iterations until Jacobian update" - +typedef ^ ^ IntKi UJacStepsRemain - 0 - "Number of time steps until Jacobian update" - typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - typedef ^ Glue_LinMisc IntKi TimeIndex - - - "" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index a49bfd1760..4bfc02afcf 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -208,15 +208,14 @@ MODULE Glue_Types ! ========= Glue_TCMisc ======= TYPE, PUBLIC :: Glue_TCMisc TYPE(ModGlueType) :: Mod !< Glue module combining tight coupling modules [-] - TYPE(TC_State) :: State !< Tight Coupling state [-] - TYPE(TC_State) :: StatePrev !< Tight Coupling previous state for correction iterations [-] + TYPE(TC_State) :: StateCurr !< Tight Coupling current state [-] + TYPE(TC_State) :: StatePred !< Tight Coupling predicted state [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UCalc !< [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T !< Tangent matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] INTEGER(IntKi) :: IterTotal = 0 !< [-] - INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] - INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] + INTEGER(IntKi) :: UJacIterRemain = 0 !< Number of convergence iterations until Jacobian update [-] + INTEGER(IntKi) :: UJacStepsRemain = 0 !< Number of time steps until Jacobian update [-] LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] END TYPE Glue_TCMisc ! ======================= @@ -1833,10 +1832,10 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM call Glue_CopyModGlueType(SrcTCMiscData%Mod, DstTCMiscData%Mod, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call Glue_CopyTC_State(SrcTCMiscData%State, DstTCMiscData%State, CtrlCode, ErrStat2, ErrMsg2) + call Glue_CopyTC_State(SrcTCMiscData%StateCurr, DstTCMiscData%StateCurr, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call Glue_CopyTC_State(SrcTCMiscData%StatePrev, DstTCMiscData%StatePrev, CtrlCode, ErrStat2, ErrMsg2) + call Glue_CopyTC_State(SrcTCMiscData%StatePred, DstTCMiscData%StatePred, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcTCMiscData%UCalc)) then @@ -1851,18 +1850,6 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM end if DstTCMiscData%UCalc = SrcTCMiscData%UCalc end if - if (allocated(SrcTCMiscData%T)) then - LB(1:2) = lbound(SrcTCMiscData%T, kind=B8Ki) - UB(1:2) = ubound(SrcTCMiscData%T, kind=B8Ki) - if (.not. allocated(DstTCMiscData%T)) then - allocate(DstTCMiscData%T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%T.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTCMiscData%T = SrcTCMiscData%T - end if if (allocated(SrcTCMiscData%XB)) then LB(1:2) = lbound(SrcTCMiscData%XB, kind=B8Ki) UB(1:2) = ubound(SrcTCMiscData%XB, kind=B8Ki) @@ -1888,8 +1875,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%IPIV = SrcTCMiscData%IPIV end if DstTCMiscData%IterTotal = SrcTCMiscData%IterTotal - DstTCMiscData%IterUntilUJac = SrcTCMiscData%IterUntilUJac - DstTCMiscData%StepsUntilUJac = SrcTCMiscData%StepsUntilUJac + DstTCMiscData%UJacIterRemain = SrcTCMiscData%UJacIterRemain + DstTCMiscData%UJacStepsRemain = SrcTCMiscData%UJacStepsRemain DstTCMiscData%ConvWarn = SrcTCMiscData%ConvWarn end subroutine @@ -1904,16 +1891,13 @@ subroutine Glue_DestroyTCMisc(TCMiscData, ErrStat, ErrMsg) ErrMsg = '' call Glue_DestroyModGlueType(TCMiscData%Mod, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Glue_DestroyTC_State(TCMiscData%State, ErrStat2, ErrMsg2) + call Glue_DestroyTC_State(TCMiscData%StateCurr, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Glue_DestroyTC_State(TCMiscData%StatePrev, ErrStat2, ErrMsg2) + call Glue_DestroyTC_State(TCMiscData%StatePred, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(TCMiscData%UCalc)) then deallocate(TCMiscData%UCalc) end if - if (allocated(TCMiscData%T)) then - deallocate(TCMiscData%T) - end if if (allocated(TCMiscData%XB)) then deallocate(TCMiscData%XB) end if @@ -1928,15 +1912,14 @@ subroutine Glue_PackTCMisc(RF, Indata) character(*), parameter :: RoutineName = 'Glue_PackTCMisc' if (RF%ErrStat >= AbortErrLev) return call Glue_PackModGlueType(RF, InData%Mod) - call Glue_PackTC_State(RF, InData%State) - call Glue_PackTC_State(RF, InData%StatePrev) + call Glue_PackTC_State(RF, InData%StateCurr) + call Glue_PackTC_State(RF, InData%StatePred) call RegPackAlloc(RF, InData%UCalc) - call RegPackAlloc(RF, InData%T) call RegPackAlloc(RF, InData%XB) call RegPackAlloc(RF, InData%IPIV) call RegPack(RF, InData%IterTotal) - call RegPack(RF, InData%IterUntilUJac) - call RegPack(RF, InData%StepsUntilUJac) + call RegPack(RF, InData%UJacIterRemain) + call RegPack(RF, InData%UJacStepsRemain) call RegPack(RF, InData%ConvWarn) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1950,15 +1933,14 @@ subroutine Glue_UnPackTCMisc(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call Glue_UnpackModGlueType(RF, OutData%Mod) ! Mod - call Glue_UnpackTC_State(RF, OutData%State) ! State - call Glue_UnpackTC_State(RF, OutData%StatePrev) ! StatePrev + call Glue_UnpackTC_State(RF, OutData%StateCurr) ! StateCurr + call Glue_UnpackTC_State(RF, OutData%StatePred) ! StatePred call RegUnpackAlloc(RF, OutData%UCalc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%T); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%XB); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IPIV); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%IterTotal); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IterUntilUJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%StepsUntilUJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UJacIterRemain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UJacStepsRemain); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return end subroutine From b34e327071533c0192e6e0fc545519acf8e0aad5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 22 Aug 2024 21:22:19 +0000 Subject: [PATCH 188/319] Fix simulink CMakeLists.txt --- glue-codes/simulink/CMakeLists.txt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index 5f387d02b2..192bfb7be0 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -55,10 +55,11 @@ matlab_add_mex( src/FAST_SFunc.c ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Subs.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mods.f90 - ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Solver.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_SolverTC.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Library.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Funcs.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModGlue.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_AeroMap.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mapping.f90 LINK_TO ${MEX_LIBS} From 0f5a5a9ac006fa2581f05963a984c26b4b124eb8 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 23 Aug 2024 13:21:21 +0000 Subject: [PATCH 189/319] Point to r-test-5 in submodule --- .gitmodules | 2 +- reg_tests/executeOpenfastCppRegressionCase.py | 2 +- reg_tests/r-test | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index e051a463bd..487be29ab5 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,3 @@ [submodule "reg_tests/r-test"] path = reg_tests/r-test - url = https://github.com/OpenFAST/r-test.git \ No newline at end of file + url = https://github.com/OpenFAST/r-test-5.git diff --git a/reg_tests/executeOpenfastCppRegressionCase.py b/reg_tests/executeOpenfastCppRegressionCase.py index 7aaae53217..2f52094f6b 100644 --- a/reg_tests/executeOpenfastCppRegressionCase.py +++ b/reg_tests/executeOpenfastCppRegressionCase.py @@ -124,7 +124,7 @@ ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, "5MW_Land_DLL_WTurb_cpp.outb") -baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb.gold") +baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/r-test b/reg_tests/r-test index 0bfa9e42ea..9f2b138114 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 0bfa9e42ea56a2a54e4c624ac436a3c1e561e3fc +Subproject commit 9f2b1381141445ecd681c6019e86bc256f47cf02 From f9f31c2566ea72ae2ae12db6d37df0809fb357a2 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 23 Aug 2024 16:38:31 +0000 Subject: [PATCH 190/319] Update r-test pointer --- reg_tests/executeAerodynRegressionCase.py | 9 ++++----- reg_tests/r-test | 2 +- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/reg_tests/executeAerodynRegressionCase.py b/reg_tests/executeAerodynRegressionCase.py index 3c6cbeac8f..62a2c1010e 100644 --- a/reg_tests/executeAerodynRegressionCase.py +++ b/reg_tests/executeAerodynRegressionCase.py @@ -101,8 +101,7 @@ time.sleep(1) # create the local output directory and initialize it with input files -rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'ad_driver.outb':'ad_driver_ref.outb'}) - # , excludeExt=['.out','.outb']) +rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'ad_driver.out':'ad_driver_ref.out'}) ### Run aerodyn on the test case if not noExec: @@ -113,9 +112,9 @@ ### Build the filesystem navigation variables for running the regression test # For multiple turbines, test turbine 2, for combined cases, test case 4 -localOutFile = os.path.join(testBuildDirectory, "ad_driver.outb") -localOutFileWT2 = os.path.join(testBuildDirectory, "ad_driver.T2.outb") -localOutFileCase4 = os.path.join(testBuildDirectory, "ad_driver.4.outb") +localOutFile = os.path.join(testBuildDirectory, "ad_driver.out") +localOutFileWT2 = os.path.join(testBuildDirectory, "ad_driver.T2.out") +localOutFileCase4 = os.path.join(testBuildDirectory, "ad_driver.4.out") if os.path.exists(localOutFileWT2) : localOutFile = localOutFileWT2 elif os.path.exists(localOutFileCase4) : diff --git a/reg_tests/r-test b/reg_tests/r-test index 9f2b138114..72457d5de8 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 9f2b1381141445ecd681c6019e86bc256f47cf02 +Subproject commit 72457d5de81163a43dd1680c9fc3aa585b256798 From 9fc8246c5cc0cfcff484846d0e3ad7f6901ca3cd Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 26 Aug 2024 14:19:26 +0000 Subject: [PATCH 191/319] Allow reg_tests to use .out or .outb files --- reg_tests/executeOpenfastCppRegressionCase.py | 6 ++++-- reg_tests/executeOpenfastRegressionCase.py | 6 ++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/reg_tests/executeOpenfastCppRegressionCase.py b/reg_tests/executeOpenfastCppRegressionCase.py index 2f52094f6b..b3a4d2cc39 100644 --- a/reg_tests/executeOpenfastCppRegressionCase.py +++ b/reg_tests/executeOpenfastCppRegressionCase.py @@ -123,8 +123,10 @@ sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, "5MW_Land_DLL_WTurb_cpp.outb") -baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb") +localOutFile = os.path.join(testBuildDirectory, "5MW_Land_DLL_WTurb_cpp.out") +baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.out") +if not os.path.exists(baselineOutFile): + baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index ae863d3a46..8af6bf205c 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -143,8 +143,10 @@ sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") +localOutFile = os.path.join(testBuildDirectory, caseName + ".out") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") +if not os.path.exists(baselineOutFile): + baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) From f8a952ff283afbb0fa16a517baf9b61edd158c95 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 26 Aug 2024 14:19:44 +0000 Subject: [PATCH 192/319] Fix step0 system initialization in FAST_SolverTC --- modules/openfast-library/src/FAST_SolverTC.f90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 0f6f09d51b..9bbd9c5c4d 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -838,7 +838,8 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg !---------------------------------------------------------------------- ! Calculate difference between calculated and predicted accelerations - if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%StatePred%vd + ! if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%StatePred%vd + if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = 0.0_R8Ki ! Calculate difference in U for all Option 1 modules (un - u_tmp) ! and add to RHS for TC and Option 1 modules @@ -864,7 +865,7 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg ! If at least one convergence iteration has been done and the RHS norm ! is less than convergence tolerance, set flag and exit convergence loop - if ((ConvIter > 0) .and. (ConvError < p%ConvTol)) then + if (ConvError < p%ConvTol) then IsConverged = .true. exit end if @@ -877,8 +878,8 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg !---------------------------------------------------------------------- ! Update State acceleration prediction (do not change other states) - if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%StatePred) - ! if (p%iJX(1) > 0) m%StatePred%vd = m%StatePred%vd + m%XB(p%iJX(1):p%iJX(2), 1) + ! if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%StatePred) + if (p%iJX(1) > 0) m%StatePred%vd = m%StatePred%vd + m%XB(p%iJX(1):p%iJX(2), 1) ! Add change in inputs if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) @@ -930,7 +931,7 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg !---------------------------------------------------------------------------- ! Set algorithmic acceleration from actual acceleration - m%StatePred%a = (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM)*m%StatePred%vd + m%StatePred%a = m%StatePred%vd !---------------------------------------------------------------------------- ! Post-convergence initialization From d1d3f61d94958e9e050ce4fc1dda35d238f9456d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 26 Aug 2024 14:39:23 +0000 Subject: [PATCH 193/319] Disable use of small rotation angles in ModVar --- modules/nwtc-library/src/ModVar.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 8d172601a1..745de1227a 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -49,7 +49,7 @@ module ModVar integer(IntKi), parameter :: MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, & FieldAngularVel, FieldTransAcc, FieldAngularAcc] -logical, parameter :: UseSmallRotAngles = .true. +logical, parameter :: UseSmallRotAngles = .false. contains From 33ca6dcb42eade4b1dcfef6d1a7408d01d2c4f1b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 26 Aug 2024 22:30:53 +0000 Subject: [PATCH 194/319] Align SolverTC with FAST_Subs --- modules/openfast-library/CMakeLists.txt | 2 +- modules/openfast-library/src/FAST_Funcs.f90 | 45 +- modules/openfast-library/src/FAST_Mapping.f90 | 9 + modules/openfast-library/src/FAST_ModGlue.f90 | 4 +- .../openfast-library/src/FAST_SolverTC.f90 | 543 ++- modules/openfast-library/src/FAST_Subs.f90 | 3258 +++-------------- .../openfast-library/src/Glue_Registry.txt | 3 + modules/openfast-library/src/Glue_Types.f90 | 54 + 8 files changed, 997 insertions(+), 2921 deletions(-) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 9a3794f2b4..00db259108 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -69,7 +69,7 @@ add_library(openfast_postlib STATIC # src/FAST_Lin.f90 src/FAST_Mods.f90 src/FAST_Subs.f90 - src/FAST_Solver.f90 + # src/FAST_Solver.f90 # src/FAST_SS_Subs.f90 # src/FAST_SS_Solver.f90 diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 4ca5dcef7f..1febec054b 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -27,23 +27,23 @@ module FAST_Funcs use AeroDyn use BeamDyn use ElastoDyn +USE ExternalInflow +USE ExtLoads use ExtPtfm_MCKF use FEAMooring use HydroDyn +use IceDyn +use IceFloe use InflowWind use MAP use MoorDyn +use OrcaFlexInterface use SeaState use ServoDyn use SubDyn -use IceDyn -use IceFloe -use OrcaFlexInterface implicit none -#define SOLVER_DEBUG - contains subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) @@ -177,7 +177,7 @@ logical function Failed() end function end subroutine -subroutine FAST_InitIO(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) +subroutine FAST_InitInputStateArrays(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModAry(:) !< Module data real(DbKi), intent(in) :: ThisTime !< Initial simulation time (almost always 0) real(DbKi), intent(in) :: DT !< Glue code time step size @@ -241,8 +241,10 @@ subroutine FAST_InitIO(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) T%MAP%InputTimes = InputTimes case (Module_MD) T%MD%InputTimes = InputTimes -! case (Module_ExtInfw) -! T%ExtInfw%InputTimes = InputTimes + case (Module_ExtInfw) + ! T%ExtInfw%InputTimes = InputTimes + case (Module_ExtLd) + ! T%ExtLd%InputTimes = InputTimes case (Module_Orca) T%Orca%InputTimes = InputTimes case (Module_SD) @@ -389,9 +391,9 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial call MAP_UpdateStates(t_module, n_t_module, T%MAP%Input(1:), T%MAP%InputTimes, T%MAP%p, & - T%MAP%x(STATE_PRED), T%MAP%xd(STATE_PRED), & - T%MAP%z(STATE_PRED), T%MAP%OtherSt, & - ErrStat2, ErrMsg2) + T%MAP%x(STATE_PRED), T%MAP%xd(STATE_PRED), & + T%MAP%z(STATE_PRED), T%MAP%OtherSt, & + ErrStat2, ErrMsg2) if (Failed()) return end do @@ -1325,16 +1327,6 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, iInput, iState, T, ErrStat end subroutine -subroutine FAST_SaveStates(ModData, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData !< Module data - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - - ! Copy state from predicted to current with MESH_UPDATECOPY - call FAST_CopyStates(ModData, T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) -end subroutine - subroutine FAST_CopyStates(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) type(ModDataType), intent(in) :: ModData !< Module data type(FAST_TurbineType), intent(inout) :: T !< Turbine type @@ -1478,7 +1470,7 @@ subroutine FAST_CopyStates(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) call SrvD_CopyOtherState(T%SrvD%OtherSt(iSrc), T%SrvD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(ModData%Abbr), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module "//trim(ModData%Abbr), ErrStat, ErrMsg, RoutineName) return end select @@ -1497,7 +1489,7 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_CopyInputs' + character(*), parameter :: RoutineName = 'FAST_CopyInput' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1572,6 +1564,11 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) end select end select + case (Module_ExtLd) + ! ExtLd only has u + Errstat2 = ErrID_None + ErrMsg2 = '' + case (Module_ExtPtfm) select case (iSrc) @@ -1804,7 +1801,7 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) case default ErrStat2 = ErrID_Fatal - ErrMsg2 = "Unknown module ID "//trim(Num2LStr(ModData%ID)) + ErrMsg2 = "Unknown module "//trim(ModData%Abbr) end select ! Set error diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 69d5c05189..3d089ceebf 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -74,6 +74,9 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, iInput, ErrSta case (Module_ExtInfw) ! ExtInfw doesn't have the typical input structure, using u Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) + case (Module_ExtLd) + ! ExtLd doesn't have the typical input structure, using u + Mesh => ExtLd_InputMeshPointer(Turbine%ExtLd%u, MeshLoc) case (Module_ExtPtfm) Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input(iInput), MeshLoc) case (Module_FEAM) @@ -137,6 +140,8 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM Mesh => ED_OutputMeshPointer(Turbine%ED%y, MeshLoc) case (Module_ExtInfw) Mesh => ExtInfw_OutputMeshPointer(Turbine%ExtInfw%y, MeshLoc) + case (Module_ExtLd) + Mesh => ExtLd_OutputMeshPointer(Turbine%ExtLd%y, MeshLoc) case (Module_ExtPtfm) Mesh => ExtPtfm_OutputMeshPointer(Turbine%ExtPtfm%y, MeshLoc) case (Module_FEAM) @@ -207,6 +212,8 @@ function FAST_InputFieldName(ModData, DL) result(Name) end select case (Module_ExtInfw) Name = trim(ModData%Abbr)//"%"//ExtInfw_InputFieldName(DL) + case (Module_ExtLd) + Name = trim(ModData%Abbr)//"%"//ExtLd_InputFieldName(DL) case (Module_ExtPtfm) Name = trim(ModData%Abbr)//"%"//ExtPtfm_InputFieldName(DL) case (Module_FEAM) @@ -275,6 +282,8 @@ function FAST_OutputFieldName(ModData, DL) result(Name) Name = trim(ModData%Abbr)//"%"//ED_OutputFieldName(DL) case (Module_ExtInfw) Name = trim(ModData%Abbr)//"%"//ExtInfw_OutputFieldName(DL) + case (Module_ExtLd) + Name = trim(ModData%Abbr)//"%"//ExtLd_OutputFieldName(DL) case (Module_ExtPtfm) Name = trim(ModData%Abbr)//"%"//ExtPtfm_OutputFieldName(DL) case (Module_FEAM) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index b86448231d..3d4c704297 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -1075,7 +1075,7 @@ subroutine ModGlue_RestoreOperatingPoint(p, m, OPIndex, Turbine, ErrStat, ErrMsg StateIndex = NumStateTimes + OPIndex ! Index into input save array where linearization data will be stored for OP - InputIndex = Turbine%p_FAST%InterpOrder + 1 + OPIndex + InputIndex = -(Turbine%p_FAST%InterpOrder + 1 + OPIndex) ! Loop through modules by index do i = 1, size(p%Lin%iMod) @@ -1086,7 +1086,7 @@ subroutine ModGlue_RestoreOperatingPoint(p, m, OPIndex, Turbine, ErrStat, ErrMsg if (Failed()) return ! Copy current module input to linearization save location - call FAST_CopyInput(ModData, Turbine, -InputIndex, INPUT_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call FAST_CopyInput(ModData, Turbine, InputIndex, INPUT_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return end associate diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 9bbd9c5c4d..80fb000510 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -1,7 +1,6 @@ module FAST_SolverTC use NWTC_LAPACK -use FAST_Solver use FAST_ModTypes use FAST_Mapping use FAST_ModGlue @@ -18,7 +17,7 @@ module FAST_SolverTC private ! Public functions -public Solver_Init, Solver_Step0, Solver_Step +public SolverTC_Init, Solver_Step0, Solver_Step, CalcOutputs_And_SolveForInputs ! Debugging logical, parameter :: DebugSolver = .false. @@ -29,7 +28,7 @@ module FAST_SolverTC contains -subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) +subroutine SolverTC_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) type(FAST_ParameterType), intent(in) :: p_FAST !< FAST parameters type(Glue_TCParam), intent(inout) :: p !< Glue Parameters type(Glue_TCMisc), intent(out) :: m !< Glue miscellaneous variables @@ -116,6 +115,14 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, pack(modInds, ModIDs == Module_Orca), & pack(modInds, ModIDs == Module_SrvD)] ! ServoDyn is last + ! Indices of modules needed for ServoDyn initialization + p%iModUY1 = [pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_ExtInfw), & + pack(modInds, ModIDs == Module_ExtLd)] + ! Indices of tight coupling modules p%iModTC = [pack(modInds, ModIDs == Module_ED), & pack(modInds, ModIDs == Module_BD), & @@ -138,8 +145,7 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, pack(modInds, ModIDs == Module_FEAM), & pack(modInds, ModIDs == Module_IceD), & pack(modInds, ModIDs == Module_IceF), & - pack(modInds, ModIDs == Module_MAP), & - pack(modInds, ModIDs == Module_MD)] + pack(modInds, ModIDs == Module_MAP)] ! Indices of modules to perform InputSolves after the Option 1 solve p%iModPost = [pack(modInds, ModIDs == Module_SrvD), & @@ -168,9 +174,12 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, if (Failed()) return !---------------------------------------------------------------------------- - ! Allocate state, input, and output storage + ! Initialize MiscVars !---------------------------------------------------------------------------- + ! Set flag to warn about convergence errors + m%ConvWarn = .true. + ! Calculated inputs array call AllocAry(m%uCalc, m%Mod%Vars%Nu, "m%uCalc", ErrStat2, ErrMsg2); if (Failed()) return @@ -188,10 +197,6 @@ subroutine Solver_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, m%StateCurr%vd = 0.0_R8Ki m%StateCurr%a = 0.0_R8Ki - !---------------------------------------------------------------------------- - ! Allocate solver Jacobian matrix and right hand side - !---------------------------------------------------------------------------- - ! Allocate Jacobian matrix, RHS/X matrix, Pivot array call AllocAry(m%Mod%Lin%J, p%NumJ, p%NumJ, "m%J", ErrStat, ErrMsg); if (Failed()) return call AllocAry(m%XB, p%NumJ, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return @@ -674,13 +679,9 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg t_initial = Turbine%m_FAST%t_global t_global_next = t_initial + n_t_global_next*p%h - Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, Turbine%p_FAST%TStart, Turbine%p_FAST%n_DT_Out) - - ! Set flag to warn about convergence errors - m%ConvWarn = .true. !---------------------------------------------------------------------------- - ! Calculate initial accelerations + ! Collect initial states from modules !---------------------------------------------------------------------------- ! Transfer initial state from modules to solver @@ -710,29 +711,52 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg ! Reset mapping ready for transfer flag GlueModMaps%Ready = .false. - !---------------------------------------------------------------------------- - ! Perform iterations to initialize inputs and acceleration - ! States are not modified - !---------------------------------------------------------------------------- - ! Initialize temporary input structure for TC and Option1 modules do i = 1, size(m%Mod%ModData) call FAST_CopyInput(m%Mod%ModData(i), Turbine, INPUT_CURR, INPUT_TEMP, MESH_NEWCOPY, ErrStat2, ErrMsg2) if (Failed()) return end do - TotalIter = 0 + !---------------------------------------------------------------------------- + ! Perform iterations to initialize inputs and acceleration + ! States are not modified + !---------------------------------------------------------------------------- ! Copy TC solver states from current to predicted call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_NEWCOPY, ErrStat2, ErrMsg2) if (Failed()) return + TotalIter = 0 + ! Do two input correction iterations - do CorrIter = 1, 3 + do CorrIter = 1, 2 ! Set converged flag to false IsConverged = .false. + ! Copy TC solver states from current to predicted + call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Loop through tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) + + ! Transfer current states to linearization array + call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) + + ! Transfer solver states to module + call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) + if (Failed()) return + + ! Transfer accelerations to BeamDyn + if (ModData%ID == Module_BD) then + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + end if + end associate + end do + !------------------------------------------------------------------------- ! InputSolve and CalcOutput for all modules, pack TC and Option 1 inputs !------------------------------------------------------------------------- @@ -800,20 +824,13 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg ! Update Jacobian !---------------------------------------------------------------------- - call BuildJacobian(p, m, GlueModMaps, t_initial, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + call BuildJacobianTC(p, m, GlueModMaps, t_initial, STATE_CURR, Turbine, ErrStat2, ErrMsg2) if (Failed()) return !---------------------------------------------------------------------- ! Formulate right hand side (X_2^tight, U^tight, U^Option1) !---------------------------------------------------------------------- - ! Calculate continuous state derivatives for tight coupling modules - do i = 1, size(m%Mod%ModData) - call FAST_GetOP(m%Mod%ModData(i), t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - dx_op=m%Mod%ModData(i)%Lin%dx, dx_glue=m%Mod%Lin%dx) - if (Failed()) return - end do - ! Input solve for tight coupling modules do i = 1, size(p%iModTC) call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) @@ -913,7 +930,7 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg end do ! Calculate output for ServoDyn - if (CorrIter == 2) then + if (CorrIter == 1) then call FAST_CalcOutput(GlueModData(p%iModOpt2(1)), GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end if @@ -933,22 +950,6 @@ subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg ! Set algorithmic acceleration from actual acceleration m%StatePred%a = m%StatePred%vd - !---------------------------------------------------------------------------- - ! Post-convergence initialization - !---------------------------------------------------------------------------- - - ! Copy current state to previous state - call Glue_CopyTC_State(m%StatePred, m%StateCurr, MESH_NEWCOPY, ErrStat2, ErrMsg2) - if (Failed()) return - - ! Initialize IO and states for all modules (also copies STATE_CURR to STATE_PRED) - call FAST_InitIO(GlueModData, t_initial, p%h, Turbine, ErrStat, ErrMsg) - if (ErrStat >= AbortErrLev) return - - ! Reset the Remap flags for all modules - call FAST_ResetRemapFlags(GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) - if (ErrStat >= AbortErrLev) return - !---------------------------------------------------------------------------- ! Set Outputs !---------------------------------------------------------------------------- @@ -1000,9 +1001,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu n_t_global_next = n_t_global + 1 t_global_next = t_initial + n_t_global_next*p%h - ! Determine if output should be written in this step - Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, Turbine%p_FAST%TStart, Turbine%p_FAST%n_DT_Out) - ! Decrement number of time steps before updating the Jacobian m%UJacStepsRemain = m%UJacStepsRemain - 1 @@ -1014,75 +1012,65 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu TotalIter = 0 !---------------------------------------------------------------------------- - ! Extrapolate/interpolate inputs for all modules - !---------------------------------------------------------------------------- - - ! Loop through all modules and extrapolate inputs - do i = 1, size(GlueModData) - associate (ModData => GlueModData(i)) - call FAST_ExtrapInterp(ModData, t_global_next, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return - end associate - end do - - !---------------------------------------------------------------------------- - ! Reset BD States + ! Correction Iterations !---------------------------------------------------------------------------- - ! Perform additional state manipulation on a per-module basis - do i = 1, size(p%iModTC) - associate (ModData => m%Mod%ModData(i)) - select case (ModData%ID) - case (Module_ED) + ! Loop through correction iterations + CorrIter = 0 + NumCorrections = p%NumCrctn + do while (CorrIter <= NumCorrections) - ! Update the azimuth angle - call ED_UpdateAzimuth(Turbine%ED%p, Turbine%ED%x(STATE_CURR), ModData%DT) + ! Reset mapping ready flags + GlueModMaps%Ready = .false. - case (Module_BD) + ! Copy TC solver states from current to predicted + call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return - ! Transfer acceleration from TC state to BeamDyn - call SetBDAccel(ModData, m%StateCurr, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + ! Perform additional state manipulation on a per-module basis + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) - ! Reset BeamDyn states so they are relative to the root node - call BD_UpdateGlobalRef(Turbine%BD%Input(INPUT_CURR, ModData%Ins), & - Turbine%BD%p(ModData%Ins), & - Turbine%BD%x(ModData%Ins, STATE_CURR), & - Turbine%BD%OtherSt(ModData%Ins, STATE_CURR), & - ErrStat2, ErrMsg2) + ! Copy state from current to predicted + call FAST_CopyStates(ModData, Turbine, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return - ! Transfer acceleration from BeamDyn to state - call GetBDAccel(ModData, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR), m%StateCurr) + ! Additional state manipulation per module + select case (ModData%ID) + case (Module_ED) - case default - cycle - end select + ! Update the azimuth angle + call ED_UpdateAzimuth(Turbine%ED%p, Turbine%ED%x(STATE_PRED), ModData%DT) - ! Collect updated states - call FAST_GetOP(ModData, t_global_next, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) - if (Failed()) return + case (Module_BD) - ! Transfer current states to linearization array - call TransferXtoQ(ModData, m%Mod%Lin%x, m%StateCurr) - end associate - end do + ! Transfer acceleration from TC state to BeamDyn + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_PRED)) - !---------------------------------------------------------------------------- - ! Correction Iterations - !---------------------------------------------------------------------------- + ! Reset BeamDyn states so they are relative to the root node + call BD_UpdateGlobalRef(Turbine%BD%Input(INPUT_CURR, ModData%Ins), & + Turbine%BD%p(ModData%Ins), & + Turbine%BD%x(ModData%Ins, STATE_PRED), & + Turbine%BD%OtherSt(ModData%Ins, STATE_PRED), & + ErrStat2, ErrMsg2) + if (Failed()) return - ! Loop through correction iterations - CorrIter = 0 - NumCorrections = p%NumCrctn - do while (CorrIter <= NumCorrections) + ! Transfer acceleration from BeamDyn to state + call GetBDAccel(ModData, Turbine%BD%OtherSt(ModData%Ins, STATE_PRED), m%StatePred) - ! Reset mapping ready flags - GlueModMaps%Ready = .false. + case default + cycle + end select - ! Copy TC solver states from current to predicted - call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - if (Failed()) return + ! Collect updated states + call FAST_GetOP(ModData, t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) + if (Failed()) return + + ! Transfer current states to linearization array + call TransferXtoQ(ModData, m%Mod%Lin%x, m%StatePred) + end associate + end do ! Update state prediction call PredictNextState(p, m%StatePred, m%Mod%Vars) @@ -1094,10 +1082,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! Transfer current states to linearization array call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) - ! Copy state from current to predicted - call FAST_CopyStates(ModData, Turbine, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - if (Failed()) return - ! Transfer solver states to module call FAST_SetOP(ModData, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) @@ -1226,7 +1210,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu ! Note: BuildJacobian resets these counters. if ((m%UJacIterRemain <= 0) .or. (m%UJacStepsRemain <= 0)) then NumUJac = NumUJac + 1 - call BuildJacobian(p, m, GlueModMaps, t_global_next, STATE_PRED, Turbine, ErrStat2, ErrMsg2) + call BuildJacobianTC(p, m, GlueModMaps, t_global_next, STATE_PRED, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end if @@ -1356,35 +1340,232 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Tu end do !---------------------------------------------------------------------------- - ! Update states for next step + ! Set Outputs !---------------------------------------------------------------------------- - ! Update algorithmic acceleration - m%StatePred%a = m%StatePred%a + (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM)*m%StatePred%vd + Turbine%y_FAST%DriverWriteOutput(1) = real(TotalIter, ReKi) ! ConvIter + Turbine%y_FAST%DriverWriteOutput(2) = real(ConvError, ReKi) ! ConvError + Turbine%y_FAST%DriverWriteOutput(3) = real(NumUJac, ReKi) ! NumUJac - ! Copy predicted state to current state - call Glue_CopyTC_State(m%StatePred, m%StateCurr, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - if (Failed()) return +contains + logical function Failed() + if (ErrStat2 /= ErrID_None) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine CalcOutputs_And_SolveForInputs(p, m, GlueModData, GlueModMaps, ThisTime, iInput, iState, Turbine, ErrStat, ErrMsg, DoInit) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(ModDataType), intent(inout) :: GlueModData(:) !< Module data + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings at glue level + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional :: DoInit + + character(*), parameter :: RoutineName = 'CalcOutputs_And_SolveForInputs' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: ConvIter + real(R8Ki) :: ConvError + integer(IntKi) :: i + + !---------------------------------------------------------------------------- + ! Special Initialization + !---------------------------------------------------------------------------- + + if (present(DoInit)) then + if (DoInit) then + + ! Input solve and calc output for ServoDyn inputs + do i = 1, size(p%iModUY1) + associate (ModData => GlueModData(p%iModUY1(i))) + + ! Solve for inputs + call FAST_InputSolve(p%iModUY1(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate outputs + call FAST_CalcOutput(ModData, GlueModMaps, ThisTime, iInput, iState, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + end if + end if + + !---------------------------------------------------------------------------- + ! Option 2 Solve + !---------------------------------------------------------------------------- + + ! Do input solve and calculate outputs for Option 2 modules (except ServoDyn) + do i = 2, size(p%iModOpt2) + associate (ModData => GlueModData(p%iModOpt2(i))) + + ! Solve for inputs + call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate outputs + call FAST_CalcOutput(ModData, GlueModMaps, ThisTime, iInput, iState, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + + !---------------------------------------------------------------------------- + ! Option 1 Solve + !---------------------------------------------------------------------------- - ! Copy the final predicted states from step t_global_next to actual states for that step - do i = 1, size(GlueModData) - call FAST_SaveStates(GlueModData(i), Turbine, ErrStat2, ErrMsg2) + ! Get inputs for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end do !---------------------------------------------------------------------------- - ! Set Outputs + ! Pack inputs !---------------------------------------------------------------------------- - Turbine%y_FAST%DriverWriteOutput(1) = real(TotalIter, ReKi) ! ConvIter - Turbine%y_FAST%DriverWriteOutput(2) = real(ConvError, ReKi) ! ConvError - Turbine%y_FAST%DriverWriteOutput(3) = real(NumUJac, ReKi) ! NumUJac + ! Pack TC and Option 1 inputs into u array + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, ThisTime, iInput, iState, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate + end do !---------------------------------------------------------------------------- - ! Update the global time + ! Option 1 Convergence Iterations !---------------------------------------------------------------------------- - Turbine%m_FAST%t_global = t_global_next + ! Loop through convergence iterations + do ConvIter = 0, p%MaxConvIter + + ! Calculate outputs for TC & Option 1 modules + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_CalcOutput(ModData, GlueModMaps, ThisTime, iInput, iState, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + !------------------------------------------------------------------------- + ! Convergence iteration limit check + !------------------------------------------------------------------------- + + ! If convergence iteration has reached or exceeded limit, exit loop + if (ConvIter >= p%MaxConvIter) then + call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & + " iterations (error="//trim(Num2LStr(ConvError))// & + ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & + ErrStat, ErrMsg, RoutineName) + exit + end if + + !------------------------------------------------------------------------- + ! Update Jacobian + !------------------------------------------------------------------------- + + call BuildJacobianIO(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------- + ! Formulate right hand side (U) + !---------------------------------------------------------------------- + + ! Input solve for tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => GlueModData(p%iModTC(i))) + call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + ! Input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + associate (ModData => GlueModData(p%iModOpt1(i))) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + ! Transfer collect inputs into uCalc + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), ThisTime, INPUT_TEMP, iState, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%uCalc) + if (Failed()) return + end do + + !------------------------------------------------------------------------- + ! Populate residual vector and apply conditioning to loads + !------------------------------------------------------------------------- + + ! Calculate difference in U for all Option 1 modules (un - u_tmp) + ! and add to RHS for TC and Option 1 modules + if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB_IO(:, 1)) + + ! Apply conditioning factor to loads in RHS + if (p%iUL(1) > 0) m%XB_IO(p%iUL(1):p%iUL(2), 1) = m%XB_IO(p%iUL(1):p%iUL(2), 1)/p%Scale_UJac + + !------------------------------------------------------------------------- + ! Solve for state and input perturbations + !------------------------------------------------------------------------- + + ! Solve Jacobian and RHS + call LAPACK_getrs('N', size(m%Jac_IO, 1), m%Jac_IO, m%IPIV, m%XB_IO, ErrStat2, ErrMsg2) + if (Failed()) return + + !------------------------------------------------------------------------- + ! Check perturbations for convergence and exit if below tolerance + !------------------------------------------------------------------------- + + ! Calculate average L2 norm of change in states and inputs + ConvError = TwoNorm(m%XB_IO(:, 1))/size(m%XB_IO) + + ! If at least one convergence iteration has been done and + ! the RHS norm is less than convergence tolerance, exit loop + if ((ConvIter > 0) .and. (ConvError < p%ConvTol)) exit + + ! Remove load condition conditioning on input changes + if (p%iUL(1) > 0) m%XB_IO(p%iUL(1):p%iUL(2), 1) = m%XB_IO(p%iUL(1):p%iUL(2), 1)*p%Scale_UJac + + !------------------------------------------------------------------------- + ! Update inputs for Tight Coupling and Option 1 modules + !------------------------------------------------------------------------- + + ! Add change in inputs + if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB_IO(:, 1), m%Mod%Lin%u) + + ! Transfer updated TC and Option 1 inputs to modules + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_SetOP(ModData, iInput, iState, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate + end do + end do + + !---------------------------------------------------------------------------- + ! Post Option 1 solve + !---------------------------------------------------------------------------- + + ! Perform input solve for modules post Option 1 convergence + do i = 1, size(p%iModPost) + call FAST_InputSolve(p%iModPost(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Reset mesh remap + call FAST_ResetRemapFlags(GlueModData, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return contains logical function Failed() @@ -1393,7 +1574,8 @@ logical function Failed() end function end subroutine -subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat, ErrMsg) +! Build Jacobian for tight coupling solve +subroutine BuildJacobianTC(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat, ErrMsg) type(Glue_TCParam), intent(in) :: p !< Parameters type(Glue_TCMisc), intent(inout) :: m !< Misc variables type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings at glue level @@ -1403,7 +1585,7 @@ subroutine BuildJacobian(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat, integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'BuildJacobian' + character(*), parameter :: RoutineName = 'BuildJacobianTC' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 real(R8Ki) :: phi, rv(3), T(3, 3), tmp1, tmp2, T2(3, 3) @@ -1552,11 +1734,86 @@ logical function Failed() end function end subroutine +! Build Jacobian for Input-Output solve (CalcOutputs_And_SolveForInputs) +subroutine BuildJacobianIO(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat, ErrMsg) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings at glue level + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BuildJacobian' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: phi, rv(3), T(3, 3), tmp1, tmp2, T2(3, 3) + integer(IntKi) :: i, j, k, idx + + ErrStat = ErrID_None + ErrMsg = '' + + if (.not. allocated(m%Jac_IO)) then + call AllocAry(m%Jac_IO, m%Mod%Vars%Nu, m%Mod%Vars%Nu, 'm%Jac_IO', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + if (.not. allocated(m%XB_IO)) then + call AllocAry(m%XB_IO, m%Mod%Vars%Nu, 1, 'm%XB_IO', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Loop through TC and Option 1 modules and calculate dYdu + if (allocated(m%Mod%Lin%dYdu)) m%Mod%Lin%dYdu = 0.0_R8Ki + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, iState, Turbine, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) + if (Failed()) return + end associate + end do + + ! Calculate dUdu and dUdy for TC and Option 1 modules + if (allocated(m%Mod%Lin%dUdy) .and. allocated(m%Mod%Lin%dUdu)) then + m%Mod%Lin%dUdy = 0.0_R8Ki + call Eye2D(m%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_LinearizeMappings(m%Mod, GlueModMaps, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! Assemble Jacobian + !---------------------------------------------------------------------------- + + ! Jac = m%Mod%Lin%dUdu + matmul(m%Mod%Lin%dUdy, m%Mod%Lin%dYdu) + if (m%Mod%Vars%Nu > 0) then + m%Jac_IO = m%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, m%Jac_IO, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Condition Jacobian matrix before factoring + if (p%iUL(1) > 0) then + m%Jac_IO(p%iUL(1):p%iUL(2), :) = m%Jac_IO(p%iUL(1):p%iUL(2), :)/p%Scale_UJac + m%Jac_IO(:, p%iUL(1):p%iUL(2)) = m%Jac_IO(:, p%iUL(1):p%iUL(2))*p%Scale_UJac + end if + + ! Factor Jacobian matrix + call LAPACK_getrf(size(m%Jac_IO, 1), size(m%Jac_IO, 2), m%Jac_IO, m%IPIV, ErrStat2, ErrMsg2) + if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + !------------------------------------------------------------------------------- ! Utility functions !------------------------------------------------------------------------------- -subroutine PredictNextState(p, State, Vars) +pure subroutine PredictNextState(p, State, Vars) type(Glue_TCParam), intent(in) :: p type(TC_State), intent(inout) :: State type(ModVarsType), intent(in) :: Vars @@ -1591,7 +1848,7 @@ subroutine PredictNextState(p, State, Vars) call CalculateStateQ(State, Vars, p%h) end subroutine -subroutine CalculateStateQ(State, Vars, h) +pure subroutine CalculateStateQ(State, Vars, h) type(TC_State), intent(inout) :: State type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: h @@ -1617,7 +1874,7 @@ subroutine CalculateStateQ(State, Vars, h) end do end subroutine -subroutine UpdateStatePrediction(p, Vars, delta_vd, State) +pure subroutine UpdateStatePrediction(p, Vars, delta_vd, State) type(Glue_TCParam), intent(in) :: p type(ModVarsType), intent(in) :: Vars real(R8Ki), intent(in) :: delta_vd(:) @@ -1632,12 +1889,15 @@ subroutine UpdateStatePrediction(p, Vars, delta_vd, State) ! Update acceleration State%vd = State%vd + delta_vd + ! Update algorithmic acceleration + State%a = State%a + (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM)*delta_vd + ! Update displacement calculation call CalculateStateQ(State, Vars, p%h) end subroutine -subroutine TransferXtoQ(ModData, x, State) +pure subroutine TransferXtoQ(ModData, x, State) type(ModDataType), intent(in) :: ModData real(R8Ki), intent(in) :: x(:) type(TC_State), intent(inout) :: State @@ -1654,7 +1914,7 @@ subroutine TransferXtoQ(ModData, x, State) end do end subroutine -subroutine TransferQtoX(ModData, State, x) +pure subroutine TransferQtoX(ModData, State, x) type(ModDataType), intent(in) :: ModData type(TC_State), intent(in) :: State real(R8Ki), intent(inout) :: x(:) @@ -1671,7 +1931,7 @@ subroutine TransferQtoX(ModData, State, x) end do end subroutine -subroutine SetBDAccel(ModData, State, BD_OtherSt) +pure subroutine SetBDAccel(ModData, State, BD_OtherSt) type(ModDataType), intent(in) :: ModData type(TC_State), intent(in) :: State type(BD_OtherStateType), intent(inout) :: BD_OtherSt @@ -1687,7 +1947,7 @@ subroutine SetBDAccel(ModData, State, BD_OtherSt) end do end subroutine -subroutine GetBDAccel(ModData, BD_OtherSt, State) +pure subroutine GetBDAccel(ModData, BD_OtherSt, State) type(ModDataType), intent(in) :: ModData type(BD_OtherStateType), intent(in) :: BD_OtherSt type(TC_State), intent(inout) :: State @@ -1703,21 +1963,6 @@ subroutine GetBDAccel(ModData, BD_OtherSt, State) end do end subroutine -pure function NeedWriteOutput(n_t_global, t_global, t_initial, n_DT_Out) result(WriteNeeded) - integer(IntKi), intent(in) :: n_t_global !< Current global time step - real(DbKi), intent(in) :: t_initial !< Initial time - real(DbKi), intent(in) :: t_global !< Current global time - integer(IntKi), intent(in) :: n_DT_Out !< Write output every n steps - logical :: WriteNeeded !< Function result; if true, WriteOutput values are needed on this time step - - ! note that if TStart isn't an multiple of DT_out, we will not necessarily start output to the file at TStart - if (t_global >= t_initial) then - WriteNeeded = MOD(n_t_global, n_DT_Out) == 0 - else - WriteNeeded = .false. - end if -end function - !------------------------------------------------------------------------------- ! Debugging routines !------------------------------------------------------------------------------- @@ -1725,7 +1970,7 @@ pure function NeedWriteOutput(n_t_global, t_global, t_initial, n_DT_Out) result( subroutine Solver_Init_Debug(p, m, GlueModData, GlueModMaps) type(Glue_TCParam), intent(in) :: p !< Parameters type(Glue_TCMisc), intent(in) :: m !< Misc variables - type(ModDataType), intent(in) :: GlueModData(:) !< Module data + type(ModDataType), intent(in) :: GlueModData(:) !< Module data type(MappingType), intent(in) :: GlueModMaps(:) !< Module mappings at glue level integer(IntKi) :: i, j diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index ae44259672..1cc20e079b 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -21,11 +21,15 @@ !********************************************************************************************************************************** MODULE FAST_Subs + USE FAST_Types + USE FAST_ModTypes USE FAST_ModGlue - USE FAST_Solver - ! USE FAST_Linear - USE SC_DataEx USE VersionInfo + USE FAST_Funcs + USE FAST_SolverTC + USE FAST_Mapping, only: FAST_InitMappings + USE SC_DataEx + USE ServoDyn IMPLICIT NONE @@ -35,9 +39,6 @@ MODULE FAST_Subs !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> a wrapper routine to call FAST_Initialize at the full-turbine simulation level (makes easier to write top-level driver) SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, InFile, ExternInitData ) - USE FAST_SolverTC, only: Solver_Init - USE FAST_Mapping, only: FAST_InitMappings, FAST_ResetRemapFlags - USE FAST_Funcs, only: FAST_InitIO REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: TurbID !< turbine Identifier (1-NumTurbines) TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine @@ -49,26 +50,10 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In LOGICAL, PARAMETER :: CompAeroMaps = .false. Turbine%TurbID = TurbID - - IF (PRESENT(InFile)) THEN - IF (PRESENT(ExternInitData)) THEN - CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) - ELSE - CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile ) - END IF - ELSE - CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) - END IF - + CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) if(ErrStat >= AbortErrLev) return ! Initialize mappings between modules @@ -76,7 +61,7 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In if(ErrStat >= AbortErrLev) return ! Initialize solver - call Solver_Init(Turbine%p_FAST, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + call SolverTC_Init(Turbine%p_FAST, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat, ErrMsg) if(ErrStat >= AbortErrLev) return @@ -1264,7 +1249,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD END IF - !---------------------------------------------------------------------------- ! Set up output for glue code ! (must be done after all modules are initialized so we have their WriteOutput information) @@ -1274,25 +1258,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD if (Failed()) return !---------------------------------------------------------------------------- - ! Initialize mesh-mapping data + ! Init low-pass-filtered displacements of HydroDyn potential-flow bodies !---------------------------------------------------------------------------- - CALL InitModuleMappings(p_FAST, ED, BD, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - ELSEIF (ErrStat /= ErrID_None) THEN - ! a little work-around in case the mesh mapping info messages get too long - CALL WrScr( NewLine//TRIM(ErrMsg)//NewLine ) - ErrStat = ErrID_None - ErrMsg = "" - END IF - - ! ---------------------------------------------------------------------------- - ! Initialize low-pass-filtered displacements of HydroDyn potential-flow bodies - ! ---------------------------------------------------------------------------- IF ( (p_FAST%CompHydro == Module_HD) .AND. (HD%p%PotMod == 1_IntKi) ) THEN IF ( HD%p%WAMIT(1)%ExctnDisp == 2_IntKi ) THEN ! Set the initial displacement of ED%PlatformPtMesh here to use MeshMapping @@ -1301,18 +1269,35 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD REAL(Init%OutData_ED%PlatformPos(4),R8Ki), & REAL(Init%OutData_ED%PlatformPos(5),R8Ki), & REAL(Init%OutData_ED%PlatformPos(6),R8Ki), & - ED%y%PlatformPtMesh%Orientation(:,:,1), '', ErrStat2, ErrMsg2 ) + ED%y%PlatformPtMesh%Orientation(:,:,1), '', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ED%y%PlatformPtMesh%TranslationDisp(1,1) = ED%y%PlatformPtMesh%TranslationDisp(1,1) + ED%y%PlatformPtMesh%Orientation(3,1,1) * ED%p%PtfmRefzt ED%y%PlatformPtMesh%TranslationDisp(2,1) = ED%y%PlatformPtMesh%TranslationDisp(2,1) + ED%y%PlatformPtMesh%Orientation(3,2,1) * ED%p%PtfmRefzt ED%y%PlatformPtMesh%TranslationDisp(3,1) = ED%y%PlatformPtMesh%TranslationDisp(3,1) + ED%y%PlatformPtMesh%Orientation(3,3,1) * ED%p%PtfmRefzt - ED%p%PtfmRefzt - CALL Transfer_PlatformMotion_to_HD( ED%y%PlatformPtMesh, HD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Transfer the ED outputs of the platform motions to the HD input of which represents the same data + call MeshMapCreate(ED%y%PlatformPtMesh, HD%Input(1)%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2); if (Failed()) return + CALL Transfer_Point_to_Point(ED%y%PlatformPtMesh, HD%Input(1)%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2); if (Failed()) return + + ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body + IF (HD%Input(1)%WAMITMesh%Committed ) THEN + CALL MeshMapCreate(ED%y%PlatformPtMesh, HD%Input(1)%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2); if (Failed()) return + CALL Transfer_Point_to_Point(ED%y%PlatformPtMesh, HD%Input(1)%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2); if (Failed()) return + END IF + + ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body + IF (HD%Input(1)%Morison%Mesh%Committed ) THEN + CALL MeshMapCreate(ED%y%PlatformPtMesh, HD%Input(1)%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2); if (Failed()) return + CALL Transfer_Point_to_Point(ED%y%PlatformPtMesh, HD%Input(1)%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2); if (Failed()) return + END IF + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - IF (HD%p%NBodyMod .EQ. 1_IntKi) THEN ! One instance of WAMIT with NBody + + IF (HD%p%NBodyMod == 1_IntKi) THEN ! One instance of WAMIT with NBody DO i = 1,HD%p%NBody HD%xd(STATE_CURR)%WAMIT(1)%BdyPosFilt(1,i,:) = HD%Input(1)%WAMITMesh%TranslationDisp(1,i) HD%xd(STATE_CURR)%WAMIT(1)%BdyPosFilt(2,i,:) = HD%Input(1)%WAMITMesh%TranslationDisp(2,i) @@ -1326,7 +1311,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD END IF END IF - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- ! Initialize data for VTK output !---------------------------------------------------------------------------- @@ -1516,7 +1501,6 @@ END SUBROUTINE FAST_InitializeAll SUBROUTINE FAST_ProgStart(ThisProgVer) TYPE(ProgDesc), INTENT(IN) :: ThisProgVer !< program name/date/version description - TYPE(ProgDesc) :: NewProgVer !< program name/date/version description NewProgVer = ThisProgVer @@ -1524,7 +1508,6 @@ SUBROUTINE FAST_ProgStart(ThisProgVer) NewProgVer%Name = ProgName end if - ! ... Initialize NWTC Library ! sets the pi constants, open console for output, etc... CALL NWTC_Init( ProgNameIN=NewProgVer%Name, EchoLibVer=.FALSE. ) @@ -4594,9 +4577,20 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CHARACTER(*), parameter :: RoutineName = 'FAST_Solution0_T' + + CHARACTER(*), parameter :: RoutineName = 'FAST_Solution0' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi), PARAMETER :: n_t_global = -1 ! loop counter + INTEGER(IntKi), PARAMETER :: n_t_global_next = 0 ! loop counter + REAL(DbKi) :: t_initial ! next simulation time (t_global_next) + + ErrStat = ErrID_None + ErrMsg = "" + + ! NOTE: m_FAST%t_global is t_initial in this routine (used as t_global_next) + t_initial = Turbine%m_FAST%t_global + Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, Turbine%p_FAST) if (Turbine%p_FAST%WrSttsTime) then call SimStatus_FirstTime(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & @@ -4604,2488 +4598,450 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) end if - ! Get initial conditions for solver - CALL Solver_Step0(Turbine%p_Glue%TC, Turbine%m_Glue%TC, Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) + !---------------------------------------------------------------------------- + ! Solve input-output relations; this section of code corresponds to Eq. (35) in Gasmi et al. (2013) + !---------------------------------------------------------------------------- + + ! Get initial ServoDyn and IfW/Lidar inputs from Simulink + IF (Turbine%p_FAST%CompServo == Module_SrvD) then + CALL SrvD_SetExternalInputs(Turbine%p_FAST, Turbine%m_FAST, Turbine%SrvD%Input(INPUT_CURR)) + end if + + ! Perform initial solve + CALL Solver_Step0(Turbine%p_Glue%TC, Turbine%m_Glue%TC, Turbine%m_Glue%ModData, & + Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - CALL WriteOutputToFile(0, Turbine%m_FAST%t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & - Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & - Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + if (Turbine%p_FAST%UseSC ) then + call SC_DX_SetInputs(Turbine%p_FAST, Turbine%SrvD%y, Turbine%SC_DX, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + !---------------------------------------------------------------------------- + ! Write output to file + !---------------------------------------------------------------------------- + + ! Write module output to file + CALL WriteOutputToFile(n_t_global_next, t_initial, Turbine%p_FAST, & + Turbine%y_FAST, Turbine%ED, Turbine%BD, & + Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, & + Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & + Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, & + ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& - ! Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + ! Write visualization data for initialization (and also note that we're ignoring any errors that occur doing so) + if (Turbine%p_FAST%WrVTK == VTK_InitOnly) then + call WriteVTK(t_initial, Turbine%p_FAST, Turbine%y_FAST, & + Turbine%MeshMapData, Turbine%ED, Turbine%BD, Turbine%AD, & + Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, & + Turbine%SD, Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & + Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD) + end if -END SUBROUTINE FAST_Solution0_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls CalcOutput for the first time of the simulation (at t=0). After the initial solve, data arrays are initialized. -SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + !---------------------------------------------------------------------------- + ! Populate inputs at for ExtrapInterp and copy current state to predicted state + !---------------------------------------------------------------------------- - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + ! Initialize input and state arrays for all modules + call FAST_InitInputStateArrays(Turbine%m_Glue%ModData, t_initial, & + Turbine%p_FAST%DT, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + ! Copy solver current state to previous state + call Glue_CopyTC_State(Turbine%m_Glue%TC%StatePred, Turbine%m_Glue%TC%StateCurr, & + MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules +END SUBROUTINE FAST_Solution0_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_InitIOarrays_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_InitIOarrays_SubStep_T(t_initial, Turbine, ErrStat, ErrMsg ) + REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi), PARAMETER :: n_t_global = -1 ! loop counter - INTEGER(IntKi), PARAMETER :: n_t_global_next = 0 ! loop counter - REAL(DbKi) :: t_initial ! next simulation time (t_global_next) - INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution0' - - - !NOTE: m_FAST%t_global is t_initial in this routine + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep_T' + INTEGER(IntKi) :: i, j ErrStat = ErrID_None ErrMsg = "" - t_initial = m_FAST%t_global ! which is used in place of t_global_next - y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, p_FAST) + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) - IF (p_FAST%WrSttsTime) then - CALL SimStatus_FirstTime( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%SimStrtTime, m_FAST%UsrTime2, t_initial, p_FAST%TMax, p_FAST%TDesc ) - END IF + ! Copy from current input to input save locations + do j = 1, Turbine%p_FAST%InterpOrder + 1 + call FAST_CopyInput(Turbine%m_Glue%ModData(i), Turbine, INPUT_CURR, -j, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + end do + ! Copy from current state to saved current state + call FAST_CopyStates(Turbine%m_Glue%ModData(i), Turbine, STATE_CURR, STATE_SAVED_CURR, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return - ! Solve input-output relations; this section of code corresponds to Eq. (35) in Gasmi et al. (2013) - ! This code will be specific to the underlying modules + ! Copy from predicted state to saved predicted state + call FAST_CopyStates(Turbine%m_Glue%ModData(i), Turbine, STATE_PRED, STATE_SAVED_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return - ! the initial ServoDyn and IfW/Lidar inputs from Simulink: - IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) + end do - if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then - ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file - call SeaSt_CalcOutput( t_initial, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if +END SUBROUTINE FAST_InitIOarrays_SubStep_T - CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Reset_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Reset_SubStep_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, ErrMsg ) - if (p_FAST%UseSC ) then - call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL - !---------------------------------------------------------------------------------------- - ! Check to see if we should output data this time step: - !---------------------------------------------------------------------------------------- + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Reset_SubStep_T' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore + REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset + REAL(DbKi), allocatable :: InputTimes(:) + INTEGER(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = "" - ! turn off VTK output when - if (p_FAST%WrVTK == VTK_InitOnly) then - ! Write visualization data for initialization (and also note that we're ignoring any errors that occur doing so) + ! Calculate input times + t_global = t_initial + n_t_global * Turbine%p_FAST%DT + InputTimes = [(t_global - (j - 1) * Turbine%p_FAST%DT, j = 1, Turbine%p_FAST%InterpOrder + 1)] - call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ! Update the global time + Turbine%m_FAST%t_global = t_global - end if + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) + associate (ModData => Turbine%m_Glue%ModData(i)) + ! Copy from current input to input save locations + do j = 1, Turbine%p_FAST%InterpOrder + 1 + call FAST_CopyInput(ModData, Turbine, -j, j, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + end do - !............... - ! Copy values of these initial guesses for interpolation/extrapolation and - ! initialize predicted states for j_pc loop (use MESH_NEWCOPY here so we can use MESH_UPDATE copy later) - !............... + ! Copy from current state to saved current state + call FAST_CopyStates(ModData, Turbine, STATE_SAVED_CURR, STATE_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + + ! Copy from predicted state to saved predicted state + call FAST_CopyStates(ModData, Turbine, STATE_SAVED_PRED, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + Turbine%AD%InputTimes = InputTimes + case (Module_BD) + Turbine%BD%InputTimes(:, ModData%Ins) = InputTimes + case (Module_ED) + Turbine%ED%InputTimes = InputTimes + case (Module_ExtPtfm) + Turbine%ExtPtfm%InputTimes = InputTimes + case (Module_FEAM) + case (Module_HD) + Turbine%HD%InputTimes = InputTimes + case (Module_IceD) + Turbine%IceD%InputTimes(:, ModData%Ins) = InputTimes + case (Module_IceF) + Turbine%IceF%InputTimes = InputTimes + case (Module_IfW) + Turbine%IfW%InputTimes = InputTimes + case (Module_MAP) + Turbine%MAP%InputTimes = InputTimes + case (Module_MD) + Turbine%MD%InputTimes = InputTimes +! case (Module_ExtInfw) +! Turbine%ExtInfw%InputTimes = InputTimes + case (Module_Orca) + Turbine%Orca%InputTimes = InputTimes + case (Module_SD) + Turbine%SD%InputTimes = InputTimes + case (Module_SeaSt) + Turbine%SeaSt%InputTimes = InputTimes + case (Module_SrvD) + Turbine%SrvD%InputTimes = InputTimes + + ! A hack to restore Bladed-style DLL data + if (Turbine%SrvD%p%UseBladedInterface) then + if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE + ! store value to be overwritten + old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = -10 + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! put values back: + Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + end if + end if - ! Initialize Input-Output arrays for interpolation/extrapolation: + case default + call SetErrStat(ErrID_Fatal, "Unknown module "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select - CALL FAST_InitIOarrays( m_FAST%t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end associate + end do +END SUBROUTINE FAST_Reset_SubStep_T -END SUBROUTINE FAST_Solution0 !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the input and output arrays stored for extrapolation. They are initialized after the first input-output solve so that the first -!! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to -!! be stored for the predictor-corrector loop. -SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables +!> Routine that calls FAST_Store_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Store_SubStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: i, j, k ! loop counters + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Store_SubStep_T' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays' - + INTEGER(IntKi) :: i, j ! generic loop counters + REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset + INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore ErrStat = ErrID_None ErrMsg = "" - ! We fill ED%InputTimes with negative times, but the ED%Input values are identical for each of those times; this allows - ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation - ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as - ! order = SIZE(ED%Input) - - - DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO + t_global = t_initial + n_t_global * Turbine%p_FAST%DT - DO j = 2, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input(1), ED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ED_CopyInput (ED%Input(1), ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) + associate (ModData => Turbine%m_Glue%ModData(i)) - ! Initialize predicted states for j_pc loop: - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Copy from current input to input save locations + do j = 1, Turbine%p_FAST%InterpOrder + 1 + call FAST_CopyInput(ModData, Turbine, j, -j, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + end do + ! Copy from current state to saved current state + call FAST_CopyStates(ModData, Turbine, STATE_CURR, STATE_SAVED_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + + ! Copy from predicted state to saved predicted state + call FAST_CopyStates(ModData, Turbine, STATE_PRED, STATE_SAVED_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + + ! A hack to store Bladed-style DLL data + if (ModData%ID == Module_SrvD) then + if (Turbine%SrvD%p%UseBladedInterface) then + if (Turbine%SrvD%m%dll_data%avrSWAP(1) > 0) then ! this isn't allocated if UseBladedInterface is FALSE + ! store value to be overwritten + old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP(1) + Turbine%SrvD%m%dll_data%avrSWAP(1) = -11 + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! put values back: + Turbine%SrvD%m%dll_data%avrSWAP(1) = old_avrSwap1 + end if + end if + end if - IF (p_FAST%CompElast == Module_BD ) THEN + end associate + end do - DO k = 1,p_FAST%nBeams +END SUBROUTINE FAST_Store_SubStep_T - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes(j,k) = t_initial - (j - 1) * p_FAST%dt - END DO +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - DO j = 2, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input(1,k), BD%Input(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL BD_CopyInput (BD%Input(1,k), BD%u(k), MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + REAL(R8Ki) :: t_global_next - ! Initialize predicted states for j_pc loop: - CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Calculate next global time + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next*Turbine%p_FAST%DT - END DO ! nBeams + !---------------------------------------------------------------------------- + ! Step 1.a: set some variables and Extrapolate Inputs + !---------------------------------------------------------------------------- - END IF ! CompElast + call FAST_Prework_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !---------------------------------------------------------------------------- + ! Step 1.b: Advance states (yield state and constraint values at t_global_next) + ! Step 1.c: Input-Output Solve + ! Step 2: Correct (continue in loop) + !---------------------------------------------------------------------------- - IF ( p_FAST%CompServo == Module_SrvD ) THEN - ! Initialize Input-Output arrays for interpolation/extrapolation: + call FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt - END DO + !---------------------------------------------------------------------------- + ! Step 3: Save all final variables (advance to next time) and reset global time + !---------------------------------------------------------------------------- - DO j = 2, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL SrvD_CopyInput (SrvD%Input(1), SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Initialize predicted states for j_pc loop: - CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + ! Write output data to file + !---------------------------------------------------------------------------- - END IF ! CompServo + call WriteOutputToFile(n_t_global_next, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & + Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & + Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !---------------------------------------------------------------------------- + ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): + !---------------------------------------------------------------------------- - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: + if (Turbine%p_FAST%WrSttsTime) then + if (MOD(n_t_global_next, Turbine%p_FAST%n_SttsTime) == 0) then + call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + end if - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO +END SUBROUTINE FAST_Solution_T - DO j = 2, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(1), AD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL AD_CopyInput (AD%Input(1), AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Prework for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Prework_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Prework' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: i - END IF ! CompAero == Module_AD + ErrStat = ErrID_None + ErrMsg = "" + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next * Turbine%p_FAST%DT + ! Set flag for writing output at time t_global_next + Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, Turbine%p_FAST) - IF ( p_FAST%CompInflow == Module_IfW ) THEN - ! Copy values for interpolation/extrapolation: + ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from + ! the previous step before we extrapolate these inputs: + if (Turbine%p_FAST%CompServo == Module_SrvD) call SrvD_SetExternalInputs(Turbine%p_FAST, Turbine%m_FAST, Turbine%SrvD%Input(1)) - DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !IfW%OutputTimes(i) = t_initial - (j - 1) * dt - END DO + if (Turbine%p_FAST%UseSC) THEN + call SC_DX_SetOutputs(Turbine%p_FAST, Turbine%SrvD%Input(1), Turbine%SC_DX, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END if - DO j = 2, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL InflowWind_CopyInput (IfW%Input(1), IfW%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.a: Extrapolate Inputs + !! + !! gives predicted values at t+dt + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + do i = 1, size(Turbine%m_Glue%ModData) + call FAST_ExtrapInterp(Turbine%m_Glue%ModData(i), t_global_next, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do - ! Initialize predicted states for j_pc loop: - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +contains - END IF ! CompInflow == Module_IfW +END SUBROUTINE FAST_Prework_T +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_UpdateStates for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - IF ( p_FAST%CompHydro == Module_HD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !HD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input(1), HD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL HydroDyn_CopyInput (HD%Input(1), HD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! Initialize predicted states for j_pc loop: - CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF !CompHydro - - - IF (p_FAST%CompSub == Module_SD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !SD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input(1), SD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL SD_CopyInput (SD%Input(1), SD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! Initialize predicted states for j_pc loop: - CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! Initialize predicted states for j_pc loop: - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF ! CompSub - - - IF (p_FAST%CompMooring == Module_MAP) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !MAP_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL MAP_CopyInput (MAPp%Input(1), MAPp%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN - CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !MD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input(1), MD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL MD_CopyInput (MD%Input(1), MD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !FEAM_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL FEAM_CopyInput (FEAM%Input(1), FEAM%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input(1), Orca%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL Orca_CopyInput (Orca%Input(1), Orca%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF ! CompMooring - - - IF (p_FAST%CompIce == Module_IceF ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !IceF_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL IceFloe_CopyInput (IceF%Input(1), IceF%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! Initialize predicted states for j_pc loop: - CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompIce == Module_IceD ) THEN - - DO i = 1,p_FAST%numIceLegs - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes(j,i) = t_initial - (j - 1) * p_FAST%dt - !IceD%OutputTimes(j,i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL IceD_CopyInput (IceD%Input(1,i), IceD%u(i), MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! Initialize predicted states for j_pc loop: - CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! numIceLegs - - END IF ! CompIce - - -END SUBROUTINE FAST_InitIOarrays -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_InitIOarrays_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_InitIOarrays_SubStep_T(t_initial, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep_T' - - CALL FAST_InitIOarrays_SubStep(t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) - - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE FAST_InitIOarrays_SubStep_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the input and output arrays stored for extrapolation when used in a sub-timestepping mode with an external driver program. They are initialized after the first input-output solve so that the first -!! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to -!! be stored for the predictor-corrector loop. -SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: i, j, k ! loop counters - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! We fill ED%InputTimes with negative times, but the ED%Input values are identical for each of those times; this allows - ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation - ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as - ! order = SIZE(ED%Input) - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input(1), ED%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_NEWCOPY, Errstat2, ErrMsg2) !BJJ: THIS IS REALLY ONLY NECESSARY FOR ED-HD COUPLING AT THE MOMENT - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF (p_FAST%CompElast == Module_BD ) THEN - - DO k = 1,p_FAST%nBeams - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input(1,k), BD%Input_Saved(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! nBeams - - END IF ! CompElast - - - IF ( p_FAST%CompServo == Module_SrvD ) THEN - - ! Initialize Input-Output arrays for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_PRED), SrvD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompServo - - - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(1), AD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_PRED), AD%x(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_PRED), AD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_PRED), AD%z(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompAero == Module_AD - - - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_PRED), IfW%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompInflow == Module_IfW - - - IF ( p_FAST%CompHydro == Module_HD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input(1), HD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF !CompHydro - - - IF (p_FAST%CompSub == Module_SD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input(1), SD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState( SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompSub - - - IF (p_FAST%CompMooring == Module_MAP) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN - CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ! Initialize predicted states for j_pc loop: - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN - CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input(1), MD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState( MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_PRED), FEAM%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input(1), Orca%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState( Orca%OtherSt(STATE_PRED), Orca%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompMooring - - - IF (p_FAST%CompIce == Module_IceF ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompIce == Module_IceD ) THEN - - DO i = 1,p_FAST%numIceLegs - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input_Saved(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_PRED), IceD%OtherSt(i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! numIceLegs - - END IF ! CompIce - - -END SUBROUTINE FAST_InitIOarrays_SubStep -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Reset_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_Reset_SubStep_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Reset_SubStep_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 -SUBROUTINE FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: i, j, k ! generic loop counters - REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset - INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Reset_SubStep' - - - ErrStat = ErrID_None - ErrMsg = "" - - - t_global = t_initial + n_t_global * p_FAST%DT - - !---------------------------------------------------------------------------------------- - !! copy the stored states and inputs from n_t_global the current states and inputs - !---------------------------------------------------------------------------------------- - - DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !ED_OutputTimes(j) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input_Saved(j), ED%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ED_CopyOutput (ED%Output_bak(1), ED%y, MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_SAVED_PRED), ED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_SAVED_PRED), ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_SAVED_PRED), ED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_SAVED_PRED), ED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyContState (ED%x( STATE_SAVED_CURR), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_SAVED_CURR), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_SAVED_CURR), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_SAVED_CURR), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - IF (p_FAST%CompElast == Module_BD ) THEN - - DO k = 1,p_FAST%nBeams - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes(j,k) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input_Saved(j,k), BD%Input(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL BD_CopyContState (BD%x( k,STATE_SAVED_PRED), BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_SAVED_PRED), BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_SAVED_PRED), BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SAVED_PRED), BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL BD_CopyContState (BD%x( k,STATE_SAVED_CURR), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_SAVED_CURR), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_SAVED_CURR), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SAVED_CURR), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - END IF - - IF ( p_FAST%CompServo == Module_SrvD ) THEN - - ! A hack to restore Bladed-style DLL data - if (SrvD%p%UseBladedInterface) then - if (SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE - ! store value to be overwritten - old_avrSwap1 = SrvD%m%dll_data%avrSWAP( 1) - SrvD%m%dll_data%avrSWAP( 1) = -10 - CALL CallBladedDLL(SrvD%Input(1), SrvD%p, SrvD%m%dll_data, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! put values back: - SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 - end if - end if - - ! Initialize Input-Output arrays for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input_Saved(j), SrvD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL SrvD_CopyContState (SrvD%x( STATE_SAVED_PRED), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_SAVED_PRED), SrvD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_SAVED_PRED), SrvD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SAVED_PRED), SrvD%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyContState (SrvD%x( STATE_SAVED_CURR), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_SAVED_CURR), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_SAVED_CURR), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SAVED_CURR), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyMisc( SrvD%m_bak, SrvD%m, MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF - - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input_Saved(j), AD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL AD_CopyContState (AD%x( STATE_SAVED_PRED), AD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_SAVED_PRED), AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_SAVED_PRED), AD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_SAVED_PRED), AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL AD_CopyContState (AD%x( STATE_SAVED_CURR), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_SAVED_CURR), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_SAVED_CURR), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_SAVED_CURR), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompAero == Module_AD - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !IfW%OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input_Saved(j), IfW%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL InflowWind_CopyContState (IfW%x( STATE_SAVED_PRED), IfW%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_SAVED_PRED), IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_SAVED_PRED), IfW%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SAVED_PRED), IfW%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL InflowWind_CopyContState (IfW%x( STATE_SAVED_CURR), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_SAVED_CURR), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_SAVED_CURR), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SAVED_CURR), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompInflow == Module_IfW - - - IF ( p_FAST%CompHydro == Module_HD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !HD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input_Saved(j), HD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL HydroDyn_CopyContState (HD%x( STATE_SAVED_PRED), HD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_SAVED_PRED), HD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_SAVED_PRED), HD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SAVED_PRED), HD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL HydroDyn_CopyContState (HD%x( STATE_SAVED_CURR), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_SAVED_CURR), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_SAVED_CURR), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SAVED_CURR), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF !CompHydro - - - IF (p_FAST%CompSub == Module_SD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !SD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input_Saved(j), SD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL SD_CopyContState (SD%x( STATE_SAVED_PRED), SD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_SAVED_PRED), SD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_SAVED_PRED), SD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_SAVED_PRED), SD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SD_CopyContState (SD%x( STATE_SAVED_CURR), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_SAVED_CURR), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_SAVED_CURR), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_SAVED_CURR), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input_Saved(j), ExtPtfm%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SAVED_PRED), ExtPtfm%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SAVED_PRED), ExtPtfm%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SAVED_PRED), ExtPtfm%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SAVED_PRED), ExtPtfm%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SAVED_CURR), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SAVED_CURR), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SAVED_CURR), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SAVED_CURR), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompSub - - - IF (p_FAST%CompMooring == Module_MAP) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !MAP_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input_Saved(j), MAPp%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL MAP_CopyContState (MAPp%x( STATE_SAVED_PRED), MAPp%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_SAVED_PRED), MAPp%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_SAVED_PRED), MAPp%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SAVED_PRED), MAPp%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL MAP_CopyContState (MAPp%x( STATE_SAVED_CURR), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_SAVED_CURR), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_SAVED_CURR), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SAVED_CURR), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !MD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input_Saved(j), MD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL MD_CopyContState (MD%x( STATE_SAVED_PRED), MD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_SAVED_PRED), MD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_SAVED_PRED), MD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_SAVED_PRED), MD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL MD_CopyContState (MD%x( STATE_SAVED_CURR), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_SAVED_CURR), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_SAVED_CURR), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_SAVED_CURR), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !FEAM_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input_Saved(j), FEAM%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL FEAM_CopyContState (FEAM%x( STATE_SAVED_PRED), FEAM%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_SAVED_PRED), FEAM%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_SAVED_PRED), FEAM%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SAVED_PRED), FEAM%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL FEAM_CopyContState (FEAM%x( STATE_SAVED_CURR), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_SAVED_CURR), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_SAVED_CURR), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SAVED_CURR), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input_Saved(j), Orca%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL Orca_CopyContState (Orca%x( STATE_SAVED_PRED), Orca%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_SAVED_PRED), Orca%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_SAVED_PRED), Orca%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SAVED_PRED), Orca%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL Orca_CopyContState (Orca%x( STATE_SAVED_CURR), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_SAVED_CURR), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_SAVED_CURR), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SAVED_CURR), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompMooring - - - IF (p_FAST%CompIce == Module_IceF ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !IceF_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input_Saved(j), IceF%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL IceFloe_CopyContState (IceF%x( STATE_SAVED_PRED), IceF%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_SAVED_PRED), IceF%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_SAVED_PRED), IceF%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SAVED_PRED), IceF%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL IceFloe_CopyContState (IceF%x( STATE_SAVED_CURR), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_SAVED_CURR), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_SAVED_CURR), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SAVED_CURR), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompIce == Module_IceD ) THEN - - DO i = 1,p_FAST%numIceLegs - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes(j,i) = t_global - (j - 1) * p_FAST%dt - !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input_Saved(j,i), IceD%Input(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL IceD_CopyContState (IceD%x( i,STATE_SAVED_PRED), IceD%x( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_SAVED_PRED), IceD%xd(i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_SAVED_PRED), IceD%z( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SAVED_PRED), IceD%OtherSt( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL IceD_CopyContState (IceD%x( i,STATE_SAVED_CURR), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_SAVED_CURR), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_SAVED_CURR), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SAVED_CURR), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! numIceLegs - - END IF ! CompIce - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! We've moved everything back to the initial time step: - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! update the global time - - m_FAST%t_global = t_global -! y_FAST%n_Out = y_FAST%n_Out - n_timesteps - -END SUBROUTINE FAST_Reset_SubStep -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Store_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_Store_SubStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_Store_SubStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Store_SubStep_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 -SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: i, j, k ! generic loop counters - REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset - INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Store_SubStep' - - - ErrStat = ErrID_None - ErrMsg = "" - - - t_global = t_initial + n_t_global * p_FAST%DT - - !---------------------------------------------------------------------------------------- - !! copy the stored states and inputs from n_t_global the current states and inputs - !---------------------------------------------------------------------------------------- - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input(j), ED%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF (p_FAST%CompElast == Module_BD ) THEN - - DO k = 1,p_FAST%nBeams - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input(j,k), BD%Input_Saved(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - END IF - - IF ( p_FAST%CompServo == Module_SrvD ) THEN - ! Initialize Input-Output arrays for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), SrvD%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF - - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(j), AD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompAero == Module_AD - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_CURR), IfW%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompInflow == Module_IfW - - - IF ( p_FAST%CompHydro == Module_HD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input(j), HD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF !CompHydro - - - IF (p_FAST%CompSub == Module_SD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input(j), SD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompSub - - - IF (p_FAST%CompMooring == Module_MAP) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), MAPp%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input(j), MD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), FEAM%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input(j), Orca%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_CURR), Orca%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompMooring - - - IF (p_FAST%CompIce == Module_IceF ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompIce == Module_IceD ) THEN - - DO i = 1,p_FAST%numIceLegs - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input_Saved(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_CURR), IceD%OtherSt( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! numIceLegs - - END IF ! CompIce - - ! A hack to store Bladed-style DLL data - if (SrvD%p%UseBladedInterface) then - if (SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE - ! store value to be overwritten - old_avrSwap1 = SrvD%m%dll_data%avrSWAP( 1) - SrvD%m%dll_data%avrSWAP( 1) = -11 - CALL CallBladedDLL(SrvD%Input(1), SrvD%p, SrvD%m%dll_data, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! put values back: - SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 - end if - end if - -END SUBROUTINE FAST_Store_SubStep -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - USE FAST_SolverTC, only: Solver_Step - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - REAL(R8Ki) :: t_global_next - - ! Calculate next global time - t_global_next = t_initial + (n_t_global+1)*Turbine%p_FAST%DT - - ! Advance simulation one step and calculate outputs - CALL Solver_Step(n_t_global, t_initial, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & - Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !---------------------------------------------------------------------------- - ! Write output data to file - !---------------------------------------------------------------------------- - - CALL WriteOutputToFile(n_t_global + 1, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & - Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & - Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !---------------------------------------------------------------------------- - ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): - !---------------------------------------------------------------------------- - - if (Turbine%p_FAST%WrSttsTime) then - if (MOD(n_t_global + 1, Turbine%p_FAST%n_SttsTime) == 0) then - call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & - Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) - end if - end if - - ! CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - ! Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Solution_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and gets values at n_t_global + 1 -SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' - - ErrStat = ErrID_None - ErrMsg = "" - - n_t_global_next = n_t_global+1 - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.a: set some variables and Extrapolate Inputs - - call FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) - !! ## Step 1.c: Input-Output Solve - !! ## Step 2: Correct (continue in loop) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - call FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 3: Save all final variables (advance to next time) and reset global time - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - call FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - !---------------------------------------------------------------------------------------- - !! Write outputs - !---------------------------------------------------------------------------------------- - call FAST_WriteOutput(t_initial, n_t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - -END SUBROUTINE FAST_Solution - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Prework for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_Prework_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_Prework(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Prework_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine does thde prep work to advance the time step from n_t_global to n_t_global + 1 -SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Prework' - - - ErrStat = ErrID_None - ErrMsg = "" - - n_t_global_next = n_t_global+1 - t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt - - ! set flag for writing output at time t_global_next - y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) - - !! determine if the Jacobian should be calculated this time - IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian - - if (p_FAST%CompMooring == Module_Orca .and. n_t_global < 5) then - m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT ! the jacobian calculated with OrcaFlex at t=0 is incorrect, but is okay on the 2nd step (it's not okay for OrcaFlex version 10, so I increased this to 5) - else - m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT_UJac - end if - - END IF - - ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from - ! the previous step before we extrapolate these inputs: - IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) - - IF ( p_FAST%UseSC ) THEN - CALL SC_DX_SetOutputs(p_FAST, SrvD%Input(1), SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.a: Extrapolate Inputs - !! - !! gives predicted values at t+dt - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE FAST_Prework -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_UpdateStates for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_UpdateStates(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_UpdateStates_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and predicts the states and output at n_t_global+1 -SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter - INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step - INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed - LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed - - !REAL(ReKi) :: ControlInputGuess ! value of controller inputs + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UpdateStates' - - - ErrStat = ErrID_None - ErrMsg = "" - - t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt - n_t_global_next = n_t_global+1 - - ! set number of corrections to be used for this time step: - IF ( p_FAST%CompElast == Module_BD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps - if (n_t_global > 2) then ! this 2 should probably be related to p_FAST%InterpOrder - NumCorrections = p_FAST%NumCrctn - elseif (n_t_global == 0) then - NumCorrections = max(p_FAST%NumCrctn,16) - else - NumCorrections = max(p_FAST%NumCrctn,1) - end if - ELSE - NumCorrections = p_FAST%NumCrctn - END IF - - !! predictor-corrector loop: - j_pc = 0 - do while (j_pc <= NumCorrections) - WriteThisStep = y_FAST%WriteThisStep .AND. j_pc==NumCorrections + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UpdateStates' + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) - !! - !! STATE_CURR values of x, xd, z, and OtherSt contain values at m_FAST%t_global; - !! STATE_PRED values contain values at t_global_next. - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ErrStat = ErrID_None + ErrMsg = "" - CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! Calculate time + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next*Turbine%p_FAST%DT !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.c: Input-Output Solve + !! Solver Step !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! save predicted inputs for comparison with corrected value later - !IF (p_FAST%CheckHSSBrTrqC) THEN - ! ControlInputGuess = ED%Input(1)%HSSBrTrqC - !END IF - CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! Advance simulation one step and calculate outputs + CALL Solver_Step(n_t_global, t_initial, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 2: Correct (continue in loop) + !! SuperController !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - j_pc = j_pc + 1 - - ! ! Check if the predicted inputs were significantly different than the corrected inputs - ! ! (values before and after CalcOutputs_And_SolveForInputs) - !if (j_pc > NumCorrections) then - ! - ! !if (p_FAST%CheckHSSBrTrqC) then - ! ! if ( abs(ControlInputGuess - ED%Input(1)%HSSBrTrqC) > 50.0_ReKi ) then ! I randomly picked 50 N-m - ! ! NumCorrections = min(p_FAST%NumCrctn + 1, MaxCorrections) - ! ! ! print *, 'correction:', t_global_next, NumCorrections - ! ! cycle - ! ! end if - ! !end if - ! - ! ! check pitch position input to structural code (not implemented, yet) - !end if - - enddo ! j_pc - - if (p_FAST%UseSC ) then - call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then - ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file - call SeaSt_CalcOutput( t_global_next, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Turbine%p_FAST%UseSC) then + call SC_DX_SetInputs(Turbine%p_FAST, Turbine%SrvD%y, Turbine%SC_DX, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if -END SUBROUTINE FAST_UpdateStates +END SUBROUTINE FAST_UpdateStates_T + !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_AdvanceToNextTimeStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST @@ -7098,243 +5054,41 @@ SUBROUTINE FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CALL FAST_AdvanceToNextTimeStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_AdvanceToNextTimeStep_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine advances the time step from n_t_global to n_t_global + 1 and does all the relvant copying of data -SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - INTEGER(IntKi) :: I, k ! generic loop counters - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceToNextTimeStep' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceToNextTimeStep' - + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: i ErrStat = ErrID_None ErrMsg = "" - t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 3: Save all final variables (advance to next time) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - !---------------------------------------------------------------------------------------- - !! copy the final predicted states from step t_global_next to actual states for that step - !---------------------------------------------------------------------------------------- - - ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! BeamDyn: copy final predictions to actual states - IF ( p_FAST%CompElast == Module_BD ) THEN - DO k=1,p_FAST%nBeams - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF - - - ! AeroDyn: copy final predictions to actual states; copy current outputs to next - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - - ! InflowWind: copy final predictions to actual states; copy current outputs to next - IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - - ! ServoDyn: copy final predictions to actual states; copy current outputs to next - IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ! SeaState has no states - - ! HydroDyn: copy final predictions to actual states - IF ( p_FAST%CompHydro == Module_HD ) THEN - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - - ! SubDyn: copy final predictions to actual states - IF ( p_FAST%CompSub == Module_SD ) THEN - CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - - ! MAP: copy final predictions to actual states - IF (p_FAST%CompMooring == Module_MAP) THEN - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! IceFloe: copy final predictions to actual states - IF ( p_FAST%CompIce == Module_IceF ) THEN - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - DO i=1,p_FAST%numIceLegs - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF + ! Copy solver predicted state to current state + call Glue_CopyTC_State(Turbine%m_Glue%TC%StatePred, Turbine%m_Glue%TC%StateCurr, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + ! Copy the final predicted states from step t_global_next to actual states for that step + do i = 1, size(Turbine%m_Glue%ModData) + call FAST_CopyStates(Turbine%m_Glue%ModData(i), Turbine, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! We've advanced everything to the next time step: - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! update the global time + t_global_next = n_t_global+1 + Turbine%m_FAST%t_global = t_initial + t_global_next * Turbine%p_FAST%DT - m_FAST%t_global = t_global_next +END SUBROUTINE FAST_AdvanceToNextTimeStep_T -END SUBROUTINE FAST_AdvanceToNextTimeStep !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_WriteOutput for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. @@ -7346,78 +5100,40 @@ SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CALL FAST_WriteOutput(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_WriteOutput_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine writes the outputs at this timestep -SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(IN ) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(IN ) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - REAL(DbKi) :: t_global ! this simulation time (m_FAST%t_global + p_FAST%dt) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_WriteOutput' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_WriteOutput' - + REAL(DbKi) :: t_global ! this simulation time (m_FAST%t_global + p_FAST%dt) ErrStat = ErrID_None ErrMsg = "" - t_global = t_initial + n_t_global*p_FAST%DT + ! Calculate current time + t_global = t_initial + n_t_global*Turbine%p_FAST%DT - !---------------------------------------------------------------------------------------- - !! Check to see if we should output data this time step: - !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + !! Write output (subroutine checks y_FAST%WriteThisStep internally) + !---------------------------------------------------------------------------- + + call WriteOutputToFile(n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, & + Turbine%ED, Turbine%BD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & + Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !---------------------------------------------------------------------------------------- + !---------------------------------------------------------------------------- !! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): - !---------------------------------------------------------------------------------------- + !---------------------------------------------------------------------------- - IF (p_FAST%WrSttsTime) then - IF ( MOD( n_t_global, p_FAST%n_SttsTime ) == 0 ) THEN - CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) - ENDIF - ENDIF + if (Turbine%p_FAST%WrSttsTime) then + if (MOD(n_t_global, Turbine%p_FAST%n_SttsTime ) == 0) then + call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + end if -END SUBROUTINE FAST_WriteOutput +END SUBROUTINE FAST_WriteOutput_T !---------------------------------------------------------------------------------------------------------------------------------- ! ROUTINES TO OUTPUT WRITE DATA TO FILE AT EACH REQUSTED TIME STEP @@ -8659,13 +6375,13 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! local variables + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message REAL(DbKi) :: t_global ! current simulation time REAL(DbKi) :: next_lin_time ! next simulation time where linearization analysis should be performed INTEGER(IntKi) :: iLinTime ! loop counter - INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' + INTEGER(IntKi) :: i ! loop counter ErrStat = ErrID_None @@ -8737,18 +6453,18 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - ! Set flags to trigger Jacobian recalculation - if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then - Turbine%m_FAST%calcJacobian = .true. - Turbine%m_FAST%NextJacCalcTime = t_global - end if - - ! Calculate using restored operating points - CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & - Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! Calculate outputs using restored operating points + do i = 1, size(Turbine%m_Glue%ModData) + call FAST_CalcOutput(Turbine%m_Glue%ModData(i), Turbine%m_Glue%Mappings, & + t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + ! call CalcOutputs_And_SolveForInputs(Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + ! Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, & + ! t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (ErrStat >= AbortErrLev) return ! Linearize at operating points call ModGlue_Linearize_OP(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & @@ -9791,16 +7507,18 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, call ModGlue_RestoreOperatingPoint(Turbine%p_Glue, Turbine%m_Glue, iLinTime, Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! TODO: Fix perturbing OPs and calculating inputs/outputs + ! ! set perturbation of states based on x_eig magnitude and phase ! call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & ! IceF, IceD, ErrStat2, ErrMsg2 ) ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! IF (ErrStat >= AbortErrLev) RETURN - CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, .true., ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + ! p_FAST, m_FAST, .true., ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! IF (ErrStat >= AbortErrLev) RETURN call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) @@ -9822,6 +7540,8 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, ! Restore operating point call ModGlue_RestoreOperatingPoint(Turbine%p_Glue, Turbine%m_Glue, iLinTime, Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TODO: Fix perturbing OPs and calculating inputs/outputs ! ! set perturbation of states based on x_eig magnitude and phase ! call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & @@ -9829,10 +7549,10 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! IF (ErrStat >= AbortErrLev) RETURN - CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, .true., ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + ! p_FAST, m_FAST, .true., ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! IF (ErrStat >= AbortErrLev) RETURN call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) @@ -10150,6 +7870,54 @@ SUBROUTINE Cleanup() END SUBROUTINE Cleanup END SUBROUTINE ReadModeShapeFile + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the inputs required for ServoDyn from an external source (Simulink) +SUBROUTINE SrvD_SetExternalInputs(p_FAST, m_FAST, u_SrvD) + + TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_MiscVarType), INTENT(IN) :: m_FAST !< Glue-code misc variables (including inputs from external sources like Simulink) + TYPE(SrvD_InputType), INTENT(INOUT) :: u_SrvD !< ServoDyn Inputs at t + + INTEGER(IntKi) :: i ! loop counter + + ! we are going to use extrapolated values because these external values from Simulink are at n instead of n+1 + u_SrvD%ExternalGenTrq = m_FAST%ExternInput%GenTrq + u_SrvD%ExternalElecPwr = m_FAST%ExternInput%ElecPwr + u_SrvD%ExternalYawPosCom = m_FAST%ExternInput%YawPosCom + u_SrvD%ExternalYawRateCom = m_FAST%ExternInput%YawRateCom + u_SrvD%ExternalHSSBrFrac = m_FAST%ExternInput%HSSBrFrac + + if (ALLOCATED(u_SrvD%ExternalBlPitchCom)) then !there should be no reason this isn't allocated, but ExternalInflow is acting strange... + do i=1,SIZE(u_SrvD%ExternalBlPitchCom) + u_SrvD%ExternalBlPitchCom(i) = m_FAST%ExternInput%BlPitchCom(i) + end do + end if + + if (ALLOCATED(u_SrvD%ExternalBlAirfoilCom)) then ! Added Blade Flap use with Simulink + do i=1,SIZE(u_SrvD%ExternalBlAirfoilCom) + u_SrvD%ExternalBlAirfoilCom(i) = m_FAST%ExternInput%BlAirfoilCom(i) + end do + end if + + ! Cable controls + if (ALLOCATED(u_SrvD%ExternalCableDeltaL)) then ! This is only allocated if cable control signals are requested + do i=1,min(SIZE(u_SrvD%ExternalCableDeltaL),SIZE(m_FAST%ExternInput%CableDeltaL)) + u_SrvD%ExternalCableDeltaL(i) = m_FAST%ExternInput%CableDeltaL(i) + end do + end if + + if (ALLOCATED(u_SrvD%ExternalCableDeltaLdot)) then ! This is only allocated if cable control signals are requested + do i=1,min(SIZE(u_SrvD%ExternalCableDeltaLdot),SIZE(m_FAST%ExternInput%CableDeltaLdot)) + u_SrvD%ExternalCableDeltaLdot(i) = m_FAST%ExternInput%CableDeltaLdot(i) + end do + end if + + ! StC controls + ! This is a placeholder for where StC controls would be passed if they are enabled from Simulink + +END SUBROUTINE SrvD_SetExternalInputs + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE FAST_Subs !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index 5a811232c9..58626a39e6 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -96,6 +96,7 @@ typedef ^ ^ IntKi iJU 2 - - typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - typedef ^ ^ IntKi iJL 2 - - "Indices of Jacobian load variables" - typedef ^ ^ IntKi iModInit : - - "ModData index order for step 0 initialization" - +typedef ^ ^ IntKi iModUY1 : - - "ModData index order for step 0 initialization" - typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - @@ -174,6 +175,8 @@ typedef ^ ^ IntKi IterTotal - 0 - typedef ^ ^ IntKi UJacIterRemain - 0 - "Number of convergence iterations until Jacobian update" - typedef ^ ^ IntKi UJacStepsRemain - 0 - "Number of time steps until Jacobian update" - typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - +typedef ^ ^ R8Ki XB_IO :: - - "" - +typedef ^ ^ R8Ki Jac_IO :: - - "" - typedef ^ Glue_LinMisc IntKi TimeIndex - - - "" - typedef ^ ^ IntKi AzimuthIndex - - - "" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 4bfc02afcf..835f623751 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -123,6 +123,7 @@ MODULE Glue_Types INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] INTEGER(IntKi) , DIMENSION(1:2) :: iJL = 0_IntKi !< Indices of Jacobian load variables [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModInit !< ModData index order for step 0 initialization [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModUY1 !< ModData index order for step 0 initialization [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] @@ -217,6 +218,8 @@ MODULE Glue_Types INTEGER(IntKi) :: UJacIterRemain = 0 !< Number of convergence iterations until Jacobian update [-] INTEGER(IntKi) :: UJacStepsRemain = 0 !< Number of time steps until Jacobian update [-] LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB_IO !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac_IO !< [-] END TYPE Glue_TCMisc ! ======================= ! ========= Glue_LinMisc ======= @@ -755,6 +758,18 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E end if DstTCParamData%iModInit = SrcTCParamData%iModInit end if + if (allocated(SrcTCParamData%iModUY1)) then + LB(1:1) = lbound(SrcTCParamData%iModUY1, kind=B8Ki) + UB(1:1) = ubound(SrcTCParamData%iModUY1, kind=B8Ki) + if (.not. allocated(DstTCParamData%iModUY1)) then + allocate(DstTCParamData%iModUY1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModUY1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCParamData%iModUY1 = SrcTCParamData%iModUY1 + end if if (allocated(SrcTCParamData%iModTC)) then LB(1:1) = lbound(SrcTCParamData%iModTC, kind=B8Ki) UB(1:1) = ubound(SrcTCParamData%iModTC, kind=B8Ki) @@ -815,6 +830,9 @@ subroutine Glue_DestroyTCParam(TCParamData, ErrStat, ErrMsg) if (allocated(TCParamData%iModInit)) then deallocate(TCParamData%iModInit) end if + if (allocated(TCParamData%iModUY1)) then + deallocate(TCParamData%iModUY1) + end if if (allocated(TCParamData%iModTC)) then deallocate(TCParamData%iModTC) end if @@ -862,6 +880,7 @@ subroutine Glue_PackTCParam(RF, Indata) call RegPack(RF, InData%iJUT) call RegPack(RF, InData%iJL) call RegPackAlloc(RF, InData%iModInit) + call RegPackAlloc(RF, InData%iModUY1) call RegPackAlloc(RF, InData%iModTC) call RegPackAlloc(RF, InData%iModOpt1) call RegPackAlloc(RF, InData%iModOpt2) @@ -905,6 +924,7 @@ subroutine Glue_UnPackTCParam(RF, OutData) call RegUnpack(RF, OutData%iJUT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iJL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModUY1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModTC); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModOpt1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModOpt2); if (RegCheckErr(RF, RoutineName)) return @@ -1878,6 +1898,30 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%UJacIterRemain = SrcTCMiscData%UJacIterRemain DstTCMiscData%UJacStepsRemain = SrcTCMiscData%UJacStepsRemain DstTCMiscData%ConvWarn = SrcTCMiscData%ConvWarn + if (allocated(SrcTCMiscData%XB_IO)) then + LB(1:2) = lbound(SrcTCMiscData%XB_IO, kind=B8Ki) + UB(1:2) = ubound(SrcTCMiscData%XB_IO, kind=B8Ki) + if (.not. allocated(DstTCMiscData%XB_IO)) then + allocate(DstTCMiscData%XB_IO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%XB_IO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%XB_IO = SrcTCMiscData%XB_IO + end if + if (allocated(SrcTCMiscData%Jac_IO)) then + LB(1:2) = lbound(SrcTCMiscData%Jac_IO, kind=B8Ki) + UB(1:2) = ubound(SrcTCMiscData%Jac_IO, kind=B8Ki) + if (.not. allocated(DstTCMiscData%Jac_IO)) then + allocate(DstTCMiscData%Jac_IO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%Jac_IO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%Jac_IO = SrcTCMiscData%Jac_IO + end if end subroutine subroutine Glue_DestroyTCMisc(TCMiscData, ErrStat, ErrMsg) @@ -1904,6 +1948,12 @@ subroutine Glue_DestroyTCMisc(TCMiscData, ErrStat, ErrMsg) if (allocated(TCMiscData%IPIV)) then deallocate(TCMiscData%IPIV) end if + if (allocated(TCMiscData%XB_IO)) then + deallocate(TCMiscData%XB_IO) + end if + if (allocated(TCMiscData%Jac_IO)) then + deallocate(TCMiscData%Jac_IO) + end if end subroutine subroutine Glue_PackTCMisc(RF, Indata) @@ -1921,6 +1971,8 @@ subroutine Glue_PackTCMisc(RF, Indata) call RegPack(RF, InData%UJacIterRemain) call RegPack(RF, InData%UJacStepsRemain) call RegPack(RF, InData%ConvWarn) + call RegPackAlloc(RF, InData%XB_IO) + call RegPackAlloc(RF, InData%Jac_IO) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1942,6 +1994,8 @@ subroutine Glue_UnPackTCMisc(RF, OutData) call RegUnpack(RF, OutData%UJacIterRemain); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%UJacStepsRemain); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%XB_IO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_IO); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Glue_CopyLinMisc(SrcLinMiscData, DstLinMiscData, CtrlCode, ErrStat, ErrMsg) From cd6b4fc650b3ad6b1dd757a80f62f76b925db930 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 12:43:58 +0000 Subject: [PATCH 195/319] Fix bug in Calculate_C_alpha (AirfoilInfo.f90) --- modules/aerodyn/src/AirfoilInfo.f90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AirfoilInfo.f90 b/modules/aerodyn/src/AirfoilInfo.f90 index e11f3b8656..60366c3801 100644 --- a/modules/aerodyn/src/AirfoilInfo.f90 +++ b/modules/aerodyn/src/AirfoilInfo.f90 @@ -1184,8 +1184,13 @@ SUBROUTINE Calculate_C_alpha(alpha, Cn, Cl, Default_Cn_alpha, Default_Cl_alpha, A(:,1) = alpha A(:,2) = 1.0_ReKi - B(:,1) = Cn - B(:,2) = Cl + if (size(Cn) == 1) then + B(:,1) = Cn(1) + B(:,2) = Cl(1) + else + B(:,1) = Cn + B(:,2) = Cl + end if CALL LAPACK_gels('N', A, B, ErrStat, ErrMsg) From d4e7c7c491c42d4101f262d27a014e68adfb6aa4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 18:33:34 +0000 Subject: [PATCH 196/319] Rename functions in FAST_SolverTC --- modules/openfast-library/src/FAST_SolverTC.f90 | 8 ++++---- modules/openfast-library/src/FAST_Subs.f90 | 10 +++++----- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 80fb000510..5a1568b3b4 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -17,7 +17,7 @@ module FAST_SolverTC private ! Public functions -public SolverTC_Init, Solver_Step0, Solver_Step, CalcOutputs_And_SolveForInputs +public FAST_SolverInit, FAST_SolverStep0, FAST_SolverStep, CalcOutputs_And_SolveForInputs ! Debugging logical, parameter :: DebugSolver = .false. @@ -28,7 +28,7 @@ module FAST_SolverTC contains -subroutine SolverTC_Init(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) +subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) type(FAST_ParameterType), intent(in) :: p_FAST !< FAST parameters type(Glue_TCParam), intent(inout) :: p !< Glue Parameters type(Glue_TCMisc), intent(out) :: m !< Glue miscellaneous variables @@ -649,7 +649,7 @@ logical function Failed() end function end subroutine -subroutine Solver_Step0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) +subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) type(Glue_TCParam), intent(in) :: p !< Parameters type(Glue_TCMisc), intent(inout) :: m !< Misc variables type(ModDataType), intent(inout) :: GlueModData(:) !< Glue module data @@ -965,7 +965,7 @@ logical function Failed() end function end subroutine -subroutine Solver_Step(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) +subroutine FAST_SolverStep(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) integer(IntKi), intent(in) :: n_t_global !< global time step real(DbKi), intent(in) :: t_initial !< Initial simulation time type(Glue_TCParam), intent(in) :: p !< Parameters diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 1cc20e079b..2a7ef174b6 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -61,7 +61,7 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In if(ErrStat >= AbortErrLev) return ! Initialize solver - call SolverTC_Init(Turbine%p_FAST, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + call FAST_SolverInit(Turbine%p_FAST, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat, ErrMsg) if(ErrStat >= AbortErrLev) return @@ -4572,7 +4572,7 @@ END SUBROUTINE FAST_WrSum !> Routine that calls FAST_Solution0 for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) - USE FAST_SolverTC, only: Solver_Step0 + USE FAST_SolverTC, only: FAST_SolverStep0 TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -4608,7 +4608,7 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) end if ! Perform initial solve - CALL Solver_Step0(Turbine%p_Glue%TC, Turbine%m_Glue%TC, Turbine%m_Glue%ModData, & + CALL FAST_SolverStep0(Turbine%p_Glue%TC, Turbine%m_Glue%TC, Turbine%m_Glue%ModData, & Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -5025,8 +5025,8 @@ SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Advance simulation one step and calculate outputs - CALL Solver_Step(n_t_global, t_initial, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & - Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) + CALL FAST_SolverStep(n_t_global, t_initial, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return From f49fc9a745b0bb47f7a5ab5ca4bf9fbe58b6a40d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 18:33:53 +0000 Subject: [PATCH 197/319] Allow .out and .outb files in regression test scripts --- reg_tests/executeOpenfastRegressionCase.py | 2 ++ reg_tests/executePythonRegressionCase.py | 7 +++++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index 8af6bf205c..d57a8252e2 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -144,6 +144,8 @@ ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName + ".out") +if not os.path.exists(localOutFile): + localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") if not os.path.exists(baselineOutFile): baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") diff --git a/reg_tests/executePythonRegressionCase.py b/reg_tests/executePythonRegressionCase.py index 84fdb9cd7d..f6bcddc710 100644 --- a/reg_tests/executePythonRegressionCase.py +++ b/reg_tests/executePythonRegressionCase.py @@ -140,8 +140,11 @@ output_channel_names = openfastlib.output_channel_names ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") +localOutFile = os.path.join(testBuildDirectory, caseName + ".out") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") +if not os.path.exists(baselineOutFile): + baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") +rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) testInfo = {"attribute_names": output_channel_names} From 4b703bc7978602c324c9d837ac787d5f20c727ff Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 18:48:47 +0000 Subject: [PATCH 198/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 72457d5de8..d6bb14d166 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 72457d5de81163a43dd1680c9fc3aa585b256798 +Subproject commit d6bb14d166e0b1ee84824024cb5f638213076066 From c06f0bb990faca1ae1fac3163ae073a59a1b2915 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 19:17:17 +0000 Subject: [PATCH 199/319] Remove GetOP from IfW and ExtPtfm --- modules/extptfm/src/ExtPtfm_MCKF.f90 | 83 ------------------------ modules/inflowwind/src/IfW_FlowField.f90 | 25 ------- 2 files changed, 108 deletions(-) diff --git a/modules/extptfm/src/ExtPtfm_MCKF.f90 b/modules/extptfm/src/ExtPtfm_MCKF.f90 index ad6e4a1fe9..fc6772167d 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF.f90 @@ -59,10 +59,6 @@ MODULE ExtPtfm_MCKF PUBLIC :: ExtPtfm_JacobianPConstrState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- ! (Xd), and constraint-state (Z) functions all with respect to the constraint ! states (z) - PUBLIC :: ExtPtfm_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays) - - - CONTAINS @@ -1233,85 +1229,6 @@ SUBROUTINE ExtPtfm_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, Er if (present(dZdz)) then end if END SUBROUTINE ExtPtfm_JacobianPConstrState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ExtPtfm_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ExtPtfm_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ExtPtfm_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - INTEGER(IntKi) :: I - TYPE(ExtPtfm_ContinuousStateType) :: dx !< derivative of continuous states at operating point - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - - if ( present( u_op ) ) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, N_INPUTS, 'u_op', ErrStat, ErrMsg); if(Failed())return - endif - u_op(1:3) = u%PtfmMesh%TranslationDisp(:,1) - u_op(4:6) = GetSmllRotAngs(u%PtfmMesh%Orientation(:,:,1), ErrStat, ErrMsg); if(Failed())return - u_op(7:9 ) = u%PtfmMesh%TranslationVel(:,1) - u_op(10:12) = u%PtfmMesh%RotationVel (:,1) - u_op(13:15) = u%PtfmMesh%TranslationAcc(:,1) - u_op(16:18) = u%PtfmMesh%RotationAcc (:,1) - end if - - if ( present( y_op ) ) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, N_OUTPUTS+p%NumOuts, 'y_op', ErrStat, ErrMsg); if(Failed())return - endif - ! Update the output mesh - y_op(1:3)=y%PtfmMesh%Force(1:3,1) - y_op(4:6)=y%PtfmMesh%Moment(1:3,1) - do i=1,p%NumOuts - y_op(i+N_OUTPUTS) = y%WriteOutput(i) - end do - end if - - if ( present( x_op ) ) then - if (.not. allocated(x_op)) then - call AllocAry(x_op, 2*p%nCB, 'x_op', ErrStat, ErrMsg); if (Failed())return - endif - x_op(1:p%nCB) = x%qm(1:p%nCB) - x_op(p%nCB+1:2*p%nCB) = x%qmdot(1:p%nCB) - end if - - if ( present( dx_op ) ) then - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, 2*p%nCB, 'dx_op', ErrStat, ErrMsg); if (Failed())return - endif - call ExtPtfm_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, dx, ErrStat, ErrMsg); if(Failed()) return - dx_op(1:p%nCB) = dx%qm(1:p%nCB) - dx_op(p%nCB+1:2*p%nCB) = dx%qmdot(1:p%nCB) - end if - - if ( present( xd_op ) ) then - end if - - if ( present( z_op ) ) then - end if - -contains - logical function Failed() - CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_GetOP') - Failed = ErrStat >= AbortErrLev - end function Failed -END SUBROUTINE ExtPtfm_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ END MODULE ExtPtfm_MCKF diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index 51310ed24e..1bc8209fb4 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -26,7 +26,6 @@ module IfW_FlowField public IfW_FlowField_GetVelAcc public IfW_UniformField_CalcAccel, IfW_Grid3DField_CalcAccel -public IfW_UniformWind_GetOP ! for linearization public Grid3D_to_Uniform, Uniform_to_Grid3D integer(IntKi), parameter :: WindProfileType_None = -1 !< don't add wind profile; already included in input @@ -710,30 +709,6 @@ subroutine CalcCubicSplineDeriv(x, y, dy) end subroutine -!> Routine to compute the Jacobians of the output (Y) function with respect to the inputs (u). The partial -!! derivative dY/du is returned. This submodule does not follow the modularization framework. -subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) - type(UniformFieldType), intent(IN) :: UF !< Parameters - real(DbKi), intent(IN) :: t !< Current simulation time in seconds - logical, intent(in) :: InterpCubic !< flag for using cubic interpolation - real(R8Ki), intent(OUT) :: OP_out(3) !< operating point (HWindSpeed and PLexp - - type(UniformField_Interp) :: op ! interpolated values of InterpParams - - ! Linearly interpolate parameters in time at operating point (or use nearest-neighbor to extrapolate) - if (InterpCubic) then - op = UniformField_InterpCubic(UF, t) - else - op = UniformField_InterpLinear(UF, t) - end if - - OP_out(1) = real(op%VelH, R8Ki) - OP_out(2) = real(op%ShrV, R8Ki) - OP_out(3) = real(op%AngleH, R8Ki) - -end subroutine - - subroutine Grid3DField_GetCell(G3D, Time, Position, CalcAccel, AllowExtrap, & VelCell, AccCell, Xi, Is3D, ErrStat, ErrMsg) From 724593f2b836dd9d1938e1e714f2584307f8d83c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 19:17:48 +0000 Subject: [PATCH 200/319] Reduce linearization size by keeping only necessary variables --- modules/openfast-library/src/FAST_ModGlue.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 3d4c704297..959b3d2615 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -449,7 +449,7 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 integer(IntKi), allocatable :: modIDs(:), modIdx(:) integer(IntKi) :: i, j, k - integer(IntKi) :: FlagFilters + integer(IntKi) :: LinFlags ! Initialize error return ErrStat = ErrID_None @@ -542,7 +542,10 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Glue Module !---------------------------------------------------------------------------- - call Glue_CombineModules(m%ModGlue, m%ModData, m%Mappings, p%Lin%iMod, VF_None, p_FAST%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + LinFlags = VF_Linearize + VF_Mapping + call Glue_CombineModules(m%ModGlue, m%ModData, m%Mappings, p%Lin%iMod, LinFlags, & + p_FAST%Linearize, ErrStat2, ErrMsg2, Name="Lin") + if (Failed()) return !---------------------------------------------------------------------------- ! Allocate linearization arrays and matrices From 5912006a74a56f08b296ad969be2d9b1741a2b0e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 21:53:22 +0000 Subject: [PATCH 201/319] Add name argument to Glue_CombineModules --- modules/openfast-library/src/FAST_SolverTC.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 5a1568b3b4..09ab207f6b 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -163,7 +163,7 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS ! Build tight coupling module using solve variables from TC and Option 1 modules call Glue_CombineModules(m%Mod, GlueModData, GlueModMaps, iMod, & - VF_Solve, .true., ErrStat2, ErrMsg2) + VF_Solve, .true., ErrStat2, ErrMsg2, Name='Solver') if (Failed()) return !---------------------------------------------------------------------------- From c624cb47ff6c8dbafe731faffab804cc068c51e3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 21:53:46 +0000 Subject: [PATCH 202/319] Update r-test pointer, disable 5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth --- reg_tests/CTestList.cmake | 2 +- reg_tests/r-test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 01f0f91dbe..a69cb5e462 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -301,7 +301,7 @@ of_regression("5MW_Land_DLL_WTurb_wNacDrag" "openfast;elastodyn;aerod of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr_Restart" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore;restart") of_regression("5MW_OC3Trpd_DLL_WSt_WavesReg" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") -of_regression("5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") +# of_regression("5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") of_regression("5MW_ITIBarge_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") of_regression("5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") of_regression("5MW_OC3Spar_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") diff --git a/reg_tests/r-test b/reg_tests/r-test index d6bb14d166..6a3303851a 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit d6bb14d166e0b1ee84824024cb5f638213076066 +Subproject commit 6a3303851a18a77fc86ff0b7280141a49779ba31 From 1a128c40699747b409a8e5f7b1a0c80a9dc56d36 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 27 Aug 2024 22:12:56 +0000 Subject: [PATCH 203/319] Read solver parameters from input file --- .../openfast-library/src/FAST_Registry.txt | 4 +++ .../openfast-library/src/FAST_SolverTC.f90 | 6 ++--- modules/openfast-library/src/FAST_Subs.f90 | 27 +++++++++++++++++++ modules/openfast-library/src/FAST_Types.f90 | 12 +++++++++ 4 files changed, 46 insertions(+), 3 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index accb34b017..f5cab663c9 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -120,6 +120,10 @@ typedef ^ FAST_ParameterType IntKi numIceLegs - - - "number of suport-structure typedef ^ FAST_ParameterType IntKi nBeams - - - "number of BeamDyn instances" - typedef ^ FAST_ParameterType LOGICAL BD_OutputSibling - - - "flag to determine if BD input is sibling of output mesh" - typedef ^ FAST_ParameterType LOGICAL ModuleInitialized {NumModules} - - "An array determining if the module has been initialized" - +# Data for TC Solver: +typedef ^ FAST_ParameterType DbKi RhoInf - - - "Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0]" - +typedef ^ FAST_ParameterType DbKi ConvTol - - - "Convergence iteration error tolerance for tight coupling generalized alpha integrator (-)" - +typedef ^ FAST_ParameterType IntKi MaxConvIter - - - "Maximum number of convergence iterations for tight coupling generalized alpha integrator (-)" - # Data for Jacobians: typedef ^ FAST_ParameterType DbKi DT_Ujac - - - "Time between when we need to re-calculate these Jacobians" s typedef ^ FAST_ParameterType Reki UJacSclFact - - - "Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians" - diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 09ab207f6b..bba321a681 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -50,15 +50,15 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS ! Generalized alpha damping coefficient ! TODO: read from input file - p%RhoInf = 0.0_R8Ki + p%RhoInf = p_FAST%RhoInf ! Max number of convergence iterations ! TODO: read from input file - p%MaxConvIter = 6 + p%MaxConvIter = p_FAST%MaxConvIter ! Convergence tolerance ! TODO: read from input file - p%ConvTol = 1.0e-4_R8Ki + p%ConvTol = p_FAST%ConvTol ! Solver time step p%h = p_FAST%DT diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 2a7ef174b6..aa6c3cae05 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -2559,6 +2559,33 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS RETURN end if + + ! RhoInf - Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0] + CALL ReadVar( UnIn, InputFile, p%RhoInf, "RhoInf", "Numerical damping parameter "//& + "for tight coupling generalized-alpha integrator (-) [0.0 to 1.0]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! ConvTol - Convergence iteration error tolerance for tight coupling generalized alpha integrator (-) + CALL ReadVar( UnIn, InputFile, p%ConvTol, "ConvTol", "Convergence iteration error tolerance for tight coupling generalized alpha integrator (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! MaxConvIter - Maximum number of convergence interations for tight coupling generalized alpha integrator (-) + CALL ReadVar( UnIn, InputFile, p%MaxConvIter, "MaxConvIter", "Maximum number of convergence iterations "//& + "for tight coupling generalized alpha integrator (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + ! DT_UJac - Time between calls to get Jacobians (s) CALL ReadVar( UnIn, InputFile, p%DT_UJac, "DT_UJac", "Time between calls to get Jacobians (s)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index ed5e673509..46f52f454a 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -140,6 +140,9 @@ MODULE FAST_Types INTEGER(IntKi) :: nBeams = 0_IntKi !< number of BeamDyn instances [-] LOGICAL :: BD_OutputSibling = .false. !< flag to determine if BD input is sibling of output mesh [-] LOGICAL , DIMENSION(1:NumModules) :: ModuleInitialized = .false. !< An array determining if the module has been initialized [-] + REAL(DbKi) :: RhoInf = 0.0_R8Ki !< Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0] [-] + INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< Maximum number of convergence iterations for tight coupling generalized alpha integrator (-) [-] + INTEGER(IntKi) :: ConvTol = 0_IntKi !< Convergence iteration error tolerance for tight coupling generalized alpha integrator (-) [-] REAL(DbKi) :: DT_Ujac = 0.0_R8Ki !< Time between when we need to re-calculate these Jacobians [s] REAL(ReKi) :: UJacSclFact = 0.0_ReKi !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 = 0_IntKi !< (1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion; [-] @@ -1367,6 +1370,9 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nBeams = SrcParamData%nBeams DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized + DstParamData%RhoInf = SrcParamData%RhoInf + DstParamData%MaxConvIter = SrcParamData%MaxConvIter + DstParamData%ConvTol = SrcParamData%ConvTol DstParamData%DT_Ujac = SrcParamData%DT_Ujac DstParamData%UJacSclFact = SrcParamData%UJacSclFact DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 @@ -1539,6 +1545,9 @@ subroutine FAST_PackParam(RF, Indata) call RegPack(RF, InData%nBeams) call RegPack(RF, InData%BD_OutputSibling) call RegPack(RF, InData%ModuleInitialized) + call RegPack(RF, InData%RhoInf) + call RegPack(RF, InData%MaxConvIter) + call RegPack(RF, InData%ConvTol) call RegPack(RF, InData%DT_Ujac) call RegPack(RF, InData%UJacSclFact) call RegPack(RF, InData%SizeJac_Opt1) @@ -1654,6 +1663,9 @@ subroutine FAST_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%nBeams); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BD_OutputSibling); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ModuleInitialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT_Ujac); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%UJacSclFact); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SizeJac_Opt1); if (RegCheckErr(RF, RoutineName)) return From fe734056bf76d35fcf1c31769cd325c50e06e01f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 28 Aug 2024 17:20:49 +0000 Subject: [PATCH 204/319] Update FAST_Types.f90 --- modules/openfast-library/src/FAST_Types.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 46f52f454a..3e5b74f789 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -141,8 +141,8 @@ MODULE FAST_Types LOGICAL :: BD_OutputSibling = .false. !< flag to determine if BD input is sibling of output mesh [-] LOGICAL , DIMENSION(1:NumModules) :: ModuleInitialized = .false. !< An array determining if the module has been initialized [-] REAL(DbKi) :: RhoInf = 0.0_R8Ki !< Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0] [-] + REAL(DbKi) :: ConvTol = 0.0_R8Ki !< Convergence iteration error tolerance for tight coupling generalized alpha integrator (-) [-] INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< Maximum number of convergence iterations for tight coupling generalized alpha integrator (-) [-] - INTEGER(IntKi) :: ConvTol = 0_IntKi !< Convergence iteration error tolerance for tight coupling generalized alpha integrator (-) [-] REAL(DbKi) :: DT_Ujac = 0.0_R8Ki !< Time between when we need to re-calculate these Jacobians [s] REAL(ReKi) :: UJacSclFact = 0.0_ReKi !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 = 0_IntKi !< (1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion; [-] @@ -1371,8 +1371,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized DstParamData%RhoInf = SrcParamData%RhoInf - DstParamData%MaxConvIter = SrcParamData%MaxConvIter DstParamData%ConvTol = SrcParamData%ConvTol + DstParamData%MaxConvIter = SrcParamData%MaxConvIter DstParamData%DT_Ujac = SrcParamData%DT_Ujac DstParamData%UJacSclFact = SrcParamData%UJacSclFact DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 @@ -1546,8 +1546,8 @@ subroutine FAST_PackParam(RF, Indata) call RegPack(RF, InData%BD_OutputSibling) call RegPack(RF, InData%ModuleInitialized) call RegPack(RF, InData%RhoInf) - call RegPack(RF, InData%MaxConvIter) call RegPack(RF, InData%ConvTol) + call RegPack(RF, InData%MaxConvIter) call RegPack(RF, InData%DT_Ujac) call RegPack(RF, InData%UJacSclFact) call RegPack(RF, InData%SizeJac_Opt1) @@ -1664,8 +1664,8 @@ subroutine FAST_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%BD_OutputSibling); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ModuleInitialized); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT_Ujac); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%UJacSclFact); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SizeJac_Opt1); if (RegCheckErr(RF, RoutineName)) return From b67fb625cf64c81e3df8a0b7b598c2078f622326 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 28 Aug 2024 17:21:25 +0000 Subject: [PATCH 205/319] Update r-test pointer --- reg_tests/executeAerodynRegressionCase.py | 8 ++++---- .../executeOpenfastAeroAcousticRegressionCase.py | 4 ++-- reg_tests/executeOpenfastCppRegressionCase.py | 6 ++---- reg_tests/executeOpenfastLinearRegressionCase.py | 2 +- reg_tests/executeOpenfastRegressionCase.py | 13 +++++-------- reg_tests/executePythonRegressionCase.py | 6 ++---- reg_tests/r-test | 2 +- 7 files changed, 17 insertions(+), 24 deletions(-) diff --git a/reg_tests/executeAerodynRegressionCase.py b/reg_tests/executeAerodynRegressionCase.py index 62a2c1010e..61fd73bf8c 100644 --- a/reg_tests/executeAerodynRegressionCase.py +++ b/reg_tests/executeAerodynRegressionCase.py @@ -101,7 +101,7 @@ time.sleep(1) # create the local output directory and initialize it with input files -rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'ad_driver.out':'ad_driver_ref.out'}) +rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'ad_driver.outb':'ad_driver_ref.outb'}) ### Run aerodyn on the test case if not noExec: @@ -112,9 +112,9 @@ ### Build the filesystem navigation variables for running the regression test # For multiple turbines, test turbine 2, for combined cases, test case 4 -localOutFile = os.path.join(testBuildDirectory, "ad_driver.out") -localOutFileWT2 = os.path.join(testBuildDirectory, "ad_driver.T2.out") -localOutFileCase4 = os.path.join(testBuildDirectory, "ad_driver.4.out") +localOutFile = os.path.join(testBuildDirectory, "ad_driver.outb") +localOutFileWT2 = os.path.join(testBuildDirectory, "ad_driver.T2.outb") +localOutFileCase4 = os.path.join(testBuildDirectory, "ad_driver.4.outb") if os.path.exists(localOutFileWT2) : localOutFile = localOutFileWT2 elif os.path.exists(localOutFileCase4) : diff --git a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py index e78bee7ba7..b563e8f622 100644 --- a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py +++ b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py @@ -107,8 +107,8 @@ ### Build the filesystem navigation variables for running the regression test # testing on file 2. Gives each observer and sweep of frequency ranges -localOutFile = os.path.join(testBuildDirectory, caseName + "_2.out") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + "_2.out") +localOutFile = os.path.join(testBuildDirectory, caseName + "_2.outb") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + "_2.outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executeOpenfastCppRegressionCase.py b/reg_tests/executeOpenfastCppRegressionCase.py index b3a4d2cc39..2f52094f6b 100644 --- a/reg_tests/executeOpenfastCppRegressionCase.py +++ b/reg_tests/executeOpenfastCppRegressionCase.py @@ -123,10 +123,8 @@ sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, "5MW_Land_DLL_WTurb_cpp.out") -baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.out") -if not os.path.exists(baselineOutFile): - baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb") +localOutFile = os.path.join(testBuildDirectory, "5MW_Land_DLL_WTurb_cpp.outb") +baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 91f43062b3..3b0e32572b 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -164,7 +164,7 @@ def indent(msg, sindent='\t'): # # Copying the actual test directory # if not os.path.isdir(testBuildDirectory): -rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, renameExtDict={'.lin':'.ref_lin'}) +rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, renameExtDict={'.lin':'.ref_lin', '.out': '.ref.out', '.outb': '.ref.outb'}) ### Run openfast on the test case if not noExec: diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index d57a8252e2..0d84e76cd7 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -37,7 +37,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] +excludeExt=['.ech','.yaml','.sum','.log'] ##### Main program @@ -120,7 +120,8 @@ shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.out': '.ref.out', '.outb': '.ref.outb'}) ### Run openfast on the test case if not noExec: @@ -143,12 +144,8 @@ sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".out") -if not os.path.exists(localOutFile): - localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") -if not os.path.exists(baselineOutFile): - baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") +localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executePythonRegressionCase.py b/reg_tests/executePythonRegressionCase.py index f6bcddc710..f043a76b8e 100644 --- a/reg_tests/executePythonRegressionCase.py +++ b/reg_tests/executePythonRegressionCase.py @@ -140,10 +140,8 @@ output_channel_names = openfastlib.output_channel_names ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".out") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") -if not os.path.exists(baselineOutFile): - baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") +localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/r-test b/reg_tests/r-test index 6a3303851a..2b5846ca11 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 6a3303851a18a77fc86ff0b7280141a49779ba31 +Subproject commit 2b5846ca1112fb9b3a8dedddc9b8bbc9adc5a7c2 From 2f7b2f81f536be0d3cc1cbcda3a8ed9b085385a3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 28 Aug 2024 20:33:25 +0000 Subject: [PATCH 206/319] Update r-test pointer --- reg_tests/CTestList.cmake | 2 +- reg_tests/r-test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index a69cb5e462..6440661f7d 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -281,7 +281,7 @@ endfunction(py_md_regression) # OpenFAST regression tests of_regression("AWT_YFix_WSt" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("AWT_WSt_StartUp_HighSpShutDown" "openfast;elastodyn;aerodyn15;servodyn") +# of_regression("AWT_WSt_StartUp_HighSpShutDown" "openfast;elastodyn;aerodyn15;servodyn") of_regression("AWT_YFree_WSt" "openfast;elastodyn;aerodyn15;servodyn") of_regression("AWT_YFree_WTurb" "openfast;elastodyn;aerodyn15;servodyn") of_regression("AWT_WSt_StartUpShutDown" "openfast;elastodyn;aerodyn15;servodyn") diff --git a/reg_tests/r-test b/reg_tests/r-test index 2b5846ca11..bdb212ead7 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 2b5846ca1112fb9b3a8dedddc9b8bbc9adc5a7c2 +Subproject commit bdb212ead786f59c76a9c87290a532adbf2c1023 From 467bb85e4460b131aeb058b4e5b7d6ef88b76acf Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 28 Aug 2024 22:18:27 +0000 Subject: [PATCH 207/319] Update r-test pointer --- .../fast-farm/src/FASTWrapper_Types.f90 | 349 +++++++++++++++++- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 25 +- reg_tests/executeFASTFarmRegressionCase.py | 4 +- ...ecuteOpenfastAeroAcousticRegressionCase.py | 4 +- reg_tests/r-test | 2 +- 5 files changed, 367 insertions(+), 17 deletions(-) diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 87b334f83a..1cf2241a0a 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -125,7 +125,22 @@ MODULE FASTWrapper_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AzimAvg_Cq !< Azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE FWrap_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: FWrap_x_dummy = 1 ! FWrap%dummy + integer(IntKi), public, parameter :: FWrap_z_dummy = 2 ! FWrap%dummy + integer(IntKi), public, parameter :: FWrap_u_fromSCglob = 3 ! FWrap%fromSCglob + integer(IntKi), public, parameter :: FWrap_u_fromSC = 4 ! FWrap%fromSC + integer(IntKi), public, parameter :: FWrap_y_toSC = 5 ! FWrap%toSC + integer(IntKi), public, parameter :: FWrap_y_xHat_Disk = 6 ! FWrap%xHat_Disk + integer(IntKi), public, parameter :: FWrap_y_YawErr = 7 ! FWrap%YawErr + integer(IntKi), public, parameter :: FWrap_y_psi_skew = 8 ! FWrap%psi_skew + integer(IntKi), public, parameter :: FWrap_y_chi_skew = 9 ! FWrap%chi_skew + integer(IntKi), public, parameter :: FWrap_y_p_hub = 10 ! FWrap%p_hub + integer(IntKi), public, parameter :: FWrap_y_D_rotor = 11 ! FWrap%D_rotor + integer(IntKi), public, parameter :: FWrap_y_DiskAvg_Vx_Rel = 12 ! FWrap%DiskAvg_Vx_Rel + integer(IntKi), public, parameter :: FWrap_y_AzimAvg_Ct = 13 ! FWrap%AzimAvg_Ct + integer(IntKi), public, parameter :: FWrap_y_AzimAvg_Cq = 14 ! FWrap%AzimAvg_Cq + +contains subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(FWrap_InitInputType), intent(in) :: SrcInitInputData @@ -967,5 +982,337 @@ subroutine FWrap_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%AzimAvg_Ct); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AzimAvg_Cq); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function FWrap_InputMeshPointer(u, DL) result(Mesh) + type(FWrap_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function FWrap_OutputMeshPointer(y, DL) result(Mesh) + type(FWrap_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine FWrap_VarsPackContState(Vars, x, ValAry) + type(FWrap_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FWrap_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_x_dummy) + VarVals(1) = x%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FWrap_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine FWrap_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_x_dummy) + x%dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function FWrap_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FWrap_x_dummy) + Name = "x%dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine FWrap_VarsPackContStateDeriv(Vars, x, ValAry) + type(FWrap_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FWrap_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_x_dummy) + VarVals(1) = x%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsPackConstrState(Vars, z, ValAry) + type(FWrap_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call FWrap_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_z_dummy) + VarVals(1) = z%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call FWrap_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine FWrap_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_z_dummy) + z%dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function FWrap_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FWrap_z_dummy) + Name = "z%dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine FWrap_VarsPackInput(Vars, u, ValAry) + type(FWrap_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call FWrap_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_u_fromSCglob) + VarVals = u%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_u_fromSC) + VarVals = u%fromSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call FWrap_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine FWrap_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_u_fromSCglob) + u%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_u_fromSC) + u%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function FWrap_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FWrap_u_fromSCglob) + Name = "u%fromSCglob" + case (FWrap_u_fromSC) + Name = "u%fromSC" + case default + Name = "Unknown Field" + end select +end function + +subroutine FWrap_VarsPackOutput(Vars, y, ValAry) + type(FWrap_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call FWrap_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_y_toSC) + VarVals = y%toSC(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_y_xHat_Disk) + VarVals = y%xHat_Disk(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_y_YawErr) + VarVals(1) = y%YawErr ! Scalar + case (FWrap_y_psi_skew) + VarVals(1) = y%psi_skew ! Scalar + case (FWrap_y_chi_skew) + VarVals(1) = y%chi_skew ! Scalar + case (FWrap_y_p_hub) + VarVals = y%p_hub(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_y_D_rotor) + VarVals(1) = y%D_rotor ! Scalar + case (FWrap_y_DiskAvg_Vx_Rel) + VarVals(1) = y%DiskAvg_Vx_Rel ! Scalar + case (FWrap_y_AzimAvg_Ct) + VarVals = y%AzimAvg_Ct(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_y_AzimAvg_Cq) + VarVals = y%AzimAvg_Cq(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call FWrap_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine FWrap_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_y_toSC) + y%toSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_y_xHat_Disk) + y%xHat_Disk(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_y_YawErr) + y%YawErr = VarVals(1) ! Scalar + case (FWrap_y_psi_skew) + y%psi_skew = VarVals(1) ! Scalar + case (FWrap_y_chi_skew) + y%chi_skew = VarVals(1) ! Scalar + case (FWrap_y_p_hub) + y%p_hub(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_y_D_rotor) + y%D_rotor = VarVals(1) ! Scalar + case (FWrap_y_DiskAvg_Vx_Rel) + y%DiskAvg_Vx_Rel = VarVals(1) ! Scalar + case (FWrap_y_AzimAvg_Ct) + y%AzimAvg_Ct(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_y_AzimAvg_Cq) + y%AzimAvg_Cq(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function FWrap_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FWrap_y_toSC) + Name = "y%toSC" + case (FWrap_y_xHat_Disk) + Name = "y%xHat_Disk" + case (FWrap_y_YawErr) + Name = "y%YawErr" + case (FWrap_y_psi_skew) + Name = "y%psi_skew" + case (FWrap_y_chi_skew) + Name = "y%chi_skew" + case (FWrap_y_p_hub) + Name = "y%p_hub" + case (FWrap_y_D_rotor) + Name = "y%D_rotor" + case (FWrap_y_DiskAvg_Vx_Rel) + Name = "y%DiskAvg_Vx_Rel" + case (FWrap_y_AzimAvg_Ct) + Name = "y%AzimAvg_Ct" + case (FWrap_y_AzimAvg_Cq) + Name = "y%AzimAvg_Cq" + case default + Name = "Unknown Field" + end select +end function + END MODULE FASTWrapper_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index cafbfa0d2f..1b73b33db9 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -37,16 +37,16 @@ MODULE FAST_Farm_Types USE SuperController_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: NumFFModules = 5 ! The number of modules available in FAST.Farm [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_None = 0 ! No module selected [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_SC = 1 ! Super Controller [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_FWrap = 2 ! FAST Wrapper [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_WD = 3 ! Wake Dynamics [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_AWAE = 4 ! Ambient Wind and Array Effects [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_MD = 5 ! Farm-level MoorDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_None = 0 ! WAT: off [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_PreDef = 1 ! WAT: predefined turbulence boxes [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_UserDef = 2 ! WAT: user defined turbulence boxes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumFFModules = 5 ! The number of modules available in FAST.Farm [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_None = 0 ! No module selected [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_SC = 1 ! Super Controller [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_FWrap = 2 ! FAST Wrapper [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_WD = 3 ! Wake Dynamics [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_AWAE = 4 ! Ambient Wind and Array Effects [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_MD = 5 ! Farm-level MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_None = 0 ! WAT: off [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_PreDef = 1 ! WAT: predefined turbulence boxes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_UserDef = 2 ! WAT: user defined turbulence boxes [-] ! ========= Farm_ParameterType ======= TYPE, PUBLIC :: Farm_ParameterType REAL(DbKi) :: DT_low = 0.0_R8Ki !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] @@ -212,7 +212,8 @@ MODULE FAST_Farm_Types TYPE(WAT_IfW_data) :: WAT_IfW !< IfW data for WAT (temporary location until pointers are enabled) [-] END TYPE All_FastFarm_Data ! ======================= -CONTAINS + +contains subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(Farm_ParameterType), intent(in) :: SrcParamData @@ -1645,5 +1646,7 @@ subroutine Farm_UnPackAll_FastFarm_Data(RF, OutData) call Farm_UnpackMD_Data(RF, OutData%MD) ! MD call Farm_UnpackWAT_IfW_data(RF, OutData%WAT_IfW) ! WAT_IfW end subroutine + END MODULE FAST_Farm_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/reg_tests/executeFASTFarmRegressionCase.py b/reg_tests/executeFASTFarmRegressionCase.py index c218b76ef0..79fa3e4528 100644 --- a/reg_tests/executeFASTFarmRegressionCase.py +++ b/reg_tests/executeFASTFarmRegressionCase.py @@ -129,8 +129,8 @@ sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".out") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") +localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py index b563e8f622..e78bee7ba7 100644 --- a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py +++ b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py @@ -107,8 +107,8 @@ ### Build the filesystem navigation variables for running the regression test # testing on file 2. Gives each observer and sweep of frequency ranges -localOutFile = os.path.join(testBuildDirectory, caseName + "_2.outb") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + "_2.outb") +localOutFile = os.path.join(testBuildDirectory, caseName + "_2.out") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + "_2.out") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/r-test b/reg_tests/r-test index bdb212ead7..3cacfb2d6f 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit bdb212ead786f59c76a9c87290a532adbf2c1023 +Subproject commit 3cacfb2d6fc47ec6bb87f371ae1a08fbfde345c0 From 4040fba9cb938cf02d0bbb4bc8292cfe76d92ca4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 28 Aug 2024 22:50:43 +0000 Subject: [PATCH 208/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 3cacfb2d6f..63c1135f0e 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 3cacfb2d6fc47ec6bb87f371ae1a08fbfde345c0 +Subproject commit 63c1135f0ea95430ba4f84a9b0a415b54d04a72e From 435d084949c40bbb0a730efb93e1eeccbaa504df Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 28 Aug 2024 23:05:10 +0000 Subject: [PATCH 209/319] Add checks in linearization for when dUdu and dUdy aren't allocated --- modules/openfast-library/src/FAST_Mapping.f90 | 3 +++ modules/openfast-library/src/FAST_ModGlue.f90 | 10 ++++++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 3d089ceebf..ec2ddd434c 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -2049,6 +2049,9 @@ subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' + ! Exit function if dUdy and dUdu aren't allocated + if (.not. (allocated(ModGlue%Lin%dUdy) .and. allocated(ModGlue%Lin%dUdu))) return + ! Initialize dUdy to zero ModGlue%Lin%dUdy = 0.0_R8Ki diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 959b3d2615..df49c688e0 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -932,10 +932,10 @@ subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbi iy = 1 ! Initialize data in Jacobian matrices to zero - m%ModGlue%Lin%dYdu = 0.0_R8Ki - m%ModGlue%Lin%dXdu = 0.0_R8Ki - m%ModGlue%Lin%dYdx = 0.0_R8Ki - m%ModGlue%Lin%dXdx = 0.0_R8Ki + if (allocated(m%ModGlue%Lin%dYdu)) m%ModGlue%Lin%dYdu = 0.0_R8Ki + if (allocated(m%ModGlue%Lin%dXdu)) m%ModGlue%Lin%dXdu = 0.0_R8Ki + if (allocated(m%ModGlue%Lin%dYdx)) m%ModGlue%Lin%dYdx = 0.0_R8Ki + if (allocated(m%ModGlue%Lin%dXdx)) m%ModGlue%Lin%dXdx = 0.0_R8Ki ! Loop through linearization modules by index do i = 1, size(m%ModGlue%ModData) @@ -1118,6 +1118,8 @@ subroutine CalcGlueStateMatrices(Vars, Lin, JacScaleFactor, ErrStat, ErrMsg) real(R8Ki), allocatable :: G(:, :), tmp(:, :) integer(IntKi), allocatable :: ipiv(:) + if (.not. allocated(Lin%dUdu)) return + ! A = dXdx ! B = dXdu ! C = dYdx From 25a5dcd96a0aee79d78974e1723dfb532c026134 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 11:44:58 +0000 Subject: [PATCH 210/319] Update r-test pointer --- modules/openfast-library/src/FAST_Subs.f90 | 3 +++ reg_tests/executeFASTFarmRegressionCase.py | 9 +++++---- reg_tests/r-test | 2 +- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index aa6c3cae05..54c7dcd4cb 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -4921,6 +4921,9 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 REAL(R8Ki) :: t_global_next + ErrStat = ErrID_None + ErrMsg = '' + ! Calculate next global time n_t_global_next = n_t_global + 1 t_global_next = t_initial + n_t_global_next*Turbine%p_FAST%DT diff --git a/reg_tests/executeFASTFarmRegressionCase.py b/reg_tests/executeFASTFarmRegressionCase.py index 79fa3e4528..e35562f174 100644 --- a/reg_tests/executeFASTFarmRegressionCase.py +++ b/reg_tests/executeFASTFarmRegressionCase.py @@ -36,7 +36,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] +excludeExt=['.ech','.yaml','.sum','.log'] ##### Main program @@ -117,7 +117,8 @@ # create the local output directory if it does not already exist if not os.path.isdir(testBuildDirectory): - rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.out':'.ref.out', '.outb':'.ref.outb'}) caseName='FAST.Farm' # for ease of comparison @@ -129,8 +130,8 @@ sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") +localOutFile = os.path.join(testBuildDirectory, caseName + ".out") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/r-test b/reg_tests/r-test index 63c1135f0e..bfd358189f 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 63c1135f0ea95430ba4f84a9b0a415b54d04a72e +Subproject commit bfd358189fac3a6e1869e7fb4265a3ad5fbc4903 From 4c139fd128a7bfb5092a09b392017a955731c569 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 14:04:12 +0000 Subject: [PATCH 211/319] Rework initialization again --- modules/openfast-library/CMakeLists.txt | 5 - .../openfast-library/src/FAST_SolverTC.f90 | 307 +++++++++--------- ...ecuteOpenfastAeroAcousticRegressionCase.py | 5 +- reg_tests/r-test | 2 +- 4 files changed, 151 insertions(+), 168 deletions(-) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 00db259108..849216a353 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -66,13 +66,8 @@ target_link_libraries(openfast_prelib ) add_library(openfast_postlib STATIC - # src/FAST_Lin.f90 src/FAST_Mods.f90 src/FAST_Subs.f90 - # src/FAST_Solver.f90 - # src/FAST_SS_Subs.f90 - # src/FAST_SS_Solver.f90 - src/FAST_Funcs.f90 src/FAST_ModGlue.f90 src/FAST_Mapping.f90 diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index bba321a681..6e2822fa64 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -728,214 +728,201 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er TotalIter = 0 - ! Do two input correction iterations - do CorrIter = 1, 2 + ! Set converged flag to false + IsConverged = .false. - ! Set converged flag to false - IsConverged = .false. + !---------------------------------------------------------------------------- + ! Input solve and calc output for ServoDyn inputs + !---------------------------------------------------------------------------- - ! Copy TC solver states from current to predicted - call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_NEWCOPY, ErrStat2, ErrMsg2) - if (Failed()) return + do i = 1, size(p%iModUY1) + associate (ModData => GlueModData(p%iModUY1(i))) - ! Loop through tight coupling modules - do i = 1, size(p%iModTC) - associate (ModData => m%Mod%ModData(i)) + ! Solve for inputs + call FAST_InputSolve(p%iModUY1(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return - ! Transfer current states to linearization array - call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) + ! Calculate outputs + call FAST_CalcOutput(ModData, GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return - ! Transfer solver states to module - call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) - if (Failed()) return + end associate + end do - ! Transfer accelerations to BeamDyn - if (ModData%ID == Module_BD) then - call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) - end if - end associate - end do + !---------------------------------------------------------------------------- + ! InputSolve and CalcOutput for Option 2 modules + !---------------------------------------------------------------------------- - !------------------------------------------------------------------------- - ! InputSolve and CalcOutput for all modules, pack TC and Option 1 inputs - !------------------------------------------------------------------------- + ! Do input solve and calculate outputs for Option 2 modules (includes TC modules) + do i = 1, size(p%iModOpt2) - ! Do input solve and calculate outputs for Option 2 modules (except ServoDyn) - do i = 2, size(p%iModOpt2) - associate (ModData => GlueModData(p%iModOpt2(i))) + ! Solve for inputs + call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return - ! Solve for inputs - call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return + ! Calculate outputs + call FAST_CalcOutput(GlueModData(p%iModOpt2(i)), GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return - ! Calculate outputs - call FAST_CalcOutput(ModData, GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return + end do - end associate - end do + !---------------------------------------------------------------------------- + ! InputSolve and pack inputs for TC and Option 1 modules + !---------------------------------------------------------------------------- - ! Do input solve for Option 1 modules - do i = 1, size(p%iModOpt1) - call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + ! Do input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Pack TC and Option 1 inputs into u array + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) if (Failed()) return - end do + end associate + end do + + !---------------------------------------------------------------------------- + ! Convergence Iterations for TC and Option 1 modules + !---------------------------------------------------------------------------- + + ! Loop through convergence iterations + do ConvIter = 0, p%MaxConvIter + + ! Increment total number of convergence iterations in step + TotalIter = TotalIter + 1 + + !---------------------------------------------------------------------- + ! Calculate outputs for TC & Opt1 modules + !---------------------------------------------------------------------- - ! Pack TC and Option 1 inputs into u array do i = 1, size(m%Mod%ModData) associate (ModData => m%Mod%ModData(i)) - call FAST_GetOP(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + call FAST_CalcOutput(ModData, GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, & + Turbine, ErrStat2, ErrMsg2) if (Failed()) return end associate end do - !------------------------------------------------------------------------- - ! Convergence Iterations for TC and Option 1 modules - !------------------------------------------------------------------------- - - ! Loop through convergence iterations - do ConvIter = 0, p%MaxConvIter - - ! Increment total number of convergence iterations in step - TotalIter = TotalIter + 1 - - !---------------------------------------------------------------------- - ! Calculate outputs for TC & Opt1 modules - !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + ! Convergence iteration check + !---------------------------------------------------------------------- - do i = 1, size(m%Mod%ModData) - associate (ModData => m%Mod%ModData(i)) - call FAST_CalcOutput(ModData, GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, & - Turbine, ErrStat2, ErrMsg2) - if (Failed()) return - end associate - end do + ! If convergence iteration has reached or exceeded limit, exit loop + if (ConvIter >= p%MaxConvIter) exit - !---------------------------------------------------------------------- - ! Convergence iteration check - !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + ! Update Jacobian + !---------------------------------------------------------------------- - ! If convergence iteration has reached or exceeded limit, exit loop - if (ConvIter >= p%MaxConvIter) exit + call BuildJacobianTC(p, m, GlueModMaps, t_initial, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return - !---------------------------------------------------------------------- - ! Update Jacobian - !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + ! Formulate right hand side (X_2^tight, U^tight, U^Option1) + !---------------------------------------------------------------------- - call BuildJacobianTC(p, m, GlueModMaps, t_initial, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + ! Input solve for tight coupling modules + do i = 1, size(p%iModTC) + call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) if (Failed()) return + end do - !---------------------------------------------------------------------- - ! Formulate right hand side (X_2^tight, U^tight, U^Option1) - !---------------------------------------------------------------------- - - ! Input solve for tight coupling modules - do i = 1, size(p%iModTC) - call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return - end do - - ! Input solve for Option 1 modules - do i = 1, size(p%iModOpt1) - call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return - end do - - ! Collect TC and Option 1 inputs into uCalc - do i = 1, size(m%Mod%ModData) - call FAST_GetOP(m%Mod%ModData(i), t_initial, INPUT_TEMP, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%uCalc) - if (Failed()) return - end do + ! Input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do - !---------------------------------------------------------------------- - ! Populate residual vector and apply conditioning to loads - !---------------------------------------------------------------------- + ! Collect TC and Option 1 inputs into uCalc + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_initial, INPUT_TEMP, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%uCalc) + if (Failed()) return + end do - ! Calculate difference between calculated and predicted accelerations - ! if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%StatePred%vd - if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = 0.0_R8Ki + !---------------------------------------------------------------------- + ! Populate residual vector and apply conditioning to loads + !---------------------------------------------------------------------- - ! Calculate difference in U for all Option 1 modules (un - u_tmp) - ! and add to RHS for TC and Option 1 modules - if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB(p%iJU(1):p%iJU(2), 1)) + ! Calculate difference between calculated and predicted accelerations + ! Step0 is assuming this is zero since it's not advancing in time + ! Changes in acceleration will be due only to input changes + if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = 0.0_R8Ki - ! Apply conditioning factor to loads in RHS - if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)/p%Scale_UJac + ! Calculate difference in U for all Option 1 modules (un - u_tmp) + ! and add to RHS for TC and Option 1 modules + if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB(p%iJU(1):p%iJU(2), 1)) - !---------------------------------------------------------------------- - ! Solve for state and input perturbations - !---------------------------------------------------------------------- + ! Apply conditioning factor to loads in RHS + if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)/p%Scale_UJac - ! Solve Jacobian and RHS - call LAPACK_getrs('N', p%NumJ, m%Mod%Lin%J, m%IPIV, m%XB, ErrStat2, ErrMsg2) - if (Failed()) return + !---------------------------------------------------------------------- + ! Solve for state and input perturbations + !---------------------------------------------------------------------- - !---------------------------------------------------------------------- - ! Check perturbations for convergence and exit if below tolerance - !---------------------------------------------------------------------- + ! Solve Jacobian and RHS + call LAPACK_getrs('N', p%NumJ, m%Mod%Lin%J, m%IPIV, m%XB, ErrStat2, ErrMsg2) + if (Failed()) return - ! Calculate average L2 norm of change in states and inputs - ConvError = TwoNorm(m%XB(:, 1))/size(m%XB) + !---------------------------------------------------------------------- + ! Check perturbations for convergence and exit if below tolerance + !---------------------------------------------------------------------- - ! If at least one convergence iteration has been done and the RHS norm - ! is less than convergence tolerance, set flag and exit convergence loop - if (ConvError < p%ConvTol) then - IsConverged = .true. - exit - end if + ! Calculate average L2 norm of change in states and inputs + ConvError = TwoNorm(m%XB(:, 1))/size(m%XB) - ! Remove load conditioning on inputs - if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)*p%Scale_UJac + ! If at least one convergence iteration has been done and the RHS norm + ! is less than convergence tolerance, set flag and exit convergence loop + if (ConvError < p%ConvTol) then + IsConverged = .true. + exit + end if - !---------------------------------------------------------------------- - ! Update acceleration and inputs - !---------------------------------------------------------------------- + ! Remove load conditioning on inputs + if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)*p%Scale_UJac - ! Update State acceleration prediction (do not change other states) - ! if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%StatePred) - if (p%iJX(1) > 0) m%StatePred%vd = m%StatePred%vd + m%XB(p%iJX(1):p%iJX(2), 1) + !---------------------------------------------------------------------- + ! Update acceleration and inputs + !---------------------------------------------------------------------- - ! Add change in inputs - if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) + ! Update State acceleration prediction (do not change other states) + ! if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%StatePred) + if (p%iJX(1) > 0) m%StatePred%vd = m%StatePred%vd + m%XB(p%iJX(1):p%iJX(2), 1) - ! Transfer updated inputs to modules - do i = 1, size(m%Mod%ModData) - associate (ModData => m%Mod%ModData(i)) + ! Add change in inputs + if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) - ! Transfer States to linearization array - call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) + ! Transfer updated inputs to modules + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) - ! Transfer states and inputs to modules - call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x, & - u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) - if (Failed()) return + ! Transfer States to linearization array + call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) - ! Transfer accelerations to BeamDyn - if (ModData%ID == Module_BD) then - call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) - end if + ! Transfer states and inputs to modules + call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return - end associate - end do - end do ! Convergence loop + ! Transfer accelerations to BeamDyn + if (ModData%ID == Module_BD) then + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + end if - ! Perform input solve for modules post Option 1 convergence - do i = 1, size(p%iModPost) - call FAST_InputSolve(p%iModPost(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return + end associate end do + end do ! Convergence loop - ! Calculate output for ServoDyn - if (CorrIter == 1) then - call FAST_CalcOutput(GlueModData(p%iModOpt2(1)), GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return - end if - - end do ! Input correction loop + ! Perform input solve for modules post Option 1 convergence + do i = 1, size(p%iModPost) + call FAST_InputSolve(p%iModPost(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do ! Print warning if not converged if (.not. IsConverged) then diff --git a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py index e78bee7ba7..ecdae78844 100644 --- a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py +++ b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py @@ -37,7 +37,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] +excludeExt=['.ech','.yaml','.sum','.log'] ##### Main program @@ -96,7 +96,8 @@ # create the local output directory if it does not already exist # and initialize it with input files for all test cases if not os.path.isdir(testBuildDirectory): - rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.out':'.ref.out', '.outb':'.ref.outb'}) ### Run openfast on the test case if not noExec: diff --git a/reg_tests/r-test b/reg_tests/r-test index bfd358189f..fd6dc39dd5 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit bfd358189fac3a6e1869e7fb4265a3ad5fbc4903 +Subproject commit fd6dc39dd56b5e677c802b7782a42d536861eb26 From 1cf4f63416113cda1f62ddb179e33b99be8da174 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 15:35:48 +0000 Subject: [PATCH 212/319] Rework initialization, attempt 3 --- .../openfast-library/src/FAST_SolverTC.f90 | 166 ++++++++++-------- .../openfast-library/src/Glue_Registry.txt | 1 - modules/openfast-library/src/Glue_Types.f90 | 18 -- 3 files changed, 89 insertions(+), 96 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 6e2822fa64..1d634d7333 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -103,25 +103,8 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS pack(modInds, ModIDs == Module_BD), & pack(modInds, ModIDs == Module_SD), & pack(modInds, ModIDs == Module_IfW), & - pack(modInds, ModIDs == Module_SeaSt), & - pack(modInds, ModIDs == Module_AD), & - pack(modInds, ModIDs == Module_FEAM), & - pack(modInds, ModIDs == Module_IceD), & - pack(modInds, ModIDs == Module_IceF), & - pack(modInds, ModIDs == Module_MAP), & - pack(modInds, ModIDs == Module_MD), & - pack(modInds, ModIDs == Module_ExtPtfm), & - pack(modInds, ModIDs == Module_HD), & - pack(modInds, ModIDs == Module_Orca), & - pack(modInds, ModIDs == Module_SrvD)] ! ServoDyn is last - - ! Indices of modules needed for ServoDyn initialization - p%iModUY1 = [pack(modInds, ModIDs == Module_ED), & - pack(modInds, ModIDs == Module_BD), & - pack(modInds, ModIDs == Module_SD), & - pack(modInds, ModIDs == Module_IfW), & - pack(modInds, ModIDs == Module_ExtInfw), & - pack(modInds, ModIDs == Module_ExtLd)] + pack(modInds, ModIDs == Module_ExtInfw), & + pack(modInds, ModIDs == Module_ExtLd)] ! Indices of tight coupling modules p%iModTC = [pack(modInds, ModIDs == Module_ED), & @@ -669,6 +652,7 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er logical :: IsConverged integer(IntKi) :: ConvIter, CorrIter, TotalIter real(R8Ki) :: ConvError + real(R8Ki), allocatable :: Jac(:, :), XB(:, :) ErrStat = ErrID_None ErrMsg = '' @@ -680,6 +664,10 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er t_initial = Turbine%m_FAST%t_global t_global_next = t_initial + n_t_global_next*p%h + ! Initialize Jacobian update counters to zero to calculate on first iteration + m%UJacIterRemain = 0 + m%UJacStepsRemain = 0 + !---------------------------------------------------------------------------- ! Collect initial states from modules !---------------------------------------------------------------------------- @@ -717,11 +705,6 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er if (Failed()) return end do - !---------------------------------------------------------------------------- - ! Perform iterations to initialize inputs and acceleration - ! States are not modified - !---------------------------------------------------------------------------- - ! Copy TC solver states from current to predicted call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_NEWCOPY, ErrStat2, ErrMsg2) if (Failed()) return @@ -731,15 +714,21 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er ! Set converged flag to false IsConverged = .false. + ! Allocate input-output solve Jacobian matrix and RHS vector + call AllocAry(Jac, m%Mod%Vars%Nu, m%Mod%Vars%Nu, 'Jac', ErrStat2, ErrMsg2) + if (Failed()) return + call AllocAry(XB, m%Mod%Vars%Nu, 1, 'XB', ErrStat2, ErrMsg2) + if (Failed()) return + !---------------------------------------------------------------------------- ! Input solve and calc output for ServoDyn inputs !---------------------------------------------------------------------------- - do i = 1, size(p%iModUY1) - associate (ModData => GlueModData(p%iModUY1(i))) + do i = 1, size(p%iModInit) + associate (ModData => GlueModData(p%iModInit(i))) ! Solve for inputs - call FAST_InputSolve(p%iModUY1(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + call FAST_InputSolve(p%iModInit(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) if (Failed()) return ! Calculate outputs @@ -818,12 +807,58 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er ! Update Jacobian !---------------------------------------------------------------------- - call BuildJacobianTC(p, m, GlueModMaps, t_initial, STATE_CURR, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return + if (ConvIter == 0) then - !---------------------------------------------------------------------- - ! Formulate right hand side (X_2^tight, U^tight, U^Option1) - !---------------------------------------------------------------------- + !---------------------------------------------------------------------- + ! Calculate Input-Output Solve Jacobian for TC and Option 1 modules + !---------------------------------------------------------------------- + + if (allocated(m%Mod%Lin%dYdu)) m%Mod%Lin%dYdu = 0.0_R8Ki + if (allocated(m%Mod%Lin%dUdy)) m%Mod%Lin%dUdy = 0.0_R8Ki + if (allocated(m%Mod%Lin%dUdu)) then + call Eye2D(m%Mod%Lin%dUdu, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Loop through TC and Option 1 modules and calculate dYdu + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_JacobianPInput(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) + if (Failed()) return + end associate + end do + + ! Calculate dUdu and dUdy for TC and Option 1 modules + if (allocated(m%Mod%Lin%dUdy) .and. allocated(m%Mod%Lin%dUdu)) then + call FAST_LinearizeMappings(m%Mod, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------- + ! Assemble Jacobian + !---------------------------------------------------------------------- + + ! Jac = m%Mod%Lin%dUdu + matmul(m%Mod%Lin%dUdy, m%Mod%Lin%dYdu) + if (m%Mod%Vars%Nu > 0) then + Jac = m%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, Jac, ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Condition jacobian matrix before factoring + if (p%iUL(1) > 0) then + Jac(p%iUL(1):p%iUL(2), :) = Jac(p%iUL(1):p%iUL(2), :)/p%Scale_UJac + Jac(:, p%iUL(1):p%iUL(2)) = Jac(:, p%iUL(1):p%iUL(2))*p%Scale_UJac + end if + + ! Factor jacobian matrix + call LAPACK_getrf(size(Jac, 1), size(Jac, 2), Jac, m%IPIV, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !------------------------------------------------------------------------- + ! Formulate right hand side (U^tight, U^Option1) + !------------------------------------------------------------------------- ! Input solve for tight coupling modules do i = 1, size(p%iModTC) @@ -844,36 +879,31 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er if (Failed()) return end do - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- ! Populate residual vector and apply conditioning to loads - !---------------------------------------------------------------------- - - ! Calculate difference between calculated and predicted accelerations - ! Step0 is assuming this is zero since it's not advancing in time - ! Changes in acceleration will be due only to input changes - if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = 0.0_R8Ki + !------------------------------------------------------------------------- ! Calculate difference in U for all Option 1 modules (un - u_tmp) ! and add to RHS for TC and Option 1 modules - if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB(p%iJU(1):p%iJU(2), 1)) + if (m%Mod%Vars%Nu > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, XB(:, 1)) ! Apply conditioning factor to loads in RHS - if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)/p%Scale_UJac + if (p%iUL(1) > 0) XB(p%iUL(1):p%iUL(2), 1) = XB(p%iUL(1):p%iUL(2), 1)/p%Scale_UJac - !---------------------------------------------------------------------- - ! Solve for state and input perturbations - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! Solve for input perturbations + !------------------------------------------------------------------------- ! Solve Jacobian and RHS - call LAPACK_getrs('N', p%NumJ, m%Mod%Lin%J, m%IPIV, m%XB, ErrStat2, ErrMsg2) + call LAPACK_getrs('N', size(Jac, 1), Jac, m%IPIV, XB, ErrStat2, ErrMsg2) if (Failed()) return - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- ! Check perturbations for convergence and exit if below tolerance - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- ! Calculate average L2 norm of change in states and inputs - ConvError = TwoNorm(m%XB(:, 1))/size(m%XB) + ConvError = TwoNorm(XB(:, 1))/size(XB) ! If at least one convergence iteration has been done and the RHS norm ! is less than convergence tolerance, set flag and exit convergence loop @@ -883,38 +913,20 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er end if ! Remove load conditioning on inputs - if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)*p%Scale_UJac + if (p%iUL(1) > 0) XB(p%iUL(1):p%iUL(2), 1) = XB(p%iUL(1):p%iUL(2), 1)*p%Scale_UJac - !---------------------------------------------------------------------- - ! Update acceleration and inputs - !---------------------------------------------------------------------- - - ! Update State acceleration prediction (do not change other states) - ! if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%StatePred) - if (p%iJX(1) > 0) m%StatePred%vd = m%StatePred%vd + m%XB(p%iJX(1):p%iJX(2), 1) + !------------------------------------------------------------------------- + ! Update inputs + !------------------------------------------------------------------------- ! Add change in inputs - if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) + if (m%Mod%Vars%Nu > 0) call MV_AddDelta(m%Mod%Vars%u, XB(:, 1), m%Mod%Lin%u) ! Transfer updated inputs to modules do i = 1, size(m%Mod%ModData) - associate (ModData => m%Mod%ModData(i)) - - ! Transfer States to linearization array - call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) - - ! Transfer states and inputs to modules - call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & - x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x, & - u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) - if (Failed()) return - - ! Transfer accelerations to BeamDyn - if (ModData%ID == Module_BD) then - call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) - end if - - end associate + call FAST_SetOP(m%Mod%ModData(i), INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return end do end do ! Convergence loop @@ -1369,11 +1381,11 @@ subroutine CalcOutputs_And_SolveForInputs(p, m, GlueModData, GlueModMaps, ThisTi if (DoInit) then ! Input solve and calc output for ServoDyn inputs - do i = 1, size(p%iModUY1) - associate (ModData => GlueModData(p%iModUY1(i))) + do i = 1, size(p%iModInit) + associate (ModData => GlueModData(p%iModInit(i))) ! Solve for inputs - call FAST_InputSolve(p%iModUY1(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) + call FAST_InputSolve(p%iModInit(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) if (Failed()) return ! Calculate outputs diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index 58626a39e6..c750b12a90 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -96,7 +96,6 @@ typedef ^ ^ IntKi iJU 2 - - typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - typedef ^ ^ IntKi iJL 2 - - "Indices of Jacobian load variables" - typedef ^ ^ IntKi iModInit : - - "ModData index order for step 0 initialization" - -typedef ^ ^ IntKi iModUY1 : - - "ModData index order for step 0 initialization" - typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 835f623751..3439ebf4cd 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -123,7 +123,6 @@ MODULE Glue_Types INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] INTEGER(IntKi) , DIMENSION(1:2) :: iJL = 0_IntKi !< Indices of Jacobian load variables [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModInit !< ModData index order for step 0 initialization [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModUY1 !< ModData index order for step 0 initialization [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] @@ -758,18 +757,6 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E end if DstTCParamData%iModInit = SrcTCParamData%iModInit end if - if (allocated(SrcTCParamData%iModUY1)) then - LB(1:1) = lbound(SrcTCParamData%iModUY1, kind=B8Ki) - UB(1:1) = ubound(SrcTCParamData%iModUY1, kind=B8Ki) - if (.not. allocated(DstTCParamData%iModUY1)) then - allocate(DstTCParamData%iModUY1(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModUY1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTCParamData%iModUY1 = SrcTCParamData%iModUY1 - end if if (allocated(SrcTCParamData%iModTC)) then LB(1:1) = lbound(SrcTCParamData%iModTC, kind=B8Ki) UB(1:1) = ubound(SrcTCParamData%iModTC, kind=B8Ki) @@ -830,9 +817,6 @@ subroutine Glue_DestroyTCParam(TCParamData, ErrStat, ErrMsg) if (allocated(TCParamData%iModInit)) then deallocate(TCParamData%iModInit) end if - if (allocated(TCParamData%iModUY1)) then - deallocate(TCParamData%iModUY1) - end if if (allocated(TCParamData%iModTC)) then deallocate(TCParamData%iModTC) end if @@ -880,7 +864,6 @@ subroutine Glue_PackTCParam(RF, Indata) call RegPack(RF, InData%iJUT) call RegPack(RF, InData%iJL) call RegPackAlloc(RF, InData%iModInit) - call RegPackAlloc(RF, InData%iModUY1) call RegPackAlloc(RF, InData%iModTC) call RegPackAlloc(RF, InData%iModOpt1) call RegPackAlloc(RF, InData%iModOpt2) @@ -924,7 +907,6 @@ subroutine Glue_UnPackTCParam(RF, OutData) call RegUnpack(RF, OutData%iJUT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iJL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModInit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iModUY1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModTC); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModOpt1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%iModOpt2); if (RegCheckErr(RF, RoutineName)) return From 4013962fe980bee35ef23927225a6cda946d4dad Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 15:35:59 +0000 Subject: [PATCH 213/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index fd6dc39dd5..f6e9c3ebe7 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit fd6dc39dd56b5e677c802b7782a42d536861eb26 +Subproject commit f6e9c3ebe76790f51b0206ee2ff32cf3c91a362d From 45be70a5c5cda827acb445bc78a5fcb11f8c9dee Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 16:27:42 +0000 Subject: [PATCH 214/319] Skip Solver_Step0 convergence if no inputs --- .../openfast-library/src/FAST_SolverTC.f90 | 51 +++++++++---------- 1 file changed, 25 insertions(+), 26 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 1d634d7333..b7f729111c 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -784,9 +784,9 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er ! Increment total number of convergence iterations in step TotalIter = TotalIter + 1 - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- ! Calculate outputs for TC & Opt1 modules - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- do i = 1, size(m%Mod%ModData) associate (ModData => m%Mod%ModData(i)) @@ -796,29 +796,31 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er end associate end do - !---------------------------------------------------------------------- - ! Convergence iteration check - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! Convergence iteration and input check + !------------------------------------------------------------------------- - ! If convergence iteration has reached or exceeded limit, exit loop - if (ConvIter >= p%MaxConvIter) exit + ! If convergence iteration limit has been reached or there are no inputs + ! involved in module mappings, exit loop + if ((ConvIter >= p%MaxConvIter) .or. (m%Mod%Vars%Nu == 0)) exit - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- ! Update Jacobian - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! Only calculate the Jacobian on the first convergence iteration, as + ! it should remain the same through subsequent iterations if (ConvIter == 0) then !---------------------------------------------------------------------- ! Calculate Input-Output Solve Jacobian for TC and Option 1 modules !---------------------------------------------------------------------- - if (allocated(m%Mod%Lin%dYdu)) m%Mod%Lin%dYdu = 0.0_R8Ki - if (allocated(m%Mod%Lin%dUdy)) m%Mod%Lin%dUdy = 0.0_R8Ki - if (allocated(m%Mod%Lin%dUdu)) then - call Eye2D(m%Mod%Lin%dUdu, ErrStat2, ErrMsg2) - if (Failed()) return - end if + m%Mod%Lin%dYdu = 0.0_R8Ki + m%Mod%Lin%dUdy = 0.0_R8Ki + + call Eye2D(m%Mod%Lin%dUdu, ErrStat2, ErrMsg2) + if (Failed()) return ! Loop through TC and Option 1 modules and calculate dYdu do i = 1, size(m%Mod%ModData) @@ -830,22 +832,19 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er end do ! Calculate dUdu and dUdy for TC and Option 1 modules - if (allocated(m%Mod%Lin%dUdy) .and. allocated(m%Mod%Lin%dUdu)) then - call FAST_LinearizeMappings(m%Mod, GlueModMaps, Turbine, ErrStat2, ErrMsg2) - if (Failed()) return - end if + call FAST_LinearizeMappings(m%Mod, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return !---------------------------------------------------------------------- ! Assemble Jacobian !---------------------------------------------------------------------- ! Jac = m%Mod%Lin%dUdu + matmul(m%Mod%Lin%dUdy, m%Mod%Lin%dYdu) - if (m%Mod%Vars%Nu > 0) then - Jac = m%Mod%Lin%dUdu - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, Jac, ErrStat2, ErrMsg2); if (Failed()) return - end if + Jac = m%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, Jac, ErrStat2, ErrMsg2) + if (Failed()) return - ! Condition jacobian matrix before factoring + ! Condition Jacobian matrix loads before factoring if (p%iUL(1) > 0) then Jac(p%iUL(1):p%iUL(2), :) = Jac(p%iUL(1):p%iUL(2), :)/p%Scale_UJac Jac(:, p%iUL(1):p%iUL(2)) = Jac(:, p%iUL(1):p%iUL(2))*p%Scale_UJac @@ -885,7 +884,7 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er ! Calculate difference in U for all Option 1 modules (un - u_tmp) ! and add to RHS for TC and Option 1 modules - if (m%Mod%Vars%Nu > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, XB(:, 1)) + call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, XB(:, 1)) ! Apply conditioning factor to loads in RHS if (p%iUL(1) > 0) XB(p%iUL(1):p%iUL(2), 1) = XB(p%iUL(1):p%iUL(2), 1)/p%Scale_UJac @@ -920,7 +919,7 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er !------------------------------------------------------------------------- ! Add change in inputs - if (m%Mod%Vars%Nu > 0) call MV_AddDelta(m%Mod%Vars%u, XB(:, 1), m%Mod%Lin%u) + call MV_AddDelta(m%Mod%Vars%u, XB(:, 1), m%Mod%Lin%u) ! Transfer updated inputs to modules do i = 1, size(m%Mod%ModData) From ff50e9755a7d49f554a8108b82c3fd6ab6511826 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 17:19:16 +0000 Subject: [PATCH 215/319] Update r-test pointer --- .gitmodules | 1 + reg_tests/r-test | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 487be29ab5..502318aa31 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,4 @@ [submodule "reg_tests/r-test"] path = reg_tests/r-test url = https://github.com/OpenFAST/r-test-5.git + shallow = true diff --git a/reg_tests/r-test b/reg_tests/r-test index f6e9c3ebe7..41cffd4358 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit f6e9c3ebe76790f51b0206ee2ff32cf3c91a362d +Subproject commit 41cffd435811263da055b401a2daeeb1619a2a4d From ef0e27712eaba44d2068e8ea931b048bb8460748 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 18:42:56 +0000 Subject: [PATCH 216/319] Move NacelleDrag and BuoyantLoads calc into RotCalcOutput to be included in linearization --- modules/aerodyn/src/AeroDyn.f90 | 52 +++++++++++++++------------------ 1 file changed, 23 insertions(+), 29 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index e87a0c877d..f2e47a76b5 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -2004,31 +2004,9 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, endif ! Cavitation check - call AD_CavtCrit(u, p, m, errStat2, errMsg2) + call RotCavtCrit(u, p, m, errStat2, errMsg2) if(Failed()) return - ! initialize nacelle mesh loads - do iR = 1,size(p%rotors) - y%rotors(iR)%NacelleLoad%Force = 0.0_ReKi - y%rotors(iR)%NacelleLoad%Moment = 0.0_ReKi - end do - - ! Calculate buoyant loads - do iR = 1,size(p%rotors) - if ( p%rotors(iR)%Buoyancy ) then - call CalcBuoyantLoads( u%rotors(iR), p%rotors(iR), m%rotors(iR), y%rotors(iR), ErrStat, ErrMsg ) - if(Failed()) return - end if - end do - - ! Calculate nacelle drag loads - do iR = 1,size(p%rotors) - if ( p%rotors(iR)%NacelleDrag ) then - call computeNacelleDrag( u%rotors(iR), p%rotors(iR), m%rotors(iR), y%rotors(iR), m%Inflow(1)%RotInflow(iR), ErrStat, ErrMsg ) - if(Failed()) return - end if - end do - !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- @@ -2116,6 +2094,22 @@ subroutine RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif + ! initialize nacelle mesh loads + y%NacelleLoad%Force = 0.0_ReKi + y%NacelleLoad%Moment = 0.0_ReKi + + ! Calculate buoyant loads + if (p%Buoyancy) then + call RotCalcBuoyantLoads(u, p, m, y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + ! Calculate nacelle drag loads + if (p%NacelleDrag) then + call RotCalcNacelleDrag(u, p, m, y, RotInflow, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + ! --- Tail Fin if (p%TFinAero) then call TFin_CalcOutput(p, p_AD, u, RotInflow, m, y, ErrStat2, ErrMsg2) @@ -2204,7 +2198,7 @@ subroutine RotWriteOutputs( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m end subroutine RotWriteOutputs !---------------------------------------------------------------------------------------------------------------------------------- -subroutine AD_CavtCrit(u, p, m, errStat, errMsg) +subroutine RotCavtCrit(u, p, m, errStat, errMsg) TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at time t TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -2253,10 +2247,10 @@ subroutine AD_CavtCrit(u, p, m, errStat, errMsg) end do ! p%numBlades end if ! Cavitation check end do ! p%numRotors -end subroutine AD_CavtCrit +end subroutine RotCavtCrit !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates buoyant loads on an MHK turbine. -subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) +subroutine RotCalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) TYPE(RotInputType), INTENT(IN ) :: u !< AD inputs - used for mesh node positions TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -2654,7 +2648,7 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) m%NacMi = y%NacelleLoad%Moment(:,1) -end subroutine CalcBuoyantLoads +end subroutine RotCalcBuoyantLoads !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for solving for the residual of the constraint state equations subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) @@ -6799,7 +6793,7 @@ END SUBROUTINE Compute_dX !------------------------------------------------------------------------------------------------------- !> This routine calculates nacelle drag loads on a turbine. -SUBROUTINE computeNacelleDrag( u, p, m, y, RotInflow, ErrStat, ErrMsg ) +SUBROUTINE RotCalcNacelleDrag( u, p, m, y, RotInflow, ErrStat, ErrMsg ) TYPE(RotInputType) , INTENT(IN ) :: u !< AD inputs - used for mesh node positions TYPE(RotParameterType) , INTENT(IN ) :: p !< Parameters @@ -6874,7 +6868,7 @@ SUBROUTINE computeNacelleDrag( u, p, m, y, RotInflow, ErrStat, ErrMsg ) -END SUBROUTINE computeNacelleDrag +END SUBROUTINE RotCalcNacelleDrag !---------------------------------------------------------------------------------------------------------------------------------- END MODULE AeroDyn From 78c12828a123db827f236dbad4dde82520edfe0a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 18:43:11 +0000 Subject: [PATCH 217/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 41cffd4358..2397fa5ce2 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 41cffd435811263da055b401a2daeeb1619a2a4d +Subproject commit 2397fa5ce26b7f1b4772b85089d11944372062d9 From 75f46daecc3015a77a6fc0983a9a2387bff1747d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 19:01:35 +0000 Subject: [PATCH 218/319] Add MHK_RM1_Floating_Linear regression test --- modules/openfast-library/src/FAST_Subs.f90 | 2 -- reg_tests/CTestList.cmake | 1 + reg_tests/r-test | 2 +- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 54c7dcd4cb..0790fef794 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1849,8 +1849,6 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%MHK /= MHK_None .and. p%MHK /= MHK_FixedBottom .and. p%MHK /= MHK_Floating) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) - IF (p%MHK /= MHK_None .and. p%Linearize) CALL SetErrStat( ErrID_Fatal, 'Linearization has not yet been implemented for an MHK turbine. Change MHK or Linearize in the FAST input file.', ErrStat, ErrMsg, RoutineName ) - IF (p%Gravity < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'Gravity must not be negative.', ErrStat, ErrMsg, RoutineName ) IF (p%WtrDpth < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'WtrDpth must not be negative.', ErrStat, ErrMsg, RoutineName ) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 6440661f7d..cb2e188ec1 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -362,6 +362,7 @@ of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfas of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("5MW_OC3Spar_Linear" "" "openfast;linear;map;hydrodyn") of_regression_linear("5MW_OC3Mnpl_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") +of_regression_linear("MHK_RM1_Floating_Linear" "" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") # FAST Farm regression tests if(BUILD_FASTFARM) diff --git a/reg_tests/r-test b/reg_tests/r-test index 2397fa5ce2..3d3186915a 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 2397fa5ce26b7f1b4772b85089d11944372062d9 +Subproject commit 3d3186915ab6bb0dfe6de52c3744faf032e46153 From a644cad6a5d3b3e428dab0456f13388af2533f08 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 20:06:38 +0000 Subject: [PATCH 219/319] Disable MHK_RM1_Floating_Linear, reset flag in ModGlue --- modules/openfast-library/src/FAST_ModGlue.f90 | 3 ++- reg_tests/CTestList.cmake | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index df49c688e0..e9ee12bdee 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -542,7 +542,8 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Glue Module !---------------------------------------------------------------------------- - LinFlags = VF_Linearize + VF_Mapping + ! LinFlags = VF_Linearize + VF_Mapping + LinFlags = VF_None call Glue_CombineModules(m%ModGlue, m%ModData, m%Mappings, p%Lin%iMod, LinFlags, & p_FAST%Linearize, ErrStat2, ErrMsg2, Name="Lin") if (Failed()) return diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index cb2e188ec1..b8860a3480 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -362,7 +362,7 @@ of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfas of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("5MW_OC3Spar_Linear" "" "openfast;linear;map;hydrodyn") of_regression_linear("5MW_OC3Mnpl_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") -of_regression_linear("MHK_RM1_Floating_Linear" "" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") +# of_regression_linear("MHK_RM1_Floating_Linear" "" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") # FAST Farm regression tests if(BUILD_FASTFARM) From 0c055145631f263ede746dcca1d83ed189be3288 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Aug 2024 22:35:00 +0000 Subject: [PATCH 220/319] Get AeroMap working again --- modules/openfast-library/src/FAST_AeroMap.f90 | 66 ++++++++++--------- modules/openfast-library/src/FAST_Mapping.f90 | 25 ++++++- reg_tests/r-test | 2 +- 3 files changed, 58 insertions(+), 35 deletions(-) diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 5fdd629998..5fe2566139 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -164,7 +164,8 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! Generate index for variables with AeroMap flag - call Glue_CombineModules(AM%Mod, m%ModData, m%Mappings, iModOrder, VF_AeroMap, .true., ErrStat2, ErrMsg2) + call Glue_CombineModules(AM%Mod, m%ModData, m%Mappings, iModOrder, VF_AeroMap, & + .true., ErrStat2, ErrMsg2, Name="AeroMap") if (Failed()) return ! Loop through modules in AM module @@ -501,7 +502,7 @@ subroutine SS_Solve(AM, m, Mappings, caseData, p_FAST, y_FAST, m_FAST, T, ErrSta y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/size(AM%Mod%Lin%J, 1) ! Remove conditioning from solution vector - call PostconditionInputDelta(AM%SolveDelta(nx + 1:), AM%JacScale) + call PostconditionInputDelta(AM%Mod%Vars, AM%SolveDelta(nx + 1:), AM%JacScale) ! If error is below tolerance if (err <= AM%SolveTolerance) then @@ -577,20 +578,36 @@ subroutine ResetInputsAndStates() end subroutine ResetInputsAndStates - subroutine PostconditionInputDelta(u_delta, JacScale) - real(R8Ki), intent(inout) :: u_delta(:) - real(R8Ki), intent(in) :: JacScale - do i = 1, size(AM%Mod%Vars%u) - associate (Var => AM%Mod%Vars%u(i)) - if (MV_IsLoad(Var)) then - u_delta(Var%iLoc(1):Var%iLoc(2)) = u_delta(Var%iLoc(1):Var%iLoc(2))*JacScale - end if - end associate - end do - end subroutine - end subroutine SS_Solve +subroutine PreconditionInputResidual(Vars, u_residual, JacScale) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: u_residual(:) + real(R8Ki), intent(in) :: JacScale + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + if (MV_IsLoad(Var)) then + u_residual(Var%iLoc(1):Var%iLoc(2)) = u_residual(Var%iLoc(1):Var%iLoc(2))/JacScale + end if + end associate + end do +end subroutine + +subroutine PostconditionInputDelta(Vars, u_delta, JacScale) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: u_delta(:) + real(R8Ki), intent(in) :: JacScale + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + if (MV_IsLoad(Var)) then + u_delta(Var%iLoc(1):Var%iLoc(2)) = u_delta(Var%iLoc(1):Var%iLoc(2))*JacScale + end if + end associate + end do +end subroutine + subroutine SS_UpdateInputsStates(AM, delta, T, ErrStat, ErrMsg) use ElastoDyn_IO, only: DOF_BF, DOF_BE type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data @@ -743,7 +760,7 @@ subroutine SS_BuildJacobian(AM, caseData, Mappings, p_FAST, y_FAST, m_FAST, T, E ! Write linearization matrices call CalcWriteLinearMatrices(ModData%Vars, ModData%Lin, p_FAST, y_FAST, SS_t_global, Un, & - LinRootName, VF_AeroMap, ErrStat2, ErrMsg2, ModData%Abbr) + LinRootName, VF_AeroMap, ErrStat2, ErrMsg2, ModData%Abbr, CalcGlue=.false.) if (Failed()) return end if @@ -910,28 +927,13 @@ subroutine SS_BuildResidual(AM, caseData, Mappings, T, ErrStat, ErrMsg) call SS_GetCalculatedInputs(AM, AM%u2, Mappings, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! call PreconditionInputResidual(AM%u1, AM%JacScale) - ! call PreconditionInputResidual(AM%u2, AM%JacScale) - ! Calculate difference between prescribed and calculated inputs call MV_ComputeDiff(AM%Mod%Vars%u, AM%u1, AM%u2, uResidual) ! Condition residual for solve - call PreconditionInputResidual(uResidual, AM%JacScale) + call PreconditionInputResidual(AM%Mod%Vars, uResidual, AM%JacScale) end associate - -contains - subroutine PreconditionInputResidual(u_residual, JacScale) - real(R8Ki), intent(inout) :: u_residual(:) - real(R8Ki), intent(in) :: JacScale - do i = 1, size(AM%Mod%Vars%u) - associate (Var => AM%Mod%Vars%u(i)) - if (MV_IsLoad(Var)) then - u_residual(Var%iLoc(1):Var%iLoc(2)) = u_residual(Var%iLoc(1):Var%iLoc(2))/JacScale - end if - end associate - end do - end subroutine + end subroutine !------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index ec2ddd434c..3a6ecfe2d7 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -2427,19 +2427,38 @@ subroutine FAST_InputSolve(iModDst, ModAry, MapAry, iInput, Turbine, ErrStat, Er if (present(VarMapAry)) then - ! Loop through mappings + ! Loop through mappings and zero load meshes before transfer + do i = 1, size(VarMapAry) + associate (Mapping => MapAry(VarMapAry(i)%iMapping)) + + ! Skip mappings where this isn't the destination module + if (iModDst /= Mapping%iModDst) cycle + + ! Skip mappings that are not ready + if (.not. Mapping%Ready) cycle + + ! If this is a load mesh mapping, clear the loads + if (Mapping%MapType == Map_LoadMesh) call ZeroDstLoadMesh(Mapping, ModAry(VarMapAry(i)%iModDst)) + end associate + end do + + ! Loop through mappings and perform input solve do i = 1, size(VarMapAry) ! Skip mappings where this isn't the destination module if (iModDst /= VarMapAry(i)%iModDst) cycle + + ! Perform input solve call InputSolveMapping(MapAry(VarMapAry(i)%iMapping), ModAry(VarMapAry(i)%iModSrc), ModAry(VarMapAry(i)%iModDst)) + end do else - ! Loop through mappings + ! Loop through mappings and zero load meshes before transfer do i = 1, size(MapAry) + ! Skip mappings that are not ready if (.not. MapAry(i)%Ready) cycle ! Skip mappings where this isn't the destination module @@ -2449,11 +2468,13 @@ subroutine FAST_InputSolve(iModDst, ModAry, MapAry, iInput, Turbine, ErrStat, Er if (MapAry(i)%MapType == Map_LoadMesh) call ZeroDstLoadMesh(MapAry(i), ModAry(MapAry(i)%iModDst)) end do + ! Loop through mappings and perform input solve do i = 1, size(MapAry) ! Skip mappings where this isn't the destination module if (iModDst /= MapAry(i)%iModDst) cycle + ! Perform input solve call InputSolveMapping(MapAry(i), ModAry(MapAry(i)%iModSrc), ModAry(MapAry(i)%iModDst)) end do end if diff --git a/reg_tests/r-test b/reg_tests/r-test index 3d3186915a..c51f6e1cc8 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 3d3186915ab6bb0dfe6de52c3744faf032e46153 +Subproject commit c51f6e1cc824cdb3bf1ffb5cd2d7622187197e32 From 17818c201ee392e03057c1e61645d34fdb3782a5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 31 Aug 2024 13:55:07 +0000 Subject: [PATCH 221/319] Integrate ExtLoads --- modules/extloads/src/ExtLoads.f90 | 152 +++----- modules/extloads/src/ExtLoads_Registry.txt | 5 +- modules/extloads/src/ExtLoads_Types.f90 | 188 +++++----- modules/inflowwind/src/InflowWind_IO.f90 | 24 +- modules/openfast-library/src/FAST_Funcs.f90 | 155 +++++--- modules/openfast-library/src/FAST_Mapping.f90 | 331 +++++++++++------- .../openfast-library/src/FAST_SolverTC.f90 | 7 +- modules/openfast-library/src/FAST_Subs.f90 | 30 +- reg_tests/executeOpenfastCppRegressionCase.py | 5 +- reg_tests/r-test | 2 +- 10 files changed, 489 insertions(+), 410 deletions(-) diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index a04a14d83f..00ca10d541 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -45,43 +45,12 @@ module ExtLoads public :: ExtLd_ConvertInpDataForExtProg ! Routine to convert Input data for external programs contains -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., -!! FAST) -subroutine ExtLd_SetInitOut(p, InitOut, errStat, errMsg) - - type(ExtLd_InitOutputType), intent( out) :: InitOut ! output data - type(ExtLd_ParameterType), intent(in ) :: p ! Parameters - integer(IntKi), intent( out) :: errStat ! Error status of the operation - character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'ExtLd_SetInitOut' - - - - integer(IntKi) :: i, j, k, f - integer(IntKi) :: NumCoords -#ifdef DBG_OUTS - integer(IntKi) :: m - character(5) ::chanPrefix -#endif - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - -end subroutine ExtLd_SetInitOut !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. !! The initial states and initial guess for the input are defined. subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. type(ExtLd_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine type(ExtLd_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined @@ -100,28 +69,23 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables + character(*), parameter :: RoutineName = 'ExtLd_Init' + integer(IntKi) :: ErrStat2 ! temporary error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary error message integer(IntKi) :: i ! loop counter - type(Points_InitInputType) :: Points_InitInput - integer(IntKi) :: errStat2 ! temporary error status of the operation - character(ErrMsgLen) :: errMsg2 ! temporary error message - character(*), parameter :: RoutineName = 'ExtLd_Init' - - - ! Initialize variables for this routine - errStat = ErrID_None errMsg = "" - ! Initialize the NWTC Subroutine Library + !---------------------------------------------------------------------------- + ! Set parameters + !---------------------------------------------------------------------------- - ! Set parameters here p%NumBlds = InitInp%NumBlades + call AllocAry(p%NumBldNds, p%NumBlds, 'NumBldNds', ErrStat2,ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + if (Failed()) return + p%NumBldNds(:) = InitInp%NumBldNodes(:) p%nTotBldNds = sum(p%NumBldNds(:)) p%NumTwrNds = InitInp%NumTwrNds @@ -134,71 +98,57 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM p%z_ref = InitInp%z_ref p%shear_exp = InitInp%shear_exp - !............................................................................................ - ! Define and initialize inputs here - !............................................................................................ + !---------------------------------------------------------------------------- + ! Define and initialize inputs + !---------------------------------------------------------------------------- - write(*,*) 'Initializing U ' - - call Init_u( u, p, InitInp, errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + call Init_u( u, p, InitInp, ErrStat2, ErrMsg2 ) + if (Failed()) return + !---------------------------------------------------------------------------- + ! Initialize misc vars states + !---------------------------------------------------------------------------- - ! Initialize discrete states m%az = 0.0 m%phi_cfd = 0.0 - write(*,*) 'Initializing y ' - ! - !............................................................................................ - ! Define outputs here - !............................................................................................ - call Init_y(y, u, m, p, errStat2, errMsg2) ! do this after input meshes have been initialized - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - !............................................................................................ - ! Initialize InflowWind FlowField - !............................................................................................ + ! Allocate new flow field structure (deallocate first if associated) if (associated(m%FlowField)) deallocate(m%FlowField) allocate(m%FlowField, stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, 'Error allocating m%FlowField', ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrID_Fatal, 'Error allocating m%FlowField', ErrStat, ErrMsg, RoutineName) return end if - ! Initialize flowfield points type - m%FlowField%FieldType = Point_FieldType - Points_InitInput%NumWindPoints = InitInp%nNodesVel - call IfW_Points_Init(Points_InitInput, m%FlowField%Points, ErrStat2, ErrMsg2); if (Failed()) return + ! Initialize stead flow field + call IfW_SteadyFlowField_Init(m%FlowField, p%z_ref, p%vel_mean, p%shear_exp, ErrStat2, ErrMsg2, & + AngleH=p%wind_dir*D2R) + if (Failed()) return + ! Set pointer to flow field in InitOut InitOut%FlowField => m%FlowField + + !---------------------------------------------------------------------------- + ! Initialize outputs + !---------------------------------------------------------------------------- - - write(*,*) 'Initializing InitOut ' - - !............................................................................................ - ! Define initialization output here - !............................................................................................ - call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Initialize outputs after input meshes have been initialized + call Init_y(y, u, m, p, ErrStat2, ErrMsg2) + if (Failed()) return - !............................................................................................ - ! Module Variables - !............................................................................................ + !---------------------------------------------------------------------------- + ! Initialize Module Variables + !---------------------------------------------------------------------------- call ExtLd_InitVars(u, p, y, m, InitOut, .false., ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + if (Failed()) return contains logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function Failed - end subroutine ExtLd_Init !---------------------------------------------------------------------------------------------------------------------------------- @@ -249,6 +199,10 @@ subroutine ExtLd_InitVars(u, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) do i = 1, size(u%BladeRootMotion) call MV_AddMeshVar(p%Vars%u, "BladeMotion"//IdxStr(i), MotionFields, DatLoc(ExtLd_u_BladeMotion, i), Mesh=u%BladeMotion(i)) end do + call MV_AddMeshVar(p%Vars%u, 'TowerLoadAD', LoadFields, DatLoc(ExtLd_u_TowerLoadAD), Mesh=u%TowerLoadAD) + do i = 1, size(u%BladeLoadAD) + call MV_AddMeshVar(p%Vars%u, 'BladeLoadAD'//IdxStr(i), LoadFields, DatLoc(ExtLd_u_BladeLoadAD, i), Mesh=u%BladeLoadAD(i)) + end do !---------------------------------------------------------------------------- ! Output variables @@ -258,10 +212,6 @@ subroutine ExtLd_InitVars(u, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) do i = 1, size(y%BladeLoad) call MV_AddMeshVar(p%Vars%y, 'BladeLoad'//IdxStr(i), LoadFields, DatLoc(ExtLd_y_BladeLoad, i), Mesh=y%BladeLoad(i)) end do - call MV_AddMeshVar(p%Vars%y, 'TowerLoadAD', LoadFields, DatLoc(ExtLd_y_TowerLoadAD), Mesh=y%TowerLoadAD) - do i = 1, size(y%BladeLoadAD) - call MV_AddMeshVar(p%Vars%y, 'BladeLoadAD'//IdxStr(i), LoadFields, DatLoc(ExtLd_y_BladeLoadAD, i), Mesh=y%BladeLoadAD(i)) - end do !---------------------------------------------------------------------------- ! Initialize Variables and Values @@ -313,7 +263,7 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) if (ErrStat >= AbortErrLev) RETURN call MeshCopy ( SrcMesh = u%TowerMotion & - , DestMesh = y%TowerLoadAD & + , DestMesh = u%TowerLoadAD & , CtrlCode = MESH_COUSIN & , IOS = COMPONENT_OUTPUT & , force = .TRUE. & @@ -324,14 +274,14 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) RETURN - !call MeshCommit(y%TowerLoadAD, errStat2, errMsg2 ) + !call MeshCommit(u%TowerLoadAD, errStat2, errMsg2 ) !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) !y%TowerLoad%force = 0.0_ReKi ! shouldn't have to initialize this !y%TowerLoad%moment= 0.0_ReKi ! shouldn't have to initialize this else y%TowerLoad%nnodes = 0 - y%TowerLoadAD%nnodes = 0 + u%TowerLoadAD%nnodes = 0 end if allocate( y%BladeLoad(p%NumBlds), stat=ErrStat2 ) @@ -340,7 +290,7 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) return end if - allocate( y%BladeLoadAD(p%NumBlds), stat=ErrStat2 ) + allocate( u%BladeLoadAD(p%NumBlds), stat=ErrStat2 ) if (errStat2 /= 0) then call SetErrStat( ErrID_Fatal, 'Error allocating y%BladeLoad.', ErrStat, ErrMsg, RoutineName ) return @@ -360,7 +310,7 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) call MeshCopy ( SrcMesh = u%BladeMotion(k) & - , DestMesh = y%BladeLoadAD(k) & + , DestMesh = u%BladeLoadAD(k) & , CtrlCode = MESH_COUSIN & , IOS = COMPONENT_OUTPUT & , force = .TRUE. & @@ -370,7 +320,7 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !call MeshCommit(y%BladeLoadAD(k), errStat2, errMsg2 ) + !call MeshCommit(u%BladeLoadAD(k), errStat2, errMsg2 ) !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -870,16 +820,16 @@ subroutine ExtLd_ConvertOpDataForOpenFAST(y, u, m, p, errStat, errMsg ) if (p%TwrAero) then do j=1,p%NumTwrNds - y%TowerLoad%Force(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+1:(j-1)*6+3) + (1.0 - m%phi_cfd) * y%TowerLoadAD%Force(:,j) - y%TowerLoad%Moment(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+4:(j-1)*6+6) + (1.0 - m%phi_cfd) * y%TowerLoadAD%Moment(:,j) + y%TowerLoad%Force(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+1:(j-1)*6+3) + (1.0 - m%phi_cfd) * u%TowerLoadAD%Force(:,j) + y%TowerLoad%Moment(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+4:(j-1)*6+6) + (1.0 - m%phi_cfd) * u%TowerLoadAD%Moment(:,j) end do end if jTot = 1 do k=1,p%NumBlds do j=1,p%NumBldNds(k) - y%BladeLoad(k)%Force(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+1:(jTot-1)*6+3) + (1.0 - m%phi_cfd) * y%BladeLoadAD(k)%Force(:,j) - y%BladeLoad(k)%Moment(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+4:(jTot-1)*6+6) + (1.0 - m%phi_cfd) * y%BladeLoadAD(k)%Moment(:,j) + y%BladeLoad(k)%Force(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+1:(jTot-1)*6+3) + (1.0 - m%phi_cfd) * u%BladeLoadAD(k)%Force(:,j) + y%BladeLoad(k)%Moment(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+4:(jTot-1)*6+6) + (1.0 - m%phi_cfd) * u%BladeLoadAD(k)%Moment(:,j) jTot = jTot+1 end do end do @@ -978,7 +928,6 @@ subroutine ExtLd_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer(intKi) :: i integer(intKi) :: j @@ -990,6 +939,9 @@ subroutine ExtLd_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" + call ExtLd_ConvertOpDataForOpenFAST(y, u, m, p, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end subroutine ExtLd_CalcOutput subroutine apply_wm(c, v, vrot, transpose) diff --git a/modules/extloads/src/ExtLoads_Registry.txt b/modules/extloads/src/ExtLoads_Registry.txt index 7d20ae9896..ee72346a38 100644 --- a/modules/extloads/src/ExtLoads_Registry.txt +++ b/modules/extloads/src/ExtLoads_Registry.txt @@ -101,11 +101,12 @@ typedef ^ InputType MeshType HubMotion - - - "motion on the hub" - typedef ^ InputType MeshType NacelleMotion - - - "motion on the nacelle" - typedef ^ InputType MeshType BladeRootMotion {:} - - "motion on each blade root" - typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - +typedef ^ InputType MeshType TowerLoadAD - - - "loads on the tower from aerodyn" - +typedef ^ InputType MeshType BladeLoadAD {:} - - "loads on each blade from aerodyn" - # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: typedef ^ OutputType ExtLdDX_OutputType DX_y - - - "Data to get from external driver" typedef ^ OutputType MeshType TowerLoad - - - "loads on the tower" - typedef ^ OutputType MeshType BladeLoad {:} - - "loads on each blade" - -typedef ^ OutputType MeshType TowerLoadAD - - - "loads on the tower from aerodyn" - -typedef ^ OutputType MeshType BladeLoadAD {:} - - "loads on each blade from aerodyn" - + diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index a5a24df582..69713ddde4 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -128,6 +128,8 @@ MODULE ExtLoads_Types TYPE(MeshType) :: NacelleMotion !< motion on the nacelle [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< motion on each blade root [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeMotion !< motion on each blade [-] + TYPE(MeshType) :: TowerLoadAD !< loads on the tower from aerodyn [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoadAD !< loads on each blade from aerodyn [-] END TYPE ExtLd_InputType ! ======================= ! ========= ExtLd_OutputType ======= @@ -135,8 +137,6 @@ MODULE ExtLoads_Types TYPE(ExtLdDX_OutputType) :: DX_y !< Data to get from external driver [-] TYPE(MeshType) :: TowerLoad !< loads on the tower [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoad !< loads on each blade [-] - TYPE(MeshType) :: TowerLoadAD !< loads on the tower from aerodyn [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoadAD !< loads on each blade from aerodyn [-] END TYPE ExtLd_OutputType ! ======================= integer(IntKi), public, parameter :: ExtLd_x_blah = 1 ! ExtLd%blah @@ -153,12 +153,12 @@ MODULE ExtLoads_Types integer(IntKi), public, parameter :: ExtLd_u_NacelleMotion = 12 ! ExtLd%NacelleMotion integer(IntKi), public, parameter :: ExtLd_u_BladeRootMotion = 13 ! ExtLd%BladeRootMotion(DL%i1) integer(IntKi), public, parameter :: ExtLd_u_BladeMotion = 14 ! ExtLd%BladeMotion(DL%i1) - integer(IntKi), public, parameter :: ExtLd_y_DX_y_twrLd = 15 ! ExtLd%DX_y%twrLd - integer(IntKi), public, parameter :: ExtLd_y_DX_y_bldLd = 16 ! ExtLd%DX_y%bldLd - integer(IntKi), public, parameter :: ExtLd_y_TowerLoad = 17 ! ExtLd%TowerLoad - integer(IntKi), public, parameter :: ExtLd_y_BladeLoad = 18 ! ExtLd%BladeLoad(DL%i1) - integer(IntKi), public, parameter :: ExtLd_y_TowerLoadAD = 19 ! ExtLd%TowerLoadAD - integer(IntKi), public, parameter :: ExtLd_y_BladeLoadAD = 20 ! ExtLd%BladeLoadAD(DL%i1) + integer(IntKi), public, parameter :: ExtLd_u_TowerLoadAD = 15 ! ExtLd%TowerLoadAD + integer(IntKi), public, parameter :: ExtLd_u_BladeLoadAD = 16 ! ExtLd%BladeLoadAD(DL%i1) + integer(IntKi), public, parameter :: ExtLd_y_DX_y_twrLd = 17 ! ExtLd%DX_y%twrLd + integer(IntKi), public, parameter :: ExtLd_y_DX_y_bldLd = 18 ! ExtLd%DX_y%bldLd + integer(IntKi), public, parameter :: ExtLd_y_TowerLoad = 19 ! ExtLd%TowerLoad + integer(IntKi), public, parameter :: ExtLd_y_BladeLoad = 20 ! ExtLd%BladeLoad(DL%i1) contains @@ -1030,6 +1030,25 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg if (ErrStat >= AbortErrLev) return end do end if + call MeshCopy(SrcInputData%TowerLoadAD, DstInputData%TowerLoadAD, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%BladeLoadAD)) then + LB(1:1) = lbound(SrcInputData%BladeLoadAD, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%BladeLoadAD, kind=B8Ki) + if (.not. allocated(DstInputData%BladeLoadAD)) then + allocate(DstInputData%BladeLoadAD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladeLoadAD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BladeLoadAD(i1), DstInputData%BladeLoadAD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if end subroutine subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) @@ -1069,6 +1088,17 @@ subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) end do deallocate(InputData%BladeMotion) end if + call MeshDestroy( InputData%TowerLoadAD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%BladeLoadAD)) then + LB(1:1) = lbound(InputData%BladeLoadAD, kind=B8Ki) + UB(1:1) = ubound(InputData%BladeLoadAD, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BladeLoadAD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%BladeLoadAD) + end if end subroutine subroutine ExtLd_PackInput(RF, Indata) @@ -1101,6 +1131,16 @@ subroutine ExtLd_PackInput(RF, Indata) call MeshPack(RF, InData%BladeMotion(i1)) end do end if + call MeshPack(RF, InData%TowerLoadAD) + call RegPack(RF, allocated(InData%BladeLoadAD)) + if (allocated(InData%BladeLoadAD)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLoadAD, kind=B8Ki), ubound(InData%BladeLoadAD, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeLoadAD, kind=B8Ki) + UB(1:1) = ubound(InData%BladeLoadAD, kind=B8Ki) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeLoadAD(i1)) + end do + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1144,6 +1184,20 @@ subroutine ExtLd_UnPackInput(RF, OutData) call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion end do end if + call MeshUnpack(RF, OutData%TowerLoadAD) ! TowerLoadAD + if (allocated(OutData%BladeLoadAD)) deallocate(OutData%BladeLoadAD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLoadAD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoadAD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLoadAD(i1)) ! BladeLoadAD + end do + end if end subroutine subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1181,25 +1235,6 @@ subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err if (ErrStat >= AbortErrLev) return end do end if - call MeshCopy(SrcOutputData%TowerLoadAD, DstOutputData%TowerLoadAD, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcOutputData%BladeLoadAD)) then - LB(1:1) = lbound(SrcOutputData%BladeLoadAD, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeLoadAD, kind=B8Ki) - if (.not. allocated(DstOutputData%BladeLoadAD)) then - allocate(DstOutputData%BladeLoadAD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLoadAD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%BladeLoadAD(i1), DstOutputData%BladeLoadAD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if end subroutine subroutine ExtLd_DestroyOutput(OutputData, ErrStat, ErrMsg) @@ -1226,17 +1261,6 @@ subroutine ExtLd_DestroyOutput(OutputData, ErrStat, ErrMsg) end do deallocate(OutputData%BladeLoad) end if - call MeshDestroy( OutputData%TowerLoadAD, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputData%BladeLoadAD)) then - LB(1:1) = lbound(OutputData%BladeLoadAD, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeLoadAD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%BladeLoadAD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OutputData%BladeLoadAD) - end if end subroutine subroutine ExtLd_PackOutput(RF, Indata) @@ -1257,16 +1281,6 @@ subroutine ExtLd_PackOutput(RF, Indata) call MeshPack(RF, InData%BladeLoad(i1)) end do end if - call MeshPack(RF, InData%TowerLoadAD) - call RegPack(RF, allocated(InData%BladeLoadAD)) - if (allocated(InData%BladeLoadAD)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoadAD, kind=B8Ki), ubound(InData%BladeLoadAD, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLoadAD, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLoadAD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeLoadAD(i1)) - end do - end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1294,20 +1308,6 @@ subroutine ExtLd_UnPackOutput(RF, OutData) call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad end do end if - call MeshUnpack(RF, OutData%TowerLoadAD) ! TowerLoadAD - if (allocated(OutData%BladeLoadAD)) deallocate(OutData%BladeLoadAD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeLoadAD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoadAD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeLoadAD(i1)) ! BladeLoadAD - end do - end if end subroutine subroutine ExtLd_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -1428,6 +1428,14 @@ SUBROUTINE ExtLd_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated + CALL MeshExtrapInterp1(u1%TowerLoadAD, u2%TowerLoadAD, tin, u_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BladeLoadAD) .AND. ALLOCATED(u1%BladeLoadAD)) THEN + DO i1 = LBOUND(u_out%BladeLoadAD,1, kind=B8Ki),UBOUND(u_out%BladeLoadAD,1, kind=B8Ki) + CALL MeshExtrapInterp1(u1%BladeLoadAD(i1), u2%BladeLoadAD(i1), tin, u_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END SUBROUTINE SUBROUTINE ExtLd_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) @@ -1506,6 +1514,14 @@ SUBROUTINE ExtLd_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated + CALL MeshExtrapInterp2(u1%TowerLoadAD, u2%TowerLoadAD, u3%TowerLoadAD, tin, u_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BladeLoadAD) .AND. ALLOCATED(u1%BladeLoadAD)) THEN + DO i1 = LBOUND(u_out%BladeLoadAD,1, kind=B8Ki),UBOUND(u_out%BladeLoadAD,1, kind=B8Ki) + CALL MeshExtrapInterp2(u1%BladeLoadAD(i1), u2%BladeLoadAD(i1), u3%BladeLoadAD(i1), tin, u_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END SUBROUTINE subroutine ExtLd_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) @@ -1615,14 +1631,6 @@ SUBROUTINE ExtLd_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated - CALL MeshExtrapInterp1(y1%TowerLoadAD, y2%TowerLoadAD, tin, y_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ALLOCATED(y_out%BladeLoadAD) .AND. ALLOCATED(y1%BladeLoadAD)) THEN - DO i1 = LBOUND(y_out%BladeLoadAD,1, kind=B8Ki),UBOUND(y_out%BladeLoadAD,1, kind=B8Ki) - CALL MeshExtrapInterp1(y1%BladeLoadAD(i1), y2%BladeLoadAD(i1), tin, y_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END DO - END IF ! check if allocated END SUBROUTINE SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) @@ -1690,14 +1698,6 @@ SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated - CALL MeshExtrapInterp2(y1%TowerLoadAD, y2%TowerLoadAD, y3%TowerLoadAD, tin, y_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ALLOCATED(y_out%BladeLoadAD) .AND. ALLOCATED(y1%BladeLoadAD)) THEN - DO i1 = LBOUND(y_out%BladeLoadAD,1, kind=B8Ki),UBOUND(y_out%BladeLoadAD,1, kind=B8Ki) - CALL MeshExtrapInterp2(y1%BladeLoadAD(i1), y2%BladeLoadAD(i1), y3%BladeLoadAD(i1), tin, y_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END DO - END IF ! check if allocated END SUBROUTINE function ExtLd_InputMeshPointer(u, DL) result(Mesh) @@ -1716,6 +1716,10 @@ function ExtLd_InputMeshPointer(u, DL) result(Mesh) Mesh => u%BladeRootMotion(DL%i1) case (ExtLd_u_BladeMotion) Mesh => u%BladeMotion(DL%i1) + case (ExtLd_u_TowerLoadAD) + Mesh => u%TowerLoadAD + case (ExtLd_u_BladeLoadAD) + Mesh => u%BladeLoadAD(DL%i1) end select end function @@ -1729,10 +1733,6 @@ function ExtLd_OutputMeshPointer(y, DL) result(Mesh) Mesh => y%TowerLoad case (ExtLd_y_BladeLoad) Mesh => y%BladeLoad(DL%i1) - case (ExtLd_y_TowerLoadAD) - Mesh => y%TowerLoadAD - case (ExtLd_y_BladeLoadAD) - Mesh => y%BladeLoadAD(DL%i1) end select end function @@ -1914,6 +1914,10 @@ subroutine ExtLd_VarPackInput(V, u, ValAry) call MV_PackMesh(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh case (ExtLd_u_BladeMotion) call MV_PackMesh(V, u%BladeMotion(DL%i1), ValAry) ! Mesh + case (ExtLd_u_TowerLoadAD) + call MV_PackMesh(V, u%TowerLoadAD, ValAry) ! Mesh + case (ExtLd_u_BladeLoadAD) + call MV_PackMesh(V, u%BladeLoadAD(DL%i1), ValAry) ! Mesh case default VarVals = 0.0_R8Ki end select @@ -1960,6 +1964,10 @@ subroutine ExtLd_VarUnpackInput(V, ValAry, u) call MV_UnpackMesh(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh case (ExtLd_u_BladeMotion) call MV_UnpackMesh(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh + case (ExtLd_u_TowerLoadAD) + call MV_UnpackMesh(V, ValAry, u%TowerLoadAD) ! Mesh + case (ExtLd_u_BladeLoadAD) + call MV_UnpackMesh(V, ValAry, u%BladeLoadAD(DL%i1)) ! Mesh end select end associate end subroutine @@ -1992,6 +2000,10 @@ function ExtLd_InputFieldName(DL) result(Name) Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" case (ExtLd_u_BladeMotion) Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" + case (ExtLd_u_TowerLoadAD) + Name = "u%TowerLoadAD" + case (ExtLd_u_BladeLoadAD) + Name = "u%BladeLoadAD("//trim(Num2LStr(DL%i1))//")" case default Name = "Unknown Field" end select @@ -2021,10 +2033,6 @@ subroutine ExtLd_VarPackOutput(V, y, ValAry) call MV_PackMesh(V, y%TowerLoad, ValAry) ! Mesh case (ExtLd_y_BladeLoad) call MV_PackMesh(V, y%BladeLoad(DL%i1), ValAry) ! Mesh - case (ExtLd_y_TowerLoadAD) - call MV_PackMesh(V, y%TowerLoadAD, ValAry) ! Mesh - case (ExtLd_y_BladeLoadAD) - call MV_PackMesh(V, y%BladeLoadAD(DL%i1), ValAry) ! Mesh case default VarVals = 0.0_R8Ki end select @@ -2055,10 +2063,6 @@ subroutine ExtLd_VarUnpackOutput(V, ValAry, y) call MV_UnpackMesh(V, ValAry, y%TowerLoad) ! Mesh case (ExtLd_y_BladeLoad) call MV_UnpackMesh(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh - case (ExtLd_y_TowerLoadAD) - call MV_UnpackMesh(V, ValAry, y%TowerLoadAD) ! Mesh - case (ExtLd_y_BladeLoadAD) - call MV_UnpackMesh(V, ValAry, y%BladeLoadAD(DL%i1)) ! Mesh end select end associate end subroutine @@ -2075,10 +2079,6 @@ function ExtLd_OutputFieldName(DL) result(Name) Name = "y%TowerLoad" case (ExtLd_y_BladeLoad) Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" - case (ExtLd_y_TowerLoadAD) - Name = "y%TowerLoadAD" - case (ExtLd_y_BladeLoadAD) - Name = "y%BladeLoadAD("//trim(Num2LStr(DL%i1))//")" case default Name = "Unknown Field" end select diff --git a/modules/inflowwind/src/InflowWind_IO.f90 b/modules/inflowwind/src/InflowWind_IO.f90 index c5e164cf34..302133043f 100644 --- a/modules/inflowwind/src/InflowWind_IO.f90 +++ b/modules/inflowwind/src/InflowWind_IO.f90 @@ -152,14 +152,15 @@ subroutine IfW_SteadyWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrMs end subroutine -subroutine IfW_SteadyFlowField_Init(FF, RefHt, HWindSpeed, PLExp, ErrStat, ErrMsg) +subroutine IfW_SteadyFlowField_Init(FF, RefHt, HWindSpeed, PLExp, ErrStat, ErrMsg, AngleH) use InflowWind_IO_Types, only: Steady_InitInputType, WindFileDat - type(FlowFieldType), pointer, intent(inout) :: FF !< FlowField - real(ReKi), intent(in) :: RefHt !< Hub reference height - real(ReKi), intent(in) :: HWindSpeed !< Horizontal wind speed at reference height - real(ReKi), intent(in) :: PLExp !< Power law shear coefficient - integer(IntKi), intent(out) :: ErrStat !< Error status - character(*), intent(out) :: ErrMsg !< Error message + type(FlowFieldType), pointer, intent(inout) :: FF !< FlowField + real(ReKi), intent(in) :: RefHt !< Hub reference height + real(ReKi), intent(in) :: HWindSpeed !< Horizontal wind speed at reference height + real(ReKi), intent(in) :: PLExp !< Power law shear coefficient + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message + real(ReKi), optional, intent(in) :: AngleH !< Horizontal angle character(*), parameter :: RoutineName = 'IfW_SteadyFlowField_Init' integer(IntKi) :: ErrStat2 @@ -198,12 +199,19 @@ subroutine IfW_SteadyFlowField_Init(FF, RefHt, HWindSpeed, PLExp, ErrStat, ErrMs FF%Uniform%VelH = HWindSpeed FF%Uniform%VelV = 0.0_ReKi FF%Uniform%VelGust = 0.0_ReKi - FF%Uniform%AngleH = 0.0_ReKi + if (present(AngleH)) then + FF%Uniform%AngleH = AngleH + else + FF%Uniform%AngleH = 0.0_ReKi + end if FF%Uniform%AngleV = 0.0_ReKi FF%Uniform%ShrH = 0.0_ReKi FF%Uniform%ShrV = PLExp FF%Uniform%LinShrV = 0.0_ReKi + + + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 1febec054b..c5546cc181 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -27,8 +27,8 @@ module FAST_Funcs use AeroDyn use BeamDyn use ElastoDyn -USE ExternalInflow -USE ExtLoads +use ExternalInflow +use ExtLoads use ExtPtfm_MCKF use FEAMooring use HydroDyn @@ -66,74 +66,97 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) case (Module_AD) if (ModData%Ins /= 1) return ! Perform extrap interp for first instance only, this advances all rotors - call AD_Input_ExtrapInterp(T%AD%Input(1:), T%AD%InputTimes, T%AD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call AD_Input_ExtrapInterp(T%AD%Input(1:), T%AD%InputTimes, T%AD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call AD_CopyInput(T%AD%Input(j), T%AD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%AD%InputTimes) case (Module_BD) - call BD_Input_ExtrapInterp(T%BD%Input(1:, ModData%Ins), T%BD%InputTimes(:, ModData%Ins), T%BD%Input(0, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call BD_Input_ExtrapInterp(T%BD%Input(1:, ModData%Ins), T%BD%InputTimes(:, ModData%Ins), T%BD%Input(INPUT_TEMP, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call BD_CopyInput(T%BD%Input(j, ModData%Ins), T%BD%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%BD%InputTimes(:, ModData%Ins)) case (Module_ED) - call ED_Input_ExtrapInterp(T%ED%Input(1:), T%ED%InputTimes, T%ED%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call ED_Input_ExtrapInterp(T%ED%Input(1:), T%ED%InputTimes, T%ED%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call ED_CopyInput(T%ED%Input(j), T%ED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%ED%InputTimes) + case (Module_ExtInfw) + ! Not used + + case (Module_ExtLd) + ! Not used + case (Module_ExtPtfm) - call ExtPtfm_Input_ExtrapInterp(T%ExtPtfm%Input(1:), T%ExtPtfm%InputTimes, T%ExtPtfm%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_Input_ExtrapInterp(T%ExtPtfm%Input(1:), T%ExtPtfm%InputTimes, T%ExtPtfm%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call ExtPtfm_CopyInput(T%ExtPtfm%Input(j), T%ExtPtfm%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%ExtPtfm%InputTimes) case (Module_FEAM) - call FEAM_Input_ExtrapInterp(T%FEAM%Input(1:), T%FEAM%InputTimes, T%FEAM%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call FEAM_Input_ExtrapInterp(T%FEAM%Input(1:), T%FEAM%InputTimes, T%FEAM%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call FEAM_CopyInput(T%FEAM%Input(j), T%FEAM%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%FEAM%InputTimes) case (Module_HD) - call HydroDyn_Input_ExtrapInterp(T%HD%Input(1:), T%HD%InputTimes, T%HD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_Input_ExtrapInterp(T%HD%Input(1:), T%HD%InputTimes, T%HD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call HydroDyn_CopyInput(T%HD%Input(j), T%HD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%HD%InputTimes) -! case (Module_IceD) -! case (Module_IceF) + case (Module_IceD) + call IceD_Input_ExtrapInterp(T%IceD%Input(1:, ModData%Ins), T%IceD%InputTimes(:, ModData%Ins), T%IceD%Input(INPUT_TEMP, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call IceD_CopyInput(T%IceD%Input(j, ModData%Ins), T%IceD%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%IceD%InputTimes(:, ModData%Ins)) + + case (Module_IceF) + call IceFloe_Input_ExtrapInterp(T%IceF%Input(1:), T%IceF%InputTimes, T%IceF%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call IceFloe_CopyInput(T%IceF%Input(j), T%IceF%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%IceF%InputTimes) + case (Module_IfW) - call InflowWind_Input_ExtrapInterp(T%IfW%Input(1:), T%IfW%InputTimes, T%IfW%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call InflowWind_Input_ExtrapInterp(T%IfW%Input(1:), T%IfW%InputTimes, T%IfW%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call InflowWind_CopyInput(T%IfW%Input(j), T%IfW%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%IfW%InputTimes) case (Module_MAP) - call MAP_Input_ExtrapInterp(T%MAP%Input(1:), T%MAP%InputTimes, T%MAP%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call MAP_Input_ExtrapInterp(T%MAP%Input(1:), T%MAP%InputTimes, T%MAP%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call MAP_CopyInput(T%MAP%Input(j), T%MAP%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%MAP%InputTimes) case (Module_MD) - call MD_Input_ExtrapInterp(T%MD%Input(1:), T%MD%InputTimes, T%MD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call MD_Input_ExtrapInterp(T%MD%Input(1:), T%MD%InputTimes, T%MD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call MD_CopyInput(T%MD%Input(j), T%MD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return end do call ShiftInputTimes(T%MD%InputTimes) -! case (Module_OpFM) -! case (Module_Orca) + case (Module_Orca) + call Orca_Input_ExtrapInterp(T%Orca%Input(1:), T%Orca%InputTimes, T%Orca%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call Orca_CopyInput(T%Orca%Input(j), T%Orca%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%Orca%InputTimes) + case (Module_SD) - call SD_Input_ExtrapInterp(T%SD%Input(1:), T%SD%InputTimes, T%SD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call SD_Input_ExtrapInterp(T%SD%Input(1:), T%SD%InputTimes, T%SD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call SD_CopyInput(T%SD%Input(j), T%SD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -151,7 +174,7 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) case (Module_SrvD) - call SrvD_Input_ExtrapInterp(T%SrvD%Input(1:), T%SrvD%InputTimes, T%SrvD%Input(0), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call SrvD_Input_ExtrapInterp(T%SrvD%Input(1:), T%SrvD%InputTimes, T%SrvD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 call SrvD_CopyInput(T%SrvD%Input(j), T%SrvD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -185,7 +208,7 @@ subroutine FAST_InitInputStateArrays(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_InitIO' + character(*), parameter :: RoutineName = 'FAST_InitInputStateArrays' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 real(DbKi) :: t_global_next ! Simulation time for computing outputs @@ -309,6 +332,9 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) case (Module_ED) ! State update is handled by tight coupling solver + case (Module_ExtLd) + ! Not used + case (Module_ExtPtfm) call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return @@ -515,6 +541,14 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt T%ED%x(iState), T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & T%ED%y, T%ED%m, ErrStat2, ErrMsg2) + case (Module_ExtInfw) + ! Not used + + case (Module_ExtLd) + call ExtLd_CalcOutput(ThisTime, T%ExtLd%u, T%ExtLd%p, & + T%ExtLd%x(iState), T%ExtLd%xd(iState), T%ExtLd%z(iState), T%ExtLd%OtherSt(iState), & + T%ExtLd%y, T%ExtLd%m, ErrStat2, ErrMsg2) + case (Module_ExtPtfm) call ExtPtfm_CalcOutput(ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, & T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), T%ExtPtfm%z(iState), T%ExtPtfm%OtherSt(iState), & @@ -530,8 +564,17 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt T%HD%x(iState), T%HD%xd(iState), T%HD%z(iState), T%HD%OtherSt(iState), & T%HD%y, T%HD%m, ErrStat2, ErrMsg2) -! case (Module_IceD) -! case (Module_IceF) + case (Module_IceD) + call IceD_CalcOutput(ThisTime, T%IceD%Input(iInput, ModData%Ins), T%IceD%p(ModData%Ins), & + T%IceD%x(ModData%Ins, iState), T%IceD%xd(ModData%Ins, iState), & + T%IceD%z(ModData%Ins, iState), T%IceD%OtherSt(ModData%Ins, iState), & + T%IceD%y(ModData%Ins), T%IceD%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_IceF) + call IceFloe_CalcOutput(ThisTime, T%IceF%Input(iInput), T%IceF%p, & + T%IceF%x(iState), T%IceF%xd(iState), T%IceF%z(iState), T%IceF%OtherSt(iState), & + T%IceF%y, T%IceF%m, ErrStat2, ErrMsg2) + case (Module_IfW) call InflowWind_CalcOutput(ThisTime, T%IfW%Input(iInput), T%IfW%p, & T%IfW%x(iState), T%IfW%xd(iState), T%IfW%z(iState), T%IfW%OtherSt(iState), & @@ -546,8 +589,12 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt call MD_CalcOutput(ThisTime, T%MD%Input(iInput), T%MD%p, & T%MD%x(iState), T%MD%xd(iState), T%MD%z(iState), T%MD%OtherSt(iState), & T%MD%y, T%MD%m, ErrStat2, ErrMsg2) -! case (Module_OpFM) -! case (Module_Orca) + + case (Module_Orca) + call Orca_CalcOutput(ThisTime, T%Orca%Input(iInput), T%Orca%p, & + T%Orca%x(iState), T%Orca%xd(iState), T%Orca%z(iState), T%Orca%OtherSt(iState), & + T%Orca%y, T%Orca%m, ErrStat2, ErrMsg2) + case (Module_SD) call SD_CalcOutput(ThisTime, T%SD%Input(iInput), T%SD%p, & T%SD%x(iState), T%SD%xd(iState), T%SD%z(iState), T%SD%OtherSt(iState), & @@ -579,13 +626,13 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt end subroutine -subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & +subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & u_op, y_op, x_op, dx_op, z_op, u_glue, y_glue, x_glue, dx_glue, z_glue) use AeroDyn, only: AD_CalcWind_Rotor type(ModDataType), intent(in) :: ModData !< Module information real(DbKi), intent(in) :: ThisTime !< Time - integer(IntKi), intent(in) :: iIndex !< Input index - integer(IntKi), intent(in) :: iState !< State index + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -619,42 +666,42 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & ! Select based on module ID select case (ModData%ID) case (Module_AD) - call AD_VarsPackInput(ModData%Vars, T%AD%Input(iIndex)%rotors(ModData%Ins), u_op) + call AD_VarsPackInput(ModData%Vars, T%AD%Input(iInput)%rotors(ModData%Ins), u_op) call AD_VarsPackExtInput(ModData%Vars, ThisTime, T%AD%p, u_op) case (Module_BD) - call BD_VarsPackInput(ModData%Vars, T%BD%Input(iIndex, ModData%Ins), u_op) + call BD_VarsPackInput(ModData%Vars, T%BD%Input(iInput, ModData%Ins), u_op) case (Module_ED) - call ED_VarsPackInput(ModData%Vars, T%ED%Input(iIndex), u_op) - call ED_PackExtInputAry(ModData%Vars, T%ED%Input(iIndex), u_op, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackInput(ModData%Vars, T%ED%Input(iInput), u_op) + call ED_PackExtInputAry(ModData%Vars, T%ED%Input(iInput), u_op, ErrStat2, ErrMsg2); if (Failed()) return case (Module_ExtPtfm) - call ExtPtfm_VarsPackInput(ModData%Vars, T%ExtPtfm%Input(iIndex), u_op) + call ExtPtfm_VarsPackInput(ModData%Vars, T%ExtPtfm%Input(iInput), u_op) case (Module_FEAM) - call FEAM_VarsPackInput(ModData%Vars, T%FEAM%Input(iIndex), u_op) + call FEAM_VarsPackInput(ModData%Vars, T%FEAM%Input(iInput), u_op) case (Module_HD) - call HydroDyn_VarsPackInput(ModData%Vars, T%HD%Input(iIndex), u_op) - call HD_PackExtInputAry(ModData%Vars, T%HD%Input(iIndex), u_op) + call HydroDyn_VarsPackInput(ModData%Vars, T%HD%Input(iInput), u_op) + call HD_PackExtInputAry(ModData%Vars, T%HD%Input(iInput), u_op) case (Module_IceD) - call IceD_VarsPackInput(ModData%Vars, T%IceD%Input(iIndex, ModData%Ins), u_op) + call IceD_VarsPackInput(ModData%Vars, T%IceD%Input(iInput, ModData%Ins), u_op) case (Module_IceF) - call IceFloe_VarsPackInput(ModData%Vars, T%IceF%Input(iIndex), u_op) + call IceFloe_VarsPackInput(ModData%Vars, T%IceF%Input(iInput), u_op) case (Module_IfW) - call InflowWind_VarsPackInput(ModData%Vars, T%IfW%Input(iIndex), u_op) + call InflowWind_VarsPackInput(ModData%Vars, T%IfW%Input(iInput), u_op) call InflowWind_PackExtInputAry(ModData%Vars, ThisTime, T%IfW%p, u_op) case (Module_MAP) - call MAP_VarsPackInput(ModData%Vars, T%MAP%Input(iIndex), u_op) + call MAP_VarsPackInput(ModData%Vars, T%MAP%Input(iInput), u_op) case (Module_MD) - call MD_VarsPackInput(ModData%Vars, T%MD%Input(iIndex), u_op) + call MD_VarsPackInput(ModData%Vars, T%MD%Input(iInput), u_op) case (Module_ExtInfw) ! call ExtInfw_VarsPackInput(ModData%Vars, T%ExtInfw%Input(iIndex), u_op) case (Module_Orca) - call Orca_VarsPackInput(ModData%Vars, T%Orca%Input(iIndex), u_op) + call Orca_VarsPackInput(ModData%Vars, T%Orca%Input(iInput), u_op) case (Module_SD) - call SD_VarsPackInput(ModData%Vars, T%SD%Input(iIndex), u_op) + call SD_VarsPackInput(ModData%Vars, T%SD%Input(iInput), u_op) case (Module_SeaSt) - call SeaSt_VarsPackInput(ModData%Vars, T%SeaSt%Input(iIndex), u_op) - call SeaSt_PackExtInputAry(ModData%Vars, T%SeaSt%Input(iIndex), u_op) + call SeaSt_VarsPackInput(ModData%Vars, T%SeaSt%Input(iInput), u_op) + call SeaSt_PackExtInputAry(ModData%Vars, T%SeaSt%Input(iInput), u_op) case (Module_SrvD) - call SrvD_VarsPackInput(ModData%Vars, T%SrvD%Input(iIndex), u_op) + call SrvD_VarsPackInput(ModData%Vars, T%SrvD%Input(iInput), u_op) case default call SetErrStat(ErrID_Fatal, "Input unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) return @@ -780,13 +827,13 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & select case (ModData%ID) case (Module_AD) i = 1 - call AD_CalcWind_Rotor(ThisTime, T%AD%Input(iIndex)%rotors(ModData%Ins), & + call AD_CalcWind_Rotor(ThisTime, T%AD%Input(iInput)%rotors(ModData%Ins), & T%AD%p%FlowField, T%AD%p%rotors(ModData%Ins), & - T%AD%m%Inflow(iIndex)%RotInflow(ModData%Ins), & + T%AD%m%Inflow(iInput)%RotInflow(ModData%Ins), & i, ErrStat2, ErrMsg2) if (Failed()) return - call RotCalcContStateDeriv(ThisTime, T%AD%Input(iIndex)%rotors(ModData%Ins), & - T%AD%m%Inflow(iIndex)%RotInflow(ModData%Ins), & + call RotCalcContStateDeriv(ThisTime, T%AD%Input(iInput)%rotors(ModData%Ins), & + T%AD%m%Inflow(iInput)%RotInflow(ModData%Ins), & T%AD%p%rotors(ModData%Ins), T%AD%p, & T%AD%x(iState)%rotors(ModData%Ins), & T%AD%xd(iState)%rotors(ModData%Ins), & @@ -799,7 +846,7 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & call AD_VarsPackContStateDeriv(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) case (Module_BD) - call BD_CalcContStateDeriv(ThisTime, T%BD%Input(iIndex, ModData%Ins), & + call BD_CalcContStateDeriv(ThisTime, T%BD%Input(iInput, ModData%Ins), & T%BD%p(ModData%Ins), & T%BD%x(ModData%Ins, iState), & T%BD%xd(ModData%Ins, iState), & @@ -812,14 +859,14 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & call BD_VarsPackContStateDeriv(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) case (Module_ED) - call ED_CalcContStateDeriv(ThisTime, T%ED%Input(iIndex), T%ED%p, T%ED%x(iState), & + call ED_CalcContStateDeriv(ThisTime, T%ED%Input(iInput), T%ED%p, T%ED%x(iState), & T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & T%ED%m, T%ED%m%dxdt_lin, ErrStat2, ErrMsg2) if (Failed()) return call ED_VarsPackContStateDeriv(ModData%Vars, T%ED%m%dxdt_lin, dx_op) case (Module_ExtPtfm) - call ExtPtfm_CalcContStateDeriv(ThisTime, T%ExtPtfm%Input(iIndex), & + call ExtPtfm_CalcContStateDeriv(ThisTime, T%ExtPtfm%Input(iInput), & T%ExtPtfm%p, T%ExtPtfm%x(iState), & T%ExtPtfm%xd(iState), T%ExtPtfm%z(iState), & T%ExtPtfm%OtherSt(iState), & @@ -831,7 +878,7 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & ! call FEAM_VarsPackContStateDeriv(ModData%Vars, T%FEAM%x(StateIndex), dx_op) case (Module_HD) - call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(iIndex), T%HD%p, T%HD%x(iState), & + call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(iInput), T%HD%p, T%HD%x(iState), & T%HD%xd(iState), T%HD%z(iState), T%HD%OtherSt(iState), & T%HD%m, T%HD%m%dxdt_lin, ErrStat2, ErrMsg2) if (Failed()) return @@ -854,7 +901,7 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & ! call MAP_VarsPackContStateDeriv(ModData%Vars, T%MAP%x(StateIndex), dx_op) case (Module_MD) - call MD_CalcContStateDeriv(ThisTime, T%MD%Input(iIndex), T%MD%p, T%MD%x(iState), & + call MD_CalcContStateDeriv(ThisTime, T%MD%Input(iInput), T%MD%p, T%MD%x(iState), & T%MD%xd(iState), T%MD%z(iState), T%MD%OtherSt(iState), & T%MD%m, T%MD%m%dxdt_lin, ErrStat2, ErrMsg2) if (Failed()) return @@ -867,7 +914,7 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & ! call Orca_VarsPackContStateDeriv(ModData%Vars, T%Orca%x(StateIndex), dx_op) case (Module_SD) - call SD_CalcContStateDeriv(ThisTime, T%SD%Input(iIndex), T%SD%p, T%SD%x(iState), & + call SD_CalcContStateDeriv(ThisTime, T%SD%Input(iInput), T%SD%p, T%SD%x(iState), & T%SD%xd(iState), T%SD%z(iState), T%SD%OtherSt(iState), & T%SD%m, T%SD%m%dxdt_lin, ErrStat2, ErrMsg2) if (Failed()) return @@ -877,7 +924,7 @@ subroutine FAST_GetOP(ModData, ThisTime, iIndex, iState, T, ErrStat, ErrMsg, & ! call SeaSt_VarsPackContStateDeriv(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) case (Module_SrvD) - call SrvD_CalcContStateDeriv(ThisTime, T%SrvD%Input(iIndex), T%SrvD%p, T%SrvD%x(iState), & + call SrvD_CalcContStateDeriv(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, T%SrvD%x(iState), & T%SrvD%xd(iState), T%SrvD%z(iState), T%SrvD%OtherSt(iState), & T%SrvD%m, T%SrvD%m%dxdt_lin, ErrStat2, ErrMsg2) call SrvD_VarsPackContStateDeriv(ModData%Vars, T%SrvD%m%dxdt_lin, dx_op) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 3a6ecfe2d7..a82230a4d4 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -22,11 +22,16 @@ module FAST_Mapping use FAST_Types use FAST_ModTypes +use ExtLoads implicit none private -public :: FAST_InitMappings, FAST_LinearizeMappings, FAST_ResetRemapFlags, FAST_InputSolve +public :: FAST_InitMappings +public :: FAST_LinearizeMappings +public :: FAST_ResetRemapFlags +public :: FAST_InputSolve +public :: FAST_ResetMappingReady integer(IntKi), parameter :: Xfr_Invalid = 0, & Xfr_Point_to_Point = 1, & @@ -35,7 +40,6 @@ module FAST_Mapping Xfr_Line2_to_Line2 = 4 character(24), parameter :: Custom_ED_to_ExtLd = 'ED -> ExtLd', & - Custom_AD_to_ExtLd = 'AD -> ExtLd', & Custom_SrvD_to_AD = 'SrvD -> AD', & Custom_ED_to_IfW = 'ED -> IfW', & Custom_SrvD_to_IfW = 'SrvD -> IfW', & @@ -368,7 +372,7 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) case (Module_ED) call InitMappings_ED(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtInfw) - ! call InitMappings_ExtInfw(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_ExtInfw(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtLd) call InitMappings_ExtLd(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtPtfm) @@ -438,7 +442,7 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i - logical :: NotCompAeroMaps + logical :: NotCompAeroMaps, CompElastED ErrStat = ErrID_None ErrMsg = '' @@ -446,6 +450,9 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Flag is true if not computing AeroMaps NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + ! Flag is true if CompElast == Module_ED + CompElastED = Turbine%p_FAST%CompElast == Module_ED + ! Select based on source module identifier select case (SrcMod%ID) @@ -460,24 +467,19 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ED) + ! Blade motion if (Turbine%p_FAST%CompElast == Module_ED) then do i = 1, size(Turbine%ED%y%BladeLn2Mesh) call MapMotionMesh(Turbine, Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) DstMod=DstMod, DstDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=NotCompAeroMaps .or. (i == 1)) + Active=CompElastED .and. (NotCompAeroMaps .or. (i == 1))) if (Failed()) return end do end if - call MapMotionMesh(Turbine, Mappings, & - SrcMod=SrcMod, SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh - DstMod=DstMod, DstDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=NotCompAeroMaps) - if (Failed()) return - + ! Blade root motion do i = 1, size(Turbine%ED%y%BladeRootMotion) call MapMotionMesh(Turbine, Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) @@ -487,6 +489,15 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) if (Failed()) return end do + ! Tower motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstMod=DstMod, DstDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Hub motion call MapMotionMesh(Turbine, Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion DstMod=DstMod, DstDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion @@ -494,6 +505,7 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) Active=NotCompAeroMaps) if (Failed()) return + ! Nacelle motion call MapMotionMesh(Turbine, Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion DstMod=DstMod, DstDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion @@ -501,6 +513,7 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) Active=NotCompAeroMaps) if (Failed()) return + ! TailFin motion call MapMotionMesh(Turbine, Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion DstMod=DstMod, DstDL=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(DstMod%Ins)%TFinMotion @@ -555,7 +568,7 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i - logical :: NotCompAeroMaps + logical :: NotCompAeroMaps, CompAeroAD ErrStat = ErrID_None ErrMsg = '' @@ -563,6 +576,9 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Flag is true if not computing AeroMaps NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + ! Flag is true of CompAero == Module_AD + CompAeroAD = Turbine%p_FAST%CompAero == Module_AD + ! Select based on source module identifier select case (SrcMod%ID) @@ -574,7 +590,7 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstDL=DatLoc(BD_u_DistrLoad), & ! BD%u(DstMod%Ins)%DistrLoad DstDispDL=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=NotCompAeroMaps .or. (DstMod%Ins == 1)) + Active=CompAeroAD .and. (NotCompAeroMaps .or. (DstMod%Ins == 1))) if (Failed()) return case (Module_ED) @@ -596,8 +612,13 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ExtLd) - ! TODO - ! CALL MeshMapCreate( ExtLd%y%BladeLoad(K), BD%Input(1,k)%DistrLoad, MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ExtLd_y_BladeLoad, DstMod%Ins), & ! ExtLd%y%BladeLoad(DstMod%Ins), & + SrcDispDL=DatLoc(ExtLd_u_BladeMotion, DstMod%Ins), & ! ExtLd%u%BStCMotionMesh(DstMod%Ins) + DstDL=DatLoc(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad + DstDispDL=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_SrvD) @@ -631,7 +652,7 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j - logical :: NotCompAeroMaps + logical :: NotCompAeroMaps, CompAeroAD, CompElastED ErrStat = ErrID_None ErrMsg = '' @@ -639,22 +660,31 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Flag is true if not computing AeroMaps NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + ! Flag is true of CompAero == Module_AD + CompAeroAD = Turbine%p_FAST%CompAero == Module_AD + + ! Flag is true of CompElast == Module_ED + CompElastED = Turbine%p_FAST%CompElast == Module_ED + ! Select based on source module identifier select case (SrcMod%ID) case (Module_AD) + ! Blade Loads do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%InsR)%BladeLoad(i) - SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%InsR)%BladeMotion(i) + SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(i) + SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(i) DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=(Turbine%p_FAST%CompElast == Module_ED) .and. (NotCompAeroMaps .or. (i == 1))) + Active=CompAeroAD .and. CompElastED .and. & + (NotCompAeroMaps .or. (i == 1))) if (Failed()) return end do + ! Hub Loads call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(AD_y_HubLoad), & ! AD%y%rotors(SrcMod%Ins)%HubLoad SrcDispDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(SrcMod%Ins)%HubMotion @@ -664,6 +694,7 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) Active=NotCompAeroMaps) if (Failed()) return + ! Nacelle Loads call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(AD_y_NacelleLoad), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad SrcDispDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion @@ -673,6 +704,7 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) Active=NotCompAeroMaps) if (Failed()) return + ! Tail Fin Loads call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(AD_y_TFinLoad), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad SrcDispDL=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion @@ -682,17 +714,19 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) Active=NotCompAeroMaps) if (Failed()) return + ! Tower Loads call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(AD_y_TowerLoad), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad SrcDispDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2, & - Active=NotCompAeroMaps) + Active=CompAeroAD .and. NotCompAeroMaps) if (Failed()) return case (Module_BD) + ! Hub Loads call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce SrcDispDL=DatLoc(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion @@ -704,8 +738,25 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ExtLd) - ! TODO - ! CALL MeshMapCreate( ExtLd%y%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2 ) + ! Blade loads + do i = 1, Turbine%ED%p%NumBl + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ExtLd_y_BladeLoad, i), & ! ExtLd%y%BladeLoad(i) + SrcDispDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) + DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Tower load + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ExtLd_y_TowerLoad), & ! ExtLd%y%TowerLoad + SrcDispDL=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion + DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads + DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_ExtPtfm) @@ -838,11 +889,6 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstMod=DstMod, DstDL=DatLoc(ED_u_GenTrq), & ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - ! call MapVariable(Mappings, & - ! SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_HssBrTrqC), & - ! DstMod=DstMod, DstDL=DatLoc(ED_u_HssBrTrqC), & - ! ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return - call MapCustom(Mappings, Custom_SrvD_to_ED, SrcMod, DstMod) ! Blade Structural Controller (if ElastoDyn is used for blades) @@ -902,6 +948,31 @@ logical function Failed() end function end subroutine +subroutine InitMappings_ExtInfw(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_ExtInfw' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(inout) :: SrcMod, DstMod @@ -912,60 +983,95 @@ subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'InitMappings_ExtLd' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i + integer(IntKi) :: i, k + logical :: CompElastED ErrStat = ErrID_None ErrMsg = '' + ! Flag is true if CompElast == Module_ED + CompElastED = Turbine%p_FAST%CompElast == Module_ED + select case (SrcMod%ID) case (Module_AD) - ! call MapCustom(Mappings, Custom_AD_to_ExtLd, SrcMod, DstMod, ErrStat2, ErrMsg2); if (Failed()) return + ! Blade Loads + do i = 1, Turbine%ED%p%NumBl + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(i) + SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(i) + DstMod=DstMod, & + DstDL=DatLoc(ExtLd_u_BladeLoadAD, i), & ! ExtLd%u%BladeLoadAD(i) + DstDispDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do - ! TODO Add mapping from aerodyn blade and tower to new input meshes - ! MeshMapCreate( AD%y%rotors(1)%BladeLoad(k), ExtLd%y%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2) - ! MeshMapCreate( AD%y%rotors(1)%TowerLoad, ExtLd%y%TowerLoadAD, MeshMapData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2 ) + ! Tower Loads + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(AD_y_TowerLoad), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad + SrcDispDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion + DstMod=DstMod, & + DstDL=DatLoc(ExtLd_u_TowerLoadAD), & ! ExtLd%u%TowerLoadAD + DstDispDL=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + case (Module_BD) - call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & - SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion - DstDL=DatLoc(ExtLd_u_BladeMotion, SrcMod%Ins), & ! ExtLd%u%BladeMotion(SrcMod%Ins) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ! Blade motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMod=DstMod, DstDL=DatLoc(ExtLd_u_BladeMotion, SrcMod%Ins), & ! ExtLd%u%BladeMotion(SrcMod%Ins) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return case (Module_ED) call MapCustom(Mappings, Custom_ED_to_ExtLd, SrcMod, DstMod) + ! Blade motion do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) DstDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) - Active=Turbine%p_FAST%CompElast == Module_ED, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + Active=CompElastED, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return end do + ! Blade root motion do i = 1, Turbine%ED%p%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) DstDL=DatLoc(ExtLd_u_BladeRootMotion, i), & ! ExtLd%u%BladeRootMotion(i) - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return end do + ! Tower motion call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh DstDL=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return + ! Hub motion call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion DstDL=DatLoc(ExtLd_u_HubMotion), & ! ExtLd%u%HubMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return + ! Nacelle motion call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion DstDL=DatLoc(ExtLd_u_NacelleMotion), & ! ExtLd%u%NacelleMotion - ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return end select @@ -1618,11 +1724,13 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & if (.not. Active) return end if - ! Get mesh pointers + ! Get mesh pointers (DstDispMesh may be found in Input for some modules: ExtLd) call FAST_OutputMeshPointer(SrcMod, Turbine, SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return call FAST_InputMeshPointer(SrcMod, Turbine, SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return call FAST_InputMeshPointer(DstMod, Turbine, DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, ErrStat2, ErrMsg2) + if (ErrStat2 == ErrID_Fatal) call FAST_InputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, INPUT_CURR, ErrStat2, ErrMsg2) + if (Failed()) return ! If any meshes aren't committed, return if (.not. (SrcMesh%committed .and. DstMesh%committed .and. SrcDispMesh%committed .and. DstDispMesh%committed)) return @@ -1646,9 +1754,6 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & return end if - call FAST_InputMeshPointer(DstMod, Turbine, DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_OutputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return - ! Create mapping description Mapping%Desc = trim(FAST_OutputFieldName(SrcMod, SrcDL))//" -> "// & trim(FAST_InputFieldName(DstMod, DstDL))// & @@ -1958,63 +2063,6 @@ subroutine SetMapVarFlags(Mapping, SrcMod, DstMod) end subroutine -! subroutine InitMeshVarLocs(Mapping, SrcMod, DstMod, SrcMesh, DstMesh, SrcDispMesh, DstDispMesh) -! type(MappingType), intent(inout) :: Mapping -! type(ModDataType), intent(inout) :: SrcMod, DstMod -! type(MeshType), intent(in) :: SrcMesh, DstMesh -! type(MeshType), optional, intent(in) :: SrcDispMesh, DstDispMesh - -! ! Get data locations for variables of source mesh fields -! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransDisp, Mapping%iVarSrcTransDisp) -! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransVel, Mapping%iVarSrcTransVel) -! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldTransAcc, Mapping%iVarSrcTransAcc) -! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldOrientation, Mapping%iVarSrcOrientation) -! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldAngularVel, Mapping%iVarSrcAngularVel) -! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldAngularAcc, Mapping%iVarSrcAngularAcc) -! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldForce, Mapping%iVarSrcForce) -! call FindVarByMeshAndField(SrcMod%Vars%y, SrcMesh%ID, FieldMoment, Mapping%iVarSrcMoment) - -! ! Get data locations for variables of destination mesh fields -! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransDisp, Mapping%iVarDstTransDisp) -! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransVel, Mapping%iVarDstTransVel) -! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldTransAcc, Mapping%iVarDstTransAcc) -! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldOrientation, Mapping%iVarDstOrientation) -! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldAngularVel, Mapping%iVarDstAngularVel) -! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldAngularAcc, Mapping%iVarDstAngularAcc) -! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldForce, Mapping%iVarDstForce) -! call FindVarByMeshAndField(DstMod%Vars%u, DstMesh%ID, FieldMoment, Mapping%iVarDstMoment) - -! if (present(SrcDispMesh)) then -! Mapping%SrcDispMeshID = SrcDispMesh%ID -! call FindVarByMeshAndField(SrcMod%Vars%u, SrcDispMesh%ID, FieldTransDisp, Mapping%iVarSrcDispTransDisp) -! end if - -! if (present(DstDispMesh)) then -! Mapping%DstDispMeshID = DstDispMesh%ID -! call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, FieldTransDisp, Mapping%iVarDstDispTransDisp) -! call FindVarByMeshAndField(DstMod%Vars%y, DstDispMesh%ID, FieldOrientation, Mapping%iVarDstDispOrientation) -! end if - -! contains -! subroutine FindVarByMeshAndField(VarAry, MeshID, Field, iVar) -! type(ModVarType), intent(in) :: VarAry(:) -! integer(IntKi), intent(in) :: MeshID, Field -! integer(IntKi), intent(out) :: iVar -! integer(IntKi) :: i - -! ! Initialize variable index to invalid value (not used) -! iVar = 0 - -! ! Loop through variables, if variable's mesh ID and field matches given values, return -! do i = 1, size(VarAry) -! if ((VarAry(i)%MeshID == MeshID) .and. (VarAry(i)%Field == Field)) then -! iVar = i -! return -! end if -! end do -! end subroutine -! end subroutine - function MeshTransferType(SrcMesh, DstMesh) result(XfrType) type(MeshType), intent(in) :: SrcMesh, DstMesh integer(IntKi) :: XfrType @@ -2115,7 +2163,7 @@ subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return - ! Get source and destination displacement meshes + ! Get source and destination displacement meshes (DstDispMesh must be in output) call FAST_InputMeshPointer(ModSrc, Turbine, Mapping%SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return call FAST_OutputMeshPointer(ModDst, Turbine, Mapping%DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return @@ -2328,6 +2376,10 @@ subroutine VarUnpackInput(ModData, Var, ValAry, T, iInput, ErrStat, ErrMsg) call BD_VarUnpackInput(Var, ValAry, T%BD%Input(iInput, ModData%Ins)) case (Module_ED) call ED_VarUnpackInput(Var, ValAry, T%ED%Input(iInput)) + case (Module_ExtLd) + call ExtLd_VarUnpackInput(Var, ValAry, T%ExtLd%u) + case (Module_ExtInfw) + call ExtInfw_VarUnpackInput(Var, ValAry, T%ExtInfw%u) case (Module_ExtPtfm) call ExtPtfm_VarUnpackInput(Var, ValAry, T%ExtPtfm%Input(iInput)) case (Module_FEAM) @@ -2344,8 +2396,6 @@ subroutine VarUnpackInput(ModData, Var, ValAry, T, iInput, ErrStat, ErrMsg) call MAP_VarUnpackInput(Var, ValAry, T%MAP%Input(iInput)) case (Module_MD) call MD_VarUnpackInput(Var, ValAry, T%MD%Input(iInput)) - case (Module_ExtInfw) - call ExtInfw_VarUnpackInput(Var, ValAry, T%ExtInfw%u) case (Module_Orca) call Orca_VarUnpackInput(Var, ValAry, T%Orca%Input(iInput)) case (Module_SD) @@ -2375,6 +2425,10 @@ subroutine VarPackOutput(ModData, Var, ValAry, T, ErrStat, ErrMsg) call BD_VarPackOutput(Var, T%BD%y(ModData%Ins), ValAry) case (Module_ED) call ED_VarPackOutput(Var, T%ED%y, ValAry) + case (Module_ExtLd) + call ExtLd_VarPackOutput(Var, T%ExtLd%y, ValAry) + case (Module_ExtInfw) + call ExtInfw_VarPackOutput(Var, T%ExtInfw%y, ValAry) case (Module_ExtPtfm) call ExtPtfm_VarPackOutput(Var, T%ExtPtfm%y, ValAry) case (Module_FEAM) @@ -2391,8 +2445,6 @@ subroutine VarPackOutput(ModData, Var, ValAry, T, ErrStat, ErrMsg) call MAP_VarPackOutput(Var, T%MAP%y, ValAry) case (Module_MD) call MD_VarPackOutput(Var, T%MD%y, ValAry) - case (Module_ExtInfw) - call ExtInfw_VarPackOutput(Var, T%ExtInfw%y, ValAry) case (Module_Orca) call Orca_VarPackOutput(Var, T%Orca%y, ValAry) case (Module_SD) @@ -2444,13 +2496,18 @@ subroutine FAST_InputSolve(iModDst, ModAry, MapAry, iInput, Turbine, ErrStat, Er ! Loop through mappings and perform input solve do i = 1, size(VarMapAry) + associate (Mapping => MapAry(VarMapAry(i)%iMapping)) - ! Skip mappings where this isn't the destination module - if (iModDst /= VarMapAry(i)%iModDst) cycle + ! Skip mappings where this isn't the destination module + if (iModDst /= VarMapAry(i)%iModDst) cycle - ! Perform input solve - call InputSolveMapping(MapAry(VarMapAry(i)%iMapping), ModAry(VarMapAry(i)%iModSrc), ModAry(VarMapAry(i)%iModDst)) - + ! Skip mappings that are not ready + if (.not. Mapping%Ready) cycle + + ! Perform input solve + call InputSolveMapping(MapAry(VarMapAry(i)%iMapping), ModAry(VarMapAry(i)%iModSrc), ModAry(VarMapAry(i)%iModDst)) + if (ErrStat >= AbortErrLev) return + end associate end do else @@ -2474,8 +2531,12 @@ subroutine FAST_InputSolve(iModDst, ModAry, MapAry, iInput, Turbine, ErrStat, Er ! Skip mappings where this isn't the destination module if (iModDst /= MapAry(i)%iModDst) cycle + ! Skip mappings that are not ready + if (.not. MapAry(i)%Ready) cycle + ! Perform input solve call InputSolveMapping(MapAry(i), ModAry(MapAry(i)%iModSrc), ModAry(MapAry(i)%iModDst)) + if (ErrStat >= AbortErrLev) return end do end if @@ -2551,20 +2612,17 @@ subroutine InputSolveMapping(Mapping, ModSrc, ModDst) if (Failed()) return ! Get source and destination displacement meshes - ! Note: source displacement mesh always references current input index + ! Note: Displacement meshes always references current input index when in input call FAST_InputMeshPointer(ModSrc, Turbine, Mapping%SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2) if (Failed()) return call FAST_OutputMeshPointer(ModDst, Turbine, Mapping%DstDispDL, DstDispMesh, ErrStat2, ErrMsg2) + if (ErrStat2 == ErrID_Fatal) call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDispDL, DstDispMesh, INPUT_CURR, ErrStat2, ErrMsg2) if (Failed()) return ! If DstDispMesh is a sibling of DstMesh if (Mapping%DstUsesSibling) then - ! Transfer the load mesh - ! call TransferMesh(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh, ErrStat2, ErrMsg2) - ! if (Failed()) return - - ! Transfer the load mesh to the temporary mesh + ! Transfer the load mesh to the temporary load mesh to be summed below call TransferMesh(Mapping%XfrType, SrcMesh, Mapping%TmpLoadMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh, ErrStat2, ErrMsg2) if (Failed()) return @@ -2573,10 +2631,6 @@ subroutine InputSolveMapping(Mapping, ModSrc, ModDst) ! Transfer destination displacement mesh to temporary motion mesh (cousin of destination load mesh) call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux, ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return - - ! Transfer the load mesh using the temporary motion mesh as the destination displacement mesh - ! call TransferMesh(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh, ErrStat2, ErrMsg2) - ! if (Failed()) return ! Transfer to temporary load mesh using the temporary motion mesh as the destination displacement mesh call TransferMesh(Mapping%XfrType, SrcMesh, Mapping%TmpLoadMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh, ErrStat2, ErrMsg2) @@ -2584,7 +2638,7 @@ subroutine InputSolveMapping(Mapping, ModSrc, ModDst) end if - ! Add loads from temporary mesh to destination mesh + ! Sum loads from temporary mesh to destination mesh if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = DstMesh%Force + Mapping%TmpLoadMesh%Force if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = DstMesh%Moment + Mapping%TmpLoadMesh%Moment @@ -2600,6 +2654,18 @@ logical function Failed() end function end subroutine +! Reset mapping read flags +subroutine FAST_ResetMappingReady(MapAry) + type(MappingType), intent(inout) :: MapAry(:) !< Mesh and variable mappings + integer(IntKi) :: i + do i = 1, size(MapAry) + select case (MapAry(i)%SrcModID) + case default ! Default to transfer is not ready + MapAry(i)%Ready = .false. + end select + end do +end subroutine + ! TransferMesh calls the specific transfer function based on ! transfer type (Point_to_Point, Point_to_Line2, etc.) subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp, ErrStat, ErrMsg) @@ -2682,6 +2748,11 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg T%ExtLd%u%az = T%ED%y%LSSTipPxa T%ExtLd%u%DX_u%bldPitch(:) = T%ED%y%BlPitch + ! Note: this may be better inside CalcOutput + call ExtLd_ConvertInpDataForExtProg(T%ExtLd%u, T%ExtLd%p, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + !------------------------------------------------------------------------------- ! InflowWind Inputs !------------------------------------------------------------------------------- @@ -2790,7 +2861,9 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg if (allocated(T%SrvD%Input(iInput)%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = 0.0 if (allocated(T%SrvD%Input(iInput)%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = 0.0 if (allocated(T%SrvD%Input(iInput)%MsrPositionsz)) T%SrvD%Input(iInput)%MsrPositionsz = 0.0 - T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + ! the nacelle yaw error estimate (positive about zi-axis) + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle case (Custom_ExtLd_to_SrvD) @@ -2805,7 +2878,9 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg if (allocated(T%SrvD%Input(iInput)%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = 0.0 if (allocated(T%SrvD%Input(iInput)%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = 0.0 if (allocated(T%SrvD%Input(iInput)%MsrPositionsz)) T%SrvD%Input(iInput)%MsrPositionsz = 0.0 - T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + ! the nacelle yaw error estimate (positive about zi-axis) + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle !------------------------------------------------------------------------------- ! Unknown Mapping diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index b7f729111c..f3bf41146b 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -98,7 +98,7 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS ! Get array of module IDs modIDs = [(GlueModData(i)%ID, i=1, size(GlueModData))] - ! Indices of all modules in Step 0 initialization order + ! Indices of all modules in Step 0 initialization order (SrvD inputs) p%iModInit = [pack(modInds, ModIDs == Module_ED), & pack(modInds, ModIDs == Module_BD), & pack(modInds, ModIDs == Module_SD), & @@ -125,6 +125,7 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS pack(modInds, ModIDs == Module_IfW), & pack(modInds, ModIDs == Module_SeaSt), & pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_ExtLd), & pack(modInds, ModIDs == Module_FEAM), & pack(modInds, ModIDs == Module_IceD), & pack(modInds, ModIDs == Module_IceF), & @@ -697,7 +698,7 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er m%StateCurr%x = 0.0_R8Ki ! Reset mapping ready for transfer flag - GlueModMaps%Ready = .false. + call FAST_ResetMappingReady(GlueModMaps) ! Initialize temporary input structure for TC and Option1 modules do i = 1, size(m%Mod%ModData) @@ -1019,7 +1020,7 @@ subroutine FAST_SolverStep(n_t_global, t_initial, p, m, GlueModData, GlueModMaps do while (CorrIter <= NumCorrections) ! Reset mapping ready flags - GlueModMaps%Ready = .false. + call FAST_ResetMappingReady(GlueModMaps) ! Copy TC solver states from current to predicted call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_UPDATECOPY, ErrStat2, ErrMsg2) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 0790fef794..fec0651eda 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -700,28 +700,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, BD ! External Loads !---------------------------------------------------------------------------- - IF ( p_FAST%CompAero == Module_ExtLd ) THEN + IF ( (p_FAST%CompAero == Module_ExtLd) .and. PRESENT(ExternInitData) ) THEN - IF ( PRESENT(ExternInitData) ) THEN - - ! set initialization data for ExtLoads - CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) - CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) - if (Failed()) return - - CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return - - ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%ModData, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & - Init%OutData_ExtLd%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) - if (Failed()) return + ! set initialization data for ExtLoads + CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) + CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) + if (Failed()) return - AirDens = Init%OutData_ExtLd%AirDens + ! Add module to list of modules, return on error + CALL MV_AddModule(m_Glue%ModData, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + Init%OutData_ExtLd%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return - p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. + AirDens = Init%OutData_ExtLd%AirDens + AD%p%FlowField => Init%OutData_ExtLd%FlowField - END IF + p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. END IF diff --git a/reg_tests/executeOpenfastCppRegressionCase.py b/reg_tests/executeOpenfastCppRegressionCase.py index 2f52094f6b..d00e193373 100644 --- a/reg_tests/executeOpenfastCppRegressionCase.py +++ b/reg_tests/executeOpenfastCppRegressionCase.py @@ -29,7 +29,7 @@ import glob ##### Helper functions -excludeExt=['.out','.outb','.ech','.sum','.log'] +excludeExt=['.ech','.sum','.log'] ##### Main program @@ -101,7 +101,8 @@ shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.outb':'.ref.outb', '.out':'.ref.out'}) ### Run openfast on the test case if not noExec: diff --git a/reg_tests/r-test b/reg_tests/r-test index c51f6e1cc8..367abe0641 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit c51f6e1cc824cdb3bf1ffb5cd2d7622187197e32 +Subproject commit 367abe0641267b7f3c13b671e228dfbb2b3b8d49 From 8f512dfe42fb33ab659a82fd5c042a5919b69d06 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 31 Aug 2024 14:27:33 +0000 Subject: [PATCH 222/319] Fix blade structural control in FAST_Mapping --- modules/openfast-library/src/FAST_Mapping.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index a82230a4d4..50c7415a55 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -614,7 +614,7 @@ subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ExtLd_y_BladeLoad, DstMod%Ins), & ! ExtLd%y%BladeLoad(DstMod%Ins), & - SrcDispDL=DatLoc(ExtLd_u_BladeMotion, DstMod%Ins), & ! ExtLd%u%BStCMotionMesh(DstMod%Ins) + SrcDispDL=DatLoc(ExtLd_u_BladeMotion, DstMod%Ins), & ! ExtLd%u%BladeMotion(DstMod%Ins) DstDL=DatLoc(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad DstDispDL=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2) @@ -892,13 +892,13 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapCustom(Mappings, Custom_SrvD_to_ED, SrcMod, DstMod) ! Blade Structural Controller (if ElastoDyn is used for blades) - do j = 1, Turbine%SrvD%p%NumBStC - do i = 1, Turbine%ED%p%NumBl + do j = 1, size(Turbine%SrvD%Input(1)%BStCMotionMesh, 2) ! Number of controllers + do i = 1, size(Turbine%SrvD%Input(1)%BStCMotionMesh, 1) ! Number of blades call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & SrcDispDL=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) - DstDL=DatLoc(ED_u_BladePtLoads, j), & ! ED%u%BladePtLoads(j) - DstDispDL=DatLoc(ED_y_BladeLn2Mesh, j), & ! ED%y%BladeLn2Mesh(j) + DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) Active=Turbine%p_FAST%CompElast == Module_ED, & ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return From 639b0a506d8f0bd744d8d41fb4c88fa593f6ab43 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 31 Aug 2024 14:30:16 +0000 Subject: [PATCH 223/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 367abe0641..4661f35c76 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 367abe0641267b7f3c13b671e228dfbb2b3b8d49 +Subproject commit 4661f35c7675e338a02a4e88f754b841628c292e From 410d5163058f1b3b5a97e29d8ec78981a936f638 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 31 Aug 2024 14:51:20 +0000 Subject: [PATCH 224/319] Fix FAST_Mapping again --- modules/openfast-library/src/FAST_Mapping.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 50c7415a55..20a680e3e4 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -892,8 +892,8 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapCustom(Mappings, Custom_SrvD_to_ED, SrcMod, DstMod) ! Blade Structural Controller (if ElastoDyn is used for blades) - do j = 1, size(Turbine%SrvD%Input(1)%BStCMotionMesh, 2) ! Number of controllers - do i = 1, size(Turbine%SrvD%Input(1)%BStCMotionMesh, 1) ! Number of blades + do j = 1, Turbine%SrvD%p%NumBStC + do i = 1, Turbine%ED%p%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & SrcDispDL=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) From 36c73bc29608158b9201ecbef5401f87256442ee Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 4 Sep 2024 17:00:47 +0000 Subject: [PATCH 225/319] Update remap flat reset function to use mesh pointers --- modules/openfast-library/src/FAST_Mapping.f90 | 190 ++++-------------- 1 file changed, 36 insertions(+), 154 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 20a680e3e4..bdd205d41d 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -32,6 +32,7 @@ module FAST_Mapping public :: FAST_ResetRemapFlags public :: FAST_InputSolve public :: FAST_ResetMappingReady +public :: FAST_InputFieldName, FAST_OutputFieldName integer(IntKi), parameter :: Xfr_Invalid = 0, & Xfr_Point_to_Point = 1, & @@ -907,9 +908,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Nacelle Structural Controller do j = 1, Turbine%SrvD%p%NumNStC - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & SrcDL=DatLoc(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & SrcDispDL=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + DstMod=DstMod, & DstDL=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads DstDispDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2) @@ -918,9 +921,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Tower Structural Controller do j = 1, Turbine%SrvD%p%NumTStC - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & SrcDL=DatLoc(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & SrcDispDL=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + DstMod=DstMod, & DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerLoads DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2) @@ -929,9 +934,11 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Substructure Structural Controller do j = 1, Turbine%SrvD%p%NumSStC - call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & SrcDL=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & SrcDispDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstMod=DstMod, & DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh Active=Turbine%p_FAST%CompSub /= Module_SD, & @@ -2895,177 +2902,52 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg end subroutine -subroutine SumMeshLoads(SrcMesh, DstMesh, DstResetFlag) - type(MeshType), intent(in) :: SrcMesh - type(MeshType), intent(inout) :: DstMesh - logical, intent(inout) :: DstResetFlag - if (DstResetFlag) then - DstResetFlag = .false. - if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = 0.0_ReKi - if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = 0.0_ReKi - end if - if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = DstMesh%Force + SrcMesh%Force - if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = DstMesh%Moment + SrcMesh%Moment -end subroutine - subroutine FAST_ResetRemapFlags(Mods, Maps, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mods(:) !< Module data - type(MappingType), intent(inout) :: Maps(:) - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg + type(ModDataType), intent(in) :: Mods(:) !< Module data + type(MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg character(*), parameter :: RoutineName = 'FAST_ResetRemapFlags' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, k + type(MeshType), pointer :: SrcMesh, DstMesh ErrStat = ErrID_None ErrMsg = '' - ! Reset remap flags in mapping temporary meshes + ! Reset remap flags in mapping meshes do i = 1, size(Maps) - if (associated(Maps(i)%TmpLoadMesh%RemapFlag)) Maps(i)%TmpLoadMesh%RemapFlag = .false. - end do - - do i = 1, size(Mods) - - ! Select based on module ID - select case (Mods(i)%ID) - - case (Module_AD) - - if (T%AD%Input(1)%rotors(1)%HubMotion%Committed) then - T%AD%Input(1)%rotors(1)%HubMotion%RemapFlag = .false. - T%AD%y%rotors(1)%HubLoad%RemapFlag = .false. - end if - - if (T%AD%Input(1)%rotors(1)%TowerMotion%Committed) then - T%AD%Input(1)%rotors(1)%TowerMotion%RemapFlag = .false. - - if (T%AD%y%rotors(1)%TowerLoad%Committed) then - T%AD%y%rotors(1)%TowerLoad%RemapFlag = .false. - end if - end if - - if (T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) then - T%AD%Input(1)%rotors(1)%NacelleMotion%RemapFlag = .false. - T%AD%y%rotors(1)%NacelleLoad%RemapFlag = .false. - end if - - if (T%AD%Input(1)%rotors(1)%TFinMotion%Committed) then - T%AD%Input(1)%rotors(1)%TFinMotion%RemapFlag = .false. - T%AD%y%rotors(1)%TFinLoad%RemapFlag = .false. - end if - - do k = 1, size(T%AD%Input(1)%rotors(1)%BladeMotion) - T%AD%Input(1)%rotors(1)%BladeRootMotion(k)%RemapFlag = .false. - T%AD%Input(1)%rotors(1)%BladeMotion(k)%RemapFlag = .false. - T%AD%y%rotors(1)%BladeLoad(k)%RemapFlag = .false. - end do + select case (Maps(i)%MapType) + case (Map_LoadMesh, Map_MotionMesh) - case (Module_BD) + if (associated(Maps(i)%TmpLoadMesh%RemapFlag)) Maps(i)%TmpLoadMesh%RemapFlag = .false. + if (associated(Maps(i)%TmpMotionMesh%RemapFlag)) Maps(i)%TmpMotionMesh%RemapFlag = .false. - T%BD%Input(1, Mods(i)%Ins)%RootMotion%RemapFlag = .false. - T%BD%Input(1, Mods(i)%Ins)%PointLoad%RemapFlag = .false. - T%BD%Input(1, Mods(i)%Ins)%DistrLoad%RemapFlag = .false. - T%BD%Input(1, Mods(i)%Ins)%HubMotion%RemapFlag = .false. - - T%BD%y(Mods(i)%Ins)%ReactionForce%RemapFlag = .false. - T%BD%y(Mods(i)%Ins)%BldMotion%RemapFlag = .false. - - case (Module_ED) - - T%ED%Input(1)%PlatformPtMesh%RemapFlag = .false. - T%ED%y%PlatformPtMesh%RemapFlag = .false. - T%ED%Input(1)%TowerPtLoads%RemapFlag = .false. - T%ED%y%TowerLn2Mesh%RemapFlag = .false. - do K = 1, size(T%ED%y%BladeRootMotion) - T%ED%y%BladeRootMotion(K)%RemapFlag = .false. - end do - if (allocated(T%ED%Input(1)%BladePtLoads)) then - do K = 1, size(T%ED%Input(1)%BladePtLoads) - T%ED%Input(1)%BladePtLoads(K)%RemapFlag = .false. - T%ED%y%BladeLn2Mesh(K)%RemapFlag = .false. - end do - end if - T%ED%Input(1)%NacelleLoads%RemapFlag = .false. - T%ED%y%NacelleMotion%RemapFlag = .false. - T%ED%Input(1)%TFinCMLoads%RemapFlag = .false. - T%ED%y%TFinCMMotion%RemapFlag = .false. - T%ED%Input(1)%HubPtLoad%RemapFlag = .false. - T%ED%y%HubPtMotion%RemapFlag = .false. - - case (Module_ExtPtfm) - - if (T%ExtPtfm%Input(1)%PtfmMesh%Committed) then - T%ExtPtfm%Input(1)%PtfmMesh%RemapFlag = .false. - T%ExtPtfm%y%PtfmMesh%RemapFlag = .false. - end if - - case (Module_FEAM) - - T%FEAM%Input(1)%PtFairleadDisplacement%RemapFlag = .false. - T%FEAM%y%PtFairleadLoad%RemapFlag = .false. - - case (Module_HD) - - T%HD%Input(1)%PRPMesh%RemapFlag = .false. - if (T%HD%Input(1)%WAMITMesh%Committed) then - T%HD%Input(1)%WAMITMesh%RemapFlag = .false. - T%HD%y%WAMITMesh%RemapFlag = .false. - end if - if (T%HD%Input(1)%Morison%Mesh%Committed) then - T%HD%Input(1)%Morison%Mesh%RemapFlag = .false. - T%HD%y%Morison%Mesh%RemapFlag = .false. - end if - - case (Module_IceD) - - if (T%IceD%Input(1, Mods(i)%Ins)%PointMesh%Committed) then - T%IceD%Input(1, Mods(i)%Ins)%PointMesh%RemapFlag = .false. - T%IceD%y(Mods(i)%Ins)%PointMesh%RemapFlag = .false. - end if - - case (Module_IceF) - - if (T%IceF%Input(1)%iceMesh%Committed) then - T%IceF%Input(1)%iceMesh%RemapFlag = .false. - T%IceF%y%iceMesh%RemapFlag = .false. - end if - - case (Module_MAP) - - T%MAP%Input(1)%PtFairDisplacement%RemapFlag = .false. - T%MAP%y%PtFairleadLoad%RemapFlag = .false. - - case (Module_MD) - - T%MD%Input(1)%CoupledKinematics(1)%RemapFlag = .false. - T%MD%y%CoupledLoads(1)%RemapFlag = .false. - - case (Module_Orca) + call FAST_OutputMeshPointer(Mods(Maps(i)%iModSrc), T, Maps(i)%SrcDL, SrcMesh, ErrStat2, ErrMsg2) + if (Failed()) return + SrcMesh%RemapFlag = .false. - T%Orca%Input(1)%PtfmMesh%RemapFlag = .false. - T%Orca%y%PtfmMesh%RemapFlag = .false. + call FAST_InputMeshPointer(Mods(Maps(i)%iModDst), T, Maps(i)%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2) + if (Failed()) return + DstMesh%RemapFlag = .false. - case (Module_SD) + ! call FAST_OutputMeshPointer(Mods(Maps(i)%SrcModID), T, Maps(i)%SrcDL, SrcMesh, ErrStat2, ErrMsg2) + ! if (ErrStat2 == ErrID_None) SrcMesh%RemapFlag = .false. - if (T%SD%Input(1)%TPMesh%Committed) then - T%SD%Input(1)%TPMesh%RemapFlag = .false. - T%SD%y%Y1Mesh%RemapFlag = .false. - end if - - if (T%SD%Input(1)%LMesh%Committed) then - T%SD%Input(1)%LMesh%RemapFlag = .false. - T%SD%y%Y2Mesh%RemapFlag = .false. - T%SD%y%Y3Mesh%RemapFlag = .false. - end if + ! call FAST_InputMeshPointer(Mods(Maps(i)%DstModID), T, Maps(i)%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2) + ! if (ErrStat2 == ErrID_None) DstMesh%RemapFlag = .false. end select - end do +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function end subroutine end module From bc551ce8396b987e59c6d72c3a9b1c894e489051 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 4 Sep 2024 17:01:12 +0000 Subject: [PATCH 226/319] improve flag usage in elastodyn --- modules/elastodyn/src/ElastoDyn.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 2066ca7ec8..c4dcfa1781 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -10913,7 +10913,7 @@ subroutine ED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, E if (allocated(u%BladePtLoads)) then do i = 1, p%NumBl Flags = VF_None - if (i == 1) Flags = VF_AeroMap + if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddMeshVar(Vars%u, "Blade "//Num2LStr(i), LoadFields, & DL=DatLoc(ED_u_BladePtLoads, i), & Mesh=u%BladePtLoads(i), & @@ -10992,7 +10992,7 @@ subroutine ED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, E if (allocated(y%BladeLn2Mesh))then do i = 1, p%NumBl Flags = VF_None - if (i == 1) Flags = VF_AeroMap + if (i == 1) Flags = ior(Flags, VF_AeroMap) call MV_AddMeshVar(Vars%y, 'Blade '//Num2LStr(i), [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & DatLoc(ED_y_BladeLn2Mesh, i), & Flags=Flags, & From 1bef93f5444934ace70d36d8c6595177f81d6873 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 4 Sep 2024 17:01:45 +0000 Subject: [PATCH 227/319] Improve method for select vars used in TC solve --- .../openfast-library/src/FAST_SolverTC.f90 | 215 +++++++++++------- 1 file changed, 133 insertions(+), 82 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index f3bf41146b..2f63c540d5 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -199,123 +199,174 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS contains + ! SetVarSolveFlags adds the VF_Solve flags to variables in Option 1 modules + ! which need to be in the tight couping solver Jacobian. subroutine SetVarSolveFlags() - ! Loop through tight coupling modules and add VF_Solve flag to + logical :: SrcModTC, SrcModO1 + logical :: DstModTC, DstModO1 + logical :: HasSolveFlag + + ! Loop through tight coupling modules and add VF_Solve flag to continuous state variables do i = 1, size(p%iModTC) associate (ModData => GlueModData(p%iModTC(i))) do j = 1, size(ModData%Vars%x) - call MV_SetFlags(ModData%Vars%x(j), VF_Solve) ! Continuous state variables + call MV_SetFlags(ModData%Vars%x(j), VF_Solve) end do end associate end do + ! dUdu + ! VarsDst%u, VarDst(FieldTransDisp), VarsDst%u, VarDst(FieldTransVel) + ! VarsDst%u, VarDst(FieldTransDisp), VarsDst%u, VarDst(FieldTransAcc) + ! VarsSrc%u, VarSrcDisp(FieldTransDisp), VarsDst%u, VarDst(FieldMoment) + + ! dUdy Loads + ! VarsSrc%y, VarSrc(FieldForce), VarsDst%u, VarDst(FieldForce) + ! VarsSrc%y, VarSrc(FieldMoment), VarsDst%u, VarDst(FieldMoment) + ! VarsSrc%y, VarSrc(FieldForce), VarsDst%u, VarDst(FieldMoment) + ! VarsDst%y, VarDstDisp(FieldTransDisp), VarsDst%u, VarDst(FieldMoment) + ! VarsDst%y, VarDstDisp(FieldTransDisp), VarsDst%u, VarDst(FieldMoment) + ! VarsDst%y, VarDstDisp(FieldOrientation), VarsDst%u, VarDst(FieldMoment) + + ! dUdy Motions + ! VarsSrc%y, VarSrc(FieldTransDisp), VarsDst%u, VarDst(FieldTransDisp) + ! VarsSrc%y, VarSrc(FieldOrientation), VarsDst%u, VarDst(FieldOrientation) + ! VarsSrc%y, VarSrc(FieldTransVel), VarsDst%u, VarDst(FieldTransVel) + ! VarsSrc%y, VarSrc(FieldAngularVel), VarsDst%u, VarDst(FieldAngularVel) + ! VarsSrc%y, VarSrc(FieldTransAcc), VarsDst%u, VarDst(FieldTransAcc) + ! VarsSrc%y, VarSrc(FieldAngularAcc), VarsDst%u, VarDst(FieldAngularAcc) + ! VarsSrc%y, VarSrc(FieldOrientation), VarsDst%u, VarDst(FieldTransDisp) + ! VarsSrc%y, VarSrc(FieldAngularVel), VarsDst%u, VarDst(FieldTransVel) + ! VarsSrc%y, VarSrc(FieldAngularAcc), VarsDst%u, VarDst(FieldTransAcc) + ! VarsSrc%y, VarSrc(FieldTransDisp), VarsDst%u, VarDst(FieldTransVel) + ! VarsSrc%y, VarSrc(FieldTransDisp), VarsDst%u, VarDst(FieldTransAcc) + ! VarsSrc%y, VarSrc(FieldAngularVel), VarsDst%u, VarDst(FieldTransAcc) + ! Loop through module mappings do j = 1, size(GlueModMaps) associate (Mapping => GlueModMaps(j), & SrcMod => GlueModData(GlueModMaps(j)%iModSrc), & DstMod => GlueModData(GlueModMaps(j)%iModDst)) - ! Skip custom mapping types - if (Mapping%MapType == Map_Variable .or. Mapping%MapType == Map_Custom) cycle + ! Determine if source and destination modules are in tight coupling or Option 1 + SrcModTC = any(SrcMod%ID == TC_Modules) + SrcModO1 = any(SrcMod%ID == O1_Modules) + DstModTC = any(DstMod%ID == TC_Modules) + DstModO1 = any(DstMod%ID == O1_Modules) - ! Skip mappings where source and destination are not in tight coupling - if (all(SrcMod%ID /= TC_Modules) .and. all(DstMod%ID /= TC_Modules)) cycle + ! Select based on mapping type + select case (Mapping%MapType) + case (Map_MotionMesh) - ! If source module is in tight coupling - if (any(SrcMod%ID == TC_Modules)) then + ! Add flag based on module locations + if (SrcModTC .and. DstModTC) then - ! Set mapping flag on source variables - do i = 1, size(SrcMod%Vars%y) - associate (Var => SrcMod%Vars%y(i)) - if (MV_EqualDL(Mapping%SrcDL, Var%DL)) call MV_SetFlags(Var, VF_Solve) - end associate - end do + ! Add flag for source displacement, velocity, and acceleration + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + write (*,*) 'Solve y:', FAST_OutputFieldName(SrcMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if + end associate + end do - ! Set mapping flag on source displacement mesh variables - if (Mapping%MapType == Map_LoadMesh) then - do i = 1, size(SrcMod%Vars%u) - associate (Var => SrcMod%Vars%u(i)) - if (MV_EqualDL(Mapping%SrcDispDL, Var%DL)) call MV_SetFlags(Var, VF_Solve) + ! Add flag for destination displacement, velocity, and acceleration + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + write (*,*) 'Solve u:', FAST_InputFieldName(DstMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if end associate end do - end if - end if - ! If source module is in option 1 - if (any(SrcMod%ID == O1_Modules)) then - - ! Set mapping flag on source variables - do i = 1, size(SrcMod%Vars%y) - associate (Var => SrcMod%Vars%y(i)) - if (.not. MV_EqualDL(Mapping%SrcDL, Var%DL)) cycle - select case (Var%Field) - case (FieldForce, FieldMoment) - call MV_SetFlags(Var, VF_Solve) - end select - end associate - end do - - ! Set mapping flag on source displacement mesh variables - if (Mapping%MapType == Map_LoadMesh) then - do i = 1, size(SrcMod%Vars%u) - associate (Var => SrcMod%Vars%u(i)) - if (.not. MV_EqualDL(Mapping%SrcDispDL, Var%DL)) cycle - select case (Var%Field) - case (FieldForce, FieldMoment) + else if ((SrcModTC .and. DstModO1) .or. & + (SrcModO1 .and. DstModTC) .or. & + (SrcModO1 .and. DstModO1)) then + + ! Add flag for source displacement, velocity, acceleration for dUdy + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then call MV_SetFlags(Var, VF_Solve) - end select + write (*,*) 'Solve y:', FAST_OutputFieldName(SrcMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if + end associate + end do + + ! Add flag for destination accelerations + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) then + select case (Var%Field) + case (FieldTransAcc, FieldAngularAcc) + call MV_SetFlags(Var, VF_Solve) + write (*,*) 'Solve u:', FAST_InputFieldName(DstMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end select + end if end associate end do end if - end if - ! If destination module is in tight coupling - if (any(DstMod%ID == TC_Modules)) then + case (Map_LoadMesh) - ! Set mapping flag on destination variables - do i = 1, size(DstMod%Vars%u) - associate (Var => DstMod%Vars%u(i)) - if (MV_EqualDL(Mapping%DstDL, Var%DL)) call MV_SetFlags(Var, VF_Solve) - end associate - end do + if (DstModTC .or. DstModO1) then - ! Set mapping flag on destination displacement mesh variables - if (Mapping%MapType == Map_LoadMesh) then - do i = 1, size(DstMod%Vars%y) - associate (Var => DstMod%Vars%y(i)) - if (MV_EqualDL(Mapping%DstDispDL, Var%DL)) call MV_SetFlags(Var, VF_Solve) + ! Add flag for destination loads + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + write (*,*) 'Solve u:', FAST_InputFieldName(DstMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if end associate end do - end if - end if - ! If destination module is in option 1 - if (any(DstMod%ID == O1_Modules)) then - - ! Set mapping flag on destination variables - do i = 1, size(DstMod%Vars%u) - associate (Var => DstMod%Vars%u(i)) - if (.not. MV_EqualDL(Mapping%DstDL, Var%DL)) cycle - select case (Var%Field) - case (FieldTransAcc, FieldAngularAcc) - call MV_SetFlags(Var, VF_Solve) - end select - end associate - end do - - ! Set mapping flag on destination displacement mesh variables - if (Mapping%MapType == Map_LoadMesh) then + ! Add flag to destination displacements for dUdy do i = 1, size(DstMod%Vars%y) associate (Var => DstMod%Vars%y(i)) - if (.not. MV_EqualDL(Mapping%DstDispDL, Var%DL)) cycle - select case (Var%Field) - case (FieldTransAcc, FieldAngularAcc) - call MV_SetFlags(Var, VF_Solve) - end select + if (MV_EqualDL(Mapping%DstDispDL, Var%DL)) then + select case (Var%Field) + case (FieldTransDisp, FieldOrientation) + call MV_SetFlags(Var, VF_Solve) + write (*,*) 'Solve y:', FAST_OutputFieldName(DstMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end select + end if end associate end do + + if ((SrcModTC .or. SrcModO1)) then + + ! Add flag for source loads + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + write (*,*) 'Solve y:', FAST_OutputFieldName(SrcMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if + end associate + end do + + ! Add flag for source translation displacement for dUdu + do i = 1, size(SrcMod%Vars%u) + associate (Var => SrcMod%Vars%u(i)) + if (MV_EqualDL(Mapping%SrcDispDL, Var%DL)) then + select case (Var%Field) + case (FieldTransDisp) + call MV_SetFlags(Var, VF_Solve) + write (*,*) 'Solve u:', FAST_InputFieldName(SrcMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end select + end if + end associate + end do + + end if + end if - end if + + end select + end associate end do end subroutine @@ -642,7 +693,7 @@ subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, Er integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'Solver_Step0' + character(*), parameter :: RoutineName = 'FAST_SolverStep0' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j, k From 8669b9af265e9ebe4da84a9f263ef77df4d73b75 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 4 Sep 2024 18:56:08 +0000 Subject: [PATCH 228/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 4661f35c76..33e6422064 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 4661f35c7675e338a02a4e88f754b841628c292e +Subproject commit 33e64220647b8a123a7684eb8f3e2f861231a73f From 3023d8eaeabfdb1c6332e90d98b7559dd0f7818e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 4 Sep 2024 20:35:44 +0000 Subject: [PATCH 229/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 33e6422064..cc0bb3bcb6 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 33e64220647b8a123a7684eb8f3e2f861231a73f +Subproject commit cc0bb3bcb6f1f81322a73cdb2abe0821b5947217 From 711df68800b30d73cd198c462d0ea27f5f8985e3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 7 Sep 2024 07:17:39 -0400 Subject: [PATCH 230/319] Change field strings in ModVar.f90 --- modules/nwtc-library/src/ModVar.f90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 745de1227a..845046a116 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -124,23 +124,25 @@ function MV_FieldString(Field) result(str) character(16) :: str select case (Field) case (FieldAngularAcc) - str = "FieldAngularAcc" + str = "AngularAcc" case (FieldAngularDisp) - str = "FieldAngularDisp" + str = "AngularDisp" case (FieldAngularVel) - str = "FieldAngularVel" + str = "AngularVel" case (FieldForce) - str = "FieldForce" + str = "Force" case (FieldMoment) - str = "FieldMoment" + str = "Moment" case (FieldOrientation) - str = "FieldOrientation" + str = "Orientation" case (FieldTransAcc) - str = "FieldTransAcc" + str = "TransAcc" case (FieldTransDisp) - str = "FieldTransDisp" + str = "TransDisp" case (FieldTransVel) - str = "FieldTransVel" + str = "TransVel" + case (FieldScalar) + str = "Scalar" case default str = "Unknown" end select From ffc4cdb4183c0d471a83418e2b6f8ea04f6ced29 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 7 Sep 2024 07:18:39 -0400 Subject: [PATCH 231/319] Fix SD->HD mapping with Y2Mesh in FAST_Mapping --- modules/openfast-library/src/FAST_Mapping.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index bdd205d41d..c8120cd64c 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1500,14 +1500,14 @@ subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) SrcDL=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh SrcDispDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + DstDispDL=DatLoc(SD_y_y2Mesh), & ! SD%y%y2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh SrcDispDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh - DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + DstDispDL=DatLoc(SD_y_y2Mesh), & ! SD%y%y2Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return case (Module_IceD) From 373a523858d3b1920001059bec8f0598d527706b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 7 Sep 2024 07:20:04 -0400 Subject: [PATCH 232/319] Cleanup in FAST_Mapping --- modules/openfast-library/src/FAST_Mapping.f90 | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index c8120cd64c..1477e6f468 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -1765,7 +1765,7 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & Mapping%Desc = trim(FAST_OutputFieldName(SrcMod, SrcDL))//" -> "// & trim(FAST_InputFieldName(DstMod, DstDL))// & " ["//trim(FAST_InputFieldName(SrcMod, SrcDispDL))// & - " -> "//trim(FAST_OutputFieldName(DstMod, DstDispDL))//"]" + " @ "//trim(FAST_OutputFieldName(DstMod, DstDispDL))//"]" ! Initialize mapping structure Mapping%MapType = Map_LoadMesh @@ -2572,9 +2572,6 @@ subroutine InputSolveMapping(Mapping, ModSrc, ModDst) type(MeshType), pointer :: SrcMesh, DstMesh type(MeshType), pointer :: SrcDispMesh, DstDispMesh - ! Return if mapping is not ready - if (.not. Mapping%Ready) return - ! Select based on type of mapping select case (Mapping%MapType) @@ -2934,12 +2931,6 @@ subroutine FAST_ResetRemapFlags(Mods, Maps, T, ErrStat, ErrMsg) if (Failed()) return DstMesh%RemapFlag = .false. - ! call FAST_OutputMeshPointer(Mods(Maps(i)%SrcModID), T, Maps(i)%SrcDL, SrcMesh, ErrStat2, ErrMsg2) - ! if (ErrStat2 == ErrID_None) SrcMesh%RemapFlag = .false. - - ! call FAST_InputMeshPointer(Mods(Maps(i)%DstModID), T, Maps(i)%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2) - ! if (ErrStat2 == ErrID_None) DstMesh%RemapFlag = .false. - end select end do From 2634482d49238e0f3c0956a9e1e1ac71138f56a4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 7 Sep 2024 07:20:22 -0400 Subject: [PATCH 233/319] Add solve debug output in FAST_SolverTC --- .../openfast-library/src/FAST_SolverTC.f90 | 34 ++++++++++++++----- 1 file changed, 26 insertions(+), 8 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 2f63c540d5..9160e0a93f 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -266,7 +266,6 @@ subroutine SetVarSolveFlags() associate (Var => SrcMod%Vars%y(i)) if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then call MV_SetFlags(Var, VF_Solve) - write (*,*) 'Solve y:', FAST_OutputFieldName(SrcMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end if end associate end do @@ -276,7 +275,6 @@ subroutine SetVarSolveFlags() associate (Var => DstMod%Vars%u(i)) if (MV_EqualDL(Mapping%DstDL, Var%DL)) then call MV_SetFlags(Var, VF_Solve) - write (*,*) 'Solve u:', FAST_InputFieldName(DstMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end if end associate end do @@ -290,7 +288,6 @@ subroutine SetVarSolveFlags() associate (Var => SrcMod%Vars%y(i)) if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then call MV_SetFlags(Var, VF_Solve) - write (*,*) 'Solve y:', FAST_OutputFieldName(SrcMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end if end associate end do @@ -302,7 +299,6 @@ subroutine SetVarSolveFlags() select case (Var%Field) case (FieldTransAcc, FieldAngularAcc) call MV_SetFlags(Var, VF_Solve) - write (*,*) 'Solve u:', FAST_InputFieldName(DstMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end select end if end associate @@ -318,7 +314,6 @@ subroutine SetVarSolveFlags() associate (Var => DstMod%Vars%u(i)) if (MV_EqualDL(Mapping%DstDL, Var%DL)) then call MV_SetFlags(Var, VF_Solve) - write (*,*) 'Solve u:', FAST_InputFieldName(DstMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end if end associate end do @@ -330,7 +325,6 @@ subroutine SetVarSolveFlags() select case (Var%Field) case (FieldTransDisp, FieldOrientation) call MV_SetFlags(Var, VF_Solve) - write (*,*) 'Solve y:', FAST_OutputFieldName(DstMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end select end if end associate @@ -343,7 +337,6 @@ subroutine SetVarSolveFlags() associate (Var => SrcMod%Vars%y(i)) if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then call MV_SetFlags(Var, VF_Solve) - write (*,*) 'Solve y:', FAST_OutputFieldName(SrcMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end if end associate end do @@ -355,7 +348,6 @@ subroutine SetVarSolveFlags() select case (Var%Field) case (FieldTransDisp) call MV_SetFlags(Var, VF_Solve) - write (*,*) 'Solve u:', FAST_InputFieldName(SrcMod, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end select end if end associate @@ -369,6 +361,32 @@ subroutine SetVarSolveFlags() end associate end do + + if (DebugSolver) then + do i = 1, size(GlueModData) + associate (ModData => GlueModData(i)) + if (allocated(ModData%Vars%u)) then + do j = 1, size(ModData%Vars%u) + associate (Var => ModData%Vars%u(j)) + if (MV_HasFlagsAny(Var, VF_Solve)) then + write (*,*) 'Solve u:', FAST_InputFieldName(ModData, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if + end associate + end do + end if + if (allocated(ModData%Vars%y)) then + do j = 1, size(ModData%Vars%y) + associate (Var => ModData%Vars%y(j)) + if (MV_HasFlagsAny(Var, VF_Solve)) then + write (*,*) 'Solve y:', FAST_OutputFieldName(ModData, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if + end associate + end do + end if + end associate + end do + end if + end subroutine logical function Failed() From 0b591341690dc45537844ff5b78a10019ce5de66 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 9 Sep 2024 18:56:45 +0000 Subject: [PATCH 234/319] Perf improvements to Conv_Radiation and SeaSt_WaveField --- modules/hydrodyn/src/Conv_Radiation.f90 | 97 ++++++++------- modules/hydrodyn/src/Conv_Radiation.txt | 2 +- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 2 +- modules/seastate/src/SeaSt_WaveField.f90 | 114 +++++++++--------- 4 files changed, 112 insertions(+), 103 deletions(-) diff --git a/modules/hydrodyn/src/Conv_Radiation.f90 b/modules/hydrodyn/src/Conv_Radiation.f90 index 59842ddd2c..7bfa90c169 100644 --- a/modules/hydrodyn/src/Conv_Radiation.f90 +++ b/modules/hydrodyn/src/Conv_Radiation.f90 @@ -164,14 +164,14 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E RETURN END IF - ALLOCATE ( p%RdtnKrnl (0:p%NStepRdtn-1,6*p%NBody,6*p%NBody) , STAT=ErrStat ) + ALLOCATE ( p%RdtnKrnl (6*p%NBody,6*p%NBody,0:p%NStepRdtn-1) , STAT=ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating memory for the RdtnKrnl array.' ErrStat = ErrID_Fatal RETURN END IF - ALLOCATE ( xd%XDHistory(0:p%NStepRdtn ,6*p%NBody ) , STAT=ErrStat ) ! In the numerical convolution we must have NStepRdtn1 elements within the XDHistory array, which is one more than the NStepRdtn elements that are in the RdtnKrnl array + ALLOCATE ( xd%XDHistory(6*p%NBody,0:p%NStepRdtn) , STAT=ErrStat ) ! In the numerical convolution we must have NStepRdtn1 elements within the XDHistory array, which is one more than the NStepRdtn elements that are in the RdtnKrnl array IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating memory for the XDHistory array.' ErrStat = ErrID_Fatal @@ -181,7 +181,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E ! Initialize all elements of the xd%XDHistory array with the intial values of u%Velocity DO K = 0,p%NStepRdtn-1 DO J = 1,6*p%NBody ! Loop through all DOFs - xd%XDHistory(K,J) = u%Velocity(J) + xd%XDHistory(J,K) = u%Velocity(J) END DO END DO @@ -221,7 +221,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal !Indx = Indx + 1 - p%RdtnKrnl(I,J,K) = Krnl_Fact*Omega*( InterpStp( Omega, InitInp%HdroFreq(:), & + p%RdtnKrnl(J,K,I) = Krnl_Fact*Omega*( InterpStp( Omega, InitInp%HdroFreq(:), & InitInp%HdroAddMs(: ,J,K), LastInd, InitInp%NInpFreq ) & - InitInp%HdroAddMs(InitInp%NInpFreq,J,K) ) END DO ! K - All columns of RdtnKrnl above and including the diagonal @@ -245,7 +245,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal - CALL ApplySINT( p%RdtnKrnl(:,J,K), FFT_Data, ErrStat ) + CALL ApplySINT( p%RdtnKrnl(J,K,:), FFT_Data, ErrStat ) IF ( ErrStat /= ErrID_None ) RETURN END DO ! K - All columns of RdtnKrnl above and including the diagonal END DO ! J - All rows of RdtnKrnl @@ -293,7 +293,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal !Indx = Indx + 1 - p%RdtnKrnl(I,J,K) = Krnl_Fact*InterpStp ( Omega, InitInp%HdroFreq(:), InitInp%HdroDmpng(:,J,K), LastInd, InitInp%NInpFreq ) + p%RdtnKrnl(J,K,I) = Krnl_Fact*InterpStp ( Omega, InitInp%HdroFreq(:), InitInp%HdroDmpng(:,J,K), LastInd, InitInp%NInpFreq ) END DO ! K - All columns of RdtnKrnl above and including the diagonal END DO ! J - All rows of RdtnKrnl @@ -314,7 +314,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal - CALL ApplyCOST( p%RdtnKrnl(:,J,K), FFT_Data, ErrStat ) + CALL ApplyCOST( p%RdtnKrnl(J,K,:), FFT_Data, ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = 'Error applying Cosine Transform' ErrStat = ErrID_Fatal @@ -481,6 +481,7 @@ END SUBROUTINE Conv_Rdtn_UpdateStates !> Routine for computing outputs, used in both loose and tight coupling. SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. + use NWTC_LAPACK, only: LAPACK_gemm REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u !< Inputs at Time @@ -495,52 +496,60 @@ SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None -! REAL(ReKi) :: F_Rdtn (6) - REAL(ReKi) :: F_RdtnDT (6*p%NBody) ! The portion of the total load contribution from wave radiation damping associated with the convolution integral proportional to ( RdtnDT - RdtnRmndr ) (N, N-m) + character(*), parameter :: RoutineName = 'Conv_Rdtn_CalcOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + REAL(SiKi), allocatable :: F_RdtnDT(:,:) ! The portion of the total load contribution from wave radiation damping associated with the convolution integral proportional to ( RdtnDT - RdtnRmndr ) (N, N-m) INTEGER :: I ! Generic index INTEGER :: J ! Generic index INTEGER :: K ! Generic index INTEGER(IntKi) :: MaxInd - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - - ! Perform numerical convolution to determine the load contribution from wave - ! radiation damping: - MaxInd = MIN(p%NStepRdtn-1,OtherState%IndRdtn) ! Note: xd%IndRdtn index is from the previous time-step since this state was for the previous time-step - DO I = 1,6*p%NBody ! Loop through all wave radiation damping forces and moments - - F_RdtnDT (I) = 0.0 - ! F_RdtnRmndr(I) = 0.0 - - DO J = 1,6*p%NBody ! Loop through all platform DOFs - ! Contribution from the first and last time steps are halved to make the integration 2nd-order accurate - F_RdtnDT(I) = F_RdtnDT(I) - 0.5_SiKi * p%RdtnKrnl(MaxInd,I,J)*xd%XDHistory(0,J) & - - 0.5_SiKi * p%RdtnKrnl(0,I,J)*xd%XDHistory(MaxInd,J) - DO K = 1, MaxInd-1 ! Loop through all remaining NStepRdtn-2 time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - F_RdtnDT(I) = F_RdtnDT(I) - p%RdtnKrnl(MaxInd-K,I,J)*xd%XDHistory(K,J) - END DO - !DO K = MAX(0,xd%IndRdtn-p%NStepRdtn ),xd%IndRdtn-1 ! Loop through all NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - ! F_RdtnDT (I) = F_RdtnDT (I) - p%RdtnKrnl(xd%IndRdtn-1-K,I,J)*xd%XDHistory(MOD(K,p%NStepRdtn1),J) - !END DO ! K - All NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - - !DO K = MAX(0,xd%IndRdtn-p%NStepRdtn+1),xd%IndRdtn ! Loop through all NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - ! F_RdtnRmndr(I) = F_RdtnRmndr(I) - p%RdtnKrnl(xd%IndRdtn -K,I,J)*xd%XDHistory(MOD(K,p%NStepRdtn1),J) - !END DO ! K - All NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - - END DO ! J - All platform DOFs - - !F_Rdtn (I) = ( p%RdtnDT - xd%RdtnRmndr )*F_RdtnDT(I) + xd%RdtnRmndr*F_RdtnRmndr(I) - - END DO ! I - All wave radiation damping forces and moments - - y%F_Rdtn = p%RdtnDT*F_RdtnDT !F_Rdtn + call AllocAry(F_RdtnDT, 6*p%NBody, 1, 'F_RdtnDT', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Perform numerical convolution to determine the load contribution from wave radiation damping: + ! Contribution from the first and last time steps are halved to make the integration 2nd-order accurate + + ! First time step + call LAPACK_gemm('N', 'N', -0.5_SiKi, p%RdtnKrnl(:,:,MaxInd), xd%XDHistory(:,0:0), 0.0_SiKi, F_RdtnDT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Last time step + call LAPACK_gemm('N', 'N', -0.5_SiKi, p%RdtnKrnl(:,:,0), xd%XDHistory(:,MaxInd:MaxInd), 1.0_SiKi, F_RdtnDT, ErrStat2, ErrMsg2) + + ! Intermediate time steps + do K = 1, MaxInd-1 + call LAPACK_gemm('N', 'N', -1.0_SiKi, p%RdtnKrnl(:,:,MaxInd-K), xd%XDHistory(:,K:K), 1.0_SiKi, F_RdtnDT, ErrStat2, ErrMsg2) + end do + + y%F_Rdtn = p%RdtnDT*real(F_RdtnDT(:,1), ReKi) !F_Rdtn + + ! Loop through all wave radiation damping forces and moments + ! F_RdtnDT = 0.0 + ! DO I = 1, 6*p%NBody + ! DO J = 1,6*p%NBody ! Loop through all platform DOFs + ! ! Contribution from the first and last time steps are halved to make the integration 2nd-order accurate + ! F_RdtnDT(I) = F_RdtnDT(I) - 0.5_SiKi * p%RdtnKrnl(MaxInd,I,J)*xd%XDHistory(0,J) & + ! - 0.5_SiKi * p%RdtnKrnl(0,I,J)*xd%XDHistory(MaxInd,J) + + ! ! Loop through all remaining NStepRdtn-2 time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) + ! DO K = 1, MaxInd-1 + ! F_RdtnDT(I) = F_RdtnDT(I) - p%RdtnKrnl(MaxInd-K,I,J)*xd%XDHistory(K,J) + ! END DO + ! END DO ! J - All platform DOFs + ! END DO ! I - All wave radiation damping forces and moments + + ! y%F_Rdtn = p%RdtnDT*F_RdtnDT !F_Rdtn END SUBROUTINE Conv_Rdtn_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -635,18 +644,18 @@ SUBROUTINE Conv_Rdtn_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, Er IF ( OtherState%IndRdtn < (p%NStepRdtn) ) THEN DO J = 1,6*p%NBody ! Loop through all platform DOFs - xd%XDHistory(OtherState%IndRdtn,J) = u%Velocity(J) ! XDHistory was allocated as a zero-based array! + xd%XDHistory(J,OtherState%IndRdtn) = u%Velocity(J) ! XDHistory was allocated as a zero-based array! END DO ! J - All platform DOFs ELSE ! Shift the stored history by one index DO K = 0,p%NStepRdtn-2 DO J = 1,6*p%NBody ! Loop through all DOFs - xd%XDHistory(K,J) = xd%XDHistory(K+1,J) + xd%XDHistory(J,K) = xd%XDHistory(J,K+1) END DO END DO DO J = 1,6*p%NBody ! Loop through all platform DOFs - xd%XDHistory(p%NStepRdtn-1,J) = u%Velocity(J) ! Set the last array element to the current velocity + xd%XDHistory(J,p%NStepRdtn-1) = u%Velocity(J) ! Set the last array element to the current velocity END DO ! J - All platform DOFs END IF diff --git a/modules/hydrodyn/src/Conv_Radiation.txt b/modules/hydrodyn/src/Conv_Radiation.txt index 711c028559..9836df2acf 100644 --- a/modules/hydrodyn/src/Conv_Radiation.txt +++ b/modules/hydrodyn/src/Conv_Radiation.txt @@ -43,7 +43,7 @@ typedef ^ ContinuousStateType SiKi # # Define discrete (nondifferentiable) states here: # -typedef ^ DiscreteStateType ReKi XDHistory {:}{:} - - "" - +typedef ^ DiscreteStateType SiKi XDHistory {:}{:} - - "" - typedef ^ ^ DbKi LastTime - - - "" - # # diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 92992e8f53..ff1eb406bd 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -59,7 +59,7 @@ MODULE Conv_Radiation_Types ! ======================= ! ========= Conv_Rdtn_DiscreteStateType ======= TYPE, PUBLIC :: Conv_Rdtn_DiscreteStateType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: XDHistory !< [-] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: XDHistory !< [-] REAL(DbKi) :: LastTime = 0.0_R8Ki !< [-] END TYPE Conv_Rdtn_DiscreteStateType ! ======================= diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index a117d3db79..e87b311aa3 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -686,15 +686,15 @@ subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) enddo ! compute weighting factors - m%N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D = m%N3D / REAL( SIZE(m%N3D), ReKi ) ! normalize + m%N3D(1) = ( 1.0_SiKi + isopc(1) )*( 1.0_SiKi - isopc(2) )*( 1.0_SiKi - isopc(3) ) + m%N3D(2) = ( 1.0_SiKi + isopc(1) )*( 1.0_SiKi + isopc(2) )*( 1.0_SiKi - isopc(3) ) + m%N3D(3) = ( 1.0_SiKi - isopc(1) )*( 1.0_SiKi + isopc(2) )*( 1.0_SiKi - isopc(3) ) + m%N3D(4) = ( 1.0_SiKi - isopc(1) )*( 1.0_SiKi - isopc(2) )*( 1.0_SiKi - isopc(3) ) + m%N3D(5) = ( 1.0_SiKi + isopc(1) )*( 1.0_SiKi - isopc(2) )*( 1.0_SiKi + isopc(3) ) + m%N3D(6) = ( 1.0_SiKi + isopc(1) )*( 1.0_SiKi + isopc(2) )*( 1.0_SiKi + isopc(3) ) + m%N3D(7) = ( 1.0_SiKi - isopc(1) )*( 1.0_SiKi + isopc(2) )*( 1.0_SiKi + isopc(3) ) + m%N3D(8) = ( 1.0_SiKi - isopc(1) )*( 1.0_SiKi - isopc(2) )*( 1.0_SiKi + isopc(3) ) + m%N3D = m%N3D / REAL( SIZE(m%N3D), SiKi ) ! normalize contains logical function Failed() @@ -716,22 +716,22 @@ function WaveField_Interp_4D( pKinXX, m ) ! interpolate u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - WaveField_Interp_4D = SUM ( m%N4D * u ) + WaveField_Interp_4D = dot_product(m%N4D, u) end function WaveField_Interp_4D @@ -749,22 +749,22 @@ function WaveField_Interp_4D_Vec( pKinXX, m) ! interpolate do iDir = 1,3 u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) + WaveField_Interp_4D_Vec(iDir) = dot_product(m%N4D, u) end do END FUNCTION WaveField_Interp_4D_Vec @@ -783,22 +783,22 @@ function WaveField_Interp_4D_Vec6( pKinXX, m) ! interpolate do iDir = 1,6 u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec6(iDir) = SUM ( m%N4D * u ) + WaveField_Interp_4D_Vec6(iDir) = dot_product(m%N4D, u) end do END FUNCTION WaveField_Interp_4D_Vec6 @@ -817,15 +817,15 @@ function WaveField_Interp_3D( pKinXX, m ) integer(IntKi) :: i ! interpolate + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) - WaveField_Interp_3D = SUM ( m%N3D * u ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + WaveField_Interp_3D = dot_product(m%N3D, u) end function WaveField_Interp_3D @@ -840,15 +840,15 @@ FUNCTION WaveField_Interp_3D_VEC( pKinXX, m ) ! interpolate do i = 1,3 + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - WaveField_Interp_3D_VEC(i) = SUM ( m%N3D * u ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + WaveField_Interp_3D_VEC(i) = dot_product(m%N3D, u) end do end function WaveField_Interp_3D_VEC @@ -864,15 +864,15 @@ function Wavefield_Interp_3D_VEC6( pKinXX, m ) ! interpolate do i = 1,6 + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - Wavefield_Interp_3D_VEC6(i) = SUM ( m%N3D * u ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + Wavefield_Interp_3D_VEC6(i) = dot_product(m%N3D, u) end do end function Wavefield_Interp_3D_VEC6 From 7bff0dcca0fb55a499b020baae26d3e7d154c243 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 10 Sep 2024 18:51:20 +0000 Subject: [PATCH 235/319] Mark several NWTC Lib functions as PURE --- modules/nwtc-library/src/NWTC_Base.f90 | 2 +- modules/nwtc-library/src/NWTC_Num.f90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index 4228fe4ee2..829ae2a9c1 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -89,7 +89,7 @@ MODULE NWTC_Base !! and has the ability to provide a sort of traceback message of called !! routines (if this is called consistently). !! Modules in the FAST framework are recommended to use it. - subroutine SetErrStat (ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName) + pure subroutine SetErrStat (ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName) INTEGER(IntKi), INTENT(IN ) :: ErrStatLcl ! Error status of the operation CHARACTER(*), INTENT(IN ) :: ErrMessLcl ! Error message if ErrStat /= ErrID_None diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 7615d0c699..5606e41453 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -1626,7 +1626,7 @@ END SUBROUTINE DCM_SetLogMapForInterpR !! !! Note that the numbers are added together in this routine, so overflow can result if comparing two "huge" numbers. \n !! Use EqualRealNos (nwtc_num::equalrealnos) instead of directly calling a specific routine in the generic interface. - FUNCTION EqualRealNos4 ( ReNum1, ReNum2 ) + PURE FUNCTION EqualRealNos4 ( ReNum1, ReNum2 ) ! passed variables @@ -1660,7 +1660,7 @@ FUNCTION EqualRealNos4 ( ReNum1, ReNum2 ) END FUNCTION EqualRealNos4 !======================================================================= !> \copydoc nwtc_num::equalrealnos4 - FUNCTION EqualRealNos8 ( ReNum1, ReNum2 ) + PURE FUNCTION EqualRealNos8 ( ReNum1, ReNum2 ) ! passed variables From cf89895bbe91202bbf3a95858780847541e773ac Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 10 Sep 2024 18:51:54 +0000 Subject: [PATCH 236/319] Minor performance improvements in SeaState (reorganize indexing to minimize cache misses) --- modules/hydrodyn/src/WAMIT_Interp.f90 | 40 +-- modules/seastate/src/SeaSt_WaveField.f90 | 331 ++++++++++++----------- modules/seastate/src/SeaState.f90 | 6 +- 3 files changed, 196 insertions(+), 181 deletions(-) diff --git a/modules/hydrodyn/src/WAMIT_Interp.f90 b/modules/hydrodyn/src/WAMIT_Interp.f90 index 585867a33a..63c6fe4845 100644 --- a/modules/hydrodyn/src/WAMIT_Interp.f90 +++ b/modules/hydrodyn/src/WAMIT_Interp.f90 @@ -652,15 +652,15 @@ function WAMIT_ForceWaves_Interp_3D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3 ! interpolate do i = 1,6 - u(1) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) - u(2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(1) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) + u(2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) u(3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) - u(4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) - u(5) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) - u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + u(4) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) + u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) u(7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) - u(8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) - WAMIT_ForceWaves_Interp_3D_vec6(i) = SUM ( WF_m%N3D * u ) + u(8) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + WAMIT_ForceWaves_Interp_3D_vec6(i) = dot_product(WF_m%N3D, u) end do end function @@ -686,22 +686,22 @@ function WAMIT_ForceWaves_Interp_4D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3 ! interpolate do i = 1,6 u( 1) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u( 2) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u( 3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u( 4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u( 5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u( 6) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u( 2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 4) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) u( 7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u( 8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u( 9) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 8) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 9) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) u(10) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u(11) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u(12) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u(13) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u(14) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u(15) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u(11) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(12) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(13) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u(14) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u(15) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) u(16) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - WAMIT_ForceWaves_Interp_4D_vec6(i) = SUM ( WF_m%N4D * u ) + WAMIT_ForceWaves_Interp_4D_vec6(i) = dot_product(WF_m%N4D, u) end do end function diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index e87b311aa3..600df4472f 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -7,8 +7,6 @@ MODULE SeaSt_WaveField PRIVATE ! Public functions and subroutines -PUBLIC WaveField_GetNodeWaveElev1 -PUBLIC WaveField_GetNodeWaveElev2 PUBLIC WaveField_GetNodeTotalWaveElev PUBLIC WaveField_GetNodeWaveNormal PUBLIC WaveField_GetNodeWaveKin @@ -81,13 +79,14 @@ function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, end function WaveField_GetNodeWaveElev2 -FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) +FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg, Elev1, Elev2 ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. integer(IntKi), intent( out) :: ErrStat ! Error status of the operation character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + real(SiKi), optional, intent( out) :: Elev1, Elev2 ! Elev1 and Elev2 components real(SiKi) :: WaveField_GetNodeTotalWaveElev real(SiKi) :: Zeta1, Zeta2 @@ -98,15 +97,29 @@ FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrS ErrStat = ErrID_None ErrMsg = "" - Zeta1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; - Zeta2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + IF (ALLOCATED(WaveField%WaveElev1) .or. ALLOCATED(WaveField%WaveElev2)) then + CALL WaveField_Interp_Setup3D(Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + + IF (ALLOCATED(WaveField%WaveElev1)) THEN + Zeta1 = WaveField_Interp_3D(WaveField%WaveElev1, WaveField_m) + ELSE + Zeta1 = 0.0_SiKi + END IF + + IF (ALLOCATED(WaveField%WaveElev2)) THEN + Zeta2 = WaveField_Interp_3D(WaveField%WaveElev2, WaveField_m) + ELSE + Zeta2 = 0.0_SiKi + END IF + + if (present(Elev1)) Elev1 = Zeta1 + if (present(Elev2)) Elev2 = Zeta2 + WaveField_GetNodeTotalWaveElev = Zeta1 + Zeta2 -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function END FUNCTION WaveField_GetNodeTotalWaveElev @@ -114,7 +127,7 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, r, n, type(SeaSt_WaveFieldType), intent(in ) :: WaveField type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time - real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. + real(ReKi), intent(in ) :: pos(:) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. real(ReKi), intent(in ) :: r ! Distance for central differencing real(ReKi), intent( out) :: n(3) ! Free-surface normal vector integer(IntKi), intent( out) :: ErrStat ! Error status of the operation @@ -180,10 +193,9 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod posXY0 = (/pos(1),pos(2),0.0_ReKi/) FAMCF(:) = 0.0 - ! Wave elevation - WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; - WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; - WaveElev = WaveElev1 + WaveElev2 + ! Wave elevation (Calls WaveField_Interp_Setup3D internally so WaveField_Interp_3D can be used below) + WaveElev = WaveField_GetNodeTotalWaveElev(WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2, Elev1=WaveElev1, Elev2=WaveElev2) + if (Failed()) return IF (WaveField%WaveStMod == 0) THEN ! No wave stretching @@ -237,7 +249,6 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) FA(:) = FA(:) + WaveField_Interp_3D_vec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) FDynP = FDynP + WaveField_Interp_3D ( WaveField%PWaveDynP0, WaveField_m ) * pos(3) @@ -309,7 +320,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod posXY = pos(1:2) posXY0 = (/pos(1),pos(2),0.0_ReKi/) - ! Wave elevation + ! Wave elevation (Calls WaveField_Interp_Setup3D internally so WaveField_Interp_3D_vec can be used below) WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; IF (WaveField%WaveStMod == 0) THEN ! No wave stretching @@ -346,7 +357,6 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) END IF @@ -454,11 +464,19 @@ subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, F Indx_Lo = 0 Indx_Hi = 0 - + ! Calculate low grid index Tmp = (p-pZero) / delta - Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - + Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 + + ! Calculate isoparametric coordinate and clamp between -1 and 1 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi + if (isopc < -1.0_SiKi) then + isopc = -1.0_SiKi + else if (isopc > 1.0_SiKi) then + isopc = 1.0_SiKi + end if + + ! Check that lower index is valid if ( Indx_Lo < 1 ) then Indx_Lo = 1 isopc = -1.0 @@ -468,8 +486,10 @@ subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, F end if end if - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based - + ! Calculate hi grid index + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based + + ! Check that upper index is valid if ( Indx_Lo >= Indx_Hi ) then ! Need to clamp to grid boundary if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary @@ -480,12 +500,6 @@ subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, F isopc = 1.0 end if - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - end subroutine SetCartesianXYIndex @@ -515,7 +529,14 @@ subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, Tmp = acos( max(-1.0_ReKi, min(1.0_ReKi, 1+(p / z_depth)) ) ) / delta Tmp = nmax - 1 - Tmp Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + ! Calculate isoparametric coordinate and clamp between -1 and 1 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi + if (isopc < -1.0_SiKi) then + isopc = -1.0_SiKi + else if (isopc > 1.0_SiKi) then + isopc = 1.0_SiKi + end if if ( Indx_Lo < 1 ) then Indx_Lo = 1 @@ -538,12 +559,6 @@ subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, isopc = 1.0 end if - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - end subroutine SetCartesianZIndex @@ -582,13 +597,13 @@ subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, Er Tmp = MOD(Tmp,real((nMax), ReKi)) Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) + ! Calculate isoparametric coordinate and clamp between -1 and 1 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo, ReKi)) - 1.0_ReKi + if (isopc < -1.0_SiKi) then + isopc = -1.0_SiKi + else if (isopc > 1.0_SiKi) then + isopc = 1.0_SiKi + end if Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based @@ -610,6 +625,8 @@ subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) character(*), parameter :: RoutineName = 'WaveField_Interp_Setup4D' integer(IntKi) :: i real(SiKi) :: isopc(4) ! isoparametric coordinates + real(SiKi) :: one_m_isopc(4) ! 1 - isoparametric coordinates + real(SiKi) :: one_p_isopc(4) ! 1 + isoparametric coordinates integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -631,24 +648,27 @@ subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) call SetCartesianZIndex(Position(i-1), p%Z_Depth, p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) if (Failed()) return; + ! Calculate 1+ and 1- isoparametric coordinates to avoid recalculations + one_m_isopc = 1.0_SiKi - isopc + one_p_isopc = 1.0_SiKi + isopc + ! compute weighting factors - m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 4) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 5) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 6) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 7) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 8) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 9) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(10) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(11) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(12) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(13) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(14) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(15) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(16) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D = m%N4D / REAL( SIZE(m%N4D), SiKi ) ! normalize + m%N4D( 1) = one_m_isopc(1) * one_m_isopc(2) * one_m_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 2) = one_p_isopc(1) * one_m_isopc(2) * one_m_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 3) = one_m_isopc(1) * one_p_isopc(2) * one_m_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 4) = one_p_isopc(1) * one_p_isopc(2) * one_m_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 5) = one_m_isopc(1) * one_m_isopc(2) * one_p_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 6) = one_p_isopc(1) * one_m_isopc(2) * one_p_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 7) = one_m_isopc(1) * one_p_isopc(2) * one_p_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 8) = one_p_isopc(1) * one_p_isopc(2) * one_p_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 9) = one_m_isopc(1) * one_m_isopc(2) * one_m_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(10) = one_p_isopc(1) * one_m_isopc(2) * one_m_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(11) = one_m_isopc(1) * one_p_isopc(2) * one_m_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(12) = one_p_isopc(1) * one_p_isopc(2) * one_m_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(13) = one_m_isopc(1) * one_m_isopc(2) * one_p_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(14) = one_p_isopc(1) * one_m_isopc(2) * one_p_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(15) = one_m_isopc(1) * one_p_isopc(2) * one_p_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(16) = one_p_isopc(1) * one_p_isopc(2) * one_p_isopc(3) * one_p_isopc(4) / 16.0_SiKi contains logical function Failed() @@ -668,7 +688,9 @@ subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) character(*), parameter :: RoutineName = 'WaveField_Interp_Setup3D' integer(IntKi) :: i - real(SiKi) :: isopc(4) ! isoparametric coordinates + real(SiKi) :: isopc(3) ! isoparametric coordinates + real(SiKi) :: one_m_isopc(3) ! 1 - isoparametric coordinates + real(SiKi) :: one_p_isopc(3) ! 1 + isoparametric coordinates integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -685,16 +707,19 @@ subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) if (Failed()) return; enddo + ! Calculate 1+ and 1- isoparametric coordinates to avoid recalculations + one_m_isopc = 1.0_SiKi - isopc + one_p_isopc = 1.0_SiKi + isopc + ! compute weighting factors - m%N3D(1) = ( 1.0_SiKi + isopc(1) )*( 1.0_SiKi - isopc(2) )*( 1.0_SiKi - isopc(3) ) - m%N3D(2) = ( 1.0_SiKi + isopc(1) )*( 1.0_SiKi + isopc(2) )*( 1.0_SiKi - isopc(3) ) - m%N3D(3) = ( 1.0_SiKi - isopc(1) )*( 1.0_SiKi + isopc(2) )*( 1.0_SiKi - isopc(3) ) - m%N3D(4) = ( 1.0_SiKi - isopc(1) )*( 1.0_SiKi - isopc(2) )*( 1.0_SiKi - isopc(3) ) - m%N3D(5) = ( 1.0_SiKi + isopc(1) )*( 1.0_SiKi - isopc(2) )*( 1.0_SiKi + isopc(3) ) - m%N3D(6) = ( 1.0_SiKi + isopc(1) )*( 1.0_SiKi + isopc(2) )*( 1.0_SiKi + isopc(3) ) - m%N3D(7) = ( 1.0_SiKi - isopc(1) )*( 1.0_SiKi + isopc(2) )*( 1.0_SiKi + isopc(3) ) - m%N3D(8) = ( 1.0_SiKi - isopc(1) )*( 1.0_SiKi - isopc(2) )*( 1.0_SiKi + isopc(3) ) - m%N3D = m%N3D / REAL( SIZE(m%N3D), SiKi ) ! normalize + m%N3D(1) = one_m_isopc(1) * one_m_isopc(2) * one_m_isopc(3) / 8.0_SiKi + m%N3D(2) = one_p_isopc(1) * one_m_isopc(2) * one_m_isopc(3) / 8.0_SiKi + m%N3D(3) = one_m_isopc(1) * one_p_isopc(2) * one_m_isopc(3) / 8.0_SiKi + m%N3D(4) = one_p_isopc(1) * one_p_isopc(2) * one_m_isopc(3) / 8.0_SiKi + m%N3D(5) = one_m_isopc(1) * one_m_isopc(2) * one_p_isopc(3) / 8.0_SiKi + m%N3D(6) = one_p_isopc(1) * one_m_isopc(2) * one_p_isopc(3) / 8.0_SiKi + m%N3D(7) = one_m_isopc(1) * one_p_isopc(2) * one_p_isopc(3) / 8.0_SiKi + m%N3D(8) = one_p_isopc(1) * one_p_isopc(2) * one_p_isopc(3) / 8.0_SiKi contains logical function Failed() @@ -712,26 +737,25 @@ function WaveField_Interp_4D( pKinXX, m ) type(SeaSt_WaveField_MiscVarType), intent(in ) :: m real(SiKi) :: WaveField_Interp_4D - real(SiKi) :: u(16) ! size 2^n ! interpolate - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - WaveField_Interp_4D = dot_product(m%N4D, u) + WaveField_Interp_4D = & + m%N4D( 1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + & + m%N4D( 2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + & + m%N4D( 3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + & + m%N4D( 4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + & + m%N4D( 5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + & + m%N4D( 6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + & + m%N4D( 7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + & + m%N4D( 8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + & + m%N4D( 9) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + & + m%N4D(10) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + & + m%N4D(11) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + & + m%N4D(12) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + & + m%N4D(13) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + & + m%N4D(14) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + & + m%N4D(15) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + & + m%N4D(16) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) end function WaveField_Interp_4D @@ -743,28 +767,27 @@ function WaveField_Interp_4D_Vec( pKinXX, m) type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation real(SiKi) :: WaveField_Interp_4D_Vec(3) - real(SiKi) :: u(16) ! size 2^n integer(IntKi) :: iDir ! interpolate do iDir = 1,3 - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec(iDir) = dot_product(m%N4D, u) + WaveField_Interp_4D_Vec(iDir) = & + m%N4D( 1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 9) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(10) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(11) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(12) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(13) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(14) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(15) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(16) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) end do END FUNCTION WaveField_Interp_4D_Vec @@ -777,28 +800,27 @@ function WaveField_Interp_4D_Vec6( pKinXX, m) type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation real(SiKi) :: WaveField_Interp_4D_Vec6(6) - real(SiKi) :: u(16) ! size 2^n integer(IntKi) :: iDir ! interpolate do iDir = 1,6 - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec6(iDir) = dot_product(m%N4D, u) + WaveField_Interp_4D_Vec6(iDir) = & + m%N4D( 1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 9) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(10) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(11) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(12) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(13) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(14) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(15) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(16) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) end do END FUNCTION WaveField_Interp_4D_Vec6 @@ -813,19 +835,18 @@ function WaveField_Interp_3D( pKinXX, m ) character(*), parameter :: RoutineName = 'WaveField_Interp_3D' real(SiKi) :: WaveField_Interp_3D - real(SiKi) :: u(8) integer(IntKi) :: i ! interpolate - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) - WaveField_Interp_3D = dot_product(m%N3D, u) + WaveField_Interp_3D = & + m%N3D(1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + & + m%N3D(2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + & + m%N3D(3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + & + m%N3D(4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + & + m%N3D(5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + & + m%N3D(6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + & + m%N3D(7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + & + m%N3D(8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) end function WaveField_Interp_3D @@ -833,22 +854,20 @@ FUNCTION WaveField_Interp_3D_VEC( pKinXX, m ) real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars - character(*), parameter :: RoutineName = 'WaveField_Interp_3D_VEC' real(SiKi) :: WaveField_Interp_3D_VEC(3) - real(SiKi) :: u(8) integer(IntKi) :: i ! interpolate do i = 1,3 - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - WaveField_Interp_3D_VEC(i) = dot_product(m%N3D, u) + WaveField_Interp_3D_VEC(i) = & + m%N3D(1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + & + m%N3D(2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + & + m%N3D(3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + & + m%N3D(4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + & + m%N3D(5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + & + m%N3D(6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + & + m%N3D(7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + & + m%N3D(8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) end do end function WaveField_Interp_3D_VEC @@ -857,22 +876,20 @@ function Wavefield_Interp_3D_VEC6( pKinXX, m ) real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< Miscvars - character(*), parameter :: RoutineName = 'Wavefield_Interp_3D_VEC6' real(SiKi) :: Wavefield_Interp_3D_VEC6(6) - real(SiKi) :: u(8) integer(IntKi) :: i ! interpolate do i = 1,6 - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - Wavefield_Interp_3D_VEC6(i) = dot_product(m%N3D, u) + Wavefield_Interp_3D_VEC6(i) = & + m%N3D(1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + & + m%N3D(2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + & + m%N3D(3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + & + m%N3D(4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + & + m%N3D(5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + & + m%N3D(6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + & + m%N3D(7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + & + m%N3D(8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) end do end function Wavefield_Interp_3D_VEC6 diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index c9c75d3708..5aedb424d9 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -745,12 +745,10 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Compute the wave elevations at the requested output locations for this time. Note that p%WaveElev has the second order added to it already. DO i = 1, p%NWaveElev positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) - WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) + zeta = WaveField_GetNodeTotalWaveElev(p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2, Elev1=WaveElev1(i), Elev2=WaveElev2(i)) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev(i) = WaveElev1(i) + WaveElev2(i) END DO + WaveElev = WaveElev1 + WaveElev2 ! Map calculated results into the AllOuts Array CALL SeaStOut_MapOutputs( p, WaveElev, WaveElev1, WaveElev2, WaveVel, WaveAcc, WaveAccMCF, WaveDynP, AllOuts, ErrStat2, ErrMsg2 ) From 208db9d0cd1f6e5e1b0be85be0fdae7800a95ffe Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 10 Sep 2024 18:52:24 +0000 Subject: [PATCH 237/319] Small performance improvements in Morison.f90 --- modules/hydrodyn/src/Morison.f90 | 46 +++++++++++++++----------------- 1 file changed, 22 insertions(+), 24 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index b192582519..9f9b9e5c03 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2518,7 +2518,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, INTEGER :: I, J REAL(ReKi) :: qdotdot(6) ! The structural acceleration of a mesh node - TYPE(Morison_MemberType) :: mem ! the current member INTEGER :: N ! Number of elements within a given member REAL(ReKi) :: dl ! Element length within a given member, m REAL(ReKi) :: vec(3) ! Vector pointing from a member's 1st node to its last node @@ -2623,7 +2622,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Loop through each member DO im = 1, p%NMembers N = p%Members(im)%NElements - mem = p%Members(im) !@mhall: does this have much overhead? + associate (mem => p%Members(im)) !zero member loads m%memberLoads(im)%F_B = 0.0_ReKi @@ -2756,7 +2755,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, Zeta2 = 0.0_ReKi END IF Is1stElement = ( i .EQ. 1) - CALL getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1b, r2b, dl, mem%alpha(i), Is1stElement, F_B0, F_B1, F_B2, ErrStat2, ErrMsg2 ) + CALL getElementHstLds_Mod1(mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1b, r2b, dl, mem%alpha(i), Is1stElement, F_B0, F_B1, F_B2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Add nodal loads to mesh IF ( .NOT. Is1stElement ) THEN @@ -3466,6 +3465,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, end if ! PropPot !----------------------------------- external buoyancy loads: ends -----------------------------------! + end associate end do ! im - looping through members !---------------------------------------------------------------------------------------------------------------! @@ -3591,7 +3591,7 @@ END SUBROUTINE GetTotalWaveElev SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) REAL(DbKi), INTENT( In ) :: Time - REAL(ReKi), INTENT( In ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. + REAL(ReKi), INTENT( In ) :: pos(:) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. REAL(ReKi), INTENT( In ) :: r ! Distance for central differencing REAL(ReKi), INTENT( OUT ) :: n(3) ! Free-surface normal vector INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation @@ -3607,7 +3607,7 @@ SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) END SUBROUTINE GetFreeSurfaceNormal - SUBROUTINE GetSectionUnitVectors( k, y, z ) + PURE SUBROUTINE GetSectionUnitVectors( k, y, z ) REAL(ReKi), INTENT( In ) :: k(3) ! Member axial unit vector REAL(ReKi), INTENT( OUT ) :: y(3) ! Horizontal unit vector perpendicular to k REAL(ReKi), INTENT( OUT ) :: z(3) ! Unit vector perpendicular to k and y with positive vertical component @@ -3624,7 +3624,7 @@ SUBROUTINE GetSectionUnitVectors( k, y, z ) END IF END SUBROUTINE GetSectionUnitVectors - SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_hat, R, theta1, theta2, secStat) + PURE SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_hat, R, theta1, theta2, secStat) REAL(DbKi), INTENT( In ) :: pos0(3) REAL(DbKi), INTENT( In ) :: FSPt(3) REAL(ReKi), INTENT( In ) :: k_hat(3) @@ -3672,7 +3672,7 @@ SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_h END SUBROUTINE GetSectionFreeSurfaceIntersects - SUBROUTINE GetSectionHstLds( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, theta2, dFdl) + PURE SUBROUTINE GetSectionHstLds( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, theta2, dFdl) REAL(DbKi), INTENT( IN ) :: origin(3) REAL(DbKi), INTENT( IN ) :: pos0(3) @@ -3882,7 +3882,7 @@ RECURSIVE SUBROUTINE RefineElementHstLds( origin, pos1, posMid, pos2, FSPt, r1, END SUBROUTINE RefineElementHstLds - SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) + PURE SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) REAL(ReKi), INTENT( IN ) :: pos0(3) REAL(ReKi), INTENT( IN ) :: k_hat(3) @@ -3948,8 +3948,9 @@ SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) END SUBROUTINE GetEndPlateHstLds - SUBROUTINE getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, dl, alphaIn, Is1stElement, F_B0, F_B1, F_B2, ErrStat, ErrMsg ) + SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, dl, alphaIn, Is1stElement, F_B0, F_B1, F_B2, ErrStat, ErrMsg ) + TYPE(Morison_MemberType), intent(in) :: mem REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos1(3) REAL(ReKi), INTENT( IN ) :: pos2(3) @@ -4119,7 +4120,7 @@ subroutine LumpDistrHydroLoads( f_hydro, k_hat, dl, h_c, lumpedLoad ) end subroutine LumpDistrHydroLoads !---------------------------------------------------------------------------------------------------------------------------------- ! Takes loads on node i in element tilted frame and converts to 6DOF loads at node i and adjacent node -SUBROUTINE DistributeElementLoads(Fl, Fr, M, sinPhi, cosPhi, SinBeta, cosBeta, alpha, F1, F2) +PURE SUBROUTINE DistributeElementLoads(Fl, Fr, M, sinPhi, cosPhi, SinBeta, cosBeta, alpha, F1, F2) REAL(ReKi), INTENT ( IN ) :: Fl ! (N) axial load about node i REAL(ReKi), INTENT ( IN ) :: Fr ! (N) radial load about node i in direction of tilt @@ -4132,25 +4133,22 @@ SUBROUTINE DistributeElementLoads(Fl, Fr, M, sinPhi, cosPhi, SinBeta, cosBeta, a REAL(ReKi), INTENT ( OUT ) :: F1(6) ! (N, Nm) force/moment vector for node i REAL(ReKi), INTENT ( OUT ) :: F2(6) ! (N, Nm) force/moment vector for the other node (whether i+1, or i-1) + REAL(ReKi) :: F(6) - F1(1) = cosBeta*(Fl*sinPhi + Fr*cosPhi)*alpha - F1(2) = sinBeta*(Fl*sinPhi + Fr*cosPhi)*alpha - F1(3) = (Fl*cosPhi - Fr*sinPhi)*alpha - F1(4) = -sinBeta * M *alpha - F1(5) = cosBeta * M *alpha - F1(6) = 0.0 - - F2(1) = cosBeta*(Fl*sinPhi + Fr*cosPhi)*(1-alpha) - F2(2) = sinBeta*(Fl*sinPhi + Fr*cosPhi)*(1-alpha) - F2(3) = (Fl*cosPhi - Fr*sinPhi)*(1-alpha) - F2(4) = -sinBeta * M *(1-alpha) - F2(5) = cosBeta * M *(1-alpha) - F2(6) = 0.0 + F(1) = cosBeta*(Fl*sinPhi + Fr*cosPhi) + F(2) = sinBeta*(Fl*sinPhi + Fr*cosPhi) + F(3) = (Fl*cosPhi - Fr*sinPhi) + F(4) = -sinBeta * M + F(5) = cosBeta * M + F(6) = 0.0 + + F1 = F*alpha + F2 = F*(1.0_ReKi-alpha) END SUBROUTINE DistributeElementLoads !---------------------------------------------------------------------------------------------------------------------------------- ! Takes loads on end node i and converts to 6DOF loads, adding to the nodes existing loads -SUBROUTINE AddEndLoad(Fl, M, sinPhi, cosPhi, SinBeta, cosBeta, Fi) +PURE SUBROUTINE AddEndLoad(Fl, M, sinPhi, cosPhi, SinBeta, cosBeta, Fi) REAL(ReKi), INTENT ( IN ) :: Fl ! (N) axial load about node i REAL(ReKi), INTENT ( IN ) :: M ! (N-m) radial moment about node i, positive in direction of tilt angle From 640acbaa78324c640c0f3315cac81b2c52186eb8 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 10 Sep 2024 18:53:10 +0000 Subject: [PATCH 238/319] Minor performance improvements in SubDyn --- modules/subdyn/src/SubDyn.f90 | 65 +++++++++++--------------- modules/subdyn/src/SubDyn_Registry.txt | 3 +- modules/subdyn/src/SubDyn_Types.f90 | 30 +++++++++--- 3 files changed, 54 insertions(+), 44 deletions(-) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index d3d9f29a1d..834782b937 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -574,10 +574,8 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) REAL(ReKi) :: Y1_Utp(6) REAL(ReKi) :: Y1_GuyanLoadCorrection(3) ! Lever arm moment contributions due to interface displacement REAL(ReKi) :: udotdot_TP(6) - INTEGER(IntKi), pointer :: DOFList(:) REAL(ReKi) :: DCM(3,3) REAL(ReKi) :: F_I(6*p%nNodes_I) ! !Forces from all interface nodes listed in one big array ( those translated to TP ref point HydroTP(6) are implicitly calculated in the equations) - TYPE(SD_ContinuousStateType) :: dxdt ! Continuous state derivatives at t- for output file qmdotdot purposes only ! Variables for Guyan rigid body motion real(ReKi), dimension(3) :: Om, OmD ! Omega, OmegaDot (body rotational speed and acceleration) real(ReKi), dimension(3) :: rIP ! Vector from TP to rotated Node @@ -679,7 +677,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) Om(1:3) = u%TPMesh%RotationVel(1:3,1) OmD(1:3) = u%TPMesh%RotationAcc(1:3,1) do iSDNode = 1,p%nNodes - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations + associate (DOFList => p%NodesDOF(iSDNode)%List) ! Alias to shorten notations ! --- Guyan (rigid body) motion in global coordinates rIP0(1:3) = p%DP0(1:3, iSDNode) rIP(1:3) = matmul(Rb2g, rIP0) @@ -725,11 +723,12 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) y%Y2mesh%TranslationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(1:3)) y%Y2mesh%RotationVel (:,iSDNode) = m%U_full_dot (DOFList(4:6)) y%Y2mesh%RotationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(4:6)) + end associate enddo else ! --- Fixed bottom - Y3 and Y2 meshes are identical in this case do iSDNode = 1,p%nNodes - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations + associate(DOFList => p%NodesDOF(iSDNode)%List) ! Alias to shorten notations ! TODO TODO which orientation to give for joints with more than 6 dofs? ! Construct the direction cosine matrix given the output angles CALL SmllRotTrans( 'UR_bar input angles', m%U_full_NS(DOFList(4)), m%U_full_NS(DOFList(5)), m%U_full_NS(DOFList(6)), DCM, '', ErrStat2, ErrMsg2) @@ -740,18 +739,17 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) y%Y2mesh%TranslationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(1:3)) y%Y2mesh%RotationVel (:,iSDNode) = m%U_full_dot (DOFList(4:6)) y%Y2mesh%RotationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(4:6)) - y%Y3mesh%TranslationDisp (:,iSDNode) = y%Y2mesh%TranslationDisp (:,iSDNode) - y%Y3mesh%Orientation (:,:,iSDNode) = y%Y2mesh%Orientation (:,:,iSDNode) + end associate enddo + y%Y3mesh%TranslationDisp = y%Y2mesh%TranslationDisp + y%Y3mesh%Orientation = y%Y2mesh%Orientation endif ! --- Y3 mesh and Y2 mesh both have elastic (Guyan+CB) velocities and accelerations - do iSDNode = 1,p%nNodes - y%Y3mesh%TranslationVel (:,iSDNode) = y%Y2mesh%TranslationVel (:,iSDNode) - y%Y3mesh%TranslationAcc (:,iSDNode) = y%Y2mesh%TranslationAcc (:,iSDNode) - y%Y3mesh%RotationVel (:,iSDNode) = y%Y2mesh%RotationVel (:,iSDNode) - y%Y3mesh%RotationAcc (:,iSDNode) = y%Y2mesh%RotationAcc (:,iSDNode) - enddo + y%Y3mesh%TranslationVel = y%Y2mesh%TranslationVel + y%Y3mesh%TranslationAcc = y%Y2mesh%TranslationAcc + y%Y3mesh%RotationVel = y%Y2mesh%RotationVel + y%Y3mesh%RotationAcc = y%Y2mesh%RotationAcc ! -------------------------------------------------------------------------------- ! --- Outputs 1, Y1=-F_TP, reaction force from SubDyn to ElastoDyn (stored in y%Y1Mesh) @@ -837,11 +835,9 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !find xdot at t IF ( p%nDOFM > 0 ) THEN ! note that this re-sets m%udotdot_TP and m%F_L, but they are the same values as earlier in this routine so it doesn't change results in SDOut_MapOutputs() - CALL SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ); if(Failed()) return + CALL SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2 ); if(Failed()) return !Assign the acceleration to the x variable since it will be used for output file purposes for SSqmdd01-99, and dxdt will disappear - m%qmdotdot=dxdt%qmdot - ! Destroy dxdt because it is not necessary for the rest of the subroutine - CALL SD_DestroyContState( dxdt, ErrStat2, ErrMsg2); if(Failed()) return + m%qmdotdot = m%dxdt_lin%qmdot END IF ! 6-vectors (making sure they are up to date for outputs m%udot_TP = (/u%TPMesh%TranslationVel( :,1),u%TPMesh%RotationVel(:,1)/) @@ -874,12 +870,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) LOGICAL FUNCTION Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() END FUNCTION Failed - - SUBROUTINE CleanUp - CALL SD_DestroyContState( dxdt, ErrStat2, ErrMsg2) - END SUBROUTINE CleanUp END SUBROUTINE SD_CalcOutput @@ -895,7 +886,7 @@ SUBROUTINE SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(SD_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t + TYPE(SD_ContinuousStateType), INTENT(INOUT) :: dxdt !< Continuous state derivatives at t INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(ReKi) :: udotdot_TP(6) @@ -904,12 +895,6 @@ SUBROUTINE SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - - ! INTENT(OUT) automatically deallocates the arrays on entry, we have to allocate them here - CALL AllocAry(dxdt%qm, p%nDOFM, 'dxdt%qm', ErrStat2, ErrMsg2 ); CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcContStateDeriv' ) - CALL AllocAry(dxdt%qmdot, p%nDOFM, 'dxdt%qmdot', ErrStat2, ErrMsg2 ); CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcContStateDeriv' ) - IF ( ErrStat >= AbortErrLev ) RETURN - IF ( p%nDOFM == 0 ) RETURN ! Compute F_L, force on internal DOF CALL GetExtForceOnInternalDOF(u, p, x, m, m%F_L, ErrStat2, ErrMsg2, GuyanLoadCorrection=(p%GuyanLoadCorrection.and..not.p%Floating), RotateLoads=(p%GuyanLoadCorrection.and.p%Floating)) @@ -2793,12 +2778,13 @@ SUBROUTINE AllocMiscVars(p, Misc, ErrStat, ErrMsg) CALL AllocAry( Misc%UL_SIM, p%nDOF__L, 'UL_SIM' , ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%UL_0m, p%nDOF__L, 'UL_0m', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%DU_full, p%nDOF, 'DU_full', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') + CALL AllocAry( Misc%x_full, p%nDOF, 1, 'x_full', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full, p%nDOF, 'U_full', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_NS, p%nDOF, 'U_full_NS', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_elast, p%nDOF, 'U_full_elast', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_dot, p%nDOF, 'U_full_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_dotdot,p%nDOF, 'U_full_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_red, p%nDOF_red, 'U_red', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') + CALL AllocAry( Misc%U_red, p%nDOF_red, 1, 'U_red', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%Fext, p%nDOF , 'm%Fext ', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%Fext_red, p%nDOF_red , 'm%Fext_red', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') @@ -3065,19 +3051,24 @@ END SUBROUTINE PartitionDOFNodes !! This is a generic function, "x" can be used for displacements, velocities, accelerations !! m%U_red is only used as a intermediate storage SUBROUTINE ReducedToFull(p, m, xR_bar, xL, x_full) + use NWTC_LAPACK, only: LAPACK_gemm TYPE(SD_ParameterType),target,INTENT(IN ) :: p !< Parameters TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables REAL(ReKi), DIMENSION(:), INTENT(IN ) :: xR_bar !< Values of "x" interface nodes (6xnI) REAL(ReKi), DIMENSION(:), INTENT(IN ) :: xL !< Values of "x" internal nodes REAL(ReKi), DIMENSION(:), INTENT( OUT) :: x_full !< Values of "x" transferred to full vector of DOF + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg if (p%reduced) then ! Filling up full vector of reduced DOF - m%U_red(p%IDI__) = xR_bar - m%U_red(p%ID__L) = xL - m%U_red(p%IDC_Rb)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) - m%U_red(p%ID__F) = 0 + m%U_red(p%IDI__,1) = xR_bar + m%U_red(p%ID__L,1) = xL + m%U_red(p%IDC_Rb,1)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) + m%U_red(p%ID__F,1) = 0 ! Transfer to full - x_full = matmul(p%T_red, m%U_red) ! TODO use LAPACK, but T_red and U_red have different types... + ! x_full = matmul(p%T_red, m%U_red(:,1)) + call LAPACK_gemm('N', 'N', 1.0_R8Ki, p%T_red, m%U_red, 0.0_R8ki, m%x_full, ErrStat, ErrMsg) + x_full = real(m%x_full(:,1), ReKi) else ! We use U_full directly x_full(p%IDI__) = xR_bar @@ -4106,14 +4097,14 @@ FUNCTION MemberLength(MemberID,Init,ErrStat,ErrMsg) MemberLength=0.0 !Find the MemberID in the list - iMember = FINDLOCI(Init%Members(:,1), MemberID) + iMember = FINDLOC(Init%Members(:,1), MemberID, dim=1) if (iMember<=0) then call SetErrStat(ErrID_Fatal,' Member with ID '//trim(Num2LStr(MemberID))//' not found in member list!', ErrStat,ErrMsg,RoutineName); return endif ! Find joints ID for this member - Joint1 = FINDLOCI(Init%Joints(:,1), Init%Members(iMember,2)) - Joint2 = FINDLOCI(Init%Joints(:,1), Init%Members(iMember,3)) + Joint1 = FINDLOC(Init%Joints(:,1), Init%Members(iMember,2), dim=1) + Joint2 = FINDLOC(Init%Joints(:,1), Init%Members(iMember,3), dim=1) xyz1= Init%Joints(Joint1,2:4) xyz2= Init%Joints(Joint2,2:4) MemberLength=SQRT( SUM((xyz2-xyz1)**2.) ) diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index be865babb0..a52a5f5937 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -310,7 +310,8 @@ typedef ^ MiscVarType ReKi U_full_NS {:} - - "Displaceme typedef ^ MiscVarType ReKi U_full_dot {:} - - typedef ^ MiscVarType ReKi U_full_dotdot {:} - - typedef ^ MiscVarType ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM" -typedef ^ MiscVarType ReKi U_red {:} - - +typedef ^ MiscVarType R8Ki U_red {:}{:} - - +typedef ^ MiscVarType R8Ki x_full {:}{:} - - typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" typedef ^ MiscVarType ReKi AllOuts {:} - - "Data for output file" diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 07f8ca2623..cc75010b71 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -360,7 +360,8 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: U_red + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: x_full REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] @@ -3597,7 +3598,7 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyMisc' @@ -3814,10 +3815,10 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_elast = SrcMiscData%U_full_elast end if if (allocated(SrcMiscData%U_red)) then - LB(1:1) = lbound(SrcMiscData%U_red, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_red, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%U_red, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%U_red, kind=B8Ki) if (.not. allocated(DstMiscData%U_red)) then - allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) + allocate(DstMiscData%U_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) return @@ -3825,6 +3826,18 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%U_red = SrcMiscData%U_red end if + if (allocated(SrcMiscData%x_full)) then + LB(1:2) = lbound(SrcMiscData%x_full, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%x_full, kind=B8Ki) + if (.not. allocated(DstMiscData%x_full)) then + allocate(DstMiscData%x_full(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%x_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%x_full = SrcMiscData%x_full + end if if (allocated(SrcMiscData%FC_unit)) then LB(1:1) = lbound(SrcMiscData%FC_unit, kind=B8Ki) UB(1:1) = ubound(SrcMiscData%FC_unit, kind=B8Ki) @@ -3983,6 +3996,9 @@ subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%U_red)) then deallocate(MiscData%U_red) end if + if (allocated(MiscData%x_full)) then + deallocate(MiscData%x_full) + end if if (allocated(MiscData%FC_unit)) then deallocate(MiscData%FC_unit) end if @@ -4036,6 +4052,7 @@ subroutine SD_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%U_full_dotdot) call RegPackAlloc(RF, InData%U_full_elast) call RegPackAlloc(RF, InData%U_red) + call RegPackAlloc(RF, InData%x_full) call RegPackAlloc(RF, InData%FC_unit) call RegPackAlloc(RF, InData%SDWrOutput) call RegPackAlloc(RF, InData%AllOuts) @@ -4052,7 +4069,7 @@ subroutine SD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4081,6 +4098,7 @@ subroutine SD_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%U_full_dotdot); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%U_full_elast); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%U_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_full); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%FC_unit); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SDWrOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return From 74f77e68e5730b52014072d41f004131aa10fd80 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 10 Sep 2024 21:43:49 +0000 Subject: [PATCH 239/319] Use LAPACK_GEMV in SubDyn --- modules/subdyn/src/SubDyn.f90 | 35 ++++++++++++++------------ modules/subdyn/src/SubDyn_Registry.txt | 16 ++++++------ modules/subdyn/src/SubDyn_Types.f90 | 32 +++++++++++------------ 3 files changed, 43 insertions(+), 40 deletions(-) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 834782b937..5e51059356 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -2778,13 +2778,12 @@ SUBROUTINE AllocMiscVars(p, Misc, ErrStat, ErrMsg) CALL AllocAry( Misc%UL_SIM, p%nDOF__L, 'UL_SIM' , ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%UL_0m, p%nDOF__L, 'UL_0m', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%DU_full, p%nDOF, 'DU_full', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%x_full, p%nDOF, 1, 'x_full', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full, p%nDOF, 'U_full', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_NS, p%nDOF, 'U_full_NS', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_elast, p%nDOF, 'U_full_elast', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_dot, p%nDOF, 'U_full_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_dotdot,p%nDOF, 'U_full_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_red, p%nDOF_red, 1, 'U_red', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') + CALL AllocAry( Misc%U_red, p%nDOF_red, 'U_red', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%Fext, p%nDOF , 'm%Fext ', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%Fext_red, p%nDOF_red , 'm%Fext_red', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') @@ -3051,24 +3050,24 @@ END SUBROUTINE PartitionDOFNodes !! This is a generic function, "x" can be used for displacements, velocities, accelerations !! m%U_red is only used as a intermediate storage SUBROUTINE ReducedToFull(p, m, xR_bar, xL, x_full) - use NWTC_LAPACK, only: LAPACK_gemm + use NWTC_LAPACK, only: LAPACK_GEMV TYPE(SD_ParameterType),target,INTENT(IN ) :: p !< Parameters TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables REAL(ReKi), DIMENSION(:), INTENT(IN ) :: xR_bar !< Values of "x" interface nodes (6xnI) REAL(ReKi), DIMENSION(:), INTENT(IN ) :: xL !< Values of "x" internal nodes - REAL(ReKi), DIMENSION(:), INTENT( OUT) :: x_full !< Values of "x" transferred to full vector of DOF + REAL(R8Ki), DIMENSION(:), INTENT( OUT) :: x_full !< Values of "x" transferred to full vector of DOF integer(IntKi) :: ErrStat character(ErrMsgLen) :: ErrMsg if (p%reduced) then ! Filling up full vector of reduced DOF - m%U_red(p%IDI__,1) = xR_bar - m%U_red(p%ID__L,1) = xL - m%U_red(p%IDC_Rb,1)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) - m%U_red(p%ID__F,1) = 0 + m%U_red(p%IDI__) = xR_bar + m%U_red(p%ID__L) = xL + m%U_red(p%IDC_Rb)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) + m%U_red(p%ID__F) = 0 ! Transfer to full - ! x_full = matmul(p%T_red, m%U_red(:,1)) - call LAPACK_gemm('N', 'N', 1.0_R8Ki, p%T_red, m%U_red, 0.0_R8ki, m%x_full, ErrStat, ErrMsg) - x_full = real(m%x_full(:,1), ReKi) + ! x_full = matmul(p%T_red, m%U_red) + call LAPACK_GEMV('N', size(p%T_red, 1), size(p%T_red, 2), 1.0_R8Ki, p%T_red, & + size(p%T_red, 1), m%U_red, 1, 0.0_R8ki, x_full, 1) else ! We use U_full directly x_full(p%IDI__) = xR_bar @@ -4127,7 +4126,8 @@ FUNCTION BeamMass(rho1,D1,t1,rho2,D2,t2,L,method) b0=rho1 b1=(rho2-rho1)/L !Here we will need to figure out what element it is for now circular pipes - IF (method<=0) THEN + select case (method) + case (:0) ! Mid values for r, t, and potentially rho r1 = 0.25_ReKi*(D1 + D2) t = 0.50_ReKi*(t1 + t2) @@ -4142,22 +4142,25 @@ FUNCTION BeamMass(rho1,D1,t1,rho2,D2,t2,L,method) else BeamMass = rho1 * L * Area ! WHAT is currently used by FEM endif - ELSEIF (method==1) THEN !circular tube + + case (1) ! circular tube a0=pi * (D1*t1-t1**2.) dt=t2-t1 !thickness variation dd=D2-D1 !OD variation a1=pi * ( dd*t1 + D1*dt -2.*t1*dt)/L a2=pi * ( dd*dt-dt**2.)/L**2. BeamMass = b0*a0*L +(a0*b1+b0*a1)*L**2/2. + (b0*a2+b1*a1)*L**3/3 + a2*b1*L**4/4.!Integral of rho*A dz - ELSEIF (method==2) THEN !linearly varying area + + case (2) ! linearly varying area a0=D1 !This is an area a1=(D2-D1)/L !Delta area a2=0. BeamMass = b0*a0*L +(a0*b1+b0*a1)*L**2/2. + (b0*a2+b1*a1)*L**3/3 + a2*b1*L**4/4.!Integral of rho*A dz - ELSE + + case default print*,'Wrong call to BeamMass, method unknown',method STOP - ENDIF + end select END FUNCTION BeamMass diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index a52a5f5937..a67f794a09 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -304,14 +304,14 @@ typedef ^ MiscVarType ReKi UL {:} - - "Internal D typedef ^ MiscVarType ReKi UL_NS {:} - - "Internal DOFs (L) displacements, No SIM (NS)" typedef ^ MiscVarType ReKi UL_dot {:} - - typedef ^ MiscVarType ReKi UL_dotdot {:} - - -typedef ^ MiscVarType ReKi DU_full {:} - - "Delta U used for extra moment, size nDOF" -typedef ^ MiscVarType ReKi U_full {:} - - "Displacement of all DOFs (full system) with SIM" -typedef ^ MiscVarType ReKi U_full_NS {:} - - "Displacement of all DOFs (full system), No SIM (NS)" -typedef ^ MiscVarType ReKi U_full_dot {:} - - -typedef ^ MiscVarType ReKi U_full_dotdot {:} - - -typedef ^ MiscVarType ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM" -typedef ^ MiscVarType R8Ki U_red {:}{:} - - -typedef ^ MiscVarType R8Ki x_full {:}{:} - - +typedef ^ MiscVarType R8Ki DU_full {:} - - "Delta U used for extra moment, size nDOF" +typedef ^ MiscVarType R8Ki U_full {:} - - "Displacement of all DOFs (full system) with SIM" +typedef ^ MiscVarType R8Ki U_full_NS {:} - - "Displacement of all DOFs (full system), No SIM (NS)" +typedef ^ MiscVarType R8Ki U_full_dot {:} - - +typedef ^ MiscVarType R8Ki U_full_dotdot {:} - - +typedef ^ MiscVarType R8Ki U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM" +typedef ^ MiscVarType R8Ki U_red {:} - - +typedef ^ MiscVarType R8Ki x_full {:} - - typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" typedef ^ MiscVarType ReKi AllOuts {:} - - "Data for output file" diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index cc75010b71..df317bb18b 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -354,14 +354,14 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_NS !< Internal DOFs (L) displacements, No SIM (NS) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: U_red - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: x_full + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full_dot + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_red + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_full REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] @@ -3598,7 +3598,7 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyMisc' @@ -3815,10 +3815,10 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_elast = SrcMiscData%U_full_elast end if if (allocated(SrcMiscData%U_red)) then - LB(1:2) = lbound(SrcMiscData%U_red, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%U_red, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%U_red, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_red, kind=B8Ki) if (.not. allocated(DstMiscData%U_red)) then - allocate(DstMiscData%U_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) return @@ -3827,10 +3827,10 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_red = SrcMiscData%U_red end if if (allocated(SrcMiscData%x_full)) then - LB(1:2) = lbound(SrcMiscData%x_full, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%x_full, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%x_full, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%x_full, kind=B8Ki) if (.not. allocated(DstMiscData%x_full)) then - allocate(DstMiscData%x_full(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + allocate(DstMiscData%x_full(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%x_full.', ErrStat, ErrMsg, RoutineName) return @@ -4069,7 +4069,7 @@ subroutine SD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return From 2ebd615a7e285733c3e9991216b35d200a92996c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 11 Sep 2024 13:12:34 +0000 Subject: [PATCH 240/319] Fully initialize Mesh%ElemTable in MeshCreate --- modules/nwtc-library/src/ModMesh.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index d132312049..3ac94f066b 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -1170,10 +1170,12 @@ SUBROUTINE MeshCreate ( BlankMesh RETURN END IF - + ! Initialize element table DO i = 1, NELEMKINDS - BlankMesh%ElemTable(i)%nelem = 0 ; BlankMesh%ElemTable(i)%maxelem = 0 - NULLIFY(BlankMesh%ElemTable(i)%Elements ) + BlankMesh%ElemTable(i)%nelem = 0 + BlankMesh%ElemTable(i)%maxelem = 0 + BlankMesh%ElemTable(i)%Xelement = 0 + NULLIFY(BlankMesh%ElemTable(i)%Elements) ENDDO ALLOCATE(BlankMesh%RemapFlag, Stat=ErrStat2 ) ! assign some space for this pointer to point to From 89238f4e978f9c4643596e4bcaf782d13ab8824c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 11 Sep 2024 13:13:02 +0000 Subject: [PATCH 241/319] SubDyn: fix single precision compile --- modules/subdyn/src/SubDyn.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 5e51059356..39c46e674b 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -565,7 +565,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !locals INTEGER(IntKi) :: I ! Counters INTEGER(IntKi) :: iSDNode - REAL(ReKi) :: rotations(3) + REAL(R8Ki) :: rotations(3) REAL(ReKi) :: Y1(6) REAL(ReKi) :: Y1_CB(6) REAL(ReKi) :: Y1_CB_L(6) @@ -574,7 +574,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) REAL(ReKi) :: Y1_Utp(6) REAL(ReKi) :: Y1_GuyanLoadCorrection(3) ! Lever arm moment contributions due to interface displacement REAL(ReKi) :: udotdot_TP(6) - REAL(ReKi) :: DCM(3,3) + REAL(R8Ki) :: DCM(3,3) REAL(ReKi) :: F_I(6*p%nNodes_I) ! !Forces from all interface nodes listed in one big array ( those translated to TP ref point HydroTP(6) are implicitly calculated in the equations) ! Variables for Guyan rigid body motion real(ReKi), dimension(3) :: Om, OmD ! Omega, OmegaDot (body rotational speed and acceleration) @@ -596,7 +596,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! --- Convert inputs to FEM DOFs and convenient 6-vector storage ! Compute the small rotation angles given the input direction cosine matrix rotations = GetSmllRotAngs(u%TPMesh%Orientation(:,:,1), ErrStat2, Errmsg2); if(Failed()) return - m%u_TP = (/REAL(u%TPMesh%TranslationDisp(:,1),ReKi), rotations/) + m%u_TP = (/u%TPMesh%TranslationDisp(:,1), rotations/) m%udot_TP = (/u%TPMesh%TranslationVel( :,1), u%TPMesh%RotationVel(:,1)/) m%udotdot_TP = (/u%TPMesh%TranslationAcc( :,1), u%TPMesh%RotationAcc(:,1)/) Rg2b(1:3,1:3) = u%TPMesh%Orientation(:,:,1) ! global 2 body coordinates @@ -3086,7 +3086,7 @@ SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic) TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables LOGICAL, INTENT(IN ) :: bGuyan !< include Guyan Contribution LOGICAL, INTENT(IN ) :: bElastic !< include Elastic contribution - REAL(ReKi), DIMENSION(:), INTENT( OUT) :: DU_full !< LeverArm in full system + REAL(R8Ki), DIMENSION(:), INTENT( OUT) :: DU_full !< LeverArm in full system !locals INTEGER(IntKi) :: iSDNode REAL(ReKi) :: rotations(3) From 41649b20f52f438fe166037bbd3e58decc426754 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 11 Sep 2024 13:13:31 +0000 Subject: [PATCH 242/319] SeaSt_WaveField: remove unused WaveElev functions --- modules/seastate/src/SeaSt_WaveField.f90 | 59 ------------------------ 1 file changed, 59 deletions(-) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 600df4472f..028967787d 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -19,65 +19,6 @@ MODULE SeaSt_WaveField CONTAINS !-------------------- Subroutine for wave elevation ------------------! -function WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) - type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m - real(DbKi), intent(in ) :: Time - real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - integer(IntKi), intent( out) :: ErrStat ! Error status of the operation - character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None - - real(SiKi) :: WaveField_GetNodeWaveElev1 - real(SiKi) :: Zeta - character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev1' - integer(IntKi) :: errStat2 - character(ErrMsgLen) :: errMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - IF (ALLOCATED(WaveField%WaveElev1)) THEN - CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta = WaveField_Interp_3D( WaveField%WaveElev1, WaveField_m ) - ELSE - Zeta = 0.0_SiKi - END IF - - WaveField_GetNodeWaveElev1 = Zeta - -end function WaveField_GetNodeWaveElev1 - - -function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) - type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m - real(DbKi), intent(in ) :: Time - real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - integer(IntKi), intent( out) :: ErrStat ! Error status of the operation - character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None - - real(SiKi) :: WaveField_GetNodeWaveElev2 - real(SiKi) :: Zeta - character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev2' - integer(IntKi) :: errStat2 - character(ErrMsgLen) :: errMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - IF (ALLOCATED(WaveField%WaveElev2)) THEN - CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta = WaveField_Interp_3D( WaveField%WaveElev2, WaveField_m ) - ELSE - Zeta = 0.0_SiKi - END IF - - WaveField_GetNodeWaveElev2 = Zeta - -end function WaveField_GetNodeWaveElev2 - FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg, Elev1, Elev2 ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField From ea17262a72cc83cd63fe9e8f4f95de5e141b664d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 11 Sep 2024 17:01:07 +0000 Subject: [PATCH 243/319] Fix crashes with Intel compiler --- modules/hydrodyn/src/HydroDyn_Input.f90 | 2 +- modules/openfast-library/src/FAST_Mapping.f90 | 75 ++++++++++------- .../openfast-library/src/FAST_SolverTC.f90 | 38 +++++---- .../openfast-library/src/Glue_Registry.txt | 8 +- modules/openfast-library/src/Glue_Types.f90 | 82 ++++++++++++++++++- modules/subdyn/src/SubDyn.f90 | 6 +- 6 files changed, 160 insertions(+), 51 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 4e4800c3ea..d5274fe997 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -279,7 +279,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, FileInfo_In, InputFi ! AddCLin do i=1,6*InputFileData%vecMultiplier - write(strI,'(I1)') i + write(strI,'(I2)') i call ParseAry( FileInfo_In, CurLine, ' Row '//strI//' of the additional linear stiffness matrix', & tmpVec2, 6*InputFileData%NBody, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 1477e6f468..6746c2fa67 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -345,6 +345,7 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) integer(IntKi) :: i, j, k integer(IntKi) :: iMap, ModIns, iModIn, iModSrc, iModDst type(MappingType), allocatable :: MappingsTmp(:) + integer(IntKi), parameter :: MappingTypeOrder(*) = [Map_MotionMesh, Map_LoadMesh, Map_Variable, Map_Custom] ErrStat = ErrID_None ErrMsg = '' @@ -354,9 +355,9 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! Define a list of all possible module mesh mappings between modules - allocate (Mappings(0), stat=ErrStat2) + allocate (MappingsTmp(0), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating mappings", ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Error allocating temporary mappings", ErrStat, ErrMsg, RoutineName) return end if @@ -367,53 +368,71 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) ! Switch by destination module (inputs) select case (Mods(IModDst)%ID) case (Module_AD) - call InitMappings_AD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_AD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_BD) - call InitMappings_BD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_BD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ED) - call InitMappings_ED(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_ED(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtInfw) - call InitMappings_ExtInfw(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_ExtInfw(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtLd) - call InitMappings_ExtLd(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_ExtLd(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtPtfm) - call InitMappings_ExtPtfm(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_ExtPtfm(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_FEAM) - call InitMappings_FEAM(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_FEAM(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_HD) - call InitMappings_HD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_HD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IceD) - call InitMappings_IceD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_IceD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IceF) - call InitMappings_IceF(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_IceF(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_IfW) - call InitMappings_IfW(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_IfW(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_MAP) - call InitMappings_MAP(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_MAP(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_MD) - call InitMappings_MD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_MD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_Orca) - call InitMappings_Orca(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_Orca(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SD) - call InitMappings_SD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_SD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SeaSt) - call InitMappings_SeaSt(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_SeaSt(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SrvD) - call InitMappings_SrvD(Mappings, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + call InitMappings_SrvD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) end select if (Failed()) return end do end do !---------------------------------------------------------------------------- - ! Get module indices in ModData and determine which mappings are active + ! Reorder mappings to be Motion, Load, Variable, Custom !---------------------------------------------------------------------------- - ! Reorder the mappings so that motion maps come before the load maps - Mappings = [pack(Mappings, Mappings%MapType == Map_MotionMesh), & - pack(Mappings, Mappings%MapType == Map_LoadMesh), & - pack(Mappings, Mappings%MapType == Map_Variable), & - pack(Mappings, Mappings%MapType == Map_Custom)] + allocate(Mappings(size(MappingsTmp)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating mappings", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Loop through MappingTypeOrder and copy mesh to Mappings array if it matches the type + k = 0 + do i = 1, size(MappingTypeOrder) + do j = 1, size(MappingsTmp) + if (MappingsTmp(j)%MapType == MappingTypeOrder(i)) then + k = k + 1 + call Glue_CopyMappingType(MappingsTmp(j), Mappings(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + end if + end do + end do + + ! Destroy temporary mappings + do i = 1, size(MappingsTmp) + call Glue_DestroyMappingType(MappingsTmp(i), ErrStat2, ErrMsg2) + if (Failed()) return + end do ! Loop through mappings do iMap = 1, size(Mappings) @@ -1709,8 +1728,8 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & type(FAST_TurbineType), target :: Turbine type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(inout) :: SrcMod, DstMod - type(DatLoc), intent(in) :: SrcDL, DstDL - type(DatLoc), intent(in) :: SrcDispDL, DstDispDL + type(DatLoc), intent(in) :: SrcDL, DstDL + type(DatLoc), intent(in) :: SrcDispDL, DstDispDL integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg logical, optional, intent(in) :: Active @@ -1718,7 +1737,7 @@ subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & character(*), parameter :: RoutineName = 'MapLoadMesh' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - type(MappingType) :: Mapping + type(MappingType) :: Mapping type(MeshType), pointer :: SrcMesh, SrcDispMesh type(MeshType), pointer :: DstMesh, DstDispMesh type(MeshType) :: DstMotionMesh diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 9160e0a93f..71fafb74ab 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -156,6 +156,8 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS call CalcVarGlobalIndices(p, m%Mod, p%NumQ, p%NumJ, ErrStat2, ErrMsg2) if (Failed()) return + p%NumU = p%iJU(2) - p%iJU(2) + 1 + p%NumUT = p%iUT(2) - p%iUT(1) + 1 !---------------------------------------------------------------------------- ! Initialize MiscVars @@ -182,6 +184,10 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS m%StateCurr%a = 0.0_R8Ki ! Allocate Jacobian matrix, RHS/X matrix, Pivot array + call AllocAry(m%J11, p%NumQ, p%NumQ, "m%J11", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%J12, p%NumQ, p%NumUT, "m%J12", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%J21, p%NumUT, p%NumQ, "m%J21", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%J22, p%NumU, p%NumU, "m%J22", ErrStat, ErrMsg); if (Failed()) return call AllocAry(m%Mod%Lin%J, p%NumJ, p%NumJ, "m%J", ErrStat, ErrMsg); if (Failed()) return call AllocAry(m%XB, p%NumJ, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return call AllocAry(m%IPIV, p%NumJ, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return @@ -215,7 +221,7 @@ subroutine SetVarSolveFlags() end associate end do - ! dUdu + ! dUdu ! VarsDst%u, VarDst(FieldTransDisp), VarsDst%u, VarDst(FieldTransVel) ! VarsDst%u, VarDst(FieldTransDisp), VarsDst%u, VarDst(FieldTransAcc) ! VarsSrc%u, VarSrcDisp(FieldTransDisp), VarsDst%u, VarDst(FieldMoment) @@ -369,7 +375,7 @@ subroutine SetVarSolveFlags() do j = 1, size(ModData%Vars%u) associate (Var => ModData%Vars%u(j)) if (MV_HasFlagsAny(Var, VF_Solve)) then - write (*,*) 'Solve u:', FAST_InputFieldName(ModData, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + write (*, *) 'Solve u:', FAST_InputFieldName(ModData, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end if end associate end do @@ -378,7 +384,7 @@ subroutine SetVarSolveFlags() do j = 1, size(ModData%Vars%y) associate (Var => ModData%Vars%y(j)) if (MV_HasFlagsAny(Var, VF_Solve)) then - write (*,*) 'Solve y:', FAST_OutputFieldName(ModData, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + write (*, *) 'Solve y:', FAST_OutputFieldName(ModData, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num end if end associate end do @@ -1656,7 +1662,7 @@ subroutine BuildJacobianTC(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat character(*), parameter :: RoutineName = 'BuildJacobianTC' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - real(R8Ki) :: phi, rv(3), T(3, 3), tmp1, tmp2, T2(3, 3) + real(R8Ki), allocatable :: J22(:, :) integer(IntKi) :: i, j, k, idx ErrStat = ErrID_None @@ -1728,24 +1734,24 @@ subroutine BuildJacobianTC(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat if (p%iJX(1) > 0) then ! Group (1,1) - associate (J11 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJX(1):p%iJX(2)), & - dX2dx2 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)), & + associate (dX2dx2 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)), & dX2dx1 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX1(1):p%iX1(2))) - J11 = -p%GammaPrime*dX2dx2 - p%BetaPrime*dX2dx1 + m%J11 = -p%GammaPrime*dX2dx2 - p%BetaPrime*dX2dx1 do i = p%iJX(1), p%iJX(2) - J11(i, i) = J11(i, i) + 1.0_R8Ki + m%J11(i, i) = m%J11(i, i) + 1.0_R8Ki end do + m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJX(1):p%iJX(2)) = m%J11 end associate ! Group (2,1) if (p%iyT(1) > 0 .and. p%iUT(1) > 0) then - associate (J21 => m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)), & - dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & + associate (dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & dYTdx2 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2)), & dYTdx1 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) ! J21 = C1*matmul(dUTdyT, dYTdx2) + C2*matmul(dUTdyT, dYTdx1) - call LAPACK_GEMM('N', 'N', p%GammaPrime, dUTdyT, dYTdx2, 0.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return - call LAPACK_GEMM('N', 'N', p%BetaPrime, dUTdyT, dYTdx1, 1.0_R8Ki, J21, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', p%GammaPrime, dUTdyT, dYTdx2, 0.0_R8Ki, m%J21, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', p%BetaPrime, dUTdyT, dYTdx1, 1.0_R8Ki, m%J21, ErrStat2, ErrMsg2); if (Failed()) return + m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)) = m%J21 end associate end if @@ -1761,11 +1767,9 @@ subroutine BuildJacobianTC(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat ! Group (2,2) - Inputs = dUdu + matmul(dUdy, dYdu) if (p%iJU(1) > 0) then - associate (J22 => m%Mod%Lin%J(p%iJU(1):p%iJU(2), p%iJU(1):p%iJU(2))) - ! J22 = m%Mod%Lin%dUdu + matmul(m%Mod%Lin%dUdy, m%Mod%Lin%dYdu) - J22 = m%Mod%Lin%dUdu - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, J22, ErrStat2, ErrMsg2); if (Failed()) return - end associate + J22 = m%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, J22, ErrStat2, ErrMsg2); if (Failed()) return + m%Mod%Lin%J(p%iJU(1):p%iJU(2), p%iJU(1):p%iJU(2)) = J22 end if ! Write debug matrices if requested diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index c750b12a90..6f80c46296 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -83,7 +83,9 @@ typedef ^ ^ R8Ki Gamma - - - typedef ^ ^ R8Ki BetaPrime - - - "Generalized-alpha beta prime" - typedef ^ ^ R8Ki GammaPrime - - - "Generalized-alpha gamma prime" - typedef ^ ^ IntKi NumJ - - - "Number of values in Jacobian" - -typedef ^ ^ IntKi NumQ - - - "Number of values in state arrays" - +typedef ^ ^ IntKi NumQ - - - "Number of states in Jacobian" - +typedef ^ ^ IntKi NumU - - - "Number of total inputs in Jacobian" - +typedef ^ ^ IntKi NumUT - - - "Number of TC inputs in Jacobian" - typedef ^ ^ IntKi iX1 2 - - "" - typedef ^ ^ IntKi iX2 2 - - "" - typedef ^ ^ IntKi iUT 2 - - "" - @@ -176,6 +178,10 @@ typedef ^ ^ IntKi UJacStepsRemain - 0 - typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - typedef ^ ^ R8Ki XB_IO :: - - "" - typedef ^ ^ R8Ki Jac_IO :: - - "" - +typedef ^ ^ R8Ki J11 :: - - "Jacobian upper left quadrant" - +typedef ^ ^ R8Ki J12 :: - - "Jacobian upper right quadrant" - +typedef ^ ^ R8Ki J21 :: - - "Jacobian lower left quadrant" - +typedef ^ ^ R8Ki J22 :: - - "Jacobian lower right quadrant" - typedef ^ Glue_LinMisc IntKi TimeIndex - - - "" - typedef ^ ^ IntKi AzimuthIndex - - - "" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index 3439ebf4cd..b43d761c01 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -110,7 +110,9 @@ MODULE Glue_Types REAL(R8Ki) :: BetaPrime = 0.0_R8Ki !< Generalized-alpha beta prime [-] REAL(R8Ki) :: GammaPrime = 0.0_R8Ki !< Generalized-alpha gamma prime [-] INTEGER(IntKi) :: NumJ = 0_IntKi !< Number of values in Jacobian [-] - INTEGER(IntKi) :: NumQ = 0_IntKi !< Number of values in state arrays [-] + INTEGER(IntKi) :: NumQ = 0_IntKi !< Number of states in Jacobian [-] + INTEGER(IntKi) :: NumU = 0_IntKi !< Number of total inputs in Jacobian [-] + INTEGER(IntKi) :: NumUT = 0_IntKi !< Number of TC inputs in Jacobian [-] INTEGER(IntKi) , DIMENSION(1:2) :: iX1 = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iX2 = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iUT = 0_IntKi !< [-] @@ -219,6 +221,10 @@ MODULE Glue_Types LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB_IO !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac_IO !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J11 !< Jacobian upper left quadrant [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J12 !< Jacobian upper right quadrant [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J21 !< Jacobian lower left quadrant [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J22 !< Jacobian lower right quadrant [-] END TYPE Glue_TCMisc ! ======================= ! ========= Glue_LinMisc ======= @@ -734,6 +740,8 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E DstTCParamData%GammaPrime = SrcTCParamData%GammaPrime DstTCParamData%NumJ = SrcTCParamData%NumJ DstTCParamData%NumQ = SrcTCParamData%NumQ + DstTCParamData%NumU = SrcTCParamData%NumU + DstTCParamData%NumUT = SrcTCParamData%NumUT DstTCParamData%iX1 = SrcTCParamData%iX1 DstTCParamData%iX2 = SrcTCParamData%iX2 DstTCParamData%iUT = SrcTCParamData%iUT @@ -852,6 +860,8 @@ subroutine Glue_PackTCParam(RF, Indata) call RegPack(RF, InData%GammaPrime) call RegPack(RF, InData%NumJ) call RegPack(RF, InData%NumQ) + call RegPack(RF, InData%NumU) + call RegPack(RF, InData%NumUT) call RegPack(RF, InData%iX1) call RegPack(RF, InData%iX2) call RegPack(RF, InData%iUT) @@ -895,6 +905,8 @@ subroutine Glue_UnPackTCParam(RF, OutData) call RegUnpack(RF, OutData%GammaPrime); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumJ); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumUT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iX1); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iX2); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%iUT); if (RegCheckErr(RF, RoutineName)) return @@ -1904,6 +1916,54 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM end if DstTCMiscData%Jac_IO = SrcTCMiscData%Jac_IO end if + if (allocated(SrcTCMiscData%J11)) then + LB(1:2) = lbound(SrcTCMiscData%J11, kind=B8Ki) + UB(1:2) = ubound(SrcTCMiscData%J11, kind=B8Ki) + if (.not. allocated(DstTCMiscData%J11)) then + allocate(DstTCMiscData%J11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%J11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%J11 = SrcTCMiscData%J11 + end if + if (allocated(SrcTCMiscData%J12)) then + LB(1:2) = lbound(SrcTCMiscData%J12, kind=B8Ki) + UB(1:2) = ubound(SrcTCMiscData%J12, kind=B8Ki) + if (.not. allocated(DstTCMiscData%J12)) then + allocate(DstTCMiscData%J12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%J12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%J12 = SrcTCMiscData%J12 + end if + if (allocated(SrcTCMiscData%J21)) then + LB(1:2) = lbound(SrcTCMiscData%J21, kind=B8Ki) + UB(1:2) = ubound(SrcTCMiscData%J21, kind=B8Ki) + if (.not. allocated(DstTCMiscData%J21)) then + allocate(DstTCMiscData%J21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%J21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%J21 = SrcTCMiscData%J21 + end if + if (allocated(SrcTCMiscData%J22)) then + LB(1:2) = lbound(SrcTCMiscData%J22, kind=B8Ki) + UB(1:2) = ubound(SrcTCMiscData%J22, kind=B8Ki) + if (.not. allocated(DstTCMiscData%J22)) then + allocate(DstTCMiscData%J22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%J22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%J22 = SrcTCMiscData%J22 + end if end subroutine subroutine Glue_DestroyTCMisc(TCMiscData, ErrStat, ErrMsg) @@ -1936,6 +1996,18 @@ subroutine Glue_DestroyTCMisc(TCMiscData, ErrStat, ErrMsg) if (allocated(TCMiscData%Jac_IO)) then deallocate(TCMiscData%Jac_IO) end if + if (allocated(TCMiscData%J11)) then + deallocate(TCMiscData%J11) + end if + if (allocated(TCMiscData%J12)) then + deallocate(TCMiscData%J12) + end if + if (allocated(TCMiscData%J21)) then + deallocate(TCMiscData%J21) + end if + if (allocated(TCMiscData%J22)) then + deallocate(TCMiscData%J22) + end if end subroutine subroutine Glue_PackTCMisc(RF, Indata) @@ -1955,6 +2027,10 @@ subroutine Glue_PackTCMisc(RF, Indata) call RegPack(RF, InData%ConvWarn) call RegPackAlloc(RF, InData%XB_IO) call RegPackAlloc(RF, InData%Jac_IO) + call RegPackAlloc(RF, InData%J11) + call RegPackAlloc(RF, InData%J12) + call RegPackAlloc(RF, InData%J21) + call RegPackAlloc(RF, InData%J22) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1978,6 +2054,10 @@ subroutine Glue_UnPackTCMisc(RF, OutData) call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%XB_IO); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Jac_IO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J21); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J22); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Glue_CopyLinMisc(SrcLinMiscData, DstLinMiscData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 39c46e674b..f891a5a6c4 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -4096,14 +4096,14 @@ FUNCTION MemberLength(MemberID,Init,ErrStat,ErrMsg) MemberLength=0.0 !Find the MemberID in the list - iMember = FINDLOC(Init%Members(:,1), MemberID, dim=1) + iMember = FINDLOCI(Init%Members(:,1), MemberID) if (iMember<=0) then call SetErrStat(ErrID_Fatal,' Member with ID '//trim(Num2LStr(MemberID))//' not found in member list!', ErrStat,ErrMsg,RoutineName); return endif ! Find joints ID for this member - Joint1 = FINDLOC(Init%Joints(:,1), Init%Members(iMember,2), dim=1) - Joint2 = FINDLOC(Init%Joints(:,1), Init%Members(iMember,3), dim=1) + Joint1 = FINDLOCI(Init%Joints(:,1), Init%Members(iMember,2)) + Joint2 = FINDLOCI(Init%Joints(:,1), Init%Members(iMember,3)) xyz1= Init%Joints(Joint1,2:4) xyz2= Init%Joints(Joint2,2:4) MemberLength=SQRT( SUM((xyz2-xyz1)**2.) ) From 622b60b537149315c80140a8317294a556e361f5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 11 Sep 2024 22:10:20 +0000 Subject: [PATCH 244/319] Everything builds after merge --- modules/aerodisk/src/AeroDisk_Registry.txt | 8 +- modules/aerodisk/src/AeroDisk_Types.f90 | 401 +++++++++- modules/hydrodyn/src/HydroDyn_Types.f90 | 25 +- modules/hydrodyn/src/Morison.f90 | 4 +- modules/hydrodyn/src/Morison_Types.f90 | 13 +- modules/hydrodyn/src/WAMIT_Types.f90 | 9 +- modules/openfast-library/src/FAST_AeroMap.f90 | 6 +- modules/openfast-library/src/FAST_Funcs.f90 | 2 + .../openfast-library/src/FAST_Registry.txt | 16 +- modules/openfast-library/src/FAST_Subs.f90 | 293 +++---- modules/openfast-library/src/FAST_Types.f90 | 683 +++++++++++++--- modules/servodyn/src/ServoDyn_Types.f90 | 38 +- modules/simple-elastodyn/src/SED_Registry.txt | 7 +- modules/simple-elastodyn/src/SED_Types.f90 | 476 ++++++++++- modules/subdyn/src/SubDyn_Registry.txt | 37 +- modules/subdyn/src/SubDyn_Types.f90 | 744 ++++-------------- 16 files changed, 1790 insertions(+), 972 deletions(-) diff --git a/modules/aerodisk/src/AeroDisk_Registry.txt b/modules/aerodisk/src/AeroDisk_Registry.txt index 93d0aefa6b..32c865fe80 100644 --- a/modules/aerodisk/src/AeroDisk_Registry.txt +++ b/modules/aerodisk/src/AeroDisk_Registry.txt @@ -65,7 +65,7 @@ typedef ^ InitInputType FlowFieldType *FlowField - - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - - +typedef ^ InitOutputType ModVarsType Vars - - - "Module variables" - # ..... Inputs .................................................................................................................... # inputs on meshes: NONE @@ -135,4 +135,10 @@ typedef ^ MiscVarType SiKi Moment 3 - typedef ^ MiscVarType ReKi DiskWindPosAbs {:}{:} - - "Disk locations for sampling to get disk avarage velocity (absolute for getting wind)" m typedef ^ MiscVarType ReKi DiskWindVel {:}{:} - - "Wind speed at disk locations for disk velocity" m/s typedef ^ MiscVarType ReKi DiskAvgVel 3 - - "Average wind speed across rotor disk" m/s +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ MiscVarType ADsk_ContinuousStateType x_perturb - - - "Continuous state type for linearization perturbation" - +typedef ^ MiscVarType ADsk_ContinuousStateType dxdt_lin - - - "Continuous state type for linearization output" - +typedef ^ MiscVarType ADsk_InputType u_perturb - - - "Input type for linearization perturbation" - +typedef ^ MiscVarType ADsk_OutputType y_lin - - - "Output type for linearization output" - + diff --git a/modules/aerodisk/src/AeroDisk_Types.f90 b/modules/aerodisk/src/AeroDisk_Types.f90 index 6da764cd80..7cfce7a058 100644 --- a/modules/aerodisk/src/AeroDisk_Types.f90 +++ b/modules/aerodisk/src/AeroDisk_Types.f90 @@ -34,7 +34,7 @@ MODULE AeroDisk_Types USE IfW_FlowField_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ADsk_NumPtsDiskAvg = 144 ! Number of points averaged for rotor-average wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADsk_NumPtsDiskAvg = 144 ! Number of points averaged for rotor-average wind speed [-] ! ========= ADsk_AeroTable ======= TYPE, PUBLIC :: ADsk_AeroTable INTEGER(IntKi) :: N_TSR = 0_IntKi !< Number of rotor tip-speed ratios in tables [-] @@ -86,6 +86,7 @@ MODULE AeroDisk_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) :: Vars !< Module variables [-] END TYPE ADsk_InitOutputType ! ======================= ! ========= ADsk_InputType ======= @@ -160,9 +161,28 @@ MODULE AeroDisk_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DiskWindPosAbs !< Disk locations for sampling to get disk avarage velocity (absolute for getting wind) [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DiskWindVel !< Wind speed at disk locations for disk velocity [m/s] REAL(ReKi) , DIMENSION(1:3) :: DiskAvgVel = 0.0_ReKi !< Average wind speed across rotor disk [m/s] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(ADsk_ContinuousStateType) :: x_perturb !< Continuous state type for linearization perturbation [-] + TYPE(ADsk_ContinuousStateType) :: dxdt_lin !< Continuous state type for linearization output [-] + TYPE(ADsk_InputType) :: u_perturb !< Input type for linearization perturbation [-] + TYPE(ADsk_OutputType) :: y_lin !< Output type for linearization output [-] END TYPE ADsk_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ADsk_x_DummyContState = 1 ! ADsk%DummyContState + integer(IntKi), public, parameter :: ADsk_z_DummyConstrState = 2 ! ADsk%DummyConstrState + integer(IntKi), public, parameter :: ADsk_u_HubMotion = 3 ! ADsk%HubMotion + integer(IntKi), public, parameter :: ADsk_u_RotSpeed = 4 ! ADsk%RotSpeed + integer(IntKi), public, parameter :: ADsk_u_BlPitch = 5 ! ADsk%BlPitch + integer(IntKi), public, parameter :: ADsk_y_AeroLoads = 6 ! ADsk%AeroLoads + integer(IntKi), public, parameter :: ADsk_y_YawErr = 7 ! ADsk%YawErr + integer(IntKi), public, parameter :: ADsk_y_PsiSkew = 8 ! ADsk%PsiSkew + integer(IntKi), public, parameter :: ADsk_y_ChiSkew = 9 ! ADsk%ChiSkew + integer(IntKi), public, parameter :: ADsk_y_VRel = 10 ! ADsk%VRel + integer(IntKi), public, parameter :: ADsk_y_Ct = 11 ! ADsk%Ct + integer(IntKi), public, parameter :: ADsk_y_Cq = 12 ! ADsk%Cq + integer(IntKi), public, parameter :: ADsk_y_WriteOutput = 13 ! ADsk%WriteOutput + +contains subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrStat, ErrMsg) type(ADsk_AeroTable), intent(in) :: SrcAeroTableData @@ -634,6 +654,9 @@ subroutine ADsk_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ADsk_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -653,6 +676,8 @@ subroutine ADsk_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADsk_PackInitOutput(RF, Indata) @@ -663,6 +688,7 @@ subroutine ADsk_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -677,6 +703,7 @@ subroutine ADsk_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine ADsk_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1140,13 +1167,14 @@ subroutine ADsk_UnPackParam(RF, OutData) end subroutine subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(ADsk_MiscVarType), intent(in) :: SrcMiscData + type(ADsk_MiscVarType), intent(inout) :: SrcMiscData type(ADsk_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyMisc' ErrStat = ErrID_None ErrMsg = '' @@ -1199,12 +1227,29 @@ subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DiskWindVel = SrcMiscData%DiskWindVel end if DstMiscData%DiskAvgVel = SrcMiscData%DiskAvgVel + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ADsk_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ADsk_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' @@ -1217,6 +1262,16 @@ subroutine ADsk_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%DiskWindVel)) then deallocate(MiscData%DiskWindVel) end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADsk_PackMisc(RF, Indata) @@ -1240,6 +1295,11 @@ subroutine ADsk_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%DiskWindPosAbs) call RegPackAlloc(RF, InData%DiskWindVel) call RegPack(RF, InData%DiskAvgVel) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call ADsk_PackContState(RF, InData%x_perturb) + call ADsk_PackContState(RF, InData%dxdt_lin) + call ADsk_PackInput(RF, InData%u_perturb) + call ADsk_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1267,6 +1327,11 @@ subroutine ADsk_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%DiskWindPosAbs); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DiskWindVel); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DiskAvgVel); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call ADsk_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call ADsk_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call ADsk_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call ADsk_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine ADsk_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -1606,5 +1671,335 @@ SUBROUTINE ADsk_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function ADsk_InputMeshPointer(u, DL) result(Mesh) + type(ADsk_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ADsk_u_HubMotion) + Mesh => u%HubMotion + end select +end function + +function ADsk_OutputMeshPointer(y, DL) result(Mesh) + type(ADsk_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ADsk_y_AeroLoads) + Mesh => y%AeroLoads + end select +end function + +subroutine ADsk_VarsPackContState(Vars, x, ValAry) + type(ADsk_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADsk_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADsk_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine ADsk_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ADsk_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADsk_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADsk_VarsPackContStateDeriv(Vars, x, ValAry) + type(ADsk_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADsk_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsPackConstrState(Vars, z, ValAry) + type(ADsk_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ADsk_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ADsk_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine ADsk_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ADsk_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADsk_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADsk_VarsPackInput(Vars, u, ValAry) + type(ADsk_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ADsk_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_u_HubMotion) + call MV_PackMesh(V, u%HubMotion, ValAry) ! Mesh + case (ADsk_u_RotSpeed) + VarVals(1) = u%RotSpeed ! Scalar + case (ADsk_u_BlPitch) + VarVals(1) = u%BlPitch ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ADsk_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine ADsk_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_u_HubMotion) + call MV_UnpackMesh(V, ValAry, u%HubMotion) ! Mesh + case (ADsk_u_RotSpeed) + u%RotSpeed = VarVals(1) ! Scalar + case (ADsk_u_BlPitch) + u%BlPitch = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ADsk_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADsk_u_HubMotion) + Name = "u%HubMotion" + case (ADsk_u_RotSpeed) + Name = "u%RotSpeed" + case (ADsk_u_BlPitch) + Name = "u%BlPitch" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADsk_VarsPackOutput(Vars, y, ValAry) + type(ADsk_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ADsk_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_y_AeroLoads) + call MV_PackMesh(V, y%AeroLoads, ValAry) ! Mesh + case (ADsk_y_YawErr) + VarVals(1) = y%YawErr ! Scalar + case (ADsk_y_PsiSkew) + VarVals(1) = y%PsiSkew ! Scalar + case (ADsk_y_ChiSkew) + VarVals(1) = y%ChiSkew ! Scalar + case (ADsk_y_VRel) + VarVals(1) = y%VRel ! Scalar + case (ADsk_y_Ct) + VarVals(1) = y%Ct ! Scalar + case (ADsk_y_Cq) + VarVals(1) = y%Cq ! Scalar + case (ADsk_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ADsk_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine ADsk_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_y_AeroLoads) + call MV_UnpackMesh(V, ValAry, y%AeroLoads) ! Mesh + case (ADsk_y_YawErr) + y%YawErr = VarVals(1) ! Scalar + case (ADsk_y_PsiSkew) + y%PsiSkew = VarVals(1) ! Scalar + case (ADsk_y_ChiSkew) + y%ChiSkew = VarVals(1) ! Scalar + case (ADsk_y_VRel) + y%VRel = VarVals(1) ! Scalar + case (ADsk_y_Ct) + y%Ct = VarVals(1) ! Scalar + case (ADsk_y_Cq) + y%Cq = VarVals(1) ! Scalar + case (ADsk_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ADsk_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADsk_y_AeroLoads) + Name = "y%AeroLoads" + case (ADsk_y_YawErr) + Name = "y%YawErr" + case (ADsk_y_PsiSkew) + Name = "y%PsiSkew" + case (ADsk_y_ChiSkew) + Name = "y%ChiSkew" + case (ADsk_y_VRel) + Name = "y%VRel" + case (ADsk_y_Ct) + Name = "y%Ct" + case (ADsk_y_Cq) + Name = "y%Cq" + case (ADsk_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE AeroDisk_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 46e645d2d6..1d2a8fd6e7 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -229,15 +229,16 @@ MODULE HydroDyn_Types integer(IntKi), public, parameter :: HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState = 7 ! HydroDyn%WAMIT%SS_Exctn%DummyConstrState integer(IntKi), public, parameter :: HydroDyn_z_Morison_DummyConstrState = 8 ! HydroDyn%Morison%DummyConstrState integer(IntKi), public, parameter :: HydroDyn_u_Morison_Mesh = 9 ! HydroDyn%Morison%Mesh - integer(IntKi), public, parameter :: HydroDyn_u_WAMITMesh = 10 ! HydroDyn%WAMITMesh - integer(IntKi), public, parameter :: HydroDyn_u_PRPMesh = 11 ! HydroDyn%PRPMesh - integer(IntKi), public, parameter :: HydroDyn_y_WAMIT_Mesh = 12 ! HydroDyn%WAMIT(DL%i1)%Mesh - integer(IntKi), public, parameter :: HydroDyn_y_WAMIT2_Mesh = 13 ! HydroDyn%WAMIT2(DL%i1)%Mesh - integer(IntKi), public, parameter :: HydroDyn_y_Morison_Mesh = 14 ! HydroDyn%Morison%Mesh - integer(IntKi), public, parameter :: HydroDyn_y_Morison_VisMesh = 15 ! HydroDyn%Morison%VisMesh - integer(IntKi), public, parameter :: HydroDyn_y_Morison_WriteOutput = 16 ! HydroDyn%Morison%WriteOutput - integer(IntKi), public, parameter :: HydroDyn_y_WAMITMesh = 17 ! HydroDyn%WAMITMesh - integer(IntKi), public, parameter :: HydroDyn_y_WriteOutput = 18 ! HydroDyn%WriteOutput + integer(IntKi), public, parameter :: HydroDyn_u_Morison_PtfmRefY = 10 ! HydroDyn%Morison%PtfmRefY + integer(IntKi), public, parameter :: HydroDyn_u_WAMITMesh = 11 ! HydroDyn%WAMITMesh + integer(IntKi), public, parameter :: HydroDyn_u_PRPMesh = 12 ! HydroDyn%PRPMesh + integer(IntKi), public, parameter :: HydroDyn_y_WAMIT_Mesh = 13 ! HydroDyn%WAMIT(DL%i1)%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_WAMIT2_Mesh = 14 ! HydroDyn%WAMIT2(DL%i1)%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_Mesh = 15 ! HydroDyn%Morison%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_VisMesh = 16 ! HydroDyn%Morison%VisMesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_WriteOutput = 17 ! HydroDyn%Morison%WriteOutput + integer(IntKi), public, parameter :: HydroDyn_y_WAMITMesh = 18 ! HydroDyn%WAMITMesh + integer(IntKi), public, parameter :: HydroDyn_y_WriteOutput = 19 ! HydroDyn%WriteOutput contains @@ -2868,6 +2869,8 @@ subroutine HydroDyn_VarPackInput(V, u, ValAry) select case (DL%Num) case (HydroDyn_u_Morison_Mesh) call MV_PackMesh(V, u%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_u_Morison_PtfmRefY) + VarVals(1) = u%Morison%PtfmRefY ! Scalar case (HydroDyn_u_WAMITMesh) call MV_PackMesh(V, u%WAMITMesh, ValAry) ! Mesh case (HydroDyn_u_PRPMesh) @@ -2896,6 +2899,8 @@ subroutine HydroDyn_VarUnpackInput(V, ValAry, u) select case (DL%Num) case (HydroDyn_u_Morison_Mesh) call MV_UnpackMesh(V, ValAry, u%Morison%Mesh) ! Mesh + case (HydroDyn_u_Morison_PtfmRefY) + u%Morison%PtfmRefY = VarVals(1) ! Scalar case (HydroDyn_u_WAMITMesh) call MV_UnpackMesh(V, ValAry, u%WAMITMesh) ! Mesh case (HydroDyn_u_PRPMesh) @@ -2910,6 +2915,8 @@ function HydroDyn_InputFieldName(DL) result(Name) select case (DL%Num) case (HydroDyn_u_Morison_Mesh) Name = "u%Morison%Mesh" + case (HydroDyn_u_Morison_PtfmRefY) + Name = "u%Morison%PtfmRefY" case (HydroDyn_u_WAMITMesh) Name = "u%WAMITMesh" case (HydroDyn_u_PRPMesh) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index be7cea20f8..6588b8e584 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2520,6 +2520,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, INTEGER :: I, J REAL(ReKi) :: qdotdot(6) ! The structural acceleration of a mesh node + TYPE(Morison_MemberType) :: mem ! the current member INTEGER :: N ! Number of elements within a given member REAL(ReKi) :: dl ! Element length within a given member, m REAL(ReKi) :: vec(3) ! Vector pointing from a member's 1st node to its last node @@ -2624,7 +2625,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Loop through each member DO im = 1, p%NMembers - associate (mem => p%Members(im)) + mem = p%Members(im) N = mem%NElements call YawMember(mem, u%PtfmRefY, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3470,7 +3471,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, end if ! PropPot !----------------------------------- external buoyancy loads: ends -----------------------------------! - end associate end do ! im - looping through members !---------------------------------------------------------------------------------------------------------------! diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 9c8c9609d4..b3e567e69d 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -436,9 +436,10 @@ MODULE Morison_Types integer(IntKi), public, parameter :: Morison_x_DummyContState = 1 ! Morison%DummyContState integer(IntKi), public, parameter :: Morison_z_DummyConstrState = 2 ! Morison%DummyConstrState integer(IntKi), public, parameter :: Morison_u_Mesh = 3 ! Morison%Mesh - integer(IntKi), public, parameter :: Morison_y_Mesh = 4 ! Morison%Mesh - integer(IntKi), public, parameter :: Morison_y_VisMesh = 5 ! Morison%VisMesh - integer(IntKi), public, parameter :: Morison_y_WriteOutput = 6 ! Morison%WriteOutput + integer(IntKi), public, parameter :: Morison_u_PtfmRefY = 4 ! Morison%PtfmRefY + integer(IntKi), public, parameter :: Morison_y_Mesh = 5 ! Morison%Mesh + integer(IntKi), public, parameter :: Morison_y_VisMesh = 6 ! Morison%VisMesh + integer(IntKi), public, parameter :: Morison_y_WriteOutput = 7 ! Morison%WriteOutput contains @@ -4859,6 +4860,8 @@ subroutine Morison_VarPackInput(V, u, ValAry) select case (DL%Num) case (Morison_u_Mesh) call MV_PackMesh(V, u%Mesh, ValAry) ! Mesh + case (Morison_u_PtfmRefY) + VarVals(1) = u%PtfmRefY ! Scalar case default VarVals = 0.0_R8Ki end select @@ -4883,6 +4886,8 @@ subroutine Morison_VarUnpackInput(V, ValAry, u) select case (DL%Num) case (Morison_u_Mesh) call MV_UnpackMesh(V, ValAry, u%Mesh) ! Mesh + case (Morison_u_PtfmRefY) + u%PtfmRefY = VarVals(1) ! Scalar end select end associate end subroutine @@ -4893,6 +4898,8 @@ function Morison_InputFieldName(DL) result(Name) select case (DL%Num) case (Morison_u_Mesh) Name = "u%Mesh" + case (Morison_u_PtfmRefY) + Name = "u%PtfmRefY" case default Name = "Unknown Field" end select diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 9dfabed739..6b585bcf2b 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -153,7 +153,8 @@ MODULE WAMIT_Types integer(IntKi), public, parameter :: WAMIT_z_SS_Rdtn_DummyConstrState = 5 ! WAMIT%SS_Rdtn%DummyConstrState integer(IntKi), public, parameter :: WAMIT_z_SS_Exctn_DummyConstrState = 6 ! WAMIT%SS_Exctn%DummyConstrState integer(IntKi), public, parameter :: WAMIT_u_Mesh = 7 ! WAMIT%Mesh - integer(IntKi), public, parameter :: WAMIT_y_Mesh = 8 ! WAMIT%Mesh + integer(IntKi), public, parameter :: WAMIT_u_PtfmRefY = 8 ! WAMIT%PtfmRefY + integer(IntKi), public, parameter :: WAMIT_y_Mesh = 9 ! WAMIT%Mesh contains @@ -1674,6 +1675,8 @@ subroutine WAMIT_VarPackInput(V, u, ValAry) select case (DL%Num) case (WAMIT_u_Mesh) call MV_PackMesh(V, u%Mesh, ValAry) ! Mesh + case (WAMIT_u_PtfmRefY) + VarVals(1) = u%PtfmRefY ! Scalar case default VarVals = 0.0_R8Ki end select @@ -1698,6 +1701,8 @@ subroutine WAMIT_VarUnpackInput(V, ValAry, u) select case (DL%Num) case (WAMIT_u_Mesh) call MV_UnpackMesh(V, ValAry, u%Mesh) ! Mesh + case (WAMIT_u_PtfmRefY) + u%PtfmRefY = VarVals(1) ! Scalar end select end associate end subroutine @@ -1708,6 +1713,8 @@ function WAMIT_InputFieldName(DL) result(Name) select case (DL%Num) case (WAMIT_u_Mesh) Name = "u%Mesh" + case (WAMIT_u_PtfmRefY) + Name = "u%PtfmRefY" case default Name = "Unknown Field" end select diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index 5fe2566139..f25d246e1d 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -112,7 +112,7 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) ! Standard Turbine initialization call FAST_InitializeAll(t_initial, T%m_Glue, T%p_FAST, T%y_FAST, T%m_FAST, & - T%ED, T%BD, T%SrvD, T%AD, & + T%ED, T%SED, T%BD, T%SrvD, T%AD, T%ADsk, & T%ExtLd, T%IfW, T%ExtInfw, T%SC_DX, & T%SeaSt, T%HD, T%SD, T%ExtPtfm, T%MAP, & T%FEAM, T%MD, T%Orca, T%IceF, T%IceD, & @@ -305,8 +305,8 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) n_global = real(n_case, DbKi) ! n_global is double-precision so that we can reuse existing code. - call WrOutputLine(n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, T%ED%y%WriteOutput, & - T%AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & + call WrOutputLine(n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, T%ED%y%WriteOutput, UnusedAry, & + T%AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & UnusedAry, UnusedAry, UnusedAry, UnusedAry, T%IceD%y, T%BD%y, ErrStat2, ErrMsg2) if (Failed()) return diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index c5546cc181..2d8bcf7895 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -24,6 +24,7 @@ module FAST_Funcs use FAST_Types use FAST_ModTypes use NWTC_LAPACK +use AeroDisk use AeroDyn use BeamDyn use ElastoDyn @@ -39,6 +40,7 @@ module FAST_Funcs use MoorDyn use OrcaFlexInterface use SeaState +use SED use ServoDyn use SubDyn diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 00b8b32a6c..f209973074 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -461,10 +461,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... Simplified-ElastoDyn data ............................................................................................ -typedef FAST SED_Data SED_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ SED_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ SED_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ SED_OtherStateType OtherSt {2} - - "Other states" +typedef FAST SED_Data SED_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ SED_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SED_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SED_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SED_ParameterType p - - - "Parameters" typedef ^ ^ SED_InputType u - - - "System inputs" typedef ^ ^ SED_OutputType y - - - "System outputs" @@ -518,10 +518,10 @@ typedef ^ ^ ExtLd_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... AeroDisk data ....................................................................................................... -typedef FAST AeroDisk_Data ADsk_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ ADsk_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ ADsk_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ ADsk_OtherStateType OtherSt {2} - - "Other states" +typedef FAST AeroDisk_Data ADsk_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ ADsk_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ ADsk_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ ADsk_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ADsk_ParameterType p - - - "Parameters" typedef ^ ^ ADsk_InputType u - - - "System inputs" typedef ^ ^ ADsk_OutputType y - - - "System outputs" diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 7a896ac59a..7a5f6f423a 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -51,7 +51,7 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In Turbine%TurbID = TurbID CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) if(ErrStat >= AbortErrLev) return @@ -256,65 +256,19 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE y_FAST%Lin%WindSpeed = 0.0_ReKi !---------------------------------------------------------------------------- - ! Initialize ElastoDyn (must be done first) + ! Initialize ElastoDyn/SED (must be done first) !---------------------------------------------------------------------------- - ! Allocate module data arrays - allocate(ED%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("ED%Input")) return - allocate(ED%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return - allocate(ED%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return - allocate(ED%x (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%x")) return - allocate(ED%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return - allocate(ED%z (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%z")) return - allocate(ED%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return - - ! Set initialization input - Init%InData_ED%Linearize = p_FAST%Linearize - Init%InData_ED%CompAeroMaps = p_FAST%CompAeroMaps - Init%InData_ED%RotSpeed = p_FAST%RotSpeedInit - Init%InData_ED%InputFile = p_FAST%EDFile - - Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) - Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED - Init%InData_ED%Gravity = p_FAST%Gravity - Init%InData_ED%MHK = p_FAST%MHK - Init%InData_ED%WtrDpth = p_FAST%WtrDpth - - ! Call module initialization routine - CALL ED_Init(Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, p_FAST%dt_module(MODULE_ED), Init%OutData_ED, ErrStat2, ErrMsg2) - if (Failed()) return + select case (p_FAST%CompElast) - CALL SetModuleSubstepTime(Module_ED, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return + case (Module_SED) ! initialize Simplified-ElastoDyn (must be done first) - ! Add module to array of modules, return if errors occurred - CALL MV_AddModule(m_Glue%ModData, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & - Init%OutData_ED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) - if (Failed()) return - - NumBl = Init%OutData_ED%NumBl - p_FAST%GearBox_index = Init%OutData_ED%GearBox_index - - if (p_FAST%CalcSteady) then - if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then - p_FAST%TrimCase = TrimCase_none - p_FAST%NLinTimes = 1 - p_FAST%LinInterpOrder = 0 ! constant values - elseif ( Init%OutData_ED%isFixed_GenDOF ) then - p_FAST%TrimCase = TrimCase_none - end if - end if - if (p_FAST%CompElast == Module_SED) then - ! ........................ - ! initialize Simplified-ElastoDyn (must be done first) - ! ........................ - ALLOCATE( SED%Input( p_FAST%InterpOrder+1 ), SED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SED%Input and SED%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + allocate(SED%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("SED%Input")) return + allocate(SED%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("SED%InputTimes")) return + allocate(SED%x (NumStates ), stat=ErrStat2); if (FailedAlloc("SED%x")) return + allocate(SED%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("SED%xd")) return + allocate(SED%z (NumStates ), stat=ErrStat2); if (FailedAlloc("SED%z")) return + allocate(SED%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("SED%OtherSt")) return Init%InData_SED%Linearize = p_FAST%Linearize Init%InData_SED%InputFile = p_FAST%EDFile @@ -324,77 +278,58 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE SED%y, SED%m, p_FAST%dt_module( MODULE_SED ), Init%OutData_SED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - p_FAST%ModuleInitialized(Module_SED) = .TRUE. + CALL SetModuleSubstepTime(Module_SED, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Add module to array of modules, return if errors occurred + CALL MV_AddModule(m_Glue%ModData, Module_SED, 'SED', 1, p_FAST%dt_module(Module_SED), p_FAST%DT, & + Init%OutData_SED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return NumBl = Init%OutData_SED%NumBl + + p_FAST%ModuleInitialized(Module_SED) = .TRUE. - else - ! ........................ - ! initialize ElastoDyn (must be done first) - ! ........................ - ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + case (Module_ED) ! initialize ElastoDyn (must be done first) + + ! Allocate module data arrays + allocate(ED%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("ED%Input")) return + allocate(ED%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return + allocate(ED%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return + allocate(ED%x (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%x")) return + allocate(ED%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return + allocate(ED%z (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%z")) return + allocate(ED%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return - ALLOCATE( ED%Input_Saved( p_FAST%InterpOrder+1 ), ED%InputTimes_Saved( p_FAST%InterpOrder+1 ), ED%Output_bak( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input_Saved, ED%Output_bak, and ED%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - + ! Set initialization input Init%InData_ED%Linearize = p_FAST%Linearize Init%InData_ED%CompAeroMaps = p_FAST%CompAeroMaps Init%InData_ED%RotSpeed = p_FAST%RotSpeedInit Init%InData_ED%InputFile = p_FAST%EDFile - + Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED - Init%InData_ED%Gravity = p_FAST%Gravity - Init%InData_ED%MHK = p_FAST%MHK Init%InData_ED%WtrDpth = p_FAST%WtrDpth - - CALL ED_Init( Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, p_FAST%dt_module( MODULE_ED ), Init%OutData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - p_FAST%ModuleInitialized(Module_ED) = .TRUE. + + ! Call module initialization routine + CALL ED_Init(Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, p_FAST%dt_module(MODULE_ED), Init%OutData_ED, ErrStat2, ErrMsg2) + if (Failed()) return + CALL SetModuleSubstepTime(Module_ED, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_ED)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) - else - - if (allocated(Init%OutData_ED%LinNames_y)) call move_alloc(Init%OutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) - if (allocated(Init%OutData_ED%LinNames_x)) call move_alloc(Init%OutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) - if (allocated(Init%OutData_ED%LinNames_u)) call move_alloc(Init%OutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) - if (allocated(Init%OutData_ED%RotFrame_y)) call move_alloc(Init%OutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) - if (allocated(Init%OutData_ED%RotFrame_x)) call move_alloc(Init%OutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) - if (allocated(Init%OutData_ED%DerivOrder_x)) call move_alloc(Init%OutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) - if (allocated(Init%OutData_ED%RotFrame_u)) call move_alloc(Init%OutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) - if (allocated(Init%OutData_ED%IsLoad_u )) call move_alloc(Init%OutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) - - if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) - end if - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - + if (Failed()) return + + ! Add module to array of modules, return if errors occurred + CALL MV_AddModule(m_Glue%ModData, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + Init%OutData_ED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + NumBl = Init%OutData_ED%NumBl p_FAST%GearBox_index = Init%OutData_ED%GearBox_index - - + if (p_FAST%CalcSteady) then if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then p_FAST%TrimCase = TrimCase_none @@ -404,9 +339,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE p_FAST%TrimCase = TrimCase_none end if end if - endif ! SED/ED - p_FAST%ModuleInitialized(Module_ED) = .TRUE. + p_FAST%ModuleInitialized(Module_ED) = .TRUE. + + end select ! SED/ED + !---------------------------------------------------------------------------- ! Initialize BeamDyn @@ -701,57 +638,23 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE end if !---------------------------------------------------------------------------- - ! Initialize AeroDyn15 + ! Initialize AeroDyn / ADsk !---------------------------------------------------------------------------- - ! Allocate module data arrays - allocate(AD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("AD%Input")) return - allocate(AD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return - allocate(AD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("AD%Input_Saved")) return - allocate(AD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%x")) return - allocate(AD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return - allocate(AD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%z")) return - allocate(AD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - end if + select case (p_FAST%CompAero) + case (Module_AD, Module_ExtLd) - ! ........................ - ! initialize AeroDyn / ADsk - ! ........................ - ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(AD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("AD%Input")) return + allocate(AD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return + allocate(AD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("AD%Input_Saved")) return + allocate(AD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%x")) return + allocate(AD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return + allocate(AD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%z")) return + allocate(AD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return - ALLOCATE( AD%Input_Saved( p_FAST%InterpOrder+1 ), AD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( ADsk%Input( p_FAST%InterpOrder+1 ), ADsk%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ADsk%Input and ADsk%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN - - allocate(Init%InData_AD%rotors(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, RoutineName ) - call Cleanup() - return - end if + allocate(Init%InData_AD%rotors(1), stat=ErrStat2); if (FailedAlloc("AD%Init%InData_AD%rotors(1)")) return Init%InData_AD%rotors(1)%NumBlades = NumBl @@ -833,30 +736,56 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - allocate( y_FAST%Lin%Modules(MODULE_AD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) + do i = 1, size(Init%OutData_AD%rotors) + CALL MV_AddModule(m_Glue%ModData, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + Init%OutData_AD%rotors(i)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + AirDens = Init%OutData_AD%rotors(1)%AirDens + + case (Module_ADsk) + + ! Allocate module data arrays + allocate(ADsk%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("ADsk%Input")) return + allocate(ADsk%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("ADsk%InputTimes")) return + allocate(ADsk%x (NumStates ), stat=ErrStat2); if (FailedAlloc("ADsk%x")) return + allocate(ADsk%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("ADsk%xd")) return + allocate(ADsk%z (NumStates ), stat=ErrStat2); if (FailedAlloc("ADsk%z")) return + allocate(ADsk%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("ADsk%OtherSt")) return + + Init%InData_ADsk%InputFile = p_FAST%AeroFile + Init%InData_ADsk%RootName = p_FAST%OutFileRoot + ! NOTE: cone angle is not included in the RotorRad calculation!!! + + if (p_FAST%CompElast == Module_SED) then + Init%InData_ADsk%RotorRad = Init%OutData_SED%HubRad + Init%OutData_SED%BladeLength + Init%InData_ADsk%HubPosition = SED%y%HubPtMotion%Position(:,1) + Init%InData_ADsk%HubOrientation = SED%y%HubPtMotion%RefOrientation(:,:,1) else - if (allocated(Init%OutData_AD%rotors(1)%LinNames_u )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) - if (allocated(Init%OutData_AD%rotors(1)%LinNames_y )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) - if (allocated(Init%OutData_AD%rotors(1)%LinNames_x )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_x ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_u )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_y )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_x )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_x ) - if (allocated(Init%OutData_AD%rotors(1)%IsLoad_u )) call move_alloc(Init%OutData_AD%rotors(1)%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_AD%rotors(1)%DerivOrder_x)) call move_alloc(Init%OutData_AD%rotors(1)%DerivOrder_x,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%DerivOrder_x ) - - if (allocated(Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%rotors(1)%WriteOutputHdr) - end if + Init%InData_ADsk%RotorRad = Init%OutData_ED%HubRad + Init%OutData_ED%BladeLength + Init%InData_ADsk%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_ADsk%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + endif - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + Init%InData_ADsk%defAirDens = p_FAST%AirDens + Init%InData_ADsk%Linearize = p_FAST%Linearize ! NOTE: This module cannot be linearized + Init%InData_ADsk%UseInputFile = .true. + !Init%InData_ADsk%PassedFileData = ! Passing filename instead of file contents + IF (p_FAST%CompInflow == Module_IfW) Init%InData_ADsk%FlowField => Init%OutData_IfW%FlowField - AirDens = Init%OutData_AD%rotors(1)%AirDens + CALL ADsk_Init( Init%InData_ADsk, ADsk%Input(1), ADsk%p, ADsk%x(STATE_CURR), ADsk%xd(STATE_CURR), ADsk%z(STATE_CURR), & + ADsk%OtherSt(STATE_CURR), ADsk%y, ADsk%m, p_FAST%dt_module( MODULE_ADsk ), Init%OutData_ADsk, ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! Add module to array, return on error + call MV_AddModule(m_Glue%ModData, Module_ADsk, 'ADsk', 1, p_FAST%dt_module(Module_ADsk), p_FAST%DT, & + Init%OutData_ADsk%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + + p_FAST%ModuleInitialized(Module_ADsk) = .TRUE. - END IF ! CompAero + end select ! CompAero !---------------------------------------------------------------------------- ! External Loads @@ -4986,7 +4915,7 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) ! turn off VTK output when if (Turbine%p_FAST%WrVTK == VTK_InitOnly) then call WriteVTK(t_initial, Turbine%p_FAST, Turbine%y_FAST, & - Turbine%MeshMapData, Turbine%ED, Turbine%BD, Turbine%AD, & + Turbine%MeshMapData, Turbine%ED, Turbine%SED, Turbine%BD, Turbine%AD, & Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, & Turbine%SD, Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD) @@ -5278,8 +5207,8 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) ! Write output data to file !---------------------------------------------------------------------------- - call WriteOutputToFile(n_t_global_next, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & - Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & + call WriteOutputToFile(n_t_global_next, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%SED, Turbine%BD, & + Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5469,7 +5398,7 @@ SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) !---------------------------------------------------------------------------- call WriteOutputToFile(n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, & - Turbine%ED, Turbine%BD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) @@ -7828,7 +7757,7 @@ END SUBROUTINE FAST_RestoreForVTKModeShape_Tary !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the motions generated by mode shapes and outputs VTK data for it -SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & +SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index ec0cd2436b..53a4631703 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -73,7 +73,9 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 19 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ADsk = 20 ! AeroDisk [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SED = 21 ! Simplified-ElastoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 21 ! The number of modules available in FAST [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] @@ -454,10 +456,10 @@ MODULE FAST_Types ! ======================= ! ========= SED_Data ======= TYPE, PUBLIC :: SED_Data - TYPE(SED_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(SED_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(SED_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(SED_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SED_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(SED_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SED_ParameterType) :: p !< Parameters [-] TYPE(SED_InputType) :: u !< System inputs [-] TYPE(SED_OutputType) :: y !< System outputs [-] @@ -518,10 +520,10 @@ MODULE FAST_Types ! ======================= ! ========= AeroDisk_Data ======= TYPE, PUBLIC :: AeroDisk_Data - TYPE(ADsk_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(ADsk_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(ADsk_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(ADsk_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ADsk_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(ADsk_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(ADsk_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(ADsk_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(ADsk_ParameterType) :: p !< Parameters [-] TYPE(ADsk_InputType) :: u !< System inputs [-] TYPE(ADsk_OutputType) :: y !< System outputs [-] @@ -8013,6 +8015,389 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat, ErrMsg) + type(SED_Data), intent(inout) :: SrcSED_DataData + type(SED_Data), intent(inout) :: DstSED_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySED_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcSED_DataData%x)) then + LB(1:1) = lbound(SrcSED_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcSED_DataData%x, kind=B8Ki) + if (.not. allocated(DstSED_DataData%x)) then + allocate(DstSED_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyContState(SrcSED_DataData%x(i1), DstSED_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSED_DataData%xd)) then + LB(1:1) = lbound(SrcSED_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcSED_DataData%xd, kind=B8Ki) + if (.not. allocated(DstSED_DataData%xd)) then + allocate(DstSED_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyDiscState(SrcSED_DataData%xd(i1), DstSED_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSED_DataData%z)) then + LB(1:1) = lbound(SrcSED_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcSED_DataData%z, kind=B8Ki) + if (.not. allocated(DstSED_DataData%z)) then + allocate(DstSED_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyConstrState(SrcSED_DataData%z(i1), DstSED_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSED_DataData%OtherSt)) then + LB(1:1) = lbound(SrcSED_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcSED_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstSED_DataData%OtherSt)) then + allocate(DstSED_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyOtherState(SrcSED_DataData%OtherSt(i1), DstSED_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SED_CopyParam(SrcSED_DataData%p, DstSED_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyInput(SrcSED_DataData%u, DstSED_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyOutput(SrcSED_DataData%y, DstSED_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyMisc(SrcSED_DataData%m, DstSED_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSED_DataData%Output)) then + LB(1:1) = lbound(SrcSED_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcSED_DataData%Output, kind=B8Ki) + if (.not. allocated(DstSED_DataData%Output)) then + allocate(DstSED_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyOutput(SrcSED_DataData%Output(i1), DstSED_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SED_CopyOutput(SrcSED_DataData%y_interp, DstSED_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSED_DataData%Input)) then + LB(1:1) = lbound(SrcSED_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcSED_DataData%Input, kind=B8Ki) + if (.not. allocated(DstSED_DataData%Input)) then + allocate(DstSED_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyInput(SrcSED_DataData%Input(i1), DstSED_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSED_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSED_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcSED_DataData%InputTimes, kind=B8Ki) + if (.not. allocated(DstSED_DataData%InputTimes)) then + allocate(DstSED_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSED_DataData%InputTimes = SrcSED_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) + type(SED_Data), intent(inout) :: SED_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySED_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SED_DataData%x)) then + LB(1:1) = lbound(SED_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SED_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_DestroyContState(SED_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%x) + end if + if (allocated(SED_DataData%xd)) then + LB(1:1) = lbound(SED_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SED_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_DestroyDiscState(SED_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%xd) + end if + if (allocated(SED_DataData%z)) then + LB(1:1) = lbound(SED_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SED_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_DestroyConstrState(SED_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%z) + end if + if (allocated(SED_DataData%OtherSt)) then + LB(1:1) = lbound(SED_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SED_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_DestroyOtherState(SED_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%OtherSt) + end if + call SED_DestroyParam(SED_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyInput(SED_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyOutput(SED_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyMisc(SED_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SED_DataData%Output)) then + LB(1:1) = lbound(SED_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SED_DataData%Output, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_DestroyOutput(SED_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%Output) + end if + call SED_DestroyOutput(SED_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SED_DataData%Input)) then + LB(1:1) = lbound(SED_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SED_DataData%Input, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_DestroyInput(SED_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%Input) + end if + if (allocated(SED_DataData%InputTimes)) then + deallocate(SED_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackSED_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSED_Data' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if + call SED_PackParam(RF, InData%p) + call SED_PackInput(RF, InData%u) + call SED_PackOutput(RF, InData%y) + call SED_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_PackOutput(RF, InData%Output(i1)) + end do + end if + call SED_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSED_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSED_Data' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if + call SED_UnpackParam(RF, OutData%p) ! p + call SED_UnpackInput(RF, OutData%u) ! u + call SED_UnpackOutput(RF, OutData%y) ! y + call SED_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call SED_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg) type(ServoDyn_Data), intent(inout) :: SrcServoDyn_DataData type(ServoDyn_Data), intent(inout) :: DstServoDyn_DataData @@ -9079,34 +9464,70 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyAeroDisk_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcAeroDisk_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_CopyContState(SrcAeroDisk_DataData%x(i1), DstAeroDisk_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDisk_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_CopyDiscState(SrcAeroDisk_DataData%xd(i1), DstAeroDisk_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDisk_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_CopyConstrState(SrcAeroDisk_DataData%z(i1), DstAeroDisk_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDisk_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_CopyOtherState(SrcAeroDisk_DataData%OtherSt(i1), DstAeroDisk_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcAeroDisk_DataData%x)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDisk_DataData%x, kind=B8Ki) + if (.not. allocated(DstAeroDisk_DataData%x)) then + allocate(DstAeroDisk_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyContState(SrcAeroDisk_DataData%x(i1), DstAeroDisk_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDisk_DataData%xd)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDisk_DataData%xd, kind=B8Ki) + if (.not. allocated(DstAeroDisk_DataData%xd)) then + allocate(DstAeroDisk_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyDiscState(SrcAeroDisk_DataData%xd(i1), DstAeroDisk_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDisk_DataData%z)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDisk_DataData%z, kind=B8Ki) + if (.not. allocated(DstAeroDisk_DataData%z)) then + allocate(DstAeroDisk_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyConstrState(SrcAeroDisk_DataData%z(i1), DstAeroDisk_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDisk_DataData%OtherSt)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDisk_DataData%OtherSt, kind=B8Ki) + if (.not. allocated(DstAeroDisk_DataData%OtherSt)) then + allocate(DstAeroDisk_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyOtherState(SrcAeroDisk_DataData%OtherSt(i1), DstAeroDisk_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call ADsk_CopyParam(SrcAeroDisk_DataData%p, DstAeroDisk_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -9179,30 +9600,42 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyAeroDisk_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDisk_DataData%x, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_DestroyContState(AeroDisk_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDisk_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_DestroyDiscState(AeroDisk_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDisk_DataData%z, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_DestroyConstrState(AeroDisk_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDisk_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_DestroyOtherState(AeroDisk_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(AeroDisk_DataData%x)) then + LB(1:1) = lbound(AeroDisk_DataData%x, kind=B8Ki) + UB(1:1) = ubound(AeroDisk_DataData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_DestroyContState(AeroDisk_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%x) + end if + if (allocated(AeroDisk_DataData%xd)) then + LB(1:1) = lbound(AeroDisk_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(AeroDisk_DataData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_DestroyDiscState(AeroDisk_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%xd) + end if + if (allocated(AeroDisk_DataData%z)) then + LB(1:1) = lbound(AeroDisk_DataData%z, kind=B8Ki) + UB(1:1) = ubound(AeroDisk_DataData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_DestroyConstrState(AeroDisk_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%z) + end if + if (allocated(AeroDisk_DataData%OtherSt)) then + LB(1:1) = lbound(AeroDisk_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(AeroDisk_DataData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_DestroyOtherState(AeroDisk_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%OtherSt) + end if call ADsk_DestroyParam(AeroDisk_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADsk_DestroyInput(AeroDisk_DataData%u, ErrStat2, ErrMsg2) @@ -9243,26 +9676,42 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call ADsk_PackParam(RF, InData%p) call ADsk_PackInput(RF, InData%u) call ADsk_PackOutput(RF, InData%y) @@ -9299,26 +9748,58 @@ subroutine FAST_UnPackAeroDisk_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if call ADsk_UnpackParam(RF, OutData%p) ! p call ADsk_UnpackInput(RF, OutData%u) ! u call ADsk_UnpackOutput(RF, OutData%y) ! y diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 7f559d5377..d10f584dbc 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -651,18 +651,20 @@ MODULE ServoDyn_Types integer(IntKi), public, parameter :: SrvD_y_BlPitchCom = 63 ! SrvD%BlPitchCom integer(IntKi), public, parameter :: SrvD_y_BlAirfoilCom = 64 ! SrvD%BlAirfoilCom integer(IntKi), public, parameter :: SrvD_y_YawMom = 65 ! SrvD%YawMom - integer(IntKi), public, parameter :: SrvD_y_GenTrq = 66 ! SrvD%GenTrq - integer(IntKi), public, parameter :: SrvD_y_HSSBrTrqC = 67 ! SrvD%HSSBrTrqC - integer(IntKi), public, parameter :: SrvD_y_ElecPwr = 68 ! SrvD%ElecPwr - integer(IntKi), public, parameter :: SrvD_y_TBDrCon = 69 ! SrvD%TBDrCon - integer(IntKi), public, parameter :: SrvD_y_Lidar = 70 ! SrvD%Lidar - integer(IntKi), public, parameter :: SrvD_y_CableDeltaL = 71 ! SrvD%CableDeltaL - integer(IntKi), public, parameter :: SrvD_y_CableDeltaLdot = 72 ! SrvD%CableDeltaLdot - integer(IntKi), public, parameter :: SrvD_y_BStCLoadMesh = 73 ! SrvD%BStCLoadMesh(DL%i1, DL%i2) - integer(IntKi), public, parameter :: SrvD_y_NStCLoadMesh = 74 ! SrvD%NStCLoadMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_y_TStCLoadMesh = 75 ! SrvD%TStCLoadMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_y_SStCLoadMesh = 76 ! SrvD%SStCLoadMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_y_toSC = 77 ! SrvD%toSC + integer(IntKi), public, parameter :: SrvD_y_YawPosCom = 66 ! SrvD%YawPosCom + integer(IntKi), public, parameter :: SrvD_y_YawRateCom = 67 ! SrvD%YawRateCom + integer(IntKi), public, parameter :: SrvD_y_GenTrq = 68 ! SrvD%GenTrq + integer(IntKi), public, parameter :: SrvD_y_HSSBrTrqC = 69 ! SrvD%HSSBrTrqC + integer(IntKi), public, parameter :: SrvD_y_ElecPwr = 70 ! SrvD%ElecPwr + integer(IntKi), public, parameter :: SrvD_y_TBDrCon = 71 ! SrvD%TBDrCon + integer(IntKi), public, parameter :: SrvD_y_Lidar = 72 ! SrvD%Lidar + integer(IntKi), public, parameter :: SrvD_y_CableDeltaL = 73 ! SrvD%CableDeltaL + integer(IntKi), public, parameter :: SrvD_y_CableDeltaLdot = 74 ! SrvD%CableDeltaLdot + integer(IntKi), public, parameter :: SrvD_y_BStCLoadMesh = 75 ! SrvD%BStCLoadMesh(DL%i1, DL%i2) + integer(IntKi), public, parameter :: SrvD_y_NStCLoadMesh = 76 ! SrvD%NStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_TStCLoadMesh = 77 ! SrvD%TStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_SStCLoadMesh = 78 ! SrvD%SStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_toSC = 79 ! SrvD%toSC contains @@ -7837,6 +7839,10 @@ subroutine SrvD_VarPackOutput(V, y, ValAry) VarVals = y%BlAirfoilCom(V%iLB:V%iUB) ! Rank 1 Array case (SrvD_y_YawMom) VarVals(1) = y%YawMom ! Scalar + case (SrvD_y_YawPosCom) + VarVals(1) = y%YawPosCom ! Scalar + case (SrvD_y_YawRateCom) + VarVals(1) = y%YawRateCom ! Scalar case (SrvD_y_GenTrq) VarVals(1) = y%GenTrq ! Scalar case (SrvD_y_HSSBrTrqC) @@ -7891,6 +7897,10 @@ subroutine SrvD_VarUnpackOutput(V, ValAry, y) y%BlAirfoilCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array case (SrvD_y_YawMom) y%YawMom = VarVals(1) ! Scalar + case (SrvD_y_YawPosCom) + y%YawPosCom = VarVals(1) ! Scalar + case (SrvD_y_YawRateCom) + y%YawRateCom = VarVals(1) ! Scalar case (SrvD_y_GenTrq) y%GenTrq = VarVals(1) ! Scalar case (SrvD_y_HSSBrTrqC) @@ -7931,6 +7941,10 @@ function SrvD_OutputFieldName(DL) result(Name) Name = "y%BlAirfoilCom" case (SrvD_y_YawMom) Name = "y%YawMom" + case (SrvD_y_YawPosCom) + Name = "y%YawPosCom" + case (SrvD_y_YawRateCom) + Name = "y%YawRateCom" case (SrvD_y_GenTrq) Name = "y%GenTrq" case (SrvD_y_HSSBrTrqC) diff --git a/modules/simple-elastodyn/src/SED_Registry.txt b/modules/simple-elastodyn/src/SED_Registry.txt index 691d108a97..6f55b3e767 100644 --- a/modules/simple-elastodyn/src/SED_Registry.txt +++ b/modules/simple-elastodyn/src/SED_Registry.txt @@ -64,7 +64,7 @@ typedef ^ InitOutputType ReKi PlatformPos {6} - typedef ^ InitOutputType ReKi HubRad - - - "Preconed hub radius (distance from the rotor apex to the blade root)" m typedef ^ InitOutputType ReKi RotSpeed - - - "Initial or fixed rotor speed" rad/s typedef ^ InitOutputType LOGICAL GenDOF - - - "whether the generator DOF is on (true) or off (false)" - - +typedef ^ InitOutputType ModVarsType Vars - - - "Module variables" - # ..... Inputs .................................................................................................................... # inputs on meshes: @@ -156,4 +156,9 @@ typedef ^ MiscVarType MeshMapType mapNac2Hub - - typedef ^ MiscVarType MeshMapType mapHub2Root {:} - - "Mesh mapping from Hub to BladeRootMotion" - typedef ^ MiscVarType R8Ki QD2T {:} - - "Current estimate of first derivative of QD (acceleration matrix) for each degree of freedom" typedef ^ MiscVarType ReKi HubPt_X {3} - - "X orientation of hub calculated in CalcOutput -- saving so we don't recalculate a bunch of things to get it in UpdateStates" +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ MiscVarType SED_ContinuousStateType x_perturb - - - "Continuous state type for linearization perturbation" - +typedef ^ MiscVarType SED_ContinuousStateType dxdt_lin - - - "Continuous state type for linearization output" - +typedef ^ MiscVarType SED_InputType u_perturb - - - "Input type for linearization perturbation" - +typedef ^ MiscVarType SED_OutputType y_lin - - - "Output type for linearization output" - diff --git a/modules/simple-elastodyn/src/SED_Types.f90 b/modules/simple-elastodyn/src/SED_Types.f90 index bc97de1b88..5a636e5e96 100644 --- a/modules/simple-elastodyn/src/SED_Types.f90 +++ b/modules/simple-elastodyn/src/SED_Types.f90 @@ -33,7 +33,7 @@ MODULE SED_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] ! ========= SED_InputFile ======= TYPE, PUBLIC :: SED_InputFile LOGICAL :: Echo = .false. !< Echo the input file [-] @@ -85,6 +85,7 @@ MODULE SED_Types REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [m] REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] LOGICAL :: GenDOF = .false. !< whether the generator DOF is on (true) or off (false) [-] + TYPE(ModVarsType) :: Vars !< Module variables [-] END TYPE SED_InitOutputType ! ======================= ! ========= SED_InputType ======= @@ -178,9 +179,38 @@ MODULE SED_Types TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: mapHub2Root !< Mesh mapping from Hub to BladeRootMotion [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Current estimate of first derivative of QD (acceleration matrix) for each degree of freedom [-] REAL(ReKi) , DIMENSION(1:3) :: HubPt_X = 0.0_ReKi !< X orientation of hub calculated in CalcOutput -- saving so we don't recalculate a bunch of things to get it in UpdateStates [-] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(SED_ContinuousStateType) :: x_perturb !< Continuous state type for linearization perturbation [-] + TYPE(SED_ContinuousStateType) :: dxdt_lin !< Continuous state type for linearization output [-] + TYPE(SED_InputType) :: u_perturb !< Input type for linearization perturbation [-] + TYPE(SED_OutputType) :: y_lin !< Output type for linearization output [-] END TYPE SED_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SED_x_QT = 1 ! SED%QT + integer(IntKi), public, parameter :: SED_x_QDT = 2 ! SED%QDT + integer(IntKi), public, parameter :: SED_z_DummyConstrState = 3 ! SED%DummyConstrState + integer(IntKi), public, parameter :: SED_u_HubPtLoad = 4 ! SED%HubPtLoad + integer(IntKi), public, parameter :: SED_u_HSSBrTrqC = 5 ! SED%HSSBrTrqC + integer(IntKi), public, parameter :: SED_u_GenTrq = 6 ! SED%GenTrq + integer(IntKi), public, parameter :: SED_u_BlPitchCom = 7 ! SED%BlPitchCom + integer(IntKi), public, parameter :: SED_u_YawPosCom = 8 ! SED%YawPosCom + integer(IntKi), public, parameter :: SED_u_YawRateCom = 9 ! SED%YawRateCom + integer(IntKi), public, parameter :: SED_y_BladeRootMotion = 10 ! SED%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: SED_y_HubPtMotion = 11 ! SED%HubPtMotion + integer(IntKi), public, parameter :: SED_y_NacelleMotion = 12 ! SED%NacelleMotion + integer(IntKi), public, parameter :: SED_y_TowerLn2Mesh = 13 ! SED%TowerLn2Mesh + integer(IntKi), public, parameter :: SED_y_PlatformPtMesh = 14 ! SED%PlatformPtMesh + integer(IntKi), public, parameter :: SED_y_LSSTipPxa = 15 ! SED%LSSTipPxa + integer(IntKi), public, parameter :: SED_y_RotSpeed = 16 ! SED%RotSpeed + integer(IntKi), public, parameter :: SED_y_RotPwr = 17 ! SED%RotPwr + integer(IntKi), public, parameter :: SED_y_RotTrq = 18 ! SED%RotTrq + integer(IntKi), public, parameter :: SED_y_HSS_Spd = 19 ! SED%HSS_Spd + integer(IntKi), public, parameter :: SED_y_Yaw = 20 ! SED%Yaw + integer(IntKi), public, parameter :: SED_y_YawRate = 21 ! SED%YawRate + integer(IntKi), public, parameter :: SED_y_BlPitch = 22 ! SED%BlPitch + integer(IntKi), public, parameter :: SED_y_WriteOutput = 23 ! SED%WriteOutput + +contains subroutine SED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(SED_InputFile), intent(in) :: SrcInputFileData @@ -425,6 +455,9 @@ subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%HubRad = SrcInitOutputData%HubRad DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed DstInitOutputData%GenDOF = SrcInitOutputData%GenDOF + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine SED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -447,6 +480,8 @@ subroutine SED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%BlPitch)) then deallocate(InitOutputData%BlPitch) end if + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SED_PackInitOutput(RF, Indata) @@ -466,6 +501,7 @@ subroutine SED_PackInitOutput(RF, Indata) call RegPack(RF, InData%HubRad) call RegPack(RF, InData%RotSpeed) call RegPack(RF, InData%GenDOF) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -489,6 +525,7 @@ subroutine SED_UnPackInitOutput(RF, OutData) call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GenDOF); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine SED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1212,6 +1249,21 @@ subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%QD2T = SrcMiscData%QD2T end if DstMiscData%HubPt_X = SrcMiscData%HubPt_X + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine SED_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -1242,6 +1294,16 @@ subroutine SED_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%QD2T)) then deallocate(MiscData%QD2T) end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SED_PackMisc(RF, Indata) @@ -1264,6 +1326,11 @@ subroutine SED_PackMisc(RF, Indata) end if call RegPackAlloc(RF, InData%QD2T) call RegPack(RF, InData%HubPt_X) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SED_PackContState(RF, InData%x_perturb) + call SED_PackContState(RF, InData%dxdt_lin) + call SED_PackInput(RF, InData%u_perturb) + call SED_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1293,6 +1360,11 @@ subroutine SED_UnPackMisc(RF, OutData) end if call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubPt_X); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SED_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call SED_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call SED_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SED_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine SED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -1686,5 +1758,405 @@ SUBROUTINE SED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function SED_InputMeshPointer(u, DL) result(Mesh) + type(SED_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SED_u_HubPtLoad) + Mesh => u%HubPtLoad + end select +end function + +function SED_OutputMeshPointer(y, DL) result(Mesh) + type(SED_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SED_y_BladeRootMotion) + Mesh => y%BladeRootMotion(DL%i1) + case (SED_y_HubPtMotion) + Mesh => y%HubPtMotion + case (SED_y_NacelleMotion) + Mesh => y%NacelleMotion + case (SED_y_TowerLn2Mesh) + Mesh => y%TowerLn2Mesh + case (SED_y_PlatformPtMesh) + Mesh => y%PlatformPtMesh + end select +end function + +subroutine SED_VarsPackContState(Vars, x, ValAry) + type(SED_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SED_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SED_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_x_QT) + VarVals = x%QT(V%iLB:V%iUB) ! Rank 1 Array + case (SED_x_QDT) + VarVals = x%QDT(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SED_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SED_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SED_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_x_QT) + x%QT(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SED_x_QDT) + x%QDT(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SED_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SED_x_QT) + Name = "x%QT" + case (SED_x_QDT) + Name = "x%QDT" + case default + Name = "Unknown Field" + end select +end function + +subroutine SED_VarsPackContStateDeriv(Vars, x, ValAry) + type(SED_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SED_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SED_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_x_QT) + VarVals = x%QT(V%iLB:V%iUB) ! Rank 1 Array + case (SED_x_QDT) + VarVals = x%QDT(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsPackConstrState(Vars, z, ValAry) + type(SED_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SED_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine SED_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SED_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SED_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SED_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine SED_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SED_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SED_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SED_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine SED_VarsPackInput(Vars, u, ValAry) + type(SED_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SED_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SED_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SED_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_u_HubPtLoad) + call MV_PackMesh(V, u%HubPtLoad, ValAry) ! Mesh + case (SED_u_HSSBrTrqC) + VarVals(1) = u%HSSBrTrqC ! Scalar + case (SED_u_GenTrq) + VarVals(1) = u%GenTrq ! Scalar + case (SED_u_BlPitchCom) + VarVals = u%BlPitchCom(V%iLB:V%iUB) ! Rank 1 Array + case (SED_u_YawPosCom) + VarVals(1) = u%YawPosCom ! Scalar + case (SED_u_YawRateCom) + VarVals(1) = u%YawRateCom ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SED_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SED_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SED_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SED_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_u_HubPtLoad) + call MV_UnpackMesh(V, ValAry, u%HubPtLoad) ! Mesh + case (SED_u_HSSBrTrqC) + u%HSSBrTrqC = VarVals(1) ! Scalar + case (SED_u_GenTrq) + u%GenTrq = VarVals(1) ! Scalar + case (SED_u_BlPitchCom) + u%BlPitchCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SED_u_YawPosCom) + u%YawPosCom = VarVals(1) ! Scalar + case (SED_u_YawRateCom) + u%YawRateCom = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SED_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SED_u_HubPtLoad) + Name = "u%HubPtLoad" + case (SED_u_HSSBrTrqC) + Name = "u%HSSBrTrqC" + case (SED_u_GenTrq) + Name = "u%GenTrq" + case (SED_u_BlPitchCom) + Name = "u%BlPitchCom" + case (SED_u_YawPosCom) + Name = "u%YawPosCom" + case (SED_u_YawRateCom) + Name = "u%YawRateCom" + case default + Name = "Unknown Field" + end select +end function + +subroutine SED_VarsPackOutput(Vars, y, ValAry) + type(SED_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SED_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SED_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SED_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_y_BladeRootMotion) + call MV_PackMesh(V, y%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (SED_y_HubPtMotion) + call MV_PackMesh(V, y%HubPtMotion, ValAry) ! Mesh + case (SED_y_NacelleMotion) + call MV_PackMesh(V, y%NacelleMotion, ValAry) ! Mesh + case (SED_y_TowerLn2Mesh) + call MV_PackMesh(V, y%TowerLn2Mesh, ValAry) ! Mesh + case (SED_y_PlatformPtMesh) + call MV_PackMesh(V, y%PlatformPtMesh, ValAry) ! Mesh + case (SED_y_LSSTipPxa) + VarVals(1) = y%LSSTipPxa ! Scalar + case (SED_y_RotSpeed) + VarVals(1) = y%RotSpeed ! Scalar + case (SED_y_RotPwr) + VarVals(1) = y%RotPwr ! Scalar + case (SED_y_RotTrq) + VarVals(1) = y%RotTrq ! Scalar + case (SED_y_HSS_Spd) + VarVals(1) = y%HSS_Spd ! Scalar + case (SED_y_Yaw) + VarVals(1) = y%Yaw ! Scalar + case (SED_y_YawRate) + VarVals(1) = y%YawRate ! Scalar + case (SED_y_BlPitch) + VarVals = y%BlPitch(V%iLB:V%iUB) ! Rank 1 Array + case (SED_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SED_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SED_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SED_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SED_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_y_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh + case (SED_y_HubPtMotion) + call MV_UnpackMesh(V, ValAry, y%HubPtMotion) ! Mesh + case (SED_y_NacelleMotion) + call MV_UnpackMesh(V, ValAry, y%NacelleMotion) ! Mesh + case (SED_y_TowerLn2Mesh) + call MV_UnpackMesh(V, ValAry, y%TowerLn2Mesh) ! Mesh + case (SED_y_PlatformPtMesh) + call MV_UnpackMesh(V, ValAry, y%PlatformPtMesh) ! Mesh + case (SED_y_LSSTipPxa) + y%LSSTipPxa = VarVals(1) ! Scalar + case (SED_y_RotSpeed) + y%RotSpeed = VarVals(1) ! Scalar + case (SED_y_RotPwr) + y%RotPwr = VarVals(1) ! Scalar + case (SED_y_RotTrq) + y%RotTrq = VarVals(1) ! Scalar + case (SED_y_HSS_Spd) + y%HSS_Spd = VarVals(1) ! Scalar + case (SED_y_Yaw) + y%Yaw = VarVals(1) ! Scalar + case (SED_y_YawRate) + y%YawRate = VarVals(1) ! Scalar + case (SED_y_BlPitch) + y%BlPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SED_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SED_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SED_y_BladeRootMotion) + Name = "y%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" + case (SED_y_HubPtMotion) + Name = "y%HubPtMotion" + case (SED_y_NacelleMotion) + Name = "y%NacelleMotion" + case (SED_y_TowerLn2Mesh) + Name = "y%TowerLn2Mesh" + case (SED_y_PlatformPtMesh) + Name = "y%PlatformPtMesh" + case (SED_y_LSSTipPxa) + Name = "y%LSSTipPxa" + case (SED_y_RotSpeed) + Name = "y%RotSpeed" + case (SED_y_RotPwr) + Name = "y%RotPwr" + case (SED_y_RotTrq) + Name = "y%RotTrq" + case (SED_y_HSS_Spd) + Name = "y%HSS_Spd" + case (SED_y_Yaw) + Name = "y%Yaw" + case (SED_y_YawRate) + Name = "y%YawRate" + case (SED_y_BlPitch) + Name = "y%BlPitch" + case (SED_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SED_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 6b7999099c..bdeffef084 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -160,42 +160,6 @@ typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variab typedef ^ OtherStateType SD_ContinuousStateType xdot {:} - - "previous state derivs for m-step time integrator" typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated last" -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" -typedef ^ MiscVarType ReKi u_TP 6 - - -typedef ^ MiscVarType ReKi udot_TP 6 - - -typedef ^ MiscVarType ReKi udotdot_TP 6 - - -typedef ^ MiscVarType ReKi F_L {:} - - "Loads on internal DOF, size nL" -typedef ^ MiscVarType ReKi F_L2 {:} - - "Loads on internal DOF, size nL, used for SIM and ADM4" -typedef ^ MiscVarType ReKi UR_bar {:} - - -typedef ^ MiscVarType ReKi UR_bar_dot {:} - - -typedef ^ MiscVarType ReKi UR_bar_dotdot {:} - - -typedef ^ MiscVarType ReKi UL {:} - - "Internal DOFs (L) displacements " -typedef ^ MiscVarType ReKi UL_NS {:} - - "Internal DOFs (L) displacements, No SIM (NS)" -typedef ^ MiscVarType ReKi UL_dot {:} - - -typedef ^ MiscVarType ReKi UL_dotdot {:} - - -typedef ^ MiscVarType ReKi DU_full {:} - - "Delta U used for extra moment, size nDOF" -typedef ^ MiscVarType ReKi U_full {:} - - "Displacement of all DOFs (full system) with SIM" -typedef ^ MiscVarType ReKi U_full_NS {:} - - "Displacement of all DOFs (full system), No SIM (NS)" -typedef ^ MiscVarType ReKi U_full_dot {:} - - -typedef ^ MiscVarType ReKi U_full_dotdot {:} - - -typedef ^ MiscVarType ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM" -typedef ^ MiscVarType ReKi U_red {:} - - -typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N -typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" -typedef ^ MiscVarType ReKi AllOuts {:} - - "Data for output file" -typedef ^ MiscVarType DbKi LastOutTime - - - "The time of the most recent stored output data" "s" -typedef ^ MiscVarType IntKi Decimat - - - "Current output decimation counter" "-" -typedef ^ MiscVarType ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" -typedef ^ MiscVarType ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" -typedef ^ MiscVarType R8Ki FG {:} - - "Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only)" N -# SIM -typedef ^ MiscVarType ReKi UL_SIM {:} - - "UL for SIM = PhiL qL0- PhiM qm0, size nL" -typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermediate UL term for SIM = PhiM qm0, size nL" -### data for writing to an output file (this data is associated with time, but saved/written in CalcOutput so not stored as an other state) ### - # ============================== Parameters ============================================================================================================================================ typedef ^ ParameterType IntKi iVarTPMesh - 0 - "Variable index for TPMesh" typedef ^ ParameterType IntKi iVarLMesh - 0 - "Variable index for LMesh" @@ -358,6 +322,7 @@ typedef ^ MiscVarType DbKi LastOutTime - - - "The time of typedef ^ MiscVarType IntKi Decimat - - - "Current output decimation counter" "-" typedef ^ MiscVarType ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" typedef ^ MiscVarType ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" +typedef ^ MiscVarType R8Ki FG {:} - - "Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only)" N # SIM typedef ^ MiscVarType ReKi UL_SIM {:} - - "UL for SIM = PhiL qL0- PhiM qm0, size nL" typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermediate UL term for SIM = PhiM qm0, size nL" diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index d792a0c94d..edbbb2564c 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -212,42 +212,14 @@ MODULE SubDyn_Types INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated last [-] END TYPE SD_OtherStateType ! ======================= -! ========= SD_MiscVarType ======= - TYPE, PUBLIC :: SD_MiscVarType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] - REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL !< Internal DOFs (L) displacements [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_NS !< Internal DOFs (L) displacements, No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< The time of the most recent stored output data [s] - INTEGER(IntKi) :: Decimat = 0_IntKi !< Current output decimation counter [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only) [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] - END TYPE SD_MiscVarType -! ======================= ! ========= SD_ParameterType ======= TYPE, PUBLIC :: SD_ParameterType + INTEGER(IntKi) :: iVarTPMesh = 0 !< Variable index for TPMesh [-] + INTEGER(IntKi) :: iVarLMesh = 0 !< Variable index for LMesh [-] + INTEGER(IntKi) :: iVarY1Mesh = 0 !< Variable index for Y1Mesh [-] + INTEGER(IntKi) :: iVarY2Mesh = 0 !< Variable index for Y2Mesh [-] + INTEGER(IntKi) :: iVarY3Mesh = 0 !< Variable index for Y3Mesh [-] + INTEGER(IntKi) :: iVarWriteOutput = 0 !< Variable index for WriteOutput [-] REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [m/s^2] REAL(DbKi) :: SDDeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1/2/3)Length of y2 array [-] @@ -400,6 +372,7 @@ MODULE SubDyn_Types INTEGER(IntKi) :: Decimat = 0_IntKi !< Current output decimation counter [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only) [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] END TYPE SD_MiscVarType @@ -1982,604 +1955,124 @@ subroutine SD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg character(*), parameter :: RoutineName = 'SD_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SD_PackConstrState(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SD_ConstraintStateType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SD_PackConstrState' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyConstrState) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_UnPackConstrState(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SD_ConstraintStateType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackConstrState' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) - type(SD_OtherStateType), intent(in) :: SrcOtherStateData - type(SD_OtherStateType), intent(inout) :: DstOtherStateData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_CopyOtherState' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) - if (.not. allocated(DstOtherStateData%xdot)) then - allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstOtherStateData%n = SrcOtherStateData%n -end subroutine - -subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) - type(SD_OtherStateType), intent(inout) :: OtherStateData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OtherStateData%xdot) - end if -end subroutine - -subroutine SD_PackOtherState(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SD_OtherStateType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%xdot)) - if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackContState(RF, InData%xdot(i1)) - end do - end if - call RegPack(RF, InData%n) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_UnPackOtherState(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SD_OtherStateType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%xdot)) deallocate(OutData%xdot) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackContState(RF, OutData%xdot(i1)) ! xdot - end do - end if - call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SD_MiscVarType), intent(in) :: SrcMiscData - type(SD_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'SD_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcMiscData%qmdotdot)) then - LB(1:1) = lbound(SrcMiscData%qmdotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%qmdotdot, kind=B8Ki) - if (.not. allocated(DstMiscData%qmdotdot)) then - allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%qmdotdot = SrcMiscData%qmdotdot - end if - DstMiscData%u_TP = SrcMiscData%u_TP - DstMiscData%udot_TP = SrcMiscData%udot_TP - DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP - if (allocated(SrcMiscData%F_L)) then - LB(1:1) = lbound(SrcMiscData%F_L, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_L, kind=B8Ki) - if (.not. allocated(DstMiscData%F_L)) then - allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%F_L = SrcMiscData%F_L - end if - if (allocated(SrcMiscData%F_L2)) then - LB(1:1) = lbound(SrcMiscData%F_L2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_L2, kind=B8Ki) - if (.not. allocated(DstMiscData%F_L2)) then - allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%F_L2 = SrcMiscData%F_L2 - end if - if (allocated(SrcMiscData%UR_bar)) then - LB(1:1) = lbound(SrcMiscData%UR_bar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar, kind=B8Ki) - if (.not. allocated(DstMiscData%UR_bar)) then - allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UR_bar = SrcMiscData%UR_bar - end if - if (allocated(SrcMiscData%UR_bar_dot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar_dot, kind=B8Ki) - if (.not. allocated(DstMiscData%UR_bar_dot)) then - allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot - end if - if (allocated(SrcMiscData%UR_bar_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) - if (.not. allocated(DstMiscData%UR_bar_dotdot)) then - allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot - end if - if (allocated(SrcMiscData%UL)) then - LB(1:1) = lbound(SrcMiscData%UL, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL, kind=B8Ki) - if (.not. allocated(DstMiscData%UL)) then - allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UL = SrcMiscData%UL - end if - if (allocated(SrcMiscData%UL_NS)) then - LB(1:1) = lbound(SrcMiscData%UL_NS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_NS, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_NS)) then - allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UL_NS = SrcMiscData%UL_NS - end if - if (allocated(SrcMiscData%UL_dot)) then - LB(1:1) = lbound(SrcMiscData%UL_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_dot, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_dot)) then - allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UL_dot = SrcMiscData%UL_dot - end if - if (allocated(SrcMiscData%UL_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UL_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_dotdot, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_dotdot)) then - allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot - end if - if (allocated(SrcMiscData%DU_full)) then - LB(1:1) = lbound(SrcMiscData%DU_full, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%DU_full, kind=B8Ki) - if (.not. allocated(DstMiscData%DU_full)) then - allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%DU_full = SrcMiscData%DU_full - end if - if (allocated(SrcMiscData%U_full)) then - LB(1:1) = lbound(SrcMiscData%U_full, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full)) then - allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%U_full = SrcMiscData%U_full - end if - if (allocated(SrcMiscData%U_full_NS)) then - LB(1:1) = lbound(SrcMiscData%U_full_NS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_NS, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full_NS)) then - allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%U_full_NS = SrcMiscData%U_full_NS - end if - if (allocated(SrcMiscData%U_full_dot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_dot, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full_dot)) then - allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%U_full_dot = SrcMiscData%U_full_dot - end if - if (allocated(SrcMiscData%U_full_dotdot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_dotdot, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full_dotdot)) then - allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot - end if - if (allocated(SrcMiscData%U_full_elast)) then - LB(1:1) = lbound(SrcMiscData%U_full_elast, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_elast, kind=B8Ki) - if (.not. allocated(DstMiscData%U_full_elast)) then - allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%U_full_elast = SrcMiscData%U_full_elast - end if - if (allocated(SrcMiscData%U_red)) then - LB(1:1) = lbound(SrcMiscData%U_red, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_red, kind=B8Ki) - if (.not. allocated(DstMiscData%U_red)) then - allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%U_red = SrcMiscData%U_red - end if - if (allocated(SrcMiscData%FC_unit)) then - LB(1:1) = lbound(SrcMiscData%FC_unit, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FC_unit, kind=B8Ki) - if (.not. allocated(DstMiscData%FC_unit)) then - allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%FC_unit = SrcMiscData%FC_unit - end if - if (allocated(SrcMiscData%SDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%SDWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SDWrOutput, kind=B8Ki) - if (.not. allocated(DstMiscData%SDWrOutput)) then - allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput - end if - if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) - if (.not. allocated(DstMiscData%AllOuts)) then - allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%AllOuts = SrcMiscData%AllOuts - end if - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%Decimat = SrcMiscData%Decimat - if (allocated(SrcMiscData%Fext)) then - LB(1:1) = lbound(SrcMiscData%Fext, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Fext, kind=B8Ki) - if (.not. allocated(DstMiscData%Fext)) then - allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%Fext = SrcMiscData%Fext - end if - if (allocated(SrcMiscData%Fext_red)) then - LB(1:1) = lbound(SrcMiscData%Fext_red, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Fext_red, kind=B8Ki) - if (.not. allocated(DstMiscData%Fext_red)) then - allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%Fext_red = SrcMiscData%Fext_red - end if - if (allocated(SrcMiscData%FG)) then - LB(1:1) = lbound(SrcMiscData%FG, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FG, kind=B8Ki) - if (.not. allocated(DstMiscData%FG)) then - allocate(DstMiscData%FG(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FG.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%FG = SrcMiscData%FG - end if - if (allocated(SrcMiscData%UL_SIM)) then - LB(1:1) = lbound(SrcMiscData%UL_SIM, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_SIM, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_SIM)) then - allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%UL_SIM = SrcMiscData%UL_SIM - end if - if (allocated(SrcMiscData%UL_0m)) then - LB(1:1) = lbound(SrcMiscData%UL_0m, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_0m, kind=B8Ki) - if (.not. allocated(DstMiscData%UL_0m)) then - allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_OtherStateType), intent(in) :: SrcOtherStateData + type(SD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_0m = SrcMiscData%UL_0m + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if + DstOtherStateData%n = SrcOtherStateData%n end subroutine -subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SD_MiscVarType), intent(inout) :: MiscData +subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SD_DestroyMisc' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%qmdotdot)) then - deallocate(MiscData%qmdotdot) - end if - if (allocated(MiscData%F_L)) then - deallocate(MiscData%F_L) - end if - if (allocated(MiscData%F_L2)) then - deallocate(MiscData%F_L2) - end if - if (allocated(MiscData%UR_bar)) then - deallocate(MiscData%UR_bar) - end if - if (allocated(MiscData%UR_bar_dot)) then - deallocate(MiscData%UR_bar_dot) - end if - if (allocated(MiscData%UR_bar_dotdot)) then - deallocate(MiscData%UR_bar_dotdot) - end if - if (allocated(MiscData%UL)) then - deallocate(MiscData%UL) - end if - if (allocated(MiscData%UL_NS)) then - deallocate(MiscData%UL_NS) - end if - if (allocated(MiscData%UL_dot)) then - deallocate(MiscData%UL_dot) - end if - if (allocated(MiscData%UL_dotdot)) then - deallocate(MiscData%UL_dotdot) - end if - if (allocated(MiscData%DU_full)) then - deallocate(MiscData%DU_full) - end if - if (allocated(MiscData%U_full)) then - deallocate(MiscData%U_full) - end if - if (allocated(MiscData%U_full_NS)) then - deallocate(MiscData%U_full_NS) - end if - if (allocated(MiscData%U_full_dot)) then - deallocate(MiscData%U_full_dot) - end if - if (allocated(MiscData%U_full_dotdot)) then - deallocate(MiscData%U_full_dotdot) - end if - if (allocated(MiscData%U_full_elast)) then - deallocate(MiscData%U_full_elast) - end if - if (allocated(MiscData%U_red)) then - deallocate(MiscData%U_red) - end if - if (allocated(MiscData%FC_unit)) then - deallocate(MiscData%FC_unit) - end if - if (allocated(MiscData%SDWrOutput)) then - deallocate(MiscData%SDWrOutput) - end if - if (allocated(MiscData%AllOuts)) then - deallocate(MiscData%AllOuts) - end if - if (allocated(MiscData%Fext)) then - deallocate(MiscData%Fext) - end if - if (allocated(MiscData%Fext_red)) then - deallocate(MiscData%Fext_red) - end if - if (allocated(MiscData%FG)) then - deallocate(MiscData%FG) - end if - if (allocated(MiscData%UL_SIM)) then - deallocate(MiscData%UL_SIM) - end if - if (allocated(MiscData%UL_0m)) then - deallocate(MiscData%UL_0m) + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) end if end subroutine -subroutine SD_PackMisc(RF, Indata) +subroutine SD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF - type(SD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SD_PackMisc' + type(SD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOtherState' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%qmdotdot) - call RegPack(RF, InData%u_TP) - call RegPack(RF, InData%udot_TP) - call RegPack(RF, InData%udotdot_TP) - call RegPackAlloc(RF, InData%F_L) - call RegPackAlloc(RF, InData%F_L2) - call RegPackAlloc(RF, InData%UR_bar) - call RegPackAlloc(RF, InData%UR_bar_dot) - call RegPackAlloc(RF, InData%UR_bar_dotdot) - call RegPackAlloc(RF, InData%UL) - call RegPackAlloc(RF, InData%UL_NS) - call RegPackAlloc(RF, InData%UL_dot) - call RegPackAlloc(RF, InData%UL_dotdot) - call RegPackAlloc(RF, InData%DU_full) - call RegPackAlloc(RF, InData%U_full) - call RegPackAlloc(RF, InData%U_full_NS) - call RegPackAlloc(RF, InData%U_full_dot) - call RegPackAlloc(RF, InData%U_full_dotdot) - call RegPackAlloc(RF, InData%U_full_elast) - call RegPackAlloc(RF, InData%U_red) - call RegPackAlloc(RF, InData%FC_unit) - call RegPackAlloc(RF, InData%SDWrOutput) - call RegPackAlloc(RF, InData%AllOuts) - call RegPack(RF, InData%LastOutTime) - call RegPack(RF, InData%Decimat) - call RegPackAlloc(RF, InData%Fext) - call RegPackAlloc(RF, InData%Fext_red) - call RegPackAlloc(RF, InData%FG) - call RegPackAlloc(RF, InData%UL_SIM) - call RegPackAlloc(RF, InData%UL_0m) + call RegPack(RF, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) + do i1 = LB(1), UB(1) + call SD_PackContState(RF, InData%xdot(i1)) + end do + end if + call RegPack(RF, InData%n) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackMisc(RF, OutData) +subroutine SD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF - type(SD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackMisc' + type(SD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOtherState' + integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%qmdotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%u_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%udot_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%udotdot_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_L); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_L2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_NS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DU_full); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_NS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_elast); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_red); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FC_unit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SDWrOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Decimat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Fext_red); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FG); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_SIM); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_0m); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + end if + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -2595,6 +2088,12 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SD_CopyParam' ErrStat = ErrID_None ErrMsg = '' + DstParamData%iVarTPMesh = SrcParamData%iVarTPMesh + DstParamData%iVarLMesh = SrcParamData%iVarLMesh + DstParamData%iVarY1Mesh = SrcParamData%iVarY1Mesh + DstParamData%iVarY2Mesh = SrcParamData%iVarY2Mesh + DstParamData%iVarY3Mesh = SrcParamData%iVarY3Mesh + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput DstParamData%g = SrcParamData%g DstParamData%SDDeltaT = SrcParamData%SDDeltaT DstParamData%IntMethod = SrcParamData%IntMethod @@ -3613,6 +3112,12 @@ subroutine SD_PackParam(RF, Indata) integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%iVarTPMesh) + call RegPack(RF, InData%iVarLMesh) + call RegPack(RF, InData%iVarY1Mesh) + call RegPack(RF, InData%iVarY2Mesh) + call RegPack(RF, InData%iVarY3Mesh) + call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%g) call RegPack(RF, InData%SDDeltaT) call RegPack(RF, InData%IntMethod) @@ -3781,6 +3286,12 @@ subroutine SD_UnPackParam(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%iVarTPMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarLMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY1Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY2Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY3Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SDDeltaT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return @@ -4430,6 +3941,18 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%Fext_red = SrcMiscData%Fext_red end if + if (allocated(SrcMiscData%FG)) then + LB(1:1) = lbound(SrcMiscData%FG, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FG, kind=B8Ki) + if (.not. allocated(DstMiscData%FG)) then + allocate(DstMiscData%FG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FG = SrcMiscData%FG + end if if (allocated(SrcMiscData%UL_SIM)) then LB(1:1) = lbound(SrcMiscData%UL_SIM, kind=B8Ki) UB(1:1) = ubound(SrcMiscData%UL_SIM, kind=B8Ki) @@ -4544,6 +4067,9 @@ subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%Fext_red)) then deallocate(MiscData%Fext_red) end if + if (allocated(MiscData%FG)) then + deallocate(MiscData%FG) + end if if (allocated(MiscData%UL_SIM)) then deallocate(MiscData%UL_SIM) end if @@ -4590,6 +4116,7 @@ subroutine SD_PackMisc(RF, Indata) call RegPack(RF, InData%Decimat) call RegPackAlloc(RF, InData%Fext) call RegPackAlloc(RF, InData%Fext_red) + call RegPackAlloc(RF, InData%FG) call RegPackAlloc(RF, InData%UL_SIM) call RegPackAlloc(RF, InData%UL_0m) if (RegCheckErr(RF, RoutineName)) return @@ -4636,6 +4163,7 @@ subroutine SD_UnPackMisc(RF, OutData) call RegUnpack(RF, OutData%Decimat); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Fext_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FG); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%UL_SIM); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%UL_0m); if (RegCheckErr(RF, RoutineName)) return end subroutine From e6112505ad50bb4d29bf7a065df87956d4d42f99 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 12 Sep 2024 11:27:08 +0000 Subject: [PATCH 245/319] FAST_Subs: Fix duplicate array allocation --- modules/openfast-library/src/FAST_Subs.f90 | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 7a5f6f423a..a7b502015e 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1236,11 +1236,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_SrvD%Gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration vector" m/s^2 CALL AllocAry(Init%InData_SrvD%BlPitchInit, NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them - CALL Cleanup() - RETURN - end if + if (Failed()) return if (p_FAST%CompElast == Module_SED) then Init%InData_SrvD%NacRefPos(1:3) = SED%y%NacelleMotion%Position(1:3,1) @@ -1336,10 +1332,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ! Set cable controls inputs (if requested by other modules) -- There is probably a nicer way to do this, but this will work for now. call SetSrvDCableControls() - CALL AllocAry(Init%InData_SrvD%BlPitchInit, Init%OutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) - if (Failed()) return - - Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch CALL SrvD_Init( Init%InData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), Init%OutData_SrvD, ErrStat2, ErrMsg2 ) if (Failed()) return @@ -1347,9 +1339,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !IF ( Init%OutData_SrvD%CouplingScheme == ExplicitLoose ) THEN ... bjj: abort if we're doing anything else! - CALL SetModuleSubstepTime(Module_SrvD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return - ! Add module to list of modules CALL MV_AddModule(m_Glue%ModData, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & Init%OutData_SrvD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) From bc3ebe5912e901ac1c283c4378a8fdb9ec17140a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 12 Sep 2024 13:37:57 +0000 Subject: [PATCH 246/319] Add IceDyn and IceFloe to modules system --- modules/icedyn/src/IceDyn.f90 | 73 +++++++-- modules/icedyn/src/IceDyn_Types.f90 | 138 ++++++++++++------ modules/icedyn/src/Registry_IceDyn.txt | 18 ++- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 138 ++++++++++++------ .../icefloe/src/interfaces/FAST/IceFloe.f90 | 55 +++++++ .../interfaces/FAST/IceFloe_FASTRegistry.inp | 16 +- 6 files changed, 328 insertions(+), 110 deletions(-) diff --git a/modules/icedyn/src/IceDyn.f90 b/modules/icedyn/src/IceDyn.f90 index 9abd548d9f..e8ab5ed01e 100644 --- a/modules/icedyn/src/IceDyn.f90 +++ b/modules/icedyn/src/IceDyn.f90 @@ -263,17 +263,18 @@ SUBROUTINE IceD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO ' m/s^2) differs from gravity in glue code ('//trim(num2Lstr(InitInp%gravity))//' m/s^2).') END IF - - - ! ! Print the summary file if requested: - ! IF (InputFileData%SumPrint) THEN - ! CALL IceD_PrintSum( p, OtherState, ErrStat2, ErrMsg2 ) - ! CALL CheckError( ErrStat2, ErrMsg2 ) - ! IF (ErrStat >= AbortErrLev) RETURN - ! END IF - - ! Destroy the InputFileData structure (deallocate arrays) - + ! Print the summary file if requested: + ! IF (InputFileData%SumPrint) THEN + ! CALL IceD_PrintSum( p, OtherState, ErrStat2, ErrMsg2 ) + ! CALL CheckError( ErrStat2, ErrMsg2 ) + ! IF (ErrStat >= AbortErrLev) RETURN + ! END IF + + ! Initialize module variables + CALL IceD_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, .false., ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2, ErrMsg2) + + ! Destroy the InputFileData structure (deallocate arrays) CALL IceD_DestroyInputFile(InputFileData, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -314,6 +315,56 @@ SUBROUTINE CheckError(ErrID,Msg) END SUBROUTINE CheckError END SUBROUTINE IceD_Init + +subroutine IceD_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(IceD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(IceD_ParameterType), intent(inout) :: p !< Parameters + type(IceD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(IceD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(IceD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(IceD_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne + + character(*), parameter :: RoutineName = 'IceD_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call IceD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE IceD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 3a10f6903e..7fb06b6894 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -114,6 +114,7 @@ MODULE IceDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] INTEGER(IntKi) :: numLegs = 0_IntKi !< Number of legs on the structure [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE IceD_InitOutputType ! ======================= ! ========= IceD_ContinuousStateType ======= @@ -146,11 +147,6 @@ MODULE IceDyn_Types INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] END TYPE IceD_OtherStateType ! ======================= -! ========= IceD_MiscVarType ======= - TYPE, PUBLIC :: IceD_MiscVarType - INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] - END TYPE IceD_MiscVarType -! ======================= ! ========= IceD_ParameterType ======= TYPE, PUBLIC :: IceD_ParameterType REAL(ReKi) :: h = 0.0_ReKi !< Ice thickness [m] @@ -223,6 +219,16 @@ MODULE IceDyn_Types TYPE(MeshType) :: PointMesh !< contains Ice force [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE IceD_OutputType +! ======================= +! ========= IceD_MiscVarType ======= + TYPE, PUBLIC :: IceD_MiscVarType + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] + TYPE(ModJacType) :: Jac !< Values [corresponding] + TYPE(IceD_ContinuousStateType) :: x_perturb !< [-] + TYPE(IceD_ContinuousStateType) :: dxdt_lin !< [-] + TYPE(IceD_InputType) :: u_perturb !< [-] + TYPE(IceD_OutputType) :: y_lin !< [-] + END TYPE IceD_MiscVarType ! ======================= integer(IntKi), public, parameter :: IceD_x_q = 1 ! IceD%q integer(IntKi), public, parameter :: IceD_x_dqdt = 2 ! IceD%dqdt @@ -591,6 +597,9 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -610,6 +619,8 @@ subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IceD_PackInitOutput(RF, Indata) @@ -621,6 +632,7 @@ subroutine IceD_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputUnt) call RegPack(RF, InData%numLegs) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -636,6 +648,7 @@ subroutine IceD_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%numLegs); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine IceD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -920,44 +933,6 @@ subroutine IceD_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(IceD_MiscVarType), intent(in) :: SrcMiscData - type(IceD_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceD_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar -end subroutine - -subroutine IceD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(IceD_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine IceD_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(IceD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'IceD_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyMiscVar) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine IceD_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(IceD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'IceD_UnPackMisc' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(IceD_ParameterType), intent(in) :: SrcParamData type(IceD_ParameterType), intent(inout) :: DstParamData @@ -1425,6 +1400,83 @@ subroutine IceD_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine IceD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(inout) :: SrcMiscData + type(IceD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call IceD_PackContState(RF, InData%x_perturb) + call IceD_PackContState(RF, InData%dxdt_lin) + call IceD_PackInput(RF, InData%u_perturb) + call IceD_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call IceD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call IceD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call IceD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call IceD_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + subroutine IceD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time diff --git a/modules/icedyn/src/Registry_IceDyn.txt b/modules/icedyn/src/Registry_IceDyn.txt index b230ebf9d9..d0643fcb0c 100644 --- a/modules/icedyn/src/Registry_IceDyn.txt +++ b/modules/icedyn/src/Registry_IceDyn.txt @@ -111,7 +111,7 @@ typedef IceDyn/IceD InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} typedef ^ ^ ^ WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ ^ IntKi numLegs - - - "Number of legs on the structure" - typedef ^ ^ ProgDesc Ver - - - "This module's name, version, and date" - - +typedef ^ ^ ModVarsType Vars - - - "Module Variables" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -142,13 +142,6 @@ typedef ^ ^ ReKi dxc typedef ^ ^ IceD_ContinuousStateType xdot {:} - - "previous state deriv for multi-step" m typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated" - - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType IntKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - - - # ..... Parameters ................................................................................................................ # Define parameters here: # ..... General parameters ........................................................................................................ @@ -232,3 +225,12 @@ typedef IceDyn/IceD InputType MeshType PointMesh typedef IceDyn/IceD OutputType MeshType PointMesh - - - "contains Ice force" N typedef ^ ^ ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType IntKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - +typedef ^ MiscVarType ModJacType Jac - - - Values corresponding to module variables" +typedef ^ MiscVarType IceD_ContinuousStateType x_perturb - - - "" - +typedef ^ MiscVarType IceD_ContinuousStateType dxdt_lin - - - "" - +typedef ^ MiscVarType IceD_InputType u_perturb - - - "" - +typedef ^ MiscVarType IceD_OutputType y_lin - - - "" - diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 61ec75f176..17720c331b 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -47,6 +47,7 @@ MODULE IceFloe_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE IceFloe_InitOutputType ! ======================= ! ========= IceFloe_ContinuousStateType ======= @@ -69,11 +70,6 @@ MODULE IceFloe_Types INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] END TYPE IceFloe_OtherStateType ! ======================= -! ========= IceFloe_MiscVarType ======= - TYPE, PUBLIC :: IceFloe_MiscVarType - INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] - END TYPE IceFloe_MiscVarType -! ======================= ! ========= IceFloe_ParameterType ======= TYPE, PUBLIC :: IceFloe_ParameterType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: loadSeries !< - [precalculated time series of ice loads for each leg] @@ -107,6 +103,16 @@ MODULE IceFloe_Types TYPE(MeshType) :: iceMesh !< Horizontal forces and torsional moment(s) on support structure leg(s) at water line [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE IceFloe_OutputType +! ======================= +! ========= IceFloe_MiscVarType ======= + TYPE, PUBLIC :: IceFloe_MiscVarType + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] + TYPE(ModJacType) :: Jac !< Values [corresponding] + TYPE(IceFloe_ContinuousStateType) :: x_perturb !< [-] + TYPE(IceFloe_ContinuousStateType) :: dxdt_lin !< [-] + TYPE(IceFloe_InputType) :: u_perturb !< [-] + TYPE(IceFloe_OutputType) :: y_lin !< [-] + END TYPE IceFloe_MiscVarType ! ======================= integer(IntKi), public, parameter :: IceFloe_x_DummyContStateVar = 1 ! IceFloe%DummyContStateVar integer(IntKi), public, parameter :: IceFloe_z_DummyConstrStateVar = 2 ! IceFloe%DummyConstrStateVar @@ -205,6 +211,9 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -224,6 +233,8 @@ subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IceFloe_PackInitOutput(RF, Indata) @@ -234,6 +245,7 @@ subroutine IceFloe_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -248,6 +260,7 @@ subroutine IceFloe_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine IceFloe_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -402,44 +415,6 @@ subroutine IceFloe_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(IceFloe_MiscVarType), intent(in) :: SrcMiscData - type(IceFloe_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceFloe_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar -end subroutine - -subroutine IceFloe_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(IceFloe_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceFloe_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine IceFloe_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(IceFloe_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'IceFloe_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyMiscVar) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine IceFloe_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(IceFloe_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(IceFloe_ParameterType), intent(in) :: SrcParamData type(IceFloe_ParameterType), intent(inout) :: DstParamData @@ -706,6 +681,83 @@ subroutine IceFloe_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine IceFloe_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(inout) :: SrcMiscData + type(IceFloe_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceFloe_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceFloe_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call IceFloe_PackContState(RF, InData%x_perturb) + call IceFloe_PackContState(RF, InData%dxdt_lin) + call IceFloe_PackInput(RF, InData%u_perturb) + call IceFloe_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call IceFloe_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call IceFloe_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call IceFloe_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call IceFloe_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + subroutine IceFloe_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time diff --git a/modules/icefloe/src/interfaces/FAST/IceFloe.f90 b/modules/icefloe/src/interfaces/FAST/IceFloe.f90 index f257ddeb6e..652512882f 100644 --- a/modules/icefloe/src/interfaces/FAST/IceFloe.f90 +++ b/modules/icefloe/src/interfaces/FAST/IceFloe.f90 @@ -49,6 +49,7 @@ MODULE IceFloe use randomCrushing use IceCpldCrushing use NWTC_IO, only : DispNVD + use ModVar IMPLICIT NONE @@ -347,6 +348,11 @@ SUBROUTINE IceFloe_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In InitOut%WriteOutputUnt(4*n-3:4*n) = (/"m/s", "m/s", "kN ", "kN "/) enddo endif + + ! Initialize module variables + CALL IceFloe_InitVars(u, p, x, y, m, InitOut%Vars, .false., ErrStat, ErrMsg) + call iceErrorHndlr (iceLog, ErrStat, 'Error in allocation of output memory', 1) + if (ErrStat >= AbortErrLev) return ! Let the user know if there have been warnings if (iceLog%WarnFlag) then @@ -364,6 +370,55 @@ SUBROUTINE IceFloe_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In END SUBROUTINE IceFloe_Init + +subroutine IceFloe_InitVars(u, p, x, y, m, Vars, Linearize, ErrStat, ErrMsg) + type(IceFloe_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(IceFloe_ParameterType), intent(inout) :: p !< Parameters + type(IceFloe_ContinuousStateType), intent(inout) :: x !< Continuous state + type(IceFloe_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(IceFloe_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne + + character(*), parameter :: RoutineName = 'IceFloe_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call IceFloe_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE IceFloe_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! diff --git a/modules/icefloe/src/interfaces/FAST/IceFloe_FASTRegistry.inp b/modules/icefloe/src/interfaces/FAST/IceFloe_FASTRegistry.inp index 362c9f02b3..e3f23ca0d3 100644 --- a/modules/icefloe/src/interfaces/FAST/IceFloe_FASTRegistry.inp +++ b/modules/icefloe/src/interfaces/FAST/IceFloe_FASTRegistry.inp @@ -25,6 +25,7 @@ typedef ^ ^ character(1024) RootName - - - "Output file root typedef IceFloe InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef IceFloe InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef IceFloe InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef IceFloe InitOutputType ModVarsType Vars - - - "Module Variables" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -39,11 +40,6 @@ typedef IceFloe ConstraintStateType SiKi DummyConstrStateVar - - - "None curre # Define any other states, including integer or logical states here: typedef IceFloe OtherStateType IntKi DummyOtherState - - - "Remove this variable if you have other states" - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef IceFloe MiscVarType IntKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -75,3 +71,13 @@ typedef IceFloe InputType MeshType iceMesh - - - "Horizontal velocit # Define outputs that are contained on the mesh here: typedef IceFloe OutputType MeshType iceMesh - - - "Horizontal forces and torsional moment(s) on support structure leg(s) at water line" - typedef IceFloe OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" + +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef IceFloe MiscVarType IntKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - +typedef ^ ^ ModJacType Jac - - - Values corresponding to module variables" +typedef ^ ^ IceFloe_ContinuousStateType x_perturb - - - "" - +typedef ^ ^ IceFloe_ContinuousStateType dxdt_lin - - - "" - +typedef ^ ^ IceFloe_InputType u_perturb - - - "" - +typedef ^ ^ IceFloe_OutputType y_lin - - - "" - From 5a17a690a9abfe723e95ba48f3c615a9adc31ad5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 12 Sep 2024 17:22:04 +0000 Subject: [PATCH 247/319] Integrate SED and AeroDisk into new glue code --- modules/aerodisk/src/AeroDisk.f90 | 62 +++ modules/openfast-library/src/FAST_Funcs.f90 | 174 ++++++++- modules/openfast-library/src/FAST_Mapping.f90 | 173 +++++++++ .../openfast-library/src/FAST_Registry.txt | 2 + .../openfast-library/src/FAST_SolverTC.f90 | 11 +- modules/openfast-library/src/FAST_Subs.f90 | 362 ++++++++---------- modules/openfast-library/src/FAST_Types.f90 | 96 +++++ modules/simple-elastodyn/src/SED.f90 | 264 ++++++++++++- 8 files changed, 940 insertions(+), 204 deletions(-) diff --git a/modules/aerodisk/src/AeroDisk.f90 b/modules/aerodisk/src/AeroDisk.f90 index efd0e40ac8..6f926fe3b2 100644 --- a/modules/aerodisk/src/AeroDisk.f90 +++ b/modules/aerodisk/src/AeroDisk.f90 @@ -144,6 +144,10 @@ SUBROUTINE ADsk_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! Set some other stuff that the framework requires call Init_OtherStuff(ErrStat2,ErrMsg2); if (Failed()) return + ! Initialize module variables + call ADsk_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, .false., ErrStat2, ErrMsg2) + if (Failed()) return + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -265,6 +269,64 @@ subroutine Init_InitY(ErrStat3,ErrMsg3) end subroutine Init_InitY END SUBROUTINE ADsk_Init +subroutine ADsk_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(ADsk_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ADsk_ParameterType), intent(inout) :: p !< Parameters + type(ADsk_ContinuousStateType), intent(inout) :: x !< Continuous state + type(ADsk_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ADsk_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(ADsk_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne + + character(*), parameter :: RoutineName = 'ADsk_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%u, "Hub", MotionFields, & + DL=DatLoc(ADsk_u_HubMotion), & + Mesh=u%HubMotion) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%y, 'AeroLoads', LoadFields, & + DatLoc(ADsk_y_AeroLoads), & + Mesh=y%AeroLoads) + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call ADsk_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ADsk_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ADsk_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ADsk_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 2d8bcf7895..2c41056c76 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -74,6 +74,13 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) end do call ShiftInputTimes(T%AD%InputTimes) + case (Module_ADsk) + call ADsk_Input_ExtrapInterp(T%ADsk%Input(1:), T%ADsk%InputTimes, T%ADsk%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call ADsk_CopyInput(T%ADsk%Input(j), T%ADsk%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%ADsk%InputTimes) + case (Module_BD) call BD_Input_ExtrapInterp(T%BD%Input(1:, ModData%Ins), T%BD%InputTimes(:, ModData%Ins), T%BD%Input(INPUT_TEMP, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 @@ -88,6 +95,13 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) end do call ShiftInputTimes(T%ED%InputTimes) + case (Module_SED) + call SED_Input_ExtrapInterp(T%SED%Input(1:), T%SED%InputTimes, T%SED%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call SED_CopyInput(T%SED%Input(j), T%SED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%SED%InputTimes) + case (Module_ExtInfw) ! Not used @@ -165,7 +179,6 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) call ShiftInputTimes(T%SD%InputTimes) case (Module_SeaSt) - ! call SeaSt_Input_ExtrapInterp(T%SeaSt%Input(1:), T%SeaSt%InputTimes, T%SeaSt%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return ! do j = T%p_FAST%InterpOrder, 1, -1 ! call SeaSt_CopyInput(T%SeaSt%Input(j), T%SeaSt%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -247,10 +260,14 @@ subroutine FAST_InitInputStateArrays(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) select case (ModData%ID) case (Module_AD) T%AD%InputTimes = InputTimes + case (Module_ADsk) + T%ADsk%InputTimes = InputTimes case (Module_BD) T%BD%InputTimes(:, ModData%Ins) = InputTimes case (Module_ED) T%ED%InputTimes = InputTimes + case (Module_SED) + T%SED%InputTimes = InputTimes case (Module_ExtPtfm) T%ExtPtfm%InputTimes = InputTimes case (Module_FEAM) @@ -328,12 +345,40 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) if (Failed()) return end do + case (Module_ADsk) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call ADsk_UpdateStates(t_module, n_t_module, T%ADsk%Input(1:), T%ADsk%InputTimes, & + T%ADsk%p, T%ADsk%x(STATE_PRED), T%ADsk%xd(STATE_PRED), & + T%ADsk%z(STATE_PRED), T%ADsk%OtherSt(STATE_PRED), & + T%ADsk%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + case (Module_BD) ! State update is handled by tight coupling solver case (Module_ED) ! State update is handled by tight coupling solver + case (Module_SED) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call SED_UpdateStates(t_module, n_t_module, T%SED%Input(1:), T%SED%InputTimes, & + T%SED%p, T%SED%x(STATE_PRED), T%SED%xd(STATE_PRED), & + T%SED%z(STATE_PRED), T%SED%OtherSt(STATE_PRED), & + T%SED%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + case (Module_ExtLd) ! Not used @@ -528,9 +573,17 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt select case (ModData%ID) case (Module_AD) - call AD_CalcOutput(ThisTime, T%AD%Input(iInput), T%AD%p, & - T%AD%x(iState), T%AD%xd(iState), T%AD%z(iState), T%AD%OtherSt(iState), & - T%AD%y, T%AD%m, ErrStat2, ErrMsg2, CalcWriteOutput) + ! Call CalcOutput on first instance, calculation is for all rotors + if (ModData%Ins == 1) then + call AD_CalcOutput(ThisTime, T%AD%Input(iInput), T%AD%p, & + T%AD%x(iState), T%AD%xd(iState), T%AD%z(iState), T%AD%OtherSt(iState), & + T%AD%y, T%AD%m, ErrStat2, ErrMsg2, CalcWriteOutput) + end if + + case (Module_ADsK) + call ADsK_CalcOutput(ThisTime, T%ADsK%Input(iInput), T%ADsK%p, & + T%ADsK%x(iState), T%ADsK%xd(iState), T%ADsK%z(iState), T%ADsK%OtherSt(iState), & + T%ADsK%y, T%ADsK%m, ErrStat2, ErrMsg2, CalcWriteOutput) case (Module_BD) call BD_CalcOutput(ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & @@ -543,6 +596,11 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt T%ED%x(iState), T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & T%ED%y, T%ED%m, ErrStat2, ErrMsg2) + case (Module_SED) + call SED_CalcOutput(ThisTime, T%SED%Input(iInput), T%SED%p, & + T%SED%x(iState), T%SED%xd(iState), T%SED%z(iState), T%SED%OtherSt(iState), & + T%SED%y, T%SED%m, ErrStat2, ErrMsg2) + case (Module_ExtInfw) ! Not used @@ -670,11 +728,15 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & case (Module_AD) call AD_VarsPackInput(ModData%Vars, T%AD%Input(iInput)%rotors(ModData%Ins), u_op) call AD_VarsPackExtInput(ModData%Vars, ThisTime, T%AD%p, u_op) + case (Module_ADsk) + call ADsk_VarsPackInput(ModData%Vars, T%ADsk%Input(iInput), u_op) case (Module_BD) call BD_VarsPackInput(ModData%Vars, T%BD%Input(iInput, ModData%Ins), u_op) case (Module_ED) call ED_VarsPackInput(ModData%Vars, T%ED%Input(iInput), u_op) call ED_PackExtInputAry(ModData%Vars, T%ED%Input(iInput), u_op, ErrStat2, ErrMsg2); if (Failed()) return + case (Module_SED) + call SED_VarsPackInput(ModData%Vars, T%SED%Input(iInput), u_op) case (Module_ExtPtfm) call ExtPtfm_VarsPackInput(ModData%Vars, T%ExtPtfm%Input(iInput), u_op) case (Module_FEAM) @@ -725,10 +787,14 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & select case (ModData%ID) case (Module_AD) call AD_VarsPackOutput(ModData%Vars, T%AD%y%rotors(ModData%Ins), y_op) + case (Module_ADsk) + call ADsk_VarsPackOutput(ModData%Vars, T%ADsk%y, y_op) case (Module_BD) call BD_VarsPackOutput(ModData%Vars, T%BD%y(ModData%Ins), y_op) case (Module_ED) call ED_VarsPackOutput(ModData%Vars, T%ED%y, y_op) + case (Module_SED) + call SED_VarsPackOutput(ModData%Vars, T%SED%y, y_op) case (Module_ExtPtfm) call ExtPtfm_VarsPackOutput(ModData%Vars, T%ExtPtfm%y, y_op) case (Module_FEAM) @@ -778,10 +844,14 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & select case (ModData%ID) case (Module_AD) call AD_VarsPackContState(ModData%Vars, T%AD%x(iState)%rotors(ModData%Ins), x_op) + case (Module_ADsk) + call ADsk_VarsPackContState(ModData%Vars, T%ADsk%x(iState), x_op) case (Module_BD) call BD_VarsPackContState(ModData%Vars, T%BD%x(ModData%Ins, iState), x_op) case (Module_ED) call ED_VarsPackContState(ModData%Vars, T%ED%x(iState), x_op) + case (Module_SED) + call SED_VarsPackContState(ModData%Vars, T%SED%x(iState), x_op) case (Module_ExtPtfm) call ExtPtfm_VarsPackContState(ModData%Vars, T%ExtPtfm%x(iState), x_op) case (Module_FEAM) @@ -847,6 +917,13 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & if (Failed()) return call AD_VarsPackContStateDeriv(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) + case (Module_ADsk) + call ADsk_CalcContStateDeriv(ThisTime, T%ADsk%Input(iInput), T%ADsk%p, T%ADsk%x(iState), & + T%ADsk%xd(iState), T%ADsk%z(iState), T%ADsk%OtherSt(iState), & + T%ADsk%m, T%ADsk%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call ADsk_VarsPackContStateDeriv(ModData%Vars, T%ADsk%m%dxdt_lin, dx_op) + case (Module_BD) call BD_CalcContStateDeriv(ThisTime, T%BD%Input(iInput, ModData%Ins), & T%BD%p(ModData%Ins), & @@ -867,6 +944,13 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & if (Failed()) return call ED_VarsPackContStateDeriv(ModData%Vars, T%ED%m%dxdt_lin, dx_op) + case (Module_SED) + call SED_CalcContStateDeriv(ThisTime, T%SED%Input(iInput), T%SED%p, T%SED%x(iState), & + T%SED%xd(iState), T%SED%z(iState), T%SED%OtherSt(iState), & + T%SED%m, T%SED%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call SED_VarsPackContStateDeriv(ModData%Vars, T%SED%m%dxdt_lin, dx_op) + case (Module_ExtPtfm) call ExtPtfm_CalcContStateDeriv(ThisTime, T%ExtPtfm%Input(iInput), & T%ExtPtfm%p, T%ExtPtfm%x(iState), & @@ -952,10 +1036,14 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & select case (ModData%ID) case (Module_AD) call AD_VarsPackConstrState(ModData%Vars, T%AD%z(iState)%rotors(ModData%Ins), z_op) + case (Module_ADsk) + call ADsk_VarsPackConstrState(ModData%Vars, T%ADsk%z(iState), z_op) case (Module_BD) call BD_VarsPackConstrState(ModData%Vars, T%BD%z(ModData%Ins, iState), z_op) case (Module_ED) call ED_VarsPackConstrState(ModData%Vars, T%ED%z(iState), z_op) + case (Module_SED) + call SED_VarsPackConstrState(ModData%Vars, T%SED%z(iState), z_op) case (Module_ExtPtfm) call ExtPtfm_VarsPackConstrState(ModData%Vars, T%ExtPtfm%z(iState), z_op) case (Module_FEAM) @@ -1028,10 +1116,14 @@ subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & select case (ModData%ID) case (Module_AD) call AD_VarsUnpackInput(ModData%Vars, u_op, T%AD%Input(iInput)%rotors(ModData%Ins)) + case (Module_ADsk) + call ADsk_VarsUnpackInput(ModData%Vars, u_op, T%ADsk%Input(iInput)) case (Module_BD) call BD_VarsUnpackInput(ModData%Vars, u_op, T%BD%Input(iInput, ModData%Ins)) case (Module_ED) call ED_VarsUnpackInput(ModData%Vars, u_op, T%ED%Input(iInput)) + case (Module_SED) + call SED_VarsUnpackInput(ModData%Vars, u_op, T%SED%Input(iInput)) case (Module_ExtPtfm) call ExtPtfm_VarsUnpackInput(ModData%Vars, u_op, T%ExtPtfm%Input(iInput)) case (Module_FEAM) @@ -1075,10 +1167,14 @@ subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & select case (ModData%ID) case (Module_AD) call AD_VarsUnpackContState(ModData%Vars, x_op, T%AD%x(iState)%rotors(ModData%Ins)) + case (Module_ADsk) + call ADsk_VarsUnpackContState(ModData%Vars, x_op, T%ADsk%x(iState)) case (Module_BD) call BD_VarsUnpackContState(ModData%Vars, x_op, T%BD%x(ModData%Ins, iState)) case (Module_ED) call ED_VarsUnpackContState(ModData%Vars, x_op, T%ED%x(iState)) + case (Module_SED) + call SED_VarsUnpackContState(ModData%Vars, x_op, T%SED%x(iState)) case (Module_ExtPtfm) call ExtPtfm_VarsUnpackContState(ModData%Vars, x_op, T%ExtPtfm%x(iState)) case (Module_FEAM) @@ -1122,10 +1218,14 @@ subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & select case (ModData%ID) case (Module_AD) call AD_VarsUnpackConstrState(ModData%Vars, z_op, T%AD%z(iState)%rotors(ModData%Ins)) + case (Module_ADsk) + call ADsk_VarsUnpackConstrState(ModData%Vars, z_op, T%ADsk%z(iState)) case (Module_BD) call BD_VarsUnpackConstrState(ModData%Vars, z_op, T%BD%z(ModData%Ins, iState)) case (Module_ED) call ED_VarsUnpackConstrState(ModData%Vars, z_op, T%ED%z(iState)) + case (Module_SED) + call SED_VarsUnpackConstrState(ModData%Vars, z_op, T%SED%z(iState)) case (Module_ExtPtfm) call ExtPtfm_VarsUnpackConstrState(ModData%Vars, z_op, T%ExtPtfm%z(iState)) case (Module_FEAM) @@ -1194,6 +1294,11 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, iInput, iState, T, ErrStat, Er T%AD%z(iState), T%AD%OtherSt(iState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) +! case (Module_ADsk) +! call ADsk_JacobianPInput(ModData%Vars, ThisTime, T%ADsk%Input(iInput), T%ADsk%p, T%ADsk%x(iState), T%ADsk%xd(iState), & +! T%ADsk%z(iState), T%ADsk%OtherSt(iState), T%ADsk%y, T%ADsk%m, ErrStat2, ErrMsg2, & +! dYdu=dYdu, dXdu=dXdu) + case (Module_BD) call BD_JacobianPInput(ModData%Vars, ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & T%BD%x(ModData%Ins, iState), T%BD%xd(ModData%Ins, iState), & @@ -1206,6 +1311,11 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, iInput, iState, T, ErrStat, Er T%ED%z(iState), T%ED%OtherSt(iState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) + case (Module_SED) + call SED_JacobianPInput(ModData%Vars, ThisTime, T%SED%Input(iInput), T%SED%p, T%SED%x(iState), T%SED%xd(iState), & + T%SED%z(iState), T%SED%OtherSt(iState), T%SED%y, T%SED%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + case (Module_ExtPtfm) call ExtPtfm_JacobianPInput(ModData%Vars, ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), & T%ExtPtfm%z(iState), T%ExtPtfm%OtherSt(iState), T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2, & @@ -1292,6 +1402,8 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, iInput, iState, T, ErrStat T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) +! case (Module_ADsk) + case (Module_BD) call BD_JacobianPContState(ModData%Vars, ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & T%BD%x(ModData%Ins, iState), T%BD%xd(ModData%Ins, iState), & @@ -1306,6 +1418,8 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, iInput, iState, T, ErrStat T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) +! case (Module_SED) + case (Module_ExtPtfm) call ExtPtfm_JacobianPContState(ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, & T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), & @@ -1406,6 +1520,13 @@ subroutine FAST_CopyStates(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) call AD_CopyConstrState(T%AD%z(iSrc), T%AD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return call AD_CopyOtherState(T%AD%OtherSt(iSrc), T%AD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case (Module_ADsk) + + call ADsk_CopyContState(T%ADsk%x(iSrc), T%ADsk%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ADsk_CopyDiscState(T%ADsk%xd(iSrc), T%ADsk%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ADsk_CopyConstrState(T%ADsk%z(iSrc), T%ADsk%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ADsk_CopyOtherState(T%ADsk%OtherSt(iSrc), T%ADsk%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case (Module_BD) call BD_CopyContState(T%BD%x(ModData%Ins, iSrc), T%BD%x(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return @@ -1420,6 +1541,13 @@ subroutine FAST_CopyStates(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) call ED_CopyConstrState(T%ED%z(iSrc), T%ED%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return call ED_CopyOtherState(T%ED%OtherSt(iSrc), T%ED%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case (Module_SED) + + call SED_CopyContState(T%SED%x(iSrc), T%SED%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SED_CopyDiscState(T%SED%xd(iSrc), T%SED%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SED_CopyConstrState(T%SED%z(iSrc), T%SED%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SED_CopyOtherState(T%SED%OtherSt(iSrc), T%SED%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case (Module_ExtInfw) ! call ExtInfw_CopyContState(T%ExtInfw%x(Src), T%ExtInfw%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return @@ -1575,6 +1703,25 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) end select end select + case (Module_ADsk) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call ADsk_CopyInput(T%ADsk%Input_Saved(-iSrc), T%ADsk%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0:) + call ADsk_CopyInput(T%ADsk%Input_Saved(-iSrc), T%ADsk%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0:) + select case (iDst) + case (:-1) + call ADsk_CopyInput(T%ADsk%Input(iSrc), T%ADsk%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0:) + call ADsk_CopyInput(T%ADsk%Input(iSrc), T%ADsk%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select + case (Module_BD) select case (iSrc) @@ -1613,6 +1760,25 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) end select end select + case (Module_SED) + + select case (iSrc) + case (:-1) + select case (iDst) + case (:-1) + call SED_CopyInput(T%SED%Input_Saved(-iSrc), T%SED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0:) + call SED_CopyInput(T%SED%Input_Saved(-iSrc), T%SED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + case (0:) + select case (iDst) + case (:-1) + call SED_CopyInput(T%SED%Input(iSrc), T%SED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) + case (0:) + call SED_CopyInput(T%SED%Input(iSrc), T%SED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + end select + end select + case (Module_ExtLd) ! ExtLd only has u Errstat2 = ErrID_None diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 6746c2fa67..f70696ed35 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -42,11 +42,14 @@ module FAST_Mapping character(24), parameter :: Custom_ED_to_ExtLd = 'ED -> ExtLd', & Custom_SrvD_to_AD = 'SrvD -> AD', & + Custom_ED_to_ADsk = 'ED -> ADsk', & + Custom_SED_to_ADsk = 'SED -> ADsk', & Custom_ED_to_IfW = 'ED -> IfW', & Custom_SrvD_to_IfW = 'SrvD -> IfW', & Custom_BD_to_SrvD = 'BD -> SrvD', & Custom_ED_to_SrvD = 'ED -> SrvD', & Custom_SrvD_to_ED = 'SrvD -> ED', & + Custom_SrvD_to_SED = 'SrvD -> SED', & Custom_IfW_to_SrvD = 'IfW -> SrvD', & Custom_ExtInfw_to_SrvD = 'ExtInfw -> SrvD', & Custom_SrvD_to_SD = 'SrvD -> SD', & @@ -72,10 +75,14 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, iInput, ErrSta select case (ModData%ID) case (Module_AD) Mesh => AD_InputMeshPointer(Turbine%AD%Input(iInput)%rotors(ModData%Ins), MeshLoc) + case (Module_ADsk) + Mesh => ADsk_InputMeshPointer(Turbine%ADsk%Input(iInput), MeshLoc) case (Module_BD) Mesh => BD_InputMeshPointer(Turbine%BD%Input(iInput, ModData%Ins), MeshLoc) case (Module_ED) Mesh => ED_InputMeshPointer(Turbine%ED%Input(iInput), MeshLoc) + case (Module_SED) + Mesh => SED_InputMeshPointer(Turbine%SED%Input(iInput), MeshLoc) case (Module_ExtInfw) ! ExtInfw doesn't have the typical input structure, using u Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) @@ -139,10 +146,14 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM select case (ModData%ID) case (Module_AD) Mesh => AD_OutputMeshPointer(Turbine%AD%y%rotors(ModData%Ins), MeshLoc) + case (Module_ADsk) + Mesh => ADsk_OutputMeshPointer(Turbine%ADsk%y, MeshLoc) case (Module_BD) Mesh => BD_OutputMeshPointer(Turbine%BD%y(ModData%Ins), MeshLoc) case (Module_ED) Mesh => ED_OutputMeshPointer(Turbine%ED%y, MeshLoc) + case (Module_SED) + Mesh => SED_OutputMeshPointer(Turbine%SED%y, MeshLoc) case (Module_ExtInfw) Mesh => ExtInfw_OutputMeshPointer(Turbine%ExtInfw%y, MeshLoc) case (Module_ExtLd) @@ -206,6 +217,8 @@ function FAST_InputFieldName(ModData, DL) result(Name) case (AD_u_PropagationDir) Name = 'AD%u%PropagationDir (Ext)' end select + case (Module_ADsk) + Name = trim(ModData%Abbr)//"%"//ADsk_InputFieldName(DL) case (Module_BD) Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputFieldName(DL) case (Module_ED) @@ -215,6 +228,8 @@ function FAST_InputFieldName(ModData, DL) result(Name) case (ED_u_BlPitchComC) Name = 'ED%u%BlPitchComC (Ext)' end select + case (Module_SED) + Name = trim(ModData%Abbr)//"%"//SED_InputFieldName(DL) case (Module_ExtInfw) Name = trim(ModData%Abbr)//"%"//ExtInfw_InputFieldName(DL) case (Module_ExtLd) @@ -281,10 +296,14 @@ function FAST_OutputFieldName(ModData, DL) result(Name) case (Module_AD) tmp = AD_OutputFieldName(DL) Name = trim(ModData%Abbr)//"%y%rotors("//trim(Num2LStr(ModData%Ins))//")"//tmp(2:) + case (Module_ADsk) + Name = trim(ModData%Abbr)//"%"//ADsk_OutputFieldName(DL) case (Module_BD) Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputFieldName(DL) case (Module_ED) Name = trim(ModData%Abbr)//"%"//ED_OutputFieldName(DL) + case (Module_SED) + Name = trim(ModData%Abbr)//"%"//SED_OutputFieldName(DL) case (Module_ExtInfw) Name = trim(ModData%Abbr)//"%"//ExtInfw_OutputFieldName(DL) case (Module_ExtLd) @@ -369,10 +388,14 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) select case (Mods(IModDst)%ID) case (Module_AD) call InitMappings_AD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_ADsk) + call InitMappings_ADsk(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_BD) call InitMappings_BD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ED) call InitMappings_ED(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_SED) + call InitMappings_SED(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtInfw) call InitMappings_ExtInfw(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ExtLd) @@ -577,6 +600,54 @@ logical function Failed() end function end subroutine +subroutine InitMappings_ADsk(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_ADsk' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on source module identifier + select case (SrcMod%ID) + + case (Module_ED) + + ! Hub motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMod=DstMod, DstDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + call MapCustom(Mappings, Custom_ED_to_ADsk, SrcMod, DstMod) + + case (Module_SED) + + ! Hub motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMod=DstMod, DstDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + call MapCustom(Mappings, Custom_SED_to_ADsk, SrcMod, DstMod) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(inout) :: SrcMod, DstMod @@ -744,6 +815,19 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) Active=CompAeroAD .and. NotCompAeroMaps) if (Failed()) return + case (Module_ADsk) + + ! Hub Loads + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(ADsk_y_AeroLoads), & ! ADsk%y%AeroLoads + SrcDispDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion + DstMod=DstMod, & + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + case (Module_BD) ! Hub Loads @@ -974,6 +1058,61 @@ logical function Failed() end function end subroutine +subroutine InitMappings_SED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_SED' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on source module identifier + select case (SrcMod%ID) + + case (Module_AD) + + ! Blade Loads + do i = 1, size(Turbine%AD%y%rotors(SrcMod%Ins)%BladeLoad) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(i) + SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(i) + DstDL=DatLoc(SED_u_HubPtLoad), & ! SED%u%HubPtLoad + DstDispDL=DatLoc(SED_y_HubPtMotion), & ! SED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + case (Module_ADsk) + + ! Hub Loads + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ADsk_y_AeroLoads), & ! ADsk%y%AeroLoads + SrcDispDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SrvD) + + call MapCustom(Mappings, Custom_SrvD_to_SED, SrcMod, DstMod) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + subroutine InitMappings_ExtInfw(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(inout) :: SrcMod, DstMod @@ -2398,10 +2537,14 @@ subroutine VarUnpackInput(ModData, Var, ValAry, T, iInput, ErrStat, ErrMsg) select case (ModData%ID) case (Module_AD) call AD_VarUnpackInput(Var, ValAry, T%AD%Input(iInput)%rotors(ModData%Ins)) + case (Module_ADsk) + call ADsk_VarUnpackInput(Var, ValAry, T%ADsk%Input(iInput)) case (Module_BD) call BD_VarUnpackInput(Var, ValAry, T%BD%Input(iInput, ModData%Ins)) case (Module_ED) call ED_VarUnpackInput(Var, ValAry, T%ED%Input(iInput)) + case (Module_SED) + call SED_VarUnpackInput(Var, ValAry, T%SED%Input(iInput)) case (Module_ExtLd) call ExtLd_VarUnpackInput(Var, ValAry, T%ExtLd%u) case (Module_ExtInfw) @@ -2447,10 +2590,14 @@ subroutine VarPackOutput(ModData, Var, ValAry, T, ErrStat, ErrMsg) select case (ModData%ID) case (Module_AD) call AD_VarPackOutput(Var, T%AD%y%rotors(ModData%Ins), ValAry) + case (Module_ADsk) + call ADsk_VarPackOutput(Var, T%ADsk%y, ValAry) case (Module_BD) call BD_VarPackOutput(Var, T%BD%y(ModData%Ins), ValAry) case (Module_ED) call ED_VarPackOutput(Var, T%ED%y, ValAry) + case (Module_SED) + call SED_VarPackOutput(Var, T%SED%y, ValAry) case (Module_ExtLd) call ExtLd_VarPackOutput(Var, T%ExtLd%y, ValAry) case (Module_ExtInfw) @@ -2751,6 +2898,20 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg T%AD%Input(iInput)%rotors(ModDst%Ins)%UserProp(:, i) = T%SrvD%y%BlAirfoilCom(i) end do +!------------------------------------------------------------------------------- +! ADsk Inputs +!------------------------------------------------------------------------------- + + case (Custom_ED_to_ADsk) + + T%ADsk%Input(iInput)%RotSpeed = T%ED%y%RotSpeed + T%ADsk%Input(iInput)%BlPitch = T%ED%y%BlPitch(1) ! ADsk only uses collective blade pitch + + case (Custom_SED_to_ADsk) + + T%ADsk%Input(iInput)%RotSpeed = T%SED%y%RotSpeed + T%ADsk%Input(iInput)%BlPitch = T%SED%y%BlPitch(1) ! ADsk only uses collective blade pitch + !------------------------------------------------------------------------------- ! ElastoDyn Inputs !------------------------------------------------------------------------------- @@ -2762,6 +2923,18 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg T%ED%Input(iInput)%BlPitchCom = T%SrvD%y%BlPitchCom T%ED%Input(iInput)%YawMom = T%SrvD%y%YawMom +!------------------------------------------------------------------------------- +! SED Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_SED) + + T%SED%Input(iInput)%GenTrq = T%SrvD%y%GenTrq + T%SED%Input(iInput)%HSSBrTrqC = T%SrvD%y%HSSBrTrqC + T%SED%Input(iInput)%BlPitchCom = T%SrvD%y%BlPitchCom + T%SED%Input(iInput)%YawPosCom = T%SrvD%y%YawPosCom + T%SED%Input(iInput)%YawRateCom = T%SrvD%y%YawRateCom + !------------------------------------------------------------------------------- ! ExtLoads Inputs !------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index f209973074..20f0e1c088 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -472,6 +472,7 @@ typedef ^ ^ SED_MiscVarType m - - - "Misc (optimization) variables not associate typedef ^ ^ SED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SED_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ SED_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -529,6 +530,7 @@ typedef ^ ^ ADsk_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ADsk_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ ADsk_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ADsk_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ ADsk_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... InflowWind data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 71fafb74ab..9646f24aa2 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -99,7 +99,8 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS modIDs = [(GlueModData(i)%ID, i=1, size(GlueModData))] ! Indices of all modules in Step 0 initialization order (SrvD inputs) - p%iModInit = [pack(modInds, ModIDs == Module_ED), & + p%iModInit = [pack(modInds, ModIDs == Module_SED), & + pack(modInds, ModIDs == Module_ED), & pack(modInds, ModIDs == Module_BD), & pack(modInds, ModIDs == Module_SD), & pack(modInds, ModIDs == Module_IfW), & @@ -112,19 +113,23 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS pack(modInds, ModIDs == Module_SD)] ! Indices of Option 1 modules - p%iModOpt1 = [pack(modInds, ModIDs == Module_ExtPtfm), & + p%iModOpt1 = [pack(modInds, ModIDs == Module_SED), & + pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK /= MHK_None), & + pack(modInds, ModIDs == Module_ExtPtfm), & pack(modInds, ModIDs == Module_HD), & pack(modInds, ModIDs == Module_MD), & pack(modInds, ModIDs == Module_Orca)] ! Indices of Option 2 modules p%iModOpt2 = [pack(modInds, ModIDs == Module_SrvD), & + pack(modInds, ModIDs == Module_SED), & pack(modInds, ModIDs == Module_ED), & pack(modInds, ModIDs == Module_BD), & pack(modInds, ModIDs == Module_SD), & pack(modInds, ModIDs == Module_IfW), & pack(modInds, ModIDs == Module_SeaSt), & - pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK == MHK_None), & + pack(modInds, ModIDs == Module_ADsk), & pack(modInds, ModIDs == Module_ExtLd), & pack(modInds, ModIDs == Module_FEAM), & pack(modInds, ModIDs == Module_IceD), & diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index a7b502015e..d5530cc609 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -128,9 +128,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE INTEGER(IntKi) :: IceDim ! dimension we're pre-allocating for number of IceDyn legs/instances INTEGER(IntKi) :: I ! generic loop counter INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: NumInput ! Number of inputs in module data input arrays - INTEGER(IntKi) :: NumInputSave ! Number of inputs in module data input saved arrays - INTEGER(IntKi) :: NumStates ! Number of states in module data state arrays + INTEGER(IntKi) :: InputAryLB ! Input array lower bound + INTEGER(IntKi) :: InputAryUB ! Input array upper bound + INTEGER(IntKi) :: StateAryLB ! States array lower bound + INTEGER(IntKi) :: StateAryUB ! States array upper bound logical :: CallStart REAL(R8Ki) :: theta(3) ! angles for hub orientation matrix for aeromaps @@ -239,15 +240,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ! Module data arrays !---------------------------------------------------------------------------- - ! Module data input arrays are interpolation order plus 1 - NumInput = p_FAST%InterpOrder + 1 - ! Input saved arrays have storage for InputArray size + linearization - NumInputSave = NumInput + p_FAST%NLinTimes + InputAryLB = InputAryUB + p_FAST%NLinTimes + + ! Module data input arrays are interpolation order plus 1 + InputAryUB = p_FAST%InterpOrder + 1 ! Module data state arrays include data at linearization times after ! STATE_CURR, STATE_PRED, STATE_SAVED_CURR, and STATE_SAVED_PRED - NumStates = NumStateTimes + p_FAST%NLinTimes + StateAryLB = 1 + StateAryUB = NumStateTimes + p_FAST%NLinTimes !---------------------------------------------------------------------------- ! Linearization @@ -261,14 +263,15 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE select case (p_FAST%CompElast) - case (Module_SED) ! initialize Simplified-ElastoDyn (must be done first) + case (Module_SED) ! Simplified-ElastoDyn - allocate(SED%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("SED%Input")) return - allocate(SED%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("SED%InputTimes")) return - allocate(SED%x (NumStates ), stat=ErrStat2); if (FailedAlloc("SED%x")) return - allocate(SED%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("SED%xd")) return - allocate(SED%z (NumStates ), stat=ErrStat2); if (FailedAlloc("SED%z")) return - allocate(SED%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("SED%OtherSt")) return + allocate(SED%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("SED%Input")) return + allocate(SED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SED%InputTimes")) return + allocate(ED%Input_Saved (InputAryLB ), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return + allocate(SED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%x")) return + allocate(SED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%xd")) return + allocate(SED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%z")) return + allocate(SED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%OtherSt")) return Init%InData_SED%Linearize = p_FAST%Linearize Init%InData_SED%InputFile = p_FAST%EDFile @@ -276,11 +279,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE CALL SED_Init( Init%InData_SED, SED%Input(1), SED%p, SED%x(STATE_CURR), SED%xd(STATE_CURR), SED%z(STATE_CURR), SED%OtherSt(STATE_CURR), & SED%y, SED%m, p_FAST%dt_module( MODULE_SED ), Init%OutData_SED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - CALL SetModuleSubstepTime(Module_SED, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return ! Add module to array of modules, return if errors occurred CALL MV_AddModule(m_Glue%ModData, Module_SED, 'SED', 1, p_FAST%dt_module(Module_SED), p_FAST%DT, & @@ -291,16 +290,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE p_FAST%ModuleInitialized(Module_SED) = .TRUE. - case (Module_ED) ! initialize ElastoDyn (must be done first) + case default ! ElastoDyn ! Allocate module data arrays - allocate(ED%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("ED%Input")) return - allocate(ED%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return - allocate(ED%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return - allocate(ED%x (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%x")) return - allocate(ED%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return - allocate(ED%z (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%z")) return - allocate(ED%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return + allocate(ED%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("ED%Input")) return + allocate(ED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return + allocate(ED%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return + allocate(ED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%x")) return + allocate(ED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return + allocate(ED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%z")) return + allocate(ED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return ! Set initialization input Init%InData_ED%Linearize = p_FAST%Linearize @@ -318,15 +317,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE CALL ED_Init(Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & ED%y, ED%m, p_FAST%dt_module(MODULE_ED), Init%OutData_ED, ErrStat2, ErrMsg2) if (Failed()) return - - CALL SetModuleSubstepTime(Module_ED, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return - + ! Add module to array of modules, return if errors occurred CALL MV_AddModule(m_Glue%ModData, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & Init%OutData_ED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return - + p_FAST%ModuleInitialized(Module_ED) = .TRUE. + NumBl = Init%OutData_ED%NumBl p_FAST%GearBox_index = Init%OutData_ED%GearBox_index @@ -340,8 +337,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE end if end if - p_FAST%ModuleInitialized(Module_ED) = .TRUE. - end select ! SED/ED @@ -360,13 +355,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE end if ! Allocate module data arrays - allocate(BD%Input (0:NumInput, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input")) return - allocate(BD%InputTimes (NumInput, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%InputTimes")) return - allocate(BD%Input_Saved (NumInputSave, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input_Saved")) return - allocate(BD%x (p_FAST%nBeams, NumStates ), stat=ErrStat2); if (FailedAlloc("BD%x")) return - allocate(BD%xd (p_FAST%nBeams, NumStates ), stat=ErrStat2); if (FailedAlloc("BD%xd")) return - allocate(BD%z (p_FAST%nBeams, NumStates ), stat=ErrStat2); if (FailedAlloc("BD%z")) return - allocate(BD%OtherSt (p_FAST%nBeams, NumStates ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return + allocate(BD%Input (0:InputAryUB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input")) return + allocate(BD%InputTimes (InputAryUB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%InputTimes")) return + allocate(BD%Input_Saved (InputAryLB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input_Saved")) return + allocate(BD%x (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%x")) return + allocate(BD%xd (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%xd")) return + allocate(BD%z (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%z")) return + allocate(BD%OtherSt (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return allocate(BD%p (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%p")) return allocate(BD%u (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%u")) return allocate(BD%y (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%y")) return @@ -434,13 +429,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(IfW%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return - allocate(IfW%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return - allocate(IfW%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("IfW%Input_Saved")) return - allocate(IfW%x (NumStates ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return - allocate(IfW%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return - allocate(IfW%z (NumStates ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return - allocate(IfW%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return + allocate(IfW%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return + allocate(IfW%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return + allocate(IfW%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("IfW%Input_Saved")) return + allocate(IfW%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return + allocate(IfW%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return + allocate(IfW%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return + allocate(IfW%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return select case(p_FAST%CompInflow) case (Module_IfW) @@ -490,8 +485,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2) if (Failed()) return - CALL SetModuleSubstepTime(Module_IfW, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS @@ -499,6 +492,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE CALL MV_AddModule(m_Glue%ModData, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & Init%OutData_IfW%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return + p_FAST%ModuleInitialized(Module_IfW) = .TRUE. IF ( p_FAST%CompServo == Module_SrvD ) THEN !assign the number of gates to ServD if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it @@ -527,8 +521,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing END IF - p_FAST%ModuleInitialized(Module_IfW) = .TRUE. - case (Module_ExtInfw) IF ( PRESENT(ExternInitData) ) THEN @@ -564,6 +556,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ! set up the data structures for integration with ExternalInflow CALL Init_ExtInfw( Init%InData_ExtInfw, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, ExtInfw, Init%OutData_ExtInfw, ErrStat2, ErrMsg2 ) if (Failed()) return + p_FAST%ModuleInitialized(Module_ExtInfw) = .TRUE. ! Add module to list of modules, return on error CALL MV_AddModule(m_Glue%ModData, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & @@ -576,9 +569,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ! Set pointer to flowfield IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtInfw%FlowField - case default + case default ! No wind + ! Set mean wind speed to zero Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi + end select ! CompInflow !---------------------------------------------------------------------------- @@ -586,13 +581,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SeaSt%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return - allocate(SeaSt%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return - allocate(SeaSt%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("SeaSt%Input_Saved")) return - allocate(SeaSt%x (NumStates ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return - allocate(SeaSt%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return - allocate(SeaSt%z (NumStates ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return - allocate(SeaSt%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return + allocate(SeaSt%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return + allocate(SeaSt%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return + allocate(SeaSt%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("SeaSt%Input_Saved")) return + allocate(SeaSt%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return + allocate(SeaSt%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return + allocate(SeaSt%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return + allocate(SeaSt%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return if ( p_FAST%CompSeaSt == Module_SeaSt ) then @@ -619,6 +614,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE CALL SeaSt_Init(Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module(MODULE_SeaSt), Init%OutData_SeaSt, ErrStat2, ErrMsg2) if (Failed()) return + p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. ! Add module to array, return on error call MV_AddModule(m_Glue%ModData, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & @@ -633,8 +629,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE p_FAST%VTK_surface%NWaveElevPts(2) = 0 endif - p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. - end if !---------------------------------------------------------------------------- @@ -646,13 +640,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE case (Module_AD, Module_ExtLd) ! Allocate module data arrays - allocate(AD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("AD%Input")) return - allocate(AD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return - allocate(AD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("AD%Input_Saved")) return - allocate(AD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%x")) return - allocate(AD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return - allocate(AD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%z")) return - allocate(AD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return + allocate(AD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("AD%Input")) return + allocate(AD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return + allocate(AD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("AD%Input_Saved")) return + allocate(AD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%x")) return + allocate(AD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return + allocate(AD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%z")) return + allocate(AD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return allocate(Init%InData_AD%rotors(1), stat=ErrStat2); if (FailedAlloc("AD%Init%InData_AD%rotors(1)")) return @@ -660,11 +654,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE if (p_FAST%CompAeroMaps) then CALL AllocAry( MeshMapData%HubOrient, 3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + if (Failed()) return theta = 0.0_R8Ki do k=1,Init%InData_AD%rotors(1)%NumBlades @@ -673,7 +663,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE end do end if - ! set initialization data for AD call AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) if (Failed()) return @@ -733,9 +722,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE if (Failed()) return p_FAST%ModuleInitialized(Module_AD) = .TRUE. - CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Loop through rotors and add module for each one do i = 1, size(Init%OutData_AD%rotors) CALL MV_AddModule(m_Glue%ModData, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & Init%OutData_AD%rotors(i)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) @@ -747,12 +735,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE case (Module_ADsk) ! Allocate module data arrays - allocate(ADsk%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("ADsk%Input")) return - allocate(ADsk%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("ADsk%InputTimes")) return - allocate(ADsk%x (NumStates ), stat=ErrStat2); if (FailedAlloc("ADsk%x")) return - allocate(ADsk%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("ADsk%xd")) return - allocate(ADsk%z (NumStates ), stat=ErrStat2); if (FailedAlloc("ADsk%z")) return - allocate(ADsk%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("ADsk%OtherSt")) return + allocate(ADsk%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%Input")) return + allocate(ADsk%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%InputTimes")) return + allocate(ADsk%Input_Saved (InputAryLB ), stat=ErrStat2); if (FailedAlloc("ADsk%Input_Saved")) return + allocate(ADsk%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%x")) return + allocate(ADsk%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%xd")) return + allocate(ADsk%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%z")) return + allocate(ADsk%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%OtherSt")) return Init%InData_ADsk%InputFile = p_FAST%AeroFile Init%InData_ADsk%RootName = p_FAST%OutFileRoot @@ -778,13 +767,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ADsk%OtherSt(STATE_CURR), ADsk%y, ADsk%m, p_FAST%dt_module( MODULE_ADsk ), Init%OutData_ADsk, ErrStat2, ErrMsg2 ) if (Failed()) return + p_FAST%ModuleInitialized(Module_ADsk) = .TRUE. + ! Add module to array, return on error call MV_AddModule(m_Glue%ModData, Module_ADsk, 'ADsk', 1, p_FAST%dt_module(Module_ADsk), p_FAST%DT, & - Init%OutData_ADsk%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + Init%OutData_ADsk%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return - p_FAST%ModuleInitialized(Module_ADsk) = .TRUE. - end select ! CompAero !---------------------------------------------------------------------------- @@ -798,6 +787,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) if (Failed()) return + p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. + ! Add module to list of modules, return on error CALL MV_AddModule(m_Glue%ModData, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & Init%OutData_ExtLd%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) @@ -806,8 +797,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE AirDens = Init%OutData_ExtLd%AirDens AD%p%FlowField => Init%OutData_ExtLd%FlowField - p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. - END IF ! No aero of any sort @@ -840,13 +829,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(HD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("HD%Input")) return - allocate(HD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("HD%InputTimes")) return - allocate(HD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("HD%Input_Saved")) return - allocate(HD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("HD%x")) return - allocate(HD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("HD%xd")) return - allocate(HD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("HD%z")) return - allocate(HD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("HD%OtherSt")) return + allocate(HD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("HD%Input")) return + allocate(HD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("HD%InputTimes")) return + allocate(HD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("HD%Input_Saved")) return + allocate(HD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%x")) return + allocate(HD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%xd")) return + allocate(HD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%z")) return + allocate(HD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%OtherSt")) return IF (p_FAST%CompHydro == Module_HD) THEN @@ -865,15 +854,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module(MODULE_HD), Init%OutData_HD, ErrStat2, ErrMsg2) if (Failed()) return - CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return + p_FAST%ModuleInitialized(Module_HD) = .TRUE. CALL MV_AddModule(m_Glue%ModData, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & Init%OutData_HD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return - p_FAST%ModuleInitialized(Module_HD) = .TRUE. - END IF ! CompHydro !---------------------------------------------------------------------------- @@ -881,22 +867,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("SD%Input")) return - allocate(SD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("SD%InputTimes")) return - allocate(SD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("SD%Input_Saved")) return - allocate(SD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("SD%x")) return - allocate(SD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("SD%xd")) return - allocate(SD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("SD%z")) return - allocate(SD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("SD%OtherSt")) return + allocate(SD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("SD%Input")) return + allocate(SD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SD%InputTimes")) return + allocate(SD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("SD%Input_Saved")) return + allocate(SD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%x")) return + allocate(SD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%xd")) return + allocate(SD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%z")) return + allocate(SD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%OtherSt")) return ! Allocate module data arrays - allocate(ExtPtfm%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input")) return - allocate(ExtPtfm%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%InputTimes")) return - allocate(ExtPtfm%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input_Saved")) return - allocate(ExtPtfm%x (NumStates ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%x")) return - allocate(ExtPtfm%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%xd")) return - allocate(ExtPtfm%z (NumStates ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%z")) return - allocate(ExtPtfm%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%OtherSt")) return + allocate(ExtPtfm%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input")) return + allocate(ExtPtfm%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%InputTimes")) return + allocate(ExtPtfm%Input_Saved(InputAryLB), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input_Saved")) return + allocate(ExtPtfm%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%x")) return + allocate(ExtPtfm%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%xd")) return + allocate(ExtPtfm%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%z")) return + allocate(ExtPtfm%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%OtherSt")) return select case (p_FAST%CompSub) @@ -918,14 +904,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), Init%OutData_SD, ErrStat2, ErrMsg2 ) if (Failed()) return - CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return + p_FAST%ModuleInitialized(Module_SD) = .TRUE. CALL MV_AddModule(m_Glue%ModData, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & Init%OutData_SD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return - p_FAST%ModuleInitialized(Module_SD) = .TRUE. case (Module_ExtPtfm) @@ -939,15 +923,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module(MODULE_ExtPtfm), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2) if (Failed()) return - CALL SetModuleSubstepTime(MODULE_ExtPtfm, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return + p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. CALL MV_AddModule(m_Glue%ModData, MODULE_ExtPtfm, 'ExtPtfm', 1, p_FAST%dt_module(MODULE_ExtPtfm), p_FAST%DT, & Init%OutData_ExtPtfm%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return - p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. - end select !---------------------------------------------------------------------------- @@ -955,40 +936,40 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(MAPp%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("MAPp%Input")) return - allocate(MAPp%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("MAPp%InputTimes")) return - allocate(MAPp%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("MAPp%Input_Saved")) return - allocate(MAPp%x (NumStates ), stat=ErrStat2); if (FailedAlloc("MAPp%x")) return - allocate(MAPp%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("MAPp%xd")) return - allocate(MAPp%z (NumStates ), stat=ErrStat2); if (FailedAlloc("MAPp%z")) return + allocate(MAPp%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%Input")) return + allocate(MAPp%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%InputTimes")) return + allocate(MAPp%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("MAPp%Input_Saved")) return + allocate(MAPp%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%x")) return + allocate(MAPp%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%xd")) return + allocate(MAPp%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%z")) return ! allocate(MAPp%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%OtherSt")) return ! Allocate module data arrays - allocate(MD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("MD%Input")) return - allocate(MD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("MD%InputTimes")) return - allocate(MD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("MD%Input_Saved")) return - allocate(MD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("MD%x")) return - allocate(MD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("MD%xd")) return - allocate(MD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("MD%z")) return - allocate(MD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("MD%OtherSt")) return + allocate(MD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("MD%Input")) return + allocate(MD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("MD%InputTimes")) return + allocate(MD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("MD%Input_Saved")) return + allocate(MD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%x")) return + allocate(MD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%xd")) return + allocate(MD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%z")) return + allocate(MD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%OtherSt")) return ! Allocate module data arrays - allocate(FEAM%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("FEAM%Input")) return - allocate(FEAM%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("FEAM%InputTimes")) return - allocate(FEAM%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("FEAM%Input_Saved")) return - allocate(FEAM%x (NumStates ), stat=ErrStat2); if (FailedAlloc("FEAM%x")) return - allocate(FEAM%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("FEAM%xd")) return - allocate(FEAM%z (NumStates ), stat=ErrStat2); if (FailedAlloc("FEAM%z")) return - allocate(FEAM%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("FEAM%OtherSt")) return + allocate(FEAM%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%Input")) return + allocate(FEAM%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%InputTimes")) return + allocate(FEAM%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("FEAM%Input_Saved")) return + allocate(FEAM%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%x")) return + allocate(FEAM%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%xd")) return + allocate(FEAM%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%z")) return + allocate(FEAM%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%OtherSt")) return ! Allocate module data arrays - allocate(Orca%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("Orca%Input")) return - allocate(Orca%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("Orca%InputTimes")) return - allocate(Orca%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("Orca%Input_Saved")) return - allocate(Orca%x (NumStates ), stat=ErrStat2); if (FailedAlloc("Orca%x")) return - allocate(Orca%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("Orca%xd")) return - allocate(Orca%z (NumStates ), stat=ErrStat2); if (FailedAlloc("Orca%z")) return - allocate(Orca%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("Orca%OtherSt")) return + allocate(Orca%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%Input")) return + allocate(Orca%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%InputTimes")) return + allocate(Orca%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("Orca%Input_Saved")) return + allocate(Orca%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%x")) return + allocate(Orca%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%xd")) return + allocate(Orca%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%z")) return + allocate(Orca%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%OtherSt")) return select case (p_FAST%CompMooring) @@ -1016,8 +997,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE if (Failed()) return p_FAST%ModuleInitialized(Module_MAP) = .TRUE. - CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return CALL MV_AddModule(m_Glue%ModData, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & Init%OutData_MAP%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) @@ -1048,8 +1027,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE if (Failed()) return p_FAST%ModuleInitialized(Module_MD) = .TRUE. - CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return CALL MV_AddModule(m_Glue%ModData, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & Init%OutData_MD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) @@ -1073,8 +1050,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE if (Failed()) return p_FAST%ModuleInitialized(Module_FEAM) = .TRUE. - CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return CALL MV_AddModule(m_Glue%ModData, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & Init%OutData_FEAM%Vars, .false., ErrStat2, ErrMsg2) @@ -1091,8 +1066,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE if (Failed()) return p_FAST%ModuleInitialized(MODULE_Orca) = .TRUE. - CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return CALL MV_AddModule(m_Glue%ModData, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & Init%OutData_Orca%Vars, .false., ErrStat2, ErrMsg2) @@ -1109,13 +1082,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !------------------------------------- ! Allocate module data arrays - allocate(IceF%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("IceF%Input")) return - allocate(IceF%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("IceF%InputTimes")) return - allocate(IceF%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("IceF%Input_Saved")) return - allocate(IceF%x (NumStates ), stat=ErrStat2); if (FailedAlloc("IceF%x")) return - allocate(IceF%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("IceF%xd")) return - allocate(IceF%z (NumStates ), stat=ErrStat2); if (FailedAlloc("IceF%z")) return - allocate(IceF%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("IceF%OtherSt")) return + allocate(IceF%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%Input")) return + allocate(IceF%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%InputTimes")) return + allocate(IceF%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("IceF%Input_Saved")) return + allocate(IceF%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%x")) return + allocate(IceF%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%xd")) return + allocate(IceF%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%z")) return + allocate(IceF%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%OtherSt")) return IF (p_FAST%CompIce == Module_IceF) THEN @@ -1129,15 +1102,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), Init%OutData_IceF, ErrStat2, ErrMsg2 ) if (Failed()) return - CALL SetModuleSubstepTime(Module_IceF, p_FAST, y_FAST, ErrStat2, ErrMsg2) - if (Failed()) return + p_FAST%ModuleInitialized(Module_IceF) = .TRUE. ! Add module to list of modules - ! CALL MV_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & - ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) - ! if (Failed()) return - - p_FAST%ModuleInitialized(Module_IceF) = .TRUE. + CALL MV_AddModule(m_Glue%ModData, Module_IceF, 'IceF', 1, p_FAST%dt_module(Module_IceF), p_FAST%DT, & + Init%OutData_IceF%Vars, .false., ErrStat2, ErrMsg2) + if (Failed()) return end if @@ -1151,17 +1121,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE IF (p_FAST%CompIce == Module_IceD) IceDim = IceD_MaxLegs ! Allocate module data arrays - allocate(IceD%Input (0:NumInput, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input")) return - allocate(IceD%InputTimes (NumInput, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%InputTimes")) return - allocate(IceD%Input_Saved (NumInputSave, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input_Saved")) return - allocate(IceD%x (IceDim, NumStates), stat=ErrStat2); if (FailedAlloc("IceD%x")) return - allocate(IceD%xd (IceDim, NumStates), stat=ErrStat2); if (FailedAlloc("IceD%xd")) return - allocate(IceD%z (IceDim, NumStates), stat=ErrStat2); if (FailedAlloc("IceD%z")) return - allocate(IceD%OtherSt (IceDim, NumStates), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return - allocate(IceD%p (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%p")) return - allocate(IceD%u (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%u")) return - allocate(IceD%y (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%y")) return - allocate(IceD%m (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%m")) return + allocate(IceD%Input (0:InputAryUB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input")) return + allocate(IceD%InputTimes (InputAryUB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%InputTimes")) return + allocate(IceD%Input_Saved (InputAryLB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input_Saved")) return + allocate(IceD%x (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%x")) return + allocate(IceD%xd (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%xd")) return + allocate(IceD%z (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%z")) return + allocate(IceD%OtherSt (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return + allocate(IceD%p (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%p")) return + allocate(IceD%u (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%u")) return + allocate(IceD%y (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%y")) return + allocate(IceD%m (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%m")) return IF (p_FAST%CompIce == Module_IceD) THEN @@ -1177,7 +1147,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE IceD%OtherSt(1,STATE_CURR), IceD%y(1), IceD%m(1), p_FAST%dt_module( MODULE_IceD ), Init%OutData_IceD, ErrStat2, ErrMsg2 ) if (Failed()) return - CALL SetModuleSubstepTime(Module_IceD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + p_FAST%ModuleInitialized(Module_IceD) = .TRUE. + + ! Add module to list of modules + CALL MV_AddModule(m_Glue%ModData, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + Init%OutData_IceD%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return ! now initialize IceD for additional legs (if necessary) @@ -1189,7 +1163,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE //TRIM(Num2LStr(p_FAST%numIceLegs))//' legs were specified.',ErrStat,ErrMsg,RoutineName) END IF - + ! Loop through Icelegs DO i=2,p_FAST%numIceLegs ! basically, we just need IceDyn to set up its meshes for inputs/outputs and possibly initial values for states Init%InData_IceD%LegNum = i @@ -1206,13 +1180,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE END IF ! Add module to list of modules - ! CALL MV_AddModule(m_Glue%Modules, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & - ! Init%OutData_IceD%Vars, ErrStat2, ErrMsg2) - ! if (Failed()) return + CALL MV_AddModule(m_Glue%ModData, Module_IceD, 'IceD', i, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + Init%OutData_IceD%Vars, .false., ErrStat2, ErrMsg2) + if (Failed()) return END DO - p_FAST%ModuleInitialized(Module_IceD) = .TRUE. - END IF !---------------------------------------------------------------------------- @@ -1220,13 +1192,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SrvD%Input (0:NumInput ), stat=ErrStat2); if (FailedAlloc("SrvD%Input")) return - allocate(SrvD%InputTimes (NumInput ), stat=ErrStat2); if (FailedAlloc("SrvD%InputTimes")) return - allocate(SrvD%Input_Saved (NumInputSave), stat=ErrStat2); if (FailedAlloc("SrvD%Input_Saved")) return - allocate(SrvD%x (NumStates ), stat=ErrStat2); if (FailedAlloc("SrvD%x")) return - allocate(SrvD%xd (NumStates ), stat=ErrStat2); if (FailedAlloc("SrvD%xd")) return - allocate(SrvD%z (NumStates ), stat=ErrStat2); if (FailedAlloc("SrvD%z")) return - allocate(SrvD%OtherSt (NumStates ), stat=ErrStat2); if (FailedAlloc("SrvD%OtherSt")) return + allocate(SrvD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%Input")) return + allocate(SrvD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%InputTimes")) return + allocate(SrvD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("SrvD%Input_Saved")) return + allocate(SrvD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%x")) return + allocate(SrvD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%xd")) return + allocate(SrvD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%z")) return + allocate(SrvD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%OtherSt")) return IF ( p_FAST%CompServo == Module_SrvD ) THEN diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 53a4631703..b9a2238600 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -467,6 +467,7 @@ MODULE FAST_Types TYPE(SED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(SED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE SED_Data ! ======================= @@ -531,6 +532,7 @@ MODULE FAST_Types TYPE(ADsk_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(ADsk_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ADsk_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(ADsk_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE AeroDisk_Data ! ======================= @@ -8139,6 +8141,22 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat if (ErrStat >= AbortErrLev) return end do end if + if (allocated(SrcSED_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcSED_DataData%Input_Saved, kind=B8Ki) + UB(1:1) = ubound(SrcSED_DataData%Input_Saved, kind=B8Ki) + if (.not. allocated(DstSED_DataData%Input_Saved)) then + allocate(DstSED_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyInput(SrcSED_DataData%Input_Saved(i1), DstSED_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcSED_DataData%InputTimes)) then LB(1:1) = lbound(SrcSED_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcSED_DataData%InputTimes, kind=B8Ki) @@ -8228,6 +8246,15 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) end do deallocate(SED_DataData%Input) end if + if (allocated(SED_DataData%Input_Saved)) then + LB(1:1) = lbound(SED_DataData%Input_Saved, kind=B8Ki) + UB(1:1) = ubound(SED_DataData%Input_Saved, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_DestroyInput(SED_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%Input_Saved) + end if if (allocated(SED_DataData%InputTimes)) then deallocate(SED_DataData%InputTimes) end if @@ -8299,6 +8326,15 @@ subroutine FAST_PackSED_Data(RF, Indata) call SED_PackInput(RF, InData%Input(i1)) end do end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) + LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) + UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) + do i1 = LB(1), UB(1) + call SED_PackInput(RF, InData%Input_Saved(i1)) + end do + end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8395,6 +8431,19 @@ subroutine FAST_UnPackSED_Data(RF, OutData) call SED_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9575,6 +9624,22 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct if (ErrStat >= AbortErrLev) return end do end if + if (allocated(SrcAeroDisk_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%Input_Saved, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDisk_DataData%Input_Saved, kind=B8Ki) + if (.not. allocated(DstAeroDisk_DataData%Input_Saved)) then + allocate(DstAeroDisk_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyInput(SrcAeroDisk_DataData%Input_Saved(i1), DstAeroDisk_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcAeroDisk_DataData%InputTimes)) then LB(1:1) = lbound(SrcAeroDisk_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcAeroDisk_DataData%InputTimes, kind=B8Ki) @@ -9664,6 +9729,15 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) end do deallocate(AeroDisk_DataData%Input) end if + if (allocated(AeroDisk_DataData%Input_Saved)) then + LB(1:1) = lbound(AeroDisk_DataData%Input_Saved, kind=B8Ki) + UB(1:1) = ubound(AeroDisk_DataData%Input_Saved, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_DestroyInput(AeroDisk_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%Input_Saved) + end if if (allocated(AeroDisk_DataData%InputTimes)) then deallocate(AeroDisk_DataData%InputTimes) end if @@ -9735,6 +9809,15 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) call ADsk_PackInput(RF, InData%Input(i1)) end do end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) + LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) + UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) + do i1 = LB(1), UB(1) + call ADsk_PackInput(RF, InData%Input_Saved(i1)) + end do + end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9831,6 +9914,19 @@ subroutine FAST_UnPackAeroDisk_Data(RF, OutData) call ADsk_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine diff --git a/modules/simple-elastodyn/src/SED.f90 b/modules/simple-elastodyn/src/SED.f90 index e1b433356a..f6043bd8bd 100644 --- a/modules/simple-elastodyn/src/SED.f90 +++ b/modules/simple-elastodyn/src/SED.f90 @@ -37,15 +37,14 @@ MODULE SED public :: SED_UpdateStates public :: SED_CalcOutput public :: SED_CalcContStateDeriv + public :: SED_JacobianPInput ! Linearization is not supported by this module, so the following routines are omitted !public :: SED_CalcConstrStateResidual !public :: SED_UpdateDiscState - !public :: SED_JacobianPInput !public :: SED_JacobianPContState !public :: SED_JacobianPDiscState !public :: SED_JacobianPConstrState - !public :: SED_GetOP CONTAINS @@ -141,6 +140,10 @@ SUBROUTINE SED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu ! Set InitOutputs call Init_InitY(ErrStat2,ErrMsg2); if (Failed()) return + ! Initialize module variables + call SED_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, .false., ErrStat2, ErrMsg2) + if (Failed()) return + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -532,6 +535,142 @@ end subroutine Init_Y END SUBROUTINE SED_Init +subroutine SED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(SED_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SED_ParameterType), intent(inout) :: p !< Parameters + type(SED_ContinuousStateType), intent(inout) :: x !< Continuous state + type(SED_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(SED_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne + + character(*), parameter :: RoutineName = 'SED_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + call MV_AddVar(Vars%x, 'GeneratorAzimuth', FieldAngularDisp, & + DL=DatLoc(SED_x_QT), iAry=DOF_Az, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Variable speed generator DOF (internal DOF index = DOF_Az), rad'], & + Active=InputFileData%GenDOF) + + call MV_AddVar(Vars%x, 'GeneratorAzimuth', FieldAngularVel, & + DL=DatLoc(SED_x_QDT), iAry=DOF_Az, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['First time derivative of Variable speed generator DOF (internal DOF index = DOF_Az), rad/s'], & + Active=InputFileData%GenDOF) + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ScaleLength = max(p%TipRad, p%TowerHt, 1.0_ReKi) + MaxThrust = 490.0_R8Ki * pi_D / 9.0_R8Ki * ScaleLength**2 + MaxTorque = 122.5_R8Ki * pi_D / 27.0_R8Ki * ScaleLength**3 + + call MV_AddMeshVar(Vars%u, "Hub", LoadFields, & + DL=DatLoc(SED_u_HubPtLoad), & + Mesh=u%HubPtLoad, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + + call MV_AddVar(Vars%u, "GenTrq", FieldScalar, & + DL=DatLoc(SED_u_GenTrq), & + Flags=VF_Linearize, & + Perturb=MaxTorque / (100.0_R8Ki*p%GBoxRatio), & + LinNames=['Generator torque, Nm']) + + call MV_AddVar(Vars%u, "BlPitchCom", FieldScalar, & + DL=DatLoc(SED_u_BlPitchCom), iAry=1, & + Num=p%NumBl, & + Flags=VF_RotFrame + VF_Linearize + VF_2PI, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Blade pitch command, rad']) + + call MV_AddVar(Vars%u, "YawPosCom", FieldScalar, & + DL=DatLoc(SED_u_YawPosCom), & + Flags=VF_Linearize, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Yaw position command, rad']) + + call MV_AddVar(Vars%u, "YawRateCom", FieldScalar, & + DL=DatLoc(SED_u_YawRateCom), & + Flags=VF_Linearize, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Yaw rate command, rad/s']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%y, 'Platform', MotionFields, & + DatLoc(SED_y_PlatformPtMesh), & + Mesh=y%PlatformPtMesh, & + Flags=VF_SmallAngle) + + call MV_AddMeshVar(Vars%y, 'Tower', MotionFields, & + DatLoc(SED_y_TowerLn2Mesh), & + Mesh=y%TowerLn2Mesh, & + Flags=ior(VF_Line, VF_SmallAngle)) + + call MV_AddMeshVar(Vars%y, 'Hub', MotionFields, & + DatLoc(SED_y_HubPtMotion), & + Mesh=y%HubPtMotion) + + do i = 1, p%NumBl + call MV_AddMeshVar(Vars%y, 'Blade root '//Num2LStr(i), MotionFields, & + DatLoc(SED_y_BladeRootMotion, i), & + Mesh=y%BladeRootMotion(i)) + end do + + call MV_AddMeshVar(Vars%y, 'Nacelle', MotionFields, & + DatLoc(SED_y_NacelleMotion), & + Mesh=y%NacelleMotion) + + call MV_AddVar(Vars%y, 'Yaw', FieldScalar, & + DatLoc(SED_y_Yaw), & + Flags=VF_2PI, & + LinNames=['Yaw, rad']) + + call MV_AddVar(Vars%y, 'YawRate', FieldScalar, & + DatLoc(SED_y_YawRate), & + LinNames=['YawRate, rad/s']) + + call MV_AddVar(Vars%y, 'HSS_Spd', FieldScalar, & + DatLoc(SED_y_HSS_Spd), & + LinNames=['HSS_Spd, rad/s']) + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call SED_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. @@ -1375,6 +1514,127 @@ logical function Failed() end function Failed END SUBROUTINE SED_CalcContStateDeriv +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. +SUBROUTINE SED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +!.................................................................................................................................. + + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(SED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(SED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(SED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(SED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(SED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(SED_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdu. + TYPE(SED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the inputs (u) [intent in to avoid deallocation] + + CHARACTER(*), PARAMETER :: RoutineName = 'SED_JacobianPInput' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, iCol + + ErrStat = ErrID_None + ErrMsg = '' + + ! Update copy of the inputs to perturb + call SED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackInput(Vars, u, m%Jac%u) + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then + + ! Allocate dYdu if not allocated + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,iCol)) + end do + end do + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu) .and. (m%Jac%Nx > 0)) then + + ! Allocate dXdu if not allocated + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdu(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) + end do + end do + end if + + if (present(dXddu)) then + if (allocated(dXddu)) deallocate(dXddu) + end if + + if (present(dZdu)) then + if (allocated(dZdu)) deallocate(dZdu) + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE SED_JacobianPInput END MODULE SED !********************************************************************************************************************************** From 10fecd575705252a4955780e678ecf40ab79675c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 15:19:44 +0000 Subject: [PATCH 248/319] Get SED working, missing mappings --- modules/nwtc-library/src/ModVar.f90 | 3 + modules/openfast-library/src/FAST_Funcs.f90 | 7 +- modules/openfast-library/src/FAST_Mapping.f90 | 115 +++++++++++- modules/openfast-library/src/FAST_ModGlue.f90 | 18 +- modules/openfast-library/src/FAST_Mods.f90 | 13 -- .../openfast-library/src/FAST_SolverTC.f90 | 18 +- modules/simple-elastodyn/src/SED.f90 | 173 +++++++++++++++--- 7 files changed, 289 insertions(+), 58 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 845046a116..cad9391bc6 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -863,6 +863,9 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, DL, Mesh, Flags, Perturbs, Active ! Loop through fields in mesh do i = 1, size(Fields) + ! Skip fields that mesh doesn't contain + if (.not. Mesh%fieldmask(Fields(i))) cycle + ! Add variable call MV_AddVar(VarAry, Name, Fields(i), & DL=DL, & diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index 2c41056c76..ca054b0afa 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -1418,7 +1418,12 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, iInput, iState, T, ErrStat T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) -! case (Module_SED) + case (Module_SED) + call SED_JacobianPContState(ModData%Vars, ThisTime, T%SED%Input(iInput), T%SED%p, & + T%SED%x(iState), T%SED%xd(iState), & + T%SED%z(iState), T%SED%OtherSt(iState), & + T%SED%y, T%SED%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) case (Module_ExtPtfm) call ExtPtfm_JacobianPContState(ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, & diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index f70696ed35..4da4faf653 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -44,17 +44,19 @@ module FAST_Mapping Custom_SrvD_to_AD = 'SrvD -> AD', & Custom_ED_to_ADsk = 'ED -> ADsk', & Custom_SED_to_ADsk = 'SED -> ADsk', & + Custom_SED_to_IfW = 'SED -> IfW', & Custom_ED_to_IfW = 'ED -> IfW', & Custom_SrvD_to_IfW = 'SrvD -> IfW', & Custom_BD_to_SrvD = 'BD -> SrvD', & Custom_ED_to_SrvD = 'ED -> SrvD', & + Custom_SED_to_SrvD = 'SED -> SrvD', & + Custom_ExtInfw_to_SrvD = 'ExtInfw -> SrvD', & + Custom_ExtLd_to_SrvD = 'ExtLd -> SrvD', & + Custom_IfW_to_SrvD = 'IfW -> SrvD', & Custom_SrvD_to_ED = 'SrvD -> ED', & Custom_SrvD_to_SED = 'SrvD -> SED', & - Custom_IfW_to_SrvD = 'IfW -> SrvD', & - Custom_ExtInfw_to_SrvD = 'ExtInfw -> SrvD', & Custom_SrvD_to_SD = 'SrvD -> SD', & - Custom_SrvD_to_MD = 'SrvD -> MD', & - Custom_ExtLd_to_SrvD = 'ExtLd -> SrvD' + Custom_SrvD_to_MD = 'SrvD -> MD' contains @@ -564,6 +566,49 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) Active=NotCompAeroMaps) if (Failed()) return + + case (Module_SED) + + ! Loop through blade root motions + do i = 1, size(Turbine%SED%y%BladeRootMotion) + + ! Blade root motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_BladeRootMotion, i), & ! SED%y%BladeRootMotion(i) + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Blade motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_BladeRootMotion, i), & ! SED%y%BladeRootMotion(i) + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Hub motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_HubPtMotion), & ! SED%y%HubPtMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Tower motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_TowerLn2Mesh), & ! SED%y%TowerLn2Mesh + DstMod=DstMod, DstDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Nacelle motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_NacelleMotion), & ! SED%y%NacelleMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + case (Module_IfW) call MapVariable(Mappings, & @@ -1095,8 +1140,8 @@ subroutine InitMappings_SED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ADsk_y_AeroLoads), & ! ADsk%y%AeroLoads SrcDispDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion - DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad - DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstDL=DatLoc(SED_u_HubPtLoad), & ! SED%u%HubPtLoad + DstDispDL=DatLoc(SED_y_HubPtMotion), & ! SED%y%HubPtMotion ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return @@ -1492,6 +1537,8 @@ subroutine InitMappings_IfW(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) ErrMsg = '' select case (SrcMod%ID) + case (Module_SED) + call MapCustom(Mappings, Custom_SED_to_IfW, SrcMod, DstMod) case (Module_ED) call MapCustom(Mappings, Custom_ED_to_IfW, SrcMod, DstMod) case (Module_SrvD) @@ -1839,6 +1886,10 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return end do + case (Module_SED) + + call MapCustom(Mappings, Custom_SED_to_SrvD, SrcMod=SrcMod, DstMod=DstMod) + case (Module_IfW) call MapCustom(Mappings, Custom_IfW_to_SrvD, SrcMod=SrcMod, DstMod=DstMod) @@ -2965,6 +3016,18 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg T%IfW%Input(iInput)%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) T%IfW%Input(iInput)%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) + case (Custom_SED_to_IfW) + + ! This section should be refactored so that IfW uses a hub point mesh + T%IfW%Input(iInput)%HubPosition = T%SED%y%HubPtMotion%Position(:, 1) + & + T%SED%y%HubPtMotion%TranslationDisp(:, 1) + T%IfW%Input(iInput)%HubOrientation = T%SED%y%HubPtMotion%Orientation(:, :, 1) + + ! Set Lidar position directly from hub motion mesh + T%IfW%Input(iInput)%lidar%HubDisplacementX = T%SED%y%HubPtMotion%TranslationDisp(1, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementY = T%SED%y%HubPtMotion%TranslationDisp(2, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementZ = T%SED%y%HubPtMotion%TranslationDisp(3, 1) + case (Custom_SrvD_to_IfW) !------------------------------------------------------------------------------- @@ -3039,6 +3102,46 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg T%SrvD%Input(iInput)%LSShftFys = T%ED%y%LSShftFys T%SrvD%Input(iInput)%LSShftFzs = T%ED%y%LSShftFzs + case (Custom_SED_to_SrvD) + + ! ServoDyn inputs from combination of InflowWind and ElastoDyn + T%SrvD%Input(iInput)%YawAngle = T%SED%y%Yaw !nacelle yaw (platform rigid) + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + ! ServoDyn inputs from Simplified-ElastoDyn + T%SrvD%Input(iInput)%Yaw = T%SED%y%Yaw !nacelle yaw + T%SrvD%Input(iInput)%YawRate = T%SED%y%YawRate + T%SrvD%Input(iInput)%LSS_Spd = T%SED%y%RotSpeed + T%SrvD%Input(iInput)%HSS_Spd = T%SED%y%HSS_Spd + T%SrvD%Input(iInput)%RotSpeed = T%SED%y%RotSpeed + T%SrvD%Input(iInput)%BlPitch = T%SED%y%BlPitch + + ! root moments + T%SrvD%Input(iInput)%RootMxc = 0.0_ReKi ! y_ED%RootMxc ! fixed-size arrays: always size 3 + T%SrvD%Input(iInput)%RootMyc = 0.0_ReKi ! y_ED%RootMyc ! fixed-size arrays: always size 3 + + T%SrvD%Input(iInput)%YawBrTAxp = 0.0_ReKi ! y_ED%YawBrTAxp + T%SrvD%Input(iInput)%YawBrTAyp = 0.0_ReKi ! y_ED%YawBrTAyp + T%SrvD%Input(iInput)%LSSTipPxa = T%SED%y%LSSTipPxa + + T%SrvD%Input(iInput)%LSSTipMxa = T%SED%y%RotTrq + T%SrvD%Input(iInput)%LSSTipMya = 0.0_ReKi ! y_ED%LSSTipMya + T%SrvD%Input(iInput)%LSSTipMza = 0.0_ReKi ! y_ED%LSSTipMza + T%SrvD%Input(iInput)%LSSTipMys = 0.0_ReKi ! y_ED%LSSTipMys + T%SrvD%Input(iInput)%LSSTipMzs = 0.0_ReKi ! y_ED%LSSTipMzs + + T%SrvD%Input(iInput)%YawBrMyn = 0.0_ReKi ! y_ED%YawBrMyn + T%SrvD%Input(iInput)%YawBrMzn = 0.0_ReKi ! y_ED%YawBrMzn + T%SrvD%Input(iInput)%NcIMURAxs = 0.0_ReKi ! y_ED%NcIMURAxs + T%SrvD%Input(iInput)%NcIMURAys = 0.0_ReKi ! y_ED%NcIMURAys + T%SrvD%Input(iInput)%NcIMURAzs = 0.0_ReKi ! y_ED%NcIMURAzs + + T%SrvD%Input(iInput)%RotPwr = T%SED%y%RotPwr + + T%SrvD%Input(iInput)%LSShftFxa = 0.0_ReKi ! y_ED%LSShftFxa + T%SrvD%Input(iInput)%LSShftFys = 0.0_ReKi ! y_ED%LSShftFys + T%SrvD%Input(iInput)%LSShftFzs = 0.0_ReKi ! y_ED%LSShftFzs + case (Custom_IfW_to_SrvD) T%SrvD%Input(iInput)%WindDir = atan2(T%IfW%y%HubVel(2), T%IfW%y%HubVel(1)) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index e9ee12bdee..5f81d9c9c9 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -472,10 +472,16 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) modIDs = [(m%ModData(i)%ID, i=1, size(m%ModData))] ! Establish module index order for linearization - allocate (p%Lin%iMod(0)) - do i = 1, size(LinMods) - p%Lin%iMod = [p%Lin%iMod, pack(modIdx, ModIDs == LinMods(i))] - end do + p%Lin%iMod = [pack(modIdx, ModIDs == Module_IfW), & + pack(modIdx, ModIDs == Module_SeaSt), & + pack(modIdx, ModIDs == Module_SrvD), & + pack(modIdx, ModIDs == Module_ED), & + pack(modIdx, ModIDs == Module_BD), & + pack(modIdx, ModIDs == Module_AD), & + pack(modIdx, ModIDs == Module_HD), & + pack(modIdx, ModIDs == Module_SD), & + pack(modIdx, ModIDs == Module_MAP), & + pack(modIdx, ModIDs == Module_MD)] ! Loop through modules, if module is not in index, return with error if (p_FAST%Linearize) then @@ -542,8 +548,8 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) ! Glue Module !---------------------------------------------------------------------------- - ! LinFlags = VF_Linearize + VF_Mapping - LinFlags = VF_None + LinFlags = VF_Linearize + VF_Mapping + ! LinFlags = VF_None call Glue_CombineModules(m%ModGlue, m%ModData, m%Mappings, p%Lin%iMod, LinFlags, & p_FAST%Linearize, ErrStat2, ErrMsg2, Name="Lin") if (Failed()) return diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 5567963d7a..62c9b8697b 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -75,19 +75,6 @@ MODULE FAST_ModTypes LOGICAL, PARAMETER :: BD_Solve_Option1 = .TRUE. - !< Tight coupling module IDs - integer(IntKi), parameter :: TC_Modules(*) = & - [Module_ED, Module_BD, Module_SD] - - !< Option 1 module IDs - integer(IntKi), parameter :: O1_Modules(*) = & - [Module_ExtPtfm, Module_HD, Module_MD, Module_Orca] - - !< Linearization module ID array (order determines Jacobian layout) - integer(IntKi), parameter :: LinMods(*) = & - [Module_IfW, Module_SeaSt, Module_SrvD, Module_ED, Module_BD, Module_AD, & - Module_HD, Module_SD, Module_MAP, Module_MD] - END MODULE FAST_ModTypes !======================================================================= diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 9646f24aa2..cc7d4e6b16 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -23,7 +23,7 @@ module FAST_SolverTC logical, parameter :: DebugSolver = .false. integer(IntKi) :: DebugUn = -1 character(*), parameter :: DebugFile = 'solver.dbg' -logical, parameter :: DebugJacobian = .false. +logical, parameter :: DebugJacobian = .true. integer(IntKi) :: MatrixUn = -1 contains @@ -260,10 +260,10 @@ subroutine SetVarSolveFlags() DstMod => GlueModData(GlueModMaps(j)%iModDst)) ! Determine if source and destination modules are in tight coupling or Option 1 - SrcModTC = any(SrcMod%ID == TC_Modules) - SrcModO1 = any(SrcMod%ID == O1_Modules) - DstModTC = any(DstMod%ID == TC_Modules) - DstModO1 = any(DstMod%ID == O1_Modules) + SrcModTC = any(SrcMod%iMod == p%iModTC) + SrcModO1 = any(SrcMod%iMod == p%iModOpt1) + DstModTC = any(DstMod%iMod == p%iModTC) + DstModO1 = any(DstMod%iMod == p%iModOpt1) ! Select based on mapping type select case (Mapping%MapType) @@ -320,7 +320,7 @@ subroutine SetVarSolveFlags() if (DstModTC .or. DstModO1) then - ! Add flag for destination loads + ! Add flag to destination loads do i = 1, size(DstMod%Vars%u) associate (Var => DstMod%Vars%u(i)) if (MV_EqualDL(Mapping%DstDL, Var%DL)) then @@ -329,7 +329,7 @@ subroutine SetVarSolveFlags() end associate end do - ! Add flag to destination displacements for dUdy + ! Add flag to destination displacements and orientations for dUdy do i = 1, size(DstMod%Vars%y) associate (Var => DstMod%Vars%y(i)) if (MV_EqualDL(Mapping%DstDispDL, Var%DL)) then @@ -343,7 +343,7 @@ subroutine SetVarSolveFlags() if ((SrcModTC .or. SrcModO1)) then - ! Add flag for source loads + ! Add flag to source loads do i = 1, size(SrcMod%Vars%y) associate (Var => SrcMod%Vars%y(i)) if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then @@ -352,7 +352,7 @@ subroutine SetVarSolveFlags() end associate end do - ! Add flag for source translation displacement for dUdu + ! Add flag to source translation displacement for dUdu do i = 1, size(SrcMod%Vars%u) associate (Var => SrcMod%Vars%u(i)) if (MV_EqualDL(Mapping%SrcDispDL, Var%DL)) then diff --git a/modules/simple-elastodyn/src/SED.f90 b/modules/simple-elastodyn/src/SED.f90 index f6043bd8bd..a628f3b4f0 100644 --- a/modules/simple-elastodyn/src/SED.f90 +++ b/modules/simple-elastodyn/src/SED.f90 @@ -38,11 +38,11 @@ MODULE SED public :: SED_CalcOutput public :: SED_CalcContStateDeriv public :: SED_JacobianPInput - + public :: SED_JacobianPContState + ! Linearization is not supported by this module, so the following routines are omitted !public :: SED_CalcConstrStateResidual !public :: SED_UpdateDiscState - !public :: SED_JacobianPContState !public :: SED_JacobianPDiscState !public :: SED_JacobianPConstrState @@ -536,13 +536,13 @@ end subroutine Init_Y END SUBROUTINE SED_Init subroutine SED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) - type(SED_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined - type(SED_ParameterType), intent(inout) :: p !< Parameters - type(SED_ContinuousStateType), intent(inout) :: x !< Continuous state - type(SED_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; - type(SED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SED_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SED_ParameterType), intent(inout) :: p !< Parameters + type(SED_ContinuousStateType), intent(inout) :: x !< Continuous state + type(SED_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) type(ModVarsType), intent(inout) :: Vars !< Module variables - type(SED_InputFile), intent(in) :: InputFileData !< Input file data + type(SED_InputFile), intent(in) :: InputFileData !< Input file data logical, intent(in) :: Linearize !< Flag to initialize linearization variables integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne @@ -565,14 +565,14 @@ subroutine SED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Variable speed generator DOF (internal DOF index = DOF_Az), rad'], & - Active=InputFileData%GenDOF) + Active=p%GenDOF) call MV_AddVar(Vars%x, 'GeneratorAzimuth', FieldAngularVel, & DL=DatLoc(SED_x_QDT), iAry=DOF_Az, & Flags=VF_DerivOrder2, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['First time derivative of Variable speed generator DOF (internal DOF index = DOF_Az), rad/s'], & - Active=InputFileData%GenDOF) + Active=p%GenDOF) !---------------------------------------------------------------------------- ! Input variables @@ -599,7 +599,7 @@ subroutine SED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, Num=p%NumBl, & Flags=VF_RotFrame + VF_Linearize + VF_2PI, & Perturb=2.0_R8Ki * D2R_D, & - LinNames=['Blade pitch command, rad']) + LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) call MV_AddVar(Vars%u, "YawPosCom", FieldScalar, & DL=DatLoc(SED_u_YawPosCom), & @@ -617,6 +617,10 @@ subroutine SED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ! Output variables !---------------------------------------------------------------------------- + call MV_AddMeshVar(Vars%y, 'Hub', MotionFields, & + DatLoc(SED_y_HubPtMotion), & + Mesh=y%HubPtMotion) + call MV_AddMeshVar(Vars%y, 'Platform', MotionFields, & DatLoc(SED_y_PlatformPtMesh), & Mesh=y%PlatformPtMesh, & @@ -627,10 +631,6 @@ subroutine SED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, Mesh=y%TowerLn2Mesh, & Flags=ior(VF_Line, VF_SmallAngle)) - call MV_AddMeshVar(Vars%y, 'Hub', MotionFields, & - DatLoc(SED_y_HubPtMotion), & - Mesh=y%HubPtMotion) - do i = 1, p%NumBl call MV_AddMeshVar(Vars%y, 'Blade root '//Num2LStr(i), MotionFields, & DatLoc(SED_y_BladeRootMotion, i), & @@ -641,6 +641,10 @@ subroutine SED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, DatLoc(SED_y_NacelleMotion), & Mesh=y%NacelleMotion) + !-------------------- + ! Non-mesh outputs + !-------------------- + call MV_AddVar(Vars%y, 'Yaw', FieldScalar, & DatLoc(SED_y_Yaw), & Flags=VF_2PI, & @@ -1521,17 +1525,17 @@ SUBROUTINE SED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat type(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SED_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SED_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(SED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(SED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(SED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(SED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(SED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(SED_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); !! Output fields are not used by this routine, but type is !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. - TYPE(SED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(SED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect to the inputs (u) [intent in to avoid deallocation] @@ -1636,5 +1640,128 @@ logical function Failed() end function END SUBROUTINE SED_JacobianPInput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. +SUBROUTINE SED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(SED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(SED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(SED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(SED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(SED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(SED_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdu. + TYPE(SED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) [intent in to avoid deallocation] + + CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j, iCol + + ErrStat = ErrID_None + ErrMsg = '' + + ! Copy state values + call SED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, x, m%Jac%x) + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then + + ! Allocate dYdx if not allocated + if (.not. allocated(dYdx)) then + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through state variables + do i = 1, size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,iCol)) + end do + end do + + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx) .and. (m%Jac%Nx > 0)) then + + ! Allocate dXdx if not allocated + if (.not. allocated(dXdx)) then + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through state variables + do i = 1, size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) + end do + end do + end if + + if (present(dXddx)) then + if (allocated(dXddx)) deallocate(dXddx) + end if + + if (present(dZdx)) then + if (allocated(dZdx)) deallocate(dZdx) + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE SED_JacobianPContState + END MODULE SED !********************************************************************************************************************************** From 6156ee169bd8143717fa98dedab0719c8e8a23fc Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 15:20:06 +0000 Subject: [PATCH 249/319] Copy .outb file when doing linear regression test --- reg_tests/executeOpenfastLinearRegressionCase.py | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 3b0e32572b..0c40a77c9d 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -39,7 +39,7 @@ # from weio.fast_linearization_file import FASTLinearizationFile ##### Helper functions -excludeExt=['.out','.outb','.ech','.yaml','.sum','.log','.md'] +excludeExt=['.ech','.yaml','.sum','.log','.md'] def file_line_count(filename): file_handle = open(filename, 'r') @@ -164,7 +164,8 @@ def indent(msg, sindent='\t'): # # Copying the actual test directory # if not os.path.isdir(testBuildDirectory): -rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, renameExtDict={'.lin':'.ref_lin', '.out': '.ref.out', '.outb': '.ref.outb'}) +rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.lin':'.ref_lin', '.out': '.ref.out', '.outb': '.ref.outb'}) ### Run openfast on the test case if not noExec: From 345db2ee88cc230b3cc38812e002884faf628efe Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 16:39:47 +0000 Subject: [PATCH 250/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 0bfa9e42ea..358508776e 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 0bfa9e42ea56a2a54e4c624ac436a3c1e561e3fc +Subproject commit 358508776e5048d4b50790508dde794101efa5d1 From 8205fcecd0d1eaddccc08d5fdd34c69e1da4f8b5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 16:56:05 +0000 Subject: [PATCH 251/319] SubDyn: fix single precision build --- modules/subdyn/src/SubDyn.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 6fc7088642..bfd4907d09 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -3167,7 +3167,7 @@ SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic) real(ReKi), dimension(3) :: rIP0 ! Vector from TP to Node (undeflected) real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global coordinates - real(ReKi), dimension(3,3) :: DCM + real(R8Ki), dimension(3,3) :: DCM INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None ! --- Convert inputs to FEM DOFs and convenient 6-vector storage From 7257fd4b138a9f6bec409715d61abed5355acee1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 18:22:14 +0000 Subject: [PATCH 252/319] FAST_SolverTC: Disable AD in Option 1 --- modules/openfast-library/src/FAST_SolverTC.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index cc7d4e6b16..2e7d5d6d6d 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -114,7 +114,7 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS ! Indices of Option 1 modules p%iModOpt1 = [pack(modInds, ModIDs == Module_SED), & - pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK /= MHK_None), & + ! TODO: pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK /= MHK_None), & pack(modInds, ModIDs == Module_ExtPtfm), & pack(modInds, ModIDs == Module_HD), & pack(modInds, ModIDs == Module_MD), & @@ -128,7 +128,8 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS pack(modInds, ModIDs == Module_SD), & pack(modInds, ModIDs == Module_IfW), & pack(modInds, ModIDs == Module_SeaSt), & - pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK == MHK_None), & + ! TODO: pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK == MHK_None), & + pack(modInds, ModIDs == Module_AD), & pack(modInds, ModIDs == Module_ADsk), & pack(modInds, ModIDs == Module_ExtLd), & pack(modInds, ModIDs == Module_FEAM), & From 99390be406cd8b8d99012e8de4ccfed249d6f313 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 18:22:35 +0000 Subject: [PATCH 253/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 358508776e..b818fdbfef 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 358508776e5048d4b50790508dde794101efa5d1 +Subproject commit b818fdbfef0e411037d580ba199b09840b2ca1ea From f68f85f492573d5612867add66f0e2c1b2e89b62 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 18:30:17 +0000 Subject: [PATCH 254/319] FAST_SolverTC: disable Jacobian debug output --- modules/openfast-library/src/FAST_SolverTC.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 2e7d5d6d6d..37989505f4 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -23,7 +23,7 @@ module FAST_SolverTC logical, parameter :: DebugSolver = .false. integer(IntKi) :: DebugUn = -1 character(*), parameter :: DebugFile = 'solver.dbg' -logical, parameter :: DebugJacobian = .true. +logical, parameter :: DebugJacobian = .false. integer(IntKi) :: MatrixUn = -1 contains From 6d50fd404cee9394d0504e5a9cc334c445f49c39 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 18:32:29 +0000 Subject: [PATCH 255/319] Add MHK floating test case --- reg_tests/CTestList.cmake | 2 +- reg_tests/r-test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index be568b57e6..55a22a8eb1 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -383,7 +383,7 @@ of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfas of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("5MW_OC3Spar_Linear" "" "openfast;linear;map;hydrodyn") of_regression_linear("5MW_OC3Mnpl_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") -# of_regression_linear("MHK_RM1_Floating_Linear" "" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") +of_regression_linear("MHK_RM1_Floating_Linear" "" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") # FAST Farm regression tests if(BUILD_FASTFARM) diff --git a/reg_tests/r-test b/reg_tests/r-test index b818fdbfef..755164294b 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit b818fdbfef0e411037d580ba199b09840b2ca1ea +Subproject commit 755164294b24f1f840e934d011b04ff09f2c1907 From 4460bef42f00597b1f7a2e7b468ff8773e54e517 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 19:04:29 +0000 Subject: [PATCH 256/319] FAST_Subs: fix bug in InputAryLB calc --- modules/openfast-library/src/FAST_Subs.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index d5530cc609..c05ab52bb8 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -240,12 +240,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ! Module data arrays !---------------------------------------------------------------------------- - ! Input saved arrays have storage for InputArray size + linearization - InputAryLB = InputAryUB + p_FAST%NLinTimes - ! Module data input arrays are interpolation order plus 1 InputAryUB = p_FAST%InterpOrder + 1 + ! Input saved arrays have storage for InputArray size + linearization + InputAryLB = InputAryUB + p_FAST%NLinTimes + ! Module data state arrays include data at linearization times after ! STATE_CURR, STATE_PRED, STATE_SAVED_CURR, and STATE_SAVED_PRED StateAryLB = 1 From 796423c56c9c8bef2578855d8d821a034bdb19d9 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 19:05:01 +0000 Subject: [PATCH 257/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 755164294b..7f1a1d6c6a 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 755164294b24f1f840e934d011b04ff09f2c1907 +Subproject commit 7f1a1d6c6afa7c3cbb6ff9c117ceb23e45c735ad From 7f85499a9a2ac0e38c1c403aff7eb902f86a537a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 21:19:14 +0000 Subject: [PATCH 258/319] HydroDyn: fix output of WAMIT%Conv_Rdtn%RdtnKrnl --- modules/hydrodyn/src/HydroDyn.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 922bc7ed50..d674b2180b 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -639,13 +639,13 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Write the data DO I = 0,p%WAMIT(j)%Conv_Rdtn%NStepRdtn-1 WRITE( InputFileData%UnSum, '(1X,I10,2X,E12.5,21(2X,ES16.5))' ) I, I*p%WAMIT(j)%Conv_Rdtn%RdtnDT, & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,1), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,2), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,3), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,4), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,6), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,2), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,3), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,4), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,6), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,3,3), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,3,4), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,3,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,3,6), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,4,4), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,4,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,4,6), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,5,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,5,6), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,6,6) + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,1,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,2,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,3,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,4,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,6,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,2,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,3,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,4,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,6,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(3,3,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(3,4,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(3,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(3,6,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(4,4,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(4,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(4,6,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(5,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(5,6,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(6,6,I) END DO end do end if From b5394f4cdee5eb93af96b995cb0d5d2d4228f3cd Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 21:19:58 +0000 Subject: [PATCH 259/319] FAST_SolverTC: Enable switching of AeroDyn between Opt1 and Opt2 if MHK enabled --- modules/openfast-library/src/FAST_SolverTC.f90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index 37989505f4..c39bdb92bb 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -49,15 +49,12 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS !---------------------------------------------------------------------------- ! Generalized alpha damping coefficient - ! TODO: read from input file p%RhoInf = p_FAST%RhoInf ! Max number of convergence iterations - ! TODO: read from input file p%MaxConvIter = p_FAST%MaxConvIter ! Convergence tolerance - ! TODO: read from input file p%ConvTol = p_FAST%ConvTol ! Solver time step @@ -114,7 +111,7 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS ! Indices of Option 1 modules p%iModOpt1 = [pack(modInds, ModIDs == Module_SED), & - ! TODO: pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK /= MHK_None), & + pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK /= MHK_None), & pack(modInds, ModIDs == Module_ExtPtfm), & pack(modInds, ModIDs == Module_HD), & pack(modInds, ModIDs == Module_MD), & @@ -128,8 +125,7 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS pack(modInds, ModIDs == Module_SD), & pack(modInds, ModIDs == Module_IfW), & pack(modInds, ModIDs == Module_SeaSt), & - ! TODO: pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK == MHK_None), & - pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK == MHK_None), & pack(modInds, ModIDs == Module_ADsk), & pack(modInds, ModIDs == Module_ExtLd), & pack(modInds, ModIDs == Module_FEAM), & From 94c6bcff9a0897602e16605ca6fd147566433745 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 21:21:05 +0000 Subject: [PATCH 260/319] AeroDyn: disable first tower node depth check in RotCalcBuoyantLoads because Jacobian perturbations would make it fail. Clamp value instead. Only for fixed bottom cases --- modules/aerodyn/src/AeroDyn.f90 | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 86bb790765..9cf87c39bf 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -2455,17 +2455,30 @@ subroutine RotCalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) ! Tower if ( p%NumTwrNds > 0 ) then - do j = 1,p%NumTwrNds ! loop through all nodes - ! Check that tower nodes do not go beneath the seabed or pierce the free surface - if ( u%TowerMotion%Position(3,j) + u%TowerMotion%TranslationDisp(3,j) >= p%MSL2SWL .OR. u%TowerMotion%Position(3,j) + u%TowerMotion%TranslationDisp(3,j) < -p%WtrDpth ) & + ! loop through all nodes + do j = 1, p%NumTwrNds + + ! Skip check for first node if this is a fixed bottom tower + if (j == 1 .and. p%MHK == MHK_FixedBottom) cycle + + ! Check that tower nodes do not go beneath the seabed or pierce the free surface + if ( u%TowerMotion%Position(3,j) + u%TowerMotion%TranslationDisp(3,j) >= p%MSL2SWL .OR. & + u%TowerMotion%Position(3,j) + u%TowerMotion%TranslationDisp(3,j) < -p%WtrDpth ) then call SetErrStat( ErrID_Fatal, 'The tower cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'CalcBuoyantLoads' ) if ( ErrStat >= AbortErrLev ) return + end if end do do j = 1,p%NumTwrNds - 1 ! loop through all nodes, except the last ! Global position of tower node TwrtmpPos = u%TowerMotion%Position(:,j) + u%TowerMotion%TranslationDisp(:,j) - (/ 0.0_ReKi, 0.0_ReKi, p%MSL2SWL /) TwrtmpPosplus = u%TowerMotion%Position(:,j+1) + u%TowerMotion%TranslationDisp(:,j+1) - (/ 0.0_ReKi, 0.0_ReKi, p%MSL2SWL /) + + ! If base node on fixed bottom tower is below the water depth (during Jacobian perturbations), + ! clamp it to the water depth + if ((j == 1) .and. (p%MHK == MHK_FixedBottom) .and. (TwrtmpPos(3) < -p%WtrDpth)) then + TwrtmpPos = -p%WtrDpth + end if ! Heading and inclination angles of tower element TwrheadAng = atan2( TwrtmpPosplus(2) - TwrtmpPos(2), TwrtmpPosplus(1) - TwrtmpPos(1) ) @@ -5645,10 +5658,14 @@ subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, character(1), parameter :: UVW(3) = ['U','V','W'] real(R8Ki) :: Perturb, PerturbTower, PerturbBlade(MaxBl) integer(IntKi) :: i, j, n, state, Flags + logical :: LinearizeLoc ErrStat = ErrID_None ErrMsg = "" + ! Combine linearization flags + LinearizeLoc = Linearize .or. CompAeroMaps .or. (p%MHK /= MHK_None) + ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) allocate(p%Vars, stat=ErrStat2) @@ -5864,9 +5881,9 @@ subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, ! Initialize Variables and Linearization data !---------------------------------------------------------------------------- - call MV_InitVarsJac(p%Vars, m%Jac, Linearize .or. CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return + call MV_InitVarsJac(p%Vars, m%Jac, LinearizeLoc, ErrStat2, ErrMsg2); if (Failed()) return - if (Linearize .or. CompAeroMaps) then + if (LinearizeLoc) then call AD_CopyRotContinuousStateType(x, m%x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotContinuousStateType(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return call AD_CopyRotContinuousStateType(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return From d977fb7e8fb85865fbdde1ed8b14c124b2f746a5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 21:21:34 +0000 Subject: [PATCH 261/319] CTestList: Add highpass filter for MHK_RM1_Floating_Linear case --- reg_tests/CTestList.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 55a22a8eb1..a081067b6b 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -383,7 +383,7 @@ of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfas of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("5MW_OC3Spar_Linear" "" "openfast;linear;map;hydrodyn") of_regression_linear("5MW_OC3Mnpl_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") -of_regression_linear("MHK_RM1_Floating_Linear" "" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") +of_regression_linear("MHK_RM1_Floating_Linear" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") # FAST Farm regression tests if(BUILD_FASTFARM) From c55c291a447747a39c94560cecfd22d36db7c590 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 21:22:00 +0000 Subject: [PATCH 262/319] Print more failed errors for linearization regression tests --- reg_tests/executeOpenfastLinearRegressionCase.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 0c40a77c9d..8ac8928ffb 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -433,7 +433,7 @@ def freqFileClose(file_freq_ref,file_freq_new): ErrorsLoc, ElemErrorsLoc = compareLin(f,ff1,ff2) Errors += ErrorsLoc if len(ElemErrorsLoc)>0: - Errors += ElemErrorsLoc[:3] # Just a couple of them + Errors += ElemErrorsLoc[:5] # Just a couple of them freqFileClose(ff1,ff2) From 348921dc6c247c8383c8841b7a155c7010803fce Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 13 Sep 2024 21:26:14 +0000 Subject: [PATCH 263/319] CTestList: Disable MHK_RM1_Floating_Linear and update r-test pointer --- reg_tests/CTestList.cmake | 2 +- reg_tests/r-test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index a081067b6b..3ca39ddba9 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -383,7 +383,7 @@ of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfas of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("5MW_OC3Spar_Linear" "" "openfast;linear;map;hydrodyn") of_regression_linear("5MW_OC3Mnpl_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") -of_regression_linear("MHK_RM1_Floating_Linear" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") +# of_regression_linear("MHK_RM1_Floating_Linear" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") # FAST Farm regression tests if(BUILD_FASTFARM) diff --git a/reg_tests/r-test b/reg_tests/r-test index 7f1a1d6c6a..e48e4ab7eb 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 7f1a1d6c6afa7c3cbb6ff9c117ceb23e45c735ad +Subproject commit e48e4ab7eb500ccb34bef0385f6ee7e6d3a85542 From 1d5b0d1a1544560dcb39aa475802681337394fab Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 14 Sep 2024 17:56:45 +0000 Subject: [PATCH 264/319] ExtLoads: update to match dev behavior --- glue-codes/openfast-cpp/src/FAST_Prog.cpp | 4 - modules/extloads/src/ExtLoads.f90 | 20 ----- modules/extloads/src/ExtLoads_Registry.txt | 3 - modules/extloads/src/ExtLoads_Types.f90 | 80 ----------------- .../src/Registry_NWTC_Library.txt | 85 +++++++++---------- modules/openfast-library/src/FAST_Subs.f90 | 5 +- modules/servodyn/src/ServoDyn_Types.f90 | 66 ++++++-------- 7 files changed, 69 insertions(+), 194 deletions(-) diff --git a/glue-codes/openfast-cpp/src/FAST_Prog.cpp b/glue-codes/openfast-cpp/src/FAST_Prog.cpp index 1143313b3e..cb35300394 100644 --- a/glue-codes/openfast-cpp/src/FAST_Prog.cpp +++ b/glue-codes/openfast-cpp/src/FAST_Prog.cpp @@ -84,10 +84,6 @@ void readTurbineData(int iTurb, fast::fastInputs & fi, YAML::Node turbNode) { get_if_present(turbNode, "az_blend_mean", fi.globTurbineData[iTurb].azBlendMean, 20*360.0*M_PI/180.0); //20 revs get_if_present(turbNode, "az_blend_delta", fi.globTurbineData[iTurb].azBlendDelta, 3.0*360.0*M_PI/180.0); // 3 rev - get_required(turbNode, "vel_mean", fi.globTurbineData[iTurb].velMean); - get_required(turbNode, "wind_dir", fi.globTurbineData[iTurb].windDir); - get_required(turbNode, "z_ref", fi.globTurbineData[iTurb].zRef); - get_required(turbNode, "shear_exp", fi.globTurbineData[iTurb].shearExp); } diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index 00ca10d541..bcd5c21d22 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -26,9 +26,6 @@ module ExtLoads use NWTC_Library use ExtLoads_Types - use IfW_FlowField - use InflowWind_IO_Types - use InflowWind_IO implicit none @@ -111,23 +108,6 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM m%az = 0.0 m%phi_cfd = 0.0 - - ! Allocate new flow field structure (deallocate first if associated) - if (associated(m%FlowField)) deallocate(m%FlowField) - allocate(m%FlowField, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating m%FlowField', ErrStat, ErrMsg, RoutineName) - return - end if - - ! Initialize stead flow field - call IfW_SteadyFlowField_Init(m%FlowField, p%z_ref, p%vel_mean, p%shear_exp, ErrStat2, ErrMsg2, & - AngleH=p%wind_dir*D2R) - if (Failed()) return - - - ! Set pointer to flow field in InitOut - InitOut%FlowField => m%FlowField !---------------------------------------------------------------------------- ! Initialize outputs diff --git a/modules/extloads/src/ExtLoads_Registry.txt b/modules/extloads/src/ExtLoads_Registry.txt index ee72346a38..cc109c3b20 100644 --- a/modules/extloads/src/ExtLoads_Registry.txt +++ b/modules/extloads/src/ExtLoads_Registry.txt @@ -15,7 +15,6 @@ ################################################################################################################################### # ...... Include files (definitions from NWTC Library) ............................................................................ include Registry_NWTC_Library.txt -include IfW_FlowField.txt usefrom ExtLoadsDX_Registry.txt # ..... Initialization data ....................................................................................................... @@ -51,7 +50,6 @@ typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ InitOutputType FlowFieldType *FlowField - - - "Pointer of flow field data type" - typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # ..... States .................................................................................................................... @@ -64,7 +62,6 @@ typedef ^ DiscreteStateType ReKi blah - - - "Somethin #Defin misc variables here typedef ^ MiscVarType ReKi az - - - "Current azimuth" - typedef ^ MiscVarType ReKi phi_cfd - - - "Blending ratio of load from external driver [0-1]" - -typedef ^ MiscVarType FlowFieldType &FlowField - - - "Flow field data type" - typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" # Define constraint states here: diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 69713ddde4..740ec1fcd4 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE ExtLoads_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE IfW_FlowField_Types USE ExtLoadsDX_Types USE NWTC_Library IMPLICIT NONE @@ -70,7 +69,6 @@ MODULE ExtLoads_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] - TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of flow field data type [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE ExtLd_InitOutputType ! ======================= @@ -88,7 +86,6 @@ MODULE ExtLoads_Types TYPE, PUBLIC :: ExtLd_MiscVarType REAL(ReKi) :: az = 0.0_ReKi !< Current azimuth [-] REAL(ReKi) :: phi_cfd = 0.0_ReKi !< Blending ratio of load from external driver [0-1] [-] - TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data type [-] TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] END TYPE ExtLd_MiscVarType ! ======================= @@ -471,7 +468,6 @@ subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%AirDens = SrcInitOutputData%AirDens - DstInitOutputData%FlowField => SrcInitOutputData%FlowField DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine @@ -492,7 +488,6 @@ subroutine ExtLd_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(InitOutputData%FlowField) nullify(InitOutputData%Vars) end subroutine @@ -506,13 +501,6 @@ subroutine ExtLd_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPack(RF, InData%AirDens) - call RegPack(RF, associated(InData%FlowField)) - if (associated(InData%FlowField)) then - call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) - if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) - end if - end if call RegPack(RF, associated(InData%Vars)) if (associated(InData%Vars)) then call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) @@ -537,24 +525,6 @@ subroutine ExtLd_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%FlowField) - else - allocate(OutData%FlowField,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField - end if - else - OutData%FlowField => null() - end if if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -657,7 +627,6 @@ subroutine ExtLd_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(0), UB(0) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyMisc' @@ -665,18 +634,6 @@ subroutine ExtLd_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstMiscData%az = SrcMiscData%az DstMiscData%phi_cfd = SrcMiscData%phi_cfd - if (associated(SrcMiscData%FlowField)) then - if (.not. associated(DstMiscData%FlowField)) then - allocate(DstMiscData%FlowField, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FlowField.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call IfW_FlowField_CopyFlowFieldType(SrcMiscData%FlowField, DstMiscData%FlowField, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -691,12 +648,6 @@ subroutine ExtLd_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtLd_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (associated(MiscData%FlowField)) then - call IfW_FlowField_DestroyFlowFieldType(MiscData%FlowField, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(MiscData%FlowField) - MiscData%FlowField => null() - end if call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -705,17 +656,9 @@ subroutine ExtLd_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackMisc' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%az) call RegPack(RF, InData%phi_cfd) - call RegPack(RF, associated(InData%FlowField)) - if (associated(InData%FlowField)) then - call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) - if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) - end if - end if call NWTC_Library_PackModJacType(RF, InData%Jac) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -724,32 +667,9 @@ subroutine ExtLd_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackMisc' - integer(B8Ki) :: LB(0), UB(0) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%az); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%phi_cfd); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%FlowField) - else - allocate(OutData%FlowField,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField - end if - else - OutData%FlowField => null() - end if call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac end subroutine diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 216b5ca627..78921cf0c8 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -6,38 +6,38 @@ #............................................................. -typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" -typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" -typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" - -typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" -typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" -typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" -typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" -typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" -typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" -typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" -typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" - -typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" -typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" -typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" -typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" - -typedef NWTC_Library FileInfoType IntKi NumLines -typedef ^ ^ IntKi NumFiles -typedef ^ ^ IntKi FileLine {:} -typedef ^ ^ IntKi FileIndx {:} +typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" +typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" +typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" + +typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" +typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" +typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" +typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" +typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" +typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" +typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" +typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" + +typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" +typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" +typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" + +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} -typedef NWTC_Library Quaternion ReKi q0 -typedef ^ ^ ReKi v {3} +typedef NWTC_Library Quaternion ReKi q0 +typedef ^ ^ ReKi v {3} -typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -typedef ^ ^ IntKi RandSeed {3} -typedef ^ ^ IntKi RandSeedAry {:} -typedef ^ ^ CHARACTER(6) RNG_type +typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type #------------------------------------------------------------------------------- # Module Variables @@ -164,22 +164,22 @@ typedef ^ ^ ModLinType Lin - - - #BJJ: the following three types will actually be placed in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 -typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" +typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" - typedef ^ ^ R8Ki distance - - - "Magnitude of couple_arm" m typedef ^ ^ R8Ki couple_arm {3} - - "Vector between a point and node 1 of an element (p_ODR - p_OSR)" m typedef ^ ^ R8Ki shape_fn {2} - - "shape functions: 1-D element-level location [0,1] based on closest-line projection of point" - -typedef NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} - - "block matrix of motions that reflects identity (i.e., solely the mapping of one quantity to itself on another mesh)" -typedef ^ ^ R8Ki fx_p {:}{:} - - "block matrix of motions that reflects skew-symmetric (cross-product) matrix" -typedef ^ ^ R8Ki tv_uD {:}{:} - - "block matrix of translational velocity that is multiplied by destination translational displacement" -typedef ^ ^ R8Ki tv_uS {:}{:} - - "block matrix of translational velocity that is multiplied by source translational displacement" -typedef ^ ^ R8Ki ta_uD {:}{:} - - "block matrix of translational acceleration that is multiplied by destination translational displacement" -typedef ^ ^ R8Ki ta_uS {:}{:} - - "block matrix of translational acceleration that is multiplied by source translational displacement" -typedef ^ ^ R8Ki ta_rv {:}{:} - - "block matrix of translational acceleration that is multiplied by omega (RotationVel)" -typedef ^ ^ R8Ki li {:}{:} - - "block matrix of loads that reflects identity (i.e., solely the mapping on one quantity to itself on another mesh)" -typedef ^ ^ R8Ki M_uS {:}{:} - - "block matrix of moment that is multiplied by Source u (translationDisp)" -typedef ^ ^ R8Ki M_uD {:}{:} - - "block matrix of moment that is multiplied by Destination u (translationDisp)" -typedef ^ ^ R8Ki M_f {:}{:} - - "block matrix of moment that is multiplied by force" +typedef NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} - - "block matrix of motions that reflects identity (i.e., solely the mapping of one quantity to itself on another mesh)" +typedef ^ ^ R8Ki fx_p {:}{:} - - "block matrix of motions that reflects skew-symmetric (cross-product) matrix" +typedef ^ ^ R8Ki tv_uD {:}{:} - - "block matrix of translational velocity that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki tv_uS {:}{:} - - "block matrix of translational velocity that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_uD {:}{:} - - "block matrix of translational acceleration that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki ta_uS {:}{:} - - "block matrix of translational acceleration that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_rv {:}{:} - - "block matrix of translational acceleration that is multiplied by omega (RotationVel)" +typedef ^ ^ R8Ki li {:}{:} - - "block matrix of loads that reflects identity (i.e., solely the mapping on one quantity to itself on another mesh)" +typedef ^ ^ R8Ki M_uS {:}{:} - - "block matrix of moment that is multiplied by Source u (translationDisp)" +typedef ^ ^ R8Ki M_uD {:}{:} - - "block matrix of moment that is multiplied by Destination u (translationDisp)" +typedef ^ ^ R8Ki M_f {:}{:} - - "block matrix of moment that is multiplied by force" typedef NWTC_Library MeshMapType MapType MapLoads {:} - - "mapping data structure for load fields on the mesh" typedef ^ ^ MapType MapMotions {:} - - "mapping data structure for motion and/or scalar fields on the mesh" @@ -191,6 +191,5 @@ typedef ^ ^ R8Ki DisplacedPo typedef ^ ^ R8Ki LoadLn2_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" -typedef ^ ^ MeshMapLinearizationType dM -#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" - +typedef ^ ^ MeshMapLinearizationType dM +#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index d3aafe85ee..277981d4e5 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -791,11 +791,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ! Add module to list of modules, return on error CALL MV_AddModule(m_Glue%ModData, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & - Init%OutData_ExtLd%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + Init%OutData_ExtLd%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return AirDens = Init%OutData_ExtLd%AirDens - AD%p%FlowField => Init%OutData_ExtLd%FlowField END IF @@ -1983,8 +1982,6 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) ! No method at the moment for getting disk average velocity from ExtInfw if (p%CompAero == Module_ADsk .and. p%CompInflow == MODULE_ExtInfw) call SetErrStat( ErrID_Fatal, 'AeroDisk cannot be used with ExtInflow or the library interface', ErrStat, ErrMsg, RoutineName ) - if ((p%CompAero == Module_ExtLd) .and. (p%CompInflow /= Module_NONE) ) call SetErrStat(ErrID_Fatal, 'Inflow module cannot be used when ExtLoads is used. Change CompAero or CompInflow in the OpenFAST input file.', ErrStat, ErrMsg, RoutineName) - IF (p%CompAero == Module_ADsk .and. p%MHK /= MHK_None) CALL SetErrStat( ErrID_Fatal, 'AeroDisk cannot be used with an MHK turbine. Change CompAero or MHK in the FAST input file.', ErrStat, ErrMsg, RoutineName ) IF (p%MHK /= MHK_None .and. p%MHK /= MHK_FixedBottom .and. p%MHK /= MHK_Floating) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index d45ba62780..13cfb36ebe 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -635,34 +635,32 @@ MODULE ServoDyn_Types integer(IntKi), public, parameter :: SrvD_u_LSShftFzs = 49 ! SrvD%LSShftFzs integer(IntKi), public, parameter :: SrvD_u_fromSC = 50 ! SrvD%fromSC integer(IntKi), public, parameter :: SrvD_u_fromSCglob = 51 ! SrvD%fromSCglob - integer(IntKi), public, parameter :: SrvD_u_Lidar = 52 ! SrvD%Lidar - integer(IntKi), public, parameter :: SrvD_u_PtfmMotionMesh = 53 ! SrvD%PtfmMotionMesh - integer(IntKi), public, parameter :: SrvD_u_BStCMotionMesh = 54 ! SrvD%BStCMotionMesh(DL%i1, DL%i2) - integer(IntKi), public, parameter :: SrvD_u_NStCMotionMesh = 55 ! SrvD%NStCMotionMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_u_TStCMotionMesh = 56 ! SrvD%TStCMotionMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_u_SStCMotionMesh = 57 ! SrvD%SStCMotionMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_u_LidSpeed = 58 ! SrvD%LidSpeed - integer(IntKi), public, parameter :: SrvD_u_MsrPositionsX = 59 ! SrvD%MsrPositionsX - integer(IntKi), public, parameter :: SrvD_u_MsrPositionsY = 60 ! SrvD%MsrPositionsY - integer(IntKi), public, parameter :: SrvD_u_MsrPositionsZ = 61 ! SrvD%MsrPositionsZ - integer(IntKi), public, parameter :: SrvD_y_WriteOutput = 62 ! SrvD%WriteOutput - integer(IntKi), public, parameter :: SrvD_y_BlPitchCom = 63 ! SrvD%BlPitchCom - integer(IntKi), public, parameter :: SrvD_y_BlAirfoilCom = 64 ! SrvD%BlAirfoilCom - integer(IntKi), public, parameter :: SrvD_y_YawMom = 65 ! SrvD%YawMom - integer(IntKi), public, parameter :: SrvD_y_YawPosCom = 66 ! SrvD%YawPosCom - integer(IntKi), public, parameter :: SrvD_y_YawRateCom = 67 ! SrvD%YawRateCom - integer(IntKi), public, parameter :: SrvD_y_GenTrq = 68 ! SrvD%GenTrq - integer(IntKi), public, parameter :: SrvD_y_HSSBrTrqC = 69 ! SrvD%HSSBrTrqC - integer(IntKi), public, parameter :: SrvD_y_ElecPwr = 70 ! SrvD%ElecPwr - integer(IntKi), public, parameter :: SrvD_y_TBDrCon = 71 ! SrvD%TBDrCon - integer(IntKi), public, parameter :: SrvD_y_Lidar = 72 ! SrvD%Lidar - integer(IntKi), public, parameter :: SrvD_y_CableDeltaL = 73 ! SrvD%CableDeltaL - integer(IntKi), public, parameter :: SrvD_y_CableDeltaLdot = 74 ! SrvD%CableDeltaLdot - integer(IntKi), public, parameter :: SrvD_y_BStCLoadMesh = 75 ! SrvD%BStCLoadMesh(DL%i1, DL%i2) - integer(IntKi), public, parameter :: SrvD_y_NStCLoadMesh = 76 ! SrvD%NStCLoadMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_y_TStCLoadMesh = 77 ! SrvD%TStCLoadMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_y_SStCLoadMesh = 78 ! SrvD%SStCLoadMesh(DL%i1) - integer(IntKi), public, parameter :: SrvD_y_toSC = 79 ! SrvD%toSC + integer(IntKi), public, parameter :: SrvD_u_PtfmMotionMesh = 52 ! SrvD%PtfmMotionMesh + integer(IntKi), public, parameter :: SrvD_u_BStCMotionMesh = 53 ! SrvD%BStCMotionMesh(DL%i1, DL%i2) + integer(IntKi), public, parameter :: SrvD_u_NStCMotionMesh = 54 ! SrvD%NStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_TStCMotionMesh = 55 ! SrvD%TStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_SStCMotionMesh = 56 ! SrvD%SStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_LidSpeed = 57 ! SrvD%LidSpeed + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsX = 58 ! SrvD%MsrPositionsX + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsY = 59 ! SrvD%MsrPositionsY + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsZ = 60 ! SrvD%MsrPositionsZ + integer(IntKi), public, parameter :: SrvD_y_WriteOutput = 61 ! SrvD%WriteOutput + integer(IntKi), public, parameter :: SrvD_y_BlPitchCom = 62 ! SrvD%BlPitchCom + integer(IntKi), public, parameter :: SrvD_y_BlAirfoilCom = 63 ! SrvD%BlAirfoilCom + integer(IntKi), public, parameter :: SrvD_y_YawMom = 64 ! SrvD%YawMom + integer(IntKi), public, parameter :: SrvD_y_YawPosCom = 65 ! SrvD%YawPosCom + integer(IntKi), public, parameter :: SrvD_y_YawRateCom = 66 ! SrvD%YawRateCom + integer(IntKi), public, parameter :: SrvD_y_GenTrq = 67 ! SrvD%GenTrq + integer(IntKi), public, parameter :: SrvD_y_HSSBrTrqC = 68 ! SrvD%HSSBrTrqC + integer(IntKi), public, parameter :: SrvD_y_ElecPwr = 69 ! SrvD%ElecPwr + integer(IntKi), public, parameter :: SrvD_y_TBDrCon = 70 ! SrvD%TBDrCon + integer(IntKi), public, parameter :: SrvD_y_CableDeltaL = 71 ! SrvD%CableDeltaL + integer(IntKi), public, parameter :: SrvD_y_CableDeltaLdot = 72 ! SrvD%CableDeltaLdot + integer(IntKi), public, parameter :: SrvD_y_BStCLoadMesh = 73 ! SrvD%BStCLoadMesh(DL%i1, DL%i2) + integer(IntKi), public, parameter :: SrvD_y_NStCLoadMesh = 74 ! SrvD%NStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_TStCLoadMesh = 75 ! SrvD%TStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_SStCLoadMesh = 76 ! SrvD%SStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_toSC = 77 ! SrvD%toSC contains @@ -7508,8 +7506,6 @@ subroutine SrvD_VarPackInput(V, u, ValAry) VarVals = u%fromSC(V%iLB:V%iUB) ! Rank 1 Array case (SrvD_u_fromSCglob) VarVals = u%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array - case (SrvD_u_Lidar) - VarVals = u%Lidar(V%iLB:V%iUB) ! Rank 1 Array case (SrvD_u_PtfmMotionMesh) call MV_PackMesh(V, u%PtfmMotionMesh, ValAry) ! Mesh case (SrvD_u_BStCMotionMesh) @@ -7632,8 +7628,6 @@ subroutine SrvD_VarUnpackInput(V, ValAry, u) u%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array case (SrvD_u_fromSCglob) u%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array - case (SrvD_u_Lidar) - u%Lidar(V%iLB:V%iUB) = VarVals ! Rank 1 Array case (SrvD_u_PtfmMotionMesh) call MV_UnpackMesh(V, ValAry, u%PtfmMotionMesh) ! Mesh case (SrvD_u_BStCMotionMesh) @@ -7742,8 +7736,6 @@ function SrvD_InputFieldName(DL) result(Name) Name = "u%fromSC" case (SrvD_u_fromSCglob) Name = "u%fromSCglob" - case (SrvD_u_Lidar) - Name = "u%Lidar" case (SrvD_u_PtfmMotionMesh) Name = "u%PtfmMotionMesh" case (SrvD_u_BStCMotionMesh) @@ -7803,8 +7795,6 @@ subroutine SrvD_VarPackOutput(V, y, ValAry) VarVals(1) = y%ElecPwr ! Scalar case (SrvD_y_TBDrCon) VarVals = y%TBDrCon(V%iLB:V%iUB) ! Rank 1 Array - case (SrvD_y_Lidar) - VarVals = y%Lidar(V%iLB:V%iUB) ! Rank 1 Array case (SrvD_y_CableDeltaL) VarVals = y%CableDeltaL(V%iLB:V%iUB) ! Rank 1 Array case (SrvD_y_CableDeltaLdot) @@ -7861,8 +7851,6 @@ subroutine SrvD_VarUnpackOutput(V, ValAry, y) y%ElecPwr = VarVals(1) ! Scalar case (SrvD_y_TBDrCon) y%TBDrCon(V%iLB:V%iUB) = VarVals ! Rank 1 Array - case (SrvD_y_Lidar) - y%Lidar(V%iLB:V%iUB) = VarVals ! Rank 1 Array case (SrvD_y_CableDeltaL) y%CableDeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array case (SrvD_y_CableDeltaLdot) @@ -7905,8 +7893,6 @@ function SrvD_OutputFieldName(DL) result(Name) Name = "y%ElecPwr" case (SrvD_y_TBDrCon) Name = "y%TBDrCon" - case (SrvD_y_Lidar) - Name = "y%Lidar" case (SrvD_y_CableDeltaL) Name = "y%CableDeltaL" case (SrvD_y_CableDeltaLdot) From 83bed317bd0d0ef8115cf8e6986e4e9a4c137d35 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 14 Sep 2024 17:56:52 +0000 Subject: [PATCH 265/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index e48e4ab7eb..1f80c2f008 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit e48e4ab7eb500ccb34bef0385f6ee7e6d3a85542 +Subproject commit 1f80c2f00806808de0e80bf7259f00d475b109d9 From 58f5aad72dceec0abc25c5665242f99ea9fe4533 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 14 Sep 2024 23:30:55 +0000 Subject: [PATCH 266/319] FAST_Subs: fix bad merge --- modules/openfast-library/src/FAST_Subs.f90 | 28 ---------------------- 1 file changed, 28 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 277981d4e5..e40c7f55b3 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1299,34 +1299,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_SrvD%NumSC2Ctrl = 0 Init%InData_SrvD%NumCtrl2SC = 0 END IF - - IF ( p_FAST%CompInflow == Module_IfW ) THEN !assign the number of gates to ServD - if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%LidSpeed = IfW%y%lidar%LidSpeed - endif - if (allocated(IfW%y%lidar%MsrPositionsX)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsX = IfW%y%lidar%MsrPositionsX - endif - if (allocated(IfW%y%lidar%MsrPositionsY)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsY = IfW%y%lidar%MsrPositionsY - endif - if (allocated(IfW%y%lidar%MsrPositionsZ)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsZ = IfW%y%lidar%MsrPositionsZ - endif - Init%InData_SrvD%SensorType = IfW%p%lidar%SensorType - Init%InData_SrvD%NumBeam = IfW%p%lidar%NumBeam - Init%InData_SrvD%NumPulseGate = IfW%p%lidar%NumPulseGate - Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing - END IF - ! Set cable controls inputs (if requested by other modules) -- There is probably a nicer way to do this, but this will work for now. call SetSrvDCableControls() From e9d007d212a9a8e7f70a4bcb298cea63c4a1a869 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 14 Sep 2024 23:35:56 +0000 Subject: [PATCH 267/319] openfast_io: update reader & writer for tight-coupling inputs --- openfast_python/openfast_io/FAST_reader.py | 3 +++ openfast_python/openfast_io/FAST_writer.py | 5 ++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/openfast_python/openfast_io/FAST_reader.py b/openfast_python/openfast_io/FAST_reader.py index f9e909d726..898bc66cb7 100644 --- a/openfast_python/openfast_io/FAST_reader.py +++ b/openfast_python/openfast_io/FAST_reader.py @@ -151,6 +151,9 @@ def read_MainInput(self): self.fst_vt['Fst']['DT'] = float_read(f.readline().split()[0]) self.fst_vt['Fst']['InterpOrder'] = int(f.readline().split()[0]) self.fst_vt['Fst']['NumCrctn'] = int(f.readline().split()[0]) + self.fst_vt['Fst']['RhoInf'] = float_read(f.readline().split()[0]) + self.fst_vt['Fst']['ConvTol'] = float_read(f.readline().split()[0]) + self.fst_vt['Fst']['MaxConvIter'] = int(f.readline().split()[0]) self.fst_vt['Fst']['DT_UJac'] = float_read(f.readline().split()[0]) self.fst_vt['Fst']['UJacSclFact'] = float_read(f.readline().split()[0]) diff --git a/openfast_python/openfast_io/FAST_writer.py b/openfast_python/openfast_io/FAST_writer.py index 928aa68eb2..25e5e3796c 100644 --- a/openfast_python/openfast_io/FAST_writer.py +++ b/openfast_python/openfast_io/FAST_writer.py @@ -207,7 +207,10 @@ def write_MainInput(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['TMax'], 'TMax', '- Total run time (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['DT'], 'DT', '- Recommended module time step (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['InterpOrder'], 'InterpOrder', '- Interpolation order for input/output time history (-) {1=linear, 2=quadratic}\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['NumCrctn'], 'NumCrctn', '- Number of correction iterations (-) {0=explicit calculation, i.e., no corrections}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['NumCrctn'], 'NumCrctn', '- Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['RhoInf'], 'RhoInf', '- Convergence iteration error tolerance for tight coupling generalized alpha integrator (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['ConvTol'], 'ConvTol', '- Maximum number of convergence iterations for tight coupling generalized alpha integrator (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['MaxConvIter'], 'MaxConvIter', '- Number of correction iterations (-) {0=explicit calculation, i.e., no corrections}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['DT_UJac'], 'DT_UJac', '- Time between calls to get Jacobians (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['UJacSclFact'], 'UJacSclFact', '- Scaling factor used in Jacobians (-)\n')) f.write('---------------------- FEATURE SWITCHES AND FLAGS ------------------------------\n') From c68d6938cd0c6f41d6469959dc8745b5594c8b30 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 14 Sep 2024 23:36:06 +0000 Subject: [PATCH 268/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 1f80c2f008..ff737eee4b 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 1f80c2f00806808de0e80bf7259f00d475b109d9 +Subproject commit ff737eee4bc1a109885885ff8a66f8e308ade284 From 7c5633ff609c88d9bdca63ea034095006b3c24ca Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 17 Sep 2024 20:17:29 +0000 Subject: [PATCH 269/319] Allow NLinTimes=1 when using CalcSteady --- modules/openfast-library/src/FAST_ModGlue.f90 | 2 +- modules/openfast-library/src/FAST_Subs.f90 | 6 ------ 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 5f81d9c9c9..5878d6bc8c 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -763,7 +763,7 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, error = CalcOutputErrorAtAzimuth() ! Update converged flag based on error and tolerance - m%CS%IsConverged = error < p_FAST%TrimTol + m%CS%IsConverged = (error < p_FAST%TrimTol) .and. (n_t_global > 1) end if ! Save interpolated outputs for this azimuth diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index e40c7f55b3..8ea6ee697a 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3335,12 +3335,6 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS RETURN end if - ! temporary work-around for error with CalcSteady - if (p%CalcSteady .and. p%NLinTimes == 1 ) then - call SetErrStat(ErrID_Info, "Setting NLinTimes to 2 to avoid problem with CalcSteady with only one time.", ErrStat,ErrMsg,RoutineName) - p%NLinTimes = 2 - end if - ! LinInputs - Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} CALL ReadVar( UnIn, InputFile, p%LinInputs, "LinInputs", "Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) From ae12bdc09966069fe29618672e1af6d00076407b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 17 Sep 2024 20:26:17 +0000 Subject: [PATCH 270/319] Allow DBEMT_Mod=-1 (frozen wake) for linearization --- modules/aerodyn/src/AeroDyn.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 9cf87c39bf..6e8108fd9c 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -3991,7 +3991,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt if (InputFileData%DTAero <= 0.0) call SetErrStat ( ErrID_Fatal, 'DTAero must be greater than zero.', ErrStat, ErrMsg, RoutineName ) if (InputFileData%Wake_Mod /= WakeMod_None .and. InputFileData%Wake_Mod /= WakeMod_BEMT .and. InputFileData%Wake_Mod /= WakeMod_FVW) then - call SetErrStat ( ErrID_Fatal, 'WakeMod must be '//trim(num2lstr(WakeMod_None))//' (none), '//trim(num2lstr(WakeMod_BEMT))//' (BEMT), '// & + call SetErrStat ( ErrID_Fatal, 'Wake_Mod must be '//trim(num2lstr(WakeMod_None))//' (none), '//trim(num2lstr(WakeMod_BEMT))//' (BEMT), '// & ' or '//trim(num2lstr(WakeMod_FVW))//' (FVW).',ErrStat, ErrMsg, RoutineName ) end if @@ -4284,16 +4284,18 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt if (InitInp%Linearize) then if (InputFileData%Wake_Mod /= WakeMod_None .and. InputFileData%Wake_Mod /= WakeMod_BEMT) then - call SetErrStat( ErrID_Fatal, 'WakeMod must be 0 or 1 for linearization.', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Fatal, 'Wake_Mod must be 0 or 1 for linearization.', ErrStat, ErrMsg, RoutineName ) endif if (InputFileData%UA_Init%UAMod /= UA_None .and. InputFileData%UA_Init%UAMod /= UA_HGM .and. InputFileData%UA_Init%UAMod /= UA_HGMV .and. InputFileData%UA_Init%UAMod /= UA_OYE) then call SetErrStat( ErrID_Fatal, 'UA_Mod must be 0, 4, 5, or 6 for linearization.', ErrStat, ErrMsg, RoutineName ) end if - if (InputFileData%DBEMT_Mod /= DBEMT_None .and. InputFileData%DBEMT_Mod /= DBEMT_cont_tauConst) then + select case(InputFileData%DBEMT_Mod) + case (DBEMT_None, DBEMT_frozen, DBEMT_cont_tauConst) + case default call SetErrStat( ErrID_Fatal, 'DBEMT Mod must be 0 or 3 (continuous formulation with constant tau1) for linearization. Set DBEMT_Mod=0,3.', ErrStat, ErrMsg, RoutineName ) - end if + end select if (InputFileData%NacelleDrag) then call SetErrStat( ErrID_Fatal, 'Nacelle drag cannot currently be used for linearization. Set NacelleDrag = false.', ErrStat, ErrMsg, RoutineName ) From e1a28e15ecbf804093c9dacad5b06a5f58f325e7 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 17 Sep 2024 23:16:38 +0000 Subject: [PATCH 271/319] FAST_ModGlue: better way to prevent CalcSteady from converging prematurely. --- modules/openfast-library/src/FAST_ModGlue.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 5878d6bc8c..0a8c50ca32 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -762,8 +762,9 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ! azimuth from the previous rotation error = CalcOutputErrorAtAzimuth() - ! Update converged flag based on error and tolerance - m%CS%IsConverged = (error < p_FAST%TrimTol) .and. (n_t_global > 1) + ! Update converged flag based on error and tolerance and more than one rotation has occurred + m%CS%IsConverged = (error < p_FAST%TrimTol) .and. (m%CS%NumRotations > 0) + end if ! Save interpolated outputs for this azimuth From 2723c202bfad6e8e5220e6e0ec3cc50fb8ea6aca Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 18 Sep 2024 02:25:21 +0000 Subject: [PATCH 272/319] FAST_Mapping: remove ExtLd -> SrvD --- modules/openfast-library/src/FAST_Mapping.f90 | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 4da4faf653..7dcab68967 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -51,7 +51,6 @@ module FAST_Mapping Custom_ED_to_SrvD = 'ED -> SrvD', & Custom_SED_to_SrvD = 'SED -> SrvD', & Custom_ExtInfw_to_SrvD = 'ExtInfw -> SrvD', & - Custom_ExtLd_to_SrvD = 'ExtLd -> SrvD', & Custom_IfW_to_SrvD = 'IfW -> SrvD', & Custom_SrvD_to_ED = 'SrvD -> ED', & Custom_SrvD_to_SED = 'SrvD -> SED', & @@ -3164,23 +3163,6 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg ! the nacelle yaw error estimate (positive about zi-axis) T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle - case (Custom_ExtLd_to_SrvD) - - pi = acos(-1.0) - z = T%ED%y%HubPtMotion%Position(3, 1) - mean_vel = T%ExtLd%p%vel_mean*((z/T%ExtLd%p%z_ref)**T%ExtLd%p%shear_exp) - u = -mean_vel*sin(T%ExtLd%p%wind_dir*pi/180.0) - v = -mean_vel*cos(T%ExtLd%p%wind_dir*pi/180.0) - T%SrvD%Input(iInput)%HorWindV = mean_vel - T%SrvD%Input(iInput)%WindDir = atan2(v, u) - if (allocated(T%SrvD%Input(iInput)%LidSpeed)) T%SrvD%Input(iInput)%LidSpeed = 0.0 - if (allocated(T%SrvD%Input(iInput)%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = 0.0 - if (allocated(T%SrvD%Input(iInput)%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = 0.0 - if (allocated(T%SrvD%Input(iInput)%MsrPositionsz)) T%SrvD%Input(iInput)%MsrPositionsz = 0.0 - - ! the nacelle yaw error estimate (positive about zi-axis) - T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle - !------------------------------------------------------------------------------- ! Unknown Mapping !------------------------------------------------------------------------------- From 0845870a2bd26be23203ed431c1a6ab3aa96f9e3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 18 Sep 2024 13:37:53 +0000 Subject: [PATCH 273/319] Use at least 2 azimuth positions for CalcSteady --- modules/openfast-library/src/FAST_ModGlue.f90 | 11 ++++++----- modules/openfast-library/src/FAST_Subs.f90 | 8 ++++---- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 0a8c50ca32..0d0e799d2a 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -562,7 +562,7 @@ subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) if (p_FAST%Linearize) then ! Copy linearization parameters - p%Lin%NumTimes = p_FAST%NLinTimes + p%Lin%NumTimes = max(p_FAST%NLinTimes, 2) p%Lin%InterpOrder = p_FAST%InterpOrder if (allocated(m_FAST%Lin%LinTimes)) then y%Lin%Times = m_FAST%Lin%LinTimes @@ -693,7 +693,8 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, if (size(ModData%Vars%y) == 0) cycle ! Get outputs - call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, y_op=m%ModGlue%Lin%y, y_glue=m%ModGlue%Lin%y) + call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + y_op=m%ModGlue%Lin%y, y_glue=m%ModGlue%Lin%y) if (Failed()) return end associate @@ -706,7 +707,7 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, if (n_t_global == 0) then ! Initialize azimuth targets - do i = 1, p%Lin%NumTimes + do i = 1, size(m%CS%AzimuthTarget) m%CS%AzimuthTarget(i) = (i - 1)*m%CS%AzimuthDelta + psi call Zero2TwoPi(m%CS%AzimuthTarget(i)) end do @@ -762,8 +763,8 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ! azimuth from the previous rotation error = CalcOutputErrorAtAzimuth() - ! Update converged flag based on error and tolerance and more than one rotation has occurred - m%CS%IsConverged = (error < p_FAST%TrimTol) .and. (m%CS%NumRotations > 0) + ! Update converged flag based on error and tolerance + m%CS%IsConverged = (error < p_FAST%TrimTol) end if diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 8ea6ee697a..e758d32fc7 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -244,12 +244,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE InputAryUB = p_FAST%InterpOrder + 1 ! Input saved arrays have storage for InputArray size + linearization - InputAryLB = InputAryUB + p_FAST%NLinTimes + InputAryLB = InputAryUB + max(p_FAST%NLinTimes, 2) ! Module data state arrays include data at linearization times after ! STATE_CURR, STATE_PRED, STATE_SAVED_CURR, and STATE_SAVED_PRED StateAryLB = 1 - StateAryUB = NumStateTimes + p_FAST%NLinTimes + StateAryUB = NumStateTimes + max(p_FAST%NLinTimes, 2) !---------------------------------------------------------------------------- ! Linearization @@ -6733,11 +6733,11 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) ! If linearization was forced, only linearize at first time if (Turbine%m_Glue%CS%ForceLin) then - Turbine%p_Glue%Lin%NumTimes = 1 + Turbine%p_FAST%NLinTimes = 1 endif ! Loop through linearization times - do iLinTime = 1, Turbine%p_Glue%Lin%NumTimes + do iLinTime = 1, Turbine%p_FAST%NLinTimes ! Set global time to saved linearization time t_global = Turbine%y_Glue%Lin%Times(iLinTime) From efc9d5ac7dcf8400f06cbf19b48d4579c79e8d82 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 19 Sep 2024 15:02:30 +0000 Subject: [PATCH 274/319] FAST_Mapping: reimplement tower and blade damping for CalcSteady --- modules/openfast-library/src/FAST_Mapping.f90 | 188 ++++++++++++++++-- .../openfast-library/src/Glue_Registry.txt | 1 + modules/openfast-library/src/Glue_Types.f90 | 4 + 3 files changed, 179 insertions(+), 14 deletions(-) diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 7dcab68967..bc251e2f01 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -55,7 +55,10 @@ module FAST_Mapping Custom_SrvD_to_ED = 'SrvD -> ED', & Custom_SrvD_to_SED = 'SrvD -> SED', & Custom_SrvD_to_SD = 'SrvD -> SD', & - Custom_SrvD_to_MD = 'SrvD -> MD' + Custom_SrvD_to_MD = 'SrvD -> MD', & + Custom_ED_Tower_Damping = 'ED Tower Damping', & + Custom_ED_Blade_Damping = 'ED Blade Damping', & + Custom_BD_Blade_Damping = 'BD Blade Damping' contains @@ -381,12 +384,29 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) return end if - ! Loop through module pairings - do iModSrc = 1, size(Mods) - do iModDst = 1, size(Mods) + ! Loop through destination modules + do iModDst = 1, size(Mods) + + ! Add mappings within module + select case (Mods(iModDst)%ID) + case (Module_ED) + call MapCustom(MappingsTmp, Custom_ED_Tower_Damping, Mods(iModDst), Mods(iModDst), & + Active=Turbine%p_FAST%CalcSteady) + do i = 1, Turbine%ED%p%NumBl + call MapCustom(MappingsTmp, Custom_ED_Blade_Damping, Mods(iModDst), Mods(iModDst), & + i=i, Active=Turbine%p_FAST%CalcSteady .and. (Turbine%p_FAST%CompElast == Module_ED)) + end do + + case (Module_BD) + call MapCustom(MappingsTmp, Custom_BD_Blade_Damping, Mods(iModDst), Mods(iModDst), & + Active=Turbine%p_FAST%CalcSteady) + end select + + ! Loop through source modules + do iModSrc = 1, size(Mods) ! Switch by destination module (inputs) - select case (Mods(IModDst)%ID) + select case (Mods(iModDst)%ID) case (Module_AD) call InitMappings_AD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_ADsk) @@ -468,6 +488,83 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) end associate end do + !---------------------------------------------------------------------------- + ! Initialize mappings used to apply damping + !---------------------------------------------------------------------------- + + ! Loop through mappings + do i = 1, size(Mappings) + associate(Mapping => Mappings(i)) + + ! Select based on mapping description + select case (Mapping%Desc) + case (Custom_ED_Tower_Damping) + + ! Create temporary motion mesh as cousin of load mesh, to compute get + ! velocities at load locations for computing damping forces + call MeshCopy(SrcMesh=Turbine%ED%Input(INPUT_CURR)%TowerPtLoads, & + DestMesh=Mapping%TmpMotionMesh, & + CtrlCode=MESH_COUSIN, & + IOS=COMPONENT_OUTPUT, & + TranslationDisp=.true., & + TranslationVel=.true., & + ErrStat=ErrStat2, & + ErrMess=ErrMsg2) + if (Failed()) return + + ! Create motion mapping from original motion mesh to temporary motion mesh + call MeshMapCreate(Turbine%ED%y%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Determine mesh transfer type and save to mapping + Mapping%XfrType = MeshTransferType(Turbine%ED%y%TowerLn2Mesh, Mapping%TmpMotionMesh) + + case (Custom_ED_Blade_Damping) + + ! Create temporary motion mesh as cousin of load mesh, to compute get + ! velocities at load locations for computing damping forces + call MeshCopy(SrcMesh=Turbine%ED%Input(INPUT_CURR)%BladePtLoads(Mapping%i), & + DestMesh=Mapping%TmpMotionMesh, & + CtrlCode=MESH_COUSIN, & + IOS=COMPONENT_OUTPUT, & + TranslationDisp=.true., & + TranslationVel=.true., & + ErrStat=ErrStat2, & + ErrMess=ErrMsg2) + if (Failed()) return + + ! Create motion mapping from original motion mesh to temporary motion mesh + call MeshMapCreate(Turbine%ED%y%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Determine mesh transfer type and save to mapping + Mapping%XfrType = MeshTransferType(Turbine%ED%y%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh) + + case (Custom_BD_Blade_Damping) + + ! Create temporary motion mesh as cousin of load mesh, to compute get + ! velocities at load locations for computing damping forces + call MeshCopy(SrcMesh=Turbine%BD%Input(INPUT_CURR, Mapping%DstIns)%DistrLoad, & + DestMesh=Mapping%TmpMotionMesh, & + CtrlCode=MESH_COUSIN, & + IOS=COMPONENT_OUTPUT, & + TranslationDisp=.true., & + TranslationVel=.true., & + ErrStat=ErrStat2, & + ErrMess=ErrMsg2) + if (Failed()) return + + ! Create motion mapping from original motion mesh to temporary motion mesh + call MeshMapCreate(Turbine%BD%y(Mapping%DstIns)%BldMotion, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Determine mesh transfer type and save to mapping + Mapping%XfrType = MeshTransferType(Turbine%BD%y(Mapping%DstIns)%BldMotion, Mapping%TmpMotionMesh) + + end select + end associate + end do + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2205,12 +2302,13 @@ subroutine MapVariable(Maps, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Acti !> MapCustom creates a custom mapping that is not included in linearization. !! Each custom mapping needs an entry in FAST_InputSolve to actually perform the transfer. -subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) - type(MappingType), allocatable :: Maps(:) - character(*), intent(in) :: Desc - type(ModDataType), intent(inout) :: SrcMod, DstMod - logical, optional, intent(in) :: Active - type(MappingType) :: Mapping +subroutine MapCustom(Maps, Desc, SrcMod, DstMod, i, Active) + type(MappingType), allocatable :: Maps(:) + character(*), intent(in) :: Desc + type(ModDataType), intent(inout) :: SrcMod, DstMod + integer(IntKi), optional, intent(in) :: i + logical, optional, intent(in) :: Active + type(MappingType) :: Mapping if (present(Active)) then if (.not. Active) return @@ -2225,6 +2323,7 @@ subroutine MapCustom(Maps, Desc, SrcMod, DstMod, Active) Mapping%DstModID = DstMod%ID Mapping%SrcIns = SrcMod%Ins Mapping%DstIns = DstMod%Ins + if (present(i)) Mapping%i = i Maps = [Maps, Mapping] end subroutine @@ -2912,7 +3011,7 @@ subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp, ErrStat, ErrMs end subroutine subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg) - type(MappingType), intent(in) :: Mapping + type(MappingType), intent(inout) :: Mapping type(ModDataType), intent(in) :: ModSrc, ModDst integer(IntKi), intent(in) :: iInput type(FAST_TurbineType), intent(inout) :: T !< Turbine type @@ -2923,8 +3022,11 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j, k - real(ReKi) :: z, u, v, mean_vel - + + real(R8Ki) :: omega_c(3) + real(R8Ki) :: r(3), r_hub(3) + real(R8Ki) :: Vrot(3) + ErrStat = ErrID_None ErrMsg = '' @@ -2962,6 +3064,30 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg T%ADsk%Input(iInput)%RotSpeed = T%SED%y%RotSpeed T%ADsk%Input(iInput)%BlPitch = T%SED%y%BlPitch(1) ! ADsk only uses collective blade pitch +!------------------------------------------------------------------------------- +! BeamDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_BD_Blade_Damping) + + ! Get rotational velocity and current hub position + omega_c = T%ED%y%RotSpeed * T%ED%y%HubPtMotion%Orientation(1,:,1) + r_hub = T%ED%y%HubPtMotion%Position(:,1) + T%ED%y%HubPtMotion%TranslationDisp(:,1) + + ! Get blade velocities at load mesh locations + call TransferMesh(Mapping%XfrType, T%BD%y(Mapping%DstIns)%BldMotion, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Remove rotor rotational velocity from node velocity + do i = 1, Mapping%TmpMotionMesh%Nnodes + r = Mapping%TmpMotionMesh%Position(:,i) + Mapping%TmpMotionMesh%TranslationDisp(:,i) - r_hub + Vrot = cross_product(omega_c, r) + Mapping%TmpMotionMesh%TranslationVel(:,i) = Mapping%TmpMotionMesh%TranslationVel(:,i) - Vrot + end do + + ! Apply damping force as Bld_Kdmp*(node velocity) + T%BD%Input(iInput, Mapping%DstIns)%DistrLoad%Force = T%BD%Input(iInput, Mapping%DstIns)%DistrLoad%Force - T%p_FAST%Bld_Kdmp * Mapping%TmpMotionMesh%TranslationVel + !------------------------------------------------------------------------------- ! ElastoDyn Inputs !------------------------------------------------------------------------------- @@ -2973,6 +3099,35 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg T%ED%Input(iInput)%BlPitchCom = T%SrvD%y%BlPitchCom T%ED%Input(iInput)%YawMom = T%SrvD%y%YawMom + case (Custom_ED_Tower_Damping) + + ! Get tower velocities at load mesh locations + call TransferMesh(Mapping%XfrType, T%ED%y%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Apply damping force as Twr_Kdmp*(node velocity) + T%ED%Input(iInput)%TowerPtLoads%Force = T%ED%Input(iInput)%TowerPtLoads%Force - T%p_FAST%Twr_Kdmp * Mapping%TmpMotionMesh%TranslationVel + + case (Custom_ED_Blade_Damping) + + ! Get rotational velocity and current hub position + omega_c = T%ED%y%RotSpeed * T%ED%y%HubPtMotion%Orientation(1,:,1) + r_hub = T%ED%y%HubPtMotion%Position(:,1) + T%ED%y%HubPtMotion%TranslationDisp(:,1) + + ! Get blade velocities at load mesh locations + call TransferMesh(Mapping%XfrType, T%ED%y%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Remove rotor rotational velocity from node velocity + do i = 1, Mapping%TmpMotionMesh%Nnodes + r = Mapping%TmpMotionMesh%Position(:,i) + Mapping%TmpMotionMesh%TranslationDisp(:,i) - r_hub + Vrot = cross_product(omega_c, r) + Mapping%TmpMotionMesh%TranslationVel(:,i) = Mapping%TmpMotionMesh%TranslationVel(:,i) - Vrot + end do + + ! Apply damping force as Bld_Kdmp*(node velocity) + T%ED%Input(iInput)%BladePtLoads(Mapping%i)%Force = T%ED%Input(iInput)%BladePtLoads(Mapping%i)%Force - T%p_FAST%Bld_Kdmp * Mapping%TmpMotionMesh%TranslationVel + !------------------------------------------------------------------------------- ! SED Inputs !------------------------------------------------------------------------------- @@ -3174,6 +3329,11 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg end select +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function end subroutine subroutine FAST_ResetRemapFlags(Mods, Maps, T, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt index 6f80c46296..df9d83bf34 100644 --- a/modules/openfast-library/src/Glue_Registry.txt +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -48,6 +48,7 @@ typedef ^ ^ DatLoc DstDispDL - - - typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Variable, 4=Custom)" - typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type to auxiliary mesh (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - +typedef ^ ^ IntKi i - 0 - "Integer for custom mapping index" - typedef ^ ^ logical Ready - F - "Flag indicating source data is ready to be transferred" - typedef ^ ^ logical DstUsesSibling - F - "Flag indicating the destination displacement mesh is a sibling of the source destination load mesh" - typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index b43d761c01..f1f6a004f1 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -73,6 +73,7 @@ MODULE Glue_Types INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Variable, 4=Custom) [-] INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type to auxiliary mesh (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] + INTEGER(IntKi) :: i = 0 !< Integer for custom mapping index [-] LOGICAL :: Ready = .false. !< Flag indicating source data is ready to be transferred [-] LOGICAL :: DstUsesSibling = .false. !< Flag indicating the destination displacement mesh is a sibling of the source destination load mesh [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] @@ -498,6 +499,7 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode DstMappingTypeData%MapType = SrcMappingTypeData%MapType DstMappingTypeData%XfrType = SrcMappingTypeData%XfrType DstMappingTypeData%XfrTypeAux = SrcMappingTypeData%XfrTypeAux + DstMappingTypeData%i = SrcMappingTypeData%i DstMappingTypeData%Ready = SrcMappingTypeData%Ready DstMappingTypeData%DstUsesSibling = SrcMappingTypeData%DstUsesSibling if (allocated(SrcMappingTypeData%TmpMatrix)) then @@ -600,6 +602,7 @@ subroutine Glue_PackMappingType(RF, Indata) call RegPack(RF, InData%MapType) call RegPack(RF, InData%XfrType) call RegPack(RF, InData%XfrTypeAux) + call RegPack(RF, InData%i) call RegPack(RF, InData%Ready) call RegPack(RF, InData%DstUsesSibling) call RegPackAlloc(RF, InData%TmpMatrix) @@ -635,6 +638,7 @@ subroutine Glue_UnPackMappingType(RF, OutData) call RegUnpack(RF, OutData%MapType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%XfrType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%XfrTypeAux); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ready); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DstUsesSibling); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return From b3541f5745705f38913b2e988f8c2d64d296120b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 20 Sep 2024 20:11:17 +0000 Subject: [PATCH 275/319] ExtLoads: fix bad merge from dev --- modules/extloads/src/ExtLoads.f90 | 121 ++++++++++++++++++++++++------ 1 file changed, 99 insertions(+), 22 deletions(-) diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index cef516974d..38d37b68f7 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -121,15 +121,12 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM p%az_blend_mean = InitInp%az_blend_mean p%az_blend_delta = InitInp%az_blend_delta - !............................................................................................ - ! Define and initialize inputs here - !............................................................................................ + !---------------------------------------------------------------------------- + ! Define and initialize inputs + !---------------------------------------------------------------------------- - write(*,*) 'Initializing U ' - - call Init_u( u, p, InitInp, errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + call Init_u( u, p, InitInp, ErrStat2, ErrMsg2 ) + if (Failed()) return !---------------------------------------------------------------------------- ! Initialize misc vars states @@ -137,23 +134,103 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM m%az = 0.0 m%phi_cfd = 0.0 + + !---------------------------------------------------------------------------- + ! Initialize outputs + !---------------------------------------------------------------------------- - write(*,*) 'Initializing y ' - - !............................................................................................ - ! Define outputs here - !............................................................................................ - call Init_y(y, u, m, p, errStat2, errMsg2) ! do this after input meshes have been initialized - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + ! Initialize outputs after input meshes have been initialized + call Init_y(y, u, m, p, ErrStat2, ErrMsg2) + if (Failed()) return - - !............................................................................................ - ! Define initialization output here - !............................................................................................ - call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + ! Define initialization output here + !---------------------------------------------------------------------------- + call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Initialize Module Variables + !---------------------------------------------------------------------------- + + call ExtLd_InitVars(u, p, y, m, InitOut, .false., ErrStat2, ErrMsg2) + if (Failed()) return + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine ExtLd_Init + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine ExtLd_InitVars(u, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ExtLd_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ExtLd_ParameterType), intent(inout) :: p !< Parameters + type(ExtLd_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ExtLd_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ExtLd_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ExtLd_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%u, "TowerMotion", MotionFields, DatLoc(ExtLd_u_TowerMotion), Mesh=u%TowerMotion) + call MV_AddMeshVar(p%Vars%u, "HubMotion", MotionFields, DatLoc(ExtLd_u_HubMotion), Mesh=u%HubMotion) + call MV_AddMeshVar(p%Vars%u, "NacelleMotion", MotionFields, DatLoc(ExtLd_u_NacelleMotion), Mesh=u%NacelleMotion) + do i = 1, size(u%BladeRootMotion) + call MV_AddMeshVar(p%Vars%u, "BladeRootMotion"//IdxStr(i), MotionFields, DatLoc(ExtLd_u_BladeRootMotion, i), Mesh=u%BladeRootMotion(i)) + end do + do i = 1, size(u%BladeRootMotion) + call MV_AddMeshVar(p%Vars%u, "BladeMotion"//IdxStr(i), MotionFields, DatLoc(ExtLd_u_BladeMotion, i), Mesh=u%BladeMotion(i)) + end do + call MV_AddMeshVar(p%Vars%u, 'TowerLoadAD', LoadFields, DatLoc(ExtLd_u_TowerLoadAD), Mesh=u%TowerLoadAD) + do i = 1, size(u%BladeLoadAD) + call MV_AddMeshVar(p%Vars%u, 'BladeLoadAD'//IdxStr(i), LoadFields, DatLoc(ExtLd_u_BladeLoadAD, i), Mesh=u%BladeLoadAD(i)) + end do + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'TowerLoad', LoadFields, DatLoc(ExtLd_y_TowerLoad), Mesh=y%TowerLoad) + do i = 1, size(y%BladeLoad) + call MV_AddMeshVar(p%Vars%y, 'BladeLoad'//IdxStr(i), LoadFields, DatLoc(ExtLd_y_BladeLoad, i), Mesh=y%BladeLoad(i)) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return contains logical function Failed() From fdffbe477cef4df88276982d65fdff55065281db Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 20 Sep 2024 20:23:36 +0000 Subject: [PATCH 276/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index ff737eee4b..0745783cb8 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit ff737eee4bc1a109885885ff8a66f8e308ade284 +Subproject commit 0745783cb88a5d76dbb51ff5110e60a4d9b68e49 From 3f0e899d1b841e2a996f24c0b011238ba8d310fc Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 26 Sep 2024 16:31:10 +0000 Subject: [PATCH 277/319] Fix MV_ExtrapInterp and its use in FAST_ModGlue --- modules/nwtc-library/src/ModVar.f90 | 6 +++--- modules/openfast-library/src/FAST_ModGlue.f90 | 1 + 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index cad9391bc6..516a386390 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -619,13 +619,13 @@ subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) ErrMsg = '' ! Check that array sizes match - if (size(t) /= size(y, 2)) then - call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + if (size(tin) /= size(y, 2)) then + call SetErrStat(ErrID_Fatal, 'size(tin) must equal size(y)', ErrStat, ErrMsg, RoutineName) return end if ! Calculate interpolation order - InterpOrder = size(t) - 1 + InterpOrder = size(tin) - 1 ! Switch based on interpolation order select case (InterpOrder) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index 0d0e799d2a..b75a16582f 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -755,6 +755,7 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ! Interpolate outputs to target azimuth call MV_ExtrapInterp(m%ModGlue%Vars%y, m%CS%y_buffer, m%CS%psi_buffer, & m%CS%y_interp, AzimuthTarget, ErrStat2, ErrMsg2) + if (Failed()) return ! If converged if (m%CS%IsConverged) then From 0bd39f963ff77003971811615b6054e5a0d08f8c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 22 Oct 2024 15:04:56 +0000 Subject: [PATCH 278/319] Update convergence failure message --- modules/openfast-library/src/FAST_SolverTC.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index c39bdb92bb..aafcc698e7 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -1269,7 +1269,8 @@ subroutine FAST_SolverStep(n_t_global, t_initial, p, m, GlueModData, GlueModMaps call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & " iterations on step "//trim(Num2LStr(n_t_global_next))// & " (error="//trim(Num2LStr(ConvError))// & - ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & + ", tolerance="//trim(Num2LStr(p%ConvTol))//"). "// & + "Solution will continue but may be invalid.", & ErrStat, ErrMsg, RoutineName) end if From 5ee4ac1bc3b285558c4a7c2a623005191f52a441 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Nov 2024 18:39:57 +0000 Subject: [PATCH 279/319] Merge %Input_Saved into %Input for modules --- modules/openfast-library/src/FAST_Funcs.f90 | 308 +------ .../openfast-library/src/FAST_Registry.txt | 17 - modules/openfast-library/src/FAST_Subs.f90 | 245 +++--- modules/openfast-library/src/FAST_Types.f90 | 832 ------------------ 4 files changed, 132 insertions(+), 1270 deletions(-) diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index ca054b0afa..b369a0da47 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -1690,99 +1690,19 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) select case (ModData%ID) case (Module_AD) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call AD_CopyInput(T%AD%Input_Saved(-iSrc), T%AD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call AD_CopyInput(T%AD%Input_Saved(-iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_ADsk) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call ADsk_CopyInput(T%ADsk%Input_Saved(-iSrc), T%ADsk%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call ADsk_CopyInput(T%ADsk%Input_Saved(-iSrc), T%ADsk%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call ADsk_CopyInput(T%ADsk%Input(iSrc), T%ADsk%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call ADsk_CopyInput(T%ADsk%Input(iSrc), T%ADsk%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call ADsk_CopyInput(T%ADsk%Input(iSrc), T%ADsk%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_BD) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call BD_CopyInput(T%BD%Input_Saved(-iSrc, ModData%Ins), T%BD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call BD_CopyInput(T%BD%Input_Saved(-iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) case (Module_ED) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call ED_CopyInput(T%ED%Input_Saved(-iSrc), T%ED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call ED_CopyInput(T%ED%Input_Saved(-iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_SED) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call SED_CopyInput(T%SED%Input_Saved(-iSrc), T%SED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call SED_CopyInput(T%SED%Input_Saved(-iSrc), T%SED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call SED_CopyInput(T%SED%Input(iSrc), T%SED%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call SED_CopyInput(T%SED%Input(iSrc), T%SED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call SED_CopyInput(T%SED%Input(iSrc), T%SED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_ExtLd) ! ExtLd only has u @@ -1790,234 +1710,42 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) ErrMsg2 = '' case (Module_ExtPtfm) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call ExtPtfm_CopyInput(T%ExtPtfm%Input_Saved(-iSrc), T%ExtPtfm%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call ExtPtfm_CopyInput(T%ExtPtfm%Input_Saved(-iSrc), T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_FEAM) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call FEAM_CopyInput(T%FEAM%Input_Saved(-iSrc), T%FEAM%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call FEAM_CopyInput(T%FEAM%Input_Saved(-iSrc), T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_HD) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call HydroDyn_CopyInput(T%HD%Input_Saved(-iSrc), T%HD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call HydroDyn_CopyInput(T%HD%Input_Saved(-iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_IceD) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call IceD_CopyInput(T%IceD%Input_Saved(-iSrc, ModData%Ins), T%IceD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call IceD_CopyInput(T%IceD%Input_Saved(-iSrc, ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%Input_Saved(-iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) case (Module_IceF) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call IceFloe_CopyInput(T%IceF%Input_Saved(-iSrc), T%IceF%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call IceFloe_CopyInput(T%IceF%Input_Saved(-iSrc), T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_IfW) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call InflowWind_CopyInput(T%IfW%Input_Saved(-iSrc), T%IfW%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call InflowWind_CopyInput(T%IfW%Input_Saved(-iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_MAP) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call MAP_CopyInput(T%MAP%Input_Saved(-iSrc), T%MAP%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call MAP_CopyInput(T%MAP%Input_Saved(-iSrc), T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_MD) + call MD_CopyInput(T%MD%Input(iSrc), T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call MD_CopyInput(T%MD%Input_Saved(-iSrc), T%MD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call MD_CopyInput(T%MD%Input_Saved(-iSrc), T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call MD_CopyInput(T%MD%Input(iSrc), T%MD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call MD_CopyInput(T%MD%Input(iSrc), T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select - - ! case (Module_ExtInfw) +! case (Module_ExtInfw) case (Module_Orca) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call Orca_CopyInput(T%Orca%Input_Saved(-iSrc), T%Orca%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call Orca_CopyInput(T%Orca%Input_Saved(-iSrc), T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_SD) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call SD_CopyInput(T%SD%Input_Saved(-iSrc), T%SD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call SD_CopyInput(T%SD%Input_Saved(-iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_SeaSt) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call SeaSt_CopyInput(T%SeaSt%Input_Saved(-iSrc), T%SeaSt%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call SeaSt_CopyInput(T%SeaSt%Input_Saved(-iSrc), T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case (Module_SrvD) - - select case (iSrc) - case (:-1) - select case (iDst) - case (:-1) - call SrvD_CopyInput(T%SrvD%Input_Saved(-iSrc), T%SrvD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call SrvD_CopyInput(T%SrvD%Input_Saved(-iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - case (0:) - select case (iDst) - case (:-1) - call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input_Saved(-iDst), CtrlCode, Errstat2, ErrMsg2) - case (0:) - call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) - end select - end select + call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) case default ErrStat2 = ErrID_Fatal diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index dfba2197f4..c3272cb1cf 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -421,7 +421,6 @@ typedef ^ ^ IceD_InputType u {:} - - "System inputs" typedef ^ ^ IceD_OutputType y {:} - - "System outputs" typedef ^ ^ IceD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ IceD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ IceD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" # ..... BeamDyn data ....................................................................................................... @@ -439,7 +438,6 @@ typedef ^ ^ BD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ BD_OutputType Output {:}{:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ BD_OutputType y_interp {:} - - "interpolated system outputs for CalcSteady" typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ BD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" # ..... ElastoDyn data ....................................................................................................... @@ -456,7 +454,6 @@ typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcS typedef ^ ^ ED_OutputType Output_bak {:} - - "Backup Array of outputs associated with InputTimes" typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ ED_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -472,7 +469,6 @@ typedef ^ ^ SED_MiscVarType m - - - "Misc (optimization) variables not associate typedef ^ ^ SED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SED_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SED_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -489,7 +485,6 @@ typedef ^ ^ SrvD_MiscVarType m_bak - - - "Backup Misc (optimization) variables n typedef ^ ^ SrvD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SrvD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SrvD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SrvD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... AeroDyn data ....................................................................................................... @@ -504,7 +499,6 @@ typedef ^ ^ AD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ AD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ AD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ AD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ AD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... ExtLoads data ....................................................................................................... @@ -530,7 +524,6 @@ typedef ^ ^ ADsk_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ADsk_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ ADsk_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ADsk_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ ADsk_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... InflowWind data ....................................................................................................... @@ -545,7 +538,6 @@ typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ InflowWind_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ InflowWind_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ InflowWind_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ InflowWind_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... ExternalInflow integration data ....................................................................................................... @@ -570,7 +562,6 @@ typedef ^ ^ SD_InputType u - - - "System inputs" typedef ^ ^ SD_OutputType y - - - "System outputs" typedef ^ ^ SD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ SD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -585,7 +576,6 @@ typedef ^ ^ ExtPtfm_InputType u - - - "System inputs" typedef ^ ^ ExtPtfm_OutputType y - - - "System outputs" typedef ^ ^ ExtPtfm_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ExtPtfm_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ ExtPtfm_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... SeaState data ....................................................................................................... @@ -598,7 +588,6 @@ typedef ^ ^ SeaSt_InputType u - - - "System inputs" typedef ^ ^ SeaSt_OutputType y - - - "System outputs" typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SeaSt_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SeaSt_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ SeaSt_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SeaSt_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -616,7 +605,6 @@ typedef ^ ^ HydroDyn_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ HydroDyn_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ HydroDyn_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ HydroDyn_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ HydroDyn_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... IceFloe data ....................................................................................................... @@ -629,7 +617,6 @@ typedef ^ ^ IceFloe_InputType u - - - "System inputs" typedef ^ ^ IceFloe_OutputType y - - - "System outputs" typedef ^ ^ IceFloe_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ IceFloe_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ IceFloe_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... MAP data ....................................................................................................... @@ -645,7 +632,6 @@ typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (cop typedef ^ ^ MAP_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MAP_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ MAP_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... FEAMooring data ....................................................................................................... @@ -658,7 +644,6 @@ typedef ^ ^ FEAM_InputType u - - - "System inputs" typedef ^ ^ FEAM_OutputType y - - - "System outputs" typedef ^ ^ FEAM_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ FEAM_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ FEAM_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... MoorDyn data ....................................................................................................... @@ -673,7 +658,6 @@ typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ MD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ MD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... OrcaFlex data ....................................................................................................... @@ -686,7 +670,6 @@ typedef ^ ^ Orca_InputType u - - - "System inputs" typedef ^ ^ Orca_OutputType y - - - "System outputs" typedef ^ ^ Orca_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ Orca_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ Orca_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... FAST_ModuleMapType data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index b88294cf92..a70492fcb3 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -240,11 +240,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ! Module data arrays !---------------------------------------------------------------------------- - ! Module data input arrays are interpolation order plus 1 + ! Input array upper bound is interpolation order plus 1 InputAryUB = p_FAST%InterpOrder + 1 - ! Input saved arrays have storage for InputArray size + linearization - InputAryLB = InputAryUB + max(p_FAST%NLinTimes, 2) + ! Input array lower bound is negative (sum of linearization times and upper bound) + InputAryLB = -(InputAryUB + max(p_FAST%NLinTimes, 2)) ! Module data state arrays include data at linearization times after ! STATE_CURR, STATE_PRED, STATE_SAVED_CURR, and STATE_SAVED_PRED @@ -265,13 +265,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE case (Module_SED) ! Simplified-ElastoDyn - allocate(SED%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("SED%Input")) return - allocate(SED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SED%InputTimes")) return - allocate(ED%Input_Saved (InputAryLB ), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return - allocate(SED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%x")) return - allocate(SED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%xd")) return - allocate(SED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%z")) return - allocate(SED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%OtherSt")) return + allocate(SED%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SED%Input")) return + allocate(SED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SED%InputTimes")) return + allocate(SED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%x")) return + allocate(SED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%xd")) return + allocate(SED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%z")) return + allocate(SED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%OtherSt")) return Init%InData_SED%Linearize = p_FAST%Linearize Init%InData_SED%InputFile = p_FAST%EDFile @@ -293,13 +292,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE case default ! ElastoDyn ! Allocate module data arrays - allocate(ED%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("ED%Input")) return - allocate(ED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return - allocate(ED%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("ED%Input_Saved")) return - allocate(ED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%x")) return - allocate(ED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return - allocate(ED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%z")) return - allocate(ED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return + allocate(ED%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("ED%Input")) return + allocate(ED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return + allocate(ED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%x")) return + allocate(ED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return + allocate(ED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%z")) return + allocate(ED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return ! Set initialization input Init%InData_ED%Linearize = p_FAST%Linearize @@ -355,18 +353,18 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE end if ! Allocate module data arrays - allocate(BD%Input (0:InputAryUB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input")) return - allocate(BD%InputTimes (InputAryUB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%InputTimes")) return - allocate(BD%Input_Saved (InputAryLB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input_Saved")) return - allocate(BD%x (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%x")) return - allocate(BD%xd (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%xd")) return - allocate(BD%z (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%z")) return - allocate(BD%OtherSt (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return - allocate(BD%p (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%p")) return - allocate(BD%u (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%u")) return - allocate(BD%y (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%y")) return - allocate(BD%m (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%m")) return - allocate(Init%OutData_BD (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("Init%OutData_BD")) return + allocate(BD%Input (InputAryLB:InputAryUB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input")) return + allocate(BD%InputTimes (InputAryUB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%InputTimes")) return + allocate(BD%x (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%x")) return + allocate(BD%xd (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%xd")) return + allocate(BD%z (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%z")) return + allocate(BD%OtherSt (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return + allocate(BD%p (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%p")) return + allocate(BD%u (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%u")) return + allocate(BD%y (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%y")) return + allocate(BD%m (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%m")) return + + allocate(Init%OutData_BD (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("Init%OutData_BD")) return if (p_FAST%CompElast == Module_BD) then @@ -429,13 +427,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(IfW%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return - allocate(IfW%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return - allocate(IfW%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("IfW%Input_Saved")) return - allocate(IfW%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return - allocate(IfW%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return - allocate(IfW%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return - allocate(IfW%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return + allocate(IfW%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return + allocate(IfW%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return + allocate(IfW%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return + allocate(IfW%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return + allocate(IfW%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return + allocate(IfW%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return select case(p_FAST%CompInflow) case (Module_IfW) @@ -581,13 +578,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SeaSt%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return - allocate(SeaSt%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return - allocate(SeaSt%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("SeaSt%Input_Saved")) return - allocate(SeaSt%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return - allocate(SeaSt%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return - allocate(SeaSt%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return - allocate(SeaSt%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return + allocate(SeaSt%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return + allocate(SeaSt%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return + allocate(SeaSt%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return + allocate(SeaSt%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return + allocate(SeaSt%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return + allocate(SeaSt%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return if ( p_FAST%CompSeaSt == Module_SeaSt ) then @@ -640,13 +636,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE case (Module_AD, Module_ExtLd) ! Allocate module data arrays - allocate(AD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("AD%Input")) return - allocate(AD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return - allocate(AD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("AD%Input_Saved")) return - allocate(AD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%x")) return - allocate(AD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return - allocate(AD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%z")) return - allocate(AD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return + allocate(AD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("AD%Input")) return + allocate(AD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return + allocate(AD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%x")) return + allocate(AD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return + allocate(AD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%z")) return + allocate(AD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return allocate(Init%InData_AD%rotors(1), stat=ErrStat2); if (FailedAlloc("AD%Init%InData_AD%rotors(1)")) return @@ -735,13 +730,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE case (Module_ADsk) ! Allocate module data arrays - allocate(ADsk%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%Input")) return - allocate(ADsk%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%InputTimes")) return - allocate(ADsk%Input_Saved (InputAryLB ), stat=ErrStat2); if (FailedAlloc("ADsk%Input_Saved")) return - allocate(ADsk%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%x")) return - allocate(ADsk%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%xd")) return - allocate(ADsk%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%z")) return - allocate(ADsk%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%OtherSt")) return + allocate(ADsk%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("ADsk%Input")) return + allocate(ADsk%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%InputTimes")) return + allocate(ADsk%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%x")) return + allocate(ADsk%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%xd")) return + allocate(ADsk%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%z")) return + allocate(ADsk%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%OtherSt")) return Init%InData_ADsk%InputFile = p_FAST%AeroFile Init%InData_ADsk%RootName = p_FAST%OutFileRoot @@ -828,13 +822,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(HD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("HD%Input")) return - allocate(HD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("HD%InputTimes")) return - allocate(HD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("HD%Input_Saved")) return - allocate(HD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%x")) return - allocate(HD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%xd")) return - allocate(HD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%z")) return - allocate(HD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%OtherSt")) return + allocate(HD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("HD%Input")) return + allocate(HD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("HD%InputTimes")) return + allocate(HD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%x")) return + allocate(HD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%xd")) return + allocate(HD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%z")) return + allocate(HD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%OtherSt")) return IF (p_FAST%CompHydro == Module_HD) THEN @@ -866,22 +859,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("SD%Input")) return - allocate(SD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SD%InputTimes")) return - allocate(SD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("SD%Input_Saved")) return - allocate(SD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%x")) return - allocate(SD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%xd")) return - allocate(SD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%z")) return - allocate(SD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%OtherSt")) return + allocate(SD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SD%Input")) return + allocate(SD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SD%InputTimes")) return + allocate(SD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%x")) return + allocate(SD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%xd")) return + allocate(SD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%z")) return + allocate(SD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%OtherSt")) return ! Allocate module data arrays - allocate(ExtPtfm%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input")) return - allocate(ExtPtfm%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%InputTimes")) return - allocate(ExtPtfm%Input_Saved(InputAryLB), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input_Saved")) return - allocate(ExtPtfm%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%x")) return - allocate(ExtPtfm%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%xd")) return - allocate(ExtPtfm%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%z")) return - allocate(ExtPtfm%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%OtherSt")) return + allocate(ExtPtfm%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input")) return + allocate(ExtPtfm%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%InputTimes")) return + allocate(ExtPtfm%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%x")) return + allocate(ExtPtfm%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%xd")) return + allocate(ExtPtfm%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%z")) return + allocate(ExtPtfm%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%OtherSt")) return select case (p_FAST%CompSub) @@ -935,40 +926,35 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(MAPp%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%Input")) return - allocate(MAPp%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%InputTimes")) return - allocate(MAPp%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("MAPp%Input_Saved")) return - allocate(MAPp%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%x")) return - allocate(MAPp%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%xd")) return - allocate(MAPp%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%z")) return - ! allocate(MAPp%OtherSt (StateArySize ), stat=ErrStat2); if (FailedAlloc("MAPp%OtherSt")) return + allocate(MAPp%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("MAPp%Input")) return + allocate(MAPp%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%InputTimes")) return + allocate(MAPp%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%x")) return + allocate(MAPp%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%xd")) return + allocate(MAPp%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%z")) return ! Allocate module data arrays - allocate(MD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("MD%Input")) return - allocate(MD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("MD%InputTimes")) return - allocate(MD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("MD%Input_Saved")) return - allocate(MD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%x")) return - allocate(MD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%xd")) return - allocate(MD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%z")) return - allocate(MD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%OtherSt")) return + allocate(MD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("MD%Input")) return + allocate(MD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("MD%InputTimes")) return + allocate(MD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%x")) return + allocate(MD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%xd")) return + allocate(MD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%z")) return + allocate(MD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%OtherSt")) return ! Allocate module data arrays - allocate(FEAM%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%Input")) return - allocate(FEAM%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%InputTimes")) return - allocate(FEAM%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("FEAM%Input_Saved")) return - allocate(FEAM%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%x")) return - allocate(FEAM%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%xd")) return - allocate(FEAM%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%z")) return - allocate(FEAM%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%OtherSt")) return + allocate(FEAM%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("FEAM%Input")) return + allocate(FEAM%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%InputTimes")) return + allocate(FEAM%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%x")) return + allocate(FEAM%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%xd")) return + allocate(FEAM%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%z")) return + allocate(FEAM%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%OtherSt")) return ! Allocate module data arrays - allocate(Orca%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%Input")) return - allocate(Orca%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%InputTimes")) return - allocate(Orca%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("Orca%Input_Saved")) return - allocate(Orca%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%x")) return - allocate(Orca%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%xd")) return - allocate(Orca%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%z")) return - allocate(Orca%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%OtherSt")) return + allocate(Orca%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("Orca%Input")) return + allocate(Orca%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%InputTimes")) return + allocate(Orca%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%x")) return + allocate(Orca%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%xd")) return + allocate(Orca%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%z")) return + allocate(Orca%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%OtherSt")) return select case (p_FAST%CompMooring) @@ -1081,13 +1067,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !------------------------------------- ! Allocate module data arrays - allocate(IceF%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%Input")) return - allocate(IceF%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%InputTimes")) return - allocate(IceF%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("IceF%Input_Saved")) return - allocate(IceF%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%x")) return - allocate(IceF%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%xd")) return - allocate(IceF%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%z")) return - allocate(IceF%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%OtherSt")) return + allocate(IceF%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("IceF%Input")) return + allocate(IceF%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%InputTimes")) return + allocate(IceF%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%x")) return + allocate(IceF%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%xd")) return + allocate(IceF%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%z")) return + allocate(IceF%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%OtherSt")) return IF (p_FAST%CompIce == Module_IceF) THEN @@ -1120,17 +1105,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE IF (p_FAST%CompIce == Module_IceD) IceDim = IceD_MaxLegs ! Allocate module data arrays - allocate(IceD%Input (0:InputAryUB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input")) return - allocate(IceD%InputTimes (InputAryUB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%InputTimes")) return - allocate(IceD%Input_Saved (InputAryLB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input_Saved")) return - allocate(IceD%x (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%x")) return - allocate(IceD%xd (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%xd")) return - allocate(IceD%z (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%z")) return - allocate(IceD%OtherSt (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return - allocate(IceD%p (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%p")) return - allocate(IceD%u (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%u")) return - allocate(IceD%y (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%y")) return - allocate(IceD%m (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%m")) return + allocate(IceD%Input (InputAryLB:InputAryUB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input")) return + allocate(IceD%InputTimes (InputAryUB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%InputTimes")) return + allocate(IceD%x (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%x")) return + allocate(IceD%xd (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%xd")) return + allocate(IceD%z (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%z")) return + allocate(IceD%OtherSt (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return + allocate(IceD%p (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%p")) return + allocate(IceD%u (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%u")) return + allocate(IceD%y (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%y")) return + allocate(IceD%m (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%m")) return IF (p_FAST%CompIce == Module_IceD) THEN @@ -1191,13 +1175,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- ! Allocate module data arrays - allocate(SrvD%Input (0:InputAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%Input")) return - allocate(SrvD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%InputTimes")) return - allocate(SrvD%Input_Saved (InputAryLB), stat=ErrStat2); if (FailedAlloc("SrvD%Input_Saved")) return - allocate(SrvD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%x")) return - allocate(SrvD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%xd")) return - allocate(SrvD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%z")) return - allocate(SrvD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%OtherSt")) return + allocate(SrvD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SrvD%Input")) return + allocate(SrvD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%InputTimes")) return + allocate(SrvD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%x")) return + allocate(SrvD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%xd")) return + allocate(SrvD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%z")) return + allocate(SrvD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%OtherSt")) return IF ( p_FAST%CompServo == Module_SrvD ) THEN diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 349ad7ec43..e25f4d1aa7 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -413,7 +413,6 @@ MODULE FAST_Types TYPE(IceD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(IceD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE IceDyn_Data ! ======================= @@ -431,7 +430,6 @@ MODULE FAST_Types TYPE(BD_OutputType) , DIMENSION(:,:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE BeamDyn_Data ! ======================= @@ -450,7 +448,6 @@ MODULE FAST_Types TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output_bak !< Backup Array of outputs associated with InputTimes [-] TYPE(ED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ElastoDyn_Data ! ======================= @@ -467,7 +464,6 @@ MODULE FAST_Types TYPE(SED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE SED_Data ! ======================= @@ -485,7 +481,6 @@ MODULE FAST_Types TYPE(SrvD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SrvD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ServoDyn_Data ! ======================= @@ -502,7 +497,6 @@ MODULE FAST_Types TYPE(AD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(AD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE AeroDyn_Data ! ======================= @@ -532,7 +526,6 @@ MODULE FAST_Types TYPE(ADsk_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(ADsk_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ADsk_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(ADsk_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE AeroDisk_Data ! ======================= @@ -549,7 +542,6 @@ MODULE FAST_Types TYPE(InflowWind_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(InflowWind_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE InflowWind_Data ! ======================= @@ -580,7 +572,6 @@ MODULE FAST_Types TYPE(SD_OutputType) :: y !< System outputs [-] TYPE(SD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] TYPE(SD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] @@ -597,7 +588,6 @@ MODULE FAST_Types TYPE(ExtPtfm_OutputType) :: y !< System outputs [-] TYPE(ExtPtfm_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ExtPtfm_Data ! ======================= @@ -612,7 +602,6 @@ MODULE FAST_Types TYPE(SeaSt_OutputType) :: y !< System outputs [-] TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] TYPE(SeaSt_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SeaSt_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] @@ -632,7 +621,6 @@ MODULE FAST_Types TYPE(HydroDyn_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(HydroDyn_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE HydroDyn_Data ! ======================= @@ -647,7 +635,6 @@ MODULE FAST_Types TYPE(IceFloe_OutputType) :: y !< System outputs [-] TYPE(IceFloe_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE IceFloe_Data ! ======================= @@ -665,7 +652,6 @@ MODULE FAST_Types TYPE(MAP_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MAP_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE MAP_Data ! ======================= @@ -680,7 +666,6 @@ MODULE FAST_Types TYPE(FEAM_OutputType) :: y !< System outputs [-] TYPE(FEAM_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE FEAMooring_Data ! ======================= @@ -697,7 +682,6 @@ MODULE FAST_Types TYPE(MD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE MoorDyn_Data ! ======================= @@ -712,7 +696,6 @@ MODULE FAST_Types TYPE(Orca_OutputType) :: y !< System outputs [-] TYPE(Orca_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE OrcaFlex_Data ! ======================= @@ -6377,24 +6360,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end do end if - if (allocated(SrcIceDyn_DataData%Input_Saved)) then - LB(1:2) = lbound(SrcIceDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstIceDyn_DataData%Input_Saved)) then - allocate(DstIceDyn_DataData%Input_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyInput(SrcIceDyn_DataData%Input_Saved(i1,i2), DstIceDyn_DataData%Input_Saved(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if if (allocated(SrcIceDyn_DataData%InputTimes)) then LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes, kind=B8Ki) UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes, kind=B8Ki) @@ -6511,17 +6476,6 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) end do deallocate(IceDyn_DataData%Input) end if - if (allocated(IceDyn_DataData%Input_Saved)) then - LB(1:2) = lbound(IceDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%Input_Saved, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyInput(IceDyn_DataData%Input_Saved(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(IceDyn_DataData%Input_Saved) - end if if (allocated(IceDyn_DataData%InputTimes)) then deallocate(IceDyn_DataData%InputTimes) end if @@ -6625,17 +6579,6 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end do end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 2, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:2) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:2) = ubound(InData%Input_Saved, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackInput(RF, InData%Input_Saved(i1,i2)) - end do - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6776,21 +6719,6 @@ subroutine FAST_UnPackIceDyn_Data(RF, OutData) end do end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackInput(RF, OutData%Input_Saved(i1,i2)) ! Input_Saved - end do - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7011,24 +6939,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end do end if - if (allocated(SrcBeamDyn_DataData%Input_Saved)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstBeamDyn_DataData%Input_Saved)) then - allocate(DstBeamDyn_DataData%Input_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyInput(SrcBeamDyn_DataData%Input_Saved(i1,i2), DstBeamDyn_DataData%Input_Saved(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if if (allocated(SrcBeamDyn_DataData%InputTimes)) then LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes, kind=B8Ki) UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes, kind=B8Ki) @@ -7174,17 +7084,6 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%Input) end if - if (allocated(BeamDyn_DataData%Input_Saved)) then - LB(1:2) = lbound(BeamDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%Input_Saved, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyInput(BeamDyn_DataData%Input_Saved(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(BeamDyn_DataData%Input_Saved) - end if if (allocated(BeamDyn_DataData%InputTimes)) then deallocate(BeamDyn_DataData%InputTimes) end if @@ -7317,17 +7216,6 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end do end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 2, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:2) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:2) = ubound(InData%Input_Saved, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackInput(RF, InData%Input_Saved(i1,i2)) - end do - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7509,21 +7397,6 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) end do end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackInput(RF, OutData%Input_Saved(i1,i2)) ! Input_Saved - end do - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7670,22 +7543,6 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcElastoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstElastoDyn_DataData%Input_Saved)) then - allocate(DstElastoDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ED_CopyInput(SrcElastoDyn_DataData%Input_Saved(i1), DstElastoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcElastoDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes, kind=B8Ki) @@ -7786,15 +7643,6 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) end do deallocate(ElastoDyn_DataData%Input) end if - if (allocated(ElastoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(ElastoDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyInput(ElastoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ElastoDyn_DataData%Input_Saved) - end if if (allocated(ElastoDyn_DataData%InputTimes)) then deallocate(ElastoDyn_DataData%InputTimes) end if @@ -7876,15 +7724,6 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) call ED_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7995,19 +7834,6 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) call ED_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8135,22 +7961,6 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSED_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcSED_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstSED_DataData%Input_Saved)) then - allocate(DstSED_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SED_CopyInput(SrcSED_DataData%Input_Saved(i1), DstSED_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcSED_DataData%InputTimes)) then LB(1:1) = lbound(SrcSED_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcSED_DataData%InputTimes, kind=B8Ki) @@ -8240,15 +8050,6 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) end do deallocate(SED_DataData%Input) end if - if (allocated(SED_DataData%Input_Saved)) then - LB(1:1) = lbound(SED_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_DestroyInput(SED_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SED_DataData%Input_Saved) - end if if (allocated(SED_DataData%InputTimes)) then deallocate(SED_DataData%InputTimes) end if @@ -8320,15 +8121,6 @@ subroutine FAST_PackSED_Data(RF, Indata) call SED_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8425,19 +8217,6 @@ subroutine FAST_UnPackSED_Data(RF, OutData) call SED_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SED_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8568,22 +8347,6 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcServoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstServoDyn_DataData%Input_Saved)) then - allocate(DstServoDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SrvD_CopyInput(SrcServoDyn_DataData%Input_Saved(i1), DstServoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcServoDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes, kind=B8Ki) @@ -8675,15 +8438,6 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) end do deallocate(ServoDyn_DataData%Input) end if - if (allocated(ServoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(ServoDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyInput(ServoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ServoDyn_DataData%Input_Saved) - end if if (allocated(ServoDyn_DataData%InputTimes)) then deallocate(ServoDyn_DataData%InputTimes) end if @@ -8756,15 +8510,6 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) call SrvD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8862,19 +8607,6 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) call SrvD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9002,22 +8734,6 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcAeroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstAeroDyn_DataData%Input_Saved)) then - allocate(DstAeroDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyInput(SrcAeroDyn_DataData%Input_Saved(i1), DstAeroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcAeroDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes, kind=B8Ki) @@ -9107,15 +8823,6 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) end do deallocate(AeroDyn_DataData%Input) end if - if (allocated(AeroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(AeroDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyInput(AeroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(AeroDyn_DataData%Input_Saved) - end if if (allocated(AeroDyn_DataData%InputTimes)) then deallocate(AeroDyn_DataData%InputTimes) end if @@ -9187,15 +8894,6 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) call AD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9292,19 +8990,6 @@ subroutine FAST_UnPackAeroDyn_Data(RF, OutData) call AD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9618,22 +9303,6 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcAeroDisk_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstAeroDisk_DataData%Input_Saved)) then - allocate(DstAeroDisk_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ADsk_CopyInput(SrcAeroDisk_DataData%Input_Saved(i1), DstAeroDisk_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcAeroDisk_DataData%InputTimes)) then LB(1:1) = lbound(SrcAeroDisk_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcAeroDisk_DataData%InputTimes, kind=B8Ki) @@ -9723,15 +9392,6 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) end do deallocate(AeroDisk_DataData%Input) end if - if (allocated(AeroDisk_DataData%Input_Saved)) then - LB(1:1) = lbound(AeroDisk_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_DestroyInput(AeroDisk_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(AeroDisk_DataData%Input_Saved) - end if if (allocated(AeroDisk_DataData%InputTimes)) then deallocate(AeroDisk_DataData%InputTimes) end if @@ -9803,15 +9463,6 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) call ADsk_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9908,19 +9559,6 @@ subroutine FAST_UnPackAeroDisk_Data(RF, OutData) call ADsk_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ADsk_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -10048,22 +9686,6 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInflowWind_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstInflowWind_DataData%Input_Saved)) then - allocate(DstInflowWind_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyInput(SrcInflowWind_DataData%Input_Saved(i1), DstInflowWind_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcInflowWind_DataData%InputTimes)) then LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes, kind=B8Ki) @@ -10153,15 +9775,6 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) end do deallocate(InflowWind_DataData%Input) end if - if (allocated(InflowWind_DataData%Input_Saved)) then - LB(1:1) = lbound(InflowWind_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyInput(InflowWind_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InflowWind_DataData%Input_Saved) - end if if (allocated(InflowWind_DataData%InputTimes)) then deallocate(InflowWind_DataData%InputTimes) end if @@ -10233,15 +9846,6 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) call InflowWind_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -10338,19 +9942,6 @@ subroutine FAST_UnPackInflowWind_Data(RF, OutData) call InflowWind_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -10589,22 +10180,6 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSubDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcSubDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstSubDyn_DataData%Input_Saved)) then - allocate(DstSubDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyInput(SrcSubDyn_DataData%Input_Saved(i1), DstSubDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcSubDyn_DataData%Output)) then LB(1:1) = lbound(SrcSubDyn_DataData%Output, kind=B8Ki) UB(1:1) = ubound(SrcSubDyn_DataData%Output, kind=B8Ki) @@ -10704,15 +10279,6 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) end do deallocate(SubDyn_DataData%Input) end if - if (allocated(SubDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SubDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyInput(SubDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SubDyn_DataData%Input_Saved) - end if if (allocated(SubDyn_DataData%Output)) then LB(1:1) = lbound(SubDyn_DataData%Output, kind=B8Ki) UB(1:1) = ubound(SubDyn_DataData%Output, kind=B8Ki) @@ -10786,15 +10352,6 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) call SD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) @@ -10888,19 +10445,6 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) call SD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -11023,22 +10567,6 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcExtPtfm_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstExtPtfm_DataData%Input_Saved)) then - allocate(DstExtPtfm_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyInput(SrcExtPtfm_DataData%Input_Saved(i1), DstExtPtfm_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcExtPtfm_DataData%InputTimes)) then LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes, kind=B8Ki) @@ -11117,15 +10645,6 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) end do deallocate(ExtPtfm_DataData%Input) end if - if (allocated(ExtPtfm_DataData%Input_Saved)) then - LB(1:1) = lbound(ExtPtfm_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ExtPtfm_DataData%Input_Saved) - end if if (allocated(ExtPtfm_DataData%InputTimes)) then deallocate(ExtPtfm_DataData%InputTimes) end if @@ -11187,15 +10706,6 @@ subroutine FAST_PackExtPtfm_Data(RF, Indata) call ExtPtfm_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11278,19 +10788,6 @@ subroutine FAST_UnPackExtPtfm_Data(RF, OutData) call ExtPtfm_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11399,22 +10896,6 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSeaState_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcSeaState_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstSeaState_DataData%Input_Saved)) then - allocate(DstSeaState_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyInput(SrcSeaState_DataData%Input_Saved(i1), DstSeaState_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcSeaState_DataData%Output)) then LB(1:1) = lbound(SrcSeaState_DataData%Output, kind=B8Ki) UB(1:1) = ubound(SrcSeaState_DataData%Output, kind=B8Ki) @@ -11512,15 +10993,6 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) end do deallocate(SeaState_DataData%Input) end if - if (allocated(SeaState_DataData%Input_Saved)) then - LB(1:1) = lbound(SeaState_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyInput(SeaState_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SeaState_DataData%Input_Saved) - end if if (allocated(SeaState_DataData%Output)) then LB(1:1) = lbound(SeaState_DataData%Output, kind=B8Ki) UB(1:1) = ubound(SeaState_DataData%Output, kind=B8Ki) @@ -11593,15 +11065,6 @@ subroutine FAST_PackSeaState_Data(RF, Indata) call SeaSt_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) @@ -11694,19 +11157,6 @@ subroutine FAST_UnPackSeaState_Data(RF, OutData) call SeaSt_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -11851,22 +11301,6 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcHydroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstHydroDyn_DataData%Input_Saved)) then - allocate(DstHydroDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input_Saved(i1), DstHydroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcHydroDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes, kind=B8Ki) @@ -11958,15 +11392,6 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) end do deallocate(HydroDyn_DataData%Input) end if - if (allocated(HydroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(HydroDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyInput(HydroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(HydroDyn_DataData%Input_Saved) - end if if (allocated(HydroDyn_DataData%InputTimes)) then deallocate(HydroDyn_DataData%InputTimes) end if @@ -12039,15 +11464,6 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) call HydroDyn_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12145,19 +11561,6 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) call HydroDyn_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12266,22 +11669,6 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcIceFloe_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcIceFloe_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstIceFloe_DataData%Input_Saved)) then - allocate(DstIceFloe_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyInput(SrcIceFloe_DataData%Input_Saved(i1), DstIceFloe_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcIceFloe_DataData%InputTimes)) then LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes, kind=B8Ki) @@ -12360,15 +11747,6 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) end do deallocate(IceFloe_DataData%Input) end if - if (allocated(IceFloe_DataData%Input_Saved)) then - LB(1:1) = lbound(IceFloe_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyInput(IceFloe_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(IceFloe_DataData%Input_Saved) - end if if (allocated(IceFloe_DataData%InputTimes)) then deallocate(IceFloe_DataData%InputTimes) end if @@ -12430,15 +11808,6 @@ subroutine FAST_PackIceFloe_Data(RF, Indata) call IceFloe_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12521,19 +11890,6 @@ subroutine FAST_UnPackIceFloe_Data(RF, OutData) call IceFloe_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12651,22 +12007,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMAP_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcMAP_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstMAP_DataData%Input_Saved)) then - allocate(DstMAP_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyInput(SrcMAP_DataData%Input_Saved(i1), DstMAP_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcMAP_DataData%InputTimes)) then LB(1:1) = lbound(SrcMAP_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcMAP_DataData%InputTimes, kind=B8Ki) @@ -12751,15 +12091,6 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) end do deallocate(MAP_DataData%Input) end if - if (allocated(MAP_DataData%Input_Saved)) then - LB(1:1) = lbound(MAP_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyInput(MAP_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MAP_DataData%Input_Saved) - end if if (allocated(MAP_DataData%InputTimes)) then deallocate(MAP_DataData%InputTimes) end if @@ -12824,15 +12155,6 @@ subroutine FAST_PackMAP_Data(RF, Indata) call MAP_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12918,19 +12240,6 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) call MAP_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -13039,22 +12348,6 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcFEAMooring_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstFEAMooring_DataData%Input_Saved)) then - allocate(DstFEAMooring_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyInput(SrcFEAMooring_DataData%Input_Saved(i1), DstFEAMooring_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcFEAMooring_DataData%InputTimes)) then LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes, kind=B8Ki) @@ -13133,15 +12426,6 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) end do deallocate(FEAMooring_DataData%Input) end if - if (allocated(FEAMooring_DataData%Input_Saved)) then - LB(1:1) = lbound(FEAMooring_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyInput(FEAMooring_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(FEAMooring_DataData%Input_Saved) - end if if (allocated(FEAMooring_DataData%InputTimes)) then deallocate(FEAMooring_DataData%InputTimes) end if @@ -13203,15 +12487,6 @@ subroutine FAST_PackFEAMooring_Data(RF, Indata) call FEAM_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -13294,19 +12569,6 @@ subroutine FAST_UnPackFEAMooring_Data(RF, OutData) call FEAM_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -13434,22 +12696,6 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMoorDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstMoorDyn_DataData%Input_Saved)) then - allocate(DstMoorDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyInput(SrcMoorDyn_DataData%Input_Saved(i1), DstMoorDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcMoorDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes, kind=B8Ki) @@ -13539,15 +12785,6 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) end do deallocate(MoorDyn_DataData%Input) end if - if (allocated(MoorDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(MoorDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyInput(MoorDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MoorDyn_DataData%Input_Saved) - end if if (allocated(MoorDyn_DataData%InputTimes)) then deallocate(MoorDyn_DataData%InputTimes) end if @@ -13619,15 +12856,6 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) call MD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -13724,19 +12952,6 @@ subroutine FAST_UnPackMoorDyn_Data(RF, OutData) call MD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -13845,22 +13060,6 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcOrcaFlex_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstOrcaFlex_DataData%Input_Saved)) then - allocate(DstOrcaFlex_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call Orca_CopyInput(SrcOrcaFlex_DataData%Input_Saved(i1), DstOrcaFlex_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcOrcaFlex_DataData%InputTimes)) then LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes, kind=B8Ki) @@ -13939,15 +13138,6 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) end do deallocate(OrcaFlex_DataData%Input) end if - if (allocated(OrcaFlex_DataData%Input_Saved)) then - LB(1:1) = lbound(OrcaFlex_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_DestroyInput(OrcaFlex_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OrcaFlex_DataData%Input_Saved) - end if if (allocated(OrcaFlex_DataData%InputTimes)) then deallocate(OrcaFlex_DataData%InputTimes) end if @@ -14009,15 +13199,6 @@ subroutine FAST_PackOrcaFlex_Data(RF, Indata) call Orca_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -14100,19 +13281,6 @@ subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) call Orca_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call Orca_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine From eb179da08cfb87afa9a965416f6ab0eee5d5336b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Nov 2024 19:41:32 +0000 Subject: [PATCH 280/319] Remove unused LinStateSave --- .../openfast-library/src/FAST_Registry.txt | 89 ------------------- 1 file changed, 89 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index c3272cb1cf..8c216c2a87 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -235,95 +235,6 @@ typedef ^ FAST_ParameterType ReKi Pitch {:} - - "List of pitch angles for aeroma typedef ^ FAST_ParameterType IntKi GearBox_index - - - "Index to gearbox rotation in state array (for steady-state calculations)" - -# SAVED OPERATING POINT DATA FOR VTKLIN (visualization of mode shapes from linearization analysis) -# ..... IceDyn OP data ....................................................................................................... -typedef FAST FAST_LinStateSave IceD_ContinuousStateType x_IceD {:}{:} - - "Continuous states" -typedef ^ ^ IceD_DiscreteStateType xd_IceD {:}{:} - - "Discrete states" -typedef ^ ^ IceD_ConstraintStateType z_IceD {:}{:} - - "Constraint states" -typedef ^ ^ IceD_OtherStateType OtherSt_IceD {:}{:} - - "Other states" -typedef ^ ^ IceD_InputType u_IceD {:}{:} - - "System inputs" -# ..... BeamDyn OP data ....................................................................................................... -typedef FAST FAST_LinStateSave BD_ContinuousStateType x_BD {:}{:} - - "Continuous states" -typedef ^ ^ BD_DiscreteStateType xd_BD {:}{:} - - "Discrete states" -typedef ^ ^ BD_ConstraintStateType z_BD {:}{:} - - "Constraint states" -typedef ^ ^ BD_OtherStateType OtherSt_BD {:}{:} - - "Other states" -typedef ^ ^ BD_InputType u_BD {:}{:} - - "System inputs" -# ..... ElastoDyn OP data ..................................................................................................... -typedef FAST FAST_LinStateSave ED_ContinuousStateType x_ED {:} - - "Continuous states" -typedef ^ ^ ED_DiscreteStateType xd_ED {:} - - "Discrete states" -typedef ^ ^ ED_ConstraintStateType z_ED {:} - - "Constraint states" -typedef ^ ^ ED_OtherStateType OtherSt_ED {:} - - "Other states" -typedef ^ ^ ED_InputType u_ED {:} - - "System inputs" -# ..... No Simplified-ElastoDyn data ........................................................................................... -# ..... ServoDyn OP data ....................................................................................................... -typedef FAST FAST_LinStateSave SrvD_ContinuousStateType x_SrvD {:} - - "Continuous states" -typedef ^ ^ SrvD_DiscreteStateType xd_SrvD {:} - - "Discrete states" -typedef ^ ^ SrvD_ConstraintStateType z_SrvD {:} - - "Constraint states" -typedef ^ ^ SrvD_OtherStateType OtherSt_SrvD {:} - - "Other states" -typedef ^ ^ SrvD_InputType u_SrvD {:} - - "System inputs" -# ..... AeroDyn OP data ....................................................................................................... -typedef FAST FAST_LinStateSave AD_ContinuousStateType x_AD {:} - - "Continuous states" -typedef ^ ^ AD_DiscreteStateType xd_AD {:} - - "Discrete states" -typedef ^ ^ AD_ConstraintStateType z_AD {:} - - "Constraint states" -typedef ^ ^ AD_OtherStateType OtherSt_AD {:} - - "Other states" -typedef ^ ^ AD_InputType u_AD {:} - - "System inputs" -# ..... No AeroDisk data ...................................................................................................... -# ..... InflowWind OP data .................................................................................................... -typedef FAST FAST_LinStateSave InflowWind_ContinuousStateType x_IfW {:} - - "Continuous states" -typedef ^ ^ InflowWind_DiscreteStateType xd_IfW {:} - - "Discrete states" -typedef ^ ^ InflowWind_ConstraintStateType z_IfW {:} - - "Constraint states" -typedef ^ ^ InflowWind_OtherStateType OtherSt_IfW {:} - - "Other states" -typedef ^ ^ InflowWind_InputType u_IfW {:} - - "System inputs" -# ..... No ExternalInflow integration data ....................................................................................................... -# ..... SubDyn OP data ....................................................................................................... -typedef FAST FAST_LinStateSave SD_ContinuousStateType x_SD {:} - - "Continuous states" -typedef ^ ^ SD_DiscreteStateType xd_SD {:} - - "Discrete states" -typedef ^ ^ SD_ConstraintStateType z_SD {:} - - "Constraint states" -typedef ^ ^ SD_OtherStateType OtherSt_SD {:} - - "Other states" -typedef ^ ^ SD_InputType u_SD {:} - - "System inputs" -# ..... ExtPtfm OP data ....................................................................................................... -typedef FAST FAST_LinStateSave ExtPtfm_ContinuousStateType x_ExtPtfm {:} - - "Continuous states" -typedef ^ ^ ExtPtfm_DiscreteStateType xd_ExtPtfm {:} - - "Discrete states" -typedef ^ ^ ExtPtfm_ConstraintStateType z_ExtPtfm {:} - - "Constraint states" -typedef ^ ^ ExtPtfm_OtherStateType OtherSt_ExtPtfm {:} - - "Other states" -typedef ^ ^ ExtPtfm_InputType u_ExtPtfm {:} - - "System inputs" -# ..... HydroDyn OP data ....................................................................................................... -typedef FAST FAST_LinStateSave HydroDyn_ContinuousStateType x_HD {:} - - "Continuous states" -typedef ^ ^ HydroDyn_DiscreteStateType xd_HD {:} - - "Discrete states" -typedef ^ ^ HydroDyn_ConstraintStateType z_HD {:} - - "Constraint states" -typedef ^ ^ HydroDyn_OtherStateType OtherSt_HD {:} - - "Other states" -typedef ^ ^ HydroDyn_InputType u_HD {:} - - "System inputs" -# ..... SeaSt OP data ....................................................................................................... -typedef FAST FAST_LinStateSave SeaSt_ContinuousStateType x_SeaSt {:} - - "Continuous states" -typedef ^ ^ SeaSt_DiscreteStateType xd_SeaSt {:} - - "Discrete states" -typedef ^ ^ SeaSt_ConstraintStateType z_SeaSt {:} - - "Constraint states" -typedef ^ ^ SeaSt_OtherStateType OtherSt_SeaSt {:} - - "Other states" -typedef ^ ^ SeaSt_InputType u_SeaSt {:} - - "System inputs" -# ..... IceFloe OP data ....................................................................................................... -typedef FAST FAST_LinStateSave IceFloe_ContinuousStateType x_IceF {:} - - "Continuous states" -typedef ^ ^ IceFloe_DiscreteStateType xd_IceF {:} - - "Discrete states" -typedef ^ ^ IceFloe_ConstraintStateType z_IceF {:} - - "Constraint states" -typedef ^ ^ IceFloe_OtherStateType OtherSt_IceF {:} - - "Other states" -typedef ^ ^ IceFloe_InputType u_IceF {:} - - "System inputs" -# ..... MAP OP data ....................................................................................................... -typedef FAST FAST_LinStateSave MAP_ContinuousStateType x_MAP {:} - - "Continuous states" -typedef ^ ^ MAP_DiscreteStateType xd_MAP {:} - - "Discrete states" -typedef ^ ^ MAP_ConstraintStateType z_MAP {:} - - "Constraint states" -#typedef ^ ^ MAP_OtherStateType OtherSt_MAP {:} - - "Other states" -typedef ^ ^ MAP_InputType u_MAP {:} - - "System inputs" -# ..... FEAMooring OP data ....................................................................................................... -typedef FAST FAST_LinStateSave FEAM_ContinuousStateType x_FEAM {:} - - "Continuous states" -typedef ^ ^ FEAM_DiscreteStateType xd_FEAM {:} - - "Discrete states" -typedef ^ ^ FEAM_ConstraintStateType z_FEAM {:} - - "Constraint states" -typedef ^ ^ FEAM_OtherStateType OtherSt_FEAM {:} - - "Other states" -typedef ^ ^ FEAM_InputType u_FEAM {:} - - "System inputs" -# ..... MoorDyn OP data ....................................................................................................... -typedef FAST FAST_LinStateSave MD_ContinuousStateType x_MD {:} - - "Continuous states" -typedef ^ ^ MD_DiscreteStateType xd_MD {:} - - "Discrete states" -typedef ^ ^ MD_ConstraintStateType z_MD {:} - - "Constraint states" -typedef ^ ^ MD_OtherStateType OtherSt_MD {:} - - "Other states" -typedef ^ ^ MD_InputType u_MD {:} - - "System inputs" -# ..... NO OrcaFlex OP data ....................................................................................................... # ..... FAST_LinType data ....................................................................................................... typedef FAST FAST_LinType CHARACTER(LinChanLen) Names_u {:} - - "Names of the linearized inputs" From bdf9b8b79cf7d63b023ca4c9a77b1cbcc6e4d83e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Nov 2024 19:41:56 +0000 Subject: [PATCH 281/319] Remove unnecessary u input in FAST_Types --- .../openfast-library/src/FAST_Registry.txt | 18 - modules/openfast-library/src/FAST_Subs.f90 | 2 - modules/openfast-library/src/FAST_Types.f90 | 3987 +---------------- 3 files changed, 159 insertions(+), 3848 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 8c216c2a87..482db2926d 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -314,7 +314,6 @@ typedef ^ FAST_OutputFileType IntKi VTK_count - - - "Number of VTK files written typedef ^ FAST_OutputFileType IntKi VTK_LastWaveIndx - - - "last index into wave array" - typedef ^ FAST_OutputFileType FAST_LinFileType Lin - - - "linearization data for output" typedef ^ FAST_OutputFileType IntKi ActualChanLen - - - "width of the column headers output in the text and/or binary file" - -typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {6} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnt {:} - - "units of data output from the driver" @@ -328,7 +327,6 @@ typedef ^ ^ IceD_DiscreteStateType xd {:}{:} - - "Discrete states" typedef ^ ^ IceD_ConstraintStateType z {:}{:} - - "Constraint states" typedef ^ ^ IceD_OtherStateType OtherSt {:}{:} - - "Other states" typedef ^ ^ IceD_ParameterType p {:} - - "Parameters" -typedef ^ ^ IceD_InputType u {:} - - "System inputs" typedef ^ ^ IceD_OutputType y {:} - - "System outputs" typedef ^ ^ IceD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ IceD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" @@ -343,7 +341,6 @@ typedef ^ ^ BD_DiscreteStateType xd {:}{:} - - "Discrete states" typedef ^ ^ BD_ConstraintStateType z {:}{:} - - "Constraint states" typedef ^ ^ BD_OtherStateType OtherSt {:}{:} - - "Other states" typedef ^ ^ BD_ParameterType p {:} - - "Parameters" -typedef ^ ^ BD_InputType u {:} - - "System inputs" typedef ^ ^ BD_OutputType y {:} - - "System outputs" typedef ^ ^ BD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ BD_OutputType Output {:}{:} - - "Array of outputs associated with CalcSteady Azimuths" @@ -358,7 +355,6 @@ typedef ^ ^ ED_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ ED_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ ED_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ED_ParameterType p - - - "Parameters" -typedef ^ ^ ED_InputType u - - - "System inputs" typedef ^ ^ ED_OutputType y - - - "System outputs" typedef ^ ^ ED_MiscVarType m - - - "Misc (optimization) variables not associated with time" typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" @@ -374,7 +370,6 @@ typedef ^ ^ SED_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ SED_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ SED_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SED_ParameterType p - - - "Parameters" -typedef ^ ^ SED_InputType u - - - "System inputs" typedef ^ ^ SED_OutputType y - - - "System outputs" typedef ^ ^ SED_MiscVarType m - - - "Misc (optimization) variables not associated with time" typedef ^ ^ SED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" @@ -389,7 +384,6 @@ typedef ^ ^ SrvD_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ SrvD_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ SrvD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SrvD_ParameterType p - - - "Parameters" -typedef ^ ^ SrvD_InputType u - - - "System inputs" typedef ^ ^ SrvD_OutputType y - - - "System outputs" typedef ^ ^ SrvD_MiscVarType m - - - "Misc (optimization) variables not associated with time" typedef ^ ^ SrvD_MiscVarType m_bak - - - "Backup Misc (optimization) variables not associated with time" @@ -404,7 +398,6 @@ typedef ^ ^ AD_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ AD_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ AD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ AD_ParameterType p - - - "Parameters" -typedef ^ ^ AD_InputType u - - - "System inputs" typedef ^ ^ AD_OutputType y - - - "System outputs" typedef ^ ^ AD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ AD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" @@ -429,7 +422,6 @@ typedef ^ ^ ADsk_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ ADsk_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ ADsk_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ADsk_ParameterType p - - - "Parameters" -typedef ^ ^ ADsk_InputType u - - - "System inputs" typedef ^ ^ ADsk_OutputType y - - - "System outputs" typedef ^ ^ ADsk_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ADsk_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" @@ -443,7 +435,6 @@ typedef ^ ^ InflowWind_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ InflowWind_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ InflowWind_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" -typedef ^ ^ InflowWind_InputType u - - - "System inputs" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ InflowWind_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" @@ -469,7 +460,6 @@ typedef ^ ^ SD_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ SD_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ SD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SD_ParameterType p - - - "Parameters" -typedef ^ ^ SD_InputType u - - - "System inputs" typedef ^ ^ SD_OutputType y - - - "System outputs" typedef ^ ^ SD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SD_InputType Input {:} - - "Array of inputs associated with InputTimes" @@ -483,7 +473,6 @@ typedef ^ ^ ExtPtfm_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ ExtPtfm_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ ExtPtfm_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ExtPtfm_ParameterType p - - - "Parameters" -typedef ^ ^ ExtPtfm_InputType u - - - "System inputs" typedef ^ ^ ExtPtfm_OutputType y - - - "System outputs" typedef ^ ^ ExtPtfm_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ExtPtfm_InputType Input {:} - - "Array of inputs associated with InputTimes" @@ -495,7 +484,6 @@ typedef ^ ^ SeaSt_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ SeaSt_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ SeaSt_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" -typedef ^ ^ SeaSt_InputType u - - - "System inputs" typedef ^ ^ SeaSt_OutputType y - - - "System outputs" typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SeaSt_InputType Input {:} - - "Array of inputs associated with InputTimes" @@ -510,7 +498,6 @@ typedef ^ ^ HydroDyn_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ HydroDyn_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ HydroDyn_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ HydroDyn_ParameterType p - - - "Parameters" -typedef ^ ^ HydroDyn_InputType u - - - "System inputs" typedef ^ ^ HydroDyn_OutputType y - - - "System outputs" typedef ^ ^ HydroDyn_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ HydroDyn_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" @@ -524,7 +511,6 @@ typedef ^ ^ IceFloe_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ IceFloe_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ IceFloe_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ IceFloe_ParameterType p - - - "Parameters" -typedef ^ ^ IceFloe_InputType u - - - "System inputs" typedef ^ ^ IceFloe_OutputType y - - - "System outputs" typedef ^ ^ IceFloe_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ IceFloe_InputType Input {:} - - "Array of inputs associated with InputTimes" @@ -536,7 +522,6 @@ typedef ^ ^ MAP_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ MAP_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ MAP_OtherStateType OtherSt - - - "Other/optimization states" typedef ^ ^ MAP_ParameterType p - - - "Parameters" -typedef ^ ^ MAP_InputType u - - - "System inputs" typedef ^ ^ MAP_OutputType y - - - "System outputs" typedef ^ ^ MAP_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (copied for the case of subcycling)" @@ -551,7 +536,6 @@ typedef ^ ^ FEAM_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ FEAM_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ FEAM_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ FEAM_ParameterType p - - - "Parameters" -typedef ^ ^ FEAM_InputType u - - - "System inputs" typedef ^ ^ FEAM_OutputType y - - - "System outputs" typedef ^ ^ FEAM_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ FEAM_InputType Input {:} - - "Array of inputs associated with InputTimes" @@ -563,7 +547,6 @@ typedef ^ ^ MD_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ MD_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ MD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ MD_ParameterType p - - - "Parameters" -typedef ^ ^ MD_InputType u - - - "System inputs" typedef ^ ^ MD_OutputType y - - - "System outputs" typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ MD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" @@ -577,7 +560,6 @@ typedef ^ ^ Orca_DiscreteStateType xd {:} - - "Discrete states" typedef ^ ^ Orca_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ Orca_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ Orca_ParameterType p - - - "Parameters" -typedef ^ ^ Orca_InputType u - - - "System inputs" typedef ^ ^ Orca_OutputType y - - - "System outputs" typedef ^ ^ Orca_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ Orca_InputType Input {:} - - "Array of inputs associated with InputTimes" diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index a70492fcb3..33b5ccf154 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -360,7 +360,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE allocate(BD%z (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%z")) return allocate(BD%OtherSt (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return allocate(BD%p (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%p")) return - allocate(BD%u (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%u")) return allocate(BD%y (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%y")) return allocate(BD%m (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%m")) return @@ -1112,7 +1111,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE allocate(IceD%z (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%z")) return allocate(IceD%OtherSt (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return allocate(IceD%p (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%p")) return - allocate(IceD%u (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%u")) return allocate(IceD%y (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%y")) return allocate(IceD%m (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%m")) return diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index e25f4d1aa7..1cf335c667 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -241,79 +241,6 @@ MODULE FAST_Types INTEGER(IntKi) :: GearBox_index = 0_IntKi !< Index to gearbox rotation in state array (for steady-state calculations) [-] END TYPE FAST_ParameterType ! ======================= -! ========= FAST_LinStateSave ======= - TYPE, PUBLIC :: FAST_LinStateSave - TYPE(IceD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x_IceD !< Continuous states [-] - TYPE(IceD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd_IceD !< Discrete states [-] - TYPE(IceD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z_IceD !< Constraint states [-] - TYPE(IceD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt_IceD !< Other states [-] - TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_IceD !< System inputs [-] - TYPE(BD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x_BD !< Continuous states [-] - TYPE(BD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd_BD !< Discrete states [-] - TYPE(BD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z_BD !< Constraint states [-] - TYPE(BD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt_BD !< Other states [-] - TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_BD !< System inputs [-] - TYPE(ED_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_ED !< Continuous states [-] - TYPE(ED_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_ED !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_ED !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_ED !< Other states [-] - TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: u_ED !< System inputs [-] - TYPE(SrvD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SrvD !< Continuous states [-] - TYPE(SrvD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SrvD !< Discrete states [-] - TYPE(SrvD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SrvD !< Constraint states [-] - TYPE(SrvD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SrvD !< Other states [-] - TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: u_SrvD !< System inputs [-] - TYPE(AD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_AD !< Continuous states [-] - TYPE(AD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_AD !< Discrete states [-] - TYPE(AD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_AD !< Constraint states [-] - TYPE(AD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_AD !< Other states [-] - TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: u_AD !< System inputs [-] - TYPE(InflowWind_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_IfW !< Continuous states [-] - TYPE(InflowWind_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_IfW !< Discrete states [-] - TYPE(InflowWind_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_IfW !< Constraint states [-] - TYPE(InflowWind_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_IfW !< Other states [-] - TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: u_IfW !< System inputs [-] - TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SD !< Continuous states [-] - TYPE(SD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SD !< Discrete states [-] - TYPE(SD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SD !< Constraint states [-] - TYPE(SD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SD !< Other states [-] - TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: u_SD !< System inputs [-] - TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_ExtPtfm !< Continuous states [-] - TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_ExtPtfm !< Discrete states [-] - TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_ExtPtfm !< Constraint states [-] - TYPE(ExtPtfm_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_ExtPtfm !< Other states [-] - TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: u_ExtPtfm !< System inputs [-] - TYPE(HydroDyn_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_HD !< Continuous states [-] - TYPE(HydroDyn_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_HD !< Discrete states [-] - TYPE(HydroDyn_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_HD !< Constraint states [-] - TYPE(HydroDyn_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_HD !< Other states [-] - TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: u_HD !< System inputs [-] - TYPE(SeaSt_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SeaSt !< Continuous states [-] - TYPE(SeaSt_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SeaSt !< Discrete states [-] - TYPE(SeaSt_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SeaSt !< Constraint states [-] - TYPE(SeaSt_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SeaSt !< Other states [-] - TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: u_SeaSt !< System inputs [-] - TYPE(IceFloe_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_IceF !< Continuous states [-] - TYPE(IceFloe_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_IceF !< Discrete states [-] - TYPE(IceFloe_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_IceF !< Constraint states [-] - TYPE(IceFloe_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_IceF !< Other states [-] - TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: u_IceF !< System inputs [-] - TYPE(MAP_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_MAP !< Continuous states [-] - TYPE(MAP_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_MAP !< Discrete states [-] - TYPE(MAP_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_MAP !< Constraint states [-] - TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: u_MAP !< System inputs [-] - TYPE(FEAM_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_FEAM !< Continuous states [-] - TYPE(FEAM_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_FEAM !< Discrete states [-] - TYPE(FEAM_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_FEAM !< Constraint states [-] - TYPE(FEAM_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_FEAM !< Other states [-] - TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: u_FEAM !< System inputs [-] - TYPE(MD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_MD !< Continuous states [-] - TYPE(MD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_MD !< Discrete states [-] - TYPE(MD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_MD !< Constraint states [-] - TYPE(MD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_MD !< Other states [-] - TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: u_MD !< System inputs [-] - END TYPE FAST_LinStateSave -! ======================= ! ========= FAST_LinType ======= TYPE, PUBLIC :: FAST_LinType CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: Names_u !< Names of the linearized inputs [-] @@ -398,7 +325,6 @@ MODULE FAST_Types INTEGER(IntKi) :: VTK_LastWaveIndx = 0_IntKi !< last index into wave array [-] TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] - TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] REAL(ReKi) , DIMENSION(1:6) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed [-] END TYPE FAST_OutputFileType ! ======================= @@ -409,7 +335,6 @@ MODULE FAST_Types TYPE(IceD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] TYPE(IceD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(IceD_ParameterType) , DIMENSION(:), ALLOCATABLE :: p !< Parameters [-] - TYPE(IceD_InputType) , DIMENSION(:), ALLOCATABLE :: u !< System inputs [-] TYPE(IceD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(IceD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] @@ -424,7 +349,6 @@ MODULE FAST_Types TYPE(BD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] TYPE(BD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(BD_ParameterType) , DIMENSION(:), ALLOCATABLE :: p !< Parameters [-] - TYPE(BD_InputType) , DIMENSION(:), ALLOCATABLE :: u !< System inputs [-] TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(BD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] TYPE(BD_OutputType) , DIMENSION(:,:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] @@ -441,7 +365,6 @@ MODULE FAST_Types TYPE(ED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(ED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(ED_ParameterType) :: p !< Parameters [-] - TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] TYPE(ED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] @@ -458,7 +381,6 @@ MODULE FAST_Types TYPE(SED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(SED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SED_ParameterType) :: p !< Parameters [-] - TYPE(SED_InputType) :: u !< System inputs [-] TYPE(SED_OutputType) :: y !< System outputs [-] TYPE(SED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] TYPE(SED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] @@ -474,7 +396,6 @@ MODULE FAST_Types TYPE(SrvD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(SrvD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SrvD_ParameterType) :: p !< Parameters [-] - TYPE(SrvD_InputType) :: u !< System inputs [-] TYPE(SrvD_OutputType) :: y !< System outputs [-] TYPE(SrvD_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] TYPE(SrvD_MiscVarType) :: m_bak !< Backup Misc (optimization) variables not associated with time [-] @@ -491,7 +412,6 @@ MODULE FAST_Types TYPE(AD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(AD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(AD_ParameterType) :: p !< Parameters [-] - TYPE(AD_InputType) :: u !< System inputs [-] TYPE(AD_OutputType) :: y !< System outputs [-] TYPE(AD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(AD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] @@ -520,7 +440,6 @@ MODULE FAST_Types TYPE(ADsk_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(ADsk_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(ADsk_ParameterType) :: p !< Parameters [-] - TYPE(ADsk_InputType) :: u !< System inputs [-] TYPE(ADsk_OutputType) :: y !< System outputs [-] TYPE(ADsk_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(ADsk_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] @@ -536,7 +455,6 @@ MODULE FAST_Types TYPE(InflowWind_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(InflowWind_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(InflowWind_ParameterType) :: p !< Parameters [-] - TYPE(InflowWind_InputType) :: u !< System inputs [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(InflowWind_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] @@ -568,7 +486,6 @@ MODULE FAST_Types TYPE(SD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(SD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SD_ParameterType) :: p !< Parameters [-] - TYPE(SD_InputType) :: u !< System inputs [-] TYPE(SD_OutputType) :: y !< System outputs [-] TYPE(SD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] @@ -584,7 +501,6 @@ MODULE FAST_Types TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(ExtPtfm_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(ExtPtfm_ParameterType) :: p !< Parameters [-] - TYPE(ExtPtfm_InputType) :: u !< System inputs [-] TYPE(ExtPtfm_OutputType) :: y !< System outputs [-] TYPE(ExtPtfm_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] @@ -598,7 +514,6 @@ MODULE FAST_Types TYPE(SeaSt_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(SeaSt_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SeaSt_ParameterType) :: p !< Parameters [-] - TYPE(SeaSt_InputType) :: u !< System inputs [-] TYPE(SeaSt_OutputType) :: y !< System outputs [-] TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] @@ -615,7 +530,6 @@ MODULE FAST_Types TYPE(HydroDyn_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(HydroDyn_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] - TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] TYPE(HydroDyn_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(HydroDyn_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] @@ -631,7 +545,6 @@ MODULE FAST_Types TYPE(IceFloe_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(IceFloe_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(IceFloe_ParameterType) :: p !< Parameters [-] - TYPE(IceFloe_InputType) :: u !< System inputs [-] TYPE(IceFloe_OutputType) :: y !< System outputs [-] TYPE(IceFloe_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] @@ -645,7 +558,6 @@ MODULE FAST_Types TYPE(MAP_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(MAP_OtherStateType) :: OtherSt !< Other/optimization states [-] TYPE(MAP_ParameterType) :: p !< Parameters [-] - TYPE(MAP_InputType) :: u !< System inputs [-] TYPE(MAP_OutputType) :: y !< System outputs [-] TYPE(MAP_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(MAP_OtherStateType) :: OtherSt_old !< Other/optimization states (copied for the case of subcycling) [-] @@ -662,7 +574,6 @@ MODULE FAST_Types TYPE(FEAM_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(FEAM_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(FEAM_ParameterType) :: p !< Parameters [-] - TYPE(FEAM_InputType) :: u !< System inputs [-] TYPE(FEAM_OutputType) :: y !< System outputs [-] TYPE(FEAM_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] @@ -676,7 +587,6 @@ MODULE FAST_Types TYPE(MD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(MD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(MD_ParameterType) :: p !< Parameters [-] - TYPE(MD_InputType) :: u !< System inputs [-] TYPE(MD_OutputType) :: y !< System outputs [-] TYPE(MD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(MD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] @@ -692,7 +602,6 @@ MODULE FAST_Types TYPE(Orca_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(Orca_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(Orca_ParameterType) :: p !< Parameters [-] - TYPE(Orca_InputType) :: u !< System inputs [-] TYPE(Orca_OutputType) :: y !< System outputs [-] TYPE(Orca_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] @@ -1632,3536 +1541,164 @@ subroutine FAST_PackParam(RF, Indata) call RegPack(RF, InData%WrVTK) call RegPack(RF, InData%VTK_Type) call RegPack(RF, InData%VTK_fields) - call RegPack(RF, InData%Delim) - call RegPack(RF, InData%OutFmt) - call RegPack(RF, InData%OutFmt_t) - call RegPack(RF, InData%FmtWidth) - call RegPack(RF, InData%TChanLen) - call RegPack(RF, InData%OutFileRoot) - call RegPack(RF, InData%FTitle) - call RegPack(RF, InData%VTK_OutFileRoot) - call RegPack(RF, InData%VTK_tWidth) - call RegPack(RF, InData%VTK_fps) - call FAST_PackVTK_SurfaceType(RF, InData%VTK_surface) - call RegPack(RF, InData%Tdesc) - call RegPack(RF, InData%CalcSteady) - call RegPack(RF, InData%TrimCase) - call RegPack(RF, InData%TrimTol) - call RegPack(RF, InData%TrimGain) - call RegPack(RF, InData%Twr_Kdmp) - call RegPack(RF, InData%Bld_Kdmp) - call RegPack(RF, InData%NLinTimes) - call RegPack(RF, InData%AzimDelta) - call RegPack(RF, InData%LinInputs) - call RegPack(RF, InData%LinOutputs) - call RegPack(RF, InData%LinOutJac) - call RegPack(RF, InData%LinOutMod) - call FAST_PackVTK_ModeShapeType(RF, InData%VTK_modes) - call RegPack(RF, InData%UseSC) - call RegPack(RF, InData%Lin_NumMods) - call RegPack(RF, InData%Lin_ModOrder) - call RegPack(RF, InData%LinInterpOrder) - call RegPack(RF, InData%CompAeroMaps) - call RegPack(RF, InData%N_UJac) - call RegPack(RF, InData%NumBl_Lin) - call RegPack(RF, InData%tolerSquared) - call RegPack(RF, InData%NumSSCases) - call RegPack(RF, InData%WindSpeedOrTSR) - call RegPack(RF, InData%RotSpeedInit) - call RegPackAlloc(RF, InData%RotSpeed) - call RegPackAlloc(RF, InData%WS_TSR) - call RegPackAlloc(RF, InData%Pitch) - call RegPack(RF, InData%GearBox_index) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(FAST_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DT_module); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%n_substeps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%n_TMax_m1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%KMax); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%numIceLegs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nBeams); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BD_OutputSibling); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ModuleInitialized); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DT_Ujac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UJacSclFact); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SizeJac_Opt1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SolveOption); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompElast); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompInflow); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompAero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompServo); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompSeaSt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompHydro); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompSub); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompMooring); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompIce); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UseDWM); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%FarmIntegration); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TurbinePos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%EDFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BDBldFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%InflowFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AeroFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ServoFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SeaStFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HydroFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SubFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MooringFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IceFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DT_Out); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WrSttsTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%n_SttsTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%n_ChkptTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%n_DT_Out); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%n_VTKTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WrBinOutFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WrTxtOutFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WrBinMod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTK_Type); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTK_fields); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%OutFmt_t); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%FmtWidth); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TChanLen); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VTK_fps); if (RegCheckErr(RF, RoutineName)) return - call FAST_UnpackVTK_SurfaceType(RF, OutData%VTK_surface) ! VTK_surface - call RegUnpack(RF, OutData%Tdesc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CalcSteady); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TrimTol); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Twr_Kdmp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Bld_Kdmp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NLinTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AzimDelta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LinInputs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LinOutputs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LinOutJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LinOutMod); if (RegCheckErr(RF, RoutineName)) return - call FAST_UnpackVTK_ModeShapeType(RF, OutData%VTK_modes) ! VTK_modes - call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Lin_NumMods); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Lin_ModOrder); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LinInterpOrder); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%N_UJac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%tolerSquared); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumSSCases); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WindSpeedOrTSR); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotSpeedInit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WS_TSR); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg) - type(FAST_LinStateSave), intent(inout) :: SrcLinStateSaveData - type(FAST_LinStateSave), intent(inout) :: DstLinStateSaveData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyLinStateSave' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcLinStateSaveData%x_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%x_IceD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%x_IceD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_IceD)) then - allocate(DstLinStateSaveData%x_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyContState(SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%xd_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%xd_IceD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%xd_IceD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_IceD)) then - allocate(DstLinStateSaveData%xd_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyDiscState(SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%z_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%z_IceD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%z_IceD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_IceD)) then - allocate(DstLinStateSaveData%z_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyConstrState(SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_IceD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_IceD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_IceD)) then - allocate(DstLinStateSaveData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyOtherState(SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%u_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%u_IceD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%u_IceD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_IceD)) then - allocate(DstLinStateSaveData%u_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyInput(SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%x_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%x_BD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%x_BD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_BD)) then - allocate(DstLinStateSaveData%x_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyContState(SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%xd_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%xd_BD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%xd_BD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_BD)) then - allocate(DstLinStateSaveData%xd_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyDiscState(SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%z_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%z_BD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%z_BD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_BD)) then - allocate(DstLinStateSaveData%z_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyConstrState(SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_BD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_BD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_BD)) then - allocate(DstLinStateSaveData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyOtherState(SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%u_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%u_BD, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%u_BD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_BD)) then - allocate(DstLinStateSaveData%u_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyInput(SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcLinStateSaveData%x_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_ED, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_ED, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_ED)) then - allocate(DstLinStateSaveData%x_ED(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ED_CopyContState(SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_ED, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_ED, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_ED)) then - allocate(DstLinStateSaveData%xd_ED(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ED_CopyDiscState(SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_ED, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_ED, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_ED)) then - allocate(DstLinStateSaveData%z_ED(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ED_CopyConstrState(SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ED, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ED, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_ED)) then - allocate(DstLinStateSaveData%OtherSt_ED(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ED_CopyOtherState(SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_ED, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_ED, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_ED)) then - allocate(DstLinStateSaveData%u_ED(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ED_CopyInput(SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_SrvD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_SrvD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_SrvD)) then - allocate(DstLinStateSaveData%x_SrvD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SrvD_CopyContState(SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_SrvD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SrvD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_SrvD)) then - allocate(DstLinStateSaveData%xd_SrvD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SrvD_CopyDiscState(SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_SrvD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_SrvD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_SrvD)) then - allocate(DstLinStateSaveData%z_SrvD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SrvD_CopyConstrState(SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SrvD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SrvD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_SrvD)) then - allocate(DstLinStateSaveData%OtherSt_SrvD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SrvD_CopyOtherState(SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_SrvD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_SrvD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_SrvD)) then - allocate(DstLinStateSaveData%u_SrvD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SrvD_CopyInput(SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_AD)) then - allocate(DstLinStateSaveData%x_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyContState(SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_AD)) then - allocate(DstLinStateSaveData%xd_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyDiscState(SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_AD)) then - allocate(DstLinStateSaveData%z_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyConstrState(SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_AD)) then - allocate(DstLinStateSaveData%OtherSt_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyOtherState(SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_AD)) then - allocate(DstLinStateSaveData%u_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyInput(SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_IfW, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_IfW, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_IfW)) then - allocate(DstLinStateSaveData%x_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyContState(SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_IfW, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_IfW, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_IfW)) then - allocate(DstLinStateSaveData%xd_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyDiscState(SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_IfW, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_IfW, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_IfW)) then - allocate(DstLinStateSaveData%z_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyConstrState(SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IfW, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IfW, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_IfW)) then - allocate(DstLinStateSaveData%OtherSt_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyOtherState(SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_IfW, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_IfW, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_IfW)) then - allocate(DstLinStateSaveData%u_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyInput(SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_SD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_SD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_SD)) then - allocate(DstLinStateSaveData%x_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyContState(SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_SD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_SD)) then - allocate(DstLinStateSaveData%xd_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyDiscState(SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_SD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_SD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_SD)) then - allocate(DstLinStateSaveData%z_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyConstrState(SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_SD)) then - allocate(DstLinStateSaveData%OtherSt_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyOtherState(SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_SD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_SD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_SD)) then - allocate(DstLinStateSaveData%u_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyInput(SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_ExtPtfm, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_ExtPtfm)) then - allocate(DstLinStateSaveData%x_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyContState(SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_ExtPtfm, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_ExtPtfm)) then - allocate(DstLinStateSaveData%xd_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyDiscState(SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_ExtPtfm, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_ExtPtfm)) then - allocate(DstLinStateSaveData%z_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyConstrState(SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_ExtPtfm)) then - allocate(DstLinStateSaveData%OtherSt_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyOtherState(SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_ExtPtfm, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_ExtPtfm)) then - allocate(DstLinStateSaveData%u_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyInput(SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_HD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_HD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_HD)) then - allocate(DstLinStateSaveData%x_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyContState(SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_HD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_HD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_HD)) then - allocate(DstLinStateSaveData%xd_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyDiscState(SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_HD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_HD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_HD)) then - allocate(DstLinStateSaveData%z_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyConstrState(SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_HD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_HD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_HD)) then - allocate(DstLinStateSaveData%OtherSt_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyOtherState(SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_HD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_HD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_HD)) then - allocate(DstLinStateSaveData%u_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyInput(SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_SeaSt, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_SeaSt, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_SeaSt)) then - allocate(DstLinStateSaveData%x_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyContState(SrcLinStateSaveData%x_SeaSt(i1), DstLinStateSaveData%x_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_SeaSt, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SeaSt, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_SeaSt)) then - allocate(DstLinStateSaveData%xd_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyDiscState(SrcLinStateSaveData%xd_SeaSt(i1), DstLinStateSaveData%xd_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_SeaSt, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_SeaSt, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_SeaSt)) then - allocate(DstLinStateSaveData%z_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyConstrState(SrcLinStateSaveData%z_SeaSt(i1), DstLinStateSaveData%z_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SeaSt, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SeaSt, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_SeaSt)) then - allocate(DstLinStateSaveData%OtherSt_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyOtherState(SrcLinStateSaveData%OtherSt_SeaSt(i1), DstLinStateSaveData%OtherSt_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_SeaSt, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_SeaSt, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_SeaSt)) then - allocate(DstLinStateSaveData%u_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyInput(SrcLinStateSaveData%u_SeaSt(i1), DstLinStateSaveData%u_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_IceF, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_IceF, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_IceF)) then - allocate(DstLinStateSaveData%x_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyContState(SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_IceF, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_IceF, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_IceF)) then - allocate(DstLinStateSaveData%xd_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyDiscState(SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_IceF, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_IceF, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_IceF)) then - allocate(DstLinStateSaveData%z_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyConstrState(SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IceF, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IceF, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_IceF)) then - allocate(DstLinStateSaveData%OtherSt_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyOtherState(SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_IceF, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_IceF, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_IceF)) then - allocate(DstLinStateSaveData%u_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyInput(SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_MAP, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_MAP, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_MAP)) then - allocate(DstLinStateSaveData%x_MAP(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyContState(SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_MAP, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_MAP, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_MAP)) then - allocate(DstLinStateSaveData%xd_MAP(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyDiscState(SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_MAP, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_MAP, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_MAP)) then - allocate(DstLinStateSaveData%z_MAP(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyConstrState(SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_MAP, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_MAP, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_MAP)) then - allocate(DstLinStateSaveData%u_MAP(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyInput(SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_FEAM, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_FEAM, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_FEAM)) then - allocate(DstLinStateSaveData%x_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyContState(SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_FEAM, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_FEAM, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_FEAM)) then - allocate(DstLinStateSaveData%xd_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyDiscState(SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_FEAM, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_FEAM, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_FEAM)) then - allocate(DstLinStateSaveData%z_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyConstrState(SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_FEAM, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_FEAM, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_FEAM)) then - allocate(DstLinStateSaveData%OtherSt_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyOtherState(SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_FEAM, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_FEAM, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_FEAM)) then - allocate(DstLinStateSaveData%u_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyInput(SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_MD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_MD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_MD)) then - allocate(DstLinStateSaveData%x_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyContState(SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_MD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_MD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_MD)) then - allocate(DstLinStateSaveData%xd_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyDiscState(SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_MD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_MD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_MD)) then - allocate(DstLinStateSaveData%z_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyConstrState(SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_MD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_MD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_MD)) then - allocate(DstLinStateSaveData%OtherSt_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyOtherState(SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_MD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_MD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_MD)) then - allocate(DstLinStateSaveData%u_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyInput(SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if -end subroutine - -subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) - type(FAST_LinStateSave), intent(inout) :: LinStateSaveData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyLinStateSave' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(LinStateSaveData%x_IceD)) then - LB(1:2) = lbound(LinStateSaveData%x_IceD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%x_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyContState(LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%x_IceD) - end if - if (allocated(LinStateSaveData%xd_IceD)) then - LB(1:2) = lbound(LinStateSaveData%xd_IceD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%xd_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyDiscState(LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%xd_IceD) - end if - if (allocated(LinStateSaveData%z_IceD)) then - LB(1:2) = lbound(LinStateSaveData%z_IceD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%z_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyConstrState(LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%z_IceD) - end if - if (allocated(LinStateSaveData%OtherSt_IceD)) then - LB(1:2) = lbound(LinStateSaveData%OtherSt_IceD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%OtherSt_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyOtherState(LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%OtherSt_IceD) - end if - if (allocated(LinStateSaveData%u_IceD)) then - LB(1:2) = lbound(LinStateSaveData%u_IceD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%u_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyInput(LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%u_IceD) - end if - if (allocated(LinStateSaveData%x_BD)) then - LB(1:2) = lbound(LinStateSaveData%x_BD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%x_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyContState(LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%x_BD) - end if - if (allocated(LinStateSaveData%xd_BD)) then - LB(1:2) = lbound(LinStateSaveData%xd_BD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%xd_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyDiscState(LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%xd_BD) - end if - if (allocated(LinStateSaveData%z_BD)) then - LB(1:2) = lbound(LinStateSaveData%z_BD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%z_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyConstrState(LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%z_BD) - end if - if (allocated(LinStateSaveData%OtherSt_BD)) then - LB(1:2) = lbound(LinStateSaveData%OtherSt_BD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%OtherSt_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyOtherState(LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%OtherSt_BD) - end if - if (allocated(LinStateSaveData%u_BD)) then - LB(1:2) = lbound(LinStateSaveData%u_BD, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%u_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyInput(LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%u_BD) - end if - if (allocated(LinStateSaveData%x_ED)) then - LB(1:1) = lbound(LinStateSaveData%x_ED, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyContState(LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_ED) - end if - if (allocated(LinStateSaveData%xd_ED)) then - LB(1:1) = lbound(LinStateSaveData%xd_ED, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyDiscState(LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_ED) - end if - if (allocated(LinStateSaveData%z_ED)) then - LB(1:1) = lbound(LinStateSaveData%z_ED, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyConstrState(LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_ED) - end if - if (allocated(LinStateSaveData%OtherSt_ED)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_ED, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyOtherState(LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_ED) - end if - if (allocated(LinStateSaveData%u_ED)) then - LB(1:1) = lbound(LinStateSaveData%u_ED, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyInput(LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_ED) - end if - if (allocated(LinStateSaveData%x_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%x_SrvD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyContState(LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_SrvD) - end if - if (allocated(LinStateSaveData%xd_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%xd_SrvD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyDiscState(LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_SrvD) - end if - if (allocated(LinStateSaveData%z_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%z_SrvD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyConstrState(LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_SrvD) - end if - if (allocated(LinStateSaveData%OtherSt_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_SrvD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyOtherState(LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_SrvD) - end if - if (allocated(LinStateSaveData%u_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%u_SrvD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyInput(LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_SrvD) - end if - if (allocated(LinStateSaveData%x_AD)) then - LB(1:1) = lbound(LinStateSaveData%x_AD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyContState(LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_AD) - end if - if (allocated(LinStateSaveData%xd_AD)) then - LB(1:1) = lbound(LinStateSaveData%xd_AD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyDiscState(LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_AD) - end if - if (allocated(LinStateSaveData%z_AD)) then - LB(1:1) = lbound(LinStateSaveData%z_AD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyConstrState(LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_AD) - end if - if (allocated(LinStateSaveData%OtherSt_AD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_AD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyOtherState(LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_AD) - end if - if (allocated(LinStateSaveData%u_AD)) then - LB(1:1) = lbound(LinStateSaveData%u_AD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyInput(LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_AD) - end if - if (allocated(LinStateSaveData%x_IfW)) then - LB(1:1) = lbound(LinStateSaveData%x_IfW, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyContState(LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_IfW) - end if - if (allocated(LinStateSaveData%xd_IfW)) then - LB(1:1) = lbound(LinStateSaveData%xd_IfW, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyDiscState(LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_IfW) - end if - if (allocated(LinStateSaveData%z_IfW)) then - LB(1:1) = lbound(LinStateSaveData%z_IfW, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyConstrState(LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_IfW) - end if - if (allocated(LinStateSaveData%OtherSt_IfW)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_IfW, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyOtherState(LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_IfW) - end if - if (allocated(LinStateSaveData%u_IfW)) then - LB(1:1) = lbound(LinStateSaveData%u_IfW, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyInput(LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_IfW) - end if - if (allocated(LinStateSaveData%x_SD)) then - LB(1:1) = lbound(LinStateSaveData%x_SD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyContState(LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_SD) - end if - if (allocated(LinStateSaveData%xd_SD)) then - LB(1:1) = lbound(LinStateSaveData%xd_SD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyDiscState(LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_SD) - end if - if (allocated(LinStateSaveData%z_SD)) then - LB(1:1) = lbound(LinStateSaveData%z_SD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyConstrState(LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_SD) - end if - if (allocated(LinStateSaveData%OtherSt_SD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_SD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyOtherState(LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_SD) - end if - if (allocated(LinStateSaveData%u_SD)) then - LB(1:1) = lbound(LinStateSaveData%u_SD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyInput(LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_SD) - end if - if (allocated(LinStateSaveData%x_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%x_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyContState(LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_ExtPtfm) - end if - if (allocated(LinStateSaveData%xd_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%xd_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyDiscState(LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_ExtPtfm) - end if - if (allocated(LinStateSaveData%z_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%z_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyConstrState(LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_ExtPtfm) - end if - if (allocated(LinStateSaveData%OtherSt_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyOtherState(LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_ExtPtfm) - end if - if (allocated(LinStateSaveData%u_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%u_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyInput(LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_ExtPtfm) - end if - if (allocated(LinStateSaveData%x_HD)) then - LB(1:1) = lbound(LinStateSaveData%x_HD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyContState(LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_HD) - end if - if (allocated(LinStateSaveData%xd_HD)) then - LB(1:1) = lbound(LinStateSaveData%xd_HD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyDiscState(LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_HD) - end if - if (allocated(LinStateSaveData%z_HD)) then - LB(1:1) = lbound(LinStateSaveData%z_HD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyConstrState(LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_HD) - end if - if (allocated(LinStateSaveData%OtherSt_HD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_HD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyOtherState(LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_HD) - end if - if (allocated(LinStateSaveData%u_HD)) then - LB(1:1) = lbound(LinStateSaveData%u_HD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyInput(LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_HD) - end if - if (allocated(LinStateSaveData%x_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%x_SeaSt, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyContState(LinStateSaveData%x_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_SeaSt) - end if - if (allocated(LinStateSaveData%xd_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%xd_SeaSt, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyDiscState(LinStateSaveData%xd_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_SeaSt) - end if - if (allocated(LinStateSaveData%z_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%z_SeaSt, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyConstrState(LinStateSaveData%z_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_SeaSt) - end if - if (allocated(LinStateSaveData%OtherSt_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_SeaSt, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyOtherState(LinStateSaveData%OtherSt_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_SeaSt) - end if - if (allocated(LinStateSaveData%u_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%u_SeaSt, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyInput(LinStateSaveData%u_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_SeaSt) - end if - if (allocated(LinStateSaveData%x_IceF)) then - LB(1:1) = lbound(LinStateSaveData%x_IceF, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyContState(LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_IceF) - end if - if (allocated(LinStateSaveData%xd_IceF)) then - LB(1:1) = lbound(LinStateSaveData%xd_IceF, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyDiscState(LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_IceF) - end if - if (allocated(LinStateSaveData%z_IceF)) then - LB(1:1) = lbound(LinStateSaveData%z_IceF, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyConstrState(LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_IceF) - end if - if (allocated(LinStateSaveData%OtherSt_IceF)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_IceF, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyOtherState(LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_IceF) - end if - if (allocated(LinStateSaveData%u_IceF)) then - LB(1:1) = lbound(LinStateSaveData%u_IceF, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_DestroyInput(LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_IceF) - end if - if (allocated(LinStateSaveData%x_MAP)) then - LB(1:1) = lbound(LinStateSaveData%x_MAP, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_MAP, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyContState(LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_MAP) - end if - if (allocated(LinStateSaveData%xd_MAP)) then - LB(1:1) = lbound(LinStateSaveData%xd_MAP, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_MAP, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyDiscState(LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_MAP) - end if - if (allocated(LinStateSaveData%z_MAP)) then - LB(1:1) = lbound(LinStateSaveData%z_MAP, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_MAP, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyConstrState(LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_MAP) - end if - if (allocated(LinStateSaveData%u_MAP)) then - LB(1:1) = lbound(LinStateSaveData%u_MAP, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_MAP, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyInput(LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_MAP) - end if - if (allocated(LinStateSaveData%x_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%x_FEAM, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyContState(LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_FEAM) - end if - if (allocated(LinStateSaveData%xd_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%xd_FEAM, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyDiscState(LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_FEAM) - end if - if (allocated(LinStateSaveData%z_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%z_FEAM, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyConstrState(LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_FEAM) - end if - if (allocated(LinStateSaveData%OtherSt_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_FEAM, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyOtherState(LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_FEAM) - end if - if (allocated(LinStateSaveData%u_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%u_FEAM, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyInput(LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_FEAM) - end if - if (allocated(LinStateSaveData%x_MD)) then - LB(1:1) = lbound(LinStateSaveData%x_MD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyContState(LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_MD) - end if - if (allocated(LinStateSaveData%xd_MD)) then - LB(1:1) = lbound(LinStateSaveData%xd_MD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyDiscState(LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_MD) - end if - if (allocated(LinStateSaveData%z_MD)) then - LB(1:1) = lbound(LinStateSaveData%z_MD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyConstrState(LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_MD) - end if - if (allocated(LinStateSaveData%OtherSt_MD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_MD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyOtherState(LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_MD) - end if - if (allocated(LinStateSaveData%u_MD)) then - LB(1:1) = lbound(LinStateSaveData%u_MD, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyInput(LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_MD) - end if -end subroutine - -subroutine FAST_PackLinStateSave(RF, Indata) - type(RegFile), intent(inout) :: RF - type(FAST_LinStateSave), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%x_IceD)) - if (allocated(InData%x_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%x_IceD, kind=B8Ki), ubound(InData%x_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%x_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%x_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackContState(RF, InData%x_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%xd_IceD)) - if (allocated(InData%xd_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%xd_IceD, kind=B8Ki), ubound(InData%xd_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%xd_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%xd_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackDiscState(RF, InData%xd_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%z_IceD)) - if (allocated(InData%z_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%z_IceD, kind=B8Ki), ubound(InData%z_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%z_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%z_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackConstrState(RF, InData%z_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%OtherSt_IceD)) - if (allocated(InData%OtherSt_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%OtherSt_IceD, kind=B8Ki), ubound(InData%OtherSt_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%OtherSt_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%OtherSt_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackOtherState(RF, InData%OtherSt_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%u_IceD)) - if (allocated(InData%u_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%u_IceD, kind=B8Ki), ubound(InData%u_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%u_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%u_IceD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackInput(RF, InData%u_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%x_BD)) - if (allocated(InData%x_BD)) then - call RegPackBounds(RF, 2, lbound(InData%x_BD, kind=B8Ki), ubound(InData%x_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%x_BD, kind=B8Ki) - UB(1:2) = ubound(InData%x_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackContState(RF, InData%x_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%xd_BD)) - if (allocated(InData%xd_BD)) then - call RegPackBounds(RF, 2, lbound(InData%xd_BD, kind=B8Ki), ubound(InData%xd_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%xd_BD, kind=B8Ki) - UB(1:2) = ubound(InData%xd_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackDiscState(RF, InData%xd_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%z_BD)) - if (allocated(InData%z_BD)) then - call RegPackBounds(RF, 2, lbound(InData%z_BD, kind=B8Ki), ubound(InData%z_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%z_BD, kind=B8Ki) - UB(1:2) = ubound(InData%z_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackConstrState(RF, InData%z_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%OtherSt_BD)) - if (allocated(InData%OtherSt_BD)) then - call RegPackBounds(RF, 2, lbound(InData%OtherSt_BD, kind=B8Ki), ubound(InData%OtherSt_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%OtherSt_BD, kind=B8Ki) - UB(1:2) = ubound(InData%OtherSt_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackOtherState(RF, InData%OtherSt_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%u_BD)) - if (allocated(InData%u_BD)) then - call RegPackBounds(RF, 2, lbound(InData%u_BD, kind=B8Ki), ubound(InData%u_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%u_BD, kind=B8Ki) - UB(1:2) = ubound(InData%u_BD, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackInput(RF, InData%u_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%x_ED)) - if (allocated(InData%x_ED)) then - call RegPackBounds(RF, 1, lbound(InData%x_ED, kind=B8Ki), ubound(InData%x_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%x_ED, kind=B8Ki) - UB(1:1) = ubound(InData%x_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackContState(RF, InData%x_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_ED)) - if (allocated(InData%xd_ED)) then - call RegPackBounds(RF, 1, lbound(InData%xd_ED, kind=B8Ki), ubound(InData%xd_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_ED, kind=B8Ki) - UB(1:1) = ubound(InData%xd_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackDiscState(RF, InData%xd_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_ED)) - if (allocated(InData%z_ED)) then - call RegPackBounds(RF, 1, lbound(InData%z_ED, kind=B8Ki), ubound(InData%z_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%z_ED, kind=B8Ki) - UB(1:1) = ubound(InData%z_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackConstrState(RF, InData%z_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_ED)) - if (allocated(InData%OtherSt_ED)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_ED, kind=B8Ki), ubound(InData%OtherSt_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_ED, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackOtherState(RF, InData%OtherSt_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_ED)) - if (allocated(InData%u_ED)) then - call RegPackBounds(RF, 1, lbound(InData%u_ED, kind=B8Ki), ubound(InData%u_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%u_ED, kind=B8Ki) - UB(1:1) = ubound(InData%u_ED, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackInput(RF, InData%u_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_SrvD)) - if (allocated(InData%x_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%x_SrvD, kind=B8Ki), ubound(InData%x_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%x_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackContState(RF, InData%x_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_SrvD)) - if (allocated(InData%xd_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_SrvD, kind=B8Ki), ubound(InData%xd_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackDiscState(RF, InData%xd_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_SrvD)) - if (allocated(InData%z_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%z_SrvD, kind=B8Ki), ubound(InData%z_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%z_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackConstrState(RF, InData%z_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_SrvD)) - if (allocated(InData%OtherSt_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_SrvD, kind=B8Ki), ubound(InData%OtherSt_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackOtherState(RF, InData%OtherSt_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_SrvD)) - if (allocated(InData%u_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%u_SrvD, kind=B8Ki), ubound(InData%u_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%u_SrvD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackInput(RF, InData%u_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_AD)) - if (allocated(InData%x_AD)) then - call RegPackBounds(RF, 1, lbound(InData%x_AD, kind=B8Ki), ubound(InData%x_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_AD, kind=B8Ki) - UB(1:1) = ubound(InData%x_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackContState(RF, InData%x_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_AD)) - if (allocated(InData%xd_AD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_AD, kind=B8Ki), ubound(InData%xd_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_AD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackDiscState(RF, InData%xd_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_AD)) - if (allocated(InData%z_AD)) then - call RegPackBounds(RF, 1, lbound(InData%z_AD, kind=B8Ki), ubound(InData%z_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_AD, kind=B8Ki) - UB(1:1) = ubound(InData%z_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackConstrState(RF, InData%z_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_AD)) - if (allocated(InData%OtherSt_AD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_AD, kind=B8Ki), ubound(InData%OtherSt_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_AD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackOtherState(RF, InData%OtherSt_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_AD)) - if (allocated(InData%u_AD)) then - call RegPackBounds(RF, 1, lbound(InData%u_AD, kind=B8Ki), ubound(InData%u_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_AD, kind=B8Ki) - UB(1:1) = ubound(InData%u_AD, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackInput(RF, InData%u_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_IfW)) - if (allocated(InData%x_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%x_IfW, kind=B8Ki), ubound(InData%x_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%x_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%x_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackContState(RF, InData%x_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_IfW)) - if (allocated(InData%xd_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%xd_IfW, kind=B8Ki), ubound(InData%xd_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%xd_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(RF, InData%xd_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_IfW)) - if (allocated(InData%z_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%z_IfW, kind=B8Ki), ubound(InData%z_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%z_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%z_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(RF, InData%z_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_IfW)) - if (allocated(InData%OtherSt_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_IfW, kind=B8Ki), ubound(InData%OtherSt_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(RF, InData%OtherSt_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_IfW)) - if (allocated(InData%u_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%u_IfW, kind=B8Ki), ubound(InData%u_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%u_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%u_IfW, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackInput(RF, InData%u_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_SD)) - if (allocated(InData%x_SD)) then - call RegPackBounds(RF, 1, lbound(InData%x_SD, kind=B8Ki), ubound(InData%x_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_SD, kind=B8Ki) - UB(1:1) = ubound(InData%x_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackContState(RF, InData%x_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_SD)) - if (allocated(InData%xd_SD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_SD, kind=B8Ki), ubound(InData%xd_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_SD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackDiscState(RF, InData%xd_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_SD)) - if (allocated(InData%z_SD)) then - call RegPackBounds(RF, 1, lbound(InData%z_SD, kind=B8Ki), ubound(InData%z_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_SD, kind=B8Ki) - UB(1:1) = ubound(InData%z_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackConstrState(RF, InData%z_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_SD)) - if (allocated(InData%OtherSt_SD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_SD, kind=B8Ki), ubound(InData%OtherSt_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_SD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackOtherState(RF, InData%OtherSt_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_SD)) - if (allocated(InData%u_SD)) then - call RegPackBounds(RF, 1, lbound(InData%u_SD, kind=B8Ki), ubound(InData%u_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_SD, kind=B8Ki) - UB(1:1) = ubound(InData%u_SD, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackInput(RF, InData%u_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_ExtPtfm)) - if (allocated(InData%x_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%x_ExtPtfm, kind=B8Ki), ubound(InData%x_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%x_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%x_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(RF, InData%x_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_ExtPtfm)) - if (allocated(InData%xd_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%xd_ExtPtfm, kind=B8Ki), ubound(InData%xd_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%xd_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(RF, InData%xd_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_ExtPtfm)) - if (allocated(InData%z_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%z_ExtPtfm, kind=B8Ki), ubound(InData%z_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%z_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%z_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(RF, InData%z_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_ExtPtfm)) - if (allocated(InData%OtherSt_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_ExtPtfm, kind=B8Ki), ubound(InData%OtherSt_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackOtherState(RF, InData%OtherSt_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_ExtPtfm)) - if (allocated(InData%u_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%u_ExtPtfm, kind=B8Ki), ubound(InData%u_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%u_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%u_ExtPtfm, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(RF, InData%u_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_HD)) - if (allocated(InData%x_HD)) then - call RegPackBounds(RF, 1, lbound(InData%x_HD, kind=B8Ki), ubound(InData%x_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_HD, kind=B8Ki) - UB(1:1) = ubound(InData%x_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackContState(RF, InData%x_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_HD)) - if (allocated(InData%xd_HD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_HD, kind=B8Ki), ubound(InData%xd_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_HD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(RF, InData%xd_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_HD)) - if (allocated(InData%z_HD)) then - call RegPackBounds(RF, 1, lbound(InData%z_HD, kind=B8Ki), ubound(InData%z_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_HD, kind=B8Ki) - UB(1:1) = ubound(InData%z_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(RF, InData%z_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_HD)) - if (allocated(InData%OtherSt_HD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_HD, kind=B8Ki), ubound(InData%OtherSt_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_HD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackOtherState(RF, InData%OtherSt_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_HD)) - if (allocated(InData%u_HD)) then - call RegPackBounds(RF, 1, lbound(InData%u_HD, kind=B8Ki), ubound(InData%u_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_HD, kind=B8Ki) - UB(1:1) = ubound(InData%u_HD, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackInput(RF, InData%u_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_SeaSt)) - if (allocated(InData%x_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%x_SeaSt, kind=B8Ki), ubound(InData%x_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%x_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%x_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackContState(RF, InData%x_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_SeaSt)) - if (allocated(InData%xd_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%xd_SeaSt, kind=B8Ki), ubound(InData%xd_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%xd_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackDiscState(RF, InData%xd_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_SeaSt)) - if (allocated(InData%z_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%z_SeaSt, kind=B8Ki), ubound(InData%z_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%z_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%z_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackConstrState(RF, InData%z_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_SeaSt)) - if (allocated(InData%OtherSt_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_SeaSt, kind=B8Ki), ubound(InData%OtherSt_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackOtherState(RF, InData%OtherSt_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_SeaSt)) - if (allocated(InData%u_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%u_SeaSt, kind=B8Ki), ubound(InData%u_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%u_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%u_SeaSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackInput(RF, InData%u_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_IceF)) - if (allocated(InData%x_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%x_IceF, kind=B8Ki), ubound(InData%x_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%x_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%x_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackContState(RF, InData%x_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_IceF)) - if (allocated(InData%xd_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%xd_IceF, kind=B8Ki), ubound(InData%xd_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%xd_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(RF, InData%xd_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_IceF)) - if (allocated(InData%z_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%z_IceF, kind=B8Ki), ubound(InData%z_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%z_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%z_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(RF, InData%z_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_IceF)) - if (allocated(InData%OtherSt_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_IceF, kind=B8Ki), ubound(InData%OtherSt_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackOtherState(RF, InData%OtherSt_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_IceF)) - if (allocated(InData%u_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%u_IceF, kind=B8Ki), ubound(InData%u_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%u_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%u_IceF, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackInput(RF, InData%u_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_MAP)) - if (allocated(InData%x_MAP)) then - call RegPackBounds(RF, 1, lbound(InData%x_MAP, kind=B8Ki), ubound(InData%x_MAP, kind=B8Ki)) - LB(1:1) = lbound(InData%x_MAP, kind=B8Ki) - UB(1:1) = ubound(InData%x_MAP, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackContState(RF, InData%x_MAP(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_MAP)) - if (allocated(InData%xd_MAP)) then - call RegPackBounds(RF, 1, lbound(InData%xd_MAP, kind=B8Ki), ubound(InData%xd_MAP, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_MAP, kind=B8Ki) - UB(1:1) = ubound(InData%xd_MAP, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackDiscState(RF, InData%xd_MAP(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_MAP)) - if (allocated(InData%z_MAP)) then - call RegPackBounds(RF, 1, lbound(InData%z_MAP, kind=B8Ki), ubound(InData%z_MAP, kind=B8Ki)) - LB(1:1) = lbound(InData%z_MAP, kind=B8Ki) - UB(1:1) = ubound(InData%z_MAP, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackConstrState(RF, InData%z_MAP(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_MAP)) - if (allocated(InData%u_MAP)) then - call RegPackBounds(RF, 1, lbound(InData%u_MAP, kind=B8Ki), ubound(InData%u_MAP, kind=B8Ki)) - LB(1:1) = lbound(InData%u_MAP, kind=B8Ki) - UB(1:1) = ubound(InData%u_MAP, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackInput(RF, InData%u_MAP(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_FEAM)) - if (allocated(InData%x_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%x_FEAM, kind=B8Ki), ubound(InData%x_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%x_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%x_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackContState(RF, InData%x_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_FEAM)) - if (allocated(InData%xd_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%xd_FEAM, kind=B8Ki), ubound(InData%xd_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%xd_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackDiscState(RF, InData%xd_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_FEAM)) - if (allocated(InData%z_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%z_FEAM, kind=B8Ki), ubound(InData%z_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%z_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%z_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackConstrState(RF, InData%z_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_FEAM)) - if (allocated(InData%OtherSt_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_FEAM, kind=B8Ki), ubound(InData%OtherSt_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackOtherState(RF, InData%OtherSt_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_FEAM)) - if (allocated(InData%u_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%u_FEAM, kind=B8Ki), ubound(InData%u_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%u_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%u_FEAM, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackInput(RF, InData%u_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_MD)) - if (allocated(InData%x_MD)) then - call RegPackBounds(RF, 1, lbound(InData%x_MD, kind=B8Ki), ubound(InData%x_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_MD, kind=B8Ki) - UB(1:1) = ubound(InData%x_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackContState(RF, InData%x_MD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_MD)) - if (allocated(InData%xd_MD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_MD, kind=B8Ki), ubound(InData%xd_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_MD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackDiscState(RF, InData%xd_MD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_MD)) - if (allocated(InData%z_MD)) then - call RegPackBounds(RF, 1, lbound(InData%z_MD, kind=B8Ki), ubound(InData%z_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_MD, kind=B8Ki) - UB(1:1) = ubound(InData%z_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackConstrState(RF, InData%z_MD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_MD)) - if (allocated(InData%OtherSt_MD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_MD, kind=B8Ki), ubound(InData%OtherSt_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_MD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackOtherState(RF, InData%OtherSt_MD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_MD)) - if (allocated(InData%u_MD)) then - call RegPackBounds(RF, 1, lbound(InData%u_MD, kind=B8Ki), ubound(InData%u_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_MD, kind=B8Ki) - UB(1:1) = ubound(InData%u_MD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackInput(RF, InData%u_MD(i1)) - end do - end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackLinStateSave(RF, OutData) - type(RegFile), intent(inout) :: RF - type(FAST_LinStateSave), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%x_IceD)) deallocate(OutData%x_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackContState(RF, OutData%x_IceD(i1,i2)) ! x_IceD - end do - end do - end if - if (allocated(OutData%xd_IceD)) deallocate(OutData%xd_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackDiscState(RF, OutData%xd_IceD(i1,i2)) ! xd_IceD - end do - end do - end if - if (allocated(OutData%z_IceD)) deallocate(OutData%z_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackConstrState(RF, OutData%z_IceD(i1,i2)) ! z_IceD - end do - end do - end if - if (allocated(OutData%OtherSt_IceD)) deallocate(OutData%OtherSt_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackOtherState(RF, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD - end do - end do - end if - if (allocated(OutData%u_IceD)) deallocate(OutData%u_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackInput(RF, OutData%u_IceD(i1,i2)) ! u_IceD - end do - end do - end if - if (allocated(OutData%x_BD)) deallocate(OutData%x_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackContState(RF, OutData%x_BD(i1,i2)) ! x_BD - end do - end do - end if - if (allocated(OutData%xd_BD)) deallocate(OutData%xd_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackDiscState(RF, OutData%xd_BD(i1,i2)) ! xd_BD - end do - end do - end if - if (allocated(OutData%z_BD)) deallocate(OutData%z_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackConstrState(RF, OutData%z_BD(i1,i2)) ! z_BD - end do - end do - end if - if (allocated(OutData%OtherSt_BD)) deallocate(OutData%OtherSt_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackOtherState(RF, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD - end do - end do - end if - if (allocated(OutData%u_BD)) deallocate(OutData%u_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackInput(RF, OutData%u_BD(i1,i2)) ! u_BD - end do - end do - end if - if (allocated(OutData%x_ED)) deallocate(OutData%x_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackContState(RF, OutData%x_ED(i1)) ! x_ED - end do - end if - if (allocated(OutData%xd_ED)) deallocate(OutData%xd_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackDiscState(RF, OutData%xd_ED(i1)) ! xd_ED - end do - end if - if (allocated(OutData%z_ED)) deallocate(OutData%z_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackConstrState(RF, OutData%z_ED(i1)) ! z_ED - end do - end if - if (allocated(OutData%OtherSt_ED)) deallocate(OutData%OtherSt_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackOtherState(RF, OutData%OtherSt_ED(i1)) ! OtherSt_ED - end do - end if - if (allocated(OutData%u_ED)) deallocate(OutData%u_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackInput(RF, OutData%u_ED(i1)) ! u_ED - end do - end if - if (allocated(OutData%x_SrvD)) deallocate(OutData%x_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackContState(RF, OutData%x_SrvD(i1)) ! x_SrvD - end do - end if - if (allocated(OutData%xd_SrvD)) deallocate(OutData%xd_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(RF, OutData%xd_SrvD(i1)) ! xd_SrvD - end do - end if - if (allocated(OutData%z_SrvD)) deallocate(OutData%z_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(RF, OutData%z_SrvD(i1)) ! z_SrvD - end do - end if - if (allocated(OutData%OtherSt_SrvD)) deallocate(OutData%OtherSt_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(RF, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD - end do - end if - if (allocated(OutData%u_SrvD)) deallocate(OutData%u_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackInput(RF, OutData%u_SrvD(i1)) ! u_SrvD - end do - end if - if (allocated(OutData%x_AD)) deallocate(OutData%x_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackContState(RF, OutData%x_AD(i1)) ! x_AD - end do - end if - if (allocated(OutData%xd_AD)) deallocate(OutData%xd_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackDiscState(RF, OutData%xd_AD(i1)) ! xd_AD - end do - end if - if (allocated(OutData%z_AD)) deallocate(OutData%z_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackConstrState(RF, OutData%z_AD(i1)) ! z_AD - end do - end if - if (allocated(OutData%OtherSt_AD)) deallocate(OutData%OtherSt_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackOtherState(RF, OutData%OtherSt_AD(i1)) ! OtherSt_AD - end do - end if - if (allocated(OutData%u_AD)) deallocate(OutData%u_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackInput(RF, OutData%u_AD(i1)) ! u_AD - end do - end if - if (allocated(OutData%x_IfW)) deallocate(OutData%x_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(RF, OutData%x_IfW(i1)) ! x_IfW - end do - end if - if (allocated(OutData%xd_IfW)) deallocate(OutData%xd_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(RF, OutData%xd_IfW(i1)) ! xd_IfW - end do - end if - if (allocated(OutData%z_IfW)) deallocate(OutData%z_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(RF, OutData%z_IfW(i1)) ! z_IfW - end do - end if - if (allocated(OutData%OtherSt_IfW)) deallocate(OutData%OtherSt_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(RF, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW - end do - end if - if (allocated(OutData%u_IfW)) deallocate(OutData%u_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(RF, OutData%u_IfW(i1)) ! u_IfW - end do - end if - if (allocated(OutData%x_SD)) deallocate(OutData%x_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackContState(RF, OutData%x_SD(i1)) ! x_SD - end do - end if - if (allocated(OutData%xd_SD)) deallocate(OutData%xd_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackDiscState(RF, OutData%xd_SD(i1)) ! xd_SD - end do - end if - if (allocated(OutData%z_SD)) deallocate(OutData%z_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackConstrState(RF, OutData%z_SD(i1)) ! z_SD - end do - end if - if (allocated(OutData%OtherSt_SD)) deallocate(OutData%OtherSt_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackOtherState(RF, OutData%OtherSt_SD(i1)) ! OtherSt_SD - end do - end if - if (allocated(OutData%u_SD)) deallocate(OutData%u_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackInput(RF, OutData%u_SD(i1)) ! u_SD - end do - end if - if (allocated(OutData%x_ExtPtfm)) deallocate(OutData%x_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(RF, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm - end do - end if - if (allocated(OutData%xd_ExtPtfm)) deallocate(OutData%xd_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(RF, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm - end do - end if - if (allocated(OutData%z_ExtPtfm)) deallocate(OutData%z_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(RF, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm - end do - end if - if (allocated(OutData%OtherSt_ExtPtfm)) deallocate(OutData%OtherSt_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm - end do - end if - if (allocated(OutData%u_ExtPtfm)) deallocate(OutData%u_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackInput(RF, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm - end do - end if - if (allocated(OutData%x_HD)) deallocate(OutData%x_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(RF, OutData%x_HD(i1)) ! x_HD - end do - end if - if (allocated(OutData%xd_HD)) deallocate(OutData%xd_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(RF, OutData%xd_HD(i1)) ! xd_HD - end do - end if - if (allocated(OutData%z_HD)) deallocate(OutData%z_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(RF, OutData%z_HD(i1)) ! z_HD - end do - end if - if (allocated(OutData%OtherSt_HD)) deallocate(OutData%OtherSt_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackOtherState(RF, OutData%OtherSt_HD(i1)) ! OtherSt_HD - end do - end if - if (allocated(OutData%u_HD)) deallocate(OutData%u_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(RF, OutData%u_HD(i1)) ! u_HD - end do - end if - if (allocated(OutData%x_SeaSt)) deallocate(OutData%x_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackContState(RF, OutData%x_SeaSt(i1)) ! x_SeaSt - end do - end if - if (allocated(OutData%xd_SeaSt)) deallocate(OutData%xd_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackDiscState(RF, OutData%xd_SeaSt(i1)) ! xd_SeaSt - end do - end if - if (allocated(OutData%z_SeaSt)) deallocate(OutData%z_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackConstrState(RF, OutData%z_SeaSt(i1)) ! z_SeaSt - end do - end if - if (allocated(OutData%OtherSt_SeaSt)) deallocate(OutData%OtherSt_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackOtherState(RF, OutData%OtherSt_SeaSt(i1)) ! OtherSt_SeaSt - end do - end if - if (allocated(OutData%u_SeaSt)) deallocate(OutData%u_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackInput(RF, OutData%u_SeaSt(i1)) ! u_SeaSt - end do - end if - if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(RF, OutData%x_IceF(i1)) ! x_IceF - end do - end if - if (allocated(OutData%xd_IceF)) deallocate(OutData%xd_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(RF, OutData%xd_IceF(i1)) ! xd_IceF - end do - end if - if (allocated(OutData%z_IceF)) deallocate(OutData%z_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(RF, OutData%z_IceF(i1)) ! z_IceF - end do - end if - if (allocated(OutData%OtherSt_IceF)) deallocate(OutData%OtherSt_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackOtherState(RF, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF - end do - end if - if (allocated(OutData%u_IceF)) deallocate(OutData%u_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(RF, OutData%u_IceF(i1)) ! u_IceF - end do - end if - if (allocated(OutData%x_MAP)) deallocate(OutData%x_MAP) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackContState(RF, OutData%x_MAP(i1)) ! x_MAP - end do - end if - if (allocated(OutData%xd_MAP)) deallocate(OutData%xd_MAP) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(RF, OutData%xd_MAP(i1)) ! xd_MAP - end do - end if - if (allocated(OutData%z_MAP)) deallocate(OutData%z_MAP) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackConstrState(RF, OutData%z_MAP(i1)) ! z_MAP - end do - end if - if (allocated(OutData%u_MAP)) deallocate(OutData%u_MAP) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackInput(RF, OutData%u_MAP(i1)) ! u_MAP - end do - end if - if (allocated(OutData%x_FEAM)) deallocate(OutData%x_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackContState(RF, OutData%x_FEAM(i1)) ! x_FEAM - end do - end if - if (allocated(OutData%xd_FEAM)) deallocate(OutData%xd_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(RF, OutData%xd_FEAM(i1)) ! xd_FEAM - end do - end if - if (allocated(OutData%z_FEAM)) deallocate(OutData%z_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(RF, OutData%z_FEAM(i1)) ! z_FEAM - end do - end if - if (allocated(OutData%OtherSt_FEAM)) deallocate(OutData%OtherSt_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackOtherState(RF, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM - end do - end if - if (allocated(OutData%u_FEAM)) deallocate(OutData%u_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackInput(RF, OutData%u_FEAM(i1)) ! u_FEAM - end do - end if - if (allocated(OutData%x_MD)) deallocate(OutData%x_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackContState(RF, OutData%x_MD(i1)) ! x_MD - end do - end if - if (allocated(OutData%xd_MD)) deallocate(OutData%xd_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackDiscState(RF, OutData%xd_MD(i1)) ! xd_MD - end do - end if - if (allocated(OutData%z_MD)) deallocate(OutData%z_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackConstrState(RF, OutData%z_MD(i1)) ! z_MD - end do - end if - if (allocated(OutData%OtherSt_MD)) deallocate(OutData%OtherSt_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackOtherState(RF, OutData%OtherSt_MD(i1)) ! OtherSt_MD - end do - end if - if (allocated(OutData%u_MD)) deallocate(OutData%u_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackInput(RF, OutData%u_MD(i1)) ! u_MD - end do - end if + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutFmt_t) + call RegPack(RF, InData%FmtWidth) + call RegPack(RF, InData%TChanLen) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%FTitle) + call RegPack(RF, InData%VTK_OutFileRoot) + call RegPack(RF, InData%VTK_tWidth) + call RegPack(RF, InData%VTK_fps) + call FAST_PackVTK_SurfaceType(RF, InData%VTK_surface) + call RegPack(RF, InData%Tdesc) + call RegPack(RF, InData%CalcSteady) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimTol) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%Twr_Kdmp) + call RegPack(RF, InData%Bld_Kdmp) + call RegPack(RF, InData%NLinTimes) + call RegPack(RF, InData%AzimDelta) + call RegPack(RF, InData%LinInputs) + call RegPack(RF, InData%LinOutputs) + call RegPack(RF, InData%LinOutJac) + call RegPack(RF, InData%LinOutMod) + call FAST_PackVTK_ModeShapeType(RF, InData%VTK_modes) + call RegPack(RF, InData%UseSC) + call RegPack(RF, InData%Lin_NumMods) + call RegPack(RF, InData%Lin_ModOrder) + call RegPack(RF, InData%LinInterpOrder) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%N_UJac) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%tolerSquared) + call RegPack(RF, InData%NumSSCases) + call RegPack(RF, InData%WindSpeedOrTSR) + call RegPack(RF, InData%RotSpeedInit) + call RegPackAlloc(RF, InData%RotSpeed) + call RegPackAlloc(RF, InData%WS_TSR) + call RegPackAlloc(RF, InData%Pitch) + call RegPack(RF, InData%GearBox_index) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackParam' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_module); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_substeps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_TMax_m1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numIceLegs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBeams); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BD_OutputSibling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ModuleInitialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_Ujac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UJacSclFact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SizeJac_Opt1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SolveOption); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompElast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompServo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSeaSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompMooring); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompIce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseDWM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FarmIntegration); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbinePos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EDFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BDBldFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ServoFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SeaStFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HydroFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MooringFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_Out); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrSttsTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_SttsTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_ChkptTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_DT_Out); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_VTKTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrBinOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrTxtOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrBinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_fields); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FmtWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TChanLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_fps); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackVTK_SurfaceType(RF, OutData%VTK_surface) ! VTK_surface + call RegUnpack(RF, OutData%Tdesc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CalcSteady); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twr_Kdmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Bld_Kdmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NLinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimDelta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutMod); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackVTK_ModeShapeType(RF, OutData%VTK_modes) ! VTK_modes + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lin_NumMods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lin_ModOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinInterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tolerSquared); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSSCases); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeedOrTSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WS_TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg) @@ -6001,7 +2538,7 @@ subroutine FAST_UnPackMiscLinType(RF, OutData) end subroutine subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) - type(FAST_OutputFileType), intent(inout) :: SrcOutputFileTypeData + type(FAST_OutputFileType), intent(in) :: SrcOutputFileTypeData type(FAST_OutputFileType), intent(inout) :: DstOutputFileTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat @@ -6083,9 +2620,6 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen - call FAST_CopyLinStateSave(SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput end subroutine @@ -6120,8 +2654,6 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) end do call FAST_DestroyLinFileType(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackOutputFileType(RF, Indata) @@ -6153,7 +2685,6 @@ subroutine FAST_PackOutputFileType(RF, Indata) call RegPack(RF, InData%VTK_LastWaveIndx) call FAST_PackLinFileType(RF, InData%Lin) call RegPack(RF, InData%ActualChanLen) - call FAST_PackLinStateSave(RF, InData%op) call RegPack(RF, InData%DriverWriteOutput) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6189,7 +2720,6 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) call RegUnpack(RF, OutData%VTK_LastWaveIndx); if (RegCheckErr(RF, RoutineName)) return call FAST_UnpackLinFileType(RF, OutData%Lin) ! Lin call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return - call FAST_UnpackLinStateSave(RF, OutData%op) ! op call RegUnpack(RF, OutData%DriverWriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6294,22 +2824,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcIceDyn_DataData%u)) then - LB(1:1) = lbound(SrcIceDyn_DataData%u, kind=B8Ki) - UB(1:1) = ubound(SrcIceDyn_DataData%u, kind=B8Ki) - if (.not. allocated(DstIceDyn_DataData%u)) then - allocate(DstIceDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceD_CopyInput(SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcIceDyn_DataData%y)) then LB(1:1) = lbound(SrcIceDyn_DataData%y, kind=B8Ki) UB(1:1) = ubound(SrcIceDyn_DataData%y, kind=B8Ki) @@ -6438,15 +2952,6 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) end do deallocate(IceDyn_DataData%p) end if - if (allocated(IceDyn_DataData%u)) then - LB(1:1) = lbound(IceDyn_DataData%u, kind=B8Ki) - UB(1:1) = ubound(IceDyn_DataData%u, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceD_DestroyInput(IceDyn_DataData%u(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(IceDyn_DataData%u) - end if if (allocated(IceDyn_DataData%y)) then LB(1:1) = lbound(IceDyn_DataData%y, kind=B8Ki) UB(1:1) = ubound(IceDyn_DataData%y, kind=B8Ki) @@ -6541,15 +3046,6 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) call IceD_PackParam(RF, InData%p(i1)) end do end if - call RegPack(RF, allocated(InData%u)) - if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceD_PackInput(RF, InData%u(i1)) - end do - end if call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) @@ -6665,19 +3161,6 @@ subroutine FAST_UnPackIceDyn_Data(RF, OutData) call IceD_UnpackParam(RF, OutData%p(i1)) ! p end do end if - if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceD_UnpackInput(RF, OutData%u(i1)) ! u - end do - end if if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -6839,22 +3322,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcBeamDyn_DataData%u)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%u, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%u, kind=B8Ki) - if (.not. allocated(DstBeamDyn_DataData%u)) then - allocate(DstBeamDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call BD_CopyInput(SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcBeamDyn_DataData%y)) then LB(1:1) = lbound(SrcBeamDyn_DataData%y, kind=B8Ki) UB(1:1) = ubound(SrcBeamDyn_DataData%y, kind=B8Ki) @@ -7026,15 +3493,6 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%p) end if - if (allocated(BeamDyn_DataData%u)) then - LB(1:1) = lbound(BeamDyn_DataData%u, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%u, kind=B8Ki) - do i1 = LB(1), UB(1) - call BD_DestroyInput(BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(BeamDyn_DataData%u) - end if if (allocated(BeamDyn_DataData%y)) then LB(1:1) = lbound(BeamDyn_DataData%y, kind=B8Ki) UB(1:1) = ubound(BeamDyn_DataData%y, kind=B8Ki) @@ -7158,15 +3616,6 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) call BD_PackParam(RF, InData%p(i1)) end do end if - call RegPack(RF, allocated(InData%u)) - if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) - do i1 = LB(1), UB(1) - call BD_PackInput(RF, InData%u(i1)) - end do - end if call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) @@ -7315,19 +3764,6 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) call BD_UnpackParam(RF, OutData%p(i1)) ! p end do end if - if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call BD_UnpackInput(RF, OutData%u(i1)) ! u - end do - end if if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -7483,9 +3919,6 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call ED_CopyParam(SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call ED_CopyInput(SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call ED_CopyOutput(SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -7608,8 +4041,6 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) end if call ED_DestroyParam(ElastoDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyInput(ElastoDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ED_DestroyOutput(ElastoDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) @@ -7693,7 +4124,6 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) end do end if call ED_PackParam(RF, InData%p) - call ED_PackInput(RF, InData%u) call ED_PackOutput(RF, InData%y) call ED_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Output)) @@ -7791,7 +4221,6 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) end do end if call ED_UnpackParam(RF, OutData%p) ! p - call ED_UnpackInput(RF, OutData%u) ! u call ED_UnpackOutput(RF, OutData%y) ! y call ED_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) @@ -7917,9 +4346,6 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat call SED_CopyParam(SrcSED_DataData%p, DstSED_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SED_CopyInput(SrcSED_DataData%u, DstSED_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call SED_CopyOutput(SrcSED_DataData%y, DstSED_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -8024,8 +4450,6 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) end if call SED_DestroyParam(SED_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SED_DestroyInput(SED_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SED_DestroyOutput(SED_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SED_DestroyMisc(SED_DataData%m, ErrStat2, ErrMsg2) @@ -8099,7 +4523,6 @@ subroutine FAST_PackSED_Data(RF, Indata) end do end if call SED_PackParam(RF, InData%p) - call SED_PackInput(RF, InData%u) call SED_PackOutput(RF, InData%y) call SED_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Output)) @@ -8187,7 +4610,6 @@ subroutine FAST_UnPackSED_Data(RF, OutData) end do end if call SED_UnpackParam(RF, OutData%p) ! p - call SED_UnpackInput(RF, OutData%u) ! u call SED_UnpackOutput(RF, OutData%y) ! y call SED_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) @@ -8300,9 +4722,6 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct call SrvD_CopyParam(SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SrvD_CopyInput(SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call SrvD_CopyOutput(SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -8410,8 +4829,6 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) end if call SrvD_DestroyParam(ServoDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SrvD_DestroyInput(ServoDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SrvD_DestroyOutput(ServoDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SrvD_DestroyMisc(ServoDyn_DataData%m, ErrStat2, ErrMsg2) @@ -8487,7 +4904,6 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) end do end if call SrvD_PackParam(RF, InData%p) - call SrvD_PackInput(RF, InData%u) call SrvD_PackOutput(RF, InData%y) call SrvD_PackMisc(RF, InData%m) call SrvD_PackMisc(RF, InData%m_bak) @@ -8576,7 +4992,6 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) end do end if call SrvD_UnpackParam(RF, OutData%p) ! p - call SrvD_UnpackInput(RF, OutData%u) ! u call SrvD_UnpackOutput(RF, OutData%y) ! y call SrvD_UnpackMisc(RF, OutData%m) ! m call SrvD_UnpackMisc(RF, OutData%m_bak) ! m_bak @@ -8690,9 +5105,6 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC call AD_CopyParam(SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call AD_CopyInput(SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call AD_CopyOutput(SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -8797,8 +5209,6 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) end if call AD_DestroyParam(AeroDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AD_DestroyInput(AeroDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AD_DestroyOutput(AeroDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AD_DestroyMisc(AeroDyn_DataData%m, ErrStat2, ErrMsg2) @@ -8872,7 +5282,6 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) end do end if call AD_PackParam(RF, InData%p) - call AD_PackInput(RF, InData%u) call AD_PackOutput(RF, InData%y) call AD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Output)) @@ -8960,7 +5369,6 @@ subroutine FAST_UnPackAeroDyn_Data(RF, OutData) end do end if call AD_UnpackParam(RF, OutData%p) ! p - call AD_UnpackInput(RF, OutData%u) ! u call AD_UnpackOutput(RF, OutData%y) ! y call AD_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) @@ -9259,9 +5667,6 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct call ADsk_CopyParam(SrcAeroDisk_DataData%p, DstAeroDisk_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call ADsk_CopyInput(SrcAeroDisk_DataData%u, DstAeroDisk_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call ADsk_CopyOutput(SrcAeroDisk_DataData%y, DstAeroDisk_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -9366,8 +5771,6 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) end if call ADsk_DestroyParam(AeroDisk_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ADsk_DestroyInput(AeroDisk_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADsk_DestroyOutput(AeroDisk_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADsk_DestroyMisc(AeroDisk_DataData%m, ErrStat2, ErrMsg2) @@ -9441,7 +5844,6 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) end do end if call ADsk_PackParam(RF, InData%p) - call ADsk_PackInput(RF, InData%u) call ADsk_PackOutput(RF, InData%y) call ADsk_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Output)) @@ -9529,7 +5931,6 @@ subroutine FAST_UnPackAeroDisk_Data(RF, OutData) end do end if call ADsk_UnpackParam(RF, OutData%p) ! p - call ADsk_UnpackInput(RF, OutData%u) ! u call ADsk_UnpackOutput(RF, OutData%y) ! y call ADsk_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) @@ -9642,9 +6043,6 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa call InflowWind_CopyParam(SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call InflowWind_CopyInput(SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call InflowWind_CopyOutput(SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -9749,8 +6147,6 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) end if call InflowWind_DestroyParam(InflowWind_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call InflowWind_DestroyInput(InflowWind_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyOutput(InflowWind_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyMisc(InflowWind_DataData%m, ErrStat2, ErrMsg2) @@ -9824,7 +6220,6 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) end do end if call InflowWind_PackParam(RF, InData%p) - call InflowWind_PackInput(RF, InData%u) call InflowWind_PackOutput(RF, InData%y) call InflowWind_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Output)) @@ -9912,7 +6307,6 @@ subroutine FAST_UnPackInflowWind_Data(RF, OutData) end do end if call InflowWind_UnpackParam(RF, OutData%p) ! p - call InflowWind_UnpackInput(RF, OutData%u) ! u call InflowWind_UnpackOutput(RF, OutData%y) ! y call InflowWind_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) @@ -10155,9 +6549,6 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SD_CopyParam(SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SD_CopyInput(SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call SD_CopyOutput(SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -10264,8 +6655,6 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) end if call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyInput(SubDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SD_DestroyOutput(SubDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) @@ -10340,7 +6729,6 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) end do end if call SD_PackParam(RF, InData%p) - call SD_PackInput(RF, InData%u) call SD_PackOutput(RF, InData%y) call SD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -10429,7 +6817,6 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) end do end if call SD_UnpackParam(RF, OutData%p) ! p - call SD_UnpackInput(RF, OutData%u) ! u call SD_UnpackOutput(RF, OutData%y) ! y call SD_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) @@ -10542,9 +6929,6 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC call ExtPtfm_CopyParam(SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call ExtPtfm_CopyInput(SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call ExtPtfm_CopyOutput(SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -10630,8 +7014,6 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) end if call ExtPtfm_DestroyParam(ExtPtfm_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ExtPtfm_DestroyInput(ExtPtfm_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ExtPtfm_DestroyOutput(ExtPtfm_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ExtPtfm_DestroyMisc(ExtPtfm_DataData%m, ErrStat2, ErrMsg2) @@ -10694,7 +7076,6 @@ subroutine FAST_PackExtPtfm_Data(RF, Indata) end do end if call ExtPtfm_PackParam(RF, InData%p) - call ExtPtfm_PackInput(RF, InData%u) call ExtPtfm_PackOutput(RF, InData%y) call ExtPtfm_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -10772,7 +7153,6 @@ subroutine FAST_UnPackExtPtfm_Data(RF, OutData) end do end if call ExtPtfm_UnpackParam(RF, OutData%p) ! p - call ExtPtfm_UnpackInput(RF, OutData%u) ! u call ExtPtfm_UnpackOutput(RF, OutData%y) ! y call ExtPtfm_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) @@ -10871,9 +7251,6 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -10978,8 +7355,6 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) end if call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) @@ -11053,7 +7428,6 @@ subroutine FAST_PackSeaState_Data(RF, Indata) end do end if call SeaSt_PackParam(RF, InData%p) - call SeaSt_PackInput(RF, InData%u) call SeaSt_PackOutput(RF, InData%y) call SeaSt_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -11141,7 +7515,6 @@ subroutine FAST_UnPackSeaState_Data(RF, OutData) end do end if call SeaSt_UnpackParam(RF, OutData%p) ! p - call SeaSt_UnpackInput(RF, OutData%u) ! u call SeaSt_UnpackOutput(RF, OutData%y) ! y call SeaSt_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) @@ -11257,9 +7630,6 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call HydroDyn_CopyParam(SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call HydroDyn_CopyInput(SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -11366,8 +7736,6 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) end if call HydroDyn_DestroyParam(HydroDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyInput(HydroDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call HydroDyn_DestroyOutput(HydroDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) @@ -11442,7 +7810,6 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) end do end if call HydroDyn_PackParam(RF, InData%p) - call HydroDyn_PackInput(RF, InData%u) call HydroDyn_PackOutput(RF, InData%y) call HydroDyn_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Output)) @@ -11531,7 +7898,6 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) end do end if call HydroDyn_UnpackParam(RF, OutData%p) ! p - call HydroDyn_UnpackInput(RF, OutData%u) ! u call HydroDyn_UnpackOutput(RF, OutData%y) ! y call HydroDyn_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) @@ -11644,9 +8010,6 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC call IceFloe_CopyParam(SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call IceFloe_CopyInput(SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call IceFloe_CopyOutput(SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -11732,8 +8095,6 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) end if call IceFloe_DestroyParam(IceFloe_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call IceFloe_DestroyInput(IceFloe_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call IceFloe_DestroyOutput(IceFloe_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call IceFloe_DestroyMisc(IceFloe_DataData%m, ErrStat2, ErrMsg2) @@ -11796,7 +8157,6 @@ subroutine FAST_PackIceFloe_Data(RF, Indata) end do end if call IceFloe_PackParam(RF, InData%p) - call IceFloe_PackInput(RF, InData%u) call IceFloe_PackOutput(RF, InData%y) call IceFloe_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -11874,7 +8234,6 @@ subroutine FAST_UnPackIceFloe_Data(RF, OutData) end do end if call IceFloe_UnpackParam(RF, OutData%p) ! p - call IceFloe_UnpackInput(RF, OutData%u) ! u call IceFloe_UnpackOutput(RF, OutData%y) ! y call IceFloe_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) @@ -11960,9 +8319,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat call MAP_CopyParam(SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MAP_CopyInput(SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call MAP_CopyOutput(SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -12063,8 +8419,6 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyParam(MAP_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MAP_DestroyInput(MAP_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyOutput(MAP_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyMisc(MAP_DataData%m, ErrStat2, ErrMsg2) @@ -12132,7 +8486,6 @@ subroutine FAST_PackMAP_Data(RF, Indata) end if call MAP_PackOtherState(RF, InData%OtherSt) call MAP_PackParam(RF, InData%p) - call MAP_PackInput(RF, InData%u) call MAP_PackOutput(RF, InData%y) call MAP_PackMisc(RF, InData%m) call MAP_PackOtherState(RF, InData%OtherSt_old) @@ -12209,7 +8562,6 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) end if call MAP_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt call MAP_UnpackParam(RF, OutData%p) ! p - call MAP_UnpackInput(RF, OutData%u) ! u call MAP_UnpackOutput(RF, OutData%y) ! y call MAP_UnpackMisc(RF, OutData%m) ! m call MAP_UnpackOtherState(RF, OutData%OtherSt_old) ! OtherSt_old @@ -12323,9 +8675,6 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa call FEAM_CopyParam(SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call FEAM_CopyInput(SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call FEAM_CopyOutput(SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -12411,8 +8760,6 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) end if call FEAM_DestroyParam(FEAMooring_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FEAM_DestroyInput(FEAMooring_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FEAM_DestroyOutput(FEAMooring_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FEAM_DestroyMisc(FEAMooring_DataData%m, ErrStat2, ErrMsg2) @@ -12475,7 +8822,6 @@ subroutine FAST_PackFEAMooring_Data(RF, Indata) end do end if call FEAM_PackParam(RF, InData%p) - call FEAM_PackInput(RF, InData%u) call FEAM_PackOutput(RF, InData%y) call FEAM_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -12553,7 +8899,6 @@ subroutine FAST_UnPackFEAMooring_Data(RF, OutData) end do end if call FEAM_UnpackParam(RF, OutData%p) ! p - call FEAM_UnpackInput(RF, OutData%u) ! u call FEAM_UnpackOutput(RF, OutData%y) ! y call FEAM_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) @@ -12652,9 +8997,6 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC call MD_CopyParam(SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MD_CopyInput(SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call MD_CopyOutput(SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -12759,8 +9101,6 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) end if call MD_DestroyParam(MoorDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MD_DestroyInput(MoorDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MD_DestroyOutput(MoorDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MD_DestroyMisc(MoorDyn_DataData%m, ErrStat2, ErrMsg2) @@ -12834,7 +9174,6 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) end do end if call MD_PackParam(RF, InData%p) - call MD_PackInput(RF, InData%u) call MD_PackOutput(RF, InData%y) call MD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Output)) @@ -12922,7 +9261,6 @@ subroutine FAST_UnPackMoorDyn_Data(RF, OutData) end do end if call MD_UnpackParam(RF, OutData%p) ! p - call MD_UnpackInput(RF, OutData%u) ! u call MD_UnpackOutput(RF, OutData%y) ! y call MD_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) @@ -13035,9 +9373,6 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct call Orca_CopyParam(SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call Orca_CopyInput(SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return call Orca_CopyOutput(SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -13123,8 +9458,6 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) end if call Orca_DestroyParam(OrcaFlex_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Orca_DestroyInput(OrcaFlex_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Orca_DestroyOutput(OrcaFlex_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Orca_DestroyMisc(OrcaFlex_DataData%m, ErrStat2, ErrMsg2) @@ -13187,7 +9520,6 @@ subroutine FAST_PackOrcaFlex_Data(RF, Indata) end do end if call Orca_PackParam(RF, InData%p) - call Orca_PackInput(RF, InData%u) call Orca_PackOutput(RF, InData%y) call Orca_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -13265,7 +9597,6 @@ subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) end do end if call Orca_UnpackParam(RF, OutData%p) ! p - call Orca_UnpackInput(RF, OutData%u) ! u call Orca_UnpackOutput(RF, OutData%y) ! y call Orca_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) From c45661fbb29cd08c60133a8b3cb395b4cd624d5b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Nov 2024 19:54:25 +0000 Subject: [PATCH 282/319] Remove unused members of module data structures --- .../openfast-library/src/FAST_Registry.txt | 26 - modules/openfast-library/src/FAST_Types.f90 | 776 ------------------ 2 files changed, 802 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 482db2926d..4113cb4ef5 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -343,8 +343,6 @@ typedef ^ ^ BD_OtherStateType OtherSt {:}{:} - - "Other states" typedef ^ ^ BD_ParameterType p {:} - - "Parameters" typedef ^ ^ BD_OutputType y {:} - - "System outputs" typedef ^ ^ BD_MiscVarType m {:} - - "Misc/optimization variables" -typedef ^ ^ BD_OutputType Output {:}{:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ BD_OutputType y_interp {:} - - "interpolated system outputs for CalcSteady" typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" @@ -357,9 +355,6 @@ typedef ^ ^ ED_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ED_ParameterType p - - - "Parameters" typedef ^ ^ ED_OutputType y - - - "System outputs" typedef ^ ^ ED_MiscVarType m - - - "Misc (optimization) variables not associated with time" -typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ ED_OutputType Output_bak {:} - - "Backup Array of outputs associated with InputTimes" -typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -372,8 +367,6 @@ typedef ^ ^ SED_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SED_ParameterType p - - - "Parameters" typedef ^ ^ SED_OutputType y - - - "System outputs" typedef ^ ^ SED_MiscVarType m - - - "Misc (optimization) variables not associated with time" -typedef ^ ^ SED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ SED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SED_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -386,9 +379,6 @@ typedef ^ ^ SrvD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SrvD_ParameterType p - - - "Parameters" typedef ^ ^ SrvD_OutputType y - - - "System outputs" typedef ^ ^ SrvD_MiscVarType m - - - "Misc (optimization) variables not associated with time" -typedef ^ ^ SrvD_MiscVarType m_bak - - - "Backup Misc (optimization) variables not associated with time" -typedef ^ ^ SrvD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ SrvD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SrvD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -400,8 +390,6 @@ typedef ^ ^ AD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ AD_ParameterType p - - - "Parameters" typedef ^ ^ AD_OutputType y - - - "System outputs" typedef ^ ^ AD_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ AD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ AD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ AD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -424,8 +412,6 @@ typedef ^ ^ ADsk_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ADsk_ParameterType p - - - "Parameters" typedef ^ ^ ADsk_OutputType y - - - "System outputs" typedef ^ ^ ADsk_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ ADsk_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ ADsk_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ADsk_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -437,8 +423,6 @@ typedef ^ ^ InflowWind_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ InflowWind_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ InflowWind_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ InflowWind_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -463,8 +447,6 @@ typedef ^ ^ SD_ParameterType p - - - "Parameters" typedef ^ ^ SD_OutputType y - - - "System outputs" typedef ^ ^ SD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ SD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... ExtPtfm data ....................................................................................................... @@ -487,8 +469,6 @@ typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" typedef ^ ^ SeaSt_OutputType y - - - "System outputs" typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SeaSt_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SeaSt_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ SeaSt_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... HydroDyn data ....................................................................................................... @@ -500,8 +480,6 @@ typedef ^ ^ HydroDyn_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ HydroDyn_ParameterType p - - - "Parameters" typedef ^ ^ HydroDyn_OutputType y - - - "System outputs" typedef ^ ^ HydroDyn_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ HydroDyn_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ HydroDyn_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ HydroDyn_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -525,8 +503,6 @@ typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_OutputType y - - - "System outputs" typedef ^ ^ MAP_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (copied for the case of subcycling)" -typedef ^ ^ MAP_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MAP_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -549,8 +525,6 @@ typedef ^ ^ MD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ MD_ParameterType p - - - "Parameters" typedef ^ ^ MD_OutputType y - - - "System outputs" typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ MD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ MD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 1cf335c667..a845083114 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -351,8 +351,6 @@ MODULE FAST_Types TYPE(BD_ParameterType) , DIMENSION(:), ALLOCATABLE :: p !< Parameters [-] TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(BD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] - TYPE(BD_OutputType) , DIMENSION(:,:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE BeamDyn_Data @@ -367,9 +365,6 @@ MODULE FAST_Types TYPE(ED_ParameterType) :: p !< Parameters [-] TYPE(ED_OutputType) :: y !< System outputs [-] TYPE(ED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] - TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output_bak !< Backup Array of outputs associated with InputTimes [-] - TYPE(ED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ElastoDyn_Data @@ -383,8 +378,6 @@ MODULE FAST_Types TYPE(SED_ParameterType) :: p !< Parameters [-] TYPE(SED_OutputType) :: y !< System outputs [-] TYPE(SED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] - TYPE(SED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(SED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE SED_Data @@ -398,9 +391,6 @@ MODULE FAST_Types TYPE(SrvD_ParameterType) :: p !< Parameters [-] TYPE(SrvD_OutputType) :: y !< System outputs [-] TYPE(SrvD_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] - TYPE(SrvD_MiscVarType) :: m_bak !< Backup Misc (optimization) variables not associated with time [-] - TYPE(SrvD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(SrvD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ServoDyn_Data @@ -414,8 +404,6 @@ MODULE FAST_Types TYPE(AD_ParameterType) :: p !< Parameters [-] TYPE(AD_OutputType) :: y !< System outputs [-] TYPE(AD_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(AD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(AD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE AeroDyn_Data @@ -442,8 +430,6 @@ MODULE FAST_Types TYPE(ADsk_ParameterType) :: p !< Parameters [-] TYPE(ADsk_OutputType) :: y !< System outputs [-] TYPE(ADsk_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(ADsk_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(ADsk_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ADsk_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE AeroDisk_Data @@ -457,8 +443,6 @@ MODULE FAST_Types TYPE(InflowWind_ParameterType) :: p !< Parameters [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(InflowWind_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(InflowWind_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE InflowWind_Data @@ -489,8 +473,6 @@ MODULE FAST_Types TYPE(SD_OutputType) :: y !< System outputs [-] TYPE(SD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(SD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE SubDyn_Data ! ======================= @@ -517,8 +499,6 @@ MODULE FAST_Types TYPE(SeaSt_OutputType) :: y !< System outputs [-] TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SeaSt_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(SeaSt_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE SeaState_Data ! ======================= @@ -532,8 +512,6 @@ MODULE FAST_Types TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] TYPE(HydroDyn_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(HydroDyn_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(HydroDyn_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE HydroDyn_Data @@ -561,8 +539,6 @@ MODULE FAST_Types TYPE(MAP_OutputType) :: y !< System outputs [-] TYPE(MAP_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(MAP_OtherStateType) :: OtherSt_old !< Other/optimization states (copied for the case of subcycling) [-] - TYPE(MAP_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(MAP_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE MAP_Data @@ -589,8 +565,6 @@ MODULE FAST_Types TYPE(MD_ParameterType) :: p !< Parameters [-] TYPE(MD_OutputType) :: y !< System outputs [-] TYPE(MD_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(MD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(MD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE MoorDyn_Data @@ -3354,40 +3328,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcBeamDyn_DataData%Output)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%Output, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%Output, kind=B8Ki) - if (.not. allocated(DstBeamDyn_DataData%Output)) then - allocate(DstBeamDyn_DataData%Output(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyOutput(SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcBeamDyn_DataData%y_interp)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%y_interp, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%y_interp, kind=B8Ki) - if (.not. allocated(DstBeamDyn_DataData%y_interp)) then - allocate(DstBeamDyn_DataData%y_interp(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call BD_CopyOutput(SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcBeamDyn_DataData%Input)) then LB(1:2) = lbound(SrcBeamDyn_DataData%Input, kind=B8Ki) UB(1:2) = ubound(SrcBeamDyn_DataData%Input, kind=B8Ki) @@ -3511,26 +3451,6 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%m) end if - if (allocated(BeamDyn_DataData%Output)) then - LB(1:2) = lbound(BeamDyn_DataData%Output, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%Output, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyOutput(BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(BeamDyn_DataData%Output) - end if - if (allocated(BeamDyn_DataData%y_interp)) then - LB(1:1) = lbound(BeamDyn_DataData%y_interp, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%y_interp, kind=B8Ki) - do i1 = LB(1), UB(1) - call BD_DestroyOutput(BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(BeamDyn_DataData%y_interp) - end if if (allocated(BeamDyn_DataData%Input)) then LB(1:2) = lbound(BeamDyn_DataData%Input, kind=B8Ki) UB(1:2) = ubound(BeamDyn_DataData%Input, kind=B8Ki) @@ -3634,26 +3554,6 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) call BD_PackMisc(RF, InData%m(i1)) end do end if - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 2, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:2) = lbound(InData%Output, kind=B8Ki) - UB(1:2) = ubound(InData%Output, kind=B8Ki) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackOutput(RF, InData%Output(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%y_interp)) - if (allocated(InData%y_interp)) then - call RegPackBounds(RF, 1, lbound(InData%y_interp, kind=B8Ki), ubound(InData%y_interp, kind=B8Ki)) - LB(1:1) = lbound(InData%y_interp, kind=B8Ki) - UB(1:1) = ubound(InData%y_interp, kind=B8Ki) - do i1 = LB(1), UB(1) - call BD_PackOutput(RF, InData%y_interp(i1)) - end do - end if call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -3790,34 +3690,6 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) call BD_UnpackMisc(RF, OutData%m(i1)) ! m end do end if - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackOutput(RF, OutData%Output(i1,i2)) ! Output - end do - end do - end if - if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call BD_UnpackOutput(RF, OutData%y_interp(i1)) ! y_interp - end do - end if if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -3925,41 +3797,6 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call ED_CopyMisc(SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcElastoDyn_DataData%Output)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%Output, kind=B8Ki) - if (.not. allocated(DstElastoDyn_DataData%Output)) then - allocate(DstElastoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ED_CopyOutput(SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcElastoDyn_DataData%Output_bak)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Output_bak, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%Output_bak, kind=B8Ki) - if (.not. allocated(DstElastoDyn_DataData%Output_bak)) then - allocate(DstElastoDyn_DataData%Output_bak(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output_bak.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ED_CopyOutput(SrcElastoDyn_DataData%Output_bak(i1), DstElastoDyn_DataData%Output_bak(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call ED_CopyOutput(SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcElastoDyn_DataData%Input)) then LB(1:1) = lbound(SrcElastoDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcElastoDyn_DataData%Input, kind=B8Ki) @@ -4045,26 +3882,6 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ElastoDyn_DataData%Output)) then - LB(1:1) = lbound(ElastoDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyOutput(ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ElastoDyn_DataData%Output) - end if - if (allocated(ElastoDyn_DataData%Output_bak)) then - LB(1:1) = lbound(ElastoDyn_DataData%Output_bak, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%Output_bak, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_DestroyOutput(ElastoDyn_DataData%Output_bak(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ElastoDyn_DataData%Output_bak) - end if - call ED_DestroyOutput(ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ElastoDyn_DataData%Input)) then LB(1:1) = lbound(ElastoDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(ElastoDyn_DataData%Input, kind=B8Ki) @@ -4126,25 +3943,6 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) call ED_PackParam(RF, InData%p) call ED_PackOutput(RF, InData%y) call ED_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackOutput(RF, InData%Output(i1)) - end do - end if - call RegPack(RF, allocated(InData%Output_bak)) - if (allocated(InData%Output_bak)) then - call RegPackBounds(RF, 1, lbound(InData%Output_bak, kind=B8Ki), ubound(InData%Output_bak, kind=B8Ki)) - LB(1:1) = lbound(InData%Output_bak, kind=B8Ki) - UB(1:1) = ubound(InData%Output_bak, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackOutput(RF, InData%Output_bak(i1)) - end do - end if - call ED_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -4223,33 +4021,6 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) call ED_UnpackParam(RF, OutData%p) ! p call ED_UnpackOutput(RF, OutData%y) ! y call ED_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - if (allocated(OutData%Output_bak)) deallocate(OutData%Output_bak) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output_bak(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output_bak.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackOutput(RF, OutData%Output_bak(i1)) ! Output_bak - end do - end if - call ED_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -4352,25 +4123,6 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat call SED_CopyMisc(SrcSED_DataData%m, DstSED_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcSED_DataData%Output)) then - LB(1:1) = lbound(SrcSED_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%Output, kind=B8Ki) - if (.not. allocated(DstSED_DataData%Output)) then - allocate(DstSED_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SED_CopyOutput(SrcSED_DataData%Output(i1), DstSED_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call SED_CopyOutput(SrcSED_DataData%y_interp, DstSED_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcSED_DataData%Input)) then LB(1:1) = lbound(SrcSED_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcSED_DataData%Input, kind=B8Ki) @@ -4454,17 +4206,6 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SED_DestroyMisc(SED_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(SED_DataData%Output)) then - LB(1:1) = lbound(SED_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_DestroyOutput(SED_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SED_DataData%Output) - end if - call SED_DestroyOutput(SED_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SED_DataData%Input)) then LB(1:1) = lbound(SED_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SED_DataData%Input, kind=B8Ki) @@ -4525,16 +4266,6 @@ subroutine FAST_PackSED_Data(RF, Indata) call SED_PackParam(RF, InData%p) call SED_PackOutput(RF, InData%y) call SED_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_PackOutput(RF, InData%Output(i1)) - end do - end if - call SED_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -4612,20 +4343,6 @@ subroutine FAST_UnPackSED_Data(RF, OutData) call SED_UnpackParam(RF, OutData%p) ! p call SED_UnpackOutput(RF, OutData%y) ! y call SED_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SED_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call SED_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -4728,28 +4445,6 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct call SrvD_CopyMisc(SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SrvD_CopyMisc(SrcServoDyn_DataData%m_bak, DstServoDyn_DataData%m_bak, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcServoDyn_DataData%Output)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%Output, kind=B8Ki) - if (.not. allocated(DstServoDyn_DataData%Output)) then - allocate(DstServoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SrvD_CopyOutput(SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call SrvD_CopyOutput(SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcServoDyn_DataData%Input)) then LB(1:1) = lbound(SrcServoDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcServoDyn_DataData%Input, kind=B8Ki) @@ -4833,19 +4528,6 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SrvD_DestroyMisc(ServoDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SrvD_DestroyMisc(ServoDyn_DataData%m_bak, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ServoDyn_DataData%Output)) then - LB(1:1) = lbound(ServoDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_DestroyOutput(ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ServoDyn_DataData%Output) - end if - call SrvD_DestroyOutput(ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ServoDyn_DataData%Input)) then LB(1:1) = lbound(ServoDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(ServoDyn_DataData%Input, kind=B8Ki) @@ -4906,17 +4588,6 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) call SrvD_PackParam(RF, InData%p) call SrvD_PackOutput(RF, InData%y) call SrvD_PackMisc(RF, InData%m) - call SrvD_PackMisc(RF, InData%m_bak) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackOutput(RF, InData%Output(i1)) - end do - end if - call SrvD_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -4994,21 +4665,6 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) call SrvD_UnpackParam(RF, OutData%p) ! p call SrvD_UnpackOutput(RF, OutData%y) ! y call SrvD_UnpackMisc(RF, OutData%m) ! m - call SrvD_UnpackMisc(RF, OutData%m_bak) ! m_bak - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call SrvD_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -5111,25 +4767,6 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC call AD_CopyMisc(SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcAeroDyn_DataData%Output)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%Output, kind=B8Ki) - if (.not. allocated(DstAeroDyn_DataData%Output)) then - allocate(DstAeroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyOutput(SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call AD_CopyOutput(SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroDyn_DataData%Input)) then LB(1:1) = lbound(SrcAeroDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcAeroDyn_DataData%Input, kind=B8Ki) @@ -5213,17 +4850,6 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AD_DestroyMisc(AeroDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(AeroDyn_DataData%Output)) then - LB(1:1) = lbound(AeroDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyOutput(AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(AeroDyn_DataData%Output) - end if - call AD_DestroyOutput(AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn_DataData%Input)) then LB(1:1) = lbound(AeroDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(AeroDyn_DataData%Input, kind=B8Ki) @@ -5284,16 +4910,6 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) call AD_PackParam(RF, InData%p) call AD_PackOutput(RF, InData%y) call AD_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackOutput(RF, InData%Output(i1)) - end do - end if - call AD_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -5371,20 +4987,6 @@ subroutine FAST_UnPackAeroDyn_Data(RF, OutData) call AD_UnpackParam(RF, OutData%p) ! p call AD_UnpackOutput(RF, OutData%y) ! y call AD_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call AD_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -5673,25 +5275,6 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct call ADsk_CopyMisc(SrcAeroDisk_DataData%m, DstAeroDisk_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcAeroDisk_DataData%Output)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%Output, kind=B8Ki) - if (.not. allocated(DstAeroDisk_DataData%Output)) then - allocate(DstAeroDisk_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ADsk_CopyOutput(SrcAeroDisk_DataData%Output(i1), DstAeroDisk_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call ADsk_CopyOutput(SrcAeroDisk_DataData%y_interp, DstAeroDisk_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroDisk_DataData%Input)) then LB(1:1) = lbound(SrcAeroDisk_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcAeroDisk_DataData%Input, kind=B8Ki) @@ -5775,17 +5358,6 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADsk_DestroyMisc(AeroDisk_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(AeroDisk_DataData%Output)) then - LB(1:1) = lbound(AeroDisk_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_DestroyOutput(AeroDisk_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(AeroDisk_DataData%Output) - end if - call ADsk_DestroyOutput(AeroDisk_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDisk_DataData%Input)) then LB(1:1) = lbound(AeroDisk_DataData%Input, kind=B8Ki) UB(1:1) = ubound(AeroDisk_DataData%Input, kind=B8Ki) @@ -5846,16 +5418,6 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) call ADsk_PackParam(RF, InData%p) call ADsk_PackOutput(RF, InData%y) call ADsk_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackOutput(RF, InData%Output(i1)) - end do - end if - call ADsk_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -5933,20 +5495,6 @@ subroutine FAST_UnPackAeroDisk_Data(RF, OutData) call ADsk_UnpackParam(RF, OutData%p) ! p call ADsk_UnpackOutput(RF, OutData%y) ! y call ADsk_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ADsk_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call ADsk_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -6049,25 +5597,6 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa call InflowWind_CopyMisc(SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcInflowWind_DataData%Output)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%Output, kind=B8Ki) - if (.not. allocated(DstInflowWind_DataData%Output)) then - allocate(DstInflowWind_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyOutput(SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call InflowWind_CopyOutput(SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcInflowWind_DataData%Input)) then LB(1:1) = lbound(SrcInflowWind_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcInflowWind_DataData%Input, kind=B8Ki) @@ -6151,17 +5680,6 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyMisc(InflowWind_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InflowWind_DataData%Output)) then - LB(1:1) = lbound(InflowWind_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_DestroyOutput(InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InflowWind_DataData%Output) - end if - call InflowWind_DestroyOutput(InflowWind_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InflowWind_DataData%Input)) then LB(1:1) = lbound(InflowWind_DataData%Input, kind=B8Ki) UB(1:1) = ubound(InflowWind_DataData%Input, kind=B8Ki) @@ -6222,16 +5740,6 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) call InflowWind_PackParam(RF, InData%p) call InflowWind_PackOutput(RF, InData%y) call InflowWind_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackOutput(RF, InData%Output(i1)) - end do - end if - call InflowWind_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -6309,20 +5817,6 @@ subroutine FAST_UnPackInflowWind_Data(RF, OutData) call InflowWind_UnpackParam(RF, OutData%p) ! p call InflowWind_UnpackOutput(RF, OutData%y) ! y call InflowWind_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call InflowWind_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -6571,25 +6065,6 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSubDyn_DataData%Output)) then - LB(1:1) = lbound(SrcSubDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%Output, kind=B8Ki) - if (.not. allocated(DstSubDyn_DataData%Output)) then - allocate(DstSubDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyOutput(SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call SD_CopyOutput(SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcSubDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes, kind=B8Ki) @@ -6668,17 +6143,6 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) end do deallocate(SubDyn_DataData%Input) end if - if (allocated(SubDyn_DataData%Output)) then - LB(1:1) = lbound(SubDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyOutput(SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SubDyn_DataData%Output) - end if - call SD_DestroyOutput(SubDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SubDyn_DataData%InputTimes)) then deallocate(SubDyn_DataData%InputTimes) end if @@ -6740,16 +6204,6 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) call SD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackOutput(RF, InData%Output(i1)) - end do - end if - call SD_PackOutput(RF, InData%y_interp) call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6832,20 +6286,6 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) call SD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call SD_UnpackOutput(RF, OutData%y_interp) ! y_interp call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7273,25 +6713,6 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSeaState_DataData%Output)) then - LB(1:1) = lbound(SrcSeaState_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%Output, kind=B8Ki) - if (.not. allocated(DstSeaState_DataData%Output)) then - allocate(DstSeaState_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyOutput(SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call SeaSt_CopyOutput(SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcSeaState_DataData%InputTimes)) then LB(1:1) = lbound(SrcSeaState_DataData%InputTimes, kind=B8Ki) UB(1:1) = ubound(SrcSeaState_DataData%InputTimes, kind=B8Ki) @@ -7368,17 +6789,6 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) end do deallocate(SeaState_DataData%Input) end if - if (allocated(SeaState_DataData%Output)) then - LB(1:1) = lbound(SeaState_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyOutput(SeaState_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SeaState_DataData%Output) - end if - call SeaSt_DestroyOutput(SeaState_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaState_DataData%InputTimes)) then deallocate(SeaState_DataData%InputTimes) end if @@ -7439,16 +6849,6 @@ subroutine FAST_PackSeaState_Data(RF, Indata) call SeaSt_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackOutput(RF, InData%Output(i1)) - end do - end if - call SeaSt_PackOutput(RF, InData%y_interp) call RegPackAlloc(RF, InData%InputTimes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7530,20 +6930,6 @@ subroutine FAST_UnPackSeaState_Data(RF, OutData) call SeaSt_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call SeaSt_UnpackOutput(RF, OutData%y_interp) ! y_interp call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7636,25 +7022,6 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call HydroDyn_CopyMisc(SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcHydroDyn_DataData%Output)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%Output, kind=B8Ki) - if (.not. allocated(DstHydroDyn_DataData%Output)) then - allocate(DstHydroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyOutput(SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcHydroDyn_DataData%Input)) then LB(1:1) = lbound(SrcHydroDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcHydroDyn_DataData%Input, kind=B8Ki) @@ -7740,17 +7107,6 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(HydroDyn_DataData%Output)) then - LB(1:1) = lbound(HydroDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyOutput(HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(HydroDyn_DataData%Output) - end if - call HydroDyn_DestroyOutput(HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(HydroDyn_DataData%Input)) then LB(1:1) = lbound(HydroDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(HydroDyn_DataData%Input, kind=B8Ki) @@ -7812,16 +7168,6 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) call HydroDyn_PackParam(RF, InData%p) call HydroDyn_PackOutput(RF, InData%y) call HydroDyn_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackOutput(RF, InData%Output(i1)) - end do - end if - call HydroDyn_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -7900,20 +7246,6 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) call HydroDyn_UnpackParam(RF, OutData%p) ! p call HydroDyn_UnpackOutput(RF, OutData%y) ! y call HydroDyn_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call HydroDyn_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -8328,25 +7660,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat call MAP_CopyOtherState(SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcMAP_DataData%Output)) then - LB(1:1) = lbound(SrcMAP_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%Output, kind=B8Ki) - if (.not. allocated(DstMAP_DataData%Output)) then - allocate(DstMAP_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyOutput(SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call MAP_CopyOutput(SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcMAP_DataData%Input)) then LB(1:1) = lbound(SrcMAP_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcMAP_DataData%Input, kind=B8Ki) @@ -8425,17 +7738,6 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MAP_DataData%Output)) then - LB(1:1) = lbound(MAP_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_DestroyOutput(MAP_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MAP_DataData%Output) - end if - call MAP_DestroyOutput(MAP_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MAP_DataData%Input)) then LB(1:1) = lbound(MAP_DataData%Input, kind=B8Ki) UB(1:1) = ubound(MAP_DataData%Input, kind=B8Ki) @@ -8489,16 +7791,6 @@ subroutine FAST_PackMAP_Data(RF, Indata) call MAP_PackOutput(RF, InData%y) call MAP_PackMisc(RF, InData%m) call MAP_PackOtherState(RF, InData%OtherSt_old) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackOutput(RF, InData%Output(i1)) - end do - end if - call MAP_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -8565,20 +7857,6 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) call MAP_UnpackOutput(RF, OutData%y) ! y call MAP_UnpackMisc(RF, OutData%m) ! m call MAP_UnpackOtherState(RF, OutData%OtherSt_old) ! OtherSt_old - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call MAP_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -9003,25 +8281,6 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC call MD_CopyMisc(SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcMoorDyn_DataData%Output)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%Output, kind=B8Ki) - if (.not. allocated(DstMoorDyn_DataData%Output)) then - allocate(DstMoorDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyOutput(SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call MD_CopyOutput(SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcMoorDyn_DataData%Input)) then LB(1:1) = lbound(SrcMoorDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(SrcMoorDyn_DataData%Input, kind=B8Ki) @@ -9105,17 +8364,6 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MD_DestroyMisc(MoorDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MoorDyn_DataData%Output)) then - LB(1:1) = lbound(MoorDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyOutput(MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MoorDyn_DataData%Output) - end if - call MD_DestroyOutput(MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MoorDyn_DataData%Input)) then LB(1:1) = lbound(MoorDyn_DataData%Input, kind=B8Ki) UB(1:1) = ubound(MoorDyn_DataData%Input, kind=B8Ki) @@ -9176,16 +8424,6 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) call MD_PackParam(RF, InData%p) call MD_PackOutput(RF, InData%y) call MD_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackOutput(RF, InData%Output(i1)) - end do - end if - call MD_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) @@ -9263,20 +8501,6 @@ subroutine FAST_UnPackMoorDyn_Data(RF, OutData) call MD_UnpackParam(RF, OutData%p) ! p call MD_UnpackOutput(RF, OutData%y) ! y call MD_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackOutput(RF, OutData%Output(i1)) ! Output - end do - end if - call MD_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then From a96dbbe1290e7be582f380d6fa2771759b9eb4fd Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 14 Nov 2024 11:09:40 -0500 Subject: [PATCH 283/319] Add Visual Studio Solution which uses IFX --- vs-build-ifx/.gitignore | 1 + vs-build-ifx/OpenFAST.sln | 1006 +++++++++++++++++ vs-build-ifx/OpenFAST.u2d | Bin 0 -> 186 bytes vs-build-ifx/OpenFAST.vfproj | 62 + vs-build-ifx/modules/AeroDisk.u2d | 0 vs-build-ifx/modules/AeroDisk.vfproj | 61 + vs-build-ifx/modules/AeroDyn.u2d | 0 vs-build-ifx/modules/AeroDyn.vfproj | 90 ++ vs-build-ifx/modules/BeamDyn.u2d | 0 vs-build-ifx/modules/BeamDyn.vfproj | 62 + vs-build-ifx/modules/BeamDyn_Driver.u2d | 0 vs-build-ifx/modules/BeamDyn_Driver.vfproj | 62 + vs-build-ifx/modules/ElastoDyn.u2d | 0 vs-build-ifx/modules/ElastoDyn.vfproj | 62 + vs-build-ifx/modules/ExtLoads.u2d | 0 vs-build-ifx/modules/ExtLoads.vfproj | 58 + vs-build-ifx/modules/ExtLoads_Types.u2d | Bin 0 -> 106 bytes vs-build-ifx/modules/ExtLoads_Types.vfproj | 61 + vs-build-ifx/modules/ExtPtfm.u2d | 0 vs-build-ifx/modules/ExtPtfm.vfproj | 61 + vs-build-ifx/modules/ExternalInflow.u2d | Bin 0 -> 106 bytes vs-build-ifx/modules/ExternalInflow.vfproj | 58 + vs-build-ifx/modules/ExternalInflow_Types.u2d | 0 .../modules/ExternalInflow_Types.vfproj | 60 + vs-build-ifx/modules/FEAMooring.u2d | 0 vs-build-ifx/modules/FEAMooring.vfproj | 60 + vs-build-ifx/modules/HydroDyn.u2d | 0 vs-build-ifx/modules/HydroDyn.vfproj | 83 ++ vs-build-ifx/modules/IceDyn.u2d | 0 vs-build-ifx/modules/IceDyn.vfproj | 60 + vs-build-ifx/modules/IceFloe.u2d | 0 vs-build-ifx/modules/IceFloe.vfproj | 74 ++ vs-build-ifx/modules/InflowWind.u2d | 0 vs-build-ifx/modules/InflowWind.vfproj | 70 ++ vs-build-ifx/modules/LinDyn.u2d | 0 vs-build-ifx/modules/LinDyn.vfproj | 59 + vs-build-ifx/modules/MAP-C.vcxproj | 197 ++++ vs-build-ifx/modules/MAP-C.vcxproj.user | 4 + vs-build-ifx/modules/MAP.u2d | 0 vs-build-ifx/modules/MAP.vfproj | 60 + vs-build-ifx/modules/MoorDyn.u2d | 0 vs-build-ifx/modules/MoorDyn.vfproj | 67 ++ vs-build-ifx/modules/MoorDyn_Driver.u2d | 0 vs-build-ifx/modules/MoorDyn_Driver.vfproj | 61 + vs-build-ifx/modules/NWTC-Library.vfproj | 105 ++ vs-build-ifx/modules/OpenFAST-Library.u2d | 0 vs-build-ifx/modules/OpenFAST-Library.vfproj | 67 ++ vs-build-ifx/modules/OpenFAST-Prelib.u2d | Bin 0 -> 106 bytes vs-build-ifx/modules/OpenFAST-Prelib.vfproj | 60 + vs-build-ifx/modules/OrcaFlex.u2d | 0 vs-build-ifx/modules/OrcaFlex.vfproj | 59 + vs-build-ifx/modules/Registry.vcxproj | 167 +++ vs-build-ifx/modules/SeaState.u2d | 0 vs-build-ifx/modules/SeaState.vfproj | 75 ++ vs-build-ifx/modules/ServoDyn.u2d | 0 vs-build-ifx/modules/ServoDyn.vfproj | 69 ++ vs-build-ifx/modules/SimpleElastoDyn.u2d | 0 vs-build-ifx/modules/SimpleElastoDyn.vfproj | 61 + vs-build-ifx/modules/SubDyn.u2d | 0 vs-build-ifx/modules/SubDyn.vfproj | 65 ++ vs-build-ifx/modules/SuperController.u2d | Bin 0 -> 106 bytes vs-build-ifx/modules/SuperController.vfproj | 60 + .../modules/SuperController_Types.u2d | 0 .../modules/SuperController_Types.vfproj | 64 ++ vs-build-ifx/modules/TurbSim.u2d | 0 vs-build-ifx/modules/TurbSim.vfproj | 71 ++ vs-build-ifx/modules/VersionInfo.u2d | 0 vs-build-ifx/modules/VersionInfo.vfproj | 57 + vs-build-ifx/modules/WakeDynamics.u2d | 0 vs-build-ifx/modules/WakeDynamics.vfproj | 59 + vs-build-ifx/modules/nwtc-library.u2d | Bin 0 -> 396 bytes 71 files changed, 3538 insertions(+) create mode 100644 vs-build-ifx/.gitignore create mode 100644 vs-build-ifx/OpenFAST.sln create mode 100644 vs-build-ifx/OpenFAST.u2d create mode 100644 vs-build-ifx/OpenFAST.vfproj create mode 100644 vs-build-ifx/modules/AeroDisk.u2d create mode 100644 vs-build-ifx/modules/AeroDisk.vfproj create mode 100644 vs-build-ifx/modules/AeroDyn.u2d create mode 100644 vs-build-ifx/modules/AeroDyn.vfproj create mode 100644 vs-build-ifx/modules/BeamDyn.u2d create mode 100644 vs-build-ifx/modules/BeamDyn.vfproj create mode 100644 vs-build-ifx/modules/BeamDyn_Driver.u2d create mode 100644 vs-build-ifx/modules/BeamDyn_Driver.vfproj create mode 100644 vs-build-ifx/modules/ElastoDyn.u2d create mode 100644 vs-build-ifx/modules/ElastoDyn.vfproj create mode 100644 vs-build-ifx/modules/ExtLoads.u2d create mode 100644 vs-build-ifx/modules/ExtLoads.vfproj create mode 100644 vs-build-ifx/modules/ExtLoads_Types.u2d create mode 100644 vs-build-ifx/modules/ExtLoads_Types.vfproj create mode 100644 vs-build-ifx/modules/ExtPtfm.u2d create mode 100644 vs-build-ifx/modules/ExtPtfm.vfproj create mode 100644 vs-build-ifx/modules/ExternalInflow.u2d create mode 100644 vs-build-ifx/modules/ExternalInflow.vfproj create mode 100644 vs-build-ifx/modules/ExternalInflow_Types.u2d create mode 100644 vs-build-ifx/modules/ExternalInflow_Types.vfproj create mode 100644 vs-build-ifx/modules/FEAMooring.u2d create mode 100644 vs-build-ifx/modules/FEAMooring.vfproj create mode 100644 vs-build-ifx/modules/HydroDyn.u2d create mode 100644 vs-build-ifx/modules/HydroDyn.vfproj create mode 100644 vs-build-ifx/modules/IceDyn.u2d create mode 100644 vs-build-ifx/modules/IceDyn.vfproj create mode 100644 vs-build-ifx/modules/IceFloe.u2d create mode 100644 vs-build-ifx/modules/IceFloe.vfproj create mode 100644 vs-build-ifx/modules/InflowWind.u2d create mode 100644 vs-build-ifx/modules/InflowWind.vfproj create mode 100644 vs-build-ifx/modules/LinDyn.u2d create mode 100644 vs-build-ifx/modules/LinDyn.vfproj create mode 100644 vs-build-ifx/modules/MAP-C.vcxproj create mode 100644 vs-build-ifx/modules/MAP-C.vcxproj.user create mode 100644 vs-build-ifx/modules/MAP.u2d create mode 100644 vs-build-ifx/modules/MAP.vfproj create mode 100644 vs-build-ifx/modules/MoorDyn.u2d create mode 100644 vs-build-ifx/modules/MoorDyn.vfproj create mode 100644 vs-build-ifx/modules/MoorDyn_Driver.u2d create mode 100644 vs-build-ifx/modules/MoorDyn_Driver.vfproj create mode 100644 vs-build-ifx/modules/NWTC-Library.vfproj create mode 100644 vs-build-ifx/modules/OpenFAST-Library.u2d create mode 100644 vs-build-ifx/modules/OpenFAST-Library.vfproj create mode 100644 vs-build-ifx/modules/OpenFAST-Prelib.u2d create mode 100644 vs-build-ifx/modules/OpenFAST-Prelib.vfproj create mode 100644 vs-build-ifx/modules/OrcaFlex.u2d create mode 100644 vs-build-ifx/modules/OrcaFlex.vfproj create mode 100644 vs-build-ifx/modules/Registry.vcxproj create mode 100644 vs-build-ifx/modules/SeaState.u2d create mode 100644 vs-build-ifx/modules/SeaState.vfproj create mode 100644 vs-build-ifx/modules/ServoDyn.u2d create mode 100644 vs-build-ifx/modules/ServoDyn.vfproj create mode 100644 vs-build-ifx/modules/SimpleElastoDyn.u2d create mode 100644 vs-build-ifx/modules/SimpleElastoDyn.vfproj create mode 100644 vs-build-ifx/modules/SubDyn.u2d create mode 100644 vs-build-ifx/modules/SubDyn.vfproj create mode 100644 vs-build-ifx/modules/SuperController.u2d create mode 100644 vs-build-ifx/modules/SuperController.vfproj create mode 100644 vs-build-ifx/modules/SuperController_Types.u2d create mode 100644 vs-build-ifx/modules/SuperController_Types.vfproj create mode 100644 vs-build-ifx/modules/TurbSim.u2d create mode 100644 vs-build-ifx/modules/TurbSim.vfproj create mode 100644 vs-build-ifx/modules/VersionInfo.u2d create mode 100644 vs-build-ifx/modules/VersionInfo.vfproj create mode 100644 vs-build-ifx/modules/WakeDynamics.u2d create mode 100644 vs-build-ifx/modules/WakeDynamics.vfproj create mode 100644 vs-build-ifx/modules/nwtc-library.u2d diff --git a/vs-build-ifx/.gitignore b/vs-build-ifx/.gitignore new file mode 100644 index 0000000000..0a34381797 --- /dev/null +++ b/vs-build-ifx/.gitignore @@ -0,0 +1 @@ +.vs \ No newline at end of file diff --git a/vs-build-ifx/OpenFAST.sln b/vs-build-ifx/OpenFAST.sln new file mode 100644 index 0000000000..1ee3d0ab83 --- /dev/null +++ b/vs-build-ifx/OpenFAST.sln @@ -0,0 +1,1006 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio Version 17 +VisualStudioVersion = 17.9.34902.65 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Registry", "modules\Registry.vcxproj", "{EC73DA51-78CF-41DB-9DFA-88360BF2EA93}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn", "modules\AeroDyn.vfproj", "{5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}" + ProjectSection(ProjectDependencies) = postProject + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "NWTC-Library", "modules\NWTC-Library.vfproj", "{EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "InflowWind", "modules\InflowWind.vfproj", "{9CB36EC2-18AF-468E-BE43-FE63E383AA3A}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "VersionInfo", "modules\VersionInfo.vfproj", "{12DF411B-C7DA-47BA-BB85-7714D5FD2A16}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "modules\BeamDyn.vfproj", "{A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn_Driver", "modules\BeamDyn_Driver.vfproj", "{D9220A21-8C69-42E4-B085-E5D996B867D9}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDisk", "modules\AeroDisk.vfproj", "{731C6D0A-CF24-4FD3-ABAC-17F31D97A188}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ElastoDyn", "modules\ElastoDyn.vfproj", "{E8C5BB9B-9709-41FA-B6F2-F334B112663A}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExternalInflow", "modules\ExternalInflow.vfproj", "{B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}" + ProjectSection(ProjectDependencies) = postProject + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads", "modules\ExtLoads.vfproj", "{AD8D7798-F800-4C73-B896-7E48EF1D52D3}" + ProjectSection(ProjectDependencies) = postProject + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtPtfm", "modules\ExtPtfm.vfproj", "{3000393A-702F-488E-B918-1D37955FA8D3}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FEAMooring", "modules\FEAMooring.vfproj", "{676276A1-DC23-4287-8386-07076303C39D}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "HydroDyn", "modules\HydroDyn.vfproj", "{1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SeaState", "modules\SeaState.vfproj", "{951A453F-1999-483D-848A-9B63C282F43D}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "IceDyn", "modules\IceDyn.vfproj", "{D029FC73-035C-4EB8-96DA-5B1131706A2D}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "IceFloe", "modules\IceFloe.vfproj", "{FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "LinDyn", "modules\LinDyn.vfproj", "{07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MAP", "modules\MAP.vfproj", "{5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn", "modules\MoorDyn.vfproj", "{923F8E1F-F5FC-4572-9C32-94C90F04A5A9}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "MAP-C", "modules\MAP-C.vcxproj", "{471EEB17-A1AA-43B0-ACEE-719B80BB4811}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn_Driver", "modules\MoorDyn_Driver.vfproj", "{FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OrcaFlex", "modules\OrcaFlex.vfproj", "{B50C776E-F931-4E83-916F-C4E6977E40A3}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ServoDyn", "modules\ServoDyn.vfproj", "{46EB37F1-EEBA-4F35-A173-A37D42D97B5B}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SimpleElastoDyn", "modules\SimpleElastoDyn.vfproj", "{2467FDD4-622B-4628-993A-73994FB8172E}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SubDyn", "modules\SubDyn.vfproj", "{648CD825-ECB0-46D1-B1AA-A28F5C36CD91}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController", "modules\SuperController.vfproj", "{7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}" + ProjectSection(ProjectDependencies) = postProject + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} = {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Prelib", "modules\OpenFAST-Prelib.vfproj", "{FE80CE9A-7E16-476D-B63A-F9F870ACB662}" + ProjectSection(ProjectDependencies) = postProject + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "TurbSim", "modules\TurbSim.vfproj", "{916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "WakeDynamics", "modules\WakeDynamics.vfproj", "{029204DD-3D5B-47C6-8CAA-A933886D4674}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExternalInflow_Types", "modules\ExternalInflow_Types.vfproj", "{3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}" + ProjectSection(ProjectDependencies) = postProject + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads_Types", "modules\ExtLoads_Types.vfproj", "{774BDC53-33C4-4926-B01D-DC376DAE055B}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController_Types", "modules\SuperController_Types.vfproj", "{2542E42E-CF7F-48F3-8621-6BCFC61102BF}" + ProjectSection(ProjectDependencies) = postProject + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Modules", "Modules", "{272B8080-A022-4F4A-BDD6-835871E44C23}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Library", "modules\OpenFAST-Library.vfproj", "{6906E75C-2A54-431B-A11D-145864FCDD5C}" + ProjectSection(ProjectDependencies) = postProject + {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST", "OpenFAST.vfproj", "{5761312F-64A3-4EC4-958F-3302AAA830AC}" + ProjectSection(ProjectDependencies) = postProject + {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {6906E75C-2A54-431B-A11D-145864FCDD5C} = {6906E75C-2A54-431B-A11D-145864FCDD5C} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + EndProjectSection +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|x64 = Debug|x64 + Debug|x86 = Debug|x86 + Debug-Double|x64 = Debug-Double|x64 + Debug-Double|x86 = Debug-Double|x86 + Release|x64 = Release|x64 + Release|x86 = Release|x86 + Release-Double|x64 = Release-Double|x64 + Release-Double|x86 = Release-Double|x86 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.Build.0 = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x86.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x86.Build.0 = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.ActiveCfg = Debug-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.Build.0 = Debug-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x86.ActiveCfg = Debug-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x86.Build.0 = Debug-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x86.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x86.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.ActiveCfg = Release-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.Build.0 = Release-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x86.ActiveCfg = Release-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x86.Build.0 = Release-Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.ActiveCfg = Debug|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.Build.0 = Debug|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x86.ActiveCfg = Debug|Win32 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x86.Build.0 = Debug|Win32 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x64.ActiveCfg = Debug|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x64.Build.0 = Debug|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x86.Build.0 = Debug|Win32 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x64.ActiveCfg = Release|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x64.Build.0 = Release|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x86.ActiveCfg = Release|Win32 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x86.Build.0 = Release|Win32 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x64.ActiveCfg = Release|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x64.Build.0 = Release|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x86.ActiveCfg = Release|Win32 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x86.Build.0 = Release|Win32 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x64.ActiveCfg = Debug|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x64.Build.0 = Debug|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x86.ActiveCfg = Debug|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x86.Build.0 = Debug|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x64.ActiveCfg = Debug-Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x64.Build.0 = Debug-Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x86.ActiveCfg = Debug-Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x86.Build.0 = Debug-Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x64.ActiveCfg = Release|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x64.Build.0 = Release|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x86.ActiveCfg = Release|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x86.Build.0 = Release|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x64.ActiveCfg = Release-Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x64.Build.0 = Release-Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x86.ActiveCfg = Release-Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x86.Build.0 = Release-Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x64.ActiveCfg = Debug|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x64.Build.0 = Debug|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x86.ActiveCfg = Debug|Win32 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x86.Build.0 = Debug|Win32 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x64.ActiveCfg = Debug|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x64.Build.0 = Debug|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x86.Build.0 = Debug|Win32 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x64.ActiveCfg = Release|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x64.Build.0 = Release|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x86.ActiveCfg = Release|Win32 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x86.Build.0 = Release|Win32 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x64.ActiveCfg = Release|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x64.Build.0 = Release|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x86.ActiveCfg = Release|Win32 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x86.Build.0 = Release|Win32 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x64.ActiveCfg = Debug|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x64.Build.0 = Debug|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x86.ActiveCfg = Debug|Win32 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x86.Build.0 = Debug|Win32 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x64.ActiveCfg = Debug|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x64.Build.0 = Debug|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x86.Build.0 = Debug|Win32 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x64.ActiveCfg = Release|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x64.Build.0 = Release|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x86.ActiveCfg = Release|Win32 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x86.Build.0 = Release|Win32 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x64.ActiveCfg = Release|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x64.Build.0 = Release|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x86.ActiveCfg = Release|Win32 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x86.Build.0 = Release|Win32 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x64.ActiveCfg = Debug|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x64.Build.0 = Debug|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x86.ActiveCfg = Debug|Win32 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x86.Build.0 = Debug|Win32 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x64.ActiveCfg = Debug|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x64.Build.0 = Debug|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x86.Build.0 = Debug|Win32 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.ActiveCfg = Release|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.Build.0 = Release|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x86.ActiveCfg = Release|Win32 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x86.Build.0 = Release|Win32 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x64.ActiveCfg = Release|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x64.Build.0 = Release|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x86.ActiveCfg = Release|Win32 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x86.Build.0 = Release|Win32 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.ActiveCfg = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.Build.0 = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x86.ActiveCfg = Debug|Win32 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x86.Build.0 = Debug|Win32 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x64.ActiveCfg = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x64.Build.0 = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x86.Build.0 = Debug|Win32 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.ActiveCfg = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.Build.0 = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x86.ActiveCfg = Release|Win32 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x86.Build.0 = Release|Win32 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x64.ActiveCfg = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x64.Build.0 = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x86.ActiveCfg = Release|Win32 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x86.Build.0 = Release|Win32 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x64.ActiveCfg = Debug|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x64.Build.0 = Debug|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x86.ActiveCfg = Debug|Win32 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x86.Build.0 = Debug|Win32 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x64.ActiveCfg = Debug|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x64.Build.0 = Debug|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x86.Build.0 = Debug|Win32 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x64.ActiveCfg = Release|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x64.Build.0 = Release|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x86.ActiveCfg = Release|Win32 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x86.Build.0 = Release|Win32 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x64.ActiveCfg = Release|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x64.Build.0 = Release|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x86.ActiveCfg = Release|Win32 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x86.Build.0 = Release|Win32 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x64.ActiveCfg = Debug|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x64.Build.0 = Debug|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x86.ActiveCfg = Debug|Win32 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x86.Build.0 = Debug|Win32 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x64.ActiveCfg = Debug|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x64.Build.0 = Debug|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x86.Build.0 = Debug|Win32 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x64.ActiveCfg = Release|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x64.Build.0 = Release|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x86.ActiveCfg = Release|Win32 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x86.Build.0 = Release|Win32 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x64.ActiveCfg = Release|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x64.Build.0 = Release|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x86.ActiveCfg = Release|Win32 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x86.Build.0 = Release|Win32 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x64.ActiveCfg = Debug|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x64.Build.0 = Debug|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x86.ActiveCfg = Debug|Win32 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x86.Build.0 = Debug|Win32 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x64.ActiveCfg = Debug|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x64.Build.0 = Debug|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x86.Build.0 = Debug|Win32 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x64.ActiveCfg = Release|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x64.Build.0 = Release|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x86.ActiveCfg = Release|Win32 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x86.Build.0 = Release|Win32 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x64.ActiveCfg = Release|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x64.Build.0 = Release|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x86.ActiveCfg = Release|Win32 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x86.Build.0 = Release|Win32 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x64.ActiveCfg = Debug|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x64.Build.0 = Debug|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x86.ActiveCfg = Debug|Win32 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x86.Build.0 = Debug|Win32 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x64.ActiveCfg = Debug|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x64.Build.0 = Debug|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x86.Build.0 = Debug|Win32 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x64.ActiveCfg = Release|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x64.Build.0 = Release|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x86.ActiveCfg = Release|Win32 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x86.Build.0 = Release|Win32 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x64.ActiveCfg = Release|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x64.Build.0 = Release|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x86.ActiveCfg = Release|Win32 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x86.Build.0 = Release|Win32 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x64.ActiveCfg = Debug|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x64.Build.0 = Debug|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x86.ActiveCfg = Debug|Win32 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x86.Build.0 = Debug|Win32 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x64.ActiveCfg = Debug|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x64.Build.0 = Debug|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x86.Build.0 = Debug|Win32 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x64.ActiveCfg = Release|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x64.Build.0 = Release|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x86.ActiveCfg = Release|Win32 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x86.Build.0 = Release|Win32 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x64.ActiveCfg = Release|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x64.Build.0 = Release|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x86.ActiveCfg = Release|Win32 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x86.Build.0 = Release|Win32 + {676276A1-DC23-4287-8386-07076303C39D}.Debug|x64.ActiveCfg = Debug|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug|x64.Build.0 = Debug|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug|x86.ActiveCfg = Debug|Win32 + {676276A1-DC23-4287-8386-07076303C39D}.Debug|x86.Build.0 = Debug|Win32 + {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x64.ActiveCfg = Debug|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x64.Build.0 = Debug|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x86.Build.0 = Debug|Win32 + {676276A1-DC23-4287-8386-07076303C39D}.Release|x64.ActiveCfg = Release|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release|x64.Build.0 = Release|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release|x86.ActiveCfg = Release|Win32 + {676276A1-DC23-4287-8386-07076303C39D}.Release|x86.Build.0 = Release|Win32 + {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x64.ActiveCfg = Release|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x64.Build.0 = Release|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x86.ActiveCfg = Release|Win32 + {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x86.Build.0 = Release|Win32 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x64.ActiveCfg = Debug|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x64.Build.0 = Debug|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x86.ActiveCfg = Debug|Win32 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x86.Build.0 = Debug|Win32 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x64.ActiveCfg = Debug|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x64.Build.0 = Debug|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x86.Build.0 = Debug|Win32 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x64.ActiveCfg = Release|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x64.Build.0 = Release|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x86.ActiveCfg = Release|Win32 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x86.Build.0 = Release|Win32 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x64.ActiveCfg = Release|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x64.Build.0 = Release|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x86.ActiveCfg = Release|Win32 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x86.Build.0 = Release|Win32 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x64.ActiveCfg = Debug|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x64.Build.0 = Debug|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x86.ActiveCfg = Debug|Win32 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x86.Build.0 = Debug|Win32 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x64.ActiveCfg = Debug|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x64.Build.0 = Debug|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x86.Build.0 = Debug|Win32 + {951A453F-1999-483D-848A-9B63C282F43D}.Release|x64.ActiveCfg = Release|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release|x64.Build.0 = Release|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release|x86.ActiveCfg = Release|Win32 + {951A453F-1999-483D-848A-9B63C282F43D}.Release|x86.Build.0 = Release|Win32 + {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x64.ActiveCfg = Release|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x64.Build.0 = Release|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x86.ActiveCfg = Release|Win32 + {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x86.Build.0 = Release|Win32 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x64.ActiveCfg = Debug|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x64.Build.0 = Debug|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x86.ActiveCfg = Debug|Win32 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x86.Build.0 = Debug|Win32 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x64.ActiveCfg = Debug|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x64.Build.0 = Debug|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x86.Build.0 = Debug|Win32 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x64.ActiveCfg = Release|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x64.Build.0 = Release|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x86.ActiveCfg = Release|Win32 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x86.Build.0 = Release|Win32 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x64.ActiveCfg = Release|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x64.Build.0 = Release|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x86.ActiveCfg = Release|Win32 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x86.Build.0 = Release|Win32 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x64.ActiveCfg = Debug|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x64.Build.0 = Debug|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x86.ActiveCfg = Debug|Win32 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x86.Build.0 = Debug|Win32 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x64.ActiveCfg = Debug|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x64.Build.0 = Debug|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x86.Build.0 = Debug|Win32 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x64.ActiveCfg = Release|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x64.Build.0 = Release|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x86.ActiveCfg = Release|Win32 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x86.Build.0 = Release|Win32 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x64.ActiveCfg = Release|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x64.Build.0 = Release|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x86.ActiveCfg = Release|Win32 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x86.Build.0 = Release|Win32 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug|x64.ActiveCfg = Debug|x64 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug|x64.Build.0 = Debug|x64 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug|x86.ActiveCfg = Debug|Win32 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug|x86.Build.0 = Debug|Win32 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug-Double|x64.ActiveCfg = Debug|x64 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug-Double|x64.Build.0 = Debug|x64 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug-Double|x86.Build.0 = Debug|Win32 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release|x64.ActiveCfg = Release|x64 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release|x64.Build.0 = Release|x64 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release|x86.ActiveCfg = Release|Win32 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release|x86.Build.0 = Release|Win32 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release-Double|x64.ActiveCfg = Release|x64 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release-Double|x64.Build.0 = Release|x64 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release-Double|x86.ActiveCfg = Release|Win32 + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release-Double|x86.Build.0 = Release|Win32 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x64.ActiveCfg = Debug|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x64.Build.0 = Debug|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x86.ActiveCfg = Debug|Win32 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x86.Build.0 = Debug|Win32 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x64.ActiveCfg = Debug|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x64.Build.0 = Debug|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x86.Build.0 = Debug|Win32 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x64.ActiveCfg = Release|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x64.Build.0 = Release|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x86.ActiveCfg = Release|Win32 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x86.Build.0 = Release|Win32 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x64.ActiveCfg = Release|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x64.Build.0 = Release|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x86.ActiveCfg = Release|Win32 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x86.Build.0 = Release|Win32 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x64.ActiveCfg = Debug|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x64.Build.0 = Debug|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x86.ActiveCfg = Debug|Win32 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x86.Build.0 = Debug|Win32 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x64.ActiveCfg = Debug|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x64.Build.0 = Debug|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x86.Build.0 = Debug|Win32 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.ActiveCfg = Release|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.Build.0 = Release|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x86.ActiveCfg = Release|Win32 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x86.Build.0 = Release|Win32 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x64.ActiveCfg = Release|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x64.Build.0 = Release|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x86.ActiveCfg = Release|Win32 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x86.Build.0 = Release|Win32 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.ActiveCfg = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.Build.0 = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x86.ActiveCfg = Debug|Win32 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x86.Build.0 = Debug|Win32 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x64.ActiveCfg = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x64.Build.0 = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x86.Build.0 = Debug|Win32 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x86.ActiveCfg = Release|Win32 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x86.Build.0 = Release|Win32 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x86.ActiveCfg = Release|Win32 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x86.Build.0 = Release|Win32 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x64.ActiveCfg = Debug|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x64.Build.0 = Debug|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x86.ActiveCfg = Debug|Win32 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x86.Build.0 = Debug|Win32 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x64.ActiveCfg = Debug|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x64.Build.0 = Debug|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x86.Build.0 = Debug|Win32 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x64.ActiveCfg = Release|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x64.Build.0 = Release|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x86.ActiveCfg = Release|Win32 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x86.Build.0 = Release|Win32 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x64.ActiveCfg = Release|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x64.Build.0 = Release|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x86.ActiveCfg = Release|Win32 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x86.Build.0 = Release|Win32 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x64.ActiveCfg = Debug|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x64.Build.0 = Debug|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x86.ActiveCfg = Debug|Win32 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x86.Build.0 = Debug|Win32 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x64.ActiveCfg = Debug|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x64.Build.0 = Debug|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x86.Build.0 = Debug|Win32 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x64.ActiveCfg = Release|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x64.Build.0 = Release|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x86.ActiveCfg = Release|Win32 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x86.Build.0 = Release|Win32 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x64.ActiveCfg = Release|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x64.Build.0 = Release|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x86.ActiveCfg = Release|Win32 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x86.Build.0 = Release|Win32 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x64.ActiveCfg = Debug|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x64.Build.0 = Debug|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x86.ActiveCfg = Debug|Win32 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x86.Build.0 = Debug|Win32 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x64.ActiveCfg = Debug|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x64.Build.0 = Debug|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x86.Build.0 = Debug|Win32 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x64.ActiveCfg = Release|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x64.Build.0 = Release|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x86.ActiveCfg = Release|Win32 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x86.Build.0 = Release|Win32 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x64.ActiveCfg = Release|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x64.Build.0 = Release|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x86.ActiveCfg = Release|Win32 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x86.Build.0 = Release|Win32 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x64.ActiveCfg = Debug|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x64.Build.0 = Debug|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x86.ActiveCfg = Debug|Win32 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x86.Build.0 = Debug|Win32 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x64.ActiveCfg = Debug|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x64.Build.0 = Debug|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x86.Build.0 = Debug|Win32 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x64.ActiveCfg = Release|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x64.Build.0 = Release|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x86.ActiveCfg = Release|Win32 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x86.Build.0 = Release|Win32 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x64.ActiveCfg = Release|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x64.Build.0 = Release|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x86.ActiveCfg = Release|Win32 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x86.Build.0 = Release|Win32 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x64.ActiveCfg = Debug|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x64.Build.0 = Debug|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x86.ActiveCfg = Debug|Win32 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x86.Build.0 = Debug|Win32 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x64.ActiveCfg = Debug|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x64.Build.0 = Debug|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x86.Build.0 = Debug|Win32 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x64.ActiveCfg = Release|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x64.Build.0 = Release|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x86.ActiveCfg = Release|Win32 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x86.Build.0 = Release|Win32 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x64.ActiveCfg = Release|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x64.Build.0 = Release|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x86.ActiveCfg = Release|Win32 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x86.Build.0 = Release|Win32 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x64.ActiveCfg = Debug|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x64.Build.0 = Debug|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x86.ActiveCfg = Debug|Win32 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x86.Build.0 = Debug|Win32 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x64.ActiveCfg = Debug|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x64.Build.0 = Debug|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x86.Build.0 = Debug|Win32 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x64.ActiveCfg = Release|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x64.Build.0 = Release|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x86.ActiveCfg = Release|Win32 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x86.Build.0 = Release|Win32 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x64.ActiveCfg = Release|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x64.Build.0 = Release|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x86.ActiveCfg = Release|Win32 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x86.Build.0 = Release|Win32 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x64.ActiveCfg = Debug|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x64.Build.0 = Debug|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x86.ActiveCfg = Debug|Win32 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x86.Build.0 = Debug|Win32 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x64.ActiveCfg = Debug|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x64.Build.0 = Debug|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x86.Build.0 = Debug|Win32 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x64.ActiveCfg = Release|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x64.Build.0 = Release|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x86.ActiveCfg = Release|Win32 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x86.Build.0 = Release|Win32 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x64.ActiveCfg = Release|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x64.Build.0 = Release|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x86.ActiveCfg = Release|Win32 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x86.Build.0 = Release|Win32 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x64.ActiveCfg = Debug|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x64.Build.0 = Debug|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x86.ActiveCfg = Debug|Win32 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x86.Build.0 = Debug|Win32 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x64.ActiveCfg = Debug|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x64.Build.0 = Debug|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x86.Build.0 = Debug|Win32 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x64.ActiveCfg = Release|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x64.Build.0 = Release|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x86.ActiveCfg = Release|Win32 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x86.Build.0 = Release|Win32 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x64.ActiveCfg = Release|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x64.Build.0 = Release|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x86.ActiveCfg = Release|Win32 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x86.Build.0 = Release|Win32 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x64.ActiveCfg = Debug|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x64.Build.0 = Debug|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x86.ActiveCfg = Debug|Win32 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x86.Build.0 = Debug|Win32 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x64.ActiveCfg = Debug|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x64.Build.0 = Debug|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x86.Build.0 = Debug|Win32 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x64.ActiveCfg = Release|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x64.Build.0 = Release|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x86.ActiveCfg = Release|Win32 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x86.Build.0 = Release|Win32 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x64.ActiveCfg = Release|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x64.Build.0 = Release|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x86.ActiveCfg = Release|Win32 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x86.Build.0 = Release|Win32 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x64.ActiveCfg = Debug|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x64.Build.0 = Debug|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x86.ActiveCfg = Debug|Win32 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x86.Build.0 = Debug|Win32 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x64.ActiveCfg = Debug|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x64.Build.0 = Debug|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x86.Build.0 = Debug|Win32 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x64.ActiveCfg = Release|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x64.Build.0 = Release|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x86.ActiveCfg = Release|Win32 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x86.Build.0 = Release|Win32 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x64.ActiveCfg = Release|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x64.Build.0 = Release|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x86.ActiveCfg = Release|Win32 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x86.Build.0 = Release|Win32 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x64.ActiveCfg = Debug|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x64.Build.0 = Debug|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x86.ActiveCfg = Debug|Win32 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x86.Build.0 = Debug|Win32 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x64.ActiveCfg = Debug|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x64.Build.0 = Debug|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x86.Build.0 = Debug|Win32 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x64.ActiveCfg = Release|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x64.Build.0 = Release|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x86.ActiveCfg = Release|Win32 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x86.Build.0 = Release|Win32 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x64.ActiveCfg = Release|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x64.Build.0 = Release|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x86.ActiveCfg = Release|Win32 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x86.Build.0 = Release|Win32 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x64.ActiveCfg = Debug|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x64.Build.0 = Debug|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x86.ActiveCfg = Debug|Win32 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x86.Build.0 = Debug|Win32 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x64.ActiveCfg = Debug|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x64.Build.0 = Debug|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x86.Build.0 = Debug|Win32 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x64.ActiveCfg = Release|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x64.Build.0 = Release|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x86.ActiveCfg = Release|Win32 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x86.Build.0 = Release|Win32 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x64.ActiveCfg = Release|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x64.Build.0 = Release|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x86.ActiveCfg = Release|Win32 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x86.Build.0 = Release|Win32 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x64.ActiveCfg = Debug|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x64.Build.0 = Debug|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x86.ActiveCfg = Debug|Win32 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x86.Build.0 = Debug|Win32 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x64.ActiveCfg = Debug|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x64.Build.0 = Debug|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x86.Build.0 = Debug|Win32 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.ActiveCfg = Release|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.Build.0 = Release|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x86.ActiveCfg = Release|Win32 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x86.Build.0 = Release|Win32 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x64.ActiveCfg = Release|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x64.Build.0 = Release|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x86.ActiveCfg = Release|Win32 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x86.Build.0 = Release|Win32 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug|x64.ActiveCfg = Debug|x64 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug|x64.Build.0 = Debug|x64 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug|x86.ActiveCfg = Debug|Win32 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug|x86.Build.0 = Debug|Win32 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug-Double|x64.ActiveCfg = Debug|x64 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug-Double|x64.Build.0 = Debug|x64 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug-Double|x86.Build.0 = Debug|Win32 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release|x64.ActiveCfg = Release|x64 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release|x64.Build.0 = Release|x64 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release|x86.ActiveCfg = Release|Win32 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release|x86.Build.0 = Release|Win32 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release-Double|x64.ActiveCfg = Release|x64 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release-Double|x64.Build.0 = Release|x64 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release-Double|x86.ActiveCfg = Release|Win32 + {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release-Double|x86.Build.0 = Release|Win32 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(NestedProjects) = preSolution + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {3000393A-702F-488E-B918-1D37955FA8D3} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {676276A1-DC23-4287-8386-07076303C39D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {951A453F-1999-483D-848A-9B63C282F43D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {2467FDD4-622B-4628-993A-73994FB8172E} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {029204DD-3D5B-47C6-8CAA-A933886D4674} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {6906E75C-2A54-431B-A11D-145864FCDD5C} = {272B8080-A022-4F4A-BDD6-835871E44C23} + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {B362252D-3254-4C68-B527-CC85CE3CCF75} + EndGlobalSection +EndGlobal diff --git a/vs-build-ifx/OpenFAST.u2d b/vs-build-ifx/OpenFAST.u2d new file mode 100644 index 0000000000000000000000000000000000000000..0e447623f172790ef1f1bb9fcac343c8ea7b075f GIT binary patch literal 186 zcmaKm-3mZZ5QM*TFP9z!c>(eO64ysb3P*m*g@-riR?;@x&h9ij0D(}@({VCz(=xJ< z5NnU|Efgv#Cc(0+f2q9BTXm6CGx*FYH_C-9*jE~ AqW}N^ literal 0 HcmV?d00001 diff --git a/vs-build-ifx/OpenFAST.vfproj b/vs-build-ifx/OpenFAST.vfproj new file mode 100644 index 0000000000..f572480660 --- /dev/null +++ b/vs-build-ifx/OpenFAST.vfproj @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDisk.u2d b/vs-build-ifx/modules/AeroDisk.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/AeroDisk.vfproj b/vs-build-ifx/modules/AeroDisk.vfproj new file mode 100644 index 0000000000..bf6a910224 --- /dev/null +++ b/vs-build-ifx/modules/AeroDisk.vfproj @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDyn.u2d b/vs-build-ifx/modules/AeroDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/AeroDyn.vfproj b/vs-build-ifx/modules/AeroDyn.vfproj new file mode 100644 index 0000000000..3dfc8b91b9 --- /dev/null +++ b/vs-build-ifx/modules/AeroDyn.vfproj @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/BeamDyn.u2d b/vs-build-ifx/modules/BeamDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/BeamDyn.vfproj b/vs-build-ifx/modules/BeamDyn.vfproj new file mode 100644 index 0000000000..6617dacc23 --- /dev/null +++ b/vs-build-ifx/modules/BeamDyn.vfproj @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/BeamDyn_Driver.u2d b/vs-build-ifx/modules/BeamDyn_Driver.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/BeamDyn_Driver.vfproj b/vs-build-ifx/modules/BeamDyn_Driver.vfproj new file mode 100644 index 0000000000..399c94dc3f --- /dev/null +++ b/vs-build-ifx/modules/BeamDyn_Driver.vfproj @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ElastoDyn.u2d b/vs-build-ifx/modules/ElastoDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/ElastoDyn.vfproj b/vs-build-ifx/modules/ElastoDyn.vfproj new file mode 100644 index 0000000000..39507e1101 --- /dev/null +++ b/vs-build-ifx/modules/ElastoDyn.vfproj @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExtLoads.u2d b/vs-build-ifx/modules/ExtLoads.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/ExtLoads.vfproj b/vs-build-ifx/modules/ExtLoads.vfproj new file mode 100644 index 0000000000..3aa5d623e7 --- /dev/null +++ b/vs-build-ifx/modules/ExtLoads.vfproj @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExtLoads_Types.u2d b/vs-build-ifx/modules/ExtLoads_Types.u2d new file mode 100644 index 0000000000000000000000000000000000000000..2f2e2dd8a55228208c3c1ca41a0cc29e05a09494 GIT binary patch literal 106 zcmZQzU|`?@Vi$%~h9rhkhIED+hH!>VhCBvi1|y(210#sw1L7c{iX0$LWGDub*i?bc PL0475V8&nqGJ+8Rt3wSB literal 0 HcmV?d00001 diff --git a/vs-build-ifx/modules/ExtLoads_Types.vfproj b/vs-build-ifx/modules/ExtLoads_Types.vfproj new file mode 100644 index 0000000000..ba6305d1da --- /dev/null +++ b/vs-build-ifx/modules/ExtLoads_Types.vfproj @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExtPtfm.u2d b/vs-build-ifx/modules/ExtPtfm.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/ExtPtfm.vfproj b/vs-build-ifx/modules/ExtPtfm.vfproj new file mode 100644 index 0000000000..785a75a8b3 --- /dev/null +++ b/vs-build-ifx/modules/ExtPtfm.vfproj @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExternalInflow.u2d b/vs-build-ifx/modules/ExternalInflow.u2d new file mode 100644 index 0000000000000000000000000000000000000000..2f2e2dd8a55228208c3c1ca41a0cc29e05a09494 GIT binary patch literal 106 zcmZQzU|`?@Vi$%~h9rhkhIED+hH!>VhCBvi1|y(210#sw1L7c{iX0$LWGDub*i?bc PL0475V8&nqGJ+8Rt3wSB literal 0 HcmV?d00001 diff --git a/vs-build-ifx/modules/ExternalInflow.vfproj b/vs-build-ifx/modules/ExternalInflow.vfproj new file mode 100644 index 0000000000..32098e0081 --- /dev/null +++ b/vs-build-ifx/modules/ExternalInflow.vfproj @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExternalInflow_Types.u2d b/vs-build-ifx/modules/ExternalInflow_Types.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/ExternalInflow_Types.vfproj b/vs-build-ifx/modules/ExternalInflow_Types.vfproj new file mode 100644 index 0000000000..edf8f64877 --- /dev/null +++ b/vs-build-ifx/modules/ExternalInflow_Types.vfproj @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/FEAMooring.u2d b/vs-build-ifx/modules/FEAMooring.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/FEAMooring.vfproj b/vs-build-ifx/modules/FEAMooring.vfproj new file mode 100644 index 0000000000..c86d007da1 --- /dev/null +++ b/vs-build-ifx/modules/FEAMooring.vfproj @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/HydroDyn.u2d b/vs-build-ifx/modules/HydroDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/HydroDyn.vfproj b/vs-build-ifx/modules/HydroDyn.vfproj new file mode 100644 index 0000000000..935917d17f --- /dev/null +++ b/vs-build-ifx/modules/HydroDyn.vfproj @@ -0,0 +1,83 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/IceDyn.u2d b/vs-build-ifx/modules/IceDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/IceDyn.vfproj b/vs-build-ifx/modules/IceDyn.vfproj new file mode 100644 index 0000000000..7ea62ead8b --- /dev/null +++ b/vs-build-ifx/modules/IceDyn.vfproj @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/IceFloe.u2d b/vs-build-ifx/modules/IceFloe.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/IceFloe.vfproj b/vs-build-ifx/modules/IceFloe.vfproj new file mode 100644 index 0000000000..b58d200e5b --- /dev/null +++ b/vs-build-ifx/modules/IceFloe.vfproj @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/InflowWind.u2d b/vs-build-ifx/modules/InflowWind.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/InflowWind.vfproj b/vs-build-ifx/modules/InflowWind.vfproj new file mode 100644 index 0000000000..570dfa7610 --- /dev/null +++ b/vs-build-ifx/modules/InflowWind.vfproj @@ -0,0 +1,70 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/LinDyn.u2d b/vs-build-ifx/modules/LinDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/LinDyn.vfproj b/vs-build-ifx/modules/LinDyn.vfproj new file mode 100644 index 0000000000..173ed80042 --- /dev/null +++ b/vs-build-ifx/modules/LinDyn.vfproj @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/MAP-C.vcxproj b/vs-build-ifx/modules/MAP-C.vcxproj new file mode 100644 index 0000000000..49b1da2d87 --- /dev/null +++ b/vs-build-ifx/modules/MAP-C.vcxproj @@ -0,0 +1,197 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + Debug + x64 + + + Release + x64 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 17.0 + Win32Proj + {471eeb17-a1aa-43b0-acee-719b80bb4811} + MAPC + 10.0 + + + + StaticLibrary + true + v143 + Unicode + + + StaticLibrary + false + v143 + true + Unicode + + + StaticLibrary + true + v143 + Unicode + + + StaticLibrary + false + v143 + true + Unicode + + + + + + + + + + + + + + + + + + + + + ..\..\build\lib + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + ..\..\build\lib + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + + Level3 + true + WIN32;_DEBUG;_LIB;%(PreprocessorDefinitions) + true + Use + pch.h + + + + + true + + + + + Level3 + true + true + true + WIN32;NDEBUG;_LIB;%(PreprocessorDefinitions) + true + Use + pch.h + + + + + true + true + true + + + + + Level3 + true + _DEBUG;_LIB;MAP_DLL_EXPORTS;CMINPACK_NO_DLL;NDEBUG;_WINDOWS;_USRDLL;%(PreprocessorDefinitions) + true + NotUsing + pch.h + + + + + true + + + + + Level3 + true + true + true + NDEBUG;_LIB;MAP_DLL_EXPORTS;CMINPACK_NO_DLL;_WINDOWS;_USRDLL;%(PreprocessorDefinitions) + true + NotUsing + pch.h + + + + + true + true + true + + + + + + \ No newline at end of file diff --git a/vs-build-ifx/modules/MAP-C.vcxproj.user b/vs-build-ifx/modules/MAP-C.vcxproj.user new file mode 100644 index 0000000000..88a550947e --- /dev/null +++ b/vs-build-ifx/modules/MAP-C.vcxproj.user @@ -0,0 +1,4 @@ + + + + \ No newline at end of file diff --git a/vs-build-ifx/modules/MAP.u2d b/vs-build-ifx/modules/MAP.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/MAP.vfproj b/vs-build-ifx/modules/MAP.vfproj new file mode 100644 index 0000000000..bdb0827618 --- /dev/null +++ b/vs-build-ifx/modules/MAP.vfproj @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/MoorDyn.u2d b/vs-build-ifx/modules/MoorDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/MoorDyn.vfproj b/vs-build-ifx/modules/MoorDyn.vfproj new file mode 100644 index 0000000000..3f08fcd2df --- /dev/null +++ b/vs-build-ifx/modules/MoorDyn.vfproj @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/MoorDyn_Driver.u2d b/vs-build-ifx/modules/MoorDyn_Driver.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/MoorDyn_Driver.vfproj b/vs-build-ifx/modules/MoorDyn_Driver.vfproj new file mode 100644 index 0000000000..cc950ee7e8 --- /dev/null +++ b/vs-build-ifx/modules/MoorDyn_Driver.vfproj @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/NWTC-Library.vfproj b/vs-build-ifx/modules/NWTC-Library.vfproj new file mode 100644 index 0000000000..94114323c1 --- /dev/null +++ b/vs-build-ifx/modules/NWTC-Library.vfproj @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/OpenFAST-Library.u2d b/vs-build-ifx/modules/OpenFAST-Library.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/OpenFAST-Library.vfproj b/vs-build-ifx/modules/OpenFAST-Library.vfproj new file mode 100644 index 0000000000..4c9ccfe33e --- /dev/null +++ b/vs-build-ifx/modules/OpenFAST-Library.vfproj @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/OpenFAST-Prelib.u2d b/vs-build-ifx/modules/OpenFAST-Prelib.u2d new file mode 100644 index 0000000000000000000000000000000000000000..2f2e2dd8a55228208c3c1ca41a0cc29e05a09494 GIT binary patch literal 106 zcmZQzU|`?@Vi$%~h9rhkhIED+hH!>VhCBvi1|y(210#sw1L7c{iX0$LWGDub*i?bc PL0475V8&nqGJ+8Rt3wSB literal 0 HcmV?d00001 diff --git a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj new file mode 100644 index 0000000000..95260beec6 --- /dev/null +++ b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/OrcaFlex.u2d b/vs-build-ifx/modules/OrcaFlex.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/OrcaFlex.vfproj b/vs-build-ifx/modules/OrcaFlex.vfproj new file mode 100644 index 0000000000..bcd86523e6 --- /dev/null +++ b/vs-build-ifx/modules/OrcaFlex.vfproj @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/Registry.vcxproj b/vs-build-ifx/modules/Registry.vcxproj new file mode 100644 index 0000000000..cf6ea10d1e --- /dev/null +++ b/vs-build-ifx/modules/Registry.vcxproj @@ -0,0 +1,167 @@ + + + + + Debug-Double + x64 + + + Release-Double + x64 + + + Debug + x64 + + + Release + x64 + + + + + + + + + + + + + + + 17.0 + Win32Proj + {ec73da51-78cf-41db-9dfa-88360bf2ea93} + openfastregistry + 10.0 + + + + Application + true + v143 + Unicode + + + Application + true + v143 + Unicode + + + Application + false + v143 + true + Unicode + + + Application + true + v143 + Unicode + + + Application + true + v143 + Unicode + + + Application + false + v143 + true + Unicode + + + v143 + + + v143 + + + + + + + + + + + + + + + + + + + + + + + + + + + ..\..\build\bin + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + ..\..\build\bin + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + ..\..\build\bin + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + ..\..\build\bin + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + + Level3 + true + _DEBUG;_CONSOLE;%(PreprocessorDefinitions) + true + + + Console + true + + + + + Level3 + true + _DEBUG;_CONSOLE;%(PreprocessorDefinitions) + true + + + Console + true + + + + + Level3 + true + true + true + NDEBUG;_CONSOLE;%(PreprocessorDefinitions) + true + + + Console + true + true + true + + + + + + \ No newline at end of file diff --git a/vs-build-ifx/modules/SeaState.u2d b/vs-build-ifx/modules/SeaState.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/SeaState.vfproj b/vs-build-ifx/modules/SeaState.vfproj new file mode 100644 index 0000000000..3a3866d84e --- /dev/null +++ b/vs-build-ifx/modules/SeaState.vfproj @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ServoDyn.u2d b/vs-build-ifx/modules/ServoDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/ServoDyn.vfproj b/vs-build-ifx/modules/ServoDyn.vfproj new file mode 100644 index 0000000000..8f858427d4 --- /dev/null +++ b/vs-build-ifx/modules/ServoDyn.vfproj @@ -0,0 +1,69 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/SimpleElastoDyn.u2d b/vs-build-ifx/modules/SimpleElastoDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/SimpleElastoDyn.vfproj b/vs-build-ifx/modules/SimpleElastoDyn.vfproj new file mode 100644 index 0000000000..95a063fdfb --- /dev/null +++ b/vs-build-ifx/modules/SimpleElastoDyn.vfproj @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/SubDyn.u2d b/vs-build-ifx/modules/SubDyn.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/SubDyn.vfproj b/vs-build-ifx/modules/SubDyn.vfproj new file mode 100644 index 0000000000..dc50308160 --- /dev/null +++ b/vs-build-ifx/modules/SubDyn.vfproj @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/SuperController.u2d b/vs-build-ifx/modules/SuperController.u2d new file mode 100644 index 0000000000000000000000000000000000000000..2f2e2dd8a55228208c3c1ca41a0cc29e05a09494 GIT binary patch literal 106 zcmZQzU|`?@Vi$%~h9rhkhIED+hH!>VhCBvi1|y(210#sw1L7c{iX0$LWGDub*i?bc PL0475V8&nqGJ+8Rt3wSB literal 0 HcmV?d00001 diff --git a/vs-build-ifx/modules/SuperController.vfproj b/vs-build-ifx/modules/SuperController.vfproj new file mode 100644 index 0000000000..1bd0f87697 --- /dev/null +++ b/vs-build-ifx/modules/SuperController.vfproj @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/SuperController_Types.u2d b/vs-build-ifx/modules/SuperController_Types.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/SuperController_Types.vfproj b/vs-build-ifx/modules/SuperController_Types.vfproj new file mode 100644 index 0000000000..572bb78c85 --- /dev/null +++ b/vs-build-ifx/modules/SuperController_Types.vfproj @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/TurbSim.u2d b/vs-build-ifx/modules/TurbSim.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/TurbSim.vfproj b/vs-build-ifx/modules/TurbSim.vfproj new file mode 100644 index 0000000000..47277c8cfe --- /dev/null +++ b/vs-build-ifx/modules/TurbSim.vfproj @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/VersionInfo.u2d b/vs-build-ifx/modules/VersionInfo.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/VersionInfo.vfproj b/vs-build-ifx/modules/VersionInfo.vfproj new file mode 100644 index 0000000000..c6557daea3 --- /dev/null +++ b/vs-build-ifx/modules/VersionInfo.vfproj @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/WakeDynamics.u2d b/vs-build-ifx/modules/WakeDynamics.u2d new file mode 100644 index 0000000000..e69de29bb2 diff --git a/vs-build-ifx/modules/WakeDynamics.vfproj b/vs-build-ifx/modules/WakeDynamics.vfproj new file mode 100644 index 0000000000..141734324b --- /dev/null +++ b/vs-build-ifx/modules/WakeDynamics.vfproj @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/nwtc-library.u2d b/vs-build-ifx/modules/nwtc-library.u2d new file mode 100644 index 0000000000000000000000000000000000000000..c9031ea6ab1b5bbdfb4ad8477985908e5eb5b4b9 GIT binary patch literal 396 zcmZQzU|`?@;vj}ph8!SHWGDubH4GIDW(+1kaYjZ)0xHCS@?i{aK$y=^#83jni41uR z&Olx+Ljgl3*wiA15FkGv$Of87z&rt{c|JhBNnq28fGm)i2s4067=(cs)z!KTEdEmD@uqV_{pSnxRSM9h2wwpJy=Xfx literal 0 HcmV?d00001 From 74d6f66580ab3e300dad18c2cb93935ef7611c40 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 15 Nov 2024 14:03:59 -0500 Subject: [PATCH 284/319] Remvoe Visual Studio temporary files from repo --- vs-build-ifx/.gitignore | 4 +++- vs-build-ifx/OpenFAST.u2d | Bin 186 -> 0 bytes vs-build-ifx/modules/AeroDisk.u2d | 0 vs-build-ifx/modules/AeroDyn.u2d | 0 vs-build-ifx/modules/BeamDyn.u2d | 0 vs-build-ifx/modules/BeamDyn_Driver.u2d | 0 vs-build-ifx/modules/ElastoDyn.u2d | 0 vs-build-ifx/modules/ExtLoads.u2d | 0 vs-build-ifx/modules/ExtLoads_Types.u2d | Bin 106 -> 0 bytes vs-build-ifx/modules/ExtPtfm.u2d | 0 vs-build-ifx/modules/ExternalInflow.u2d | Bin 106 -> 0 bytes vs-build-ifx/modules/ExternalInflow_Types.u2d | 0 vs-build-ifx/modules/FEAMooring.u2d | 0 vs-build-ifx/modules/HydroDyn.u2d | 0 vs-build-ifx/modules/IceDyn.u2d | 0 vs-build-ifx/modules/IceFloe.u2d | 0 vs-build-ifx/modules/InflowWind.u2d | 0 vs-build-ifx/modules/LinDyn.u2d | 0 vs-build-ifx/modules/MAP-C.vcxproj.user | 4 ---- vs-build-ifx/modules/MAP.u2d | 0 vs-build-ifx/modules/MoorDyn.u2d | 0 vs-build-ifx/modules/MoorDyn_Driver.u2d | 0 vs-build-ifx/modules/OpenFAST-Library.u2d | 0 vs-build-ifx/modules/OpenFAST-Prelib.u2d | Bin 106 -> 0 bytes vs-build-ifx/modules/OrcaFlex.u2d | 0 vs-build-ifx/modules/SeaState.u2d | 0 vs-build-ifx/modules/ServoDyn.u2d | 0 vs-build-ifx/modules/SimpleElastoDyn.u2d | 0 vs-build-ifx/modules/SubDyn.u2d | 0 vs-build-ifx/modules/SuperController.u2d | Bin 106 -> 0 bytes vs-build-ifx/modules/SuperController_Types.u2d | 0 vs-build-ifx/modules/TurbSim.u2d | 0 vs-build-ifx/modules/VersionInfo.u2d | 0 vs-build-ifx/modules/WakeDynamics.u2d | 0 vs-build-ifx/modules/nwtc-library.u2d | Bin 396 -> 0 bytes 35 files changed, 3 insertions(+), 5 deletions(-) delete mode 100644 vs-build-ifx/OpenFAST.u2d delete mode 100644 vs-build-ifx/modules/AeroDisk.u2d delete mode 100644 vs-build-ifx/modules/AeroDyn.u2d delete mode 100644 vs-build-ifx/modules/BeamDyn.u2d delete mode 100644 vs-build-ifx/modules/BeamDyn_Driver.u2d delete mode 100644 vs-build-ifx/modules/ElastoDyn.u2d delete mode 100644 vs-build-ifx/modules/ExtLoads.u2d delete mode 100644 vs-build-ifx/modules/ExtLoads_Types.u2d delete mode 100644 vs-build-ifx/modules/ExtPtfm.u2d delete mode 100644 vs-build-ifx/modules/ExternalInflow.u2d delete mode 100644 vs-build-ifx/modules/ExternalInflow_Types.u2d delete mode 100644 vs-build-ifx/modules/FEAMooring.u2d delete mode 100644 vs-build-ifx/modules/HydroDyn.u2d delete mode 100644 vs-build-ifx/modules/IceDyn.u2d delete mode 100644 vs-build-ifx/modules/IceFloe.u2d delete mode 100644 vs-build-ifx/modules/InflowWind.u2d delete mode 100644 vs-build-ifx/modules/LinDyn.u2d delete mode 100644 vs-build-ifx/modules/MAP-C.vcxproj.user delete mode 100644 vs-build-ifx/modules/MAP.u2d delete mode 100644 vs-build-ifx/modules/MoorDyn.u2d delete mode 100644 vs-build-ifx/modules/MoorDyn_Driver.u2d delete mode 100644 vs-build-ifx/modules/OpenFAST-Library.u2d delete mode 100644 vs-build-ifx/modules/OpenFAST-Prelib.u2d delete mode 100644 vs-build-ifx/modules/OrcaFlex.u2d delete mode 100644 vs-build-ifx/modules/SeaState.u2d delete mode 100644 vs-build-ifx/modules/ServoDyn.u2d delete mode 100644 vs-build-ifx/modules/SimpleElastoDyn.u2d delete mode 100644 vs-build-ifx/modules/SubDyn.u2d delete mode 100644 vs-build-ifx/modules/SuperController.u2d delete mode 100644 vs-build-ifx/modules/SuperController_Types.u2d delete mode 100644 vs-build-ifx/modules/TurbSim.u2d delete mode 100644 vs-build-ifx/modules/VersionInfo.u2d delete mode 100644 vs-build-ifx/modules/WakeDynamics.u2d delete mode 100644 vs-build-ifx/modules/nwtc-library.u2d diff --git a/vs-build-ifx/.gitignore b/vs-build-ifx/.gitignore index 0a34381797..dc70644a4d 100644 --- a/vs-build-ifx/.gitignore +++ b/vs-build-ifx/.gitignore @@ -1 +1,3 @@ -.vs \ No newline at end of file +.vs +*.user +*.u2d \ No newline at end of file diff --git a/vs-build-ifx/OpenFAST.u2d b/vs-build-ifx/OpenFAST.u2d deleted file mode 100644 index 0e447623f172790ef1f1bb9fcac343c8ea7b075f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 186 zcmaKm-3mZZ5QM*TFP9z!c>(eO64ysb3P*m*g@-riR?;@x&h9ij0D(}@({VCz(=xJ< z5NnU|Efgv#Cc(0+f2q9BTXm6CGx*FYH_C-9*jE~ AqW}N^ diff --git a/vs-build-ifx/modules/AeroDisk.u2d b/vs-build-ifx/modules/AeroDisk.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/AeroDyn.u2d b/vs-build-ifx/modules/AeroDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/BeamDyn.u2d b/vs-build-ifx/modules/BeamDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/BeamDyn_Driver.u2d b/vs-build-ifx/modules/BeamDyn_Driver.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/ElastoDyn.u2d b/vs-build-ifx/modules/ElastoDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/ExtLoads.u2d b/vs-build-ifx/modules/ExtLoads.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/ExtLoads_Types.u2d b/vs-build-ifx/modules/ExtLoads_Types.u2d deleted file mode 100644 index 2f2e2dd8a55228208c3c1ca41a0cc29e05a09494..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 106 zcmZQzU|`?@Vi$%~h9rhkhIED+hH!>VhCBvi1|y(210#sw1L7c{iX0$LWGDub*i?bc PL0475V8&nqGJ+8Rt3wSB diff --git a/vs-build-ifx/modules/ExtPtfm.u2d b/vs-build-ifx/modules/ExtPtfm.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/ExternalInflow.u2d b/vs-build-ifx/modules/ExternalInflow.u2d deleted file mode 100644 index 2f2e2dd8a55228208c3c1ca41a0cc29e05a09494..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 106 zcmZQzU|`?@Vi$%~h9rhkhIED+hH!>VhCBvi1|y(210#sw1L7c{iX0$LWGDub*i?bc PL0475V8&nqGJ+8Rt3wSB diff --git a/vs-build-ifx/modules/ExternalInflow_Types.u2d b/vs-build-ifx/modules/ExternalInflow_Types.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/FEAMooring.u2d b/vs-build-ifx/modules/FEAMooring.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/HydroDyn.u2d b/vs-build-ifx/modules/HydroDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/IceDyn.u2d b/vs-build-ifx/modules/IceDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/IceFloe.u2d b/vs-build-ifx/modules/IceFloe.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/InflowWind.u2d b/vs-build-ifx/modules/InflowWind.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/LinDyn.u2d b/vs-build-ifx/modules/LinDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/MAP-C.vcxproj.user b/vs-build-ifx/modules/MAP-C.vcxproj.user deleted file mode 100644 index 88a550947e..0000000000 --- a/vs-build-ifx/modules/MAP-C.vcxproj.user +++ /dev/null @@ -1,4 +0,0 @@ - - - - \ No newline at end of file diff --git a/vs-build-ifx/modules/MAP.u2d b/vs-build-ifx/modules/MAP.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/MoorDyn.u2d b/vs-build-ifx/modules/MoorDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/MoorDyn_Driver.u2d b/vs-build-ifx/modules/MoorDyn_Driver.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/OpenFAST-Library.u2d b/vs-build-ifx/modules/OpenFAST-Library.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/OpenFAST-Prelib.u2d b/vs-build-ifx/modules/OpenFAST-Prelib.u2d deleted file mode 100644 index 2f2e2dd8a55228208c3c1ca41a0cc29e05a09494..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 106 zcmZQzU|`?@Vi$%~h9rhkhIED+hH!>VhCBvi1|y(210#sw1L7c{iX0$LWGDub*i?bc PL0475V8&nqGJ+8Rt3wSB diff --git a/vs-build-ifx/modules/OrcaFlex.u2d b/vs-build-ifx/modules/OrcaFlex.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/SeaState.u2d b/vs-build-ifx/modules/SeaState.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/ServoDyn.u2d b/vs-build-ifx/modules/ServoDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/SimpleElastoDyn.u2d b/vs-build-ifx/modules/SimpleElastoDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/SubDyn.u2d b/vs-build-ifx/modules/SubDyn.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/SuperController.u2d b/vs-build-ifx/modules/SuperController.u2d deleted file mode 100644 index 2f2e2dd8a55228208c3c1ca41a0cc29e05a09494..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 106 zcmZQzU|`?@Vi$%~h9rhkhIED+hH!>VhCBvi1|y(210#sw1L7c{iX0$LWGDub*i?bc PL0475V8&nqGJ+8Rt3wSB diff --git a/vs-build-ifx/modules/SuperController_Types.u2d b/vs-build-ifx/modules/SuperController_Types.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/TurbSim.u2d b/vs-build-ifx/modules/TurbSim.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/VersionInfo.u2d b/vs-build-ifx/modules/VersionInfo.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/WakeDynamics.u2d b/vs-build-ifx/modules/WakeDynamics.u2d deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vs-build-ifx/modules/nwtc-library.u2d b/vs-build-ifx/modules/nwtc-library.u2d deleted file mode 100644 index c9031ea6ab1b5bbdfb4ad8477985908e5eb5b4b9..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 396 zcmZQzU|`?@;vj}ph8!SHWGDubH4GIDW(+1kaYjZ)0xHCS@?i{aK$y=^#83jni41uR z&Olx+Ljgl3*wiA15FkGv$Of87z&rt{c|JhBNnq28fGm)i2s4067=(cs)z!KTEdEmD@uqV_{pSnxRSM9h2wwpJy=Xfx From 6b3c85edcee808d829773e246a89fb7b2a6cbab3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 15 Nov 2024 17:09:40 -0500 Subject: [PATCH 285/319] Adding missing features and modules to vs-build-ifx --- vs-build-ifx/CreateGitVersion.bat | 9 + vs-build-ifx/OpenFAST.sln | 247 ++++++++++-- vs-build-ifx/RunRegistry.bat | 365 ++++++++++++++++++ vs-build-ifx/gitVersionInfo.h | 1 + vs-build-ifx/glue-codes/FAST.Farm.vfproj | 46 +++ vs-build-ifx/glue-codes/OpenFAST.vfproj | 37 ++ vs-build-ifx/modules/AWAE.vfproj | 41 ++ vs-build-ifx/modules/AeroDisk.vfproj | 37 +- vs-build-ifx/modules/AeroDyn.vfproj | 71 +++- vs-build-ifx/modules/AeroDyn_Driver.vfproj | 38 ++ .../modules/AeroDyn_Driver_Subs.vfproj | 46 +++ vs-build-ifx/modules/AeroDyn_Inflow.vfproj | 45 +++ .../AeroDyn_Inflow_C_Binding.vfproj} | 27 +- vs-build-ifx/modules/BeamDyn.vfproj | 38 +- vs-build-ifx/modules/BeamDyn_Driver.vfproj | 30 +- vs-build-ifx/modules/ElastoDyn.vfproj | 38 +- vs-build-ifx/modules/ExtLoads.vfproj | 10 +- vs-build-ifx/modules/ExtLoads_Types.vfproj | 7 +- vs-build-ifx/modules/ExtPtfm.vfproj | 7 +- vs-build-ifx/modules/ExternalInflow.vfproj | 10 +- .../modules/ExternalInflow_Types.vfproj | 32 +- vs-build-ifx/modules/FEAMooring.vfproj | 7 +- vs-build-ifx/modules/HydroDyn.vfproj | 10 +- vs-build-ifx/modules/IceDyn.vfproj | 10 +- vs-build-ifx/modules/IceFloe.vfproj | 16 +- vs-build-ifx/modules/InflowWind.vfproj | 44 ++- vs-build-ifx/modules/LinDyn.vfproj | 7 +- vs-build-ifx/modules/MAP-C.vcxproj | 2 + vs-build-ifx/modules/MAP.vfproj | 10 +- vs-build-ifx/modules/MoorDyn.vfproj | 10 +- vs-build-ifx/modules/MoorDyn_Driver.vfproj | 5 +- vs-build-ifx/modules/NWTC-Library.vfproj | 5 +- vs-build-ifx/modules/OpenFAST-Library.vfproj | 8 +- vs-build-ifx/modules/OpenFAST-Prelib.vfproj | 7 +- vs-build-ifx/modules/OrcaFlex.vfproj | 7 +- vs-build-ifx/modules/Registry.vcxproj | 42 +- vs-build-ifx/modules/SeaState.vfproj | 7 +- vs-build-ifx/modules/ServoDyn.vfproj | 10 +- vs-build-ifx/modules/SimpleElastoDyn.vfproj | 7 +- vs-build-ifx/modules/SubDyn.vfproj | 7 +- vs-build-ifx/modules/SuperController.vfproj | 10 +- .../modules/SuperController_Types.vfproj | 8 +- vs-build-ifx/modules/TurbSim.vfproj | 2 +- vs-build-ifx/modules/VersionInfo.vfproj | 32 +- vs-build-ifx/modules/WakeDynamics.vfproj | 7 +- 45 files changed, 1092 insertions(+), 370 deletions(-) create mode 100644 vs-build-ifx/CreateGitVersion.bat create mode 100644 vs-build-ifx/RunRegistry.bat create mode 100644 vs-build-ifx/gitVersionInfo.h create mode 100644 vs-build-ifx/glue-codes/FAST.Farm.vfproj create mode 100644 vs-build-ifx/glue-codes/OpenFAST.vfproj create mode 100644 vs-build-ifx/modules/AWAE.vfproj create mode 100644 vs-build-ifx/modules/AeroDyn_Driver.vfproj create mode 100644 vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj create mode 100644 vs-build-ifx/modules/AeroDyn_Inflow.vfproj rename vs-build-ifx/{OpenFAST.vfproj => modules/AeroDyn_Inflow_C_Binding.vfproj} (67%) diff --git a/vs-build-ifx/CreateGitVersion.bat b/vs-build-ifx/CreateGitVersion.bat new file mode 100644 index 0000000000..91647f8e93 --- /dev/null +++ b/vs-build-ifx/CreateGitVersion.bat @@ -0,0 +1,9 @@ +@ECHO off +SET IncludeFile=..\gitVersionInfo.h + + %IncludeFile% +FOR /f %%a IN ('git describe --abbrev^=8 --always --tags --dirty') DO > %IncludeFile% +git describe --abbrev^=8 --always --tags --dirty > NUL +IF %ERRORLEVEL%==0 ( ECHO '>> %IncludeFile% ) else ( ECHO Unversioned from $Format:%H$ '>> %IncludeFile% ) + +EXIT /B 0 \ No newline at end of file diff --git a/vs-build-ifx/OpenFAST.sln b/vs-build-ifx/OpenFAST.sln index 1ee3d0ab83..82e28fff9c 100644 --- a/vs-build-ifx/OpenFAST.sln +++ b/vs-build-ifx/OpenFAST.sln @@ -12,6 +12,9 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn", "modules\AeroDyn. EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "NWTC-Library", "modules\NWTC-Library.vfproj", "{EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}" + ProjectSection(ProjectDependencies) = postProject + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "InflowWind", "modules\InflowWind.vfproj", "{9CB36EC2-18AF-468E-BE43-FE63E383AA3A}" ProjectSection(ProjectDependencies) = postProject @@ -28,6 +31,7 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "modules\BeamDyn. ProjectSection(ProjectDependencies) = postProject {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn_Driver", "modules\BeamDyn_Driver.vfproj", "{D9220A21-8C69-42E4-B085-E5D996B867D9}" @@ -355,7 +359,92 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Library", "modules {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} EndProjectSection EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST", "OpenFAST.vfproj", "{5761312F-64A3-4EC4-958F-3302AAA830AC}" +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver", "modules\AeroDyn_Driver.vfproj", "{2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Inflow", "modules\AeroDyn_Inflow.vfproj", "{ACF05685-6592-462C-A3B3-9CDE2CAFD958}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver_Subs", "modules\AeroDyn_Driver_Subs.vfproj", "{60BA8F27-5C49-42DA-9CE4-F85A8215D02A}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Inflow_C_Binding", "modules\AeroDyn_Inflow_C_Binding.vfproj", "{DB03A086-3362-41E5-930A-B151D137ACCF}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AWAE", "modules\AWAE.vfproj", "{CA8A0366-3C47-439A-8E9A-25BB36E3C10D}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Glue Codes", "Glue Codes", "{D7D6BEC5-A67B-4D15-81F9-D846A7041C5D}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST", "glue-codes\OpenFAST.vfproj", "{6E5137FC-19EB-4A7F-AAE8-523AAF95A861}" + ProjectSection(ProjectDependencies) = postProject + {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {6906E75C-2A54-431B-A11D-145864FCDD5C} = {6906E75C-2A54-431B-A11D-145864FCDD5C} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} = {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST.Farm", "glue-codes\FAST.Farm.vfproj", "{4A398285-E3C7-4CD9-8F43-51A017D5A48A}" ProjectSection(ProjectDependencies) = postProject {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} @@ -379,12 +468,16 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST", "OpenFAST.vfproj {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} = {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} EndProjectSection @@ -405,18 +498,18 @@ Global {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.Build.0 = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x86.ActiveCfg = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x86.Build.0 = Debug|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.ActiveCfg = Debug-Double|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.Build.0 = Debug-Double|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x86.ActiveCfg = Debug-Double|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x86.Build.0 = Debug-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.Build.0 = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x86.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x86.Build.0 = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.ActiveCfg = Release|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.Build.0 = Release|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x86.ActiveCfg = Release|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x86.Build.0 = Release|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.ActiveCfg = Release-Double|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.Build.0 = Release-Double|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x86.ActiveCfg = Release-Double|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x86.Build.0 = Release-Double|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x86.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x86.Build.0 = Release|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.ActiveCfg = Debug|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.Build.0 = Debug|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x86.ActiveCfg = Debug|Win32 @@ -945,22 +1038,118 @@ Global {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x64.Build.0 = Release|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x86.ActiveCfg = Release|Win32 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x86.Build.0 = Release|Win32 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug|x64.ActiveCfg = Debug|x64 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug|x64.Build.0 = Debug|x64 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug|x86.ActiveCfg = Debug|Win32 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug|x86.Build.0 = Debug|Win32 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug-Double|x64.ActiveCfg = Debug|x64 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug-Double|x64.Build.0 = Debug|x64 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Debug-Double|x86.Build.0 = Debug|Win32 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release|x64.ActiveCfg = Release|x64 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release|x64.Build.0 = Release|x64 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release|x86.ActiveCfg = Release|Win32 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release|x86.Build.0 = Release|Win32 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release-Double|x64.ActiveCfg = Release|x64 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release-Double|x64.Build.0 = Release|x64 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release-Double|x86.ActiveCfg = Release|Win32 - {5761312F-64A3-4EC4-958F-3302AAA830AC}.Release-Double|x86.Build.0 = Release|Win32 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x64.ActiveCfg = Debug|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x64.Build.0 = Debug|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x86.ActiveCfg = Debug|Win32 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x86.Build.0 = Debug|Win32 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x64.ActiveCfg = Debug|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x64.Build.0 = Debug|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x86.Build.0 = Debug|Win32 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x64.ActiveCfg = Release|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x64.Build.0 = Release|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x86.ActiveCfg = Release|Win32 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x86.Build.0 = Release|Win32 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x64.ActiveCfg = Release|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x64.Build.0 = Release|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x86.ActiveCfg = Release|Win32 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x86.Build.0 = Release|Win32 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x64.ActiveCfg = Debug|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x64.Build.0 = Debug|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x86.ActiveCfg = Debug|Win32 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x86.Build.0 = Debug|Win32 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x64.ActiveCfg = Debug|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x64.Build.0 = Debug|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x86.Build.0 = Debug|Win32 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x64.ActiveCfg = Release|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x64.Build.0 = Release|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x86.ActiveCfg = Release|Win32 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x86.Build.0 = Release|Win32 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x64.ActiveCfg = Release|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x64.Build.0 = Release|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x86.ActiveCfg = Release|Win32 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x86.Build.0 = Release|Win32 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x64.ActiveCfg = Debug|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x64.Build.0 = Debug|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x86.ActiveCfg = Debug|Win32 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x86.Build.0 = Debug|Win32 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x64.ActiveCfg = Debug|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x64.Build.0 = Debug|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x86.Build.0 = Debug|Win32 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x64.ActiveCfg = Release|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x64.Build.0 = Release|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x86.ActiveCfg = Release|Win32 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x86.Build.0 = Release|Win32 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x64.ActiveCfg = Release|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x64.Build.0 = Release|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x86.ActiveCfg = Release|Win32 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x86.Build.0 = Release|Win32 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x64.ActiveCfg = Debug|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x64.Build.0 = Debug|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x86.ActiveCfg = Debug|Win32 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x86.Build.0 = Debug|Win32 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x64.ActiveCfg = Debug|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x64.Build.0 = Debug|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x86.ActiveCfg = Debug|Win32 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x86.Build.0 = Debug|Win32 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x64.ActiveCfg = Release|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x64.Build.0 = Release|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x86.ActiveCfg = Release|Win32 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x86.Build.0 = Release|Win32 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x64.ActiveCfg = Release|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x64.Build.0 = Release|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x86.ActiveCfg = Release|Win32 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x86.Build.0 = Release|Win32 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x64.ActiveCfg = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x64.Build.0 = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x86.ActiveCfg = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x86.Build.0 = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x64.ActiveCfg = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x64.Build.0 = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x86.ActiveCfg = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x86.Build.0 = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x64.ActiveCfg = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x64.Build.0 = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x86.ActiveCfg = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x86.Build.0 = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x64.ActiveCfg = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x64.Build.0 = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x86.ActiveCfg = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x86.Build.0 = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x64.ActiveCfg = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x64.Build.0 = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x86.ActiveCfg = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x86.Build.0 = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x64.ActiveCfg = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x64.Build.0 = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x86.ActiveCfg = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x86.Build.0 = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x64.ActiveCfg = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x64.Build.0 = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x86.ActiveCfg = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x86.Build.0 = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x64.ActiveCfg = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x64.Build.0 = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x86.ActiveCfg = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x86.Build.0 = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x64.ActiveCfg = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x64.Build.0 = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x86.ActiveCfg = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x86.Build.0 = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x64.ActiveCfg = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x64.Build.0 = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x86.ActiveCfg = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x86.Build.0 = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.ActiveCfg = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.Build.0 = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x86.ActiveCfg = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x86.Build.0 = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x64.ActiveCfg = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x64.Build.0 = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x86.ActiveCfg = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x86.Build.0 = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -994,11 +1183,19 @@ Global {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {272B8080-A022-4F4A-BDD6-835871E44C23} {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {272B8080-A022-4F4A-BDD6-835871E44C23} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE} = {272B8080-A022-4F4A-BDD6-835871E44C23} {029204DD-3D5B-47C6-8CAA-A933886D4674} = {272B8080-A022-4F4A-BDD6-835871E44C23} {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {272B8080-A022-4F4A-BDD6-835871E44C23} {774BDC53-33C4-4926-B01D-DC376DAE055B} = {272B8080-A022-4F4A-BDD6-835871E44C23} {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {272B8080-A022-4F4A-BDD6-835871E44C23} {6906E75C-2A54-431B-A11D-145864FCDD5C} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {DB03A086-3362-41E5-930A-B151D137ACCF} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861} = {D7D6BEC5-A67B-4D15-81F9-D846A7041C5D} + {4A398285-E3C7-4CD9-8F43-51A017D5A48A} = {D7D6BEC5-A67B-4D15-81F9-D846A7041C5D} EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {B362252D-3254-4C68-B527-CC85CE3CCF75} diff --git a/vs-build-ifx/RunRegistry.bat b/vs-build-ifx/RunRegistry.bat new file mode 100644 index 0000000000..8a65be2a5d --- /dev/null +++ b/vs-build-ifx/RunRegistry.bat @@ -0,0 +1,365 @@ +@ECHO OFF + +set lines======================================================================= +echo %lines% +IF "%1"=="" ( +ECHO. +ECHO The calling syntax for this script is +ECHO RunRegistry ModuleName [FAST_Root_Loc] +ECHO. +GOTO Done +) + + +REM ---------------------------------------------------------------------------- +REM ------------------------- LOCAL PATHS -------------------------------------- +REM ---------------------------------------------------------------------------- +REM -- USERS MAY EDIT THESE PATHS TO POINT TO FOLDERS ON THEIR LOCAL MACHINES. - +REM -- NOTE: do not use quotation marks around the path names!!!! -------------- +REM ---------------------------------------------------------------------------- +REM ---------------------------------------------------------------------------- +SET Root_Loc=..\.. +IF not "%2"=="" SET Root_Loc=%2 + +SET Modules_Loc=%Root_Loc%\modules +SET Registry=..\..\build\bin\Registry.exe +SET FAST_Loc=%Modules_Loc%\openfast-library\src +SET ED_Loc=%Modules_Loc%\elastodyn\src +SET SED_Loc=%Modules_Loc%\simple-elastodyn\src +SET IfW_Loc=%Modules_Loc%\inflowwind\src +SET HD_Loc=%Modules_Loc%\hydrodyn\src +SET SEAST_Loc=%Modules_Loc%\seastate\src +SET SD_Loc=%Modules_Loc%\subdyn\src +SET MAP_Loc=%Modules_Loc%\map\src +SET FEAM_Loc=%Modules_Loc%\feamooring\src +SET IceF_Loc=%Modules_Loc%\icefloe\src\interfaces\FAST +SET IceD_Loc=%Modules_Loc%\icedyn\src +SET MD_Loc=%Modules_Loc%\moordyn\src +SET ExtInfw_Loc=%Modules_Loc%\externalinflow\src +SET ExtLoads_Loc=%Modules_Loc%\extloads\src +SET Orca_Loc=%Modules_Loc%\orcaflex-interface\src +SET NWTC_Lib_Loc=%Modules_Loc%\nwtc-library\src +SET ExtPtfm_Loc=%Modules_Loc%\extptfm\src +SET AD_Loc=%Modules_Loc%\aerodyn\src +SET SrvD_Loc=%Modules_Loc%\servodyn\src +SET BD_Loc=%Modules_Loc%\beamdyn\src +SET SC_Loc=%Modules_Loc%\supercontroller\src +SET ADsk_Loc=%Modules_Loc%\aerodisk\src + +SET LD_Loc=%Modules_Loc%\lindyn\src + +SET AWAE_Loc=%Modules_Loc%\awae\src +SET WD_Loc=%Modules_Loc%\wakedynamics\src +SET Farm_Loc=%Root_Loc%\glue-codes\fast-farm\src + +SET ALL_FAST_Includes=-I "%FAST_Loc%" -I "%NWTC_Lib_Loc%" -I "%ED_Loc%" -I "%SED_Loc%" -I^ + "%SrvD_Loc%" -I "%AD_Loc%" -I "%ADsk_Loc%" -I "%BD_Loc%" -I "%SC_Loc%" -I^ + "%IfW_Loc%" -I "%SD_Loc%" -I "%HD_Loc%" -I "%SEAST_Loc%" -I "%MAP_Loc%" -I "%FEAM_Loc%" -I^ + "%IceF_Loc%" -I "%IceD_Loc%" -I "%MD_Loc%" -I "%ExtInfw_Loc%" -I "%Orca_Loc%" -I "%ExtPtfm_Loc%" -I "%ExtLoads_Loc%" + + +SET ModuleName=%1 + +GOTO %ModuleName% + +REM ---------------------------------------------------------------------------- +REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- +REM ---------------------------------------------------------------------------- +:NWTC_Lib +SET CURR_LOC=%NWTC_Lib_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_NWTC_Library_base.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:MAP +SET CURR_LOC=%MAP_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -ccode -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +:: %REGISTRY% "%CURR_LOC%\MAP_Fortran_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:MAP_Fortran +SET CURR_LOC=%MAP_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:FAST +SET CURR_LOC=%FAST_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FAST_Registry.txt" %ALL_FAST_Includes% -noextrap -O "%Output_Loc%" +GOTO checkError + +:BeamDyn +SET CURR_LOC=%BD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_BeamDyn.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:SuperController +SET CURR_LOC=%SC_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\SuperController_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -ccode +GOTO checkError + +:SCDataEx: +SET CURR_LOC=%SC_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\SC_DataEx_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -ccode -noextrap +GOTO checkError + + +:ElastoDyn +SET CURR_LOC=%ED_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:SimpleElastoDyn +SET CURR_LOC=%SED_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\SED_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:StrucCtrl +:ServoDyn +SET CURR_LOC=%SrvD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:Lidar +:InflowWind +SET CURR_LOC=%IfW_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:IfW_FlowField +:InflowWind_IO +SET CURR_LOC=%IfW_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -noextrap -O "%Output_Loc%" +GOTO checkError + +:ExternalInflow +SET CURR_LOC=%ExtInfw_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -ccode -O "%Output_Loc%" +GOTO checkError + +:ExtLoads +SET CURR_LOC=%ExtLoads_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -I "%IfW_Loc%" -O "%Output_Loc%" +GOTO checkError + +:ExtLoadsDX +SET CURR_LOC=%ExtLoads_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -ccode -O "%Output_Loc%" +GOTO checkError + +:AeroDyn +:BEMT +:DBEMT +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:AeroDyn_Driver +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroDyn_Driver_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:ADI +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroDyn_Inflow_Registry.txt" -I "%NWTC_Lib_Loc%" -I %IfW_Loc% -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + + +:AFI +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AirfoilInfo_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:UA +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\UnsteadyAero_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:LD +SET CURR_LOC=%LD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\LinDyn_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:FVW +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FVW_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:AA +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroAcoustics_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:HydroDyn +:SS_Excitation +:SS_Radiation +:Conv_Radiation +:WAMIT +:WAMIT2 +:Morison +SET CURR_LOC=%HD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -I "%SEAST_Loc%" -O "%Output_Loc%" +GOTO checkError + +:SeaState +:Current +:Waves +:Waves2 +:SeaSt_WaveField + +SET CURR_LOC=%SEAST_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -noextrap -O "%Output_Loc%" +GOTO checkError + +:SubDyn +SET CURR_LOC=%SD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:FEAMooring +SET CURR_LOC=%FEAM_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FEAM_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:MoorDyn +SET CURR_LOC=%MD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:IceFloe +SET CURR_LOC=%IceF_Loc% +SET Output_Loc=%Modules_Loc%\icefloe\src\icefloe +%REGISTRY% "%CURR_LOC%\%ModuleName%_FASTRegistry.inp" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:IceDyn +SET CURR_LOC=%IceD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:OrcaFlexInterface +SET CURR_LOC=%Orca_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:ExtPtfm_MCKF +SET CURR_LOC=%ExtPtfm_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:FarmDriver +SET CURR_LOC=%Farm_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FAST_Farm_Registry.txt" -I %WD_Loc% -I %AWAE_Loc% -I %Farm_Loc% %ALL_FAST_INCLUDES% -noextrap -O "%Output_Loc%" +GOTO checkError + +:FASTWrapper +SET CURR_LOC=%Farm_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FASTWrapper_Registry.txt" -I %NWTC_Lib_Loc% %ALL_FAST_INCLUDES% -noextrap -O "%Output_Loc%" +GOTO checkError + +:WakeDynamics +SET CURR_LOC=%WD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\WakeDynamics_Registry.txt" -I %NWTC_Lib_Loc% -noextrap -O "%Output_Loc%" +GOTO checkError + +:AWAE +SET CURR_LOC=%AWAE_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AWAE_Registry.txt" -I %NWTC_Lib_Loc% -I %IfW_Loc% -noextrap -O "%Output_Loc%" +GOTO checkError + +:AeroDisk +SET CURR_LOC=%ADsk_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroDisk_Registry.txt" -I %NWTC_Lib_Loc% -I %IfW_Loc% -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:Version +DEL "%Root_Loc%\VersionInfo.obj" "%Root_Loc%\versioninfo.mod" +GOTO end + +:checkError +ECHO. +IF %ERRORLEVEL% NEQ 0 ( +ECHO Error running FAST Registry for %ModuleName%. +) ELSE ( +ECHO Registry for %ModuleName% completed. +REM COPY /Y "%ModuleName%_Types.f90" "%CURR_LOC%" +rem IF /I "%ModuleName%"=="MAP" COPY /Y "%ModuleName%_Types.h" "%CURR_LOC%" +) + +:end +REM ---------------------------------------------------------------------------- +REM ------------------------- CLEAR MEMORY ------------------------------------- +REM ---------------------------------------------------------------------------- +ECHO.  + +SET ModuleName= +SET CURR_LOC= + +SET Root_Loc= +SET Output_Loc= + +SET Subs_Loc= +SET FAST_Loc= +SET Registry= + +SET ED_Loc= +SET SED_Loc= +SET BD_Loc= +SET IfW_Loc= +SET HD_Loc= +SET SD_Loc= +SET MAP_Loc= +SET FEAM_Loc= +SET IceF_Loc= +SET IceD_Loc= +SET MD_Loc= +SET ExtInfw_Loc= +SET Orca_Loc= +SET NWTC_Lib_Loc= +SET ExtPtfm_Loc= +SET AD_Loc= +SET ADsk_Loc= +SET SrvD_Loc= + +SET MAP_Loc= +SET ALL_FAST_Includes= + +:Done +echo %lines% +set lines= + +:PathsOnly diff --git a/vs-build-ifx/gitVersionInfo.h b/vs-build-ifx/gitVersionInfo.h new file mode 100644 index 0000000000..d1ed2e7a69 --- /dev/null +++ b/vs-build-ifx/gitVersionInfo.h @@ -0,0 +1 @@ +#define GIT_VERSION_INFO 'v3.5.3-2142-g74d6f665-dirty' diff --git a/vs-build-ifx/glue-codes/FAST.Farm.vfproj b/vs-build-ifx/glue-codes/FAST.Farm.vfproj new file mode 100644 index 0000000000..93aa63c00a --- /dev/null +++ b/vs-build-ifx/glue-codes/FAST.Farm.vfproj @@ -0,0 +1,46 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/glue-codes/OpenFAST.vfproj b/vs-build-ifx/glue-codes/OpenFAST.vfproj new file mode 100644 index 0000000000..7a94a1fdcf --- /dev/null +++ b/vs-build-ifx/glue-codes/OpenFAST.vfproj @@ -0,0 +1,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AWAE.vfproj b/vs-build-ifx/modules/AWAE.vfproj new file mode 100644 index 0000000000..898cdb897e --- /dev/null +++ b/vs-build-ifx/modules/AWAE.vfproj @@ -0,0 +1,41 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDisk.vfproj b/vs-build-ifx/modules/AeroDisk.vfproj index bf6a910224..9c4716765d 100644 --- a/vs-build-ifx/modules/AeroDisk.vfproj +++ b/vs-build-ifx/modules/AeroDisk.vfproj @@ -5,18 +5,8 @@ - - - - - - - - - - - + @@ -25,18 +15,8 @@ - - - - - - - - - - - + @@ -47,13 +27,20 @@ - - + + + + + + + + + + - diff --git a/vs-build-ifx/modules/AeroDyn.vfproj b/vs-build-ifx/modules/AeroDyn.vfproj index 3dfc8b91b9..6dbda0ec3e 100644 --- a/vs-build-ifx/modules/AeroDyn.vfproj +++ b/vs-build-ifx/modules/AeroDyn.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,34 +47,84 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - @@ -82,7 +132,6 @@ - diff --git a/vs-build-ifx/modules/AeroDyn_Driver.vfproj b/vs-build-ifx/modules/AeroDyn_Driver.vfproj new file mode 100644 index 0000000000..a3721981fd --- /dev/null +++ b/vs-build-ifx/modules/AeroDyn_Driver.vfproj @@ -0,0 +1,38 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj b/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj new file mode 100644 index 0000000000..481d7b6288 --- /dev/null +++ b/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj @@ -0,0 +1,46 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDyn_Inflow.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow.vfproj new file mode 100644 index 0000000000..0a0838bf3d --- /dev/null +++ b/vs-build-ifx/modules/AeroDyn_Inflow.vfproj @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/OpenFAST.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj similarity index 67% rename from vs-build-ifx/OpenFAST.vfproj rename to vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj index f572480660..ef666dcecd 100644 --- a/vs-build-ifx/OpenFAST.vfproj +++ b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj @@ -1,13 +1,13 @@ - + - + - + @@ -16,9 +16,9 @@ - - - + + + @@ -27,9 +27,9 @@ - + - + @@ -38,9 +38,9 @@ - - - + + + @@ -51,11 +51,8 @@ - - - - + diff --git a/vs-build-ifx/modules/BeamDyn.vfproj b/vs-build-ifx/modules/BeamDyn.vfproj index 6617dacc23..8035e50105 100644 --- a/vs-build-ifx/modules/BeamDyn.vfproj +++ b/vs-build-ifx/modules/BeamDyn.vfproj @@ -1,22 +1,11 @@ - - - - - - - - - - - - + @@ -25,18 +14,8 @@ - - - - - - - - - - - + @@ -47,15 +26,22 @@ - - + + + + + + + + + + - diff --git a/vs-build-ifx/modules/BeamDyn_Driver.vfproj b/vs-build-ifx/modules/BeamDyn_Driver.vfproj index 399c94dc3f..065d0ab4e5 100644 --- a/vs-build-ifx/modules/BeamDyn_Driver.vfproj +++ b/vs-build-ifx/modules/BeamDyn_Driver.vfproj @@ -1,23 +1,11 @@ - - - - - - - - - - - - - + @@ -27,19 +15,8 @@ - - - - - - - - - - - - + @@ -51,8 +28,7 @@ - - + diff --git a/vs-build-ifx/modules/ElastoDyn.vfproj b/vs-build-ifx/modules/ElastoDyn.vfproj index 39507e1101..e686002eb4 100644 --- a/vs-build-ifx/modules/ElastoDyn.vfproj +++ b/vs-build-ifx/modules/ElastoDyn.vfproj @@ -1,22 +1,11 @@ - - - - - - - - - - - - + @@ -25,18 +14,8 @@ - - - - - - - - - - - + @@ -47,14 +26,21 @@ - - + + + + + + + + + + - diff --git a/vs-build-ifx/modules/ExtLoads.vfproj b/vs-build-ifx/modules/ExtLoads.vfproj index 3aa5d623e7..6ffa65cbbe 100644 --- a/vs-build-ifx/modules/ExtLoads.vfproj +++ b/vs-build-ifx/modules/ExtLoads.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,11 +47,9 @@ - - + - - + diff --git a/vs-build-ifx/modules/ExtLoads_Types.vfproj b/vs-build-ifx/modules/ExtLoads_Types.vfproj index ba6305d1da..b4cbe3d18d 100644 --- a/vs-build-ifx/modules/ExtLoads_Types.vfproj +++ b/vs-build-ifx/modules/ExtLoads_Types.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/ExtPtfm.vfproj b/vs-build-ifx/modules/ExtPtfm.vfproj index 785a75a8b3..4978519487 100644 --- a/vs-build-ifx/modules/ExtPtfm.vfproj +++ b/vs-build-ifx/modules/ExtPtfm.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/ExternalInflow.vfproj b/vs-build-ifx/modules/ExternalInflow.vfproj index 32098e0081..44173ffc86 100644 --- a/vs-build-ifx/modules/ExternalInflow.vfproj +++ b/vs-build-ifx/modules/ExternalInflow.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,11 +47,9 @@ - - + - - + diff --git a/vs-build-ifx/modules/ExternalInflow_Types.vfproj b/vs-build-ifx/modules/ExternalInflow_Types.vfproj index edf8f64877..30b11235f1 100644 --- a/vs-build-ifx/modules/ExternalInflow_Types.vfproj +++ b/vs-build-ifx/modules/ExternalInflow_Types.vfproj @@ -5,18 +5,8 @@ - - - - - - - - - - - + @@ -25,18 +15,8 @@ - - - - - - - - - - - + @@ -47,11 +27,13 @@ - - - + + + + + diff --git a/vs-build-ifx/modules/FEAMooring.vfproj b/vs-build-ifx/modules/FEAMooring.vfproj index c86d007da1..0b48d4afd0 100644 --- a/vs-build-ifx/modules/FEAMooring.vfproj +++ b/vs-build-ifx/modules/FEAMooring.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/HydroDyn.vfproj b/vs-build-ifx/modules/HydroDyn.vfproj index 935917d17f..e4f280058b 100644 --- a/vs-build-ifx/modules/HydroDyn.vfproj +++ b/vs-build-ifx/modules/HydroDyn.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,16 +47,14 @@ - - + - - + diff --git a/vs-build-ifx/modules/IceDyn.vfproj b/vs-build-ifx/modules/IceDyn.vfproj index 7ea62ead8b..e7bc0b14e6 100644 --- a/vs-build-ifx/modules/IceDyn.vfproj +++ b/vs-build-ifx/modules/IceDyn.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,11 +47,9 @@ - - + - - + diff --git a/vs-build-ifx/modules/IceFloe.vfproj b/vs-build-ifx/modules/IceFloe.vfproj index b58d200e5b..524f5a99e1 100644 --- a/vs-build-ifx/modules/IceFloe.vfproj +++ b/vs-build-ifx/modules/IceFloe.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + @@ -56,13 +55,10 @@ - - + - - - - + + diff --git a/vs-build-ifx/modules/InflowWind.vfproj b/vs-build-ifx/modules/InflowWind.vfproj index 570dfa7610..646490dfd8 100644 --- a/vs-build-ifx/modules/InflowWind.vfproj +++ b/vs-build-ifx/modules/InflowWind.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,22 +47,50 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - diff --git a/vs-build-ifx/modules/LinDyn.vfproj b/vs-build-ifx/modules/LinDyn.vfproj index 173ed80042..6f0e9a5044 100644 --- a/vs-build-ifx/modules/LinDyn.vfproj +++ b/vs-build-ifx/modules/LinDyn.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/MAP-C.vcxproj b/vs-build-ifx/modules/MAP-C.vcxproj index 49b1da2d87..99a2a7a4c0 100644 --- a/vs-build-ifx/modules/MAP-C.vcxproj +++ b/vs-build-ifx/modules/MAP-C.vcxproj @@ -165,6 +165,7 @@ true NotUsing pch.h + true @@ -182,6 +183,7 @@ true NotUsing pch.h + true diff --git a/vs-build-ifx/modules/MAP.vfproj b/vs-build-ifx/modules/MAP.vfproj index bdb0827618..58a4084090 100644 --- a/vs-build-ifx/modules/MAP.vfproj +++ b/vs-build-ifx/modules/MAP.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,12 +47,10 @@ - - + - - + diff --git a/vs-build-ifx/modules/MoorDyn.vfproj b/vs-build-ifx/modules/MoorDyn.vfproj index 3f08fcd2df..dd53b296f6 100644 --- a/vs-build-ifx/modules/MoorDyn.vfproj +++ b/vs-build-ifx/modules/MoorDyn.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,14 +47,12 @@ - - + - - + diff --git a/vs-build-ifx/modules/MoorDyn_Driver.vfproj b/vs-build-ifx/modules/MoorDyn_Driver.vfproj index cc950ee7e8..39b5b58874 100644 --- a/vs-build-ifx/modules/MoorDyn_Driver.vfproj +++ b/vs-build-ifx/modules/MoorDyn_Driver.vfproj @@ -17,7 +17,7 @@ - + @@ -39,7 +39,7 @@ - + @@ -52,7 +52,6 @@ - diff --git a/vs-build-ifx/modules/NWTC-Library.vfproj b/vs-build-ifx/modules/NWTC-Library.vfproj index 94114323c1..c11feceb3b 100644 --- a/vs-build-ifx/modules/NWTC-Library.vfproj +++ b/vs-build-ifx/modules/NWTC-Library.vfproj @@ -5,7 +5,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -48,7 +48,6 @@ - diff --git a/vs-build-ifx/modules/OpenFAST-Library.vfproj b/vs-build-ifx/modules/OpenFAST-Library.vfproj index 4c9ccfe33e..a8a5d88a6b 100644 --- a/vs-build-ifx/modules/OpenFAST-Library.vfproj +++ b/vs-build-ifx/modules/OpenFAST-Library.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -48,10 +48,8 @@ - - + - diff --git a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj index 95260beec6..baf9a50aea 100644 --- a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj +++ b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/OrcaFlex.vfproj b/vs-build-ifx/modules/OrcaFlex.vfproj index bcd86523e6..85b3b2a2d3 100644 --- a/vs-build-ifx/modules/OrcaFlex.vfproj +++ b/vs-build-ifx/modules/OrcaFlex.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/Registry.vcxproj b/vs-build-ifx/modules/Registry.vcxproj index cf6ea10d1e..14e5a5ab44 100644 --- a/vs-build-ifx/modules/Registry.vcxproj +++ b/vs-build-ifx/modules/Registry.vcxproj @@ -1,14 +1,6 @@ - - Debug-Double - x64 - - - Release-Double - x64 - Debug x64 @@ -62,12 +54,6 @@ v143 Unicode - - Application - true - v143 - Unicode - Application false @@ -78,9 +64,6 @@ v143 - - v143 - @@ -98,9 +81,6 @@ - - - @@ -109,36 +89,17 @@ ..\..\build\bin ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ - - ..\..\build\bin - ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ - ..\..\build\bin ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ - - ..\..\build\bin - ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ - Level3 true _DEBUG;_CONSOLE;%(PreprocessorDefinitions) true - - - Console - true - - - - - Level3 - true - _DEBUG;_CONSOLE;%(PreprocessorDefinitions) - true + true Console @@ -153,6 +114,7 @@ true NDEBUG;_CONSOLE;%(PreprocessorDefinitions) true + true Console diff --git a/vs-build-ifx/modules/SeaState.vfproj b/vs-build-ifx/modules/SeaState.vfproj index 3a3866d84e..515602e456 100644 --- a/vs-build-ifx/modules/SeaState.vfproj +++ b/vs-build-ifx/modules/SeaState.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/ServoDyn.vfproj b/vs-build-ifx/modules/ServoDyn.vfproj index 8f858427d4..c4ea34c5e3 100644 --- a/vs-build-ifx/modules/ServoDyn.vfproj +++ b/vs-build-ifx/modules/ServoDyn.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + @@ -58,8 +57,7 @@ - - + diff --git a/vs-build-ifx/modules/SimpleElastoDyn.vfproj b/vs-build-ifx/modules/SimpleElastoDyn.vfproj index 95a063fdfb..5530b75529 100644 --- a/vs-build-ifx/modules/SimpleElastoDyn.vfproj +++ b/vs-build-ifx/modules/SimpleElastoDyn.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/SubDyn.vfproj b/vs-build-ifx/modules/SubDyn.vfproj index dc50308160..09c2be757d 100644 --- a/vs-build-ifx/modules/SubDyn.vfproj +++ b/vs-build-ifx/modules/SubDyn.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + diff --git a/vs-build-ifx/modules/SuperController.vfproj b/vs-build-ifx/modules/SuperController.vfproj index 1bd0f87697..e63fc6283b 100644 --- a/vs-build-ifx/modules/SuperController.vfproj +++ b/vs-build-ifx/modules/SuperController.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,13 +47,11 @@ - - + - - + diff --git a/vs-build-ifx/modules/SuperController_Types.vfproj b/vs-build-ifx/modules/SuperController_Types.vfproj index 572bb78c85..25348d02ae 100644 --- a/vs-build-ifx/modules/SuperController_Types.vfproj +++ b/vs-build-ifx/modules/SuperController_Types.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -51,12 +51,10 @@ - - - + diff --git a/vs-build-ifx/modules/TurbSim.vfproj b/vs-build-ifx/modules/TurbSim.vfproj index 47277c8cfe..bc9fca18ec 100644 --- a/vs-build-ifx/modules/TurbSim.vfproj +++ b/vs-build-ifx/modules/TurbSim.vfproj @@ -52,7 +52,7 @@ - + diff --git a/vs-build-ifx/modules/VersionInfo.vfproj b/vs-build-ifx/modules/VersionInfo.vfproj index c6557daea3..bc91c8950d 100644 --- a/vs-build-ifx/modules/VersionInfo.vfproj +++ b/vs-build-ifx/modules/VersionInfo.vfproj @@ -1,54 +1,32 @@ - - - - - - - - - - - - + - - - - - - - - - - - + - + - + - - + diff --git a/vs-build-ifx/modules/WakeDynamics.vfproj b/vs-build-ifx/modules/WakeDynamics.vfproj index 141734324b..758d497c31 100644 --- a/vs-build-ifx/modules/WakeDynamics.vfproj +++ b/vs-build-ifx/modules/WakeDynamics.vfproj @@ -16,7 +16,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,8 +47,7 @@ - - + From 4adeb57308328dafe62394a6117cbb8d4ead3ed2 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 18 Nov 2024 12:16:09 -0500 Subject: [PATCH 286/319] Updating VS projects --- vs-build-ifx/.gitignore | 3 +- vs-build-ifx/OpenFAST.sln | 356 ------------------ vs-build-ifx/configurations.xml | 85 +++++ vs-build-ifx/gitVersionInfo.h | 1 - .../modules/AeroDyn_Inflow_C_Binding.vfproj | 22 -- vs-build-ifx/modules/ExtLoads_Types.vfproj | 33 +- vs-build-ifx/modules/ExtPtfm.vfproj | 28 +- vs-build-ifx/modules/ExternalInflow.vfproj | 20 - vs-build-ifx/modules/FEAMooring.vfproj | 28 +- vs-build-ifx/modules/HydroDyn.vfproj | 58 +-- vs-build-ifx/modules/IceDyn.vfproj | 28 +- vs-build-ifx/modules/IceFloe.vfproj | 28 +- vs-build-ifx/modules/LinDyn.vfproj | 58 --- vs-build-ifx/modules/MAP-C.vcxproj | 8 +- vs-build-ifx/modules/MAP.vfproj | 28 +- vs-build-ifx/modules/MoorDyn.vfproj | 31 +- vs-build-ifx/modules/NWTC-Library.vfproj | 16 +- vs-build-ifx/modules/OpenFAST-Prelib.vfproj | 9 +- vs-build-ifx/modules/Registry.vcxproj | 12 +- vs-build-ifx/update-vfproj.py | 16 + 20 files changed, 209 insertions(+), 659 deletions(-) create mode 100644 vs-build-ifx/configurations.xml delete mode 100644 vs-build-ifx/gitVersionInfo.h delete mode 100644 vs-build-ifx/modules/LinDyn.vfproj create mode 100644 vs-build-ifx/update-vfproj.py diff --git a/vs-build-ifx/.gitignore b/vs-build-ifx/.gitignore index dc70644a4d..5253e137da 100644 --- a/vs-build-ifx/.gitignore +++ b/vs-build-ifx/.gitignore @@ -1,3 +1,4 @@ .vs *.user -*.u2d \ No newline at end of file +*.u2d +gitVersionInfo.h \ No newline at end of file diff --git a/vs-build-ifx/OpenFAST.sln b/vs-build-ifx/OpenFAST.sln index 82e28fff9c..02bda342a0 100644 --- a/vs-build-ifx/OpenFAST.sln +++ b/vs-build-ifx/OpenFAST.sln @@ -56,7 +56,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ElastoDyn", "modules\Elasto EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExternalInflow", "modules\ExternalInflow.vfproj", "{B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}" ProjectSection(ProjectDependencies) = postProject - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} @@ -86,7 +85,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExternalInflow", "modules\E EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads", "modules\ExtLoads.vfproj", "{AD8D7798-F800-4C73-B896-7E48EF1D52D3}" ProjectSection(ProjectDependencies) = postProject - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} @@ -156,13 +154,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "IceFloe", "modules\IceFloe. {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "LinDyn", "modules\LinDyn.vfproj", "{07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}" - ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} - EndProjectSection -EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MAP", "modules\MAP.vfproj", "{5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}" ProjectSection(ProjectDependencies) = postProject {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} @@ -217,7 +208,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SubDyn", "modules\SubDyn.vf EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController", "modules\SuperController.vfproj", "{7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}" ProjectSection(ProjectDependencies) = postProject - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} @@ -248,7 +238,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController", "modules\ EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Prelib", "modules\OpenFAST-Prelib.vfproj", "{FE80CE9A-7E16-476D-B63A-F9F870ACB662}" ProjectSection(ProjectDependencies) = postProject - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} @@ -299,7 +288,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads_Types", "modules\E EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController_Types", "modules\SuperController_Types.vfproj", "{2542E42E-CF7F-48F3-8621-6BCFC61102BF}" ProjectSection(ProjectDependencies) = postProject - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} @@ -329,7 +317,6 @@ EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Library", "modules\OpenFAST-Library.vfproj", "{6906E75C-2A54-431B-A11D-145864FCDD5C}" ProjectSection(ProjectDependencies) = postProject {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} @@ -410,7 +397,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Glue Codes", "Glue Codes", EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST", "glue-codes\OpenFAST.vfproj", "{6E5137FC-19EB-4A7F-AAE8-523AAF95A861}" ProjectSection(ProjectDependencies) = postProject - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} @@ -447,7 +433,6 @@ EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST.Farm", "glue-codes\FAST.Farm.vfproj", "{4A398285-E3C7-4CD9-8F43-51A017D5A48A}" ProjectSection(ProjectDependencies) = postProject {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} @@ -485,671 +470,331 @@ EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|x64 = Debug|x64 - Debug|x86 = Debug|x86 Debug-Double|x64 = Debug-Double|x64 - Debug-Double|x86 = Debug-Double|x86 Release|x64 = Release|x64 - Release|x86 = Release|x86 Release-Double|x64 = Release-Double|x64 - Release-Double|x86 = Release-Double|x86 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.ActiveCfg = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.Build.0 = Debug|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x86.ActiveCfg = Debug|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x86.Build.0 = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.ActiveCfg = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.Build.0 = Debug|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x86.ActiveCfg = Debug|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x86.Build.0 = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.ActiveCfg = Release|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.Build.0 = Release|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x86.ActiveCfg = Release|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x86.Build.0 = Release|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.ActiveCfg = Release|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.Build.0 = Release|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x86.ActiveCfg = Release|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x86.Build.0 = Release|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.ActiveCfg = Debug|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.Build.0 = Debug|x64 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x86.ActiveCfg = Debug|Win32 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x86.Build.0 = Debug|Win32 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x64.ActiveCfg = Debug|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x64.Build.0 = Debug|x64 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x86.Build.0 = Debug|Win32 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x64.ActiveCfg = Release|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x64.Build.0 = Release|x64 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x86.ActiveCfg = Release|Win32 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x86.Build.0 = Release|Win32 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x64.ActiveCfg = Release|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x64.Build.0 = Release|x64 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x86.ActiveCfg = Release|Win32 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x86.Build.0 = Release|Win32 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x64.ActiveCfg = Debug|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x64.Build.0 = Debug|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x86.ActiveCfg = Debug|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x86.Build.0 = Debug|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x64.ActiveCfg = Debug-Double|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x64.Build.0 = Debug-Double|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x86.ActiveCfg = Debug-Double|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x86.Build.0 = Debug-Double|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x64.ActiveCfg = Release|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x64.Build.0 = Release|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x86.ActiveCfg = Release|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x86.Build.0 = Release|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x64.ActiveCfg = Release-Double|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x64.Build.0 = Release-Double|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x86.ActiveCfg = Release-Double|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x86.Build.0 = Release-Double|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x64.ActiveCfg = Debug|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x64.Build.0 = Debug|x64 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x86.ActiveCfg = Debug|Win32 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x86.Build.0 = Debug|Win32 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x64.ActiveCfg = Debug|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x64.Build.0 = Debug|x64 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x86.Build.0 = Debug|Win32 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x64.ActiveCfg = Release|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x64.Build.0 = Release|x64 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x86.ActiveCfg = Release|Win32 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x86.Build.0 = Release|Win32 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x64.ActiveCfg = Release|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x64.Build.0 = Release|x64 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x86.ActiveCfg = Release|Win32 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x86.Build.0 = Release|Win32 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x64.ActiveCfg = Debug|x64 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x64.Build.0 = Debug|x64 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x86.ActiveCfg = Debug|Win32 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x86.Build.0 = Debug|Win32 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x64.ActiveCfg = Debug|x64 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x64.Build.0 = Debug|x64 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x86.Build.0 = Debug|Win32 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x64.ActiveCfg = Release|x64 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x64.Build.0 = Release|x64 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x86.ActiveCfg = Release|Win32 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x86.Build.0 = Release|Win32 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x64.ActiveCfg = Release|x64 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x64.Build.0 = Release|x64 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x86.ActiveCfg = Release|Win32 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x86.Build.0 = Release|Win32 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x64.ActiveCfg = Debug|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x64.Build.0 = Debug|x64 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x86.ActiveCfg = Debug|Win32 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x86.Build.0 = Debug|Win32 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x64.ActiveCfg = Debug|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x64.Build.0 = Debug|x64 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x86.Build.0 = Debug|Win32 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.ActiveCfg = Release|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.Build.0 = Release|x64 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x86.ActiveCfg = Release|Win32 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x86.Build.0 = Release|Win32 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x64.ActiveCfg = Release|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x64.Build.0 = Release|x64 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x86.ActiveCfg = Release|Win32 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x86.Build.0 = Release|Win32 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.ActiveCfg = Debug|x64 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.Build.0 = Debug|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x86.ActiveCfg = Debug|Win32 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x86.Build.0 = Debug|Win32 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x64.ActiveCfg = Debug|x64 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x64.Build.0 = Debug|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x86.Build.0 = Debug|Win32 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.ActiveCfg = Release|x64 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.Build.0 = Release|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x86.ActiveCfg = Release|Win32 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x86.Build.0 = Release|Win32 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x64.ActiveCfg = Release|x64 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x64.Build.0 = Release|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x86.ActiveCfg = Release|Win32 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x86.Build.0 = Release|Win32 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x64.ActiveCfg = Debug|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x64.Build.0 = Debug|x64 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x86.ActiveCfg = Debug|Win32 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x86.Build.0 = Debug|Win32 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x64.ActiveCfg = Debug|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x64.Build.0 = Debug|x64 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x86.Build.0 = Debug|Win32 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x64.ActiveCfg = Release|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x64.Build.0 = Release|x64 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x86.ActiveCfg = Release|Win32 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x86.Build.0 = Release|Win32 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x64.ActiveCfg = Release|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x64.Build.0 = Release|x64 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x86.ActiveCfg = Release|Win32 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x86.Build.0 = Release|Win32 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x64.ActiveCfg = Debug|x64 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x64.Build.0 = Debug|x64 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x86.ActiveCfg = Debug|Win32 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x86.Build.0 = Debug|Win32 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x64.ActiveCfg = Debug|x64 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x64.Build.0 = Debug|x64 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x86.Build.0 = Debug|Win32 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x64.ActiveCfg = Release|x64 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x64.Build.0 = Release|x64 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x86.ActiveCfg = Release|Win32 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x86.Build.0 = Release|Win32 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x64.ActiveCfg = Release|x64 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x64.Build.0 = Release|x64 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x86.ActiveCfg = Release|Win32 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x86.Build.0 = Release|Win32 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x64.ActiveCfg = Debug|x64 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x64.Build.0 = Debug|x64 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x86.ActiveCfg = Debug|Win32 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x86.Build.0 = Debug|Win32 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x64.ActiveCfg = Debug|x64 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x64.Build.0 = Debug|x64 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x86.Build.0 = Debug|Win32 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x64.ActiveCfg = Release|x64 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x64.Build.0 = Release|x64 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x86.ActiveCfg = Release|Win32 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x86.Build.0 = Release|Win32 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x64.ActiveCfg = Release|x64 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x64.Build.0 = Release|x64 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x86.ActiveCfg = Release|Win32 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x86.Build.0 = Release|Win32 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x64.ActiveCfg = Debug|x64 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x64.Build.0 = Debug|x64 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x86.ActiveCfg = Debug|Win32 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x86.Build.0 = Debug|Win32 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x64.ActiveCfg = Debug|x64 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x64.Build.0 = Debug|x64 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x86.Build.0 = Debug|Win32 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x64.ActiveCfg = Release|x64 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x64.Build.0 = Release|x64 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x86.ActiveCfg = Release|Win32 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x86.Build.0 = Release|Win32 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x64.ActiveCfg = Release|x64 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x64.Build.0 = Release|x64 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x86.ActiveCfg = Release|Win32 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x86.Build.0 = Release|Win32 {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x64.ActiveCfg = Debug|x64 {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x64.Build.0 = Debug|x64 - {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x86.ActiveCfg = Debug|Win32 - {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x86.Build.0 = Debug|Win32 {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x64.ActiveCfg = Debug|x64 {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x64.Build.0 = Debug|x64 - {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x86.Build.0 = Debug|Win32 {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x64.ActiveCfg = Release|x64 {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x64.Build.0 = Release|x64 - {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x86.ActiveCfg = Release|Win32 - {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x86.Build.0 = Release|Win32 {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x64.ActiveCfg = Release|x64 {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x64.Build.0 = Release|x64 - {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x86.ActiveCfg = Release|Win32 - {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x86.Build.0 = Release|Win32 {676276A1-DC23-4287-8386-07076303C39D}.Debug|x64.ActiveCfg = Debug|x64 {676276A1-DC23-4287-8386-07076303C39D}.Debug|x64.Build.0 = Debug|x64 - {676276A1-DC23-4287-8386-07076303C39D}.Debug|x86.ActiveCfg = Debug|Win32 - {676276A1-DC23-4287-8386-07076303C39D}.Debug|x86.Build.0 = Debug|Win32 {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x64.ActiveCfg = Debug|x64 {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x64.Build.0 = Debug|x64 - {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x86.Build.0 = Debug|Win32 {676276A1-DC23-4287-8386-07076303C39D}.Release|x64.ActiveCfg = Release|x64 {676276A1-DC23-4287-8386-07076303C39D}.Release|x64.Build.0 = Release|x64 - {676276A1-DC23-4287-8386-07076303C39D}.Release|x86.ActiveCfg = Release|Win32 - {676276A1-DC23-4287-8386-07076303C39D}.Release|x86.Build.0 = Release|Win32 {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x64.ActiveCfg = Release|x64 {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x64.Build.0 = Release|x64 - {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x86.ActiveCfg = Release|Win32 - {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x86.Build.0 = Release|Win32 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x64.ActiveCfg = Debug|x64 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x64.Build.0 = Debug|x64 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x86.ActiveCfg = Debug|Win32 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x86.Build.0 = Debug|Win32 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x64.ActiveCfg = Debug|x64 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x64.Build.0 = Debug|x64 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x86.Build.0 = Debug|Win32 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x64.ActiveCfg = Release|x64 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x64.Build.0 = Release|x64 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x86.ActiveCfg = Release|Win32 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x86.Build.0 = Release|Win32 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x64.ActiveCfg = Release|x64 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x64.Build.0 = Release|x64 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x86.ActiveCfg = Release|Win32 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x86.Build.0 = Release|Win32 {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x64.ActiveCfg = Debug|x64 {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x64.Build.0 = Debug|x64 - {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x86.ActiveCfg = Debug|Win32 - {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x86.Build.0 = Debug|Win32 {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x64.ActiveCfg = Debug|x64 {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x64.Build.0 = Debug|x64 - {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x86.Build.0 = Debug|Win32 {951A453F-1999-483D-848A-9B63C282F43D}.Release|x64.ActiveCfg = Release|x64 {951A453F-1999-483D-848A-9B63C282F43D}.Release|x64.Build.0 = Release|x64 - {951A453F-1999-483D-848A-9B63C282F43D}.Release|x86.ActiveCfg = Release|Win32 - {951A453F-1999-483D-848A-9B63C282F43D}.Release|x86.Build.0 = Release|Win32 {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x64.ActiveCfg = Release|x64 {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x64.Build.0 = Release|x64 - {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x86.ActiveCfg = Release|Win32 - {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x86.Build.0 = Release|Win32 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x64.ActiveCfg = Debug|x64 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x64.Build.0 = Debug|x64 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x86.ActiveCfg = Debug|Win32 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x86.Build.0 = Debug|Win32 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x64.ActiveCfg = Debug|x64 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x64.Build.0 = Debug|x64 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x86.Build.0 = Debug|Win32 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x64.ActiveCfg = Release|x64 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x64.Build.0 = Release|x64 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x86.ActiveCfg = Release|Win32 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x86.Build.0 = Release|Win32 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x64.ActiveCfg = Release|x64 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x64.Build.0 = Release|x64 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x86.ActiveCfg = Release|Win32 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x86.Build.0 = Release|Win32 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x64.ActiveCfg = Debug|x64 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x64.Build.0 = Debug|x64 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x86.ActiveCfg = Debug|Win32 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x86.Build.0 = Debug|Win32 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x64.ActiveCfg = Debug|x64 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x64.Build.0 = Debug|x64 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x86.Build.0 = Debug|Win32 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x64.ActiveCfg = Release|x64 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x64.Build.0 = Release|x64 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x86.ActiveCfg = Release|Win32 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x86.Build.0 = Release|Win32 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x64.ActiveCfg = Release|x64 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x64.Build.0 = Release|x64 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x86.ActiveCfg = Release|Win32 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x86.Build.0 = Release|Win32 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug|x64.ActiveCfg = Debug|x64 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug|x64.Build.0 = Debug|x64 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug|x86.ActiveCfg = Debug|Win32 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug|x86.Build.0 = Debug|Win32 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug-Double|x64.ActiveCfg = Debug|x64 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug-Double|x64.Build.0 = Debug|x64 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Debug-Double|x86.Build.0 = Debug|Win32 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release|x64.ActiveCfg = Release|x64 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release|x64.Build.0 = Release|x64 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release|x86.ActiveCfg = Release|Win32 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release|x86.Build.0 = Release|Win32 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release-Double|x64.ActiveCfg = Release|x64 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release-Double|x64.Build.0 = Release|x64 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release-Double|x86.ActiveCfg = Release|Win32 - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC}.Release-Double|x86.Build.0 = Release|Win32 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x64.ActiveCfg = Debug|x64 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x64.Build.0 = Debug|x64 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x86.ActiveCfg = Debug|Win32 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x86.Build.0 = Debug|Win32 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x64.ActiveCfg = Debug|x64 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x64.Build.0 = Debug|x64 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x86.Build.0 = Debug|Win32 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x64.ActiveCfg = Release|x64 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x64.Build.0 = Release|x64 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x86.ActiveCfg = Release|Win32 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x86.Build.0 = Release|Win32 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x64.ActiveCfg = Release|x64 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x64.Build.0 = Release|x64 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x86.ActiveCfg = Release|Win32 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x86.Build.0 = Release|Win32 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x64.ActiveCfg = Debug|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x64.Build.0 = Debug|x64 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x86.ActiveCfg = Debug|Win32 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x86.Build.0 = Debug|Win32 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x64.ActiveCfg = Debug|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x64.Build.0 = Debug|x64 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x86.Build.0 = Debug|Win32 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.ActiveCfg = Release|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.Build.0 = Release|x64 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x86.ActiveCfg = Release|Win32 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x86.Build.0 = Release|Win32 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x64.ActiveCfg = Release|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x64.Build.0 = Release|x64 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x86.ActiveCfg = Release|Win32 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x86.Build.0 = Release|Win32 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.ActiveCfg = Debug|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.Build.0 = Debug|x64 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x86.ActiveCfg = Debug|Win32 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x86.Build.0 = Debug|Win32 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x64.ActiveCfg = Debug|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x64.Build.0 = Debug|x64 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x86.Build.0 = Debug|Win32 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.ActiveCfg = Release|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.Build.0 = Release|x64 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x86.ActiveCfg = Release|Win32 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x86.Build.0 = Release|Win32 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x64.ActiveCfg = Release|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x64.Build.0 = Release|x64 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x86.ActiveCfg = Release|Win32 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x86.Build.0 = Release|Win32 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x64.ActiveCfg = Debug|x64 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x64.Build.0 = Debug|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x86.ActiveCfg = Debug|Win32 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x86.Build.0 = Debug|Win32 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x64.ActiveCfg = Debug|x64 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x64.Build.0 = Debug|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x86.Build.0 = Debug|Win32 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x64.ActiveCfg = Release|x64 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x64.Build.0 = Release|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x86.ActiveCfg = Release|Win32 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x86.Build.0 = Release|Win32 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x64.ActiveCfg = Release|x64 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x64.Build.0 = Release|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x86.ActiveCfg = Release|Win32 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x86.Build.0 = Release|Win32 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x64.ActiveCfg = Debug|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x64.Build.0 = Debug|x64 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x86.ActiveCfg = Debug|Win32 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x86.Build.0 = Debug|Win32 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x64.ActiveCfg = Debug|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x64.Build.0 = Debug|x64 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x86.Build.0 = Debug|Win32 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x64.ActiveCfg = Release|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x64.Build.0 = Release|x64 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x86.ActiveCfg = Release|Win32 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x86.Build.0 = Release|Win32 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x64.ActiveCfg = Release|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x64.Build.0 = Release|x64 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x86.ActiveCfg = Release|Win32 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x86.Build.0 = Release|Win32 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x64.ActiveCfg = Debug|x64 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x64.Build.0 = Debug|x64 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x86.ActiveCfg = Debug|Win32 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x86.Build.0 = Debug|Win32 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x64.ActiveCfg = Debug|x64 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x64.Build.0 = Debug|x64 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x86.Build.0 = Debug|Win32 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x64.ActiveCfg = Release|x64 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x64.Build.0 = Release|x64 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x86.ActiveCfg = Release|Win32 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x86.Build.0 = Release|Win32 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x64.ActiveCfg = Release|x64 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x64.Build.0 = Release|x64 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x86.ActiveCfg = Release|Win32 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x86.Build.0 = Release|Win32 {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x64.ActiveCfg = Debug|x64 {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x64.Build.0 = Debug|x64 - {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x86.ActiveCfg = Debug|Win32 - {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x86.Build.0 = Debug|Win32 {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x64.ActiveCfg = Debug|x64 {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x64.Build.0 = Debug|x64 - {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x86.Build.0 = Debug|Win32 {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x64.ActiveCfg = Release|x64 {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x64.Build.0 = Release|x64 - {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x86.ActiveCfg = Release|Win32 - {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x86.Build.0 = Release|Win32 {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x64.ActiveCfg = Release|x64 {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x64.Build.0 = Release|x64 - {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x86.ActiveCfg = Release|Win32 - {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x86.Build.0 = Release|Win32 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x64.ActiveCfg = Debug|x64 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x64.Build.0 = Debug|x64 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x86.ActiveCfg = Debug|Win32 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x86.Build.0 = Debug|Win32 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x64.ActiveCfg = Debug|x64 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x64.Build.0 = Debug|x64 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x86.Build.0 = Debug|Win32 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x64.ActiveCfg = Release|x64 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x64.Build.0 = Release|x64 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x86.ActiveCfg = Release|Win32 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x86.Build.0 = Release|Win32 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x64.ActiveCfg = Release|x64 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x64.Build.0 = Release|x64 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x86.ActiveCfg = Release|Win32 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x86.Build.0 = Release|Win32 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x64.ActiveCfg = Debug|x64 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x64.Build.0 = Debug|x64 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x86.ActiveCfg = Debug|Win32 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x86.Build.0 = Debug|Win32 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x64.ActiveCfg = Debug|x64 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x64.Build.0 = Debug|x64 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x86.Build.0 = Debug|Win32 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x64.ActiveCfg = Release|x64 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x64.Build.0 = Release|x64 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x86.ActiveCfg = Release|Win32 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x86.Build.0 = Release|Win32 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x64.ActiveCfg = Release|x64 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x64.Build.0 = Release|x64 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x86.ActiveCfg = Release|Win32 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x86.Build.0 = Release|Win32 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x64.ActiveCfg = Debug|x64 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x64.Build.0 = Debug|x64 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x86.ActiveCfg = Debug|Win32 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x86.Build.0 = Debug|Win32 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x64.ActiveCfg = Debug|x64 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x64.Build.0 = Debug|x64 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x86.Build.0 = Debug|Win32 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x64.ActiveCfg = Release|x64 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x64.Build.0 = Release|x64 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x86.ActiveCfg = Release|Win32 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x86.Build.0 = Release|Win32 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x64.ActiveCfg = Release|x64 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x64.Build.0 = Release|x64 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x86.ActiveCfg = Release|Win32 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x86.Build.0 = Release|Win32 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x64.ActiveCfg = Debug|x64 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x64.Build.0 = Debug|x64 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x86.ActiveCfg = Debug|Win32 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x86.Build.0 = Debug|Win32 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x64.ActiveCfg = Debug|x64 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x64.Build.0 = Debug|x64 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x86.Build.0 = Debug|Win32 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x64.ActiveCfg = Release|x64 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x64.Build.0 = Release|x64 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x86.ActiveCfg = Release|Win32 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x86.Build.0 = Release|Win32 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x64.ActiveCfg = Release|x64 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x64.Build.0 = Release|x64 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x86.ActiveCfg = Release|Win32 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x86.Build.0 = Release|Win32 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x64.ActiveCfg = Debug|x64 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x64.Build.0 = Debug|x64 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x86.ActiveCfg = Debug|Win32 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x86.Build.0 = Debug|Win32 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x64.ActiveCfg = Debug|x64 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x64.Build.0 = Debug|x64 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x86.Build.0 = Debug|Win32 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x64.ActiveCfg = Release|x64 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x64.Build.0 = Release|x64 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x86.ActiveCfg = Release|Win32 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x86.Build.0 = Release|Win32 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x64.ActiveCfg = Release|x64 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x64.Build.0 = Release|x64 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x86.ActiveCfg = Release|Win32 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x86.Build.0 = Release|Win32 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x64.ActiveCfg = Debug|x64 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x64.Build.0 = Debug|x64 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x86.ActiveCfg = Debug|Win32 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x86.Build.0 = Debug|Win32 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x64.ActiveCfg = Debug|x64 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x64.Build.0 = Debug|x64 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x86.Build.0 = Debug|Win32 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x64.ActiveCfg = Release|x64 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x64.Build.0 = Release|x64 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x86.ActiveCfg = Release|Win32 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x86.Build.0 = Release|Win32 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x64.ActiveCfg = Release|x64 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x64.Build.0 = Release|x64 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x86.ActiveCfg = Release|Win32 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x86.Build.0 = Release|Win32 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x64.ActiveCfg = Debug|x64 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x64.Build.0 = Debug|x64 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x86.ActiveCfg = Debug|Win32 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x86.Build.0 = Debug|Win32 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x64.ActiveCfg = Debug|x64 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x64.Build.0 = Debug|x64 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x86.Build.0 = Debug|Win32 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x64.ActiveCfg = Release|x64 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x64.Build.0 = Release|x64 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x86.ActiveCfg = Release|Win32 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x86.Build.0 = Release|Win32 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x64.ActiveCfg = Release|x64 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x64.Build.0 = Release|x64 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x86.ActiveCfg = Release|Win32 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x86.Build.0 = Release|Win32 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x64.ActiveCfg = Debug|x64 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x64.Build.0 = Debug|x64 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x86.ActiveCfg = Debug|Win32 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x86.Build.0 = Debug|Win32 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x64.ActiveCfg = Debug|x64 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x64.Build.0 = Debug|x64 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x86.Build.0 = Debug|Win32 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x64.ActiveCfg = Release|x64 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x64.Build.0 = Release|x64 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x86.ActiveCfg = Release|Win32 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x86.Build.0 = Release|Win32 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x64.ActiveCfg = Release|x64 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x64.Build.0 = Release|x64 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x86.ActiveCfg = Release|Win32 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x86.Build.0 = Release|Win32 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x64.ActiveCfg = Debug|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x64.Build.0 = Debug|x64 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x86.ActiveCfg = Debug|Win32 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x86.Build.0 = Debug|Win32 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x64.ActiveCfg = Debug|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x64.Build.0 = Debug|x64 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x86.Build.0 = Debug|Win32 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.ActiveCfg = Release|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.Build.0 = Release|x64 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x86.ActiveCfg = Release|Win32 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x86.Build.0 = Release|Win32 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x64.ActiveCfg = Release|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x64.Build.0 = Release|x64 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x86.ActiveCfg = Release|Win32 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x86.Build.0 = Release|Win32 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x64.ActiveCfg = Debug|x64 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x64.Build.0 = Debug|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x86.ActiveCfg = Debug|Win32 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x86.Build.0 = Debug|Win32 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x64.ActiveCfg = Debug|x64 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x64.Build.0 = Debug|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x86.Build.0 = Debug|Win32 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x64.ActiveCfg = Release|x64 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x64.Build.0 = Release|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x86.ActiveCfg = Release|Win32 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x86.Build.0 = Release|Win32 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x64.ActiveCfg = Release|x64 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x64.Build.0 = Release|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x86.ActiveCfg = Release|Win32 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x86.Build.0 = Release|Win32 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x64.ActiveCfg = Debug|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x64.Build.0 = Debug|x64 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x86.ActiveCfg = Debug|Win32 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x86.Build.0 = Debug|Win32 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x64.ActiveCfg = Debug|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x64.Build.0 = Debug|x64 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x86.Build.0 = Debug|Win32 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x64.ActiveCfg = Release|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x64.Build.0 = Release|x64 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x86.ActiveCfg = Release|Win32 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x86.Build.0 = Release|Win32 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x64.ActiveCfg = Release|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x64.Build.0 = Release|x64 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x86.ActiveCfg = Release|Win32 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x86.Build.0 = Release|Win32 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x64.ActiveCfg = Debug|x64 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x64.Build.0 = Debug|x64 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x86.ActiveCfg = Debug|Win32 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x86.Build.0 = Debug|Win32 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x64.ActiveCfg = Debug|x64 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x64.Build.0 = Debug|x64 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x86.Build.0 = Debug|Win32 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x64.ActiveCfg = Release|x64 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x64.Build.0 = Release|x64 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x86.ActiveCfg = Release|Win32 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x86.Build.0 = Release|Win32 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x64.ActiveCfg = Release|x64 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x64.Build.0 = Release|x64 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x86.ActiveCfg = Release|Win32 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x86.Build.0 = Release|Win32 {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x64.ActiveCfg = Debug|x64 {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x64.Build.0 = Debug|x64 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x86.ActiveCfg = Debug|Win32 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x86.Build.0 = Debug|Win32 {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x64.ActiveCfg = Debug|x64 {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x64.Build.0 = Debug|x64 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x86.ActiveCfg = Debug|Win32 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x86.Build.0 = Debug|Win32 {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x64.ActiveCfg = Release|x64 {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x64.Build.0 = Release|x64 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x86.ActiveCfg = Release|Win32 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x86.Build.0 = Release|Win32 {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x64.ActiveCfg = Release|x64 {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x64.Build.0 = Release|x64 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x86.ActiveCfg = Release|Win32 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x86.Build.0 = Release|Win32 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x64.ActiveCfg = Debug|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x64.Build.0 = Debug|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x86.ActiveCfg = Debug|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x86.Build.0 = Debug|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x64.ActiveCfg = Debug|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x64.Build.0 = Debug|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x86.ActiveCfg = Debug|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x86.Build.0 = Debug|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x64.ActiveCfg = Release|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x64.Build.0 = Release|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x86.ActiveCfg = Release|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x86.Build.0 = Release|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x64.ActiveCfg = Release|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x64.Build.0 = Release|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x86.ActiveCfg = Release|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x86.Build.0 = Release|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x64.ActiveCfg = Debug|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x64.Build.0 = Debug|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x86.ActiveCfg = Debug|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x86.Build.0 = Debug|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x64.ActiveCfg = Debug|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x64.Build.0 = Debug|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x86.ActiveCfg = Debug|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x86.Build.0 = Debug|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x64.ActiveCfg = Release|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x64.Build.0 = Release|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x86.ActiveCfg = Release|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x86.Build.0 = Release|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x64.ActiveCfg = Release|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x64.Build.0 = Release|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x86.ActiveCfg = Release|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x86.Build.0 = Release|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x64.ActiveCfg = Debug|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x64.Build.0 = Debug|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x86.ActiveCfg = Debug|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x86.Build.0 = Debug|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x64.ActiveCfg = Debug|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x64.Build.0 = Debug|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x86.ActiveCfg = Debug|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x86.Build.0 = Debug|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.ActiveCfg = Release|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.Build.0 = Release|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x86.ActiveCfg = Release|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x86.Build.0 = Release|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x64.ActiveCfg = Release|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x64.Build.0 = Release|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x86.ActiveCfg = Release|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x86.Build.0 = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -1172,7 +817,6 @@ Global {951A453F-1999-483D-848A-9B63C282F43D} = {272B8080-A022-4F4A-BDD6-835871E44C23} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {272B8080-A022-4F4A-BDD6-835871E44C23} {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {272B8080-A022-4F4A-BDD6-835871E44C23} - {07F70EA6-D8B7-49AD-8DB4-0E36CD5BBCBC} = {272B8080-A022-4F4A-BDD6-835871E44C23} {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {272B8080-A022-4F4A-BDD6-835871E44C23} {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {272B8080-A022-4F4A-BDD6-835871E44C23} {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {272B8080-A022-4F4A-BDD6-835871E44C23} diff --git a/vs-build-ifx/configurations.xml b/vs-build-ifx/configurations.xml new file mode 100644 index 0000000000..537ba97086 --- /dev/null +++ b/vs-build-ifx/configurations.xml @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/vs-build-ifx/gitVersionInfo.h b/vs-build-ifx/gitVersionInfo.h deleted file mode 100644 index d1ed2e7a69..0000000000 --- a/vs-build-ifx/gitVersionInfo.h +++ /dev/null @@ -1 +0,0 @@ -#define GIT_VERSION_INFO 'v3.5.3-2142-g74d6f665-dirty' diff --git a/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj index ef666dcecd..d412147f84 100644 --- a/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj +++ b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj @@ -5,17 +5,6 @@ - - - - - - - - - - - @@ -27,17 +16,6 @@ - - - - - - - - - - - diff --git a/vs-build-ifx/modules/ExtLoads_Types.vfproj b/vs-build-ifx/modules/ExtLoads_Types.vfproj index b4cbe3d18d..04f9fb2beb 100644 --- a/vs-build-ifx/modules/ExtLoads_Types.vfproj +++ b/vs-build-ifx/modules/ExtLoads_Types.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - @@ -47,11 +27,18 @@ - + + + + + + + + + + - - diff --git a/vs-build-ifx/modules/ExtPtfm.vfproj b/vs-build-ifx/modules/ExtPtfm.vfproj index 4978519487..60ae90dd81 100644 --- a/vs-build-ifx/modules/ExtPtfm.vfproj +++ b/vs-build-ifx/modules/ExtPtfm.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - @@ -47,12 +27,16 @@ - + + + + + + - diff --git a/vs-build-ifx/modules/ExternalInflow.vfproj b/vs-build-ifx/modules/ExternalInflow.vfproj index 44173ffc86..2867d9d5c1 100644 --- a/vs-build-ifx/modules/ExternalInflow.vfproj +++ b/vs-build-ifx/modules/ExternalInflow.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - diff --git a/vs-build-ifx/modules/FEAMooring.vfproj b/vs-build-ifx/modules/FEAMooring.vfproj index 0b48d4afd0..613af7f8ca 100644 --- a/vs-build-ifx/modules/FEAMooring.vfproj +++ b/vs-build-ifx/modules/FEAMooring.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - @@ -47,11 +27,15 @@ - + + + + + + - diff --git a/vs-build-ifx/modules/HydroDyn.vfproj b/vs-build-ifx/modules/HydroDyn.vfproj index e4f280058b..718a5847dc 100644 --- a/vs-build-ifx/modules/HydroDyn.vfproj +++ b/vs-build-ifx/modules/HydroDyn.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - @@ -47,30 +27,52 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - diff --git a/vs-build-ifx/modules/IceDyn.vfproj b/vs-build-ifx/modules/IceDyn.vfproj index e7bc0b14e6..28e8fa2b5c 100644 --- a/vs-build-ifx/modules/IceDyn.vfproj +++ b/vs-build-ifx/modules/IceDyn.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - @@ -47,11 +27,15 @@ - + + + + + + - diff --git a/vs-build-ifx/modules/IceFloe.vfproj b/vs-build-ifx/modules/IceFloe.vfproj index 524f5a99e1..bda8d39615 100644 --- a/vs-build-ifx/modules/IceFloe.vfproj +++ b/vs-build-ifx/modules/IceFloe.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - @@ -47,7 +27,12 @@ - + + + + + + @@ -56,7 +41,6 @@ - diff --git a/vs-build-ifx/modules/LinDyn.vfproj b/vs-build-ifx/modules/LinDyn.vfproj deleted file mode 100644 index 6f0e9a5044..0000000000 --- a/vs-build-ifx/modules/LinDyn.vfproj +++ /dev/null @@ -1,58 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/vs-build-ifx/modules/MAP-C.vcxproj b/vs-build-ifx/modules/MAP-C.vcxproj index 99a2a7a4c0..05551660c9 100644 --- a/vs-build-ifx/modules/MAP-C.vcxproj +++ b/vs-build-ifx/modules/MAP-C.vcxproj @@ -74,26 +74,26 @@ StaticLibrary true - v143 + v142 Unicode StaticLibrary false - v143 + v142 true Unicode StaticLibrary true - v143 + v142 Unicode StaticLibrary false - v143 + v142 true Unicode diff --git a/vs-build-ifx/modules/MAP.vfproj b/vs-build-ifx/modules/MAP.vfproj index 58a4084090..1c9bb39ce7 100644 --- a/vs-build-ifx/modules/MAP.vfproj +++ b/vs-build-ifx/modules/MAP.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - @@ -47,10 +27,14 @@ - + + + + + + - diff --git a/vs-build-ifx/modules/MoorDyn.vfproj b/vs-build-ifx/modules/MoorDyn.vfproj index dd53b296f6..8d8289f417 100644 --- a/vs-build-ifx/modules/MoorDyn.vfproj +++ b/vs-build-ifx/modules/MoorDyn.vfproj @@ -5,16 +5,6 @@ - - - - - - - - - - @@ -25,16 +15,6 @@ - - - - - - - - - - @@ -47,16 +27,21 @@ - + + + + + + - + + - diff --git a/vs-build-ifx/modules/NWTC-Library.vfproj b/vs-build-ifx/modules/NWTC-Library.vfproj index c11feceb3b..be0c23004e 100644 --- a/vs-build-ifx/modules/NWTC-Library.vfproj +++ b/vs-build-ifx/modules/NWTC-Library.vfproj @@ -15,7 +15,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -47,7 +47,16 @@ - + + + + + + + + + + @@ -60,7 +69,6 @@ - diff --git a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj index baf9a50aea..64c2bfb544 100644 --- a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj +++ b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj @@ -47,11 +47,14 @@ - + + + + + + - - diff --git a/vs-build-ifx/modules/Registry.vcxproj b/vs-build-ifx/modules/Registry.vcxproj index 14e5a5ab44..31ef2f190f 100644 --- a/vs-build-ifx/modules/Registry.vcxproj +++ b/vs-build-ifx/modules/Registry.vcxproj @@ -32,37 +32,37 @@ Application true - v143 + v142 Unicode Application true - v143 + v142 Unicode Application false - v143 + v142 true Unicode Application true - v143 + v142 Unicode Application false - v143 + v142 true Unicode - v143 + v142 diff --git a/vs-build-ifx/update-vfproj.py b/vs-build-ifx/update-vfproj.py new file mode 100644 index 0000000000..4c4493acc5 --- /dev/null +++ b/vs-build-ifx/update-vfproj.py @@ -0,0 +1,16 @@ +from pathlib import Path + +from bs4 import BeautifulSoup + +with open('configsurations.xml') as fp: + configs = soup = BeautifulSoup(fp, 'xml') + +for path in Path('.').rglob('*.vfproj'): + print(path) + with open(path) as fp: + soup = BeautifulSoup(fp, 'xml') + for cfg in soup.findAll('Configuration'): + configs[cfg['Name']] = cfg + break + +print(configs) \ No newline at end of file From 7ae7a457ff75274daaefcecd9fc9ef089e3be98e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 19 Nov 2024 13:09:10 -0500 Subject: [PATCH 287/319] Update all the projects --- vs-build-ifx/OpenFAST.sln | 647 +++++++++++++----- vs-build-ifx/RunRegistry.bat | 6 + vs-build-ifx/configurations.xml | 85 --- vs-build-ifx/glue-codes/FAST.Farm.vfproj | 86 ++- vs-build-ifx/glue-codes/OpenFAST.vfproj | 86 ++- vs-build-ifx/modules/AWAE.vfproj | 76 +- vs-build-ifx/modules/AeroDisk.vfproj | 100 ++- vs-build-ifx/modules/AeroDyn.vfproj | 236 ++++++- vs-build-ifx/modules/AeroDyn_Driver.vfproj | 86 ++- .../modules/AeroDyn_Driver_Subs.vfproj | 100 ++- vs-build-ifx/modules/AeroDyn_Inflow.vfproj | 100 ++- .../modules/AeroDyn_Inflow_C_Binding.vfproj | 84 ++- vs-build-ifx/modules/BeamDyn.vfproj | 100 ++- vs-build-ifx/modules/BeamDyn_Driver.vfproj | 86 ++- vs-build-ifx/modules/ElastoDyn.vfproj | 100 ++- vs-build-ifx/modules/ExtLoads.vfproj | 68 +- vs-build-ifx/modules/ExtLoads_Types.vfproj | 128 +++- vs-build-ifx/modules/ExtPtfm.vfproj | 102 ++- vs-build-ifx/modules/ExternalInflow.vfproj | 76 +- .../modules/ExternalInflow_Types.vfproj | 102 ++- vs-build-ifx/modules/FEAMooring.vfproj | 102 ++- vs-build-ifx/modules/HydroDyn.vfproj | 258 ++++++- vs-build-ifx/modules/IceDyn.vfproj | 102 ++- vs-build-ifx/modules/IceFloe.vfproj | 102 ++- vs-build-ifx/modules/InflowWind.vfproj | 164 ++++- vs-build-ifx/modules/MAP-C.vcxproj | 15 +- vs-build-ifx/modules/MAP.vfproj | 102 ++- vs-build-ifx/modules/MoorDyn.vfproj | 102 ++- vs-build-ifx/modules/MoorDyn_Driver.vfproj | 80 ++- vs-build-ifx/modules/NWTC-Library.vfproj | 154 ++++- vs-build-ifx/modules/OpenFAST-Library.vfproj | 68 +- vs-build-ifx/modules/OpenFAST-Prelib.vfproj | 116 +++- vs-build-ifx/modules/OrcaFlex.vfproj | 68 +- vs-build-ifx/modules/Registry.vcxproj | 24 +- vs-build-ifx/modules/SeaState.vfproj | 68 +- vs-build-ifx/modules/ServoDyn.vfproj | 68 +- vs-build-ifx/modules/SimpleElastoDyn.vfproj | 68 +- vs-build-ifx/modules/SubDyn.vfproj | 68 +- vs-build-ifx/modules/SuperController.vfproj | 68 +- .../modules/SuperController_Types.vfproj | 68 +- vs-build-ifx/modules/TurbSim.vfproj | 81 ++- vs-build-ifx/modules/VersionInfo.vfproj | 80 ++- vs-build-ifx/modules/WakeDynamics.vfproj | 68 +- vs-build-ifx/update-vfproj.py | 129 +++- 44 files changed, 3906 insertions(+), 771 deletions(-) delete mode 100644 vs-build-ifx/configurations.xml diff --git a/vs-build-ifx/OpenFAST.sln b/vs-build-ifx/OpenFAST.sln index 02bda342a0..3b7a6f7141 100644 --- a/vs-build-ifx/OpenFAST.sln +++ b/vs-build-ifx/OpenFAST.sln @@ -469,332 +469,655 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST.Farm", "glue-codes\FAS EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug_Double|x64 = Debug_Double|x64 + Debug_Matlab|x64 = Debug_Matlab|x64 Debug|x64 = Debug|x64 - Debug-Double|x64 = Debug-Double|x64 + Release_Double_OpenMP|x64 = Release_Double_OpenMP|x64 + Release_Double|x64 = Release_Double|x64 + Release_Matlab|x64 = Release_Matlab|x64 + Release_OpenMP|x64 = Release_OpenMP|x64 Release|x64 = Release|x64 - Release-Double|x64 = Release-Double|x64 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug_Double|x64.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug_Double|x64.Build.0 = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug_Matlab|x64.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug_Matlab|x64.Build.0 = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.ActiveCfg = Debug|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.Build.0 = Debug|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.ActiveCfg = Debug|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug-Double|x64.Build.0 = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Double_OpenMP|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Double_OpenMP|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Double|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Double|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Matlab|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Matlab|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_OpenMP|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_OpenMP|x64.Build.0 = Release|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.ActiveCfg = Release|x64 {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.Build.0 = Release|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.ActiveCfg = Release|x64 - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release-Double|x64.Build.0 = Release|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.ActiveCfg = Debug|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.Build.0 = Debug|x64 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x64.ActiveCfg = Debug|x64 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug-Double|x64.Build.0 = Debug|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Double|x64.Build.0 = Release_Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x64.ActiveCfg = Release|x64 {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x64.Build.0 = Release|x64 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x64.ActiveCfg = Release|x64 - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release-Double|x64.Build.0 = Release|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x64.ActiveCfg = Debug|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x64.Build.0 = Debug|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x64.ActiveCfg = Debug-Double|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug-Double|x64.Build.0 = Debug-Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Double|x64.Build.0 = Release_Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x64.ActiveCfg = Release|x64 {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x64.Build.0 = Release|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x64.ActiveCfg = Release-Double|x64 - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release-Double|x64.Build.0 = Release-Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x64.ActiveCfg = Debug|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x64.Build.0 = Debug|x64 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x64.ActiveCfg = Debug|x64 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug-Double|x64.Build.0 = Debug|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Double|x64.Build.0 = Release_Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x64.ActiveCfg = Release|x64 {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x64.Build.0 = Release|x64 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x64.ActiveCfg = Release|x64 - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release-Double|x64.Build.0 = Release|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x64.ActiveCfg = Debug|x64 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x64.Build.0 = Debug|x64 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x64.ActiveCfg = Debug|x64 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug-Double|x64.Build.0 = Debug|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Double|x64.Build.0 = Release_Double|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x64.ActiveCfg = Release|x64 {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x64.Build.0 = Release|x64 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x64.ActiveCfg = Release|x64 - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release-Double|x64.Build.0 = Release|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x64.ActiveCfg = Debug|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x64.Build.0 = Debug|x64 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x64.ActiveCfg = Debug|x64 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug-Double|x64.Build.0 = Debug|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Double|x64.Build.0 = Release_Double|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.ActiveCfg = Release|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.Build.0 = Release|x64 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x64.ActiveCfg = Release|x64 - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release-Double|x64.Build.0 = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.ActiveCfg = Debug|x64 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.Build.0 = Debug|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x64.ActiveCfg = Debug|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug-Double|x64.Build.0 = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double|x64.Build.0 = Release_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.ActiveCfg = Release|x64 {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.Build.0 = Release|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x64.ActiveCfg = Release|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release-Double|x64.Build.0 = Release|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x64.ActiveCfg = Debug|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x64.Build.0 = Debug|x64 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x64.ActiveCfg = Debug|x64 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug-Double|x64.Build.0 = Debug|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Double|x64.Build.0 = Release_Double|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x64.ActiveCfg = Release|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x64.Build.0 = Release|x64 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x64.ActiveCfg = Release|x64 - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release-Double|x64.Build.0 = Release|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x64.ActiveCfg = Debug|x64 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x64.Build.0 = Debug|x64 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x64.ActiveCfg = Debug|x64 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug-Double|x64.Build.0 = Debug|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Double|x64.Build.0 = Release_Double|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x64.ActiveCfg = Release|x64 {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x64.Build.0 = Release|x64 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x64.ActiveCfg = Release|x64 - {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release-Double|x64.Build.0 = Release|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x64.ActiveCfg = Debug|x64 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x64.Build.0 = Debug|x64 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x64.ActiveCfg = Debug|x64 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug-Double|x64.Build.0 = Debug|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Double|x64.Build.0 = Release_Double|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x64.ActiveCfg = Release|x64 {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x64.Build.0 = Release|x64 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x64.ActiveCfg = Release|x64 - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release-Double|x64.Build.0 = Release|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x64.ActiveCfg = Debug|x64 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x64.Build.0 = Debug|x64 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x64.ActiveCfg = Debug|x64 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug-Double|x64.Build.0 = Debug|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Double|x64.Build.0 = Release_Double|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x64.ActiveCfg = Release|x64 {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x64.Build.0 = Release|x64 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x64.ActiveCfg = Release|x64 - {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release-Double|x64.Build.0 = Release|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x64.ActiveCfg = Debug|x64 {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x64.Build.0 = Debug|x64 - {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x64.ActiveCfg = Debug|x64 - {3000393A-702F-488E-B918-1D37955FA8D3}.Debug-Double|x64.Build.0 = Debug|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Double|x64.Build.0 = Release_Double|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x64.ActiveCfg = Release|x64 {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x64.Build.0 = Release|x64 - {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x64.ActiveCfg = Release|x64 - {3000393A-702F-488E-B918-1D37955FA8D3}.Release-Double|x64.Build.0 = Release|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {676276A1-DC23-4287-8386-07076303C39D}.Debug|x64.ActiveCfg = Debug|x64 {676276A1-DC23-4287-8386-07076303C39D}.Debug|x64.Build.0 = Debug|x64 - {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x64.ActiveCfg = Debug|x64 - {676276A1-DC23-4287-8386-07076303C39D}.Debug-Double|x64.Build.0 = Debug|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Double|x64.Build.0 = Release_Double|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {676276A1-DC23-4287-8386-07076303C39D}.Release|x64.ActiveCfg = Release|x64 {676276A1-DC23-4287-8386-07076303C39D}.Release|x64.Build.0 = Release|x64 - {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x64.ActiveCfg = Release|x64 - {676276A1-DC23-4287-8386-07076303C39D}.Release-Double|x64.Build.0 = Release|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x64.ActiveCfg = Debug|x64 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x64.Build.0 = Debug|x64 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x64.ActiveCfg = Debug|x64 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug-Double|x64.Build.0 = Debug|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Double|x64.Build.0 = Release_Double|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x64.ActiveCfg = Release|x64 {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x64.Build.0 = Release|x64 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x64.ActiveCfg = Release|x64 - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release-Double|x64.Build.0 = Release|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x64.ActiveCfg = Debug|x64 {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x64.Build.0 = Debug|x64 - {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x64.ActiveCfg = Debug|x64 - {951A453F-1999-483D-848A-9B63C282F43D}.Debug-Double|x64.Build.0 = Debug|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Double|x64.Build.0 = Release_Double|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {951A453F-1999-483D-848A-9B63C282F43D}.Release|x64.ActiveCfg = Release|x64 {951A453F-1999-483D-848A-9B63C282F43D}.Release|x64.Build.0 = Release|x64 - {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x64.ActiveCfg = Release|x64 - {951A453F-1999-483D-848A-9B63C282F43D}.Release-Double|x64.Build.0 = Release|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x64.ActiveCfg = Debug|x64 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x64.Build.0 = Debug|x64 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x64.ActiveCfg = Debug|x64 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug-Double|x64.Build.0 = Debug|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Double|x64.Build.0 = Release_Double|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x64.ActiveCfg = Release|x64 {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x64.Build.0 = Release|x64 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x64.ActiveCfg = Release|x64 - {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release-Double|x64.Build.0 = Release|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x64.ActiveCfg = Debug|x64 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x64.Build.0 = Debug|x64 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x64.ActiveCfg = Debug|x64 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug-Double|x64.Build.0 = Debug|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Double|x64.Build.0 = Release_Double|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x64.ActiveCfg = Release|x64 {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x64.Build.0 = Release|x64 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x64.ActiveCfg = Release|x64 - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release-Double|x64.Build.0 = Release|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x64.ActiveCfg = Debug|x64 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x64.Build.0 = Debug|x64 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x64.ActiveCfg = Debug|x64 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug-Double|x64.Build.0 = Debug|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Double|x64.Build.0 = Release_Double|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x64.ActiveCfg = Release|x64 {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x64.Build.0 = Release|x64 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x64.ActiveCfg = Release|x64 - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release-Double|x64.Build.0 = Release|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x64.ActiveCfg = Debug|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x64.Build.0 = Debug|x64 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x64.ActiveCfg = Debug|x64 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug-Double|x64.Build.0 = Debug|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Double|x64.Build.0 = Release_Double|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.ActiveCfg = Release|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.Build.0 = Release|x64 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x64.ActiveCfg = Release|x64 - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release-Double|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Double|x64.ActiveCfg = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Matlab|x64.ActiveCfg = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Matlab|x64.Build.0 = Debug|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.ActiveCfg = Debug|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.Build.0 = Debug|x64 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x64.ActiveCfg = Debug|x64 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug-Double|x64.Build.0 = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Double_OpenMP|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Double_OpenMP|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Double|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Double|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Matlab|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Matlab|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_OpenMP|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_OpenMP|x64.Build.0 = Release|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.ActiveCfg = Release|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.Build.0 = Release|x64 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x64.ActiveCfg = Release|x64 - {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release-Double|x64.Build.0 = Release|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x64.ActiveCfg = Debug|x64 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x64.Build.0 = Debug|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x64.ActiveCfg = Debug|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug-Double|x64.Build.0 = Debug|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Double|x64.Build.0 = Release_Double|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x64.ActiveCfg = Release|x64 {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x64.Build.0 = Release|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x64.ActiveCfg = Release|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release-Double|x64.Build.0 = Release|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x64.ActiveCfg = Debug|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x64.Build.0 = Debug|x64 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x64.ActiveCfg = Debug|x64 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug-Double|x64.Build.0 = Debug|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Double|x64.Build.0 = Release_Double|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x64.ActiveCfg = Release|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x64.Build.0 = Release|x64 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x64.ActiveCfg = Release|x64 - {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release-Double|x64.Build.0 = Release|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x64.ActiveCfg = Debug|x64 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x64.Build.0 = Debug|x64 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x64.ActiveCfg = Debug|x64 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug-Double|x64.Build.0 = Debug|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Double|x64.Build.0 = Release_Double|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x64.ActiveCfg = Release|x64 {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x64.Build.0 = Release|x64 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x64.ActiveCfg = Release|x64 - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release-Double|x64.Build.0 = Release|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x64.ActiveCfg = Debug|x64 {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x64.Build.0 = Debug|x64 - {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x64.ActiveCfg = Debug|x64 - {2467FDD4-622B-4628-993A-73994FB8172E}.Debug-Double|x64.Build.0 = Debug|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Double|x64.Build.0 = Release_Double|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x64.ActiveCfg = Release|x64 {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x64.Build.0 = Release|x64 - {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x64.ActiveCfg = Release|x64 - {2467FDD4-622B-4628-993A-73994FB8172E}.Release-Double|x64.Build.0 = Release|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x64.ActiveCfg = Debug|x64 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x64.Build.0 = Debug|x64 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x64.ActiveCfg = Debug|x64 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug-Double|x64.Build.0 = Debug|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Double|x64.Build.0 = Release_Double|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x64.ActiveCfg = Release|x64 {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x64.Build.0 = Release|x64 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x64.ActiveCfg = Release|x64 - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release-Double|x64.Build.0 = Release|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x64.ActiveCfg = Debug|x64 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x64.Build.0 = Debug|x64 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x64.ActiveCfg = Debug|x64 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug-Double|x64.Build.0 = Debug|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Double|x64.Build.0 = Release_Double|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x64.ActiveCfg = Release|x64 {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x64.Build.0 = Release|x64 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x64.ActiveCfg = Release|x64 - {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release-Double|x64.Build.0 = Release|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x64.ActiveCfg = Debug|x64 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x64.Build.0 = Debug|x64 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x64.ActiveCfg = Debug|x64 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug-Double|x64.Build.0 = Debug|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Double|x64.Build.0 = Release_Double|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x64.ActiveCfg = Release|x64 {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x64.Build.0 = Release|x64 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x64.ActiveCfg = Release|x64 - {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release-Double|x64.Build.0 = Release|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x64.ActiveCfg = Debug|x64 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x64.Build.0 = Debug|x64 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x64.ActiveCfg = Debug|x64 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug-Double|x64.Build.0 = Debug|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Double|x64.Build.0 = Release_Double|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x64.ActiveCfg = Release|x64 {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x64.Build.0 = Release|x64 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x64.ActiveCfg = Release|x64 - {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release-Double|x64.Build.0 = Release|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x64.ActiveCfg = Debug|x64 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x64.Build.0 = Debug|x64 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x64.ActiveCfg = Debug|x64 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug-Double|x64.Build.0 = Debug|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Double|x64.Build.0 = Release_Double|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x64.ActiveCfg = Release|x64 {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x64.Build.0 = Release|x64 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x64.ActiveCfg = Release|x64 - {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release-Double|x64.Build.0 = Release|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x64.ActiveCfg = Debug|x64 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x64.Build.0 = Debug|x64 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x64.ActiveCfg = Debug|x64 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug-Double|x64.Build.0 = Debug|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Double|x64.Build.0 = Release_Double|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x64.ActiveCfg = Release|x64 {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x64.Build.0 = Release|x64 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x64.ActiveCfg = Release|x64 - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release-Double|x64.Build.0 = Release|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x64.ActiveCfg = Debug|x64 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x64.Build.0 = Debug|x64 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x64.ActiveCfg = Debug|x64 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug-Double|x64.Build.0 = Debug|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Double|x64.Build.0 = Release_Double|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x64.ActiveCfg = Release|x64 {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x64.Build.0 = Release|x64 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x64.ActiveCfg = Release|x64 - {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release-Double|x64.Build.0 = Release|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x64.ActiveCfg = Debug|x64 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x64.Build.0 = Debug|x64 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x64.ActiveCfg = Debug|x64 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug-Double|x64.Build.0 = Debug|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Double|x64.Build.0 = Release_Double|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x64.ActiveCfg = Release|x64 {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x64.Build.0 = Release|x64 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x64.ActiveCfg = Release|x64 - {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release-Double|x64.Build.0 = Release|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x64.ActiveCfg = Debug|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x64.Build.0 = Debug|x64 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x64.ActiveCfg = Debug|x64 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug-Double|x64.Build.0 = Debug|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Double|x64.Build.0 = Release_Double|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.ActiveCfg = Release|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.Build.0 = Release|x64 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x64.ActiveCfg = Release|x64 - {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release-Double|x64.Build.0 = Release|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x64.ActiveCfg = Debug|x64 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x64.Build.0 = Debug|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x64.ActiveCfg = Debug|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug-Double|x64.Build.0 = Debug|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Double|x64.Build.0 = Release_Double|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x64.ActiveCfg = Release|x64 {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x64.Build.0 = Release|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x64.ActiveCfg = Release|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release-Double|x64.Build.0 = Release|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x64.ActiveCfg = Debug|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x64.Build.0 = Debug|x64 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x64.ActiveCfg = Debug|x64 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug-Double|x64.Build.0 = Debug|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Double|x64.Build.0 = Release_Double|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x64.ActiveCfg = Release|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x64.Build.0 = Release|x64 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x64.ActiveCfg = Release|x64 - {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release-Double|x64.Build.0 = Release|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x64.ActiveCfg = Debug|x64 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x64.Build.0 = Debug|x64 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x64.ActiveCfg = Debug|x64 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug-Double|x64.Build.0 = Debug|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Double|x64.Build.0 = Release_Double|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x64.ActiveCfg = Release|x64 {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x64.Build.0 = Release|x64 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x64.ActiveCfg = Release|x64 - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release-Double|x64.Build.0 = Release|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x64.ActiveCfg = Debug|x64 {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x64.Build.0 = Debug|x64 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x64.ActiveCfg = Debug|x64 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug-Double|x64.Build.0 = Debug|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Double|x64.Build.0 = Release_Double|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x64.ActiveCfg = Release|x64 {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x64.Build.0 = Release|x64 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x64.ActiveCfg = Release|x64 - {DB03A086-3362-41E5-930A-B151D137ACCF}.Release-Double|x64.Build.0 = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x64.ActiveCfg = Debug|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x64.Build.0 = Debug|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x64.ActiveCfg = Debug|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug-Double|x64.Build.0 = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Double|x64.Build.0 = Release_Double|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x64.ActiveCfg = Release|x64 {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x64.Build.0 = Release|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x64.ActiveCfg = Release|x64 - {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release-Double|x64.Build.0 = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x64.ActiveCfg = Debug|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x64.Build.0 = Debug|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x64.ActiveCfg = Debug|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug-Double|x64.Build.0 = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Double|x64.Build.0 = Release_Double|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x64.ActiveCfg = Release|x64 {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x64.Build.0 = Release|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x64.ActiveCfg = Release|x64 - {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release-Double|x64.Build.0 = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x64.ActiveCfg = Debug|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x64.Build.0 = Debug|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x64.ActiveCfg = Debug|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug-Double|x64.Build.0 = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Double|x64.Build.0 = Release_Double|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.ActiveCfg = Release|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.Build.0 = Release|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x64.ActiveCfg = Release|x64 - {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release-Double|x64.Build.0 = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE diff --git a/vs-build-ifx/RunRegistry.bat b/vs-build-ifx/RunRegistry.bat index 8a65be2a5d..59312201b0 100644 --- a/vs-build-ifx/RunRegistry.bat +++ b/vs-build-ifx/RunRegistry.bat @@ -90,6 +90,12 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\FAST_Registry.txt" %ALL_FAST_Includes% -noextrap -O "%Output_Loc%" GOTO checkError +:Glue +SET CURR_LOC=%FAST_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Glue_Registry.txt" %ALL_FAST_Includes% -noextrap -O "%Output_Loc%" +GOTO checkError + :BeamDyn SET CURR_LOC=%BD_Loc% SET Output_Loc=%CURR_LOC% diff --git a/vs-build-ifx/configurations.xml b/vs-build-ifx/configurations.xml deleted file mode 100644 index 537ba97086..0000000000 --- a/vs-build-ifx/configurations.xml +++ /dev/null @@ -1,85 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/vs-build-ifx/glue-codes/FAST.Farm.vfproj b/vs-build-ifx/glue-codes/FAST.Farm.vfproj index 93aa63c00a..d673ea97d5 100644 --- a/vs-build-ifx/glue-codes/FAST.Farm.vfproj +++ b/vs-build-ifx/glue-codes/FAST.Farm.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,75 @@ - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -28,11 +94,11 @@ - + - + diff --git a/vs-build-ifx/glue-codes/OpenFAST.vfproj b/vs-build-ifx/glue-codes/OpenFAST.vfproj index 7a94a1fdcf..3e2831eb97 100644 --- a/vs-build-ifx/glue-codes/OpenFAST.vfproj +++ b/vs-build-ifx/glue-codes/OpenFAST.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,75 @@ - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -28,8 +94,8 @@ - - + + diff --git a/vs-build-ifx/modules/AWAE.vfproj b/vs-build-ifx/modules/AWAE.vfproj index 898cdb897e..941b46eef3 100644 --- a/vs-build-ifx/modules/AWAE.vfproj +++ b/vs-build-ifx/modules/AWAE.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -26,11 +86,11 @@ - + - + diff --git a/vs-build-ifx/modules/AeroDisk.vfproj b/vs-build-ifx/modules/AeroDisk.vfproj index 9c4716765d..7b472d8789 100644 --- a/vs-build-ifx/modules/AeroDisk.vfproj +++ b/vs-build-ifx/modules/AeroDisk.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,17 +87,35 @@ - + + + + + + + + + + - + - - + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/AeroDyn.vfproj b/vs-build-ifx/modules/AeroDyn.vfproj index 6dbda0ec3e..b1fcd4835e 100644 --- a/vs-build-ifx/modules/AeroDyn.vfproj +++ b/vs-build-ifx/modules/AeroDyn.vfproj @@ -1,22 +1,32 @@ - - + + - - + + - + + + + + + + + + + + - - + + @@ -25,18 +35,48 @@ - - + + - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -47,65 +87,191 @@ - + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/AeroDyn_Driver.vfproj b/vs-build-ifx/modules/AeroDyn_Driver.vfproj index a3721981fd..a4d16b38fb 100644 --- a/vs-build-ifx/modules/AeroDyn_Driver.vfproj +++ b/vs-build-ifx/modules/AeroDyn_Driver.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,75 @@ - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -28,8 +94,8 @@ - - + + diff --git a/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj b/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj index 481d7b6288..a9e11eb349 100644 --- a/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj +++ b/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -26,17 +86,35 @@ - + + + + + + + + + + - + - - + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/AeroDyn_Inflow.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow.vfproj index 0a0838bf3d..90e8fe75e1 100644 --- a/vs-build-ifx/modules/AeroDyn_Inflow.vfproj +++ b/vs-build-ifx/modules/AeroDyn_Inflow.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -26,17 +86,35 @@ - + + + + + + + + + + - + - - + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj index d412147f84..def6e6c77d 100644 --- a/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj +++ b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj @@ -1,13 +1,13 @@ - - + + - - - + + + @@ -16,9 +16,75 @@ - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -29,7 +95,7 @@ - + diff --git a/vs-build-ifx/modules/BeamDyn.vfproj b/vs-build-ifx/modules/BeamDyn.vfproj index 8035e50105..75ba5d0920 100644 --- a/vs-build-ifx/modules/BeamDyn.vfproj +++ b/vs-build-ifx/modules/BeamDyn.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -26,17 +86,35 @@ - + + + + + + + + + + - + - - + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/BeamDyn_Driver.vfproj b/vs-build-ifx/modules/BeamDyn_Driver.vfproj index 065d0ab4e5..549a2c49b0 100644 --- a/vs-build-ifx/modules/BeamDyn_Driver.vfproj +++ b/vs-build-ifx/modules/BeamDyn_Driver.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,75 @@ - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -28,8 +94,8 @@ - - + + diff --git a/vs-build-ifx/modules/ElastoDyn.vfproj b/vs-build-ifx/modules/ElastoDyn.vfproj index e686002eb4..4ba3515068 100644 --- a/vs-build-ifx/modules/ElastoDyn.vfproj +++ b/vs-build-ifx/modules/ElastoDyn.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -26,17 +86,35 @@ - + + + + + + + + + + - + - - + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/ExtLoads.vfproj b/vs-build-ifx/modules/ExtLoads.vfproj index 6ffa65cbbe..3b91dac662 100644 --- a/vs-build-ifx/modules/ExtLoads.vfproj +++ b/vs-build-ifx/modules/ExtLoads.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/modules/ExtLoads_Types.vfproj b/vs-build-ifx/modules/ExtLoads_Types.vfproj index 04f9fb2beb..d192c80065 100644 --- a/vs-build-ifx/modules/ExtLoads_Types.vfproj +++ b/vs-build-ifx/modules/ExtLoads_Types.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,17 +87,61 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/ExtPtfm.vfproj b/vs-build-ifx/modules/ExtPtfm.vfproj index 60ae90dd81..f42b6b254b 100644 --- a/vs-build-ifx/modules/ExtPtfm.vfproj +++ b/vs-build-ifx/modules/ExtPtfm.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,13 +87,35 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/ExternalInflow.vfproj b/vs-build-ifx/modules/ExternalInflow.vfproj index 2867d9d5c1..749b1e4a83 100644 --- a/vs-build-ifx/modules/ExternalInflow.vfproj +++ b/vs-build-ifx/modules/ExternalInflow.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/modules/ExternalInflow_Types.vfproj b/vs-build-ifx/modules/ExternalInflow_Types.vfproj index 30b11235f1..b89acfedd7 100644 --- a/vs-build-ifx/modules/ExternalInflow_Types.vfproj +++ b/vs-build-ifx/modules/ExternalInflow_Types.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,13 +87,35 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/FEAMooring.vfproj b/vs-build-ifx/modules/FEAMooring.vfproj index 613af7f8ca..bb4a179466 100644 --- a/vs-build-ifx/modules/FEAMooring.vfproj +++ b/vs-build-ifx/modules/FEAMooring.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,13 +87,35 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/HydroDyn.vfproj b/vs-build-ifx/modules/HydroDyn.vfproj index 718a5847dc..c8d388ebc0 100644 --- a/vs-build-ifx/modules/HydroDyn.vfproj +++ b/vs-build-ifx/modules/HydroDyn.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,37 +87,191 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/IceDyn.vfproj b/vs-build-ifx/modules/IceDyn.vfproj index 28e8fa2b5c..d3915397b1 100644 --- a/vs-build-ifx/modules/IceDyn.vfproj +++ b/vs-build-ifx/modules/IceDyn.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,13 +87,35 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/IceFloe.vfproj b/vs-build-ifx/modules/IceFloe.vfproj index bda8d39615..9c27605fd4 100644 --- a/vs-build-ifx/modules/IceFloe.vfproj +++ b/vs-build-ifx/modules/IceFloe.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,13 +87,35 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/InflowWind.vfproj b/vs-build-ifx/modules/InflowWind.vfproj index 646490dfd8..3e00c229e1 100644 --- a/vs-build-ifx/modules/InflowWind.vfproj +++ b/vs-build-ifx/modules/InflowWind.vfproj @@ -1,22 +1,62 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +65,18 @@ - - + + - + - - + + @@ -47,41 +87,113 @@ - + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/MAP-C.vcxproj b/vs-build-ifx/modules/MAP-C.vcxproj index 05551660c9..d3fb4b5a47 100644 --- a/vs-build-ifx/modules/MAP-C.vcxproj +++ b/vs-build-ifx/modules/MAP-C.vcxproj @@ -81,7 +81,6 @@ StaticLibrary false v142 - true Unicode @@ -94,7 +93,6 @@ StaticLibrary false v142 - true Unicode @@ -116,11 +114,11 @@ - ..\..\build\lib + ..\..\build\lib\ ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ - ..\..\build\lib + ..\..\build\lib\ ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ @@ -166,12 +164,17 @@ NotUsing pch.h true + MultiThreadedDebug + ProgramDatabase true + + true + @@ -184,6 +187,7 @@ NotUsing pch.h true + MultiThreaded @@ -192,6 +196,9 @@ true true + + true + diff --git a/vs-build-ifx/modules/MAP.vfproj b/vs-build-ifx/modules/MAP.vfproj index 1c9bb39ce7..5c16d46fbc 100644 --- a/vs-build-ifx/modules/MAP.vfproj +++ b/vs-build-ifx/modules/MAP.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,13 +87,35 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/MoorDyn.vfproj b/vs-build-ifx/modules/MoorDyn.vfproj index 8d8289f417..ad8e0e4183 100644 --- a/vs-build-ifx/modules/MoorDyn.vfproj +++ b/vs-build-ifx/modules/MoorDyn.vfproj @@ -1,12 +1,12 @@ - - + + - - + + @@ -15,8 +15,68 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27,13 +87,35 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/MoorDyn_Driver.vfproj b/vs-build-ifx/modules/MoorDyn_Driver.vfproj index 39b5b58874..14fc89a33a 100644 --- a/vs-build-ifx/modules/MoorDyn_Driver.vfproj +++ b/vs-build-ifx/modules/MoorDyn_Driver.vfproj @@ -1,24 +1,46 @@ - - + + - - - + + + - + + + + + + + + + + + + + + + + + + + + + + + - - - + + + @@ -27,20 +49,42 @@ - - - + + + - + + + + + + + + + + + + + + + + + + + + + + + - - - + + + @@ -51,8 +95,8 @@ - - + + diff --git a/vs-build-ifx/modules/NWTC-Library.vfproj b/vs-build-ifx/modules/NWTC-Library.vfproj index be0c23004e..acc0140f45 100644 --- a/vs-build-ifx/modules/NWTC-Library.vfproj +++ b/vs-build-ifx/modules/NWTC-Library.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,8 @@ - - + + @@ -24,9 +24,8 @@ - - - + + @@ -35,11 +34,56 @@ - - + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -47,23 +91,42 @@ - + + + + + + + + + + - + - - + + + + + + + + + + + - + - + + @@ -72,9 +135,58 @@ - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/OpenFAST-Library.vfproj b/vs-build-ifx/modules/OpenFAST-Library.vfproj index a8a5d88a6b..69c81ce0b4 100644 --- a/vs-build-ifx/modules/OpenFAST-Library.vfproj +++ b/vs-build-ifx/modules/OpenFAST-Library.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,10 +87,10 @@ - + - + diff --git a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj index 64c2bfb544..11bf701596 100644 --- a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj +++ b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,13 +87,61 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/vs-build-ifx/modules/OrcaFlex.vfproj b/vs-build-ifx/modules/OrcaFlex.vfproj index 85b3b2a2d3..de59597765 100644 --- a/vs-build-ifx/modules/OrcaFlex.vfproj +++ b/vs-build-ifx/modules/OrcaFlex.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/modules/Registry.vcxproj b/vs-build-ifx/modules/Registry.vcxproj index 31ef2f190f..72098e4114 100644 --- a/vs-build-ifx/modules/Registry.vcxproj +++ b/vs-build-ifx/modules/Registry.vcxproj @@ -35,6 +35,12 @@ v142 Unicode + + Application + true + v142 + Unicode + Application true @@ -45,7 +51,12 @@ Application false v142 - true + Unicode + + + Application + false + v142 Unicode @@ -58,7 +69,6 @@ Application false v142 - true Unicode @@ -72,12 +82,18 @@ + + + + + + @@ -86,11 +102,11 @@ - ..\..\build\bin + ..\..\build\lib\ ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ - ..\..\build\bin + ..\..\build\lib\ ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ diff --git a/vs-build-ifx/modules/SeaState.vfproj b/vs-build-ifx/modules/SeaState.vfproj index 515602e456..17257bec2c 100644 --- a/vs-build-ifx/modules/SeaState.vfproj +++ b/vs-build-ifx/modules/SeaState.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/modules/ServoDyn.vfproj b/vs-build-ifx/modules/ServoDyn.vfproj index c4ea34c5e3..0c739f73bc 100644 --- a/vs-build-ifx/modules/ServoDyn.vfproj +++ b/vs-build-ifx/modules/ServoDyn.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/modules/SimpleElastoDyn.vfproj b/vs-build-ifx/modules/SimpleElastoDyn.vfproj index 5530b75529..73e0c1de87 100644 --- a/vs-build-ifx/modules/SimpleElastoDyn.vfproj +++ b/vs-build-ifx/modules/SimpleElastoDyn.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/modules/SubDyn.vfproj b/vs-build-ifx/modules/SubDyn.vfproj index 09c2be757d..000a3d614c 100644 --- a/vs-build-ifx/modules/SubDyn.vfproj +++ b/vs-build-ifx/modules/SubDyn.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/modules/SuperController.vfproj b/vs-build-ifx/modules/SuperController.vfproj index e63fc6283b..0223df34ac 100644 --- a/vs-build-ifx/modules/SuperController.vfproj +++ b/vs-build-ifx/modules/SuperController.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/modules/SuperController_Types.vfproj b/vs-build-ifx/modules/SuperController_Types.vfproj index 25348d02ae..afd2dd3009 100644 --- a/vs-build-ifx/modules/SuperController_Types.vfproj +++ b/vs-build-ifx/modules/SuperController_Types.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,11 +87,11 @@ - + - + diff --git a/vs-build-ifx/modules/TurbSim.vfproj b/vs-build-ifx/modules/TurbSim.vfproj index bc9fca18ec..5fe2c603c2 100644 --- a/vs-build-ifx/modules/TurbSim.vfproj +++ b/vs-build-ifx/modules/TurbSim.vfproj @@ -1,24 +1,46 @@ - - + + - - - + + + - + + + + + + + + + + + + + + + + + + + + + + + - - - + + + @@ -27,20 +49,42 @@ - - - + + + - + + + + + + + + + + + + + + + + + + + + + + + - - - + + + @@ -51,9 +95,8 @@ - - - + + diff --git a/vs-build-ifx/modules/VersionInfo.vfproj b/vs-build-ifx/modules/VersionInfo.vfproj index bc91c8950d..cb0d8c28db 100644 --- a/vs-build-ifx/modules/VersionInfo.vfproj +++ b/vs-build-ifx/modules/VersionInfo.vfproj @@ -1,33 +1,93 @@ - - + + - - + + - + - - + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + diff --git a/vs-build-ifx/modules/WakeDynamics.vfproj b/vs-build-ifx/modules/WakeDynamics.vfproj index 758d497c31..b76b0fce27 100644 --- a/vs-build-ifx/modules/WakeDynamics.vfproj +++ b/vs-build-ifx/modules/WakeDynamics.vfproj @@ -1,22 +1,42 @@ - - + + - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -25,18 +45,38 @@ - - + + - + + + + + + + + + + + + + + + + + + + + + - - + + @@ -47,8 +87,8 @@ - - + + diff --git a/vs-build-ifx/update-vfproj.py b/vs-build-ifx/update-vfproj.py index 4c4493acc5..778f0a4dd1 100644 --- a/vs-build-ifx/update-vfproj.py +++ b/vs-build-ifx/update-vfproj.py @@ -1,16 +1,127 @@ from pathlib import Path -from bs4 import BeautifulSoup +import bs4 +import copy -with open('configsurations.xml') as fp: - configs = soup = BeautifulSoup(fp, 'xml') +formatter = bs4.formatter.HTMLFormatter(indent=4) + +options_debug_release = {"Debug": {}, "Release": {}} + +cfg_names = [ + "Debug|x64", + "Debug_Double|x64", + "Debug_Matlab|x64", + "Release|x64", + "Release_Double|x64", + "Release_Matlab|x64", + "Release_OpenMP|x64", + "Release_Double_OpenMP|x64", +] + +for path in Path(".").rglob("*.vfproj"): -for path in Path('.').rglob('*.vfproj'): print(path) with open(path) as fp: - soup = BeautifulSoup(fp, 'xml') - for cfg in soup.findAll('Configuration'): - configs[cfg['Name']] = cfg - break + soup = bs4.BeautifulSoup(fp, "xml") + cfgs = soup.find("Configurations") + cfg_map = { + "Debug|x64": cfgs.find("Configuration", Name="Debug|x64"), + "Release|x64": cfgs.find("Configuration", Name="Release|x64"), + } + cfgs.clear() + for cfg_name in cfg_names: + if "Debug" in cfg_name: + cfg = copy.copy(cfg_map["Debug|x64"]) + else: + cfg = copy.copy(cfg_map["Release|x64"]) + cfg["Name"] = cfg_name + + # Get tool elements + compiler_tool = cfg.find("Tool", Name="VFFortranCompilerTool") + linker_tool = cfg.find("Tool", Name="VFLinkerTool") + prebuild_tool = cfg.find("Tool", Name="VFPreBuildEventTool") + + # Compiler tool settings + compiler_tool["Preprocess"] = "preprocessYes" + compiler_tool["MultiProcessorCompilation"] = "true" + compiler_tool["UseMkl"] = "mklSequential" + compiler_tool["WarnUnusedVariables"] = "false" + if "Debug" in cfg["Name"]: + compiler_tool["RuntimeLibrary"] = "rtMultiThreadedDebug" + else: + compiler_tool["RuntimeLibrary"] = "rtMultiThreaded" + + # Determine project type (static lib, shared lib, executable) + if cfg.attrs.get("ConfigurationType", "") == "typeStaticLibrary": + cfg["OutputDirectory"] = "..\\..\\build\\lib" + elif cfg.attrs.get("ConfigurationType", "") == "typeDynamicLibrary": + cfg["OutputDirectory"] = "..\\..\\build\\bin" + compiler_tool["AdditionalOptions"] = "/fpe-all:0" + compiler_tool["FloatingPointExceptionHandling"] = "fpe0" + linker_tool["StackReserveSize"] = "9999999" + elif linker_tool != None and linker_tool["SubSystem"] == "subSystemConsole": + cfg["OutputDirectory"] = "..\\..\\build\\bin" + compiler_tool["AdditionalOptions"] = "/fpe-all:0" + compiler_tool["FloatingPointExceptionHandling"] = "fpe0" + linker_tool["StackReserveSize"] = "9999999" + else: + print("unknown project type") + continue + + # Set intermediate build directory + cfg["IntermediateDirectory"] = ( + "..\\..\\build\\$(Configuration)_$(Platform)\\$(ProjectName)\\" + ) + + # Preprocessor defines + defines = [] + + # Project specific settings + if "NWTC" in str(path): + # defines.append("HAS_FORTRAN2008_FEATURES") + pass + if "VersionInfo" in str(path): + defines.append("GIT_INCLUDE_FILE='..\\gitVersionInfo.h'") + prebuild_tool["CommandLine"] = "..\\CreateGitVersion.bat" + + # Configuration spectific settings + if "Double" in cfg["Name"]: + compiler_tool["RealKIND"] = "realKIND8" + compiler_tool["DoublePrecisionKIND"] = "doublePrecisionKIND8" + if "NWTC" in str(path): + defines.append("OPENFAST_DOUBLE_PRECISION") + if "OpenMP" in cfg["Name"]: + compiler_tool["OpenMP"] = "OpenMPParallelCode" + compiler_tool["EnableOpenMPSupport"] = "OpenMPParallelCodeIFX" + if "Matlab" in cfg["Name"]: + defines.append("COMPILE_SIMULINK") + defines.append("CONSOLE_FILE") + + # Preprocessor defines + compiler_tool["PreprocessorDefinitions"] = ";".join(defines) + + # Add config to configs + cfgs.append(cfg) + + # Update registry file configurations + for f in soup.find_all("File"): + fcs = f.find_all("FileConfiguration") + if len(fcs) == 0: + continue + fc_base = copy.copy(fcs[0]) + for fc in f.find_all("FileConfiguration"): + fc.decompose() + for cfg_name in cfg_names: + fc = copy.copy(fc_base) + fc["Name"] = cfg_name + f.append(fc) -print(configs) \ No newline at end of file + # Write file + with open(path, "w") as fp: + for line in soup.prettify().splitlines(): + try: + n = line.index("<") + except: + n = 0 + line = ("\t" * n) + line[n:] + "\n" + fp.write(line) From c6fc177e6004f4309307706b1564fd704d715f09 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 19 Nov 2024 14:48:45 -0500 Subject: [PATCH 288/319] Moved driver projects, fixed SuperController --- vs-build-ifx/OpenFAST.sln | 252 ++++++++++++------ .../AeroDyn_Driver.vfproj | 0 .../BeamDyn_Driver.vfproj | 0 .../MoorDyn_Driver.vfproj | 0 vs-build-ifx/drivers/OrcaFlex_Driver.vfproj | 105 ++++++++ vs-build-ifx/drivers/SED_Driver.vfproj | 105 ++++++++ vs-build-ifx/drivers/SeaState_Driver.vfproj | 103 +++++++ vs-build-ifx/drivers/SubDyn_Driver.vfproj | 103 +++++++ vs-build-ifx/modules/OpenFAST-Prelib.vfproj | 32 +-- vs-build-ifx/modules/OrcaFlex.vfproj | 31 ++- vs-build-ifx/modules/SeaState.vfproj | 139 +++++++++- vs-build-ifx/modules/ServoDyn.vfproj | 58 +++- vs-build-ifx/modules/SimpleElastoDyn.vfproj | 31 ++- vs-build-ifx/modules/SubDyn.vfproj | 31 ++- vs-build-ifx/modules/SuperController.vfproj | 67 +++-- .../modules/SuperController_Types.vfproj | 72 +++-- vs-build-ifx/modules/TurbSim.vfproj | 1 - vs-build-ifx/modules/WakeDynamics.vfproj | 31 ++- 18 files changed, 996 insertions(+), 165 deletions(-) rename vs-build-ifx/{modules => drivers}/AeroDyn_Driver.vfproj (100%) rename vs-build-ifx/{modules => drivers}/BeamDyn_Driver.vfproj (100%) rename vs-build-ifx/{modules => drivers}/MoorDyn_Driver.vfproj (100%) create mode 100644 vs-build-ifx/drivers/OrcaFlex_Driver.vfproj create mode 100644 vs-build-ifx/drivers/SED_Driver.vfproj create mode 100644 vs-build-ifx/drivers/SeaState_Driver.vfproj create mode 100644 vs-build-ifx/drivers/SubDyn_Driver.vfproj diff --git a/vs-build-ifx/OpenFAST.sln b/vs-build-ifx/OpenFAST.sln index 3b7a6f7141..6bec22bde4 100644 --- a/vs-build-ifx/OpenFAST.sln +++ b/vs-build-ifx/OpenFAST.sln @@ -34,13 +34,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "modules\BeamDyn. {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn_Driver", "modules\BeamDyn_Driver.vfproj", "{D9220A21-8C69-42E4-B085-E5D996B867D9}" - ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - EndProjectSection -EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDisk", "modules\AeroDisk.vfproj", "{731C6D0A-CF24-4FD3-ABAC-17F31D97A188}" ProjectSection(ProjectDependencies) = postProject {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} @@ -171,13 +164,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn", "modules\MoorDyn. EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "MAP-C", "modules\MAP-C.vcxproj", "{471EEB17-A1AA-43B0-ACEE-719B80BB4811}" EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn_Driver", "modules\MoorDyn_Driver.vfproj", "{FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}" - ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - EndProjectSection -EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OrcaFlex", "modules\OrcaFlex.vfproj", "{B50C776E-F931-4E83-916F-C4E6977E40A3}" ProjectSection(ProjectDependencies) = postProject {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} @@ -231,7 +217,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController", "modules\ {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} = {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} EndProjectSection @@ -259,6 +244,7 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Prelib", "modules\ {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} EndProjectSection EndProject @@ -346,16 +332,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Library", "modules {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} EndProjectSection EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver", "modules\AeroDyn_Driver.vfproj", "{2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}" - ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - EndProjectSection -EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Inflow", "modules\AeroDyn_Inflow.vfproj", "{ACF05685-6592-462C-A3B3-9CDE2CAFD958}" ProjectSection(ProjectDependencies) = postProject {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} @@ -425,7 +401,6 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST", "glue-codes\Open {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} = {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} EndProjectSection @@ -462,11 +437,64 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST.Farm", "glue-codes\FAS {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} EndProjectSection EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Drivers", "Drivers", "{3517E990-350F-4471-A518-8B0BC77CFDDB}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver", "drivers\AeroDyn_Driver.vfproj", "{D9220A21-8C69-42E4-B085-E5D996B867D9}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn_Driver", "drivers\BeamDyn_Driver.vfproj", "{E32296E3-72E8-435B-9BF3-2FAE02189CA5}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn_Driver", "drivers\MoorDyn_Driver.vfproj", "{9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OrcaFlex_Driver", "drivers\OrcaFlex_Driver.vfproj", "{4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SeaState_Driver", "drivers\SeaState_Driver.vfproj", "{F861FB71-8FE4-42A5-8FB4-684F60D50B9C}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SubDyn_Driver", "drivers\SubDyn_Driver.vfproj", "{09919696-2DC4-48A3-B862-7BBF5CFD59CE}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SED_Driver", "drivers\SED_Driver.vfproj", "{C271833A-06D0-441D-A5A8-DDAB0AA4740C}" + ProjectSection(ProjectDependencies) = postProject + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug_Double|x64 = Debug_Double|x64 @@ -575,22 +603,6 @@ Global {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.ActiveCfg = Release|x64 {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.Build.0 = Release|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.ActiveCfg = Debug|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.Build.0 = Debug|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double|x64.Build.0 = Release_Double|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.ActiveCfg = Release|x64 - {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.Build.0 = Release|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Double|x64.Build.0 = Debug_Double|x64 {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 @@ -798,22 +810,6 @@ Global {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_OpenMP|x64.Build.0 = Release|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.ActiveCfg = Release|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.Build.0 = Release|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x64.ActiveCfg = Debug|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Debug|x64.Build.0 = Debug|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Double|x64.Build.0 = Release_Double|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x64.ActiveCfg = Release|x64 - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB}.Release|x64.Build.0 = Release|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Double|x64.Build.0 = Debug_Double|x64 {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 @@ -1006,22 +1002,6 @@ Global {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.ActiveCfg = Release|x64 {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.Build.0 = Release|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x64.ActiveCfg = Debug|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Debug|x64.Build.0 = Debug|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Double|x64.Build.0 = Release_Double|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x64.ActiveCfg = Release|x64 - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3}.Release|x64.Build.0 = Release|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Double|x64.Build.0 = Debug_Double|x64 {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 @@ -1118,6 +1098,118 @@ Global {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.ActiveCfg = Release|x64 {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.Build.0 = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.ActiveCfg = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.Build.0 = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double|x64.Build.0 = Release_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.ActiveCfg = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.Build.0 = Release|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug|x64.ActiveCfg = Debug|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug|x64.Build.0 = Debug|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Double|x64.Build.0 = Release_Double|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release|x64.ActiveCfg = Release|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release|x64.Build.0 = Release|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug|x64.ActiveCfg = Debug|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug|x64.Build.0 = Debug|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Double|x64.Build.0 = Release_Double|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release|x64.ActiveCfg = Release|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release|x64.Build.0 = Release|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug|x64.ActiveCfg = Debug|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug|x64.Build.0 = Debug|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Double|x64.Build.0 = Release_Double|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release|x64.ActiveCfg = Release|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release|x64.Build.0 = Release|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug|x64.ActiveCfg = Debug|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug|x64.Build.0 = Debug|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Double|x64.Build.0 = Release_Double|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release|x64.ActiveCfg = Release|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release|x64.Build.0 = Release|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug|x64.ActiveCfg = Debug|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug|x64.Build.0 = Debug|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Double|x64.Build.0 = Release_Double|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release|x64.ActiveCfg = Release|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release|x64.Build.0 = Release|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug|x64.ActiveCfg = Debug|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug|x64.Build.0 = Debug|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Double|x64.Build.0 = Release_Double|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release|x64.ActiveCfg = Release|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release|x64.Build.0 = Release|x64 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -1129,7 +1221,6 @@ Global {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {272B8080-A022-4F4A-BDD6-835871E44C23} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {272B8080-A022-4F4A-BDD6-835871E44C23} {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {272B8080-A022-4F4A-BDD6-835871E44C23} - {D9220A21-8C69-42E4-B085-E5D996B867D9} = {272B8080-A022-4F4A-BDD6-835871E44C23} {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {272B8080-A022-4F4A-BDD6-835871E44C23} {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {272B8080-A022-4F4A-BDD6-835871E44C23} {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {272B8080-A022-4F4A-BDD6-835871E44C23} @@ -1143,7 +1234,6 @@ Global {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {272B8080-A022-4F4A-BDD6-835871E44C23} {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {272B8080-A022-4F4A-BDD6-835871E44C23} {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {272B8080-A022-4F4A-BDD6-835871E44C23} - {FB0BB5F1-58E8-4F0D-93B5-7D8130A26EEB} = {272B8080-A022-4F4A-BDD6-835871E44C23} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {272B8080-A022-4F4A-BDD6-835871E44C23} {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {272B8080-A022-4F4A-BDD6-835871E44C23} {2467FDD4-622B-4628-993A-73994FB8172E} = {272B8080-A022-4F4A-BDD6-835871E44C23} @@ -1156,13 +1246,19 @@ Global {774BDC53-33C4-4926-B01D-DC376DAE055B} = {272B8080-A022-4F4A-BDD6-835871E44C23} {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {272B8080-A022-4F4A-BDD6-835871E44C23} {6906E75C-2A54-431B-A11D-145864FCDD5C} = {272B8080-A022-4F4A-BDD6-835871E44C23} - {2B0BE3C8-FAE3-4137-9E6C-E2E30F8D00F3} = {272B8080-A022-4F4A-BDD6-835871E44C23} {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {272B8080-A022-4F4A-BDD6-835871E44C23} {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {272B8080-A022-4F4A-BDD6-835871E44C23} {DB03A086-3362-41E5-930A-B151D137ACCF} = {272B8080-A022-4F4A-BDD6-835871E44C23} {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} = {272B8080-A022-4F4A-BDD6-835871E44C23} {6E5137FC-19EB-4A7F-AAE8-523AAF95A861} = {D7D6BEC5-A67B-4D15-81F9-D846A7041C5D} {4A398285-E3C7-4CD9-8F43-51A017D5A48A} = {D7D6BEC5-A67B-4D15-81F9-D846A7041C5D} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {E32296E3-72E8-435B-9BF3-2FAE02189CA5} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {09919696-2DC4-48A3-B862-7BBF5CFD59CE} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {C271833A-06D0-441D-A5A8-DDAB0AA4740C} = {3517E990-350F-4471-A518-8B0BC77CFDDB} EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {B362252D-3254-4C68-B527-CC85CE3CCF75} diff --git a/vs-build-ifx/modules/AeroDyn_Driver.vfproj b/vs-build-ifx/drivers/AeroDyn_Driver.vfproj similarity index 100% rename from vs-build-ifx/modules/AeroDyn_Driver.vfproj rename to vs-build-ifx/drivers/AeroDyn_Driver.vfproj diff --git a/vs-build-ifx/modules/BeamDyn_Driver.vfproj b/vs-build-ifx/drivers/BeamDyn_Driver.vfproj similarity index 100% rename from vs-build-ifx/modules/BeamDyn_Driver.vfproj rename to vs-build-ifx/drivers/BeamDyn_Driver.vfproj diff --git a/vs-build-ifx/modules/MoorDyn_Driver.vfproj b/vs-build-ifx/drivers/MoorDyn_Driver.vfproj similarity index 100% rename from vs-build-ifx/modules/MoorDyn_Driver.vfproj rename to vs-build-ifx/drivers/MoorDyn_Driver.vfproj diff --git a/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj b/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj new file mode 100644 index 0000000000..0125446ca0 --- /dev/null +++ b/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/SED_Driver.vfproj b/vs-build-ifx/drivers/SED_Driver.vfproj new file mode 100644 index 0000000000..53a375cc3b --- /dev/null +++ b/vs-build-ifx/drivers/SED_Driver.vfproj @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/SeaState_Driver.vfproj b/vs-build-ifx/drivers/SeaState_Driver.vfproj new file mode 100644 index 0000000000..86d2eecebf --- /dev/null +++ b/vs-build-ifx/drivers/SeaState_Driver.vfproj @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/SubDyn_Driver.vfproj b/vs-build-ifx/drivers/SubDyn_Driver.vfproj new file mode 100644 index 0000000000..ed10291fcc --- /dev/null +++ b/vs-build-ifx/drivers/SubDyn_Driver.vfproj @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj index 11bf701596..f6c207a219 100644 --- a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj +++ b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj @@ -90,54 +90,54 @@ - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/vs-build-ifx/modules/OrcaFlex.vfproj b/vs-build-ifx/modules/OrcaFlex.vfproj index de59597765..426730a9fe 100644 --- a/vs-build-ifx/modules/OrcaFlex.vfproj +++ b/vs-build-ifx/modules/OrcaFlex.vfproj @@ -1,7 +1,6 @@ - @@ -87,10 +86,36 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + - diff --git a/vs-build-ifx/modules/SeaState.vfproj b/vs-build-ifx/modules/SeaState.vfproj index 17257bec2c..e2c1b8b50e 100644 --- a/vs-build-ifx/modules/SeaState.vfproj +++ b/vs-build-ifx/modules/SeaState.vfproj @@ -1,7 +1,6 @@ - @@ -87,25 +86,151 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - diff --git a/vs-build-ifx/modules/ServoDyn.vfproj b/vs-build-ifx/modules/ServoDyn.vfproj index 0c739f73bc..4d60d4b318 100644 --- a/vs-build-ifx/modules/ServoDyn.vfproj +++ b/vs-build-ifx/modules/ServoDyn.vfproj @@ -1,7 +1,6 @@ - @@ -87,17 +86,68 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - diff --git a/vs-build-ifx/modules/SimpleElastoDyn.vfproj b/vs-build-ifx/modules/SimpleElastoDyn.vfproj index 73e0c1de87..87977f36ed 100644 --- a/vs-build-ifx/modules/SimpleElastoDyn.vfproj +++ b/vs-build-ifx/modules/SimpleElastoDyn.vfproj @@ -1,7 +1,6 @@ - @@ -87,12 +86,38 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + - diff --git a/vs-build-ifx/modules/SubDyn.vfproj b/vs-build-ifx/modules/SubDyn.vfproj index 000a3d614c..4e53f284ec 100644 --- a/vs-build-ifx/modules/SubDyn.vfproj +++ b/vs-build-ifx/modules/SubDyn.vfproj @@ -1,7 +1,6 @@ - @@ -87,7 +86,34 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -95,7 +121,6 @@ - diff --git a/vs-build-ifx/modules/SuperController.vfproj b/vs-build-ifx/modules/SuperController.vfproj index 0223df34ac..71586b4c4c 100644 --- a/vs-build-ifx/modules/SuperController.vfproj +++ b/vs-build-ifx/modules/SuperController.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -14,9 +14,11 @@ + - - + + + @@ -24,9 +26,11 @@ + - - + + + @@ -34,9 +38,11 @@ + - - + + + @@ -44,9 +50,11 @@ + - - + + + @@ -54,9 +62,11 @@ + - - + + + @@ -64,9 +74,11 @@ + - - + + + @@ -74,9 +86,11 @@ + - - + + + @@ -84,14 +98,19 @@ + - - - - - + + + + + + + + + diff --git a/vs-build-ifx/modules/SuperController_Types.vfproj b/vs-build-ifx/modules/SuperController_Types.vfproj index afd2dd3009..0dd006b6ae 100644 --- a/vs-build-ifx/modules/SuperController_Types.vfproj +++ b/vs-build-ifx/modules/SuperController_Types.vfproj @@ -1,12 +1,11 @@ - - + + - - - + + @@ -15,8 +14,8 @@ - - + + @@ -25,8 +24,8 @@ - - + + @@ -35,8 +34,8 @@ - - + + @@ -45,8 +44,8 @@ - - + + @@ -55,8 +54,8 @@ - - + + @@ -65,8 +64,8 @@ - - + + @@ -75,8 +74,8 @@ - - + + @@ -87,14 +86,41 @@ - + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/TurbSim.vfproj b/vs-build-ifx/modules/TurbSim.vfproj index 5fe2c603c2..94030df3fd 100644 --- a/vs-build-ifx/modules/TurbSim.vfproj +++ b/vs-build-ifx/modules/TurbSim.vfproj @@ -95,7 +95,6 @@ - diff --git a/vs-build-ifx/modules/WakeDynamics.vfproj b/vs-build-ifx/modules/WakeDynamics.vfproj index b76b0fce27..cf5e3aab82 100644 --- a/vs-build-ifx/modules/WakeDynamics.vfproj +++ b/vs-build-ifx/modules/WakeDynamics.vfproj @@ -1,7 +1,6 @@ - @@ -87,10 +86,36 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + - From f4ef8abd7a6db0fd4a1a6337a0ae5dcd6dbc463f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 20 Nov 2024 13:51:35 -0500 Subject: [PATCH 289/319] Fix build in VS2019 --- .../nwtc-library/src/NWTC_Library_Types.f90 | 1 + .../src/registry_gen_fortran.cpp | 3 +- vs-build-ifx/OpenFAST.sln | 392 +++++++++--------- vs-build-ifx/modules/AeroDyn_Inflow.vfproj | 2 +- vs-build-ifx/modules/NWTC-Library.vfproj | 135 +++--- vs-build-ifx/modules/Registry.vcxproj | 4 +- 6 files changed, 260 insertions(+), 277 deletions(-) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index b7d9d98024..942fb383a6 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE NWTC_Library_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE Precision USE SysSubs USE ModReg IMPLICIT NONE diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index d825822623..7cb92cd30b 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -107,7 +107,8 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // If this is the NWTC Library, we're not going to print "USE NWTC_Library" if (tolower(mod.name).compare("nwtc_library") == 0) - w << "USE SysSubs\n" + w << "USE Precision\n" + << "USE SysSubs\n" << "USE ModReg\n"; else w << "USE NWTC_Library\n"; diff --git a/vs-build-ifx/OpenFAST.sln b/vs-build-ifx/OpenFAST.sln index 6bec22bde4..2992d3d69b 100644 --- a/vs-build-ifx/OpenFAST.sln +++ b/vs-build-ifx/OpenFAST.sln @@ -1,25 +1,22 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 17 -VisualStudioVersion = 17.9.34902.65 +# Visual Studio Version 16 +VisualStudioVersion = 16.0.35425.106 MinimumVisualStudioVersion = 10.0.40219.1 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Registry", "modules\Registry.vcxproj", "{EC73DA51-78CF-41DB-9DFA-88360BF2EA93}" EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn", "modules\AeroDyn.vfproj", "{5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}" ProjectSection(ProjectDependencies) = postProject - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "NWTC-Library", "modules\NWTC-Library.vfproj", "{EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}" - ProjectSection(ProjectDependencies) = postProject - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} - EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "InflowWind", "modules\InflowWind.vfproj", "{9CB36EC2-18AF-468E-BE43-FE63E383AA3A}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "VersionInfo", "modules\VersionInfo.vfproj", "{12DF411B-C7DA-47BA-BB85-7714D5FD2A16}" @@ -29,242 +26,244 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "VersionInfo", "modules\Vers EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "modules\BeamDyn.vfproj", "{A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDisk", "modules\AeroDisk.vfproj", "{731C6D0A-CF24-4FD3-ABAC-17F31D97A188}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ElastoDyn", "modules\ElastoDyn.vfproj", "{E8C5BB9B-9709-41FA-B6F2-F334B112663A}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExternalInflow", "modules\ExternalInflow.vfproj", "{B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} - {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} - {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} - {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} - {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads", "modules\ExtLoads.vfproj", "{AD8D7798-F800-4C73-B896-7E48EF1D52D3}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} - {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} - {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} - {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} - {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtPtfm", "modules\ExtPtfm.vfproj", "{3000393A-702F-488E-B918-1D37955FA8D3}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FEAMooring", "modules\FEAMooring.vfproj", "{676276A1-DC23-4287-8386-07076303C39D}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "HydroDyn", "modules\HydroDyn.vfproj", "{1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SeaState", "modules\SeaState.vfproj", "{951A453F-1999-483D-848A-9B63C282F43D}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "IceDyn", "modules\IceDyn.vfproj", "{D029FC73-035C-4EB8-96DA-5B1131706A2D}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "IceFloe", "modules\IceFloe.vfproj", "{FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MAP", "modules\MAP.vfproj", "{5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn", "modules\MoorDyn.vfproj", "{923F8E1F-F5FC-4572-9C32-94C90F04A5A9}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "MAP-C", "modules\MAP-C.vcxproj", "{471EEB17-A1AA-43B0-ACEE-719B80BB4811}" + ProjectSection(ProjectDependencies) = postProject + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OrcaFlex", "modules\OrcaFlex.vfproj", "{B50C776E-F931-4E83-916F-C4E6977E40A3}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ServoDyn", "modules\ServoDyn.vfproj", "{46EB37F1-EEBA-4F35-A173-A37D42D97B5B}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SimpleElastoDyn", "modules\SimpleElastoDyn.vfproj", "{2467FDD4-622B-4628-993A-73994FB8172E}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SubDyn", "modules\SubDyn.vfproj", "{648CD825-ECB0-46D1-B1AA-A28F5C36CD91}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController", "modules\SuperController.vfproj", "{7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} - {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} - {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} - {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} - {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Prelib", "modules\OpenFAST-Prelib.vfproj", "{FE80CE9A-7E16-476D-B63A-F9F870ACB662}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} - {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} - {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} - {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "TurbSim", "modules\TurbSim.vfproj", "{916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "WakeDynamics", "modules\WakeDynamics.vfproj", "{029204DD-3D5B-47C6-8CAA-A933886D4674}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExternalInflow_Types", "modules\ExternalInflow_Types.vfproj", "{3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}" ProjectSection(ProjectDependencies) = postProject - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads_Types", "modules\ExtLoads_Types.vfproj", "{774BDC53-33C4-4926-B01D-DC376DAE055B}" @@ -274,225 +273,225 @@ Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads_Types", "modules\E EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController_Types", "modules\SuperController_Types.vfproj", "{2542E42E-CF7F-48F3-8621-6BCFC61102BF}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} - {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} - {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} - {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} - {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} EndProjectSection EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Modules", "Modules", "{272B8080-A022-4F4A-BDD6-835871E44C23}" EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Library", "modules\OpenFAST-Library.vfproj", "{6906E75C-2A54-431B-A11D-145864FCDD5C}" ProjectSection(ProjectDependencies) = postProject - {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} - {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} - {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} - {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} - {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} - {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} - {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Inflow", "modules\AeroDyn_Inflow.vfproj", "{ACF05685-6592-462C-A3B3-9CDE2CAFD958}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver_Subs", "modules\AeroDyn_Driver_Subs.vfproj", "{60BA8F27-5C49-42DA-9CE4-F85A8215D02A}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Inflow_C_Binding", "modules\AeroDyn_Inflow_C_Binding.vfproj", "{DB03A086-3362-41E5-930A-B151D137ACCF}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AWAE", "modules\AWAE.vfproj", "{CA8A0366-3C47-439A-8E9A-25BB36E3C10D}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} EndProjectSection EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Glue Codes", "Glue Codes", "{D7D6BEC5-A67B-4D15-81F9-D846A7041C5D}" EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST", "glue-codes\OpenFAST.vfproj", "{6E5137FC-19EB-4A7F-AAE8-523AAF95A861}" ProjectSection(ProjectDependencies) = postProject - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} - {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} - {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} - {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} - {6906E75C-2A54-431B-A11D-145864FCDD5C} = {6906E75C-2A54-431B-A11D-145864FCDD5C} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} - {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} - {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} - {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {6906E75C-2A54-431B-A11D-145864FCDD5C} = {6906E75C-2A54-431B-A11D-145864FCDD5C} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} - {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} - {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST.Farm", "glue-codes\FAST.Farm.vfproj", "{4A398285-E3C7-4CD9-8F43-51A017D5A48A}" ProjectSection(ProjectDependencies) = postProject - {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} - {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} - {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} - {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} - {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} - {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} - {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} - {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} - {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} - {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} - {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} - {6906E75C-2A54-431B-A11D-145864FCDD5C} = {6906E75C-2A54-431B-A11D-145864FCDD5C} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} - {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} - {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} - {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} - {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} - {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} - {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {6906E75C-2A54-431B-A11D-145864FCDD5C} = {6906E75C-2A54-431B-A11D-145864FCDD5C} {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} = {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} - {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} - {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} - {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} EndProjectSection EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Drivers", "Drivers", "{3517E990-350F-4471-A518-8B0BC77CFDDB}" EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver", "drivers\AeroDyn_Driver.vfproj", "{D9220A21-8C69-42E4-B085-E5D996B867D9}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} - {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn_Driver", "drivers\BeamDyn_Driver.vfproj", "{E32296E3-72E8-435B-9BF3-2FAE02189CA5}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn_Driver", "drivers\MoorDyn_Driver.vfproj", "{9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OrcaFlex_Driver", "drivers\OrcaFlex_Driver.vfproj", "{4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SeaState_Driver", "drivers\SeaState_Driver.vfproj", "{F861FB71-8FE4-42A5-8FB4-684F60D50B9C}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SubDyn_Driver", "drivers\SubDyn_Driver.vfproj", "{09919696-2DC4-48A3-B862-7BBF5CFD59CE}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SED_Driver", "drivers\SED_Driver.vfproj", "{C271833A-06D0-441D-A5A8-DDAB0AA4740C}" ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} - {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} EndProjectSection EndProject Global @@ -796,6 +795,7 @@ Global {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.ActiveCfg = Release|x64 {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.Build.0 = Release|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Double|x64.ActiveCfg = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Double|x64.Build.0 = Debug|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Matlab|x64.ActiveCfg = Debug|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Matlab|x64.Build.0 = Debug|x64 {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.ActiveCfg = Debug|x64 diff --git a/vs-build-ifx/modules/AeroDyn_Inflow.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow.vfproj index 90e8fe75e1..97c709c2e3 100644 --- a/vs-build-ifx/modules/AeroDyn_Inflow.vfproj +++ b/vs-build-ifx/modules/AeroDyn_Inflow.vfproj @@ -87,7 +87,7 @@ - + diff --git a/vs-build-ifx/modules/NWTC-Library.vfproj b/vs-build-ifx/modules/NWTC-Library.vfproj index acc0140f45..5ad5668449 100644 --- a/vs-build-ifx/modules/NWTC-Library.vfproj +++ b/vs-build-ifx/modules/NWTC-Library.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,8 @@ - - + + @@ -24,8 +24,8 @@ - - + + @@ -34,9 +34,9 @@ - - - + + + @@ -45,9 +45,9 @@ - - - + + + @@ -56,9 +56,9 @@ - - - + + + @@ -67,9 +67,9 @@ - - - + + + @@ -78,9 +78,9 @@ - - - + + + @@ -91,42 +91,14 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - + @@ -136,6 +108,15 @@ + + + + + + + + + @@ -145,23 +126,23 @@ - - - + + + + + - - @@ -171,21 +152,12 @@ - - - - - - - - - @@ -200,23 +172,32 @@ - + + - + + - - + + + + - - + + + + - - - + + + + + + diff --git a/vs-build-ifx/modules/Registry.vcxproj b/vs-build-ifx/modules/Registry.vcxproj index 72098e4114..544c947e1d 100644 --- a/vs-build-ifx/modules/Registry.vcxproj +++ b/vs-build-ifx/modules/Registry.vcxproj @@ -102,11 +102,11 @@ - ..\..\build\lib\ + ..\..\build\bin\ ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ - ..\..\build\lib\ + ..\..\build\bin\ ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ From 1217146519f75278d3e786e9fe635edaa38fc074 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 25 Nov 2024 16:59:20 -0500 Subject: [PATCH 290/319] Resolve stack overflow in using ifx --- .../openfast-library/src/FAST_SolverTC.f90 | 6 +- vs-build-ifx/drivers/AeroDyn_Driver.vfproj | 16 +++--- vs-build-ifx/drivers/BeamDyn_Driver.vfproj | 16 +++--- vs-build-ifx/drivers/MoorDyn_Driver.vfproj | 16 +++--- vs-build-ifx/drivers/OrcaFlex_Driver.vfproj | 16 +++--- vs-build-ifx/drivers/SED_Driver.vfproj | 16 +++--- vs-build-ifx/drivers/SeaState_Driver.vfproj | 16 +++--- vs-build-ifx/drivers/SubDyn_Driver.vfproj | 16 +++--- vs-build-ifx/glue-codes/FAST.Farm.vfproj | 16 +++--- vs-build-ifx/glue-codes/OpenFAST.vfproj | 56 +++++++++---------- .../modules/AeroDyn_Inflow_C_Binding.vfproj | 16 +++--- vs-build-ifx/modules/SuperController.vfproj | 16 +++--- vs-build-ifx/modules/TurbSim.vfproj | 16 +++--- 13 files changed, 118 insertions(+), 120 deletions(-) diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index aafcc698e7..c87dbcbbd6 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -1751,10 +1751,8 @@ subroutine BuildJacobianTC(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat associate (dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & dYTdx2 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2)), & dYTdx1 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) - ! J21 = C1*matmul(dUTdyT, dYTdx2) + C2*matmul(dUTdyT, dYTdx1) - call LAPACK_GEMM('N', 'N', p%GammaPrime, dUTdyT, dYTdx2, 0.0_R8Ki, m%J21, ErrStat2, ErrMsg2); if (Failed()) return - call LAPACK_GEMM('N', 'N', p%BetaPrime, dUTdyT, dYTdx1, 1.0_R8Ki, m%J21, ErrStat2, ErrMsg2); if (Failed()) return - m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)) = m%J21 + m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)) = & + p%GammaPrime*matmul(dUTdyT, dYTdx2) + p%BetaPrime*matmul(dUTdyT, dYTdx1) end associate end if diff --git a/vs-build-ifx/drivers/AeroDyn_Driver.vfproj b/vs-build-ifx/drivers/AeroDyn_Driver.vfproj index a4d16b38fb..49daad02aa 100644 --- a/vs-build-ifx/drivers/AeroDyn_Driver.vfproj +++ b/vs-build-ifx/drivers/AeroDyn_Driver.vfproj @@ -5,7 +5,7 @@ - + @@ -16,7 +16,7 @@ - + @@ -27,7 +27,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -49,7 +49,7 @@ - + @@ -60,7 +60,7 @@ - + @@ -71,7 +71,7 @@ - + @@ -82,7 +82,7 @@ - + diff --git a/vs-build-ifx/drivers/BeamDyn_Driver.vfproj b/vs-build-ifx/drivers/BeamDyn_Driver.vfproj index 549a2c49b0..591067ff13 100644 --- a/vs-build-ifx/drivers/BeamDyn_Driver.vfproj +++ b/vs-build-ifx/drivers/BeamDyn_Driver.vfproj @@ -5,7 +5,7 @@ - + @@ -16,7 +16,7 @@ - + @@ -27,7 +27,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -49,7 +49,7 @@ - + @@ -60,7 +60,7 @@ - + @@ -71,7 +71,7 @@ - + @@ -82,7 +82,7 @@ - + diff --git a/vs-build-ifx/drivers/MoorDyn_Driver.vfproj b/vs-build-ifx/drivers/MoorDyn_Driver.vfproj index 14fc89a33a..9c1f276903 100644 --- a/vs-build-ifx/drivers/MoorDyn_Driver.vfproj +++ b/vs-build-ifx/drivers/MoorDyn_Driver.vfproj @@ -6,7 +6,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -28,7 +28,7 @@ - + @@ -39,7 +39,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -61,7 +61,7 @@ - + @@ -72,7 +72,7 @@ - + @@ -83,7 +83,7 @@ - + diff --git a/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj b/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj index 0125446ca0..6af4d499c1 100644 --- a/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj +++ b/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj @@ -5,7 +5,7 @@ - + @@ -16,7 +16,7 @@ - + @@ -27,7 +27,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -49,7 +49,7 @@ - + @@ -60,7 +60,7 @@ - + @@ -71,7 +71,7 @@ - + @@ -82,7 +82,7 @@ - + diff --git a/vs-build-ifx/drivers/SED_Driver.vfproj b/vs-build-ifx/drivers/SED_Driver.vfproj index 53a375cc3b..655ca037af 100644 --- a/vs-build-ifx/drivers/SED_Driver.vfproj +++ b/vs-build-ifx/drivers/SED_Driver.vfproj @@ -5,7 +5,7 @@ - + @@ -16,7 +16,7 @@ - + @@ -27,7 +27,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -49,7 +49,7 @@ - + @@ -60,7 +60,7 @@ - + @@ -71,7 +71,7 @@ - + @@ -82,7 +82,7 @@ - + diff --git a/vs-build-ifx/drivers/SeaState_Driver.vfproj b/vs-build-ifx/drivers/SeaState_Driver.vfproj index 86d2eecebf..f8e4761969 100644 --- a/vs-build-ifx/drivers/SeaState_Driver.vfproj +++ b/vs-build-ifx/drivers/SeaState_Driver.vfproj @@ -5,7 +5,7 @@ - + @@ -16,7 +16,7 @@ - + @@ -27,7 +27,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -49,7 +49,7 @@ - + @@ -60,7 +60,7 @@ - + @@ -71,7 +71,7 @@ - + @@ -82,7 +82,7 @@ - + diff --git a/vs-build-ifx/drivers/SubDyn_Driver.vfproj b/vs-build-ifx/drivers/SubDyn_Driver.vfproj index ed10291fcc..a5750bb049 100644 --- a/vs-build-ifx/drivers/SubDyn_Driver.vfproj +++ b/vs-build-ifx/drivers/SubDyn_Driver.vfproj @@ -5,7 +5,7 @@ - + @@ -16,7 +16,7 @@ - + @@ -27,7 +27,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -49,7 +49,7 @@ - + @@ -60,7 +60,7 @@ - + @@ -71,7 +71,7 @@ - + @@ -82,7 +82,7 @@ - + diff --git a/vs-build-ifx/glue-codes/FAST.Farm.vfproj b/vs-build-ifx/glue-codes/FAST.Farm.vfproj index d673ea97d5..411346b404 100644 --- a/vs-build-ifx/glue-codes/FAST.Farm.vfproj +++ b/vs-build-ifx/glue-codes/FAST.Farm.vfproj @@ -5,7 +5,7 @@ - + @@ -16,7 +16,7 @@ - + @@ -27,7 +27,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -49,7 +49,7 @@ - + @@ -60,7 +60,7 @@ - + @@ -71,7 +71,7 @@ - + @@ -82,7 +82,7 @@ - + diff --git a/vs-build-ifx/glue-codes/OpenFAST.vfproj b/vs-build-ifx/glue-codes/OpenFAST.vfproj index 3e2831eb97..cad33ce4b9 100644 --- a/vs-build-ifx/glue-codes/OpenFAST.vfproj +++ b/vs-build-ifx/glue-codes/OpenFAST.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,9 @@ - - - + + + @@ -26,9 +26,9 @@ - - - + + + @@ -37,9 +37,9 @@ - - - + + + @@ -48,9 +48,9 @@ - - - + + + @@ -59,9 +59,9 @@ - - - + + + @@ -70,9 +70,9 @@ - - - + + + @@ -81,9 +81,9 @@ - - - + + + @@ -94,8 +94,8 @@ - - + + diff --git a/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj index def6e6c77d..5566853f5d 100644 --- a/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj +++ b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj @@ -6,7 +6,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -28,7 +28,7 @@ - + @@ -39,7 +39,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -61,7 +61,7 @@ - + @@ -72,7 +72,7 @@ - + @@ -83,7 +83,7 @@ - + diff --git a/vs-build-ifx/modules/SuperController.vfproj b/vs-build-ifx/modules/SuperController.vfproj index 71586b4c4c..f7ccf1fd09 100644 --- a/vs-build-ifx/modules/SuperController.vfproj +++ b/vs-build-ifx/modules/SuperController.vfproj @@ -5,7 +5,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -29,7 +29,7 @@ - + @@ -41,7 +41,7 @@ - + @@ -53,7 +53,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -77,7 +77,7 @@ - + @@ -89,7 +89,7 @@ - + diff --git a/vs-build-ifx/modules/TurbSim.vfproj b/vs-build-ifx/modules/TurbSim.vfproj index 94030df3fd..0f2f46b40b 100644 --- a/vs-build-ifx/modules/TurbSim.vfproj +++ b/vs-build-ifx/modules/TurbSim.vfproj @@ -6,7 +6,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -28,7 +28,7 @@ - + @@ -39,7 +39,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -61,7 +61,7 @@ - + @@ -72,7 +72,7 @@ - + @@ -83,7 +83,7 @@ - + From ff98846a4b05f2a78bfb8eac9a632624a8444b3f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 25 Nov 2024 17:12:57 -0500 Subject: [PATCH 291/319] More work on Visual Studio projects --- vs-build-ifx/drivers/AeroDyn_Driver.vfproj | 16 ++-- vs-build-ifx/drivers/BeamDyn_Driver.vfproj | 16 ++-- vs-build-ifx/drivers/MoorDyn_Driver.vfproj | 16 ++-- vs-build-ifx/drivers/OrcaFlex_Driver.vfproj | 56 ++++++------- vs-build-ifx/drivers/SED_Driver.vfproj | 56 ++++++------- vs-build-ifx/drivers/SeaState_Driver.vfproj | 56 ++++++------- vs-build-ifx/drivers/SubDyn_Driver.vfproj | 56 ++++++------- vs-build-ifx/glue-codes/FAST.Farm.vfproj | 16 ++-- vs-build-ifx/modules/NWTC-Library.vfproj | 78 +++++++++---------- vs-build-ifx/modules/SuperController.vfproj | 58 +++++++------- .../modules/SuperController_Types.vfproj | 70 ++++++++--------- vs-build-ifx/modules/TurbSim.vfproj | 16 ++-- vs-build-ifx/update-vfproj.py | 9 ++- 13 files changed, 260 insertions(+), 259 deletions(-) diff --git a/vs-build-ifx/drivers/AeroDyn_Driver.vfproj b/vs-build-ifx/drivers/AeroDyn_Driver.vfproj index 49daad02aa..6d8ebb3078 100644 --- a/vs-build-ifx/drivers/AeroDyn_Driver.vfproj +++ b/vs-build-ifx/drivers/AeroDyn_Driver.vfproj @@ -6,7 +6,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -28,7 +28,7 @@ - + @@ -39,7 +39,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -61,7 +61,7 @@ - + @@ -72,7 +72,7 @@ - + @@ -83,7 +83,7 @@ - + diff --git a/vs-build-ifx/drivers/BeamDyn_Driver.vfproj b/vs-build-ifx/drivers/BeamDyn_Driver.vfproj index 591067ff13..f187f1e901 100644 --- a/vs-build-ifx/drivers/BeamDyn_Driver.vfproj +++ b/vs-build-ifx/drivers/BeamDyn_Driver.vfproj @@ -6,7 +6,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -28,7 +28,7 @@ - + @@ -39,7 +39,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -61,7 +61,7 @@ - + @@ -72,7 +72,7 @@ - + @@ -83,7 +83,7 @@ - + diff --git a/vs-build-ifx/drivers/MoorDyn_Driver.vfproj b/vs-build-ifx/drivers/MoorDyn_Driver.vfproj index 9c1f276903..d5021c26f1 100644 --- a/vs-build-ifx/drivers/MoorDyn_Driver.vfproj +++ b/vs-build-ifx/drivers/MoorDyn_Driver.vfproj @@ -7,7 +7,7 @@ - + @@ -18,7 +18,7 @@ - + @@ -29,7 +29,7 @@ - + @@ -40,7 +40,7 @@ - + @@ -51,7 +51,7 @@ - + @@ -62,7 +62,7 @@ - + @@ -73,7 +73,7 @@ - + @@ -84,7 +84,7 @@ - + diff --git a/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj b/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj index 6af4d499c1..36b1620b22 100644 --- a/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj +++ b/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,9 @@ - - - + + + @@ -26,9 +26,9 @@ - - - + + + @@ -37,9 +37,9 @@ - - - + + + @@ -48,9 +48,9 @@ - - - + + + @@ -59,9 +59,9 @@ - - - + + + @@ -70,9 +70,9 @@ - - - + + + @@ -81,9 +81,9 @@ - - - + + + @@ -94,8 +94,8 @@ - - + + diff --git a/vs-build-ifx/drivers/SED_Driver.vfproj b/vs-build-ifx/drivers/SED_Driver.vfproj index 655ca037af..437ed0255c 100644 --- a/vs-build-ifx/drivers/SED_Driver.vfproj +++ b/vs-build-ifx/drivers/SED_Driver.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,9 @@ - - - + + + @@ -26,9 +26,9 @@ - - - + + + @@ -37,9 +37,9 @@ - - - + + + @@ -48,9 +48,9 @@ - - - + + + @@ -59,9 +59,9 @@ - - - + + + @@ -70,9 +70,9 @@ - - - + + + @@ -81,9 +81,9 @@ - - - + + + @@ -94,8 +94,8 @@ - - + + diff --git a/vs-build-ifx/drivers/SeaState_Driver.vfproj b/vs-build-ifx/drivers/SeaState_Driver.vfproj index f8e4761969..f32dfc4dac 100644 --- a/vs-build-ifx/drivers/SeaState_Driver.vfproj +++ b/vs-build-ifx/drivers/SeaState_Driver.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,9 @@ - - - + + + @@ -26,9 +26,9 @@ - - - + + + @@ -37,9 +37,9 @@ - - - + + + @@ -48,9 +48,9 @@ - - - + + + @@ -59,9 +59,9 @@ - - - + + + @@ -70,9 +70,9 @@ - - - + + + @@ -81,9 +81,9 @@ - - - + + + @@ -94,8 +94,8 @@ - - + + diff --git a/vs-build-ifx/drivers/SubDyn_Driver.vfproj b/vs-build-ifx/drivers/SubDyn_Driver.vfproj index a5750bb049..a4ceb778cf 100644 --- a/vs-build-ifx/drivers/SubDyn_Driver.vfproj +++ b/vs-build-ifx/drivers/SubDyn_Driver.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -15,9 +15,9 @@ - - - + + + @@ -26,9 +26,9 @@ - - - + + + @@ -37,9 +37,9 @@ - - - + + + @@ -48,9 +48,9 @@ - - - + + + @@ -59,9 +59,9 @@ - - - + + + @@ -70,9 +70,9 @@ - - - + + + @@ -81,9 +81,9 @@ - - - + + + @@ -94,8 +94,8 @@ - - + + diff --git a/vs-build-ifx/glue-codes/FAST.Farm.vfproj b/vs-build-ifx/glue-codes/FAST.Farm.vfproj index 411346b404..e7cbc0977a 100644 --- a/vs-build-ifx/glue-codes/FAST.Farm.vfproj +++ b/vs-build-ifx/glue-codes/FAST.Farm.vfproj @@ -6,7 +6,7 @@ - + @@ -17,7 +17,7 @@ - + @@ -28,7 +28,7 @@ - + @@ -39,7 +39,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -61,7 +61,7 @@ - + @@ -72,7 +72,7 @@ - + @@ -83,7 +83,7 @@ - + diff --git a/vs-build-ifx/modules/NWTC-Library.vfproj b/vs-build-ifx/modules/NWTC-Library.vfproj index 5ad5668449..7f9b0a2587 100644 --- a/vs-build-ifx/modules/NWTC-Library.vfproj +++ b/vs-build-ifx/modules/NWTC-Library.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,8 @@ - - + + @@ -24,8 +24,8 @@ - - + + @@ -34,9 +34,9 @@ - - - + + + @@ -45,9 +45,9 @@ - - - + + + @@ -56,9 +56,9 @@ - - - + + + @@ -67,9 +67,9 @@ - - - + + + @@ -78,9 +78,9 @@ - - - + + + @@ -91,8 +91,8 @@ - - + + @@ -108,15 +108,6 @@ - - - - - - - - - @@ -126,23 +117,23 @@ + + + - - - - - + + @@ -152,12 +143,21 @@ + + + + + + + + + diff --git a/vs-build-ifx/modules/SuperController.vfproj b/vs-build-ifx/modules/SuperController.vfproj index f7ccf1fd09..ea23c06e7b 100644 --- a/vs-build-ifx/modules/SuperController.vfproj +++ b/vs-build-ifx/modules/SuperController.vfproj @@ -1,12 +1,12 @@ - - + + - - - + + + @@ -16,9 +16,9 @@ - - - + + + @@ -28,9 +28,9 @@ - - - + + + @@ -40,9 +40,9 @@ - - - + + + @@ -52,9 +52,9 @@ - - - + + + @@ -64,9 +64,9 @@ - - - + + + @@ -76,9 +76,9 @@ - - - + + + @@ -88,9 +88,9 @@ - - - + + + @@ -102,9 +102,9 @@ - - - + + + diff --git a/vs-build-ifx/modules/SuperController_Types.vfproj b/vs-build-ifx/modules/SuperController_Types.vfproj index 0dd006b6ae..73950ca231 100644 --- a/vs-build-ifx/modules/SuperController_Types.vfproj +++ b/vs-build-ifx/modules/SuperController_Types.vfproj @@ -1,11 +1,11 @@ - - + + - - + + @@ -14,8 +14,8 @@ - - + + @@ -24,8 +24,8 @@ - - + + @@ -34,8 +34,8 @@ - - + + @@ -44,8 +44,8 @@ - - + + @@ -54,8 +54,8 @@ - - + + @@ -64,8 +64,8 @@ - - + + @@ -74,8 +74,8 @@ - - + + @@ -86,40 +86,40 @@ - + - + - - - - - - - - - - + - + - + + + + - + - + + + + + + + - + diff --git a/vs-build-ifx/modules/TurbSim.vfproj b/vs-build-ifx/modules/TurbSim.vfproj index 0f2f46b40b..2f2181d106 100644 --- a/vs-build-ifx/modules/TurbSim.vfproj +++ b/vs-build-ifx/modules/TurbSim.vfproj @@ -7,7 +7,7 @@ - + @@ -18,7 +18,7 @@ - + @@ -29,7 +29,7 @@ - + @@ -40,7 +40,7 @@ - + @@ -51,7 +51,7 @@ - + @@ -62,7 +62,7 @@ - + @@ -73,7 +73,7 @@ - + @@ -84,7 +84,7 @@ - + diff --git a/vs-build-ifx/update-vfproj.py b/vs-build-ifx/update-vfproj.py index 778f0a4dd1..87bbc2cf37 100644 --- a/vs-build-ifx/update-vfproj.py +++ b/vs-build-ifx/update-vfproj.py @@ -56,14 +56,15 @@ cfg["OutputDirectory"] = "..\\..\\build\\lib" elif cfg.attrs.get("ConfigurationType", "") == "typeDynamicLibrary": cfg["OutputDirectory"] = "..\\..\\build\\bin" - compiler_tool["AdditionalOptions"] = "/fpe-all:0" - compiler_tool["FloatingPointExceptionHandling"] = "fpe0" + if 'Debug' in cfg_name: + compiler_tool["FloatingPointExceptionHandling"] = "fpe0" linker_tool["StackReserveSize"] = "9999999" elif linker_tool != None and linker_tool["SubSystem"] == "subSystemConsole": cfg["OutputDirectory"] = "..\\..\\build\\bin" - compiler_tool["AdditionalOptions"] = "/fpe-all:0" - compiler_tool["FloatingPointExceptionHandling"] = "fpe0" + if 'Debug' in cfg_name: + compiler_tool["FloatingPointExceptionHandling"] = "fpe0" linker_tool["StackReserveSize"] = "9999999" + linker_tool['GenerateManifest'] = "false" else: print("unknown project type") continue From 4284409b846de4012e93fb902163b6669c7f3097 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 9 Dec 2024 18:11:13 -0700 Subject: [PATCH 292/319] Update regression tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index d86d45a124..331988f451 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit d86d45a12435dd2bd8899399206b7f76294257bc +Subproject commit 331988f45177d63d321cec844d16ea23b994242a From 429b01a514a9c1422185f514e71a08e6ce09532a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 10 Dec 2024 18:41:55 +0000 Subject: [PATCH 293/319] Merge 'dev' into f/tight-coupling --- cmake/OpenfastFortranOptions.cmake | 8 +- docs/changelogs/v3.5.4.md | 96 + docs/conf.py | 2 +- docs/source/install/index.rst | 2 +- .../aerodyn-aeroacoustics/02-noise-models.rst | 4 +- .../user/aerodyn-aeroacoustics/App-usage.rst | 39 +- .../example/AeroAcousticsInput.dat | 8 +- .../aerodyn-aeroacoustics/example/TIGrid.txt | 13 - docs/source/user/api_change.rst | 8 +- docs/source/user/hydrodyn/appendix.rst | 12 +- docs/source/user/hydrodyn/input_files.rst | 140 +- .../fast-farm/src/FASTWrapper_Types.f90 | 120 +- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 208 +- glue-codes/openfast-cpp/src/OpenFAST.cpp | 19 +- modules/aerodisk/src/AeroDisk.f90 | 3 +- modules/aerodisk/src/AeroDisk_Registry.txt | 1 + modules/aerodisk/src/AeroDisk_Types.f90 | 134 +- .../python-lib/aerodyn_inflow_library.py | 15 +- modules/aerodyn/src/AeroAcoustics.f90 | 38 +- modules/aerodyn/src/AeroAcoustics_IO.f90 | 67 +- .../aerodyn/src/AeroAcoustics_Registry.txt | 13 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 612 ++-- modules/aerodyn/src/AeroDyn.f90 | 2 +- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 178 +- modules/aerodyn/src/AeroDyn_Inflow.f90 | 7 +- .../aerodyn/src/AeroDyn_Inflow_C_Binding.f90 | 244 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 250 +- modules/aerodyn/src/AeroDyn_Registry.txt | 1 + modules/aerodyn/src/AeroDyn_Types.f90 | 1270 ++++----- modules/aerodyn/src/AirfoilInfo.f90 | 15 +- modules/aerodyn/src/AirfoilInfo_Types.f90 | 58 +- modules/aerodyn/src/BEMT.f90 | 6 +- modules/aerodyn/src/BEMT_Types.f90 | 346 +-- modules/aerodyn/src/DBEMT.f90 | 8 +- modules/aerodyn/src/DBEMT_Types.f90 | 140 +- modules/aerodyn/src/FVW_Types.f90 | 714 ++--- modules/aerodyn/src/UnsteadyAero_Types.f90 | 350 +-- modules/awae/src/AWAE_Types.f90 | 498 ++-- modules/beamdyn/src/BeamDyn.f90 | 4 +- modules/beamdyn/src/BeamDyn_Types.f90 | 520 ++-- modules/elastodyn/src/ElastoDyn_Types.f90 | 1090 +++---- modules/externalinflow/src/ExternalInflow.f90 | 6 +- .../src/ExternalInflow_Types.f90 | 248 +- modules/extloads/src/ExtLoadsDX_Types.f90 | 132 +- modules/extloads/src/ExtLoads_Types.f90 | 172 +- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 252 +- modules/feamooring/src/FEAMooring_Types.f90 | 318 +-- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 48 +- modules/hydrodyn/src/HydroDyn.f90 | 3 +- modules/hydrodyn/src/HydroDyn.txt | 4 +- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 23 +- modules/hydrodyn/src/HydroDyn_Input.f90 | 16 +- modules/hydrodyn/src/HydroDyn_Output.f90 | 4 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 406 +-- modules/hydrodyn/src/Morison.f90 | 6 +- modules/hydrodyn/src/Morison_Types.f90 | 680 ++--- modules/hydrodyn/src/SS_Excitation_Types.f90 | 100 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 104 +- modules/hydrodyn/src/WAMIT.f90 | 20 +- modules/hydrodyn/src/WAMIT.txt | 5 +- modules/hydrodyn/src/WAMIT2.txt | 4 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 44 +- modules/hydrodyn/src/WAMIT_Types.f90 | 92 +- modules/icedyn/src/IceDyn_Types.f90 | 122 +- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 40 +- .../inflowwind/src/IfW_FlowField_Types.f90 | 112 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 4 +- modules/inflowwind/src/InflowWind_Types.f90 | 150 +- modules/inflowwind/src/Lidar_Types.f90 | 44 +- modules/lindyn/src/LinDyn_Types.f90 | 212 +- modules/map/CMakeLists.txt | 8 +- modules/map/src/MAP_Fortran_Types.f90 | 249 ++ modules/map/src/MAP_Types.f90 | 200 +- modules/moordyn/src/MoorDyn.f90 | 23 +- modules/moordyn/src/MoorDyn_Driver.f90 | 2 +- modules/moordyn/src/MoorDyn_Line.f90 | 72 +- modules/moordyn/src/MoorDyn_Misc.f90 | 27 +- modules/moordyn/src/MoorDyn_Registry.txt | 40 +- modules/moordyn/src/MoorDyn_Types.f90 | 814 +++--- modules/moordyn/src/MoorDyn_bathymetry.txt | 8 - modules/nwtc-library/ModRegGen.py | 12 +- modules/nwtc-library/src/ModReg.f90 | 244 +- modules/nwtc-library/src/NWTC_Base.f90 | 2 +- .../nwtc-library/src/NWTC_Library_IncSubs.f90 | 126 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 236 +- modules/nwtc-library/src/VTK.f90 | 4 + modules/openfast-library/src/FAST_Subs.f90 | 192 +- modules/openfast-library/src/FAST_Types.f90 | 2540 ++++++++--------- modules/openfast-library/src/Glue_Types.f90 | 334 +-- .../src/registry_gen_fortran.cpp | 46 +- .../src/OrcaFlexInterface_Types.f90 | 58 +- modules/seastate/src/Current_Types.f90 | 20 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 64 +- modules/seastate/src/SeaState_Types.f90 | 110 +- modules/seastate/src/Waves2_Types.f90 | 44 +- modules/seastate/src/Waves_Types.f90 | 24 +- modules/servodyn/src/ServoDyn_Types.f90 | 1324 ++++----- modules/servodyn/src/StrucCtrl_Types.f90 | 264 +- modules/simple-elastodyn/src/SED_Types.f90 | 194 +- modules/subdyn/src/SD_FEM.f90 | 23 +- modules/subdyn/src/SubDyn.f90 | 53 +- modules/subdyn/src/SubDyn_Registry.txt | 5 +- modules/subdyn/src/SubDyn_Types.f90 | 784 ++--- .../supercontroller/src/SCDataEx_Types.f90 | 26 +- .../src/SuperController_Types.f90 | 64 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 240 +- vs-build/FAST-farm/FAST-Farm.vfproj | 6 +- vs-build/FASTlib/FASTlib.vfproj | 14 +- vs-build/MAPlib/MAP_dll.vcxproj | 4 +- 109 files changed, 9804 insertions(+), 9330 deletions(-) create mode 100644 docs/changelogs/v3.5.4.md delete mode 100644 docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt create mode 100644 modules/map/src/MAP_Fortran_Types.f90 delete mode 100644 modules/moordyn/src/MoorDyn_bathymetry.txt diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index 554c175b85..a362ee31bc 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -162,7 +162,9 @@ endmacro(set_fast_intel_fortran) # arch # macro(set_fast_intel_fortran_posix) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic -fpp") + # Set size where temporary are stored on heap instead of stack + # 1000: size in kB (1 MB) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic -fpp -heap-arrays 1000") # debug flags if(CMAKE_BUILD_TYPE MATCHES Debug) @@ -205,7 +207,9 @@ macro(set_fast_intel_fortran_windows) # Turn off specific warnings # - 5199: too many continuation lines # - 5268: 132 column limit - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /Qdiag-disable:5199,5268 /fpp") + # Set size where temporary are stored on heap instead of stack + # 1000: size in kB (1 MB) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /Qdiag-disable:5199,5268 /fpp /heap-arrays:1000") # If double precision, make constants double precision if (DOUBLE_PRECISION) diff --git a/docs/changelogs/v3.5.4.md b/docs/changelogs/v3.5.4.md new file mode 100644 index 0000000000..e099bfab56 --- /dev/null +++ b/docs/changelogs/v3.5.4.md @@ -0,0 +1,96 @@ +**Feature or improvement description** +Pull request to merge `rc-3.5.4` into `main` and create a tagged release for v3.5.4. + +See the milestone and project pages for additional information + + https://github.com/OpenFAST/openfast/milestone/14 + +Test results, if applicable +See GitHub Actions + +### Release checklist: +- [ ] Update the documentation version in docs/conf.py +- [ ] Update the versions in docs/source/user/api_change.rst +- [ ] Verify readthedocs builds correctly +- [ ] Create a tag in OpenFAST +- [ ] Create a merge commit in r-test and add a corresponding annotated tag +- [ ] Compile executables for Windows builds + - [ ] AeroDyn_Driver_x64.exe + - [ ] AeroDyn_Driver_x64_OpenMP.exe + - [ ] AeroDyn_Inflow_C_Binding_x64.dll + - [ ] AeroDyn_Inflow_C_Binding_x64_OpenMP.dll + - [ ] BeamDyn_Driver_x64.exe + - [ ] DISCON.dll (x64) + - [ ] DISCON_ITIBarge.dll (x64) + - [ ] DISCON_OC3Hywind.dll (x64) + - [ ] DISCON_SC.dll (x64) + - [ ] FAST.Farm_x64.exe + - [ ] FAST.Farm_x64_OMP.exe + - [ ] FAST_SFunc.mexw64 + - [ ] HydroDynDriver_x64.exe + - [ ] HydroDyn_C_Binding_x64.dll + - [ ] IfW_C_Binding_x64.dll + - [ ] InflowWind_Driver_x64.exe + - [ ] InflowWind_Driver_x64_OpenMP.exe + - [ ] MoorDyn_Driver_x64.exe + - [ ] MoorDyn_C_Binding_x64.dll + - [ ] OpenFAST-Simulink_x64.dll + - [ ] openfast_x64.exe + - [ ] Turbsim_x64.exe + +# Changelog + +## Overview + +This release includes performance improvements for BeamDyn (up to 30% speed increase), python file readers and writers from WEIS, and a fix for stack overflows with FAST.Farm (Intel compilation). A few other minor updates are included as outlined below. + +Anyone using BeamDyn will want to update to this version. + + +## General + +### Build systems + +#2311 Always build `openfastcpplib` as shared. Use `BUILD_OPENFAST_CPP_DRIVER` to disable `openfastcpp` executable (@deslaughter) +#2173 Fix crash in `MAP_End` when using Intel's new icx compiler and disable caching in setup-python GH action (@deslaughter) + + +### Python file readers/writers + +#2188 Add WEIS file readers and writers (@cortadocodes and @mayankchetan) + + +## Solvers + +### FAST.Farm + +#2452 Fix for some stack overflow issues with FAST.Farm when copying large amounts of wind data (closes #2053) (@andrew-platt) +#2340 Add `!$ OMP critical` around file opening for VTK to prevent file collision (@andrew-platt) + + +## Module changes + +### BeamDyn + +#2399 BeamDyn performance improvements (@deslaughter) + + +### ElastoDyn + +#2321 Backport of #2317: Explicitly initialize `ED` `RtHS` to zero -- corrects issue with inccorect linearization results (@andrew-platt) + + +### HydroDyn +#2397 HD bug fix: prevent array index out-of-bound error in `HDOut_MapOutputs` when more than 9 potential-flow bodies are present (@luwang00) + +### NWTC-Library +#2389 FileInfoType: increase line length allowed (@andrew-platt) + +## Input file changes + +No input files change with this release, as this only includes minor bugfixes. + +Full list of changes: https://openfast.readthedocs.io/en/main/source/user/api_change.html + +Full input file sets: https://github.com/OpenFAST/r-test/tree/v3.5.4 (example input files from the regression testing) + diff --git a/docs/conf.py b/docs/conf.py index c0432bfcaf..38764e4a10 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -138,7 +138,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): # The short X.Y version. version = u'3.5' # The full version, including alpha/beta/rc tags. -release = u'v3.5.3' +release = u'v3.5.4' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/docs/source/install/index.rst b/docs/source/install/index.rst index ee7951a100..b394ed808d 100644 --- a/docs/source/install/index.rst +++ b/docs/source/install/index.rst @@ -162,7 +162,7 @@ containing the executables, and running a simple test command: Running OpenFAST with docker ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -OpenFAST is avilable to be run on docker starting with version 3.5.3. Three approaches are shared below. +OpenFAST is available to be run on docker starting with version 3.5.3. Three approaches are shared below. Using a docker image from Docker hub ------------------------------------ diff --git a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst index 56f7faf9e5..8422a63b62 100644 --- a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst +++ b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst @@ -151,8 +151,8 @@ The formulations of :math:`{\overline{D}}_{h}\ `\ and :math:`{\overline{D}}_{l}` are presented in :numref:`aa-directivity`. The current implementation offers two approaches to estimate -:math:`I_{1}`. The first one is through a user-defined grid of -:math:`I_{1}`; see :numref:`aa-sec-TIgrid`. The second option is to have the code +:math:`I_{1}`. The first one is through a user-defined :math:`I_{1}`. +The second option is to have the code reconstructing :math:`I_{1}` from the turbulent wind grid, where the code computes the airfoil relative position of each blade section, :math:`i`, at every time instant and, given the rotor speed, diff --git a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst index f83c773acb..7d9394bed5 100644 --- a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst +++ b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst @@ -56,12 +56,14 @@ models: - **TICalcMeth** – Integer 1/2: flag to set the calculation method for the incident turbulence intensity. When set to 1, incident turbulence intensity is - defined in a user-defined grid; see :numref:`aa-sec-TIgrid`. When set to - 2, incident turbulence intensity is estimated from the time history of the - incident flow. + user-defined. When set to 2, incident turbulence intensity is + estimated from the time history of the incident flow. -- **TICalcTabFile** – String: name of the text file with the user-defined - turbulence intensity grid; see :numref:`aa-sec-TIgrid`. +- **TI** – Float: user-defined value of :math:`TI`, which is the rotor-incident + turbulence intensity used in the Amiet model. + +- **avgV** – Float: value of the average wind speed used to scale :math:`TI` + and convert it to a blade section incident turbulence intensity. - **Lturb** – Float: value of :math:`L_{turb}` used to estimate the turbulent lengthscale used in the Amiet model. @@ -255,32 +257,5 @@ is shown here: :language: none -.. _aa-sec-TIgrid: - -Turbulence Grid ---------------- - -When the flag **TICalcMeth** is set equal to 1, the grid of turbulence -intensity of the wind :math:`TI` must be defined by the user. This is -done by creating a file called **TIGrid_In.txt**, which mimics a TurbSim -output file and contains a grid of turbulence intensity, which is -defined as a fraction value. The file defines a grid centered at hub -height and oriented with the OpenFAST global inertial frame coordinate -system; see :numref:`aa-fig:ObsRefSys`. A user-defined number of lateral and vertical -points equally spaced by a user-defined number of meters must be -specified. Note that an average wind speed must be defined to convert -the turbulence intensity of the wind to the incident turbulent intensity :math:`I_{1}`. -An example file for a 160 (lateral) by 180 (vertical) meters -grid looks like the following: - - -.. container:: - :name: aa-tab:TIgrid - - .. literalinclude:: example/TIGrid.txt - :linenos: - :language: none - - .. [4] https://github.com/OpenFAST/python-toolbox diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat index eebaa51625..4a2bae7582 100644 --- a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat +++ b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat @@ -8,8 +8,9 @@ False Echo - Echo the input to ".AD.NN.ech"? (flag) ====== Aeroacoustic Models ============================================================================ 2 TIMod - Turbulent Inflow noise model {0: none, 1: Amiet 2: Amiet + Simplified Guidati} (switch) 1 TICalcMeth - Method to estimate turbulence intensity incident to the profile {1: given table, 2: computed on the fly} (switch) [Only used if TIMod!=0] -"TIGrid_InVerify.txt" TICalcTabFile - Name of the file containing the table for incident turbulence intensity (-) [Only used if TiCalcMeth == 1] -0.5 SurfRoughness- Surface roughness value used to estimate the turbulent length scale in Amiet model (m) +0.1 TI - Rotor-incident wind turbulence intensity (-) [Only used if TiCalcMeth == 1] +8 avgV - Average wind speed used to compute the section-incident turbulence intensity (m/s) [Only used if TiCalcMeth == 1] +40 Lturb - Turbulent length scale in Amiet model (m) [Only used if TIMod!=0] 1 TBLTEMod - Turbulent Boundary Layer-Trailing Edge noise calculation {0: none, 1:BPM, 2: TNO} (switch) 1 BLMod - Calculation method for boundary layer properties, {1: BPM, 2: Pretabulated} (switch) 1 TripMod - Boundary layer trip model {0:no trip, 1: heavy trip, 2: light trip} (switch) [Only used if BLMod=1] @@ -18,9 +19,6 @@ False Echo - Echo the input to ".AD.NN.ech"? (flag) True RoundedTip - Logical indicating rounded tip (flag) [Only used if TipMod=1] 1.0 Alprat - Tip lift curve slope (Default = 1.0) [Only used if TipMod=1] 0 BluntMod - Trailing-edge-bluntness – Vortex-shedding model {0:none, 1: BPM} (switch) -"AABlade1.dat" AABlFile(1) - Name of file containing distributed aerodynamic properties for Blade #1 (-) -"AABlade1.dat" AABlFile(2) - Name of file containing distributed aerodynamic properties for Blade #2 (-) -"AABlade1.dat" AABlFile(3) - Name of file containing distributed aerodynamic properties for Blade #3 (-) ====== Observer Input =================================================================== "AA_ObserverLocations.dat" ObserverLocations - Name of file containing all observer locations X Y Z (-) ====== Outputs ==================================================================================== diff --git a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt b/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt deleted file mode 100644 index 4f01c54833..0000000000 --- a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt +++ /dev/null @@ -1,13 +0,0 @@ -Average Inflow Wind Speed -8.0 -Total Grid points In Y (lateral), Starts from - radius goes to + radius+ -4 -Total Grid points In Z (vertical), Starts from bottom tip (hub-radius) -3 -Grid spacing In Y (lateral) -40 -Grid spacing In Z (vertical) -60 -0.1200 0.1200 0.1200 0.1200 -0.1100 0.1100 0.1100 0.1100 -0.1000 0.1000 0.1000 0.1000 diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index f995d20766..30d3a351f0 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -11,7 +11,7 @@ Thus, be sure to implement each in order so that subsequent line numbers are cor -OpenFAST v3.5.3 to OpenFAST dev +OpenFAST v3.5.4 to OpenFAST dev ---------------------------------- The HydroDyn module was split into HydroDyn and SeaState. This results in a @@ -29,6 +29,8 @@ OpenFAST 15 CompAero\** 2 C OpenFAST 13 CompElast 3 CompElast - Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades; 3=Simplified ElastoDyn} AeroDyn 40 IntegrationMethod 3 IntegrationMethod - Switch to indicate which integration method UA uses (1=RK4, 2=AB4, 3=ABM4, 4=BDF2) AeroDyn 140\* BldNd_BlOutNd "All" BldNd_BlOutNd - Specify a portion of the nodes to output. {"ALL", "Tip", "Root", or a list of node numbers} (-) +AeroDyn Aeroacoustics 11\* TI 0.1 TI - Rotor-incident wind turbulence intensity (-) [Only used if TiCalcMeth == 1] +AeroDyn Aeroacoustics 12\* avgV 8 avgV - Average wind speed used to compute the section-incident turbulence intensity (m/s) [Only used if TiCalcMeth == 1] ElastoDyn blade file 15 Removal of the `PitchAxis` input column HydroDyn all Complete restructuring of input file SeaState all New module (split from HydroDyn, so contains some inputs previously found in HydroDyn) @@ -104,6 +106,10 @@ Old inputs Corresponding new inputs +OpenFAST v3.5.3 to OpenFAST v3.5.4 +---------------------------------- + +No input file changes were made. OpenFAST v3.5.2 to OpenFAST v3.5.3 diff --git a/docs/source/user/hydrodyn/appendix.rst b/docs/source/user/hydrodyn/appendix.rst index 24a2e1b352..b58c4717b9 100644 --- a/docs/source/user/hydrodyn/appendix.rst +++ b/docs/source/user/hydrodyn/appendix.rst @@ -12,9 +12,13 @@ structure:: False Echo - Echo the input file data (flag) ---------------------- FLOATING PLATFORM --------------------------------------- [unused with WaveMod=6] 1 PotMod - Potential-flow model {0: none=no potential flow, 1: frequency-to-time-domain transforms based on WAMIT output, 2: fluid-impulse theory (FIT)} (switch) - 1 ExctnMod - Wave-excitation model {0: no wave-excitation calculation, 1: DFT, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ssexctn INPUT FILE] + 1 ExctnMod - Wave-excitation model {0: no wave-excitation calculation, 1: DFT, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ssexctn INPUT FILE; if PtfmYMod=1, need ExctnMod=0 or 1] 0 ExctnDisp - Method of computing Wave Excitation {0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0 and SeaState's WaveMod>0]} (switch) 10 ExctnCutOff - Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [used only when PotMod=1, ExctnMod>0, and ExctnDisp=2]) [only used when PotMod=1 and ExctnMod>0 and SeaState's WaveMod>0]} (switch) + 0 PtfmYMod - Model for large platform yaw offset {0: Static reference yaw offset based on PtfmRefY, 1: dynamic reference yaw offset based on low-pass filtering the PRP yaw motion with cutoff frequency PtfmYCutOff} (switch) + 0 PtfmRefY - Constant (if PtfmYMod=0) or initial (if PtfmYMod=1) platform reference yaw offset (deg) + 0.01 PtfmYCutOff - Cutoff frequency for the low-pass filtering of PRP yaw motion when PtfmYMod=1 [>0.0; unused when PtfmYMod=0] (Hz) + 36 NExctnHdg - Number of evenly distributed platform yaw/heading angles over the range of [-180, 180) deg for which the wave excitation shall be computed [>=2; unused when PtfmYMod=0] (-) 1 RdtnMod - Radiation memory-effect model {0: no memory-effect calculation, 1: convolution, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ss INPUT FILE] 60 RdtnTMax - Analysis time for wave radiation kernel calculations (sec) [only used when PotMod=1 and RdtnMod>0; determines RdtnDOmega=Pi/RdtnTMax in the cosine transform; MAKE SURE THIS IS LONG ENOUGH FOR THE RADIATION IMPULSE RESPONSE FUNCTIONS TO DECAY TO NEAR-ZERO FOR THE GIVEN PLATFORM!] 0.0125 RdtnDT - Time step for wave radiation kernel calculations (sec) [only used when PotMod=1 and ExctnMod>0 or RdtnMod>0; DT<=RdtnDT<=0.1 recommended; determines RdtnOmegaMax=Pi/RdtnDT in the cosine transform] @@ -32,8 +36,8 @@ structure:: ---------------------- 2ND-ORDER FLOATING PLATFORM FORCES ---------------------- [unused with WaveMod=0 or 6, or PotMod=0 or 2] 0 MnDrift - Mean-drift 2nd-order forces computed {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If NBody>1, MnDrift /=8] 0 NewmanApp - Mean- and slow-drift 2nd-order forces computed with Newman's approximation {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If NBody>1, NewmanApp/=8. Used only when WaveDirMod=0] - 0 DiffQTF - Full difference-frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero] - 0 SumQTF - Full summation -frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} + 0 DiffQTF - Full difference-frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If PtfmYMod=1, need DiffQTF=0] + 0 SumQTF - Full summation -frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [If PtfmYMod=1, need SumQTF=0] ---------------------- PLATFORM ADDITIONAL STIFFNESS AND DAMPING -------------- [unused with PotMod=0 or 2] 0 AddF0 - Additional preload (N, N-m) [If NBodyMod=1, one size 6*NBody x 1 vector; if NBodyMod>1, NBody size 6 x 1 vectors] 0 @@ -60,7 +64,7 @@ structure:: 0 0 0 0 0 0 0 0 0 0 0 0 ---------------------- STRIP THEORY OPTIONS -------------------------------------- - 0 WaveDisp - Method of computing Wave Kinematics {0: use undisplaced position, 1: use displaced position) } (switch) + 0 WaveDisp - Method of computing Wave Kinematics {0: use undisplaced position, 1: use displaced position) } (switch) [If PtfmYMod=1, need WaveDisp=1] 0 AMMod - Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 2: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] ---------------------- AXIAL COEFFICIENTS -------------------------------------- 2 NAxCoef - Number of axial coefficients (-) diff --git a/docs/source/user/hydrodyn/input_files.rst b/docs/source/user/hydrodyn/input_files.rst index df6d5fdc27..49c0593d60 100644 --- a/docs/source/user/hydrodyn/input_files.rst +++ b/docs/source/user/hydrodyn/input_files.rst @@ -58,6 +58,20 @@ computed and printed to the calling terminal. **NSteps** specifies the number of simulation time steps, and **TimeInterval** specifies the time between steps. +Motion of the structure can be specified in different ways according to +**PRPInputsMod**. Irrespective of the choice of **PRPInputsMod** (which +are explained below), the translational displacement, velocity, and +acceleration are always specified in the global inertial-frame coordinate +system. With OpenFAST now updated to support potentially large platform +rotation, the specification of rotation differs from previous versions. +HydroDyn now describes body rotation using Tait-Bryan roll, pitch, and +yaw angles with the convention of intrinsic (about body-fixed axis) yaw +rotation first, followed by pitch rotation, and roll last. Furthermore, +HydroDyn now expects the first and second time derivatives of the +Tait-Bryan roll, pitch, and yaw angles in place of angular velocity and +acceleration. The standalone HydroDyn driver will convert these inputs +to angular velocity and acceleration internally. + Setting **PRPInputsMod** = 0 forces all platform reference point (PRP) input motions to zero for all time. If you set **PRPInputsMod** = 1, then you must set the steady-state inputs in the PRP STEADY STATE @@ -67,25 +81,24 @@ time-series input file whose name is specified via the file. This file has no header lines. Each data row corresponds to a given time step, and the whitespace separated columns of floating point values represent the necessary motion inputs as shown in -:numref:`hd-prp_input_table`. All motions are specified in the global -inertial-frame coordinate system. +:numref:`hd-prp_input_table`. .. _hd-prp_input_table: .. table:: PRP Inputs Time-Series Data File Contents (**PRPInputsMod** = 2) :widths: auto - ============= ================================================================================ ====================================== - Column Number Input Units - ============= ================================================================================ ====================================== - 1 Time step value .. math:: s - 2-4 Translational displacements along *X*, *Y*, and *Z* .. math:: m - 5-7 Rotational displacements about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - 8-10 Translational velocities along *X*, *Y*, and *Z* .. math:: \frac{m}{s} - 11-13 Rotational velocities about *X*, *Y*, and *Z* .. math:: \frac{\text{radians}}{s} - 14-16 Translational accelerations along *X*, *Y*, and *Z* .. math:: \frac{m}{s^{2}} - 17-19 Rotational accelerations about *X*, *Y*, and *Z* .. math:: \frac{\text{radians}}{s^{2}} - ============= ================================================================================ ====================================== + ============= ====================================================================== ====================================== + Column Number Input Units + ============= ====================================================================== ====================================== + 1 Time step value .. math:: s + 2-4 Translational displacements along *X*, *Y*, and *Z* .. math:: m + 5-7 Tait-Bryan roll, pitch, and yaw angles .. math:: \text{radians} + 8-10 Translational velocities along *X*, *Y*, and *Z* .. math:: \frac{m}{s} + 11-13 First time derivatives of the Tait-Bryan roll, pitch, and yaw angles .. math:: \frac{\text{radians}}{s} + 14-16 Translational accelerations along *X*, *Y*, and *Z* .. math:: \frac{m}{s^{2}} + 17-19 Second time derivatives of the Tait-Bryan roll, pitch, and yaw angles .. math:: \frac{\text{radians}}{s^{2}} + ============= ====================================================================== ====================================== With **PRPInputsMod** = 1 or 2, any potential-flow bodies and strip-theory members defined in the primary HydroDyn input file will follow the prescribed @@ -110,18 +123,18 @@ with respect to time. .. table:: PRP Inputs Time-Series Data File Contents (**PRPInputsMod** < 0) :widths: auto - ============= ================================================================================================================ ======================== - Column Number Input Units - ============= ================================================================================================================ ======================== - 1 Time step value .. math:: s - 2-4 Translational displacements of the PRP along *X*, *Y*, and *Z* .. math:: m - 5-7 Rotational displacements of the PRP about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - 8-10 Translational displacements of the 1st potential-flow body along *X*, *Y*, and *Z* .. math:: m - 11-13 Rotational displacements of the 1st potential-flow body about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - 14-16 Translational displacements of the 2nd potential-flow body along *X*, *Y*, and *Z* .. math:: m - 17-19 Rotational displacements of the 2nd potential-flow body about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - ... ... ... - ============= ================================================================================================================ ======================== + ============= =================================================================================== ======================== + Column Number Input Units + ============= =================================================================================== ======================== + 1 Time step value .. math:: s + 2-4 Translational displacements of the PRP along *X*, *Y*, and *Z* .. math:: m + 5-7 Tait-Bryan roll, pitch, and yaw angles of the PRP .. math:: \text{radians} + 8-10 Translational displacements of the 1st potential-flow body along *X*, *Y*, and *Z* .. math:: m + 11-13 Tait-Bryan roll, pitch, and yaw angles of the 1st potential-flow body .. math:: \text{radians} + 14-16 Translational displacements of the 2nd potential-flow body along *X*, *Y*, and *Z* .. math:: m + 17-19 Tait-Bryan roll, pitch, and yaw angles of the 2nd potential-flow body .. math:: \text{radians} + ... ... ... + ============= =================================================================================== ======================== .. _hd-primary-input: @@ -200,6 +213,83 @@ motion to prevent double counting the contributions from first-order structural motion already included in the second-order potential-flow wave excitation. +HydroDyn now supports large but slow (well below wave frequencies) +transient platform yaw motion with both strip-theory only and hybrid +potential-flow models. To enable this capability, the inputs +**PtfmYMod**, **PtfmRefY**, **PtfmYCutoff**, and **NExctnHdg** must +be set appropriately. Note that HydroDyn still requires the platform +roll and pitch angles to be small, i.e., within +/-15 deg. + +To conform with the first- and second-order potential-flow theory, +which limits the structure to small displacement about a reference +mean position, a constant or slowly varying reference platform yaw +orientation must be established. + +Setting **PtfmYMod** = 0 lets HydroDyn use a constant reference yaw +angle given by **PtfmRefY** in degrees. In this case, the platform +yaw rotation during the simulation, as given by the **PRPYaw** +output channel, must stay within +/-15 deg of **PtfmRefY** specified +by the user. A severe warning will be displayed if this requirement +is not met at any point during the simulation, while still allowing +the simulation to continue if possible. With a hybrid potential-flow +model, the potential-flow wave excitation input file needs to cover +a suitable range of wave headings relative to the platform after a +yaw offset of **PtfmRefY** is applied. + +Alternatively, **PtfmYMod** = 1 lets HydroDyn update the reference +yaw position **PtfmRefY** dynamically based on the low-pass-filtered +platform yaw rotation, analogous to the modeling of slow-drift motion +with **ExctnDisp** = 2 above. In this case, the **PtfmRefY** input +allows the user to specify the initial reference yaw position at +**t** = 0. The cutoff frequency of the first-order low-pass filter +for platform yaw rotation can be set with **PtfmYCutoff** in Hz. +Ideally, **PtfmYCutoff** should be placed between the wave frequency +region and the characteristic frequency of any slow but large change +in platform heading to filter out as much wave-frequency platform +motion as possible while minimizing the phase shift in the low-frequency +heading change. Throughout the simulation, the instantaneous +platform yaw rotation should stay within +/-15 deg of the now +time-dependent **PtfmRefY**. A severe warning will be displayed if +this requirement is not met at any point during the simulation, while +still allowing the simulation to continue if possible. + +With **PtfmYMod** = 1, HydroDyn requires the first- and second-order +(mean- or slow-drift loads from Newman's approximation only) +potential-flow wave excitation input file(s) to cover the full range +of possible wave headings with the first (smallest) wave heading being +exactly -180 deg and the last (largest) wave heading being exactly ++180 deg (the duplicated wave headings of +/-180 deg are intentional). +HydroDyn will error out if this requirement is not met by the input files. +HydroDyn uses this information to precompute the wave excitation on +the platform for **NExctnHdg** evenly distributed platform yaw/heading +angles over the range of [-180,+180) deg. For instance, with +**NExctnHdg** = 36, HydroDyn will precomupte the wave excitation for 0, +10, 20, ..., 350 deg platform heading. The instantaneous wave excitation +applied on the platform during the time-domain simulation is interpolated +from this data based on the instantaneous **PtfmRefY**. **NExctnHdg** +should be set appropriately to ensure adequate angular resolution in +platform heading. However, a high **NExctnHdg** can increase memory use +by OpenFAST substantially. + +Additional constraints on HydroDyn inputs apply when **PtfmYMod** = 1. +The strip-theory hydrodynamic load must be evaluated using the wave +kinematics and dynamic pressure at the displaced structure position +by setting **WaveDisp** = 1. State-space wave excitation cannot be used. +**ExctnMod** must be either 0 (no wave excitation) or 1 (frequency-to-time +domain transform using inverse discrete Fourier transform). Lastly, +full difference- and sum-frequency QTFs are not supported, requiring +both **DiffQTF** and **SumQTF** to be set to 0. However, mean- or +slow-drift loads based on Newman's approximation can be included through +the **MnDrift** or **NewmanApp** inputs explained below. + +Note that the inputs **PtfmYMod** and **PtfmRefY** also affect the +strip-theory hydrodynamic load. This is because the orientation of +the strip-theory members is updated based on **PtfmRefY** instead +of the instantaneous platform yaw rotation. Behavior of previous +versions of HydroDyn can be approximately recovered by setting +**PtfmYMod** = 0 and **PtfmRefY** = 0 deg, in which case, the +inputs **PtfmYCutoff** and **NExctnHdg** are not used. + HydroDyn has two methods for calculating the radiation memory effect. Set **RdtnMod** to 1 for the convolution method, 2 for the linear state-space model, or 0 to disable the memory effect calculation. For diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 1cf2241a0a..92d8947393 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -148,7 +148,7 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyInitInput' ErrStat = ErrID_None @@ -175,8 +175,8 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC DstInitInputData%UseSC = SrcInitInputData%UseSC if (allocated(SrcInitInputData%fromSCGlob)) then - LB(1:1) = lbound(SrcInitInputData%fromSCGlob, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%fromSCGlob, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) if (.not. allocated(DstInitInputData%fromSCGlob)) then allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -187,8 +187,8 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob end if if (allocated(SrcInitInputData%fromSC)) then - LB(1:1) = lbound(SrcInitInputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) if (.not. allocated(DstInitInputData%fromSC)) then allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -254,7 +254,7 @@ subroutine FWrap_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInitInput' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -493,8 +493,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FWrap_CopyMisc' @@ -504,8 +504,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%TempDisp)) then - LB(1:1) = lbound(SrcMiscData%TempDisp, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TempDisp, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%TempDisp) + UB(1:1) = ubound(SrcMiscData%TempDisp) if (.not. allocated(DstMiscData%TempDisp)) then allocate(DstMiscData%TempDisp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -520,8 +520,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%TempLoads)) then - LB(1:1) = lbound(SrcMiscData%TempLoads, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TempLoads, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%TempLoads) + UB(1:1) = ubound(SrcMiscData%TempLoads) if (.not. allocated(DstMiscData%TempLoads)) then allocate(DstMiscData%TempLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -536,8 +536,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%ADRotorDisk)) then - LB(1:1) = lbound(SrcMiscData%ADRotorDisk, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ADRotorDisk, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ADRotorDisk) + UB(1:1) = ubound(SrcMiscData%ADRotorDisk) if (.not. allocated(DstMiscData%ADRotorDisk)) then allocate(DstMiscData%ADRotorDisk(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -552,8 +552,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%AD_L2L)) then - LB(1:1) = lbound(SrcMiscData%AD_L2L, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AD_L2L, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AD_L2L) + UB(1:1) = ubound(SrcMiscData%AD_L2L) if (.not. allocated(DstMiscData%AD_L2L)) then allocate(DstMiscData%AD_L2L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -573,8 +573,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) type(FWrap_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FWrap_DestroyMisc' @@ -583,8 +583,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) call FAST_DestroyTurbineType(MiscData%Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%TempDisp)) then - LB(1:1) = lbound(MiscData%TempDisp, kind=B8Ki) - UB(1:1) = ubound(MiscData%TempDisp, kind=B8Ki) + LB(1:1) = lbound(MiscData%TempDisp) + UB(1:1) = ubound(MiscData%TempDisp) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -592,8 +592,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%TempDisp) end if if (allocated(MiscData%TempLoads)) then - LB(1:1) = lbound(MiscData%TempLoads, kind=B8Ki) - UB(1:1) = ubound(MiscData%TempLoads, kind=B8Ki) + LB(1:1) = lbound(MiscData%TempLoads) + UB(1:1) = ubound(MiscData%TempLoads) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -601,8 +601,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%TempLoads) end if if (allocated(MiscData%ADRotorDisk)) then - LB(1:1) = lbound(MiscData%ADRotorDisk, kind=B8Ki) - UB(1:1) = ubound(MiscData%ADRotorDisk, kind=B8Ki) + LB(1:1) = lbound(MiscData%ADRotorDisk) + UB(1:1) = ubound(MiscData%ADRotorDisk) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -610,8 +610,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ADRotorDisk) end if if (allocated(MiscData%AD_L2L)) then - LB(1:1) = lbound(MiscData%AD_L2L, kind=B8Ki) - UB(1:1) = ubound(MiscData%AD_L2L, kind=B8Ki) + LB(1:1) = lbound(MiscData%AD_L2L) + UB(1:1) = ubound(MiscData%AD_L2L) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%AD_L2L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -624,42 +624,42 @@ subroutine FWrap_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(FWrap_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call FAST_PackTurbineType(RF, InData%Turbine) call RegPack(RF, allocated(InData%TempDisp)) if (allocated(InData%TempDisp)) then - call RegPackBounds(RF, 1, lbound(InData%TempDisp, kind=B8Ki), ubound(InData%TempDisp, kind=B8Ki)) - LB(1:1) = lbound(InData%TempDisp, kind=B8Ki) - UB(1:1) = ubound(InData%TempDisp, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TempDisp), ubound(InData%TempDisp)) + LB(1:1) = lbound(InData%TempDisp) + UB(1:1) = ubound(InData%TempDisp) do i1 = LB(1), UB(1) call MeshPack(RF, InData%TempDisp(i1)) end do end if call RegPack(RF, allocated(InData%TempLoads)) if (allocated(InData%TempLoads)) then - call RegPackBounds(RF, 1, lbound(InData%TempLoads, kind=B8Ki), ubound(InData%TempLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%TempLoads, kind=B8Ki) - UB(1:1) = ubound(InData%TempLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TempLoads), ubound(InData%TempLoads)) + LB(1:1) = lbound(InData%TempLoads) + UB(1:1) = ubound(InData%TempLoads) do i1 = LB(1), UB(1) call MeshPack(RF, InData%TempLoads(i1)) end do end if call RegPack(RF, allocated(InData%ADRotorDisk)) if (allocated(InData%ADRotorDisk)) then - call RegPackBounds(RF, 1, lbound(InData%ADRotorDisk, kind=B8Ki), ubound(InData%ADRotorDisk, kind=B8Ki)) - LB(1:1) = lbound(InData%ADRotorDisk, kind=B8Ki) - UB(1:1) = ubound(InData%ADRotorDisk, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ADRotorDisk), ubound(InData%ADRotorDisk)) + LB(1:1) = lbound(InData%ADRotorDisk) + UB(1:1) = ubound(InData%ADRotorDisk) do i1 = LB(1), UB(1) call MeshPack(RF, InData%ADRotorDisk(i1)) end do end if call RegPack(RF, allocated(InData%AD_L2L)) if (allocated(InData%AD_L2L)) then - call RegPackBounds(RF, 1, lbound(InData%AD_L2L, kind=B8Ki), ubound(InData%AD_L2L, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_L2L, kind=B8Ki) - UB(1:1) = ubound(InData%AD_L2L, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_L2L), ubound(InData%AD_L2L)) + LB(1:1) = lbound(InData%AD_L2L) + UB(1:1) = ubound(InData%AD_L2L) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_L2L(i1)) end do @@ -671,8 +671,8 @@ subroutine FWrap_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -737,15 +737,15 @@ subroutine FWrap_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%nr = SrcParamData%nr if (allocated(SrcParamData%r)) then - LB(1:1) = lbound(SrcParamData%r, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%r, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) if (.not. allocated(DstParamData%r)) then allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -787,7 +787,7 @@ subroutine FWrap_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -803,14 +803,14 @@ subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%fromSCglob)) then - LB(1:1) = lbound(SrcInputData%fromSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSCglob, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) if (.not. allocated(DstInputData%fromSCglob)) then allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -821,8 +821,8 @@ subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%fromSCglob = SrcInputData%fromSCglob end if if (allocated(SrcInputData%fromSC)) then - LB(1:1) = lbound(SrcInputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) if (.not. allocated(DstInputData%fromSC)) then allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -863,7 +863,7 @@ subroutine FWrap_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -877,14 +877,14 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%toSC)) then - LB(1:1) = lbound(SrcOutputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%toSC, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) if (.not. allocated(DstOutputData%toSC)) then allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -902,8 +902,8 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%D_rotor = SrcOutputData%D_rotor DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel if (allocated(SrcOutputData%AzimAvg_Ct)) then - LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct) if (.not. allocated(DstOutputData%AzimAvg_Ct)) then allocate(DstOutputData%AzimAvg_Ct(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -914,8 +914,8 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct end if if (allocated(SrcOutputData%AzimAvg_Cq)) then - LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq) if (.not. allocated(DstOutputData%AzimAvg_Cq)) then allocate(DstOutputData%AzimAvg_Cq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -967,7 +967,7 @@ subroutine FWrap_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 1b73b33db9..3597c121b0 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -221,8 +221,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyParam' @@ -237,8 +237,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SC_FileName = SrcParamData%SC_FileName DstParamData%UseSC = SrcParamData%UseSC if (allocated(SrcParamData%WT_Position)) then - LB(1:2) = lbound(SrcParamData%WT_Position, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%WT_Position, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) if (.not. allocated(DstParamData%WT_Position)) then allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -254,8 +254,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DT_mooring = SrcParamData%DT_mooring DstParamData%n_mooring = SrcParamData%n_mooring if (allocated(SrcParamData%WT_FASTInFile)) then - LB(1:1) = lbound(SrcParamData%WT_FASTInFile, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WT_FASTInFile, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WT_FASTInFile) + UB(1:1) = ubound(SrcParamData%WT_FASTInFile) if (.not. allocated(DstParamData%WT_FASTInFile)) then allocate(DstParamData%WT_FASTInFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -282,8 +282,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NOutTurb = SrcParamData%NOutTurb DstParamData%NOutRadii = SrcParamData%NOutRadii if (allocated(SrcParamData%OutRadii)) then - LB(1:1) = lbound(SrcParamData%OutRadii, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutRadii, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutRadii) + UB(1:1) = ubound(SrcParamData%OutRadii) if (.not. allocated(DstParamData%OutRadii)) then allocate(DstParamData%OutRadii(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -295,8 +295,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDist = SrcParamData%NOutDist if (allocated(SrcParamData%OutDist)) then - LB(1:1) = lbound(SrcParamData%OutDist, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutDist, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutDist) + UB(1:1) = ubound(SrcParamData%OutDist) if (.not. allocated(DstParamData%OutDist)) then allocate(DstParamData%OutDist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -308,8 +308,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NWindVel = SrcParamData%NWindVel if (allocated(SrcParamData%WindVelX)) then - LB(1:1) = lbound(SrcParamData%WindVelX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WindVelX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WindVelX) + UB(1:1) = ubound(SrcParamData%WindVelX) if (.not. allocated(DstParamData%WindVelX)) then allocate(DstParamData%WindVelX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -320,8 +320,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelX = SrcParamData%WindVelX end if if (allocated(SrcParamData%WindVelY)) then - LB(1:1) = lbound(SrcParamData%WindVelY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WindVelY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WindVelY) + UB(1:1) = ubound(SrcParamData%WindVelY) if (.not. allocated(DstParamData%WindVelY)) then allocate(DstParamData%WindVelY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -332,8 +332,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelY = SrcParamData%WindVelY end if if (allocated(SrcParamData%WindVelZ)) then - LB(1:1) = lbound(SrcParamData%WindVelZ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WindVelZ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WindVelZ) + UB(1:1) = ubound(SrcParamData%WindVelZ) if (.not. allocated(DstParamData%WindVelZ)) then allocate(DstParamData%WindVelZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -344,8 +344,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelZ = SrcParamData%WindVelZ end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -362,8 +362,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%NOutSteps = SrcParamData%NOutSteps DstParamData%FileDescLines = SrcParamData%FileDescLines - LB(1:1) = lbound(SrcParamData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Module_Ver) + UB(1:1) = ubound(SrcParamData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_CopyProgDesc(SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -390,8 +390,8 @@ subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) type(Farm_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyParam' @@ -419,16 +419,16 @@ subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WindVelZ) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ParamData%OutParam) end if - LB(1:1) = lbound(ParamData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(ParamData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(ParamData%Module_Ver) + UB(1:1) = ubound(ParamData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_DestroyProgDesc(ParamData%Module_Ver(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -439,8 +439,8 @@ subroutine Farm_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(Farm_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT_low) call RegPack(RF, InData%DT_high) @@ -482,9 +482,9 @@ subroutine Farm_PackParam(RF, Indata) call RegPackAlloc(RF, InData%WindVelZ) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -492,8 +492,8 @@ subroutine Farm_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, InData%NOutSteps) call RegPack(RF, InData%FileDescLines) - LB(1:1) = lbound(InData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(InData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(RF, InData%Module_Ver(i1)) end do @@ -519,8 +519,8 @@ subroutine Farm_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Farm_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -578,8 +578,8 @@ subroutine Farm_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NOutSteps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%FileDescLines); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(OutData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_UnpackProgDesc(RF, OutData%Module_Ver(i1)) ! Module_Ver end do @@ -606,16 +606,16 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -626,8 +626,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%TimeData)) then - LB(1:1) = lbound(SrcMiscData%TimeData, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TimeData, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%TimeData) + UB(1:1) = ubound(SrcMiscData%TimeData) if (.not. allocated(DstMiscData%TimeData)) then allocate(DstMiscData%TimeData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -638,8 +638,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TimeData = SrcMiscData%TimeData end if if (allocated(SrcMiscData%AllOutData)) then - LB(1:2) = lbound(SrcMiscData%AllOutData, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AllOutData, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%AllOutData) + UB(1:2) = ubound(SrcMiscData%AllOutData) if (.not. allocated(DstMiscData%AllOutData)) then allocate(DstMiscData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -651,8 +651,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%n_Out = SrcMiscData%n_Out if (allocated(SrcMiscData%FWrap_2_MD)) then - LB(1:1) = lbound(SrcMiscData%FWrap_2_MD, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FWrap_2_MD, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FWrap_2_MD) + UB(1:1) = ubound(SrcMiscData%FWrap_2_MD) if (.not. allocated(DstMiscData%FWrap_2_MD)) then allocate(DstMiscData%FWrap_2_MD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -667,8 +667,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%MD_2_FWrap)) then - LB(1:1) = lbound(SrcMiscData%MD_2_FWrap, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%MD_2_FWrap, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%MD_2_FWrap) + UB(1:1) = ubound(SrcMiscData%MD_2_FWrap) if (.not. allocated(DstMiscData%MD_2_FWrap)) then allocate(DstMiscData%MD_2_FWrap(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -688,8 +688,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Farm_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyMisc' @@ -705,8 +705,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%AllOutData) end if if (allocated(MiscData%FWrap_2_MD)) then - LB(1:1) = lbound(MiscData%FWrap_2_MD, kind=B8Ki) - UB(1:1) = ubound(MiscData%FWrap_2_MD, kind=B8Ki) + LB(1:1) = lbound(MiscData%FWrap_2_MD) + UB(1:1) = ubound(MiscData%FWrap_2_MD) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -714,8 +714,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%FWrap_2_MD) end if if (allocated(MiscData%MD_2_FWrap)) then - LB(1:1) = lbound(MiscData%MD_2_FWrap, kind=B8Ki) - UB(1:1) = ubound(MiscData%MD_2_FWrap, kind=B8Ki) + LB(1:1) = lbound(MiscData%MD_2_FWrap) + UB(1:1) = ubound(MiscData%MD_2_FWrap) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -728,8 +728,8 @@ subroutine Farm_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(Farm_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%AllOuts) call RegPackAlloc(RF, InData%TimeData) @@ -737,18 +737,18 @@ subroutine Farm_PackMisc(RF, Indata) call RegPack(RF, InData%n_Out) call RegPack(RF, allocated(InData%FWrap_2_MD)) if (allocated(InData%FWrap_2_MD)) then - call RegPackBounds(RF, 1, lbound(InData%FWrap_2_MD, kind=B8Ki), ubound(InData%FWrap_2_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%FWrap_2_MD, kind=B8Ki) - UB(1:1) = ubound(InData%FWrap_2_MD, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%FWrap_2_MD), ubound(InData%FWrap_2_MD)) + LB(1:1) = lbound(InData%FWrap_2_MD) + UB(1:1) = ubound(InData%FWrap_2_MD) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%FWrap_2_MD(i1)) end do end if call RegPack(RF, allocated(InData%MD_2_FWrap)) if (allocated(InData%MD_2_FWrap)) then - call RegPackBounds(RF, 1, lbound(InData%MD_2_FWrap, kind=B8Ki), ubound(InData%MD_2_FWrap, kind=B8Ki)) - LB(1:1) = lbound(InData%MD_2_FWrap, kind=B8Ki) - UB(1:1) = ubound(InData%MD_2_FWrap, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MD_2_FWrap), ubound(InData%MD_2_FWrap)) + LB(1:1) = lbound(InData%MD_2_FWrap) + UB(1:1) = ubound(InData%MD_2_FWrap) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%MD_2_FWrap(i1)) end do @@ -760,8 +760,8 @@ subroutine Farm_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Farm_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1198,8 +1198,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyMD_Data' @@ -1224,8 +1224,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMD_DataData%Input)) then - LB(1:1) = lbound(SrcMD_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcMD_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcMD_DataData%Input) + UB(1:1) = ubound(SrcMD_DataData%Input) if (.not. allocated(DstMD_DataData%Input)) then allocate(DstMD_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1240,8 +1240,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E end do end if if (allocated(SrcMD_DataData%InputTimes)) then - LB(1:1) = lbound(SrcMD_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcMD_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcMD_DataData%InputTimes) + UB(1:1) = ubound(SrcMD_DataData%InputTimes) if (.not. allocated(DstMD_DataData%InputTimes)) then allocate(DstMD_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1264,8 +1264,8 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) type(MD_Data), intent(inout) :: MD_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyMD_Data' @@ -1284,8 +1284,8 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) call MD_DestroyInput(MD_DataData%u, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MD_DataData%Input)) then - LB(1:1) = lbound(MD_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(MD_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(MD_DataData%Input) + UB(1:1) = ubound(MD_DataData%Input) do i1 = LB(1), UB(1) call MD_DestroyInput(MD_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1305,8 +1305,8 @@ subroutine Farm_PackMD_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(MD_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackMD_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call MD_PackContState(RF, InData%x) call MD_PackDiscState(RF, InData%xd) @@ -1316,9 +1316,9 @@ subroutine Farm_PackMD_Data(RF, Indata) call MD_PackInput(RF, InData%u) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call MD_PackInput(RF, InData%Input(i1)) end do @@ -1334,8 +1334,8 @@ subroutine Farm_UnPackMD_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackMD_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1468,8 +1468,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyAll_FastFarm_Data' @@ -1482,8 +1482,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAll_FastFarm_DataData%FWrap)) then - LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap, kind=B8Ki) - UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap, kind=B8Ki) + LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap) if (.not. allocated(DstAll_FastFarm_DataData%FWrap)) then allocate(DstAll_FastFarm_DataData%FWrap(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1498,8 +1498,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ end do end if if (allocated(SrcAll_FastFarm_DataData%WD)) then - LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD, kind=B8Ki) - UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD, kind=B8Ki) + LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD) if (.not. allocated(DstAll_FastFarm_DataData%WD)) then allocate(DstAll_FastFarm_DataData%WD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1531,8 +1531,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) type(All_FastFarm_Data), intent(inout) :: All_FastFarm_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' @@ -1543,8 +1543,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) call Farm_DestroyMisc(All_FastFarm_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(All_FastFarm_DataData%FWrap)) then - LB(1:1) = lbound(All_FastFarm_DataData%FWrap, kind=B8Ki) - UB(1:1) = ubound(All_FastFarm_DataData%FWrap, kind=B8Ki) + LB(1:1) = lbound(All_FastFarm_DataData%FWrap) + UB(1:1) = ubound(All_FastFarm_DataData%FWrap) do i1 = LB(1), UB(1) call Farm_DestroyFASTWrapper_Data(All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1552,8 +1552,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) deallocate(All_FastFarm_DataData%FWrap) end if if (allocated(All_FastFarm_DataData%WD)) then - LB(1:1) = lbound(All_FastFarm_DataData%WD, kind=B8Ki) - UB(1:1) = ubound(All_FastFarm_DataData%WD, kind=B8Ki) + LB(1:1) = lbound(All_FastFarm_DataData%WD) + UB(1:1) = ubound(All_FastFarm_DataData%WD) do i1 = LB(1), UB(1) call Farm_DestroyWakeDynamics_Data(All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1574,25 +1574,25 @@ subroutine Farm_PackAll_FastFarm_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(All_FastFarm_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackAll_FastFarm_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call Farm_PackParam(RF, InData%p) call Farm_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%FWrap)) if (allocated(InData%FWrap)) then - call RegPackBounds(RF, 1, lbound(InData%FWrap, kind=B8Ki), ubound(InData%FWrap, kind=B8Ki)) - LB(1:1) = lbound(InData%FWrap, kind=B8Ki) - UB(1:1) = ubound(InData%FWrap, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%FWrap), ubound(InData%FWrap)) + LB(1:1) = lbound(InData%FWrap) + UB(1:1) = ubound(InData%FWrap) do i1 = LB(1), UB(1) call Farm_PackFASTWrapper_Data(RF, InData%FWrap(i1)) end do end if call RegPack(RF, allocated(InData%WD)) if (allocated(InData%WD)) then - call RegPackBounds(RF, 1, lbound(InData%WD, kind=B8Ki), ubound(InData%WD, kind=B8Ki)) - LB(1:1) = lbound(InData%WD, kind=B8Ki) - UB(1:1) = ubound(InData%WD, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WD), ubound(InData%WD)) + LB(1:1) = lbound(InData%WD) + UB(1:1) = ubound(InData%WD) do i1 = LB(1), UB(1) call Farm_PackWakeDynamics_Data(RF, InData%WD(i1)) end do @@ -1608,8 +1608,8 @@ subroutine Farm_UnPackAll_FastFarm_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(All_FastFarm_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackAll_FastFarm_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 7303f2c3d3..33a534f8dc 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -452,7 +452,7 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { ncOutVarIDs_["bld_ld"] = tmpVarID; ierr = nc_def_var(ncid, "bld_ld_loc", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); ncOutVarIDs_["bld_ld_loc"] = tmpVarID; - ierr = nc_def_var(ncid, "hub_ref_pos", NC_DOUBLE, 2, ptRefDataDims.data(), &tmpVarID); + ierr = nc_def_var(ncid, "hub_ref_pos", NC_DOUBLE, 1, ptRefDataDims.data(), &tmpVarID); ncOutVarIDs_["hub_ref_pos"] = tmpVarID; ierr = nc_def_var(ncid, "hub_disp", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); ncOutVarIDs_["hub_disp"] = tmpVarID; @@ -461,7 +461,7 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { ierr = nc_def_var(ncid, "hub_rotvel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); ncOutVarIDs_["hub_rotvel"] = tmpVarID; - ierr = nc_def_var(ncid, "nac_ref_pos", NC_DOUBLE, 2, ptRefDataDims.data(), &tmpVarID); + ierr = nc_def_var(ncid, "nac_ref_pos", NC_DOUBLE, 1, ptRefDataDims.data(), &tmpVarID); ncOutVarIDs_["nac_ref_pos"] = tmpVarID; ierr = nc_def_var(ncid, "nac_disp", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); ncOutVarIDs_["nac_disp"] = tmpVarID; @@ -611,17 +611,6 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { param_count_dim.data(), tmpArray.data()); } } - - ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_pos"], - &brFSIData[iTurbLoc][3].nac_ref_pos[0]); - ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_orient"], - &brFSIData[iTurbLoc][3].nac_ref_pos[3]); - - ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_pos"], - &brFSIData[iTurbLoc][3].hub_ref_pos[0]); - ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_orient"], - &brFSIData[iTurbLoc][3].hub_ref_pos[3]); - } ierr = nc_close(ncid); @@ -2378,8 +2367,8 @@ void fast::OpenFAST::get_data_from_openfast(timeStep t) { if (turbineData[iTurb].inflowType == 2) { int nvelpts = get_numVelPtsLoc(iTurb); int nfpts = get_numForcePtsLoc(iTurb); - std::cerr << "nvelpts = " << nvelpts << std::endl; - std::cerr << "nfpts = " << nfpts << " " << get_numForcePtsBladeLoc(iTurb) << " " << get_numForcePtsTwrLoc(iTurb) << std::endl; + // std::cerr << "nvelpts = " << nvelpts << std::endl; + // std::cerr << "nfpts = " << nfpts << " " << get_numForcePtsBladeLoc(iTurb) << " " << get_numForcePtsTwrLoc(iTurb) << std::endl; for (int i=0; i= AbortErrLev) return + DstInitOutputData%AirDens = SrcInitOutputData%AirDens call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -688,6 +690,7 @@ subroutine ADsk_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%AirDens) call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -696,13 +699,14 @@ subroutine ADsk_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine @@ -764,7 +768,7 @@ subroutine ADsk_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyOutput' @@ -780,8 +784,8 @@ subroutine ADsk_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Ct = SrcOutputData%Ct DstOutputData%Cq = SrcOutputData%Cq if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -829,7 +833,7 @@ subroutine ADsk_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1001,8 +1005,8 @@ subroutine ADsk_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyParam' @@ -1019,8 +1023,8 @@ subroutine ADsk_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return DstParamData%UseTSR = SrcParamData%UseTSR if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1036,8 +1040,8 @@ subroutine ADsk_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%FlowField => SrcParamData%FlowField if (allocated(SrcParamData%DiskWindPosRel)) then - LB(1:2) = lbound(SrcParamData%DiskWindPosRel, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DiskWindPosRel, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%DiskWindPosRel) + UB(1:2) = ubound(SrcParamData%DiskWindPosRel) if (.not. allocated(DstParamData%DiskWindPosRel)) then allocate(DstParamData%DiskWindPosRel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1053,8 +1057,8 @@ subroutine ADsk_DestroyParam(ParamData, ErrStat, ErrMsg) type(ADsk_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_DestroyParam' @@ -1063,8 +1067,8 @@ subroutine ADsk_DestroyParam(ParamData, ErrStat, ErrMsg) call ADsk_DestroyAeroTable(ParamData%AeroTable, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1081,8 +1085,8 @@ subroutine ADsk_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(ADsk_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADsk_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%RootName) @@ -1095,9 +1099,9 @@ subroutine ADsk_PackParam(RF, Indata) call RegPack(RF, InData%UseTSR) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1117,8 +1121,8 @@ subroutine ADsk_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1172,7 +1176,7 @@ subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyMisc' @@ -1180,8 +1184,8 @@ subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstMiscData%idx_last = SrcMiscData%idx_last if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1203,8 +1207,8 @@ subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Force = SrcMiscData%Force DstMiscData%Moment = SrcMiscData%Moment if (allocated(SrcMiscData%DiskWindPosAbs)) then - LB(1:2) = lbound(SrcMiscData%DiskWindPosAbs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%DiskWindPosAbs, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%DiskWindPosAbs) + UB(1:2) = ubound(SrcMiscData%DiskWindPosAbs) if (.not. allocated(DstMiscData%DiskWindPosAbs)) then allocate(DstMiscData%DiskWindPosAbs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1215,8 +1219,8 @@ subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DiskWindPosAbs = SrcMiscData%DiskWindPosAbs end if if (allocated(SrcMiscData%DiskWindVel)) then - LB(1:2) = lbound(SrcMiscData%DiskWindVel, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%DiskWindVel, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%DiskWindVel) + UB(1:2) = ubound(SrcMiscData%DiskWindVel) if (.not. allocated(DstMiscData%DiskWindVel)) then allocate(DstMiscData%DiskWindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1307,7 +1311,7 @@ subroutine ADsk_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/python-lib/aerodyn_inflow_library.py b/modules/aerodyn/python-lib/aerodyn_inflow_library.py index add1bcf5ac..fe3cf33d9d 100644 --- a/modules/aerodyn/python-lib/aerodyn_inflow_library.py +++ b/modules/aerodyn/python-lib/aerodyn_inflow_library.py @@ -2,7 +2,7 @@ # LICENSING # Copyright (C) 2021 National Renewable Energy Laboratory # -# This file is part of InflowWind. +# This file is part of AeroDyn. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -101,6 +101,7 @@ def __init__(self, library_path): # flags self.storeHHVel = 1 # 0=false, 1=true self.transposeDCM= 1 # 0=false, 1=true + self.pointLoadOut= 1 # 0=false, 1=true self.debuglevel = 0 # 0-4 levels # VTK @@ -162,6 +163,7 @@ def _initialize_routines(self): self.ADI_C_PreInit.argtypes = [ POINTER(c_int), # numTurbines POINTER(c_int), # transposeDCM + POINTER(c_int), # pointLoadOutput POINTER(c_int), # debuglevel POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C @@ -258,6 +260,7 @@ def _initialize_routines(self): POINTER(c_int), # iturb POINTER(c_int), # numMeshPts POINTER(c_float), # meshFrc -- mesh forces/moments in flat array of 6*numMeshPts + POINTER(c_float), # hhVel -- wind speed at hub height in flat array of 3 POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C ] @@ -295,6 +298,7 @@ def adi_preinit(self): self.ADI_C_PreInit( byref(c_int(self.numTurbines)), # IN: numTurbines byref(c_int(self.transposeDCM)), # IN: transposeDCM + byref(c_int(self.pointLoadOut)), # IN: pointLoadOut byref(c_int(self.debuglevel)), # IN: debuglevel byref(self.error_status_c), # OUT: ErrStat_C self.error_message_c # OUT: ErrMsg_C @@ -487,15 +491,17 @@ def adi_setrotormotion(self, iturb, \ # adi_calcOutput ------------------------------------------------------------------------------------------------------------ - def adi_getrotorloads(self, iturb, meshFrcMom): + def adi_getrotorloads(self, iturb, meshFrcMom, hhVel=None): # Resulting Forces/moments -- [Fx1,Fy1,Fz1,Mx1,My1,Mz1, Fx2,Fy2,Fz2,Mx2,My2,Mz2 ...] _meshFrc_flat_c = (c_float * (6 * self.numMeshPts))(0.0,) + _hhVel_flat_c = (c_float * 3)(0.0,) # Run ADI_C_GetRotorLoads self.ADI_C_GetRotorLoads( c_int(iturb), # IN: iturb -- current turbine number byref(c_int(self.numMeshPts)), # IN: number of attachment points expected (where motions are transferred into HD) _meshFrc_flat_c, # OUT: resulting forces/moments array + _hhVel_flat_c, # OUT: hub height velocity [Vx, Vy, Vz] byref(self.error_status_c), # OUT: ErrStat_C self.error_message_c # OUT: ErrMsg_C ) @@ -513,6 +519,11 @@ def adi_getrotorloads(self, iturb, meshFrcMom): meshFrcMom[j,5] = _meshFrc_flat_c[count+5] count = count + 6 + ## Hub height wind speed + if self.storeHHVel and hhVel != None: + hhVel[0] = _hhVel_flat_c[0] + hhVel[1] = _hhVel_flat_c[1] + hhVel[2] = _hhVel_flat_c[2] # adi_calcOutput ------------------------------------------------------------------------------------------------------------ def adi_calcOutput(self, time, outputChannelValues): diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index bd2650d49a..968693f6a1 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -177,17 +177,10 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%SpdSound = InitInp%SpdSound p%HubHeight = InitInp%HubHeight p%Lturb = InputFileData%Lturb - p%dy_turb_in = InputFileData%dy_turb_in - p%dz_turb_in = InputFileData%dz_turb_in p%NrObsLoc = InputFileData%NrObsLoc p%FTitle = InputFileData%FTitle - - IF ((InputFileData%TICalcMeth==1)) THEN - call AllocAry(p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2); if(Failed()) return - p%TI_Grid_In=InputFileData%TI_Grid_In - ENDIF - - p%AvgV=InputFileData%AvgV + p%TI = InputFileData%TI + p%avgV = InputFileData%avgV ! Copy AFInfo into AA module ! TODO Allocate AFInfo and AFindx variables (DONE AND DONE) @@ -733,30 +726,9 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) ELSE! interpolate from the user given ti values do i=1,p%NumBlades do j=1,p%NumBlNds - zi_a=ABS(m%LE_Location(3,j,i) - (FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))) ) /p%dz_turb_in - z0_a=floor(zi_a) - z1_a=ceiling(zi_a) - zd_a=zi_a-z0_a - yi_a=ABS(m%LE_Location(2,j,i) + maxval(p%BlSpn(:,1)) ) /p%dy_turb_in - y0_a=floor(yi_a) - y1_a=ceiling(yi_a) - yd_a=yi_a-y0_a - c00_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z0_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z0_a+1,y1_a+1) - c10_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z1_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z1_a+1,y1_a+1) - - ! This is the turbulence intensity of the wind at the location of the blade i at node j - ti_vx = (1.0_ReKi-zd_a)*c00_a+zd_a*c10_a - ! With some velocity triangles, we convert it into the incident turbulence intensity, i.e. the TI used by the Amiet model - U1 = u%Vrel(J,I) - U2 = SQRT((p%AvgV*(1.+ti_vx))**2 + U1**2 - p%AvgV**2) - ! xd%TIVx(j,i)=(U2-U1)/U1 - xd%TIVx(j,i)=p%AvgV*ti_vx/U1 - - - if (i.eq.p%NumBlades) then - if (j.eq.p%NumBlNds) then - endif - endif + ! We scale the incident turbulence intensity by the ratio of average to incident wind speed + ! The scaled TI is used by the Amiet model + xd%TIVx(j,i)=p%TI*p%avgV/u%Vrel(J,I) enddo enddo endif diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 index 28679b5992..7e6affa37e 100644 --- a/modules/aerodyn/src/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -94,10 +94,6 @@ SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFil if (Failed())return endif - IF( (InputFileData%TICalcMeth==1) ) THEN - CALL REadTICalcTables(InputFileName,InputFileData, ErrStat2, ErrMsg2); if(Failed()) return - ENDIF - CONTAINS logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -203,7 +199,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U CALL ReadCom( UnIn, InputFile, 'Section Header: Aeroacoustic Models', ErrStat2, ErrMsg2, UnEc ); call check() CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVAr(UnIn,InputFile,InputFileData%TICalcTabFile,"TICalcTabFile","" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVAr(UnIn,InputFile,InputFileData%TI ,"TI" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVAr(UnIn,InputFile,InputFileData%avgV ,"avgV" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%Lturb ,"Lturb" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() ! ITURB - TBLTE NOISE CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() @@ -423,66 +420,6 @@ SUBROUTINE Cleanup() END SUBROUTINE Cleanup END SUBROUTINE ReadBLTables !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadTICalcTables(InputFile, InputFileData, ErrStat, ErrMsg) - ! Passed variables - integer(IntKi), intent(out) :: ErrStat ! Error status - character(*), intent(out) :: ErrMsg ! Error message - type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - ! Local variables: - integer(IntKi) :: UnIn ! Unit number for reading file - character(1024) :: FileName ! name of the files containing obesever location - integer(IntKi) :: ErrStat2 ! Temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(1024) :: PriPath ! Path name of the primary file - character(*), parameter :: RoutineName = 'REadTICalcTables' - integer(IntKi) :: GridY ! - integer(IntKi) :: GridZ ! - integer(IntKi) :: cou1 - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - FileName = TRIM(PriPath)//InputFileData%TICalcTabFile - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2); call check() - CALL OpenFInpFile ( UnIn, FileName, ErrStat2, ErrMsg2 ); if(Failed()) return - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%AvgV, 'AvgV', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, GridY, 'GridY', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2);call check() - CALL ReadVar(UnIn, FileName, GridZ, 'GridZ', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%dy_turb_in, 'InputFileData%dy_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%dz_turb_in, 'InputFileData%dz_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check() - if(Failed()) return - - CALL AllocAry( InputFileData%TI_Grid_In,GridZ,GridY,'InputFileData%TI_Grid_In', ErrStat2, ErrMsg2); - if(Failed()) return - DO cou1=1,size(InputFileData%TI_Grid_In,1) - read(UnIn,*) InputFileData%TI_Grid_In(cou1,:) - ENDDO - !---------------------- END OF FILE ----------------------------------------- - CALL Cleanup( ) - -CONTAINS - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if(Failed) call cleanup() - end function Failed - SUBROUTINE Check() - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Check - SUBROUTINE Cleanup() - IF (UnIn > 0) CLOSE ( UnIn ) - END SUBROUTINE Cleanup -END SUBROUTINE REadTICalcTables -!---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the AeroDyn input files. SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) type(AA_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt index a0c314e776..b01f3061dc 100644 --- a/modules/aerodyn/src/AeroAcoustics_Registry.txt +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -74,11 +74,11 @@ typedef ^ AA_InputFile ReKi ObsZ typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {:} - - "AAoutfile for writing output files" - -typedef ^ AA_InputFile CHARACTER(1024) TICalcTabFile - - - "Name of the file containing the table for incident turbulence intensity" - typedef ^ AA_InputFile CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - typedef ^ AA_InputFile DBKi AAStart - - - "Time after which to calculate AA" s +typedef ^ AA_InputFile ReKi TI - - - "Average rotor incident turbulence intensity" - +typedef ^ AA_InputFile ReKi avgV - - - "Average wind speed" - typedef ^ AA_InputFile ReKi Lturb - - - "Turbulent lengthscale in Amiet model" - -typedef ^ AA_InputFile ReKi AvgV - - - "Average wind speed to compute incident turbulence intensity" m typedef ^ AA_InputFile ReKi ReListBL {:} - - "" typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" @@ -89,9 +89,6 @@ typedef ^ AA_InputFile ReKi Pres_Cf typedef ^ AA_InputFile ReKi Suct_Cf {:}{:}{:} - - "" typedef ^ AA_InputFile ReKi Pres_EdgeVelRat {:}{:}{:} - - "" typedef ^ AA_InputFile ReKi Suct_EdgeVelRat {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi TI_Grid_In {:}{:} - - "" -typedef ^ AA_InputFile ReKi dz_turb_in - - - "" m -typedef ^ AA_InputFile ReKi dy_turb_in - - - "" m # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -184,10 +181,8 @@ typedef ^ ParameterType IntKi total_s typedef ^ ParameterType IntKi AA_Bl_Prcntge - - - "The Percentage of the Blade which the noise is calculated" % typedef ^ ParameterType IntKi startnode - - - "Corersponding node to the noise calculation percentage of the blade" - typedef ^ ParameterType ReKi Lturb - - - "Turbulent lengthscale in Amiet model" m -typedef ^ ParameterType ReKi AvgV - - - "Average wind speed to compute incident turbulence intensity" m -typedef ^ ParameterType ReKi dz_turb_in - - - "" m -typedef ^ ParameterType ReKi dy_turb_in - - - "" m -typedef ^ ParameterType ReKi TI_Grid_In {:}{:} - - "" +typedef ^ ParameterType ReKi avgV - - - "Average wind speed to compute incident turbulence intensity" m +typedef ^ ParameterType ReKi TI - - - "Rotor incident turbulent intensity" typedef ^ ParameterType CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - # parameters for output diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 5ad5640167..fe8bb54fcf 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -94,11 +94,11 @@ MODULE AeroAcoustics_Types TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AAoutfile !< AAoutfile for writing output files [-] - CHARACTER(1024) :: TICalcTabFile !< Name of the file containing the table for incident turbulence intensity [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] + REAL(ReKi) :: TI = 0.0_ReKi !< Average rotor incident turbulence intensity [-] + REAL(ReKi) :: avgV = 0.0_ReKi !< Average wind speed [-] REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [-] - REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AoAListBL !< [deg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_DispThick !< [-] @@ -109,9 +109,6 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_Cf !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_EdgeVelRat !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_EdgeVelRat !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] - REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] - REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] END TYPE AA_InputFile ! ======================= ! ========= AA_ContinuousStateType ======= @@ -212,10 +209,8 @@ MODULE AeroAcoustics_Types INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< The Percentage of the Blade which the noise is calculated [%] INTEGER(IntKi) :: startnode = 0_IntKi !< Corersponding node to the noise calculation percentage of the blade [-] REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [m] - REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] - REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] - REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] + REAL(ReKi) :: avgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] + REAL(ReKi) :: TI = 0.0_ReKi !< Rotor incident turbulent intensity [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] character(20) :: outFmt !< Format specifier [-] INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] @@ -345,8 +340,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitInput' @@ -357,8 +352,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%BlSpn)) then - LB(1:2) = lbound(SrcInitInputData%BlSpn, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BlSpn, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BlSpn) + UB(1:2) = ubound(SrcInitInputData%BlSpn) if (.not. allocated(DstInitInputData%BlSpn)) then allocate(DstInitInputData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -369,8 +364,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%BlSpn = SrcInitInputData%BlSpn end if if (allocated(SrcInitInputData%BlChord)) then - LB(1:2) = lbound(SrcInitInputData%BlChord, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BlChord, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BlChord) + UB(1:2) = ubound(SrcInitInputData%BlChord) if (.not. allocated(DstInitInputData%BlChord)) then allocate(DstInitInputData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -385,8 +380,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%SpdSound = SrcInitInputData%SpdSound DstInitInputData%HubHeight = SrcInitInputData%HubHeight if (allocated(SrcInitInputData%BlAFID)) then - LB(1:2) = lbound(SrcInitInputData%BlAFID, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BlAFID, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BlAFID) + UB(1:2) = ubound(SrcInitInputData%BlAFID) if (.not. allocated(DstInitInputData%BlAFID)) then allocate(DstInitInputData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -397,8 +392,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%BlAFID = SrcInitInputData%BlAFID end if if (allocated(SrcInitInputData%AFInfo)) then - LB(1:1) = lbound(SrcInitInputData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%AFInfo, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%AFInfo) + UB(1:1) = ubound(SrcInitInputData%AFInfo) if (.not. allocated(DstInitInputData%AFInfo)) then allocate(DstInitInputData%AFInfo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -418,8 +413,8 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(AA_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInitInput' @@ -435,8 +430,8 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%BlAFID) end if if (allocated(InitInputData%AFInfo)) then - LB(1:1) = lbound(InitInputData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(InitInputData%AFInfo, kind=B8Ki) + LB(1:1) = lbound(InitInputData%AFInfo) + UB(1:1) = ubound(InitInputData%AFInfo) do i1 = LB(1), UB(1) call AFI_DestroyParam(InitInputData%AFInfo(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -449,8 +444,8 @@ subroutine AA_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInitInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%InputFile) call RegPack(RF, InData%NumBlades) @@ -465,9 +460,9 @@ subroutine AA_PackInitInput(RF, Indata) call RegPackAlloc(RF, InData%BlAFID) call RegPack(RF, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then - call RegPackBounds(RF, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) - LB(1:1) = lbound(InData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(InData%AFInfo, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) do i1 = LB(1), UB(1) call AFI_PackParam(RF, InData%AFInfo(i1)) end do @@ -479,8 +474,8 @@ subroutine AA_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -516,15 +511,15 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -535,8 +530,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -547,8 +542,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if if (allocated(SrcInitOutputData%WriteOutputHdrforPE)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE) if (.not. allocated(DstInitOutputData%WriteOutputHdrforPE)) then allocate(DstInitOutputData%WriteOutputHdrforPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -559,8 +554,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE end if if (allocated(SrcInitOutputData%WriteOutputUntforPE)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE) if (.not. allocated(DstInitOutputData%WriteOutputUntforPE)) then allocate(DstInitOutputData%WriteOutputUntforPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -571,8 +566,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE end if if (allocated(SrcInitOutputData%WriteOutputHdrSep)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep) if (.not. allocated(DstInitOutputData%WriteOutputHdrSep)) then allocate(DstInitOutputData%WriteOutputHdrSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -583,8 +578,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep end if if (allocated(SrcInitOutputData%WriteOutputUntSep)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep) if (.not. allocated(DstInitOutputData%WriteOutputUntSep)) then allocate(DstInitOutputData%WriteOutputUntSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -595,8 +590,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep end if if (allocated(SrcInitOutputData%WriteOutputHdrNodes)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes) if (.not. allocated(DstInitOutputData%WriteOutputHdrNodes)) then allocate(DstInitOutputData%WriteOutputHdrNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -607,8 +602,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes end if if (allocated(SrcInitOutputData%WriteOutputUntNodes)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes) if (.not. allocated(DstInitOutputData%WriteOutputUntNodes)) then allocate(DstInitOutputData%WriteOutputUntNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -685,7 +680,7 @@ subroutine AA_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -708,8 +703,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInputFile' @@ -731,8 +726,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc if (allocated(SrcInputFileData%ObsX)) then - LB(1:1) = lbound(SrcInputFileData%ObsX, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ObsX, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ObsX) + UB(1:1) = ubound(SrcInputFileData%ObsX) if (.not. allocated(DstInputFileData%ObsX)) then allocate(DstInputFileData%ObsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -743,8 +738,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsX = SrcInputFileData%ObsX end if if (allocated(SrcInputFileData%ObsY)) then - LB(1:1) = lbound(SrcInputFileData%ObsY, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ObsY, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ObsY) + UB(1:1) = ubound(SrcInputFileData%ObsY) if (.not. allocated(DstInputFileData%ObsY)) then allocate(DstInputFileData%ObsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -755,8 +750,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsY = SrcInputFileData%ObsY end if if (allocated(SrcInputFileData%ObsZ)) then - LB(1:1) = lbound(SrcInputFileData%ObsZ, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ObsZ, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ObsZ) + UB(1:1) = ubound(SrcInputFileData%ObsZ) if (.not. allocated(DstInputFileData%ObsZ)) then allocate(DstInputFileData%ObsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -767,8 +762,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsZ = SrcInputFileData%ObsZ end if if (allocated(SrcInputFileData%BladeProps)) then - LB(1:1) = lbound(SrcInputFileData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BladeProps) + UB(1:1) = ubound(SrcInputFileData%BladeProps) if (.not. allocated(DstInputFileData%BladeProps)) then allocate(DstInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -784,8 +779,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile if (allocated(SrcInputFileData%AAoutfile)) then - LB(1:1) = lbound(SrcInputFileData%AAoutfile, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%AAoutfile, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%AAoutfile) + UB(1:1) = ubound(SrcInputFileData%AAoutfile) if (.not. allocated(DstInputFileData%AAoutfile)) then allocate(DstInputFileData%AAoutfile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -795,14 +790,14 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile end if - DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile DstInputFileData%FTitle = SrcInputFileData%FTitle DstInputFileData%AAStart = SrcInputFileData%AAStart + DstInputFileData%TI = SrcInputFileData%TI + DstInputFileData%avgV = SrcInputFileData%avgV DstInputFileData%Lturb = SrcInputFileData%Lturb - DstInputFileData%AvgV = SrcInputFileData%AvgV if (allocated(SrcInputFileData%ReListBL)) then - LB(1:1) = lbound(SrcInputFileData%ReListBL, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ReListBL, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ReListBL) + UB(1:1) = ubound(SrcInputFileData%ReListBL) if (.not. allocated(DstInputFileData%ReListBL)) then allocate(DstInputFileData%ReListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -813,8 +808,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ReListBL = SrcInputFileData%ReListBL end if if (allocated(SrcInputFileData%AoAListBL)) then - LB(1:1) = lbound(SrcInputFileData%AoAListBL, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%AoAListBL, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%AoAListBL) + UB(1:1) = ubound(SrcInputFileData%AoAListBL) if (.not. allocated(DstInputFileData%AoAListBL)) then allocate(DstInputFileData%AoAListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -825,8 +820,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL end if if (allocated(SrcInputFileData%Pres_DispThick)) then - LB(1:3) = lbound(SrcInputFileData%Pres_DispThick, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Pres_DispThick, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Pres_DispThick) + UB(1:3) = ubound(SrcInputFileData%Pres_DispThick) if (.not. allocated(DstInputFileData%Pres_DispThick)) then allocate(DstInputFileData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -837,8 +832,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick end if if (allocated(SrcInputFileData%Suct_DispThick)) then - LB(1:3) = lbound(SrcInputFileData%Suct_DispThick, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Suct_DispThick, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Suct_DispThick) + UB(1:3) = ubound(SrcInputFileData%Suct_DispThick) if (.not. allocated(DstInputFileData%Suct_DispThick)) then allocate(DstInputFileData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -849,8 +844,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick end if if (allocated(SrcInputFileData%Pres_BLThick)) then - LB(1:3) = lbound(SrcInputFileData%Pres_BLThick, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Pres_BLThick, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Pres_BLThick) + UB(1:3) = ubound(SrcInputFileData%Pres_BLThick) if (.not. allocated(DstInputFileData%Pres_BLThick)) then allocate(DstInputFileData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -861,8 +856,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick end if if (allocated(SrcInputFileData%Suct_BLThick)) then - LB(1:3) = lbound(SrcInputFileData%Suct_BLThick, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Suct_BLThick, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Suct_BLThick) + UB(1:3) = ubound(SrcInputFileData%Suct_BLThick) if (.not. allocated(DstInputFileData%Suct_BLThick)) then allocate(DstInputFileData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -873,8 +868,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick end if if (allocated(SrcInputFileData%Pres_Cf)) then - LB(1:3) = lbound(SrcInputFileData%Pres_Cf, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Pres_Cf, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Pres_Cf) + UB(1:3) = ubound(SrcInputFileData%Pres_Cf) if (.not. allocated(DstInputFileData%Pres_Cf)) then allocate(DstInputFileData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -885,8 +880,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf end if if (allocated(SrcInputFileData%Suct_Cf)) then - LB(1:3) = lbound(SrcInputFileData%Suct_Cf, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Suct_Cf, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Suct_Cf) + UB(1:3) = ubound(SrcInputFileData%Suct_Cf) if (.not. allocated(DstInputFileData%Suct_Cf)) then allocate(DstInputFileData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -897,8 +892,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf end if if (allocated(SrcInputFileData%Pres_EdgeVelRat)) then - LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat) if (.not. allocated(DstInputFileData%Pres_EdgeVelRat)) then allocate(DstInputFileData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -909,8 +904,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat end if if (allocated(SrcInputFileData%Suct_EdgeVelRat)) then - LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat) if (.not. allocated(DstInputFileData%Suct_EdgeVelRat)) then allocate(DstInputFileData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -920,28 +915,14 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat end if - if (allocated(SrcInputFileData%TI_Grid_In)) then - LB(1:2) = lbound(SrcInputFileData%TI_Grid_In, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%TI_Grid_In, kind=B8Ki) - if (.not. allocated(DstInputFileData%TI_Grid_In)) then - allocate(DstInputFileData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TI_Grid_In.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In - end if - DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in - DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in end subroutine subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(AA_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInputFile' @@ -957,8 +938,8 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%ObsZ) end if if (allocated(InputFileData%BladeProps)) then - LB(1:1) = lbound(InputFileData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(InputFileData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(InputFileData%BladeProps) + UB(1:1) = ubound(InputFileData%BladeProps) do i1 = LB(1), UB(1) call AA_DestroyBladePropsType(InputFileData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -998,17 +979,14 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) if (allocated(InputFileData%Suct_EdgeVelRat)) then deallocate(InputFileData%Suct_EdgeVelRat) end if - if (allocated(InputFileData%TI_Grid_In)) then - deallocate(InputFileData%TI_Grid_In) - end if end subroutine subroutine AA_PackInputFile(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInputFile' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT_AA) call RegPack(RF, InData%IBLUNT) @@ -1030,20 +1008,20 @@ subroutine AA_PackInputFile(RF, Indata) call RegPackAlloc(RF, InData%ObsZ) call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) do i1 = LB(1), UB(1) call AA_PackBladePropsType(RF, InData%BladeProps(i1)) end do end if call RegPack(RF, InData%NrOutFile) call RegPackAlloc(RF, InData%AAoutfile) - call RegPack(RF, InData%TICalcTabFile) call RegPack(RF, InData%FTitle) call RegPack(RF, InData%AAStart) + call RegPack(RF, InData%TI) + call RegPack(RF, InData%avgV) call RegPack(RF, InData%Lturb) - call RegPack(RF, InData%AvgV) call RegPackAlloc(RF, InData%ReListBL) call RegPackAlloc(RF, InData%AoAListBL) call RegPackAlloc(RF, InData%Pres_DispThick) @@ -1054,9 +1032,6 @@ subroutine AA_PackInputFile(RF, Indata) call RegPackAlloc(RF, InData%Suct_Cf) call RegPackAlloc(RF, InData%Pres_EdgeVelRat) call RegPackAlloc(RF, InData%Suct_EdgeVelRat) - call RegPackAlloc(RF, InData%TI_Grid_In) - call RegPack(RF, InData%dz_turb_in) - call RegPack(RF, InData%dy_turb_in) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1064,8 +1039,8 @@ subroutine AA_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInputFile' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1102,11 +1077,11 @@ subroutine AA_UnPackInputFile(RF, OutData) end if call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AAoutfile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TICalcTabFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%AAStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avgV); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgV); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ReListBL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AoAListBL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Pres_DispThick); if (RegCheckErr(RF, RoutineName)) return @@ -1117,9 +1092,6 @@ subroutine AA_UnPackInputFile(RF, OutData) call RegUnpackAlloc(RF, OutData%Suct_Cf); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Pres_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Suct_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TI_Grid_In); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dz_turb_in); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dy_turb_in); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1166,14 +1138,14 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%MeanVrel)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVrel, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%MeanVrel, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%MeanVrel) + UB(1:2) = ubound(SrcDiscStateData%MeanVrel) if (.not. allocated(DstDiscStateData%MeanVrel)) then allocate(DstDiscStateData%MeanVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1184,8 +1156,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel end if if (allocated(SrcDiscStateData%VrelSq)) then - LB(1:2) = lbound(SrcDiscStateData%VrelSq, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%VrelSq, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%VrelSq) + UB(1:2) = ubound(SrcDiscStateData%VrelSq) if (.not. allocated(DstDiscStateData%VrelSq)) then allocate(DstDiscStateData%VrelSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1196,8 +1168,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq end if if (allocated(SrcDiscStateData%TIVrel)) then - LB(1:2) = lbound(SrcDiscStateData%TIVrel, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%TIVrel, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%TIVrel) + UB(1:2) = ubound(SrcDiscStateData%TIVrel) if (.not. allocated(DstDiscStateData%TIVrel)) then allocate(DstDiscStateData%TIVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1208,8 +1180,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel end if if (allocated(SrcDiscStateData%VrelStore)) then - LB(1:3) = lbound(SrcDiscStateData%VrelStore, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%VrelStore, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%VrelStore) + UB(1:3) = ubound(SrcDiscStateData%VrelStore) if (.not. allocated(DstDiscStateData%VrelStore)) then allocate(DstDiscStateData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1220,8 +1192,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore end if if (allocated(SrcDiscStateData%TIVx)) then - LB(1:2) = lbound(SrcDiscStateData%TIVx, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%TIVx, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%TIVx) + UB(1:2) = ubound(SrcDiscStateData%TIVx) if (.not. allocated(DstDiscStateData%TIVx)) then allocate(DstDiscStateData%TIVx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1232,8 +1204,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TIVx = SrcDiscStateData%TIVx end if if (allocated(SrcDiscStateData%MeanVxVyVz)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) + UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz) if (.not. allocated(DstDiscStateData%MeanVxVyVz)) then allocate(DstDiscStateData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1244,8 +1216,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz end if if (allocated(SrcDiscStateData%VxSq)) then - LB(1:2) = lbound(SrcDiscStateData%VxSq, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%VxSq, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%VxSq) + UB(1:2) = ubound(SrcDiscStateData%VxSq) if (.not. allocated(DstDiscStateData%VxSq)) then allocate(DstDiscStateData%VxSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1256,8 +1228,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VxSq = SrcDiscStateData%VxSq end if if (allocated(SrcDiscStateData%allregcounter)) then - LB(1:2) = lbound(SrcDiscStateData%allregcounter, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%allregcounter, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%allregcounter) + UB(1:2) = ubound(SrcDiscStateData%allregcounter) if (.not. allocated(DstDiscStateData%allregcounter)) then allocate(DstDiscStateData%allregcounter(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1268,8 +1240,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter end if if (allocated(SrcDiscStateData%VxSqRegion)) then - LB(1:2) = lbound(SrcDiscStateData%VxSqRegion, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%VxSqRegion, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%VxSqRegion) + UB(1:2) = ubound(SrcDiscStateData%VxSqRegion) if (.not. allocated(DstDiscStateData%VxSqRegion)) then allocate(DstDiscStateData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1280,8 +1252,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion end if if (allocated(SrcDiscStateData%RegVxStor)) then - LB(1:3) = lbound(SrcDiscStateData%RegVxStor, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%RegVxStor, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%RegVxStor) + UB(1:3) = ubound(SrcDiscStateData%RegVxStor) if (.not. allocated(DstDiscStateData%RegVxStor)) then allocate(DstDiscStateData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1292,8 +1264,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor end if if (allocated(SrcDiscStateData%RegionTIDelete)) then - LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) + UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete) if (.not. allocated(DstDiscStateData%RegionTIDelete)) then allocate(DstDiscStateData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1370,7 +1342,7 @@ subroutine AA_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackDiscState' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1469,14 +1441,14 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1487,8 +1459,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%ChordAngleTE)) then - LB(1:3) = lbound(SrcMiscData%ChordAngleTE, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%ChordAngleTE, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%ChordAngleTE) + UB(1:3) = ubound(SrcMiscData%ChordAngleTE) if (.not. allocated(DstMiscData%ChordAngleTE)) then allocate(DstMiscData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1499,8 +1471,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE end if if (allocated(SrcMiscData%SpanAngleTE)) then - LB(1:3) = lbound(SrcMiscData%SpanAngleTE, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%SpanAngleTE, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%SpanAngleTE) + UB(1:3) = ubound(SrcMiscData%SpanAngleTE) if (.not. allocated(DstMiscData%SpanAngleTE)) then allocate(DstMiscData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1511,8 +1483,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE end if if (allocated(SrcMiscData%ChordAngleLE)) then - LB(1:3) = lbound(SrcMiscData%ChordAngleLE, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%ChordAngleLE, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%ChordAngleLE) + UB(1:3) = ubound(SrcMiscData%ChordAngleLE) if (.not. allocated(DstMiscData%ChordAngleLE)) then allocate(DstMiscData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1523,8 +1495,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE end if if (allocated(SrcMiscData%SpanAngleLE)) then - LB(1:3) = lbound(SrcMiscData%SpanAngleLE, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%SpanAngleLE, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%SpanAngleLE) + UB(1:3) = ubound(SrcMiscData%SpanAngleLE) if (.not. allocated(DstMiscData%SpanAngleLE)) then allocate(DstMiscData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1535,8 +1507,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE end if if (allocated(SrcMiscData%rTEtoObserve)) then - LB(1:3) = lbound(SrcMiscData%rTEtoObserve, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%rTEtoObserve, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%rTEtoObserve) + UB(1:3) = ubound(SrcMiscData%rTEtoObserve) if (.not. allocated(DstMiscData%rTEtoObserve)) then allocate(DstMiscData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1547,8 +1519,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve end if if (allocated(SrcMiscData%rLEtoObserve)) then - LB(1:3) = lbound(SrcMiscData%rLEtoObserve, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%rLEtoObserve, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%rLEtoObserve) + UB(1:3) = ubound(SrcMiscData%rLEtoObserve) if (.not. allocated(DstMiscData%rLEtoObserve)) then allocate(DstMiscData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1559,8 +1531,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve end if if (allocated(SrcMiscData%LE_Location)) then - LB(1:3) = lbound(SrcMiscData%LE_Location, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%LE_Location, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%LE_Location) + UB(1:3) = ubound(SrcMiscData%LE_Location) if (.not. allocated(DstMiscData%LE_Location)) then allocate(DstMiscData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1572,8 +1544,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA if (allocated(SrcMiscData%SPLLBL)) then - LB(1:1) = lbound(SrcMiscData%SPLLBL, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLLBL, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLLBL) + UB(1:1) = ubound(SrcMiscData%SPLLBL) if (.not. allocated(DstMiscData%SPLLBL)) then allocate(DstMiscData%SPLLBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1584,8 +1556,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLLBL = SrcMiscData%SPLLBL end if if (allocated(SrcMiscData%SPLP)) then - LB(1:1) = lbound(SrcMiscData%SPLP, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLP, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLP) + UB(1:1) = ubound(SrcMiscData%SPLP) if (.not. allocated(DstMiscData%SPLP)) then allocate(DstMiscData%SPLP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1596,8 +1568,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLP = SrcMiscData%SPLP end if if (allocated(SrcMiscData%SPLS)) then - LB(1:1) = lbound(SrcMiscData%SPLS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLS, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLS) + UB(1:1) = ubound(SrcMiscData%SPLS) if (.not. allocated(DstMiscData%SPLS)) then allocate(DstMiscData%SPLS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1608,8 +1580,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLS = SrcMiscData%SPLS end if if (allocated(SrcMiscData%SPLALPH)) then - LB(1:1) = lbound(SrcMiscData%SPLALPH, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLALPH, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLALPH) + UB(1:1) = ubound(SrcMiscData%SPLALPH) if (.not. allocated(DstMiscData%SPLALPH)) then allocate(DstMiscData%SPLALPH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1620,8 +1592,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLALPH = SrcMiscData%SPLALPH end if if (allocated(SrcMiscData%SPLTBL)) then - LB(1:1) = lbound(SrcMiscData%SPLTBL, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLTBL, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLTBL) + UB(1:1) = ubound(SrcMiscData%SPLTBL) if (.not. allocated(DstMiscData%SPLTBL)) then allocate(DstMiscData%SPLTBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1632,8 +1604,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTBL = SrcMiscData%SPLTBL end if if (allocated(SrcMiscData%SPLTIP)) then - LB(1:1) = lbound(SrcMiscData%SPLTIP, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLTIP, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLTIP) + UB(1:1) = ubound(SrcMiscData%SPLTIP) if (.not. allocated(DstMiscData%SPLTIP)) then allocate(DstMiscData%SPLTIP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1644,8 +1616,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTIP = SrcMiscData%SPLTIP end if if (allocated(SrcMiscData%SPLTI)) then - LB(1:1) = lbound(SrcMiscData%SPLTI, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLTI, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLTI) + UB(1:1) = ubound(SrcMiscData%SPLTI) if (.not. allocated(DstMiscData%SPLTI)) then allocate(DstMiscData%SPLTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1656,8 +1628,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTI = SrcMiscData%SPLTI end if if (allocated(SrcMiscData%SPLTIGui)) then - LB(1:1) = lbound(SrcMiscData%SPLTIGui, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLTIGui, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLTIGui) + UB(1:1) = ubound(SrcMiscData%SPLTIGui) if (.not. allocated(DstMiscData%SPLTIGui)) then allocate(DstMiscData%SPLTIGui(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1668,8 +1640,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui end if if (allocated(SrcMiscData%SPLBLUNT)) then - LB(1:1) = lbound(SrcMiscData%SPLBLUNT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLBLUNT, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLBLUNT) + UB(1:1) = ubound(SrcMiscData%SPLBLUNT) if (.not. allocated(DstMiscData%SPLBLUNT)) then allocate(DstMiscData%SPLBLUNT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1680,8 +1652,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT end if if (allocated(SrcMiscData%CfVar)) then - LB(1:1) = lbound(SrcMiscData%CfVar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%CfVar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%CfVar) + UB(1:1) = ubound(SrcMiscData%CfVar) if (.not. allocated(DstMiscData%CfVar)) then allocate(DstMiscData%CfVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1692,8 +1664,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CfVar = SrcMiscData%CfVar end if if (allocated(SrcMiscData%d99Var)) then - LB(1:1) = lbound(SrcMiscData%d99Var, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%d99Var, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%d99Var) + UB(1:1) = ubound(SrcMiscData%d99Var) if (.not. allocated(DstMiscData%d99Var)) then allocate(DstMiscData%d99Var(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1704,8 +1676,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%d99Var = SrcMiscData%d99Var end if if (allocated(SrcMiscData%dStarVar)) then - LB(1:1) = lbound(SrcMiscData%dStarVar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%dStarVar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%dStarVar) + UB(1:1) = ubound(SrcMiscData%dStarVar) if (.not. allocated(DstMiscData%dStarVar)) then allocate(DstMiscData%dStarVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1716,8 +1688,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dStarVar = SrcMiscData%dStarVar end if if (allocated(SrcMiscData%EdgeVelVar)) then - LB(1:1) = lbound(SrcMiscData%EdgeVelVar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%EdgeVelVar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%EdgeVelVar) + UB(1:1) = ubound(SrcMiscData%EdgeVelVar) if (.not. allocated(DstMiscData%EdgeVelVar)) then allocate(DstMiscData%EdgeVelVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1839,7 +1811,7 @@ subroutine AA_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackMisc' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1875,8 +1847,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyParam' @@ -1902,8 +1874,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%toptip = SrcParamData%toptip DstParamData%bottip = SrcParamData%bottip if (allocated(SrcParamData%rotorregionlimitsVert)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert) if (.not. allocated(DstParamData%rotorregionlimitsVert)) then allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1914,8 +1886,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert end if if (allocated(SrcParamData%rotorregionlimitsHorz)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz) if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1926,8 +1898,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz end if if (allocated(SrcParamData%rotorregionlimitsalph)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph) if (.not. allocated(DstParamData%rotorregionlimitsalph)) then allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1938,8 +1910,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph end if if (allocated(SrcParamData%rotorregionlimitsrad)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad) if (.not. allocated(DstParamData%rotorregionlimitsrad)) then allocate(DstParamData%rotorregionlimitsrad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1954,8 +1926,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput DstParamData%AAStart = SrcParamData%AAStart if (allocated(SrcParamData%ObsX)) then - LB(1:1) = lbound(SrcParamData%ObsX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ObsX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ObsX) + UB(1:1) = ubound(SrcParamData%ObsX) if (.not. allocated(DstParamData%ObsX)) then allocate(DstParamData%ObsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1966,8 +1938,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsX = SrcParamData%ObsX end if if (allocated(SrcParamData%ObsY)) then - LB(1:1) = lbound(SrcParamData%ObsY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ObsY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ObsY) + UB(1:1) = ubound(SrcParamData%ObsY) if (.not. allocated(DstParamData%ObsY)) then allocate(DstParamData%ObsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1978,8 +1950,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsY = SrcParamData%ObsY end if if (allocated(SrcParamData%ObsZ)) then - LB(1:1) = lbound(SrcParamData%ObsZ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ObsZ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ObsZ) + UB(1:1) = ubound(SrcParamData%ObsZ) if (.not. allocated(DstParamData%ObsZ)) then allocate(DstParamData%ObsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1990,8 +1962,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsZ = SrcParamData%ObsZ end if if (allocated(SrcParamData%FreqList)) then - LB(1:1) = lbound(SrcParamData%FreqList, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FreqList, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FreqList) + UB(1:1) = ubound(SrcParamData%FreqList) if (.not. allocated(DstParamData%FreqList)) then allocate(DstParamData%FreqList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2002,8 +1974,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FreqList = SrcParamData%FreqList end if if (allocated(SrcParamData%Aweight)) then - LB(1:1) = lbound(SrcParamData%Aweight, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Aweight, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Aweight) + UB(1:1) = ubound(SrcParamData%Aweight) if (.not. allocated(DstParamData%Aweight)) then allocate(DstParamData%Aweight(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2019,21 +1991,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge DstParamData%startnode = SrcParamData%startnode DstParamData%Lturb = SrcParamData%Lturb - DstParamData%AvgV = SrcParamData%AvgV - DstParamData%dz_turb_in = SrcParamData%dz_turb_in - DstParamData%dy_turb_in = SrcParamData%dy_turb_in - if (allocated(SrcParamData%TI_Grid_In)) then - LB(1:2) = lbound(SrcParamData%TI_Grid_In, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TI_Grid_In, kind=B8Ki) - if (.not. allocated(DstParamData%TI_Grid_In)) then - allocate(DstParamData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In - end if + DstParamData%avgV = SrcParamData%avgV + DstParamData%TI = SrcParamData%TI DstParamData%FTitle = SrcParamData%FTitle DstParamData%outFmt = SrcParamData%outFmt DstParamData%NrOutFile = SrcParamData%NrOutFile @@ -2048,8 +2007,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%unOutFile4 = SrcParamData%unOutFile4 DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2064,8 +2023,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%StallStart)) then - LB(1:2) = lbound(SrcParamData%StallStart, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%StallStart, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%StallStart) + UB(1:2) = ubound(SrcParamData%StallStart) if (.not. allocated(DstParamData%StallStart)) then allocate(DstParamData%StallStart(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2076,8 +2035,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StallStart = SrcParamData%StallStart end if if (allocated(SrcParamData%TEThick)) then - LB(1:2) = lbound(SrcParamData%TEThick, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TEThick, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%TEThick) + UB(1:2) = ubound(SrcParamData%TEThick) if (.not. allocated(DstParamData%TEThick)) then allocate(DstParamData%TEThick(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2088,8 +2047,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TEThick = SrcParamData%TEThick end if if (allocated(SrcParamData%TEAngle)) then - LB(1:2) = lbound(SrcParamData%TEAngle, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TEAngle, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%TEAngle) + UB(1:2) = ubound(SrcParamData%TEAngle) if (.not. allocated(DstParamData%TEAngle)) then allocate(DstParamData%TEAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2100,8 +2059,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TEAngle = SrcParamData%TEAngle end if if (allocated(SrcParamData%AerCent)) then - LB(1:3) = lbound(SrcParamData%AerCent, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AerCent, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AerCent) + UB(1:3) = ubound(SrcParamData%AerCent) if (.not. allocated(DstParamData%AerCent)) then allocate(DstParamData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2112,8 +2071,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AerCent = SrcParamData%AerCent end if if (allocated(SrcParamData%BlAFID)) then - LB(1:2) = lbound(SrcParamData%BlAFID, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BlAFID, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BlAFID) + UB(1:2) = ubound(SrcParamData%BlAFID) if (.not. allocated(DstParamData%BlAFID)) then allocate(DstParamData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2124,8 +2083,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlAFID = SrcParamData%BlAFID end if if (allocated(SrcParamData%AFInfo)) then - LB(1:1) = lbound(SrcParamData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AFInfo, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%AFInfo) + UB(1:1) = ubound(SrcParamData%AFInfo) if (.not. allocated(DstParamData%AFInfo)) then allocate(DstParamData%AFInfo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2140,8 +2099,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%AFLECo)) then - LB(1:3) = lbound(SrcParamData%AFLECo, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AFLECo, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AFLECo) + UB(1:3) = ubound(SrcParamData%AFLECo) if (.not. allocated(DstParamData%AFLECo)) then allocate(DstParamData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2152,8 +2111,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFLECo = SrcParamData%AFLECo end if if (allocated(SrcParamData%AFTECo)) then - LB(1:3) = lbound(SrcParamData%AFTECo, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AFTECo, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AFTECo) + UB(1:3) = ubound(SrcParamData%AFTECo) if (.not. allocated(DstParamData%AFTECo)) then allocate(DstParamData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2164,8 +2123,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFTECo = SrcParamData%AFTECo end if if (allocated(SrcParamData%BlSpn)) then - LB(1:2) = lbound(SrcParamData%BlSpn, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BlSpn, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BlSpn) + UB(1:2) = ubound(SrcParamData%BlSpn) if (.not. allocated(DstParamData%BlSpn)) then allocate(DstParamData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2176,8 +2135,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlSpn = SrcParamData%BlSpn end if if (allocated(SrcParamData%BlChord)) then - LB(1:2) = lbound(SrcParamData%BlChord, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BlChord, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BlChord) + UB(1:2) = ubound(SrcParamData%BlChord) if (.not. allocated(DstParamData%BlChord)) then allocate(DstParamData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2188,8 +2147,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlChord = SrcParamData%BlChord end if if (allocated(SrcParamData%ReListBL)) then - LB(1:1) = lbound(SrcParamData%ReListBL, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ReListBL, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ReListBL) + UB(1:1) = ubound(SrcParamData%ReListBL) if (.not. allocated(DstParamData%ReListBL)) then allocate(DstParamData%ReListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2200,8 +2159,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ReListBL = SrcParamData%ReListBL end if if (allocated(SrcParamData%AOAListBL)) then - LB(1:1) = lbound(SrcParamData%AOAListBL, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AOAListBL, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%AOAListBL) + UB(1:1) = ubound(SrcParamData%AOAListBL) if (.not. allocated(DstParamData%AOAListBL)) then allocate(DstParamData%AOAListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2212,8 +2171,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AOAListBL = SrcParamData%AOAListBL end if if (allocated(SrcParamData%dStarAll1)) then - LB(1:3) = lbound(SrcParamData%dStarAll1, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%dStarAll1, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%dStarAll1) + UB(1:3) = ubound(SrcParamData%dStarAll1) if (.not. allocated(DstParamData%dStarAll1)) then allocate(DstParamData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2224,8 +2183,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dStarAll1 = SrcParamData%dStarAll1 end if if (allocated(SrcParamData%dStarAll2)) then - LB(1:3) = lbound(SrcParamData%dStarAll2, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%dStarAll2, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%dStarAll2) + UB(1:3) = ubound(SrcParamData%dStarAll2) if (.not. allocated(DstParamData%dStarAll2)) then allocate(DstParamData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2236,8 +2195,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dStarAll2 = SrcParamData%dStarAll2 end if if (allocated(SrcParamData%d99All1)) then - LB(1:3) = lbound(SrcParamData%d99All1, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%d99All1, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%d99All1) + UB(1:3) = ubound(SrcParamData%d99All1) if (.not. allocated(DstParamData%d99All1)) then allocate(DstParamData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2248,8 +2207,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%d99All1 = SrcParamData%d99All1 end if if (allocated(SrcParamData%d99All2)) then - LB(1:3) = lbound(SrcParamData%d99All2, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%d99All2, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%d99All2) + UB(1:3) = ubound(SrcParamData%d99All2) if (.not. allocated(DstParamData%d99All2)) then allocate(DstParamData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2260,8 +2219,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%d99All2 = SrcParamData%d99All2 end if if (allocated(SrcParamData%CfAll1)) then - LB(1:3) = lbound(SrcParamData%CfAll1, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%CfAll1, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%CfAll1) + UB(1:3) = ubound(SrcParamData%CfAll1) if (.not. allocated(DstParamData%CfAll1)) then allocate(DstParamData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2272,8 +2231,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CfAll1 = SrcParamData%CfAll1 end if if (allocated(SrcParamData%CfAll2)) then - LB(1:3) = lbound(SrcParamData%CfAll2, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%CfAll2, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%CfAll2) + UB(1:3) = ubound(SrcParamData%CfAll2) if (.not. allocated(DstParamData%CfAll2)) then allocate(DstParamData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2284,8 +2243,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CfAll2 = SrcParamData%CfAll2 end if if (allocated(SrcParamData%EdgeVelRat1)) then - LB(1:3) = lbound(SrcParamData%EdgeVelRat1, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%EdgeVelRat1, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%EdgeVelRat1) + UB(1:3) = ubound(SrcParamData%EdgeVelRat1) if (.not. allocated(DstParamData%EdgeVelRat1)) then allocate(DstParamData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2296,8 +2255,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 end if if (allocated(SrcParamData%EdgeVelRat2)) then - LB(1:3) = lbound(SrcParamData%EdgeVelRat2, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%EdgeVelRat2, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%EdgeVelRat2) + UB(1:3) = ubound(SrcParamData%EdgeVelRat2) if (.not. allocated(DstParamData%EdgeVelRat2)) then allocate(DstParamData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2308,8 +2267,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 end if if (allocated(SrcParamData%AFThickGuida)) then - LB(1:2) = lbound(SrcParamData%AFThickGuida, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AFThickGuida, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AFThickGuida) + UB(1:2) = ubound(SrcParamData%AFThickGuida) if (.not. allocated(DstParamData%AFThickGuida)) then allocate(DstParamData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2325,8 +2284,8 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) type(AA_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyParam' @@ -2359,12 +2318,9 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%Aweight)) then deallocate(ParamData%Aweight) end if - if (allocated(ParamData%TI_Grid_In)) then - deallocate(ParamData%TI_Grid_In) - end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2387,8 +2343,8 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%BlAFID) end if if (allocated(ParamData%AFInfo)) then - LB(1:1) = lbound(ParamData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(ParamData%AFInfo, kind=B8Ki) + LB(1:1) = lbound(ParamData%AFInfo) + UB(1:1) = ubound(ParamData%AFInfo) do i1 = LB(1), UB(1) call AFI_DestroyParam(ParamData%AFInfo(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2446,8 +2402,8 @@ subroutine AA_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%IBLUNT) @@ -2487,10 +2443,8 @@ subroutine AA_PackParam(RF, Indata) call RegPack(RF, InData%AA_Bl_Prcntge) call RegPack(RF, InData%startnode) call RegPack(RF, InData%Lturb) - call RegPack(RF, InData%AvgV) - call RegPack(RF, InData%dz_turb_in) - call RegPack(RF, InData%dy_turb_in) - call RegPackAlloc(RF, InData%TI_Grid_In) + call RegPack(RF, InData%avgV) + call RegPack(RF, InData%TI) call RegPack(RF, InData%FTitle) call RegPack(RF, InData%outFmt) call RegPack(RF, InData%NrOutFile) @@ -2506,9 +2460,9 @@ subroutine AA_PackParam(RF, Indata) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -2520,9 +2474,9 @@ subroutine AA_PackParam(RF, Indata) call RegPackAlloc(RF, InData%BlAFID) call RegPack(RF, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then - call RegPackBounds(RF, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) - LB(1:1) = lbound(InData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(InData%AFInfo, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) do i1 = LB(1), UB(1) call AFI_PackParam(RF, InData%AFInfo(i1)) end do @@ -2549,8 +2503,8 @@ subroutine AA_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2592,10 +2546,8 @@ subroutine AA_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%startnode); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgV); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dz_turb_in); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dy_turb_in); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TI_Grid_In); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avgV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%outFmt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return @@ -2663,14 +2615,14 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%RotGtoL)) then - LB(1:4) = lbound(SrcInputData%RotGtoL, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%RotGtoL, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%RotGtoL) + UB(1:4) = ubound(SrcInputData%RotGtoL) if (.not. allocated(DstInputData%RotGtoL)) then allocate(DstInputData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2681,8 +2633,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%RotGtoL = SrcInputData%RotGtoL end if if (allocated(SrcInputData%AeroCent_G)) then - LB(1:3) = lbound(SrcInputData%AeroCent_G, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%AeroCent_G, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%AeroCent_G) + UB(1:3) = ubound(SrcInputData%AeroCent_G) if (.not. allocated(DstInputData%AeroCent_G)) then allocate(DstInputData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2693,8 +2645,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%AeroCent_G = SrcInputData%AeroCent_G end if if (allocated(SrcInputData%Vrel)) then - LB(1:2) = lbound(SrcInputData%Vrel, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%Vrel, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%Vrel) + UB(1:2) = ubound(SrcInputData%Vrel) if (.not. allocated(DstInputData%Vrel)) then allocate(DstInputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2705,8 +2657,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vrel = SrcInputData%Vrel end if if (allocated(SrcInputData%AoANoise)) then - LB(1:2) = lbound(SrcInputData%AoANoise, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%AoANoise, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%AoANoise) + UB(1:2) = ubound(SrcInputData%AoANoise) if (.not. allocated(DstInputData%AoANoise)) then allocate(DstInputData%AoANoise(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2717,8 +2669,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%AoANoise = SrcInputData%AoANoise end if if (allocated(SrcInputData%Inflow)) then - LB(1:3) = lbound(SrcInputData%Inflow, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%Inflow, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%Inflow) + UB(1:3) = ubound(SrcInputData%Inflow) if (.not. allocated(DstInputData%Inflow)) then allocate(DstInputData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2771,7 +2723,7 @@ subroutine AA_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInput' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2788,14 +2740,14 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%SumSpecNoise)) then - LB(1:3) = lbound(SrcOutputData%SumSpecNoise, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%SumSpecNoise, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%SumSpecNoise) + UB(1:3) = ubound(SrcOutputData%SumSpecNoise) if (.not. allocated(DstOutputData%SumSpecNoise)) then allocate(DstOutputData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2806,8 +2758,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise end if if (allocated(SrcOutputData%SumSpecNoiseSep)) then - LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep) + UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep) if (.not. allocated(DstOutputData%SumSpecNoiseSep)) then allocate(DstOutputData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2818,8 +2770,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep end if if (allocated(SrcOutputData%OASPL)) then - LB(1:3) = lbound(SrcOutputData%OASPL, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%OASPL, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%OASPL) + UB(1:3) = ubound(SrcOutputData%OASPL) if (.not. allocated(DstOutputData%OASPL)) then allocate(DstOutputData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2830,8 +2782,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OASPL = SrcOutputData%OASPL end if if (allocated(SrcOutputData%OASPL_Mech)) then - LB(1:4) = lbound(SrcOutputData%OASPL_Mech, kind=B8Ki) - UB(1:4) = ubound(SrcOutputData%OASPL_Mech, kind=B8Ki) + LB(1:4) = lbound(SrcOutputData%OASPL_Mech) + UB(1:4) = ubound(SrcOutputData%OASPL_Mech) if (.not. allocated(DstOutputData%OASPL_Mech)) then allocate(DstOutputData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2842,8 +2794,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech end if if (allocated(SrcOutputData%DirectiviOutput)) then - LB(1:1) = lbound(SrcOutputData%DirectiviOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%DirectiviOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%DirectiviOutput) + UB(1:1) = ubound(SrcOutputData%DirectiviOutput) if (.not. allocated(DstOutputData%DirectiviOutput)) then allocate(DstOutputData%DirectiviOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2854,8 +2806,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput end if if (allocated(SrcOutputData%OutLECoords)) then - LB(1:4) = lbound(SrcOutputData%OutLECoords, kind=B8Ki) - UB(1:4) = ubound(SrcOutputData%OutLECoords, kind=B8Ki) + LB(1:4) = lbound(SrcOutputData%OutLECoords) + UB(1:4) = ubound(SrcOutputData%OutLECoords) if (.not. allocated(DstOutputData%OutLECoords)) then allocate(DstOutputData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2866,8 +2818,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OutLECoords = SrcOutputData%OutLECoords end if if (allocated(SrcOutputData%PtotalFreq)) then - LB(1:2) = lbound(SrcOutputData%PtotalFreq, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%PtotalFreq, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%PtotalFreq) + UB(1:2) = ubound(SrcOutputData%PtotalFreq) if (.not. allocated(DstOutputData%PtotalFreq)) then allocate(DstOutputData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2878,8 +2830,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq end if if (allocated(SrcOutputData%WriteOutputForPE)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputForPE, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutputForPE, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutputForPE) + UB(1:1) = ubound(SrcOutputData%WriteOutputForPE) if (.not. allocated(DstOutputData%WriteOutputForPE)) then allocate(DstOutputData%WriteOutputForPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2890,8 +2842,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2902,8 +2854,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%WriteOutputSep)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputSep, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutputSep, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutputSep) + UB(1:1) = ubound(SrcOutputData%WriteOutputSep) if (.not. allocated(DstOutputData%WriteOutputSep)) then allocate(DstOutputData%WriteOutputSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2914,8 +2866,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep end if if (allocated(SrcOutputData%WriteOutputNode)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputNode, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutputNode, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutputNode) + UB(1:1) = ubound(SrcOutputData%WriteOutputNode) if (.not. allocated(DstOutputData%WriteOutputNode)) then allocate(DstOutputData%WriteOutputNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2992,7 +2944,7 @@ subroutine AA_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackOutput' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index f6aa6cf7b5..c220b3f7b4 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -2155,7 +2155,7 @@ subroutine RotWriteOutputs( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'RotCalcOutput' + character(*), parameter :: RoutineName = 'RotWriteOutputs' real(R8Ki) :: x_hat_disk(3) ! LOGICAL :: CalcWriteOutput !------------------------------------------------------- diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 3cbde801fe..10d706033e 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -318,8 +318,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_Outputs' @@ -329,8 +329,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDvr_OutputsData%unOutFile)) then - LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile) + UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile) if (.not. allocated(DstDvr_OutputsData%unOutFile)) then allocate(DstDvr_OutputsData%unOutFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -352,8 +352,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot if (allocated(SrcDvr_OutputsData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr) if (.not. allocated(DstDvr_OutputsData%WriteOutputHdr)) then allocate(DstDvr_OutputsData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -364,8 +364,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr end if if (allocated(SrcDvr_OutputsData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt) if (.not. allocated(DstDvr_OutputsData%WriteOutputUnt)) then allocate(DstDvr_OutputsData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -376,8 +376,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt end if if (allocated(SrcDvr_OutputsData%storage)) then - LB(1:3) = lbound(SrcDvr_OutputsData%storage, kind=B8Ki) - UB(1:3) = ubound(SrcDvr_OutputsData%storage, kind=B8Ki) + LB(1:3) = lbound(SrcDvr_OutputsData%storage) + UB(1:3) = ubound(SrcDvr_OutputsData%storage) if (.not. allocated(DstDvr_OutputsData%storage)) then allocate(DstDvr_OutputsData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -388,8 +388,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage end if if (allocated(SrcDvr_OutputsData%outLine)) then - LB(1:1) = lbound(SrcDvr_OutputsData%outLine, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%outLine, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%outLine) + UB(1:1) = ubound(SrcDvr_OutputsData%outLine) if (.not. allocated(DstDvr_OutputsData%outLine)) then allocate(DstDvr_OutputsData%outLine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -400,8 +400,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine end if if (allocated(SrcDvr_OutputsData%VTK_surface)) then - LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface) + UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface) if (.not. allocated(DstDvr_OutputsData%VTK_surface)) then allocate(DstDvr_OutputsData%VTK_surface(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -428,8 +428,8 @@ subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) type(Dvr_Outputs), intent(inout) :: Dvr_OutputsData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' @@ -453,8 +453,8 @@ subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) deallocate(Dvr_OutputsData%outLine) end if if (allocated(Dvr_OutputsData%VTK_surface)) then - LB(1:1) = lbound(Dvr_OutputsData%VTK_surface, kind=B8Ki) - UB(1:1) = ubound(Dvr_OutputsData%VTK_surface, kind=B8Ki) + LB(1:1) = lbound(Dvr_OutputsData%VTK_surface) + UB(1:1) = ubound(Dvr_OutputsData%VTK_surface) do i1 = LB(1), UB(1) call AD_Dvr_DestroyDvrVTK_SurfaceType(Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -467,8 +467,8 @@ subroutine AD_Dvr_PackDvr_Outputs(RF, Indata) type(RegFile), intent(inout) :: RF type(Dvr_Outputs), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Outputs' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(RF, InData%AD_ver) call RegPackAlloc(RF, InData%unOutFile) @@ -489,9 +489,9 @@ subroutine AD_Dvr_PackDvr_Outputs(RF, Indata) call RegPackAlloc(RF, InData%outLine) call RegPack(RF, allocated(InData%VTK_surface)) if (allocated(InData%VTK_surface)) then - call RegPackBounds(RF, 1, lbound(InData%VTK_surface, kind=B8Ki), ubound(InData%VTK_surface, kind=B8Ki)) - LB(1:1) = lbound(InData%VTK_surface, kind=B8Ki) - UB(1:1) = ubound(InData%VTK_surface, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VTK_surface), ubound(InData%VTK_surface)) + LB(1:1) = lbound(InData%VTK_surface) + UB(1:1) = ubound(InData%VTK_surface) do i1 = LB(1), UB(1) call AD_Dvr_PackDvrVTK_SurfaceType(RF, InData%VTK_surface(i1)) end do @@ -510,8 +510,8 @@ subroutine AD_Dvr_UnPackDvr_Outputs(RF, OutData) type(RegFile), intent(inout) :: RF type(Dvr_Outputs), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -560,7 +560,7 @@ subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyBladeData' ErrStat = ErrID_None @@ -575,8 +575,8 @@ subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, Er DstBladeDataData%motionType = SrcBladeDataData%motionType DstBladeDataData%iMotion = SrcBladeDataData%iMotion if (allocated(SrcBladeDataData%motion)) then - LB(1:2) = lbound(SrcBladeDataData%motion, kind=B8Ki) - UB(1:2) = ubound(SrcBladeDataData%motion, kind=B8Ki) + LB(1:2) = lbound(SrcBladeDataData%motion) + UB(1:2) = ubound(SrcBladeDataData%motion) if (.not. allocated(DstBladeDataData%motion)) then allocate(DstBladeDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -624,7 +624,7 @@ subroutine AD_Dvr_UnPackBladeData(RF, OutData) type(RegFile), intent(inout) :: RF type(BladeData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackBladeData' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -647,7 +647,7 @@ subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyHubData' ErrStat = ErrID_None @@ -661,8 +661,8 @@ subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, DstHubDataData%rotAcc = SrcHubDataData%rotAcc DstHubDataData%motionFileName = SrcHubDataData%motionFileName if (allocated(SrcHubDataData%motion)) then - LB(1:2) = lbound(SrcHubDataData%motion, kind=B8Ki) - UB(1:2) = ubound(SrcHubDataData%motion, kind=B8Ki) + LB(1:2) = lbound(SrcHubDataData%motion) + UB(1:2) = ubound(SrcHubDataData%motion) if (.not. allocated(DstHubDataData%motion)) then allocate(DstHubDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -707,7 +707,7 @@ subroutine AD_Dvr_UnPackHubData(RF, OutData) type(RegFile), intent(inout) :: RF type(HubData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackHubData' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -728,7 +728,7 @@ subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyNacData' ErrStat = ErrID_None @@ -741,8 +741,8 @@ subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, DstNacDataData%yawAcc = SrcNacDataData%yawAcc DstNacDataData%motionFileName = SrcNacDataData%motionFileName if (allocated(SrcNacDataData%motion)) then - LB(1:2) = lbound(SrcNacDataData%motion, kind=B8Ki) - UB(1:2) = ubound(SrcNacDataData%motion, kind=B8Ki) + LB(1:2) = lbound(SrcNacDataData%motion) + UB(1:2) = ubound(SrcNacDataData%motion) if (.not. allocated(DstNacDataData%motion)) then allocate(DstNacDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -786,7 +786,7 @@ subroutine AD_Dvr_UnPackNacData(RF, OutData) type(RegFile), intent(inout) :: RF type(NacData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackNacData' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -844,8 +844,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyWTData' @@ -863,8 +863,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcWTDataData%map2BldPt)) then - LB(1:1) = lbound(SrcWTDataData%map2BldPt, kind=B8Ki) - UB(1:1) = ubound(SrcWTDataData%map2BldPt, kind=B8Ki) + LB(1:1) = lbound(SrcWTDataData%map2BldPt) + UB(1:1) = ubound(SrcWTDataData%map2BldPt) if (.not. allocated(DstWTDataData%map2BldPt)) then allocate(DstWTDataData%map2BldPt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -879,8 +879,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er end do end if if (allocated(SrcWTDataData%bld)) then - LB(1:1) = lbound(SrcWTDataData%bld, kind=B8Ki) - UB(1:1) = ubound(SrcWTDataData%bld, kind=B8Ki) + LB(1:1) = lbound(SrcWTDataData%bld) + UB(1:1) = ubound(SrcWTDataData%bld) if (.not. allocated(DstWTDataData%bld)) then allocate(DstWTDataData%bld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -911,8 +911,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection DstWTDataData%motionType = SrcWTDataData%motionType if (allocated(SrcWTDataData%motion)) then - LB(1:2) = lbound(SrcWTDataData%motion, kind=B8Ki) - UB(1:2) = ubound(SrcWTDataData%motion, kind=B8Ki) + LB(1:2) = lbound(SrcWTDataData%motion) + UB(1:2) = ubound(SrcWTDataData%motion) if (.not. allocated(DstWTDataData%motion)) then allocate(DstWTDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -928,8 +928,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%frequency = SrcWTDataData%frequency DstWTDataData%motionFileName = SrcWTDataData%motionFileName if (allocated(SrcWTDataData%WriteOutput)) then - LB(1:1) = lbound(SrcWTDataData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcWTDataData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcWTDataData%WriteOutput) + UB(1:1) = ubound(SrcWTDataData%WriteOutput) if (.not. allocated(DstWTDataData%WriteOutput)) then allocate(DstWTDataData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -940,8 +940,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput end if if (allocated(SrcWTDataData%userSwapArray)) then - LB(1:1) = lbound(SrcWTDataData%userSwapArray, kind=B8Ki) - UB(1:1) = ubound(SrcWTDataData%userSwapArray, kind=B8Ki) + LB(1:1) = lbound(SrcWTDataData%userSwapArray) + UB(1:1) = ubound(SrcWTDataData%userSwapArray) if (.not. allocated(DstWTDataData%userSwapArray)) then allocate(DstWTDataData%userSwapArray(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -957,8 +957,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) type(WTData), intent(inout) :: WTDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyWTData' @@ -971,8 +971,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(WTDataData%map2hubPt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(WTDataData%map2BldPt)) then - LB(1:1) = lbound(WTDataData%map2BldPt, kind=B8Ki) - UB(1:1) = ubound(WTDataData%map2BldPt, kind=B8Ki) + LB(1:1) = lbound(WTDataData%map2BldPt) + UB(1:1) = ubound(WTDataData%map2BldPt) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -980,8 +980,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) deallocate(WTDataData%map2BldPt) end if if (allocated(WTDataData%bld)) then - LB(1:1) = lbound(WTDataData%bld, kind=B8Ki) - UB(1:1) = ubound(WTDataData%bld, kind=B8Ki) + LB(1:1) = lbound(WTDataData%bld) + UB(1:1) = ubound(WTDataData%bld) do i1 = LB(1), UB(1) call AD_Dvr_DestroyBladeData(WTDataData%bld(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1009,8 +1009,8 @@ subroutine AD_Dvr_PackWTData(RF, Indata) type(RegFile), intent(inout) :: RF type(WTData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackWTData' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%originInit) call RegPack(RF, InData%orientationInit) @@ -1019,18 +1019,18 @@ subroutine AD_Dvr_PackWTData(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%map2hubPt) call RegPack(RF, allocated(InData%map2BldPt)) if (allocated(InData%map2BldPt)) then - call RegPackBounds(RF, 1, lbound(InData%map2BldPt, kind=B8Ki), ubound(InData%map2BldPt, kind=B8Ki)) - LB(1:1) = lbound(InData%map2BldPt, kind=B8Ki) - UB(1:1) = ubound(InData%map2BldPt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%map2BldPt), ubound(InData%map2BldPt)) + LB(1:1) = lbound(InData%map2BldPt) + UB(1:1) = ubound(InData%map2BldPt) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%map2BldPt(i1)) end do end if call RegPack(RF, allocated(InData%bld)) if (allocated(InData%bld)) then - call RegPackBounds(RF, 1, lbound(InData%bld, kind=B8Ki), ubound(InData%bld, kind=B8Ki)) - LB(1:1) = lbound(InData%bld, kind=B8Ki) - UB(1:1) = ubound(InData%bld, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%bld), ubound(InData%bld)) + LB(1:1) = lbound(InData%bld) + UB(1:1) = ubound(InData%bld) do i1 = LB(1), UB(1) call AD_Dvr_PackBladeData(RF, InData%bld(i1)) end do @@ -1060,8 +1060,8 @@ subroutine AD_Dvr_UnPackWTData(RF, OutData) type(RegFile), intent(inout) :: RF type(WTData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackWTData' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1122,8 +1122,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_SimData' @@ -1141,8 +1141,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines if (allocated(SrcDvr_SimDataData%WT)) then - LB(1:1) = lbound(SrcDvr_SimDataData%WT, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_SimDataData%WT, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_SimDataData%WT) + UB(1:1) = ubound(SrcDvr_SimDataData%WT) if (.not. allocated(DstDvr_SimDataData%WT)) then allocate(DstDvr_SimDataData%WT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1161,8 +1161,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases if (allocated(SrcDvr_SimDataData%Cases)) then - LB(1:1) = lbound(SrcDvr_SimDataData%Cases, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_SimDataData%Cases, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_SimDataData%Cases) + UB(1:1) = ubound(SrcDvr_SimDataData%Cases) if (.not. allocated(DstDvr_SimDataData%Cases)) then allocate(DstDvr_SimDataData%Cases(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1178,8 +1178,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo end if DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase if (allocated(SrcDvr_SimDataData%timeSeries)) then - LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries, kind=B8Ki) - UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries, kind=B8Ki) + LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries) + UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries) if (.not. allocated(DstDvr_SimDataData%timeSeries)) then allocate(DstDvr_SimDataData%timeSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1203,16 +1203,16 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) type(Dvr_SimData), intent(inout) :: Dvr_SimDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' ErrStat = ErrID_None ErrMsg = '' if (allocated(Dvr_SimDataData%WT)) then - LB(1:1) = lbound(Dvr_SimDataData%WT, kind=B8Ki) - UB(1:1) = ubound(Dvr_SimDataData%WT, kind=B8Ki) + LB(1:1) = lbound(Dvr_SimDataData%WT) + UB(1:1) = ubound(Dvr_SimDataData%WT) do i1 = LB(1), UB(1) call AD_Dvr_DestroyWTData(Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1220,8 +1220,8 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) deallocate(Dvr_SimDataData%WT) end if if (allocated(Dvr_SimDataData%Cases)) then - LB(1:1) = lbound(Dvr_SimDataData%Cases, kind=B8Ki) - UB(1:1) = ubound(Dvr_SimDataData%Cases, kind=B8Ki) + LB(1:1) = lbound(Dvr_SimDataData%Cases) + UB(1:1) = ubound(Dvr_SimDataData%Cases) do i1 = LB(1), UB(1) call AD_Dvr_DestroyDvr_Case(Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1241,8 +1241,8 @@ subroutine AD_Dvr_PackDvr_SimData(RF, Indata) type(RegFile), intent(inout) :: RF type(Dvr_SimData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_SimData' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%AD_InputFile) call RegPack(RF, InData%MHK) @@ -1257,9 +1257,9 @@ subroutine AD_Dvr_PackDvr_SimData(RF, Indata) call RegPack(RF, InData%numTurbines) call RegPack(RF, allocated(InData%WT)) if (allocated(InData%WT)) then - call RegPackBounds(RF, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) - LB(1:1) = lbound(InData%WT, kind=B8Ki) - UB(1:1) = ubound(InData%WT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) do i1 = LB(1), UB(1) call AD_Dvr_PackWTData(RF, InData%WT(i1)) end do @@ -1270,9 +1270,9 @@ subroutine AD_Dvr_PackDvr_SimData(RF, Indata) call RegPack(RF, InData%numCases) call RegPack(RF, allocated(InData%Cases)) if (allocated(InData%Cases)) then - call RegPackBounds(RF, 1, lbound(InData%Cases, kind=B8Ki), ubound(InData%Cases, kind=B8Ki)) - LB(1:1) = lbound(InData%Cases, kind=B8Ki) - UB(1:1) = ubound(InData%Cases, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Cases), ubound(InData%Cases)) + LB(1:1) = lbound(InData%Cases) + UB(1:1) = ubound(InData%Cases) do i1 = LB(1), UB(1) call AD_Dvr_PackDvr_Case(RF, InData%Cases(i1)) end do @@ -1290,8 +1290,8 @@ subroutine AD_Dvr_UnPackDvr_SimData(RF, OutData) type(RegFile), intent(inout) :: RF type(Dvr_SimData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 99e6abbfd6..5da3f6b8d6 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -299,9 +299,10 @@ subroutine ADI_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg) ! --- Set outputs !TODO: this assumes one rotor!!! - associate(AD_NumOuts => p%AD%rotors(1)%NumOuts + p%AD%rotors(1)%BldNd_TotNumOuts) - y%WriteOutput(1:AD_NumOuts) = y%AD%rotors(1)%WriteOutput(1:AD_NumOuts) - y%WriteOutput(AD_NumOuts+1:p%NumOuts) = y%IW_WriteOutput(1:m%IW%p%NumOuts) + associate(AD_NumOuts => p%AD%rotors(1)%NumOuts + p%AD%rotors(1)%BldNd_TotNumOuts, & + IW_NumOuts => m%IW%p%NumOuts) + y%WriteOutput(1:IW_NumOuts) = y%IW_WriteOutput(1:IW_NumOuts) + y%WriteOutput(IW_NumOuts+1:p%NumOuts) = y%AD%rotors(1)%WriteOutput(1:AD_NumOuts) end associate !---------------------------------------------------------------------------- diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 index 31889a853a..b2523e14c4 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 @@ -45,13 +45,19 @@ MODULE AeroDyn_Inflow_C_BINDING type(ProgDesc), parameter :: version = ProgDesc( 'AeroDyn-Inflow library', '', '' ) !------------------------------------------------------------------------------------ - ! Debugging: debugverbose -- passed at PreInit + ! Debugging: DebugLevel -- passed at PreInit ! 0 - none ! 1 - some summary info ! 2 - above + all position/orientation info ! 3 - above + input files (if direct passed) ! 4 - above + meshes - integer(IntKi) :: debugverbose = 0 + integer(IntKi) :: DebugLevel = 0 + + !------------------------------------------------------------------------------------ + ! Point Load Output: flag indicating library returns point loads -- passed at PreInit + ! true - loads returned by ADI_C_GetRotorLoads are point loads (N, N-m) at mesh points + ! false - loads returned by ADI_C_GetRotorLoads are distributed (N/m, N-m/m) loads at mesh points + logical :: PointLoadOutput = .true. !------------------------------------------------------------------------------------ ! Error handling @@ -144,14 +150,14 @@ MODULE AeroDyn_Inflow_C_BINDING INTEGER(IntKi), ALLOCATABLE :: BladeNodeToMeshPoint(:) !< Blade node -> structural mesh point mapping (sized by the number of nodes on the blade) END TYPE BladeNodeToMeshPointMapType ! ======================= - ! ========= BladePtMeshCoordsType ======= - TYPE, PUBLIC :: BladePtMeshCoordsType + ! ========= BladeStrMeshCoordsType ======= + TYPE, PUBLIC :: BladeStrMeshCoordsType REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Position !< Position of all blade points (sized by 3 x number of mesh points on the blade [x,y,z]) REAL(ReKi), DIMENSION(:,:,:), ALLOCATABLE :: Orient !< Orientation of all blade points (sized by 3 x 3 x number of mesh points on the blade [r11,r12,r13,r21,r22,r23,r31,r32,r33]) REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Velocity !< Velocity of all blade points (sized by 6 x number of mesh points on the blade [u,v,w,p,q,r]) REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Accln !< Acceleration of all blade points (sized by 6 x number of mesh points on the blade [udot,vdot,wdot,pdot,qdot,rdot]) REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Force !< Force of all blade points (sized by 6 x number of mesh points on the blade [Fx,Fy,Fz,Mx,My,Mz]) - END TYPE BladePtMeshCoordsType + END TYPE BladeStrMeshCoordsType ! ======================= ! ========= StrucPtsToBladeMapType ======= TYPE, PUBLIC :: StrucPtsToBladeMapType @@ -159,7 +165,7 @@ MODULE AeroDyn_Inflow_C_BINDING INTEGER(IntKi), ALLOCATABLE :: NumMeshPtsPerBlade(:) ! Number of structural mesh points on each blade (sized by the number of blades) INTEGER(IntKi), ALLOCATABLE :: MeshPt_2_BladeNum(:) ! Structural mesh point -> which blade on the rotor it is on (sized by the number of mesh points on the rotor) TYPE(BladeNodeToMeshPointMapType),ALLOCATABLE:: BladeNode_2_MeshPt(:) ! Blade node on blade -> structural mesh point (sized by the number of mesh points on the blade) - TYPE(BladePtMeshCoordsType), ALLOCATABLE :: BladePtMeshCoords(:) ! Mesh point coordinates for each blade (sized by the number of blades) + TYPE(BladeStrMeshCoordsType), ALLOCATABLE :: BladeStrMeshCoords(:) ! Mesh point coordinates for each blade (sized by the number of blades) END TYPE StrucPtsToBladeMapType ! ======================= ! ========= MeshByBladeType ======= @@ -176,25 +182,25 @@ MODULE AeroDyn_Inflow_C_BINDING ! one or multiple points. ! - 1 point -- rigid floating body assumption ! - N points -- flexible structure (either floating or fixed bottom) - ! TODO: for clarity, sometime it might be worth renaming BldPt* here to RtrPt* instead + ! TODO: for clarity, sometime it might be worth renaming BldStr* here to RtrPt* instead logical :: TransposeDCM !< Transpose DCMs as passed in -- test the vtk outputs to see if needed integer(IntKi), allocatable :: NumMeshPts(:) ! Number of mesh points we are interfacing motions/loads to/from AD for each rotor - type(MeshByBladeType), allocatable :: BldPtMotionMesh(:) ! Mesh for motions of external nodes (sized by number of rotors) - type(MeshByBladeType), allocatable :: BldPtLoadMesh(:) ! Mesh for loads for external nodes (sized by number of rotors) - type(MeshByBladeType), allocatable :: BldPtLoadMesh_tmp(:) ! Mesh for loads for external nodes -- temporary storage for loads (sized by number of rotors) + type(MeshByBladeType), allocatable :: BldStrMotionMesh(:) ! Mesh for motions of external nodes (sized by number of rotors) + type(MeshByBladeType), allocatable :: BldStrLoadMesh(:) ! Mesh for loads for external nodes (sized by number of rotors) + type(MeshByBladeType), allocatable :: BldStrLoadMesh_tmp(:) ! Mesh for loads for external nodes -- temporary storage for loads (sized by number of rotors) ! type(MeshType), allocatable :: NacMotionMesh(:) ! mesh for motion of nacelle -- TODO: add this mesh for nacelle load transfers ! type(MeshType), allocatable :: NacLoadMesh(:) ! mesh for loads for nacelle loads -- TODO: add this mesh for nacelle load transfers !------------------------------ ! Mesh mapping: motions ! The mapping of motions from the nodes passed in to the corresponding AD meshes - ! TODO: sometime restructure the Map_BldPtMotion_2_AD_Blade and Map_AD_BldLoad_P_2_BldPtLoad to 1D and place inside a rotor structure - type(MeshMapType), allocatable :: Map_BldPtMotion_2_AD_Blade(:,:) ! Mesh mapping between input motion mesh for blade (sized by the number of blades and number of rotors) + ! TODO: sometime restructure the Map_BldStrMotion_2_AD_Blade and Map_AD_BldLoad_P_2_BldStrLoad to 1D and place inside a rotor structure + type(MeshMapType), allocatable :: Map_BldStrMotion_2_AD_Blade(:,:) ! Mesh mapping between input motion mesh for blade (sized by the number of blades and number of rotors) type(MeshMapType), allocatable :: Map_AD_Nac_2_NacPtLoad(:) ! Mesh mapping between input motion mesh for nacelle !------------------------------ ! Mesh mapping: loads ! The mapping of loads from the AD meshes to the corresponding external nodes type(StrucPtsToBladeMapType), allocatable :: StrucPts_2_Bld_Map(:) ! Array mapping info for structural mesh points to blades, and back (sized by the number of rotors/turbines) - type(MeshMapType), allocatable :: Map_AD_BldLoad_P_2_BldPtLoad(:,:) ! Mesh mapping between AD output blade line2 load to BldPtLoad for return (sized by the number of blades and number of rotors) + type(MeshMapType), allocatable :: Map_AD_BldLoad_P_2_BldStrLoad(:,:) ! Mesh mapping between AD output blade line2 load to BldStrLoad for return (sized by the number of blades and number of rotors) ! NOTE on turbine origin ! The turbine origin is set by TurbOrigin_C during the ADI_C_SetupRotor routine. This is the tower base location. All @@ -229,7 +235,7 @@ end subroutine SetErr !--------------------------------------------- AeroDyn PreInit ------------------------------------------------- !=============================================================================================================== !> Allocate all the arrays for data storage for all turbine rotors -subroutine ADI_C_PreInit(NumTurbines_C,TransposeDCM_in,debuglevel,ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_PreInit') +subroutine ADI_C_PreInit(NumTurbines_C, TransposeDCM_in, PointLoadOutput_in, DebugLevel_in, ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_PreInit') implicit none #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_PreInit @@ -237,7 +243,8 @@ subroutine ADI_C_PreInit(NumTurbines_C,TransposeDCM_in,debuglevel,ErrStat_C,ErrM #endif integer(c_int), intent(in ) :: NumTurbines_C integer(c_int), intent(in ) :: TransposeDCM_in !< Transpose DCMs as they are passed i - integer(c_int), intent(in ) :: debuglevel + integer(c_int), intent(in ) :: PointLoadOutput_in + integer(c_int), intent(in ) :: DebugLevel_in integer(c_int), intent( out) :: ErrStat_C character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) @@ -257,16 +264,19 @@ subroutine ADI_C_PreInit(NumTurbines_C,TransposeDCM_in,debuglevel,ErrStat_C,ErrM CALL DispCopyrightLicense( version%Name ) CALL DispCompileRuntimeInfo( version%Name ) + ! Save flag for outputting point or distributed loads + PointLoadOutput = PointLoadOutput_in /= 0 + ! interface debugging - debugverbose = int(debuglevel,IntKi) + DebugLevel = int(DebugLevel_in,IntKi) ! if non-zero, show all passed data here. Then check valid values - if (debugverbose /= 0_IntKi) then - call WrScr(" Interface debugging level "//trim(Num2Lstr(debugverbose))//" requested.") + if (DebugLevel /= 0_IntKi) then + call WrScr(" Interface debugging level "//trim(Num2Lstr(DebugLevel))//" requested.") call ShowPassedData() endif ! check valid debug level - if (debugverbose < 0_IntKi .or. debugverbose > 4_IntKi) then + if (DebugLevel < 0_IntKi .or. DebugLevel > 4_IntKi) then ErrStat2 = ErrID_Fatal ErrMsg2 = "Interface debug level must be between 0 and 4"//NewLine// & " 0 - none"//NewLine// & @@ -306,21 +316,21 @@ subroutine ADI_C_PreInit(NumTurbines_C,TransposeDCM_in,debuglevel,ErrStat_C,ErrM NumMeshPts = -999 ! Allocate meshes and mesh mappings - if (allocated(BldPtMotionMesh )) deallocate(BldPtMotionMesh ) - if (allocated(BldPtLoadMesh )) deallocate(BldPtLoadMesh ) - if (allocated(BldPtLoadMesh_tmp)) deallocate(BldPtLoadMesh_tmp) + if (allocated(BldStrMotionMesh )) deallocate(BldStrMotionMesh ) + if (allocated(BldStrLoadMesh )) deallocate(BldStrLoadMesh ) + if (allocated(BldStrLoadMesh_tmp)) deallocate(BldStrLoadMesh_tmp) ! if (allocated(NacMotionMesh )) deallocate(NacMotionMesh ) ! if (allocated(NacLoadMesh )) deallocate(NacLoadMesh ) - allocate(BldPtMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldPtMotionMesh' )) return - allocate(BldPtLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldPtLoadMesh' )) return - allocate(BldPtLoadMesh_tmp(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldPtLoadMesh_tmp')) return + allocate(BldStrMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrMotionMesh' )) return + allocate(BldStrLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrLoadMesh' )) return + allocate(BldStrLoadMesh_tmp(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrLoadMesh_tmp')) return ! allocate(NacMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('NacMotionMesh' )) return ! allocate(NacLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('NacLoadMesh' )) return - if (allocated(Map_BldPtMotion_2_AD_Blade )) deallocate(Map_BldPtMotion_2_AD_Blade ) - if (allocated(Map_AD_BldLoad_P_2_BldPtLoad )) deallocate(Map_AD_BldLoad_P_2_BldPtLoad) + if (allocated(Map_BldStrMotion_2_AD_Blade )) deallocate(Map_BldStrMotion_2_AD_Blade ) + if (allocated(Map_AD_BldLoad_P_2_BldStrLoad )) deallocate(Map_AD_BldLoad_P_2_BldStrLoad) ! if (allocated(Map_NacPtMotion_2_AD_Nac )) deallocate(Map_NacPtMotion_2_AD_Nac ) - ! allocate(Map_NacPtMotion_2_AD_Nac(Sim%NumTurbines),STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldPtLoad')) returns + ! allocate(Map_NacPtMotion_2_AD_Nac(Sim%NumTurbines),STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) returns ! Allocate the StrucPtsToBladeMapType array used for mapping structural points to blades of the rotor if (allocated(StrucPts_2_Bld_Map)) deallocate(StrucPts_2_Bld_Map) @@ -362,7 +372,7 @@ subroutine ShowPassedData() call WrScr(" NumTurbines_C "//trim(Num2LStr( NumTurbines_C )) ) TmpFlag="F"; if (TransposeDCM_in==1_c_int) TmpFlag="T" call WrScr(" TransposeDCM_in "//TmpFlag ) - call WrScr(" debuglevel "//trim(Num2LStr( debuglevel )) ) + call WrScr(" debuglevel "//trim(Num2LStr( DebugLevel_in )) ) call WrScr("-----------------------------------------------------------") end subroutine ShowPassedData @@ -486,7 +496,7 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -532,7 +542,7 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! For diagnostic purposes, the following can be used to display the contents ! of the InFileInfo data structure. ! CU is the screen -- system dependent. - if (debugverbose >= 3) then + if (DebugLevel >= 3) then if (ADinputFilePassed==1_c_int) call Print_FileInfo_Struct( CU, InitInp%AD%PassedPrimaryInputData ) if (IfWinputFilePassed==1_c_int) call Print_FileInfo_Struct( CU, InitInp%IW_InitInp%PassedFileInfo ) endif @@ -883,8 +893,8 @@ subroutine SetupMotionLoadsInterfaceMeshes() ! NOTE: storing mappings in 2D this way may increase memory usage slightly if one turbine has many more blades than another. However ! the speed an memory penalties are negligible, so I don't see much reason to change that at this point. - allocate(Map_BldPtMotion_2_AD_Blade( maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_BldPtMotion_2_AD_Blade' )) return - allocate(Map_AD_BldLoad_P_2_BldPtLoad(maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldPtLoad')) return + allocate(Map_BldStrMotion_2_AD_Blade( maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_BldStrMotion_2_AD_Blade' )) return + allocate(Map_AD_BldLoad_P_2_BldStrLoad(maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) return ! Step through all turbine rotors do iWT=1,Sim%NumTurbines @@ -894,8 +904,8 @@ subroutine SetupMotionLoadsInterfaceMeshes() do iBlade=1,Sim%WT(iWT)%NumBlades !------------------------------------------------------------- ! Load mesh for blades - CALL MeshCopy( SrcMesh = BldPtMotionMesh(iWT)%Mesh(iBlade) ,& - DestMesh = BldPtLoadMesh(iWT)%Mesh(iBlade) ,& + CALL MeshCopy( SrcMesh = BldStrMotionMesh(iWT)%Mesh(iBlade) ,& + DestMesh = BldStrLoadMesh(iWT)%Mesh(iBlade) ,& CtrlCode = MESH_SIBLING ,& IOS = COMPONENT_OUTPUT ,& ErrStat = ErrStat2 ,& @@ -903,11 +913,11 @@ subroutine SetupMotionLoadsInterfaceMeshes() Force = .TRUE. ,& Moment = .TRUE. ) if(Failed()) return - BldPtMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + BldStrMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. ! Temp mesh for load transfer - CALL MeshCopy( SrcMesh = BldPtLoadMesh(iWT)%Mesh(iBlade) ,& - DestMesh = BldPtLoadMesh_tmp(iWT)%Mesh(iBlade) ,& + CALL MeshCopy( SrcMesh = BldStrLoadMesh(iWT)%Mesh(iBlade) ,& + DestMesh = BldStrLoadMesh_tmp(iWT)%Mesh(iBlade) ,& CtrlCode = MESH_COUSIN ,& IOS = COMPONENT_OUTPUT ,& ErrStat = ErrStat2 ,& @@ -915,17 +925,17 @@ subroutine SetupMotionLoadsInterfaceMeshes() Force = .TRUE. ,& Moment = .TRUE. ) if(Failed()) return - BldPtLoadMesh_tmp(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. ! For checking the mesh ! Note: CU is is output unit (platform dependent). - if (debugverbose >= 4) call MeshPrintInfo( CU, BldPtLoadMesh(iWT)%Mesh(iBlade), MeshName='BldPtLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%Mesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) !------------------------------------------------------------- ! Set the mapping meshes ! blades - call MeshMapCreate( BldPtMotionMesh(iWT)%Mesh(iBlade), ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldPtMotion_2_AD_Blade(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return - call MeshMapCreate( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldPtLoadMesh(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldPtLoad(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return + call MeshMapCreate( BldStrMotionMesh(iWT)%Mesh(iBlade), ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return + call MeshMapCreate( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return enddo ! iBlade enddo ! iWT @@ -1337,7 +1347,7 @@ subroutine ADI_C_SetupRotor(iWT_c, TurbineIsHAWT_c, TurbOrigin_C, & ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -1447,7 +1457,7 @@ subroutine ShowPassedData() call WrNR(" Nacelle Orientation ") call WrMatrix(NacOri_C,CU,'(9(ES23.15e2))') call WrScr(" NumBlades_C "//trim(Num2LStr(NumBlades_C)) ) - if (debugverbose > 1) then + if (DebugLevel > 1) then call WrScr(" Root Positions") do i=1,NumBlades_C j=3*(i-1) @@ -1460,7 +1470,7 @@ subroutine ShowPassedData() enddo endif call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) - if (debugverbose > 1) then + if (DebugLevel > 1) then call WrScr(" Mesh Positions") do i=1,NumMeshPts_C j=3*(i-1) @@ -1518,34 +1528,34 @@ subroutine SetupMotionMesh() enddo enddo - ! Allocate and define the components of BladePtMeshCoords - allocate(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(Sim%WT(iWT)%NumBlades), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords')) return + ! Allocate and define the components of BladeStrMeshCoords + allocate(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(Sim%WT(iWT)%NumBlades), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords')) return do i=1,Sim%WT(iWT)%NumBlades - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Position, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Position", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Orient, 3, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Orient", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Velocity, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Velocity", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Accln, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Accln", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Force, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Force", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Position", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient, 3, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Orient", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Velocity, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Velocity", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Accln, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Accln", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Force, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Force", ErrStat2, ErrMsg2 ); if (Failed()) return enddo do i=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Position(1:3,j) = reshape( real(InitMeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(InitMeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position(1:3,j) = reshape( real(InitMeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(InitMeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) enddo enddo ! Allocate the meshes - allocate(BldPtMotionMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldPtMotionMesh( iWT )%Mesh' )) return - allocate(BldPtLoadMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldPtLoadMesh( iWT )%Mesh' )) return - allocate(BldPtLoadMesh_tmp(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldPtLoadMesh_tmp( iWT )%Mesh' )) return + allocate(BldStrMotionMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrMotionMesh( iWT )%Mesh' )) return + allocate(BldStrLoadMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrLoadMesh( iWT )%Mesh' )) return + allocate(BldStrLoadMesh_tmp(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrLoadMesh_tmp( iWT )%Mesh' )) return !------------------------------------------------------------- ! Set the interface meshes for motion inputs and loads output !------------------------------------------------------------- ! Motion mesh for blades do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshCreate( BldPtMotionMesh(iWT)%Mesh(iBlade) , & + call MeshCreate( BldStrMotionMesh(iWT)%Mesh(iBlade) , & IOS = COMPONENT_INPUT , & Nnodes = StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) , & ErrStat = ErrStat2 , & @@ -1559,30 +1569,37 @@ subroutine SetupMotionMesh() do iBlade=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) ! Initial position and orientation of node - InitPos = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) + InitPos = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) if (TransposeDCM) then - Orient = transpose(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Orient(1:3,1:3,j)) + Orient = transpose(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j)) else - Orient = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Orient(1:3,1:3,j) + Orient = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) endif call OrientRemap(Orient) - call MeshPositionNode( BldPtMotionMesh(iWT)%Mesh(iBlade) , & + call MeshPositionNode( BldStrMotionMesh(iWT)%Mesh(iBlade) , & j , & InitPos , & ! position ErrStat2, ErrMsg2 , & Orient ) ! orientation if(Failed()) return - call MeshConstructElement ( BldPtMotionMesh(iWT)%Mesh(iBlade), ELEMENT_POINT, ErrStat2, ErrMsg2, j ); if(Failed()) return + + ! Create point or line element based on flag + if (PointLoadOutput) then + call MeshConstructElement ( BldStrMotionMesh(iWT)%Mesh(iBlade), ELEMENT_POINT, ErrStat2, ErrMsg2, j ); if(Failed()) return + else if (j > 1) then + ! This assumes that the first point is the root + call MeshConstructElement ( BldStrMotionMesh(iWT)%Mesh(iBlade), ELEMENT_LINE2, ErrStat2, ErrMsg2, j-1, j ); if(Failed()) return + end if enddo enddo do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshCommit ( BldPtMotionMesh(iWT)%Mesh(iBlade), ErrStat2, ErrMsg2 ); if(Failed()) return - BldPtMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + call MeshCommit ( BldStrMotionMesh(iWT)%Mesh(iBlade), ErrStat2, ErrMsg2 ); if(Failed()) return + BldStrMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. ! For checking the mesh ! Note: CU is is output unit (platform dependent) - if (debugverbose >= 4) call MeshPrintInfo( CU, BldPtMotionMesh(iWT)%Mesh(iBlade), MeshName='BldPtMotionMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrMotionMesh(iWT)%Mesh(iBlade), MeshName='BldStrMotionMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) enddo ! !------------------------------------------------------------- @@ -1614,7 +1631,7 @@ subroutine SetupMotionMesh() ! ! ! For checking the mesh, uncomment this. ! ! note: CU is is output unit (platform dependent). -! if (debugverbose >= 4) call MeshPrintInfo( CU, NacMotionMesh(iWT), MeshName='NacMotionMesh'//trim(Num2LStr(iWT)) ) +! if (DebugLevel >= 4) call MeshPrintInfo( CU, NacMotionMesh(iWT), MeshName='NacMotionMesh'//trim(Num2LStr(iWT)) ) end subroutine SetupMotionMesh end subroutine ADI_C_SetupRotor @@ -1672,7 +1689,7 @@ subroutine ADI_C_SetRotorMotion( iWT_c, & ErrMsg = "" ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -1689,10 +1706,10 @@ subroutine ADI_C_SetRotorMotion( iWT_c, & ! Reshape mesh position, orientation, velocity, acceleration do i=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Position( 1:3,j) = reshape( real(MeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(MeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Velocity( 1:6,j) = reshape( real(MeshVel_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Accln( 1:6,j) = reshape( real(MeshAcc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position( 1:3,j) = reshape( real(MeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(MeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Velocity( 1:6,j) = reshape( real(MeshVel_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Accln( 1:6,j) = reshape( real(MeshAcc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) enddo enddo @@ -1746,7 +1763,7 @@ subroutine ShowPassedData() call WrNR(" Nacelle Acceleration ") call WrMatrix(NacAcc_C,CU,'(6(ES15.7e2))') - if (debugverbose > 1) then + if (DebugLevel > 1) then call WrScr(" Root Positions (positions do not include Turbine origin offset)") do i=1,Sim%WT(iWT_c)%NumBlades j=3*(i-1) @@ -1769,7 +1786,7 @@ subroutine ShowPassedData() enddo endif call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) - if (debugverbose > 1) then + if (DebugLevel > 1) then call WrScr(" Mesh Positions (positions do not include Turbine origin offset)") do i=1,NumMeshPts_C j=3*(i-1) @@ -1801,7 +1818,7 @@ end subroutine ADI_C_SetRotorMotion !=============================================================================================================== !> Get the loads from a single rotor. This must be called after ADI_C_CalcOutput subroutine ADI_C_GetRotorLoads(iWT_C, & - NumMeshPts_C, MeshFrc_C, & + NumMeshPts_C, MeshFrc_C, HHVel_C, & ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_GetRotorLoads') implicit none #ifndef IMPLICIT_DLLEXPORT @@ -1811,6 +1828,7 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & integer(c_int), intent(in ) :: iWT_C !< Wind turbine / rotor number integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to real(c_float), intent( out) :: MeshFrc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [Fx,Fy,Fz,Mx,My,Mz] -- forces and moments (global) + real(c_float), intent( out) :: HHVel_C(3) !< Wind speed array [Vx,Vy,Vz] -- (m/s) (global) integer(c_int), intent( out) :: ErrStat_C character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) @@ -1828,7 +1846,7 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & ErrMsg = "" ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -1850,10 +1868,17 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & call Set_OutputLoadArray(iWT) do i=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) - MeshFrc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)) = real(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Force(1:6,j), c_float) + MeshFrc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)) = real(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Force(1:6,j), c_float) enddo enddo + ! Set hub height wind speed (m/s) + if (ADI%p%storeHHVel) then + HHVel_C = real(ADI%y%HHVel(:, iWT), c_float) + else + HHVel_C = 0.0_c_float + end if + ! Set error status call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) @@ -1897,14 +1922,14 @@ subroutine Set_MotionMesh(iWT, ErrStat3, ErrMsg3) ! Set mesh corresponding to input motions do iBlade=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) - BldPtMotionMesh(iWT)%Mesh(iBlade)%TranslationDisp(1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) - real(BldPtMotionMesh(iWT)%Mesh(iBlade)%Position(1:3,j), R8Ki) - BldPtMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Orient(1:3,1:3,j) - BldPtMotionMesh(iWT)%Mesh(iBlade)%TranslationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Velocity(1:3,j) - BldPtMotionMesh(iWT)%Mesh(iBlade)%RotationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Velocity(4:6,j) - BldPtMotionMesh(iWT)%Mesh(iBlade)%TranslationAcc( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Accln(1:3,j) - call OrientRemap(BldPtMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationDisp(1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) - real(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position(1:3,j), R8Ki) + BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(1:3,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%RotationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(4:6,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationAcc( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Accln(1:3,j) + call OrientRemap(BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) if (TransposeDCM) then - BldPtMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = transpose(BldPtMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) + BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = transpose(BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) endif enddo enddo @@ -1983,9 +2008,14 @@ subroutine AD_SetInputMotion( iWT, u_local, & ! Blade mesh do iBlade=1,Sim%WT(iWT)%numBlades - n_elems = size(BldPtMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) if (( u_local%AD%rotors(iWT)%BladeMotion(iBlade)%Committed ) .and. (n_elems > 0)) then - call Transfer_Point_to_Line2( BldPtMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldPtMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg ) + if (PointLoadOutput) then + call Transfer_Point_to_Line2(BldStrMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) + else + call Transfer_Line2_to_Line2(BldStrMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) + u_local%AD%rotors(iWT)%BladeMotion(iBlade)%RemapFlag = .false. + end if if (ErrStat >= AbortErrLev) return endif enddo @@ -2004,26 +2034,32 @@ subroutine AD_TransferLoads( iWT, u_local, y_local, ErrStat3, ErrMsg3 ) do iBlade=1,Sim%WT(iWT)%NumBlades - n_elems = size(BldPtMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) if (n_elems > 0) then - BldPtLoadMesh(iWT)%Mesh(iBlade)%Force = 0.0_ReKi - BldPtLoadMesh(iWT)%Mesh(iBlade)%Moment = 0.0_ReKi + BldStrLoadMesh(iWT)%Mesh(iBlade)%Force = 0.0_ReKi + BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment = 0.0_ReKi endif enddo do iBlade=1,Sim%WT(iWT)%NumBlades if ( y_local%AD%rotors(iWT)%BladeLoad(iBlade)%Committed ) then - if (debugverbose > 4) call MeshPrintInfo( CU, y_local%AD%rotors(iWT)%BladeLoad(iBlade), MeshName='AD%rotors('//trim(Num2LStr(iWT))//')%BladeLoad('//trim(Num2LStr(iBlade))//')' ) - n_elems = size(BldPtMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + if (DebugLevel >= 4) call MeshPrintInfo( CU, y_local%AD%rotors(iWT)%BladeLoad(iBlade), MeshName='AD%rotors('//trim(Num2LStr(iWT))//')%BladeLoad('//trim(Num2LStr(iBlade))//')' ) + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) if (n_elems > 0) then - call Transfer_Line2_to_Point( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldPtLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldPtLoad(iBlade,iWT), & - ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldPtMotionMesh(iWT)%Mesh(iBlade) ) + if (PointLoadOutput) then + call Transfer_Line2_to_Point(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & + ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%Mesh(iBlade)) + else + call Transfer_Line2_to_Line2(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & + ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%Mesh(iBlade)) + ADI%y%AD%rotors(iWT)%BladeLoad(iBlade)%RemapFlag = .false. + end if if (ErrStat3 >= AbortErrLev) return - BldPtLoadMesh(iWT)%Mesh(iBlade)%Force = BldPtLoadMesh(iWT)%Mesh(iBlade)%Force + BldPtLoadMesh_tmp(iWT)%Mesh(iBlade)%Force - BldPtLoadMesh(iWT)%Mesh(iBlade)%Moment = BldPtLoadMesh(iWT)%Mesh(iBlade)%Moment + BldPtLoadMesh_tmp(iWT)%Mesh(iBlade)%Moment + BldStrLoadMesh(iWT)%Mesh(iBlade)%Force = BldStrLoadMesh(iWT)%Mesh(iBlade)%Force + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%Force + BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment = BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%Moment endif endif - if (debugverbose > 4) call MeshPrintInfo( CU, BldPtLoadMesh(iWT)%Mesh(iBlade), MeshName='BldPtLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%Mesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) enddo end subroutine AD_TransferLoads @@ -2036,8 +2072,8 @@ subroutine Set_OutputLoadArray(iWT) ! Set mesh corresponding to input motions do iBlade=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Force(1:3,j) = BldPtLoadMesh(iWT)%Mesh(iBlade)%Force( 1:3,j) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Force(4:6,j) = BldPtLoadMesh(iWT)%Mesh(iBlade)%Moment(1:3,j) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(1:3,j) = BldStrLoadMesh(iWT)%Mesh(iBlade)%Force( 1:3,j) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(4:6,j) = BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment(1:3,j) enddo enddo end subroutine Set_OutputLoadArray @@ -2111,7 +2147,7 @@ subroutine WrVTK_PointsRef(ErrStat3,ErrMsg3) ! Blade point motion (structural mesh from driver) do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshWrVTKreference(RefPoint, BldPtMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldPtMotionMesh', ErrStat3, ErrMsg3) + call MeshWrVTKreference(RefPoint, BldStrMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh', ErrStat3, ErrMsg3) if (ErrStat3 >= AbortErrLev) return enddo @@ -2218,7 +2254,7 @@ subroutine WrVTK_Points(ErrStat3,ErrMsg3) ! Blade point motion (structural mesh from driver) do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshWrVTK(RefPoint, BldPtMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldPtMotionMesh'//trim(num2lstr(iBlade)), n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + call MeshWrVTK(RefPoint, BldStrMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh'//trim(num2lstr(iBlade)), n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return enddo @@ -2403,13 +2439,13 @@ subroutine ClearTmpStorage() CHARACTER(ErrMsgLen) :: errMsg2 ! Meshes do iWT=1,Sim%NumTurbines - if (allocated(BldPtMotionMesh(iWT)%Mesh)) call ClearMeshArr1(BldPtMotionMesh(iWT)%Mesh) - if (allocated(BldPtLoadMesh(iWT)%Mesh)) call ClearMeshArr1(BldPtLoadMesh(iWT)%Mesh) - if (allocated(BldPtLoadMesh_tmp(iWT)%Mesh)) call ClearMeshArr1(BldPtLoadMesh_tmp(iWT)%Mesh) + if (allocated(BldStrMotionMesh(iWT)%Mesh)) call ClearMeshArr1(BldStrMotionMesh(iWT)%Mesh) + if (allocated(BldStrLoadMesh(iWT)%Mesh)) call ClearMeshArr1(BldStrLoadMesh(iWT)%Mesh) + if (allocated(BldStrLoadMesh_tmp(iWT)%Mesh)) call ClearMeshArr1(BldStrLoadMesh_tmp(iWT)%Mesh) enddo ! if (allocated(NacMotionMesh )) call ClearMeshArr1(NacMotionMesh ) ! if (allocated(NacLoadMesh )) call ClearMeshArr1(NacLoadMesh ) - if (allocated(Map_BldPtMotion_2_AD_Blade )) call ClearMeshMapArr2(Map_BldPtMotion_2_AD_Blade ) + if (allocated(Map_BldStrMotion_2_AD_Blade )) call ClearMeshMapArr2(Map_BldStrMotion_2_AD_Blade ) contains subroutine ClearMeshArr1(MeshName) type(MeshType), allocatable :: MeshName(:) diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 3c7f3665f8..0b09d54208 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -469,7 +469,7 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyInitOutput' @@ -479,8 +479,8 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -491,8 +491,8 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -538,7 +538,7 @@ subroutine ADI_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -737,8 +737,8 @@ subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyMisc' @@ -751,8 +751,8 @@ subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%VTK_surfaces)) then - LB(1:1) = lbound(SrcMiscData%VTK_surfaces, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%VTK_surfaces, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%VTK_surfaces) + UB(1:1) = ubound(SrcMiscData%VTK_surfaces) if (.not. allocated(DstMiscData%VTK_surfaces)) then allocate(DstMiscData%VTK_surfaces(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -772,8 +772,8 @@ subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ADI_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyMisc' @@ -784,8 +784,8 @@ subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) call ADI_DestroyInflowWindData(MiscData%IW, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%VTK_surfaces)) then - LB(1:1) = lbound(MiscData%VTK_surfaces, kind=B8Ki) - UB(1:1) = ubound(MiscData%VTK_surfaces, kind=B8Ki) + LB(1:1) = lbound(MiscData%VTK_surfaces) + UB(1:1) = ubound(MiscData%VTK_surfaces) do i1 = LB(1), UB(1) call AD_DestroyVTK_RotSurfaceType(MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -798,16 +798,16 @@ subroutine ADI_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(ADI_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call AD_PackMisc(RF, InData%AD) call ADI_PackInflowWindData(RF, InData%IW) call RegPack(RF, allocated(InData%VTK_surfaces)) if (allocated(InData%VTK_surfaces)) then - call RegPackBounds(RF, 1, lbound(InData%VTK_surfaces, kind=B8Ki), ubound(InData%VTK_surfaces, kind=B8Ki)) - LB(1:1) = lbound(InData%VTK_surfaces, kind=B8Ki) - UB(1:1) = ubound(InData%VTK_surfaces, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VTK_surfaces), ubound(InData%VTK_surfaces)) + LB(1:1) = lbound(InData%VTK_surfaces) + UB(1:1) = ubound(InData%VTK_surfaces) do i1 = LB(1), UB(1) call AD_PackVTK_RotSurfaceType(RF, InData%VTK_surfaces(i1)) end do @@ -819,8 +819,8 @@ subroutine ADI_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -960,7 +960,7 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyOutput' @@ -970,8 +970,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%HHVel)) then - LB(1:2) = lbound(SrcOutputData%HHVel, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%HHVel, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%HHVel) + UB(1:2) = ubound(SrcOutputData%HHVel) if (.not. allocated(DstOutputData%HHVel)) then allocate(DstOutputData%HHVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -983,8 +983,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if DstOutputData%PLExp = SrcOutputData%PLExp if (allocated(SrcOutputData%IW_WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%IW_WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%IW_WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%IW_WriteOutput) + UB(1:1) = ubound(SrcOutputData%IW_WriteOutput) if (.not. allocated(DstOutputData%IW_WriteOutput)) then allocate(DstOutputData%IW_WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -995,8 +995,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1047,7 +1047,7 @@ subroutine ADI_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1064,16 +1064,16 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyData' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDataData%x)) then - LB(1:1) = lbound(SrcDataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%x) + UB(1:1) = ubound(SrcDataData%x) if (.not. allocated(DstDataData%x)) then allocate(DstDataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1088,8 +1088,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%xd)) then - LB(1:1) = lbound(SrcDataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%xd) + UB(1:1) = ubound(SrcDataData%xd) if (.not. allocated(DstDataData%xd)) then allocate(DstDataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1104,8 +1104,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%z)) then - LB(1:1) = lbound(SrcDataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%z) + UB(1:1) = ubound(SrcDataData%z) if (.not. allocated(DstDataData%z)) then allocate(DstDataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1120,8 +1120,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%OtherState)) then - LB(1:1) = lbound(SrcDataData%OtherState, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%OtherState, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%OtherState) + UB(1:1) = ubound(SrcDataData%OtherState) if (.not. allocated(DstDataData%OtherState)) then allocate(DstDataData%OtherState(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1142,8 +1142,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDataData%u)) then - LB(1:1) = lbound(SrcDataData%u, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%u, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%u) + UB(1:1) = ubound(SrcDataData%u) if (.not. allocated(DstDataData%u)) then allocate(DstDataData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1161,8 +1161,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDataData%inputTimes)) then - LB(1:1) = lbound(SrcDataData%inputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%inputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%inputTimes) + UB(1:1) = ubound(SrcDataData%inputTimes) if (.not. allocated(DstDataData%inputTimes)) then allocate(DstDataData%inputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1178,16 +1178,16 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) type(ADI_Data), intent(inout) :: DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyData' ErrStat = ErrID_None ErrMsg = '' if (allocated(DataData%x)) then - LB(1:1) = lbound(DataData%x, kind=B8Ki) - UB(1:1) = ubound(DataData%x, kind=B8Ki) + LB(1:1) = lbound(DataData%x) + UB(1:1) = ubound(DataData%x) do i1 = LB(1), UB(1) call ADI_DestroyContState(DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1195,8 +1195,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%x) end if if (allocated(DataData%xd)) then - LB(1:1) = lbound(DataData%xd, kind=B8Ki) - UB(1:1) = ubound(DataData%xd, kind=B8Ki) + LB(1:1) = lbound(DataData%xd) + UB(1:1) = ubound(DataData%xd) do i1 = LB(1), UB(1) call ADI_DestroyDiscState(DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1204,8 +1204,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%xd) end if if (allocated(DataData%z)) then - LB(1:1) = lbound(DataData%z, kind=B8Ki) - UB(1:1) = ubound(DataData%z, kind=B8Ki) + LB(1:1) = lbound(DataData%z) + UB(1:1) = ubound(DataData%z) do i1 = LB(1), UB(1) call ADI_DestroyConstrState(DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1213,8 +1213,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%z) end if if (allocated(DataData%OtherState)) then - LB(1:1) = lbound(DataData%OtherState, kind=B8Ki) - UB(1:1) = ubound(DataData%OtherState, kind=B8Ki) + LB(1:1) = lbound(DataData%OtherState) + UB(1:1) = ubound(DataData%OtherState) do i1 = LB(1), UB(1) call ADI_DestroyOtherState(DataData%OtherState(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1226,8 +1226,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) call ADI_DestroyMisc(DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(DataData%u)) then - LB(1:1) = lbound(DataData%u, kind=B8Ki) - UB(1:1) = ubound(DataData%u, kind=B8Ki) + LB(1:1) = lbound(DataData%u) + UB(1:1) = ubound(DataData%u) do i1 = LB(1), UB(1) call ADI_DestroyInput(DataData%u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1245,41 +1245,41 @@ subroutine ADI_PackData(RF, Indata) type(RegFile), intent(inout) :: RF type(ADI_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackData' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call ADI_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call ADI_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call ADI_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherState)) if (allocated(InData%OtherState)) then - call RegPackBounds(RF, 1, lbound(InData%OtherState, kind=B8Ki), ubound(InData%OtherState, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherState, kind=B8Ki) - UB(1:1) = ubound(InData%OtherState, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherState), ubound(InData%OtherState)) + LB(1:1) = lbound(InData%OtherState) + UB(1:1) = ubound(InData%OtherState) do i1 = LB(1), UB(1) call ADI_PackOtherState(RF, InData%OtherState(i1)) end do @@ -1288,9 +1288,9 @@ subroutine ADI_PackData(RF, Indata) call ADI_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) do i1 = LB(1), UB(1) call ADI_PackInput(RF, InData%u(i1)) end do @@ -1304,8 +1304,8 @@ subroutine ADI_UnPackData(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackData' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1386,8 +1386,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyRotFED' @@ -1409,8 +1409,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%BladeRootMotion)) then - LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion) + UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion) if (.not. allocated(DstRotFEDData%BladeRootMotion)) then allocate(DstRotFEDData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1425,8 +1425,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs end do end if if (allocated(SrcRotFEDData%BladeLn2Mesh)) then - LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh, kind=B8Ki) + LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh) if (.not. allocated(DstRotFEDData%BladeLn2Mesh)) then allocate(DstRotFEDData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1450,8 +1450,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%AD_P_2_AD_L_B)) then - LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B) if (.not. allocated(DstRotFEDData%AD_P_2_AD_L_B)) then allocate(DstRotFEDData%AD_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1469,8 +1469,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R) if (.not. allocated(DstRotFEDData%ED_P_2_AD_P_R)) then allocate(DstRotFEDData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1496,8 +1496,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) type(RotFED), intent(inout) :: RotFEDData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyRotFED' @@ -1514,8 +1514,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%BladeRootMotion)) then - LB(1:1) = lbound(RotFEDData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(RotFEDData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(RotFEDData%BladeRootMotion) + UB(1:1) = ubound(RotFEDData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1523,8 +1523,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) deallocate(RotFEDData%BladeRootMotion) end if if (allocated(RotFEDData%BladeLn2Mesh)) then - LB(1:1) = lbound(RotFEDData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(RotFEDData%BladeLn2Mesh, kind=B8Ki) + LB(1:1) = lbound(RotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(RotFEDData%BladeLn2Mesh) do i1 = LB(1), UB(1) call MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1536,8 +1536,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%AD_P_2_AD_L_B)) then - LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1547,8 +1547,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1565,8 +1565,8 @@ subroutine ADI_PackRotFED(RF, Indata) type(RegFile), intent(inout) :: RF type(RotFED), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackRotFED' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call MeshPack(RF, InData%PlatformPtMesh) call MeshPack(RF, InData%TwrPtMesh) @@ -1575,18 +1575,18 @@ subroutine ADI_PackRotFED(RF, Indata) call MeshPack(RF, InData%HubPtMotion) call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeRootMotion(i1)) end do end if call RegPack(RF, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLn2Mesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeLn2Mesh(i1)) end do @@ -1598,9 +1598,9 @@ subroutine ADI_PackRotFED(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_AD_L_T) call RegPack(RF, allocated(InData%AD_P_2_AD_L_B)) if (allocated(InData%AD_P_2_AD_L_B)) then - call RegPackBounds(RF, 1, lbound(InData%AD_P_2_AD_L_B, kind=B8Ki), ubound(InData%AD_P_2_AD_L_B, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(InData%AD_P_2_AD_L_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_P_2_AD_L_B), ubound(InData%AD_P_2_AD_L_B)) + LB(1:1) = lbound(InData%AD_P_2_AD_L_B) + UB(1:1) = ubound(InData%AD_P_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_AD_L_B(i1)) end do @@ -1608,9 +1608,9 @@ subroutine ADI_PackRotFED(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_TF) call RegPack(RF, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_AD_P_R, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_R(i1)) end do @@ -1624,8 +1624,8 @@ subroutine ADI_UnPackRotFED(RF, OutData) type(RegFile), intent(inout) :: RF type(RotFED), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackRotFED' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1702,16 +1702,16 @@ subroutine ADI_CopyFED_Data(SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyFED_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcFED_DataData%WT)) then - LB(1:1) = lbound(SrcFED_DataData%WT, kind=B8Ki) - UB(1:1) = ubound(SrcFED_DataData%WT, kind=B8Ki) + LB(1:1) = lbound(SrcFED_DataData%WT) + UB(1:1) = ubound(SrcFED_DataData%WT) if (.not. allocated(DstFED_DataData%WT)) then allocate(DstFED_DataData%WT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1731,16 +1731,16 @@ subroutine ADI_DestroyFED_Data(FED_DataData, ErrStat, ErrMsg) type(FED_Data), intent(inout) :: FED_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyFED_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(FED_DataData%WT)) then - LB(1:1) = lbound(FED_DataData%WT, kind=B8Ki) - UB(1:1) = ubound(FED_DataData%WT, kind=B8Ki) + LB(1:1) = lbound(FED_DataData%WT) + UB(1:1) = ubound(FED_DataData%WT) do i1 = LB(1), UB(1) call ADI_DestroyRotFED(FED_DataData%WT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1753,14 +1753,14 @@ subroutine ADI_PackFED_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(FED_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackFED_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%WT)) if (allocated(InData%WT)) then - call RegPackBounds(RF, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) - LB(1:1) = lbound(InData%WT, kind=B8Ki) - UB(1:1) = ubound(InData%WT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) do i1 = LB(1), UB(1) call ADI_PackRotFED(RF, InData%WT(i1)) end do @@ -1772,8 +1772,8 @@ subroutine ADI_UnPackFED_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(FED_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackFED_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 9d64fe8e13..78ad76dd5b 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -294,6 +294,7 @@ typedef ^ RotInflowType ReKi InflowOnHub {3}{1} - - "U,V,W at hub" m/s typedef ^ RotInflowType ReKi InflowOnNacelle {3}{1} - - "U,V,W at nacelle" m/s typedef ^ RotInflowType ReKi InflowOnTailFin {3}{1} - - "U,V,W at tailfin" m/s typedef ^ RotInflowType ReKi AvgDiskVel {3} - 0.0 "disk-averaged U,V,W" m/s + typedef ^ AD_InflowType ReKi InflowWakeVel {:}{:} - - "U,V,W at wake points" m/s typedef ^ AD_InflowType RotInflowType RotInflow {:} - - "Inflow on rotor" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 382fa4c77a..9096b21483 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -723,14 +723,14 @@ subroutine AD_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTy integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyVTK_BLSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -767,7 +767,7 @@ subroutine AD_UnPackVTK_BLSurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_VTK_BLSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackVTK_BLSurfaceType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -780,16 +780,16 @@ subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfac integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyVTK_RotSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_RotSurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape) if (.not. allocated(DstVTK_RotSurfaceTypeData%BladeShape)) then allocate(DstVTK_RotSurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -804,8 +804,8 @@ subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfac end do end if if (allocated(SrcVTK_RotSurfaceTypeData%TowerRad)) then - LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad) if (.not. allocated(DstVTK_RotSurfaceTypeData%TowerRad)) then allocate(DstVTK_RotSurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -821,16 +821,16 @@ subroutine AD_DestroyVTK_RotSurfaceType(VTK_RotSurfaceTypeData, ErrStat, ErrMsg) type(AD_VTK_RotSurfaceType), intent(inout) :: VTK_RotSurfaceTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(VTK_RotSurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape) do i1 = LB(1), UB(1) call AD_DestroyVTK_BLSurfaceType(VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -846,14 +846,14 @@ subroutine AD_PackVTK_RotSurfaceType(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_VTK_RotSurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackVTK_RotSurfaceType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) do i1 = LB(1), UB(1) call AD_PackVTK_BLSurfaceType(RF, InData%BladeShape(i1)) end do @@ -866,8 +866,8 @@ subroutine AD_UnPackVTK_RotSurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_VTK_RotSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackVTK_RotSurfaceType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -893,7 +893,7 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyRotInitInputType' ErrStat = ErrID_None @@ -903,8 +903,8 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation if (allocated(SrcRotInitInputTypeData%BladeRootPosition)) then - LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition, kind=B8Ki) - UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition, kind=B8Ki) + LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition) + UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition) if (.not. allocated(DstRotInitInputTypeData%BladeRootPosition)) then allocate(DstRotInitInputTypeData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -915,8 +915,8 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition end if if (allocated(SrcRotInitInputTypeData%BladeRootOrientation)) then - LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation, kind=B8Ki) - UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation, kind=B8Ki) + LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation) + UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation) if (.not. allocated(DstRotInitInputTypeData%BladeRootOrientation)) then allocate(DstRotInitInputTypeData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -969,7 +969,7 @@ subroutine AD_UnPackRotInitInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotInitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInitInputType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -991,16 +991,16 @@ subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitInputData%rotors)) then - LB(1:1) = lbound(SrcInitInputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%rotors) + UB(1:1) = ubound(SrcInitInputData%rotors) if (.not. allocated(DstInitInputData%rotors)) then allocate(DstInitInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1038,16 +1038,16 @@ subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(AD_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%rotors)) then - LB(1:1) = lbound(InitInputData%rotors, kind=B8Ki) - UB(1:1) = ubound(InitInputData%rotors, kind=B8Ki) + LB(1:1) = lbound(InitInputData%rotors) + UB(1:1) = ubound(InitInputData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotInitInputType(InitInputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1063,15 +1063,15 @@ subroutine AD_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotInitInputType(RF, InData%rotors(i1)) end do @@ -1105,8 +1105,8 @@ subroutine AD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1166,15 +1166,15 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyBladePropsType' ErrStat = ErrID_None ErrMsg = '' DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds if (allocated(SrcBladePropsTypeData%BlSpn)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn) if (.not. allocated(DstBladePropsTypeData%BlSpn)) then allocate(DstBladePropsTypeData%BlSpn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1185,8 +1185,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn end if if (allocated(SrcBladePropsTypeData%BlCrvAC)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC) if (.not. allocated(DstBladePropsTypeData%BlCrvAC)) then allocate(DstBladePropsTypeData%BlCrvAC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1197,8 +1197,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC end if if (allocated(SrcBladePropsTypeData%BlSwpAC)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC) if (.not. allocated(DstBladePropsTypeData%BlSwpAC)) then allocate(DstBladePropsTypeData%BlSwpAC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1209,8 +1209,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC end if if (allocated(SrcBladePropsTypeData%BlCrvAng)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng) if (.not. allocated(DstBladePropsTypeData%BlCrvAng)) then allocate(DstBladePropsTypeData%BlCrvAng(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1221,8 +1221,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng end if if (allocated(SrcBladePropsTypeData%BlTwist)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist) + UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist) if (.not. allocated(DstBladePropsTypeData%BlTwist)) then allocate(DstBladePropsTypeData%BlTwist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1233,8 +1233,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist end if if (allocated(SrcBladePropsTypeData%BlChord)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlChord, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlChord, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlChord) + UB(1:1) = ubound(SrcBladePropsTypeData%BlChord) if (.not. allocated(DstBladePropsTypeData%BlChord)) then allocate(DstBladePropsTypeData%BlChord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1245,8 +1245,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord end if if (allocated(SrcBladePropsTypeData%BlAFID)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID) + UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID) if (.not. allocated(DstBladePropsTypeData%BlAFID)) then allocate(DstBladePropsTypeData%BlAFID(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1257,8 +1257,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID end if if (allocated(SrcBladePropsTypeData%BlCb)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCb, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCb, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCb) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCb) if (.not. allocated(DstBladePropsTypeData%BlCb)) then allocate(DstBladePropsTypeData%BlCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1269,8 +1269,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb end if if (allocated(SrcBladePropsTypeData%BlCenBn)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn) if (.not. allocated(DstBladePropsTypeData%BlCenBn)) then allocate(DstBladePropsTypeData%BlCenBn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1281,8 +1281,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn end if if (allocated(SrcBladePropsTypeData%BlCenBt)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt) if (.not. allocated(DstBladePropsTypeData%BlCenBt)) then allocate(DstBladePropsTypeData%BlCenBt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1356,7 +1356,7 @@ subroutine AD_UnPackBladePropsType(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_BladePropsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBladePropsType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1379,14 +1379,14 @@ subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyBladeShape' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBladeShapeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords, kind=B8Ki) - UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords, kind=B8Ki) + LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords) + UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords) if (.not. allocated(DstBladeShapeData%AirfoilCoords)) then allocate(DstBladeShapeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1423,7 +1423,7 @@ subroutine AD_UnPackBladeShape(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_BladeShape), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBladeShape' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1436,8 +1436,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotInitOutputType' @@ -1446,8 +1446,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%Vars => SrcRotInitOutputTypeData%Vars DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens if (allocated(SrcRotInitOutputTypeData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr) if (.not. allocated(DstRotInitOutputTypeData%WriteOutputHdr)) then allocate(DstRotInitOutputTypeData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1458,8 +1458,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr end if if (allocated(SrcRotInitOutputTypeData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt) if (.not. allocated(DstRotInitOutputTypeData%WriteOutputUnt)) then allocate(DstRotInitOutputTypeData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1470,8 +1470,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt end if if (allocated(SrcRotInitOutputTypeData%BladeShape)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape) if (.not. allocated(DstRotInitOutputTypeData%BladeShape)) then allocate(DstRotInitOutputTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1486,8 +1486,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end do end if if (allocated(SrcRotInitOutputTypeData%LinNames_y)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y) if (.not. allocated(DstRotInitOutputTypeData%LinNames_y)) then allocate(DstRotInitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1498,8 +1498,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y end if if (allocated(SrcRotInitOutputTypeData%LinNames_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x) if (.not. allocated(DstRotInitOutputTypeData%LinNames_x)) then allocate(DstRotInitOutputTypeData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1510,8 +1510,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x end if if (allocated(SrcRotInitOutputTypeData%LinNames_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u) if (.not. allocated(DstRotInitOutputTypeData%LinNames_u)) then allocate(DstRotInitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1522,8 +1522,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u end if if (allocated(SrcRotInitOutputTypeData%RotFrame_y)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_y)) then allocate(DstRotInitOutputTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1534,8 +1534,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y end if if (allocated(SrcRotInitOutputTypeData%RotFrame_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_x)) then allocate(DstRotInitOutputTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1546,8 +1546,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x end if if (allocated(SrcRotInitOutputTypeData%RotFrame_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_u)) then allocate(DstRotInitOutputTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1558,8 +1558,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u end if if (allocated(SrcRotInitOutputTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u) if (.not. allocated(DstRotInitOutputTypeData%IsLoad_u)) then allocate(DstRotInitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1570,8 +1570,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u end if if (allocated(SrcRotInitOutputTypeData%BladeProps)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps) if (.not. allocated(DstRotInitOutputTypeData%BladeProps)) then allocate(DstRotInitOutputTypeData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1586,8 +1586,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end do end if if (allocated(SrcRotInitOutputTypeData%DerivOrder_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x) if (.not. allocated(DstRotInitOutputTypeData%DerivOrder_x)) then allocate(DstRotInitOutputTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1598,8 +1598,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x end if if (allocated(SrcRotInitOutputTypeData%TwrElev)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev) if (.not. allocated(DstRotInitOutputTypeData%TwrElev)) then allocate(DstRotInitOutputTypeData%TwrElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1610,8 +1610,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev end if if (allocated(SrcRotInitOutputTypeData%TwrDiam)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam) if (.not. allocated(DstRotInitOutputTypeData%TwrDiam)) then allocate(DstRotInitOutputTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1627,8 +1627,8 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) type(RotInitOutputType), intent(inout) :: RotInitOutputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInitOutputType' @@ -1642,8 +1642,8 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) deallocate(RotInitOutputTypeData%WriteOutputUnt) end if if (allocated(RotInitOutputTypeData%BladeShape)) then - LB(1:1) = lbound(RotInitOutputTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(RotInitOutputTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(RotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(RotInitOutputTypeData%BladeShape) do i1 = LB(1), UB(1) call AD_DestroyBladeShape(RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1672,8 +1672,8 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) deallocate(RotInitOutputTypeData%IsLoad_u) end if if (allocated(RotInitOutputTypeData%BladeProps)) then - LB(1:1) = lbound(RotInitOutputTypeData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(RotInitOutputTypeData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(RotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(RotInitOutputTypeData%BladeProps) do i1 = LB(1), UB(1) call AD_DestroyBladePropsType(RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1695,8 +1695,8 @@ subroutine AD_PackRotInitOutputType(RF, Indata) type(RegFile), intent(inout) :: RF type(RotInitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, associated(InData%Vars)) @@ -1711,9 +1711,9 @@ subroutine AD_PackRotInitOutputType(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputUnt) call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) do i1 = LB(1), UB(1) call AD_PackBladeShape(RF, InData%BladeShape(i1)) end do @@ -1727,9 +1727,9 @@ subroutine AD_PackRotInitOutputType(RF, Indata) call RegPackAlloc(RF, InData%IsLoad_u) call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) do i1 = LB(1), UB(1) call AD_PackBladePropsType(RF, InData%BladeProps(i1)) end do @@ -1744,8 +1744,8 @@ subroutine AD_UnPackRotInitOutputType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotInitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInitOutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1816,16 +1816,16 @@ subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%rotors)) then - LB(1:1) = lbound(SrcInitOutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%rotors) + UB(1:1) = ubound(SrcInitOutputData%rotors) if (.not. allocated(DstInitOutputData%rotors)) then allocate(DstInitOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1849,16 +1849,16 @@ subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) type(AD_InitOutputType), intent(inout) :: InitOutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitOutputData%rotors)) then - LB(1:1) = lbound(InitOutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(InitOutputData%rotors, kind=B8Ki) + LB(1:1) = lbound(InitOutputData%rotors) + UB(1:1) = ubound(InitOutputData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotInitOutputType(InitOutputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1873,14 +1873,14 @@ subroutine AD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInitOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotInitOutputType(RF, InData%rotors(i1)) end do @@ -1894,8 +1894,8 @@ subroutine AD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInitOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1922,16 +1922,16 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotInputFile' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcRotInputFileData%BladeProps)) then - LB(1:1) = lbound(SrcRotInputFileData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%BladeProps) + UB(1:1) = ubound(SrcRotInputFileData%BladeProps) if (.not. allocated(DstRotInputFileData%BladeProps)) then allocate(DstRotInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1947,8 +1947,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds if (allocated(SrcRotInputFileData%TwrElev)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrElev, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrElev, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrElev) + UB(1:1) = ubound(SrcRotInputFileData%TwrElev) if (.not. allocated(DstRotInputFileData%TwrElev)) then allocate(DstRotInputFileData%TwrElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1959,8 +1959,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev end if if (allocated(SrcRotInputFileData%TwrDiam)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrDiam, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrDiam, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrDiam) + UB(1:1) = ubound(SrcRotInputFileData%TwrDiam) if (.not. allocated(DstRotInputFileData%TwrDiam)) then allocate(DstRotInputFileData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1971,8 +1971,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam end if if (allocated(SrcRotInputFileData%TwrCd)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrCd, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrCd, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrCd) + UB(1:1) = ubound(SrcRotInputFileData%TwrCd) if (.not. allocated(DstRotInputFileData%TwrCd)) then allocate(DstRotInputFileData%TwrCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1983,8 +1983,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd end if if (allocated(SrcRotInputFileData%TwrTI)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrTI, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrTI, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrTI) + UB(1:1) = ubound(SrcRotInputFileData%TwrTI) if (.not. allocated(DstRotInputFileData%TwrTI)) then allocate(DstRotInputFileData%TwrTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1995,8 +1995,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI end if if (allocated(SrcRotInputFileData%TwrCb)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrCb, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrCb, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrCb) + UB(1:1) = ubound(SrcRotInputFileData%TwrCb) if (.not. allocated(DstRotInputFileData%TwrCb)) then allocate(DstRotInputFileData%TwrCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2024,16 +2024,16 @@ subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) type(RotInputFile), intent(inout) :: RotInputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInputFile' ErrStat = ErrID_None ErrMsg = '' if (allocated(RotInputFileData%BladeProps)) then - LB(1:1) = lbound(RotInputFileData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(RotInputFileData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(RotInputFileData%BladeProps) + UB(1:1) = ubound(RotInputFileData%BladeProps) do i1 = LB(1), UB(1) call AD_DestroyBladePropsType(RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2063,14 +2063,14 @@ subroutine AD_PackRotInputFile(RF, Indata) type(RegFile), intent(inout) :: RF type(RotInputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) do i1 = LB(1), UB(1) call AD_PackBladePropsType(RF, InData%BladeProps(i1)) end do @@ -2098,8 +2098,8 @@ subroutine AD_UnPackRotInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(RotInputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2140,8 +2140,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInputFile' @@ -2160,8 +2160,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%CompAA = SrcInputFileData%CompAA DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile if (allocated(SrcInputFileData%ADBlFile)) then - LB(1:1) = lbound(SrcInputFileData%ADBlFile, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ADBlFile, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ADBlFile) + UB(1:1) = ubound(SrcInputFileData%ADBlFile) if (.not. allocated(DstInputFileData%ADBlFile)) then allocate(DstInputFileData%ADBlFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2205,8 +2205,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName if (allocated(SrcInputFileData%AFNames)) then - LB(1:1) = lbound(SrcInputFileData%AFNames, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%AFNames, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%AFNames) + UB(1:1) = ubound(SrcInputFileData%AFNames) if (.not. allocated(DstInputFileData%AFNames)) then allocate(DstInputFileData%AFNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2224,8 +2224,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2239,8 +2239,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2255,8 +2255,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad if (allocated(SrcInputFileData%rotors)) then - LB(1:1) = lbound(SrcInputFileData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%rotors) + UB(1:1) = ubound(SrcInputFileData%rotors) if (.not. allocated(DstInputFileData%rotors)) then allocate(DstInputFileData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2276,8 +2276,8 @@ subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(AD_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInputFile' @@ -2298,8 +2298,8 @@ subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%BldNd_OutList) end if if (allocated(InputFileData%rotors)) then - LB(1:1) = lbound(InputFileData%rotors, kind=B8Ki) - UB(1:1) = ubound(InputFileData%rotors, kind=B8Ki) + LB(1:1) = lbound(InputFileData%rotors) + UB(1:1) = ubound(InputFileData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotInputFile(InputFileData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2312,8 +2312,8 @@ subroutine AD_PackInputFile(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Echo) call RegPack(RF, InData%DTAero) @@ -2378,9 +2378,9 @@ subroutine AD_PackInputFile(RF, Indata) call RegPack(RF, InData%UAEndRad) call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotInputFile(RF, InData%rotors(i1)) end do @@ -2392,8 +2392,8 @@ subroutine AD_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2532,16 +2532,16 @@ subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%rotors)) then - LB(1:1) = lbound(SrcContStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%rotors) + UB(1:1) = ubound(SrcContStateData%rotors) if (.not. allocated(DstContStateData%rotors)) then allocate(DstContStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2564,16 +2564,16 @@ subroutine AD_DestroyContState(ContStateData, ErrStat, ErrMsg) type(AD_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%rotors)) then - LB(1:1) = lbound(ContStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(ContStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(ContStateData%rotors) + UB(1:1) = ubound(ContStateData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotContinuousStateType(ContStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2588,14 +2588,14 @@ subroutine AD_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotContinuousStateType(RF, InData%rotors(i1)) end do @@ -2608,8 +2608,8 @@ subroutine AD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2688,16 +2688,16 @@ subroutine AD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%rotors)) then - LB(1:1) = lbound(SrcDiscStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%rotors) + UB(1:1) = ubound(SrcDiscStateData%rotors) if (.not. allocated(DstDiscStateData%rotors)) then allocate(DstDiscStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2720,16 +2720,16 @@ subroutine AD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(AD_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%rotors)) then - LB(1:1) = lbound(DiscStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%rotors) + UB(1:1) = ubound(DiscStateData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotDiscreteStateType(DiscStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2744,14 +2744,14 @@ subroutine AD_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotDiscreteStateType(RF, InData%rotors(i1)) end do @@ -2764,8 +2764,8 @@ subroutine AD_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2844,16 +2844,16 @@ subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%rotors)) then - LB(1:1) = lbound(SrcConstrStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%rotors) + UB(1:1) = ubound(SrcConstrStateData%rotors) if (.not. allocated(DstConstrStateData%rotors)) then allocate(DstConstrStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2876,16 +2876,16 @@ subroutine AD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(AD_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%rotors)) then - LB(1:1) = lbound(ConstrStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%rotors) + UB(1:1) = ubound(ConstrStateData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotConstraintStateType(ConstrStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2900,14 +2900,14 @@ subroutine AD_PackConstrState(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotConstraintStateType(RF, InData%rotors(i1)) end do @@ -2920,8 +2920,8 @@ subroutine AD_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3000,16 +3000,16 @@ subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%rotors)) then - LB(1:1) = lbound(SrcOtherStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%rotors) + UB(1:1) = ubound(SrcOtherStateData%rotors) if (.not. allocated(DstOtherStateData%rotors)) then allocate(DstOtherStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3027,8 +3027,8 @@ subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOtherStateData%WakeLocationPoints)) then - LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints) + UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints) if (.not. allocated(DstOtherStateData%WakeLocationPoints)) then allocate(DstOtherStateData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3044,16 +3044,16 @@ subroutine AD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(AD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%rotors)) then - LB(1:1) = lbound(OtherStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%rotors) + UB(1:1) = ubound(OtherStateData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotOtherStateType(OtherStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3071,14 +3071,14 @@ subroutine AD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotOtherStateType(RF, InData%rotors(i1)) end do @@ -3092,8 +3092,8 @@ subroutine AD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3120,14 +3120,14 @@ subroutine AD_CopyElemInflowType(SrcElemInflowTypeData, DstElemInflowTypeData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyElemInflowType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcElemInflowTypeData%InflowVel)) then - LB(1:2) = lbound(SrcElemInflowTypeData%InflowVel, kind=B8Ki) - UB(1:2) = ubound(SrcElemInflowTypeData%InflowVel, kind=B8Ki) + LB(1:2) = lbound(SrcElemInflowTypeData%InflowVel) + UB(1:2) = ubound(SrcElemInflowTypeData%InflowVel) if (.not. allocated(DstElemInflowTypeData%InflowVel)) then allocate(DstElemInflowTypeData%InflowVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3138,8 +3138,8 @@ subroutine AD_CopyElemInflowType(SrcElemInflowTypeData, DstElemInflowTypeData, C DstElemInflowTypeData%InflowVel = SrcElemInflowTypeData%InflowVel end if if (allocated(SrcElemInflowTypeData%InflowAcc)) then - LB(1:2) = lbound(SrcElemInflowTypeData%InflowAcc, kind=B8Ki) - UB(1:2) = ubound(SrcElemInflowTypeData%InflowAcc, kind=B8Ki) + LB(1:2) = lbound(SrcElemInflowTypeData%InflowAcc) + UB(1:2) = ubound(SrcElemInflowTypeData%InflowAcc) if (.not. allocated(DstElemInflowTypeData%InflowAcc)) then allocate(DstElemInflowTypeData%InflowAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3180,7 +3180,7 @@ subroutine AD_UnPackElemInflowType(RF, OutData) type(RegFile), intent(inout) :: RF type(ElemInflowType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackElemInflowType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3194,16 +3194,16 @@ subroutine AD_CopyRotInflowType(SrcRotInflowTypeData, DstRotInflowTypeData, Ctrl integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotInflowType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcRotInflowTypeData%Blade)) then - LB(1:1) = lbound(SrcRotInflowTypeData%Blade, kind=B8Ki) - UB(1:1) = ubound(SrcRotInflowTypeData%Blade, kind=B8Ki) + LB(1:1) = lbound(SrcRotInflowTypeData%Blade) + UB(1:1) = ubound(SrcRotInflowTypeData%Blade) if (.not. allocated(DstRotInflowTypeData%Blade)) then allocate(DstRotInflowTypeData%Blade(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3230,16 +3230,16 @@ subroutine AD_DestroyRotInflowType(RotInflowTypeData, ErrStat, ErrMsg) type(RotInflowType), intent(inout) :: RotInflowTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInflowType' ErrStat = ErrID_None ErrMsg = '' if (allocated(RotInflowTypeData%Blade)) then - LB(1:1) = lbound(RotInflowTypeData%Blade, kind=B8Ki) - UB(1:1) = ubound(RotInflowTypeData%Blade, kind=B8Ki) + LB(1:1) = lbound(RotInflowTypeData%Blade) + UB(1:1) = ubound(RotInflowTypeData%Blade) do i1 = LB(1), UB(1) call AD_DestroyElemInflowType(RotInflowTypeData%Blade(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3254,14 +3254,14 @@ subroutine AD_PackRotInflowType(RF, Indata) type(RegFile), intent(inout) :: RF type(RotInflowType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInflowType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Blade)) if (allocated(InData%Blade)) then - call RegPackBounds(RF, 1, lbound(InData%Blade, kind=B8Ki), ubound(InData%Blade, kind=B8Ki)) - LB(1:1) = lbound(InData%Blade, kind=B8Ki) - UB(1:1) = ubound(InData%Blade, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Blade), ubound(InData%Blade)) + LB(1:1) = lbound(InData%Blade) + UB(1:1) = ubound(InData%Blade) do i1 = LB(1), UB(1) call AD_PackElemInflowType(RF, InData%Blade(i1)) end do @@ -3278,8 +3278,8 @@ subroutine AD_UnPackRotInflowType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotInflowType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInflowType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3309,16 +3309,16 @@ subroutine AD_CopyInflowType(SrcInflowTypeData, DstInflowTypeData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInflowType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInflowTypeData%InflowWakeVel)) then - LB(1:2) = lbound(SrcInflowTypeData%InflowWakeVel, kind=B8Ki) - UB(1:2) = ubound(SrcInflowTypeData%InflowWakeVel, kind=B8Ki) + LB(1:2) = lbound(SrcInflowTypeData%InflowWakeVel) + UB(1:2) = ubound(SrcInflowTypeData%InflowWakeVel) if (.not. allocated(DstInflowTypeData%InflowWakeVel)) then allocate(DstInflowTypeData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3329,8 +3329,8 @@ subroutine AD_CopyInflowType(SrcInflowTypeData, DstInflowTypeData, CtrlCode, Err DstInflowTypeData%InflowWakeVel = SrcInflowTypeData%InflowWakeVel end if if (allocated(SrcInflowTypeData%RotInflow)) then - LB(1:1) = lbound(SrcInflowTypeData%RotInflow, kind=B8Ki) - UB(1:1) = ubound(SrcInflowTypeData%RotInflow, kind=B8Ki) + LB(1:1) = lbound(SrcInflowTypeData%RotInflow) + UB(1:1) = ubound(SrcInflowTypeData%RotInflow) if (.not. allocated(DstInflowTypeData%RotInflow)) then allocate(DstInflowTypeData%RotInflow(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3350,8 +3350,8 @@ subroutine AD_DestroyInflowType(InflowTypeData, ErrStat, ErrMsg) type(AD_InflowType), intent(inout) :: InflowTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInflowType' @@ -3361,8 +3361,8 @@ subroutine AD_DestroyInflowType(InflowTypeData, ErrStat, ErrMsg) deallocate(InflowTypeData%InflowWakeVel) end if if (allocated(InflowTypeData%RotInflow)) then - LB(1:1) = lbound(InflowTypeData%RotInflow, kind=B8Ki) - UB(1:1) = ubound(InflowTypeData%RotInflow, kind=B8Ki) + LB(1:1) = lbound(InflowTypeData%RotInflow) + UB(1:1) = ubound(InflowTypeData%RotInflow) do i1 = LB(1), UB(1) call AD_DestroyRotInflowType(InflowTypeData%RotInflow(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3375,15 +3375,15 @@ subroutine AD_PackInflowType(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_InflowType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInflowType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%InflowWakeVel) call RegPack(RF, allocated(InData%RotInflow)) if (allocated(InData%RotInflow)) then - call RegPackBounds(RF, 1, lbound(InData%RotInflow, kind=B8Ki), ubound(InData%RotInflow, kind=B8Ki)) - LB(1:1) = lbound(InData%RotInflow, kind=B8Ki) - UB(1:1) = ubound(InData%RotInflow, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%RotInflow), ubound(InData%RotInflow)) + LB(1:1) = lbound(InData%RotInflow) + UB(1:1) = ubound(InData%RotInflow) do i1 = LB(1), UB(1) call AD_PackRotInflowType(RF, InData%RotInflow(i1)) end do @@ -3395,8 +3395,8 @@ subroutine AD_UnPackInflowType(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_InflowType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInflowType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3422,8 +3422,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' @@ -3445,8 +3445,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds if (allocated(SrcRotParameterTypeData%TwrDiam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam) if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3457,8 +3457,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam end if if (allocated(SrcRotParameterTypeData%TwrCd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd) if (.not. allocated(DstRotParameterTypeData%TwrCd)) then allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3469,8 +3469,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd end if if (allocated(SrcRotParameterTypeData%TwrTI)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI) if (.not. allocated(DstRotParameterTypeData%TwrTI)) then allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3481,8 +3481,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI end if if (allocated(SrcRotParameterTypeData%BlTwist)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) + LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist) if (.not. allocated(DstRotParameterTypeData%BlTwist)) then allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3493,8 +3493,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist end if if (allocated(SrcRotParameterTypeData%TwrCb)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb) if (.not. allocated(DstRotParameterTypeData%TwrCb)) then allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3505,8 +3505,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb end if if (allocated(SrcRotParameterTypeData%BlCenBn)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn) if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3517,8 +3517,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn end if if (allocated(SrcRotParameterTypeData%BlCenBt)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt) if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3538,8 +3538,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr if (allocated(SrcRotParameterTypeData%BlRad)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlRad, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlRad, kind=B8Ki) + LB(1:2) = lbound(SrcRotParameterTypeData%BlRad) + UB(1:2) = ubound(SrcRotParameterTypeData%BlRad) if (.not. allocated(DstRotParameterTypeData%BlRad)) then allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3550,8 +3550,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad end if if (allocated(SrcRotParameterTypeData%BlDL)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlDL, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlDL, kind=B8Ki) + LB(1:2) = lbound(SrcRotParameterTypeData%BlDL) + UB(1:2) = ubound(SrcRotParameterTypeData%BlDL) if (.not. allocated(DstRotParameterTypeData%BlDL)) then allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3562,8 +3562,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL end if if (allocated(SrcRotParameterTypeData%BlTaper)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) + LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper) if (.not. allocated(DstRotParameterTypeData%BlTaper)) then allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3574,8 +3574,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper end if if (allocated(SrcRotParameterTypeData%BlAxCent)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) + LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent) if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3586,8 +3586,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent end if if (allocated(SrcRotParameterTypeData%TwrRad)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad) if (.not. allocated(DstRotParameterTypeData%TwrRad)) then allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3598,8 +3598,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad end if if (allocated(SrcRotParameterTypeData%TwrDL)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL) if (.not. allocated(DstRotParameterTypeData%TwrDL)) then allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3610,8 +3610,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL end if if (allocated(SrcRotParameterTypeData%TwrTaper)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper) if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3622,8 +3622,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper end if if (allocated(SrcRotParameterTypeData%TwrAxCent)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent) if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3641,8 +3641,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD if (ErrStat >= AbortErrLev) return DstRotParameterTypeData%NumExtendedInputs = SrcRotParameterTypeData%NumExtendedInputs if (allocated(SrcRotParameterTypeData%du)) then - LB(1:1) = lbound(SrcRotParameterTypeData%du, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%du, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%du) + UB(1:1) = ubound(SrcRotParameterTypeData%du) if (.not. allocated(DstRotParameterTypeData%du)) then allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3653,8 +3653,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%du = SrcRotParameterTypeData%du end if if (allocated(SrcRotParameterTypeData%dx)) then - LB(1:1) = lbound(SrcRotParameterTypeData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%dx, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%dx) + UB(1:1) = ubound(SrcRotParameterTypeData%dx) if (.not. allocated(DstRotParameterTypeData%dx)) then allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3688,8 +3688,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName if (allocated(SrcRotParameterTypeData%OutParam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%OutParam) if (.not. allocated(DstRotParameterTypeData%OutParam)) then allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3710,8 +3710,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam) if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3726,8 +3726,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end do end if if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd) if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3749,8 +3749,8 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) type(RotParameterType), intent(inout) :: RotParameterTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' @@ -3818,8 +3818,8 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) deallocate(RotParameterTypeData%dx) end if if (allocated(RotParameterTypeData%OutParam)) then - LB(1:1) = lbound(RotParameterTypeData%OutParam, kind=B8Ki) - UB(1:1) = ubound(RotParameterTypeData%OutParam, kind=B8Ki) + LB(1:1) = lbound(RotParameterTypeData%OutParam) + UB(1:1) = ubound(RotParameterTypeData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3827,8 +3827,8 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) deallocate(RotParameterTypeData%OutParam) end if if (allocated(RotParameterTypeData%BldNd_OutParam)) then - LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3846,8 +3846,8 @@ subroutine AD_PackRotParameterType(RF, Indata) type(RegFile), intent(inout) :: RF type(RotParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotParameterType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, associated(InData%Vars)) @@ -3914,9 +3914,9 @@ subroutine AD_PackRotParameterType(RF, Indata) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -3929,9 +3929,9 @@ subroutine AD_PackRotParameterType(RF, Indata) call RegPack(RF, InData%BldNd_TotNumOuts) call RegPack(RF, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) end do @@ -3948,8 +3948,8 @@ subroutine AD_UnPackRotParameterType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -4073,16 +4073,16 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%rotors)) then - LB(1:1) = lbound(SrcParamData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotors) + UB(1:1) = ubound(SrcParamData%rotors) if (.not. allocated(DstParamData%rotors)) then allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4099,8 +4099,8 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DT = SrcParamData%DT DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%AFI)) then - LB(1:1) = lbound(SrcParamData%AFI, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AFI, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%AFI) + UB(1:1) = ubound(SrcParamData%AFI) if (.not. allocated(DstParamData%AFI)) then allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4133,16 +4133,16 @@ subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) type(AD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%rotors)) then - LB(1:1) = lbound(ParamData%rotors, kind=B8Ki) - UB(1:1) = ubound(ParamData%rotors, kind=B8Ki) + LB(1:1) = lbound(ParamData%rotors) + UB(1:1) = ubound(ParamData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4150,8 +4150,8 @@ subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%rotors) end if if (allocated(ParamData%AFI)) then - LB(1:1) = lbound(ParamData%AFI, kind=B8Ki) - UB(1:1) = ubound(ParamData%AFI, kind=B8Ki) + LB(1:1) = lbound(ParamData%AFI) + UB(1:1) = ubound(ParamData%AFI) do i1 = LB(1), UB(1) call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4167,15 +4167,15 @@ subroutine AD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotParameterType(RF, InData%rotors(i1)) end do @@ -4184,9 +4184,9 @@ subroutine AD_PackParam(RF, Indata) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%AFI)) if (allocated(InData%AFI)) then - call RegPackBounds(RF, 1, lbound(InData%AFI, kind=B8Ki), ubound(InData%AFI, kind=B8Ki)) - LB(1:1) = lbound(InData%AFI, kind=B8Ki) - UB(1:1) = ubound(InData%AFI, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AFI), ubound(InData%AFI)) + LB(1:1) = lbound(InData%AFI) + UB(1:1) = ubound(InData%AFI) do i1 = LB(1), UB(1) call AFI_PackParam(RF, InData%AFI(i1)) end do @@ -4215,8 +4215,8 @@ subroutine AD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -4286,8 +4286,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotInputType' @@ -4303,8 +4303,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion) if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4319,8 +4319,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod end do end if if (allocated(SrcRotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion) if (.not. allocated(DstRotInputTypeData%BladeMotion)) then allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4338,8 +4338,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotInputTypeData%UserProp)) then - LB(1:2) = lbound(SrcRotInputTypeData%UserProp, kind=B8Ki) - UB(1:2) = ubound(SrcRotInputTypeData%UserProp, kind=B8Ki) + LB(1:2) = lbound(SrcRotInputTypeData%UserProp) + UB(1:2) = ubound(SrcRotInputTypeData%UserProp) if (.not. allocated(DstRotInputTypeData%UserProp)) then allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4355,8 +4355,8 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) type(RotInputType), intent(inout) :: RotInputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' @@ -4369,8 +4369,8 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(RotInputTypeData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(RotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(RotInputTypeData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4378,8 +4378,8 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) deallocate(RotInputTypeData%BladeRootMotion) end if if (allocated(RotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(RotInputTypeData%BladeMotion, kind=B8Ki) + LB(1:1) = lbound(RotInputTypeData%BladeMotion) + UB(1:1) = ubound(RotInputTypeData%BladeMotion) do i1 = LB(1), UB(1) call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4397,26 +4397,26 @@ subroutine AD_PackRotInputType(RF, Indata) type(RegFile), intent(inout) :: RF type(RotInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInputType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call MeshPack(RF, InData%NacelleMotion) call MeshPack(RF, InData%TowerMotion) call MeshPack(RF, InData%HubMotion) call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeRootMotion(i1)) end do end if call RegPack(RF, allocated(InData%BladeMotion)) if (allocated(InData%BladeMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) + LB(1:1) = lbound(InData%BladeMotion) + UB(1:1) = ubound(InData%BladeMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeMotion(i1)) end do @@ -4430,8 +4430,8 @@ subroutine AD_UnPackRotInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4474,16 +4474,16 @@ subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%rotors)) then - LB(1:1) = lbound(SrcInputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) if (.not. allocated(DstInputData%rotors)) then allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4503,16 +4503,16 @@ subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) type(AD_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%rotors)) then - LB(1:1) = lbound(InputData%rotors, kind=B8Ki) - UB(1:1) = ubound(InputData%rotors, kind=B8Ki) + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4525,14 +4525,14 @@ subroutine AD_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotInputType(RF, InData%rotors(i1)) end do @@ -4544,8 +4544,8 @@ subroutine AD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4570,8 +4570,8 @@ subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, Ctrl integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' @@ -4587,8 +4587,8 @@ subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, Ctrl call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) + LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad) + UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad) if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4606,8 +4606,8 @@ subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, Ctrl call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotOutputTypeData%WriteOutput)) then - LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput) + UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput) if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4623,8 +4623,8 @@ subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) type(RotOutputType), intent(inout) :: RotOutputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' @@ -4637,8 +4637,8 @@ subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(RotOutputTypeData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(RotOutputTypeData%BladeLoad, kind=B8Ki) + LB(1:1) = lbound(RotOutputTypeData%BladeLoad) + UB(1:1) = ubound(RotOutputTypeData%BladeLoad) do i1 = LB(1), UB(1) call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4656,17 +4656,17 @@ subroutine AD_PackRotOutputType(RF, Indata) type(RegFile), intent(inout) :: RF type(RotOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotOutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call MeshPack(RF, InData%NacelleLoad) call MeshPack(RF, InData%HubLoad) call MeshPack(RF, InData%TowerLoad) call RegPack(RF, allocated(InData%BladeLoad)) if (allocated(InData%BladeLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoad, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLoad, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) + LB(1:1) = lbound(InData%BladeLoad) + UB(1:1) = ubound(InData%BladeLoad) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeLoad(i1)) end do @@ -4680,8 +4680,8 @@ subroutine AD_UnPackRotOutputType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4711,16 +4711,16 @@ subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%rotors)) then - LB(1:1) = lbound(SrcOutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%rotors) + UB(1:1) = ubound(SrcOutputData%rotors) if (.not. allocated(DstOutputData%rotors)) then allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4740,16 +4740,16 @@ subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) type(AD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%rotors)) then - LB(1:1) = lbound(OutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(OutputData%rotors, kind=B8Ki) + LB(1:1) = lbound(OutputData%rotors) + UB(1:1) = ubound(OutputData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4762,14 +4762,14 @@ subroutine AD_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotOutputType(RF, InData%rotors(i1)) end do @@ -4781,8 +4781,8 @@ subroutine AD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4807,8 +4807,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' @@ -4847,8 +4847,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u) do i1 = LB(1), UB(1) call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4864,8 +4864,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) - UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) + LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow) + UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow) if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4876,8 +4876,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow end if if (allocated(SrcRotMiscVarTypeData%SectAvgInflow)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%SectAvgInflow, kind=B8Ki) - UB(1:3) = ubound(SrcRotMiscVarTypeData%SectAvgInflow, kind=B8Ki) + LB(1:3) = lbound(SrcRotMiscVarTypeData%SectAvgInflow) + UB(1:3) = ubound(SrcRotMiscVarTypeData%SectAvgInflow) if (.not. allocated(DstRotMiscVarTypeData%SectAvgInflow)) then allocate(DstRotMiscVarTypeData%SectAvgInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4888,8 +4888,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%SectAvgInflow = SrcRotMiscVarTypeData%SectAvgInflow end if if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then - LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) - UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) + LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus) + UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus) if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4900,8 +4900,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus end if if (allocated(SrcRotMiscVarTypeData%R_li)) then - LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) - UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) + LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li) + UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li) if (.not. allocated(DstRotMiscVarTypeData%R_li)) then allocate(DstRotMiscVarTypeData%R_li(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4912,8 +4912,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li end if if (allocated(SrcRotMiscVarTypeData%AllOuts)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts) + UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts) if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4924,8 +4924,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts end if if (allocated(SrcRotMiscVarTypeData%W_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr) if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4936,8 +4936,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr end if if (allocated(SrcRotMiscVarTypeData%X_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr) if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4948,8 +4948,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr end if if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr) if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4960,8 +4960,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr end if if (allocated(SrcRotMiscVarTypeData%Cant)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Cant, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Cant, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Cant) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Cant) if (.not. allocated(DstRotMiscVarTypeData%Cant)) then allocate(DstRotMiscVarTypeData%Cant(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4972,8 +4972,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Cant = SrcRotMiscVarTypeData%Cant end if if (allocated(SrcRotMiscVarTypeData%Toe)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Toe, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Toe, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Toe) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Toe) if (.not. allocated(DstRotMiscVarTypeData%Toe)) then allocate(DstRotMiscVarTypeData%Toe(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4984,8 +4984,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Toe = SrcRotMiscVarTypeData%Toe end if if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc) if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4996,8 +4996,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc end if if (allocated(SrcRotMiscVarTypeData%X)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%X, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%X, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%X) + UB(1:2) = ubound(SrcRotMiscVarTypeData%X) if (.not. allocated(DstRotMiscVarTypeData%X)) then allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5008,8 +5008,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X end if if (allocated(SrcRotMiscVarTypeData%Y)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Y, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Y, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Y) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Y) if (.not. allocated(DstRotMiscVarTypeData%Y)) then allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5020,8 +5020,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y end if if (allocated(SrcRotMiscVarTypeData%Z)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Z, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Z, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Z) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Z) if (.not. allocated(DstRotMiscVarTypeData%Z)) then allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5032,8 +5032,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z end if if (allocated(SrcRotMiscVarTypeData%M)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%M, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%M, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%M) + UB(1:2) = ubound(SrcRotMiscVarTypeData%M) if (.not. allocated(DstRotMiscVarTypeData%M)) then allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5044,8 +5044,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M end if if (allocated(SrcRotMiscVarTypeData%Mx)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx) if (.not. allocated(DstRotMiscVarTypeData%Mx)) then allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5056,8 +5056,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx end if if (allocated(SrcRotMiscVarTypeData%My)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%My, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%My, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%My) + UB(1:2) = ubound(SrcRotMiscVarTypeData%My) if (.not. allocated(DstRotMiscVarTypeData%My)) then allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5068,8 +5068,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My end if if (allocated(SrcRotMiscVarTypeData%Mz)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz) if (.not. allocated(DstRotMiscVarTypeData%Mz)) then allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5080,8 +5080,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz end if if (allocated(SrcRotMiscVarTypeData%Vind_i)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) - UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) + LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i) + UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i) if (.not. allocated(DstRotMiscVarTypeData%Vind_i)) then allocate(DstRotMiscVarTypeData%Vind_i(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5095,8 +5095,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root) + UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root) if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5111,8 +5111,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P) if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5127,8 +5127,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit) if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5139,8 +5139,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit end if if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit) if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5151,8 +5151,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit end if if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet) + UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet) if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5163,8 +5163,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet end if if (allocated(SrcRotMiscVarTypeData%TwrFB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB) if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5175,8 +5175,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB end if if (allocated(SrcRotMiscVarTypeData%TwrMB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB) if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5187,8 +5187,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB end if if (allocated(SrcRotMiscVarTypeData%HubFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB) if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5199,8 +5199,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB end if if (allocated(SrcRotMiscVarTypeData%HubMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB) if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5211,8 +5211,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB end if if (allocated(SrcRotMiscVarTypeData%NacFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB) if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5223,8 +5223,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB end if if (allocated(SrcRotMiscVarTypeData%NacMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB) if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5235,8 +5235,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB end if if (allocated(SrcRotMiscVarTypeData%NacDragF)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragF, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragF, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragF) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragF) if (.not. allocated(DstRotMiscVarTypeData%NacDragF)) then allocate(DstRotMiscVarTypeData%NacDragF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5247,8 +5247,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacDragF = SrcRotMiscVarTypeData%NacDragF end if if (allocated(SrcRotMiscVarTypeData%NacDragM)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragM, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragM, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragM) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragM) if (.not. allocated(DstRotMiscVarTypeData%NacDragM)) then allocate(DstRotMiscVarTypeData%NacDragM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5259,8 +5259,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacDragM = SrcRotMiscVarTypeData%NacDragM end if if (allocated(SrcRotMiscVarTypeData%NacFi)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFi, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFi, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFi) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFi) if (.not. allocated(DstRotMiscVarTypeData%NacFi)) then allocate(DstRotMiscVarTypeData%NacFi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5271,8 +5271,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacFi = SrcRotMiscVarTypeData%NacFi end if if (allocated(SrcRotMiscVarTypeData%NacMi)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMi, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMi, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMi) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMi) if (.not. allocated(DstRotMiscVarTypeData%NacMi)) then allocate(DstRotMiscVarTypeData%NacMi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5283,8 +5283,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacMi = SrcRotMiscVarTypeData%NacMi end if if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad) if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5299,8 +5299,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P) if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5315,8 +5315,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5331,8 +5331,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad) if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5347,8 +5347,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L) if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5389,8 +5389,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' @@ -5418,8 +5418,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) + LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u) do i1 = LB(1), UB(1) call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5493,8 +5493,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5541,8 +5541,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%NacMi) end if if (allocated(RotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) + LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad) do i1 = LB(1), UB(1) call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5550,8 +5550,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%BladeRootLoad) end if if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5559,8 +5559,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%B_L_2_R_P) end if if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint) do i1 = LB(1), UB(1) call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5568,8 +5568,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) end if if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad) do i1 = LB(1), UB(1) call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5577,8 +5577,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%BladeBuoyLoad) end if if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) + LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5597,8 +5597,8 @@ subroutine AD_PackRotMiscVarType(RF, Indata) type(RegFile), intent(inout) :: RF type(RotMiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackModJacType(RF, InData%Jac) call AD_PackRotContinuousStateType(RF, InData%x_init) @@ -5611,8 +5611,8 @@ subroutine AD_PackRotMiscVarType(RF, Indata) call AD_PackRotOtherStateType(RF, InData%OtherState_jac) call BEMT_PackMisc(RF, InData%BEMT) call BEMT_PackOutput(RF, InData%BEMT_y) - LB(1:1) = lbound(InData%BEMT_u, kind=B8Ki) - UB(1:1) = ubound(InData%BEMT_u, kind=B8Ki) + LB(1:1) = lbound(InData%BEMT_u) + UB(1:1) = ubound(InData%BEMT_u) do i1 = LB(1), UB(1) call BEMT_PackInput(RF, InData%BEMT_u(i1)) end do @@ -5646,9 +5646,9 @@ subroutine AD_PackRotMiscVarType(RF, Indata) call MeshPack(RF, InData%HubLoad) call RegPack(RF, allocated(InData%B_L_2_H_P)) if (allocated(InData%B_L_2_H_P)) then - call RegPackBounds(RF, 1, lbound(InData%B_L_2_H_P, kind=B8Ki), ubound(InData%B_L_2_H_P, kind=B8Ki)) - LB(1:1) = lbound(InData%B_L_2_H_P, kind=B8Ki) - UB(1:1) = ubound(InData%B_L_2_H_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) + LB(1:1) = lbound(InData%B_L_2_H_P) + UB(1:1) = ubound(InData%B_L_2_H_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_H_P(i1)) end do @@ -5668,45 +5668,45 @@ subroutine AD_PackRotMiscVarType(RF, Indata) call RegPackAlloc(RF, InData%NacMi) call RegPack(RF, allocated(InData%BladeRootLoad)) if (allocated(InData%BladeRootLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootLoad, kind=B8Ki), ubound(InData%BladeRootLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootLoad, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) + LB(1:1) = lbound(InData%BladeRootLoad) + UB(1:1) = ubound(InData%BladeRootLoad) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeRootLoad(i1)) end do end if call RegPack(RF, allocated(InData%B_L_2_R_P)) if (allocated(InData%B_L_2_R_P)) then - call RegPackBounds(RF, 1, lbound(InData%B_L_2_R_P, kind=B8Ki), ubound(InData%B_L_2_R_P, kind=B8Ki)) - LB(1:1) = lbound(InData%B_L_2_R_P, kind=B8Ki) - UB(1:1) = ubound(InData%B_L_2_R_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) + LB(1:1) = lbound(InData%B_L_2_R_P) + UB(1:1) = ubound(InData%B_L_2_R_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_R_P(i1)) end do end if call RegPack(RF, allocated(InData%BladeBuoyLoadPoint)) if (allocated(InData%BladeBuoyLoadPoint)) then - call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoadPoint, kind=B8Ki), ubound(InData%BladeBuoyLoadPoint, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeBuoyLoadPoint, kind=B8Ki) - UB(1:1) = ubound(InData%BladeBuoyLoadPoint, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) + LB(1:1) = lbound(InData%BladeBuoyLoadPoint) + UB(1:1) = ubound(InData%BladeBuoyLoadPoint) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeBuoyLoadPoint(i1)) end do end if call RegPack(RF, allocated(InData%BladeBuoyLoad)) if (allocated(InData%BladeBuoyLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoad, kind=B8Ki), ubound(InData%BladeBuoyLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeBuoyLoad, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) + LB(1:1) = lbound(InData%BladeBuoyLoad) + UB(1:1) = ubound(InData%BladeBuoyLoad) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeBuoyLoad(i1)) end do end if call RegPack(RF, allocated(InData%B_P_2_B_L)) if (allocated(InData%B_P_2_B_L)) then - call RegPackBounds(RF, 1, lbound(InData%B_P_2_B_L, kind=B8Ki), ubound(InData%B_P_2_B_L, kind=B8Ki)) - LB(1:1) = lbound(InData%B_P_2_B_L, kind=B8Ki) - UB(1:1) = ubound(InData%B_P_2_B_L, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) + LB(1:1) = lbound(InData%B_P_2_B_L) + UB(1:1) = ubound(InData%B_P_2_B_L) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%B_P_2_B_L(i1)) end do @@ -5733,8 +5733,8 @@ subroutine AD_UnPackRotMiscVarType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotMiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5749,8 +5749,8 @@ subroutine AD_UnPackRotMiscVarType(RF, OutData) call AD_UnpackRotOtherStateType(RF, OutData%OtherState_jac) ! OtherState_jac call BEMT_UnpackMisc(RF, OutData%BEMT) ! BEMT call BEMT_UnpackOutput(RF, OutData%BEMT_y) ! BEMT_y - LB(1:1) = lbound(OutData%BEMT_u, kind=B8Ki) - UB(1:1) = ubound(OutData%BEMT_u, kind=B8Ki) + LB(1:1) = lbound(OutData%BEMT_u) + UB(1:1) = ubound(OutData%BEMT_u) do i1 = LB(1), UB(1) call BEMT_UnpackInput(RF, OutData%BEMT_u(i1)) ! BEMT_u end do @@ -5896,16 +5896,16 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%rotors)) then - LB(1:1) = lbound(SrcMiscData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%rotors) + UB(1:1) = ubound(SrcMiscData%rotors) if (.not. allocated(DstMiscData%rotors)) then allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5920,8 +5920,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%FVW_u)) then - LB(1:1) = lbound(SrcMiscData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FVW_u, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FVW_u) + UB(1:1) = ubound(SrcMiscData%FVW_u) if (.not. allocated(DstMiscData%FVW_u)) then allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5942,8 +5942,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%WindPos)) then - LB(1:2) = lbound(SrcMiscData%WindPos, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindPos, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%WindPos) + UB(1:2) = ubound(SrcMiscData%WindPos) if (.not. allocated(DstMiscData%WindPos)) then allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5954,8 +5954,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WindPos = SrcMiscData%WindPos end if if (allocated(SrcMiscData%WindVel)) then - LB(1:2) = lbound(SrcMiscData%WindVel, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindVel, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%WindVel) + UB(1:2) = ubound(SrcMiscData%WindVel) if (.not. allocated(DstMiscData%WindVel)) then allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5966,8 +5966,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WindVel = SrcMiscData%WindVel end if if (allocated(SrcMiscData%WindAcc)) then - LB(1:2) = lbound(SrcMiscData%WindAcc, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindAcc, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%WindAcc) + UB(1:2) = ubound(SrcMiscData%WindAcc) if (.not. allocated(DstMiscData%WindAcc)) then allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5978,8 +5978,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WindAcc = SrcMiscData%WindAcc end if if (allocated(SrcMiscData%Inflow)) then - LB(1:1) = lbound(SrcMiscData%Inflow, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Inflow, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Inflow) + UB(1:1) = ubound(SrcMiscData%Inflow) if (.not. allocated(DstMiscData%Inflow)) then allocate(DstMiscData%Inflow(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5999,16 +5999,16 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) type(AD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(MiscData%rotors)) then - LB(1:1) = lbound(MiscData%rotors, kind=B8Ki) - UB(1:1) = ubound(MiscData%rotors, kind=B8Ki) + LB(1:1) = lbound(MiscData%rotors) + UB(1:1) = ubound(MiscData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6016,8 +6016,8 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%rotors) end if if (allocated(MiscData%FVW_u)) then - LB(1:1) = lbound(MiscData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(MiscData%FVW_u, kind=B8Ki) + LB(1:1) = lbound(MiscData%FVW_u) + UB(1:1) = ubound(MiscData%FVW_u) do i1 = LB(1), UB(1) call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6038,8 +6038,8 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%WindAcc) end if if (allocated(MiscData%Inflow)) then - LB(1:1) = lbound(MiscData%Inflow, kind=B8Ki) - UB(1:1) = ubound(MiscData%Inflow, kind=B8Ki) + LB(1:1) = lbound(MiscData%Inflow) + UB(1:1) = ubound(MiscData%Inflow) do i1 = LB(1), UB(1) call AD_DestroyInflowType(MiscData%Inflow(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6052,23 +6052,23 @@ subroutine AD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call AD_PackRotMiscVarType(RF, InData%rotors(i1)) end do end if call RegPack(RF, allocated(InData%FVW_u)) if (allocated(InData%FVW_u)) then - call RegPackBounds(RF, 1, lbound(InData%FVW_u, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) - LB(1:1) = lbound(InData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(InData%FVW_u, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) + LB(1:1) = lbound(InData%FVW_u) + UB(1:1) = ubound(InData%FVW_u) do i1 = LB(1), UB(1) call FVW_PackInput(RF, InData%FVW_u(i1)) end do @@ -6080,9 +6080,9 @@ subroutine AD_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%WindAcc) call RegPack(RF, allocated(InData%Inflow)) if (allocated(InData%Inflow)) then - call RegPackBounds(RF, 1, lbound(InData%Inflow, kind=B8Ki), ubound(InData%Inflow, kind=B8Ki)) - LB(1:1) = lbound(InData%Inflow, kind=B8Ki) - UB(1:1) = ubound(InData%Inflow, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Inflow), ubound(InData%Inflow)) + LB(1:1) = lbound(InData%Inflow) + UB(1:1) = ubound(InData%Inflow) do i1 = LB(1), UB(1) call AD_PackInflowType(RF, InData%Inflow(i1)) end do @@ -6094,8 +6094,8 @@ subroutine AD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6245,39 +6245,39 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(u_out%rotors(i01)%BladeRootMotion,1),ubound(u_out%rotors(i01)%BladeRootMotion,1) CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki) + do i1 = lbound(u_out%rotors(i01)%BladeMotion,1),ubound(u_out%rotors(i01)%BladeMotion,1) CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp END IF ! check if allocated @@ -6343,39 +6343,39 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(u_out%rotors(i01)%BladeRootMotion,1),ubound(u_out%rotors(i01)%BladeRootMotion,1) CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki) + do i1 = lbound(u_out%rotors(i01)%BladeMotion,1),ubound(u_out%rotors(i01)%BladeMotion,1) CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + a3*u3%rotors(i01)%UserProp END IF ! check if allocated @@ -6481,31 +6481,31 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki),UBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki) + do i1 = lbound(y_out%rotors(i01)%BladeLoad,1),ubound(y_out%rotors(i01)%BladeLoad,1) CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput END IF ! check if allocated @@ -6569,31 +6569,31 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki),UBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki) + do i1 = lbound(y_out%rotors(i01)%BladeLoad,1),ubound(y_out%rotors(i01)%BladeLoad,1) CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + a3*y3%rotors(i01)%WriteOutput END IF ! check if allocated @@ -6706,21 +6706,21 @@ SUBROUTINE AD_InflowType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel END IF ! check if allocated IF (ALLOCATED(u_out%RotInflow) .AND. ALLOCATED(u1%RotInflow)) THEN - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade) .AND. ALLOCATED(u1%RotInflow(i01)%Blade)) THEN - DO i11 = LBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki) + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowVel)) THEN u_out%RotInflow(i01)%Blade(i11)%InflowVel = a1*u1%RotInflow(i01)%Blade(i11)%InflowVel + a2*u2%RotInflow(i01)%Blade(i11)%InflowVel END IF ! check if allocated END DO - DO i11 = LBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki) + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowAcc) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowAcc)) THEN u_out%RotInflow(i01)%Blade(i11)%InflowAcc = a1*u1%RotInflow(i01)%Blade(i11)%InflowAcc + a2*u2%RotInflow(i01)%Blade(i11)%InflowAcc END IF ! check if allocated END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) IF (ALLOCATED(u_out%RotInflow(i01)%Tower%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Tower%InflowVel)) THEN u_out%RotInflow(i01)%Tower%InflowVel = a1*u1%RotInflow(i01)%Tower%InflowVel + a2*u2%RotInflow(i01)%Tower%InflowVel END IF ! check if allocated @@ -6728,16 +6728,16 @@ SUBROUTINE AD_InflowType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err u_out%RotInflow(i01)%Tower%InflowAcc = a1*u1%RotInflow(i01)%Tower%InflowAcc + a2*u2%RotInflow(i01)%Tower%InflowAcc END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnHub = a1*u1%RotInflow(i01)%InflowOnHub + a2*u2%RotInflow(i01)%InflowOnHub END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnNacelle = a1*u1%RotInflow(i01)%InflowOnNacelle + a2*u2%RotInflow(i01)%InflowOnNacelle END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnTailFin = a1*u1%RotInflow(i01)%InflowOnTailFin + a2*u2%RotInflow(i01)%InflowOnTailFin END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%AvgDiskVel = a1*u1%RotInflow(i01)%AvgDiskVel + a2*u2%RotInflow(i01)%AvgDiskVel END DO END IF ! check if allocated @@ -6806,21 +6806,21 @@ SUBROUTINE AD_InflowType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + a3*u3%InflowWakeVel END IF ! check if allocated IF (ALLOCATED(u_out%RotInflow) .AND. ALLOCATED(u1%RotInflow)) THEN - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade) .AND. ALLOCATED(u1%RotInflow(i01)%Blade)) THEN - DO i11 = LBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki) + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowVel)) THEN u_out%RotInflow(i01)%Blade(i11)%InflowVel = a1*u1%RotInflow(i01)%Blade(i11)%InflowVel + a2*u2%RotInflow(i01)%Blade(i11)%InflowVel + a3*u3%RotInflow(i01)%Blade(i11)%InflowVel END IF ! check if allocated END DO - DO i11 = LBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki) + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowAcc) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowAcc)) THEN u_out%RotInflow(i01)%Blade(i11)%InflowAcc = a1*u1%RotInflow(i01)%Blade(i11)%InflowAcc + a2*u2%RotInflow(i01)%Blade(i11)%InflowAcc + a3*u3%RotInflow(i01)%Blade(i11)%InflowAcc END IF ! check if allocated END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) IF (ALLOCATED(u_out%RotInflow(i01)%Tower%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Tower%InflowVel)) THEN u_out%RotInflow(i01)%Tower%InflowVel = a1*u1%RotInflow(i01)%Tower%InflowVel + a2*u2%RotInflow(i01)%Tower%InflowVel + a3*u3%RotInflow(i01)%Tower%InflowVel END IF ! check if allocated @@ -6828,16 +6828,16 @@ SUBROUTINE AD_InflowType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, u_out%RotInflow(i01)%Tower%InflowAcc = a1*u1%RotInflow(i01)%Tower%InflowAcc + a2*u2%RotInflow(i01)%Tower%InflowAcc + a3*u3%RotInflow(i01)%Tower%InflowAcc END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnHub = a1*u1%RotInflow(i01)%InflowOnHub + a2*u2%RotInflow(i01)%InflowOnHub + a3*u3%RotInflow(i01)%InflowOnHub END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnNacelle = a1*u1%RotInflow(i01)%InflowOnNacelle + a2*u2%RotInflow(i01)%InflowOnNacelle + a3*u3%RotInflow(i01)%InflowOnNacelle END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnTailFin = a1*u1%RotInflow(i01)%InflowOnTailFin + a2*u2%RotInflow(i01)%InflowOnTailFin + a3*u3%RotInflow(i01)%InflowOnTailFin END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%AvgDiskVel = a1*u1%RotInflow(i01)%AvgDiskVel + a2*u2%RotInflow(i01)%AvgDiskVel + a3*u3%RotInflow(i01)%AvgDiskVel END DO END IF ! check if allocated diff --git a/modules/aerodyn/src/AirfoilInfo.f90 b/modules/aerodyn/src/AirfoilInfo.f90 index 60366c3801..ad76c2c689 100644 --- a/modules/aerodyn/src/AirfoilInfo.f90 +++ b/modules/aerodyn/src/AirfoilInfo.f90 @@ -990,6 +990,8 @@ SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UAMod) ! find bounding indices for limitAlphaRange iHighLimit = min( maxloc( alpha_ , DIM=1, MASK=alpha_ < LimitAlphaRange) + 1, size(alpha_) ) ! we can limit this to some range iLowLimit = max( minloc( alpha_ , DIM=1, MASK=alpha_ > -LimitAlphaRange) - 1, 1 ) ! we can limit this to some range + if (iHighLimit - iLowLimit < 3) iHighLimit = min(iLowLimit+2,size(alpha_)) ! this could still be an issue if we don't have very many points in the airfoil table. If that's the case, this data is not worth anything anyway + if (iHighLimit - iLowLimit < 3) iLowLimit = max(iHighLimit-2,1) ! this could still be an issue if we don't have very many points in the airfoil table. If that's the case, this data is not worth anything anyway ! find alphaUpper (using smoothed Cn values): if (CalcDefaults%alphaUpper) then @@ -1053,12 +1055,12 @@ SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UAMod) !mask = p%alpha >= p%UA_BL%alphaLower+alphaMargin & p%alpha <= p%UA_BL%alphaUpper-alphaMargin; iLow2 = iLowLimit - do while (iLow2 < iHighLimit .and. p%alpha(iLow2) < p%UA_BL%alphaLower + alphaMargin) + do while (iLow2 < iHighLimit-1 .and. p%alpha(iLow2) < p%UA_BL%alphaLower + alphaMargin) iLow2 = iLow2 + 1 end do iHigh2 = iHighLimit - do while (iHigh2 > iLowLimit .and. p%alpha(iHigh2) > p%UA_BL%alphaUpper - alphaMargin) + do while (iHigh2 > iLow2+1 .and. p%alpha(iHigh2) > p%UA_BL%alphaUpper - alphaMargin) iHigh2 = iHigh2 - 1 end do @@ -1181,6 +1183,15 @@ SUBROUTINE Calculate_C_alpha(alpha, Cn, Cl, Default_Cn_alpha, Default_Cl_alpha, REAL(ReKi) :: A( size(alpha), 2) REAL(ReKi) :: B(max(2,size(alpha)),2) + if (SIZE(Cn) < 2 .OR. SIZE(Cl) < 2) then + ErrMsg='Calculate_C_alpha: Not enough data points to compute Cn and Cl slopes.' + ErrStat=ErrID_Fatal + Default_Cn_alpha = EPSILON(Default_Cn_alpha) + Default_Cl_alpha = EPSILON(Default_Cl_alpha) + Default_alpha0 = 0.0_ReKi + return + end if + A(:,1) = alpha A(:,2) = 1.0_ReKi diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 28dfb0883a..ae02f958b3 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -535,15 +535,15 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_CopyTable_Type' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcTable_TypeData%Alpha)) then - LB(1:1) = lbound(SrcTable_TypeData%Alpha, kind=B8Ki) - UB(1:1) = ubound(SrcTable_TypeData%Alpha, kind=B8Ki) + LB(1:1) = lbound(SrcTable_TypeData%Alpha) + UB(1:1) = ubound(SrcTable_TypeData%Alpha) if (.not. allocated(DstTable_TypeData%Alpha)) then allocate(DstTable_TypeData%Alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -554,8 +554,8 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha end if if (allocated(SrcTable_TypeData%Coefs)) then - LB(1:2) = lbound(SrcTable_TypeData%Coefs, kind=B8Ki) - UB(1:2) = ubound(SrcTable_TypeData%Coefs, kind=B8Ki) + LB(1:2) = lbound(SrcTable_TypeData%Coefs) + UB(1:2) = ubound(SrcTable_TypeData%Coefs) if (.not. allocated(DstTable_TypeData%Coefs)) then allocate(DstTable_TypeData%Coefs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -566,8 +566,8 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs end if if (allocated(SrcTable_TypeData%SplineCoefs)) then - LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs, kind=B8Ki) - UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs, kind=B8Ki) + LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs) + UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs) if (.not. allocated(DstTable_TypeData%SplineCoefs)) then allocate(DstTable_TypeData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -630,7 +630,7 @@ subroutine AFI_UnPackTable_Type(RF, OutData) type(RegFile), intent(inout) :: RF type(AFI_Table_Type), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackTable_Type' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -756,8 +756,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_CopyParam' @@ -770,8 +770,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ColUAf = SrcParamData%ColUAf DstParamData%AFTabMod = SrcParamData%AFTabMod if (allocated(SrcParamData%secondVals)) then - LB(1:1) = lbound(SrcParamData%secondVals, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%secondVals, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%secondVals) + UB(1:1) = ubound(SrcParamData%secondVals) if (.not. allocated(DstParamData%secondVals)) then allocate(DstParamData%secondVals(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -786,8 +786,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NonDimArea = SrcParamData%NonDimArea DstParamData%NumCoords = SrcParamData%NumCoords if (allocated(SrcParamData%X_Coord)) then - LB(1:1) = lbound(SrcParamData%X_Coord, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%X_Coord, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%X_Coord) + UB(1:1) = ubound(SrcParamData%X_Coord) if (.not. allocated(DstParamData%X_Coord)) then allocate(DstParamData%X_Coord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -798,8 +798,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%X_Coord = SrcParamData%X_Coord end if if (allocated(SrcParamData%Y_Coord)) then - LB(1:1) = lbound(SrcParamData%Y_Coord, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Y_Coord, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Y_Coord) + UB(1:1) = ubound(SrcParamData%Y_Coord) if (.not. allocated(DstParamData%Y_Coord)) then allocate(DstParamData%Y_Coord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -811,8 +811,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NumTabs = SrcParamData%NumTabs if (allocated(SrcParamData%Table)) then - LB(1:1) = lbound(SrcParamData%Table, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Table, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Table) + UB(1:1) = ubound(SrcParamData%Table) if (.not. allocated(DstParamData%Table)) then allocate(DstParamData%Table(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -834,8 +834,8 @@ subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) type(AFI_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_DestroyParam' @@ -851,8 +851,8 @@ subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Y_Coord) end if if (allocated(ParamData%Table)) then - LB(1:1) = lbound(ParamData%Table, kind=B8Ki) - UB(1:1) = ubound(ParamData%Table, kind=B8Ki) + LB(1:1) = lbound(ParamData%Table) + UB(1:1) = ubound(ParamData%Table) do i1 = LB(1), UB(1) call AFI_DestroyTable_Type(ParamData%Table(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -865,8 +865,8 @@ subroutine AFI_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AFI_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%ColCd) call RegPack(RF, InData%ColCl) @@ -884,9 +884,9 @@ subroutine AFI_PackParam(RF, Indata) call RegPack(RF, InData%NumTabs) call RegPack(RF, allocated(InData%Table)) if (allocated(InData%Table)) then - call RegPackBounds(RF, 1, lbound(InData%Table, kind=B8Ki), ubound(InData%Table, kind=B8Ki)) - LB(1:1) = lbound(InData%Table, kind=B8Ki) - UB(1:1) = ubound(InData%Table, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Table), ubound(InData%Table)) + LB(1:1) = lbound(InData%Table) + UB(1:1) = ubound(InData%Table) do i1 = LB(1), UB(1) call AFI_PackTable_Type(RF, InData%Table(i1)) end do @@ -900,8 +900,8 @@ subroutine AFI_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AFI_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index f1eb5b1b98..04df6a4098 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -636,7 +636,7 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte if (errStat >= AbortErrLev) return InitInp_DBEMT%DBEMT_Mod = p%DBEMT_Mod - if ( p%DBEMT_Mod > DBEMT_none .or. p%DBEMT_Mod == DBEMT_Frozen ) then + if ( p%DBEMT_Mod > DBEMT_none ) then InitInp_DBEMT%DBEMT_Mod = p%DBEMT_Mod InitInp_DBEMT%numBlades = p%numBlades InitInp_DBEMT%numNodes = p%numBladeNodes @@ -929,7 +929,7 @@ subroutine BEMT_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, !............................................................................................................................... ! update DBEMT states to step n+1 !............................................................................................................................... - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then !........................ ! update DBEMT states to t+dt @@ -956,7 +956,7 @@ subroutine BEMT_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, !............................................ ! apply DBEMT correction to axInduction and tanInduction: !............................................ - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then call calculate_Inductions_from_DBEMT_AllNodes(TimeIndex_t_plus_dt, uTimes(TimeIndex_t_plus_dt), u(TimeIndex_t_plus_dt), p, x, OtherState, m, m%axInduction, m%tanInduction) end if diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 855f2580ee..000671e07f 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -281,15 +281,15 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitInputData%chord)) then - LB(1:2) = lbound(SrcInitInputData%chord, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%chord, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%chord) + UB(1:2) = ubound(SrcInitInputData%chord) if (.not. allocated(DstInitInputData%chord)) then allocate(DstInitInputData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -316,8 +316,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%numReIterations = SrcInitInputData%numReIterations DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations if (allocated(SrcInitInputData%AFindx)) then - LB(1:2) = lbound(SrcInitInputData%AFindx, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%AFindx, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%AFindx) + UB(1:2) = ubound(SrcInitInputData%AFindx) if (.not. allocated(DstInitInputData%AFindx)) then allocate(DstInitInputData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -328,8 +328,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%AFindx = SrcInitInputData%AFindx end if if (allocated(SrcInitInputData%zHub)) then - LB(1:1) = lbound(SrcInitInputData%zHub, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%zHub, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%zHub) + UB(1:1) = ubound(SrcInitInputData%zHub) if (.not. allocated(DstInitInputData%zHub)) then allocate(DstInitInputData%zHub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -340,8 +340,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zHub = SrcInitInputData%zHub end if if (allocated(SrcInitInputData%zLocal)) then - LB(1:2) = lbound(SrcInitInputData%zLocal, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%zLocal, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%zLocal) + UB(1:2) = ubound(SrcInitInputData%zLocal) if (.not. allocated(DstInitInputData%zLocal)) then allocate(DstInitInputData%zLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -352,8 +352,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zLocal = SrcInitInputData%zLocal end if if (allocated(SrcInitInputData%zTip)) then - LB(1:1) = lbound(SrcInitInputData%zTip, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%zTip, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%zTip) + UB(1:1) = ubound(SrcInitInputData%zTip) if (.not. allocated(DstInitInputData%zTip)) then allocate(DstInitInputData%zTip(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -364,8 +364,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zTip = SrcInitInputData%zTip end if if (allocated(SrcInitInputData%rLocal)) then - LB(1:2) = lbound(SrcInitInputData%rLocal, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%rLocal, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) if (.not. allocated(DstInitInputData%rLocal)) then allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -376,8 +376,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%rLocal = SrcInitInputData%rLocal end if if (allocated(SrcInitInputData%rTipFix)) then - LB(1:1) = lbound(SrcInitInputData%rTipFix, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%rTipFix, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%rTipFix) + UB(1:1) = ubound(SrcInitInputData%rTipFix) if (.not. allocated(DstInitInputData%rTipFix)) then allocate(DstInitInputData%rTipFix(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -476,7 +476,7 @@ subroutine BEMT_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -711,14 +711,14 @@ subroutine BEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%phi)) then - LB(1:2) = lbound(SrcConstrStateData%phi, kind=B8Ki) - UB(1:2) = ubound(SrcConstrStateData%phi, kind=B8Ki) + LB(1:2) = lbound(SrcConstrStateData%phi) + UB(1:2) = ubound(SrcConstrStateData%phi) if (.not. allocated(DstConstrStateData%phi)) then allocate(DstConstrStateData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -755,7 +755,7 @@ subroutine BEMT_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackConstrState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -768,8 +768,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyOtherState' @@ -782,8 +782,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOtherStateData%ValidPhi)) then - LB(1:2) = lbound(SrcOtherStateData%ValidPhi, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%ValidPhi, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%ValidPhi) + UB(1:2) = ubound(SrcOtherStateData%ValidPhi) if (.not. allocated(DstOtherStateData%ValidPhi)) then allocate(DstOtherStateData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -794,8 +794,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi end if DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call BEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -808,8 +808,8 @@ subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(BEMT_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_DestroyOtherState' @@ -822,8 +822,8 @@ subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%ValidPhi)) then deallocate(OtherStateData%ValidPhi) end if - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call BEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -834,15 +834,15 @@ subroutine BEMT_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(BEMT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call UA_PackOtherState(RF, InData%UA) call DBEMT_PackOtherState(RF, InData%DBEMT) call RegPackAlloc(RF, InData%ValidPhi) call RegPack(RF, InData%nodesInitialized) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call BEMT_PackContState(RF, InData%xdot(i1)) end do @@ -854,8 +854,8 @@ subroutine BEMT_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -863,8 +863,8 @@ subroutine BEMT_UnPackOtherState(RF, OutData) call DBEMT_UnpackOtherState(RF, OutData%DBEMT) ! DBEMT call RegUnpackAlloc(RF, OutData%ValidPhi); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nodesInitialized); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call BEMT_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -877,8 +877,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyMisc' @@ -897,8 +897,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%u_UA)) then - LB(1:3) = lbound(SrcMiscData%u_UA, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%u_UA, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%u_UA) + UB(1:3) = ubound(SrcMiscData%u_UA) if (.not. allocated(DstMiscData%u_UA)) then allocate(DstMiscData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -916,23 +916,23 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end do end if - LB(1:1) = lbound(SrcMiscData%u_DBEMT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u_DBEMT, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%u_DBEMT) + UB(1:1) = ubound(SrcMiscData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_CopyInput(SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcMiscData%u_SkewWake, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u_SkewWake, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%u_SkewWake) + UB(1:1) = ubound(SrcMiscData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_CopySkewWake_InputType(SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcMiscData%TnInd_op)) then - LB(1:2) = lbound(SrcMiscData%TnInd_op, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%TnInd_op, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%TnInd_op) + UB(1:2) = ubound(SrcMiscData%TnInd_op) if (.not. allocated(DstMiscData%TnInd_op)) then allocate(DstMiscData%TnInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -943,8 +943,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TnInd_op = SrcMiscData%TnInd_op end if if (allocated(SrcMiscData%AxInd_op)) then - LB(1:2) = lbound(SrcMiscData%AxInd_op, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AxInd_op, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%AxInd_op) + UB(1:2) = ubound(SrcMiscData%AxInd_op) if (.not. allocated(DstMiscData%AxInd_op)) then allocate(DstMiscData%AxInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -955,8 +955,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AxInd_op = SrcMiscData%AxInd_op end if if (allocated(SrcMiscData%AxInduction)) then - LB(1:2) = lbound(SrcMiscData%AxInduction, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AxInduction, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%AxInduction) + UB(1:2) = ubound(SrcMiscData%AxInduction) if (.not. allocated(DstMiscData%AxInduction)) then allocate(DstMiscData%AxInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -967,8 +967,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AxInduction = SrcMiscData%AxInduction end if if (allocated(SrcMiscData%TanInduction)) then - LB(1:2) = lbound(SrcMiscData%TanInduction, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%TanInduction, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%TanInduction) + UB(1:2) = ubound(SrcMiscData%TanInduction) if (.not. allocated(DstMiscData%TanInduction)) then allocate(DstMiscData%TanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -980,8 +980,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake if (allocated(SrcMiscData%Rtip)) then - LB(1:1) = lbound(SrcMiscData%Rtip, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Rtip, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Rtip) + UB(1:1) = ubound(SrcMiscData%Rtip) if (.not. allocated(DstMiscData%Rtip)) then allocate(DstMiscData%Rtip(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -992,8 +992,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Rtip = SrcMiscData%Rtip end if if (allocated(SrcMiscData%phi)) then - LB(1:2) = lbound(SrcMiscData%phi, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%phi, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%phi) + UB(1:2) = ubound(SrcMiscData%phi) if (.not. allocated(DstMiscData%phi)) then allocate(DstMiscData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1004,8 +1004,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%phi = SrcMiscData%phi end if if (allocated(SrcMiscData%chi)) then - LB(1:2) = lbound(SrcMiscData%chi, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%chi, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%chi) + UB(1:2) = ubound(SrcMiscData%chi) if (.not. allocated(DstMiscData%chi)) then allocate(DstMiscData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1016,8 +1016,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%chi = SrcMiscData%chi end if if (allocated(SrcMiscData%ValidPhi)) then - LB(1:2) = lbound(SrcMiscData%ValidPhi, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%ValidPhi, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%ValidPhi) + UB(1:2) = ubound(SrcMiscData%ValidPhi) if (.not. allocated(DstMiscData%ValidPhi)) then allocate(DstMiscData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1034,8 +1034,8 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) type(BEMT_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_DestroyMisc' @@ -1048,8 +1048,8 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) call UA_DestroyOutput(MiscData%y_UA, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%u_UA)) then - LB(1:3) = lbound(MiscData%u_UA, kind=B8Ki) - UB(1:3) = ubound(MiscData%u_UA, kind=B8Ki) + LB(1:3) = lbound(MiscData%u_UA) + UB(1:3) = ubound(MiscData%u_UA) do i3 = LB(3), UB(3) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) @@ -1060,14 +1060,14 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%u_UA) end if - LB(1:1) = lbound(MiscData%u_DBEMT, kind=B8Ki) - UB(1:1) = ubound(MiscData%u_DBEMT, kind=B8Ki) + LB(1:1) = lbound(MiscData%u_DBEMT) + UB(1:1) = ubound(MiscData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_DestroyInput(MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(MiscData%u_SkewWake, kind=B8Ki) - UB(1:1) = ubound(MiscData%u_SkewWake, kind=B8Ki) + LB(1:1) = lbound(MiscData%u_SkewWake) + UB(1:1) = ubound(MiscData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_DestroySkewWake_InputType(MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1102,8 +1102,8 @@ subroutine BEMT_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(BEMT_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackMisc' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%FirstWarn_Skew) call RegPack(RF, InData%FirstWarn_Phi) @@ -1113,9 +1113,9 @@ subroutine BEMT_PackMisc(RF, Indata) call UA_PackOutput(RF, InData%y_UA) call RegPack(RF, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then - call RegPackBounds(RF, 3, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) - LB(1:3) = lbound(InData%u_UA, kind=B8Ki) - UB(1:3) = ubound(InData%u_UA, kind=B8Ki) + call RegPackBounds(RF, 3, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:3) = lbound(InData%u_UA) + UB(1:3) = ubound(InData%u_UA) do i3 = LB(3), UB(3) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) @@ -1124,13 +1124,13 @@ subroutine BEMT_PackMisc(RF, Indata) end do end do end if - LB(1:1) = lbound(InData%u_DBEMT, kind=B8Ki) - UB(1:1) = ubound(InData%u_DBEMT, kind=B8Ki) + LB(1:1) = lbound(InData%u_DBEMT) + UB(1:1) = ubound(InData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_PackInput(RF, InData%u_DBEMT(i1)) end do - LB(1:1) = lbound(InData%u_SkewWake, kind=B8Ki) - UB(1:1) = ubound(InData%u_SkewWake, kind=B8Ki) + LB(1:1) = lbound(InData%u_SkewWake) + UB(1:1) = ubound(InData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_PackSkewWake_InputType(RF, InData%u_SkewWake(i1)) end do @@ -1151,8 +1151,8 @@ subroutine BEMT_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackMisc' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1179,13 +1179,13 @@ subroutine BEMT_UnPackMisc(RF, OutData) end do end do end if - LB(1:1) = lbound(OutData%u_DBEMT, kind=B8Ki) - UB(1:1) = ubound(OutData%u_DBEMT, kind=B8Ki) + LB(1:1) = lbound(OutData%u_DBEMT) + UB(1:1) = ubound(OutData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_UnpackInput(RF, OutData%u_DBEMT(i1)) ! u_DBEMT end do - LB(1:1) = lbound(OutData%u_SkewWake, kind=B8Ki) - UB(1:1) = ubound(OutData%u_SkewWake, kind=B8Ki) + LB(1:1) = lbound(OutData%u_SkewWake) + UB(1:1) = ubound(OutData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_UnpackSkewWake_InputType(RF, OutData%u_SkewWake(i1)) ! u_SkewWake end do @@ -1207,7 +1207,7 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyParam' @@ -1215,8 +1215,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%chord)) then - LB(1:2) = lbound(SrcParamData%chord, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%chord, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%chord) + UB(1:2) = ubound(SrcParamData%chord) if (.not. allocated(DstParamData%chord)) then allocate(DstParamData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1242,8 +1242,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%numReIterations = SrcParamData%numReIterations DstParamData%maxIndIterations = SrcParamData%maxIndIterations if (allocated(SrcParamData%AFindx)) then - LB(1:2) = lbound(SrcParamData%AFindx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AFindx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AFindx) + UB(1:2) = ubound(SrcParamData%AFindx) if (.not. allocated(DstParamData%AFindx)) then allocate(DstParamData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1254,8 +1254,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFindx = SrcParamData%AFindx end if if (allocated(SrcParamData%tipLossConst)) then - LB(1:2) = lbound(SrcParamData%tipLossConst, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%tipLossConst, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%tipLossConst) + UB(1:2) = ubound(SrcParamData%tipLossConst) if (.not. allocated(DstParamData%tipLossConst)) then allocate(DstParamData%tipLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1266,8 +1266,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%tipLossConst = SrcParamData%tipLossConst end if if (allocated(SrcParamData%hubLossConst)) then - LB(1:2) = lbound(SrcParamData%hubLossConst, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%hubLossConst, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%hubLossConst) + UB(1:2) = ubound(SrcParamData%hubLossConst) if (.not. allocated(DstParamData%hubLossConst)) then allocate(DstParamData%hubLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1278,8 +1278,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%hubLossConst = SrcParamData%hubLossConst end if if (allocated(SrcParamData%zHub)) then - LB(1:1) = lbound(SrcParamData%zHub, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%zHub, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%zHub) + UB(1:1) = ubound(SrcParamData%zHub) if (.not. allocated(DstParamData%zHub)) then allocate(DstParamData%zHub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1299,8 +1299,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor if (allocated(SrcParamData%FixedInductions)) then - LB(1:2) = lbound(SrcParamData%FixedInductions, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%FixedInductions, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%FixedInductions) + UB(1:2) = ubound(SrcParamData%FixedInductions) if (.not. allocated(DstParamData%FixedInductions)) then allocate(DstParamData%FixedInductions(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1313,8 +1313,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MomentumCorr = SrcParamData%MomentumCorr DstParamData%rTipFixMax = SrcParamData%rTipFixMax if (allocated(SrcParamData%IntegrateWeight)) then - LB(1:2) = lbound(SrcParamData%IntegrateWeight, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%IntegrateWeight, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%IntegrateWeight) + UB(1:2) = ubound(SrcParamData%IntegrateWeight) if (.not. allocated(DstParamData%IntegrateWeight)) then allocate(DstParamData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1408,7 +1408,7 @@ subroutine BEMT_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1452,14 +1452,14 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%theta)) then - LB(1:2) = lbound(SrcInputData%theta, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%theta, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%theta) + UB(1:2) = ubound(SrcInputData%theta) if (.not. allocated(DstInputData%theta)) then allocate(DstInputData%theta(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1472,8 +1472,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%chi0 = SrcInputData%chi0 DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset if (allocated(SrcInputData%psi_s)) then - LB(1:1) = lbound(SrcInputData%psi_s, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%psi_s, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%psi_s) + UB(1:1) = ubound(SrcInputData%psi_s) if (.not. allocated(DstInputData%psi_s)) then allocate(DstInputData%psi_s(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1486,8 +1486,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%omega = SrcInputData%omega DstInputData%TSR = SrcInputData%TSR if (allocated(SrcInputData%Vx)) then - LB(1:2) = lbound(SrcInputData%Vx, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%Vx, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%Vx) + UB(1:2) = ubound(SrcInputData%Vx) if (.not. allocated(DstInputData%Vx)) then allocate(DstInputData%Vx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1498,8 +1498,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vx = SrcInputData%Vx end if if (allocated(SrcInputData%Vy)) then - LB(1:2) = lbound(SrcInputData%Vy, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%Vy, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%Vy) + UB(1:2) = ubound(SrcInputData%Vy) if (.not. allocated(DstInputData%Vy)) then allocate(DstInputData%Vy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1510,8 +1510,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vy = SrcInputData%Vy end if if (allocated(SrcInputData%Vz)) then - LB(1:2) = lbound(SrcInputData%Vz, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%Vz, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%Vz) + UB(1:2) = ubound(SrcInputData%Vz) if (.not. allocated(DstInputData%Vz)) then allocate(DstInputData%Vz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1522,8 +1522,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vz = SrcInputData%Vz end if if (allocated(SrcInputData%omega_z)) then - LB(1:2) = lbound(SrcInputData%omega_z, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%omega_z, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%omega_z) + UB(1:2) = ubound(SrcInputData%omega_z) if (.not. allocated(DstInputData%omega_z)) then allocate(DstInputData%omega_z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1534,8 +1534,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%omega_z = SrcInputData%omega_z end if if (allocated(SrcInputData%xVelCorr)) then - LB(1:2) = lbound(SrcInputData%xVelCorr, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%xVelCorr, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%xVelCorr) + UB(1:2) = ubound(SrcInputData%xVelCorr) if (.not. allocated(DstInputData%xVelCorr)) then allocate(DstInputData%xVelCorr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1546,8 +1546,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%xVelCorr = SrcInputData%xVelCorr end if if (allocated(SrcInputData%rLocal)) then - LB(1:2) = lbound(SrcInputData%rLocal, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%rLocal, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%rLocal) + UB(1:2) = ubound(SrcInputData%rLocal) if (.not. allocated(DstInputData%rLocal)) then allocate(DstInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1561,8 +1561,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%V0 = SrcInputData%V0 DstInputData%x_hat_disk = SrcInputData%x_hat_disk if (allocated(SrcInputData%UserProp)) then - LB(1:2) = lbound(SrcInputData%UserProp, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%UserProp, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%UserProp) + UB(1:2) = ubound(SrcInputData%UserProp) if (.not. allocated(DstInputData%UserProp)) then allocate(DstInputData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1573,8 +1573,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%UserProp = SrcInputData%UserProp end if if (allocated(SrcInputData%CantAngle)) then - LB(1:2) = lbound(SrcInputData%CantAngle, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CantAngle, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CantAngle) + UB(1:2) = ubound(SrcInputData%CantAngle) if (.not. allocated(DstInputData%CantAngle)) then allocate(DstInputData%CantAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1585,8 +1585,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CantAngle = SrcInputData%CantAngle end if if (allocated(SrcInputData%drdz)) then - LB(1:2) = lbound(SrcInputData%drdz, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%drdz, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%drdz) + UB(1:2) = ubound(SrcInputData%drdz) if (.not. allocated(DstInputData%drdz)) then allocate(DstInputData%drdz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1597,8 +1597,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%drdz = SrcInputData%drdz end if if (allocated(SrcInputData%toeAngle)) then - LB(1:2) = lbound(SrcInputData%toeAngle, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%toeAngle, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%toeAngle) + UB(1:2) = ubound(SrcInputData%toeAngle) if (.not. allocated(DstInputData%toeAngle)) then allocate(DstInputData%toeAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1686,7 +1686,7 @@ subroutine BEMT_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1717,14 +1717,14 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Vrel)) then - LB(1:2) = lbound(SrcOutputData%Vrel, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Vrel, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Vrel) + UB(1:2) = ubound(SrcOutputData%Vrel) if (.not. allocated(DstOutputData%Vrel)) then allocate(DstOutputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1735,8 +1735,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Vrel = SrcOutputData%Vrel end if if (allocated(SrcOutputData%phi)) then - LB(1:2) = lbound(SrcOutputData%phi, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%phi, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%phi) + UB(1:2) = ubound(SrcOutputData%phi) if (.not. allocated(DstOutputData%phi)) then allocate(DstOutputData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1747,8 +1747,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%phi = SrcOutputData%phi end if if (allocated(SrcOutputData%axInduction)) then - LB(1:2) = lbound(SrcOutputData%axInduction, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%axInduction, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%axInduction) + UB(1:2) = ubound(SrcOutputData%axInduction) if (.not. allocated(DstOutputData%axInduction)) then allocate(DstOutputData%axInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1759,8 +1759,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%axInduction = SrcOutputData%axInduction end if if (allocated(SrcOutputData%tanInduction)) then - LB(1:2) = lbound(SrcOutputData%tanInduction, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%tanInduction, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%tanInduction) + UB(1:2) = ubound(SrcOutputData%tanInduction) if (.not. allocated(DstOutputData%tanInduction)) then allocate(DstOutputData%tanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1771,8 +1771,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%tanInduction = SrcOutputData%tanInduction end if if (allocated(SrcOutputData%axInduction_qs)) then - LB(1:2) = lbound(SrcOutputData%axInduction_qs, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%axInduction_qs, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%axInduction_qs) + UB(1:2) = ubound(SrcOutputData%axInduction_qs) if (.not. allocated(DstOutputData%axInduction_qs)) then allocate(DstOutputData%axInduction_qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1783,8 +1783,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%axInduction_qs = SrcOutputData%axInduction_qs end if if (allocated(SrcOutputData%tanInduction_qs)) then - LB(1:2) = lbound(SrcOutputData%tanInduction_qs, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%tanInduction_qs, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%tanInduction_qs) + UB(1:2) = ubound(SrcOutputData%tanInduction_qs) if (.not. allocated(DstOutputData%tanInduction_qs)) then allocate(DstOutputData%tanInduction_qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1795,8 +1795,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%tanInduction_qs = SrcOutputData%tanInduction_qs end if if (allocated(SrcOutputData%k)) then - LB(1:2) = lbound(SrcOutputData%k, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%k, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%k) + UB(1:2) = ubound(SrcOutputData%k) if (.not. allocated(DstOutputData%k)) then allocate(DstOutputData%k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1807,8 +1807,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%k = SrcOutputData%k end if if (allocated(SrcOutputData%k_p)) then - LB(1:2) = lbound(SrcOutputData%k_p, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%k_p, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%k_p) + UB(1:2) = ubound(SrcOutputData%k_p) if (.not. allocated(DstOutputData%k_p)) then allocate(DstOutputData%k_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1819,8 +1819,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%k_p = SrcOutputData%k_p end if if (allocated(SrcOutputData%F)) then - LB(1:2) = lbound(SrcOutputData%F, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%F, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%F) + UB(1:2) = ubound(SrcOutputData%F) if (.not. allocated(DstOutputData%F)) then allocate(DstOutputData%F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1831,8 +1831,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%F = SrcOutputData%F end if if (allocated(SrcOutputData%Re)) then - LB(1:2) = lbound(SrcOutputData%Re, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Re, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Re) + UB(1:2) = ubound(SrcOutputData%Re) if (.not. allocated(DstOutputData%Re)) then allocate(DstOutputData%Re(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1843,8 +1843,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Re = SrcOutputData%Re end if if (allocated(SrcOutputData%AOA)) then - LB(1:2) = lbound(SrcOutputData%AOA, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%AOA, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%AOA) + UB(1:2) = ubound(SrcOutputData%AOA) if (.not. allocated(DstOutputData%AOA)) then allocate(DstOutputData%AOA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1855,8 +1855,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%AOA = SrcOutputData%AOA end if if (allocated(SrcOutputData%Cx)) then - LB(1:2) = lbound(SrcOutputData%Cx, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cx, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cx) + UB(1:2) = ubound(SrcOutputData%Cx) if (.not. allocated(DstOutputData%Cx)) then allocate(DstOutputData%Cx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1867,8 +1867,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cx = SrcOutputData%Cx end if if (allocated(SrcOutputData%Cy)) then - LB(1:2) = lbound(SrcOutputData%Cy, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cy, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cy) + UB(1:2) = ubound(SrcOutputData%Cy) if (.not. allocated(DstOutputData%Cy)) then allocate(DstOutputData%Cy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1879,8 +1879,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cy = SrcOutputData%Cy end if if (allocated(SrcOutputData%Cz)) then - LB(1:2) = lbound(SrcOutputData%Cz, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cz, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cz) + UB(1:2) = ubound(SrcOutputData%Cz) if (.not. allocated(DstOutputData%Cz)) then allocate(DstOutputData%Cz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1891,8 +1891,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cz = SrcOutputData%Cz end if if (allocated(SrcOutputData%Cmx)) then - LB(1:2) = lbound(SrcOutputData%Cmx, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cmx, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cmx) + UB(1:2) = ubound(SrcOutputData%Cmx) if (.not. allocated(DstOutputData%Cmx)) then allocate(DstOutputData%Cmx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1903,8 +1903,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmx = SrcOutputData%Cmx end if if (allocated(SrcOutputData%Cmy)) then - LB(1:2) = lbound(SrcOutputData%Cmy, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cmy, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cmy) + UB(1:2) = ubound(SrcOutputData%Cmy) if (.not. allocated(DstOutputData%Cmy)) then allocate(DstOutputData%Cmy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1915,8 +1915,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmy = SrcOutputData%Cmy end if if (allocated(SrcOutputData%Cmz)) then - LB(1:2) = lbound(SrcOutputData%Cmz, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cmz, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cmz) + UB(1:2) = ubound(SrcOutputData%Cmz) if (.not. allocated(DstOutputData%Cmz)) then allocate(DstOutputData%Cmz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1927,8 +1927,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmz = SrcOutputData%Cmz end if if (allocated(SrcOutputData%Cm)) then - LB(1:2) = lbound(SrcOutputData%Cm, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cm, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cm) + UB(1:2) = ubound(SrcOutputData%Cm) if (.not. allocated(DstOutputData%Cm)) then allocate(DstOutputData%Cm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1939,8 +1939,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cm = SrcOutputData%Cm end if if (allocated(SrcOutputData%Cl)) then - LB(1:2) = lbound(SrcOutputData%Cl, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cl, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cl) + UB(1:2) = ubound(SrcOutputData%Cl) if (.not. allocated(DstOutputData%Cl)) then allocate(DstOutputData%Cl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1951,8 +1951,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cl = SrcOutputData%Cl end if if (allocated(SrcOutputData%Cd)) then - LB(1:2) = lbound(SrcOutputData%Cd, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cd, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cd) + UB(1:2) = ubound(SrcOutputData%Cd) if (.not. allocated(DstOutputData%Cd)) then allocate(DstOutputData%Cd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1963,8 +1963,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cd = SrcOutputData%Cd end if if (allocated(SrcOutputData%chi)) then - LB(1:2) = lbound(SrcOutputData%chi, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%chi, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%chi) + UB(1:2) = ubound(SrcOutputData%chi) if (.not. allocated(DstOutputData%chi)) then allocate(DstOutputData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1975,8 +1975,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%chi = SrcOutputData%chi end if if (allocated(SrcOutputData%Cpmin)) then - LB(1:2) = lbound(SrcOutputData%Cpmin, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cpmin, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cpmin) + UB(1:2) = ubound(SrcOutputData%Cpmin) if (.not. allocated(DstOutputData%Cpmin)) then allocate(DstOutputData%Cpmin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2097,7 +2097,7 @@ subroutine BEMT_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/DBEMT.f90 b/modules/aerodyn/src/DBEMT.f90 index 4b8d001d08..4f5a2d6bd8 100644 --- a/modules/aerodyn/src/DBEMT.f90 +++ b/modules/aerodyn/src/DBEMT.f90 @@ -64,11 +64,9 @@ subroutine DBEMT_ValidateInitInp(interval, InitInp, errStat, errMsg) errMsg = "" if ( interval <= sqrt(epsilon(1.0_ReKi)) ) call SetErrStat( ErrID_Fatal, " The timestep size for DBEMT (interval) must be larger than sqrt(epsilon).", ErrStat, ErrMsg, RoutineName) - select case(InitInp%DBEMT_Mod) - case (DBEMT_frozen, DBEMT_tauConst, DBEMT_tauVaries, DBEMT_cont_tauConst) - case default - call SetErrStat( ErrID_Fatal, " DBEMT_Mod must be set to -1, 1, 2, or 3.", ErrStat, ErrMsg, RoutineName) - end select + if ( (InitInp%DBEMT_Mod .ne. DBEMT_tauConst) .and. (InitInp%DBEMT_Mod .ne. DBEMT_tauVaries) .and. (InitInp%DBEMT_Mod .ne. DBEMT_cont_tauConst)) then + call SetErrStat( ErrID_Fatal, " DBEMT_Mod must be set to 1, 2, or 3.", ErrStat, ErrMsg, RoutineName) + end if if (InitInp%numBlades < 1) call SetErrStat( ErrID_Fatal, " InitInp%numBlades must set to 1 or more.", ErrStat, ErrMsg, RoutineName) if (InitInp%numNodes < 2) call SetErrStat( ErrID_Fatal, " InitInp%numNodes must set to 2 or more.", ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 9a0378426a..6f50584c04 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -136,7 +136,7 @@ subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyInitInput' ErrStat = ErrID_None @@ -146,8 +146,8 @@ subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%tau1_const = SrcInitInputData%tau1_const DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod if (allocated(SrcInitInputData%rLocal)) then - LB(1:2) = lbound(SrcInitInputData%rLocal, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%rLocal, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) if (.not. allocated(DstInitInputData%rLocal)) then allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -188,7 +188,7 @@ subroutine DBEMT_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -292,16 +292,16 @@ subroutine DBEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%element)) then - LB(1:2) = lbound(SrcContStateData%element, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%element, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) if (.not. allocated(DstContStateData%element)) then allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -323,16 +323,16 @@ subroutine DBEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) type(DBEMT_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%element)) then - LB(1:2) = lbound(ContStateData%element, kind=B8Ki) - UB(1:2) = ubound(ContStateData%element, kind=B8Ki) + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) @@ -347,14 +347,14 @@ subroutine DBEMT_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(DBEMT_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackContState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) - LB(1:2) = lbound(InData%element, kind=B8Ki) - UB(1:2) = ubound(InData%element, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_PackElementContinuousStateType(RF, InData%element(i1,i2)) @@ -368,8 +368,8 @@ subroutine DBEMT_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackContState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -472,16 +472,16 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%areStatesInitialized)) then - LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized) + UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized) if (.not. allocated(DstOtherStateData%areStatesInitialized)) then allocate(DstOtherStateData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -494,8 +494,8 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%tau1 = SrcOtherStateData%tau1 DstOtherStateData%tau2 = SrcOtherStateData%tau2 if (allocated(SrcOtherStateData%n)) then - LB(1:2) = lbound(SrcOtherStateData%n, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%n, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) if (.not. allocated(DstOtherStateData%n)) then allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -505,8 +505,8 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, end if DstOtherStateData%n = SrcOtherStateData%n end if - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call DBEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -518,8 +518,8 @@ subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(DBEMT_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyOtherState' @@ -531,8 +531,8 @@ subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%n)) then deallocate(OtherStateData%n) end if - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call DBEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -543,15 +543,15 @@ subroutine DBEMT_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(DBEMT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%areStatesInitialized) call RegPack(RF, InData%tau1) call RegPack(RF, InData%tau2) call RegPackAlloc(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call DBEMT_PackContState(RF, InData%xdot(i1)) end do @@ -562,8 +562,8 @@ subroutine DBEMT_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -571,8 +571,8 @@ subroutine DBEMT_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%tau1); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%tau2); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call DBEMT_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -622,7 +622,7 @@ subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyParam' ErrStat = ErrID_None @@ -634,8 +634,8 @@ subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%k_0ye = SrcParamData%k_0ye DstParamData%tau1_const = SrcParamData%tau1_const if (allocated(SrcParamData%spanRatio)) then - LB(1:2) = lbound(SrcParamData%spanRatio, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%spanRatio, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%spanRatio) + UB(1:2) = ubound(SrcParamData%spanRatio) if (.not. allocated(DstParamData%spanRatio)) then allocate(DstParamData%spanRatio(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -680,7 +680,7 @@ subroutine DBEMT_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -741,8 +741,8 @@ subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyInput' @@ -752,8 +752,8 @@ subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%Un_disk = SrcInputData%Un_disk DstInputData%R_disk = SrcInputData%R_disk if (allocated(SrcInputData%element)) then - LB(1:2) = lbound(SrcInputData%element, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%element, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%element) + UB(1:2) = ubound(SrcInputData%element) if (.not. allocated(DstInputData%element)) then allocate(DstInputData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -775,16 +775,16 @@ subroutine DBEMT_DestroyInput(InputData, ErrStat, ErrMsg) type(DBEMT_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%element)) then - LB(1:2) = lbound(InputData%element, kind=B8Ki) - UB(1:2) = ubound(InputData%element, kind=B8Ki) + LB(1:2) = lbound(InputData%element) + UB(1:2) = ubound(InputData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_DestroyElementInputType(InputData%element(i1,i2), ErrStat2, ErrMsg2) @@ -799,17 +799,17 @@ subroutine DBEMT_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(DBEMT_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%AxInd_disk) call RegPack(RF, InData%Un_disk) call RegPack(RF, InData%R_disk) call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) - LB(1:2) = lbound(InData%element, kind=B8Ki) - UB(1:2) = ubound(InData%element, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_PackElementInputType(RF, InData%element(i1,i2)) @@ -823,8 +823,8 @@ subroutine DBEMT_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -854,14 +854,14 @@ subroutine DBEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%vind)) then - LB(1:3) = lbound(SrcOutputData%vind, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%vind, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%vind) + UB(1:3) = ubound(SrcOutputData%vind) if (.not. allocated(DstOutputData%vind)) then allocate(DstOutputData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -898,7 +898,7 @@ subroutine DBEMT_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackOutput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1168,13 +1168,13 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) - DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s END DO END DO - DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) - DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio END DO END DO @@ -1242,13 +1242,13 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + a3*u3%R_disk IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) - DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + a3*u3%element(i01,i02)%vind_s END DO END DO - DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) - DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + a3*u3%element(i01,i02)%spanRatio END DO END DO diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 548ef0d57a..65b338ebcb 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -377,7 +377,7 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyGridOutType' ErrStat = ErrID_None @@ -397,8 +397,8 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, DstGridOutTypeData%ny = SrcGridOutTypeData%ny DstGridOutTypeData%nz = SrcGridOutTypeData%nz if (allocated(SrcGridOutTypeData%uGrid)) then - LB(1:4) = lbound(SrcGridOutTypeData%uGrid, kind=B8Ki) - UB(1:4) = ubound(SrcGridOutTypeData%uGrid, kind=B8Ki) + LB(1:4) = lbound(SrcGridOutTypeData%uGrid) + UB(1:4) = ubound(SrcGridOutTypeData%uGrid) if (.not. allocated(DstGridOutTypeData%uGrid)) then allocate(DstGridOutTypeData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -409,8 +409,8 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid end if if (allocated(SrcGridOutTypeData%omGrid)) then - LB(1:4) = lbound(SrcGridOutTypeData%omGrid, kind=B8Ki) - UB(1:4) = ubound(SrcGridOutTypeData%omGrid, kind=B8Ki) + LB(1:4) = lbound(SrcGridOutTypeData%omGrid) + UB(1:4) = ubound(SrcGridOutTypeData%omGrid) if (.not. allocated(DstGridOutTypeData%omGrid)) then allocate(DstGridOutTypeData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -467,7 +467,7 @@ subroutine FVW_UnPackGridOutType(RF, OutData) type(RegFile), intent(inout) :: RF type(GridOutType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackGridOutType' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -496,14 +496,14 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyT_Sgmt' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcT_SgmtData%Points)) then - LB(1:2) = lbound(SrcT_SgmtData%Points, kind=B8Ki) - UB(1:2) = ubound(SrcT_SgmtData%Points, kind=B8Ki) + LB(1:2) = lbound(SrcT_SgmtData%Points) + UB(1:2) = ubound(SrcT_SgmtData%Points) if (.not. allocated(DstT_SgmtData%Points)) then allocate(DstT_SgmtData%Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -514,8 +514,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Points = SrcT_SgmtData%Points end if if (allocated(SrcT_SgmtData%Connct)) then - LB(1:2) = lbound(SrcT_SgmtData%Connct, kind=B8Ki) - UB(1:2) = ubound(SrcT_SgmtData%Connct, kind=B8Ki) + LB(1:2) = lbound(SrcT_SgmtData%Connct) + UB(1:2) = ubound(SrcT_SgmtData%Connct) if (.not. allocated(DstT_SgmtData%Connct)) then allocate(DstT_SgmtData%Connct(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -526,8 +526,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Connct = SrcT_SgmtData%Connct end if if (allocated(SrcT_SgmtData%Gamma)) then - LB(1:1) = lbound(SrcT_SgmtData%Gamma, kind=B8Ki) - UB(1:1) = ubound(SrcT_SgmtData%Gamma, kind=B8Ki) + LB(1:1) = lbound(SrcT_SgmtData%Gamma) + UB(1:1) = ubound(SrcT_SgmtData%Gamma) if (.not. allocated(DstT_SgmtData%Gamma)) then allocate(DstT_SgmtData%Gamma(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -538,8 +538,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma end if if (allocated(SrcT_SgmtData%Epsilon)) then - LB(1:1) = lbound(SrcT_SgmtData%Epsilon, kind=B8Ki) - UB(1:1) = ubound(SrcT_SgmtData%Epsilon, kind=B8Ki) + LB(1:1) = lbound(SrcT_SgmtData%Epsilon) + UB(1:1) = ubound(SrcT_SgmtData%Epsilon) if (.not. allocated(DstT_SgmtData%Epsilon)) then allocate(DstT_SgmtData%Epsilon(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -594,7 +594,7 @@ subroutine FVW_UnPackT_Sgmt(RF, OutData) type(RegFile), intent(inout) :: RF type(T_Sgmt), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackT_Sgmt' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -613,14 +613,14 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyT_Part' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcT_PartData%P)) then - LB(1:2) = lbound(SrcT_PartData%P, kind=B8Ki) - UB(1:2) = ubound(SrcT_PartData%P, kind=B8Ki) + LB(1:2) = lbound(SrcT_PartData%P) + UB(1:2) = ubound(SrcT_PartData%P) if (.not. allocated(DstT_PartData%P)) then allocate(DstT_PartData%P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -631,8 +631,8 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs DstT_PartData%P = SrcT_PartData%P end if if (allocated(SrcT_PartData%Alpha)) then - LB(1:2) = lbound(SrcT_PartData%Alpha, kind=B8Ki) - UB(1:2) = ubound(SrcT_PartData%Alpha, kind=B8Ki) + LB(1:2) = lbound(SrcT_PartData%Alpha) + UB(1:2) = ubound(SrcT_PartData%Alpha) if (.not. allocated(DstT_PartData%Alpha)) then allocate(DstT_PartData%Alpha(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -643,8 +643,8 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs DstT_PartData%Alpha = SrcT_PartData%Alpha end if if (allocated(SrcT_PartData%RegParam)) then - LB(1:1) = lbound(SrcT_PartData%RegParam, kind=B8Ki) - UB(1:1) = ubound(SrcT_PartData%RegParam, kind=B8Ki) + LB(1:1) = lbound(SrcT_PartData%RegParam) + UB(1:1) = ubound(SrcT_PartData%RegParam) if (.not. allocated(DstT_PartData%RegParam)) then allocate(DstT_PartData%RegParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -693,7 +693,7 @@ subroutine FVW_UnPackT_Part(RF, OutData) type(RegFile), intent(inout) :: RF type(T_Part), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackT_Part' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -710,14 +710,14 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ParameterType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ParameterTypeData%chord_LL)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL) if (.not. allocated(DstWng_ParameterTypeData%chord_LL)) then allocate(DstWng_ParameterTypeData%chord_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -728,8 +728,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL end if if (allocated(SrcWng_ParameterTypeData%chord_CP)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP) if (.not. allocated(DstWng_ParameterTypeData%chord_CP)) then allocate(DstWng_ParameterTypeData%chord_CP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -740,8 +740,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP end if if (allocated(SrcWng_ParameterTypeData%s_LL)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL) if (.not. allocated(DstWng_ParameterTypeData%s_LL)) then allocate(DstWng_ParameterTypeData%s_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -752,8 +752,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL end if if (allocated(SrcWng_ParameterTypeData%s_CP)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP) if (.not. allocated(DstWng_ParameterTypeData%s_CP)) then allocate(DstWng_ParameterTypeData%s_CP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -765,8 +765,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor if (allocated(SrcWng_ParameterTypeData%AFindx)) then - LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx, kind=B8Ki) - UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx, kind=B8Ki) + LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx) + UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx) if (.not. allocated(DstWng_ParameterTypeData%AFindx)) then allocate(DstWng_ParameterTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -778,8 +778,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan if (allocated(SrcWng_ParameterTypeData%PrescribedCirculation)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation) + UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation) if (.not. allocated(DstWng_ParameterTypeData%PrescribedCirculation)) then allocate(DstWng_ParameterTypeData%PrescribedCirculation(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -838,7 +838,7 @@ subroutine FVW_UnPackWng_ParameterType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ParameterType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -858,8 +858,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyParam' @@ -868,8 +868,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nRotors = SrcParamData%nRotors DstParamData%nWings = SrcParamData%nWings if (allocated(SrcParamData%W)) then - LB(1:1) = lbound(SrcParamData%W, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%W, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%W) + UB(1:1) = ubound(SrcParamData%W) if (.not. allocated(DstParamData%W)) then allocate(DstParamData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -884,8 +884,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%Bld2Wings)) then - LB(1:2) = lbound(SrcParamData%Bld2Wings, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Bld2Wings, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Bld2Wings) + UB(1:2) = ubound(SrcParamData%Bld2Wings) if (.not. allocated(DstParamData%Bld2Wings)) then allocate(DstParamData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -946,16 +946,16 @@ subroutine FVW_DestroyParam(ParamData, ErrStat, ErrMsg) type(FVW_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%W)) then - LB(1:1) = lbound(ParamData%W, kind=B8Ki) - UB(1:1) = ubound(ParamData%W, kind=B8Ki) + LB(1:1) = lbound(ParamData%W) + UB(1:1) = ubound(ParamData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_ParameterType(ParamData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -971,16 +971,16 @@ subroutine FVW_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%nRotors) call RegPack(RF, InData%nWings) call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_ParameterType(RF, InData%W(i1)) end do @@ -1038,8 +1038,8 @@ subroutine FVW_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1112,14 +1112,14 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ContinuousStateType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ContinuousStateTypeData%Gamma_NW)) then - LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW, kind=B8Ki) - UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW, kind=B8Ki) + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW) if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_NW)) then allocate(DstWng_ContinuousStateTypeData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1130,8 +1130,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW end if if (allocated(SrcWng_ContinuousStateTypeData%Gamma_FW)) then - LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW, kind=B8Ki) - UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW, kind=B8Ki) + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW) if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_FW)) then allocate(DstWng_ContinuousStateTypeData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1142,8 +1142,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW end if if (allocated(SrcWng_ContinuousStateTypeData%Eps_NW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW) if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_NW)) then allocate(DstWng_ContinuousStateTypeData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1154,8 +1154,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW end if if (allocated(SrcWng_ContinuousStateTypeData%Eps_FW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW) if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_FW)) then allocate(DstWng_ContinuousStateTypeData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1166,8 +1166,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW end if if (allocated(SrcWng_ContinuousStateTypeData%r_NW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW) if (.not. allocated(DstWng_ContinuousStateTypeData%r_NW)) then allocate(DstWng_ContinuousStateTypeData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1178,8 +1178,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW end if if (allocated(SrcWng_ContinuousStateTypeData%r_FW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW) if (.not. allocated(DstWng_ContinuousStateTypeData%r_FW)) then allocate(DstWng_ContinuousStateTypeData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1236,7 +1236,7 @@ subroutine FVW_UnPackWng_ContinuousStateType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1254,16 +1254,16 @@ subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%W)) then - LB(1:1) = lbound(SrcContStateData%W, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%W, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%W) + UB(1:1) = ubound(SrcContStateData%W) if (.not. allocated(DstContStateData%W)) then allocate(DstContStateData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1278,8 +1278,8 @@ subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt end do end if if (allocated(SrcContStateData%UA)) then - LB(1:1) = lbound(SrcContStateData%UA, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%UA, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%UA) + UB(1:1) = ubound(SrcContStateData%UA) if (.not. allocated(DstContStateData%UA)) then allocate(DstContStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1299,16 +1299,16 @@ subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) type(FVW_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%W)) then - LB(1:1) = lbound(ContStateData%W, kind=B8Ki) - UB(1:1) = ubound(ContStateData%W, kind=B8Ki) + LB(1:1) = lbound(ContStateData%W) + UB(1:1) = ubound(ContStateData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_ContinuousStateType(ContStateData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1316,8 +1316,8 @@ subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%W) end if if (allocated(ContStateData%UA)) then - LB(1:1) = lbound(ContStateData%UA, kind=B8Ki) - UB(1:1) = ubound(ContStateData%UA, kind=B8Ki) + LB(1:1) = lbound(ContStateData%UA) + UB(1:1) = ubound(ContStateData%UA) do i1 = LB(1), UB(1) call UA_DestroyContState(ContStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1330,23 +1330,23 @@ subroutine FVW_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_ContinuousStateType(RF, InData%W(i1)) end do end if call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) - LB(1:1) = lbound(InData%UA, kind=B8Ki) - UB(1:1) = ubound(InData%UA, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) do i1 = LB(1), UB(1) call UA_PackContState(RF, InData%UA(i1)) end do @@ -1358,8 +1358,8 @@ subroutine FVW_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1397,14 +1397,14 @@ subroutine FVW_CopyWng_OutputType(SrcWng_OutputTypeData, DstWng_OutputTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_OutputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_OutputTypeData%Vind)) then - LB(1:2) = lbound(SrcWng_OutputTypeData%Vind, kind=B8Ki) - UB(1:2) = ubound(SrcWng_OutputTypeData%Vind, kind=B8Ki) + LB(1:2) = lbound(SrcWng_OutputTypeData%Vind) + UB(1:2) = ubound(SrcWng_OutputTypeData%Vind) if (.not. allocated(DstWng_OutputTypeData%Vind)) then allocate(DstWng_OutputTypeData%Vind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1441,7 +1441,7 @@ subroutine FVW_UnPackWng_OutputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_OutputType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1454,16 +1454,16 @@ subroutine FVW_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%W)) then - LB(1:1) = lbound(SrcOutputData%W, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%W, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%W) + UB(1:1) = ubound(SrcOutputData%W) if (.not. allocated(DstOutputData%W)) then allocate(DstOutputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1483,16 +1483,16 @@ subroutine FVW_DestroyOutput(OutputData, ErrStat, ErrMsg) type(FVW_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%W)) then - LB(1:1) = lbound(OutputData%W, kind=B8Ki) - UB(1:1) = ubound(OutputData%W, kind=B8Ki) + LB(1:1) = lbound(OutputData%W) + UB(1:1) = ubound(OutputData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_OutputType(OutputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1505,14 +1505,14 @@ subroutine FVW_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_OutputType(RF, InData%W(i1)) end do @@ -1524,8 +1524,8 @@ subroutine FVW_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1550,16 +1550,16 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyWng_MiscVarType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_MiscVarTypeData%LE)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE) if (.not. allocated(DstWng_MiscVarTypeData%LE)) then allocate(DstWng_MiscVarTypeData%LE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1570,8 +1570,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE end if if (allocated(SrcWng_MiscVarTypeData%TE)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE) if (.not. allocated(DstWng_MiscVarTypeData%TE)) then allocate(DstWng_MiscVarTypeData%TE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1582,8 +1582,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE end if if (allocated(SrcWng_MiscVarTypeData%r_LL)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL) if (.not. allocated(DstWng_MiscVarTypeData%r_LL)) then allocate(DstWng_MiscVarTypeData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1594,8 +1594,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL end if if (allocated(SrcWng_MiscVarTypeData%CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP) if (.not. allocated(DstWng_MiscVarTypeData%CP)) then allocate(DstWng_MiscVarTypeData%CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1606,8 +1606,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP end if if (allocated(SrcWng_MiscVarTypeData%Tang)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang) if (.not. allocated(DstWng_MiscVarTypeData%Tang)) then allocate(DstWng_MiscVarTypeData%Tang(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1618,8 +1618,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang end if if (allocated(SrcWng_MiscVarTypeData%Norm)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm) if (.not. allocated(DstWng_MiscVarTypeData%Norm)) then allocate(DstWng_MiscVarTypeData%Norm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1630,8 +1630,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm end if if (allocated(SrcWng_MiscVarTypeData%Orth)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth) if (.not. allocated(DstWng_MiscVarTypeData%Orth)) then allocate(DstWng_MiscVarTypeData%Orth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1642,8 +1642,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth end if if (allocated(SrcWng_MiscVarTypeData%dl)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl) if (.not. allocated(DstWng_MiscVarTypeData%dl)) then allocate(DstWng_MiscVarTypeData%dl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1654,8 +1654,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl end if if (allocated(SrcWng_MiscVarTypeData%Area)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area) if (.not. allocated(DstWng_MiscVarTypeData%Area)) then allocate(DstWng_MiscVarTypeData%Area(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1666,8 +1666,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area end if if (allocated(SrcWng_MiscVarTypeData%diag_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL) if (.not. allocated(DstWng_MiscVarTypeData%diag_LL)) then allocate(DstWng_MiscVarTypeData%diag_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1678,8 +1678,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL end if if (allocated(SrcWng_MiscVarTypeData%Vind_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP) if (.not. allocated(DstWng_MiscVarTypeData%Vind_CP)) then allocate(DstWng_MiscVarTypeData%Vind_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1690,8 +1690,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP end if if (allocated(SrcWng_MiscVarTypeData%Vtot_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP) if (.not. allocated(DstWng_MiscVarTypeData%Vtot_CP)) then allocate(DstWng_MiscVarTypeData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1702,8 +1702,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP end if if (allocated(SrcWng_MiscVarTypeData%Vstr_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP) if (.not. allocated(DstWng_MiscVarTypeData%Vstr_CP)) then allocate(DstWng_MiscVarTypeData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1714,8 +1714,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_CP)) then allocate(DstWng_MiscVarTypeData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1726,8 +1726,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_NW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_NW)) then allocate(DstWng_MiscVarTypeData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1738,8 +1738,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_FW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_FW)) then allocate(DstWng_MiscVarTypeData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1750,8 +1750,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW end if if (allocated(SrcWng_MiscVarTypeData%Vind_NW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW) if (.not. allocated(DstWng_MiscVarTypeData%Vind_NW)) then allocate(DstWng_MiscVarTypeData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1762,8 +1762,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW end if if (allocated(SrcWng_MiscVarTypeData%Vind_FW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW) if (.not. allocated(DstWng_MiscVarTypeData%Vind_FW)) then allocate(DstWng_MiscVarTypeData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1774,8 +1774,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW end if if (allocated(SrcWng_MiscVarTypeData%PitchAndTwist)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist) if (.not. allocated(DstWng_MiscVarTypeData%PitchAndTwist)) then allocate(DstWng_MiscVarTypeData%PitchAndTwist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1788,8 +1788,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot if (allocated(SrcWng_MiscVarTypeData%alpha_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL) if (.not. allocated(DstWng_MiscVarTypeData%alpha_LL)) then allocate(DstWng_MiscVarTypeData%alpha_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1800,8 +1800,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL end if if (allocated(SrcWng_MiscVarTypeData%Vreln_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL) if (.not. allocated(DstWng_MiscVarTypeData%Vreln_LL)) then allocate(DstWng_MiscVarTypeData%Vreln_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1812,8 +1812,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL end if if (allocated(SrcWng_MiscVarTypeData%u_UA)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA) if (.not. allocated(DstWng_MiscVarTypeData%u_UA)) then allocate(DstWng_MiscVarTypeData%u_UA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1839,8 +1839,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcWng_MiscVarTypeData%Vind_LL)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL) if (.not. allocated(DstWng_MiscVarTypeData%Vind_LL)) then allocate(DstWng_MiscVarTypeData%Vind_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1851,8 +1851,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL end if if (allocated(SrcWng_MiscVarTypeData%BN_AxInd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd) if (.not. allocated(DstWng_MiscVarTypeData%BN_AxInd)) then allocate(DstWng_MiscVarTypeData%BN_AxInd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1863,8 +1863,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd end if if (allocated(SrcWng_MiscVarTypeData%BN_TanInd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd) if (.not. allocated(DstWng_MiscVarTypeData%BN_TanInd)) then allocate(DstWng_MiscVarTypeData%BN_TanInd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1875,8 +1875,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd end if if (allocated(SrcWng_MiscVarTypeData%BN_Vrel)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel) if (.not. allocated(DstWng_MiscVarTypeData%BN_Vrel)) then allocate(DstWng_MiscVarTypeData%BN_Vrel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1887,8 +1887,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel end if if (allocated(SrcWng_MiscVarTypeData%BN_alpha)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha) if (.not. allocated(DstWng_MiscVarTypeData%BN_alpha)) then allocate(DstWng_MiscVarTypeData%BN_alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1899,8 +1899,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha end if if (allocated(SrcWng_MiscVarTypeData%BN_phi)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi) if (.not. allocated(DstWng_MiscVarTypeData%BN_phi)) then allocate(DstWng_MiscVarTypeData%BN_phi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1911,8 +1911,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi end if if (allocated(SrcWng_MiscVarTypeData%BN_Re)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re) if (.not. allocated(DstWng_MiscVarTypeData%BN_Re)) then allocate(DstWng_MiscVarTypeData%BN_Re(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1923,8 +1923,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re end if if (allocated(SrcWng_MiscVarTypeData%BN_URelWind_s)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s) if (.not. allocated(DstWng_MiscVarTypeData%BN_URelWind_s)) then allocate(DstWng_MiscVarTypeData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1935,8 +1935,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s end if if (allocated(SrcWng_MiscVarTypeData%BN_Cl_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cl_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1947,8 +1947,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cd_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cd_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1959,8 +1959,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cm_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cm_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1971,8 +1971,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cpmin)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cpmin)) then allocate(DstWng_MiscVarTypeData%BN_Cpmin(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1983,8 +1983,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin end if if (allocated(SrcWng_MiscVarTypeData%BN_Cl)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl)) then allocate(DstWng_MiscVarTypeData%BN_Cl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1995,8 +1995,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl end if if (allocated(SrcWng_MiscVarTypeData%BN_Cd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd)) then allocate(DstWng_MiscVarTypeData%BN_Cd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2007,8 +2007,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd end if if (allocated(SrcWng_MiscVarTypeData%BN_Cm)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm)) then allocate(DstWng_MiscVarTypeData%BN_Cm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2019,8 +2019,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm end if if (allocated(SrcWng_MiscVarTypeData%BN_Cx)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cx)) then allocate(DstWng_MiscVarTypeData%BN_Cx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2031,8 +2031,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx end if if (allocated(SrcWng_MiscVarTypeData%BN_Cy)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cy)) then allocate(DstWng_MiscVarTypeData%BN_Cy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2048,8 +2048,8 @@ subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) type(Wng_MiscVarType), intent(inout) :: Wng_MiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyWng_MiscVarType' @@ -2119,8 +2119,8 @@ subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) deallocate(Wng_MiscVarTypeData%Vreln_LL) end if if (allocated(Wng_MiscVarTypeData%u_UA)) then - LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA, kind=B8Ki) - UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA, kind=B8Ki) + LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_DestroyInput(Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2) @@ -2192,8 +2192,8 @@ subroutine FVW_PackWng_MiscVarType(RF, Indata) type(RegFile), intent(inout) :: RF type(Wng_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_MiscVarType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%LE) call RegPackAlloc(RF, InData%TE) @@ -2220,9 +2220,9 @@ subroutine FVW_PackWng_MiscVarType(RF, Indata) call RegPackAlloc(RF, InData%Vreln_LL) call RegPack(RF, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then - call RegPackBounds(RF, 2, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) - LB(1:2) = lbound(InData%u_UA, kind=B8Ki) - UB(1:2) = ubound(InData%u_UA, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:2) = lbound(InData%u_UA) + UB(1:2) = ubound(InData%u_UA) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_PackInput(RF, InData%u_UA(i1,i2)) @@ -2256,8 +2256,8 @@ subroutine FVW_UnPackWng_MiscVarType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_MiscVarType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2327,16 +2327,16 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%W)) then - LB(1:1) = lbound(SrcMiscData%W, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%W, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%W) + UB(1:1) = ubound(SrcMiscData%W) if (.not. allocated(DstMiscData%W)) then allocate(DstMiscData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2357,8 +2357,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%VTKstep = SrcMiscData%VTKstep DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime if (allocated(SrcMiscData%r_wind)) then - LB(1:2) = lbound(SrcMiscData%r_wind, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%r_wind, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%r_wind) + UB(1:2) = ubound(SrcMiscData%r_wind) if (.not. allocated(DstMiscData%r_wind)) then allocate(DstMiscData%r_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2389,8 +2389,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%CPs)) then - LB(1:2) = lbound(SrcMiscData%CPs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CPs, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%CPs) + UB(1:2) = ubound(SrcMiscData%CPs) if (.not. allocated(DstMiscData%CPs)) then allocate(DstMiscData%CPs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2401,8 +2401,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CPs = SrcMiscData%CPs end if if (allocated(SrcMiscData%Uind)) then - LB(1:2) = lbound(SrcMiscData%Uind, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Uind, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%Uind) + UB(1:2) = ubound(SrcMiscData%Uind) if (.not. allocated(DstMiscData%Uind)) then allocate(DstMiscData%Uind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2413,8 +2413,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Uind = SrcMiscData%Uind end if if (allocated(SrcMiscData%GridOutputs)) then - LB(1:1) = lbound(SrcMiscData%GridOutputs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%GridOutputs, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%GridOutputs) + UB(1:1) = ubound(SrcMiscData%GridOutputs) if (.not. allocated(DstMiscData%GridOutputs)) then allocate(DstMiscData%GridOutputs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2435,16 +2435,16 @@ subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) type(FVW_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(MiscData%W)) then - LB(1:1) = lbound(MiscData%W, kind=B8Ki) - UB(1:1) = ubound(MiscData%W, kind=B8Ki) + LB(1:1) = lbound(MiscData%W) + UB(1:1) = ubound(MiscData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_MiscVarType(MiscData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2471,8 +2471,8 @@ subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Uind) end if if (allocated(MiscData%GridOutputs)) then - LB(1:1) = lbound(MiscData%GridOutputs, kind=B8Ki) - UB(1:1) = ubound(MiscData%GridOutputs, kind=B8Ki) + LB(1:1) = lbound(MiscData%GridOutputs) + UB(1:1) = ubound(MiscData%GridOutputs) do i1 = LB(1), UB(1) call FVW_DestroyGridOutType(MiscData%GridOutputs(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2485,14 +2485,14 @@ subroutine FVW_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_MiscVarType(RF, InData%W(i1)) end do @@ -2518,9 +2518,9 @@ subroutine FVW_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%Uind) call RegPack(RF, allocated(InData%GridOutputs)) if (allocated(InData%GridOutputs)) then - call RegPackBounds(RF, 1, lbound(InData%GridOutputs, kind=B8Ki), ubound(InData%GridOutputs, kind=B8Ki)) - LB(1:1) = lbound(InData%GridOutputs, kind=B8Ki) - UB(1:1) = ubound(InData%GridOutputs, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%GridOutputs), ubound(InData%GridOutputs)) + LB(1:1) = lbound(InData%GridOutputs) + UB(1:1) = ubound(InData%GridOutputs) do i1 = LB(1), UB(1) call FVW_PackGridOutType(RF, InData%GridOutputs(i1)) end do @@ -2533,8 +2533,8 @@ subroutine FVW_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2633,14 +2633,14 @@ subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, Ctr integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_InputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_InputTypeData%Vwnd_LL)) then - LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL, kind=B8Ki) - UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL, kind=B8Ki) + LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL) + UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL) if (.not. allocated(DstWng_InputTypeData%Vwnd_LL)) then allocate(DstWng_InputTypeData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2651,8 +2651,8 @@ subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, Ctr DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL end if if (allocated(SrcWng_InputTypeData%omega_z)) then - LB(1:1) = lbound(SrcWng_InputTypeData%omega_z, kind=B8Ki) - UB(1:1) = ubound(SrcWng_InputTypeData%omega_z, kind=B8Ki) + LB(1:1) = lbound(SrcWng_InputTypeData%omega_z) + UB(1:1) = ubound(SrcWng_InputTypeData%omega_z) if (.not. allocated(DstWng_InputTypeData%omega_z)) then allocate(DstWng_InputTypeData%omega_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2693,7 +2693,7 @@ subroutine FVW_UnPackWng_InputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_InputType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2707,16 +2707,16 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%rotors)) then - LB(1:1) = lbound(SrcInputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) if (.not. allocated(DstInputData%rotors)) then allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2731,8 +2731,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%W)) then - LB(1:1) = lbound(SrcInputData%W, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%W, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%W) + UB(1:1) = ubound(SrcInputData%W) if (.not. allocated(DstInputData%W)) then allocate(DstInputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2747,8 +2747,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%WingsMesh)) then - LB(1:1) = lbound(SrcInputData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%WingsMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%WingsMesh) + UB(1:1) = ubound(SrcInputData%WingsMesh) if (.not. allocated(DstInputData%WingsMesh)) then allocate(DstInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2763,8 +2763,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%V_wind)) then - LB(1:2) = lbound(SrcInputData%V_wind, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%V_wind, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%V_wind) + UB(1:2) = ubound(SrcInputData%V_wind) if (.not. allocated(DstInputData%V_wind)) then allocate(DstInputData%V_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2780,16 +2780,16 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) type(FVW_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%rotors)) then - LB(1:1) = lbound(InputData%rotors, kind=B8Ki) - UB(1:1) = ubound(InputData%rotors, kind=B8Ki) + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) do i1 = LB(1), UB(1) call FVW_DestroyRot_InputType(InputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2797,8 +2797,8 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%rotors) end if if (allocated(InputData%W)) then - LB(1:1) = lbound(InputData%W, kind=B8Ki) - UB(1:1) = ubound(InputData%W, kind=B8Ki) + LB(1:1) = lbound(InputData%W) + UB(1:1) = ubound(InputData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_InputType(InputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2806,8 +2806,8 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%W) end if if (allocated(InputData%WingsMesh)) then - LB(1:1) = lbound(InputData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(InputData%WingsMesh, kind=B8Ki) + LB(1:1) = lbound(InputData%WingsMesh) + UB(1:1) = ubound(InputData%WingsMesh) do i1 = LB(1), UB(1) call MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2823,32 +2823,32 @@ subroutine FVW_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) call FVW_PackRot_InputType(RF, InData%rotors(i1)) end do end if call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_InputType(RF, InData%W(i1)) end do end if call RegPack(RF, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%WingsMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%WingsMesh(i1)) end do @@ -2861,8 +2861,8 @@ subroutine FVW_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2914,8 +2914,8 @@ subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyDiscState' @@ -2923,8 +2923,8 @@ subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ErrMsg = '' DstDiscStateData%Dummy = SrcDiscStateData%Dummy if (allocated(SrcDiscStateData%UA)) then - LB(1:1) = lbound(SrcDiscStateData%UA, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%UA, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%UA) + UB(1:1) = ubound(SrcDiscStateData%UA) if (.not. allocated(DstDiscStateData%UA)) then allocate(DstDiscStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2944,16 +2944,16 @@ subroutine FVW_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(FVW_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%UA)) then - LB(1:1) = lbound(DiscStateData%UA, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%UA, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%UA) + UB(1:1) = ubound(DiscStateData%UA) do i1 = LB(1), UB(1) call UA_DestroyDiscState(DiscStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2966,15 +2966,15 @@ subroutine FVW_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Dummy) call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) - LB(1:1) = lbound(InData%UA, kind=B8Ki) - UB(1:1) = ubound(InData%UA, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) do i1 = LB(1), UB(1) call UA_PackDiscState(RF, InData%UA(i1)) end do @@ -2986,8 +2986,8 @@ subroutine FVW_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3013,14 +3013,14 @@ subroutine FVW_CopyWng_ConstraintStateType(SrcWng_ConstraintStateTypeData, DstWn integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ConstraintStateType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ConstraintStateTypeData%Gamma_LL)) then - LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL) + UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL) if (.not. allocated(DstWng_ConstraintStateTypeData%Gamma_LL)) then allocate(DstWng_ConstraintStateTypeData%Gamma_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3057,7 +3057,7 @@ subroutine FVW_UnPackWng_ConstraintStateType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3070,16 +3070,16 @@ subroutine FVW_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%W)) then - LB(1:1) = lbound(SrcConstrStateData%W, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%W, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%W) + UB(1:1) = ubound(SrcConstrStateData%W) if (.not. allocated(DstConstrStateData%W)) then allocate(DstConstrStateData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3100,16 +3100,16 @@ subroutine FVW_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(FVW_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%W)) then - LB(1:1) = lbound(ConstrStateData%W, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%W, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%W) + UB(1:1) = ubound(ConstrStateData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_ConstraintStateType(ConstrStateData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3122,14 +3122,14 @@ subroutine FVW_PackConstrState(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_ConstraintStateType(RF, InData%W(i1)) end do @@ -3142,8 +3142,8 @@ subroutine FVW_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3169,8 +3169,8 @@ subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyOtherState' @@ -3178,8 +3178,8 @@ subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er ErrMsg = '' DstOtherStateData%Dummy = SrcOtherStateData%Dummy if (allocated(SrcOtherStateData%UA)) then - LB(1:1) = lbound(SrcOtherStateData%UA, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%UA, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%UA) + UB(1:1) = ubound(SrcOtherStateData%UA) if (.not. allocated(DstOtherStateData%UA)) then allocate(DstOtherStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3199,16 +3199,16 @@ subroutine FVW_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(FVW_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%UA)) then - LB(1:1) = lbound(OtherStateData%UA, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%UA, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%UA) + UB(1:1) = ubound(OtherStateData%UA) do i1 = LB(1), UB(1) call UA_DestroyOtherState(OtherStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3221,15 +3221,15 @@ subroutine FVW_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Dummy) call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) - LB(1:1) = lbound(InData%UA, kind=B8Ki) - UB(1:1) = ubound(InData%UA, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) do i1 = LB(1), UB(1) call UA_PackOtherState(RF, InData%UA(i1)) end do @@ -3241,8 +3241,8 @@ subroutine FVW_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3268,14 +3268,14 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_InitInputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_InitInputTypeData%AFindx)) then - LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx, kind=B8Ki) - UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx, kind=B8Ki) + LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx) + UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx) if (.not. allocated(DstWng_InitInputTypeData%AFindx)) then allocate(DstWng_InitInputTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3286,8 +3286,8 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx end if if (allocated(SrcWng_InitInputTypeData%chord)) then - LB(1:1) = lbound(SrcWng_InitInputTypeData%chord, kind=B8Ki) - UB(1:1) = ubound(SrcWng_InitInputTypeData%chord, kind=B8Ki) + LB(1:1) = lbound(SrcWng_InitInputTypeData%chord) + UB(1:1) = ubound(SrcWng_InitInputTypeData%chord) if (.not. allocated(DstWng_InitInputTypeData%chord)) then allocate(DstWng_InitInputTypeData%chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3298,8 +3298,8 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord end if if (allocated(SrcWng_InitInputTypeData%RElm)) then - LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm, kind=B8Ki) - UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm, kind=B8Ki) + LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm) + UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm) if (.not. allocated(DstWng_InitInputTypeData%RElm)) then allocate(DstWng_InitInputTypeData%RElm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3350,7 +3350,7 @@ subroutine FVW_UnPackWng_InitInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_InitInputType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3368,8 +3368,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyInitInput' @@ -3378,8 +3378,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%W)) then - LB(1:1) = lbound(SrcInitInputData%W, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%W, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%W) + UB(1:1) = ubound(SrcInitInputData%W) if (.not. allocated(DstInitInputData%W)) then allocate(DstInitInputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3394,8 +3394,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt end do end if if (allocated(SrcInitInputData%WingsMesh)) then - LB(1:1) = lbound(SrcInitInputData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WingsMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WingsMesh) + UB(1:1) = ubound(SrcInitInputData%WingsMesh) if (.not. allocated(DstInitInputData%WingsMesh)) then allocate(DstInitInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3424,16 +3424,16 @@ subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(FVW_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%W)) then - LB(1:1) = lbound(InitInputData%W, kind=B8Ki) - UB(1:1) = ubound(InitInputData%W, kind=B8Ki) + LB(1:1) = lbound(InitInputData%W) + UB(1:1) = ubound(InitInputData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_InitInputType(InitInputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3441,8 +3441,8 @@ subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%W) end if if (allocated(InitInputData%WingsMesh)) then - LB(1:1) = lbound(InitInputData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(InitInputData%WingsMesh, kind=B8Ki) + LB(1:1) = lbound(InitInputData%WingsMesh) + UB(1:1) = ubound(InitInputData%WingsMesh) do i1 = LB(1), UB(1) call MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3457,25 +3457,25 @@ subroutine FVW_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%FVWFileName) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_InitInputType(RF, InData%W(i1)) end do end if call RegPack(RF, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%WingsMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%WingsMesh(i1)) end do @@ -3494,8 +3494,8 @@ subroutine FVW_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3805,27 +3805,27 @@ SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition END DO END IF ! check if allocated IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z END IF ! check if allocated END DO END IF ! check if allocated IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1, kind=B8Ki),UBOUND(u_out%WingsMesh,1, kind=B8Ki) + do i1 = lbound(u_out%WingsMesh,1),ubound(u_out%WingsMesh,1) CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -3893,27 +3893,27 @@ SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + a3*u3%rotors(i01)%HubOrientation END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + a3*u3%rotors(i01)%HubPosition END DO END IF ! check if allocated IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + a3*u3%W(i01)%Vwnd_LL END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + a3*u3%W(i01)%omega_z END IF ! check if allocated END DO END IF ! check if allocated IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1, kind=B8Ki),UBOUND(u_out%WingsMesh,1, kind=B8Ki) + do i1 = lbound(u_out%WingsMesh,1),ubound(u_out%WingsMesh,1) CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4023,7 +4023,7 @@ SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1, kind=B8Ki),UBOUND(y_out%W,1, kind=B8Ki) + do i01 = lbound(y_out%W,1),ubound(y_out%W,1) IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind END IF ! check if allocated @@ -4089,7 +4089,7 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1, kind=B8Ki),UBOUND(y_out%W,1, kind=B8Ki) + do i01 = lbound(y_out%W,1),ubound(y_out%W,1) IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + a3*y3%W(i01)%Vind END IF ! check if allocated diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index c2ea24c9af..5d1773010d 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -272,7 +272,7 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyInitInput' ErrStat = ErrID_None @@ -280,8 +280,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%dt = SrcInitInputData%dt DstInitInputData%OutRootName = SrcInitInputData%OutRootName if (allocated(SrcInitInputData%c)) then - LB(1:2) = lbound(SrcInitInputData%c, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%c, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%c) + UB(1:2) = ubound(SrcInitInputData%c) if (.not. allocated(DstInitInputData%c)) then allocate(DstInitInputData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -300,8 +300,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect DstInitInputData%WrSum = SrcInitInputData%WrSum if (allocated(SrcInitInputData%UAOff_innerNode)) then - LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) if (.not. allocated(DstInitInputData%UAOff_innerNode)) then allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -312,8 +312,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode end if if (allocated(SrcInitInputData%UAOff_outerNode)) then - LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) if (.not. allocated(DstInitInputData%UAOff_outerNode)) then allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -372,7 +372,7 @@ subroutine UA_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -399,7 +399,7 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyInitOutput' @@ -409,8 +409,8 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -421,8 +421,8 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -468,7 +468,7 @@ subroutine UA_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -709,16 +709,16 @@ subroutine UA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%element)) then - LB(1:2) = lbound(SrcContStateData%element, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%element, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) if (.not. allocated(DstContStateData%element)) then allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -740,16 +740,16 @@ subroutine UA_DestroyContState(ContStateData, ErrStat, ErrMsg) type(UA_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%element)) then - LB(1:2) = lbound(ContStateData%element, kind=B8Ki) - UB(1:2) = ubound(ContStateData%element, kind=B8Ki) + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) @@ -764,14 +764,14 @@ subroutine UA_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(UA_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackContState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) - LB(1:2) = lbound(InData%element, kind=B8Ki) - UB(1:2) = ubound(InData%element, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_PackElementContinuousStateType(RF, InData%element(i1,i2)) @@ -785,8 +785,8 @@ subroutine UA_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackContState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -813,14 +813,14 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%alpha_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alpha_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_minus1) if (.not. allocated(DstDiscStateData%alpha_minus1)) then allocate(DstDiscStateData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -831,8 +831,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 end if if (allocated(SrcDiscStateData%alpha_filt_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1) if (.not. allocated(DstDiscStateData%alpha_filt_minus1)) then allocate(DstDiscStateData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -843,8 +843,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 end if if (allocated(SrcDiscStateData%alpha_dot)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_dot, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alpha_dot, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alpha_dot) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot) if (.not. allocated(DstDiscStateData%alpha_dot)) then allocate(DstDiscStateData%alpha_dot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -855,8 +855,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot end if if (allocated(SrcDiscStateData%alpha_dot_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1) if (.not. allocated(DstDiscStateData%alpha_dot_minus1)) then allocate(DstDiscStateData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -867,8 +867,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 end if if (allocated(SrcDiscStateData%q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%q_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%q_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%q_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_minus1) if (.not. allocated(DstDiscStateData%q_minus1)) then allocate(DstDiscStateData%q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -879,8 +879,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 end if if (allocated(SrcDiscStateData%Kalpha_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1) if (.not. allocated(DstDiscStateData%Kalpha_f_minus1)) then allocate(DstDiscStateData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -891,8 +891,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 end if if (allocated(SrcDiscStateData%Kq_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1) if (.not. allocated(DstDiscStateData%Kq_f_minus1)) then allocate(DstDiscStateData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -903,8 +903,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 end if if (allocated(SrcDiscStateData%q_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%q_f_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%q_f_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%q_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_f_minus1) if (.not. allocated(DstDiscStateData%q_f_minus1)) then allocate(DstDiscStateData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -915,8 +915,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 end if if (allocated(SrcDiscStateData%X1_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X1_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%X1_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%X1_minus1) + UB(1:2) = ubound(SrcDiscStateData%X1_minus1) if (.not. allocated(DstDiscStateData%X1_minus1)) then allocate(DstDiscStateData%X1_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -927,8 +927,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 end if if (allocated(SrcDiscStateData%X2_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X2_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%X2_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%X2_minus1) + UB(1:2) = ubound(SrcDiscStateData%X2_minus1) if (.not. allocated(DstDiscStateData%X2_minus1)) then allocate(DstDiscStateData%X2_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -939,8 +939,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 end if if (allocated(SrcDiscStateData%X3_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X3_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%X3_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%X3_minus1) + UB(1:2) = ubound(SrcDiscStateData%X3_minus1) if (.not. allocated(DstDiscStateData%X3_minus1)) then allocate(DstDiscStateData%X3_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -951,8 +951,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 end if if (allocated(SrcDiscStateData%X4_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X4_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%X4_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%X4_minus1) + UB(1:2) = ubound(SrcDiscStateData%X4_minus1) if (.not. allocated(DstDiscStateData%X4_minus1)) then allocate(DstDiscStateData%X4_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -963,8 +963,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 end if if (allocated(SrcDiscStateData%Kprime_alpha_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1) if (.not. allocated(DstDiscStateData%Kprime_alpha_minus1)) then allocate(DstDiscStateData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -975,8 +975,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 end if if (allocated(SrcDiscStateData%Kprime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1) if (.not. allocated(DstDiscStateData%Kprime_q_minus1)) then allocate(DstDiscStateData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -987,8 +987,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 end if if (allocated(SrcDiscStateData%Kprimeprime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1) if (.not. allocated(DstDiscStateData%Kprimeprime_q_minus1)) then allocate(DstDiscStateData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -999,8 +999,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 end if if (allocated(SrcDiscStateData%K3prime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1) if (.not. allocated(DstDiscStateData%K3prime_q_minus1)) then allocate(DstDiscStateData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1011,8 +1011,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 end if if (allocated(SrcDiscStateData%Dp_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Dp_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Dp_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Dp_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dp_minus1) if (.not. allocated(DstDiscStateData%Dp_minus1)) then allocate(DstDiscStateData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1023,8 +1023,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 end if if (allocated(SrcDiscStateData%Cn_pot_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1) if (.not. allocated(DstDiscStateData%Cn_pot_minus1)) then allocate(DstDiscStateData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1035,8 +1035,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1) if (.not. allocated(DstDiscStateData%fprimeprime_minus1)) then allocate(DstDiscStateData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1047,8 +1047,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1) if (.not. allocated(DstDiscStateData%fprimeprime_c_minus1)) then allocate(DstDiscStateData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1059,8 +1059,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1) if (.not. allocated(DstDiscStateData%fprimeprime_m_minus1)) then allocate(DstDiscStateData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1071,8 +1071,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 end if if (allocated(SrcDiscStateData%Df_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Df_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Df_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_minus1) if (.not. allocated(DstDiscStateData%Df_minus1)) then allocate(DstDiscStateData%Df_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1083,8 +1083,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 end if if (allocated(SrcDiscStateData%Df_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1) if (.not. allocated(DstDiscStateData%Df_c_minus1)) then allocate(DstDiscStateData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1095,8 +1095,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 end if if (allocated(SrcDiscStateData%Df_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1) if (.not. allocated(DstDiscStateData%Df_m_minus1)) then allocate(DstDiscStateData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1107,8 +1107,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 end if if (allocated(SrcDiscStateData%Dalphaf_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1) if (.not. allocated(DstDiscStateData%Dalphaf_minus1)) then allocate(DstDiscStateData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1119,8 +1119,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 end if if (allocated(SrcDiscStateData%alphaf_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1) if (.not. allocated(DstDiscStateData%alphaf_minus1)) then allocate(DstDiscStateData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1131,8 +1131,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 end if if (allocated(SrcDiscStateData%fprime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprime_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_minus1) if (.not. allocated(DstDiscStateData%fprime_minus1)) then allocate(DstDiscStateData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1143,8 +1143,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 end if if (allocated(SrcDiscStateData%fprime_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1) if (.not. allocated(DstDiscStateData%fprime_c_minus1)) then allocate(DstDiscStateData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1155,8 +1155,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 end if if (allocated(SrcDiscStateData%fprime_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1) if (.not. allocated(DstDiscStateData%fprime_m_minus1)) then allocate(DstDiscStateData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1167,8 +1167,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 end if if (allocated(SrcDiscStateData%tau_V)) then - LB(1:2) = lbound(SrcDiscStateData%tau_V, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%tau_V, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%tau_V) + UB(1:2) = ubound(SrcDiscStateData%tau_V) if (.not. allocated(DstDiscStateData%tau_V)) then allocate(DstDiscStateData%tau_V(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1179,8 +1179,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%tau_V = SrcDiscStateData%tau_V end if if (allocated(SrcDiscStateData%tau_V_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1) if (.not. allocated(DstDiscStateData%tau_V_minus1)) then allocate(DstDiscStateData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1191,8 +1191,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 end if if (allocated(SrcDiscStateData%Cn_v_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1) if (.not. allocated(DstDiscStateData%Cn_v_minus1)) then allocate(DstDiscStateData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1203,8 +1203,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 end if if (allocated(SrcDiscStateData%C_V_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%C_V_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%C_V_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%C_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%C_V_minus1) if (.not. allocated(DstDiscStateData%C_V_minus1)) then allocate(DstDiscStateData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1215,8 +1215,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 end if if (allocated(SrcDiscStateData%Cn_prime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1) if (.not. allocated(DstDiscStateData%Cn_prime_minus1)) then allocate(DstDiscStateData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1385,7 +1385,7 @@ subroutine UA_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackDiscState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1469,16 +1469,16 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%FirstPass)) then - LB(1:2) = lbound(SrcOtherStateData%FirstPass, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%FirstPass, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%FirstPass) + UB(1:2) = ubound(SrcOtherStateData%FirstPass) if (.not. allocated(DstOtherStateData%FirstPass)) then allocate(DstOtherStateData%FirstPass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1489,8 +1489,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass end if if (allocated(SrcOtherStateData%sigma1)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%sigma1, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%sigma1) + UB(1:2) = ubound(SrcOtherStateData%sigma1) if (.not. allocated(DstOtherStateData%sigma1)) then allocate(DstOtherStateData%sigma1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1501,8 +1501,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 end if if (allocated(SrcOtherStateData%sigma1c)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1c, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%sigma1c, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%sigma1c) + UB(1:2) = ubound(SrcOtherStateData%sigma1c) if (.not. allocated(DstOtherStateData%sigma1c)) then allocate(DstOtherStateData%sigma1c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1513,8 +1513,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c end if if (allocated(SrcOtherStateData%sigma1m)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1m, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%sigma1m, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%sigma1m) + UB(1:2) = ubound(SrcOtherStateData%sigma1m) if (.not. allocated(DstOtherStateData%sigma1m)) then allocate(DstOtherStateData%sigma1m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1525,8 +1525,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m end if if (allocated(SrcOtherStateData%sigma3)) then - LB(1:2) = lbound(SrcOtherStateData%sigma3, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%sigma3, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%sigma3) + UB(1:2) = ubound(SrcOtherStateData%sigma3) if (.not. allocated(DstOtherStateData%sigma3)) then allocate(DstOtherStateData%sigma3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1537,8 +1537,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 end if if (allocated(SrcOtherStateData%n)) then - LB(1:2) = lbound(SrcOtherStateData%n, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%n, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) if (.not. allocated(DstOtherStateData%n)) then allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1548,23 +1548,23 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if DstOtherStateData%n = SrcOtherStateData%n end if - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call UA_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcOtherStateData%xHistory, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xHistory, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xHistory) + UB(1:1) = ubound(SrcOtherStateData%xHistory) do i1 = LB(1), UB(1) call UA_CopyContState(SrcOtherStateData%xHistory(i1), DstOtherStateData%xHistory(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcOtherStateData%t_vortexBegin)) then - LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin) + UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin) if (.not. allocated(DstOtherStateData%t_vortexBegin)) then allocate(DstOtherStateData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1575,8 +1575,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin end if if (allocated(SrcOtherStateData%SignOfOmega)) then - LB(1:2) = lbound(SrcOtherStateData%SignOfOmega, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%SignOfOmega, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%SignOfOmega) + UB(1:2) = ubound(SrcOtherStateData%SignOfOmega) if (.not. allocated(DstOtherStateData%SignOfOmega)) then allocate(DstOtherStateData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1587,8 +1587,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega end if if (allocated(SrcOtherStateData%PositivePressure)) then - LB(1:2) = lbound(SrcOtherStateData%PositivePressure, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%PositivePressure, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%PositivePressure) + UB(1:2) = ubound(SrcOtherStateData%PositivePressure) if (.not. allocated(DstOtherStateData%PositivePressure)) then allocate(DstOtherStateData%PositivePressure(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1599,8 +1599,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure end if if (allocated(SrcOtherStateData%vortexOn)) then - LB(1:2) = lbound(SrcOtherStateData%vortexOn, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%vortexOn, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%vortexOn) + UB(1:2) = ubound(SrcOtherStateData%vortexOn) if (.not. allocated(DstOtherStateData%vortexOn)) then allocate(DstOtherStateData%vortexOn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1611,8 +1611,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn end if if (allocated(SrcOtherStateData%BelowThreshold)) then - LB(1:2) = lbound(SrcOtherStateData%BelowThreshold, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%BelowThreshold, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%BelowThreshold) + UB(1:2) = ubound(SrcOtherStateData%BelowThreshold) if (.not. allocated(DstOtherStateData%BelowThreshold)) then allocate(DstOtherStateData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1623,8 +1623,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold end if if (allocated(SrcOtherStateData%activeL)) then - LB(1:2) = lbound(SrcOtherStateData%activeL, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%activeL, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%activeL) + UB(1:2) = ubound(SrcOtherStateData%activeL) if (.not. allocated(DstOtherStateData%activeL)) then allocate(DstOtherStateData%activeL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1635,8 +1635,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%activeL = SrcOtherStateData%activeL end if if (allocated(SrcOtherStateData%activeD)) then - LB(1:2) = lbound(SrcOtherStateData%activeD, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%activeD, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%activeD) + UB(1:2) = ubound(SrcOtherStateData%activeD) if (.not. allocated(DstOtherStateData%activeD)) then allocate(DstOtherStateData%activeD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1652,8 +1652,8 @@ subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(UA_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_DestroyOtherState' @@ -1677,14 +1677,14 @@ subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%n)) then deallocate(OtherStateData%n) end if - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call UA_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(OtherStateData%xHistory, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xHistory, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xHistory) + UB(1:1) = ubound(OtherStateData%xHistory) do i1 = LB(1), UB(1) call UA_DestroyContState(OtherStateData%xHistory(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1716,8 +1716,8 @@ subroutine UA_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(UA_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%FirstPass) call RegPackAlloc(RF, InData%sigma1) @@ -1725,13 +1725,13 @@ subroutine UA_PackOtherState(RF, Indata) call RegPackAlloc(RF, InData%sigma1m) call RegPackAlloc(RF, InData%sigma3) call RegPackAlloc(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call UA_PackContState(RF, InData%xdot(i1)) end do - LB(1:1) = lbound(InData%xHistory, kind=B8Ki) - UB(1:1) = ubound(InData%xHistory, kind=B8Ki) + LB(1:1) = lbound(InData%xHistory) + UB(1:1) = ubound(InData%xHistory) do i1 = LB(1), UB(1) call UA_PackContState(RF, InData%xHistory(i1)) end do @@ -1749,8 +1749,8 @@ subroutine UA_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1760,13 +1760,13 @@ subroutine UA_UnPackOtherState(RF, OutData) call RegUnpackAlloc(RF, OutData%sigma1m); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%sigma3); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call UA_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do - LB(1:1) = lbound(OutData%xHistory, kind=B8Ki) - UB(1:1) = ubound(OutData%xHistory, kind=B8Ki) + LB(1:1) = lbound(OutData%xHistory) + UB(1:1) = ubound(OutData%xHistory) do i1 = LB(1), UB(1) call UA_UnpackContState(RF, OutData%xHistory(i1)) ! xHistory end do @@ -1785,7 +1785,7 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyMisc' ErrStat = ErrID_None @@ -1794,8 +1794,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off if (allocated(SrcMiscData%TESF)) then - LB(1:2) = lbound(SrcMiscData%TESF, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%TESF, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%TESF) + UB(1:2) = ubound(SrcMiscData%TESF) if (.not. allocated(DstMiscData%TESF)) then allocate(DstMiscData%TESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1806,8 +1806,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TESF = SrcMiscData%TESF end if if (allocated(SrcMiscData%LESF)) then - LB(1:2) = lbound(SrcMiscData%LESF, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LESF, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LESF) + UB(1:2) = ubound(SrcMiscData%LESF) if (.not. allocated(DstMiscData%LESF)) then allocate(DstMiscData%LESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1818,8 +1818,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LESF = SrcMiscData%LESF end if if (allocated(SrcMiscData%VRTX)) then - LB(1:2) = lbound(SrcMiscData%VRTX, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%VRTX, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%VRTX) + UB(1:2) = ubound(SrcMiscData%VRTX) if (.not. allocated(DstMiscData%VRTX)) then allocate(DstMiscData%VRTX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1830,8 +1830,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%VRTX = SrcMiscData%VRTX end if if (allocated(SrcMiscData%T_Sh)) then - LB(1:2) = lbound(SrcMiscData%T_Sh, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%T_Sh, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%T_Sh) + UB(1:2) = ubound(SrcMiscData%T_Sh) if (.not. allocated(DstMiscData%T_Sh)) then allocate(DstMiscData%T_Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1842,8 +1842,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%T_Sh = SrcMiscData%T_Sh end if if (allocated(SrcMiscData%BEDSEP)) then - LB(1:2) = lbound(SrcMiscData%BEDSEP, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BEDSEP, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%BEDSEP) + UB(1:2) = ubound(SrcMiscData%BEDSEP) if (.not. allocated(DstMiscData%BEDSEP)) then allocate(DstMiscData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1854,8 +1854,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BEDSEP = SrcMiscData%BEDSEP end if if (allocated(SrcMiscData%weight)) then - LB(1:2) = lbound(SrcMiscData%weight, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%weight, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%weight) + UB(1:2) = ubound(SrcMiscData%weight) if (.not. allocated(DstMiscData%weight)) then allocate(DstMiscData%weight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1915,7 +1915,7 @@ subroutine UA_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1936,15 +1936,15 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%dt = SrcParamData%dt if (allocated(SrcParamData%c)) then - LB(1:2) = lbound(SrcParamData%c, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%c, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%c) + UB(1:2) = ubound(SrcParamData%c) if (.not. allocated(DstParamData%c)) then allocate(DstParamData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1969,8 +1969,8 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ShedEffect = SrcParamData%ShedEffect DstParamData%lin_nx = SrcParamData%lin_nx if (allocated(SrcParamData%UA_off_forGood)) then - LB(1:2) = lbound(SrcParamData%UA_off_forGood, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%UA_off_forGood, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%UA_off_forGood) + UB(1:2) = ubound(SrcParamData%UA_off_forGood) if (.not. allocated(DstParamData%UA_off_forGood)) then allocate(DstParamData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1981,8 +1981,8 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood end if if (allocated(SrcParamData%lin_xIndx)) then - LB(1:2) = lbound(SrcParamData%lin_xIndx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%lin_xIndx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%lin_xIndx) + UB(1:2) = ubound(SrcParamData%lin_xIndx) if (.not. allocated(DstParamData%lin_xIndx)) then allocate(DstParamData%lin_xIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2048,7 +2048,7 @@ subroutine UA_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2134,7 +2134,7 @@ subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyOutput' ErrStat = ErrID_None @@ -2145,8 +2145,8 @@ subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Cl = SrcOutputData%Cl DstOutputData%Cd = SrcOutputData%Cd if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2188,7 +2188,7 @@ subroutine UA_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 1e7c315610..fadc1131bc 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -274,14 +274,14 @@ subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGrid' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcHighWindGridData%data)) then - LB(1:5) = lbound(SrcHighWindGridData%data, kind=B8Ki) - UB(1:5) = ubound(SrcHighWindGridData%data, kind=B8Ki) + LB(1:5) = lbound(SrcHighWindGridData%data) + UB(1:5) = ubound(SrcHighWindGridData%data) if (.not. associated(DstHighWindGridData%data)) then allocate(DstHighWindGridData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -320,7 +320,7 @@ subroutine AWAE_UnPackHighWindGrid(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_HighWindGrid), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGrid' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -335,7 +335,7 @@ subroutine AWAE_CopyHighWindGridPtr(SrcHighWindGridPtrData, DstHighWindGridPtrDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGridPtr' ErrStat = ErrID_None @@ -367,7 +367,7 @@ subroutine AWAE_UnPackHighWindGridPtr(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_HighWindGridPtr), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGridPtr' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -382,7 +382,7 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyInputFileType' ErrStat = ErrID_None @@ -396,8 +396,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY if (allocated(SrcInputFileTypeData%OutDisWindZ)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ) if (.not. allocated(DstInputFileTypeData%OutDisWindZ)) then allocate(DstInputFileTypeData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -409,8 +409,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ if (allocated(SrcInputFileTypeData%OutDisWindX)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX) if (.not. allocated(DstInputFileTypeData%OutDisWindX)) then allocate(DstInputFileTypeData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -422,8 +422,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ if (allocated(SrcInputFileTypeData%OutDisWindY)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY) if (.not. allocated(DstInputFileTypeData%OutDisWindY)) then allocate(DstInputFileTypeData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -441,8 +441,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high if (allocated(SrcInputFileTypeData%X0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%X0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%X0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%X0_high) + UB(1:1) = ubound(SrcInputFileTypeData%X0_high) if (.not. allocated(DstInputFileTypeData%X0_high)) then allocate(DstInputFileTypeData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -453,8 +453,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high end if if (allocated(SrcInputFileTypeData%Y0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%Y0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%Y0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%Y0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Y0_high) if (.not. allocated(DstInputFileTypeData%Y0_high)) then allocate(DstInputFileTypeData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -465,8 +465,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high end if if (allocated(SrcInputFileTypeData%Z0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%Z0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%Z0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%Z0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Z0_high) if (.not. allocated(DstInputFileTypeData%Z0_high)) then allocate(DstInputFileTypeData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -477,8 +477,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high end if if (allocated(SrcInputFileTypeData%dX_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dX_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%dX_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%dX_high) + UB(1:1) = ubound(SrcInputFileTypeData%dX_high) if (.not. allocated(DstInputFileTypeData%dX_high)) then allocate(DstInputFileTypeData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -489,8 +489,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high end if if (allocated(SrcInputFileTypeData%dY_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dY_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%dY_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%dY_high) + UB(1:1) = ubound(SrcInputFileTypeData%dY_high) if (.not. allocated(DstInputFileTypeData%dY_high)) then allocate(DstInputFileTypeData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -501,8 +501,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high end if if (allocated(SrcInputFileTypeData%dZ_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dZ_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%dZ_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%dZ_high) + UB(1:1) = ubound(SrcInputFileTypeData%dZ_high) if (.not. allocated(DstInputFileTypeData%dZ_high)) then allocate(DstInputFileTypeData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -525,8 +525,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low if (allocated(SrcInputFileTypeData%WT_Position)) then - LB(1:2) = lbound(SrcInputFileTypeData%WT_Position, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileTypeData%WT_Position, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileTypeData%WT_Position) + UB(1:2) = ubound(SrcInputFileTypeData%WT_Position) if (.not. allocated(DstInputFileTypeData%WT_Position)) then allocate(DstInputFileTypeData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -630,7 +630,7 @@ subroutine AWAE_UnPackInputFileType(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_InputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInputFileType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -682,7 +682,7 @@ subroutine AWAE_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(0), UB(0) + integer(B4Ki) :: LB(0), UB(0) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyInitInput' @@ -737,7 +737,7 @@ subroutine AWAE_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInitInput' - integer(B8Ki) :: LB(0), UB(0) + integer(B4Ki) :: LB(0), UB(0) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -774,8 +774,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyInitOutput' @@ -785,8 +785,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%X0_high)) then - LB(1:1) = lbound(SrcInitOutputData%X0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%X0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%X0_high) + UB(1:1) = ubound(SrcInitOutputData%X0_high) if (.not. allocated(DstInitOutputData%X0_high)) then allocate(DstInitOutputData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -797,8 +797,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%X0_high = SrcInitOutputData%X0_high end if if (allocated(SrcInitOutputData%Y0_high)) then - LB(1:1) = lbound(SrcInitOutputData%Y0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%Y0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%Y0_high) + UB(1:1) = ubound(SrcInitOutputData%Y0_high) if (.not. allocated(DstInitOutputData%Y0_high)) then allocate(DstInitOutputData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -809,8 +809,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high end if if (allocated(SrcInitOutputData%Z0_high)) then - LB(1:1) = lbound(SrcInitOutputData%Z0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%Z0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%Z0_high) + UB(1:1) = ubound(SrcInitOutputData%Z0_high) if (.not. allocated(DstInitOutputData%Z0_high)) then allocate(DstInitOutputData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -821,8 +821,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high end if if (allocated(SrcInitOutputData%dX_high)) then - LB(1:1) = lbound(SrcInitOutputData%dX_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%dX_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%dX_high) + UB(1:1) = ubound(SrcInitOutputData%dX_high) if (.not. allocated(DstInitOutputData%dX_high)) then allocate(DstInitOutputData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -833,8 +833,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%dX_high = SrcInitOutputData%dX_high end if if (allocated(SrcInitOutputData%dY_high)) then - LB(1:1) = lbound(SrcInitOutputData%dY_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%dY_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%dY_high) + UB(1:1) = ubound(SrcInitOutputData%dY_high) if (.not. allocated(DstInitOutputData%dY_high)) then allocate(DstInitOutputData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -845,8 +845,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%dY_high = SrcInitOutputData%dY_high end if if (allocated(SrcInitOutputData%dZ_high)) then - LB(1:1) = lbound(SrcInitOutputData%dZ_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%dZ_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%dZ_high) + UB(1:1) = ubound(SrcInitOutputData%dZ_high) if (.not. allocated(DstInitOutputData%dZ_high)) then allocate(DstInitOutputData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -869,8 +869,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low if (allocated(SrcInitOutputData%Vdist_High)) then - LB(1:1) = lbound(SrcInitOutputData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%Vdist_High, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%Vdist_High) + UB(1:1) = ubound(SrcInitOutputData%Vdist_High) if (.not. allocated(DstInitOutputData%Vdist_High)) then allocate(DstInitOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -890,8 +890,8 @@ subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) type(AWAE_InitOutputType), intent(inout) :: InitOutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyInitOutput' @@ -918,8 +918,8 @@ subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%dZ_high) end if if (allocated(InitOutputData%Vdist_High)) then - LB(1:1) = lbound(InitOutputData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(InitOutputData%Vdist_High, kind=B8Ki) + LB(1:1) = lbound(InitOutputData%Vdist_High) + UB(1:1) = ubound(InitOutputData%Vdist_High) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGridPtr(InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -932,8 +932,8 @@ subroutine AWAE_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInitOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPackAlloc(RF, InData%X0_high) @@ -956,9 +956,9 @@ subroutine AWAE_PackInitOutput(RF, Indata) call RegPack(RF, InData%Z0_low) call RegPack(RF, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then - call RegPackBounds(RF, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) - LB(1:1) = lbound(InData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(InData%Vdist_High, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) do i1 = LB(1), UB(1) call AWAE_PackHighWindGridPtr(RF, InData%Vdist_High(i1)) end do @@ -970,8 +970,8 @@ subroutine AWAE_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInitOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1015,16 +1015,16 @@ subroutine AWAE_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%IfW)) then - LB(1:1) = lbound(SrcContStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%IfW) + UB(1:1) = ubound(SrcContStateData%IfW) if (.not. allocated(DstContStateData%IfW)) then allocate(DstContStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1044,16 +1044,16 @@ subroutine AWAE_DestroyContState(ContStateData, ErrStat, ErrMsg) type(AWAE_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%IfW)) then - LB(1:1) = lbound(ContStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(ContStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(ContStateData%IfW) + UB(1:1) = ubound(ContStateData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyContState(ContStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1066,14 +1066,14 @@ subroutine AWAE_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackContState(RF, InData%IfW(i1)) end do @@ -1085,8 +1085,8 @@ subroutine AWAE_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1111,16 +1111,16 @@ subroutine AWAE_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%IfW)) then - LB(1:1) = lbound(SrcDiscStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%IfW) + UB(1:1) = ubound(SrcDiscStateData%IfW) if (.not. allocated(DstDiscStateData%IfW)) then allocate(DstDiscStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1142,16 +1142,16 @@ subroutine AWAE_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(AWAE_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%IfW)) then - LB(1:1) = lbound(DiscStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%IfW) + UB(1:1) = ubound(DiscStateData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyDiscState(DiscStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1164,14 +1164,14 @@ subroutine AWAE_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackDiscState(RF, InData%IfW(i1)) end do @@ -1185,8 +1185,8 @@ subroutine AWAE_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1213,16 +1213,16 @@ subroutine AWAE_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%IfW)) then - LB(1:1) = lbound(SrcConstrStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%IfW) + UB(1:1) = ubound(SrcConstrStateData%IfW) if (.not. allocated(DstConstrStateData%IfW)) then allocate(DstConstrStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1242,16 +1242,16 @@ subroutine AWAE_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(AWAE_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%IfW)) then - LB(1:1) = lbound(ConstrStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%IfW) + UB(1:1) = ubound(ConstrStateData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyConstrState(ConstrStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1264,14 +1264,14 @@ subroutine AWAE_PackConstrState(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackConstrState(RF, InData%IfW(i1)) end do @@ -1283,8 +1283,8 @@ subroutine AWAE_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1309,16 +1309,16 @@ subroutine AWAE_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%IfW)) then - LB(1:1) = lbound(SrcOtherStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%IfW) + UB(1:1) = ubound(SrcOtherStateData%IfW) if (.not. allocated(DstOtherStateData%IfW)) then allocate(DstOtherStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1338,16 +1338,16 @@ subroutine AWAE_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(AWAE_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%IfW)) then - LB(1:1) = lbound(OtherStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%IfW) + UB(1:1) = ubound(OtherStateData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyOtherState(OtherStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1360,14 +1360,14 @@ subroutine AWAE_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackOtherState(RF, InData%IfW(i1)) end do @@ -1379,8 +1379,8 @@ subroutine AWAE_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1405,16 +1405,16 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%Vamb_low)) then - LB(1:4) = lbound(SrcMiscData%Vamb_low, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%Vamb_low, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%Vamb_low) + UB(1:4) = ubound(SrcMiscData%Vamb_low) if (.not. allocated(DstMiscData%Vamb_low)) then allocate(DstMiscData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1425,8 +1425,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vamb_low = SrcMiscData%Vamb_low end if if (allocated(SrcMiscData%Vamb_lowpol)) then - LB(1:2) = lbound(SrcMiscData%Vamb_lowpol, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Vamb_lowpol, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%Vamb_lowpol) + UB(1:2) = ubound(SrcMiscData%Vamb_lowpol) if (.not. allocated(DstMiscData%Vamb_lowpol)) then allocate(DstMiscData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1437,8 +1437,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol end if if (allocated(SrcMiscData%Vdist_low)) then - LB(1:4) = lbound(SrcMiscData%Vdist_low, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%Vdist_low, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%Vdist_low) + UB(1:4) = ubound(SrcMiscData%Vdist_low) if (.not. allocated(DstMiscData%Vdist_low)) then allocate(DstMiscData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1449,8 +1449,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vdist_low = SrcMiscData%Vdist_low end if if (allocated(SrcMiscData%Vdist_low_full)) then - LB(1:4) = lbound(SrcMiscData%Vdist_low_full, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%Vdist_low_full, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%Vdist_low_full) + UB(1:4) = ubound(SrcMiscData%Vdist_low_full) if (.not. allocated(DstMiscData%Vdist_low_full)) then allocate(DstMiscData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1461,8 +1461,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full end if if (allocated(SrcMiscData%Vamb_High)) then - LB(1:1) = lbound(SrcMiscData%Vamb_High, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Vamb_High, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Vamb_High) + UB(1:1) = ubound(SrcMiscData%Vamb_High) if (.not. allocated(DstMiscData%Vamb_High)) then allocate(DstMiscData%Vamb_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1477,8 +1477,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%parallelFlag)) then - LB(1:2) = lbound(SrcMiscData%parallelFlag, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%parallelFlag, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%parallelFlag) + UB(1:2) = ubound(SrcMiscData%parallelFlag) if (.not. allocated(DstMiscData%parallelFlag)) then allocate(DstMiscData%parallelFlag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1489,8 +1489,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%parallelFlag = SrcMiscData%parallelFlag end if if (allocated(SrcMiscData%r_s)) then - LB(1:2) = lbound(SrcMiscData%r_s, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%r_s, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%r_s) + UB(1:2) = ubound(SrcMiscData%r_s) if (.not. allocated(DstMiscData%r_s)) then allocate(DstMiscData%r_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1501,8 +1501,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_s = SrcMiscData%r_s end if if (allocated(SrcMiscData%r_e)) then - LB(1:2) = lbound(SrcMiscData%r_e, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%r_e, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%r_e) + UB(1:2) = ubound(SrcMiscData%r_e) if (.not. allocated(DstMiscData%r_e)) then allocate(DstMiscData%r_e(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1513,8 +1513,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_e = SrcMiscData%r_e end if if (allocated(SrcMiscData%rhat_s)) then - LB(1:3) = lbound(SrcMiscData%rhat_s, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%rhat_s, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%rhat_s) + UB(1:3) = ubound(SrcMiscData%rhat_s) if (.not. allocated(DstMiscData%rhat_s)) then allocate(DstMiscData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1525,8 +1525,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rhat_s = SrcMiscData%rhat_s end if if (allocated(SrcMiscData%rhat_e)) then - LB(1:3) = lbound(SrcMiscData%rhat_e, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%rhat_e, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%rhat_e) + UB(1:3) = ubound(SrcMiscData%rhat_e) if (.not. allocated(DstMiscData%rhat_e)) then allocate(DstMiscData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1537,8 +1537,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rhat_e = SrcMiscData%rhat_e end if if (allocated(SrcMiscData%pvec_cs)) then - LB(1:3) = lbound(SrcMiscData%pvec_cs, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%pvec_cs, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%pvec_cs) + UB(1:3) = ubound(SrcMiscData%pvec_cs) if (.not. allocated(DstMiscData%pvec_cs)) then allocate(DstMiscData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1549,8 +1549,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%pvec_cs = SrcMiscData%pvec_cs end if if (allocated(SrcMiscData%pvec_ce)) then - LB(1:3) = lbound(SrcMiscData%pvec_ce, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%pvec_ce, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%pvec_ce) + UB(1:3) = ubound(SrcMiscData%pvec_ce) if (.not. allocated(DstMiscData%pvec_ce)) then allocate(DstMiscData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1561,8 +1561,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%pvec_ce = SrcMiscData%pvec_ce end if if (allocated(SrcMiscData%outVizXYPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizXYPlane, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%outVizXYPlane, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%outVizXYPlane) + UB(1:4) = ubound(SrcMiscData%outVizXYPlane) if (.not. allocated(DstMiscData%outVizXYPlane)) then allocate(DstMiscData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1573,8 +1573,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane end if if (allocated(SrcMiscData%outVizYZPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizYZPlane, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%outVizYZPlane, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%outVizYZPlane) + UB(1:4) = ubound(SrcMiscData%outVizYZPlane) if (.not. allocated(DstMiscData%outVizYZPlane)) then allocate(DstMiscData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1585,8 +1585,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane end if if (allocated(SrcMiscData%outVizXZPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizXZPlane, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%outVizXZPlane, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%outVizXZPlane) + UB(1:4) = ubound(SrcMiscData%outVizXZPlane) if (.not. allocated(DstMiscData%outVizXZPlane)) then allocate(DstMiscData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1597,8 +1597,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane end if if (allocated(SrcMiscData%IfW)) then - LB(1:1) = lbound(SrcMiscData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%IfW) + UB(1:1) = ubound(SrcMiscData%IfW) if (.not. allocated(DstMiscData%IfW)) then allocate(DstMiscData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1625,8 +1625,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%V_amb_low_disk)) then - LB(1:2) = lbound(SrcMiscData%V_amb_low_disk, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%V_amb_low_disk, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%V_amb_low_disk) + UB(1:2) = ubound(SrcMiscData%V_amb_low_disk) if (.not. allocated(DstMiscData%V_amb_low_disk)) then allocate(DstMiscData%V_amb_low_disk(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1642,8 +1642,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) type(AWAE_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyMisc' @@ -1662,8 +1662,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Vdist_low_full) end if if (allocated(MiscData%Vamb_High)) then - LB(1:1) = lbound(MiscData%Vamb_High, kind=B8Ki) - UB(1:1) = ubound(MiscData%Vamb_High, kind=B8Ki) + LB(1:1) = lbound(MiscData%Vamb_High) + UB(1:1) = ubound(MiscData%Vamb_High) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGrid(MiscData%Vamb_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1701,8 +1701,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%outVizXZPlane) end if if (allocated(MiscData%IfW)) then - LB(1:1) = lbound(MiscData%IfW, kind=B8Ki) - UB(1:1) = ubound(MiscData%IfW, kind=B8Ki) + LB(1:1) = lbound(MiscData%IfW) + UB(1:1) = ubound(MiscData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyMisc(MiscData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1726,8 +1726,8 @@ subroutine AWAE_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackMisc' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%Vamb_low) call RegPackAlloc(RF, InData%Vamb_lowpol) @@ -1735,9 +1735,9 @@ subroutine AWAE_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%Vdist_low_full) call RegPack(RF, allocated(InData%Vamb_High)) if (allocated(InData%Vamb_High)) then - call RegPackBounds(RF, 1, lbound(InData%Vamb_High, kind=B8Ki), ubound(InData%Vamb_High, kind=B8Ki)) - LB(1:1) = lbound(InData%Vamb_High, kind=B8Ki) - UB(1:1) = ubound(InData%Vamb_High, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Vamb_High), ubound(InData%Vamb_High)) + LB(1:1) = lbound(InData%Vamb_High) + UB(1:1) = ubound(InData%Vamb_High) do i1 = LB(1), UB(1) call AWAE_PackHighWindGrid(RF, InData%Vamb_High(i1)) end do @@ -1754,9 +1754,9 @@ subroutine AWAE_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%outVizXZPlane) call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackMisc(RF, InData%IfW(i1)) end do @@ -1773,8 +1773,8 @@ subroutine AWAE_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackMisc' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1831,8 +1831,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyParam' @@ -1843,8 +1843,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumRadii = SrcParamData%NumRadii DstParamData%NumPlanes = SrcParamData%NumPlanes if (allocated(SrcParamData%y)) then - LB(1:1) = lbound(SrcParamData%y, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%y, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) if (.not. allocated(DstParamData%y)) then allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1855,8 +1855,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%y = SrcParamData%y end if if (allocated(SrcParamData%z)) then - LB(1:1) = lbound(SrcParamData%z, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%z, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) if (.not. allocated(DstParamData%z)) then allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1881,8 +1881,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0_low = SrcParamData%Y0_low DstParamData%Z0_low = SrcParamData%Z0_low if (allocated(SrcParamData%X0_high)) then - LB(1:1) = lbound(SrcParamData%X0_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%X0_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%X0_high) + UB(1:1) = ubound(SrcParamData%X0_high) if (.not. allocated(DstParamData%X0_high)) then allocate(DstParamData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1893,8 +1893,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%X0_high = SrcParamData%X0_high end if if (allocated(SrcParamData%Y0_high)) then - LB(1:1) = lbound(SrcParamData%Y0_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Y0_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Y0_high) + UB(1:1) = ubound(SrcParamData%Y0_high) if (.not. allocated(DstParamData%Y0_high)) then allocate(DstParamData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1905,8 +1905,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0_high = SrcParamData%Y0_high end if if (allocated(SrcParamData%Z0_high)) then - LB(1:1) = lbound(SrcParamData%Z0_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Z0_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Z0_high) + UB(1:1) = ubound(SrcParamData%Z0_high) if (.not. allocated(DstParamData%Z0_high)) then allocate(DstParamData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1917,8 +1917,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Z0_high = SrcParamData%Z0_high end if if (allocated(SrcParamData%dX_high)) then - LB(1:1) = lbound(SrcParamData%dX_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dX_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dX_high) + UB(1:1) = ubound(SrcParamData%dX_high) if (.not. allocated(DstParamData%dX_high)) then allocate(DstParamData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1929,8 +1929,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dX_high = SrcParamData%dX_high end if if (allocated(SrcParamData%dY_high)) then - LB(1:1) = lbound(SrcParamData%dY_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dY_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dY_high) + UB(1:1) = ubound(SrcParamData%dY_high) if (.not. allocated(DstParamData%dY_high)) then allocate(DstParamData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1941,8 +1941,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dY_high = SrcParamData%dY_high end if if (allocated(SrcParamData%dZ_high)) then - LB(1:1) = lbound(SrcParamData%dZ_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dZ_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dZ_high) + UB(1:1) = ubound(SrcParamData%dZ_high) if (.not. allocated(DstParamData%dZ_high)) then allocate(DstParamData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1956,8 +1956,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nY_high = SrcParamData%nY_high DstParamData%nZ_high = SrcParamData%nZ_high if (allocated(SrcParamData%Grid_low)) then - LB(1:2) = lbound(SrcParamData%Grid_low, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Grid_low, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Grid_low) + UB(1:2) = ubound(SrcParamData%Grid_low) if (.not. allocated(DstParamData%Grid_low)) then allocate(DstParamData%Grid_low(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1968,8 +1968,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Grid_low = SrcParamData%Grid_low end if if (allocated(SrcParamData%Grid_high)) then - LB(1:3) = lbound(SrcParamData%Grid_high, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Grid_high, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Grid_high) + UB(1:3) = ubound(SrcParamData%Grid_high) if (.not. allocated(DstParamData%Grid_high)) then allocate(DstParamData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1980,8 +1980,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Grid_high = SrcParamData%Grid_high end if if (allocated(SrcParamData%WT_Position)) then - LB(1:2) = lbound(SrcParamData%WT_Position, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%WT_Position, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) if (.not. allocated(DstParamData%WT_Position)) then allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2000,8 +2000,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam DstParamData%Mod_Projection = SrcParamData%Mod_Projection if (allocated(SrcParamData%IfW)) then - LB(1:1) = lbound(SrcParamData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IfW) + UB(1:1) = ubound(SrcParamData%IfW) if (.not. allocated(DstParamData%IfW)) then allocate(DstParamData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2019,8 +2019,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WrDisWind = SrcParamData%WrDisWind DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY if (allocated(SrcParamData%OutDisWindZ)) then - LB(1:1) = lbound(SrcParamData%OutDisWindZ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutDisWindZ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutDisWindZ) + UB(1:1) = ubound(SrcParamData%OutDisWindZ) if (.not. allocated(DstParamData%OutDisWindZ)) then allocate(DstParamData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2032,8 +2032,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ if (allocated(SrcParamData%OutDisWindX)) then - LB(1:1) = lbound(SrcParamData%OutDisWindX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutDisWindX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutDisWindX) + UB(1:1) = ubound(SrcParamData%OutDisWindX) if (.not. allocated(DstParamData%OutDisWindX)) then allocate(DstParamData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2045,8 +2045,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ if (allocated(SrcParamData%OutDisWindY)) then - LB(1:1) = lbound(SrcParamData%OutDisWindY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutDisWindY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutDisWindY) + UB(1:1) = ubound(SrcParamData%OutDisWindY) if (.not. allocated(DstParamData%OutDisWindY)) then allocate(DstParamData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2067,8 +2067,8 @@ subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) type(AWAE_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyParam' @@ -2108,8 +2108,8 @@ subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WT_Position) end if if (allocated(ParamData%IfW)) then - LB(1:1) = lbound(ParamData%IfW, kind=B8Ki) - UB(1:1) = ubound(ParamData%IfW, kind=B8Ki) + LB(1:1) = lbound(ParamData%IfW) + UB(1:1) = ubound(ParamData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyParam(ParamData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2132,8 +2132,8 @@ subroutine AWAE_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%WindFilePath) @@ -2178,9 +2178,9 @@ subroutine AWAE_PackParam(RF, Indata) call RegPack(RF, InData%Mod_Projection) call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackParam(RF, InData%IfW(i1)) end do @@ -2211,8 +2211,8 @@ subroutine AWAE_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2309,16 +2309,16 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Vdist_High)) then - LB(1:1) = lbound(SrcOutputData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Vdist_High, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Vdist_High) + UB(1:1) = ubound(SrcOutputData%Vdist_High) if (.not. allocated(DstOutputData%Vdist_High)) then allocate(DstOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2333,8 +2333,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%V_plane)) then - LB(1:3) = lbound(SrcOutputData%V_plane, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%V_plane, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%V_plane) + UB(1:3) = ubound(SrcOutputData%V_plane) if (.not. allocated(DstOutputData%V_plane)) then allocate(DstOutputData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2345,8 +2345,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%V_plane = SrcOutputData%V_plane end if if (allocated(SrcOutputData%TI_amb)) then - LB(1:1) = lbound(SrcOutputData%TI_amb, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%TI_amb, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%TI_amb) + UB(1:1) = ubound(SrcOutputData%TI_amb) if (.not. allocated(DstOutputData%TI_amb)) then allocate(DstOutputData%TI_amb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2357,8 +2357,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%TI_amb = SrcOutputData%TI_amb end if if (allocated(SrcOutputData%Vx_wind_disk)) then - LB(1:1) = lbound(SrcOutputData%Vx_wind_disk, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Vx_wind_disk, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Vx_wind_disk) + UB(1:1) = ubound(SrcOutputData%Vx_wind_disk) if (.not. allocated(DstOutputData%Vx_wind_disk)) then allocate(DstOutputData%Vx_wind_disk(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2374,16 +2374,16 @@ subroutine AWAE_DestroyOutput(OutputData, ErrStat, ErrMsg) type(AWAE_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%Vdist_High)) then - LB(1:1) = lbound(OutputData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(OutputData%Vdist_High, kind=B8Ki) + LB(1:1) = lbound(OutputData%Vdist_High) + UB(1:1) = ubound(OutputData%Vdist_High) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGrid(OutputData%Vdist_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2405,14 +2405,14 @@ subroutine AWAE_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackOutput' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then - call RegPackBounds(RF, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) - LB(1:1) = lbound(InData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(InData%Vdist_High, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) do i1 = LB(1), UB(1) call AWAE_PackHighWindGrid(RF, InData%Vdist_High(i1)) end do @@ -2427,8 +2427,8 @@ subroutine AWAE_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackOutput' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2456,14 +2456,14 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%xhat_plane)) then - LB(1:3) = lbound(SrcInputData%xhat_plane, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%xhat_plane, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%xhat_plane) + UB(1:3) = ubound(SrcInputData%xhat_plane) if (.not. allocated(DstInputData%xhat_plane)) then allocate(DstInputData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2474,8 +2474,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%xhat_plane = SrcInputData%xhat_plane end if if (allocated(SrcInputData%p_plane)) then - LB(1:3) = lbound(SrcInputData%p_plane, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%p_plane, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%p_plane) + UB(1:3) = ubound(SrcInputData%p_plane) if (.not. allocated(DstInputData%p_plane)) then allocate(DstInputData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2486,8 +2486,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%p_plane = SrcInputData%p_plane end if if (allocated(SrcInputData%Vx_wake)) then - LB(1:4) = lbound(SrcInputData%Vx_wake, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%Vx_wake, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%Vx_wake) + UB(1:4) = ubound(SrcInputData%Vx_wake) if (.not. allocated(DstInputData%Vx_wake)) then allocate(DstInputData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2498,8 +2498,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vx_wake = SrcInputData%Vx_wake end if if (allocated(SrcInputData%Vy_wake)) then - LB(1:4) = lbound(SrcInputData%Vy_wake, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%Vy_wake, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%Vy_wake) + UB(1:4) = ubound(SrcInputData%Vy_wake) if (.not. allocated(DstInputData%Vy_wake)) then allocate(DstInputData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2510,8 +2510,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vy_wake = SrcInputData%Vy_wake end if if (allocated(SrcInputData%Vz_wake)) then - LB(1:4) = lbound(SrcInputData%Vz_wake, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%Vz_wake, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%Vz_wake) + UB(1:4) = ubound(SrcInputData%Vz_wake) if (.not. allocated(DstInputData%Vz_wake)) then allocate(DstInputData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2522,8 +2522,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vz_wake = SrcInputData%Vz_wake end if if (allocated(SrcInputData%D_wake)) then - LB(1:2) = lbound(SrcInputData%D_wake, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%D_wake, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%D_wake) + UB(1:2) = ubound(SrcInputData%D_wake) if (.not. allocated(DstInputData%D_wake)) then allocate(DstInputData%D_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2534,8 +2534,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%D_wake = SrcInputData%D_wake end if if (allocated(SrcInputData%WAT_k)) then - LB(1:4) = lbound(SrcInputData%WAT_k, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%WAT_k, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%WAT_k) + UB(1:4) = ubound(SrcInputData%WAT_k) if (.not. allocated(DstInputData%WAT_k)) then allocate(DstInputData%WAT_k(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2596,7 +2596,7 @@ subroutine AWAE_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInput' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 32d2449c5c..e006498846 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -1655,6 +1655,7 @@ subroutine Init_MiscVars( p, u, y, m, ErrStat, ErrMsg ) ! Array for storing the position information for the quadrature points. CALL AllocAry(m%qp%uuu, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uuu displacement at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%uup, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(m%qp%uup, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%vvv, p%dof_node ,p%nqp,p%elem_total, 'm%qp%vvv velocity at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%vvp, p%dof_node ,p%nqp,p%elem_total, 'm%qp%vvp velocity prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%aaa, p%dof_node ,p%nqp,p%elem_total, 'm%qp%aaa acceleration at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3009,7 +3010,8 @@ SUBROUTINE BD_QPDataAcceleration( p, OtherState, m ) elem_start = p%node_elem_idx(nelem,1) ! Interpolate the acceleration term at t+dt (OtherState%acc is at t+dt) to quadrature points - call LAPACK_DGEMM('N','N', 1.0_BDKi, OtherState%acc(:,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%aaa(:,:,nelem), ErrStat, ErrMsg) + ! NOTE: errors from LAPACK_GEMM can only be due to matrix size mismatch, so they can be safely ignored if matrices are correct size + call LAPACK_GEMM('N','N', 1.0_BDKi, OtherState%acc(:,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%aaa(:,:,nelem), ErrStat, ErrMsg) end do diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 15ea8691a5..aec9b4bd05 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -428,15 +428,15 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -447,8 +447,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -463,8 +463,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err if (ErrStat >= AbortErrLev) return DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -475,8 +475,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -487,8 +487,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -499,8 +499,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -511,8 +511,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -523,8 +523,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -535,8 +535,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -547,8 +547,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -635,7 +635,7 @@ subroutine BD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -678,7 +678,7 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyBladeInputData' ErrStat = ErrID_None @@ -686,8 +686,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index if (allocated(SrcBladeInputDataData%station_eta)) then - LB(1:1) = lbound(SrcBladeInputDataData%station_eta, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%station_eta, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%station_eta) + UB(1:1) = ubound(SrcBladeInputDataData%station_eta) if (.not. allocated(DstBladeInputDataData%station_eta)) then allocate(DstBladeInputDataData%station_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -698,8 +698,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta end if if (allocated(SrcBladeInputDataData%stiff0)) then - LB(1:3) = lbound(SrcBladeInputDataData%stiff0, kind=B8Ki) - UB(1:3) = ubound(SrcBladeInputDataData%stiff0, kind=B8Ki) + LB(1:3) = lbound(SrcBladeInputDataData%stiff0) + UB(1:3) = ubound(SrcBladeInputDataData%stiff0) if (.not. allocated(DstBladeInputDataData%stiff0)) then allocate(DstBladeInputDataData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -710,8 +710,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 end if if (allocated(SrcBladeInputDataData%mass0)) then - LB(1:3) = lbound(SrcBladeInputDataData%mass0, kind=B8Ki) - UB(1:3) = ubound(SrcBladeInputDataData%mass0, kind=B8Ki) + LB(1:3) = lbound(SrcBladeInputDataData%mass0) + UB(1:3) = ubound(SrcBladeInputDataData%mass0) if (.not. allocated(DstBladeInputDataData%mass0)) then allocate(DstBladeInputDataData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -762,7 +762,7 @@ subroutine BD_UnPackBladeInputData(RF, OutData) type(RegFile), intent(inout) :: RF type(BladeInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackBladeInputData' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -781,7 +781,7 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyInputFile' @@ -790,8 +790,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%member_total = SrcInputFileData%member_total DstInputFileData%kp_total = SrcInputFileData%kp_total if (allocated(SrcInputFileData%kp_member)) then - LB(1:1) = lbound(SrcInputFileData%kp_member, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%kp_member, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%kp_member) + UB(1:1) = ubound(SrcInputFileData%kp_member) if (.not. allocated(DstInputFileData%kp_member)) then allocate(DstInputFileData%kp_member(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -819,8 +819,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol if (allocated(SrcInputFileData%kp_coordinate)) then - LB(1:2) = lbound(SrcInputFileData%kp_coordinate, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%kp_coordinate, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%kp_coordinate) + UB(1:2) = ubound(SrcInputFileData%kp_coordinate) if (.not. allocated(DstInputFileData%kp_coordinate)) then allocate(DstInputFileData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -841,8 +841,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%OutNd = SrcInputFileData%OutNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -856,8 +856,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%OutFmt = SrcInputFileData%OutFmt DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -868,8 +868,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList end if if (allocated(SrcInputFileData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd) if (.not. allocated(DstInputFileData%BldNd_BlOutNd)) then allocate(DstInputFileData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -958,7 +958,7 @@ subroutine BD_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInputFile' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1006,14 +1006,14 @@ subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%q)) then - LB(1:2) = lbound(SrcContStateData%q, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%q, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%q) + UB(1:2) = ubound(SrcContStateData%q) if (.not. allocated(DstContStateData%q)) then allocate(DstContStateData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1024,8 +1024,8 @@ subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%q = SrcContStateData%q end if if (allocated(SrcContStateData%dqdt)) then - LB(1:2) = lbound(SrcContStateData%dqdt, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%dqdt, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%dqdt) + UB(1:2) = ubound(SrcContStateData%dqdt) if (.not. allocated(DstContStateData%dqdt)) then allocate(DstContStateData%dqdt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1066,7 +1066,7 @@ subroutine BD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackContState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1159,14 +1159,14 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%acc)) then - LB(1:2) = lbound(SrcOtherStateData%acc, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%acc, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%acc) + UB(1:2) = ubound(SrcOtherStateData%acc) if (.not. allocated(DstOtherStateData%acc)) then allocate(DstOtherStateData%acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1177,8 +1177,8 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%acc = SrcOtherStateData%acc end if if (allocated(SrcOtherStateData%xcc)) then - LB(1:2) = lbound(SrcOtherStateData%xcc, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%xcc, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%xcc) + UB(1:2) = ubound(SrcOtherStateData%xcc) if (.not. allocated(DstOtherStateData%xcc)) then allocate(DstOtherStateData%xcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1229,7 +1229,7 @@ subroutine BD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackOtherState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1248,14 +1248,14 @@ subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyqpParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcqpParamData%mmm)) then - LB(1:2) = lbound(SrcqpParamData%mmm, kind=B8Ki) - UB(1:2) = ubound(SrcqpParamData%mmm, kind=B8Ki) + LB(1:2) = lbound(SrcqpParamData%mmm) + UB(1:2) = ubound(SrcqpParamData%mmm) if (.not. allocated(DstqpParamData%mmm)) then allocate(DstqpParamData%mmm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1266,8 +1266,8 @@ subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Err DstqpParamData%mmm = SrcqpParamData%mmm end if if (allocated(SrcqpParamData%mEta)) then - LB(1:3) = lbound(SrcqpParamData%mEta, kind=B8Ki) - UB(1:3) = ubound(SrcqpParamData%mEta, kind=B8Ki) + LB(1:3) = lbound(SrcqpParamData%mEta) + UB(1:3) = ubound(SrcqpParamData%mEta) if (.not. allocated(DstqpParamData%mEta)) then allocate(DstqpParamData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1308,7 +1308,7 @@ subroutine BD_UnPackqpParam(RF, OutData) type(RegFile), intent(inout) :: RF type(qpParam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackqpParam' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1322,8 +1322,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyParam' @@ -1345,8 +1345,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%coef = SrcParamData%coef DstParamData%rhoinf = SrcParamData%rhoinf if (allocated(SrcParamData%uuN0)) then - LB(1:3) = lbound(SrcParamData%uuN0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%uuN0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%uuN0) + UB(1:3) = ubound(SrcParamData%uuN0) if (.not. allocated(DstParamData%uuN0)) then allocate(DstParamData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1357,8 +1357,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uuN0 = SrcParamData%uuN0 end if if (allocated(SrcParamData%Stif0_QP)) then - LB(1:3) = lbound(SrcParamData%Stif0_QP, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Stif0_QP, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Stif0_QP) + UB(1:3) = ubound(SrcParamData%Stif0_QP) if (.not. allocated(DstParamData%Stif0_QP)) then allocate(DstParamData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1369,8 +1369,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Stif0_QP = SrcParamData%Stif0_QP end if if (allocated(SrcParamData%Mass0_QP)) then - LB(1:3) = lbound(SrcParamData%Mass0_QP, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Mass0_QP, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Mass0_QP) + UB(1:3) = ubound(SrcParamData%Mass0_QP) if (.not. allocated(DstParamData%Mass0_QP)) then allocate(DstParamData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1382,8 +1382,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%gravity = SrcParamData%gravity if (allocated(SrcParamData%segment_eta)) then - LB(1:1) = lbound(SrcParamData%segment_eta, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%segment_eta, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%segment_eta) + UB(1:1) = ubound(SrcParamData%segment_eta) if (.not. allocated(DstParamData%segment_eta)) then allocate(DstParamData%segment_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1394,8 +1394,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%segment_eta = SrcParamData%segment_eta end if if (allocated(SrcParamData%member_eta)) then - LB(1:1) = lbound(SrcParamData%member_eta, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%member_eta, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%member_eta) + UB(1:1) = ubound(SrcParamData%member_eta) if (.not. allocated(DstParamData%member_eta)) then allocate(DstParamData%member_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1412,8 +1412,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%beta = SrcParamData%beta DstParamData%tol = SrcParamData%tol if (allocated(SrcParamData%QPtN)) then - LB(1:1) = lbound(SrcParamData%QPtN, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%QPtN, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%QPtN) + UB(1:1) = ubound(SrcParamData%QPtN) if (.not. allocated(DstParamData%QPtN)) then allocate(DstParamData%QPtN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1424,8 +1424,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtN = SrcParamData%QPtN end if if (allocated(SrcParamData%QPtWeight)) then - LB(1:1) = lbound(SrcParamData%QPtWeight, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%QPtWeight, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%QPtWeight) + UB(1:1) = ubound(SrcParamData%QPtWeight) if (.not. allocated(DstParamData%QPtWeight)) then allocate(DstParamData%QPtWeight(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1436,8 +1436,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtWeight = SrcParamData%QPtWeight end if if (allocated(SrcParamData%Shp)) then - LB(1:2) = lbound(SrcParamData%Shp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Shp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Shp) + UB(1:2) = ubound(SrcParamData%Shp) if (.not. allocated(DstParamData%Shp)) then allocate(DstParamData%Shp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1448,8 +1448,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Shp = SrcParamData%Shp end if if (allocated(SrcParamData%ShpDer)) then - LB(1:2) = lbound(SrcParamData%ShpDer, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%ShpDer, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%ShpDer) + UB(1:2) = ubound(SrcParamData%ShpDer) if (.not. allocated(DstParamData%ShpDer)) then allocate(DstParamData%ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1460,8 +1460,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ShpDer = SrcParamData%ShpDer end if if (allocated(SrcParamData%Jacobian)) then - LB(1:2) = lbound(SrcParamData%Jacobian, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jacobian, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jacobian) + UB(1:2) = ubound(SrcParamData%Jacobian) if (.not. allocated(DstParamData%Jacobian)) then allocate(DstParamData%Jacobian(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1472,8 +1472,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jacobian = SrcParamData%Jacobian end if if (allocated(SrcParamData%uu0)) then - LB(1:3) = lbound(SrcParamData%uu0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%uu0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%uu0) + UB(1:3) = ubound(SrcParamData%uu0) if (.not. allocated(DstParamData%uu0)) then allocate(DstParamData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1484,8 +1484,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uu0 = SrcParamData%uu0 end if if (allocated(SrcParamData%rrN0)) then - LB(1:3) = lbound(SrcParamData%rrN0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%rrN0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%rrN0) + UB(1:3) = ubound(SrcParamData%rrN0) if (.not. allocated(DstParamData%rrN0)) then allocate(DstParamData%rrN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1496,8 +1496,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rrN0 = SrcParamData%rrN0 end if if (allocated(SrcParamData%E10)) then - LB(1:3) = lbound(SrcParamData%E10, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%E10, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%E10) + UB(1:3) = ubound(SrcParamData%E10) if (.not. allocated(DstParamData%E10)) then allocate(DstParamData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1509,8 +1509,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem if (allocated(SrcParamData%node_elem_idx)) then - LB(1:2) = lbound(SrcParamData%node_elem_idx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%node_elem_idx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%node_elem_idx) + UB(1:2) = ubound(SrcParamData%node_elem_idx) if (.not. allocated(DstParamData%node_elem_idx)) then allocate(DstParamData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1537,8 +1537,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutInputs = SrcParamData%OutInputs DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1555,8 +1555,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NNodeOuts = SrcParamData%NNodeOuts DstParamData%OutNd = SrcParamData%OutNd if (allocated(SrcParamData%NdIndx)) then - LB(1:1) = lbound(SrcParamData%NdIndx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NdIndx, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NdIndx) + UB(1:1) = ubound(SrcParamData%NdIndx) if (.not. allocated(DstParamData%NdIndx)) then allocate(DstParamData%NdIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1567,8 +1567,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NdIndx = SrcParamData%NdIndx end if if (allocated(SrcParamData%NdIndxInverse)) then - LB(1:1) = lbound(SrcParamData%NdIndxInverse, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NdIndxInverse, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NdIndxInverse) + UB(1:1) = ubound(SrcParamData%NdIndxInverse) if (.not. allocated(DstParamData%NdIndxInverse)) then allocate(DstParamData%NdIndxInverse(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1579,8 +1579,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse end if if (allocated(SrcParamData%OutNd2NdElem)) then - LB(1:2) = lbound(SrcParamData%OutNd2NdElem, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%OutNd2NdElem, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%OutNd2NdElem) + UB(1:2) = ubound(SrcParamData%OutNd2NdElem) if (.not. allocated(DstParamData%OutNd2NdElem)) then allocate(DstParamData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1608,8 +1608,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts if (allocated(SrcParamData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) if (.not. allocated(DstParamData%BldNd_OutParam)) then allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1624,8 +1624,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd) if (.not. allocated(DstParamData%BldNd_BlOutNd)) then allocate(DstParamData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1636,8 +1636,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd end if if (allocated(SrcParamData%QPtw_Shp_Shp_Jac)) then - LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac) if (.not. allocated(DstParamData%QPtw_Shp_Shp_Jac)) then allocate(DstParamData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1648,8 +1648,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac end if if (allocated(SrcParamData%QPtw_Shp_ShpDer)) then - LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer) if (.not. allocated(DstParamData%QPtw_Shp_ShpDer)) then allocate(DstParamData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1660,8 +1660,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer end if if (allocated(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) then - LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) if (.not. allocated(DstParamData%QPtw_ShpDer_ShpDer_Jac)) then allocate(DstParamData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1672,8 +1672,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac end if if (allocated(SrcParamData%QPtw_Shp_Jac)) then - LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac) if (.not. allocated(DstParamData%QPtw_Shp_Jac)) then allocate(DstParamData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1684,8 +1684,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac end if if (allocated(SrcParamData%QPtw_ShpDer)) then - LB(1:2) = lbound(SrcParamData%QPtw_ShpDer, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%QPtw_ShpDer, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%QPtw_ShpDer) + UB(1:2) = ubound(SrcParamData%QPtw_ShpDer) if (.not. allocated(DstParamData%QPtw_ShpDer)) then allocate(DstParamData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1696,8 +1696,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer end if if (allocated(SrcParamData%FEweight)) then - LB(1:2) = lbound(SrcParamData%FEweight, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%FEweight, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%FEweight) + UB(1:2) = ubound(SrcParamData%FEweight) if (.not. allocated(DstParamData%FEweight)) then allocate(DstParamData%FEweight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1715,8 +1715,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) type(BD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_DestroyParam' @@ -1771,8 +1771,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%node_elem_idx) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1791,8 +1791,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) call BD_DestroyqpParam(ParamData%qp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%BldNd_OutParam)) then - LB(1:1) = lbound(ParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1826,8 +1826,8 @@ subroutine BD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(BD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, associated(InData%Vars)) @@ -1880,9 +1880,9 @@ subroutine BD_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1909,9 +1909,9 @@ subroutine BD_PackParam(RF, Indata) call RegPack(RF, InData%BldNd_TotNumOuts) call RegPack(RF, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) end do @@ -1932,8 +1932,8 @@ subroutine BD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2128,7 +2128,7 @@ subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyOutput' @@ -2143,8 +2143,8 @@ subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%RootMxr = SrcOutputData%RootMxr DstOutputData%RootMyr = SrcOutputData%RootMyr if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2191,7 +2191,7 @@ subroutine BD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2208,14 +2208,14 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyEqMotionQP' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcEqMotionQPData%uuu)) then - LB(1:3) = lbound(SrcEqMotionQPData%uuu, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%uuu, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%uuu) + UB(1:3) = ubound(SrcEqMotionQPData%uuu) if (.not. allocated(DstEqMotionQPData%uuu)) then allocate(DstEqMotionQPData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2226,8 +2226,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu end if if (allocated(SrcEqMotionQPData%uup)) then - LB(1:3) = lbound(SrcEqMotionQPData%uup, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%uup, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%uup) + UB(1:3) = ubound(SrcEqMotionQPData%uup) if (.not. allocated(DstEqMotionQPData%uup)) then allocate(DstEqMotionQPData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2238,8 +2238,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%uup = SrcEqMotionQPData%uup end if if (allocated(SrcEqMotionQPData%vvv)) then - LB(1:3) = lbound(SrcEqMotionQPData%vvv, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%vvv, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%vvv) + UB(1:3) = ubound(SrcEqMotionQPData%vvv) if (.not. allocated(DstEqMotionQPData%vvv)) then allocate(DstEqMotionQPData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2250,8 +2250,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv end if if (allocated(SrcEqMotionQPData%vvp)) then - LB(1:3) = lbound(SrcEqMotionQPData%vvp, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%vvp, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%vvp) + UB(1:3) = ubound(SrcEqMotionQPData%vvp) if (.not. allocated(DstEqMotionQPData%vvp)) then allocate(DstEqMotionQPData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2262,8 +2262,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp end if if (allocated(SrcEqMotionQPData%aaa)) then - LB(1:3) = lbound(SrcEqMotionQPData%aaa, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%aaa, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%aaa) + UB(1:3) = ubound(SrcEqMotionQPData%aaa) if (.not. allocated(DstEqMotionQPData%aaa)) then allocate(DstEqMotionQPData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2274,8 +2274,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa end if if (allocated(SrcEqMotionQPData%RR0)) then - LB(1:4) = lbound(SrcEqMotionQPData%RR0, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%RR0, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%RR0) + UB(1:4) = ubound(SrcEqMotionQPData%RR0) if (.not. allocated(DstEqMotionQPData%RR0)) then allocate(DstEqMotionQPData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2286,8 +2286,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 end if if (allocated(SrcEqMotionQPData%kappa)) then - LB(1:3) = lbound(SrcEqMotionQPData%kappa, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%kappa, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%kappa) + UB(1:3) = ubound(SrcEqMotionQPData%kappa) if (.not. allocated(DstEqMotionQPData%kappa)) then allocate(DstEqMotionQPData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2298,8 +2298,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa end if if (allocated(SrcEqMotionQPData%E1)) then - LB(1:3) = lbound(SrcEqMotionQPData%E1, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%E1, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%E1) + UB(1:3) = ubound(SrcEqMotionQPData%E1) if (.not. allocated(DstEqMotionQPData%E1)) then allocate(DstEqMotionQPData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2310,8 +2310,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 end if if (allocated(SrcEqMotionQPData%Stif)) then - LB(1:4) = lbound(SrcEqMotionQPData%Stif, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Stif, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Stif) + UB(1:4) = ubound(SrcEqMotionQPData%Stif) if (.not. allocated(DstEqMotionQPData%Stif)) then allocate(DstEqMotionQPData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2322,8 +2322,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif end if if (allocated(SrcEqMotionQPData%Fb)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fb, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fb, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fb) + UB(1:3) = ubound(SrcEqMotionQPData%Fb) if (.not. allocated(DstEqMotionQPData%Fb)) then allocate(DstEqMotionQPData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2334,8 +2334,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb end if if (allocated(SrcEqMotionQPData%Fc)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fc, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fc, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fc) + UB(1:3) = ubound(SrcEqMotionQPData%Fc) if (.not. allocated(DstEqMotionQPData%Fc)) then allocate(DstEqMotionQPData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2346,8 +2346,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc end if if (allocated(SrcEqMotionQPData%Fd)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fd, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fd, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fd) + UB(1:3) = ubound(SrcEqMotionQPData%Fd) if (.not. allocated(DstEqMotionQPData%Fd)) then allocate(DstEqMotionQPData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2358,8 +2358,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd end if if (allocated(SrcEqMotionQPData%Fg)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fg, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fg, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fg) + UB(1:3) = ubound(SrcEqMotionQPData%Fg) if (.not. allocated(DstEqMotionQPData%Fg)) then allocate(DstEqMotionQPData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2370,8 +2370,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg end if if (allocated(SrcEqMotionQPData%Fi)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fi, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fi, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fi) + UB(1:3) = ubound(SrcEqMotionQPData%Fi) if (.not. allocated(DstEqMotionQPData%Fi)) then allocate(DstEqMotionQPData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2382,8 +2382,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi end if if (allocated(SrcEqMotionQPData%Ftemp)) then - LB(1:3) = lbound(SrcEqMotionQPData%Ftemp, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Ftemp, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Ftemp) + UB(1:3) = ubound(SrcEqMotionQPData%Ftemp) if (.not. allocated(DstEqMotionQPData%Ftemp)) then allocate(DstEqMotionQPData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2394,8 +2394,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp end if if (allocated(SrcEqMotionQPData%RR0mEta)) then - LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta) + UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta) if (.not. allocated(DstEqMotionQPData%RR0mEta)) then allocate(DstEqMotionQPData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2406,8 +2406,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta end if if (allocated(SrcEqMotionQPData%rho)) then - LB(1:4) = lbound(SrcEqMotionQPData%rho, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%rho, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%rho) + UB(1:4) = ubound(SrcEqMotionQPData%rho) if (.not. allocated(DstEqMotionQPData%rho)) then allocate(DstEqMotionQPData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2418,8 +2418,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%rho = SrcEqMotionQPData%rho end if if (allocated(SrcEqMotionQPData%betaC)) then - LB(1:4) = lbound(SrcEqMotionQPData%betaC, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%betaC, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%betaC) + UB(1:4) = ubound(SrcEqMotionQPData%betaC) if (.not. allocated(DstEqMotionQPData%betaC)) then allocate(DstEqMotionQPData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2430,8 +2430,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC end if if (allocated(SrcEqMotionQPData%Gi)) then - LB(1:4) = lbound(SrcEqMotionQPData%Gi, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Gi, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Gi) + UB(1:4) = ubound(SrcEqMotionQPData%Gi) if (.not. allocated(DstEqMotionQPData%Gi)) then allocate(DstEqMotionQPData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2442,8 +2442,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi end if if (allocated(SrcEqMotionQPData%Ki)) then - LB(1:4) = lbound(SrcEqMotionQPData%Ki, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Ki, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Ki) if (.not. allocated(DstEqMotionQPData%Ki)) then allocate(DstEqMotionQPData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2454,8 +2454,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki end if if (allocated(SrcEqMotionQPData%Mi)) then - LB(1:4) = lbound(SrcEqMotionQPData%Mi, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Mi, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Mi) + UB(1:4) = ubound(SrcEqMotionQPData%Mi) if (.not. allocated(DstEqMotionQPData%Mi)) then allocate(DstEqMotionQPData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2466,8 +2466,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi end if if (allocated(SrcEqMotionQPData%Oe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Oe, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Oe, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Oe) + UB(1:4) = ubound(SrcEqMotionQPData%Oe) if (.not. allocated(DstEqMotionQPData%Oe)) then allocate(DstEqMotionQPData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2478,8 +2478,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe end if if (allocated(SrcEqMotionQPData%Pe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Pe, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Pe, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Pe) + UB(1:4) = ubound(SrcEqMotionQPData%Pe) if (.not. allocated(DstEqMotionQPData%Pe)) then allocate(DstEqMotionQPData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2490,8 +2490,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe end if if (allocated(SrcEqMotionQPData%Qe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Qe, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Qe, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Qe) + UB(1:4) = ubound(SrcEqMotionQPData%Qe) if (.not. allocated(DstEqMotionQPData%Qe)) then allocate(DstEqMotionQPData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2502,8 +2502,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe end if if (allocated(SrcEqMotionQPData%Gd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Gd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Gd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Gd) + UB(1:4) = ubound(SrcEqMotionQPData%Gd) if (.not. allocated(DstEqMotionQPData%Gd)) then allocate(DstEqMotionQPData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2514,8 +2514,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd end if if (allocated(SrcEqMotionQPData%Od)) then - LB(1:4) = lbound(SrcEqMotionQPData%Od, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Od, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Od) + UB(1:4) = ubound(SrcEqMotionQPData%Od) if (.not. allocated(DstEqMotionQPData%Od)) then allocate(DstEqMotionQPData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2526,8 +2526,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Od = SrcEqMotionQPData%Od end if if (allocated(SrcEqMotionQPData%Pd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Pd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Pd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Pd) + UB(1:4) = ubound(SrcEqMotionQPData%Pd) if (.not. allocated(DstEqMotionQPData%Pd)) then allocate(DstEqMotionQPData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2538,8 +2538,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd end if if (allocated(SrcEqMotionQPData%Qd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Qd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Qd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Qd) + UB(1:4) = ubound(SrcEqMotionQPData%Qd) if (.not. allocated(DstEqMotionQPData%Qd)) then allocate(DstEqMotionQPData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2550,8 +2550,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd end if if (allocated(SrcEqMotionQPData%Sd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Sd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Sd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Sd) + UB(1:4) = ubound(SrcEqMotionQPData%Sd) if (.not. allocated(DstEqMotionQPData%Sd)) then allocate(DstEqMotionQPData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2562,8 +2562,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd end if if (allocated(SrcEqMotionQPData%Xd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Xd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Xd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Xd) + UB(1:4) = ubound(SrcEqMotionQPData%Xd) if (.not. allocated(DstEqMotionQPData%Xd)) then allocate(DstEqMotionQPData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2574,8 +2574,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd end if if (allocated(SrcEqMotionQPData%Yd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Yd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Yd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Yd) + UB(1:4) = ubound(SrcEqMotionQPData%Yd) if (.not. allocated(DstEqMotionQPData%Yd)) then allocate(DstEqMotionQPData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2732,7 +2732,7 @@ subroutine BD_UnPackEqMotionQP(RF, OutData) type(RegFile), intent(inout) :: RF type(EqMotionQP), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackEqMotionQP' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2775,7 +2775,7 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyMisc' @@ -2798,8 +2798,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%lin_A)) then - LB(1:2) = lbound(SrcMiscData%lin_A, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%lin_A, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%lin_A) + UB(1:2) = ubound(SrcMiscData%lin_A) if (.not. allocated(DstMiscData%lin_A)) then allocate(DstMiscData%lin_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2810,8 +2810,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%lin_A = SrcMiscData%lin_A end if if (allocated(SrcMiscData%lin_C)) then - LB(1:2) = lbound(SrcMiscData%lin_C, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%lin_C, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%lin_C) + UB(1:2) = ubound(SrcMiscData%lin_C) if (.not. allocated(DstMiscData%lin_C)) then allocate(DstMiscData%lin_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2822,8 +2822,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%lin_C = SrcMiscData%lin_C end if if (allocated(SrcMiscData%Nrrr)) then - LB(1:3) = lbound(SrcMiscData%Nrrr, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%Nrrr, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%Nrrr) + UB(1:3) = ubound(SrcMiscData%Nrrr) if (.not. allocated(DstMiscData%Nrrr)) then allocate(DstMiscData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2834,8 +2834,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Nrrr = SrcMiscData%Nrrr end if if (allocated(SrcMiscData%elf)) then - LB(1:2) = lbound(SrcMiscData%elf, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%elf, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%elf) + UB(1:2) = ubound(SrcMiscData%elf) if (.not. allocated(DstMiscData%elf)) then allocate(DstMiscData%elf(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2846,8 +2846,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elf = SrcMiscData%elf end if if (allocated(SrcMiscData%EFint)) then - LB(1:3) = lbound(SrcMiscData%EFint, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%EFint, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%EFint) + UB(1:3) = ubound(SrcMiscData%EFint) if (.not. allocated(DstMiscData%EFint)) then allocate(DstMiscData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2858,8 +2858,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%EFint = SrcMiscData%EFint end if if (allocated(SrcMiscData%elk)) then - LB(1:4) = lbound(SrcMiscData%elk, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%elk, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%elk) + UB(1:4) = ubound(SrcMiscData%elk) if (.not. allocated(DstMiscData%elk)) then allocate(DstMiscData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2870,8 +2870,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elk = SrcMiscData%elk end if if (allocated(SrcMiscData%elg)) then - LB(1:4) = lbound(SrcMiscData%elg, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%elg, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%elg) + UB(1:4) = ubound(SrcMiscData%elg) if (.not. allocated(DstMiscData%elg)) then allocate(DstMiscData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2882,8 +2882,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elg = SrcMiscData%elg end if if (allocated(SrcMiscData%elm)) then - LB(1:4) = lbound(SrcMiscData%elm, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%elm, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%elm) + UB(1:4) = ubound(SrcMiscData%elm) if (.not. allocated(DstMiscData%elm)) then allocate(DstMiscData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2894,8 +2894,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elm = SrcMiscData%elm end if if (allocated(SrcMiscData%DistrLoad_QP)) then - LB(1:3) = lbound(SrcMiscData%DistrLoad_QP, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%DistrLoad_QP, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%DistrLoad_QP) + UB(1:3) = ubound(SrcMiscData%DistrLoad_QP) if (.not. allocated(DstMiscData%DistrLoad_QP)) then allocate(DstMiscData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2906,8 +2906,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP end if if (allocated(SrcMiscData%PointLoadLcl)) then - LB(1:2) = lbound(SrcMiscData%PointLoadLcl, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%PointLoadLcl, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%PointLoadLcl) + UB(1:2) = ubound(SrcMiscData%PointLoadLcl) if (.not. allocated(DstMiscData%PointLoadLcl)) then allocate(DstMiscData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2918,8 +2918,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl end if if (allocated(SrcMiscData%StifK)) then - LB(1:4) = lbound(SrcMiscData%StifK, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%StifK, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%StifK) + UB(1:4) = ubound(SrcMiscData%StifK) if (.not. allocated(DstMiscData%StifK)) then allocate(DstMiscData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2930,8 +2930,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%StifK = SrcMiscData%StifK end if if (allocated(SrcMiscData%MassM)) then - LB(1:4) = lbound(SrcMiscData%MassM, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%MassM, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%MassM) + UB(1:4) = ubound(SrcMiscData%MassM) if (.not. allocated(DstMiscData%MassM)) then allocate(DstMiscData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2942,8 +2942,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%MassM = SrcMiscData%MassM end if if (allocated(SrcMiscData%DampG)) then - LB(1:4) = lbound(SrcMiscData%DampG, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%DampG, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%DampG) + UB(1:4) = ubound(SrcMiscData%DampG) if (.not. allocated(DstMiscData%DampG)) then allocate(DstMiscData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2954,8 +2954,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DampG = SrcMiscData%DampG end if if (allocated(SrcMiscData%StifK_fd)) then - LB(1:4) = lbound(SrcMiscData%StifK_fd, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%StifK_fd, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%StifK_fd) + UB(1:4) = ubound(SrcMiscData%StifK_fd) if (.not. allocated(DstMiscData%StifK_fd)) then allocate(DstMiscData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2966,8 +2966,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%StifK_fd = SrcMiscData%StifK_fd end if if (allocated(SrcMiscData%MassM_fd)) then - LB(1:4) = lbound(SrcMiscData%MassM_fd, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%MassM_fd, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%MassM_fd) + UB(1:4) = ubound(SrcMiscData%MassM_fd) if (.not. allocated(DstMiscData%MassM_fd)) then allocate(DstMiscData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2978,8 +2978,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%MassM_fd = SrcMiscData%MassM_fd end if if (allocated(SrcMiscData%DampG_fd)) then - LB(1:4) = lbound(SrcMiscData%DampG_fd, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%DampG_fd, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%DampG_fd) + UB(1:4) = ubound(SrcMiscData%DampG_fd) if (.not. allocated(DstMiscData%DampG_fd)) then allocate(DstMiscData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2990,8 +2990,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DampG_fd = SrcMiscData%DampG_fd end if if (allocated(SrcMiscData%RHS)) then - LB(1:2) = lbound(SrcMiscData%RHS, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%RHS, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%RHS) + UB(1:2) = ubound(SrcMiscData%RHS) if (.not. allocated(DstMiscData%RHS)) then allocate(DstMiscData%RHS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3002,8 +3002,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS = SrcMiscData%RHS end if if (allocated(SrcMiscData%RHS_p)) then - LB(1:2) = lbound(SrcMiscData%RHS_p, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%RHS_p, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%RHS_p) + UB(1:2) = ubound(SrcMiscData%RHS_p) if (.not. allocated(DstMiscData%RHS_p)) then allocate(DstMiscData%RHS_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3014,8 +3014,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS_p = SrcMiscData%RHS_p end if if (allocated(SrcMiscData%RHS_m)) then - LB(1:2) = lbound(SrcMiscData%RHS_m, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%RHS_m, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%RHS_m) + UB(1:2) = ubound(SrcMiscData%RHS_m) if (.not. allocated(DstMiscData%RHS_m)) then allocate(DstMiscData%RHS_m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3026,8 +3026,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS_m = SrcMiscData%RHS_m end if if (allocated(SrcMiscData%BldInternalForceFE)) then - LB(1:2) = lbound(SrcMiscData%BldInternalForceFE, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BldInternalForceFE, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%BldInternalForceFE) + UB(1:2) = ubound(SrcMiscData%BldInternalForceFE) if (.not. allocated(DstMiscData%BldInternalForceFE)) then allocate(DstMiscData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3038,8 +3038,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE end if if (allocated(SrcMiscData%BldInternalForceQP)) then - LB(1:2) = lbound(SrcMiscData%BldInternalForceQP, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BldInternalForceQP, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%BldInternalForceQP) + UB(1:2) = ubound(SrcMiscData%BldInternalForceQP) if (.not. allocated(DstMiscData%BldInternalForceQP)) then allocate(DstMiscData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3050,8 +3050,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP end if if (allocated(SrcMiscData%FirstNodeReactionLclForceMoment)) then - LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment) + UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment) if (.not. allocated(DstMiscData%FirstNodeReactionLclForceMoment)) then allocate(DstMiscData%FirstNodeReactionLclForceMoment(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3062,8 +3062,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment end if if (allocated(SrcMiscData%Solution)) then - LB(1:2) = lbound(SrcMiscData%Solution, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Solution, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%Solution) + UB(1:2) = ubound(SrcMiscData%Solution) if (.not. allocated(DstMiscData%Solution)) then allocate(DstMiscData%Solution(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3074,8 +3074,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Solution = SrcMiscData%Solution end if if (allocated(SrcMiscData%LP_StifK)) then - LB(1:2) = lbound(SrcMiscData%LP_StifK, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LP_StifK, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LP_StifK) + UB(1:2) = ubound(SrcMiscData%LP_StifK) if (.not. allocated(DstMiscData%LP_StifK)) then allocate(DstMiscData%LP_StifK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3086,8 +3086,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_StifK = SrcMiscData%LP_StifK end if if (allocated(SrcMiscData%LP_MassM)) then - LB(1:2) = lbound(SrcMiscData%LP_MassM, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LP_MassM, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LP_MassM) + UB(1:2) = ubound(SrcMiscData%LP_MassM) if (.not. allocated(DstMiscData%LP_MassM)) then allocate(DstMiscData%LP_MassM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3098,8 +3098,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_MassM = SrcMiscData%LP_MassM end if if (allocated(SrcMiscData%LP_MassM_LU)) then - LB(1:2) = lbound(SrcMiscData%LP_MassM_LU, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LP_MassM_LU, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LP_MassM_LU) + UB(1:2) = ubound(SrcMiscData%LP_MassM_LU) if (.not. allocated(DstMiscData%LP_MassM_LU)) then allocate(DstMiscData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3110,8 +3110,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU end if if (allocated(SrcMiscData%LP_RHS)) then - LB(1:1) = lbound(SrcMiscData%LP_RHS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LP_RHS, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LP_RHS) + UB(1:1) = ubound(SrcMiscData%LP_RHS) if (.not. allocated(DstMiscData%LP_RHS)) then allocate(DstMiscData%LP_RHS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3122,8 +3122,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_RHS = SrcMiscData%LP_RHS end if if (allocated(SrcMiscData%LP_StifK_LU)) then - LB(1:2) = lbound(SrcMiscData%LP_StifK_LU, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LP_StifK_LU, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LP_StifK_LU) + UB(1:2) = ubound(SrcMiscData%LP_StifK_LU) if (.not. allocated(DstMiscData%LP_StifK_LU)) then allocate(DstMiscData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3134,8 +3134,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU end if if (allocated(SrcMiscData%LP_RHS_LU)) then - LB(1:1) = lbound(SrcMiscData%LP_RHS_LU, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LP_RHS_LU, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LP_RHS_LU) + UB(1:1) = ubound(SrcMiscData%LP_RHS_LU) if (.not. allocated(DstMiscData%LP_RHS_LU)) then allocate(DstMiscData%LP_RHS_LU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3146,8 +3146,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU end if if (allocated(SrcMiscData%LP_indx)) then - LB(1:1) = lbound(SrcMiscData%LP_indx, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LP_indx, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LP_indx) + UB(1:1) = ubound(SrcMiscData%LP_indx) if (.not. allocated(DstMiscData%LP_indx)) then allocate(DstMiscData%LP_indx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3360,7 +3360,7 @@ subroutine BD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackMisc' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 92f2a42d68..37f50cd60a 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -977,15 +977,15 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -996,8 +996,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1012,8 +1012,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err if (ErrStat >= AbortErrLev) return DstInitOutputData%NumBl = SrcInitOutputData%NumBl if (allocated(SrcInitOutputData%BlPitch)) then - LB(1:1) = lbound(SrcInitOutputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%BlPitch) + UB(1:1) = ubound(SrcInitOutputData%BlPitch) if (.not. allocated(DstInitOutputData%BlPitch)) then allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1028,8 +1028,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight DstInitOutputData%HubHt = SrcInitOutputData%HubHt if (allocated(SrcInitOutputData%BldRNodes)) then - LB(1:1) = lbound(SrcInitOutputData%BldRNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%BldRNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%BldRNodes) + UB(1:1) = ubound(SrcInitOutputData%BldRNodes) if (.not. allocated(DstInitOutputData%BldRNodes)) then allocate(DstInitOutputData%BldRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1040,8 +1040,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes end if if (allocated(SrcInitOutputData%TwrHNodes)) then - LB(1:1) = lbound(SrcInitOutputData%TwrHNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%TwrHNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%TwrHNodes) + UB(1:1) = ubound(SrcInitOutputData%TwrHNodes) if (.not. allocated(DstInitOutputData%TwrHNodes)) then allocate(DstInitOutputData%TwrHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1060,8 +1060,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1072,8 +1072,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1084,8 +1084,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1096,8 +1096,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1108,8 +1108,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1120,8 +1120,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1132,8 +1132,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1144,8 +1144,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1256,7 +1256,7 @@ subroutine ED_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInitOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1297,15 +1297,15 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyBladeInputData' ErrStat = ErrID_None ErrMsg = '' DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt if (allocated(SrcBladeInputDataData%BlFract)) then - LB(1:1) = lbound(SrcBladeInputDataData%BlFract, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BlFract, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BlFract) + UB(1:1) = ubound(SrcBladeInputDataData%BlFract) if (.not. allocated(DstBladeInputDataData%BlFract)) then allocate(DstBladeInputDataData%BlFract(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1316,8 +1316,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract end if if (allocated(SrcBladeInputDataData%PitchAx)) then - LB(1:1) = lbound(SrcBladeInputDataData%PitchAx, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%PitchAx, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%PitchAx) + UB(1:1) = ubound(SrcBladeInputDataData%PitchAx) if (.not. allocated(DstBladeInputDataData%PitchAx)) then allocate(DstBladeInputDataData%PitchAx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1328,8 +1328,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx end if if (allocated(SrcBladeInputDataData%StrcTwst)) then - LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst) + UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst) if (.not. allocated(DstBladeInputDataData%StrcTwst)) then allocate(DstBladeInputDataData%StrcTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1340,8 +1340,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst end if if (allocated(SrcBladeInputDataData%BMassDen)) then - LB(1:1) = lbound(SrcBladeInputDataData%BMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BMassDen) + UB(1:1) = ubound(SrcBladeInputDataData%BMassDen) if (.not. allocated(DstBladeInputDataData%BMassDen)) then allocate(DstBladeInputDataData%BMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1352,8 +1352,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen end if if (allocated(SrcBladeInputDataData%FlpStff)) then - LB(1:1) = lbound(SrcBladeInputDataData%FlpStff, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%FlpStff, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%FlpStff) + UB(1:1) = ubound(SrcBladeInputDataData%FlpStff) if (.not. allocated(DstBladeInputDataData%FlpStff)) then allocate(DstBladeInputDataData%FlpStff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1364,8 +1364,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff end if if (allocated(SrcBladeInputDataData%EdgStff)) then - LB(1:1) = lbound(SrcBladeInputDataData%EdgStff, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%EdgStff, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%EdgStff) + UB(1:1) = ubound(SrcBladeInputDataData%EdgStff) if (.not. allocated(DstBladeInputDataData%EdgStff)) then allocate(DstBladeInputDataData%EdgStff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1379,8 +1379,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr if (allocated(SrcBladeInputDataData%BldFl1Sh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh) if (.not. allocated(DstBladeInputDataData%BldFl1Sh)) then allocate(DstBladeInputDataData%BldFl1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1391,8 +1391,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh end if if (allocated(SrcBladeInputDataData%BldFl2Sh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh) if (.not. allocated(DstBladeInputDataData%BldFl2Sh)) then allocate(DstBladeInputDataData%BldFl2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1403,8 +1403,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh end if if (allocated(SrcBladeInputDataData%BldEdgSh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh) + UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh) if (.not. allocated(DstBladeInputDataData%BldEdgSh)) then allocate(DstBladeInputDataData%BldEdgSh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1477,7 +1477,7 @@ subroutine ED_UnPackBladeInputData(RF, OutData) type(RegFile), intent(inout) :: RF type(BladeInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackBladeInputData' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1502,15 +1502,15 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyBladeMeshInputData' ErrStat = ErrID_None ErrMsg = '' DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes if (allocated(SrcBladeMeshInputDataData%RNodes)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes, kind=B8Ki) - UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes, kind=B8Ki) + LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes) + UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes) if (.not. allocated(DstBladeMeshInputDataData%RNodes)) then allocate(DstBladeMeshInputDataData%RNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1521,8 +1521,8 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes end if if (allocated(SrcBladeMeshInputDataData%AeroTwst)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst, kind=B8Ki) - UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst, kind=B8Ki) + LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst) + UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst) if (.not. allocated(DstBladeMeshInputDataData%AeroTwst)) then allocate(DstBladeMeshInputDataData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1533,8 +1533,8 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst end if if (allocated(SrcBladeMeshInputDataData%Chord)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord, kind=B8Ki) - UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord, kind=B8Ki) + LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord) + UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord) if (.not. allocated(DstBladeMeshInputDataData%Chord)) then allocate(DstBladeMeshInputDataData%Chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1580,7 +1580,7 @@ subroutine ED_UnPackBladeMeshInputData(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_BladeMeshInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackBladeMeshInputData' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1596,8 +1596,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyInputFile' @@ -1624,8 +1624,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl DstInputFileData%IPDefl = SrcInputFileData%IPDefl if (allocated(SrcInputFileData%BlPitch)) then - LB(1:1) = lbound(SrcInputFileData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BlPitch) + UB(1:1) = ubound(SrcInputFileData%BlPitch) if (.not. allocated(DstInputFileData%BlPitch)) then allocate(DstInputFileData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1651,8 +1651,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TipRad = SrcInputFileData%TipRad DstInputFileData%HubRad = SrcInputFileData%HubRad if (allocated(SrcInputFileData%PreCone)) then - LB(1:1) = lbound(SrcInputFileData%PreCone, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PreCone, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PreCone) + UB(1:1) = ubound(SrcInputFileData%PreCone) if (.not. allocated(DstInputFileData%PreCone)) then allocate(DstInputFileData%PreCone(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1683,8 +1683,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt if (allocated(SrcInputFileData%TipMass)) then - LB(1:1) = lbound(SrcInputFileData%TipMass, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TipMass, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TipMass) + UB(1:1) = ubound(SrcInputFileData%TipMass) if (.not. allocated(DstInputFileData%TipMass)) then allocate(DstInputFileData%TipMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1709,8 +1709,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%PtfmXZIner = SrcInputFileData%PtfmXZIner DstInputFileData%BldNodes = SrcInputFileData%BldNodes if (allocated(SrcInputFileData%InpBlMesh)) then - LB(1:1) = lbound(SrcInputFileData%InpBlMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%InpBlMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%InpBlMesh) + UB(1:1) = ubound(SrcInputFileData%InpBlMesh) if (.not. allocated(DstInputFileData%InpBlMesh)) then allocate(DstInputFileData%InpBlMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1725,8 +1725,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end do end if if (allocated(SrcInputFileData%InpBl)) then - LB(1:1) = lbound(SrcInputFileData%InpBl, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%InpBl, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%InpBl) + UB(1:1) = ubound(SrcInputFileData%InpBl) if (.not. allocated(DstInputFileData%InpBl)) then allocate(DstInputFileData%InpBl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1770,8 +1770,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1787,8 +1787,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr if (allocated(SrcInputFileData%HtFract)) then - LB(1:1) = lbound(SrcInputFileData%HtFract, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%HtFract, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%HtFract) + UB(1:1) = ubound(SrcInputFileData%HtFract) if (.not. allocated(DstInputFileData%HtFract)) then allocate(DstInputFileData%HtFract(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1799,8 +1799,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%HtFract = SrcInputFileData%HtFract end if if (allocated(SrcInputFileData%TMassDen)) then - LB(1:1) = lbound(SrcInputFileData%TMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TMassDen) + UB(1:1) = ubound(SrcInputFileData%TMassDen) if (.not. allocated(DstInputFileData%TMassDen)) then allocate(DstInputFileData%TMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1811,8 +1811,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TMassDen = SrcInputFileData%TMassDen end if if (allocated(SrcInputFileData%TwFAStif)) then - LB(1:1) = lbound(SrcInputFileData%TwFAStif, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwFAStif, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwFAStif) + UB(1:1) = ubound(SrcInputFileData%TwFAStif) if (.not. allocated(DstInputFileData%TwFAStif)) then allocate(DstInputFileData%TwFAStif(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1823,8 +1823,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif end if if (allocated(SrcInputFileData%TwSSStif)) then - LB(1:1) = lbound(SrcInputFileData%TwSSStif, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwSSStif, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwSSStif) + UB(1:1) = ubound(SrcInputFileData%TwSSStif) if (.not. allocated(DstInputFileData%TwSSStif)) then allocate(DstInputFileData%TwSSStif(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1835,8 +1835,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif end if if (allocated(SrcInputFileData%TwFAM1Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh) if (.not. allocated(DstInputFileData%TwFAM1Sh)) then allocate(DstInputFileData%TwFAM1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1847,8 +1847,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh end if if (allocated(SrcInputFileData%TwFAM2Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh) if (.not. allocated(DstInputFileData%TwFAM2Sh)) then allocate(DstInputFileData%TwFAM2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1859,8 +1859,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh end if if (allocated(SrcInputFileData%TwSSM1Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh) if (.not. allocated(DstInputFileData%TwSSM1Sh)) then allocate(DstInputFileData%TwSSM1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1871,8 +1871,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh end if if (allocated(SrcInputFileData%TwSSM2Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh) if (.not. allocated(DstInputFileData%TwSSM2Sh)) then allocate(DstInputFileData%TwSSM2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1927,8 +1927,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%method = SrcInputFileData%method DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1946,8 +1946,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(ED_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyInputFile' @@ -1963,8 +1963,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%TipMass) end if if (allocated(InputFileData%InpBlMesh)) then - LB(1:1) = lbound(InputFileData%InpBlMesh, kind=B8Ki) - UB(1:1) = ubound(InputFileData%InpBlMesh, kind=B8Ki) + LB(1:1) = lbound(InputFileData%InpBlMesh) + UB(1:1) = ubound(InputFileData%InpBlMesh) do i1 = LB(1), UB(1) call ED_DestroyBladeMeshInputData(InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1972,8 +1972,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%InpBlMesh) end if if (allocated(InputFileData%InpBl)) then - LB(1:1) = lbound(InputFileData%InpBl, kind=B8Ki) - UB(1:1) = ubound(InputFileData%InpBl, kind=B8Ki) + LB(1:1) = lbound(InputFileData%InpBl) + UB(1:1) = ubound(InputFileData%InpBl) do i1 = LB(1), UB(1) call ED_DestroyBladeInputData(InputFileData%InpBl(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2016,8 +2016,8 @@ subroutine ED_PackInputFile(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%FlapDOF1) @@ -2093,18 +2093,18 @@ subroutine ED_PackInputFile(RF, Indata) call RegPack(RF, InData%BldNodes) call RegPack(RF, allocated(InData%InpBlMesh)) if (allocated(InData%InpBlMesh)) then - call RegPackBounds(RF, 1, lbound(InData%InpBlMesh, kind=B8Ki), ubound(InData%InpBlMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%InpBlMesh, kind=B8Ki) - UB(1:1) = ubound(InData%InpBlMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%InpBlMesh), ubound(InData%InpBlMesh)) + LB(1:1) = lbound(InData%InpBlMesh) + UB(1:1) = ubound(InData%InpBlMesh) do i1 = LB(1), UB(1) call ED_PackBladeMeshInputData(RF, InData%InpBlMesh(i1)) end do end if call RegPack(RF, allocated(InData%InpBl)) if (allocated(InData%InpBl)) then - call RegPackBounds(RF, 1, lbound(InData%InpBl, kind=B8Ki), ubound(InData%InpBl, kind=B8Ki)) - LB(1:1) = lbound(InData%InpBl, kind=B8Ki) - UB(1:1) = ubound(InData%InpBl, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%InpBl), ubound(InData%InpBl)) + LB(1:1) = lbound(InData%InpBl) + UB(1:1) = ubound(InData%InpBl) do i1 = LB(1), UB(1) call ED_PackBladeInputData(RF, InData%InpBl(i1)) end do @@ -2206,8 +2206,8 @@ subroutine ED_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2407,7 +2407,7 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyCoordSys' ErrStat = ErrID_None @@ -2440,8 +2440,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%g2 = SrcCoordSysData%g2 DstCoordSysData%g3 = SrcCoordSysData%g3 if (allocated(SrcCoordSysData%i1)) then - LB(1:2) = lbound(SrcCoordSysData%i1, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%i1, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%i1) + UB(1:2) = ubound(SrcCoordSysData%i1) if (.not. allocated(DstCoordSysData%i1)) then allocate(DstCoordSysData%i1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2452,8 +2452,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i1 = SrcCoordSysData%i1 end if if (allocated(SrcCoordSysData%i2)) then - LB(1:2) = lbound(SrcCoordSysData%i2, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%i2, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%i2) + UB(1:2) = ubound(SrcCoordSysData%i2) if (.not. allocated(DstCoordSysData%i2)) then allocate(DstCoordSysData%i2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2464,8 +2464,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i2 = SrcCoordSysData%i2 end if if (allocated(SrcCoordSysData%i3)) then - LB(1:2) = lbound(SrcCoordSysData%i3, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%i3, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%i3) + UB(1:2) = ubound(SrcCoordSysData%i3) if (.not. allocated(DstCoordSysData%i3)) then allocate(DstCoordSysData%i3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2476,8 +2476,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i3 = SrcCoordSysData%i3 end if if (allocated(SrcCoordSysData%j1)) then - LB(1:2) = lbound(SrcCoordSysData%j1, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%j1, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%j1) + UB(1:2) = ubound(SrcCoordSysData%j1) if (.not. allocated(DstCoordSysData%j1)) then allocate(DstCoordSysData%j1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2488,8 +2488,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j1 = SrcCoordSysData%j1 end if if (allocated(SrcCoordSysData%j2)) then - LB(1:2) = lbound(SrcCoordSysData%j2, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%j2, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%j2) + UB(1:2) = ubound(SrcCoordSysData%j2) if (.not. allocated(DstCoordSysData%j2)) then allocate(DstCoordSysData%j2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2500,8 +2500,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j2 = SrcCoordSysData%j2 end if if (allocated(SrcCoordSysData%j3)) then - LB(1:2) = lbound(SrcCoordSysData%j3, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%j3, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%j3) + UB(1:2) = ubound(SrcCoordSysData%j3) if (.not. allocated(DstCoordSysData%j3)) then allocate(DstCoordSysData%j3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2512,8 +2512,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j3 = SrcCoordSysData%j3 end if if (allocated(SrcCoordSysData%m1)) then - LB(1:3) = lbound(SrcCoordSysData%m1, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%m1, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%m1) + UB(1:3) = ubound(SrcCoordSysData%m1) if (.not. allocated(DstCoordSysData%m1)) then allocate(DstCoordSysData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2524,8 +2524,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m1 = SrcCoordSysData%m1 end if if (allocated(SrcCoordSysData%m2)) then - LB(1:3) = lbound(SrcCoordSysData%m2, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%m2, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%m2) + UB(1:3) = ubound(SrcCoordSysData%m2) if (.not. allocated(DstCoordSysData%m2)) then allocate(DstCoordSysData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2536,8 +2536,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m2 = SrcCoordSysData%m2 end if if (allocated(SrcCoordSysData%m3)) then - LB(1:3) = lbound(SrcCoordSysData%m3, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%m3, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%m3) + UB(1:3) = ubound(SrcCoordSysData%m3) if (.not. allocated(DstCoordSysData%m3)) then allocate(DstCoordSysData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2548,8 +2548,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m3 = SrcCoordSysData%m3 end if if (allocated(SrcCoordSysData%n1)) then - LB(1:3) = lbound(SrcCoordSysData%n1, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%n1, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%n1) + UB(1:3) = ubound(SrcCoordSysData%n1) if (.not. allocated(DstCoordSysData%n1)) then allocate(DstCoordSysData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2560,8 +2560,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%n1 = SrcCoordSysData%n1 end if if (allocated(SrcCoordSysData%n2)) then - LB(1:3) = lbound(SrcCoordSysData%n2, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%n2, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%n2) + UB(1:3) = ubound(SrcCoordSysData%n2) if (.not. allocated(DstCoordSysData%n2)) then allocate(DstCoordSysData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2572,8 +2572,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%n2 = SrcCoordSysData%n2 end if if (allocated(SrcCoordSysData%n3)) then - LB(1:3) = lbound(SrcCoordSysData%n3, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%n3, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%n3) + UB(1:3) = ubound(SrcCoordSysData%n3) if (.not. allocated(DstCoordSysData%n3)) then allocate(DstCoordSysData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2588,8 +2588,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%rf3 = SrcCoordSysData%rf3 DstCoordSysData%rfa = SrcCoordSysData%rfa if (allocated(SrcCoordSysData%t1)) then - LB(1:2) = lbound(SrcCoordSysData%t1, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%t1, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%t1) + UB(1:2) = ubound(SrcCoordSysData%t1) if (.not. allocated(DstCoordSysData%t1)) then allocate(DstCoordSysData%t1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2600,8 +2600,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t1 = SrcCoordSysData%t1 end if if (allocated(SrcCoordSysData%t2)) then - LB(1:2) = lbound(SrcCoordSysData%t2, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%t2, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%t2) + UB(1:2) = ubound(SrcCoordSysData%t2) if (.not. allocated(DstCoordSysData%t2)) then allocate(DstCoordSysData%t2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2612,8 +2612,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t2 = SrcCoordSysData%t2 end if if (allocated(SrcCoordSysData%t3)) then - LB(1:2) = lbound(SrcCoordSysData%t3, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%t3, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%t3) + UB(1:2) = ubound(SrcCoordSysData%t3) if (.not. allocated(DstCoordSysData%t3)) then allocate(DstCoordSysData%t3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2624,8 +2624,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t3 = SrcCoordSysData%t3 end if if (allocated(SrcCoordSysData%te1)) then - LB(1:3) = lbound(SrcCoordSysData%te1, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%te1, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%te1) + UB(1:3) = ubound(SrcCoordSysData%te1) if (.not. allocated(DstCoordSysData%te1)) then allocate(DstCoordSysData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2636,8 +2636,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%te1 = SrcCoordSysData%te1 end if if (allocated(SrcCoordSysData%te2)) then - LB(1:3) = lbound(SrcCoordSysData%te2, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%te2, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%te2) + UB(1:3) = ubound(SrcCoordSysData%te2) if (.not. allocated(DstCoordSysData%te2)) then allocate(DstCoordSysData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2648,8 +2648,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%te2 = SrcCoordSysData%te2 end if if (allocated(SrcCoordSysData%te3)) then - LB(1:3) = lbound(SrcCoordSysData%te3, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%te3, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%te3) + UB(1:3) = ubound(SrcCoordSysData%te3) if (.not. allocated(DstCoordSysData%te3)) then allocate(DstCoordSysData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2799,7 +2799,7 @@ subroutine ED_UnPackCoordSys(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_CoordSys), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackCoordSys' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2867,7 +2867,7 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyActiveDOFs' ErrStat = ErrID_None @@ -2879,8 +2879,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE if (allocated(SrcActiveDOFsData%NPSBE)) then - LB(1:1) = lbound(SrcActiveDOFsData%NPSBE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%NPSBE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%NPSBE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSBE) if (.not. allocated(DstActiveDOFsData%NPSBE)) then allocate(DstActiveDOFsData%NPSBE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2891,8 +2891,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE end if if (allocated(SrcActiveDOFsData%NPSE)) then - LB(1:1) = lbound(SrcActiveDOFsData%NPSE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%NPSE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%NPSE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSE) if (.not. allocated(DstActiveDOFsData%NPSE)) then allocate(DstActiveDOFsData%NPSE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2905,8 +2905,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE if (allocated(SrcActiveDOFsData%PCE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PCE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PCE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PCE) + UB(1:1) = ubound(SrcActiveDOFsData%PCE) if (.not. allocated(DstActiveDOFsData%PCE)) then allocate(DstActiveDOFsData%PCE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2917,8 +2917,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE end if if (allocated(SrcActiveDOFsData%PDE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PDE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PDE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PDE) + UB(1:1) = ubound(SrcActiveDOFsData%PDE) if (.not. allocated(DstActiveDOFsData%PDE)) then allocate(DstActiveDOFsData%PDE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2929,8 +2929,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE end if if (allocated(SrcActiveDOFsData%PIE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PIE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PIE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PIE) + UB(1:1) = ubound(SrcActiveDOFsData%PIE) if (.not. allocated(DstActiveDOFsData%PIE)) then allocate(DstActiveDOFsData%PIE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2941,8 +2941,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE end if if (allocated(SrcActiveDOFsData%PTE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PTE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PTE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTE) if (.not. allocated(DstActiveDOFsData%PTE)) then allocate(DstActiveDOFsData%PTE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2953,8 +2953,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE end if if (allocated(SrcActiveDOFsData%PTTE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PTTE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PTTE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PTTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTTE) if (.not. allocated(DstActiveDOFsData%PTTE)) then allocate(DstActiveDOFsData%PTTE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2965,8 +2965,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE end if if (allocated(SrcActiveDOFsData%PS)) then - LB(1:1) = lbound(SrcActiveDOFsData%PS, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PS, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PS) + UB(1:1) = ubound(SrcActiveDOFsData%PS) if (.not. allocated(DstActiveDOFsData%PS)) then allocate(DstActiveDOFsData%PS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2977,8 +2977,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PS = SrcActiveDOFsData%PS end if if (allocated(SrcActiveDOFsData%PSBE)) then - LB(1:2) = lbound(SrcActiveDOFsData%PSBE, kind=B8Ki) - UB(1:2) = ubound(SrcActiveDOFsData%PSBE, kind=B8Ki) + LB(1:2) = lbound(SrcActiveDOFsData%PSBE) + UB(1:2) = ubound(SrcActiveDOFsData%PSBE) if (.not. allocated(DstActiveDOFsData%PSBE)) then allocate(DstActiveDOFsData%PSBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2989,8 +2989,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE end if if (allocated(SrcActiveDOFsData%PSE)) then - LB(1:2) = lbound(SrcActiveDOFsData%PSE, kind=B8Ki) - UB(1:2) = ubound(SrcActiveDOFsData%PSE, kind=B8Ki) + LB(1:2) = lbound(SrcActiveDOFsData%PSE) + UB(1:2) = ubound(SrcActiveDOFsData%PSE) if (.not. allocated(DstActiveDOFsData%PSE)) then allocate(DstActiveDOFsData%PSE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3001,8 +3001,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE end if if (allocated(SrcActiveDOFsData%PUE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PUE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PUE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PUE) + UB(1:1) = ubound(SrcActiveDOFsData%PUE) if (.not. allocated(DstActiveDOFsData%PUE)) then allocate(DstActiveDOFsData%PUE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3013,8 +3013,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE end if if (allocated(SrcActiveDOFsData%PYE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PYE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PYE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PYE) + UB(1:1) = ubound(SrcActiveDOFsData%PYE) if (.not. allocated(DstActiveDOFsData%PYE)) then allocate(DstActiveDOFsData%PYE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3025,8 +3025,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE end if if (allocated(SrcActiveDOFsData%SrtPS)) then - LB(1:1) = lbound(SrcActiveDOFsData%SrtPS, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%SrtPS, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%SrtPS) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPS) if (.not. allocated(DstActiveDOFsData%SrtPS)) then allocate(DstActiveDOFsData%SrtPS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3037,8 +3037,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS end if if (allocated(SrcActiveDOFsData%SrtPSNAUG)) then - LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG) if (.not. allocated(DstActiveDOFsData%SrtPSNAUG)) then allocate(DstActiveDOFsData%SrtPSNAUG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3049,8 +3049,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG end if if (allocated(SrcActiveDOFsData%Diag)) then - LB(1:1) = lbound(SrcActiveDOFsData%Diag, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%Diag, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%Diag) + UB(1:1) = ubound(SrcActiveDOFsData%Diag) if (.not. allocated(DstActiveDOFsData%Diag)) then allocate(DstActiveDOFsData%Diag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3151,7 +3151,7 @@ subroutine ED_UnPackActiveDOFs(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_ActiveDOFs), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackActiveDOFs' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3186,15 +3186,15 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyRtHndSide' ErrStat = ErrID_None ErrMsg = '' DstRtHndSideData%rO = SrcRtHndSideData%rO if (allocated(SrcRtHndSideData%rQS)) then - LB(1:3) = lbound(SrcRtHndSideData%rQS, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%rQS, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%rQS) + UB(1:3) = ubound(SrcRtHndSideData%rQS) if (.not. allocated(DstRtHndSideData%rQS)) then allocate(DstRtHndSideData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3205,8 +3205,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rQS = SrcRtHndSideData%rQS end if if (allocated(SrcRtHndSideData%rS)) then - LB(1:3) = lbound(SrcRtHndSideData%rS, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%rS, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%rS) + UB(1:3) = ubound(SrcRtHndSideData%rS) if (.not. allocated(DstRtHndSideData%rS)) then allocate(DstRtHndSideData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3217,8 +3217,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rS = SrcRtHndSideData%rS end if if (allocated(SrcRtHndSideData%rS0S)) then - LB(1:3) = lbound(SrcRtHndSideData%rS0S, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%rS0S, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%rS0S) + UB(1:3) = ubound(SrcRtHndSideData%rS0S) if (.not. allocated(DstRtHndSideData%rS0S)) then allocate(DstRtHndSideData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3229,8 +3229,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S end if if (allocated(SrcRtHndSideData%rT)) then - LB(1:2) = lbound(SrcRtHndSideData%rT, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%rT, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%rT) + UB(1:2) = ubound(SrcRtHndSideData%rT) if (.not. allocated(DstRtHndSideData%rT)) then allocate(DstRtHndSideData%rT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3242,8 +3242,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O if (allocated(SrcRtHndSideData%rT0T)) then - LB(1:2) = lbound(SrcRtHndSideData%rT0T, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%rT0T, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%rT0T) + UB(1:2) = ubound(SrcRtHndSideData%rT0T) if (.not. allocated(DstRtHndSideData%rT0T)) then allocate(DstRtHndSideData%rT0T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3256,8 +3256,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rZ = SrcRtHndSideData%rZ DstRtHndSideData%rZO = SrcRtHndSideData%rZO if (allocated(SrcRtHndSideData%rZT)) then - LB(1:2) = lbound(SrcRtHndSideData%rZT, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%rZT, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%rZT) + UB(1:2) = ubound(SrcRtHndSideData%rZT) if (.not. allocated(DstRtHndSideData%rZT)) then allocate(DstRtHndSideData%rZT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3278,8 +3278,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rOW = SrcRtHndSideData%rOW DstRtHndSideData%rPC = SrcRtHndSideData%rPC if (allocated(SrcRtHndSideData%rPS0)) then - LB(1:2) = lbound(SrcRtHndSideData%rPS0, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%rPS0, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%rPS0) + UB(1:2) = ubound(SrcRtHndSideData%rPS0) if (.not. allocated(DstRtHndSideData%rPS0)) then allocate(DstRtHndSideData%rPS0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3297,8 +3297,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 if (allocated(SrcRtHndSideData%AngPosEF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngPosEF, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%AngPosEF, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%AngPosEF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosEF) if (.not. allocated(DstRtHndSideData%AngPosEF)) then allocate(DstRtHndSideData%AngPosEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3309,8 +3309,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF end if if (allocated(SrcRtHndSideData%AngPosXF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngPosXF, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%AngPosXF, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%AngPosXF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosXF) if (.not. allocated(DstRtHndSideData%AngPosXF)) then allocate(DstRtHndSideData%AngPosXF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3321,8 +3321,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF end if if (allocated(SrcRtHndSideData%AngPosHM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngPosHM, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%AngPosHM, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%AngPosHM) + UB(1:3) = ubound(SrcRtHndSideData%AngPosHM) if (.not. allocated(DstRtHndSideData%AngPosHM)) then allocate(DstRtHndSideData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3335,8 +3335,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX if (allocated(SrcRtHndSideData%PAngVelEA)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA) if (.not. allocated(DstRtHndSideData%PAngVelEA)) then allocate(DstRtHndSideData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3347,8 +3347,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA end if if (allocated(SrcRtHndSideData%PAngVelEF)) then - LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF, kind=B8Ki) - UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF, kind=B8Ki) + LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF) + UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF) if (.not. allocated(DstRtHndSideData%PAngVelEF)) then allocate(DstRtHndSideData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3359,8 +3359,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF end if if (allocated(SrcRtHndSideData%PAngVelEG)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG) if (.not. allocated(DstRtHndSideData%PAngVelEG)) then allocate(DstRtHndSideData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3371,8 +3371,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG end if if (allocated(SrcRtHndSideData%PAngVelEH)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH) if (.not. allocated(DstRtHndSideData%PAngVelEH)) then allocate(DstRtHndSideData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3383,8 +3383,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH end if if (allocated(SrcRtHndSideData%PAngVelEL)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL) if (.not. allocated(DstRtHndSideData%PAngVelEL)) then allocate(DstRtHndSideData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3395,8 +3395,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL end if if (allocated(SrcRtHndSideData%PAngVelEM)) then - LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM, kind=B8Ki) - UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM, kind=B8Ki) + LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM) + UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM) if (.not. allocated(DstRtHndSideData%PAngVelEM)) then allocate(DstRtHndSideData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3407,8 +3407,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM end if if (allocated(SrcRtHndSideData%AngVelEM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngVelEM, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%AngVelEM, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%AngVelEM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelEM) if (.not. allocated(DstRtHndSideData%AngVelEM)) then allocate(DstRtHndSideData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3419,8 +3419,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM end if if (allocated(SrcRtHndSideData%PAngVelEN)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN) if (.not. allocated(DstRtHndSideData%PAngVelEN)) then allocate(DstRtHndSideData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3432,8 +3432,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA if (allocated(SrcRtHndSideData%PAngVelEB)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB) if (.not. allocated(DstRtHndSideData%PAngVelEB)) then allocate(DstRtHndSideData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3444,8 +3444,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB end if if (allocated(SrcRtHndSideData%PAngVelER)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelER, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelER, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelER) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelER) if (.not. allocated(DstRtHndSideData%PAngVelER)) then allocate(DstRtHndSideData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3456,8 +3456,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER end if if (allocated(SrcRtHndSideData%PAngVelEX)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX) if (.not. allocated(DstRtHndSideData%PAngVelEX)) then allocate(DstRtHndSideData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3479,8 +3479,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt if (allocated(SrcRtHndSideData%AngAccEFt)) then - LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt) + UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt) if (.not. allocated(DstRtHndSideData%AngAccEFt)) then allocate(DstRtHndSideData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3491,8 +3491,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt end if if (allocated(SrcRtHndSideData%AngVelEF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngVelEF, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%AngVelEF, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%AngVelEF) + UB(1:2) = ubound(SrcRtHndSideData%AngVelEF) if (.not. allocated(DstRtHndSideData%AngVelEF)) then allocate(DstRtHndSideData%AngVelEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3503,8 +3503,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF end if if (allocated(SrcRtHndSideData%AngVelHM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngVelHM, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%AngVelHM, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%AngVelHM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelHM) if (.not. allocated(DstRtHndSideData%AngVelHM)) then allocate(DstRtHndSideData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3518,8 +3518,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt if (allocated(SrcRtHndSideData%AngAccEKt)) then - LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt) + UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt) if (.not. allocated(DstRtHndSideData%AngAccEKt)) then allocate(DstRtHndSideData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3537,8 +3537,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt if (allocated(SrcRtHndSideData%LinVelES)) then - LB(1:3) = lbound(SrcRtHndSideData%LinVelES, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%LinVelES, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%LinVelES) + UB(1:3) = ubound(SrcRtHndSideData%LinVelES) if (.not. allocated(DstRtHndSideData%LinVelES)) then allocate(DstRtHndSideData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3550,8 +3550,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ if (allocated(SrcRtHndSideData%LinVelET)) then - LB(1:2) = lbound(SrcRtHndSideData%LinVelET, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%LinVelET, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%LinVelET) + UB(1:2) = ubound(SrcRtHndSideData%LinVelET) if (.not. allocated(DstRtHndSideData%LinVelET)) then allocate(DstRtHndSideData%LinVelET(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3562,8 +3562,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET end if if (allocated(SrcRtHndSideData%LinVelESm2)) then - LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2, kind=B8Ki) - UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2, kind=B8Ki) + LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2) + UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2) if (.not. allocated(DstRtHndSideData%LinVelESm2)) then allocate(DstRtHndSideData%LinVelESm2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3574,8 +3574,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 end if if (allocated(SrcRtHndSideData%PLinVelEIMU)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU) if (.not. allocated(DstRtHndSideData%PLinVelEIMU)) then allocate(DstRtHndSideData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3586,8 +3586,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU end if if (allocated(SrcRtHndSideData%PLinVelEO)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO) if (.not. allocated(DstRtHndSideData%PLinVelEO)) then allocate(DstRtHndSideData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3598,8 +3598,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO end if if (allocated(SrcRtHndSideData%PLinVelES)) then - LB(1:5) = lbound(SrcRtHndSideData%PLinVelES, kind=B8Ki) - UB(1:5) = ubound(SrcRtHndSideData%PLinVelES, kind=B8Ki) + LB(1:5) = lbound(SrcRtHndSideData%PLinVelES) + UB(1:5) = ubound(SrcRtHndSideData%PLinVelES) if (.not. allocated(DstRtHndSideData%PLinVelES)) then allocate(DstRtHndSideData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3610,8 +3610,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES end if if (allocated(SrcRtHndSideData%PLinVelET)) then - LB(1:4) = lbound(SrcRtHndSideData%PLinVelET, kind=B8Ki) - UB(1:4) = ubound(SrcRtHndSideData%PLinVelET, kind=B8Ki) + LB(1:4) = lbound(SrcRtHndSideData%PLinVelET) + UB(1:4) = ubound(SrcRtHndSideData%PLinVelET) if (.not. allocated(DstRtHndSideData%PLinVelET)) then allocate(DstRtHndSideData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3622,8 +3622,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET end if if (allocated(SrcRtHndSideData%PLinVelEZ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ) if (.not. allocated(DstRtHndSideData%PLinVelEZ)) then allocate(DstRtHndSideData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3634,8 +3634,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ end if if (allocated(SrcRtHndSideData%PLinVelEC)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC) if (.not. allocated(DstRtHndSideData%PLinVelEC)) then allocate(DstRtHndSideData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3646,8 +3646,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC end if if (allocated(SrcRtHndSideData%PLinVelED)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelED, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelED, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelED) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelED) if (.not. allocated(DstRtHndSideData%PLinVelED)) then allocate(DstRtHndSideData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3658,8 +3658,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED end if if (allocated(SrcRtHndSideData%PLinVelEI)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI) if (.not. allocated(DstRtHndSideData%PLinVelEI)) then allocate(DstRtHndSideData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3670,8 +3670,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI end if if (allocated(SrcRtHndSideData%PLinVelEJ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ) if (.not. allocated(DstRtHndSideData%PLinVelEJ)) then allocate(DstRtHndSideData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3682,8 +3682,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ end if if (allocated(SrcRtHndSideData%PLinVelEP)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP) if (.not. allocated(DstRtHndSideData%PLinVelEP)) then allocate(DstRtHndSideData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3694,8 +3694,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP end if if (allocated(SrcRtHndSideData%PLinVelEQ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ) if (.not. allocated(DstRtHndSideData%PLinVelEQ)) then allocate(DstRtHndSideData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3706,8 +3706,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ end if if (allocated(SrcRtHndSideData%PLinVelEU)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU) if (.not. allocated(DstRtHndSideData%PLinVelEU)) then allocate(DstRtHndSideData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3718,8 +3718,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU end if if (allocated(SrcRtHndSideData%PLinVelEV)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV) if (.not. allocated(DstRtHndSideData%PLinVelEV)) then allocate(DstRtHndSideData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3730,8 +3730,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV end if if (allocated(SrcRtHndSideData%PLinVelEW)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW) if (.not. allocated(DstRtHndSideData%PLinVelEW)) then allocate(DstRtHndSideData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3742,8 +3742,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW end if if (allocated(SrcRtHndSideData%PLinVelEY)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY) if (.not. allocated(DstRtHndSideData%PLinVelEY)) then allocate(DstRtHndSideData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3756,8 +3756,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt if (allocated(SrcRtHndSideData%LinAccESt)) then - LB(1:3) = lbound(SrcRtHndSideData%LinAccESt, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%LinAccESt, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%LinAccESt) + UB(1:3) = ubound(SrcRtHndSideData%LinAccESt) if (.not. allocated(DstRtHndSideData%LinAccESt)) then allocate(DstRtHndSideData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3768,8 +3768,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt end if if (allocated(SrcRtHndSideData%LinAccETt)) then - LB(1:2) = lbound(SrcRtHndSideData%LinAccETt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%LinAccETt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%LinAccETt) + UB(1:2) = ubound(SrcRtHndSideData%LinAccETt) if (.not. allocated(DstRtHndSideData%LinAccETt)) then allocate(DstRtHndSideData%LinAccETt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3787,8 +3787,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott if (allocated(SrcRtHndSideData%FrcS0Bt)) then - LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt) + UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt) if (.not. allocated(DstRtHndSideData%FrcS0Bt)) then allocate(DstRtHndSideData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3800,8 +3800,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt if (allocated(SrcRtHndSideData%FSAero)) then - LB(1:3) = lbound(SrcRtHndSideData%FSAero, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%FSAero, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%FSAero) + UB(1:3) = ubound(SrcRtHndSideData%FSAero) if (.not. allocated(DstRtHndSideData%FSAero)) then allocate(DstRtHndSideData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3812,8 +3812,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero end if if (allocated(SrcRtHndSideData%FSTipDrag)) then - LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag) + UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag) if (.not. allocated(DstRtHndSideData%FSTipDrag)) then allocate(DstRtHndSideData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3824,8 +3824,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag end if if (allocated(SrcRtHndSideData%FTHydrot)) then - LB(1:2) = lbound(SrcRtHndSideData%FTHydrot, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%FTHydrot, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%FTHydrot) + UB(1:2) = ubound(SrcRtHndSideData%FTHydrot) if (.not. allocated(DstRtHndSideData%FTHydrot)) then allocate(DstRtHndSideData%FTHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3837,8 +3837,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot if (allocated(SrcRtHndSideData%MFHydrot)) then - LB(1:2) = lbound(SrcRtHndSideData%MFHydrot, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%MFHydrot, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%MFHydrot) + UB(1:2) = ubound(SrcRtHndSideData%MFHydrot) if (.not. allocated(DstRtHndSideData%MFHydrot)) then allocate(DstRtHndSideData%MFHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3850,8 +3850,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt if (allocated(SrcRtHndSideData%MomH0Bt)) then - LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt) + UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt) if (.not. allocated(DstRtHndSideData%MomH0Bt)) then allocate(DstRtHndSideData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3866,8 +3866,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt if (allocated(SrcRtHndSideData%MMAero)) then - LB(1:3) = lbound(SrcRtHndSideData%MMAero, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%MMAero, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%MMAero) + UB(1:3) = ubound(SrcRtHndSideData%MMAero) if (.not. allocated(DstRtHndSideData%MMAero)) then allocate(DstRtHndSideData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3879,8 +3879,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot if (allocated(SrcRtHndSideData%PFrcONcRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt) if (.not. allocated(DstRtHndSideData%PFrcONcRt)) then allocate(DstRtHndSideData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3891,8 +3891,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt end if if (allocated(SrcRtHndSideData%PFrcPRot)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot) + UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot) if (.not. allocated(DstRtHndSideData%PFrcPRot)) then allocate(DstRtHndSideData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3903,8 +3903,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot end if if (allocated(SrcRtHndSideData%PFrcS0B)) then - LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B) + UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B) if (.not. allocated(DstRtHndSideData%PFrcS0B)) then allocate(DstRtHndSideData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3915,8 +3915,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B end if if (allocated(SrcRtHndSideData%PFrcT0Trb)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb) if (.not. allocated(DstRtHndSideData%PFrcT0Trb)) then allocate(DstRtHndSideData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3927,8 +3927,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb end if if (allocated(SrcRtHndSideData%PFTHydro)) then - LB(1:3) = lbound(SrcRtHndSideData%PFTHydro, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PFTHydro, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PFTHydro) + UB(1:3) = ubound(SrcRtHndSideData%PFTHydro) if (.not. allocated(DstRtHndSideData%PFTHydro)) then allocate(DstRtHndSideData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3940,8 +3940,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro if (allocated(SrcRtHndSideData%PMFHydro)) then - LB(1:3) = lbound(SrcRtHndSideData%PMFHydro, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PMFHydro, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PMFHydro) + UB(1:3) = ubound(SrcRtHndSideData%PMFHydro) if (.not. allocated(DstRtHndSideData%PMFHydro)) then allocate(DstRtHndSideData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3952,8 +3952,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro end if if (allocated(SrcRtHndSideData%PMomBNcRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt) if (.not. allocated(DstRtHndSideData%PMomBNcRt)) then allocate(DstRtHndSideData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3964,8 +3964,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt end if if (allocated(SrcRtHndSideData%PMomH0B)) then - LB(1:3) = lbound(SrcRtHndSideData%PMomH0B, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PMomH0B, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PMomH0B) + UB(1:3) = ubound(SrcRtHndSideData%PMomH0B) if (.not. allocated(DstRtHndSideData%PMomH0B)) then allocate(DstRtHndSideData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3976,8 +3976,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B end if if (allocated(SrcRtHndSideData%PMomLPRot)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot) + UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot) if (.not. allocated(DstRtHndSideData%PMomLPRot)) then allocate(DstRtHndSideData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3988,8 +3988,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot end if if (allocated(SrcRtHndSideData%PMomNGnRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt) if (.not. allocated(DstRtHndSideData%PMomNGnRt)) then allocate(DstRtHndSideData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4000,8 +4000,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt end if if (allocated(SrcRtHndSideData%PMomNTail)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomNTail, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomNTail, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomNTail) + UB(1:2) = ubound(SrcRtHndSideData%PMomNTail) if (.not. allocated(DstRtHndSideData%PMomNTail)) then allocate(DstRtHndSideData%PMomNTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4012,8 +4012,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail end if if (allocated(SrcRtHndSideData%PMomX0Trb)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb) if (.not. allocated(DstRtHndSideData%PMomX0Trb)) then allocate(DstRtHndSideData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4030,8 +4030,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt if (allocated(SrcRtHndSideData%PFrcVGnRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt) if (.not. allocated(DstRtHndSideData%PFrcVGnRt)) then allocate(DstRtHndSideData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4042,8 +4042,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt end if if (allocated(SrcRtHndSideData%PFrcWTail)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail) + UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail) if (.not. allocated(DstRtHndSideData%PFrcWTail)) then allocate(DstRtHndSideData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4054,8 +4054,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail end if if (allocated(SrcRtHndSideData%PFrcZAll)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll) + UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll) if (.not. allocated(DstRtHndSideData%PFrcZAll)) then allocate(DstRtHndSideData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4066,8 +4066,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll end if if (allocated(SrcRtHndSideData%PMomXAll)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomXAll, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomXAll, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomXAll) + UB(1:2) = ubound(SrcRtHndSideData%PMomXAll) if (.not. allocated(DstRtHndSideData%PMomXAll)) then allocate(DstRtHndSideData%PMomXAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4082,8 +4082,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac if (allocated(SrcRtHndSideData%rSAerCen)) then - LB(1:3) = lbound(SrcRtHndSideData%rSAerCen, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%rSAerCen, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%rSAerCen) + UB(1:3) = ubound(SrcRtHndSideData%rSAerCen) if (.not. allocated(DstRtHndSideData%rSAerCen)) then allocate(DstRtHndSideData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4468,7 +4468,7 @@ subroutine ED_UnPackRtHndSide(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_RtHndSide), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackRtHndSide' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4624,14 +4624,14 @@ subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%QT)) then - LB(1:1) = lbound(SrcContStateData%QT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%QT) + UB(1:1) = ubound(SrcContStateData%QT) if (.not. allocated(DstContStateData%QT)) then allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4642,8 +4642,8 @@ subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%QT = SrcContStateData%QT end if if (allocated(SrcContStateData%QDT)) then - LB(1:1) = lbound(SrcContStateData%QDT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QDT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%QDT) + UB(1:1) = ubound(SrcContStateData%QDT) if (.not. allocated(DstContStateData%QDT)) then allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4684,7 +4684,7 @@ subroutine ED_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4774,24 +4774,24 @@ subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call ED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcOtherStateData%IC)) then - LB(1:1) = lbound(SrcOtherStateData%IC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%IC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%IC) + UB(1:1) = ubound(SrcOtherStateData%IC) if (.not. allocated(DstOtherStateData%IC)) then allocate(DstOtherStateData%IC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4815,15 +4815,15 @@ subroutine ED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(ED_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call ED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4837,12 +4837,12 @@ subroutine ED_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call ED_PackContState(RF, InData%xdot(i1)) end do @@ -4862,14 +4862,14 @@ subroutine ED_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call ED_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -4890,8 +4890,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyParam' @@ -4906,8 +4906,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NAug = SrcParamData%NAug DstParamData%NPH = SrcParamData%NPH if (allocated(SrcParamData%PH)) then - LB(1:1) = lbound(SrcParamData%PH, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%PH, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%PH) + UB(1:1) = ubound(SrcParamData%PH) if (.not. allocated(DstParamData%PH)) then allocate(DstParamData%PH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4919,8 +4919,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NPM = SrcParamData%NPM if (allocated(SrcParamData%PM)) then - LB(1:2) = lbound(SrcParamData%PM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PM, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PM) + UB(1:2) = ubound(SrcParamData%PM) if (.not. allocated(DstParamData%PM)) then allocate(DstParamData%PM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4931,8 +4931,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PM = SrcParamData%PM end if if (allocated(SrcParamData%DOF_Flag)) then - LB(1:1) = lbound(SrcParamData%DOF_Flag, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DOF_Flag, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DOF_Flag) + UB(1:1) = ubound(SrcParamData%DOF_Flag) if (.not. allocated(DstParamData%DOF_Flag)) then allocate(DstParamData%DOF_Flag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4943,8 +4943,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DOF_Flag = SrcParamData%DOF_Flag end if if (allocated(SrcParamData%DOF_Desc)) then - LB(1:1) = lbound(SrcParamData%DOF_Desc, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DOF_Desc, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DOF_Desc) + UB(1:1) = ubound(SrcParamData%DOF_Desc) if (.not. allocated(DstParamData%DOF_Desc)) then allocate(DstParamData%DOF_Desc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4962,8 +4962,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NBlGages = SrcParamData%NBlGages DstParamData%NTwGages = SrcParamData%NTwGages if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4982,8 +4982,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AzimB1Up = SrcParamData%AzimB1Up DstParamData%CosDel3 = SrcParamData%CosDel3 if (allocated(SrcParamData%CosPreC)) then - LB(1:1) = lbound(SrcParamData%CosPreC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%CosPreC, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%CosPreC) + UB(1:1) = ubound(SrcParamData%CosPreC) if (.not. allocated(DstParamData%CosPreC)) then allocate(DstParamData%CosPreC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5037,8 +5037,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rZYzt = SrcParamData%rZYzt DstParamData%SinDel3 = SrcParamData%SinDel3 if (allocated(SrcParamData%SinPreC)) then - LB(1:1) = lbound(SrcParamData%SinPreC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SinPreC, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%SinPreC) + UB(1:1) = ubound(SrcParamData%SinPreC) if (.not. allocated(DstParamData%SinPreC)) then allocate(DstParamData%SinPreC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5065,8 +5065,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%UndSling = SrcParamData%UndSling DstParamData%NumBl = SrcParamData%NumBl if (allocated(SrcParamData%AxRedTFA)) then - LB(1:3) = lbound(SrcParamData%AxRedTFA, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AxRedTFA, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AxRedTFA) + UB(1:3) = ubound(SrcParamData%AxRedTFA) if (.not. allocated(DstParamData%AxRedTFA)) then allocate(DstParamData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5077,8 +5077,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AxRedTFA = SrcParamData%AxRedTFA end if if (allocated(SrcParamData%AxRedTSS)) then - LB(1:3) = lbound(SrcParamData%AxRedTSS, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AxRedTSS, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AxRedTSS) + UB(1:3) = ubound(SrcParamData%AxRedTSS) if (.not. allocated(DstParamData%AxRedTSS)) then allocate(DstParamData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5091,8 +5091,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CTFA = SrcParamData%CTFA DstParamData%CTSS = SrcParamData%CTSS if (allocated(SrcParamData%DHNodes)) then - LB(1:1) = lbound(SrcParamData%DHNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DHNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DHNodes) + UB(1:1) = ubound(SrcParamData%DHNodes) if (.not. allocated(DstParamData%DHNodes)) then allocate(DstParamData%DHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5103,8 +5103,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DHNodes = SrcParamData%DHNodes end if if (allocated(SrcParamData%HNodes)) then - LB(1:1) = lbound(SrcParamData%HNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%HNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%HNodes) + UB(1:1) = ubound(SrcParamData%HNodes) if (.not. allocated(DstParamData%HNodes)) then allocate(DstParamData%HNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5115,8 +5115,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%HNodes = SrcParamData%HNodes end if if (allocated(SrcParamData%HNodesNorm)) then - LB(1:1) = lbound(SrcParamData%HNodesNorm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%HNodesNorm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%HNodesNorm) + UB(1:1) = ubound(SrcParamData%HNodesNorm) if (.not. allocated(DstParamData%HNodesNorm)) then allocate(DstParamData%HNodesNorm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5129,8 +5129,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KTFA = SrcParamData%KTFA DstParamData%KTSS = SrcParamData%KTSS if (allocated(SrcParamData%MassT)) then - LB(1:1) = lbound(SrcParamData%MassT, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MassT, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%MassT) + UB(1:1) = ubound(SrcParamData%MassT) if (.not. allocated(DstParamData%MassT)) then allocate(DstParamData%MassT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5141,8 +5141,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MassT = SrcParamData%MassT end if if (allocated(SrcParamData%StiffTSS)) then - LB(1:1) = lbound(SrcParamData%StiffTSS, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StiffTSS, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%StiffTSS) + UB(1:1) = ubound(SrcParamData%StiffTSS) if (.not. allocated(DstParamData%StiffTSS)) then allocate(DstParamData%StiffTSS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5153,8 +5153,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffTSS = SrcParamData%StiffTSS end if if (allocated(SrcParamData%TwrFASF)) then - LB(1:3) = lbound(SrcParamData%TwrFASF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%TwrFASF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%TwrFASF) + UB(1:3) = ubound(SrcParamData%TwrFASF) if (.not. allocated(DstParamData%TwrFASF)) then allocate(DstParamData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5166,8 +5166,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%TwrFlexL = SrcParamData%TwrFlexL if (allocated(SrcParamData%TwrSSSF)) then - LB(1:3) = lbound(SrcParamData%TwrSSSF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%TwrSSSF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%TwrSSSF) + UB(1:3) = ubound(SrcParamData%TwrSSSF) if (.not. allocated(DstParamData%TwrSSSF)) then allocate(DstParamData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5181,8 +5181,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TwrNodes = SrcParamData%TwrNodes DstParamData%MHK = SrcParamData%MHK if (allocated(SrcParamData%StiffTFA)) then - LB(1:1) = lbound(SrcParamData%StiffTFA, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StiffTFA, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%StiffTFA) + UB(1:1) = ubound(SrcParamData%StiffTFA) if (.not. allocated(DstParamData%StiffTFA)) then allocate(DstParamData%StiffTFA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5194,8 +5194,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%AtfaIner = SrcParamData%AtfaIner if (allocated(SrcParamData%BldCG)) then - LB(1:1) = lbound(SrcParamData%BldCG, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldCG, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldCG) + UB(1:1) = ubound(SrcParamData%BldCG) if (.not. allocated(DstParamData%BldCG)) then allocate(DstParamData%BldCG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5206,8 +5206,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldCG = SrcParamData%BldCG end if if (allocated(SrcParamData%BldMass)) then - LB(1:1) = lbound(SrcParamData%BldMass, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldMass, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldMass) + UB(1:1) = ubound(SrcParamData%BldMass) if (.not. allocated(DstParamData%BldMass)) then allocate(DstParamData%BldMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5219,8 +5219,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BoomMass = SrcParamData%BoomMass if (allocated(SrcParamData%FirstMom)) then - LB(1:1) = lbound(SrcParamData%FirstMom, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FirstMom, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FirstMom) + UB(1:1) = ubound(SrcParamData%FirstMom) if (.not. allocated(DstParamData%FirstMom)) then allocate(DstParamData%FirstMom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5248,8 +5248,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotMass = SrcParamData%RotMass DstParamData%RrfaIner = SrcParamData%RrfaIner if (allocated(SrcParamData%SecondMom)) then - LB(1:1) = lbound(SrcParamData%SecondMom, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SecondMom, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%SecondMom) + UB(1:1) = ubound(SrcParamData%SecondMom) if (.not. allocated(DstParamData%SecondMom)) then allocate(DstParamData%SecondMom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5262,8 +5262,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TFinMass = SrcParamData%TFinMass DstParamData%TFrlIner = SrcParamData%TFrlIner if (allocated(SrcParamData%TipMass)) then - LB(1:1) = lbound(SrcParamData%TipMass, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TipMass, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%TipMass) + UB(1:1) = ubound(SrcParamData%TipMass) if (.not. allocated(DstParamData%TipMass)) then allocate(DstParamData%TipMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5279,8 +5279,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%YawBrMass = SrcParamData%YawBrMass DstParamData%Gravity = SrcParamData%Gravity if (allocated(SrcParamData%PitchAxis)) then - LB(1:2) = lbound(SrcParamData%PitchAxis, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PitchAxis, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PitchAxis) + UB(1:2) = ubound(SrcParamData%PitchAxis) if (.not. allocated(DstParamData%PitchAxis)) then allocate(DstParamData%PitchAxis(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5291,8 +5291,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PitchAxis = SrcParamData%PitchAxis end if if (allocated(SrcParamData%AeroTwst)) then - LB(1:1) = lbound(SrcParamData%AeroTwst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AeroTwst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%AeroTwst) + UB(1:1) = ubound(SrcParamData%AeroTwst) if (.not. allocated(DstParamData%AeroTwst)) then allocate(DstParamData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5303,8 +5303,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AeroTwst = SrcParamData%AeroTwst end if if (allocated(SrcParamData%AxRedBld)) then - LB(1:4) = lbound(SrcParamData%AxRedBld, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%AxRedBld, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%AxRedBld) + UB(1:4) = ubound(SrcParamData%AxRedBld) if (.not. allocated(DstParamData%AxRedBld)) then allocate(DstParamData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5315,8 +5315,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AxRedBld = SrcParamData%AxRedBld end if if (allocated(SrcParamData%BldEDamp)) then - LB(1:2) = lbound(SrcParamData%BldEDamp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldEDamp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldEDamp) + UB(1:2) = ubound(SrcParamData%BldEDamp) if (.not. allocated(DstParamData%BldEDamp)) then allocate(DstParamData%BldEDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5327,8 +5327,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldEDamp = SrcParamData%BldEDamp end if if (allocated(SrcParamData%BldFDamp)) then - LB(1:2) = lbound(SrcParamData%BldFDamp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldFDamp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldFDamp) + UB(1:2) = ubound(SrcParamData%BldFDamp) if (.not. allocated(DstParamData%BldFDamp)) then allocate(DstParamData%BldFDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5340,8 +5340,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BldFlexL = SrcParamData%BldFlexL if (allocated(SrcParamData%CAeroTwst)) then - LB(1:1) = lbound(SrcParamData%CAeroTwst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%CAeroTwst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%CAeroTwst) + UB(1:1) = ubound(SrcParamData%CAeroTwst) if (.not. allocated(DstParamData%CAeroTwst)) then allocate(DstParamData%CAeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5352,8 +5352,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CAeroTwst = SrcParamData%CAeroTwst end if if (allocated(SrcParamData%CBE)) then - LB(1:3) = lbound(SrcParamData%CBE, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%CBE, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%CBE) + UB(1:3) = ubound(SrcParamData%CBE) if (.not. allocated(DstParamData%CBE)) then allocate(DstParamData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5364,8 +5364,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CBE = SrcParamData%CBE end if if (allocated(SrcParamData%CBF)) then - LB(1:3) = lbound(SrcParamData%CBF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%CBF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%CBF) + UB(1:3) = ubound(SrcParamData%CBF) if (.not. allocated(DstParamData%CBF)) then allocate(DstParamData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5376,8 +5376,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CBF = SrcParamData%CBF end if if (allocated(SrcParamData%Chord)) then - LB(1:1) = lbound(SrcParamData%Chord, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Chord, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Chord) + UB(1:1) = ubound(SrcParamData%Chord) if (.not. allocated(DstParamData%Chord)) then allocate(DstParamData%Chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5388,8 +5388,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Chord = SrcParamData%Chord end if if (allocated(SrcParamData%CThetaS)) then - LB(1:2) = lbound(SrcParamData%CThetaS, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CThetaS, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CThetaS) + UB(1:2) = ubound(SrcParamData%CThetaS) if (.not. allocated(DstParamData%CThetaS)) then allocate(DstParamData%CThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5400,8 +5400,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CThetaS = SrcParamData%CThetaS end if if (allocated(SrcParamData%DRNodes)) then - LB(1:1) = lbound(SrcParamData%DRNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DRNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DRNodes) + UB(1:1) = ubound(SrcParamData%DRNodes) if (.not. allocated(DstParamData%DRNodes)) then allocate(DstParamData%DRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5412,8 +5412,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DRNodes = SrcParamData%DRNodes end if if (allocated(SrcParamData%FStTunr)) then - LB(1:2) = lbound(SrcParamData%FStTunr, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%FStTunr, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%FStTunr) + UB(1:2) = ubound(SrcParamData%FStTunr) if (.not. allocated(DstParamData%FStTunr)) then allocate(DstParamData%FStTunr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5424,8 +5424,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FStTunr = SrcParamData%FStTunr end if if (allocated(SrcParamData%KBE)) then - LB(1:3) = lbound(SrcParamData%KBE, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%KBE, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%KBE) + UB(1:3) = ubound(SrcParamData%KBE) if (.not. allocated(DstParamData%KBE)) then allocate(DstParamData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5436,8 +5436,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KBE = SrcParamData%KBE end if if (allocated(SrcParamData%KBF)) then - LB(1:3) = lbound(SrcParamData%KBF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%KBF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%KBF) + UB(1:3) = ubound(SrcParamData%KBF) if (.not. allocated(DstParamData%KBF)) then allocate(DstParamData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5448,8 +5448,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KBF = SrcParamData%KBF end if if (allocated(SrcParamData%MassB)) then - LB(1:2) = lbound(SrcParamData%MassB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MassB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MassB) + UB(1:2) = ubound(SrcParamData%MassB) if (.not. allocated(DstParamData%MassB)) then allocate(DstParamData%MassB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5460,8 +5460,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MassB = SrcParamData%MassB end if if (allocated(SrcParamData%RNodes)) then - LB(1:1) = lbound(SrcParamData%RNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%RNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%RNodes) + UB(1:1) = ubound(SrcParamData%RNodes) if (.not. allocated(DstParamData%RNodes)) then allocate(DstParamData%RNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5472,8 +5472,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RNodes = SrcParamData%RNodes end if if (allocated(SrcParamData%RNodesNorm)) then - LB(1:1) = lbound(SrcParamData%RNodesNorm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%RNodesNorm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%RNodesNorm) + UB(1:1) = ubound(SrcParamData%RNodesNorm) if (.not. allocated(DstParamData%RNodesNorm)) then allocate(DstParamData%RNodesNorm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5484,8 +5484,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RNodesNorm = SrcParamData%RNodesNorm end if if (allocated(SrcParamData%rSAerCenn1)) then - LB(1:2) = lbound(SrcParamData%rSAerCenn1, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%rSAerCenn1, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%rSAerCenn1) + UB(1:2) = ubound(SrcParamData%rSAerCenn1) if (.not. allocated(DstParamData%rSAerCenn1)) then allocate(DstParamData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5496,8 +5496,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 end if if (allocated(SrcParamData%rSAerCenn2)) then - LB(1:2) = lbound(SrcParamData%rSAerCenn2, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%rSAerCenn2, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%rSAerCenn2) + UB(1:2) = ubound(SrcParamData%rSAerCenn2) if (.not. allocated(DstParamData%rSAerCenn2)) then allocate(DstParamData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5508,8 +5508,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 end if if (allocated(SrcParamData%SAeroTwst)) then - LB(1:1) = lbound(SrcParamData%SAeroTwst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SAeroTwst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%SAeroTwst) + UB(1:1) = ubound(SrcParamData%SAeroTwst) if (.not. allocated(DstParamData%SAeroTwst)) then allocate(DstParamData%SAeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5520,8 +5520,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SAeroTwst = SrcParamData%SAeroTwst end if if (allocated(SrcParamData%StiffBE)) then - LB(1:2) = lbound(SrcParamData%StiffBE, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%StiffBE, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%StiffBE) + UB(1:2) = ubound(SrcParamData%StiffBE) if (.not. allocated(DstParamData%StiffBE)) then allocate(DstParamData%StiffBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5532,8 +5532,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffBE = SrcParamData%StiffBE end if if (allocated(SrcParamData%StiffBF)) then - LB(1:2) = lbound(SrcParamData%StiffBF, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%StiffBF, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%StiffBF) + UB(1:2) = ubound(SrcParamData%StiffBF) if (.not. allocated(DstParamData%StiffBF)) then allocate(DstParamData%StiffBF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5544,8 +5544,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffBF = SrcParamData%StiffBF end if if (allocated(SrcParamData%SThetaS)) then - LB(1:2) = lbound(SrcParamData%SThetaS, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%SThetaS, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%SThetaS) + UB(1:2) = ubound(SrcParamData%SThetaS) if (.not. allocated(DstParamData%SThetaS)) then allocate(DstParamData%SThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5556,8 +5556,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SThetaS = SrcParamData%SThetaS end if if (allocated(SrcParamData%ThetaS)) then - LB(1:2) = lbound(SrcParamData%ThetaS, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%ThetaS, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%ThetaS) + UB(1:2) = ubound(SrcParamData%ThetaS) if (.not. allocated(DstParamData%ThetaS)) then allocate(DstParamData%ThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5568,8 +5568,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ThetaS = SrcParamData%ThetaS end if if (allocated(SrcParamData%TwistedSF)) then - LB(1:5) = lbound(SrcParamData%TwistedSF, kind=B8Ki) - UB(1:5) = ubound(SrcParamData%TwistedSF, kind=B8Ki) + LB(1:5) = lbound(SrcParamData%TwistedSF) + UB(1:5) = ubound(SrcParamData%TwistedSF) if (.not. allocated(DstParamData%TwistedSF)) then allocate(DstParamData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5580,8 +5580,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TwistedSF = SrcParamData%TwistedSF end if if (allocated(SrcParamData%BldFl1Sh)) then - LB(1:2) = lbound(SrcParamData%BldFl1Sh, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldFl1Sh, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldFl1Sh) + UB(1:2) = ubound(SrcParamData%BldFl1Sh) if (.not. allocated(DstParamData%BldFl1Sh)) then allocate(DstParamData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5592,8 +5592,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh end if if (allocated(SrcParamData%BldFl2Sh)) then - LB(1:2) = lbound(SrcParamData%BldFl2Sh, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldFl2Sh, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldFl2Sh) + UB(1:2) = ubound(SrcParamData%BldFl2Sh) if (.not. allocated(DstParamData%BldFl2Sh)) then allocate(DstParamData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5604,8 +5604,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh end if if (allocated(SrcParamData%BldEdgSh)) then - LB(1:2) = lbound(SrcParamData%BldEdgSh, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldEdgSh, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldEdgSh) + UB(1:2) = ubound(SrcParamData%BldEdgSh) if (.not. allocated(DstParamData%BldEdgSh)) then allocate(DstParamData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5616,8 +5616,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldEdgSh = SrcParamData%BldEdgSh end if if (allocated(SrcParamData%FreqBE)) then - LB(1:3) = lbound(SrcParamData%FreqBE, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%FreqBE, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%FreqBE) + UB(1:3) = ubound(SrcParamData%FreqBE) if (.not. allocated(DstParamData%FreqBE)) then allocate(DstParamData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5628,8 +5628,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FreqBE = SrcParamData%FreqBE end if if (allocated(SrcParamData%FreqBF)) then - LB(1:3) = lbound(SrcParamData%FreqBF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%FreqBF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%FreqBF) + UB(1:3) = ubound(SrcParamData%FreqBF) if (.not. allocated(DstParamData%FreqBF)) then allocate(DstParamData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5682,8 +5682,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotSpeed = SrcParamData%RotSpeed DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%BElmntMass)) then - LB(1:2) = lbound(SrcParamData%BElmntMass, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BElmntMass, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BElmntMass) + UB(1:2) = ubound(SrcParamData%BElmntMass) if (.not. allocated(DstParamData%BElmntMass)) then allocate(DstParamData%BElmntMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5694,8 +5694,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BElmntMass = SrcParamData%BElmntMass end if if (allocated(SrcParamData%TElmntMass)) then - LB(1:1) = lbound(SrcParamData%TElmntMass, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TElmntMass, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%TElmntMass) + UB(1:1) = ubound(SrcParamData%TElmntMass) if (.not. allocated(DstParamData%TElmntMass)) then allocate(DstParamData%TElmntMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5717,8 +5717,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts if (allocated(SrcParamData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) if (.not. allocated(DstParamData%BldNd_OutParam)) then allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5734,8 +5734,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5746,8 +5746,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5758,8 +5758,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) if (.not. allocated(DstParamData%dx)) then allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5782,8 +5782,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) type(ED_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyParam' @@ -5804,8 +5804,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) call ED_DestroyActiveDOFs(ParamData%DOFs, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5960,8 +5960,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%TElmntMass) end if if (allocated(ParamData%BldNd_OutParam)) then - LB(1:1) = lbound(ParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5983,8 +5983,8 @@ subroutine ED_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackParam' - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%DT24) @@ -6006,9 +6006,9 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%NTwGages) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -6215,9 +6215,9 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%BldNd_TotNumOuts) call RegPack(RF, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) end do @@ -6240,8 +6240,8 @@ subroutine ED_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6508,16 +6508,16 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%BladePtLoads)) then - LB(1:1) = lbound(SrcInputData%BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BladePtLoads, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BladePtLoads) + UB(1:1) = ubound(SrcInputData%BladePtLoads) if (.not. allocated(DstInputData%BladePtLoads)) then allocate(DstInputData%BladePtLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6547,8 +6547,8 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%TwrAddedMass)) then - LB(1:3) = lbound(SrcInputData%TwrAddedMass, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%TwrAddedMass, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%TwrAddedMass) + UB(1:3) = ubound(SrcInputData%TwrAddedMass) if (.not. allocated(DstInputData%TwrAddedMass)) then allocate(DstInputData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6560,8 +6560,8 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass if (allocated(SrcInputData%BlPitchCom)) then - LB(1:1) = lbound(SrcInputData%BlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BlPitchCom, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BlPitchCom) + UB(1:1) = ubound(SrcInputData%BlPitchCom) if (.not. allocated(DstInputData%BlPitchCom)) then allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6580,16 +6580,16 @@ subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) type(ED_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%BladePtLoads)) then - LB(1:1) = lbound(InputData%BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(InputData%BladePtLoads, kind=B8Ki) + LB(1:1) = lbound(InputData%BladePtLoads) + UB(1:1) = ubound(InputData%BladePtLoads) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6618,14 +6618,14 @@ subroutine ED_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInput' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%BladePtLoads)) if (allocated(InData%BladePtLoads)) then - call RegPackBounds(RF, 1, lbound(InData%BladePtLoads, kind=B8Ki), ubound(InData%BladePtLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(InData%BladePtLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladePtLoads), ubound(InData%BladePtLoads)) + LB(1:1) = lbound(InData%BladePtLoads) + UB(1:1) = ubound(InData%BladePtLoads) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladePtLoads(i1)) end do @@ -6648,8 +6648,8 @@ subroutine ED_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInput' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6685,16 +6685,16 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%BladeLn2Mesh)) then - LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh) + UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh) if (.not. allocated(DstOutputData%BladeLn2Mesh)) then allocate(DstOutputData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6718,8 +6718,8 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%BladeRootMotion)) then - LB(1:1) = lbound(SrcOutputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BladeRootMotion) + UB(1:1) = ubound(SrcOutputData%BladeRootMotion) if (.not. allocated(DstOutputData%BladeRootMotion)) then allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6740,8 +6740,8 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6752,8 +6752,8 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%BlPitch)) then - LB(1:1) = lbound(SrcOutputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BlPitch) + UB(1:1) = ubound(SrcOutputData%BlPitch) if (.not. allocated(DstOutputData%BlPitch)) then allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6795,16 +6795,16 @@ subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) type(ED_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%BladeLn2Mesh)) then - LB(1:1) = lbound(OutputData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeLn2Mesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%BladeLn2Mesh) + UB(1:1) = ubound(OutputData%BladeLn2Mesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6818,8 +6818,8 @@ subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) call MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%BladeRootMotion)) then - LB(1:1) = lbound(OutputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(OutputData%BladeRootMotion) + UB(1:1) = ubound(OutputData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6842,14 +6842,14 @@ subroutine ED_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLn2Mesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeLn2Mesh(i1)) end do @@ -6859,9 +6859,9 @@ subroutine ED_PackOutput(RF, Indata) call MeshPack(RF, InData%HubPtMotion) call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeRootMotion(i1)) end do @@ -6903,8 +6903,8 @@ subroutine ED_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6975,7 +6975,7 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyMisc' @@ -6988,8 +6988,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7000,8 +7000,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%AugMat)) then - LB(1:2) = lbound(SrcMiscData%AugMat, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AugMat, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%AugMat) + UB(1:2) = ubound(SrcMiscData%AugMat) if (.not. allocated(DstMiscData%AugMat)) then allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7012,8 +7012,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AugMat = SrcMiscData%AugMat end if if (allocated(SrcMiscData%AugMat_factor)) then - LB(1:2) = lbound(SrcMiscData%AugMat_factor, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AugMat_factor, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%AugMat_factor) + UB(1:2) = ubound(SrcMiscData%AugMat_factor) if (.not. allocated(DstMiscData%AugMat_factor)) then allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7024,8 +7024,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor end if if (allocated(SrcMiscData%SolnVec)) then - LB(1:1) = lbound(SrcMiscData%SolnVec, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SolnVec, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SolnVec) + UB(1:1) = ubound(SrcMiscData%SolnVec) if (.not. allocated(DstMiscData%SolnVec)) then allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7036,8 +7036,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SolnVec = SrcMiscData%SolnVec end if if (allocated(SrcMiscData%AugMat_pivot)) then - LB(1:1) = lbound(SrcMiscData%AugMat_pivot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AugMat_pivot, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AugMat_pivot) + UB(1:1) = ubound(SrcMiscData%AugMat_pivot) if (.not. allocated(DstMiscData%AugMat_pivot)) then allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7048,8 +7048,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot end if if (allocated(SrcMiscData%OgnlGeAzRo)) then - LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo) + UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo) if (.not. allocated(DstMiscData%OgnlGeAzRo)) then allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7060,8 +7060,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo end if if (allocated(SrcMiscData%QD2T)) then - LB(1:1) = lbound(SrcMiscData%QD2T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%QD2T, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%QD2T) + UB(1:1) = ubound(SrcMiscData%QD2T) if (.not. allocated(DstMiscData%QD2T)) then allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7073,8 +7073,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod if (allocated(SrcMiscData%OgnlYawRow)) then - LB(1:1) = lbound(SrcMiscData%OgnlYawRow, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%OgnlYawRow, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%OgnlYawRow) + UB(1:1) = ubound(SrcMiscData%OgnlYawRow) if (.not. allocated(DstMiscData%OgnlYawRow)) then allocate(DstMiscData%OgnlYawRow(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7182,7 +7182,7 @@ subroutine ED_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -7308,7 +7308,7 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1, kind=B8Ki),UBOUND(u_out%BladePtLoads,1, kind=B8Ki) + do i1 = lbound(u_out%BladePtLoads,1),ubound(u_out%BladePtLoads,1) CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7328,7 +7328,7 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) END IF ! check if allocated u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -7397,7 +7397,7 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1, kind=B8Ki),UBOUND(u_out%BladePtLoads,1, kind=B8Ki) + do i1 = lbound(u_out%BladePtLoads,1),ubound(u_out%BladePtLoads,1) CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7417,7 +7417,7 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM END IF ! check if allocated u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + a3*u3%PtfmAddedMass IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -7524,7 +7524,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki),UBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki) + do i1 = lbound(y_out%BladeLn2Mesh,1),ubound(y_out%BladeLn2Mesh,1) CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7536,7 +7536,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7549,7 +7549,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -7637,7 +7637,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki),UBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki) + do i1 = lbound(y_out%BladeLn2Mesh,1),ubound(y_out%BladeLn2Mesh,1) CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7649,7 +7649,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7662,7 +7662,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated diff --git a/modules/externalinflow/src/ExternalInflow.f90 b/modules/externalinflow/src/ExternalInflow.f90 index 343c853293..d85798230e 100644 --- a/modules/externalinflow/src/ExternalInflow.f90 +++ b/modules/externalinflow/src/ExternalInflow.f90 @@ -365,9 +365,9 @@ SUBROUTINE ExtInfw_UpdateFlowField(p_FAST, ExtInfw, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - ExtInfw%m%FlowField%Points%Vel(1:size(ExtInfw%y%u),1) = ExtInfw%y%u - ExtInfw%m%FlowField%Points%Vel(1:size(ExtInfw%y%v),2) = ExtInfw%y%v - ExtInfw%m%FlowField%Points%Vel(1:size(ExtInfw%y%w),3) = ExtInfw%y%w + ExtInfw%m%FlowField%Points%Vel(1,1:size(ExtInfw%y%u)) = ExtInfw%y%u + ExtInfw%m%FlowField%Points%Vel(2,1:size(ExtInfw%y%v)) = ExtInfw%y%v + ExtInfw%m%FlowField%Points%Vel(3,1:size(ExtInfw%y%w)) = ExtInfw%y%w END SUBROUTINE ExtInfw_UpdateFlowField !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index da02d647f3..5c24efa86d 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -237,7 +237,7 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInitInput' ErrStat = ErrID_None @@ -247,8 +247,8 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NumActForcePtsTower = SrcInitInputData%NumActForcePtsTower DstInitInputData%C_obj%NumActForcePtsTower = SrcInitInputData%C_obj%NumActForcePtsTower if (associated(SrcInitInputData%StructBldRNodes)) then - LB(1:1) = lbound(SrcInitInputData%StructBldRNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%StructBldRNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%StructBldRNodes) + UB(1:1) = ubound(SrcInitInputData%StructBldRNodes) if (.not. associated(DstInitInputData%StructBldRNodes)) then allocate(DstInitInputData%StructBldRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -262,8 +262,8 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes end if if (associated(SrcInitInputData%StructTwrHNodes)) then - LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes) + UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes) if (.not. associated(DstInitInputData%StructTwrHNodes)) then allocate(DstInitInputData%StructTwrHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -332,7 +332,7 @@ subroutine ExtInfw_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -429,7 +429,7 @@ SUBROUTINE ExtInfw_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointe ELSE InitInputData%C_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) IF (InitInputData%C_obj%StructBldRNodes_Len > 0) & - InitInputData%C_obj%StructBldRNodes = C_LOC(InitInputData%StructBldRNodes(LBOUND(InitInputData%StructBldRNodes,1, kind=B8Ki))) + InitInputData%C_obj%StructBldRNodes = C_LOC(InitInputData%StructBldRNodes(lbound(InitInputData%StructBldRNodes,1))) END IF END IF @@ -441,7 +441,7 @@ SUBROUTINE ExtInfw_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointe ELSE InitInputData%C_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) IF (InitInputData%C_obj%StructTwrHNodes_Len > 0) & - InitInputData%C_obj%StructTwrHNodes = C_LOC(InitInputData%StructTwrHNodes(LBOUND(InitInputData%StructTwrHNodes,1, kind=B8Ki))) + InitInputData%C_obj%StructTwrHNodes = C_LOC(InitInputData%StructTwrHNodes(lbound(InitInputData%StructTwrHNodes,1))) END IF END IF InitInputData%C_obj%BladeLength = InitInputData%BladeLength @@ -456,15 +456,15 @@ subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -475,8 +475,8 @@ subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -548,7 +548,7 @@ subroutine ExtInfw_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -635,8 +635,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_CopyMisc' @@ -646,8 +646,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%ActForceMotionsPoints)) then - LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints) if (.not. allocated(DstMiscData%ActForceMotionsPoints)) then allocate(DstMiscData%ActForceMotionsPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -662,8 +662,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%ActForceLoadsPoints)) then - LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints) if (.not. allocated(DstMiscData%ActForceLoadsPoints)) then allocate(DstMiscData%ActForceLoadsPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -678,8 +678,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%Line2_to_Point_Loads)) then - LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads) if (.not. allocated(DstMiscData%Line2_to_Point_Loads)) then allocate(DstMiscData%Line2_to_Point_Loads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -694,8 +694,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%Line2_to_Point_Motions)) then - LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions) if (.not. allocated(DstMiscData%Line2_to_Point_Motions)) then allocate(DstMiscData%Line2_to_Point_Motions(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -727,8 +727,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ExtInfw_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_DestroyMisc' @@ -737,8 +737,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%ActForceMotionsPoints)) then - LB(1:1) = lbound(MiscData%ActForceMotionsPoints, kind=B8Ki) - UB(1:1) = ubound(MiscData%ActForceMotionsPoints, kind=B8Ki) + LB(1:1) = lbound(MiscData%ActForceMotionsPoints) + UB(1:1) = ubound(MiscData%ActForceMotionsPoints) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -746,8 +746,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ActForceMotionsPoints) end if if (allocated(MiscData%ActForceLoadsPoints)) then - LB(1:1) = lbound(MiscData%ActForceLoadsPoints, kind=B8Ki) - UB(1:1) = ubound(MiscData%ActForceLoadsPoints, kind=B8Ki) + LB(1:1) = lbound(MiscData%ActForceLoadsPoints) + UB(1:1) = ubound(MiscData%ActForceLoadsPoints) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -755,8 +755,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ActForceLoadsPoints) end if if (allocated(MiscData%Line2_to_Point_Loads)) then - LB(1:1) = lbound(MiscData%Line2_to_Point_Loads, kind=B8Ki) - UB(1:1) = ubound(MiscData%Line2_to_Point_Loads, kind=B8Ki) + LB(1:1) = lbound(MiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(MiscData%Line2_to_Point_Loads) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -764,8 +764,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Line2_to_Point_Loads) end if if (allocated(MiscData%Line2_to_Point_Motions)) then - LB(1:1) = lbound(MiscData%Line2_to_Point_Motions, kind=B8Ki) - UB(1:1) = ubound(MiscData%Line2_to_Point_Motions, kind=B8Ki) + LB(1:1) = lbound(MiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(MiscData%Line2_to_Point_Motions) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -784,8 +784,8 @@ subroutine ExtInfw_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtInfw_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then @@ -795,36 +795,36 @@ subroutine ExtInfw_PackMisc(RF, Indata) call NWTC_Library_PackModJacType(RF, InData%Jac) call RegPack(RF, allocated(InData%ActForceMotionsPoints)) if (allocated(InData%ActForceMotionsPoints)) then - call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints, kind=B8Ki), ubound(InData%ActForceMotionsPoints, kind=B8Ki)) - LB(1:1) = lbound(InData%ActForceMotionsPoints, kind=B8Ki) - UB(1:1) = ubound(InData%ActForceMotionsPoints, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) + LB(1:1) = lbound(InData%ActForceMotionsPoints) + UB(1:1) = ubound(InData%ActForceMotionsPoints) do i1 = LB(1), UB(1) call MeshPack(RF, InData%ActForceMotionsPoints(i1)) end do end if call RegPack(RF, allocated(InData%ActForceLoadsPoints)) if (allocated(InData%ActForceLoadsPoints)) then - call RegPackBounds(RF, 1, lbound(InData%ActForceLoadsPoints, kind=B8Ki), ubound(InData%ActForceLoadsPoints, kind=B8Ki)) - LB(1:1) = lbound(InData%ActForceLoadsPoints, kind=B8Ki) - UB(1:1) = ubound(InData%ActForceLoadsPoints, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ActForceLoadsPoints), ubound(InData%ActForceLoadsPoints)) + LB(1:1) = lbound(InData%ActForceLoadsPoints) + UB(1:1) = ubound(InData%ActForceLoadsPoints) do i1 = LB(1), UB(1) call MeshPack(RF, InData%ActForceLoadsPoints(i1)) end do end if call RegPack(RF, allocated(InData%Line2_to_Point_Loads)) if (allocated(InData%Line2_to_Point_Loads)) then - call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Loads, kind=B8Ki), ubound(InData%Line2_to_Point_Loads, kind=B8Ki)) - LB(1:1) = lbound(InData%Line2_to_Point_Loads, kind=B8Ki) - UB(1:1) = ubound(InData%Line2_to_Point_Loads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Loads), ubound(InData%Line2_to_Point_Loads)) + LB(1:1) = lbound(InData%Line2_to_Point_Loads) + UB(1:1) = ubound(InData%Line2_to_Point_Loads) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%Line2_to_Point_Loads(i1)) end do end if call RegPack(RF, allocated(InData%Line2_to_Point_Motions)) if (allocated(InData%Line2_to_Point_Motions)) then - call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Motions, kind=B8Ki), ubound(InData%Line2_to_Point_Motions, kind=B8Ki)) - LB(1:1) = lbound(InData%Line2_to_Point_Motions, kind=B8Ki) - UB(1:1) = ubound(InData%Line2_to_Point_Motions, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Motions), ubound(InData%Line2_to_Point_Motions)) + LB(1:1) = lbound(InData%Line2_to_Point_Motions) + UB(1:1) = ubound(InData%Line2_to_Point_Motions) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%Line2_to_Point_Motions(i1)) end do @@ -843,8 +843,8 @@ subroutine ExtInfw_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -963,7 +963,7 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_CopyParam' @@ -996,8 +996,8 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NnodesForceTower = SrcParamData%NnodesForceTower DstParamData%C_obj%NnodesForceTower = SrcParamData%C_obj%NnodesForceTower if (associated(SrcParamData%forceBldRnodes)) then - LB(1:1) = lbound(SrcParamData%forceBldRnodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%forceBldRnodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%forceBldRnodes) + UB(1:1) = ubound(SrcParamData%forceBldRnodes) if (.not. associated(DstParamData%forceBldRnodes)) then allocate(DstParamData%forceBldRnodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1011,8 +1011,8 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes end if if (associated(SrcParamData%forceTwrHnodes)) then - LB(1:1) = lbound(SrcParamData%forceTwrHnodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%forceTwrHnodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%forceTwrHnodes) + UB(1:1) = ubound(SrcParamData%forceTwrHnodes) if (.not. associated(DstParamData%forceTwrHnodes)) then allocate(DstParamData%forceTwrHnodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1101,7 +1101,7 @@ subroutine ExtInfw_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1236,7 +1236,7 @@ SUBROUTINE ExtInfw_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) IF (ParamData%C_obj%forceBldRnodes_Len > 0) & - ParamData%C_obj%forceBldRnodes = C_LOC(ParamData%forceBldRnodes(LBOUND(ParamData%forceBldRnodes,1, kind=B8Ki))) + ParamData%C_obj%forceBldRnodes = C_LOC(ParamData%forceBldRnodes(lbound(ParamData%forceBldRnodes,1))) END IF END IF @@ -1248,7 +1248,7 @@ SUBROUTINE ExtInfw_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) IF (ParamData%C_obj%forceTwrHnodes_Len > 0) & - ParamData%C_obj%forceTwrHnodes = C_LOC(ParamData%forceTwrHnodes(LBOUND(ParamData%forceTwrHnodes,1, kind=B8Ki))) + ParamData%C_obj%forceTwrHnodes = C_LOC(ParamData%forceTwrHnodes(lbound(ParamData%forceTwrHnodes,1))) END IF END IF ParamData%C_obj%BladeLength = ParamData%BladeLength @@ -1263,14 +1263,14 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%pxVel)) then - LB(1:1) = lbound(SrcInputData%pxVel, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pxVel, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pxVel) + UB(1:1) = ubound(SrcInputData%pxVel) if (.not. associated(DstInputData%pxVel)) then allocate(DstInputData%pxVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1284,8 +1284,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pxVel = SrcInputData%pxVel end if if (associated(SrcInputData%pyVel)) then - LB(1:1) = lbound(SrcInputData%pyVel, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pyVel, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pyVel) + UB(1:1) = ubound(SrcInputData%pyVel) if (.not. associated(DstInputData%pyVel)) then allocate(DstInputData%pyVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1299,8 +1299,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pyVel = SrcInputData%pyVel end if if (associated(SrcInputData%pzVel)) then - LB(1:1) = lbound(SrcInputData%pzVel, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pzVel, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pzVel) + UB(1:1) = ubound(SrcInputData%pzVel) if (.not. associated(DstInputData%pzVel)) then allocate(DstInputData%pzVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1314,8 +1314,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pzVel = SrcInputData%pzVel end if if (associated(SrcInputData%pxForce)) then - LB(1:1) = lbound(SrcInputData%pxForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pxForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pxForce) + UB(1:1) = ubound(SrcInputData%pxForce) if (.not. associated(DstInputData%pxForce)) then allocate(DstInputData%pxForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1329,8 +1329,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pxForce = SrcInputData%pxForce end if if (associated(SrcInputData%pyForce)) then - LB(1:1) = lbound(SrcInputData%pyForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pyForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pyForce) + UB(1:1) = ubound(SrcInputData%pyForce) if (.not. associated(DstInputData%pyForce)) then allocate(DstInputData%pyForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1344,8 +1344,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pyForce = SrcInputData%pyForce end if if (associated(SrcInputData%pzForce)) then - LB(1:1) = lbound(SrcInputData%pzForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pzForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pzForce) + UB(1:1) = ubound(SrcInputData%pzForce) if (.not. associated(DstInputData%pzForce)) then allocate(DstInputData%pzForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1359,8 +1359,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pzForce = SrcInputData%pzForce end if if (associated(SrcInputData%xdotForce)) then - LB(1:1) = lbound(SrcInputData%xdotForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%xdotForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%xdotForce) + UB(1:1) = ubound(SrcInputData%xdotForce) if (.not. associated(DstInputData%xdotForce)) then allocate(DstInputData%xdotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1374,8 +1374,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%xdotForce = SrcInputData%xdotForce end if if (associated(SrcInputData%ydotForce)) then - LB(1:1) = lbound(SrcInputData%ydotForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ydotForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%ydotForce) + UB(1:1) = ubound(SrcInputData%ydotForce) if (.not. associated(DstInputData%ydotForce)) then allocate(DstInputData%ydotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1389,8 +1389,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%ydotForce = SrcInputData%ydotForce end if if (associated(SrcInputData%zdotForce)) then - LB(1:1) = lbound(SrcInputData%zdotForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%zdotForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%zdotForce) + UB(1:1) = ubound(SrcInputData%zdotForce) if (.not. associated(DstInputData%zdotForce)) then allocate(DstInputData%zdotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1404,8 +1404,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%zdotForce = SrcInputData%zdotForce end if if (associated(SrcInputData%pOrientation)) then - LB(1:1) = lbound(SrcInputData%pOrientation, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pOrientation, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pOrientation) + UB(1:1) = ubound(SrcInputData%pOrientation) if (.not. associated(DstInputData%pOrientation)) then allocate(DstInputData%pOrientation(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1419,8 +1419,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pOrientation = SrcInputData%pOrientation end if if (associated(SrcInputData%fx)) then - LB(1:1) = lbound(SrcInputData%fx, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fx, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fx) + UB(1:1) = ubound(SrcInputData%fx) if (.not. associated(DstInputData%fx)) then allocate(DstInputData%fx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1434,8 +1434,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fx = SrcInputData%fx end if if (associated(SrcInputData%fy)) then - LB(1:1) = lbound(SrcInputData%fy, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fy, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fy) + UB(1:1) = ubound(SrcInputData%fy) if (.not. associated(DstInputData%fy)) then allocate(DstInputData%fy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1449,8 +1449,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fy = SrcInputData%fy end if if (associated(SrcInputData%fz)) then - LB(1:1) = lbound(SrcInputData%fz, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fz, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fz) + UB(1:1) = ubound(SrcInputData%fz) if (.not. associated(DstInputData%fz)) then allocate(DstInputData%fz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1464,8 +1464,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fz = SrcInputData%fz end if if (associated(SrcInputData%momentx)) then - LB(1:1) = lbound(SrcInputData%momentx, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%momentx, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%momentx) + UB(1:1) = ubound(SrcInputData%momentx) if (.not. associated(DstInputData%momentx)) then allocate(DstInputData%momentx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1479,8 +1479,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momentx = SrcInputData%momentx end if if (associated(SrcInputData%momenty)) then - LB(1:1) = lbound(SrcInputData%momenty, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%momenty, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%momenty) + UB(1:1) = ubound(SrcInputData%momenty) if (.not. associated(DstInputData%momenty)) then allocate(DstInputData%momenty(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1494,8 +1494,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momenty = SrcInputData%momenty end if if (associated(SrcInputData%momentz)) then - LB(1:1) = lbound(SrcInputData%momentz, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%momentz, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%momentz) + UB(1:1) = ubound(SrcInputData%momentz) if (.not. associated(DstInputData%momentz)) then allocate(DstInputData%momentz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1509,8 +1509,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momentz = SrcInputData%momentz end if if (associated(SrcInputData%forceNodesChord)) then - LB(1:1) = lbound(SrcInputData%forceNodesChord, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%forceNodesChord, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%forceNodesChord) + UB(1:1) = ubound(SrcInputData%forceNodesChord) if (.not. associated(DstInputData%forceNodesChord)) then allocate(DstInputData%forceNodesChord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1670,7 +1670,7 @@ subroutine ExtInfw_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1957,7 +1957,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pxVel_Len = SIZE(InputData%pxVel) IF (InputData%C_obj%pxVel_Len > 0) & - InputData%C_obj%pxVel = C_LOC(InputData%pxVel(LBOUND(InputData%pxVel,1, kind=B8Ki))) + InputData%C_obj%pxVel = C_LOC(InputData%pxVel(lbound(InputData%pxVel,1))) END IF END IF @@ -1969,7 +1969,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pyVel_Len = SIZE(InputData%pyVel) IF (InputData%C_obj%pyVel_Len > 0) & - InputData%C_obj%pyVel = C_LOC(InputData%pyVel(LBOUND(InputData%pyVel,1, kind=B8Ki))) + InputData%C_obj%pyVel = C_LOC(InputData%pyVel(lbound(InputData%pyVel,1))) END IF END IF @@ -1981,7 +1981,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pzVel_Len = SIZE(InputData%pzVel) IF (InputData%C_obj%pzVel_Len > 0) & - InputData%C_obj%pzVel = C_LOC(InputData%pzVel(LBOUND(InputData%pzVel,1, kind=B8Ki))) + InputData%C_obj%pzVel = C_LOC(InputData%pzVel(lbound(InputData%pzVel,1))) END IF END IF @@ -1993,7 +1993,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pxForce_Len = SIZE(InputData%pxForce) IF (InputData%C_obj%pxForce_Len > 0) & - InputData%C_obj%pxForce = C_LOC(InputData%pxForce(LBOUND(InputData%pxForce,1, kind=B8Ki))) + InputData%C_obj%pxForce = C_LOC(InputData%pxForce(lbound(InputData%pxForce,1))) END IF END IF @@ -2005,7 +2005,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pyForce_Len = SIZE(InputData%pyForce) IF (InputData%C_obj%pyForce_Len > 0) & - InputData%C_obj%pyForce = C_LOC(InputData%pyForce(LBOUND(InputData%pyForce,1, kind=B8Ki))) + InputData%C_obj%pyForce = C_LOC(InputData%pyForce(lbound(InputData%pyForce,1))) END IF END IF @@ -2017,7 +2017,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pzForce_Len = SIZE(InputData%pzForce) IF (InputData%C_obj%pzForce_Len > 0) & - InputData%C_obj%pzForce = C_LOC(InputData%pzForce(LBOUND(InputData%pzForce,1, kind=B8Ki))) + InputData%C_obj%pzForce = C_LOC(InputData%pzForce(lbound(InputData%pzForce,1))) END IF END IF @@ -2029,7 +2029,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%xdotForce_Len = SIZE(InputData%xdotForce) IF (InputData%C_obj%xdotForce_Len > 0) & - InputData%C_obj%xdotForce = C_LOC(InputData%xdotForce(LBOUND(InputData%xdotForce,1, kind=B8Ki))) + InputData%C_obj%xdotForce = C_LOC(InputData%xdotForce(lbound(InputData%xdotForce,1))) END IF END IF @@ -2041,7 +2041,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%ydotForce_Len = SIZE(InputData%ydotForce) IF (InputData%C_obj%ydotForce_Len > 0) & - InputData%C_obj%ydotForce = C_LOC(InputData%ydotForce(LBOUND(InputData%ydotForce,1, kind=B8Ki))) + InputData%C_obj%ydotForce = C_LOC(InputData%ydotForce(lbound(InputData%ydotForce,1))) END IF END IF @@ -2053,7 +2053,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%zdotForce_Len = SIZE(InputData%zdotForce) IF (InputData%C_obj%zdotForce_Len > 0) & - InputData%C_obj%zdotForce = C_LOC(InputData%zdotForce(LBOUND(InputData%zdotForce,1, kind=B8Ki))) + InputData%C_obj%zdotForce = C_LOC(InputData%zdotForce(lbound(InputData%zdotForce,1))) END IF END IF @@ -2065,7 +2065,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pOrientation_Len = SIZE(InputData%pOrientation) IF (InputData%C_obj%pOrientation_Len > 0) & - InputData%C_obj%pOrientation = C_LOC(InputData%pOrientation(LBOUND(InputData%pOrientation,1, kind=B8Ki))) + InputData%C_obj%pOrientation = C_LOC(InputData%pOrientation(lbound(InputData%pOrientation,1))) END IF END IF @@ -2077,7 +2077,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fx_Len = SIZE(InputData%fx) IF (InputData%C_obj%fx_Len > 0) & - InputData%C_obj%fx = C_LOC(InputData%fx(LBOUND(InputData%fx,1, kind=B8Ki))) + InputData%C_obj%fx = C_LOC(InputData%fx(lbound(InputData%fx,1))) END IF END IF @@ -2089,7 +2089,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fy_Len = SIZE(InputData%fy) IF (InputData%C_obj%fy_Len > 0) & - InputData%C_obj%fy = C_LOC(InputData%fy(LBOUND(InputData%fy,1, kind=B8Ki))) + InputData%C_obj%fy = C_LOC(InputData%fy(lbound(InputData%fy,1))) END IF END IF @@ -2101,7 +2101,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fz_Len = SIZE(InputData%fz) IF (InputData%C_obj%fz_Len > 0) & - InputData%C_obj%fz = C_LOC(InputData%fz(LBOUND(InputData%fz,1, kind=B8Ki))) + InputData%C_obj%fz = C_LOC(InputData%fz(lbound(InputData%fz,1))) END IF END IF @@ -2113,7 +2113,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momentx_Len = SIZE(InputData%momentx) IF (InputData%C_obj%momentx_Len > 0) & - InputData%C_obj%momentx = C_LOC(InputData%momentx(LBOUND(InputData%momentx,1, kind=B8Ki))) + InputData%C_obj%momentx = C_LOC(InputData%momentx(lbound(InputData%momentx,1))) END IF END IF @@ -2125,7 +2125,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momenty_Len = SIZE(InputData%momenty) IF (InputData%C_obj%momenty_Len > 0) & - InputData%C_obj%momenty = C_LOC(InputData%momenty(LBOUND(InputData%momenty,1, kind=B8Ki))) + InputData%C_obj%momenty = C_LOC(InputData%momenty(lbound(InputData%momenty,1))) END IF END IF @@ -2137,7 +2137,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momentz_Len = SIZE(InputData%momentz) IF (InputData%C_obj%momentz_Len > 0) & - InputData%C_obj%momentz = C_LOC(InputData%momentz(LBOUND(InputData%momentz,1, kind=B8Ki))) + InputData%C_obj%momentz = C_LOC(InputData%momentz(lbound(InputData%momentz,1))) END IF END IF @@ -2149,7 +2149,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) IF (InputData%C_obj%forceNodesChord_Len > 0) & - InputData%C_obj%forceNodesChord = C_LOC(InputData%forceNodesChord(LBOUND(InputData%forceNodesChord,1, kind=B8Ki))) + InputData%C_obj%forceNodesChord = C_LOC(InputData%forceNodesChord(lbound(InputData%forceNodesChord,1))) END IF END IF END SUBROUTINE @@ -2160,14 +2160,14 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%u)) then - LB(1:1) = lbound(SrcOutputData%u, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%u, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%u) + UB(1:1) = ubound(SrcOutputData%u) if (.not. associated(DstOutputData%u)) then allocate(DstOutputData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2181,8 +2181,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%u = SrcOutputData%u end if if (associated(SrcOutputData%v)) then - LB(1:1) = lbound(SrcOutputData%v, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%v, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%v) + UB(1:1) = ubound(SrcOutputData%v) if (.not. associated(DstOutputData%v)) then allocate(DstOutputData%v(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2196,8 +2196,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%v = SrcOutputData%v end if if (associated(SrcOutputData%w)) then - LB(1:1) = lbound(SrcOutputData%w, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%w, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%w) + UB(1:1) = ubound(SrcOutputData%w) if (.not. associated(DstOutputData%w)) then allocate(DstOutputData%w(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2211,8 +2211,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%w = SrcOutputData%w end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2275,7 +2275,7 @@ subroutine ExtInfw_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2367,7 +2367,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%u_Len = SIZE(OutputData%u) IF (OutputData%C_obj%u_Len > 0) & - OutputData%C_obj%u = C_LOC(OutputData%u(LBOUND(OutputData%u,1, kind=B8Ki))) + OutputData%C_obj%u = C_LOC(OutputData%u(lbound(OutputData%u,1))) END IF END IF @@ -2379,7 +2379,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%v_Len = SIZE(OutputData%v) IF (OutputData%C_obj%v_Len > 0) & - OutputData%C_obj%v = C_LOC(OutputData%v(LBOUND(OutputData%v,1, kind=B8Ki))) + OutputData%C_obj%v = C_LOC(OutputData%v(lbound(OutputData%v,1))) END IF END IF @@ -2391,7 +2391,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%w_Len = SIZE(OutputData%w) IF (OutputData%C_obj%w_Len > 0) & - OutputData%C_obj%w = C_LOC(OutputData%w(LBOUND(OutputData%w,1, kind=B8Ki))) + OutputData%C_obj%w = C_LOC(OutputData%w(lbound(OutputData%w,1))) END IF END IF END SUBROUTINE diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index fdeef925bf..8de53a4af7 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -134,14 +134,14 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtLdDX_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%twrDef)) then - LB(1:1) = lbound(SrcInputData%twrDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%twrDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%twrDef) + UB(1:1) = ubound(SrcInputData%twrDef) if (.not. associated(DstInputData%twrDef)) then allocate(DstInputData%twrDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -155,8 +155,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%twrDef = SrcInputData%twrDef end if if (associated(SrcInputData%bldDef)) then - LB(1:1) = lbound(SrcInputData%bldDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%bldDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%bldDef) + UB(1:1) = ubound(SrcInputData%bldDef) if (.not. associated(DstInputData%bldDef)) then allocate(DstInputData%bldDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -170,8 +170,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%bldDef = SrcInputData%bldDef end if if (associated(SrcInputData%hubDef)) then - LB(1:1) = lbound(SrcInputData%hubDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%hubDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%hubDef) + UB(1:1) = ubound(SrcInputData%hubDef) if (.not. associated(DstInputData%hubDef)) then allocate(DstInputData%hubDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -185,8 +185,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%hubDef = SrcInputData%hubDef end if if (associated(SrcInputData%nacDef)) then - LB(1:1) = lbound(SrcInputData%nacDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%nacDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%nacDef) + UB(1:1) = ubound(SrcInputData%nacDef) if (.not. associated(DstInputData%nacDef)) then allocate(DstInputData%nacDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -200,8 +200,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%nacDef = SrcInputData%nacDef end if if (associated(SrcInputData%bldRootDef)) then - LB(1:1) = lbound(SrcInputData%bldRootDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%bldRootDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%bldRootDef) + UB(1:1) = ubound(SrcInputData%bldRootDef) if (.not. associated(DstInputData%bldRootDef)) then allocate(DstInputData%bldRootDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -215,8 +215,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%bldRootDef = SrcInputData%bldRootDef end if if (associated(SrcInputData%bldPitch)) then - LB(1:1) = lbound(SrcInputData%bldPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%bldPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%bldPitch) + UB(1:1) = ubound(SrcInputData%bldPitch) if (.not. associated(DstInputData%bldPitch)) then allocate(DstInputData%bldPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -299,7 +299,7 @@ subroutine ExtLdDX_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLdDX_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLdDX_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -432,7 +432,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%twrDef_Len = SIZE(InputData%twrDef) IF (InputData%C_obj%twrDef_Len > 0) & - InputData%C_obj%twrDef = C_LOC(InputData%twrDef(LBOUND(InputData%twrDef,1, kind=B8Ki))) + InputData%C_obj%twrDef = C_LOC(InputData%twrDef(lbound(InputData%twrDef,1))) END IF END IF @@ -444,7 +444,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%bldDef_Len = SIZE(InputData%bldDef) IF (InputData%C_obj%bldDef_Len > 0) & - InputData%C_obj%bldDef = C_LOC(InputData%bldDef(LBOUND(InputData%bldDef,1, kind=B8Ki))) + InputData%C_obj%bldDef = C_LOC(InputData%bldDef(lbound(InputData%bldDef,1))) END IF END IF @@ -456,7 +456,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%hubDef_Len = SIZE(InputData%hubDef) IF (InputData%C_obj%hubDef_Len > 0) & - InputData%C_obj%hubDef = C_LOC(InputData%hubDef(LBOUND(InputData%hubDef,1, kind=B8Ki))) + InputData%C_obj%hubDef = C_LOC(InputData%hubDef(lbound(InputData%hubDef,1))) END IF END IF @@ -468,7 +468,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%nacDef_Len = SIZE(InputData%nacDef) IF (InputData%C_obj%nacDef_Len > 0) & - InputData%C_obj%nacDef = C_LOC(InputData%nacDef(LBOUND(InputData%nacDef,1, kind=B8Ki))) + InputData%C_obj%nacDef = C_LOC(InputData%nacDef(lbound(InputData%nacDef,1))) END IF END IF @@ -480,7 +480,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%bldRootDef_Len = SIZE(InputData%bldRootDef) IF (InputData%C_obj%bldRootDef_Len > 0) & - InputData%C_obj%bldRootDef = C_LOC(InputData%bldRootDef(LBOUND(InputData%bldRootDef,1, kind=B8Ki))) + InputData%C_obj%bldRootDef = C_LOC(InputData%bldRootDef(lbound(InputData%bldRootDef,1))) END IF END IF @@ -492,7 +492,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%bldPitch_Len = SIZE(InputData%bldPitch) IF (InputData%C_obj%bldPitch_Len > 0) & - InputData%C_obj%bldPitch = C_LOC(InputData%bldPitch(LBOUND(InputData%bldPitch,1, kind=B8Ki))) + InputData%C_obj%bldPitch = C_LOC(InputData%bldPitch(lbound(InputData%bldPitch,1))) END IF END IF END SUBROUTINE @@ -503,14 +503,14 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtLdDX_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcParamData%nBlades)) then - LB(1:1) = lbound(SrcParamData%nBlades, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nBlades, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nBlades) + UB(1:1) = ubound(SrcParamData%nBlades) if (.not. associated(DstParamData%nBlades)) then allocate(DstParamData%nBlades(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -524,8 +524,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%nBlades = SrcParamData%nBlades end if if (associated(SrcParamData%nBladeNodes)) then - LB(1:1) = lbound(SrcParamData%nBladeNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nBladeNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nBladeNodes) + UB(1:1) = ubound(SrcParamData%nBladeNodes) if (.not. associated(DstParamData%nBladeNodes)) then allocate(DstParamData%nBladeNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -539,8 +539,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%nBladeNodes = SrcParamData%nBladeNodes end if if (associated(SrcParamData%nTowerNodes)) then - LB(1:1) = lbound(SrcParamData%nTowerNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nTowerNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nTowerNodes) + UB(1:1) = ubound(SrcParamData%nTowerNodes) if (.not. associated(DstParamData%nTowerNodes)) then allocate(DstParamData%nTowerNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -554,8 +554,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%nTowerNodes = SrcParamData%nTowerNodes end if if (associated(SrcParamData%twrRefPos)) then - LB(1:1) = lbound(SrcParamData%twrRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%twrRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%twrRefPos) + UB(1:1) = ubound(SrcParamData%twrRefPos) if (.not. associated(DstParamData%twrRefPos)) then allocate(DstParamData%twrRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -569,8 +569,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%twrRefPos = SrcParamData%twrRefPos end if if (associated(SrcParamData%bldRefPos)) then - LB(1:1) = lbound(SrcParamData%bldRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%bldRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%bldRefPos) + UB(1:1) = ubound(SrcParamData%bldRefPos) if (.not. associated(DstParamData%bldRefPos)) then allocate(DstParamData%bldRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -584,8 +584,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%bldRefPos = SrcParamData%bldRefPos end if if (associated(SrcParamData%hubRefPos)) then - LB(1:1) = lbound(SrcParamData%hubRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%hubRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%hubRefPos) + UB(1:1) = ubound(SrcParamData%hubRefPos) if (.not. associated(DstParamData%hubRefPos)) then allocate(DstParamData%hubRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -599,8 +599,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%hubRefPos = SrcParamData%hubRefPos end if if (associated(SrcParamData%nacRefPos)) then - LB(1:1) = lbound(SrcParamData%nacRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nacRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nacRefPos) + UB(1:1) = ubound(SrcParamData%nacRefPos) if (.not. associated(DstParamData%nacRefPos)) then allocate(DstParamData%nacRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -614,8 +614,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%nacRefPos = SrcParamData%nacRefPos end if if (associated(SrcParamData%bldRootRefPos)) then - LB(1:1) = lbound(SrcParamData%bldRootRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%bldRootRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%bldRootRefPos) + UB(1:1) = ubound(SrcParamData%bldRootRefPos) if (.not. associated(DstParamData%bldRootRefPos)) then allocate(DstParamData%bldRootRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -629,8 +629,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%bldRootRefPos = SrcParamData%bldRootRefPos end if if (associated(SrcParamData%bldChord)) then - LB(1:1) = lbound(SrcParamData%bldChord, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%bldChord, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%bldChord) + UB(1:1) = ubound(SrcParamData%bldChord) if (.not. associated(DstParamData%bldChord)) then allocate(DstParamData%bldChord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -644,8 +644,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%bldChord = SrcParamData%bldChord end if if (associated(SrcParamData%bldRloc)) then - LB(1:1) = lbound(SrcParamData%bldRloc, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%bldRloc, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%bldRloc) + UB(1:1) = ubound(SrcParamData%bldRloc) if (.not. associated(DstParamData%bldRloc)) then allocate(DstParamData%bldRloc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -659,8 +659,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%bldRloc = SrcParamData%bldRloc end if if (associated(SrcParamData%twrDia)) then - LB(1:1) = lbound(SrcParamData%twrDia, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%twrDia, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%twrDia) + UB(1:1) = ubound(SrcParamData%twrDia) if (.not. associated(DstParamData%twrDia)) then allocate(DstParamData%twrDia(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -674,8 +674,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%twrDia = SrcParamData%twrDia end if if (associated(SrcParamData%twrHloc)) then - LB(1:1) = lbound(SrcParamData%twrHloc, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%twrHloc, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%twrHloc) + UB(1:1) = ubound(SrcParamData%twrHloc) if (.not. associated(DstParamData%twrHloc)) then allocate(DstParamData%twrHloc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -800,7 +800,7 @@ subroutine ExtLdDX_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLdDX_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLdDX_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1017,7 +1017,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%nBlades_Len = SIZE(ParamData%nBlades) IF (ParamData%C_obj%nBlades_Len > 0) & - ParamData%C_obj%nBlades = C_LOC(ParamData%nBlades(LBOUND(ParamData%nBlades,1, kind=B8Ki))) + ParamData%C_obj%nBlades = C_LOC(ParamData%nBlades(lbound(ParamData%nBlades,1))) END IF END IF @@ -1029,7 +1029,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%nBladeNodes_Len = SIZE(ParamData%nBladeNodes) IF (ParamData%C_obj%nBladeNodes_Len > 0) & - ParamData%C_obj%nBladeNodes = C_LOC(ParamData%nBladeNodes(LBOUND(ParamData%nBladeNodes,1, kind=B8Ki))) + ParamData%C_obj%nBladeNodes = C_LOC(ParamData%nBladeNodes(lbound(ParamData%nBladeNodes,1))) END IF END IF @@ -1041,7 +1041,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%nTowerNodes_Len = SIZE(ParamData%nTowerNodes) IF (ParamData%C_obj%nTowerNodes_Len > 0) & - ParamData%C_obj%nTowerNodes = C_LOC(ParamData%nTowerNodes(LBOUND(ParamData%nTowerNodes,1, kind=B8Ki))) + ParamData%C_obj%nTowerNodes = C_LOC(ParamData%nTowerNodes(lbound(ParamData%nTowerNodes,1))) END IF END IF @@ -1053,7 +1053,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%twrRefPos_Len = SIZE(ParamData%twrRefPos) IF (ParamData%C_obj%twrRefPos_Len > 0) & - ParamData%C_obj%twrRefPos = C_LOC(ParamData%twrRefPos(LBOUND(ParamData%twrRefPos,1, kind=B8Ki))) + ParamData%C_obj%twrRefPos = C_LOC(ParamData%twrRefPos(lbound(ParamData%twrRefPos,1))) END IF END IF @@ -1065,7 +1065,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%bldRefPos_Len = SIZE(ParamData%bldRefPos) IF (ParamData%C_obj%bldRefPos_Len > 0) & - ParamData%C_obj%bldRefPos = C_LOC(ParamData%bldRefPos(LBOUND(ParamData%bldRefPos,1, kind=B8Ki))) + ParamData%C_obj%bldRefPos = C_LOC(ParamData%bldRefPos(lbound(ParamData%bldRefPos,1))) END IF END IF @@ -1077,7 +1077,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%hubRefPos_Len = SIZE(ParamData%hubRefPos) IF (ParamData%C_obj%hubRefPos_Len > 0) & - ParamData%C_obj%hubRefPos = C_LOC(ParamData%hubRefPos(LBOUND(ParamData%hubRefPos,1, kind=B8Ki))) + ParamData%C_obj%hubRefPos = C_LOC(ParamData%hubRefPos(lbound(ParamData%hubRefPos,1))) END IF END IF @@ -1089,7 +1089,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%nacRefPos_Len = SIZE(ParamData%nacRefPos) IF (ParamData%C_obj%nacRefPos_Len > 0) & - ParamData%C_obj%nacRefPos = C_LOC(ParamData%nacRefPos(LBOUND(ParamData%nacRefPos,1, kind=B8Ki))) + ParamData%C_obj%nacRefPos = C_LOC(ParamData%nacRefPos(lbound(ParamData%nacRefPos,1))) END IF END IF @@ -1101,7 +1101,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%bldRootRefPos_Len = SIZE(ParamData%bldRootRefPos) IF (ParamData%C_obj%bldRootRefPos_Len > 0) & - ParamData%C_obj%bldRootRefPos = C_LOC(ParamData%bldRootRefPos(LBOUND(ParamData%bldRootRefPos,1, kind=B8Ki))) + ParamData%C_obj%bldRootRefPos = C_LOC(ParamData%bldRootRefPos(lbound(ParamData%bldRootRefPos,1))) END IF END IF @@ -1113,7 +1113,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%bldChord_Len = SIZE(ParamData%bldChord) IF (ParamData%C_obj%bldChord_Len > 0) & - ParamData%C_obj%bldChord = C_LOC(ParamData%bldChord(LBOUND(ParamData%bldChord,1, kind=B8Ki))) + ParamData%C_obj%bldChord = C_LOC(ParamData%bldChord(lbound(ParamData%bldChord,1))) END IF END IF @@ -1125,7 +1125,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%bldRloc_Len = SIZE(ParamData%bldRloc) IF (ParamData%C_obj%bldRloc_Len > 0) & - ParamData%C_obj%bldRloc = C_LOC(ParamData%bldRloc(LBOUND(ParamData%bldRloc,1, kind=B8Ki))) + ParamData%C_obj%bldRloc = C_LOC(ParamData%bldRloc(lbound(ParamData%bldRloc,1))) END IF END IF @@ -1137,7 +1137,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%twrDia_Len = SIZE(ParamData%twrDia) IF (ParamData%C_obj%twrDia_Len > 0) & - ParamData%C_obj%twrDia = C_LOC(ParamData%twrDia(LBOUND(ParamData%twrDia,1, kind=B8Ki))) + ParamData%C_obj%twrDia = C_LOC(ParamData%twrDia(lbound(ParamData%twrDia,1))) END IF END IF @@ -1149,7 +1149,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%twrHloc_Len = SIZE(ParamData%twrHloc) IF (ParamData%C_obj%twrHloc_Len > 0) & - ParamData%C_obj%twrHloc = C_LOC(ParamData%twrHloc(LBOUND(ParamData%twrHloc,1, kind=B8Ki))) + ParamData%C_obj%twrHloc = C_LOC(ParamData%twrHloc(lbound(ParamData%twrHloc,1))) END IF END IF END SUBROUTINE @@ -1160,14 +1160,14 @@ subroutine ExtLdDX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtLdDX_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%twrLd)) then - LB(1:1) = lbound(SrcOutputData%twrLd, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%twrLd, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%twrLd) + UB(1:1) = ubound(SrcOutputData%twrLd) if (.not. associated(DstOutputData%twrLd)) then allocate(DstOutputData%twrLd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1181,8 +1181,8 @@ subroutine ExtLdDX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%twrLd = SrcOutputData%twrLd end if if (associated(SrcOutputData%bldLd)) then - LB(1:1) = lbound(SrcOutputData%bldLd, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%bldLd, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%bldLd) + UB(1:1) = ubound(SrcOutputData%bldLd) if (.not. associated(DstOutputData%bldLd)) then allocate(DstOutputData%bldLd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1237,7 +1237,7 @@ subroutine ExtLdDX_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLdDX_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLdDX_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1314,7 +1314,7 @@ SUBROUTINE ExtLdDX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%twrLd_Len = SIZE(OutputData%twrLd) IF (OutputData%C_obj%twrLd_Len > 0) & - OutputData%C_obj%twrLd = C_LOC(OutputData%twrLd(LBOUND(OutputData%twrLd,1, kind=B8Ki))) + OutputData%C_obj%twrLd = C_LOC(OutputData%twrLd(lbound(OutputData%twrLd,1))) END IF END IF @@ -1326,7 +1326,7 @@ SUBROUTINE ExtLdDX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%bldLd_Len = SIZE(OutputData%bldLd) IF (OutputData%C_obj%bldLd_Len > 0) & - OutputData%C_obj%bldLd = C_LOC(OutputData%bldLd(LBOUND(OutputData%bldLd,1, kind=B8Ki))) + OutputData%C_obj%bldLd = C_LOC(OutputData%bldLd(lbound(OutputData%bldLd,1))) END IF END IF END SUBROUTINE diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index b9725ebd8c..f694a54b07 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -157,15 +157,15 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtLd_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' DstInitInputData%NumBlades = SrcInitInputData%NumBlades if (allocated(SrcInitInputData%NumBldNodes)) then - LB(1:1) = lbound(SrcInitInputData%NumBldNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%NumBldNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%NumBldNodes) + UB(1:1) = ubound(SrcInitInputData%NumBldNodes) if (.not. allocated(DstInitInputData%NumBldNodes)) then allocate(DstInitInputData%NumBldNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -182,8 +182,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NacellePos = SrcInitInputData%NacellePos DstInitInputData%NacelleOrient = SrcInitInputData%NacelleOrient if (allocated(SrcInitInputData%BldRootPos)) then - LB(1:2) = lbound(SrcInitInputData%BldRootPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BldRootPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BldRootPos) + UB(1:2) = ubound(SrcInitInputData%BldRootPos) if (.not. allocated(DstInitInputData%BldRootPos)) then allocate(DstInitInputData%BldRootPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -194,8 +194,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldRootPos = SrcInitInputData%BldRootPos end if if (allocated(SrcInitInputData%BldRootOrient)) then - LB(1:3) = lbound(SrcInitInputData%BldRootOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%BldRootOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%BldRootOrient) + UB(1:3) = ubound(SrcInitInputData%BldRootOrient) if (.not. allocated(DstInitInputData%BldRootOrient)) then allocate(DstInitInputData%BldRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -206,8 +206,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldRootOrient = SrcInitInputData%BldRootOrient end if if (allocated(SrcInitInputData%BldPos)) then - LB(1:3) = lbound(SrcInitInputData%BldPos, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%BldPos, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%BldPos) + UB(1:3) = ubound(SrcInitInputData%BldPos) if (.not. allocated(DstInitInputData%BldPos)) then allocate(DstInitInputData%BldPos(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -218,8 +218,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldPos = SrcInitInputData%BldPos end if if (allocated(SrcInitInputData%BldOrient)) then - LB(1:4) = lbound(SrcInitInputData%BldOrient, kind=B8Ki) - UB(1:4) = ubound(SrcInitInputData%BldOrient, kind=B8Ki) + LB(1:4) = lbound(SrcInitInputData%BldOrient) + UB(1:4) = ubound(SrcInitInputData%BldOrient) if (.not. allocated(DstInitInputData%BldOrient)) then allocate(DstInitInputData%BldOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -230,8 +230,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldOrient = SrcInitInputData%BldOrient end if if (allocated(SrcInitInputData%TwrPos)) then - LB(1:2) = lbound(SrcInitInputData%TwrPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%TwrPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%TwrPos) + UB(1:2) = ubound(SrcInitInputData%TwrPos) if (.not. allocated(DstInitInputData%TwrPos)) then allocate(DstInitInputData%TwrPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -242,8 +242,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%TwrPos = SrcInitInputData%TwrPos end if if (allocated(SrcInitInputData%TwrOrient)) then - LB(1:3) = lbound(SrcInitInputData%TwrOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%TwrOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%TwrOrient) + UB(1:3) = ubound(SrcInitInputData%TwrOrient) if (.not. allocated(DstInitInputData%TwrOrient)) then allocate(DstInitInputData%TwrOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -256,8 +256,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%az_blend_mean = SrcInitInputData%az_blend_mean DstInitInputData%az_blend_delta = SrcInitInputData%az_blend_delta if (allocated(SrcInitInputData%BldChord)) then - LB(1:2) = lbound(SrcInitInputData%BldChord, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BldChord, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BldChord) + UB(1:2) = ubound(SrcInitInputData%BldChord) if (.not. allocated(DstInitInputData%BldChord)) then allocate(DstInitInputData%BldChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -268,8 +268,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldChord = SrcInitInputData%BldChord end if if (allocated(SrcInitInputData%BldRloc)) then - LB(1:2) = lbound(SrcInitInputData%BldRloc, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BldRloc, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BldRloc) + UB(1:2) = ubound(SrcInitInputData%BldRloc) if (.not. allocated(DstInitInputData%BldRloc)) then allocate(DstInitInputData%BldRloc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -280,8 +280,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldRloc = SrcInitInputData%BldRloc end if if (allocated(SrcInitInputData%TwrDia)) then - LB(1:1) = lbound(SrcInitInputData%TwrDia, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%TwrDia, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%TwrDia) + UB(1:1) = ubound(SrcInitInputData%TwrDia) if (.not. allocated(DstInitInputData%TwrDia)) then allocate(DstInitInputData%TwrDia(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -292,8 +292,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%TwrDia = SrcInitInputData%TwrDia end if if (allocated(SrcInitInputData%TwrHloc)) then - LB(1:1) = lbound(SrcInitInputData%TwrHloc, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%TwrHloc, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%TwrHloc) + UB(1:1) = ubound(SrcInitInputData%TwrHloc) if (.not. allocated(DstInitInputData%TwrHloc)) then allocate(DstInitInputData%TwrHloc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -381,7 +381,7 @@ subroutine ExtLd_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackInitInput' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -414,15 +414,15 @@ subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -433,8 +433,8 @@ subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -495,7 +495,7 @@ subroutine ExtLd_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -735,7 +735,7 @@ subroutine ExtLd_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyParam' @@ -758,8 +758,8 @@ subroutine ExtLd_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg if (ErrStat >= AbortErrLev) return DstParamData%NumBlds = SrcParamData%NumBlds if (allocated(SrcParamData%NumBldNds)) then - LB(1:1) = lbound(SrcParamData%NumBldNds, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NumBldNds, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NumBldNds) + UB(1:1) = ubound(SrcParamData%NumBldNds) if (.not. allocated(DstParamData%NumBldNds)) then allocate(DstParamData%NumBldNds(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -826,7 +826,7 @@ subroutine ExtLd_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -866,8 +866,8 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyInput' @@ -887,8 +887,8 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%BladeRootMotion)) then - LB(1:1) = lbound(SrcInputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BladeRootMotion) + UB(1:1) = ubound(SrcInputData%BladeRootMotion) if (.not. allocated(DstInputData%BladeRootMotion)) then allocate(DstInputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -903,8 +903,8 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcInputData%BladeMotion)) then - LB(1:1) = lbound(SrcInputData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BladeMotion, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BladeMotion) + UB(1:1) = ubound(SrcInputData%BladeMotion) if (.not. allocated(DstInputData%BladeMotion)) then allocate(DstInputData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -922,8 +922,8 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%BladeLoadAD)) then - LB(1:1) = lbound(SrcInputData%BladeLoadAD, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BladeLoadAD, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BladeLoadAD) + UB(1:1) = ubound(SrcInputData%BladeLoadAD) if (.not. allocated(DstInputData%BladeLoadAD)) then allocate(DstInputData%BladeLoadAD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -943,8 +943,8 @@ subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) type(ExtLd_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_DestroyInput' @@ -959,8 +959,8 @@ subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) call MeshDestroy( InputData%NacelleMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%BladeRootMotion)) then - LB(1:1) = lbound(InputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InputData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(InputData%BladeRootMotion) + UB(1:1) = ubound(InputData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -968,8 +968,8 @@ subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%BladeRootMotion) end if if (allocated(InputData%BladeMotion)) then - LB(1:1) = lbound(InputData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(InputData%BladeMotion, kind=B8Ki) + LB(1:1) = lbound(InputData%BladeMotion) + UB(1:1) = ubound(InputData%BladeMotion) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BladeMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -979,8 +979,8 @@ subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) call MeshDestroy( InputData%TowerLoadAD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%BladeLoadAD)) then - LB(1:1) = lbound(InputData%BladeLoadAD, kind=B8Ki) - UB(1:1) = ubound(InputData%BladeLoadAD, kind=B8Ki) + LB(1:1) = lbound(InputData%BladeLoadAD) + UB(1:1) = ubound(InputData%BladeLoadAD) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BladeLoadAD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -993,8 +993,8 @@ subroutine ExtLd_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call ExtLdDX_PackInput(RF, InData%DX_u) call RegPack(RF, InData%az) @@ -1003,18 +1003,18 @@ subroutine ExtLd_PackInput(RF, Indata) call MeshPack(RF, InData%NacelleMotion) call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeRootMotion(i1)) end do end if call RegPack(RF, allocated(InData%BladeMotion)) if (allocated(InData%BladeMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) + LB(1:1) = lbound(InData%BladeMotion) + UB(1:1) = ubound(InData%BladeMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeMotion(i1)) end do @@ -1022,9 +1022,9 @@ subroutine ExtLd_PackInput(RF, Indata) call MeshPack(RF, InData%TowerLoadAD) call RegPack(RF, allocated(InData%BladeLoadAD)) if (allocated(InData%BladeLoadAD)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoadAD, kind=B8Ki), ubound(InData%BladeLoadAD, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLoadAD, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLoadAD, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeLoadAD), ubound(InData%BladeLoadAD)) + LB(1:1) = lbound(InData%BladeLoadAD) + UB(1:1) = ubound(InData%BladeLoadAD) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeLoadAD(i1)) end do @@ -1036,8 +1036,8 @@ subroutine ExtLd_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1094,8 +1094,8 @@ subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyOutput' @@ -1108,8 +1108,8 @@ subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%BladeLoad)) then - LB(1:1) = lbound(SrcOutputData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeLoad, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BladeLoad) + UB(1:1) = ubound(SrcOutputData%BladeLoad) if (.not. allocated(DstOutputData%BladeLoad)) then allocate(DstOutputData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1129,8 +1129,8 @@ subroutine ExtLd_DestroyOutput(OutputData, ErrStat, ErrMsg) type(ExtLd_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_DestroyOutput' @@ -1141,8 +1141,8 @@ subroutine ExtLd_DestroyOutput(OutputData, ErrStat, ErrMsg) call MeshDestroy( OutputData%TowerLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%BladeLoad)) then - LB(1:1) = lbound(OutputData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeLoad, kind=B8Ki) + LB(1:1) = lbound(OutputData%BladeLoad) + UB(1:1) = ubound(OutputData%BladeLoad) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BladeLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1155,16 +1155,16 @@ subroutine ExtLd_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call ExtLdDX_PackOutput(RF, InData%DX_y) call MeshPack(RF, InData%TowerLoad) call RegPack(RF, allocated(InData%BladeLoad)) if (allocated(InData%BladeLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoad, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLoad, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) + LB(1:1) = lbound(InData%BladeLoad) + UB(1:1) = ubound(InData%BladeLoad) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeLoad(i1)) end do @@ -1176,8 +1176,8 @@ subroutine ExtLd_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1305,13 +1305,13 @@ SUBROUTINE ExtLd_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL MeshExtrapInterp1(u1%NacelleMotion, u2%NacelleMotion, tin, u_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(u_out%BladeRootMotion,1),ubound(u_out%BladeRootMotion,1) CALL MeshExtrapInterp1(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i1 = LBOUND(u_out%BladeMotion,1, kind=B8Ki),UBOUND(u_out%BladeMotion,1, kind=B8Ki) + do i1 = lbound(u_out%BladeMotion,1),ubound(u_out%BladeMotion,1) CALL MeshExtrapInterp1(u1%BladeMotion(i1), u2%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1319,7 +1319,7 @@ SUBROUTINE ExtLd_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL MeshExtrapInterp1(u1%TowerLoadAD, u2%TowerLoadAD, tin, u_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeLoadAD) .AND. ALLOCATED(u1%BladeLoadAD)) THEN - DO i1 = LBOUND(u_out%BladeLoadAD,1, kind=B8Ki),UBOUND(u_out%BladeLoadAD,1, kind=B8Ki) + do i1 = lbound(u_out%BladeLoadAD,1),ubound(u_out%BladeLoadAD,1) CALL MeshExtrapInterp1(u1%BladeLoadAD(i1), u2%BladeLoadAD(i1), tin, u_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1391,13 +1391,13 @@ SUBROUTINE ExtLd_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL MeshExtrapInterp2(u1%NacelleMotion, u2%NacelleMotion, u3%NacelleMotion, tin, u_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(u_out%BladeRootMotion,1),ubound(u_out%BladeRootMotion,1) CALL MeshExtrapInterp2(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), u3%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i1 = LBOUND(u_out%BladeMotion,1, kind=B8Ki),UBOUND(u_out%BladeMotion,1, kind=B8Ki) + do i1 = lbound(u_out%BladeMotion,1),ubound(u_out%BladeMotion,1) CALL MeshExtrapInterp2(u1%BladeMotion(i1), u2%BladeMotion(i1), u3%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1405,7 +1405,7 @@ SUBROUTINE ExtLd_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL MeshExtrapInterp2(u1%TowerLoadAD, u2%TowerLoadAD, u3%TowerLoadAD, tin, u_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeLoadAD) .AND. ALLOCATED(u1%BladeLoadAD)) THEN - DO i1 = LBOUND(u_out%BladeLoadAD,1, kind=B8Ki),UBOUND(u_out%BladeLoadAD,1, kind=B8Ki) + do i1 = lbound(u_out%BladeLoadAD,1),ubound(u_out%BladeLoadAD,1) CALL MeshExtrapInterp2(u1%BladeLoadAD(i1), u2%BladeLoadAD(i1), u3%BladeLoadAD(i1), tin, u_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1514,7 +1514,7 @@ SUBROUTINE ExtLd_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL MeshExtrapInterp1(y1%TowerLoad, y2%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN - DO i1 = LBOUND(y_out%BladeLoad,1, kind=B8Ki),UBOUND(y_out%BladeLoad,1, kind=B8Ki) + do i1 = lbound(y_out%BladeLoad,1),ubound(y_out%BladeLoad,1) CALL MeshExtrapInterp1(y1%BladeLoad(i1), y2%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1581,7 +1581,7 @@ SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL MeshExtrapInterp2(y1%TowerLoad, y2%TowerLoad, y3%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN - DO i1 = LBOUND(y_out%BladeLoad,1, kind=B8Ki),UBOUND(y_out%BladeLoad,1, kind=B8Ki) + do i1 = lbound(y_out%BladeLoad,1),ubound(y_out%BladeLoad,1) CALL MeshExtrapInterp2(y1%BladeLoad(i1), y2%BladeLoad(i1), y3%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index b27ccc6177..798feb7b98 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -222,7 +222,7 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyInputFile' ErrStat = ErrID_None @@ -234,8 +234,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst DstInputFileData%EquilStart = SrcInputFileData%EquilStart if (allocated(SrcInputFileData%ActiveCBDOF)) then - LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF) + UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF) if (.not. allocated(DstInputFileData%ActiveCBDOF)) then allocate(DstInputFileData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -246,8 +246,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF end if if (allocated(SrcInputFileData%InitPosList)) then - LB(1:1) = lbound(SrcInputFileData%InitPosList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%InitPosList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%InitPosList) + UB(1:1) = ubound(SrcInputFileData%InitPosList) if (.not. allocated(DstInputFileData%InitPosList)) then allocate(DstInputFileData%InitPosList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -258,8 +258,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%InitPosList = SrcInputFileData%InitPosList end if if (allocated(SrcInputFileData%InitVelList)) then - LB(1:1) = lbound(SrcInputFileData%InitVelList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%InitVelList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%InitVelList) + UB(1:1) = ubound(SrcInputFileData%InitVelList) if (.not. allocated(DstInputFileData%InitVelList)) then allocate(DstInputFileData%InitVelList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -276,8 +276,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -338,7 +338,7 @@ subroutine ExtPtfm_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -366,7 +366,7 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyInitOutput' @@ -376,8 +376,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -388,8 +388,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -400,8 +400,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -412,8 +412,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -424,8 +424,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -436,8 +436,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -448,8 +448,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -460,8 +460,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -472,8 +472,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -484,8 +484,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -569,7 +569,7 @@ subroutine ExtPtfm_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -593,14 +593,14 @@ subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%qm)) then - LB(1:1) = lbound(SrcContStateData%qm, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qm, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) if (.not. allocated(DstContStateData%qm)) then allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -611,8 +611,8 @@ subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, E DstContStateData%qm = SrcContStateData%qm end if if (allocated(SrcContStateData%qmdot)) then - LB(1:1) = lbound(SrcContStateData%qmdot, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qmdot, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) if (.not. allocated(DstContStateData%qmdot)) then allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -653,7 +653,7 @@ subroutine ExtPtfm_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -743,16 +743,16 @@ subroutine ExtPtfm_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -773,16 +773,16 @@ subroutine ExtPtfm_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(ExtPtfm_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call ExtPtfm_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -795,14 +795,14 @@ subroutine ExtPtfm_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtPtfm_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call ExtPtfm_PackContState(RF, InData%xdot(i1)) end do @@ -815,8 +815,8 @@ subroutine ExtPtfm_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -842,16 +842,16 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%Mass)) then - LB(1:2) = lbound(SrcParamData%Mass, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Mass, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Mass) + UB(1:2) = ubound(SrcParamData%Mass) if (.not. allocated(DstParamData%Mass)) then allocate(DstParamData%Mass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -862,8 +862,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Mass = SrcParamData%Mass end if if (allocated(SrcParamData%Damp)) then - LB(1:2) = lbound(SrcParamData%Damp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Damp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Damp) + UB(1:2) = ubound(SrcParamData%Damp) if (.not. allocated(DstParamData%Damp)) then allocate(DstParamData%Damp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -874,8 +874,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Damp = SrcParamData%Damp end if if (allocated(SrcParamData%Stff)) then - LB(1:2) = lbound(SrcParamData%Stff, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Stff, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Stff) + UB(1:2) = ubound(SrcParamData%Stff) if (.not. allocated(DstParamData%Stff)) then allocate(DstParamData%Stff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -886,8 +886,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Stff = SrcParamData%Stff end if if (allocated(SrcParamData%Forces)) then - LB(1:2) = lbound(SrcParamData%Forces, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Forces, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Forces) + UB(1:2) = ubound(SrcParamData%Forces) if (.not. allocated(DstParamData%Forces)) then allocate(DstParamData%Forces(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -898,8 +898,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Forces = SrcParamData%Forces end if if (allocated(SrcParamData%times)) then - LB(1:1) = lbound(SrcParamData%times, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%times, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%times) + UB(1:1) = ubound(SrcParamData%times) if (.not. allocated(DstParamData%times)) then allocate(DstParamData%times(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -910,8 +910,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%times = SrcParamData%times end if if (allocated(SrcParamData%AMat)) then - LB(1:2) = lbound(SrcParamData%AMat, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AMat, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AMat) + UB(1:2) = ubound(SrcParamData%AMat) if (.not. allocated(DstParamData%AMat)) then allocate(DstParamData%AMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -922,8 +922,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%AMat = SrcParamData%AMat end if if (allocated(SrcParamData%BMat)) then - LB(1:2) = lbound(SrcParamData%BMat, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BMat, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BMat) + UB(1:2) = ubound(SrcParamData%BMat) if (.not. allocated(DstParamData%BMat)) then allocate(DstParamData%BMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -934,8 +934,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%BMat = SrcParamData%BMat end if if (allocated(SrcParamData%CMat)) then - LB(1:2) = lbound(SrcParamData%CMat, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CMat, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CMat) + UB(1:2) = ubound(SrcParamData%CMat) if (.not. allocated(DstParamData%CMat)) then allocate(DstParamData%CMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -946,8 +946,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%CMat = SrcParamData%CMat end if if (allocated(SrcParamData%DMat)) then - LB(1:2) = lbound(SrcParamData%DMat, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DMat, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%DMat) + UB(1:2) = ubound(SrcParamData%DMat) if (.not. allocated(DstParamData%DMat)) then allocate(DstParamData%DMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -958,8 +958,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DMat = SrcParamData%DMat end if if (allocated(SrcParamData%FX)) then - LB(1:1) = lbound(SrcParamData%FX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FX) + UB(1:1) = ubound(SrcParamData%FX) if (.not. allocated(DstParamData%FX)) then allocate(DstParamData%FX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -970,8 +970,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%FX = SrcParamData%FX end if if (allocated(SrcParamData%FY)) then - LB(1:1) = lbound(SrcParamData%FY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FY) + UB(1:1) = ubound(SrcParamData%FY) if (.not. allocated(DstParamData%FY)) then allocate(DstParamData%FY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -982,8 +982,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%FY = SrcParamData%FY end if if (allocated(SrcParamData%M11)) then - LB(1:2) = lbound(SrcParamData%M11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%M11, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%M11) + UB(1:2) = ubound(SrcParamData%M11) if (.not. allocated(DstParamData%M11)) then allocate(DstParamData%M11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -994,8 +994,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M11 = SrcParamData%M11 end if if (allocated(SrcParamData%M12)) then - LB(1:2) = lbound(SrcParamData%M12, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%M12, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%M12) + UB(1:2) = ubound(SrcParamData%M12) if (.not. allocated(DstParamData%M12)) then allocate(DstParamData%M12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1006,8 +1006,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M12 = SrcParamData%M12 end if if (allocated(SrcParamData%M22)) then - LB(1:2) = lbound(SrcParamData%M22, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%M22, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%M22) + UB(1:2) = ubound(SrcParamData%M22) if (.not. allocated(DstParamData%M22)) then allocate(DstParamData%M22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1018,8 +1018,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M22 = SrcParamData%M22 end if if (allocated(SrcParamData%M21)) then - LB(1:2) = lbound(SrcParamData%M21, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%M21, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%M21) + UB(1:2) = ubound(SrcParamData%M21) if (.not. allocated(DstParamData%M21)) then allocate(DstParamData%M21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1030,8 +1030,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M21 = SrcParamData%M21 end if if (allocated(SrcParamData%K11)) then - LB(1:2) = lbound(SrcParamData%K11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%K11, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%K11) + UB(1:2) = ubound(SrcParamData%K11) if (.not. allocated(DstParamData%K11)) then allocate(DstParamData%K11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1042,8 +1042,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%K11 = SrcParamData%K11 end if if (allocated(SrcParamData%K22)) then - LB(1:2) = lbound(SrcParamData%K22, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%K22, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%K22) + UB(1:2) = ubound(SrcParamData%K22) if (.not. allocated(DstParamData%K22)) then allocate(DstParamData%K22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1054,8 +1054,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%K22 = SrcParamData%K22 end if if (allocated(SrcParamData%C11)) then - LB(1:2) = lbound(SrcParamData%C11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C11, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C11) + UB(1:2) = ubound(SrcParamData%C11) if (.not. allocated(DstParamData%C11)) then allocate(DstParamData%C11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1066,8 +1066,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C11 = SrcParamData%C11 end if if (allocated(SrcParamData%C12)) then - LB(1:2) = lbound(SrcParamData%C12, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C12, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C12) + UB(1:2) = ubound(SrcParamData%C12) if (.not. allocated(DstParamData%C12)) then allocate(DstParamData%C12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1078,8 +1078,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C12 = SrcParamData%C12 end if if (allocated(SrcParamData%C22)) then - LB(1:2) = lbound(SrcParamData%C22, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C22, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C22) + UB(1:2) = ubound(SrcParamData%C22) if (.not. allocated(DstParamData%C22)) then allocate(DstParamData%C22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1090,8 +1090,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C22 = SrcParamData%C22 end if if (allocated(SrcParamData%C21)) then - LB(1:2) = lbound(SrcParamData%C21, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C21, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C21) + UB(1:2) = ubound(SrcParamData%C21) if (.not. allocated(DstParamData%C21)) then allocate(DstParamData%C21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1109,8 +1109,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%IntMethod = SrcParamData%IntMethod if (allocated(SrcParamData%ActiveCBDOF)) then - LB(1:1) = lbound(SrcParamData%ActiveCBDOF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ActiveCBDOF, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ActiveCBDOF) + UB(1:1) = ubound(SrcParamData%ActiveCBDOF) if (.not. allocated(DstParamData%ActiveCBDOF)) then allocate(DstParamData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1121,8 +1121,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1137,8 +1137,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcParamData%OutParamLinIndx)) then - LB(1:2) = lbound(SrcParamData%OutParamLinIndx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%OutParamLinIndx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) if (.not. allocated(DstParamData%OutParamLinIndx)) then allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1154,8 +1154,8 @@ subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) type(ExtPtfm_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_DestroyParam' @@ -1228,8 +1228,8 @@ subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%ActiveCBDOF) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1245,8 +1245,8 @@ subroutine ExtPtfm_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtPtfm_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%Mass) call RegPackAlloc(RF, InData%Damp) @@ -1279,9 +1279,9 @@ subroutine ExtPtfm_PackParam(RF, Indata) call RegPackAlloc(RF, InData%ActiveCBDOF) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1294,8 +1294,8 @@ subroutine ExtPtfm_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1396,7 +1396,7 @@ subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyOutput' @@ -1406,8 +1406,8 @@ subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1449,7 +1449,7 @@ subroutine ExtPtfm_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1463,15 +1463,15 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%xFlat)) then - LB(1:1) = lbound(SrcMiscData%xFlat, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%xFlat, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%xFlat) + UB(1:1) = ubound(SrcMiscData%xFlat) if (.not. allocated(DstMiscData%xFlat)) then allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1483,8 +1483,8 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%uFlat = SrcMiscData%uFlat if (allocated(SrcMiscData%F_at_t)) then - LB(1:1) = lbound(SrcMiscData%F_at_t, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_at_t, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_at_t) + UB(1:1) = ubound(SrcMiscData%F_at_t) if (.not. allocated(DstMiscData%F_at_t)) then allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1497,8 +1497,8 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Indx = SrcMiscData%Indx DstMiscData%EquilStart = SrcMiscData%EquilStart if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1578,7 +1578,7 @@ subroutine ExtPtfm_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 73e02a8803..79de7a2b52 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -244,15 +244,15 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyInputFile' ErrStat = ErrID_None ErrMsg = '' DstInputFileData%DT = SrcInputFileData%DT if (allocated(SrcInputFileData%LineCI)) then - LB(1:1) = lbound(SrcInputFileData%LineCI, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LineCI, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LineCI) + UB(1:1) = ubound(SrcInputFileData%LineCI) if (.not. allocated(DstInputFileData%LineCI)) then allocate(DstInputFileData%LineCI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -263,8 +263,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LineCI = SrcInputFileData%LineCI end if if (allocated(SrcInputFileData%LineCD)) then - LB(1:1) = lbound(SrcInputFileData%LineCD, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LineCD, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LineCD) + UB(1:1) = ubound(SrcInputFileData%LineCD) if (.not. allocated(DstInputFileData%LineCD)) then allocate(DstInputFileData%LineCD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -275,8 +275,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LineCD = SrcInputFileData%LineCD end if if (allocated(SrcInputFileData%LEAStiff)) then - LB(1:1) = lbound(SrcInputFileData%LEAStiff, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LEAStiff, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LEAStiff) + UB(1:1) = ubound(SrcInputFileData%LEAStiff) if (.not. allocated(DstInputFileData%LEAStiff)) then allocate(DstInputFileData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -287,8 +287,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff end if if (allocated(SrcInputFileData%LMassDen)) then - LB(1:1) = lbound(SrcInputFileData%LMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LMassDen) + UB(1:1) = ubound(SrcInputFileData%LMassDen) if (.not. allocated(DstInputFileData%LMassDen)) then allocate(DstInputFileData%LMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -299,8 +299,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LMassDen = SrcInputFileData%LMassDen end if if (allocated(SrcInputFileData%LDMassDen)) then - LB(1:1) = lbound(SrcInputFileData%LDMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LDMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LDMassDen) + UB(1:1) = ubound(SrcInputFileData%LDMassDen) if (.not. allocated(DstInputFileData%LDMassDen)) then allocate(DstInputFileData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -311,8 +311,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen end if if (allocated(SrcInputFileData%BottmStiff)) then - LB(1:1) = lbound(SrcInputFileData%BottmStiff, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BottmStiff, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BottmStiff) + UB(1:1) = ubound(SrcInputFileData%BottmStiff) if (.not. allocated(DstInputFileData%BottmStiff)) then allocate(DstInputFileData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -323,8 +323,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff end if if (allocated(SrcInputFileData%LRadAnch)) then - LB(1:1) = lbound(SrcInputFileData%LRadAnch, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LRadAnch, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LRadAnch) + UB(1:1) = ubound(SrcInputFileData%LRadAnch) if (.not. allocated(DstInputFileData%LRadAnch)) then allocate(DstInputFileData%LRadAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -335,8 +335,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch end if if (allocated(SrcInputFileData%LAngAnch)) then - LB(1:1) = lbound(SrcInputFileData%LAngAnch, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LAngAnch, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LAngAnch) + UB(1:1) = ubound(SrcInputFileData%LAngAnch) if (.not. allocated(DstInputFileData%LAngAnch)) then allocate(DstInputFileData%LAngAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -347,8 +347,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch end if if (allocated(SrcInputFileData%LDpthAnch)) then - LB(1:1) = lbound(SrcInputFileData%LDpthAnch, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LDpthAnch, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LDpthAnch) + UB(1:1) = ubound(SrcInputFileData%LDpthAnch) if (.not. allocated(DstInputFileData%LDpthAnch)) then allocate(DstInputFileData%LDpthAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -359,8 +359,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch end if if (allocated(SrcInputFileData%LRadFair)) then - LB(1:1) = lbound(SrcInputFileData%LRadFair, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LRadFair, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LRadFair) + UB(1:1) = ubound(SrcInputFileData%LRadFair) if (.not. allocated(DstInputFileData%LRadFair)) then allocate(DstInputFileData%LRadFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -371,8 +371,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LRadFair = SrcInputFileData%LRadFair end if if (allocated(SrcInputFileData%LAngFair)) then - LB(1:1) = lbound(SrcInputFileData%LAngFair, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LAngFair, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LAngFair) + UB(1:1) = ubound(SrcInputFileData%LAngFair) if (.not. allocated(DstInputFileData%LAngFair)) then allocate(DstInputFileData%LAngFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -383,8 +383,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LAngFair = SrcInputFileData%LAngFair end if if (allocated(SrcInputFileData%LDrftFair)) then - LB(1:1) = lbound(SrcInputFileData%LDrftFair, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LDrftFair, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LDrftFair) + UB(1:1) = ubound(SrcInputFileData%LDrftFair) if (.not. allocated(DstInputFileData%LDrftFair)) then allocate(DstInputFileData%LDrftFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -395,8 +395,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair end if if (allocated(SrcInputFileData%LUnstrLen)) then - LB(1:1) = lbound(SrcInputFileData%LUnstrLen, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LUnstrLen, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LUnstrLen) + UB(1:1) = ubound(SrcInputFileData%LUnstrLen) if (.not. allocated(DstInputFileData%LUnstrLen)) then allocate(DstInputFileData%LUnstrLen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -407,8 +407,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen end if if (allocated(SrcInputFileData%Tension)) then - LB(1:1) = lbound(SrcInputFileData%Tension, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%Tension, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%Tension) + UB(1:1) = ubound(SrcInputFileData%Tension) if (.not. allocated(DstInputFileData%Tension)) then allocate(DstInputFileData%Tension(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -419,8 +419,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tension = SrcInputFileData%Tension end if if (allocated(SrcInputFileData%GSL)) then - LB(1:3) = lbound(SrcInputFileData%GSL, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%GSL, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%GSL) + UB(1:3) = ubound(SrcInputFileData%GSL) if (.not. allocated(DstInputFileData%GSL)) then allocate(DstInputFileData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -431,8 +431,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GSL = SrcInputFileData%GSL end if if (allocated(SrcInputFileData%GSR)) then - LB(1:2) = lbound(SrcInputFileData%GSR, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%GSR, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%GSR) + UB(1:2) = ubound(SrcInputFileData%GSR) if (.not. allocated(DstInputFileData%GSR)) then allocate(DstInputFileData%GSR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -443,8 +443,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GSR = SrcInputFileData%GSR end if if (allocated(SrcInputFileData%GE)) then - LB(1:3) = lbound(SrcInputFileData%GE, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%GE, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%GE) + UB(1:3) = ubound(SrcInputFileData%GE) if (.not. allocated(DstInputFileData%GE)) then allocate(DstInputFileData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -467,8 +467,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -586,7 +586,7 @@ subroutine FEAM_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInputFile' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -629,7 +629,7 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyInitInput' ErrStat = ErrID_None @@ -639,8 +639,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit DstInitInputData%NStepWave = SrcInitInputData%NStepWave if (allocated(SrcInitInputData%WaveAcc0)) then - LB(1:3) = lbound(SrcInitInputData%WaveAcc0, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%WaveAcc0, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%WaveAcc0) + UB(1:3) = ubound(SrcInitInputData%WaveAcc0) if (.not. allocated(DstInitInputData%WaveAcc0)) then allocate(DstInitInputData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -651,8 +651,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 end if if (allocated(SrcInitInputData%WaveTime)) then - LB(1:1) = lbound(SrcInitInputData%WaveTime, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveTime, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveTime) + UB(1:1) = ubound(SrcInitInputData%WaveTime) if (.not. allocated(DstInitInputData%WaveTime)) then allocate(DstInitInputData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -663,8 +663,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%WaveTime = SrcInitInputData%WaveTime end if if (allocated(SrcInitInputData%WaveVel0)) then - LB(1:3) = lbound(SrcInitInputData%WaveVel0, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%WaveVel0, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%WaveVel0) + UB(1:3) = ubound(SrcInitInputData%WaveVel0) if (.not. allocated(DstInitInputData%WaveVel0)) then allocate(DstInitInputData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -717,7 +717,7 @@ subroutine FEAM_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -738,15 +738,15 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -757,8 +757,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -773,8 +773,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E if (ErrStat >= AbortErrLev) return DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%LAnchxi)) then - LB(1:1) = lbound(SrcInitOutputData%LAnchxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LAnchxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LAnchxi) + UB(1:1) = ubound(SrcInitOutputData%LAnchxi) if (.not. allocated(DstInitOutputData%LAnchxi)) then allocate(DstInitOutputData%LAnchxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -785,8 +785,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi end if if (allocated(SrcInitOutputData%LAnchyi)) then - LB(1:1) = lbound(SrcInitOutputData%LAnchyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LAnchyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LAnchyi) + UB(1:1) = ubound(SrcInitOutputData%LAnchyi) if (.not. allocated(DstInitOutputData%LAnchyi)) then allocate(DstInitOutputData%LAnchyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -797,8 +797,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi end if if (allocated(SrcInitOutputData%LAnchzi)) then - LB(1:1) = lbound(SrcInitOutputData%LAnchzi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LAnchzi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LAnchzi) + UB(1:1) = ubound(SrcInitOutputData%LAnchzi) if (.not. allocated(DstInitOutputData%LAnchzi)) then allocate(DstInitOutputData%LAnchzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -809,8 +809,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi end if if (allocated(SrcInitOutputData%LFairxt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairxt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LFairxt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LFairxt) + UB(1:1) = ubound(SrcInitOutputData%LFairxt) if (.not. allocated(DstInitOutputData%LFairxt)) then allocate(DstInitOutputData%LFairxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -821,8 +821,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt end if if (allocated(SrcInitOutputData%LFairyt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairyt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LFairyt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LFairyt) + UB(1:1) = ubound(SrcInitOutputData%LFairyt) if (.not. allocated(DstInitOutputData%LFairyt)) then allocate(DstInitOutputData%LFairyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -833,8 +833,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt end if if (allocated(SrcInitOutputData%LFairzt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairzt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LFairzt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LFairzt) + UB(1:1) = ubound(SrcInitOutputData%LFairzt) if (.not. allocated(DstInitOutputData%LFairzt)) then allocate(DstInitOutputData%LFairzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -913,7 +913,7 @@ subroutine FEAM_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -954,14 +954,14 @@ subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%GLU)) then - LB(1:2) = lbound(SrcContStateData%GLU, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%GLU, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%GLU) + UB(1:2) = ubound(SrcContStateData%GLU) if (.not. allocated(DstContStateData%GLU)) then allocate(DstContStateData%GLU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -972,8 +972,8 @@ subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS DstContStateData%GLU = SrcContStateData%GLU end if if (allocated(SrcContStateData%GLDU)) then - LB(1:2) = lbound(SrcContStateData%GLDU, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%GLDU, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%GLDU) + UB(1:2) = ubound(SrcContStateData%GLDU) if (.not. allocated(DstContStateData%GLDU)) then allocate(DstContStateData%GLDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1014,7 +1014,7 @@ subroutine FEAM_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackContState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1107,14 +1107,14 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%GLU0)) then - LB(1:2) = lbound(SrcOtherStateData%GLU0, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%GLU0, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%GLU0) + UB(1:2) = ubound(SrcOtherStateData%GLU0) if (.not. allocated(DstOtherStateData%GLU0)) then allocate(DstOtherStateData%GLU0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1125,8 +1125,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 end if if (allocated(SrcOtherStateData%GLDDU)) then - LB(1:2) = lbound(SrcOtherStateData%GLDDU, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%GLDDU, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%GLDDU) + UB(1:2) = ubound(SrcOtherStateData%GLDDU) if (.not. allocated(DstOtherStateData%GLDDU)) then allocate(DstOtherStateData%GLDDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1138,8 +1138,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch if (allocated(SrcOtherStateData%GFORC0)) then - LB(1:3) = lbound(SrcOtherStateData%GFORC0, kind=B8Ki) - UB(1:3) = ubound(SrcOtherStateData%GFORC0, kind=B8Ki) + LB(1:3) = lbound(SrcOtherStateData%GFORC0) + UB(1:3) = ubound(SrcOtherStateData%GFORC0) if (.not. allocated(DstOtherStateData%GFORC0)) then allocate(DstOtherStateData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1150,8 +1150,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 end if if (allocated(SrcOtherStateData%GMASS0)) then - LB(1:4) = lbound(SrcOtherStateData%GMASS0, kind=B8Ki) - UB(1:4) = ubound(SrcOtherStateData%GMASS0, kind=B8Ki) + LB(1:4) = lbound(SrcOtherStateData%GMASS0) + UB(1:4) = ubound(SrcOtherStateData%GMASS0) if (.not. allocated(DstOtherStateData%GMASS0)) then allocate(DstOtherStateData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1162,8 +1162,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 end if if (allocated(SrcOtherStateData%FAST_FPA)) then - LB(1:2) = lbound(SrcOtherStateData%FAST_FPA, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%FAST_FPA, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%FAST_FPA) + UB(1:2) = ubound(SrcOtherStateData%FAST_FPA) if (.not. allocated(DstOtherStateData%FAST_FPA)) then allocate(DstOtherStateData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1174,8 +1174,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA end if if (allocated(SrcOtherStateData%FAST_RP)) then - LB(1:2) = lbound(SrcOtherStateData%FAST_RP, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%FAST_RP, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%FAST_RP) + UB(1:2) = ubound(SrcOtherStateData%FAST_RP) if (.not. allocated(DstOtherStateData%FAST_RP)) then allocate(DstOtherStateData%FAST_RP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1241,7 +1241,7 @@ subroutine FEAM_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackOtherState' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1264,7 +1264,7 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyMisc' @@ -1274,8 +1274,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%GLF)) then - LB(1:2) = lbound(SrcMiscData%GLF, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%GLF, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%GLF) + UB(1:2) = ubound(SrcMiscData%GLF) if (.not. allocated(DstMiscData%GLF)) then allocate(DstMiscData%GLF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1286,8 +1286,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%GLF = SrcMiscData%GLF end if if (allocated(SrcMiscData%GLK)) then - LB(1:3) = lbound(SrcMiscData%GLK, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%GLK, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%GLK) + UB(1:3) = ubound(SrcMiscData%GLK) if (.not. allocated(DstMiscData%GLK)) then allocate(DstMiscData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1300,8 +1300,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%EMASS = SrcMiscData%EMASS DstMiscData%ESTIF = SrcMiscData%ESTIF if (allocated(SrcMiscData%FAST_FP)) then - LB(1:2) = lbound(SrcMiscData%FAST_FP, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FAST_FP, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FAST_FP) + UB(1:2) = ubound(SrcMiscData%FAST_FP) if (.not. allocated(DstMiscData%FAST_FP)) then allocate(DstMiscData%FAST_FP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1323,8 +1323,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SLIN = SrcMiscData%SLIN DstMiscData%STIFR = SrcMiscData%STIFR if (allocated(SrcMiscData%FAIR_ANG)) then - LB(1:2) = lbound(SrcMiscData%FAIR_ANG, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FAIR_ANG, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FAIR_ANG) + UB(1:2) = ubound(SrcMiscData%FAIR_ANG) if (.not. allocated(DstMiscData%FAIR_ANG)) then allocate(DstMiscData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1335,8 +1335,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG end if if (allocated(SrcMiscData%FAIR_T)) then - LB(1:1) = lbound(SrcMiscData%FAIR_T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FAIR_T, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FAIR_T) + UB(1:1) = ubound(SrcMiscData%FAIR_T) if (.not. allocated(DstMiscData%FAIR_T)) then allocate(DstMiscData%FAIR_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1347,8 +1347,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAIR_T = SrcMiscData%FAIR_T end if if (allocated(SrcMiscData%ANCH_ANG)) then - LB(1:2) = lbound(SrcMiscData%ANCH_ANG, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%ANCH_ANG, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%ANCH_ANG) + UB(1:2) = ubound(SrcMiscData%ANCH_ANG) if (.not. allocated(DstMiscData%ANCH_ANG)) then allocate(DstMiscData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1359,8 +1359,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG end if if (allocated(SrcMiscData%ANCH_T)) then - LB(1:1) = lbound(SrcMiscData%ANCH_T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ANCH_T, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ANCH_T) + UB(1:1) = ubound(SrcMiscData%ANCH_T) if (.not. allocated(DstMiscData%ANCH_T)) then allocate(DstMiscData%ANCH_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1371,8 +1371,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ANCH_T = SrcMiscData%ANCH_T end if if (allocated(SrcMiscData%Line_Coordinate)) then - LB(1:3) = lbound(SrcMiscData%Line_Coordinate, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%Line_Coordinate, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%Line_Coordinate) + UB(1:3) = ubound(SrcMiscData%Line_Coordinate) if (.not. allocated(DstMiscData%Line_Coordinate)) then allocate(DstMiscData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1383,8 +1383,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate end if if (allocated(SrcMiscData%Line_Tangent)) then - LB(1:3) = lbound(SrcMiscData%Line_Tangent, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%Line_Tangent, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%Line_Tangent) + UB(1:3) = ubound(SrcMiscData%Line_Tangent) if (.not. allocated(DstMiscData%Line_Tangent)) then allocate(DstMiscData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1395,8 +1395,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent end if if (allocated(SrcMiscData%F_Lines)) then - LB(1:2) = lbound(SrcMiscData%F_Lines, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_Lines, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_Lines) + UB(1:2) = ubound(SrcMiscData%F_Lines) if (.not. allocated(DstMiscData%F_Lines)) then allocate(DstMiscData%F_Lines(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1489,7 +1489,7 @@ subroutine FEAM_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackMisc' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1526,8 +1526,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyParam' @@ -1554,8 +1554,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NHBD = SrcParamData%NHBD DstParamData%NDIM = SrcParamData%NDIM if (allocated(SrcParamData%NEQ)) then - LB(1:1) = lbound(SrcParamData%NEQ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NEQ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NEQ) + UB(1:1) = ubound(SrcParamData%NEQ) if (.not. allocated(DstParamData%NEQ)) then allocate(DstParamData%NEQ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1570,8 +1570,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumElems = SrcParamData%NumElems DstParamData%NumNodes = SrcParamData%NumNodes if (allocated(SrcParamData%GSL)) then - LB(1:3) = lbound(SrcParamData%GSL, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%GSL, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%GSL) + UB(1:3) = ubound(SrcParamData%GSL) if (.not. allocated(DstParamData%GSL)) then allocate(DstParamData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1582,8 +1582,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GSL = SrcParamData%GSL end if if (allocated(SrcParamData%GP)) then - LB(1:2) = lbound(SrcParamData%GP, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%GP, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%GP) + UB(1:2) = ubound(SrcParamData%GP) if (.not. allocated(DstParamData%GP)) then allocate(DstParamData%GP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1594,8 +1594,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GP = SrcParamData%GP end if if (allocated(SrcParamData%Elength)) then - LB(1:1) = lbound(SrcParamData%Elength, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Elength, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Elength) + UB(1:1) = ubound(SrcParamData%Elength) if (.not. allocated(DstParamData%Elength)) then allocate(DstParamData%Elength(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1606,8 +1606,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Elength = SrcParamData%Elength end if if (allocated(SrcParamData%BottmElev)) then - LB(1:1) = lbound(SrcParamData%BottmElev, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BottmElev, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BottmElev) + UB(1:1) = ubound(SrcParamData%BottmElev) if (.not. allocated(DstParamData%BottmElev)) then allocate(DstParamData%BottmElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1618,8 +1618,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BottmElev = SrcParamData%BottmElev end if if (allocated(SrcParamData%BottmStiff)) then - LB(1:1) = lbound(SrcParamData%BottmStiff, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BottmStiff, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BottmStiff) + UB(1:1) = ubound(SrcParamData%BottmStiff) if (.not. allocated(DstParamData%BottmStiff)) then allocate(DstParamData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1630,8 +1630,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BottmStiff = SrcParamData%BottmStiff end if if (allocated(SrcParamData%LMassDen)) then - LB(1:1) = lbound(SrcParamData%LMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LMassDen) + UB(1:1) = ubound(SrcParamData%LMassDen) if (.not. allocated(DstParamData%LMassDen)) then allocate(DstParamData%LMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1642,8 +1642,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LMassDen = SrcParamData%LMassDen end if if (allocated(SrcParamData%LDMassDen)) then - LB(1:1) = lbound(SrcParamData%LDMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LDMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LDMassDen) + UB(1:1) = ubound(SrcParamData%LDMassDen) if (.not. allocated(DstParamData%LDMassDen)) then allocate(DstParamData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1654,8 +1654,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LDMassDen = SrcParamData%LDMassDen end if if (allocated(SrcParamData%LEAStiff)) then - LB(1:1) = lbound(SrcParamData%LEAStiff, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LEAStiff, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LEAStiff) + UB(1:1) = ubound(SrcParamData%LEAStiff) if (.not. allocated(DstParamData%LEAStiff)) then allocate(DstParamData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1666,8 +1666,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LEAStiff = SrcParamData%LEAStiff end if if (allocated(SrcParamData%LineCI)) then - LB(1:1) = lbound(SrcParamData%LineCI, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LineCI, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LineCI) + UB(1:1) = ubound(SrcParamData%LineCI) if (.not. allocated(DstParamData%LineCI)) then allocate(DstParamData%LineCI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1678,8 +1678,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LineCI = SrcParamData%LineCI end if if (allocated(SrcParamData%LineCD)) then - LB(1:1) = lbound(SrcParamData%LineCD, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LineCD, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LineCD) + UB(1:1) = ubound(SrcParamData%LineCD) if (.not. allocated(DstParamData%LineCD)) then allocate(DstParamData%LineCD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1690,8 +1690,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LineCD = SrcParamData%LineCD end if if (allocated(SrcParamData%Bvp)) then - LB(1:2) = lbound(SrcParamData%Bvp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Bvp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Bvp) + UB(1:2) = ubound(SrcParamData%Bvp) if (.not. allocated(DstParamData%Bvp)) then allocate(DstParamData%Bvp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1702,8 +1702,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Bvp = SrcParamData%Bvp end if if (allocated(SrcParamData%WaveAcc0)) then - LB(1:3) = lbound(SrcParamData%WaveAcc0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%WaveAcc0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%WaveAcc0) + UB(1:3) = ubound(SrcParamData%WaveAcc0) if (.not. allocated(DstParamData%WaveAcc0)) then allocate(DstParamData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1714,8 +1714,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 end if if (allocated(SrcParamData%WaveTime)) then - LB(1:1) = lbound(SrcParamData%WaveTime, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveTime, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveTime) + UB(1:1) = ubound(SrcParamData%WaveTime) if (.not. allocated(DstParamData%WaveTime)) then allocate(DstParamData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1726,8 +1726,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WaveTime = SrcParamData%WaveTime end if if (allocated(SrcParamData%WaveVel0)) then - LB(1:3) = lbound(SrcParamData%WaveVel0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%WaveVel0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%WaveVel0) + UB(1:3) = ubound(SrcParamData%WaveVel0) if (.not. allocated(DstParamData%WaveVel0)) then allocate(DstParamData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1759,8 +1759,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1776,8 +1776,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%Delim = SrcParamData%Delim if (allocated(SrcParamData%GLUZR)) then - LB(1:3) = lbound(SrcParamData%GLUZR, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%GLUZR, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%GLUZR) + UB(1:3) = ubound(SrcParamData%GLUZR) if (.not. allocated(DstParamData%GLUZR)) then allocate(DstParamData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1788,8 +1788,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GLUZR = SrcParamData%GLUZR end if if (allocated(SrcParamData%GTZER)) then - LB(1:2) = lbound(SrcParamData%GTZER, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%GTZER, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%GTZER) + UB(1:2) = ubound(SrcParamData%GTZER) if (.not. allocated(DstParamData%GTZER)) then allocate(DstParamData%GTZER(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1805,8 +1805,8 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) type(FEAM_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_DestroyParam' @@ -1864,8 +1864,8 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveVel0) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1884,8 +1884,8 @@ subroutine FEAM_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(FEAM_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) @@ -1945,9 +1945,9 @@ subroutine FEAM_PackParam(RF, Indata) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1962,8 +1962,8 @@ subroutine FEAM_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2112,15 +2112,15 @@ subroutine FEAM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2171,7 +2171,7 @@ subroutine FEAM_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index ff1eb406bd..b10a6b7183 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -111,7 +111,7 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitInput' ErrStat = ErrID_None @@ -122,8 +122,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HighFreq = SrcInitInputData%HighFreq DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile if (allocated(SrcInitInputData%HdroAddMs)) then - LB(1:3) = lbound(SrcInitInputData%HdroAddMs, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%HdroAddMs, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%HdroAddMs) + UB(1:3) = ubound(SrcInitInputData%HdroAddMs) if (.not. allocated(DstInitInputData%HdroAddMs)) then allocate(DstInitInputData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -134,8 +134,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs end if if (allocated(SrcInitInputData%HdroFreq)) then - LB(1:1) = lbound(SrcInitInputData%HdroFreq, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%HdroFreq, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%HdroFreq) + UB(1:1) = ubound(SrcInitInputData%HdroFreq) if (.not. allocated(DstInitInputData%HdroFreq)) then allocate(DstInitInputData%HdroFreq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -146,8 +146,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq end if if (allocated(SrcInitInputData%HdroDmpng)) then - LB(1:3) = lbound(SrcInitInputData%HdroDmpng, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%HdroDmpng, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%HdroDmpng) + UB(1:3) = ubound(SrcInitInputData%HdroDmpng) if (.not. allocated(DstInitInputData%HdroDmpng)) then allocate(DstInitInputData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -201,7 +201,7 @@ subroutine Conv_Rdtn_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -299,14 +299,14 @@ subroutine Conv_Rdtn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%XDHistory)) then - LB(1:2) = lbound(SrcDiscStateData%XDHistory, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%XDHistory, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%XDHistory) + UB(1:2) = ubound(SrcDiscStateData%XDHistory) if (.not. allocated(DstDiscStateData%XDHistory)) then allocate(DstDiscStateData%XDHistory(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -345,7 +345,7 @@ subroutine Conv_Rdtn_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackDiscState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -473,7 +473,7 @@ subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyParam' ErrStat = ErrID_None @@ -482,8 +482,8 @@ subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Er DstParamData%RdtnDT = SrcParamData%RdtnDT DstParamData%NBody = SrcParamData%NBody if (allocated(SrcParamData%RdtnKrnl)) then - LB(1:3) = lbound(SrcParamData%RdtnKrnl, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%RdtnKrnl, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%RdtnKrnl) + UB(1:3) = ubound(SrcParamData%RdtnKrnl) if (.not. allocated(DstParamData%RdtnKrnl)) then allocate(DstParamData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -527,7 +527,7 @@ subroutine Conv_Rdtn_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackParam' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -545,14 +545,14 @@ subroutine Conv_Rdtn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%Velocity)) then - LB(1:1) = lbound(SrcInputData%Velocity, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Velocity, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Velocity) + UB(1:1) = ubound(SrcInputData%Velocity) if (.not. allocated(DstInputData%Velocity)) then allocate(DstInputData%Velocity(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -589,7 +589,7 @@ subroutine Conv_Rdtn_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -602,14 +602,14 @@ subroutine Conv_Rdtn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%F_Rdtn)) then - LB(1:1) = lbound(SrcOutputData%F_Rdtn, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%F_Rdtn, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%F_Rdtn) + UB(1:1) = ubound(SrcOutputData%F_Rdtn) if (.not. allocated(DstOutputData%F_Rdtn)) then allocate(DstOutputData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -646,7 +646,7 @@ subroutine Conv_Rdtn_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index d674b2180b..c6caee100e 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -293,6 +293,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%vecMultiplier = InputFileData%vecMultiplier ! Multiply all vectors and matrices row/column lengths by NBody InputFileData%WAMIT%NBodyMod = InputFileData%NBodyMod InputFileData%WAMIT%Gravity = InitInp%Gravity + InputFileData%WAMIT%PlatformPos = InitInp%PlatformPos ! Initial platform/HD origin position p%NBody = InputFileData%NBody p%NBodyMod = InputFileData%NBodyMod call AllocAry( m%F_PtfmAdd, 6*InputFileData%NBody, "m%F_PtfmAdd", ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1407,7 +1408,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, END IF IF ( (ABS( WrapToPi(PRPRotation(3)-PtfmRefY) ) > LrgAngle) .AND. FrstWarn_LrgY ) THEN ErrStat2 = ErrID_Severe - ErrMsg2 = 'Yaw angle at PRP relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff in ElastoDyn. Simulation continuing, but future warnings will be suppressed.' + ErrMsg2 = 'Yaw angle at PRP relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff. Simulation continuing, but future warnings will be suppressed.' call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FrstWarn_LrgY = .FALSE. END IF diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index d180a4ee02..8a40ecbb87 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -76,13 +76,13 @@ typedef HydroDyn/HydroDyn InitInputType CHARACTER(1 typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - typedef ^ ^ CHARACTER(1024) OutRootName - - - "Supplied by Driver: The name of the root file (without extension) including the full path" - -typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - -# typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - +typedef ^ ^ ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" # # # Define outputs from the initialization routine here: diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 1502bbace3..4c2ccf61bb 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -240,23 +240,6 @@ PROGRAM HydroDynDriver CALL SetHDInputs(0.0_R8Ki, n, u(1), mappingData, drvrData, ErrStat, ErrMsg); CALL CheckError() END IF - ! Set the initial low-pass-filtered displacements of potential-flow bodies if ExctnDisp = 2 - IF ( p%PotMod == 1_IntKi ) THEN - IF ( p%WAMIT(1)%ExctnDisp == 2_IntKi ) THEN - IF (p%NBodyMod .EQ. 1_IntKi) THEN ! One instance of WAMIT with NBody - DO i = 1,p%NBody - xd%WAMIT(1)%BdyPosFilt(1,i,:) = u(1)%WAMITMesh%TranslationDisp(1,i) - xd%WAMIT(1)%BdyPosFilt(2,i,:) = u(1)%WAMITMesh%TranslationDisp(2,i) - END DO - ELSE IF (p%NBodyMod > 1_IntKi) THEN ! NBody instances of WAMIT with one body each - DO i = 1,p%NBody - xd%WAMIT(i)%BdyPosFilt(1,1,:) = u(1)%WAMITMesh%TranslationDisp(1,i) - xd%WAMIT(i)%BdyPosFilt(2,1,:) = u(1)%WAMITMesh%TranslationDisp(2,i) - END DO - END IF - END IF - END IF - !............................................................................................................................... ! --- Linearization !............................................................................................................................... @@ -348,6 +331,12 @@ subroutine SetHD_InitInputs() InitInData_HD%WaveField => InitOutData_SeaSt%WaveField + IF (( drvrData%PRPInputsMod /= 2 ) .AND. ( drvrData%PRPInputsMod >= 0 )) THEN + InitInData_HD%PlatformPos = drvrData%uPRPInSteady + ELSE + InitInData_HD%PlatformPos = drvrData%PRPin(1,1:6) + END IF + end subroutine SetHD_InitInputs !---------------------------------------------------------------------------------------------------------------------------------- subroutine CheckError() diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index bdb1f7a816..67b443815a 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -157,7 +157,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, FileInfo_In, InputFi call ParseVar( FileInfo_In, CurLine, 'PtfmYCutOff', InputFileData%PtfmYCutOff, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return - ! NExctnHdg - Number of PRP headings/yaw offset evenly distributed in the range of [-180, 180) deg to precompute [used only when PtfmYMod = 1 in the HD driver or ElastoDyn] + ! NExctnHdg - Number of PRP headings/yaw offset evenly distributed in the range of [-180, 180) deg to precompute [used only when PtfmYMod = 1] call ParseVar( FileInfo_In, CurLine, 'NExctnHdg', InputFileData%WAMIT%NExctnHdg, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; InputFileData%WAMIT2%NExctnHdg = InputFileData%WAMIT%NExctnHdg @@ -1911,19 +1911,19 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCa1 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCa1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCa1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCa2 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCa2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCa2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCaMG1 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCaMG1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCaMG1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCaMG2 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCaMG2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCaMG2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberCb1 < 0 ) THEN @@ -2226,11 +2226,11 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS CALL SetErrStat( ErrID_Fatal, 'PtfmYCutOff must be greater than 0 Hz.',ErrStat,ErrMsg,RoutineName) end if if ( InputFileData%Morison%WaveDisp == 0 .AND. InputFileData%Morison%NMembers > 0 ) then - call SetErrStat( ErrID_Fatal,'Dynamic reference yaw offset (PtfmYMod=1) in ElastoDyn or HydroDyn driver cannot be used with WaveDisp=0. Set WaveDisp=1.',ErrStat,ErrMsg,RoutineName) + call SetErrStat( ErrID_Fatal,'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with WaveDisp=0. Set WaveDisp=1.',ErrStat,ErrMsg,RoutineName) return end if if ( InputFileData%PotMod > 0 .AND. InputFileData%WAMIT%ExctnMod == 2 ) then - call SetErrStat( ErrID_Fatal, 'Dynamic reference yaw offset (PtfmYMod=1) in ElastoDyn or HydroDyn driver cannot be used with State-space wave excitations. Set ExctnMod=0 or 1.', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Fatal,'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with state-space wave excitations. Set ExctnMod=0 or 1.', ErrStat, ErrMsg, RoutineName ) return end if if ( InputFileData%PotMod > 0 .AND. InputFileData%WAMIT%NExctnHdg < 2 ) then @@ -2238,7 +2238,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS return end if if ( InputFileData%WAMIT2%SumQTFF .OR. InputFileData%WAMIT2%DiffQTFF ) then - call SetErrStat( ErrID_Fatal, 'Dynamic reference yaw offset (PtfmYMod=1) in ElastoDyn or HydroDyn driver cannot be used with full sum-frequency or difference-frequency QTFs. Set SumQTF and DiffQTF to 0.', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Fatal, 'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with full sum-frequency or difference-frequency QTFs. Set SumQTF and DiffQTF to 0.', ErrStat, ErrMsg, RoutineName ) return end if END IF diff --git a/modules/hydrodyn/src/HydroDyn_Output.f90 b/modules/hydrodyn/src/HydroDyn_Output.f90 index 7a971b36b2..45a7450afa 100644 --- a/modules/hydrodyn/src/HydroDyn_Output.f90 +++ b/modules/hydrodyn/src/HydroDyn_Output.f90 @@ -855,7 +855,7 @@ SUBROUTINE HDOut_MapOutputs( p, y, m_WAMIT, m_WAMIT2, F_Add, F_Waves, F_Hydro, P ! Need to use individual components of force for output reporting, the y%mesh data has total forces from all contributions if ( p%potMod == 1 ) then if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then - do iBody = 1,p%NBody + do iBody = 1,min(p%NBody,9) ! Can only output the first 9 bodies for now startIndx = 6*(iBody-1) + 1 endIndx = startIndx + 5 AllOuts(FWaves1 (:,iBody)) = m_WAMIT(1)%F_Waves1(startIndx:endIndx) @@ -873,7 +873,7 @@ SUBROUTINE HDOut_MapOutputs( p, y, m_WAMIT, m_WAMIT2, F_Add, F_Waves, F_Hydro, P ! This happens when NBodyMod > 1, in which case, each WAMIT object is for a single body, but there may be multiple bodies in the HydroDyn model, ! so we need to use BodyID to determine the index into the complete HydroDyn list of WAMIT bodies - do iBody = 1,p%NBody + do iBody = 1,min(p%NBody,9) ! Can only output the first 9 bodies for now startIndx = 6*(iBody-1) + 1 endIndx = startIndx + 5 AllOuts(FWaves1 (:,iBody)) = m_WAMIT(iBody)%F_Waves1 diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 1d2a8fd6e7..c09f4d20f9 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -98,6 +98,7 @@ MODULE HydroDyn_Types LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] END TYPE HydroDyn_InitInputType ! ======================= ! ========= HydroDyn_InitOutputType ======= @@ -248,7 +249,7 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInputFile' @@ -256,8 +257,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrMsg = '' DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag if (allocated(SrcInputFileData%AddF0)) then - LB(1:2) = lbound(SrcInputFileData%AddF0, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%AddF0, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%AddF0) + UB(1:2) = ubound(SrcInputFileData%AddF0) if (.not. allocated(DstInputFileData%AddF0)) then allocate(DstInputFileData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -268,8 +269,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddF0 = SrcInputFileData%AddF0 end if if (allocated(SrcInputFileData%AddCLin)) then - LB(1:3) = lbound(SrcInputFileData%AddCLin, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%AddCLin, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%AddCLin) + UB(1:3) = ubound(SrcInputFileData%AddCLin) if (.not. allocated(DstInputFileData%AddCLin)) then allocate(DstInputFileData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -280,8 +281,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddCLin = SrcInputFileData%AddCLin end if if (allocated(SrcInputFileData%AddBLin)) then - LB(1:3) = lbound(SrcInputFileData%AddBLin, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%AddBLin, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%AddBLin) + UB(1:3) = ubound(SrcInputFileData%AddBLin) if (.not. allocated(DstInputFileData%AddBLin)) then allocate(DstInputFileData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -292,8 +293,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddBLin = SrcInputFileData%AddBLin end if if (allocated(SrcInputFileData%AddBQuad)) then - LB(1:3) = lbound(SrcInputFileData%AddBQuad, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%AddBQuad, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%AddBQuad) + UB(1:3) = ubound(SrcInputFileData%AddBQuad) if (.not. allocated(DstInputFileData%AddBQuad)) then allocate(DstInputFileData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -304,8 +305,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad end if if (allocated(SrcInputFileData%PotFile)) then - LB(1:1) = lbound(SrcInputFileData%PotFile, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PotFile, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PotFile) + UB(1:1) = ubound(SrcInputFileData%PotFile) if (.not. allocated(DstInputFileData%PotFile)) then allocate(DstInputFileData%PotFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -320,8 +321,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%NBody = SrcInputFileData%NBody DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod if (allocated(SrcInputFileData%PtfmVol0)) then - LB(1:1) = lbound(SrcInputFileData%PtfmVol0, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmVol0, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmVol0) + UB(1:1) = ubound(SrcInputFileData%PtfmVol0) if (.not. allocated(DstInputFileData%PtfmVol0)) then allocate(DstInputFileData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -333,8 +334,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT if (allocated(SrcInputFileData%WAMITULEN)) then - LB(1:1) = lbound(SrcInputFileData%WAMITULEN, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WAMITULEN, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WAMITULEN) + UB(1:1) = ubound(SrcInputFileData%WAMITULEN) if (.not. allocated(DstInputFileData%WAMITULEN)) then allocate(DstInputFileData%WAMITULEN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -345,8 +346,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN end if if (allocated(SrcInputFileData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefxt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmRefxt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmRefxt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefxt) if (.not. allocated(DstInputFileData%PtfmRefxt)) then allocate(DstInputFileData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -357,8 +358,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt end if if (allocated(SrcInputFileData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefyt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmRefyt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmRefyt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefyt) if (.not. allocated(DstInputFileData%PtfmRefyt)) then allocate(DstInputFileData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -369,8 +370,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt end if if (allocated(SrcInputFileData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefzt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmRefzt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmRefzt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefzt) if (.not. allocated(DstInputFileData%PtfmRefzt)) then allocate(DstInputFileData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -381,8 +382,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt end if if (allocated(SrcInputFileData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot) + UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot) if (.not. allocated(DstInputFileData%PtfmRefztRot)) then allocate(DstInputFileData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -393,8 +394,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot end if if (allocated(SrcInputFileData%PtfmCOBxt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt) if (.not. allocated(DstInputFileData%PtfmCOBxt)) then allocate(DstInputFileData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -405,8 +406,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt end if if (allocated(SrcInputFileData%PtfmCOByt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmCOByt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmCOByt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmCOByt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOByt) if (.not. allocated(DstInputFileData%PtfmCOByt)) then allocate(DstInputFileData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -429,8 +430,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PotMod = SrcInputFileData%PotMod DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs if (allocated(SrcInputFileData%UserOutputs)) then - LB(1:1) = lbound(SrcInputFileData%UserOutputs, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%UserOutputs, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%UserOutputs) + UB(1:1) = ubound(SrcInputFileData%UserOutputs) if (.not. allocated(DstInputFileData%UserOutputs)) then allocate(DstInputFileData%UserOutputs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -444,8 +445,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%OutAll = SrcInputFileData%OutAll DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -575,7 +576,7 @@ subroutine HydroDyn_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInputFile' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -624,7 +625,7 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(0), UB(0) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInitInput' @@ -642,6 +643,7 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn DstInitInputData%WaveField => SrcInitInputData%WaveField + DstInitInputData%PlatformPos = SrcInitInputData%PlatformPos end subroutine subroutine HydroDyn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -680,6 +682,7 @@ subroutine HydroDyn_PackInitInput(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if + call RegPack(RF, InData%PlatformPos) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -687,7 +690,7 @@ subroutine HydroDyn_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitInput' - integer(B8Ki) :: LB(0), UB(0) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -720,6 +723,7 @@ subroutine HydroDyn_UnPackInitInput(RF, OutData) else OutData%WaveField => null() end if + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -728,7 +732,7 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInitOutput' @@ -741,8 +745,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -753,8 +757,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -768,8 +772,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -780,8 +784,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -792,8 +796,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -804,8 +808,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -816,8 +820,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -889,7 +893,7 @@ subroutine HydroDyn_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -971,16 +975,16 @@ subroutine HydroDyn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%WAMIT)) then - LB(1:1) = lbound(SrcContStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%WAMIT) + UB(1:1) = ubound(SrcContStateData%WAMIT) if (.not. allocated(DstContStateData%WAMIT)) then allocate(DstContStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1003,16 +1007,16 @@ subroutine HydroDyn_DestroyContState(ContStateData, ErrStat, ErrMsg) type(HydroDyn_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%WAMIT)) then - LB(1:1) = lbound(ContStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(ContStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(ContStateData%WAMIT) + UB(1:1) = ubound(ContStateData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyContState(ContStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1027,14 +1031,14 @@ subroutine HydroDyn_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_PackContState(RF, InData%WAMIT(i1)) end do @@ -1047,8 +1051,8 @@ subroutine HydroDyn_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1074,16 +1078,16 @@ subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%WAMIT)) then - LB(1:1) = lbound(SrcDiscStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%WAMIT) + UB(1:1) = ubound(SrcDiscStateData%WAMIT) if (.not. allocated(DstDiscStateData%WAMIT)) then allocate(DstDiscStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1101,8 +1105,8 @@ subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDiscStateData%PtfmRefY)) then - LB(1:1) = lbound(SrcDiscStateData%PtfmRefY, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%PtfmRefY, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%PtfmRefY) + UB(1:1) = ubound(SrcDiscStateData%PtfmRefY) if (.not. allocated(DstDiscStateData%PtfmRefY)) then allocate(DstDiscStateData%PtfmRefY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1118,16 +1122,16 @@ subroutine HydroDyn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(HydroDyn_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%WAMIT)) then - LB(1:1) = lbound(DiscStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%WAMIT) + UB(1:1) = ubound(DiscStateData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyDiscState(DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1145,14 +1149,14 @@ subroutine HydroDyn_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_PackDiscState(RF, InData%WAMIT(i1)) end do @@ -1166,8 +1170,8 @@ subroutine HydroDyn_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1247,16 +1251,16 @@ subroutine HydroDyn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%WAMIT)) then - LB(1:1) = lbound(SrcOtherStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%WAMIT) + UB(1:1) = ubound(SrcOtherStateData%WAMIT) if (.not. allocated(DstOtherStateData%WAMIT)) then allocate(DstOtherStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1279,16 +1283,16 @@ subroutine HydroDyn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(HydroDyn_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%WAMIT)) then - LB(1:1) = lbound(OtherStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%WAMIT) + UB(1:1) = ubound(OtherStateData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyOtherState(OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1303,14 +1307,14 @@ subroutine HydroDyn_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_PackOtherState(RF, InData%WAMIT(i1)) end do @@ -1323,8 +1327,8 @@ subroutine HydroDyn_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1350,8 +1354,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' @@ -1360,8 +1364,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%nWAMITObj = SrcParamData%nWAMITObj DstParamData%vecMultiplier = SrcParamData%vecMultiplier if (allocated(SrcParamData%WAMIT)) then - LB(1:1) = lbound(SrcParamData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WAMIT) + UB(1:1) = ubound(SrcParamData%WAMIT) if (.not. allocated(DstParamData%WAMIT)) then allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1376,8 +1380,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end do end if if (allocated(SrcParamData%WAMIT2)) then - LB(1:1) = lbound(SrcParamData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WAMIT2, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WAMIT2) + UB(1:1) = ubound(SrcParamData%WAMIT2) if (.not. allocated(DstParamData%WAMIT2)) then allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1402,8 +1406,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%totalExctnStates = SrcParamData%totalExctnStates DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates if (allocated(SrcParamData%AddF0)) then - LB(1:2) = lbound(SrcParamData%AddF0, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AddF0, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AddF0) + UB(1:2) = ubound(SrcParamData%AddF0) if (.not. allocated(DstParamData%AddF0)) then allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1414,8 +1418,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddF0 = SrcParamData%AddF0 end if if (allocated(SrcParamData%AddCLin)) then - LB(1:3) = lbound(SrcParamData%AddCLin, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddCLin, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AddCLin) + UB(1:3) = ubound(SrcParamData%AddCLin) if (.not. allocated(DstParamData%AddCLin)) then allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1426,8 +1430,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddCLin = SrcParamData%AddCLin end if if (allocated(SrcParamData%AddBLin)) then - LB(1:3) = lbound(SrcParamData%AddBLin, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddBLin, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AddBLin) + UB(1:3) = ubound(SrcParamData%AddBLin) if (.not. allocated(DstParamData%AddBLin)) then allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1438,8 +1442,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddBLin = SrcParamData%AddBLin end if if (allocated(SrcParamData%AddBQuad)) then - LB(1:3) = lbound(SrcParamData%AddBQuad, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddBQuad, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AddBQuad) + UB(1:3) = ubound(SrcParamData%AddBQuad) if (.not. allocated(DstParamData%AddBQuad)) then allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1451,8 +1455,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1475,8 +1479,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%UnOutFile = SrcParamData%UnOutFile DstParamData%OutDec = SrcParamData%OutDec if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1487,8 +1491,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1499,8 +1503,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) if (.not. allocated(DstParamData%dx)) then allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1521,16 +1525,16 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) type(HydroDyn_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%WAMIT)) then - LB(1:1) = lbound(ParamData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(ParamData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(ParamData%WAMIT) + UB(1:1) = ubound(ParamData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyParam(ParamData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1538,8 +1542,8 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WAMIT) end if if (allocated(ParamData%WAMIT2)) then - LB(1:1) = lbound(ParamData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(ParamData%WAMIT2, kind=B8Ki) + LB(1:1) = lbound(ParamData%WAMIT2) + UB(1:1) = ubound(ParamData%WAMIT2) do i1 = LB(1), UB(1) call WAMIT2_DestroyParam(ParamData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1561,8 +1565,8 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%AddBQuad) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1585,26 +1589,26 @@ subroutine HydroDyn_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%nWAMITObj) call RegPack(RF, InData%vecMultiplier) call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_PackParam(RF, InData%WAMIT(i1)) end do end if call RegPack(RF, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) do i1 = LB(1), UB(1) call WAMIT2_PackParam(RF, InData%WAMIT2(i1)) end do @@ -1624,9 +1628,9 @@ subroutine HydroDyn_PackParam(RF, Indata) call RegPack(RF, InData%DT) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1660,8 +1664,8 @@ subroutine HydroDyn_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1822,16 +1826,16 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WAMIT)) then - LB(1:1) = lbound(SrcOutputData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WAMIT) + UB(1:1) = ubound(SrcOutputData%WAMIT) if (.not. allocated(DstOutputData%WAMIT)) then allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1846,8 +1850,8 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, end do end if if (allocated(SrcOutputData%WAMIT2)) then - LB(1:1) = lbound(SrcOutputData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WAMIT2, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WAMIT2) + UB(1:1) = ubound(SrcOutputData%WAMIT2) if (.not. allocated(DstOutputData%WAMIT2)) then allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1868,8 +1872,8 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1885,16 +1889,16 @@ subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) type(HydroDyn_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%WAMIT)) then - LB(1:1) = lbound(OutputData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(OutputData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(OutputData%WAMIT) + UB(1:1) = ubound(OutputData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1902,8 +1906,8 @@ subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%WAMIT) end if if (allocated(OutputData%WAMIT2)) then - LB(1:1) = lbound(OutputData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(OutputData%WAMIT2, kind=B8Ki) + LB(1:1) = lbound(OutputData%WAMIT2) + UB(1:1) = ubound(OutputData%WAMIT2) do i1 = LB(1), UB(1) call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1923,23 +1927,23 @@ subroutine HydroDyn_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_PackOutput(RF, InData%WAMIT(i1)) end do end if call RegPack(RF, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) do i1 = LB(1), UB(1) call WAMIT2_PackOutput(RF, InData%WAMIT2(i1)) end do @@ -1954,8 +1958,8 @@ subroutine HydroDyn_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1996,8 +2000,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' @@ -2027,8 +2031,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%Decimate = SrcMiscData%Decimate DstMiscData%LastOutTime = SrcMiscData%LastOutTime if (allocated(SrcMiscData%F_PtfmAdd)) then - LB(1:1) = lbound(SrcMiscData%F_PtfmAdd, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_PtfmAdd, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_PtfmAdd) + UB(1:1) = ubound(SrcMiscData%F_PtfmAdd) if (.not. allocated(DstMiscData%F_PtfmAdd)) then allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2040,8 +2044,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg end if DstMiscData%F_Hydro = SrcMiscData%F_Hydro if (allocated(SrcMiscData%F_Waves)) then - LB(1:1) = lbound(SrcMiscData%F_Waves, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Waves, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_Waves) + UB(1:1) = ubound(SrcMiscData%F_Waves) if (.not. allocated(DstMiscData%F_Waves)) then allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2052,8 +2056,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%F_Waves = SrcMiscData%F_Waves end if if (allocated(SrcMiscData%WAMIT)) then - LB(1:1) = lbound(SrcMiscData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%WAMIT) + UB(1:1) = ubound(SrcMiscData%WAMIT) if (.not. allocated(DstMiscData%WAMIT)) then allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2068,8 +2072,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcMiscData%WAMIT2)) then - LB(1:1) = lbound(SrcMiscData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WAMIT2, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%WAMIT2) + UB(1:1) = ubound(SrcMiscData%WAMIT2) if (.not. allocated(DstMiscData%WAMIT2)) then allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2087,8 +2091,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%u_WAMIT)) then - LB(1:1) = lbound(SrcMiscData%u_WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u_WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%u_WAMIT) + UB(1:1) = ubound(SrcMiscData%u_WAMIT) if (.not. allocated(DstMiscData%u_WAMIT)) then allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2108,8 +2112,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) type(HydroDyn_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' @@ -2136,8 +2140,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%F_Waves) end if if (allocated(MiscData%WAMIT)) then - LB(1:1) = lbound(MiscData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(MiscData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(MiscData%WAMIT) + UB(1:1) = ubound(MiscData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2145,8 +2149,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%WAMIT) end if if (allocated(MiscData%WAMIT2)) then - LB(1:1) = lbound(MiscData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(MiscData%WAMIT2, kind=B8Ki) + LB(1:1) = lbound(MiscData%WAMIT2) + UB(1:1) = ubound(MiscData%WAMIT2) do i1 = LB(1), UB(1) call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2156,8 +2160,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%u_WAMIT)) then - LB(1:1) = lbound(MiscData%u_WAMIT, kind=B8Ki) - UB(1:1) = ubound(MiscData%u_WAMIT, kind=B8Ki) + LB(1:1) = lbound(MiscData%u_WAMIT) + UB(1:1) = ubound(MiscData%u_WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2170,8 +2174,8 @@ subroutine HydroDyn_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackModJacType(RF, InData%Jac) call HydroDyn_PackContState(RF, InData%x_perturb) @@ -2187,18 +2191,18 @@ subroutine HydroDyn_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%F_Waves) call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_PackMisc(RF, InData%WAMIT(i1)) end do end if call RegPack(RF, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) do i1 = LB(1), UB(1) call WAMIT2_PackMisc(RF, InData%WAMIT2(i1)) end do @@ -2206,9 +2210,9 @@ subroutine HydroDyn_PackMisc(RF, Indata) call Morison_PackMisc(RF, InData%Morison) call RegPack(RF, allocated(InData%u_WAMIT)) if (allocated(InData%u_WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%u_WAMIT, kind=B8Ki), ubound(InData%u_WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%u_WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%u_WAMIT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) + LB(1:1) = lbound(InData%u_WAMIT) + UB(1:1) = ubound(InData%u_WAMIT) do i1 = LB(1), UB(1) call WAMIT_PackInput(RF, InData%u_WAMIT(i1)) end do @@ -2220,8 +2224,8 @@ subroutine HydroDyn_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2541,13 +2545,13 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E a2 = t_out/t(2) IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1, kind=B8Ki),UBOUND(y_out%WAMIT,1, kind=B8Ki) + do i1 = lbound(y_out%WAMIT,1),ubound(y_out%WAMIT,1) CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1, kind=B8Ki),UBOUND(y_out%WAMIT2,1, kind=B8Ki) + do i1 = lbound(y_out%WAMIT2,1),ubound(y_out%WAMIT2,1) CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2617,13 +2621,13 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1, kind=B8Ki),UBOUND(y_out%WAMIT,1, kind=B8Ki) + do i1 = lbound(y_out%WAMIT,1),ubound(y_out%WAMIT,1) CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1, kind=B8Ki),UBOUND(y_out%WAMIT2,1, kind=B8Ki) + do i1 = lbound(y_out%WAMIT2,1),ubound(y_out%WAMIT2,1) CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 6588b8e584..e14918f844 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1111,9 +1111,9 @@ SUBROUTINE SetDepthBasedCoefs( z, tMG, NCoefDpth, CoefDpths, Cd, Ca, Cp, AxCd, A Cd = CoefDpths(indx1)%DpthCd*(1-s) + CoefDpths(indx2)%DpthCd*s Ca = CoefDpths(indx1)%DpthCa*(1-s) + CoefDpths(indx2)%DpthCa*s Cp = CoefDpths(indx1)%DpthCp*(1-s) + CoefDpths(indx2)%DpthCp*s - AxCd = CoefDpths(indx1)%DpthCd*(1-s) + CoefDpths(indx2)%DpthAxCd*s - AxCa = CoefDpths(indx1)%DpthCa*(1-s) + CoefDpths(indx2)%DpthAxCa*s - AxCp = CoefDpths(indx1)%DpthCp*(1-s) + CoefDpths(indx2)%DpthAxCp*s + AxCd = CoefDpths(indx1)%DpthAxCd*(1-s) + CoefDpths(indx2)%DpthAxCd*s + AxCa = CoefDpths(indx1)%DpthAxCa*(1-s) + CoefDpths(indx2)%DpthAxCa*s + AxCp = CoefDpths(indx1)%DpthAxCp*(1-s) + CoefDpths(indx2)%DpthAxCp*s Cb = CoefDpths(indx1)%DpthCb*(1-s) + CoefDpths(indx2)%DpthCb*s end if diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index b3e567e69d..bc47ce9be3 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -549,15 +549,15 @@ subroutine Morison_CopyFilledGroupType(SrcFilledGroupTypeData, DstFilledGroupTyp integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyFilledGroupType' ErrStat = ErrID_None ErrMsg = '' DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM if (allocated(SrcFilledGroupTypeData%FillMList)) then - LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList, kind=B8Ki) - UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList, kind=B8Ki) + LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList) + UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList) if (.not. allocated(DstFilledGroupTypeData%FillMList)) then allocate(DstFilledGroupTypeData%FillMList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -601,7 +601,7 @@ subroutine Morison_UnPackFilledGroupType(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_FilledGroupType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackFilledGroupType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -757,15 +757,15 @@ subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTyp integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberInputType' ErrStat = ErrID_None ErrMsg = '' DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID if (allocated(SrcMemberInputTypeData%NodeIndx)) then - LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx, kind=B8Ki) - UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx, kind=B8Ki) + LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx) if (.not. allocated(DstMemberInputTypeData%NodeIndx)) then allocate(DstMemberInputTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -839,7 +839,7 @@ subroutine Morison_UnPackMemberInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MemberInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberInputType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -951,14 +951,14 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMemberTypeData%NodeIndx)) then - LB(1:1) = lbound(SrcMemberTypeData%NodeIndx, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%NodeIndx, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberTypeData%NodeIndx) if (.not. allocated(DstMemberTypeData%NodeIndx)) then allocate(DstMemberTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -977,8 +977,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%kkt = SrcMemberTypeData%kkt DstMemberTypeData%Ak = SrcMemberTypeData%Ak if (allocated(SrcMemberTypeData%R)) then - LB(1:1) = lbound(SrcMemberTypeData%R, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%R, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%R) + UB(1:1) = ubound(SrcMemberTypeData%R) if (.not. allocated(DstMemberTypeData%R)) then allocate(DstMemberTypeData%R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -989,8 +989,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%R = SrcMemberTypeData%R end if if (allocated(SrcMemberTypeData%RMG)) then - LB(1:1) = lbound(SrcMemberTypeData%RMG, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%RMG, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%RMG) + UB(1:1) = ubound(SrcMemberTypeData%RMG) if (.not. allocated(DstMemberTypeData%RMG)) then allocate(DstMemberTypeData%RMG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1001,8 +1001,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%RMG = SrcMemberTypeData%RMG end if if (allocated(SrcMemberTypeData%RMGB)) then - LB(1:1) = lbound(SrcMemberTypeData%RMGB, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%RMGB, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%RMGB) + UB(1:1) = ubound(SrcMemberTypeData%RMGB) if (.not. allocated(DstMemberTypeData%RMGB)) then allocate(DstMemberTypeData%RMGB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1013,8 +1013,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB end if if (allocated(SrcMemberTypeData%Rin)) then - LB(1:1) = lbound(SrcMemberTypeData%Rin, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Rin, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Rin) + UB(1:1) = ubound(SrcMemberTypeData%Rin) if (.not. allocated(DstMemberTypeData%Rin)) then allocate(DstMemberTypeData%Rin(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1025,8 +1025,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Rin = SrcMemberTypeData%Rin end if if (allocated(SrcMemberTypeData%tMG)) then - LB(1:1) = lbound(SrcMemberTypeData%tMG, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%tMG, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%tMG) + UB(1:1) = ubound(SrcMemberTypeData%tMG) if (.not. allocated(DstMemberTypeData%tMG)) then allocate(DstMemberTypeData%tMG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1037,8 +1037,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%tMG = SrcMemberTypeData%tMG end if if (allocated(SrcMemberTypeData%MGdensity)) then - LB(1:1) = lbound(SrcMemberTypeData%MGdensity, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%MGdensity, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%MGdensity) + UB(1:1) = ubound(SrcMemberTypeData%MGdensity) if (.not. allocated(DstMemberTypeData%MGdensity)) then allocate(DstMemberTypeData%MGdensity(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1049,8 +1049,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity end if if (allocated(SrcMemberTypeData%dRdl_mg)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg) if (.not. allocated(DstMemberTypeData%dRdl_mg)) then allocate(DstMemberTypeData%dRdl_mg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1061,8 +1061,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg end if if (allocated(SrcMemberTypeData%dRdl_mg_b)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b) if (.not. allocated(DstMemberTypeData%dRdl_mg_b)) then allocate(DstMemberTypeData%dRdl_mg_b(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1073,8 +1073,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b end if if (allocated(SrcMemberTypeData%dRdl_in)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_in, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_in, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_in) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_in) if (.not. allocated(DstMemberTypeData%dRdl_in)) then allocate(DstMemberTypeData%dRdl_in(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1096,8 +1096,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus if (allocated(SrcMemberTypeData%floodstatus)) then - LB(1:1) = lbound(SrcMemberTypeData%floodstatus, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%floodstatus, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%floodstatus) + UB(1:1) = ubound(SrcMemberTypeData%floodstatus) if (.not. allocated(DstMemberTypeData%floodstatus)) then allocate(DstMemberTypeData%floodstatus(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1108,8 +1108,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus end if if (allocated(SrcMemberTypeData%alpha)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%alpha, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%alpha) + UB(1:1) = ubound(SrcMemberTypeData%alpha) if (.not. allocated(DstMemberTypeData%alpha)) then allocate(DstMemberTypeData%alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1120,8 +1120,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha = SrcMemberTypeData%alpha end if if (allocated(SrcMemberTypeData%alpha_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha_fb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%alpha_fb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb) if (.not. allocated(DstMemberTypeData%alpha_fb)) then allocate(DstMemberTypeData%alpha_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1132,8 +1132,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb end if if (allocated(SrcMemberTypeData%alpha_fb_star)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star) if (.not. allocated(DstMemberTypeData%alpha_fb_star)) then allocate(DstMemberTypeData%alpha_fb_star(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1144,8 +1144,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star end if if (allocated(SrcMemberTypeData%Cd)) then - LB(1:1) = lbound(SrcMemberTypeData%Cd, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cd, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cd) + UB(1:1) = ubound(SrcMemberTypeData%Cd) if (.not. allocated(DstMemberTypeData%Cd)) then allocate(DstMemberTypeData%Cd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1156,8 +1156,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cd = SrcMemberTypeData%Cd end if if (allocated(SrcMemberTypeData%Ca)) then - LB(1:1) = lbound(SrcMemberTypeData%Ca, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Ca, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Ca) + UB(1:1) = ubound(SrcMemberTypeData%Ca) if (.not. allocated(DstMemberTypeData%Ca)) then allocate(DstMemberTypeData%Ca(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1168,8 +1168,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Ca = SrcMemberTypeData%Ca end if if (allocated(SrcMemberTypeData%Cp)) then - LB(1:1) = lbound(SrcMemberTypeData%Cp, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cp, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cp) + UB(1:1) = ubound(SrcMemberTypeData%Cp) if (.not. allocated(DstMemberTypeData%Cp)) then allocate(DstMemberTypeData%Cp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1180,8 +1180,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cp = SrcMemberTypeData%Cp end if if (allocated(SrcMemberTypeData%AxCd)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCd, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%AxCd, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%AxCd) + UB(1:1) = ubound(SrcMemberTypeData%AxCd) if (.not. allocated(DstMemberTypeData%AxCd)) then allocate(DstMemberTypeData%AxCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1192,8 +1192,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd end if if (allocated(SrcMemberTypeData%AxCa)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCa, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%AxCa, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%AxCa) + UB(1:1) = ubound(SrcMemberTypeData%AxCa) if (.not. allocated(DstMemberTypeData%AxCa)) then allocate(DstMemberTypeData%AxCa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1204,8 +1204,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa end if if (allocated(SrcMemberTypeData%AxCp)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCp, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%AxCp, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%AxCp) + UB(1:1) = ubound(SrcMemberTypeData%AxCp) if (.not. allocated(DstMemberTypeData%AxCp)) then allocate(DstMemberTypeData%AxCp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1216,8 +1216,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp end if if (allocated(SrcMemberTypeData%Cb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cb) + UB(1:1) = ubound(SrcMemberTypeData%Cb) if (.not. allocated(DstMemberTypeData%Cb)) then allocate(DstMemberTypeData%Cb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1228,8 +1228,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cb = SrcMemberTypeData%Cb end if if (allocated(SrcMemberTypeData%m_fb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%m_fb_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%m_fb_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%m_fb_l) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_l) if (.not. allocated(DstMemberTypeData%m_fb_l)) then allocate(DstMemberTypeData%m_fb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1240,8 +1240,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l end if if (allocated(SrcMemberTypeData%m_fb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%m_fb_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%m_fb_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%m_fb_u) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_u) if (.not. allocated(DstMemberTypeData%m_fb_u)) then allocate(DstMemberTypeData%m_fb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1252,8 +1252,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u end if if (allocated(SrcMemberTypeData%h_cfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l) if (.not. allocated(DstMemberTypeData%h_cfb_l)) then allocate(DstMemberTypeData%h_cfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1264,8 +1264,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l end if if (allocated(SrcMemberTypeData%h_cfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u) if (.not. allocated(DstMemberTypeData%h_cfb_u)) then allocate(DstMemberTypeData%h_cfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1276,8 +1276,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u end if if (allocated(SrcMemberTypeData%I_lfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l) if (.not. allocated(DstMemberTypeData%I_lfb_l)) then allocate(DstMemberTypeData%I_lfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1288,8 +1288,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l end if if (allocated(SrcMemberTypeData%I_lfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u) if (.not. allocated(DstMemberTypeData%I_lfb_u)) then allocate(DstMemberTypeData%I_lfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1300,8 +1300,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u end if if (allocated(SrcMemberTypeData%I_rfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l) if (.not. allocated(DstMemberTypeData%I_rfb_l)) then allocate(DstMemberTypeData%I_rfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1312,8 +1312,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l end if if (allocated(SrcMemberTypeData%I_rfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u) if (.not. allocated(DstMemberTypeData%I_rfb_u)) then allocate(DstMemberTypeData%I_rfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1324,8 +1324,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u end if if (allocated(SrcMemberTypeData%m_mg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%m_mg_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%m_mg_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%m_mg_l) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_l) if (.not. allocated(DstMemberTypeData%m_mg_l)) then allocate(DstMemberTypeData%m_mg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1336,8 +1336,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l end if if (allocated(SrcMemberTypeData%m_mg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%m_mg_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%m_mg_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%m_mg_u) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_u) if (.not. allocated(DstMemberTypeData%m_mg_u)) then allocate(DstMemberTypeData%m_mg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1348,8 +1348,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u end if if (allocated(SrcMemberTypeData%h_cmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l) if (.not. allocated(DstMemberTypeData%h_cmg_l)) then allocate(DstMemberTypeData%h_cmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1360,8 +1360,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l end if if (allocated(SrcMemberTypeData%h_cmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u) if (.not. allocated(DstMemberTypeData%h_cmg_u)) then allocate(DstMemberTypeData%h_cmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1372,8 +1372,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u end if if (allocated(SrcMemberTypeData%I_lmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l) if (.not. allocated(DstMemberTypeData%I_lmg_l)) then allocate(DstMemberTypeData%I_lmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1384,8 +1384,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l end if if (allocated(SrcMemberTypeData%I_lmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u) if (.not. allocated(DstMemberTypeData%I_lmg_u)) then allocate(DstMemberTypeData%I_lmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1396,8 +1396,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u end if if (allocated(SrcMemberTypeData%I_rmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l) if (.not. allocated(DstMemberTypeData%I_rmg_l)) then allocate(DstMemberTypeData%I_rmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1408,8 +1408,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l end if if (allocated(SrcMemberTypeData%I_rmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u) if (.not. allocated(DstMemberTypeData%I_rmg_u)) then allocate(DstMemberTypeData%I_rmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1420,8 +1420,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u end if if (allocated(SrcMemberTypeData%Cfl_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb) if (.not. allocated(DstMemberTypeData%Cfl_fb)) then allocate(DstMemberTypeData%Cfl_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1432,8 +1432,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb end if if (allocated(SrcMemberTypeData%Cfr_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb) if (.not. allocated(DstMemberTypeData%Cfr_fb)) then allocate(DstMemberTypeData%Cfr_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1444,8 +1444,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb end if if (allocated(SrcMemberTypeData%CM0_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%CM0_fb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%CM0_fb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%CM0_fb) + UB(1:1) = ubound(SrcMemberTypeData%CM0_fb) if (.not. allocated(DstMemberTypeData%CM0_fb)) then allocate(DstMemberTypeData%CM0_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1679,7 +1679,7 @@ subroutine Morison_UnPackMemberType(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MemberType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1761,14 +1761,14 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberLoads' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMemberLoadsData%F_D)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_D, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_D, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_D) + UB(1:2) = ubound(SrcMemberLoadsData%F_D) if (.not. allocated(DstMemberLoadsData%F_D)) then allocate(DstMemberLoadsData%F_D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1779,8 +1779,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D end if if (allocated(SrcMemberLoadsData%F_I)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_I, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_I, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_I) + UB(1:2) = ubound(SrcMemberLoadsData%F_I) if (.not. allocated(DstMemberLoadsData%F_I)) then allocate(DstMemberLoadsData%F_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1791,8 +1791,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I end if if (allocated(SrcMemberLoadsData%F_A)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_A, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_A, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_A) + UB(1:2) = ubound(SrcMemberLoadsData%F_A) if (.not. allocated(DstMemberLoadsData%F_A)) then allocate(DstMemberLoadsData%F_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1803,8 +1803,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A end if if (allocated(SrcMemberLoadsData%F_B)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_B, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_B, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_B) + UB(1:2) = ubound(SrcMemberLoadsData%F_B) if (.not. allocated(DstMemberLoadsData%F_B)) then allocate(DstMemberLoadsData%F_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1815,8 +1815,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B end if if (allocated(SrcMemberLoadsData%F_BF)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_BF, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_BF, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_BF) + UB(1:2) = ubound(SrcMemberLoadsData%F_BF) if (.not. allocated(DstMemberLoadsData%F_BF)) then allocate(DstMemberLoadsData%F_BF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1827,8 +1827,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF end if if (allocated(SrcMemberLoadsData%F_If)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_If, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_If, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_If) + UB(1:2) = ubound(SrcMemberLoadsData%F_If) if (.not. allocated(DstMemberLoadsData%F_If)) then allocate(DstMemberLoadsData%F_If(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1839,8 +1839,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If end if if (allocated(SrcMemberLoadsData%F_WMG)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_WMG, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_WMG, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_WMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_WMG) if (.not. allocated(DstMemberLoadsData%F_WMG)) then allocate(DstMemberLoadsData%F_WMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1851,8 +1851,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG end if if (allocated(SrcMemberLoadsData%F_IMG)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_IMG, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_IMG, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_IMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_IMG) if (.not. allocated(DstMemberLoadsData%F_IMG)) then allocate(DstMemberLoadsData%F_IMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1863,8 +1863,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG end if if (allocated(SrcMemberLoadsData%FV)) then - LB(1:2) = lbound(SrcMemberLoadsData%FV, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%FV, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%FV) + UB(1:2) = ubound(SrcMemberLoadsData%FV) if (.not. allocated(DstMemberLoadsData%FV)) then allocate(DstMemberLoadsData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1875,8 +1875,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%FV = SrcMemberLoadsData%FV end if if (allocated(SrcMemberLoadsData%FA)) then - LB(1:2) = lbound(SrcMemberLoadsData%FA, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%FA, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%FA) + UB(1:2) = ubound(SrcMemberLoadsData%FA) if (.not. allocated(DstMemberLoadsData%FA)) then allocate(DstMemberLoadsData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1887,8 +1887,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%FA = SrcMemberLoadsData%FA end if if (allocated(SrcMemberLoadsData%F_DP)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_DP, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_DP, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_DP) + UB(1:2) = ubound(SrcMemberLoadsData%F_DP) if (.not. allocated(DstMemberLoadsData%F_DP)) then allocate(DstMemberLoadsData%F_DP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1965,7 +1965,7 @@ subroutine Morison_UnPackMemberLoads(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MemberLoads), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberLoads' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2157,7 +2157,7 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMOutput' ErrStat = ErrID_None @@ -2165,8 +2165,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberID = SrcMOutputData%MemberID DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc if (allocated(SrcMOutputData%NodeLocs)) then - LB(1:1) = lbound(SrcMOutputData%NodeLocs, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%NodeLocs, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%NodeLocs) + UB(1:1) = ubound(SrcMOutputData%NodeLocs) if (.not. allocated(DstMOutputData%NodeLocs)) then allocate(DstMOutputData%NodeLocs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2178,8 +2178,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx if (allocated(SrcMOutputData%MeshIndx1)) then - LB(1:1) = lbound(SrcMOutputData%MeshIndx1, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%MeshIndx1, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%MeshIndx1) + UB(1:1) = ubound(SrcMOutputData%MeshIndx1) if (.not. allocated(DstMOutputData%MeshIndx1)) then allocate(DstMOutputData%MeshIndx1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2190,8 +2190,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 end if if (allocated(SrcMOutputData%MeshIndx2)) then - LB(1:1) = lbound(SrcMOutputData%MeshIndx2, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%MeshIndx2, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%MeshIndx2) + UB(1:1) = ubound(SrcMOutputData%MeshIndx2) if (.not. allocated(DstMOutputData%MeshIndx2)) then allocate(DstMOutputData%MeshIndx2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2202,8 +2202,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 end if if (allocated(SrcMOutputData%MemberIndx1)) then - LB(1:1) = lbound(SrcMOutputData%MemberIndx1, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%MemberIndx1, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%MemberIndx1) + UB(1:1) = ubound(SrcMOutputData%MemberIndx1) if (.not. allocated(DstMOutputData%MemberIndx1)) then allocate(DstMOutputData%MemberIndx1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2214,8 +2214,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 end if if (allocated(SrcMOutputData%MemberIndx2)) then - LB(1:1) = lbound(SrcMOutputData%MemberIndx2, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%MemberIndx2, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%MemberIndx2) + UB(1:1) = ubound(SrcMOutputData%MemberIndx2) if (.not. allocated(DstMOutputData%MemberIndx2)) then allocate(DstMOutputData%MemberIndx2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2226,8 +2226,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 end if if (allocated(SrcMOutputData%s)) then - LB(1:1) = lbound(SrcMOutputData%s, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%s, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%s) + UB(1:1) = ubound(SrcMOutputData%s) if (.not. allocated(DstMOutputData%s)) then allocate(DstMOutputData%s(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2287,7 +2287,7 @@ subroutine Morison_UnPackMOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MOutput), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2349,8 +2349,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyInitInput' @@ -2362,8 +2362,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NJoints = SrcInitInputData%NJoints DstInitInputData%NNodes = SrcInitInputData%NNodes if (allocated(SrcInitInputData%InpJoints)) then - LB(1:1) = lbound(SrcInitInputData%InpJoints, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%InpJoints, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%InpJoints) + UB(1:1) = ubound(SrcInitInputData%InpJoints) if (.not. allocated(DstInitInputData%InpJoints)) then allocate(DstInitInputData%InpJoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2378,8 +2378,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end do end if if (allocated(SrcInitInputData%Nodes)) then - LB(1:1) = lbound(SrcInitInputData%Nodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%Nodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%Nodes) + UB(1:1) = ubound(SrcInitInputData%Nodes) if (.not. allocated(DstInitInputData%Nodes)) then allocate(DstInitInputData%Nodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2395,8 +2395,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs if (allocated(SrcInitInputData%AxialCoefs)) then - LB(1:1) = lbound(SrcInitInputData%AxialCoefs, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%AxialCoefs, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%AxialCoefs) + UB(1:1) = ubound(SrcInitInputData%AxialCoefs) if (.not. allocated(DstInitInputData%AxialCoefs)) then allocate(DstInitInputData%AxialCoefs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2412,8 +2412,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NPropSets = SrcInitInputData%NPropSets if (allocated(SrcInitInputData%MPropSets)) then - LB(1:1) = lbound(SrcInitInputData%MPropSets, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MPropSets, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MPropSets) + UB(1:1) = ubound(SrcInitInputData%MPropSets) if (.not. allocated(DstInitInputData%MPropSets)) then allocate(DstInitInputData%MPropSets(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2444,8 +2444,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%SimplMCF = SrcInitInputData%SimplMCF DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth if (allocated(SrcInitInputData%CoefDpths)) then - LB(1:1) = lbound(SrcInitInputData%CoefDpths, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CoefDpths, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CoefDpths) + UB(1:1) = ubound(SrcInitInputData%CoefDpths) if (.not. allocated(DstInitInputData%CoefDpths)) then allocate(DstInitInputData%CoefDpths(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2461,8 +2461,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers if (allocated(SrcInitInputData%CoefMembers)) then - LB(1:1) = lbound(SrcInitInputData%CoefMembers, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CoefMembers, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CoefMembers) + UB(1:1) = ubound(SrcInitInputData%CoefMembers) if (.not. allocated(DstInitInputData%CoefMembers)) then allocate(DstInitInputData%CoefMembers(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2478,8 +2478,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NMembers = SrcInitInputData%NMembers if (allocated(SrcInitInputData%InpMembers)) then - LB(1:1) = lbound(SrcInitInputData%InpMembers, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%InpMembers, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%InpMembers) + UB(1:1) = ubound(SrcInitInputData%InpMembers) if (.not. allocated(DstInitInputData%InpMembers)) then allocate(DstInitInputData%InpMembers(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2495,8 +2495,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups if (allocated(SrcInitInputData%FilledGroups)) then - LB(1:1) = lbound(SrcInitInputData%FilledGroups, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%FilledGroups, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%FilledGroups) + UB(1:1) = ubound(SrcInitInputData%FilledGroups) if (.not. allocated(DstInitInputData%FilledGroups)) then allocate(DstInitInputData%FilledGroups(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2512,8 +2512,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths if (allocated(SrcInitInputData%MGDepths)) then - LB(1:1) = lbound(SrcInitInputData%MGDepths, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MGDepths, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MGDepths) + UB(1:1) = ubound(SrcInitInputData%MGDepths) if (.not. allocated(DstInitInputData%MGDepths)) then allocate(DstInitInputData%MGDepths(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2531,8 +2531,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%MGBottom = SrcInitInputData%MGBottom DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs if (allocated(SrcInitInputData%MOutLst)) then - LB(1:1) = lbound(SrcInitInputData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MOutLst, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MOutLst) + UB(1:1) = ubound(SrcInitInputData%MOutLst) if (.not. allocated(DstInitInputData%MOutLst)) then allocate(DstInitInputData%MOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2548,8 +2548,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs if (allocated(SrcInitInputData%JOutLst)) then - LB(1:1) = lbound(SrcInitInputData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%JOutLst, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%JOutLst) + UB(1:1) = ubound(SrcInitInputData%JOutLst) if (.not. allocated(DstInitInputData%JOutLst)) then allocate(DstInitInputData%JOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2564,8 +2564,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end do end if if (allocated(SrcInitInputData%OutList)) then - LB(1:1) = lbound(SrcInitInputData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) if (.not. allocated(DstInitInputData%OutList)) then allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2586,16 +2586,16 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(Morison_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%InpJoints)) then - LB(1:1) = lbound(InitInputData%InpJoints, kind=B8Ki) - UB(1:1) = ubound(InitInputData%InpJoints, kind=B8Ki) + LB(1:1) = lbound(InitInputData%InpJoints) + UB(1:1) = ubound(InitInputData%InpJoints) do i1 = LB(1), UB(1) call Morison_DestroyJointType(InitInputData%InpJoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2603,8 +2603,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%InpJoints) end if if (allocated(InitInputData%Nodes)) then - LB(1:1) = lbound(InitInputData%Nodes, kind=B8Ki) - UB(1:1) = ubound(InitInputData%Nodes, kind=B8Ki) + LB(1:1) = lbound(InitInputData%Nodes) + UB(1:1) = ubound(InitInputData%Nodes) do i1 = LB(1), UB(1) call Morison_DestroyNodeType(InitInputData%Nodes(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2612,8 +2612,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%Nodes) end if if (allocated(InitInputData%AxialCoefs)) then - LB(1:1) = lbound(InitInputData%AxialCoefs, kind=B8Ki) - UB(1:1) = ubound(InitInputData%AxialCoefs, kind=B8Ki) + LB(1:1) = lbound(InitInputData%AxialCoefs) + UB(1:1) = ubound(InitInputData%AxialCoefs) do i1 = LB(1), UB(1) call Morison_DestroyAxialCoefType(InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2621,8 +2621,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%AxialCoefs) end if if (allocated(InitInputData%MPropSets)) then - LB(1:1) = lbound(InitInputData%MPropSets, kind=B8Ki) - UB(1:1) = ubound(InitInputData%MPropSets, kind=B8Ki) + LB(1:1) = lbound(InitInputData%MPropSets) + UB(1:1) = ubound(InitInputData%MPropSets) do i1 = LB(1), UB(1) call Morison_DestroyMemberPropType(InitInputData%MPropSets(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2630,8 +2630,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MPropSets) end if if (allocated(InitInputData%CoefDpths)) then - LB(1:1) = lbound(InitInputData%CoefDpths, kind=B8Ki) - UB(1:1) = ubound(InitInputData%CoefDpths, kind=B8Ki) + LB(1:1) = lbound(InitInputData%CoefDpths) + UB(1:1) = ubound(InitInputData%CoefDpths) do i1 = LB(1), UB(1) call Morison_DestroyCoefDpths(InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2639,8 +2639,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%CoefDpths) end if if (allocated(InitInputData%CoefMembers)) then - LB(1:1) = lbound(InitInputData%CoefMembers, kind=B8Ki) - UB(1:1) = ubound(InitInputData%CoefMembers, kind=B8Ki) + LB(1:1) = lbound(InitInputData%CoefMembers) + UB(1:1) = ubound(InitInputData%CoefMembers) do i1 = LB(1), UB(1) call Morison_DestroyCoefMembers(InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2648,8 +2648,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%CoefMembers) end if if (allocated(InitInputData%InpMembers)) then - LB(1:1) = lbound(InitInputData%InpMembers, kind=B8Ki) - UB(1:1) = ubound(InitInputData%InpMembers, kind=B8Ki) + LB(1:1) = lbound(InitInputData%InpMembers) + UB(1:1) = ubound(InitInputData%InpMembers) do i1 = LB(1), UB(1) call Morison_DestroyMemberInputType(InitInputData%InpMembers(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2657,8 +2657,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%InpMembers) end if if (allocated(InitInputData%FilledGroups)) then - LB(1:1) = lbound(InitInputData%FilledGroups, kind=B8Ki) - UB(1:1) = ubound(InitInputData%FilledGroups, kind=B8Ki) + LB(1:1) = lbound(InitInputData%FilledGroups) + UB(1:1) = ubound(InitInputData%FilledGroups) do i1 = LB(1), UB(1) call Morison_DestroyFilledGroupType(InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2666,8 +2666,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%FilledGroups) end if if (allocated(InitInputData%MGDepths)) then - LB(1:1) = lbound(InitInputData%MGDepths, kind=B8Ki) - UB(1:1) = ubound(InitInputData%MGDepths, kind=B8Ki) + LB(1:1) = lbound(InitInputData%MGDepths) + UB(1:1) = ubound(InitInputData%MGDepths) do i1 = LB(1), UB(1) call Morison_DestroyMGDepthsType(InitInputData%MGDepths(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2675,8 +2675,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MGDepths) end if if (allocated(InitInputData%MOutLst)) then - LB(1:1) = lbound(InitInputData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(InitInputData%MOutLst, kind=B8Ki) + LB(1:1) = lbound(InitInputData%MOutLst) + UB(1:1) = ubound(InitInputData%MOutLst) do i1 = LB(1), UB(1) call Morison_DestroyMOutput(InitInputData%MOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2684,8 +2684,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MOutLst) end if if (allocated(InitInputData%JOutLst)) then - LB(1:1) = lbound(InitInputData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(InitInputData%JOutLst, kind=B8Ki) + LB(1:1) = lbound(InitInputData%JOutLst) + UB(1:1) = ubound(InitInputData%JOutLst) do i1 = LB(1), UB(1) call Morison_DestroyJOutput(InitInputData%JOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2702,8 +2702,8 @@ subroutine Morison_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(Morison_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Gravity) @@ -2713,18 +2713,18 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NNodes) call RegPack(RF, allocated(InData%InpJoints)) if (allocated(InData%InpJoints)) then - call RegPackBounds(RF, 1, lbound(InData%InpJoints, kind=B8Ki), ubound(InData%InpJoints, kind=B8Ki)) - LB(1:1) = lbound(InData%InpJoints, kind=B8Ki) - UB(1:1) = ubound(InData%InpJoints, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%InpJoints), ubound(InData%InpJoints)) + LB(1:1) = lbound(InData%InpJoints) + UB(1:1) = ubound(InData%InpJoints) do i1 = LB(1), UB(1) call Morison_PackJointType(RF, InData%InpJoints(i1)) end do end if call RegPack(RF, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then - call RegPackBounds(RF, 1, lbound(InData%Nodes, kind=B8Ki), ubound(InData%Nodes, kind=B8Ki)) - LB(1:1) = lbound(InData%Nodes, kind=B8Ki) - UB(1:1) = ubound(InData%Nodes, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Nodes), ubound(InData%Nodes)) + LB(1:1) = lbound(InData%Nodes) + UB(1:1) = ubound(InData%Nodes) do i1 = LB(1), UB(1) call Morison_PackNodeType(RF, InData%Nodes(i1)) end do @@ -2732,9 +2732,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NAxCoefs) call RegPack(RF, allocated(InData%AxialCoefs)) if (allocated(InData%AxialCoefs)) then - call RegPackBounds(RF, 1, lbound(InData%AxialCoefs, kind=B8Ki), ubound(InData%AxialCoefs, kind=B8Ki)) - LB(1:1) = lbound(InData%AxialCoefs, kind=B8Ki) - UB(1:1) = ubound(InData%AxialCoefs, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AxialCoefs), ubound(InData%AxialCoefs)) + LB(1:1) = lbound(InData%AxialCoefs) + UB(1:1) = ubound(InData%AxialCoefs) do i1 = LB(1), UB(1) call Morison_PackAxialCoefType(RF, InData%AxialCoefs(i1)) end do @@ -2742,9 +2742,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NPropSets) call RegPack(RF, allocated(InData%MPropSets)) if (allocated(InData%MPropSets)) then - call RegPackBounds(RF, 1, lbound(InData%MPropSets, kind=B8Ki), ubound(InData%MPropSets, kind=B8Ki)) - LB(1:1) = lbound(InData%MPropSets, kind=B8Ki) - UB(1:1) = ubound(InData%MPropSets, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MPropSets), ubound(InData%MPropSets)) + LB(1:1) = lbound(InData%MPropSets) + UB(1:1) = ubound(InData%MPropSets) do i1 = LB(1), UB(1) call Morison_PackMemberPropType(RF, InData%MPropSets(i1)) end do @@ -2767,9 +2767,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NCoefDpth) call RegPack(RF, allocated(InData%CoefDpths)) if (allocated(InData%CoefDpths)) then - call RegPackBounds(RF, 1, lbound(InData%CoefDpths, kind=B8Ki), ubound(InData%CoefDpths, kind=B8Ki)) - LB(1:1) = lbound(InData%CoefDpths, kind=B8Ki) - UB(1:1) = ubound(InData%CoefDpths, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%CoefDpths), ubound(InData%CoefDpths)) + LB(1:1) = lbound(InData%CoefDpths) + UB(1:1) = ubound(InData%CoefDpths) do i1 = LB(1), UB(1) call Morison_PackCoefDpths(RF, InData%CoefDpths(i1)) end do @@ -2777,9 +2777,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NCoefMembers) call RegPack(RF, allocated(InData%CoefMembers)) if (allocated(InData%CoefMembers)) then - call RegPackBounds(RF, 1, lbound(InData%CoefMembers, kind=B8Ki), ubound(InData%CoefMembers, kind=B8Ki)) - LB(1:1) = lbound(InData%CoefMembers, kind=B8Ki) - UB(1:1) = ubound(InData%CoefMembers, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%CoefMembers), ubound(InData%CoefMembers)) + LB(1:1) = lbound(InData%CoefMembers) + UB(1:1) = ubound(InData%CoefMembers) do i1 = LB(1), UB(1) call Morison_PackCoefMembers(RF, InData%CoefMembers(i1)) end do @@ -2787,9 +2787,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NMembers) call RegPack(RF, allocated(InData%InpMembers)) if (allocated(InData%InpMembers)) then - call RegPackBounds(RF, 1, lbound(InData%InpMembers, kind=B8Ki), ubound(InData%InpMembers, kind=B8Ki)) - LB(1:1) = lbound(InData%InpMembers, kind=B8Ki) - UB(1:1) = ubound(InData%InpMembers, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%InpMembers), ubound(InData%InpMembers)) + LB(1:1) = lbound(InData%InpMembers) + UB(1:1) = ubound(InData%InpMembers) do i1 = LB(1), UB(1) call Morison_PackMemberInputType(RF, InData%InpMembers(i1)) end do @@ -2797,9 +2797,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NFillGroups) call RegPack(RF, allocated(InData%FilledGroups)) if (allocated(InData%FilledGroups)) then - call RegPackBounds(RF, 1, lbound(InData%FilledGroups, kind=B8Ki), ubound(InData%FilledGroups, kind=B8Ki)) - LB(1:1) = lbound(InData%FilledGroups, kind=B8Ki) - UB(1:1) = ubound(InData%FilledGroups, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%FilledGroups), ubound(InData%FilledGroups)) + LB(1:1) = lbound(InData%FilledGroups) + UB(1:1) = ubound(InData%FilledGroups) do i1 = LB(1), UB(1) call Morison_PackFilledGroupType(RF, InData%FilledGroups(i1)) end do @@ -2807,9 +2807,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NMGDepths) call RegPack(RF, allocated(InData%MGDepths)) if (allocated(InData%MGDepths)) then - call RegPackBounds(RF, 1, lbound(InData%MGDepths, kind=B8Ki), ubound(InData%MGDepths, kind=B8Ki)) - LB(1:1) = lbound(InData%MGDepths, kind=B8Ki) - UB(1:1) = ubound(InData%MGDepths, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MGDepths), ubound(InData%MGDepths)) + LB(1:1) = lbound(InData%MGDepths) + UB(1:1) = ubound(InData%MGDepths) do i1 = LB(1), UB(1) call Morison_PackMGDepthsType(RF, InData%MGDepths(i1)) end do @@ -2819,9 +2819,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NMOutputs) call RegPack(RF, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then - call RegPackBounds(RF, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(InData%MOutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) do i1 = LB(1), UB(1) call Morison_PackMOutput(RF, InData%MOutLst(i1)) end do @@ -2829,9 +2829,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NJOutputs) call RegPack(RF, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then - call RegPackBounds(RF, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(InData%JOutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) do i1 = LB(1), UB(1) call Morison_PackJOutput(RF, InData%JOutLst(i1)) end do @@ -2855,8 +2855,8 @@ subroutine Morison_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -3067,14 +3067,14 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%MorisonVisRad)) then - LB(1:1) = lbound(SrcInitOutputData%MorisonVisRad, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%MorisonVisRad, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%MorisonVisRad) + UB(1:1) = ubound(SrcInitOutputData%MorisonVisRad) if (.not. allocated(DstInitOutputData%MorisonVisRad)) then allocate(DstInitOutputData%MorisonVisRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3085,8 +3085,8 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%MorisonVisRad = SrcInitOutputData%MorisonVisRad end if if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3097,8 +3097,8 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3143,7 +3143,7 @@ subroutine Morison_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3196,14 +3196,14 @@ subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%V_rel_n_FiltStat)) then - LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat) + UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat) if (.not. allocated(DstDiscStateData%V_rel_n_FiltStat)) then allocate(DstDiscStateData%V_rel_n_FiltStat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3240,7 +3240,7 @@ subroutine Morison_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackDiscState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3329,16 +3329,16 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%DispNodePosHdn)) then - LB(1:2) = lbound(SrcMiscData%DispNodePosHdn, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%DispNodePosHdn, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%DispNodePosHdn) + UB(1:2) = ubound(SrcMiscData%DispNodePosHdn) if (.not. allocated(DstMiscData%DispNodePosHdn)) then allocate(DstMiscData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3349,8 +3349,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DispNodePosHdn = SrcMiscData%DispNodePosHdn end if if (allocated(SrcMiscData%DispNodePosHst)) then - LB(1:2) = lbound(SrcMiscData%DispNodePosHst, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%DispNodePosHst, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%DispNodePosHst) + UB(1:2) = ubound(SrcMiscData%DispNodePosHst) if (.not. allocated(DstMiscData%DispNodePosHst)) then allocate(DstMiscData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3361,8 +3361,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DispNodePosHst = SrcMiscData%DispNodePosHst end if if (allocated(SrcMiscData%FV)) then - LB(1:2) = lbound(SrcMiscData%FV, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FV, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FV) + UB(1:2) = ubound(SrcMiscData%FV) if (.not. allocated(DstMiscData%FV)) then allocate(DstMiscData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3373,8 +3373,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FV = SrcMiscData%FV end if if (allocated(SrcMiscData%FA)) then - LB(1:2) = lbound(SrcMiscData%FA, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FA, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FA) + UB(1:2) = ubound(SrcMiscData%FA) if (.not. allocated(DstMiscData%FA)) then allocate(DstMiscData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3385,8 +3385,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FA = SrcMiscData%FA end if if (allocated(SrcMiscData%FAMCF)) then - LB(1:2) = lbound(SrcMiscData%FAMCF, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FAMCF, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FAMCF) + UB(1:2) = ubound(SrcMiscData%FAMCF) if (.not. allocated(DstMiscData%FAMCF)) then allocate(DstMiscData%FAMCF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3397,8 +3397,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAMCF = SrcMiscData%FAMCF end if if (allocated(SrcMiscData%FDynP)) then - LB(1:1) = lbound(SrcMiscData%FDynP, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FDynP, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FDynP) + UB(1:1) = ubound(SrcMiscData%FDynP) if (.not. allocated(DstMiscData%FDynP)) then allocate(DstMiscData%FDynP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3409,8 +3409,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FDynP = SrcMiscData%FDynP end if if (allocated(SrcMiscData%WaveElev)) then - LB(1:1) = lbound(SrcMiscData%WaveElev, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WaveElev, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%WaveElev) + UB(1:1) = ubound(SrcMiscData%WaveElev) if (.not. allocated(DstMiscData%WaveElev)) then allocate(DstMiscData%WaveElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3421,8 +3421,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev = SrcMiscData%WaveElev end if if (allocated(SrcMiscData%WaveElev1)) then - LB(1:1) = lbound(SrcMiscData%WaveElev1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WaveElev1, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%WaveElev1) + UB(1:1) = ubound(SrcMiscData%WaveElev1) if (.not. allocated(DstMiscData%WaveElev1)) then allocate(DstMiscData%WaveElev1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3433,8 +3433,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 end if if (allocated(SrcMiscData%WaveElev2)) then - LB(1:1) = lbound(SrcMiscData%WaveElev2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WaveElev2, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%WaveElev2) + UB(1:1) = ubound(SrcMiscData%WaveElev2) if (.not. allocated(DstMiscData%WaveElev2)) then allocate(DstMiscData%WaveElev2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3445,8 +3445,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 end if if (allocated(SrcMiscData%vrel)) then - LB(1:2) = lbound(SrcMiscData%vrel, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%vrel, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%vrel) + UB(1:2) = ubound(SrcMiscData%vrel) if (.not. allocated(DstMiscData%vrel)) then allocate(DstMiscData%vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3457,8 +3457,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vrel = SrcMiscData%vrel end if if (allocated(SrcMiscData%nodeInWater)) then - LB(1:1) = lbound(SrcMiscData%nodeInWater, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%nodeInWater, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%nodeInWater) + UB(1:1) = ubound(SrcMiscData%nodeInWater) if (.not. allocated(DstMiscData%nodeInWater)) then allocate(DstMiscData%nodeInWater(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3469,8 +3469,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nodeInWater = SrcMiscData%nodeInWater end if if (allocated(SrcMiscData%memberLoads)) then - LB(1:1) = lbound(SrcMiscData%memberLoads, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%memberLoads, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%memberLoads) + UB(1:1) = ubound(SrcMiscData%memberLoads) if (.not. allocated(DstMiscData%memberLoads)) then allocate(DstMiscData%memberLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3485,8 +3485,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%F_B_End)) then - LB(1:2) = lbound(SrcMiscData%F_B_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_B_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_B_End) + UB(1:2) = ubound(SrcMiscData%F_B_End) if (.not. allocated(DstMiscData%F_B_End)) then allocate(DstMiscData%F_B_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3497,8 +3497,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_B_End = SrcMiscData%F_B_End end if if (allocated(SrcMiscData%F_D_End)) then - LB(1:2) = lbound(SrcMiscData%F_D_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_D_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_D_End) + UB(1:2) = ubound(SrcMiscData%F_D_End) if (.not. allocated(DstMiscData%F_D_End)) then allocate(DstMiscData%F_D_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3509,8 +3509,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_D_End = SrcMiscData%F_D_End end if if (allocated(SrcMiscData%F_I_End)) then - LB(1:2) = lbound(SrcMiscData%F_I_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_I_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_I_End) + UB(1:2) = ubound(SrcMiscData%F_I_End) if (.not. allocated(DstMiscData%F_I_End)) then allocate(DstMiscData%F_I_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3521,8 +3521,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_I_End = SrcMiscData%F_I_End end if if (allocated(SrcMiscData%F_IMG_End)) then - LB(1:2) = lbound(SrcMiscData%F_IMG_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_IMG_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_IMG_End) + UB(1:2) = ubound(SrcMiscData%F_IMG_End) if (.not. allocated(DstMiscData%F_IMG_End)) then allocate(DstMiscData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3533,8 +3533,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End end if if (allocated(SrcMiscData%F_A_End)) then - LB(1:2) = lbound(SrcMiscData%F_A_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_A_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_A_End) + UB(1:2) = ubound(SrcMiscData%F_A_End) if (.not. allocated(DstMiscData%F_A_End)) then allocate(DstMiscData%F_A_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3545,8 +3545,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_A_End = SrcMiscData%F_A_End end if if (allocated(SrcMiscData%F_BF_End)) then - LB(1:2) = lbound(SrcMiscData%F_BF_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_BF_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_BF_End) + UB(1:2) = ubound(SrcMiscData%F_BF_End) if (.not. allocated(DstMiscData%F_BF_End)) then allocate(DstMiscData%F_BF_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3557,8 +3557,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_BF_End = SrcMiscData%F_BF_End end if if (allocated(SrcMiscData%V_rel_n)) then - LB(1:1) = lbound(SrcMiscData%V_rel_n, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%V_rel_n, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%V_rel_n) + UB(1:1) = ubound(SrcMiscData%V_rel_n) if (.not. allocated(DstMiscData%V_rel_n)) then allocate(DstMiscData%V_rel_n(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3569,8 +3569,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%V_rel_n = SrcMiscData%V_rel_n end if if (allocated(SrcMiscData%V_rel_n_HiPass)) then - LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass) + UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass) if (.not. allocated(DstMiscData%V_rel_n_HiPass)) then allocate(DstMiscData%V_rel_n_HiPass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3592,8 +3592,8 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Morison_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyMisc' @@ -3633,8 +3633,8 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%nodeInWater) end if if (allocated(MiscData%memberLoads)) then - LB(1:1) = lbound(MiscData%memberLoads, kind=B8Ki) - UB(1:1) = ubound(MiscData%memberLoads, kind=B8Ki) + LB(1:1) = lbound(MiscData%memberLoads) + UB(1:1) = ubound(MiscData%memberLoads) do i1 = LB(1), UB(1) call Morison_DestroyMemberLoads(MiscData%memberLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3675,8 +3675,8 @@ subroutine Morison_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(Morison_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%DispNodePosHdn) call RegPackAlloc(RF, InData%DispNodePosHst) @@ -3691,9 +3691,9 @@ subroutine Morison_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%nodeInWater) call RegPack(RF, allocated(InData%memberLoads)) if (allocated(InData%memberLoads)) then - call RegPackBounds(RF, 1, lbound(InData%memberLoads, kind=B8Ki), ubound(InData%memberLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%memberLoads, kind=B8Ki) - UB(1:1) = ubound(InData%memberLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%memberLoads), ubound(InData%memberLoads)) + LB(1:1) = lbound(InData%memberLoads) + UB(1:1) = ubound(InData%memberLoads) do i1 = LB(1), UB(1) call Morison_PackMemberLoads(RF, InData%memberLoads(i1)) end do @@ -3715,8 +3715,8 @@ subroutine Morison_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3762,8 +3762,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyParam' @@ -3775,8 +3775,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%AMMod = SrcParamData%AMMod DstParamData%NMembers = SrcParamData%NMembers if (allocated(SrcParamData%Members)) then - LB(1:1) = lbound(SrcParamData%Members, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Members, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Members) + UB(1:1) = ubound(SrcParamData%Members) if (.not. allocated(DstParamData%Members)) then allocate(DstParamData%Members(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3793,8 +3793,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NNodes = SrcParamData%NNodes DstParamData%NJoints = SrcParamData%NJoints if (allocated(SrcParamData%I_MG_End)) then - LB(1:3) = lbound(SrcParamData%I_MG_End, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%I_MG_End, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%I_MG_End) + UB(1:3) = ubound(SrcParamData%I_MG_End) if (.not. allocated(DstParamData%I_MG_End)) then allocate(DstParamData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3805,8 +3805,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%I_MG_End = SrcParamData%I_MG_End end if if (allocated(SrcParamData%An_End)) then - LB(1:2) = lbound(SrcParamData%An_End, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%An_End, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%An_End) + UB(1:2) = ubound(SrcParamData%An_End) if (.not. allocated(DstParamData%An_End)) then allocate(DstParamData%An_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3817,8 +3817,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%An_End = SrcParamData%An_End end if if (allocated(SrcParamData%DragConst_End)) then - LB(1:1) = lbound(SrcParamData%DragConst_End, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DragConst_End, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DragConst_End) + UB(1:1) = ubound(SrcParamData%DragConst_End) if (.not. allocated(DstParamData%DragConst_End)) then allocate(DstParamData%DragConst_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3829,8 +3829,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragConst_End = SrcParamData%DragConst_End end if if (allocated(SrcParamData%VRelNFiltConst)) then - LB(1:1) = lbound(SrcParamData%VRelNFiltConst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%VRelNFiltConst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%VRelNFiltConst) + UB(1:1) = ubound(SrcParamData%VRelNFiltConst) if (.not. allocated(DstParamData%VRelNFiltConst)) then allocate(DstParamData%VRelNFiltConst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3841,8 +3841,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst end if if (allocated(SrcParamData%DragMod_End)) then - LB(1:1) = lbound(SrcParamData%DragMod_End, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DragMod_End, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DragMod_End) + UB(1:1) = ubound(SrcParamData%DragMod_End) if (.not. allocated(DstParamData%DragMod_End)) then allocate(DstParamData%DragMod_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3853,8 +3853,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragMod_End = SrcParamData%DragMod_End end if if (allocated(SrcParamData%DragLoFSc_End)) then - LB(1:1) = lbound(SrcParamData%DragLoFSc_End, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DragLoFSc_End, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DragLoFSc_End) + UB(1:1) = ubound(SrcParamData%DragLoFSc_End) if (.not. allocated(DstParamData%DragLoFSc_End)) then allocate(DstParamData%DragLoFSc_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3865,8 +3865,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End end if if (allocated(SrcParamData%F_WMG_End)) then - LB(1:2) = lbound(SrcParamData%F_WMG_End, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%F_WMG_End, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%F_WMG_End) + UB(1:2) = ubound(SrcParamData%F_WMG_End) if (.not. allocated(DstParamData%F_WMG_End)) then allocate(DstParamData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3877,8 +3877,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%F_WMG_End = SrcParamData%F_WMG_End end if if (allocated(SrcParamData%DP_Const_End)) then - LB(1:2) = lbound(SrcParamData%DP_Const_End, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DP_Const_End, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%DP_Const_End) + UB(1:2) = ubound(SrcParamData%DP_Const_End) if (.not. allocated(DstParamData%DP_Const_End)) then allocate(DstParamData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3889,8 +3889,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DP_Const_End = SrcParamData%DP_Const_End end if if (allocated(SrcParamData%Mass_MG_End)) then - LB(1:1) = lbound(SrcParamData%Mass_MG_End, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Mass_MG_End, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Mass_MG_End) + UB(1:1) = ubound(SrcParamData%Mass_MG_End) if (.not. allocated(DstParamData%Mass_MG_End)) then allocate(DstParamData%Mass_MG_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3901,8 +3901,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End end if if (allocated(SrcParamData%AM_End)) then - LB(1:3) = lbound(SrcParamData%AM_End, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AM_End, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AM_End) + UB(1:3) = ubound(SrcParamData%AM_End) if (.not. allocated(DstParamData%AM_End)) then allocate(DstParamData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3914,8 +3914,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if DstParamData%NMOutputs = SrcParamData%NMOutputs if (allocated(SrcParamData%MOutLst)) then - LB(1:1) = lbound(SrcParamData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MOutLst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%MOutLst) + UB(1:1) = ubound(SrcParamData%MOutLst) if (.not. allocated(DstParamData%MOutLst)) then allocate(DstParamData%MOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3931,8 +3931,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if DstParamData%NJOutputs = SrcParamData%NJOutputs if (allocated(SrcParamData%JOutLst)) then - LB(1:1) = lbound(SrcParamData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%JOutLst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%JOutLst) + UB(1:1) = ubound(SrcParamData%JOutLst) if (.not. allocated(DstParamData%JOutLst)) then allocate(DstParamData%JOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3947,8 +3947,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3972,16 +3972,16 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) type(Morison_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%Members)) then - LB(1:1) = lbound(ParamData%Members, kind=B8Ki) - UB(1:1) = ubound(ParamData%Members, kind=B8Ki) + LB(1:1) = lbound(ParamData%Members) + UB(1:1) = ubound(ParamData%Members) do i1 = LB(1), UB(1) call Morison_DestroyMemberType(ParamData%Members(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4019,8 +4019,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%AM_End) end if if (allocated(ParamData%MOutLst)) then - LB(1:1) = lbound(ParamData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(ParamData%MOutLst, kind=B8Ki) + LB(1:1) = lbound(ParamData%MOutLst) + UB(1:1) = ubound(ParamData%MOutLst) do i1 = LB(1), UB(1) call Morison_DestroyMOutput(ParamData%MOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4028,8 +4028,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MOutLst) end if if (allocated(ParamData%JOutLst)) then - LB(1:1) = lbound(ParamData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(ParamData%JOutLst, kind=B8Ki) + LB(1:1) = lbound(ParamData%JOutLst) + UB(1:1) = ubound(ParamData%JOutLst) do i1 = LB(1), UB(1) call Morison_DestroyJOutput(ParamData%JOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4037,8 +4037,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%JOutLst) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4052,8 +4052,8 @@ subroutine Morison_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(Morison_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) @@ -4063,9 +4063,9 @@ subroutine Morison_PackParam(RF, Indata) call RegPack(RF, InData%NMembers) call RegPack(RF, allocated(InData%Members)) if (allocated(InData%Members)) then - call RegPackBounds(RF, 1, lbound(InData%Members, kind=B8Ki), ubound(InData%Members, kind=B8Ki)) - LB(1:1) = lbound(InData%Members, kind=B8Ki) - UB(1:1) = ubound(InData%Members, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Members), ubound(InData%Members)) + LB(1:1) = lbound(InData%Members) + UB(1:1) = ubound(InData%Members) do i1 = LB(1), UB(1) call Morison_PackMemberType(RF, InData%Members(i1)) end do @@ -4085,9 +4085,9 @@ subroutine Morison_PackParam(RF, Indata) call RegPack(RF, InData%NMOutputs) call RegPack(RF, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then - call RegPackBounds(RF, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(InData%MOutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) do i1 = LB(1), UB(1) call Morison_PackMOutput(RF, InData%MOutLst(i1)) end do @@ -4095,18 +4095,18 @@ subroutine Morison_PackParam(RF, Indata) call RegPack(RF, InData%NJOutputs) call RegPack(RF, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then - call RegPackBounds(RF, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(InData%JOutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) do i1 = LB(1), UB(1) call Morison_PackJOutput(RF, InData%JOutLst(i1)) end do end if call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -4128,8 +4128,8 @@ subroutine Morison_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -4284,7 +4284,7 @@ subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyOutput' @@ -4297,8 +4297,8 @@ subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4343,7 +4343,7 @@ subroutine Morison_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 4459e057da..7b4ddf2602 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -115,7 +115,7 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInitInput' @@ -125,8 +125,8 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -178,7 +178,7 @@ subroutine SS_Exc_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -214,14 +214,14 @@ subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -232,8 +232,8 @@ subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -274,7 +274,7 @@ subroutine SS_Exc_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -288,14 +288,14 @@ subroutine SS_Exc_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%x)) then - LB(1:1) = lbound(SrcContStateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) if (.not. allocated(DstContStateData%x)) then allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -332,7 +332,7 @@ subroutine SS_Exc_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -421,16 +421,16 @@ subroutine SS_Exc_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Exc_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -442,15 +442,15 @@ subroutine SS_Exc_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SS_Exc_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Exc_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -461,12 +461,12 @@ subroutine SS_Exc_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SS_Exc_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call SS_Exc_PackContState(RF, InData%xdot(i1)) end do @@ -477,12 +477,12 @@ subroutine SS_Exc_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call SS_Exc_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -543,7 +543,7 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyParam' @@ -553,8 +553,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%NBody = SrcParamData%NBody DstParamData%ExctnDisp = SrcParamData%ExctnDisp if (allocated(SrcParamData%spDOF)) then - LB(1:1) = lbound(SrcParamData%spDOF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%spDOF, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%spDOF) + UB(1:1) = ubound(SrcParamData%spDOF) if (.not. allocated(DstParamData%spDOF)) then allocate(DstParamData%spDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -565,8 +565,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%spDOF = SrcParamData%spDOF end if if (allocated(SrcParamData%A)) then - LB(1:2) = lbound(SrcParamData%A, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%A, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) if (.not. allocated(DstParamData%A)) then allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -577,8 +577,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%A = SrcParamData%A end if if (allocated(SrcParamData%B)) then - LB(1:1) = lbound(SrcParamData%B, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%B, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%B) + UB(1:1) = ubound(SrcParamData%B) if (.not. allocated(DstParamData%B)) then allocate(DstParamData%B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -589,8 +589,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%B = SrcParamData%B end if if (allocated(SrcParamData%C)) then - LB(1:2) = lbound(SrcParamData%C, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) if (.not. allocated(DstParamData%C)) then allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -658,7 +658,7 @@ subroutine SS_Exc_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -699,14 +699,14 @@ subroutine SS_Exc_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%PtfmPos)) then - LB(1:2) = lbound(SrcInputData%PtfmPos, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%PtfmPos, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%PtfmPos) + UB(1:2) = ubound(SrcInputData%PtfmPos) if (.not. allocated(DstInputData%PtfmPos)) then allocate(DstInputData%PtfmPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -743,7 +743,7 @@ subroutine SS_Exc_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -756,14 +756,14 @@ subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%y)) then - LB(1:1) = lbound(SrcOutputData%y, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%y, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) if (.not. allocated(DstOutputData%y)) then allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -774,8 +774,8 @@ subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er DstOutputData%y = SrcOutputData%y end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -816,7 +816,7 @@ subroutine SS_Exc_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 3f9c769378..aa51b5f25c 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -109,15 +109,15 @@ subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' DstInitInputData%InputFile = SrcInitInputData%InputFile if (allocated(SrcInitInputData%enabledDOFs)) then - LB(1:1) = lbound(SrcInitInputData%enabledDOFs, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%enabledDOFs, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%enabledDOFs) + UB(1:1) = ubound(SrcInitInputData%enabledDOFs) if (.not. allocated(DstInitInputData%enabledDOFs)) then allocate(DstInitInputData%enabledDOFs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -129,8 +129,8 @@ subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if DstInitInputData%NBody = SrcInitInputData%NBody if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -173,7 +173,7 @@ subroutine SS_Rad_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -189,14 +189,14 @@ subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -207,8 +207,8 @@ subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -249,7 +249,7 @@ subroutine SS_Rad_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -263,14 +263,14 @@ subroutine SS_Rad_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%x)) then - LB(1:1) = lbound(SrcContStateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) if (.not. allocated(DstContStateData%x)) then allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -307,7 +307,7 @@ subroutine SS_Rad_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -396,16 +396,16 @@ subroutine SS_Rad_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Rad_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Rad_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -417,15 +417,15 @@ subroutine SS_Rad_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SS_Rad_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Rad_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Rad_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -436,12 +436,12 @@ subroutine SS_Rad_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SS_Rad_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call SS_Rad_PackContState(RF, InData%xdot(i1)) end do @@ -452,12 +452,12 @@ subroutine SS_Rad_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call SS_Rad_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -507,15 +507,15 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%A)) then - LB(1:2) = lbound(SrcParamData%A, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%A, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) if (.not. allocated(DstParamData%A)) then allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -526,8 +526,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%A = SrcParamData%A end if if (allocated(SrcParamData%B)) then - LB(1:2) = lbound(SrcParamData%B, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%B, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%B) + UB(1:2) = ubound(SrcParamData%B) if (.not. allocated(DstParamData%B)) then allocate(DstParamData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -538,8 +538,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%B = SrcParamData%B end if if (allocated(SrcParamData%C)) then - LB(1:2) = lbound(SrcParamData%C, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) if (.not. allocated(DstParamData%C)) then allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -551,8 +551,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if DstParamData%numStates = SrcParamData%numStates if (allocated(SrcParamData%spdof)) then - LB(1:1) = lbound(SrcParamData%spdof, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%spdof, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%spdof) + UB(1:1) = ubound(SrcParamData%spdof) if (.not. allocated(DstParamData%spdof)) then allocate(DstParamData%spdof(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -605,7 +605,7 @@ subroutine SS_Rad_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -624,14 +624,14 @@ subroutine SS_Rad_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%dq)) then - LB(1:1) = lbound(SrcInputData%dq, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%dq, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%dq) + UB(1:1) = ubound(SrcInputData%dq) if (.not. allocated(DstInputData%dq)) then allocate(DstInputData%dq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -668,7 +668,7 @@ subroutine SS_Rad_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -681,14 +681,14 @@ subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%y)) then - LB(1:1) = lbound(SrcOutputData%y, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%y, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) if (.not. allocated(DstOutputData%y)) then allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -699,8 +699,8 @@ subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er DstOutputData%y = SrcOutputData%y end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -741,7 +741,7 @@ subroutine SS_Rad_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 34b16fdc49..d04c5a823b 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -164,7 +164,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS REAL(ReKi), ALLOCATABLE :: WAMITPer (:) ! Period components as ordered in the WAMIT output files (sec ) REAL(ReKi), ALLOCATABLE :: WAMITWvDir(:) ! Wave direction components as ordered in the WAMIT output files (degrees) - INTEGER :: I,iGrid,iX,iY,iHdg,iBdy ! Generic index + INTEGER :: I,iGrid,iX,iY,iHdg,iBdy,iStp ! Generic index INTEGER :: InsertInd ! The lowest sorted index whose associated frequency component is higher than the current frequency component -- this is to sort the frequency components from lowest to highest INTEGER :: J ! Generic index INTEGER :: K ! Generic index @@ -190,6 +190,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using integer(IntKi) :: iSub, jSub ! indices into the 6x6 sub-matrices used to redimensionalize the WAMIT data (Needed because NBodyMod=1 could have WAMIT matrices which are 6N x 6N) integer(IntKi) :: iBody ! WAMIT body index + real(ReKi) :: BdyPos0(3) ! Initial translational displacement of the WAMIT body real(R8Ki) :: orientation(3,3) ! Initial orientation of the WAMIT body real(R8Ki) :: theta(3) ! Euler angle rotations of the WAMIT body real(ReKi) :: WaveNmbr ! Frequency-dependent wave number @@ -1025,7 +1026,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END DO ELSE IF ( InitInp%PtfmYMod == 1 ) THEN IF ( (.not. EqualRealNos( HdroWvDir(1),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( HdroWvDir(NInpWvDir),REAL(180,SiKi))) ) THEN - ErrMsg2 = 'With PtfmYMod=1 in ElastoDyn or HydroDyn driver, we need the lowest and highest wave headings to be exactly -180 deg and 180 deg, respectively, in "' & + ErrMsg2 = 'With PtfmYMod=1, we need the lowest and highest wave headings to be exactly -180 deg and 180 deg, respectively, in "' & //TRIM(InitInp%WAMITFile)//'.3" (inclusive).' CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL Cleanup() @@ -1371,7 +1372,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS end if end if - IF ( (p%ExctnMod>0) .AND. (p%ExctnDisp==2) ) THEN ! Allocate array for filtered potential-flow body positions + IF ( (p%ExctnMod>0) .AND. (p%ExctnDisp==2) ) THEN ! Allocate and initialize array for filtered potential-flow body positions p%ExctnFiltConst = exp(-2.0*Pi*p%ExctnCutOff * Interval) ALLOCATE ( xd%BdyPosFilt(1:2, 1:p%NBody, 1:3) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN @@ -1379,7 +1380,16 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS CALL Cleanup() RETURN END IF - xd%BdyPosFilt = 0.0_ReKi + orientation = EulerConstructZYX(InitInp%PlatformPos(4:6)); + DO iBdy = 1,p%NBody + ! Initial WAMIT body position + BdyPos0 = InitInp%PlatformPos(1:3) & + + matmul((/InitInp%PtfmRefxt(iBdy),InitInp%PtfmRefyt(iBdy),InitInp%PtfmRefzt(iBdy)/),orientation) & + - (/InitInp%PtfmRefxt(iBdy),InitInp%PtfmRefyt(iBdy),InitInp%PtfmRefzt(iBdy)/) + DO iStp = 1,3 + xd%BdyPosFilt(1:2,iBdy,iStp) = BdyPos0(1:2) + END DO + END DO END IF ENDSELECT @@ -1985,7 +1995,7 @@ SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er END IF IF ( (ABS( WrapToPi(rotDisp(3)-u%PtfmRefY) ) > LrgAngle) .AND. FrstWarn_LrgY ) THEN ErrStat2 = ErrID_Severe - ErrMsg2 = 'Yaw angle of a potential-flow body relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff in ElastoDyn. Simulation continuing, but future warnings will be suppressed.' + ErrMsg2 = 'Yaw angle of a potential-flow body relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff. Simulation continuing, but future warnings will be suppressed.' call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FrstWarn_LrgY = .FALSE. END IF diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index df76292930..0d07cfe542 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -34,13 +34,14 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER ExctnMod - - - "" - typedef ^ ^ INTEGER ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - typedef ^ ^ ReKi ExctnCutOff - - - "Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] " Hz -typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn]" +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" typedef ^ ^ DbKi RdtnTMax - - - "" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "" - typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - typedef ^ ^ ReKi PtfmRefY - - - "Initial reference yaw offset" (rad) +typedef ^ ^ ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" # # # Define outputs from the initialization routine here: @@ -109,7 +110,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER ExctnMod - - - "" - typedef ^ ^ INTEGER ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - typedef ^ ^ ReKi ExctnCutOff - - - "Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] " Hz -typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn]" +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" typedef ^ ^ ReKi ExctnFiltConst - - - "Low-pass time filter constant computed from ExctnCutOff" typedef ^ ^ SiKi WaveExctn {:}{:}{:} - - "" - typedef ^ ^ SiKi WaveExctnGrid {:}{:}{:}{:}{:} - - "WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP Yaw, 5th: Force component for eac WAMIT Body" - diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index c2b948f610..ad3ec0d6f3 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -33,7 +33,7 @@ typedef ^ ^ ReKi Gravity typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - typedef ^ ^ ReKi PtfmRefY - - - "Initial reference yaw offset" (rad) -typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn]" +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" #[note: only one of MnDriff / NewmanApp / DiffQTF can be non-zero typedef ^ ^ INTEGER MnDrift - - - "Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use}" - @@ -74,7 +74,7 @@ typedef ^ ^ LOGICAL NewmanAppF typedef ^ ^ LOGICAL DiffQTFF - - - "Flag indicating the full difference QTF should be calculated" - typedef ^ ^ LOGICAL SumQTFF - - - "Flag indicating the full sum QTF should be calculated" - typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - -typedef ^ ^ INTEGER NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn]" +typedef ^ ^ INTEGER NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index f85c2c2b60..e4b8800d70 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -50,7 +50,7 @@ MODULE WAMIT2_Types TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Initial reference yaw offset [(rad)] - INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn] [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] INTEGER(IntKi) :: NewmanApp = 0_IntKi !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] INTEGER(IntKi) :: DiffQTF = 0_IntKi !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] @@ -83,7 +83,7 @@ MODULE WAMIT2_Types LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] - INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn] [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] END TYPE WAMIT2_ParameterType ! ======================= ! ========= WAMIT2_OutputType ======= @@ -101,7 +101,7 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_CopyInitInput' @@ -112,8 +112,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod if (allocated(SrcInitInputData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefxt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefxt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) if (.not. allocated(DstInitInputData%PtfmRefxt)) then allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -124,8 +124,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt end if if (allocated(SrcInitInputData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefyt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefyt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) if (.not. allocated(DstInitInputData%PtfmRefyt)) then allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -136,8 +136,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt end if if (allocated(SrcInitInputData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefzt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefzt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) if (.not. allocated(DstInitInputData%PtfmRefzt)) then allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -148,8 +148,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt end if if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -240,7 +240,7 @@ subroutine WAMIT2_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -293,15 +293,15 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%LastIndWave)) then - LB(1:1) = lbound(SrcMiscData%LastIndWave, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LastIndWave, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LastIndWave) + UB(1:1) = ubound(SrcMiscData%LastIndWave) if (.not. allocated(DstMiscData%LastIndWave)) then allocate(DstMiscData%LastIndWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -312,8 +312,8 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LastIndWave = SrcMiscData%LastIndWave end if if (allocated(SrcMiscData%F_Waves2)) then - LB(1:1) = lbound(SrcMiscData%F_Waves2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Waves2, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_Waves2) + UB(1:1) = ubound(SrcMiscData%F_Waves2) if (.not. allocated(DstMiscData%F_Waves2)) then allocate(DstMiscData%F_Waves2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -362,7 +362,7 @@ subroutine WAMIT2_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT2_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -377,7 +377,7 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_CopyParam' @@ -386,8 +386,8 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%NBody = SrcParamData%NBody DstParamData%NBodyMod = SrcParamData%NBodyMod if (allocated(SrcParamData%WaveExctn2Grid)) then - LB(1:5) = lbound(SrcParamData%WaveExctn2Grid, kind=B8Ki) - UB(1:5) = ubound(SrcParamData%WaveExctn2Grid, kind=B8Ki) + LB(1:5) = lbound(SrcParamData%WaveExctn2Grid) + UB(1:5) = ubound(SrcParamData%WaveExctn2Grid) if (.not. allocated(DstParamData%WaveExctn2Grid)) then allocate(DstParamData%WaveExctn2Grid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -454,7 +454,7 @@ subroutine WAMIT2_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT2_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackParam' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 6b585bcf2b..761b3130e2 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -54,13 +54,14 @@ MODULE WAMIT_Types INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] - INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn] [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Initial reference yaw offset [(rad)] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] END TYPE WAMIT_InitInputType ! ======================= ! ========= WAMIT_ContinuousStateType ======= @@ -122,7 +123,7 @@ MODULE WAMIT_Types INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] - INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn] [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] REAL(ReKi) :: ExctnFiltConst = 0.0_ReKi !< Low-pass time filter constant computed from ExctnCutOff [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveExctn !< [-] REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveExctnGrid !< WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP Yaw, 5th: Force component for eac WAMIT Body [-] @@ -164,7 +165,7 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyInitInput' @@ -174,8 +175,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod DstInitInputData%Gravity = SrcInitInputData%Gravity if (allocated(SrcInitInputData%PtfmVol0)) then - LB(1:1) = lbound(SrcInitInputData%PtfmVol0, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmVol0, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmVol0) + UB(1:1) = ubound(SrcInitInputData%PtfmVol0) if (.not. allocated(DstInitInputData%PtfmVol0)) then allocate(DstInitInputData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -188,8 +189,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN if (allocated(SrcInitInputData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefxt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefxt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) if (.not. allocated(DstInitInputData%PtfmRefxt)) then allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -200,8 +201,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt end if if (allocated(SrcInitInputData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefyt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefyt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) if (.not. allocated(DstInitInputData%PtfmRefyt)) then allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -212,8 +213,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt end if if (allocated(SrcInitInputData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefzt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefzt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) if (.not. allocated(DstInitInputData%PtfmRefzt)) then allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -224,8 +225,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt end if if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -236,8 +237,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot end if if (allocated(SrcInitInputData%PtfmCOBxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt) if (.not. allocated(DstInitInputData%PtfmCOBxt)) then allocate(DstInitInputData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -248,8 +249,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt end if if (allocated(SrcInitInputData%PtfmCOByt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmCOByt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmCOByt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmCOByt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOByt) if (.not. allocated(DstInitInputData%PtfmCOByt)) then allocate(DstInitInputData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -272,6 +273,7 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%PtfmYMod = SrcInitInputData%PtfmYMod DstInitInputData%PtfmRefY = SrcInitInputData%PtfmRefY + DstInitInputData%PlatformPos = SrcInitInputData%PlatformPos end subroutine subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -344,6 +346,7 @@ subroutine WAMIT_PackInitInput(RF, Indata) end if call RegPack(RF, InData%PtfmYMod) call RegPack(RF, InData%PtfmRefY) + call RegPack(RF, InData%PlatformPos) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -351,7 +354,7 @@ subroutine WAMIT_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -397,6 +400,7 @@ subroutine WAMIT_UnPackInitInput(RF, OutData) end if call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmRefY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WAMIT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -465,7 +469,7 @@ subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyDiscState' @@ -481,8 +485,8 @@ subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDiscStateData%BdyPosFilt)) then - LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt) + UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt) if (.not. allocated(DstDiscStateData%BdyPosFilt)) then allocate(DstDiscStateData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -530,7 +534,7 @@ subroutine WAMIT_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackDiscState' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -666,7 +670,7 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyMisc' @@ -674,8 +678,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstMiscData%LastIndWave = SrcMiscData%LastIndWave if (allocated(SrcMiscData%F_HS)) then - LB(1:1) = lbound(SrcMiscData%F_HS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_HS, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_HS) + UB(1:1) = ubound(SrcMiscData%F_HS) if (.not. allocated(DstMiscData%F_HS)) then allocate(DstMiscData%F_HS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -686,8 +690,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_HS = SrcMiscData%F_HS end if if (allocated(SrcMiscData%F_Waves1)) then - LB(1:1) = lbound(SrcMiscData%F_Waves1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Waves1, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_Waves1) + UB(1:1) = ubound(SrcMiscData%F_Waves1) if (.not. allocated(DstMiscData%F_Waves1)) then allocate(DstMiscData%F_Waves1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -698,8 +702,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 end if if (allocated(SrcMiscData%F_Rdtn)) then - LB(1:1) = lbound(SrcMiscData%F_Rdtn, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Rdtn, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_Rdtn) + UB(1:1) = ubound(SrcMiscData%F_Rdtn) if (.not. allocated(DstMiscData%F_Rdtn)) then allocate(DstMiscData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -710,8 +714,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn end if if (allocated(SrcMiscData%F_PtfmAM)) then - LB(1:1) = lbound(SrcMiscData%F_PtfmAM, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_PtfmAM, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_PtfmAM) + UB(1:1) = ubound(SrcMiscData%F_PtfmAM) if (.not. allocated(DstMiscData%F_PtfmAM)) then allocate(DstMiscData%F_PtfmAM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -823,7 +827,7 @@ subroutine WAMIT_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -850,7 +854,7 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyParam' @@ -859,8 +863,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%NBody = SrcParamData%NBody DstParamData%NBodyMod = SrcParamData%NBodyMod if (allocated(SrcParamData%F_HS_Moment_Offset)) then - LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset) + UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset) if (.not. allocated(DstParamData%F_HS_Moment_Offset)) then allocate(DstParamData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -871,8 +875,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset end if if (allocated(SrcParamData%HdroAdMsI)) then - LB(1:2) = lbound(SrcParamData%HdroAdMsI, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%HdroAdMsI, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%HdroAdMsI) + UB(1:2) = ubound(SrcParamData%HdroAdMsI) if (.not. allocated(DstParamData%HdroAdMsI)) then allocate(DstParamData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -883,8 +887,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI end if if (allocated(SrcParamData%HdroSttc)) then - LB(1:2) = lbound(SrcParamData%HdroSttc, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%HdroSttc, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%HdroSttc) + UB(1:2) = ubound(SrcParamData%HdroSttc) if (.not. allocated(DstParamData%HdroSttc)) then allocate(DstParamData%HdroSttc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -901,8 +905,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%NExctnHdg = SrcParamData%NExctnHdg DstParamData%ExctnFiltConst = SrcParamData%ExctnFiltConst if (allocated(SrcParamData%WaveExctn)) then - LB(1:3) = lbound(SrcParamData%WaveExctn, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%WaveExctn, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%WaveExctn) + UB(1:3) = ubound(SrcParamData%WaveExctn) if (.not. allocated(DstParamData%WaveExctn)) then allocate(DstParamData%WaveExctn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -913,8 +917,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveExctn = SrcParamData%WaveExctn end if if (allocated(SrcParamData%WaveExctnGrid)) then - LB(1:5) = lbound(SrcParamData%WaveExctnGrid, kind=B8Ki) - UB(1:5) = ubound(SrcParamData%WaveExctnGrid, kind=B8Ki) + LB(1:5) = lbound(SrcParamData%WaveExctnGrid) + UB(1:5) = ubound(SrcParamData%WaveExctnGrid) if (.not. allocated(DstParamData%WaveExctnGrid)) then allocate(DstParamData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1015,7 +1019,7 @@ subroutine WAMIT_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackParam' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 7fb06b6894..e8cbce9737 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -245,7 +245,7 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceD_CopyInputFile' ErrStat = ErrID_None @@ -262,8 +262,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Seed2 = SrcInputFileData%Seed2 DstInputFileData%NumLegs = SrcInputFileData%NumLegs if (allocated(SrcInputFileData%LegPosX)) then - LB(1:1) = lbound(SrcInputFileData%LegPosX, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LegPosX, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LegPosX) + UB(1:1) = ubound(SrcInputFileData%LegPosX) if (.not. allocated(DstInputFileData%LegPosX)) then allocate(DstInputFileData%LegPosX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -274,8 +274,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LegPosX = SrcInputFileData%LegPosX end if if (allocated(SrcInputFileData%LegPosY)) then - LB(1:1) = lbound(SrcInputFileData%LegPosY, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LegPosY, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LegPosY) + UB(1:1) = ubound(SrcInputFileData%LegPosY) if (.not. allocated(DstInputFileData%LegPosY)) then allocate(DstInputFileData%LegPosY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -286,8 +286,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LegPosY = SrcInputFileData%LegPosY end if if (allocated(SrcInputFileData%StrWd)) then - LB(1:1) = lbound(SrcInputFileData%StrWd, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%StrWd, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%StrWd) + UB(1:1) = ubound(SrcInputFileData%StrWd) if (.not. allocated(DstInputFileData%StrWd)) then allocate(DstInputFileData%StrWd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -435,7 +435,7 @@ subroutine IceD_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -563,15 +563,15 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -582,8 +582,8 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -640,7 +640,7 @@ subroutine IceD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -774,8 +774,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyOtherState' @@ -783,8 +783,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E ErrMsg = '' DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 if (allocated(SrcOtherStateData%Nc)) then - LB(1:1) = lbound(SrcOtherStateData%Nc, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Nc, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Nc) + UB(1:1) = ubound(SrcOtherStateData%Nc) if (.not. allocated(DstOtherStateData%Nc)) then allocate(DstOtherStateData%Nc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -795,8 +795,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Nc = SrcOtherStateData%Nc end if if (allocated(SrcOtherStateData%Psum)) then - LB(1:1) = lbound(SrcOtherStateData%Psum, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Psum, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Psum) + UB(1:1) = ubound(SrcOtherStateData%Psum) if (.not. allocated(DstOtherStateData%Psum)) then allocate(DstOtherStateData%Psum(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -807,8 +807,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Psum = SrcOtherStateData%Psum end if if (allocated(SrcOtherStateData%IceTthNo)) then - LB(1:1) = lbound(SrcOtherStateData%IceTthNo, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%IceTthNo, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%IceTthNo) + UB(1:1) = ubound(SrcOtherStateData%IceTthNo) if (.not. allocated(DstOtherStateData%IceTthNo)) then allocate(DstOtherStateData%IceTthNo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -823,8 +823,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Splitf = SrcOtherStateData%Splitf DstOtherStateData%dxc = SrcOtherStateData%dxc if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -845,8 +845,8 @@ subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(IceD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_DestroyOtherState' @@ -862,8 +862,8 @@ subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%IceTthNo) end if if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call IceD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -876,8 +876,8 @@ subroutine IceD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(IceD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%IceTthNo2) call RegPackAlloc(RF, InData%Nc) @@ -889,9 +889,9 @@ subroutine IceD_PackOtherState(RF, Indata) call RegPack(RF, InData%dxc) call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call IceD_PackContState(RF, InData%xdot(i1)) end do @@ -904,8 +904,8 @@ subroutine IceD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -939,7 +939,7 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceD_CopyParam' ErrStat = ErrID_None @@ -959,8 +959,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%method = SrcParamData%method DstParamData%TmStep = SrcParamData%TmStep if (allocated(SrcParamData%OutName)) then - LB(1:1) = lbound(SrcParamData%OutName, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutName, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutName) + UB(1:1) = ubound(SrcParamData%OutName) if (.not. allocated(DstParamData%OutName)) then allocate(DstParamData%OutName(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -971,8 +971,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutName = SrcParamData%OutName end if if (allocated(SrcParamData%OutUnit)) then - LB(1:1) = lbound(SrcParamData%OutUnit, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutUnit, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutUnit) + UB(1:1) = ubound(SrcParamData%OutUnit) if (.not. allocated(DstParamData%OutUnit)) then allocate(DstParamData%OutUnit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -996,8 +996,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Pitch = SrcParamData%Pitch DstParamData%Kice2 = SrcParamData%Kice2 if (allocated(SrcParamData%rdmFm)) then - LB(1:1) = lbound(SrcParamData%rdmFm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmFm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmFm) + UB(1:1) = ubound(SrcParamData%rdmFm) if (.not. allocated(DstParamData%rdmFm)) then allocate(DstParamData%rdmFm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1008,8 +1008,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmFm = SrcParamData%rdmFm end if if (allocated(SrcParamData%rdmt0)) then - LB(1:1) = lbound(SrcParamData%rdmt0, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmt0, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmt0) + UB(1:1) = ubound(SrcParamData%rdmt0) if (.not. allocated(DstParamData%rdmt0)) then allocate(DstParamData%rdmt0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1020,8 +1020,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmt0 = SrcParamData%rdmt0 end if if (allocated(SrcParamData%rdmtm)) then - LB(1:1) = lbound(SrcParamData%rdmtm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmtm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmtm) + UB(1:1) = ubound(SrcParamData%rdmtm) if (.not. allocated(DstParamData%rdmtm)) then allocate(DstParamData%rdmtm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1032,8 +1032,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmtm = SrcParamData%rdmtm end if if (allocated(SrcParamData%rdmDm)) then - LB(1:1) = lbound(SrcParamData%rdmDm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmDm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmDm) + UB(1:1) = ubound(SrcParamData%rdmDm) if (.not. allocated(DstParamData%rdmDm)) then allocate(DstParamData%rdmDm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1044,8 +1044,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmDm = SrcParamData%rdmDm end if if (allocated(SrcParamData%rdmP)) then - LB(1:1) = lbound(SrcParamData%rdmP, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmP, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmP) + UB(1:1) = ubound(SrcParamData%rdmP) if (.not. allocated(DstParamData%rdmP)) then allocate(DstParamData%rdmP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1056,8 +1056,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmP = SrcParamData%rdmP end if if (allocated(SrcParamData%rdmKi)) then - LB(1:1) = lbound(SrcParamData%rdmKi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmKi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmKi) + UB(1:1) = ubound(SrcParamData%rdmKi) if (.not. allocated(DstParamData%rdmKi)) then allocate(DstParamData%rdmKi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1071,8 +1071,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Kice = SrcParamData%Kice DstParamData%Delmax = SrcParamData%Delmax if (allocated(SrcParamData%Y0)) then - LB(1:1) = lbound(SrcParamData%Y0, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Y0, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Y0) + UB(1:1) = ubound(SrcParamData%Y0) if (.not. allocated(DstParamData%Y0)) then allocate(DstParamData%Y0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1083,8 +1083,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0 = SrcParamData%Y0 end if if (allocated(SrcParamData%ContPrfl)) then - LB(1:1) = lbound(SrcParamData%ContPrfl, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ContPrfl, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ContPrfl) + UB(1:1) = ubound(SrcParamData%ContPrfl) if (.not. allocated(DstParamData%ContPrfl)) then allocate(DstParamData%ContPrfl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1223,7 +1223,7 @@ subroutine IceD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1339,7 +1339,7 @@ subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyOutput' @@ -1349,8 +1349,8 @@ subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1392,7 +1392,7 @@ subroutine IceD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 17720c331b..8abe5a27dc 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -178,15 +178,15 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceFloe_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -197,8 +197,8 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -253,7 +253,7 @@ subroutine IceFloe_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(IceFloe_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -421,14 +421,14 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceFloe_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%loadSeries)) then - LB(1:2) = lbound(SrcParamData%loadSeries, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%loadSeries, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%loadSeries) + UB(1:2) = ubound(SrcParamData%loadSeries) if (.not. allocated(DstParamData%loadSeries)) then allocate(DstParamData%loadSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -449,8 +449,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%dt = SrcParamData%dt DstParamData%rampTime = SrcParamData%rampTime if (allocated(SrcParamData%legX)) then - LB(1:1) = lbound(SrcParamData%legX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%legX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%legX) + UB(1:1) = ubound(SrcParamData%legX) if (.not. allocated(DstParamData%legX)) then allocate(DstParamData%legX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -461,8 +461,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%legX = SrcParamData%legX end if if (allocated(SrcParamData%legY)) then - LB(1:1) = lbound(SrcParamData%legY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%legY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%legY) + UB(1:1) = ubound(SrcParamData%legY) if (.not. allocated(DstParamData%legY)) then allocate(DstParamData%legY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -473,8 +473,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%legY = SrcParamData%legY end if if (allocated(SrcParamData%ks)) then - LB(1:1) = lbound(SrcParamData%ks, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ks, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ks) + UB(1:1) = ubound(SrcParamData%ks) if (.not. allocated(DstParamData%ks)) then allocate(DstParamData%ks(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -543,7 +543,7 @@ subroutine IceFloe_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(IceFloe_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -620,7 +620,7 @@ subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceFloe_CopyOutput' @@ -630,8 +630,8 @@ subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -673,7 +673,7 @@ subroutine IceFloe_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(IceFloe_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index ecb083f2f2..6a5e024e7b 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -173,7 +173,7 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' ErrStat = ErrID_None @@ -182,8 +182,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize if (allocated(SrcUniformFieldTypeData%Time)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%Time, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%Time, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%Time) + UB(1:1) = ubound(SrcUniformFieldTypeData%Time) if (.not. allocated(DstUniformFieldTypeData%Time)) then allocate(DstUniformFieldTypeData%Time(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -194,8 +194,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time end if if (allocated(SrcUniformFieldTypeData%VelH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelH, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelH, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelH) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelH) if (.not. allocated(DstUniformFieldTypeData%VelH)) then allocate(DstUniformFieldTypeData%VelH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -206,8 +206,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH end if if (allocated(SrcUniformFieldTypeData%VelHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot) if (.not. allocated(DstUniformFieldTypeData%VelHDot)) then allocate(DstUniformFieldTypeData%VelHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -218,8 +218,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot end if if (allocated(SrcUniformFieldTypeData%VelV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelV, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelV, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelV) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelV) if (.not. allocated(DstUniformFieldTypeData%VelV)) then allocate(DstUniformFieldTypeData%VelV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -230,8 +230,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV end if if (allocated(SrcUniformFieldTypeData%VelVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot) if (.not. allocated(DstUniformFieldTypeData%VelVDot)) then allocate(DstUniformFieldTypeData%VelVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -242,8 +242,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot end if if (allocated(SrcUniformFieldTypeData%VelGust)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust) if (.not. allocated(DstUniformFieldTypeData%VelGust)) then allocate(DstUniformFieldTypeData%VelGust(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -254,8 +254,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust end if if (allocated(SrcUniformFieldTypeData%VelGustDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot) if (.not. allocated(DstUniformFieldTypeData%VelGustDot)) then allocate(DstUniformFieldTypeData%VelGustDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -266,8 +266,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot end if if (allocated(SrcUniformFieldTypeData%AngleH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH) if (.not. allocated(DstUniformFieldTypeData%AngleH)) then allocate(DstUniformFieldTypeData%AngleH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -278,8 +278,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH end if if (allocated(SrcUniformFieldTypeData%AngleHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot) if (.not. allocated(DstUniformFieldTypeData%AngleHDot)) then allocate(DstUniformFieldTypeData%AngleHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -290,8 +290,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot end if if (allocated(SrcUniformFieldTypeData%AngleV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV) if (.not. allocated(DstUniformFieldTypeData%AngleV)) then allocate(DstUniformFieldTypeData%AngleV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -302,8 +302,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV end if if (allocated(SrcUniformFieldTypeData%AngleVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot) if (.not. allocated(DstUniformFieldTypeData%AngleVDot)) then allocate(DstUniformFieldTypeData%AngleVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -314,8 +314,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot end if if (allocated(SrcUniformFieldTypeData%ShrH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH) if (.not. allocated(DstUniformFieldTypeData%ShrH)) then allocate(DstUniformFieldTypeData%ShrH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -326,8 +326,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH end if if (allocated(SrcUniformFieldTypeData%ShrHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot) if (.not. allocated(DstUniformFieldTypeData%ShrHDot)) then allocate(DstUniformFieldTypeData%ShrHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -338,8 +338,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot end if if (allocated(SrcUniformFieldTypeData%ShrV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV) if (.not. allocated(DstUniformFieldTypeData%ShrV)) then allocate(DstUniformFieldTypeData%ShrV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -350,8 +350,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV end if if (allocated(SrcUniformFieldTypeData%ShrVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot) if (.not. allocated(DstUniformFieldTypeData%ShrVDot)) then allocate(DstUniformFieldTypeData%ShrVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -362,8 +362,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot end if if (allocated(SrcUniformFieldTypeData%LinShrV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV) if (.not. allocated(DstUniformFieldTypeData%LinShrV)) then allocate(DstUniformFieldTypeData%LinShrV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -374,8 +374,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV end if if (allocated(SrcUniformFieldTypeData%LinShrVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot) if (.not. allocated(DstUniformFieldTypeData%LinShrVDot)) then allocate(DstUniformFieldTypeData%LinShrVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -479,7 +479,7 @@ subroutine IfW_FlowField_UnPackUniformFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(UniformFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -606,7 +606,7 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid3DFieldType' ErrStat = ErrID_None @@ -619,8 +619,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength if (allocated(SrcGrid3DFieldTypeData%Vel)) then - LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel, kind=B8Ki) - UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel, kind=B8Ki) + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel) if (.not. allocated(DstGrid3DFieldTypeData%Vel)) then allocate(DstGrid3DFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -631,8 +631,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel end if if (allocated(SrcGrid3DFieldTypeData%Acc)) then - LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc, kind=B8Ki) - UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc, kind=B8Ki) + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc) if (.not. allocated(DstGrid3DFieldTypeData%Acc)) then allocate(DstGrid3DFieldTypeData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -643,8 +643,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc end if if (allocated(SrcGrid3DFieldTypeData%VelTower)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower, kind=B8Ki) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower, kind=B8Ki) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower) if (.not. allocated(DstGrid3DFieldTypeData%VelTower)) then allocate(DstGrid3DFieldTypeData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -655,8 +655,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower end if if (allocated(SrcGrid3DFieldTypeData%AccTower)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower, kind=B8Ki) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower, kind=B8Ki) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower) if (.not. allocated(DstGrid3DFieldTypeData%AccTower)) then allocate(DstGrid3DFieldTypeData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -667,8 +667,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower end if if (allocated(SrcGrid3DFieldTypeData%VelAvg)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg, kind=B8Ki) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg, kind=B8Ki) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg) if (.not. allocated(DstGrid3DFieldTypeData%VelAvg)) then allocate(DstGrid3DFieldTypeData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -679,8 +679,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg end if if (allocated(SrcGrid3DFieldTypeData%AccAvg)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg, kind=B8Ki) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg, kind=B8Ki) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg) if (.not. allocated(DstGrid3DFieldTypeData%AccAvg)) then allocate(DstGrid3DFieldTypeData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -788,7 +788,7 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(Grid3DFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -835,7 +835,7 @@ subroutine IfW_FlowField_CopyGrid4DFieldType(SrcGrid4DFieldTypeData, DstGrid4DFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid4DFieldType' ErrStat = ErrID_None @@ -877,7 +877,7 @@ subroutine IfW_FlowField_UnPackGrid4DFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(Grid4DFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -897,14 +897,14 @@ subroutine IfW_FlowField_CopyPointsFieldType(SrcPointsFieldTypeData, DstPointsFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyPointsFieldType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcPointsFieldTypeData%Vel)) then - LB(1:2) = lbound(SrcPointsFieldTypeData%Vel, kind=B8Ki) - UB(1:2) = ubound(SrcPointsFieldTypeData%Vel, kind=B8Ki) + LB(1:2) = lbound(SrcPointsFieldTypeData%Vel) + UB(1:2) = ubound(SrcPointsFieldTypeData%Vel) if (.not. allocated(DstPointsFieldTypeData%Vel)) then allocate(DstPointsFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -941,7 +941,7 @@ subroutine IfW_FlowField_UnPackPointsFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(PointsFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackPointsFieldType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index f329437c4d..0832c35c71 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -651,7 +651,7 @@ subroutine InflowWind_IO_CopyGrid4D_InitInputType(SrcGrid4D_InitInputTypeData, D integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid4D_InitInputType' ErrStat = ErrID_None @@ -689,7 +689,7 @@ subroutine InflowWind_IO_UnPackGrid4D_InitInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Grid4D_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index a900b921c2..3cf9eddfb0 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -238,7 +238,7 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInputFile' @@ -251,8 +251,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic DstInputFileData%NWindVel = SrcInputFileData%NWindVel if (allocated(SrcInputFileData%WindVxiList)) then - LB(1:1) = lbound(SrcInputFileData%WindVxiList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WindVxiList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WindVxiList) + UB(1:1) = ubound(SrcInputFileData%WindVxiList) if (.not. allocated(DstInputFileData%WindVxiList)) then allocate(DstInputFileData%WindVxiList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -263,8 +263,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList end if if (allocated(SrcInputFileData%WindVyiList)) then - LB(1:1) = lbound(SrcInputFileData%WindVyiList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WindVyiList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WindVyiList) + UB(1:1) = ubound(SrcInputFileData%WindVyiList) if (.not. allocated(DstInputFileData%WindVyiList)) then allocate(DstInputFileData%WindVyiList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -275,8 +275,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList end if if (allocated(SrcInputFileData%WindVziList)) then - LB(1:1) = lbound(SrcInputFileData%WindVziList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WindVziList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WindVziList) + UB(1:1) = ubound(SrcInputFileData%WindVziList) if (.not. allocated(DstInputFileData%WindVziList)) then allocate(DstInputFileData%WindVziList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -310,8 +310,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -326,8 +326,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos if (allocated(SrcInputFileData%FocalDistanceX)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceX, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceX, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceX) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceX) if (.not. allocated(DstInputFileData%FocalDistanceX)) then allocate(DstInputFileData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -338,8 +338,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX end if if (allocated(SrcInputFileData%FocalDistanceY)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceY, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceY, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceY) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceY) if (.not. allocated(DstInputFileData%FocalDistanceY)) then allocate(DstInputFileData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -350,8 +350,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY end if if (allocated(SrcInputFileData%FocalDistanceZ)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ) if (.not. allocated(DstInputFileData%FocalDistanceZ)) then allocate(DstInputFileData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -463,7 +463,7 @@ subroutine InflowWind_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -640,15 +640,15 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -659,8 +659,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -677,8 +677,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -689,8 +689,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -701,8 +701,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -713,8 +713,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -725,8 +725,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -811,7 +811,7 @@ subroutine InflowWind_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -853,8 +853,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyParam' @@ -863,8 +863,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%RootFileName = SrcParamData%RootFileName DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%WindViXYZprime)) then - LB(1:2) = lbound(SrcParamData%WindViXYZprime, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%WindViXYZprime, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%WindViXYZprime) + UB(1:2) = ubound(SrcParamData%WindViXYZprime) if (.not. allocated(DstParamData%WindViXYZprime)) then allocate(DstParamData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -875,8 +875,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime end if if (allocated(SrcParamData%WindViXYZ)) then - LB(1:2) = lbound(SrcParamData%WindViXYZ, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%WindViXYZ, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%WindViXYZ) + UB(1:2) = ubound(SrcParamData%WindViXYZ) if (.not. allocated(DstParamData%WindViXYZ)) then allocate(DstParamData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -899,8 +899,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E if (ErrStat >= AbortErrLev) return end if if (allocated(SrcParamData%PositionAvg)) then - LB(1:2) = lbound(SrcParamData%PositionAvg, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PositionAvg, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PositionAvg) + UB(1:2) = ubound(SrcParamData%PositionAvg) if (.not. allocated(DstParamData%PositionAvg)) then allocate(DstParamData%PositionAvg(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -913,8 +913,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%NWindVel = SrcParamData%NWindVel DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -929,8 +929,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E end do end if if (allocated(SrcParamData%OutParamLinIndx)) then - LB(1:2) = lbound(SrcParamData%OutParamLinIndx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%OutParamLinIndx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) if (.not. allocated(DstParamData%OutParamLinIndx)) then allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -950,8 +950,8 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) type(InflowWind_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_DestroyParam' @@ -973,8 +973,8 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%PositionAvg) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -992,8 +992,8 @@ subroutine InflowWind_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(InflowWind_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%RootFileName) @@ -1012,9 +1012,9 @@ subroutine InflowWind_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1029,8 +1029,8 @@ subroutine InflowWind_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1085,15 +1085,15 @@ subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%PositionXYZ)) then - LB(1:2) = lbound(SrcInputData%PositionXYZ, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%PositionXYZ, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%PositionXYZ) + UB(1:2) = ubound(SrcInputData%PositionXYZ) if (.not. allocated(DstInputData%PositionXYZ)) then allocate(DstInputData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1142,7 +1142,7 @@ subroutine InflowWind_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1158,15 +1158,15 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%VelocityUVW)) then - LB(1:2) = lbound(SrcOutputData%VelocityUVW, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%VelocityUVW, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%VelocityUVW) + UB(1:2) = ubound(SrcOutputData%VelocityUVW) if (.not. allocated(DstOutputData%VelocityUVW)) then allocate(DstOutputData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1177,8 +1177,8 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW end if if (allocated(SrcOutputData%AccelUVW)) then - LB(1:2) = lbound(SrcOutputData%AccelUVW, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%AccelUVW, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%AccelUVW) + UB(1:2) = ubound(SrcOutputData%AccelUVW) if (.not. allocated(DstOutputData%AccelUVW)) then allocate(DstOutputData%AccelUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1189,8 +1189,8 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat DstOutputData%AccelUVW = SrcOutputData%AccelUVW end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1247,7 +1247,7 @@ subroutine InflowWind_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1417,15 +1417,15 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1436,8 +1436,8 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%WindViUVW)) then - LB(1:2) = lbound(SrcMiscData%WindViUVW, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindViUVW, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%WindViUVW) + UB(1:2) = ubound(SrcMiscData%WindViUVW) if (.not. allocated(DstMiscData%WindViUVW)) then allocate(DstMiscData%WindViUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1448,8 +1448,8 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%WindViUVW = SrcMiscData%WindViUVW end if if (allocated(SrcMiscData%WindAiUVW)) then - LB(1:2) = lbound(SrcMiscData%WindAiUVW, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindAiUVW, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%WindAiUVW) + UB(1:2) = ubound(SrcMiscData%WindAiUVW) if (.not. allocated(DstMiscData%WindAiUVW)) then allocate(DstMiscData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1526,7 +1526,7 @@ subroutine InflowWind_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 001121953e..4386b2bfbe 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -235,7 +235,7 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Lidar_CopyParam' ErrStat = ErrID_None @@ -256,8 +256,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ DstParamData%NumBeam = SrcParamData%NumBeam if (allocated(SrcParamData%FocalDistanceX)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FocalDistanceX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FocalDistanceX) + UB(1:1) = ubound(SrcParamData%FocalDistanceX) if (.not. allocated(DstParamData%FocalDistanceX)) then allocate(DstParamData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -268,8 +268,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX end if if (allocated(SrcParamData%FocalDistanceY)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FocalDistanceY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FocalDistanceY) + UB(1:1) = ubound(SrcParamData%FocalDistanceY) if (.not. allocated(DstParamData%FocalDistanceY)) then allocate(DstParamData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -280,8 +280,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY end if if (allocated(SrcParamData%FocalDistanceZ)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceZ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FocalDistanceZ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FocalDistanceZ) + UB(1:1) = ubound(SrcParamData%FocalDistanceZ) if (.not. allocated(DstParamData%FocalDistanceZ)) then allocate(DstParamData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -292,8 +292,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ end if if (allocated(SrcParamData%MsrPosition)) then - LB(1:2) = lbound(SrcParamData%MsrPosition, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MsrPosition, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MsrPosition) + UB(1:2) = ubound(SrcParamData%MsrPosition) if (.not. allocated(DstParamData%MsrPosition)) then allocate(DstParamData%MsrPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -367,7 +367,7 @@ subroutine Lidar_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Lidar_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -643,14 +643,14 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Lidar_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%LidSpeed)) then - LB(1:1) = lbound(SrcOutputData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%LidSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%LidSpeed) + UB(1:1) = ubound(SrcOutputData%LidSpeed) if (.not. allocated(DstOutputData%LidSpeed)) then allocate(DstOutputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -661,8 +661,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%LidSpeed = SrcOutputData%LidSpeed end if if (allocated(SrcOutputData%WtTrunc)) then - LB(1:1) = lbound(SrcOutputData%WtTrunc, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WtTrunc, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WtTrunc) + UB(1:1) = ubound(SrcOutputData%WtTrunc) if (.not. allocated(DstOutputData%WtTrunc)) then allocate(DstOutputData%WtTrunc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -673,8 +673,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%WtTrunc = SrcOutputData%WtTrunc end if if (allocated(SrcOutputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%MsrPositionsX, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%MsrPositionsX) + UB(1:1) = ubound(SrcOutputData%MsrPositionsX) if (.not. allocated(DstOutputData%MsrPositionsX)) then allocate(DstOutputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -685,8 +685,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX end if if (allocated(SrcOutputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%MsrPositionsY, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%MsrPositionsY) + UB(1:1) = ubound(SrcOutputData%MsrPositionsY) if (.not. allocated(DstOutputData%MsrPositionsY)) then allocate(DstOutputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -697,8 +697,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY end if if (allocated(SrcOutputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%MsrPositionsZ, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%MsrPositionsZ) + UB(1:1) = ubound(SrcOutputData%MsrPositionsZ) if (.not. allocated(DstOutputData%MsrPositionsZ)) then allocate(DstOutputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -751,7 +751,7 @@ subroutine Lidar_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Lidar_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/lindyn/src/LinDyn_Types.f90 b/modules/lindyn/src/LinDyn_Types.f90 index 93ad8d48c2..28cbce7930 100644 --- a/modules/lindyn/src/LinDyn_Types.f90 +++ b/modules/lindyn/src/LinDyn_Types.f90 @@ -137,7 +137,7 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyInitInput' ErrStat = ErrID_None @@ -145,8 +145,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%dt = SrcInitInputData%dt DstInitInputData%IntMethod = SrcInitInputData%IntMethod if (allocated(SrcInitInputData%MM)) then - LB(1:2) = lbound(SrcInitInputData%MM, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%MM, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%MM) + UB(1:2) = ubound(SrcInitInputData%MM) if (.not. allocated(DstInitInputData%MM)) then allocate(DstInitInputData%MM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -157,8 +157,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%MM = SrcInitInputData%MM end if if (allocated(SrcInitInputData%CC)) then - LB(1:2) = lbound(SrcInitInputData%CC, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%CC, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%CC) + UB(1:2) = ubound(SrcInitInputData%CC) if (.not. allocated(DstInitInputData%CC)) then allocate(DstInitInputData%CC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -169,8 +169,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%CC = SrcInitInputData%CC end if if (allocated(SrcInitInputData%KK)) then - LB(1:2) = lbound(SrcInitInputData%KK, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%KK, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%KK) + UB(1:2) = ubound(SrcInitInputData%KK) if (.not. allocated(DstInitInputData%KK)) then allocate(DstInitInputData%KK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -181,8 +181,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%KK = SrcInitInputData%KK end if if (allocated(SrcInitInputData%x0)) then - LB(1:1) = lbound(SrcInitInputData%x0, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%x0, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%x0) + UB(1:1) = ubound(SrcInitInputData%x0) if (.not. allocated(DstInitInputData%x0)) then allocate(DstInitInputData%x0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -193,8 +193,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%x0 = SrcInitInputData%x0 end if if (allocated(SrcInitInputData%xd0)) then - LB(1:1) = lbound(SrcInitInputData%xd0, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%xd0, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%xd0) + UB(1:1) = ubound(SrcInitInputData%xd0) if (.not. allocated(DstInitInputData%xd0)) then allocate(DstInitInputData%xd0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -205,8 +205,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%xd0 = SrcInitInputData%xd0 end if if (allocated(SrcInitInputData%activeDOFs)) then - LB(1:1) = lbound(SrcInitInputData%activeDOFs, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%activeDOFs, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%activeDOFs) + UB(1:1) = ubound(SrcInitInputData%activeDOFs) if (.not. allocated(DstInitInputData%activeDOFs)) then allocate(DstInitInputData%activeDOFs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -218,8 +218,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if DstInitInputData%prefix = SrcInitInputData%prefix if (allocated(SrcInitInputData%DOFsNames)) then - LB(1:1) = lbound(SrcInitInputData%DOFsNames, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%DOFsNames, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%DOFsNames) + UB(1:1) = ubound(SrcInitInputData%DOFsNames) if (.not. allocated(DstInitInputData%DOFsNames)) then allocate(DstInitInputData%DOFsNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -230,8 +230,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%DOFsNames = SrcInitInputData%DOFsNames end if if (allocated(SrcInitInputData%DOFsUnits)) then - LB(1:1) = lbound(SrcInitInputData%DOFsUnits, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%DOFsUnits, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%DOFsUnits) + UB(1:1) = ubound(SrcInitInputData%DOFsUnits) if (.not. allocated(DstInitInputData%DOFsUnits)) then allocate(DstInitInputData%DOFsUnits(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -303,7 +303,7 @@ subroutine LD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -328,7 +328,7 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_CopyInitOutput' @@ -338,8 +338,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -350,8 +350,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -362,8 +362,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -374,8 +374,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -386,8 +386,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -398,8 +398,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -410,8 +410,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -422,8 +422,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -434,8 +434,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -446,8 +446,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -525,7 +525,7 @@ subroutine LD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -548,14 +548,14 @@ subroutine LD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%q)) then - LB(1:1) = lbound(SrcContStateData%q, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%q, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%q) + UB(1:1) = ubound(SrcContStateData%q) if (.not. allocated(DstContStateData%q)) then allocate(DstContStateData%q(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -592,7 +592,7 @@ subroutine LD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -681,16 +681,16 @@ subroutine LD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -712,16 +712,16 @@ subroutine LD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(LD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call LD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -734,14 +734,14 @@ subroutine LD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(LD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'LD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call LD_PackContState(RF, InData%xdot(i1)) end do @@ -755,8 +755,8 @@ subroutine LD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -783,15 +783,15 @@ subroutine LD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' DstMiscData%Dummy = SrcMiscData%Dummy if (allocated(SrcMiscData%qPrescribed)) then - LB(1:1) = lbound(SrcMiscData%qPrescribed, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%qPrescribed, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%qPrescribed) + UB(1:1) = ubound(SrcMiscData%qPrescribed) if (.not. allocated(DstMiscData%qPrescribed)) then allocate(DstMiscData%qPrescribed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -829,7 +829,7 @@ subroutine LD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -843,8 +843,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_CopyParam' @@ -855,8 +855,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nx = SrcParamData%nx DstParamData%nq = SrcParamData%nq if (allocated(SrcParamData%MM)) then - LB(1:2) = lbound(SrcParamData%MM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MM, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MM) + UB(1:2) = ubound(SrcParamData%MM) if (.not. allocated(DstParamData%MM)) then allocate(DstParamData%MM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -867,8 +867,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MM = SrcParamData%MM end if if (allocated(SrcParamData%CC)) then - LB(1:2) = lbound(SrcParamData%CC, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CC, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CC) + UB(1:2) = ubound(SrcParamData%CC) if (.not. allocated(DstParamData%CC)) then allocate(DstParamData%CC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -879,8 +879,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CC = SrcParamData%CC end if if (allocated(SrcParamData%KK)) then - LB(1:2) = lbound(SrcParamData%KK, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%KK, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%KK) + UB(1:2) = ubound(SrcParamData%KK) if (.not. allocated(DstParamData%KK)) then allocate(DstParamData%KK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -891,8 +891,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KK = SrcParamData%KK end if if (allocated(SrcParamData%Minv)) then - LB(1:2) = lbound(SrcParamData%Minv, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Minv, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Minv) + UB(1:2) = ubound(SrcParamData%Minv) if (.not. allocated(DstParamData%Minv)) then allocate(DstParamData%Minv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -903,8 +903,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Minv = SrcParamData%Minv end if if (allocated(SrcParamData%activeDOFs)) then - LB(1:1) = lbound(SrcParamData%activeDOFs, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%activeDOFs, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%activeDOFs) + UB(1:1) = ubound(SrcParamData%activeDOFs) if (.not. allocated(DstParamData%activeDOFs)) then allocate(DstParamData%activeDOFs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -915,8 +915,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%activeDOFs = SrcParamData%activeDOFs end if if (allocated(SrcParamData%AA)) then - LB(1:2) = lbound(SrcParamData%AA, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AA, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AA) + UB(1:2) = ubound(SrcParamData%AA) if (.not. allocated(DstParamData%AA)) then allocate(DstParamData%AA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -927,8 +927,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AA = SrcParamData%AA end if if (allocated(SrcParamData%BB)) then - LB(1:2) = lbound(SrcParamData%BB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BB) + UB(1:2) = ubound(SrcParamData%BB) if (.not. allocated(DstParamData%BB)) then allocate(DstParamData%BB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -940,8 +940,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -956,8 +956,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%OutParamLinIndx)) then - LB(1:2) = lbound(SrcParamData%OutParamLinIndx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%OutParamLinIndx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) if (.not. allocated(DstParamData%OutParamLinIndx)) then allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -968,8 +968,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx end if if (allocated(SrcParamData%PrescribedValues)) then - LB(1:2) = lbound(SrcParamData%PrescribedValues, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PrescribedValues, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PrescribedValues) + UB(1:2) = ubound(SrcParamData%PrescribedValues) if (.not. allocated(DstParamData%PrescribedValues)) then allocate(DstParamData%PrescribedValues(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -985,8 +985,8 @@ subroutine LD_DestroyParam(ParamData, ErrStat, ErrMsg) type(LD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_DestroyParam' @@ -1014,8 +1014,8 @@ subroutine LD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%BB) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1034,8 +1034,8 @@ subroutine LD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(LD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'LD_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%dt) call RegPack(RF, InData%IntMethod) @@ -1051,9 +1051,9 @@ subroutine LD_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1067,8 +1067,8 @@ subroutine LD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1107,14 +1107,14 @@ subroutine LD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%Fext)) then - LB(1:1) = lbound(SrcInputData%Fext, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Fext, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Fext) + UB(1:1) = ubound(SrcInputData%Fext) if (.not. allocated(DstInputData%Fext)) then allocate(DstInputData%Fext(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1151,7 +1151,7 @@ subroutine LD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1164,14 +1164,14 @@ subroutine LD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%xdd)) then - LB(1:1) = lbound(SrcOutputData%xdd, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%xdd, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%xdd) + UB(1:1) = ubound(SrcOutputData%xdd) if (.not. allocated(DstOutputData%xdd)) then allocate(DstOutputData%xdd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1182,8 +1182,8 @@ subroutine LD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%xdd = SrcOutputData%xdd end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1224,7 +1224,7 @@ subroutine LD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/map/CMakeLists.txt b/modules/map/CMakeLists.txt index e49554d311..8c34521b58 100644 --- a/modules/map/CMakeLists.txt +++ b/modules/map/CMakeLists.txt @@ -39,13 +39,13 @@ add_library(mappplib STATIC target_sources( mappplib PUBLIC - $ + $/include/mappp/MAP_Types.h> $ - $ + $/include/mappp/mapsys.h> $ - $ + $/include/mappp/maperror.h> $ - $ + $/include/mappp/mapapi.h> $ ) target_link_libraries(mappplib nwtclibs) diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 new file mode 100644 index 0000000000..ced2d55d68 --- /dev/null +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -0,0 +1,249 @@ +!STARTOFREGISTRYGENERATEDFILE 'MAP_Fortran_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! MAP_Fortran_Types +!................................................................................................................................. +! This file is part of MAP_Fortran. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in MAP_Fortran. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE MAP_Fortran_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= Lin_InitInputType ======= + TYPE, PUBLIC :: Lin_InitInputType + LOGICAL :: linearize = .false. !< Flag that tells this module if the glue code wants to linearize. (fortran-only) [-] + END TYPE Lin_InitInputType +! ======================= +! ========= Lin_InitOutputType ======= + TYPE, PUBLIC :: Lin_InitOutputType + CHARACTER(200) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< second line of output file contents: units (fortran-only) [-] + CHARACTER(200) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization (fortran-only) [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) (fortran-only) [-] + END TYPE Lin_InitOutputType +! ======================= +! ========= Lin_ParamType ======= + TYPE, PUBLIC :: Lin_ParamType + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian (fortran-only) [-] + REAL(R8Ki) :: du = 0.0_R8Ki !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix (fortran-only) [-] + END TYPE Lin_ParamType +! ======================= +CONTAINS + +subroutine MAP_Fortran_CopyLin_InitInputType(SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_InitInputType), intent(in) :: SrcLin_InitInputTypeData + type(Lin_InitInputType), intent(inout) :: DstLin_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize +end subroutine + +subroutine MAP_Fortran_DestroyLin_InitInputType(Lin_InitInputTypeData, ErrStat, ErrMsg) + type(Lin_InitInputType), intent(inout) :: Lin_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MAP_Fortran_PackLin_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lin_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%linearize) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_UnPackLin_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lin_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%linearize); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_InitOutputType), intent(in) :: SrcLin_InitOutputTypeData + type(Lin_InitOutputType), intent(inout) :: DstLin_InitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLin_InitOutputTypeData%LinNames_y)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y) + if (.not. allocated(DstLin_InitOutputTypeData%LinNames_y)) then + allocate(DstLin_InitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y + end if + if (allocated(SrcLin_InitOutputTypeData%LinNames_u)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u) + if (.not. allocated(DstLin_InitOutputTypeData%LinNames_u)) then + allocate(DstLin_InitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u + end if + if (allocated(SrcLin_InitOutputTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u) + if (.not. allocated(DstLin_InitOutputTypeData%IsLoad_u)) then + allocate(DstLin_InitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u + end if +end subroutine + +subroutine MAP_Fortran_DestroyLin_InitOutputType(Lin_InitOutputTypeData, ErrStat, ErrMsg) + type(Lin_InitOutputType), intent(inout) :: Lin_InitOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Lin_InitOutputTypeData%LinNames_y)) then + deallocate(Lin_InitOutputTypeData%LinNames_y) + end if + if (allocated(Lin_InitOutputTypeData%LinNames_u)) then + deallocate(Lin_InitOutputTypeData%LinNames_u) + end if + if (allocated(Lin_InitOutputTypeData%IsLoad_u)) then + deallocate(Lin_InitOutputTypeData%IsLoad_u) + end if +end subroutine + +subroutine MAP_Fortran_PackLin_InitOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lin_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%IsLoad_u) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_UnPackLin_InitOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lin_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_ParamType), intent(in) :: SrcLin_ParamTypeData + type(Lin_ParamType), intent(inout) :: DstLin_ParamTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLin_ParamTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx) + if (.not. allocated(DstLin_ParamTypeData%Jac_u_indx)) then + allocate(DstLin_ParamTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx + end if + DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du + DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny +end subroutine + +subroutine MAP_Fortran_DestroyLin_ParamType(Lin_ParamTypeData, ErrStat, ErrMsg) + type(Lin_ParamType), intent(inout) :: Lin_ParamTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Lin_ParamTypeData%Jac_u_indx)) then + deallocate(Lin_ParamTypeData%Jac_u_indx) + end if +end subroutine + +subroutine MAP_Fortran_PackLin_ParamType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lin_ParamType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_ParamType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPack(RF, InData%du) + call RegPack(RF, InData%Jac_ny) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_UnPackLin_ParamType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lin_ParamType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE MAP_Fortran_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 920af997d6..f73948cdfe 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -423,7 +423,7 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyInitOutput' @@ -436,8 +436,8 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%compilingData = SrcInitOutputData%compilingData DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData if (allocated(SrcInitOutputData%writeOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) if (.not. allocated(DstInitOutputData%writeOutputHdr)) then allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -448,8 +448,8 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr end if if (allocated(SrcInitOutputData%writeOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) if (.not. allocated(DstInitOutputData%writeOutputUnt)) then allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -511,7 +511,7 @@ subroutine MAP_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -733,14 +733,14 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOtherStateData%H)) then - LB(1:1) = lbound(SrcOtherStateData%H, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%H, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%H) + UB(1:1) = ubound(SrcOtherStateData%H) if (.not. associated(DstOtherStateData%H)) then allocate(DstOtherStateData%H(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -754,8 +754,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%H = SrcOtherStateData%H end if if (associated(SrcOtherStateData%V)) then - LB(1:1) = lbound(SrcOtherStateData%V, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%V, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%V) + UB(1:1) = ubound(SrcOtherStateData%V) if (.not. associated(DstOtherStateData%V)) then allocate(DstOtherStateData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -769,8 +769,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%V = SrcOtherStateData%V end if if (associated(SrcOtherStateData%Ha)) then - LB(1:1) = lbound(SrcOtherStateData%Ha, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Ha, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Ha) + UB(1:1) = ubound(SrcOtherStateData%Ha) if (.not. associated(DstOtherStateData%Ha)) then allocate(DstOtherStateData%Ha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -784,8 +784,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Ha = SrcOtherStateData%Ha end if if (associated(SrcOtherStateData%Va)) then - LB(1:1) = lbound(SrcOtherStateData%Va, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Va, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Va) + UB(1:1) = ubound(SrcOtherStateData%Va) if (.not. associated(DstOtherStateData%Va)) then allocate(DstOtherStateData%Va(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -799,8 +799,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Va = SrcOtherStateData%Va end if if (associated(SrcOtherStateData%x)) then - LB(1:1) = lbound(SrcOtherStateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%x) + UB(1:1) = ubound(SrcOtherStateData%x) if (.not. associated(DstOtherStateData%x)) then allocate(DstOtherStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -814,8 +814,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%x = SrcOtherStateData%x end if if (associated(SrcOtherStateData%y)) then - LB(1:1) = lbound(SrcOtherStateData%y, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%y, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%y) + UB(1:1) = ubound(SrcOtherStateData%y) if (.not. associated(DstOtherStateData%y)) then allocate(DstOtherStateData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -829,8 +829,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%y = SrcOtherStateData%y end if if (associated(SrcOtherStateData%z)) then - LB(1:1) = lbound(SrcOtherStateData%z, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%z, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%z) + UB(1:1) = ubound(SrcOtherStateData%z) if (.not. associated(DstOtherStateData%z)) then allocate(DstOtherStateData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -844,8 +844,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%z = SrcOtherStateData%z end if if (associated(SrcOtherStateData%xa)) then - LB(1:1) = lbound(SrcOtherStateData%xa, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xa, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xa) + UB(1:1) = ubound(SrcOtherStateData%xa) if (.not. associated(DstOtherStateData%xa)) then allocate(DstOtherStateData%xa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -859,8 +859,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%xa = SrcOtherStateData%xa end if if (associated(SrcOtherStateData%ya)) then - LB(1:1) = lbound(SrcOtherStateData%ya, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%ya, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%ya) + UB(1:1) = ubound(SrcOtherStateData%ya) if (.not. associated(DstOtherStateData%ya)) then allocate(DstOtherStateData%ya(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -874,8 +874,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%ya = SrcOtherStateData%ya end if if (associated(SrcOtherStateData%za)) then - LB(1:1) = lbound(SrcOtherStateData%za, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%za, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%za) + UB(1:1) = ubound(SrcOtherStateData%za) if (.not. associated(DstOtherStateData%za)) then allocate(DstOtherStateData%za(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -889,8 +889,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%za = SrcOtherStateData%za end if if (associated(SrcOtherStateData%Fx_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fx_connect, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fx_connect, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fx_connect) + UB(1:1) = ubound(SrcOtherStateData%Fx_connect) if (.not. associated(DstOtherStateData%Fx_connect)) then allocate(DstOtherStateData%Fx_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -904,8 +904,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect end if if (associated(SrcOtherStateData%Fy_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fy_connect, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fy_connect, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fy_connect) + UB(1:1) = ubound(SrcOtherStateData%Fy_connect) if (.not. associated(DstOtherStateData%Fy_connect)) then allocate(DstOtherStateData%Fy_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -919,8 +919,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect end if if (associated(SrcOtherStateData%Fz_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fz_connect, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fz_connect, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fz_connect) + UB(1:1) = ubound(SrcOtherStateData%Fz_connect) if (.not. associated(DstOtherStateData%Fz_connect)) then allocate(DstOtherStateData%Fz_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -934,8 +934,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect end if if (associated(SrcOtherStateData%Fx_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fx_anchor, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fx_anchor, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fx_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fx_anchor) if (.not. associated(DstOtherStateData%Fx_anchor)) then allocate(DstOtherStateData%Fx_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -949,8 +949,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor end if if (associated(SrcOtherStateData%Fy_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fy_anchor, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fy_anchor, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fy_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fy_anchor) if (.not. associated(DstOtherStateData%Fy_anchor)) then allocate(DstOtherStateData%Fy_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -964,8 +964,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor end if if (associated(SrcOtherStateData%Fz_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fz_anchor, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fz_anchor, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fz_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fz_anchor) if (.not. associated(DstOtherStateData%Fz_anchor)) then allocate(DstOtherStateData%Fz_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1118,7 +1118,7 @@ subroutine MAP_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackOtherState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1391,7 +1391,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%H_Len = SIZE(OtherStateData%H) IF (OtherStateData%C_obj%H_Len > 0) & - OtherStateData%C_obj%H = C_LOC(OtherStateData%H(LBOUND(OtherStateData%H,1, kind=B8Ki))) + OtherStateData%C_obj%H = C_LOC(OtherStateData%H(lbound(OtherStateData%H,1))) END IF END IF @@ -1403,7 +1403,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%V_Len = SIZE(OtherStateData%V) IF (OtherStateData%C_obj%V_Len > 0) & - OtherStateData%C_obj%V = C_LOC(OtherStateData%V(LBOUND(OtherStateData%V,1, kind=B8Ki))) + OtherStateData%C_obj%V = C_LOC(OtherStateData%V(lbound(OtherStateData%V,1))) END IF END IF @@ -1415,7 +1415,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Ha_Len = SIZE(OtherStateData%Ha) IF (OtherStateData%C_obj%Ha_Len > 0) & - OtherStateData%C_obj%Ha = C_LOC(OtherStateData%Ha(LBOUND(OtherStateData%Ha,1, kind=B8Ki))) + OtherStateData%C_obj%Ha = C_LOC(OtherStateData%Ha(lbound(OtherStateData%Ha,1))) END IF END IF @@ -1427,7 +1427,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Va_Len = SIZE(OtherStateData%Va) IF (OtherStateData%C_obj%Va_Len > 0) & - OtherStateData%C_obj%Va = C_LOC(OtherStateData%Va(LBOUND(OtherStateData%Va,1, kind=B8Ki))) + OtherStateData%C_obj%Va = C_LOC(OtherStateData%Va(lbound(OtherStateData%Va,1))) END IF END IF @@ -1439,7 +1439,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%x_Len = SIZE(OtherStateData%x) IF (OtherStateData%C_obj%x_Len > 0) & - OtherStateData%C_obj%x = C_LOC(OtherStateData%x(LBOUND(OtherStateData%x,1, kind=B8Ki))) + OtherStateData%C_obj%x = C_LOC(OtherStateData%x(lbound(OtherStateData%x,1))) END IF END IF @@ -1451,7 +1451,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%y_Len = SIZE(OtherStateData%y) IF (OtherStateData%C_obj%y_Len > 0) & - OtherStateData%C_obj%y = C_LOC(OtherStateData%y(LBOUND(OtherStateData%y,1, kind=B8Ki))) + OtherStateData%C_obj%y = C_LOC(OtherStateData%y(lbound(OtherStateData%y,1))) END IF END IF @@ -1463,7 +1463,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%z_Len = SIZE(OtherStateData%z) IF (OtherStateData%C_obj%z_Len > 0) & - OtherStateData%C_obj%z = C_LOC(OtherStateData%z(LBOUND(OtherStateData%z,1, kind=B8Ki))) + OtherStateData%C_obj%z = C_LOC(OtherStateData%z(lbound(OtherStateData%z,1))) END IF END IF @@ -1475,7 +1475,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%xa_Len = SIZE(OtherStateData%xa) IF (OtherStateData%C_obj%xa_Len > 0) & - OtherStateData%C_obj%xa = C_LOC(OtherStateData%xa(LBOUND(OtherStateData%xa,1, kind=B8Ki))) + OtherStateData%C_obj%xa = C_LOC(OtherStateData%xa(lbound(OtherStateData%xa,1))) END IF END IF @@ -1487,7 +1487,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%ya_Len = SIZE(OtherStateData%ya) IF (OtherStateData%C_obj%ya_Len > 0) & - OtherStateData%C_obj%ya = C_LOC(OtherStateData%ya(LBOUND(OtherStateData%ya,1, kind=B8Ki))) + OtherStateData%C_obj%ya = C_LOC(OtherStateData%ya(lbound(OtherStateData%ya,1))) END IF END IF @@ -1499,7 +1499,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%za_Len = SIZE(OtherStateData%za) IF (OtherStateData%C_obj%za_Len > 0) & - OtherStateData%C_obj%za = C_LOC(OtherStateData%za(LBOUND(OtherStateData%za,1, kind=B8Ki))) + OtherStateData%C_obj%za = C_LOC(OtherStateData%za(lbound(OtherStateData%za,1))) END IF END IF @@ -1511,7 +1511,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) IF (OtherStateData%C_obj%Fx_connect_Len > 0) & - OtherStateData%C_obj%Fx_connect = C_LOC(OtherStateData%Fx_connect(LBOUND(OtherStateData%Fx_connect,1, kind=B8Ki))) + OtherStateData%C_obj%Fx_connect = C_LOC(OtherStateData%Fx_connect(lbound(OtherStateData%Fx_connect,1))) END IF END IF @@ -1523,7 +1523,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) IF (OtherStateData%C_obj%Fy_connect_Len > 0) & - OtherStateData%C_obj%Fy_connect = C_LOC(OtherStateData%Fy_connect(LBOUND(OtherStateData%Fy_connect,1, kind=B8Ki))) + OtherStateData%C_obj%Fy_connect = C_LOC(OtherStateData%Fy_connect(lbound(OtherStateData%Fy_connect,1))) END IF END IF @@ -1535,7 +1535,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) IF (OtherStateData%C_obj%Fz_connect_Len > 0) & - OtherStateData%C_obj%Fz_connect = C_LOC(OtherStateData%Fz_connect(LBOUND(OtherStateData%Fz_connect,1, kind=B8Ki))) + OtherStateData%C_obj%Fz_connect = C_LOC(OtherStateData%Fz_connect(lbound(OtherStateData%Fz_connect,1))) END IF END IF @@ -1547,7 +1547,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) IF (OtherStateData%C_obj%Fx_anchor_Len > 0) & - OtherStateData%C_obj%Fx_anchor = C_LOC(OtherStateData%Fx_anchor(LBOUND(OtherStateData%Fx_anchor,1, kind=B8Ki))) + OtherStateData%C_obj%Fx_anchor = C_LOC(OtherStateData%Fx_anchor(lbound(OtherStateData%Fx_anchor,1))) END IF END IF @@ -1559,7 +1559,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) IF (OtherStateData%C_obj%Fy_anchor_Len > 0) & - OtherStateData%C_obj%Fy_anchor = C_LOC(OtherStateData%Fy_anchor(LBOUND(OtherStateData%Fy_anchor,1, kind=B8Ki))) + OtherStateData%C_obj%Fy_anchor = C_LOC(OtherStateData%Fy_anchor(lbound(OtherStateData%Fy_anchor,1))) END IF END IF @@ -1571,7 +1571,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) IF (OtherStateData%C_obj%Fz_anchor_Len > 0) & - OtherStateData%C_obj%Fz_anchor = C_LOC(OtherStateData%Fz_anchor(LBOUND(OtherStateData%Fz_anchor,1, kind=B8Ki))) + OtherStateData%C_obj%Fz_anchor = C_LOC(OtherStateData%Fz_anchor(lbound(OtherStateData%Fz_anchor,1))) END IF END IF END SUBROUTINE @@ -1582,14 +1582,14 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcConstrStateData%H)) then - LB(1:1) = lbound(SrcConstrStateData%H, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%H, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%H) + UB(1:1) = ubound(SrcConstrStateData%H) if (.not. associated(DstConstrStateData%H)) then allocate(DstConstrStateData%H(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1603,8 +1603,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%H = SrcConstrStateData%H end if if (associated(SrcConstrStateData%V)) then - LB(1:1) = lbound(SrcConstrStateData%V, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%V, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%V) + UB(1:1) = ubound(SrcConstrStateData%V) if (.not. associated(DstConstrStateData%V)) then allocate(DstConstrStateData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1618,8 +1618,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%V = SrcConstrStateData%V end if if (associated(SrcConstrStateData%x)) then - LB(1:1) = lbound(SrcConstrStateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%x) + UB(1:1) = ubound(SrcConstrStateData%x) if (.not. associated(DstConstrStateData%x)) then allocate(DstConstrStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1633,8 +1633,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%x = SrcConstrStateData%x end if if (associated(SrcConstrStateData%y)) then - LB(1:1) = lbound(SrcConstrStateData%y, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%y, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%y) + UB(1:1) = ubound(SrcConstrStateData%y) if (.not. associated(DstConstrStateData%y)) then allocate(DstConstrStateData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1648,8 +1648,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%y = SrcConstrStateData%y end if if (associated(SrcConstrStateData%z)) then - LB(1:1) = lbound(SrcConstrStateData%z, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%z, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%z) + UB(1:1) = ubound(SrcConstrStateData%z) if (.not. associated(DstConstrStateData%z)) then allocate(DstConstrStateData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1725,7 +1725,7 @@ subroutine MAP_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackConstrState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1844,7 +1844,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%H_Len = SIZE(ConstrStateData%H) IF (ConstrStateData%C_obj%H_Len > 0) & - ConstrStateData%C_obj%H = C_LOC(ConstrStateData%H(LBOUND(ConstrStateData%H,1, kind=B8Ki))) + ConstrStateData%C_obj%H = C_LOC(ConstrStateData%H(lbound(ConstrStateData%H,1))) END IF END IF @@ -1856,7 +1856,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%V_Len = SIZE(ConstrStateData%V) IF (ConstrStateData%C_obj%V_Len > 0) & - ConstrStateData%C_obj%V = C_LOC(ConstrStateData%V(LBOUND(ConstrStateData%V,1, kind=B8Ki))) + ConstrStateData%C_obj%V = C_LOC(ConstrStateData%V(lbound(ConstrStateData%V,1))) END IF END IF @@ -1868,7 +1868,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%x_Len = SIZE(ConstrStateData%x) IF (ConstrStateData%C_obj%x_Len > 0) & - ConstrStateData%C_obj%x = C_LOC(ConstrStateData%x(LBOUND(ConstrStateData%x,1, kind=B8Ki))) + ConstrStateData%C_obj%x = C_LOC(ConstrStateData%x(lbound(ConstrStateData%x,1))) END IF END IF @@ -1880,7 +1880,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%y_Len = SIZE(ConstrStateData%y) IF (ConstrStateData%C_obj%y_Len > 0) & - ConstrStateData%C_obj%y = C_LOC(ConstrStateData%y(LBOUND(ConstrStateData%y,1, kind=B8Ki))) + ConstrStateData%C_obj%y = C_LOC(ConstrStateData%y(lbound(ConstrStateData%y,1))) END IF END IF @@ -1892,7 +1892,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%z_Len = SIZE(ConstrStateData%z) IF (ConstrStateData%C_obj%z_Len > 0) & - ConstrStateData%C_obj%z = C_LOC(ConstrStateData%z(LBOUND(ConstrStateData%z,1, kind=B8Ki))) + ConstrStateData%C_obj%z = C_LOC(ConstrStateData%z(lbound(ConstrStateData%z,1))) END IF END IF END SUBROUTINE @@ -2017,15 +2017,15 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%x)) then - LB(1:1) = lbound(SrcInputData%x, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%x, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%x) + UB(1:1) = ubound(SrcInputData%x) if (.not. associated(DstInputData%x)) then allocate(DstInputData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2039,8 +2039,8 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%x = SrcInputData%x end if if (associated(SrcInputData%y)) then - LB(1:1) = lbound(SrcInputData%y, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%y, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%y) + UB(1:1) = ubound(SrcInputData%y) if (.not. associated(DstInputData%y)) then allocate(DstInputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2054,8 +2054,8 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%y = SrcInputData%y end if if (associated(SrcInputData%z)) then - LB(1:1) = lbound(SrcInputData%z, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%z, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%z) + UB(1:1) = ubound(SrcInputData%z) if (.not. associated(DstInputData%z)) then allocate(DstInputData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2125,7 +2125,7 @@ subroutine MAP_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2217,7 +2217,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%x_Len = SIZE(InputData%x) IF (InputData%C_obj%x_Len > 0) & - InputData%C_obj%x = C_LOC(InputData%x(LBOUND(InputData%x,1, kind=B8Ki))) + InputData%C_obj%x = C_LOC(InputData%x(lbound(InputData%x,1))) END IF END IF @@ -2229,7 +2229,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%y_Len = SIZE(InputData%y) IF (InputData%C_obj%y_Len > 0) & - InputData%C_obj%y = C_LOC(InputData%y(LBOUND(InputData%y,1, kind=B8Ki))) + InputData%C_obj%y = C_LOC(InputData%y(lbound(InputData%y,1))) END IF END IF @@ -2241,7 +2241,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%z_Len = SIZE(InputData%z) IF (InputData%C_obj%z_Len > 0) & - InputData%C_obj%z = C_LOC(InputData%z(LBOUND(InputData%z,1, kind=B8Ki))) + InputData%C_obj%z = C_LOC(InputData%z(lbound(InputData%z,1))) END IF END IF END SUBROUTINE @@ -2252,15 +2252,15 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%Fx)) then - LB(1:1) = lbound(SrcOutputData%Fx, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Fx, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Fx) + UB(1:1) = ubound(SrcOutputData%Fx) if (.not. associated(DstOutputData%Fx)) then allocate(DstOutputData%Fx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2274,8 +2274,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fx = SrcOutputData%Fx end if if (associated(SrcOutputData%Fy)) then - LB(1:1) = lbound(SrcOutputData%Fy, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Fy, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Fy) + UB(1:1) = ubound(SrcOutputData%Fy) if (.not. associated(DstOutputData%Fy)) then allocate(DstOutputData%Fy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2289,8 +2289,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fy = SrcOutputData%Fy end if if (associated(SrcOutputData%Fz)) then - LB(1:1) = lbound(SrcOutputData%Fz, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Fz, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Fz) + UB(1:1) = ubound(SrcOutputData%Fz) if (.not. associated(DstOutputData%Fz)) then allocate(DstOutputData%Fz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2304,8 +2304,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fz = SrcOutputData%Fz end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2316,8 +2316,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (associated(SrcOutputData%wrtOutput)) then - LB(1:1) = lbound(SrcOutputData%wrtOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%wrtOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%wrtOutput) + UB(1:1) = ubound(SrcOutputData%wrtOutput) if (.not. associated(DstOutputData%wrtOutput)) then allocate(DstOutputData%wrtOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2398,7 +2398,7 @@ subroutine MAP_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2505,7 +2505,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fx_Len = SIZE(OutputData%Fx) IF (OutputData%C_obj%Fx_Len > 0) & - OutputData%C_obj%Fx = C_LOC(OutputData%Fx(LBOUND(OutputData%Fx,1, kind=B8Ki))) + OutputData%C_obj%Fx = C_LOC(OutputData%Fx(lbound(OutputData%Fx,1))) END IF END IF @@ -2517,7 +2517,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fy_Len = SIZE(OutputData%Fy) IF (OutputData%C_obj%Fy_Len > 0) & - OutputData%C_obj%Fy = C_LOC(OutputData%Fy(LBOUND(OutputData%Fy,1, kind=B8Ki))) + OutputData%C_obj%Fy = C_LOC(OutputData%Fy(lbound(OutputData%Fy,1))) END IF END IF @@ -2529,7 +2529,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fz_Len = SIZE(OutputData%Fz) IF (OutputData%C_obj%Fz_Len > 0) & - OutputData%C_obj%Fz = C_LOC(OutputData%Fz(LBOUND(OutputData%Fz,1, kind=B8Ki))) + OutputData%C_obj%Fz = C_LOC(OutputData%Fz(lbound(OutputData%Fz,1))) END IF END IF @@ -2541,7 +2541,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) IF (OutputData%C_obj%wrtOutput_Len > 0) & - OutputData%C_obj%wrtOutput = C_LOC(OutputData%wrtOutput(LBOUND(OutputData%wrtOutput,1, kind=B8Ki))) + OutputData%C_obj%wrtOutput = C_LOC(OutputData%wrtOutput(lbound(OutputData%wrtOutput,1))) END IF END IF END SUBROUTINE diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index feddd4c442..38d038fcee 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -166,7 +166,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er InitOut%Ver = MD_ProgDesc CALL WrScr(' This is MoorDyn v2, with significant input file changes from v1.') - CALL DispCopyrightLicense( MD_ProgDesc%Name, 'Copyright (C) 2019 Matt Hall' ) + CALL DispCopyrightLicense( MD_ProgDesc%Name) !--------------------------------------------------------------------------------------------- @@ -637,10 +637,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! process stiffness coefficients CALL SplitByBars(tempString1, N, tempStrings) - if (N > 2) then - CALL SetErrStat( ErrID_Fatal, 'A line type EA entry can have at most 2 (comma-separated) values.', ErrStat, ErrMsg, RoutineName ) + if (N > 3) then + CALL SetErrStat( ErrID_Fatal, 'A line type EA entry can have at most 3 (bar-separated) values.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() - else if (N==2) then ! visco-elastic case! + else if (N==3) then ! visco-elastic case, load dependent dynamic stiffness! + m%LineTypeList(l)%ElasticMod = 3 + read(tempStrings(2), *) m%LineTypeList(l)%alphaMBL + read(tempStrings(3), *) m%LineTypeList(l)%vbeta + else if (N==2) then ! visco-elastic case, constant dynamic stiffness! m%LineTypeList(l)%ElasticMod = 2 read(tempStrings(2), *) m%LineTypeList(l)%EA_D else @@ -656,11 +660,11 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! process damping coefficients CALL SplitByBars(tempString2, N, tempStrings) if (N > m%LineTypeList(l)%ElasticMod) then - CALL SetErrStat( ErrID_Fatal, 'A line type BA entry cannot have more (comma-separated) values its EA entry.', ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, 'A line type BA entry cannot have more (bar-separated) values than its EA entry.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() else if (N==2) then ! visco-elastic case when two BA values provided read(tempStrings(2), *) m%LineTypeList(l)%BA_D - else if (m%LineTypeList(l)%ElasticMod == 2) then ! case where there is no dynamic damping for viscoelastic model (will it work)? + else if (m%LineTypeList(l)%ElasticMod > 1) then ! case where there is no dynamic damping for viscoelastic model (will it work)? CALL WrScr("Warning, viscoelastic model being used with zero damping on the dynamic stiffness.") if (p%writeLog > 0) then write(p%UnLog,'(A)') "Warning, viscoelastic model being used with zero damping on the dynamic stiffness." @@ -1437,7 +1441,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! account for states of line m%LineStateIs1(l) = Nx + 1 - if (m%LineTypeList(m%LineList(l)%PropsIdNum)%ElasticMod == 2) then + if (m%LineTypeList(m%LineList(l)%PropsIdNum)%ElasticMod > 1) then ! todo add an error check here? or change to 2 or 3? Nx = Nx + 7*m%LineList(l)%N - 6 ! if using viscoelastic model, need one more state per segment m%LineStateIsN(l) = Nx else @@ -3822,7 +3826,10 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er ! calculate line dynamics (and calculate line forces and masses attributed to points) DO l = 1,p%nLines - CALL Line_GetStateDeriv(m%LineList(l), dxdt%states(m%LineStateIs1(l):m%LineStateIsN(l)), m, p) !dt might also be passed for fancy friction models + CALL Line_GetStateDeriv(m%LineList(l), dxdt%states(m%LineStateIs1(l):m%LineStateIsN(l)), m, p, ErrStat, ErrMsg) !dt might also be passed for fancy friction models + if (ErrStat == ErrID_Fatal) then + return + endif END DO ! calculate point dynamics (including contributions from attached lines diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index f5a33ada5c..1e7e5950f7 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -144,7 +144,7 @@ PROGRAM MoorDyn_Driver CALL CPU_TIME ( ProgStrtCPU ) ! Initial time (this zeros the start time when used as a MATLAB function) - CALL WrScr('MD Driver updated '//TRIM( version%Date )) + CALL WrScr('MD Driver last updated '//TRIM( version%Date )) ! Parse the driver input file and run the simulation based on that file CALL get_command_argument(1, drvrFilename) diff --git a/modules/moordyn/src/MoorDyn_Line.f90 b/modules/moordyn/src/MoorDyn_Line.f90 index 144021456e..fe1131f32e 100644 --- a/modules/moordyn/src/MoorDyn_Line.f90 +++ b/modules/moordyn/src/MoorDyn_Line.f90 @@ -69,11 +69,13 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) Line%d = LineProp%d Line%rho = LineProp%w/(Pi/4.0 * Line%d * Line%d) - Line%EA = LineProp%EA + Line%EA = LineProp%EA ! note: Line%BA is set later - Line%EA_D = LineProp%EA_D - Line%BA_D = LineProp%BA_D - Line%EI = LineProp%EI !<<< for bending stiffness + Line%EA_D = LineProp%EA_D + Line%alphaMBL = LineProp%alphaMBL + Line%vbeta = LineProp%vbeta + Line%BA_D = LineProp%BA_D + Line%EI = LineProp%EI !<<< for bending stiffness Line%Can = LineProp%Can Line%Cat = LineProp%Cat @@ -82,6 +84,12 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) ! copy over elasticity data Line%ElasticMod = LineProp%ElasticMod + + if (Line%ElasticMod > 3) then + ErrStat = ErrID_Fatal + ErrMsg = "Line ElasticMod > 3. This is not possible." + RETURN + endif Line%nEApoints = LineProp%nEApoints DO I = 1,Line%nEApoints @@ -141,7 +149,7 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) END IF ! if using viscoelastic model, allocate additional state quantities - if (Line%ElasticMod == 2) then + if (Line%ElasticMod > 1) then ALLOCATE ( Line%dl_1(N), STAT = ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating dl_1 array.' @@ -991,7 +999,7 @@ SUBROUTINE Line_SetState(Line, X, t) END DO ! if using viscoelastic model, also set the static stiffness stretch - if (Line%ElasticMod == 2) then + if (Line%ElasticMod > 1) then do I=1,Line%N Line%dl_1(I) = X( 6*Line%N-6 + I) ! these will be the last N entries in the state vector end do @@ -1001,12 +1009,15 @@ END SUBROUTINE Line_SetState !-------------------------------------------------------------- !-------------------------------------------------------------- - SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, AnchMtot) + SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p, ErrStat, ErrMsg) !, FairFtot, FairMtot, AnchFtot, AnchMtot) TYPE(MD_Line), INTENT(INOUT) :: Line ! the current Line object Real(DbKi), INTENT(INOUT) :: Xd(:) ! state derivative vector section for this line TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! Real(DbKi), INTENT( IN ) :: X(:) ! state vector, provided ! Real(DbKi), INTENT( INOUT ) :: Xd(:) ! derivative of state vector, returned ! cahnged to INOUT @@ -1044,7 +1055,8 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, Real(DbKi) :: Yi ! used in interpolating from lookup table Real(DbKi) :: dl ! stretch of a segment [m] Real(DbKi) :: ld_1 ! rate of change of static stiffness portion of segment [m/s] - Real(DbKi) :: EA_1 ! stiffness of 'static stiffness' portion of segment, combines with dynamic stiffness to give static stiffnes [m/s] + Real(DbKi) :: EA_1 ! stiffness of 'slow' portion of segment, combines with dynamic stiffness to give static stiffnes [m/s] + Real(DbKi) :: EA_D ! stiffness of 'fast' portion of segment, combines with EA_1 stiffness to give static stiffnes [m/s] REAL(DbKi) :: surface_height ! Average the surface heights at the two nodes REAL(DbKi) :: firstNodeZ ! Difference of first node depth from surface height @@ -1268,21 +1280,49 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, else MagT = 0.0_DbKi ! cable can't "push" end if + ! line internal damping force based on line-specific BA value, including possibility of dynamic length changes in l and ld terms MagTd = Line%BA* ( Line%lstrd(I) - Line%lstr(I)*Line%ld(I)/Line%l(I) )/Line%l(I) - ! viscoelastic model - else if (Line%ElasticMod == 2) then + ! viscoelastic model from https://asmedigitalcollection.asme.org/OMAE/proceedings/IOWTC2023/87578/V001T01A029/1195018 + else if (Line%ElasticMod > 1) then + + if (Line%ElasticMod == 3) then + if (Line%dl_1(I) >= 0.0) then + ! Mean load dependent dynamic stiffness: from combining eqn. 2 and eqn. 10 from original MD viscoelastic paper, taking mean load = k1 delta_L1 / MBL, and solving for k_D using WolframAlpha with following conditions: k_D > k_s, (MBL,alpha,beta,unstrLen,delta_L1) > 0 + EA_D = 0.5 * ((Line%alphaMBL) + (Line%vbeta*Line%dl_1(I)*(Line%EA / Line%l(I))) + Line%EA + sqrt((Line%alphaMBL * Line%alphaMBL) + (2*Line%alphaMBL*(Line%EA / Line%l(I)) * (Line%vbeta*Line%dl_1(I) - Line%l(I))) + ((Line%EA / Line%l(I))*(Line%EA / Line%l(I)) * (Line%vbeta*Line%dl_1(I) + Line%l(I))*(Line%vbeta*Line%dl_1(I) + Line%l(I))))) + else + EA_D = Line%alphaMBL ! mean load is considered to be 0 in this case. The second term in the above equation is not valid for delta_L1 < 0. + endif + + else if (Line%ElasticMod == 2) then + ! constant dynamic stiffness + EA_D = Line%EA_D + endif + + if (EA_D == 0.0) then ! Make sure EA != EA_D or else nans, also make sure EA_D != 0 or else nans. + ErrStat = ErrID_Fatal + ErrMsg = "Viscoelastic model: Dynamic stiffness cannot equal zero" + return + else if (EA_D == Line%EA) then + ErrStat = ErrID_Fatal + ErrMsg = "Viscoelastic model: Dynamic stiffness cannot equal static stiffness" + return + endif - EA_1 = Line%EA_D*Line%EA/(Line%EA_D - Line%EA)! calculated EA_1 which is the stiffness in series with EA_D that will result in the desired static stiffness of EA_S + EA_1 = EA_D*Line%EA/(EA_D - Line%EA)! calculated EA_1 which is the stiffness in series with EA_D that will result in the desired static stiffness of EA_S. dl = Line%lstr(I) - Line%l(I) ! delta l of this segment - ld_1 = (Line%EA_D*dl - (Line%EA_D + EA_1)*Line%dl_1(I) + Line%BA_D*Line%lstrd(I)) /( Line%BA_D + Line%BA) ! rate of change of static stiffness portion [m/s] - - !MagT = (Line%EA*Line%dl_S(I) + Line%BA*ld_S)/ Line%l(I) ! compute tension based on static portion (dynamic portion would give same) - MagT = EA_1*Line%dl_1(I)/ Line%l(I) - MagTd = Line%BA*ld_1 / Line%l(I) + ld_1 = (EA_D*dl - (EA_D + EA_1)*Line%dl_1(I) + Line%BA_D*Line%lstrd(I)) /( Line%BA_D + Line%BA) ! rate of change of static stiffness portion [m/s] + + if (dl >= 0.0) then ! if both spring 1 (the spring dashpot in parallel) and the whole segment are not in compression + MagT = EA_1*Line%dl_1(I) / Line%l(I) ! compute tension based on static portion (dynamic portion would give same). See eqn. 14 in paper + else + MagT = 0.0_DbKi ! cable can't "push" + endif + + MagTd = Line%BA*ld_1 / Line%l(I) ! compute tension based on static portion (dynamic portion would give same). See eqn. 14 in paper ! update state derivative for static stiffness stretch (last N entries in the state vector) Xd( 6*N-6 + I) = ld_1 diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index cfc82ed6f4..bf26a7ab1b 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -1283,7 +1283,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: I, iIn, ix, iy, iz + INTEGER(IntKi) :: I, iIn, ix, iy, iz, numHdrLn INTEGER(IntKi) :: ntIn ! number of time series inputs from file INTEGER(IntKi) :: UnIn ! unit number for coefficient input file INTEGER(IntKi) :: UnEcho @@ -1302,6 +1302,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CHARACTER(120) :: Line CHARACTER(4096) :: entries2 INTEGER(IntKi) :: coordtype + LOGICAL :: dataBegin INTEGER(IntKi) :: NStepWave ! INTEGER(IntKi) :: NStepWave2 ! @@ -1313,7 +1314,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) REAL(SiKi), ALLOCATABLE :: TmpFFTWaveElev(:) ! Data for the FFT calculation TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using - + REAL(SiKi) :: tmpReal ! A temporary real number COMPLEX(SiKi),ALLOCATABLE :: tmpComplex(:) ! A temporary array (0:NStepWave2-1) for FFT use. REAL(SiKi) :: Omega ! Wave frequency (rad/s) @@ -1469,17 +1470,28 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) call WrScr( 'Reading wave elevation data from '//trim(WaveKinFile) ) ! Read through length of file to find its length - i = 1 ! start counter + i = 0 ! start line counter + numHdrLn = 0 ! start header-line counter + dataBegin = .FALSE. ! started reading the data section DO READ(UnElev,'(A)',IOSTAT=ErrStat2) Line !read into a line IF (ErrStat2 /= 0) EXIT ! break out of the loop if it couldn't read the line (i.e. if at end of file) i = i+1 + READ(Line,*,IOSTAT=ErrStatTmp) tmpReal + IF (ErrStatTmp/=0) THEN ! Not a number + IF (dataBegin) THEN + CALL SetErrStat( ErrID_Fatal,' Non-data line detected in WaveKinFile past the header lines.',ErrStat, ErrMsg, RoutineName); return + END IF + numHdrLn = numHdrLn + 1 + ELSE + dataBegin = .TRUE. + END IF END DO ! rewind to start of input file to re-read things now that we know how long it is REWIND(UnElev) - ntIn = i-3 ! save number of lines of file + ntIn = i-numHdrLn ! save number of lines of file ! allocate space for input wave elevation array (including time column) @@ -1487,8 +1499,9 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CALL AllocAry(WaveElevIn, ntIn, 'WaveElevIn', ErrStat2, ErrMsg2 ); if(Failed()) return ! read the data in from the file - READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! skip the first two lines as headers - READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! + DO i = 1, numHdrLn + READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! skip header lines + END DO DO i = 1, ntIn READ (UnElev, *, IOSTAT=ErrStat2) WaveTimeIn(i), WaveElevIn(i) @@ -1502,7 +1515,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) 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 + CALL SetErrStat( ErrID_Fatal, ' MoorDyn WaveElev time series should start at t = 0 seconds.',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 58f60b3fff..a5824b9764 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -55,6 +55,8 @@ typedef ^ ^ DbKi d - typedef ^ ^ DbKi w - - - "per-length weight in air" "[kg/m]" typedef ^ ^ DbKi EA - - - "axial stiffness" "[N]" typedef ^ ^ DbKi EA_D - - - "axial stiffness" "[N]" +typedef ^ ^ DbKi alphaMBL - - - "dynamic stiffness constant: Krd alpha term x MBL" "[N]" +typedef ^ ^ DbKi vbeta - - - "dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load)" "[N]" typedef ^ ^ DbKi BA - - - "internal damping coefficient times area" "[N-s]" typedef ^ ^ DbKi BA_D - - - "internal damping coefficient times area" "[N-s]" typedef ^ ^ DbKi EI - - - "bending stiffness" "[N-m]" @@ -62,14 +64,14 @@ typedef ^ ^ DbKi Can - typedef ^ ^ DbKi Cat - - - "tangential added mass coefficient" typedef ^ ^ DbKi Cdn - - - "transverse drag coefficient" typedef ^ ^ DbKi Cdt - - - "tangential drag coefficient" -typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} " - -typedef ^ ^ IntKi nEApoints - 0 - "number of values in stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {1 basic, 2 viscoelastic, 3 viscoelastic+meanload} " - +typedef ^ ^ IntKi nEApoints - - - "number of values in stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" -typedef ^ ^ IntKi nBApoints - 0 - "number of values in stress-strainrate lookup table (0 means using constant c)" +typedef ^ ^ IntKi nBApoints - - - "number of values in stress-strainrate lookup table (0 means using constant c)" typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table" -typedef ^ ^ IntKi nEIpoints - 0 - "number of values in bending stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi nEIpoints - - - "number of values in bending stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" @@ -92,8 +94,8 @@ typedef ^ MD_Body IntKi IdNum - typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned" typedef ^ ^ IntKi AttachedC {30} - - "list of IdNums of points attached to this body" typedef ^ ^ IntKi AttachedR {30} - - "list of IdNums of rods attached to this body" -typedef ^ ^ IntKi nAttachedC - 0 - "number of attached points" -typedef ^ ^ IntKi nAttachedR - 0 - "number of attached rods" +typedef ^ ^ IntKi nAttachedC - - - "number of attached points" +typedef ^ ^ IntKi nAttachedR - - - "number of attached rods" typedef ^ ^ DbKi rPointRel {3}{30} - - "relative position of point on body" typedef ^ ^ DbKi r6RodRel {6}{30} - - "relative position and orientation of rod on body" typedef ^ ^ DbKi bodyM - - - "body mass (seperate from attached objects)" "[kg]" @@ -121,7 +123,7 @@ typedef ^ ^ CHARACTER(10) type - typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 1=fixed, -1=coupled, 0=free" typedef ^ ^ IntKi Attached {10} - - "list of IdNums of lines attached to this point node" typedef ^ ^ IntKi Top {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" -typedef ^ ^ IntKi nAttached - 0 - "number of attached lines" +typedef ^ ^ IntKi nAttached - - - "number of attached lines" typedef ^ ^ DbKi pointM - - - "point mass" "[kg]" typedef ^ ^ DbKi pointV - - - "point volume" "[m^3]" typedef ^ ^ DbKi pointFX - - - "" @@ -149,8 +151,8 @@ typedef ^ ^ IntKi AttachedA {10} typedef ^ ^ IntKi AttachedB {10} - - "list of IdNums of lines attached to end B" typedef ^ ^ IntKi TopA {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" typedef ^ ^ IntKi TopB {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" -typedef ^ ^ IntKi nAttachedA - 0 - "number of attached lines to Rod end A" -typedef ^ ^ IntKi nAttachedB - 0 - "number of attached lines to Rod end B" +typedef ^ ^ IntKi nAttachedA - - - "number of attached lines to Rod end A" +typedef ^ ^ IntKi nAttachedB - - - "number of attached lines to Rod end B" typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - typedef ^ ^ IntKi N - - - "The number of elements in the line" - typedef ^ ^ IntKi endTypeA - - - "type of point at end A: 0=pinned to Point, 1=cantilevered to Rod." - @@ -210,7 +212,7 @@ typedef ^ MD_Line IntKi IdNum - typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated line properties" - typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} " - typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - -typedef ^ ^ IntKi CtrlChan - 0 - "index of control channel that will drive line active tensioning (0 for none)" - +typedef ^ ^ IntKi CtrlChan - - - "index of control channel that will drive line active tensioning (0 for none)" - typedef ^ ^ IntKi FairPoint - - - "IdNum of Point at fairlead" typedef ^ ^ IntKi AnchPoint - - - "IdNum of Point at anchor" typedef ^ ^ IntKi N - - - "The number of elements in the line" - @@ -219,22 +221,24 @@ typedef ^ ^ IntKi endTypeB - typedef ^ ^ DbKi UnstrLen - - - "unstretched length of the line" - typedef ^ ^ DbKi rho - - - "density" "[kg/m3]" typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" -typedef ^ ^ DbKi EA - 0 - "stiffness" "[N]" -typedef ^ ^ DbKi EA_D - 0 - "dynamic stiffness when using viscoelastic model" "[N]" -typedef ^ ^ DbKi BA - 0 - "internal damping coefficient times area for this line only" "[N-s]" -typedef ^ ^ DbKi BA_D - 0 - "dynamic internal damping coefficient times area when using viscoelastic model" "[N-s]" -typedef ^ ^ DbKi EI - 0 - "bending stiffness" "[N-m]" +typedef ^ ^ DbKi EA - - - "stiffness" "[N]" +typedef ^ ^ DbKi EA_D - - - "constant dynamic stiffness when using viscoelastic model" "[N]" +typedef ^ ^ DbKi alphaMBL - - - "load dependent dynamic stiffness constant: Krd alpha term x MBL" "[N]" +typedef ^ ^ DbKi vbeta - - - "load dependent dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load)" "[N]" +typedef ^ ^ DbKi BA - - - "internal damping coefficient times area for this line only" "[N-s]" +typedef ^ ^ DbKi BA_D - - - "dynamic internal damping coefficient times area when using viscoelastic model" "[N-s]" +typedef ^ ^ DbKi EI - - - "bending stiffness" "[N-m]" typedef ^ ^ DbKi Can - - - "" "[-]" typedef ^ ^ DbKi Cat - - - "" "[-]" typedef ^ ^ DbKi Cdn - - - "" "[-]" typedef ^ ^ DbKi Cdt - - - "" "[-]" -typedef ^ ^ IntKi nEApoints - 0 - "number of values in stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi nEApoints - - - "number of values in stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" -typedef ^ ^ IntKi nBApoints - 0 - "number of values in stress-strainrate lookup table (0 means using constant c)" +typedef ^ ^ IntKi nBApoints - - - "number of values in stress-strainrate lookup table (0 means using constant c)" typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table" -typedef ^ ^ IntKi nEIpoints - 0 - "number of values in bending stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi nEIpoints - - - "number of values in bending stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" typedef ^ ^ DbKi time - - - "current time" "[s]" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 3c3809049b..97b3873739 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -68,6 +68,8 @@ MODULE MoorDyn_Types REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] REAL(DbKi) :: EA = 0.0_R8Ki !< axial stiffness [[N]] REAL(DbKi) :: EA_D = 0.0_R8Ki !< axial stiffness [[N]] + REAL(DbKi) :: alphaMBL = 0.0_R8Ki !< dynamic stiffness constant: Krd alpha term x MBL [[N]] + REAL(DbKi) :: vbeta = 0.0_R8Ki !< dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load) [[N]] REAL(DbKi) :: BA = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] REAL(DbKi) :: BA_D = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] REAL(DbKi) :: EI = 0.0_R8Ki !< bending stiffness [[N-m]] @@ -75,14 +77,14 @@ MODULE MoorDyn_Types REAL(DbKi) :: Cat = 0.0_R8Ki !< tangential added mass coefficient [-] REAL(DbKi) :: Cdn = 0.0_R8Ki !< transverse drag coefficient [-] REAL(DbKi) :: Cdt = 0.0_R8Ki !< tangential drag coefficient [-] - INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] - INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] + INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {1 basic, 2 viscoelastic, 3 viscoelastic+meanload} [-] + INTEGER(IntKi) :: nEApoints = 0_IntKi !< number of values in stress-strain lookup table (0 means using constant E) [-] REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] - INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] + INTEGER(IntKi) :: nBApoints = 0_IntKi !< number of values in stress-strainrate lookup table (0 means using constant c) [-] REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] - INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] + INTEGER(IntKi) :: nEIpoints = 0_IntKi !< number of values in bending stress-strain lookup table (0 means using constant E) [-] REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] END TYPE MD_LineProp @@ -109,8 +111,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned [-] INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC = 0_IntKi !< list of IdNums of points attached to this body [-] INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR = 0_IntKi !< list of IdNums of rods attached to this body [-] - INTEGER(IntKi) :: nAttachedC = 0 !< number of attached points [-] - INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] + INTEGER(IntKi) :: nAttachedC = 0_IntKi !< number of attached points [-] + INTEGER(IntKi) :: nAttachedR = 0_IntKi !< number of attached rods [-] REAL(DbKi) , DIMENSION(1:3,1:30) :: rPointRel = 0.0_R8Ki !< relative position of point on body [-] REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel = 0.0_R8Ki !< relative position and orientation of rod on body [-] REAL(DbKi) :: bodyM = 0.0_R8Ki !< body mass (seperate from attached objects) [[kg]] @@ -140,7 +142,7 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 1=fixed, -1=coupled, 0=free [-] INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0_IntKi !< list of IdNums of lines attached to this point node [-] INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) :: nAttached = 0 !< number of attached lines [-] + INTEGER(IntKi) :: nAttached = 0_IntKi !< number of attached lines [-] REAL(DbKi) :: pointM = 0.0_R8Ki !< point mass [[kg]] REAL(DbKi) :: pointV = 0.0_R8Ki !< point volume [[m^3]] REAL(DbKi) :: pointFX = 0.0_R8Ki !< [-] @@ -170,8 +172,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB = 0_IntKi !< list of IdNums of lines attached to end B [-] INTEGER(IntKi) , DIMENSION(1:10) :: TopA = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) , DIMENSION(1:10) :: TopB = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) :: nAttachedA = 0 !< number of attached lines to Rod end A [-] - INTEGER(IntKi) :: nAttachedB = 0 !< number of attached lines to Rod end B [-] + INTEGER(IntKi) :: nAttachedA = 0_IntKi !< number of attached lines to Rod end A [-] + INTEGER(IntKi) :: nAttachedB = 0_IntKi !< number of attached lines to Rod end B [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of point at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] @@ -231,7 +233,7 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated line properties [-] INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] - INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] + INTEGER(IntKi) :: CtrlChan = 0_IntKi !< index of control channel that will drive line active tensioning (0 for none) [-] INTEGER(IntKi) :: FairPoint = 0_IntKi !< IdNum of Point at fairlead [-] INTEGER(IntKi) :: AnchPoint = 0_IntKi !< IdNum of Point at anchor [-] INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] @@ -240,22 +242,24 @@ MODULE MoorDyn_Types REAL(DbKi) :: UnstrLen = 0.0_R8Ki !< unstretched length of the line [-] REAL(DbKi) :: rho = 0.0_R8Ki !< density [[kg/m3]] REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] - REAL(DbKi) :: EA = 0 !< stiffness [[N]] - REAL(DbKi) :: EA_D = 0 !< dynamic stiffness when using viscoelastic model [[N]] - REAL(DbKi) :: BA = 0 !< internal damping coefficient times area for this line only [[N-s]] - REAL(DbKi) :: BA_D = 0 !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] - REAL(DbKi) :: EI = 0 !< bending stiffness [[N-m]] + REAL(DbKi) :: EA = 0.0_R8Ki !< stiffness [[N]] + REAL(DbKi) :: EA_D = 0.0_R8Ki !< constant dynamic stiffness when using viscoelastic model [[N]] + REAL(DbKi) :: alphaMBL = 0.0_R8Ki !< load dependent dynamic stiffness constant: Krd alpha term x MBL [[N]] + REAL(DbKi) :: vbeta = 0.0_R8Ki !< load dependent dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load) [[N]] + REAL(DbKi) :: BA = 0.0_R8Ki !< internal damping coefficient times area for this line only [[N-s]] + REAL(DbKi) :: BA_D = 0.0_R8Ki !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] + REAL(DbKi) :: EI = 0.0_R8Ki !< bending stiffness [[N-m]] REAL(DbKi) :: Can = 0.0_R8Ki !< [[-]] REAL(DbKi) :: Cat = 0.0_R8Ki !< [[-]] REAL(DbKi) :: Cdn = 0.0_R8Ki !< [[-]] REAL(DbKi) :: Cdt = 0.0_R8Ki !< [[-]] - INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] + INTEGER(IntKi) :: nEApoints = 0_IntKi !< number of values in stress-strain lookup table (0 means using constant E) [-] REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] - INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] + INTEGER(IntKi) :: nBApoints = 0_IntKi !< number of values in stress-strainrate lookup table (0 means using constant c) [-] REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] - INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] + INTEGER(IntKi) :: nEIpoints = 0_IntKi !< number of values in bending stress-strain lookup table (0 means using constant E) [-] REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] @@ -563,7 +567,7 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyInitInput' @@ -573,8 +577,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%rhoW = SrcInitInputData%rhoW DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth if (allocated(SrcInitInputData%PtfmInit)) then - LB(1:2) = lbound(SrcInitInputData%PtfmInit, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%PtfmInit, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%PtfmInit) + UB(1:2) = ubound(SrcInitInputData%PtfmInit) if (.not. allocated(DstInitInputData%PtfmInit)) then allocate(DstInitInputData%PtfmInit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -586,8 +590,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if DstInitInputData%FarmSize = SrcInitInputData%FarmSize if (allocated(SrcInitInputData%TurbineRefPos)) then - LB(1:2) = lbound(SrcInitInputData%TurbineRefPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%TurbineRefPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%TurbineRefPos) + UB(1:2) = ubound(SrcInitInputData%TurbineRefPos) if (.not. allocated(DstInitInputData%TurbineRefPos)) then allocate(DstInitInputData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -606,8 +610,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta if (ErrStat >= AbortErrLev) return DstInitInputData%Echo = SrcInitInputData%Echo if (allocated(SrcInitInputData%OutList)) then - LB(1:1) = lbound(SrcInitInputData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) if (.not. allocated(DstInitInputData%OutList)) then allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -670,7 +674,7 @@ subroutine MD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -706,6 +710,8 @@ subroutine MD_CopyLineProp(SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, DstLinePropData%w = SrcLinePropData%w DstLinePropData%EA = SrcLinePropData%EA DstLinePropData%EA_D = SrcLinePropData%EA_D + DstLinePropData%alphaMBL = SrcLinePropData%alphaMBL + DstLinePropData%vbeta = SrcLinePropData%vbeta DstLinePropData%BA = SrcLinePropData%BA DstLinePropData%BA_D = SrcLinePropData%BA_D DstLinePropData%EI = SrcLinePropData%EI @@ -745,6 +751,8 @@ subroutine MD_PackLineProp(RF, Indata) call RegPack(RF, InData%w) call RegPack(RF, InData%EA) call RegPack(RF, InData%EA_D) + call RegPack(RF, InData%alphaMBL) + call RegPack(RF, InData%vbeta) call RegPack(RF, InData%BA) call RegPack(RF, InData%BA_D) call RegPack(RF, InData%EI) @@ -776,6 +784,8 @@ subroutine MD_UnPackLineProp(RF, OutData) call RegUnpack(RF, OutData%w); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaMBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vbeta); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BA_D); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EI); if (RegCheckErr(RF, RoutineName)) return @@ -985,7 +995,7 @@ subroutine MD_CopyPoint(SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyPoint' ErrStat = ErrID_None @@ -1011,8 +1021,8 @@ subroutine MD_CopyPoint(SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg) DstPointData%Ud = SrcPointData%Ud DstPointData%zeta = SrcPointData%zeta if (allocated(SrcPointData%PDyn)) then - LB(1:1) = lbound(SrcPointData%PDyn, kind=B8Ki) - UB(1:1) = ubound(SrcPointData%PDyn, kind=B8Ki) + LB(1:1) = lbound(SrcPointData%PDyn) + UB(1:1) = ubound(SrcPointData%PDyn) if (.not. allocated(DstPointData%PDyn)) then allocate(DstPointData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1073,7 +1083,7 @@ subroutine MD_UnPackPoint(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_Point), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackPoint' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1108,7 +1118,7 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyRod' ErrStat = ErrID_None @@ -1144,8 +1154,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%pitch = SrcRodData%pitch DstRodData%h0 = SrcRodData%h0 if (allocated(SrcRodData%r)) then - LB(1:2) = lbound(SrcRodData%r, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%r, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%r) + UB(1:2) = ubound(SrcRodData%r) if (.not. allocated(DstRodData%r)) then allocate(DstRodData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1156,8 +1166,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%r = SrcRodData%r end if if (allocated(SrcRodData%rd)) then - LB(1:2) = lbound(SrcRodData%rd, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%rd, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%rd) + UB(1:2) = ubound(SrcRodData%rd) if (.not. allocated(DstRodData%rd)) then allocate(DstRodData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1169,8 +1179,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if DstRodData%q = SrcRodData%q if (allocated(SrcRodData%l)) then - LB(1:1) = lbound(SrcRodData%l, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%l, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%l) + UB(1:1) = ubound(SrcRodData%l) if (.not. allocated(DstRodData%l)) then allocate(DstRodData%l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1181,8 +1191,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%l = SrcRodData%l end if if (allocated(SrcRodData%V)) then - LB(1:1) = lbound(SrcRodData%V, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%V, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%V) + UB(1:1) = ubound(SrcRodData%V) if (.not. allocated(DstRodData%V)) then allocate(DstRodData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1193,8 +1203,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%V = SrcRodData%V end if if (allocated(SrcRodData%U)) then - LB(1:2) = lbound(SrcRodData%U, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%U, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%U) + UB(1:2) = ubound(SrcRodData%U) if (.not. allocated(DstRodData%U)) then allocate(DstRodData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1205,8 +1215,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%U = SrcRodData%U end if if (allocated(SrcRodData%Ud)) then - LB(1:2) = lbound(SrcRodData%Ud, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Ud, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Ud) + UB(1:2) = ubound(SrcRodData%Ud) if (.not. allocated(DstRodData%Ud)) then allocate(DstRodData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1217,8 +1227,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Ud = SrcRodData%Ud end if if (allocated(SrcRodData%zeta)) then - LB(1:1) = lbound(SrcRodData%zeta, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%zeta, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%zeta) + UB(1:1) = ubound(SrcRodData%zeta) if (.not. allocated(DstRodData%zeta)) then allocate(DstRodData%zeta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1229,8 +1239,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%zeta = SrcRodData%zeta end if if (allocated(SrcRodData%PDyn)) then - LB(1:1) = lbound(SrcRodData%PDyn, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%PDyn, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%PDyn) + UB(1:1) = ubound(SrcRodData%PDyn) if (.not. allocated(DstRodData%PDyn)) then allocate(DstRodData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1241,8 +1251,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%PDyn = SrcRodData%PDyn end if if (allocated(SrcRodData%W)) then - LB(1:2) = lbound(SrcRodData%W, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%W, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%W) + UB(1:2) = ubound(SrcRodData%W) if (.not. allocated(DstRodData%W)) then allocate(DstRodData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1253,8 +1263,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%W = SrcRodData%W end if if (allocated(SrcRodData%Bo)) then - LB(1:2) = lbound(SrcRodData%Bo, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Bo, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Bo) + UB(1:2) = ubound(SrcRodData%Bo) if (.not. allocated(DstRodData%Bo)) then allocate(DstRodData%Bo(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1265,8 +1275,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Bo = SrcRodData%Bo end if if (allocated(SrcRodData%Pd)) then - LB(1:2) = lbound(SrcRodData%Pd, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Pd, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Pd) + UB(1:2) = ubound(SrcRodData%Pd) if (.not. allocated(DstRodData%Pd)) then allocate(DstRodData%Pd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1277,8 +1287,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Pd = SrcRodData%Pd end if if (allocated(SrcRodData%Dp)) then - LB(1:2) = lbound(SrcRodData%Dp, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Dp, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Dp) + UB(1:2) = ubound(SrcRodData%Dp) if (.not. allocated(DstRodData%Dp)) then allocate(DstRodData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1289,8 +1299,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Dp = SrcRodData%Dp end if if (allocated(SrcRodData%Dq)) then - LB(1:2) = lbound(SrcRodData%Dq, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Dq, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Dq) + UB(1:2) = ubound(SrcRodData%Dq) if (.not. allocated(DstRodData%Dq)) then allocate(DstRodData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1301,8 +1311,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Dq = SrcRodData%Dq end if if (allocated(SrcRodData%Ap)) then - LB(1:2) = lbound(SrcRodData%Ap, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Ap, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Ap) + UB(1:2) = ubound(SrcRodData%Ap) if (.not. allocated(DstRodData%Ap)) then allocate(DstRodData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1313,8 +1323,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Ap = SrcRodData%Ap end if if (allocated(SrcRodData%Aq)) then - LB(1:2) = lbound(SrcRodData%Aq, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Aq, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Aq) + UB(1:2) = ubound(SrcRodData%Aq) if (.not. allocated(DstRodData%Aq)) then allocate(DstRodData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1325,8 +1335,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Aq = SrcRodData%Aq end if if (allocated(SrcRodData%B)) then - LB(1:2) = lbound(SrcRodData%B, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%B, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%B) + UB(1:2) = ubound(SrcRodData%B) if (.not. allocated(DstRodData%B)) then allocate(DstRodData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1337,8 +1347,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%B = SrcRodData%B end if if (allocated(SrcRodData%Fnet)) then - LB(1:2) = lbound(SrcRodData%Fnet, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Fnet, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Fnet) + UB(1:2) = ubound(SrcRodData%Fnet) if (.not. allocated(DstRodData%Fnet)) then allocate(DstRodData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1349,8 +1359,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Fnet = SrcRodData%Fnet end if if (allocated(SrcRodData%M)) then - LB(1:3) = lbound(SrcRodData%M, kind=B8Ki) - UB(1:3) = ubound(SrcRodData%M, kind=B8Ki) + LB(1:3) = lbound(SrcRodData%M) + UB(1:3) = ubound(SrcRodData%M) if (.not. allocated(DstRodData%M)) then allocate(DstRodData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1372,8 +1382,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%OrMat = SrcRodData%OrMat DstRodData%RodUnOut = SrcRodData%RodUnOut if (allocated(SrcRodData%RodWrOutput)) then - LB(1:1) = lbound(SrcRodData%RodWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%RodWrOutput, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%RodWrOutput) + UB(1:1) = ubound(SrcRodData%RodWrOutput) if (.not. allocated(DstRodData%RodWrOutput)) then allocate(DstRodData%RodWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1524,7 +1534,7 @@ subroutine MD_UnPackRod(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_Rod), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackRod' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1597,7 +1607,7 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyLine' ErrStat = ErrID_None @@ -1617,6 +1627,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%d = SrcLineData%d DstLineData%EA = SrcLineData%EA DstLineData%EA_D = SrcLineData%EA_D + DstLineData%alphaMBL = SrcLineData%alphaMBL + DstLineData%vbeta = SrcLineData%vbeta DstLineData%BA = SrcLineData%BA DstLineData%BA_D = SrcLineData%BA_D DstLineData%EI = SrcLineData%EI @@ -1635,8 +1647,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%bstiffYs = SrcLineData%bstiffYs DstLineData%time = SrcLineData%time if (allocated(SrcLineData%r)) then - LB(1:2) = lbound(SrcLineData%r, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%r, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%r) + UB(1:2) = ubound(SrcLineData%r) if (.not. allocated(DstLineData%r)) then allocate(DstLineData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1647,8 +1659,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%r = SrcLineData%r end if if (allocated(SrcLineData%rd)) then - LB(1:2) = lbound(SrcLineData%rd, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%rd, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%rd) + UB(1:2) = ubound(SrcLineData%rd) if (.not. allocated(DstLineData%rd)) then allocate(DstLineData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1659,8 +1671,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%rd = SrcLineData%rd end if if (allocated(SrcLineData%q)) then - LB(1:2) = lbound(SrcLineData%q, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%q, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%q) + UB(1:2) = ubound(SrcLineData%q) if (.not. allocated(DstLineData%q)) then allocate(DstLineData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1671,8 +1683,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%q = SrcLineData%q end if if (allocated(SrcLineData%qs)) then - LB(1:2) = lbound(SrcLineData%qs, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%qs, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%qs) + UB(1:2) = ubound(SrcLineData%qs) if (.not. allocated(DstLineData%qs)) then allocate(DstLineData%qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1683,8 +1695,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%qs = SrcLineData%qs end if if (allocated(SrcLineData%l)) then - LB(1:1) = lbound(SrcLineData%l, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%l, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%l) + UB(1:1) = ubound(SrcLineData%l) if (.not. allocated(DstLineData%l)) then allocate(DstLineData%l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1695,8 +1707,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%l = SrcLineData%l end if if (allocated(SrcLineData%ld)) then - LB(1:1) = lbound(SrcLineData%ld, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%ld, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%ld) + UB(1:1) = ubound(SrcLineData%ld) if (.not. allocated(DstLineData%ld)) then allocate(DstLineData%ld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1707,8 +1719,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%ld = SrcLineData%ld end if if (allocated(SrcLineData%lstr)) then - LB(1:1) = lbound(SrcLineData%lstr, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%lstr, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%lstr) + UB(1:1) = ubound(SrcLineData%lstr) if (.not. allocated(DstLineData%lstr)) then allocate(DstLineData%lstr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1719,8 +1731,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%lstr = SrcLineData%lstr end if if (allocated(SrcLineData%lstrd)) then - LB(1:1) = lbound(SrcLineData%lstrd, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%lstrd, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%lstrd) + UB(1:1) = ubound(SrcLineData%lstrd) if (.not. allocated(DstLineData%lstrd)) then allocate(DstLineData%lstrd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1731,8 +1743,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%lstrd = SrcLineData%lstrd end if if (allocated(SrcLineData%Kurv)) then - LB(1:1) = lbound(SrcLineData%Kurv, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%Kurv, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%Kurv) + UB(1:1) = ubound(SrcLineData%Kurv) if (.not. allocated(DstLineData%Kurv)) then allocate(DstLineData%Kurv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1743,8 +1755,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Kurv = SrcLineData%Kurv end if if (allocated(SrcLineData%dl_1)) then - LB(1:1) = lbound(SrcLineData%dl_1, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%dl_1, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%dl_1) + UB(1:1) = ubound(SrcLineData%dl_1) if (.not. allocated(DstLineData%dl_1)) then allocate(DstLineData%dl_1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1755,8 +1767,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%dl_1 = SrcLineData%dl_1 end if if (allocated(SrcLineData%V)) then - LB(1:1) = lbound(SrcLineData%V, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%V, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%V) + UB(1:1) = ubound(SrcLineData%V) if (.not. allocated(DstLineData%V)) then allocate(DstLineData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1767,8 +1779,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%V = SrcLineData%V end if if (allocated(SrcLineData%F)) then - LB(1:1) = lbound(SrcLineData%F, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%F, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%F) + UB(1:1) = ubound(SrcLineData%F) if (.not. allocated(DstLineData%F)) then allocate(DstLineData%F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1779,8 +1791,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%F = SrcLineData%F end if if (allocated(SrcLineData%U)) then - LB(1:2) = lbound(SrcLineData%U, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%U, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%U) + UB(1:2) = ubound(SrcLineData%U) if (.not. allocated(DstLineData%U)) then allocate(DstLineData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1791,8 +1803,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%U = SrcLineData%U end if if (allocated(SrcLineData%Ud)) then - LB(1:2) = lbound(SrcLineData%Ud, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Ud, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Ud) + UB(1:2) = ubound(SrcLineData%Ud) if (.not. allocated(DstLineData%Ud)) then allocate(DstLineData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1803,8 +1815,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Ud = SrcLineData%Ud end if if (allocated(SrcLineData%zeta)) then - LB(1:1) = lbound(SrcLineData%zeta, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%zeta, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%zeta) + UB(1:1) = ubound(SrcLineData%zeta) if (.not. allocated(DstLineData%zeta)) then allocate(DstLineData%zeta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1815,8 +1827,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%zeta = SrcLineData%zeta end if if (allocated(SrcLineData%PDyn)) then - LB(1:1) = lbound(SrcLineData%PDyn, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%PDyn, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%PDyn) + UB(1:1) = ubound(SrcLineData%PDyn) if (.not. allocated(DstLineData%PDyn)) then allocate(DstLineData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1827,8 +1839,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%PDyn = SrcLineData%PDyn end if if (allocated(SrcLineData%T)) then - LB(1:2) = lbound(SrcLineData%T, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%T, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%T) + UB(1:2) = ubound(SrcLineData%T) if (.not. allocated(DstLineData%T)) then allocate(DstLineData%T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1839,8 +1851,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%T = SrcLineData%T end if if (allocated(SrcLineData%Td)) then - LB(1:2) = lbound(SrcLineData%Td, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Td, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Td) + UB(1:2) = ubound(SrcLineData%Td) if (.not. allocated(DstLineData%Td)) then allocate(DstLineData%Td(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1851,8 +1863,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Td = SrcLineData%Td end if if (allocated(SrcLineData%W)) then - LB(1:2) = lbound(SrcLineData%W, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%W, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%W) + UB(1:2) = ubound(SrcLineData%W) if (.not. allocated(DstLineData%W)) then allocate(DstLineData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1863,8 +1875,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%W = SrcLineData%W end if if (allocated(SrcLineData%Dp)) then - LB(1:2) = lbound(SrcLineData%Dp, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Dp, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Dp) + UB(1:2) = ubound(SrcLineData%Dp) if (.not. allocated(DstLineData%Dp)) then allocate(DstLineData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1875,8 +1887,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Dp = SrcLineData%Dp end if if (allocated(SrcLineData%Dq)) then - LB(1:2) = lbound(SrcLineData%Dq, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Dq, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Dq) + UB(1:2) = ubound(SrcLineData%Dq) if (.not. allocated(DstLineData%Dq)) then allocate(DstLineData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1887,8 +1899,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Dq = SrcLineData%Dq end if if (allocated(SrcLineData%Ap)) then - LB(1:2) = lbound(SrcLineData%Ap, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Ap, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Ap) + UB(1:2) = ubound(SrcLineData%Ap) if (.not. allocated(DstLineData%Ap)) then allocate(DstLineData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1899,8 +1911,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Ap = SrcLineData%Ap end if if (allocated(SrcLineData%Aq)) then - LB(1:2) = lbound(SrcLineData%Aq, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Aq, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Aq) + UB(1:2) = ubound(SrcLineData%Aq) if (.not. allocated(DstLineData%Aq)) then allocate(DstLineData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1911,8 +1923,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Aq = SrcLineData%Aq end if if (allocated(SrcLineData%B)) then - LB(1:2) = lbound(SrcLineData%B, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%B, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%B) + UB(1:2) = ubound(SrcLineData%B) if (.not. allocated(DstLineData%B)) then allocate(DstLineData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1923,8 +1935,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%B = SrcLineData%B end if if (allocated(SrcLineData%Bs)) then - LB(1:2) = lbound(SrcLineData%Bs, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Bs, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Bs) + UB(1:2) = ubound(SrcLineData%Bs) if (.not. allocated(DstLineData%Bs)) then allocate(DstLineData%Bs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1935,8 +1947,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Bs = SrcLineData%Bs end if if (allocated(SrcLineData%Fnet)) then - LB(1:2) = lbound(SrcLineData%Fnet, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Fnet, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Fnet) + UB(1:2) = ubound(SrcLineData%Fnet) if (.not. allocated(DstLineData%Fnet)) then allocate(DstLineData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1947,8 +1959,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Fnet = SrcLineData%Fnet end if if (allocated(SrcLineData%S)) then - LB(1:3) = lbound(SrcLineData%S, kind=B8Ki) - UB(1:3) = ubound(SrcLineData%S, kind=B8Ki) + LB(1:3) = lbound(SrcLineData%S) + UB(1:3) = ubound(SrcLineData%S) if (.not. allocated(DstLineData%S)) then allocate(DstLineData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1959,8 +1971,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%S = SrcLineData%S end if if (allocated(SrcLineData%M)) then - LB(1:3) = lbound(SrcLineData%M, kind=B8Ki) - UB(1:3) = ubound(SrcLineData%M, kind=B8Ki) + LB(1:3) = lbound(SrcLineData%M) + UB(1:3) = ubound(SrcLineData%M) if (.not. allocated(DstLineData%M)) then allocate(DstLineData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1974,8 +1986,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%EndMomentB = SrcLineData%EndMomentB DstLineData%LineUnOut = SrcLineData%LineUnOut if (allocated(SrcLineData%LineWrOutput)) then - LB(1:1) = lbound(SrcLineData%LineWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%LineWrOutput, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%LineWrOutput) + UB(1:1) = ubound(SrcLineData%LineWrOutput) if (.not. allocated(DstLineData%LineWrOutput)) then allocate(DstLineData%LineWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2103,6 +2115,8 @@ subroutine MD_PackLine(RF, Indata) call RegPack(RF, InData%d) call RegPack(RF, InData%EA) call RegPack(RF, InData%EA_D) + call RegPack(RF, InData%alphaMBL) + call RegPack(RF, InData%vbeta) call RegPack(RF, InData%BA) call RegPack(RF, InData%BA_D) call RegPack(RF, InData%EI) @@ -2159,7 +2173,7 @@ subroutine MD_UnPackLine(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_Line), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackLine' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2178,6 +2192,8 @@ subroutine MD_UnPackLine(RF, OutData) call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaMBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vbeta); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BA_D); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EI); if (RegCheckErr(RF, RoutineName)) return @@ -2350,14 +2366,14 @@ subroutine MD_CopyVisDiam(SrcVisDiamData, DstVisDiamData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyVisDiam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVisDiamData%Diam)) then - LB(1:1) = lbound(SrcVisDiamData%Diam, kind=B8Ki) - UB(1:1) = ubound(SrcVisDiamData%Diam, kind=B8Ki) + LB(1:1) = lbound(SrcVisDiamData%Diam) + UB(1:1) = ubound(SrcVisDiamData%Diam) if (.not. allocated(DstVisDiamData%Diam)) then allocate(DstVisDiamData%Diam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2394,7 +2410,7 @@ subroutine MD_UnPackVisDiam(RF, OutData) type(RegFile), intent(inout) :: RF type(VisDiam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackVisDiam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2407,15 +2423,15 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%writeOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) if (.not. allocated(DstInitOutputData%writeOutputHdr)) then allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2426,8 +2442,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr end if if (allocated(SrcInitOutputData%writeOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) if (.not. allocated(DstInitOutputData%writeOutputUnt)) then allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2441,8 +2457,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%CableCChanRqst)) then - LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) if (.not. allocated(DstInitOutputData%CableCChanRqst)) then allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2453,8 +2469,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst end if if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2465,8 +2481,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2477,8 +2493,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2489,8 +2505,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2501,8 +2517,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2513,8 +2529,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2525,8 +2541,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2537,8 +2553,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2626,7 +2642,7 @@ subroutine MD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2651,14 +2667,14 @@ subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%states)) then - LB(1:1) = lbound(SrcContStateData%states, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%states, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%states) + UB(1:1) = ubound(SrcContStateData%states) if (.not. allocated(DstContStateData%states)) then allocate(DstContStateData%states(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2695,7 +2711,7 @@ subroutine MD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2822,8 +2838,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyParam' @@ -2842,8 +2858,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nFreeRods = SrcParamData%nFreeRods DstParamData%nFreePoints = SrcParamData%nFreePoints if (allocated(SrcParamData%nCpldBodies)) then - LB(1:1) = lbound(SrcParamData%nCpldBodies, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldBodies, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nCpldBodies) + UB(1:1) = ubound(SrcParamData%nCpldBodies) if (.not. allocated(DstParamData%nCpldBodies)) then allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2854,8 +2870,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nCpldBodies = SrcParamData%nCpldBodies end if if (allocated(SrcParamData%nCpldRods)) then - LB(1:1) = lbound(SrcParamData%nCpldRods, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldRods, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nCpldRods) + UB(1:1) = ubound(SrcParamData%nCpldRods) if (.not. allocated(DstParamData%nCpldRods)) then allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2866,8 +2882,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nCpldRods = SrcParamData%nCpldRods end if if (allocated(SrcParamData%nCpldPoints)) then - LB(1:1) = lbound(SrcParamData%nCpldPoints, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldPoints, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nCpldPoints) + UB(1:1) = ubound(SrcParamData%nCpldPoints) if (.not. allocated(DstParamData%nCpldPoints)) then allocate(DstParamData%nCpldPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2891,8 +2907,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dtOut = SrcParamData%dtOut DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2915,8 +2931,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Current = SrcParamData%Current DstParamData%nTurbines = SrcParamData%nTurbines if (allocated(SrcParamData%TurbineRefPos)) then - LB(1:2) = lbound(SrcParamData%TurbineRefPos, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TurbineRefPos, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%TurbineRefPos) + UB(1:2) = ubound(SrcParamData%TurbineRefPos) if (.not. allocated(DstParamData%TurbineRefPos)) then allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2937,8 +2953,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nzWave = SrcParamData%nzWave DstParamData%ntWave = SrcParamData%ntWave if (allocated(SrcParamData%pxWave)) then - LB(1:1) = lbound(SrcParamData%pxWave, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pxWave, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%pxWave) + UB(1:1) = ubound(SrcParamData%pxWave) if (.not. allocated(DstParamData%pxWave)) then allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2949,8 +2965,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%pxWave = SrcParamData%pxWave end if if (allocated(SrcParamData%pyWave)) then - LB(1:1) = lbound(SrcParamData%pyWave, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pyWave, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%pyWave) + UB(1:1) = ubound(SrcParamData%pyWave) if (.not. allocated(DstParamData%pyWave)) then allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2961,8 +2977,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%pyWave = SrcParamData%pyWave end if if (allocated(SrcParamData%pzWave)) then - LB(1:1) = lbound(SrcParamData%pzWave, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pzWave, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%pzWave) + UB(1:1) = ubound(SrcParamData%pzWave) if (.not. allocated(DstParamData%pzWave)) then allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2974,8 +2990,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%dtWave = SrcParamData%dtWave if (allocated(SrcParamData%uxWave)) then - LB(1:4) = lbound(SrcParamData%uxWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uxWave, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%uxWave) + UB(1:4) = ubound(SrcParamData%uxWave) if (.not. allocated(DstParamData%uxWave)) then allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2986,8 +3002,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uxWave = SrcParamData%uxWave end if if (allocated(SrcParamData%uyWave)) then - LB(1:4) = lbound(SrcParamData%uyWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uyWave, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%uyWave) + UB(1:4) = ubound(SrcParamData%uyWave) if (.not. allocated(DstParamData%uyWave)) then allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2998,8 +3014,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uyWave = SrcParamData%uyWave end if if (allocated(SrcParamData%uzWave)) then - LB(1:4) = lbound(SrcParamData%uzWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uzWave, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%uzWave) + UB(1:4) = ubound(SrcParamData%uzWave) if (.not. allocated(DstParamData%uzWave)) then allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3010,8 +3026,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uzWave = SrcParamData%uzWave end if if (allocated(SrcParamData%axWave)) then - LB(1:4) = lbound(SrcParamData%axWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%axWave, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%axWave) + UB(1:4) = ubound(SrcParamData%axWave) if (.not. allocated(DstParamData%axWave)) then allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3022,8 +3038,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%axWave = SrcParamData%axWave end if if (allocated(SrcParamData%ayWave)) then - LB(1:4) = lbound(SrcParamData%ayWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%ayWave, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%ayWave) + UB(1:4) = ubound(SrcParamData%ayWave) if (.not. allocated(DstParamData%ayWave)) then allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3034,8 +3050,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ayWave = SrcParamData%ayWave end if if (allocated(SrcParamData%azWave)) then - LB(1:4) = lbound(SrcParamData%azWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%azWave, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%azWave) + UB(1:4) = ubound(SrcParamData%azWave) if (.not. allocated(DstParamData%azWave)) then allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3046,8 +3062,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%azWave = SrcParamData%azWave end if if (allocated(SrcParamData%PDyn)) then - LB(1:4) = lbound(SrcParamData%PDyn, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%PDyn, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%PDyn) + UB(1:4) = ubound(SrcParamData%PDyn) if (.not. allocated(DstParamData%PDyn)) then allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3058,8 +3074,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PDyn = SrcParamData%PDyn end if if (allocated(SrcParamData%zeta)) then - LB(1:3) = lbound(SrcParamData%zeta, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%zeta, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%zeta) + UB(1:3) = ubound(SrcParamData%zeta) if (.not. allocated(DstParamData%zeta)) then allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3071,8 +3087,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%nzCurrent = SrcParamData%nzCurrent if (allocated(SrcParamData%pzCurrent)) then - LB(1:1) = lbound(SrcParamData%pzCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pzCurrent, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%pzCurrent) + UB(1:1) = ubound(SrcParamData%pzCurrent) if (.not. allocated(DstParamData%pzCurrent)) then allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3083,8 +3099,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%pzCurrent = SrcParamData%pzCurrent end if if (allocated(SrcParamData%uxCurrent)) then - LB(1:1) = lbound(SrcParamData%uxCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%uxCurrent, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%uxCurrent) + UB(1:1) = ubound(SrcParamData%uxCurrent) if (.not. allocated(DstParamData%uxCurrent)) then allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3095,8 +3111,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uxCurrent = SrcParamData%uxCurrent end if if (allocated(SrcParamData%uyCurrent)) then - LB(1:1) = lbound(SrcParamData%uyCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%uyCurrent, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%uyCurrent) + UB(1:1) = ubound(SrcParamData%uyCurrent) if (.not. allocated(DstParamData%uyCurrent)) then allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3108,8 +3124,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%Nx0 = SrcParamData%Nx0 if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3120,8 +3136,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3132,8 +3148,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) if (.not. allocated(DstParamData%dx)) then allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3146,8 +3162,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_ny = SrcParamData%Jac_ny DstParamData%Jac_nx = SrcParamData%Jac_nx if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then - LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx) + UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx) if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3159,8 +3175,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%VisMeshes = SrcParamData%VisMeshes if (allocated(SrcParamData%VisRodsDiam)) then - LB(1:1) = lbound(SrcParamData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%VisRodsDiam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%VisRodsDiam) + UB(1:1) = ubound(SrcParamData%VisRodsDiam) if (.not. allocated(DstParamData%VisRodsDiam)) then allocate(DstParamData%VisRodsDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3180,8 +3196,8 @@ subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) type(MD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_DestroyParam' @@ -3197,8 +3213,8 @@ subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%nCpldPoints) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3263,8 +3279,8 @@ subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%dxIdx_map2_xStateIdx) end if if (allocated(ParamData%VisRodsDiam)) then - LB(1:1) = lbound(ParamData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(ParamData%VisRodsDiam, kind=B8Ki) + LB(1:1) = lbound(ParamData%VisRodsDiam) + UB(1:1) = ubound(ParamData%VisRodsDiam) do i1 = LB(1), UB(1) call MD_DestroyVisDiam(ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3277,8 +3293,8 @@ subroutine MD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(MD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%nLineTypes) call RegPack(RF, InData%nRodTypes) @@ -3310,9 +3326,9 @@ subroutine MD_PackParam(RF, Indata) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call MD_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -3362,9 +3378,9 @@ subroutine MD_PackParam(RF, Indata) call RegPack(RF, InData%VisMeshes) call RegPack(RF, allocated(InData%VisRodsDiam)) if (allocated(InData%VisRodsDiam)) then - call RegPackBounds(RF, 1, lbound(InData%VisRodsDiam, kind=B8Ki), ubound(InData%VisRodsDiam, kind=B8Ki)) - LB(1:1) = lbound(InData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(InData%VisRodsDiam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VisRodsDiam), ubound(InData%VisRodsDiam)) + LB(1:1) = lbound(InData%VisRodsDiam) + UB(1:1) = ubound(InData%VisRodsDiam) do i1 = LB(1), UB(1) call MD_PackVisDiam(RF, InData%VisRodsDiam(i1)) end do @@ -3376,8 +3392,8 @@ subroutine MD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3486,16 +3502,16 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%CoupledKinematics)) then - LB(1:1) = lbound(SrcInputData%CoupledKinematics, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%CoupledKinematics, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%CoupledKinematics) + UB(1:1) = ubound(SrcInputData%CoupledKinematics) if (.not. allocated(DstInputData%CoupledKinematics)) then allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3510,8 +3526,8 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%DeltaL)) then - LB(1:1) = lbound(SrcInputData%DeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%DeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%DeltaL) + UB(1:1) = ubound(SrcInputData%DeltaL) if (.not. allocated(DstInputData%DeltaL)) then allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3522,8 +3538,8 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%DeltaL = SrcInputData%DeltaL end if if (allocated(SrcInputData%DeltaLdot)) then - LB(1:1) = lbound(SrcInputData%DeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%DeltaLdot, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%DeltaLdot) + UB(1:1) = ubound(SrcInputData%DeltaLdot) if (.not. allocated(DstInputData%DeltaLdot)) then allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3539,16 +3555,16 @@ subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) type(MD_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%CoupledKinematics)) then - LB(1:1) = lbound(InputData%CoupledKinematics, kind=B8Ki) - UB(1:1) = ubound(InputData%CoupledKinematics, kind=B8Ki) + LB(1:1) = lbound(InputData%CoupledKinematics) + UB(1:1) = ubound(InputData%CoupledKinematics) do i1 = LB(1), UB(1) call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3567,14 +3583,14 @@ subroutine MD_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(MD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%CoupledKinematics)) if (allocated(InData%CoupledKinematics)) then - call RegPackBounds(RF, 1, lbound(InData%CoupledKinematics, kind=B8Ki), ubound(InData%CoupledKinematics, kind=B8Ki)) - LB(1:1) = lbound(InData%CoupledKinematics, kind=B8Ki) - UB(1:1) = ubound(InData%CoupledKinematics, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%CoupledKinematics), ubound(InData%CoupledKinematics)) + LB(1:1) = lbound(InData%CoupledKinematics) + UB(1:1) = ubound(InData%CoupledKinematics) do i1 = LB(1), UB(1) call MeshPack(RF, InData%CoupledKinematics(i1)) end do @@ -3588,8 +3604,8 @@ subroutine MD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3616,16 +3632,16 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%CoupledLoads)) then - LB(1:1) = lbound(SrcOutputData%CoupledLoads, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CoupledLoads, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%CoupledLoads) + UB(1:1) = ubound(SrcOutputData%CoupledLoads) if (.not. allocated(DstOutputData%CoupledLoads)) then allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3640,8 +3656,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3652,8 +3668,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%VisLinesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisLinesMesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%VisLinesMesh) + UB(1:1) = ubound(SrcOutputData%VisLinesMesh) if (.not. allocated(DstOutputData%VisLinesMesh)) then allocate(DstOutputData%VisLinesMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3668,8 +3684,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcOutputData%VisRodsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisRodsMesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%VisRodsMesh) + UB(1:1) = ubound(SrcOutputData%VisRodsMesh) if (.not. allocated(DstOutputData%VisRodsMesh)) then allocate(DstOutputData%VisRodsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3684,8 +3700,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcOutputData%VisBodiesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisBodiesMesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%VisBodiesMesh) + UB(1:1) = ubound(SrcOutputData%VisBodiesMesh) if (.not. allocated(DstOutputData%VisBodiesMesh)) then allocate(DstOutputData%VisBodiesMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3700,8 +3716,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcOutputData%VisAnchsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisAnchsMesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%VisAnchsMesh) + UB(1:1) = ubound(SrcOutputData%VisAnchsMesh) if (.not. allocated(DstOutputData%VisAnchsMesh)) then allocate(DstOutputData%VisAnchsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3721,16 +3737,16 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) type(MD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%CoupledLoads)) then - LB(1:1) = lbound(OutputData%CoupledLoads, kind=B8Ki) - UB(1:1) = ubound(OutputData%CoupledLoads, kind=B8Ki) + LB(1:1) = lbound(OutputData%CoupledLoads) + UB(1:1) = ubound(OutputData%CoupledLoads) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3741,8 +3757,8 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%WriteOutput) end if if (allocated(OutputData%VisLinesMesh)) then - LB(1:1) = lbound(OutputData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisLinesMesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%VisLinesMesh) + UB(1:1) = ubound(OutputData%VisLinesMesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3750,8 +3766,8 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%VisLinesMesh) end if if (allocated(OutputData%VisRodsMesh)) then - LB(1:1) = lbound(OutputData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisRodsMesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%VisRodsMesh) + UB(1:1) = ubound(OutputData%VisRodsMesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3759,8 +3775,8 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%VisRodsMesh) end if if (allocated(OutputData%VisBodiesMesh)) then - LB(1:1) = lbound(OutputData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisBodiesMesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%VisBodiesMesh) + UB(1:1) = ubound(OutputData%VisBodiesMesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3768,8 +3784,8 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%VisBodiesMesh) end if if (allocated(OutputData%VisAnchsMesh)) then - LB(1:1) = lbound(OutputData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisAnchsMesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%VisAnchsMesh) + UB(1:1) = ubound(OutputData%VisAnchsMesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3782,14 +3798,14 @@ subroutine MD_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(MD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%CoupledLoads)) if (allocated(InData%CoupledLoads)) then - call RegPackBounds(RF, 1, lbound(InData%CoupledLoads, kind=B8Ki), ubound(InData%CoupledLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%CoupledLoads, kind=B8Ki) - UB(1:1) = ubound(InData%CoupledLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%CoupledLoads), ubound(InData%CoupledLoads)) + LB(1:1) = lbound(InData%CoupledLoads) + UB(1:1) = ubound(InData%CoupledLoads) do i1 = LB(1), UB(1) call MeshPack(RF, InData%CoupledLoads(i1)) end do @@ -3797,36 +3813,36 @@ subroutine MD_PackOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutput) call RegPack(RF, allocated(InData%VisLinesMesh)) if (allocated(InData%VisLinesMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisLinesMesh, kind=B8Ki), ubound(InData%VisLinesMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisLinesMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VisLinesMesh), ubound(InData%VisLinesMesh)) + LB(1:1) = lbound(InData%VisLinesMesh) + UB(1:1) = ubound(InData%VisLinesMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%VisLinesMesh(i1)) end do end if call RegPack(RF, allocated(InData%VisRodsMesh)) if (allocated(InData%VisRodsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisRodsMesh, kind=B8Ki), ubound(InData%VisRodsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisRodsMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VisRodsMesh), ubound(InData%VisRodsMesh)) + LB(1:1) = lbound(InData%VisRodsMesh) + UB(1:1) = ubound(InData%VisRodsMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%VisRodsMesh(i1)) end do end if call RegPack(RF, allocated(InData%VisBodiesMesh)) if (allocated(InData%VisBodiesMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisBodiesMesh, kind=B8Ki), ubound(InData%VisBodiesMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisBodiesMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VisBodiesMesh), ubound(InData%VisBodiesMesh)) + LB(1:1) = lbound(InData%VisBodiesMesh) + UB(1:1) = ubound(InData%VisBodiesMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%VisBodiesMesh(i1)) end do end if call RegPack(RF, allocated(InData%VisAnchsMesh)) if (allocated(InData%VisAnchsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisAnchsMesh, kind=B8Ki), ubound(InData%VisAnchsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisAnchsMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VisAnchsMesh), ubound(InData%VisAnchsMesh)) + LB(1:1) = lbound(InData%VisAnchsMesh) + UB(1:1) = ubound(InData%VisAnchsMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%VisAnchsMesh(i1)) end do @@ -3838,8 +3854,8 @@ subroutine MD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3917,8 +3933,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyMisc' @@ -3940,8 +3956,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%LineTypeList)) then - LB(1:1) = lbound(SrcMiscData%LineTypeList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineTypeList, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LineTypeList) + UB(1:1) = ubound(SrcMiscData%LineTypeList) if (.not. allocated(DstMiscData%LineTypeList)) then allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3956,8 +3972,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%RodTypeList)) then - LB(1:1) = lbound(SrcMiscData%RodTypeList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodTypeList, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%RodTypeList) + UB(1:1) = ubound(SrcMiscData%RodTypeList) if (.not. allocated(DstMiscData%RodTypeList)) then allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3975,8 +3991,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%BodyList)) then - LB(1:1) = lbound(SrcMiscData%BodyList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyList, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%BodyList) + UB(1:1) = ubound(SrcMiscData%BodyList) if (.not. allocated(DstMiscData%BodyList)) then allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3991,8 +4007,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%RodList)) then - LB(1:1) = lbound(SrcMiscData%RodList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodList, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%RodList) + UB(1:1) = ubound(SrcMiscData%RodList) if (.not. allocated(DstMiscData%RodList)) then allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4007,8 +4023,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%PointList)) then - LB(1:1) = lbound(SrcMiscData%PointList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointList, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%PointList) + UB(1:1) = ubound(SrcMiscData%PointList) if (.not. allocated(DstMiscData%PointList)) then allocate(DstMiscData%PointList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4023,8 +4039,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%LineList)) then - LB(1:1) = lbound(SrcMiscData%LineList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineList, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LineList) + UB(1:1) = ubound(SrcMiscData%LineList) if (.not. allocated(DstMiscData%LineList)) then allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4039,8 +4055,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%FailList)) then - LB(1:1) = lbound(SrcMiscData%FailList, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FailList, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FailList) + UB(1:1) = ubound(SrcMiscData%FailList) if (.not. allocated(DstMiscData%FailList)) then allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4055,8 +4071,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%FreePointIs)) then - LB(1:1) = lbound(SrcMiscData%FreePointIs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreePointIs, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FreePointIs) + UB(1:1) = ubound(SrcMiscData%FreePointIs) if (.not. allocated(DstMiscData%FreePointIs)) then allocate(DstMiscData%FreePointIs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4067,8 +4083,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FreePointIs = SrcMiscData%FreePointIs end if if (allocated(SrcMiscData%CpldPointIs)) then - LB(1:2) = lbound(SrcMiscData%CpldPointIs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldPointIs, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%CpldPointIs) + UB(1:2) = ubound(SrcMiscData%CpldPointIs) if (.not. allocated(DstMiscData%CpldPointIs)) then allocate(DstMiscData%CpldPointIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4079,8 +4095,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs end if if (allocated(SrcMiscData%FreeRodIs)) then - LB(1:1) = lbound(SrcMiscData%FreeRodIs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreeRodIs, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FreeRodIs) + UB(1:1) = ubound(SrcMiscData%FreeRodIs) if (.not. allocated(DstMiscData%FreeRodIs)) then allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4091,8 +4107,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs end if if (allocated(SrcMiscData%CpldRodIs)) then - LB(1:2) = lbound(SrcMiscData%CpldRodIs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldRodIs, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%CpldRodIs) + UB(1:2) = ubound(SrcMiscData%CpldRodIs) if (.not. allocated(DstMiscData%CpldRodIs)) then allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4103,8 +4119,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs end if if (allocated(SrcMiscData%FreeBodyIs)) then - LB(1:1) = lbound(SrcMiscData%FreeBodyIs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreeBodyIs, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FreeBodyIs) + UB(1:1) = ubound(SrcMiscData%FreeBodyIs) if (.not. allocated(DstMiscData%FreeBodyIs)) then allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4115,8 +4131,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs end if if (allocated(SrcMiscData%CpldBodyIs)) then - LB(1:2) = lbound(SrcMiscData%CpldBodyIs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldBodyIs, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%CpldBodyIs) + UB(1:2) = ubound(SrcMiscData%CpldBodyIs) if (.not. allocated(DstMiscData%CpldBodyIs)) then allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4127,8 +4143,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs end if if (allocated(SrcMiscData%LineStateIs1)) then - LB(1:1) = lbound(SrcMiscData%LineStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineStateIs1, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LineStateIs1) + UB(1:1) = ubound(SrcMiscData%LineStateIs1) if (.not. allocated(DstMiscData%LineStateIs1)) then allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4139,8 +4155,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 end if if (allocated(SrcMiscData%LineStateIsN)) then - LB(1:1) = lbound(SrcMiscData%LineStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineStateIsN, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LineStateIsN) + UB(1:1) = ubound(SrcMiscData%LineStateIsN) if (.not. allocated(DstMiscData%LineStateIsN)) then allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4151,8 +4167,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN end if if (allocated(SrcMiscData%PointStateIs1)) then - LB(1:1) = lbound(SrcMiscData%PointStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointStateIs1, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%PointStateIs1) + UB(1:1) = ubound(SrcMiscData%PointStateIs1) if (.not. allocated(DstMiscData%PointStateIs1)) then allocate(DstMiscData%PointStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4163,8 +4179,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 end if if (allocated(SrcMiscData%PointStateIsN)) then - LB(1:1) = lbound(SrcMiscData%PointStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointStateIsN, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%PointStateIsN) + UB(1:1) = ubound(SrcMiscData%PointStateIsN) if (.not. allocated(DstMiscData%PointStateIsN)) then allocate(DstMiscData%PointStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4175,8 +4191,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN end if if (allocated(SrcMiscData%RodStateIs1)) then - LB(1:1) = lbound(SrcMiscData%RodStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodStateIs1, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%RodStateIs1) + UB(1:1) = ubound(SrcMiscData%RodStateIs1) if (.not. allocated(DstMiscData%RodStateIs1)) then allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4187,8 +4203,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 end if if (allocated(SrcMiscData%RodStateIsN)) then - LB(1:1) = lbound(SrcMiscData%RodStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodStateIsN, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%RodStateIsN) + UB(1:1) = ubound(SrcMiscData%RodStateIsN) if (.not. allocated(DstMiscData%RodStateIsN)) then allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4199,8 +4215,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN end if if (allocated(SrcMiscData%BodyStateIs1)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyStateIs1, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%BodyStateIs1) + UB(1:1) = ubound(SrcMiscData%BodyStateIs1) if (.not. allocated(DstMiscData%BodyStateIs1)) then allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4211,8 +4227,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 end if if (allocated(SrcMiscData%BodyStateIsN)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyStateIsN, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%BodyStateIsN) + UB(1:1) = ubound(SrcMiscData%BodyStateIsN) if (.not. allocated(DstMiscData%BodyStateIsN)) then allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4233,8 +4249,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return DstMiscData%zeros6 = SrcMiscData%zeros6 if (allocated(SrcMiscData%MDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%MDWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%MDWrOutput, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%MDWrOutput) + UB(1:1) = ubound(SrcMiscData%MDWrOutput) if (.not. allocated(DstMiscData%MDWrOutput)) then allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4247,8 +4263,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%PtfmInit = SrcMiscData%PtfmInit if (allocated(SrcMiscData%BathymetryGrid)) then - LB(1:2) = lbound(SrcMiscData%BathymetryGrid, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BathymetryGrid, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%BathymetryGrid) + UB(1:2) = ubound(SrcMiscData%BathymetryGrid) if (.not. allocated(DstMiscData%BathymetryGrid)) then allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4259,8 +4275,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid end if if (allocated(SrcMiscData%BathGrid_Xs)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Xs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_Xs, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%BathGrid_Xs) + UB(1:1) = ubound(SrcMiscData%BathGrid_Xs) if (.not. allocated(DstMiscData%BathGrid_Xs)) then allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4271,8 +4287,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs end if if (allocated(SrcMiscData%BathGrid_Ys)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Ys, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_Ys, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%BathGrid_Ys) + UB(1:1) = ubound(SrcMiscData%BathGrid_Ys) if (.not. allocated(DstMiscData%BathGrid_Ys)) then allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4283,8 +4299,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys end if if (allocated(SrcMiscData%BathGrid_npoints)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_npoints, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_npoints, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%BathGrid_npoints) + UB(1:1) = ubound(SrcMiscData%BathGrid_npoints) if (.not. allocated(DstMiscData%BathGrid_npoints)) then allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4300,8 +4316,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) type(MD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_DestroyMisc' @@ -4318,8 +4334,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) call MD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%LineTypeList)) then - LB(1:1) = lbound(MiscData%LineTypeList, kind=B8Ki) - UB(1:1) = ubound(MiscData%LineTypeList, kind=B8Ki) + LB(1:1) = lbound(MiscData%LineTypeList) + UB(1:1) = ubound(MiscData%LineTypeList) do i1 = LB(1), UB(1) call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4327,8 +4343,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%LineTypeList) end if if (allocated(MiscData%RodTypeList)) then - LB(1:1) = lbound(MiscData%RodTypeList, kind=B8Ki) - UB(1:1) = ubound(MiscData%RodTypeList, kind=B8Ki) + LB(1:1) = lbound(MiscData%RodTypeList) + UB(1:1) = ubound(MiscData%RodTypeList) do i1 = LB(1), UB(1) call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4338,8 +4354,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%BodyList)) then - LB(1:1) = lbound(MiscData%BodyList, kind=B8Ki) - UB(1:1) = ubound(MiscData%BodyList, kind=B8Ki) + LB(1:1) = lbound(MiscData%BodyList) + UB(1:1) = ubound(MiscData%BodyList) do i1 = LB(1), UB(1) call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4347,8 +4363,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%BodyList) end if if (allocated(MiscData%RodList)) then - LB(1:1) = lbound(MiscData%RodList, kind=B8Ki) - UB(1:1) = ubound(MiscData%RodList, kind=B8Ki) + LB(1:1) = lbound(MiscData%RodList) + UB(1:1) = ubound(MiscData%RodList) do i1 = LB(1), UB(1) call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4356,8 +4372,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%RodList) end if if (allocated(MiscData%PointList)) then - LB(1:1) = lbound(MiscData%PointList, kind=B8Ki) - UB(1:1) = ubound(MiscData%PointList, kind=B8Ki) + LB(1:1) = lbound(MiscData%PointList) + UB(1:1) = ubound(MiscData%PointList) do i1 = LB(1), UB(1) call MD_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4365,8 +4381,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%PointList) end if if (allocated(MiscData%LineList)) then - LB(1:1) = lbound(MiscData%LineList, kind=B8Ki) - UB(1:1) = ubound(MiscData%LineList, kind=B8Ki) + LB(1:1) = lbound(MiscData%LineList) + UB(1:1) = ubound(MiscData%LineList) do i1 = LB(1), UB(1) call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4374,8 +4390,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%LineList) end if if (allocated(MiscData%FailList)) then - LB(1:1) = lbound(MiscData%FailList, kind=B8Ki) - UB(1:1) = ubound(MiscData%FailList, kind=B8Ki) + LB(1:1) = lbound(MiscData%FailList) + UB(1:1) = ubound(MiscData%FailList) do i1 = LB(1), UB(1) call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4449,8 +4465,8 @@ subroutine MD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(MD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackModJacType(RF, InData%Jac) call MD_PackContState(RF, InData%x_perturb) @@ -4459,18 +4475,18 @@ subroutine MD_PackMisc(RF, Indata) call MD_PackOutput(RF, InData%y_lin) call RegPack(RF, allocated(InData%LineTypeList)) if (allocated(InData%LineTypeList)) then - call RegPackBounds(RF, 1, lbound(InData%LineTypeList, kind=B8Ki), ubound(InData%LineTypeList, kind=B8Ki)) - LB(1:1) = lbound(InData%LineTypeList, kind=B8Ki) - UB(1:1) = ubound(InData%LineTypeList, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%LineTypeList), ubound(InData%LineTypeList)) + LB(1:1) = lbound(InData%LineTypeList) + UB(1:1) = ubound(InData%LineTypeList) do i1 = LB(1), UB(1) call MD_PackLineProp(RF, InData%LineTypeList(i1)) end do end if call RegPack(RF, allocated(InData%RodTypeList)) if (allocated(InData%RodTypeList)) then - call RegPackBounds(RF, 1, lbound(InData%RodTypeList, kind=B8Ki), ubound(InData%RodTypeList, kind=B8Ki)) - LB(1:1) = lbound(InData%RodTypeList, kind=B8Ki) - UB(1:1) = ubound(InData%RodTypeList, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) + LB(1:1) = lbound(InData%RodTypeList) + UB(1:1) = ubound(InData%RodTypeList) do i1 = LB(1), UB(1) call MD_PackRodProp(RF, InData%RodTypeList(i1)) end do @@ -4478,45 +4494,45 @@ subroutine MD_PackMisc(RF, Indata) call MD_PackBody(RF, InData%GroundBody) call RegPack(RF, allocated(InData%BodyList)) if (allocated(InData%BodyList)) then - call RegPackBounds(RF, 1, lbound(InData%BodyList, kind=B8Ki), ubound(InData%BodyList, kind=B8Ki)) - LB(1:1) = lbound(InData%BodyList, kind=B8Ki) - UB(1:1) = ubound(InData%BodyList, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BodyList), ubound(InData%BodyList)) + LB(1:1) = lbound(InData%BodyList) + UB(1:1) = ubound(InData%BodyList) do i1 = LB(1), UB(1) call MD_PackBody(RF, InData%BodyList(i1)) end do end if call RegPack(RF, allocated(InData%RodList)) if (allocated(InData%RodList)) then - call RegPackBounds(RF, 1, lbound(InData%RodList, kind=B8Ki), ubound(InData%RodList, kind=B8Ki)) - LB(1:1) = lbound(InData%RodList, kind=B8Ki) - UB(1:1) = ubound(InData%RodList, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%RodList), ubound(InData%RodList)) + LB(1:1) = lbound(InData%RodList) + UB(1:1) = ubound(InData%RodList) do i1 = LB(1), UB(1) call MD_PackRod(RF, InData%RodList(i1)) end do end if call RegPack(RF, allocated(InData%PointList)) if (allocated(InData%PointList)) then - call RegPackBounds(RF, 1, lbound(InData%PointList, kind=B8Ki), ubound(InData%PointList, kind=B8Ki)) - LB(1:1) = lbound(InData%PointList, kind=B8Ki) - UB(1:1) = ubound(InData%PointList, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%PointList), ubound(InData%PointList)) + LB(1:1) = lbound(InData%PointList) + UB(1:1) = ubound(InData%PointList) do i1 = LB(1), UB(1) call MD_PackPoint(RF, InData%PointList(i1)) end do end if call RegPack(RF, allocated(InData%LineList)) if (allocated(InData%LineList)) then - call RegPackBounds(RF, 1, lbound(InData%LineList, kind=B8Ki), ubound(InData%LineList, kind=B8Ki)) - LB(1:1) = lbound(InData%LineList, kind=B8Ki) - UB(1:1) = ubound(InData%LineList, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%LineList), ubound(InData%LineList)) + LB(1:1) = lbound(InData%LineList) + UB(1:1) = ubound(InData%LineList) do i1 = LB(1), UB(1) call MD_PackLine(RF, InData%LineList(i1)) end do end if call RegPack(RF, allocated(InData%FailList)) if (allocated(InData%FailList)) then - call RegPackBounds(RF, 1, lbound(InData%FailList, kind=B8Ki), ubound(InData%FailList, kind=B8Ki)) - LB(1:1) = lbound(InData%FailList, kind=B8Ki) - UB(1:1) = ubound(InData%FailList, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%FailList), ubound(InData%FailList)) + LB(1:1) = lbound(InData%FailList) + UB(1:1) = ubound(InData%FailList) do i1 = LB(1), UB(1) call MD_PackFail(RF, InData%FailList(i1)) end do @@ -4555,8 +4571,8 @@ subroutine MD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4784,7 +4800,7 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1, kind=B8Ki),UBOUND(u_out%CoupledKinematics,1, kind=B8Ki) + do i1 = lbound(u_out%CoupledKinematics,1),ubound(u_out%CoupledKinematics,1) CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4853,7 +4869,7 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1, kind=B8Ki),UBOUND(u_out%CoupledKinematics,1, kind=B8Ki) + do i1 = lbound(u_out%CoupledKinematics,1),ubound(u_out%CoupledKinematics,1) CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4964,7 +4980,7 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1, kind=B8Ki),UBOUND(y_out%CoupledLoads,1, kind=B8Ki) + do i1 = lbound(y_out%CoupledLoads,1),ubound(y_out%CoupledLoads,1) CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4973,25 +4989,25 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN - DO i1 = LBOUND(y_out%VisLinesMesh,1, kind=B8Ki),UBOUND(y_out%VisLinesMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisLinesMesh,1),ubound(y_out%VisLinesMesh,1) CALL MeshExtrapInterp1(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN - DO i1 = LBOUND(y_out%VisRodsMesh,1, kind=B8Ki),UBOUND(y_out%VisRodsMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisRodsMesh,1),ubound(y_out%VisRodsMesh,1) CALL MeshExtrapInterp1(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN - DO i1 = LBOUND(y_out%VisBodiesMesh,1, kind=B8Ki),UBOUND(y_out%VisBodiesMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisBodiesMesh,1),ubound(y_out%VisBodiesMesh,1) CALL MeshExtrapInterp1(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN - DO i1 = LBOUND(y_out%VisAnchsMesh,1, kind=B8Ki),UBOUND(y_out%VisAnchsMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisAnchsMesh,1),ubound(y_out%VisAnchsMesh,1) CALL MeshExtrapInterp1(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -5054,7 +5070,7 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1, kind=B8Ki),UBOUND(y_out%CoupledLoads,1, kind=B8Ki) + do i1 = lbound(y_out%CoupledLoads,1),ubound(y_out%CoupledLoads,1) CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -5063,25 +5079,25 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN - DO i1 = LBOUND(y_out%VisLinesMesh,1, kind=B8Ki),UBOUND(y_out%VisLinesMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisLinesMesh,1),ubound(y_out%VisLinesMesh,1) CALL MeshExtrapInterp2(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), y3%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN - DO i1 = LBOUND(y_out%VisRodsMesh,1, kind=B8Ki),UBOUND(y_out%VisRodsMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisRodsMesh,1),ubound(y_out%VisRodsMesh,1) CALL MeshExtrapInterp2(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), y3%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN - DO i1 = LBOUND(y_out%VisBodiesMesh,1, kind=B8Ki),UBOUND(y_out%VisBodiesMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisBodiesMesh,1),ubound(y_out%VisBodiesMesh,1) CALL MeshExtrapInterp2(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), y3%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN - DO i1 = LBOUND(y_out%VisAnchsMesh,1, kind=B8Ki),UBOUND(y_out%VisAnchsMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisAnchsMesh,1),ubound(y_out%VisAnchsMesh,1) CALL MeshExtrapInterp2(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), y3%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/moordyn/src/MoorDyn_bathymetry.txt b/modules/moordyn/src/MoorDyn_bathymetry.txt deleted file mode 100644 index bfe4ffbbbd..0000000000 --- a/modules/moordyn/src/MoorDyn_bathymetry.txt +++ /dev/null @@ -1,8 +0,0 @@ ---- MoorDyn Bathymetry Input File --- -nGridX 4 -nGridY 4 - -800 -10 10 800 --800 400 400 500 500 - -10 400 400 500 500 - 10 600 600 600 600 - 800 600 600 600 600 \ No newline at end of file diff --git a/modules/nwtc-library/ModRegGen.py b/modules/nwtc-library/ModRegGen.py index b7a9811cca..7ab8753a63 100644 --- a/modules/nwtc-library/ModRegGen.py +++ b/modules/nwtc-library/ModRegGen.py @@ -273,7 +273,7 @@ subroutine RegPackBounds(RF, R, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(in) :: LB(:), UB(:) + integer(B4Ki), intent(in) :: LB(:), UB(:) ! If has an error, return if (RF%ErrStat /= ErrID_None) return @@ -287,7 +287,7 @@ subroutine RegUnpackBounds(RF, R, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) ! If has an error, return if (RF%ErrStat /= ErrID_None) return @@ -377,7 +377,7 @@ def gen_pack_alloc(w, dt, decl, rank): w.write(f'\n') if rank > 0: w.write(f'\n ! Write array bounds') - w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') + w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data), ubound(Data))') w.write(f'\n') w.write(f'\n ! Write data to file') w.write(f'\n call RegPack(RF, Data)') @@ -395,7 +395,7 @@ def gen_unpack_alloc(w, dt, decl, rank): w.write(f'\n integer(IntKi) :: stat') w.write(f'\n logical :: IsAllocated') if rank > 0: - w.write(f'\n integer(B8Ki) :: LB({rank}), UB({rank})') + w.write(f'\n integer(B4Ki) :: LB({rank}), UB({rank})') w.write(f'\n') w.write(f'\n ! If error, return') w.write(f'\n if (RF%ErrStat /= ErrID_None) return') @@ -449,7 +449,7 @@ def gen_pack_ptr(w, dt, decl, rank): if rank > 0: w.write(f'\n') w.write(f'\n ! Write array bounds') - w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') + w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data), ubound(Data))') w.write(f'\n') w.write(f'\n ! Write pointer info') w.write(f'\n call RegPackPointer(RF, c_loc(Data), PtrInIndex)') @@ -473,7 +473,7 @@ def gen_unpack_ptr(w, dt, decl, rank): w.write(f'\n type(RegFile), intent(inout) :: RF') w.write(f'\n {decl+", pointer, intent(out)":<36s} :: Data{dims}') if rank > 0: - w.write(f'\n integer(B8Ki), intent(out) :: LB(:), UB(:)') + w.write(f'\n integer(B4Ki), intent(out) :: LB(:), UB(:)') w.write(f'\n integer(IntKi) :: stat') w.write(f'\n integer(B8Ki) :: PtrIdx') w.write(f'\n logical :: IsAssociated') diff --git a/modules/nwtc-library/src/ModReg.f90 b/modules/nwtc-library/src/ModReg.f90 index ea398d46c3..48c664fe7d 100644 --- a/modules/nwtc-library/src/ModReg.f90 +++ b/modules/nwtc-library/src/ModReg.f90 @@ -340,7 +340,7 @@ subroutine RegUnpackPointer(RF, Ptr, Idx) subroutine RegPackBounds(RF, R, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(in) :: LB(:), UB(:) + integer(B4Ki), intent(in) :: LB(:), UB(:) ! If has an error, return if (RF%ErrStat /= ErrID_None) return @@ -354,7 +354,7 @@ subroutine RegPackBounds(RF, R, LB, UB) subroutine RegUnpackBounds(RF, R, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) ! If has an error, return if (RF%ErrStat /= ErrID_None) return @@ -576,7 +576,7 @@ subroutine PackAlloc_C1_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -588,7 +588,7 @@ subroutine UnpackAlloc_C1_Rank1(RF, Data) character(*), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -632,7 +632,7 @@ subroutine PackPtr_C1_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -647,7 +647,7 @@ subroutine PackPtr_C1_Rank1(RF, Data) subroutine UnpackPtr_C1_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -737,7 +737,7 @@ subroutine PackAlloc_C1_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -749,7 +749,7 @@ subroutine UnpackAlloc_C1_Rank2(RF, Data) character(*), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -793,7 +793,7 @@ subroutine PackPtr_C1_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -808,7 +808,7 @@ subroutine PackPtr_C1_Rank2(RF, Data) subroutine UnpackPtr_C1_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -898,7 +898,7 @@ subroutine PackAlloc_C1_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -910,7 +910,7 @@ subroutine UnpackAlloc_C1_Rank3(RF, Data) character(*), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -954,7 +954,7 @@ subroutine PackPtr_C1_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -969,7 +969,7 @@ subroutine PackPtr_C1_Rank3(RF, Data) subroutine UnpackPtr_C1_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1059,7 +1059,7 @@ subroutine PackAlloc_C1_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1071,7 +1071,7 @@ subroutine UnpackAlloc_C1_Rank4(RF, Data) character(*), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1115,7 +1115,7 @@ subroutine PackPtr_C1_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1130,7 +1130,7 @@ subroutine PackPtr_C1_Rank4(RF, Data) subroutine UnpackPtr_C1_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1220,7 +1220,7 @@ subroutine PackAlloc_C1_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1232,7 +1232,7 @@ subroutine UnpackAlloc_C1_Rank5(RF, Data) character(*), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1276,7 +1276,7 @@ subroutine PackPtr_C1_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1291,7 +1291,7 @@ subroutine PackPtr_C1_Rank5(RF, Data) subroutine UnpackPtr_C1_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1527,7 +1527,7 @@ subroutine PackAlloc_L1_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1539,7 +1539,7 @@ subroutine UnpackAlloc_L1_Rank1(RF, Data) logical, allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1583,7 +1583,7 @@ subroutine PackPtr_L1_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1598,7 +1598,7 @@ subroutine PackPtr_L1_Rank1(RF, Data) subroutine UnpackPtr_L1_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1688,7 +1688,7 @@ subroutine PackAlloc_L1_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1700,7 +1700,7 @@ subroutine UnpackAlloc_L1_Rank2(RF, Data) logical, allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1744,7 +1744,7 @@ subroutine PackPtr_L1_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1759,7 +1759,7 @@ subroutine PackPtr_L1_Rank2(RF, Data) subroutine UnpackPtr_L1_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1849,7 +1849,7 @@ subroutine PackAlloc_L1_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1861,7 +1861,7 @@ subroutine UnpackAlloc_L1_Rank3(RF, Data) logical, allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1905,7 +1905,7 @@ subroutine PackPtr_L1_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1920,7 +1920,7 @@ subroutine PackPtr_L1_Rank3(RF, Data) subroutine UnpackPtr_L1_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2010,7 +2010,7 @@ subroutine PackAlloc_L1_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2022,7 +2022,7 @@ subroutine UnpackAlloc_L1_Rank4(RF, Data) logical, allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2066,7 +2066,7 @@ subroutine PackPtr_L1_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2081,7 +2081,7 @@ subroutine PackPtr_L1_Rank4(RF, Data) subroutine UnpackPtr_L1_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2171,7 +2171,7 @@ subroutine PackAlloc_L1_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2183,7 +2183,7 @@ subroutine UnpackAlloc_L1_Rank5(RF, Data) logical, allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2227,7 +2227,7 @@ subroutine PackPtr_L1_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2242,7 +2242,7 @@ subroutine PackPtr_L1_Rank5(RF, Data) subroutine UnpackPtr_L1_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2478,7 +2478,7 @@ subroutine PackAlloc_I4_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2490,7 +2490,7 @@ subroutine UnpackAlloc_I4_Rank1(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2534,7 +2534,7 @@ subroutine PackPtr_I4_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2549,7 +2549,7 @@ subroutine PackPtr_I4_Rank1(RF, Data) subroutine UnpackPtr_I4_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2639,7 +2639,7 @@ subroutine PackAlloc_I4_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2651,7 +2651,7 @@ subroutine UnpackAlloc_I4_Rank2(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2695,7 +2695,7 @@ subroutine PackPtr_I4_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2710,7 +2710,7 @@ subroutine PackPtr_I4_Rank2(RF, Data) subroutine UnpackPtr_I4_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2800,7 +2800,7 @@ subroutine PackAlloc_I4_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2812,7 +2812,7 @@ subroutine UnpackAlloc_I4_Rank3(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2856,7 +2856,7 @@ subroutine PackPtr_I4_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2871,7 +2871,7 @@ subroutine PackPtr_I4_Rank3(RF, Data) subroutine UnpackPtr_I4_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2961,7 +2961,7 @@ subroutine PackAlloc_I4_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2973,7 +2973,7 @@ subroutine UnpackAlloc_I4_Rank4(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3017,7 +3017,7 @@ subroutine PackPtr_I4_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3032,7 +3032,7 @@ subroutine PackPtr_I4_Rank4(RF, Data) subroutine UnpackPtr_I4_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3122,7 +3122,7 @@ subroutine PackAlloc_I4_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3134,7 +3134,7 @@ subroutine UnpackAlloc_I4_Rank5(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3178,7 +3178,7 @@ subroutine PackPtr_I4_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3193,7 +3193,7 @@ subroutine PackPtr_I4_Rank5(RF, Data) subroutine UnpackPtr_I4_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3429,7 +3429,7 @@ subroutine PackAlloc_I8_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3441,7 +3441,7 @@ subroutine UnpackAlloc_I8_Rank1(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3485,7 +3485,7 @@ subroutine PackPtr_I8_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3500,7 +3500,7 @@ subroutine PackPtr_I8_Rank1(RF, Data) subroutine UnpackPtr_I8_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3590,7 +3590,7 @@ subroutine PackAlloc_I8_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3602,7 +3602,7 @@ subroutine UnpackAlloc_I8_Rank2(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3646,7 +3646,7 @@ subroutine PackPtr_I8_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3661,7 +3661,7 @@ subroutine PackPtr_I8_Rank2(RF, Data) subroutine UnpackPtr_I8_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3751,7 +3751,7 @@ subroutine PackAlloc_I8_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3763,7 +3763,7 @@ subroutine UnpackAlloc_I8_Rank3(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3807,7 +3807,7 @@ subroutine PackPtr_I8_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3822,7 +3822,7 @@ subroutine PackPtr_I8_Rank3(RF, Data) subroutine UnpackPtr_I8_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3912,7 +3912,7 @@ subroutine PackAlloc_I8_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3924,7 +3924,7 @@ subroutine UnpackAlloc_I8_Rank4(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3968,7 +3968,7 @@ subroutine PackPtr_I8_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3983,7 +3983,7 @@ subroutine PackPtr_I8_Rank4(RF, Data) subroutine UnpackPtr_I8_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4073,7 +4073,7 @@ subroutine PackAlloc_I8_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4085,7 +4085,7 @@ subroutine UnpackAlloc_I8_Rank5(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4129,7 +4129,7 @@ subroutine PackPtr_I8_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4144,7 +4144,7 @@ subroutine PackPtr_I8_Rank5(RF, Data) subroutine UnpackPtr_I8_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4380,7 +4380,7 @@ subroutine PackAlloc_R4_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4392,7 +4392,7 @@ subroutine UnpackAlloc_R4_Rank1(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4436,7 +4436,7 @@ subroutine PackPtr_R4_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4451,7 +4451,7 @@ subroutine PackPtr_R4_Rank1(RF, Data) subroutine UnpackPtr_R4_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4541,7 +4541,7 @@ subroutine PackAlloc_R4_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4553,7 +4553,7 @@ subroutine UnpackAlloc_R4_Rank2(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4597,7 +4597,7 @@ subroutine PackPtr_R4_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4612,7 +4612,7 @@ subroutine PackPtr_R4_Rank2(RF, Data) subroutine UnpackPtr_R4_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4702,7 +4702,7 @@ subroutine PackAlloc_R4_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4714,7 +4714,7 @@ subroutine UnpackAlloc_R4_Rank3(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4758,7 +4758,7 @@ subroutine PackPtr_R4_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4773,7 +4773,7 @@ subroutine PackPtr_R4_Rank3(RF, Data) subroutine UnpackPtr_R4_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4863,7 +4863,7 @@ subroutine PackAlloc_R4_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4875,7 +4875,7 @@ subroutine UnpackAlloc_R4_Rank4(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4919,7 +4919,7 @@ subroutine PackPtr_R4_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4934,7 +4934,7 @@ subroutine PackPtr_R4_Rank4(RF, Data) subroutine UnpackPtr_R4_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5024,7 +5024,7 @@ subroutine PackAlloc_R4_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5036,7 +5036,7 @@ subroutine UnpackAlloc_R4_Rank5(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5080,7 +5080,7 @@ subroutine PackPtr_R4_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5095,7 +5095,7 @@ subroutine PackPtr_R4_Rank5(RF, Data) subroutine UnpackPtr_R4_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5331,7 +5331,7 @@ subroutine PackAlloc_R8_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5343,7 +5343,7 @@ subroutine UnpackAlloc_R8_Rank1(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5387,7 +5387,7 @@ subroutine PackPtr_R8_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5402,7 +5402,7 @@ subroutine PackPtr_R8_Rank1(RF, Data) subroutine UnpackPtr_R8_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5492,7 +5492,7 @@ subroutine PackAlloc_R8_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5504,7 +5504,7 @@ subroutine UnpackAlloc_R8_Rank2(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5548,7 +5548,7 @@ subroutine PackPtr_R8_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5563,7 +5563,7 @@ subroutine PackPtr_R8_Rank2(RF, Data) subroutine UnpackPtr_R8_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5653,7 +5653,7 @@ subroutine PackAlloc_R8_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5665,7 +5665,7 @@ subroutine UnpackAlloc_R8_Rank3(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5709,7 +5709,7 @@ subroutine PackPtr_R8_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5724,7 +5724,7 @@ subroutine PackPtr_R8_Rank3(RF, Data) subroutine UnpackPtr_R8_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5814,7 +5814,7 @@ subroutine PackAlloc_R8_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5826,7 +5826,7 @@ subroutine UnpackAlloc_R8_Rank4(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5870,7 +5870,7 @@ subroutine PackPtr_R8_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5885,7 +5885,7 @@ subroutine PackPtr_R8_Rank4(RF, Data) subroutine UnpackPtr_R8_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5975,7 +5975,7 @@ subroutine PackAlloc_R8_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5987,7 +5987,7 @@ subroutine UnpackAlloc_R8_Rank5(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -6031,7 +6031,7 @@ subroutine PackPtr_R8_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -6046,7 +6046,7 @@ subroutine PackPtr_R8_Rank5(RF, Data) subroutine UnpackPtr_R8_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index 829ae2a9c1..bedcf6183b 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -40,7 +40,7 @@ MODULE NWTC_Base INTEGER(IntKi), PARAMETER :: MinChanLen = 10 !< The min allowable length of channel names (i.e., width of output columns), used because some modules (like Bladed DLL outputs) have excessively long names INTEGER(IntKi), PARAMETER :: LinChanLen = 200 !< The allowable length of row/column names in linearization files - INTEGER(IntKi), PARAMETER :: MaxFileInfoLineLen = 1024 !< The allowable length of an input line stored in FileInfoType%Lines + INTEGER(IntKi), PARAMETER :: MaxFileInfoLineLen = 8192 !< The allowable length of an input line stored in FileInfoType%Lines INTEGER(IntKi), PARAMETER :: NWTC_Verbose = 10 !< The maximum level of verbosity INTEGER(IntKi), PARAMETER :: NWTC_VerboseLevel = 5 !< a number in [0, NWTC_Verbose]: 0 = no output; NWTC_Verbose=verbose; diff --git a/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 index 95437f702a..6bddd1120e 100644 --- a/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 +++ b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 @@ -58,14 +58,14 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapLinearizationType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMeshMapLinearizationTypeData%mi)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%mi) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%mi) if (.not. allocated(DstMeshMapLinearizationTypeData%mi)) then allocate(DstMeshMapLinearizationTypeData%mi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -76,8 +76,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%mi = SrcMeshMapLinearizationTypeData%mi end if if (allocated(SrcMeshMapLinearizationTypeData%fx_p)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%fx_p) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%fx_p) if (.not. allocated(DstMeshMapLinearizationTypeData%fx_p)) then allocate(DstMeshMapLinearizationTypeData%fx_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -88,8 +88,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%fx_p = SrcMeshMapLinearizationTypeData%fx_p end if if (allocated(SrcMeshMapLinearizationTypeData%tv_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uD) if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uD)) then allocate(DstMeshMapLinearizationTypeData%tv_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -100,8 +100,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%tv_uD = SrcMeshMapLinearizationTypeData%tv_uD end if if (allocated(SrcMeshMapLinearizationTypeData%tv_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uS) if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uS)) then allocate(DstMeshMapLinearizationTypeData%tv_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -112,8 +112,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%tv_uS = SrcMeshMapLinearizationTypeData%tv_uS end if if (allocated(SrcMeshMapLinearizationTypeData%ta_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uD) if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uD)) then allocate(DstMeshMapLinearizationTypeData%ta_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -124,8 +124,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%ta_uD = SrcMeshMapLinearizationTypeData%ta_uD end if if (allocated(SrcMeshMapLinearizationTypeData%ta_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uS) if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uS)) then allocate(DstMeshMapLinearizationTypeData%ta_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -136,8 +136,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%ta_uS = SrcMeshMapLinearizationTypeData%ta_uS end if if (allocated(SrcMeshMapLinearizationTypeData%ta_rv)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_rv) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_rv) if (.not. allocated(DstMeshMapLinearizationTypeData%ta_rv)) then allocate(DstMeshMapLinearizationTypeData%ta_rv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -148,8 +148,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%ta_rv = SrcMeshMapLinearizationTypeData%ta_rv end if if (allocated(SrcMeshMapLinearizationTypeData%li)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%li) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%li) if (.not. allocated(DstMeshMapLinearizationTypeData%li)) then allocate(DstMeshMapLinearizationTypeData%li(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -160,8 +160,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%li = SrcMeshMapLinearizationTypeData%li end if if (allocated(SrcMeshMapLinearizationTypeData%M_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uS) if (.not. allocated(DstMeshMapLinearizationTypeData%M_uS)) then allocate(DstMeshMapLinearizationTypeData%M_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -172,8 +172,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%M_uS = SrcMeshMapLinearizationTypeData%M_uS end if if (allocated(SrcMeshMapLinearizationTypeData%M_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uD) if (.not. allocated(DstMeshMapLinearizationTypeData%M_uD)) then allocate(DstMeshMapLinearizationTypeData%M_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -184,8 +184,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%M_uD = SrcMeshMapLinearizationTypeData%M_uD end if if (allocated(SrcMeshMapLinearizationTypeData%M_f)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_f) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_f) if (.not. allocated(DstMeshMapLinearizationTypeData%M_f)) then allocate(DstMeshMapLinearizationTypeData%M_f(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -262,7 +262,7 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(RF, OutData) type(RegFile), intent(inout) :: RF type(MeshMapLinearizationType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -285,16 +285,16 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMeshMapTypeData%MapLoads)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) + LB(1:1) = lbound(SrcMeshMapTypeData%MapLoads) + UB(1:1) = ubound(SrcMeshMapTypeData%MapLoads) if (.not. allocated(DstMeshMapTypeData%MapLoads)) then allocate(DstMeshMapTypeData%MapLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -309,8 +309,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, end do end if if (allocated(SrcMeshMapTypeData%MapMotions)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) + LB(1:1) = lbound(SrcMeshMapTypeData%MapMotions) + UB(1:1) = ubound(SrcMeshMapTypeData%MapMotions) if (.not. allocated(DstMeshMapTypeData%MapMotions)) then allocate(DstMeshMapTypeData%MapMotions(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -325,8 +325,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, end do end if if (allocated(SrcMeshMapTypeData%MapSrcToAugmt)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + LB(1:1) = lbound(SrcMeshMapTypeData%MapSrcToAugmt) + UB(1:1) = ubound(SrcMeshMapTypeData%MapSrcToAugmt) if (.not. allocated(DstMeshMapTypeData%MapSrcToAugmt)) then allocate(DstMeshMapTypeData%MapSrcToAugmt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -347,8 +347,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv)) then - LB(1:1) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) + LB(1:1) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv) + UB(1:1) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv) if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat_Piv)) then allocate(DstMeshMapTypeData%LoadLn2_A_Mat_Piv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -359,8 +359,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, DstMeshMapTypeData%LoadLn2_A_Mat_Piv = SrcMeshMapTypeData%LoadLn2_A_Mat_Piv end if if (allocated(SrcMeshMapTypeData%DisplacedPosition)) then - LB(1:3) = lbound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) - UB(1:3) = ubound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) + LB(1:3) = lbound(SrcMeshMapTypeData%DisplacedPosition) + UB(1:3) = ubound(SrcMeshMapTypeData%DisplacedPosition) if (.not. allocated(DstMeshMapTypeData%DisplacedPosition)) then allocate(DstMeshMapTypeData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -371,8 +371,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition end if if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat) if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat)) then allocate(DstMeshMapTypeData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -383,8 +383,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat end if if (allocated(SrcMeshMapTypeData%LoadLn2_F)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_F) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_F) if (.not. allocated(DstMeshMapTypeData%LoadLn2_F)) then allocate(DstMeshMapTypeData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -395,8 +395,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F end if if (allocated(SrcMeshMapTypeData%LoadLn2_M)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_M) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_M) if (.not. allocated(DstMeshMapTypeData%LoadLn2_M)) then allocate(DstMeshMapTypeData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -415,16 +415,16 @@ subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) type(MeshMapType), intent(inout) :: MeshMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(MeshMapTypeData%MapLoads)) then - LB(1:1) = lbound(MeshMapTypeData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapLoads, kind=B8Ki) + LB(1:1) = lbound(MeshMapTypeData%MapLoads) + UB(1:1) = ubound(MeshMapTypeData%MapLoads) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMapType(MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -432,8 +432,8 @@ subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) deallocate(MeshMapTypeData%MapLoads) end if if (allocated(MeshMapTypeData%MapMotions)) then - LB(1:1) = lbound(MeshMapTypeData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapMotions, kind=B8Ki) + LB(1:1) = lbound(MeshMapTypeData%MapMotions) + UB(1:1) = ubound(MeshMapTypeData%MapMotions) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMapType(MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -441,8 +441,8 @@ subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) deallocate(MeshMapTypeData%MapMotions) end if if (allocated(MeshMapTypeData%MapSrcToAugmt)) then - LB(1:1) = lbound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + LB(1:1) = lbound(MeshMapTypeData%MapSrcToAugmt) + UB(1:1) = ubound(MeshMapTypeData%MapSrcToAugmt) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMapType(MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -476,32 +476,32 @@ subroutine NWTC_Library_PackMeshMapType(RF, Indata) type(RegFile), intent(inout) :: RF type(MeshMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%MapLoads)) if (allocated(InData%MapLoads)) then - call RegPackBounds(RF, 1, lbound(InData%MapLoads, kind=B8Ki), ubound(InData%MapLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(InData%MapLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MapLoads), ubound(InData%MapLoads)) + LB(1:1) = lbound(InData%MapLoads) + UB(1:1) = ubound(InData%MapLoads) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(RF, InData%MapLoads(i1)) end do end if call RegPack(RF, allocated(InData%MapMotions)) if (allocated(InData%MapMotions)) then - call RegPackBounds(RF, 1, lbound(InData%MapMotions, kind=B8Ki), ubound(InData%MapMotions, kind=B8Ki)) - LB(1:1) = lbound(InData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(InData%MapMotions, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MapMotions), ubound(InData%MapMotions)) + LB(1:1) = lbound(InData%MapMotions) + UB(1:1) = ubound(InData%MapMotions) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(RF, InData%MapMotions(i1)) end do end if call RegPack(RF, allocated(InData%MapSrcToAugmt)) if (allocated(InData%MapSrcToAugmt)) then - call RegPackBounds(RF, 1, lbound(InData%MapSrcToAugmt, kind=B8Ki), ubound(InData%MapSrcToAugmt, kind=B8Ki)) - LB(1:1) = lbound(InData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(InData%MapSrcToAugmt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MapSrcToAugmt), ubound(InData%MapSrcToAugmt)) + LB(1:1) = lbound(InData%MapSrcToAugmt) + UB(1:1) = ubound(InData%MapSrcToAugmt) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(RF, InData%MapSrcToAugmt(i1)) end do @@ -521,8 +521,8 @@ subroutine NWTC_Library_UnPackMeshMapType(RF, OutData) type(RegFile), intent(inout) :: RF type(MeshMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 942fb383a6..3c010739bf 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -264,7 +264,7 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyFASTdataType' ErrStat = ErrID_None @@ -275,8 +275,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep if (allocated(SrcFASTdataTypeData%ChanNames)) then - LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames, kind=B8Ki) - UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames, kind=B8Ki) + LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames) if (.not. allocated(DstFASTdataTypeData%ChanNames)) then allocate(DstFASTdataTypeData%ChanNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -287,8 +287,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames end if if (allocated(SrcFASTdataTypeData%ChanUnits)) then - LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits, kind=B8Ki) - UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits, kind=B8Ki) + LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits) if (.not. allocated(DstFASTdataTypeData%ChanUnits)) then allocate(DstFASTdataTypeData%ChanUnits(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -299,8 +299,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits end if if (allocated(SrcFASTdataTypeData%Data)) then - LB(1:2) = lbound(SrcFASTdataTypeData%Data, kind=B8Ki) - UB(1:2) = ubound(SrcFASTdataTypeData%Data, kind=B8Ki) + LB(1:2) = lbound(SrcFASTdataTypeData%Data) + UB(1:2) = ubound(SrcFASTdataTypeData%Data) if (.not. allocated(DstFASTdataTypeData%Data)) then allocate(DstFASTdataTypeData%Data(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -350,7 +350,7 @@ subroutine NWTC_Library_UnPackFASTdataType(RF, OutData) type(RegFile), intent(inout) :: RF type(FASTdataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFASTdataType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -417,7 +417,7 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyFileInfoType' ErrStat = ErrID_None @@ -425,8 +425,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles if (allocated(SrcFileInfoTypeData%FileLine)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileLine, kind=B8Ki) - UB(1:1) = ubound(SrcFileInfoTypeData%FileLine, kind=B8Ki) + LB(1:1) = lbound(SrcFileInfoTypeData%FileLine) + UB(1:1) = ubound(SrcFileInfoTypeData%FileLine) if (.not. allocated(DstFileInfoTypeData%FileLine)) then allocate(DstFileInfoTypeData%FileLine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -437,8 +437,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine end if if (allocated(SrcFileInfoTypeData%FileIndx)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx, kind=B8Ki) - UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx, kind=B8Ki) + LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx) + UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx) if (.not. allocated(DstFileInfoTypeData%FileIndx)) then allocate(DstFileInfoTypeData%FileIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -449,8 +449,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx end if if (allocated(SrcFileInfoTypeData%FileList)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileList, kind=B8Ki) - UB(1:1) = ubound(SrcFileInfoTypeData%FileList, kind=B8Ki) + LB(1:1) = lbound(SrcFileInfoTypeData%FileList) + UB(1:1) = ubound(SrcFileInfoTypeData%FileList) if (.not. allocated(DstFileInfoTypeData%FileList)) then allocate(DstFileInfoTypeData%FileList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -461,8 +461,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList end if if (allocated(SrcFileInfoTypeData%Lines)) then - LB(1:1) = lbound(SrcFileInfoTypeData%Lines, kind=B8Ki) - UB(1:1) = ubound(SrcFileInfoTypeData%Lines, kind=B8Ki) + LB(1:1) = lbound(SrcFileInfoTypeData%Lines) + UB(1:1) = ubound(SrcFileInfoTypeData%Lines) if (.not. allocated(DstFileInfoTypeData%Lines)) then allocate(DstFileInfoTypeData%Lines(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -513,7 +513,7 @@ subroutine NWTC_Library_UnPackFileInfoType(RF, OutData) type(RegFile), intent(inout) :: RF type(FileInfoType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFileInfoType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -572,7 +572,7 @@ subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' ErrStat = ErrID_None @@ -580,8 +580,8 @@ subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed if (allocated(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then - LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry, kind=B8Ki) - UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry, kind=B8Ki) + LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) if (.not. allocated(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then allocate(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -622,7 +622,7 @@ subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(RF, OutData) type(RegFile), intent(inout) :: RF type(NWTC_RandomNumber_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -691,7 +691,7 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' @@ -717,8 +717,8 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr if (ErrStat >= AbortErrLev) return DstModVarTypeData%Name = SrcModVarTypeData%Name if (allocated(SrcModVarTypeData%LinNames)) then - LB(1:1) = lbound(SrcModVarTypeData%LinNames, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%LinNames, kind=B8Ki) + LB(1:1) = lbound(SrcModVarTypeData%LinNames) + UB(1:1) = ubound(SrcModVarTypeData%LinNames) if (.not. allocated(DstModVarTypeData%LinNames)) then allocate(DstModVarTypeData%LinNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -776,7 +776,7 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -806,8 +806,8 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarsType' @@ -818,8 +818,8 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny if (allocated(SrcModVarsTypeData%x)) then - LB(1:1) = lbound(SrcModVarsTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcModVarsTypeData%x, kind=B8Ki) + LB(1:1) = lbound(SrcModVarsTypeData%x) + UB(1:1) = ubound(SrcModVarsTypeData%x) if (.not. allocated(DstModVarsTypeData%x)) then allocate(DstModVarsTypeData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -834,8 +834,8 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, end do end if if (allocated(SrcModVarsTypeData%z)) then - LB(1:1) = lbound(SrcModVarsTypeData%z, kind=B8Ki) - UB(1:1) = ubound(SrcModVarsTypeData%z, kind=B8Ki) + LB(1:1) = lbound(SrcModVarsTypeData%z) + UB(1:1) = ubound(SrcModVarsTypeData%z) if (.not. allocated(DstModVarsTypeData%z)) then allocate(DstModVarsTypeData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -850,8 +850,8 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, end do end if if (allocated(SrcModVarsTypeData%u)) then - LB(1:1) = lbound(SrcModVarsTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcModVarsTypeData%u, kind=B8Ki) + LB(1:1) = lbound(SrcModVarsTypeData%u) + UB(1:1) = ubound(SrcModVarsTypeData%u) if (.not. allocated(DstModVarsTypeData%u)) then allocate(DstModVarsTypeData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -866,8 +866,8 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, end do end if if (allocated(SrcModVarsTypeData%y)) then - LB(1:1) = lbound(SrcModVarsTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModVarsTypeData%y, kind=B8Ki) + LB(1:1) = lbound(SrcModVarsTypeData%y) + UB(1:1) = ubound(SrcModVarsTypeData%y) if (.not. allocated(DstModVarsTypeData%y)) then allocate(DstModVarsTypeData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -887,16 +887,16 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) type(ModVarsType), intent(inout) :: ModVarsTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarsType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModVarsTypeData%x)) then - LB(1:1) = lbound(ModVarsTypeData%x, kind=B8Ki) - UB(1:1) = ubound(ModVarsTypeData%x, kind=B8Ki) + LB(1:1) = lbound(ModVarsTypeData%x) + UB(1:1) = ubound(ModVarsTypeData%x) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModVarType(ModVarsTypeData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -904,8 +904,8 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) deallocate(ModVarsTypeData%x) end if if (allocated(ModVarsTypeData%z)) then - LB(1:1) = lbound(ModVarsTypeData%z, kind=B8Ki) - UB(1:1) = ubound(ModVarsTypeData%z, kind=B8Ki) + LB(1:1) = lbound(ModVarsTypeData%z) + UB(1:1) = ubound(ModVarsTypeData%z) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModVarType(ModVarsTypeData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -913,8 +913,8 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) deallocate(ModVarsTypeData%z) end if if (allocated(ModVarsTypeData%u)) then - LB(1:1) = lbound(ModVarsTypeData%u, kind=B8Ki) - UB(1:1) = ubound(ModVarsTypeData%u, kind=B8Ki) + LB(1:1) = lbound(ModVarsTypeData%u) + UB(1:1) = ubound(ModVarsTypeData%u) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModVarType(ModVarsTypeData%u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -922,8 +922,8 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) deallocate(ModVarsTypeData%u) end if if (allocated(ModVarsTypeData%y)) then - LB(1:1) = lbound(ModVarsTypeData%y, kind=B8Ki) - UB(1:1) = ubound(ModVarsTypeData%y, kind=B8Ki) + LB(1:1) = lbound(ModVarsTypeData%y) + UB(1:1) = ubound(ModVarsTypeData%y) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModVarType(ModVarsTypeData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -936,8 +936,8 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) type(RegFile), intent(inout) :: RF type(ModVarsType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarsType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Nx) call RegPack(RF, InData%Nz) @@ -945,36 +945,36 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) call RegPack(RF, InData%Ny) call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call NWTC_Library_PackModVarType(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call NWTC_Library_PackModVarType(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) do i1 = LB(1), UB(1) call NWTC_Library_PackModVarType(RF, InData%u(i1)) end do end if call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - LB(1:1) = lbound(InData%y, kind=B8Ki) - UB(1:1) = ubound(InData%y, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) do i1 = LB(1), UB(1) call NWTC_Library_PackModVarType(RF, InData%y(i1)) end do @@ -986,8 +986,8 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModVarsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarsType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1055,7 +1055,7 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModJacType' ErrStat = ErrID_None @@ -1065,8 +1065,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%Nu = SrcModJacTypeData%Nu DstModJacTypeData%Ny = SrcModJacTypeData%Ny if (allocated(SrcModJacTypeData%x)) then - LB(1:1) = lbound(SrcModJacTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%x, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%x) + UB(1:1) = ubound(SrcModJacTypeData%x) if (.not. allocated(DstModJacTypeData%x)) then allocate(DstModJacTypeData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1077,8 +1077,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%x = SrcModJacTypeData%x end if if (allocated(SrcModJacTypeData%z)) then - LB(1:1) = lbound(SrcModJacTypeData%z, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%z, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%z) + UB(1:1) = ubound(SrcModJacTypeData%z) if (.not. allocated(DstModJacTypeData%z)) then allocate(DstModJacTypeData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1089,8 +1089,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%z = SrcModJacTypeData%z end if if (allocated(SrcModJacTypeData%u)) then - LB(1:1) = lbound(SrcModJacTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%u, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%u) + UB(1:1) = ubound(SrcModJacTypeData%u) if (.not. allocated(DstModJacTypeData%u)) then allocate(DstModJacTypeData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1101,8 +1101,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%u = SrcModJacTypeData%u end if if (allocated(SrcModJacTypeData%y)) then - LB(1:1) = lbound(SrcModJacTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%y, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%y) + UB(1:1) = ubound(SrcModJacTypeData%y) if (.not. allocated(DstModJacTypeData%y)) then allocate(DstModJacTypeData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1113,8 +1113,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%y = SrcModJacTypeData%y end if if (allocated(SrcModJacTypeData%x_perturb)) then - LB(1:1) = lbound(SrcModJacTypeData%x_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%x_perturb, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%x_perturb) + UB(1:1) = ubound(SrcModJacTypeData%x_perturb) if (.not. allocated(DstModJacTypeData%x_perturb)) then allocate(DstModJacTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1125,8 +1125,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%x_perturb = SrcModJacTypeData%x_perturb end if if (allocated(SrcModJacTypeData%z_perturb)) then - LB(1:1) = lbound(SrcModJacTypeData%z_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%z_perturb, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%z_perturb) + UB(1:1) = ubound(SrcModJacTypeData%z_perturb) if (.not. allocated(DstModJacTypeData%z_perturb)) then allocate(DstModJacTypeData%z_perturb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1137,8 +1137,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%z_perturb = SrcModJacTypeData%z_perturb end if if (allocated(SrcModJacTypeData%u_perturb)) then - LB(1:1) = lbound(SrcModJacTypeData%u_perturb, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%u_perturb, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%u_perturb) + UB(1:1) = ubound(SrcModJacTypeData%u_perturb) if (.not. allocated(DstModJacTypeData%u_perturb)) then allocate(DstModJacTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1149,8 +1149,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%u_perturb = SrcModJacTypeData%u_perturb end if if (allocated(SrcModJacTypeData%x_pos)) then - LB(1:1) = lbound(SrcModJacTypeData%x_pos, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%x_pos, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%x_pos) + UB(1:1) = ubound(SrcModJacTypeData%x_pos) if (.not. allocated(DstModJacTypeData%x_pos)) then allocate(DstModJacTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1161,8 +1161,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%x_pos = SrcModJacTypeData%x_pos end if if (allocated(SrcModJacTypeData%x_neg)) then - LB(1:1) = lbound(SrcModJacTypeData%x_neg, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%x_neg, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%x_neg) + UB(1:1) = ubound(SrcModJacTypeData%x_neg) if (.not. allocated(DstModJacTypeData%x_neg)) then allocate(DstModJacTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1173,8 +1173,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%x_neg = SrcModJacTypeData%x_neg end if if (allocated(SrcModJacTypeData%y_pos)) then - LB(1:1) = lbound(SrcModJacTypeData%y_pos, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%y_pos, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%y_pos) + UB(1:1) = ubound(SrcModJacTypeData%y_pos) if (.not. allocated(DstModJacTypeData%y_pos)) then allocate(DstModJacTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1185,8 +1185,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%y_pos = SrcModJacTypeData%y_pos end if if (allocated(SrcModJacTypeData%y_neg)) then - LB(1:1) = lbound(SrcModJacTypeData%y_neg, kind=B8Ki) - UB(1:1) = ubound(SrcModJacTypeData%y_neg, kind=B8Ki) + LB(1:1) = lbound(SrcModJacTypeData%y_neg) + UB(1:1) = ubound(SrcModJacTypeData%y_neg) if (.not. allocated(DstModJacTypeData%y_neg)) then allocate(DstModJacTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1197,8 +1197,8 @@ subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, Ctr DstModJacTypeData%y_neg = SrcModJacTypeData%y_neg end if if (allocated(SrcModJacTypeData%StateRotation)) then - LB(1:2) = lbound(SrcModJacTypeData%StateRotation, kind=B8Ki) - UB(1:2) = ubound(SrcModJacTypeData%StateRotation, kind=B8Ki) + LB(1:2) = lbound(SrcModJacTypeData%StateRotation) + UB(1:2) = ubound(SrcModJacTypeData%StateRotation) if (.not. allocated(DstModJacTypeData%StateRotation)) then allocate(DstModJacTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1283,7 +1283,7 @@ subroutine NWTC_Library_UnPackModJacType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModJacType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModJacType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1311,14 +1311,14 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModLinTypeData%x)) then - LB(1:1) = lbound(SrcModLinTypeData%x, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%x, kind=B8Ki) + LB(1:1) = lbound(SrcModLinTypeData%x) + UB(1:1) = ubound(SrcModLinTypeData%x) if (.not. allocated(DstModLinTypeData%x)) then allocate(DstModLinTypeData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1329,8 +1329,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%x = SrcModLinTypeData%x end if if (allocated(SrcModLinTypeData%dx)) then - LB(1:1) = lbound(SrcModLinTypeData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%dx, kind=B8Ki) + LB(1:1) = lbound(SrcModLinTypeData%dx) + UB(1:1) = ubound(SrcModLinTypeData%dx) if (.not. allocated(DstModLinTypeData%dx)) then allocate(DstModLinTypeData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1341,8 +1341,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%dx = SrcModLinTypeData%dx end if if (allocated(SrcModLinTypeData%z)) then - LB(1:1) = lbound(SrcModLinTypeData%z, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%z, kind=B8Ki) + LB(1:1) = lbound(SrcModLinTypeData%z) + UB(1:1) = ubound(SrcModLinTypeData%z) if (.not. allocated(DstModLinTypeData%z)) then allocate(DstModLinTypeData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1353,8 +1353,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%z = SrcModLinTypeData%z end if if (allocated(SrcModLinTypeData%u)) then - LB(1:1) = lbound(SrcModLinTypeData%u, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%u, kind=B8Ki) + LB(1:1) = lbound(SrcModLinTypeData%u) + UB(1:1) = ubound(SrcModLinTypeData%u) if (.not. allocated(DstModLinTypeData%u)) then allocate(DstModLinTypeData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1365,8 +1365,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%u = SrcModLinTypeData%u end if if (allocated(SrcModLinTypeData%y)) then - LB(1:1) = lbound(SrcModLinTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%y, kind=B8Ki) + LB(1:1) = lbound(SrcModLinTypeData%y) + UB(1:1) = ubound(SrcModLinTypeData%y) if (.not. allocated(DstModLinTypeData%y)) then allocate(DstModLinTypeData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1377,8 +1377,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%y = SrcModLinTypeData%y end if if (allocated(SrcModLinTypeData%J)) then - LB(1:2) = lbound(SrcModLinTypeData%J, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%J, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%J) + UB(1:2) = ubound(SrcModLinTypeData%J) if (.not. allocated(DstModLinTypeData%J)) then allocate(DstModLinTypeData%J(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1389,8 +1389,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%J = SrcModLinTypeData%J end if if (allocated(SrcModLinTypeData%dYdx)) then - LB(1:2) = lbound(SrcModLinTypeData%dYdx, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dYdx, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%dYdx) + UB(1:2) = ubound(SrcModLinTypeData%dYdx) if (.not. allocated(DstModLinTypeData%dYdx)) then allocate(DstModLinTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1401,8 +1401,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%dYdx = SrcModLinTypeData%dYdx end if if (allocated(SrcModLinTypeData%dXdx)) then - LB(1:2) = lbound(SrcModLinTypeData%dXdx, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dXdx, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%dXdx) + UB(1:2) = ubound(SrcModLinTypeData%dXdx) if (.not. allocated(DstModLinTypeData%dXdx)) then allocate(DstModLinTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1413,8 +1413,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%dXdx = SrcModLinTypeData%dXdx end if if (allocated(SrcModLinTypeData%dYdu)) then - LB(1:2) = lbound(SrcModLinTypeData%dYdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dYdu, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%dYdu) + UB(1:2) = ubound(SrcModLinTypeData%dYdu) if (.not. allocated(DstModLinTypeData%dYdu)) then allocate(DstModLinTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1425,8 +1425,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%dYdu = SrcModLinTypeData%dYdu end if if (allocated(SrcModLinTypeData%dXdu)) then - LB(1:2) = lbound(SrcModLinTypeData%dXdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dXdu, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%dXdu) + UB(1:2) = ubound(SrcModLinTypeData%dXdu) if (.not. allocated(DstModLinTypeData%dXdu)) then allocate(DstModLinTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1437,8 +1437,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%dXdu = SrcModLinTypeData%dXdu end if if (allocated(SrcModLinTypeData%dXdy)) then - LB(1:2) = lbound(SrcModLinTypeData%dXdy, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dXdy, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%dXdy) + UB(1:2) = ubound(SrcModLinTypeData%dXdy) if (.not. allocated(DstModLinTypeData%dXdy)) then allocate(DstModLinTypeData%dXdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1449,8 +1449,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%dXdy = SrcModLinTypeData%dXdy end if if (allocated(SrcModLinTypeData%dUdu)) then - LB(1:2) = lbound(SrcModLinTypeData%dUdu, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dUdu, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%dUdu) + UB(1:2) = ubound(SrcModLinTypeData%dUdu) if (.not. allocated(DstModLinTypeData%dUdu)) then allocate(DstModLinTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1461,8 +1461,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%dUdu = SrcModLinTypeData%dUdu end if if (allocated(SrcModLinTypeData%dUdy)) then - LB(1:2) = lbound(SrcModLinTypeData%dUdy, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%dUdy, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%dUdy) + UB(1:2) = ubound(SrcModLinTypeData%dUdy) if (.not. allocated(DstModLinTypeData%dUdy)) then allocate(DstModLinTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1473,8 +1473,8 @@ subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, Ctr DstModLinTypeData%dUdy = SrcModLinTypeData%dUdy end if if (allocated(SrcModLinTypeData%StateRotation)) then - LB(1:2) = lbound(SrcModLinTypeData%StateRotation, kind=B8Ki) - UB(1:2) = ubound(SrcModLinTypeData%StateRotation, kind=B8Ki) + LB(1:2) = lbound(SrcModLinTypeData%StateRotation) + UB(1:2) = ubound(SrcModLinTypeData%StateRotation) if (.not. allocated(DstModLinTypeData%StateRotation)) then allocate(DstModLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1563,7 +1563,7 @@ subroutine NWTC_Library_UnPackModLinType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModLinType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/nwtc-library/src/VTK.f90 b/modules/nwtc-library/src/VTK.f90 index e56ad540b5..19f3d967a9 100644 --- a/modules/nwtc-library/src/VTK.f90 +++ b/modules/nwtc-library/src/VTK.f90 @@ -157,8 +157,10 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel closeOnReturn = .FALSE. END IF + !$OMP critical CALL GetNewUnit( Un, ErrStat, ErrMsg ) CALL OpenFInpFile ( Un, TRIM(FileName), ErrStat, ErrMsg ) + !$OMP end critical if (ErrStat >= AbortErrLev) return CALL ReadCom( Un, FileName, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, 0 ) @@ -357,8 +359,10 @@ SUBROUTINE WrVTK_SP_header( FileName, descr, Un, ErrStat, ErrMsg ) INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< error level/status of OpenFOutFile operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< message when error occurs + !$OMP critical CALL GetNewUnit( Un, ErrStat, ErrMsg ) CALL OpenFOutFile ( Un, TRIM(FileName), ErrStat, ErrMsg ) + !$OMP end critical if (ErrStat >= AbortErrLev) return WRITE(Un,'(A)') '# vtk DataFile Version 3.0' diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 33b5ccf154..f38ebecd32 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -518,56 +518,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE END IF case (Module_ExtInfw) - - IF ( PRESENT(ExternInitData) ) THEN - Init%InData_ExtInfw%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade - Init%InData_ExtInfw%NumActForcePtsTower = ExternInitData%NumActForcePtsTower - ELSE - CALL SetErrStat( ErrID_Fatal, 'ExternalInflow integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - END IF - - ! get blade and tower info from AD. Assumption made that all blades have same spanwise characteristics - Init%InData_ExtInfw%BladeLength = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds) - if (allocated(Init%OutData_AD%rotors(1)%TwrElev)) then - Init%InData_ExtInfw%TowerHeight = Init%OutData_AD%rotors(1)%TwrElev(SIZE(Init%OutData_AD%rotors(1)%TwrElev)) - Init%OutData_AD%rotors(1)%TwrElev(1) ! TwrElev is based on ground or MSL. Need flexible tower length and first node - Init%InData_ExtInfw%TowerBaseHeight = Init%OutData_AD%rotors(1)%TwrElev(1) - ALLOCATE(Init%InData_ExtInfw%StructTwrHNodes( SIZE(Init%OutData_AD%rotors(1)%TwrElev)), STAT=ErrStat2) - if (FailedAlloc("Init%InData_ExtInfw%StructTwrHNodes")) return - Init%InData_ExtInfw%StructTwrHNodes(:) = Init%OutData_AD%rotors(1)%TwrElev(:) - else - Init%InData_ExtInfw%TowerHeight = 0.0_ReKi - Init%InData_ExtInfw%TowerBaseHeight = 0.0_ReKi - endif - - allocate(Init%InData_ExtInfw%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), stat=ErrStat2) - if (FailedAlloc("Init%InData_ExtInfw%StructBldRNodes")) return - - Init%InData_ExtInfw%StructBldRNodes(:) = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(:) - - ! Set node clustering type - Init%InData_ExtInfw%NodeClusterType = ExternInitData%NodeClusterType - - ! set up the data structures for integration with ExternalInflow - CALL Init_ExtInfw( Init%InData_ExtInfw, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, ExtInfw, Init%OutData_ExtInfw, ErrStat2, ErrMsg2 ) - if (Failed()) return - p_FAST%ModuleInitialized(Module_ExtInfw) = .TRUE. - - ! Add module to list of modules, return on error - CALL MV_AddModule(m_Glue%ModData, Module_ExtInfw, 'ExtInfw', 1, p_FAST%dt_module(Module_ExtInfw), p_FAST%DT, & - Init%OutData_ExtInfw%Vars, .false., ErrStat2, ErrMsg2) - if (Failed()) return - - !bjj: fix me!!! to do - Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi - - ! Set pointer to flowfield - IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtInfw%FlowField - - case default ! No wind - - ! Set mean wind speed to zero + ! ExtInfw requires initialization of AD first, so nothing executed here + case default Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi end select ! CompInflow @@ -767,6 +719,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%OutData_ADsk%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return + ! AeroDisk may override the AirDens value. Store this to inform other modules + AirDens = Init%OutData_ADsk%AirDens + end select ! CompAero !---------------------------------------------------------------------------- @@ -787,17 +742,70 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%OutData_ExtLd%Vars, .false., ErrStat2, ErrMsg2) if (Failed()) return - AirDens = Init%OutData_ExtLd%AirDens + ! ExtLd may override the AirDens value. Store this to inform other modules + AirDens = Init%OutData_ExtLd%AirDens END IF ! No aero of any sort ! ........................ - IF ( (p_FAST%CompAero /= Module_AD) .and. (p_FAST%CompAero /= Module_ExtLd) ) THEN - ELSE + IF ( (p_FAST%CompAero == Module_None) .or. (p_FAST%CompAero == Module_Unknown)) THEN AirDens = 0.0_ReKi + ENDIF + + + ! ........................ + ! initialize ExtInfw + ! Ideally this would be initialized in the same logic as InflowWind above. However AD outputs are required + ! ........................ + IF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + + IF ( PRESENT(ExternInitData) ) THEN + Init%InData_ExtInfw%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade + Init%InData_ExtInfw%NumActForcePtsTower = ExternInitData%NumActForcePtsTower + ELSE + CALL SetErrStat( ErrID_Fatal, 'ExternalInflow integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + END IF + ! get blade and tower info from AD. Assumption made that all blades have same spanwise characteristics + Init%InData_ExtInfw%BladeLength = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds) + if (allocated(Init%OutData_AD%rotors(1)%TwrElev)) then + Init%InData_ExtInfw%TowerHeight = Init%OutData_AD%rotors(1)%TwrElev(SIZE(Init%OutData_AD%rotors(1)%TwrElev)) - Init%OutData_AD%rotors(1)%TwrElev(1) ! TwrElev is based on ground or MSL. Need flexible tower length and first node + Init%InData_ExtInfw%TowerBaseHeight = Init%OutData_AD%rotors(1)%TwrElev(1) + ALLOCATE(Init%InData_ExtInfw%StructTwrHNodes( SIZE(Init%OutData_AD%rotors(1)%TwrElev)), STAT=ErrStat2) + Init%InData_ExtInfw%StructTwrHNodes(:) = Init%OutData_AD%rotors(1)%TwrElev(:) + else + Init%InData_ExtInfw%TowerHeight = 0.0_ReKi + Init%InData_ExtInfw%TowerBaseHeight = 0.0_ReKi + endif + ALLOCATE(Init%InData_ExtInfw%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), STAT=ErrStat2) + Init%InData_ExtInfw%StructBldRNodes(:) = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(:) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ExtInfw%InitInput.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + !Set node clustering type + Init%InData_ExtInfw%NodeClusterType = ExternInitData%NodeClusterType + ! set up the data structures for integration with ExternalInflow + CALL Init_ExtInfw( Init%InData_ExtInfw, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, ExtInfw, Init%OutData_ExtInfw, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + !bjj: fix me!!! to do + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi + + ! Set pointer to flowfield -- I would prefer that we did this through the AD_Init, but AD_InitOut results are required for ExtInfw_Init + IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtInfw%FlowField endif + !---------------------------------------------------------------------------- ! Initialize SuperController !---------------------------------------------------------------------------- @@ -830,15 +838,19 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE IF (p_FAST%CompHydro == Module_HD) THEN - Init%InData_HD%Gravity = p_FAST%Gravity - Init%InData_HD%UseInputFile = .TRUE. - Init%InData_HD%InputFile = p_FAST%HydroFile - Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) - Init%InData_HD%TMax = p_FAST%TMax - Init%InData_HD%Linearize = p_FAST%Linearize - Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn - Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField - if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes = .true. + Init%InData_HD%Gravity = p_FAST%Gravity + Init%InData_HD%UseInputFile = .TRUE. + Init%InData_HD%InputFile = p_FAST%HydroFile + Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) + Init%InData_HD%TMax = p_FAST%TMax + Init%InData_HD%Linearize = p_FAST%Linearize + Init%InData_HD%PlatformPos = Init%OutData_ED%PlatformPos ! Initial platform position; PlatformPos(1:3) is effectively the initial position of the HD origin + if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. + + ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true + Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn + Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField + ! end if ! Call module initialization routine CALL HydroDyn_Init(Init%InData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & @@ -1328,60 +1340,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE CALL FAST_InitOutput(p_FAST, y_FAST, Init, ErrStat2, ErrMsg2) if (Failed()) return - !---------------------------------------------------------------------------- - ! Init low-pass-filtered displacements of HydroDyn potential-flow bodies - !---------------------------------------------------------------------------- - - IF ( (p_FAST%CompHydro == Module_HD) .AND. (HD%p%PotMod == 1_IntKi) ) THEN - IF ( HD%p%WAMIT(1)%ExctnDisp == 2_IntKi ) THEN - ! Set the initial displacement of ED%PlatformPtMesh here to use MeshMapping - ED%y%PlatformPtMesh%TranslationDisp(:,1) = Init%OutData_ED%PlatformPos(1:3) - CALL SmllRotTrans( 'initial platform rotation ', & - REAL(Init%OutData_ED%PlatformPos(4),R8Ki), & - REAL(Init%OutData_ED%PlatformPos(5),R8Ki), & - REAL(Init%OutData_ED%PlatformPos(6),R8Ki), & - ED%y%PlatformPtMesh%Orientation(:,:,1), '', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ED%y%PlatformPtMesh%TranslationDisp(1,1) = ED%y%PlatformPtMesh%TranslationDisp(1,1) + ED%y%PlatformPtMesh%Orientation(3,1,1) * ED%p%PtfmRefzt - ED%y%PlatformPtMesh%TranslationDisp(2,1) = ED%y%PlatformPtMesh%TranslationDisp(2,1) + ED%y%PlatformPtMesh%Orientation(3,2,1) * ED%p%PtfmRefzt - ED%y%PlatformPtMesh%TranslationDisp(3,1) = ED%y%PlatformPtMesh%TranslationDisp(3,1) + ED%y%PlatformPtMesh%Orientation(3,3,1) * ED%p%PtfmRefzt - ED%p%PtfmRefzt - - ! Transfer the ED outputs of the platform motions to the HD input of which represents the same data - call MeshMapCreate(ED%y%PlatformPtMesh, HD%Input(1)%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2); if (Failed()) return - CALL Transfer_Point_to_Point(ED%y%PlatformPtMesh, HD%Input(1)%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2); if (Failed()) return - - ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body - IF (HD%Input(1)%WAMITMesh%Committed ) THEN - CALL MeshMapCreate(ED%y%PlatformPtMesh, HD%Input(1)%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2); if (Failed()) return - CALL Transfer_Point_to_Point(ED%y%PlatformPtMesh, HD%Input(1)%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2); if (Failed()) return - END IF - - ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body - IF (HD%Input(1)%Morison%Mesh%Committed ) THEN - CALL MeshMapCreate(ED%y%PlatformPtMesh, HD%Input(1)%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2); if (Failed()) return - CALL Transfer_Point_to_Point(ED%y%PlatformPtMesh, HD%Input(1)%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2); if (Failed()) return - END IF - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - IF (HD%p%NBodyMod == 1_IntKi) THEN ! One instance of WAMIT with NBody - DO i = 1,HD%p%NBody - HD%xd(STATE_CURR)%WAMIT(1)%BdyPosFilt(1,i,:) = HD%Input(1)%WAMITMesh%TranslationDisp(1,i) - HD%xd(STATE_CURR)%WAMIT(1)%BdyPosFilt(2,i,:) = HD%Input(1)%WAMITMesh%TranslationDisp(2,i) - END DO - ELSE IF (HD%p%NBodyMod > 1_IntKi) THEN ! NBody instances of WAMIT with one body each - DO i = 1,HD%p%NBody - HD%xd(STATE_CURR)%WAMIT(i)%BdyPosFilt(1,1,:) = HD%Input(1)%WAMITMesh%TranslationDisp(1,i) - HD%xd(STATE_CURR)%WAMIT(i)%BdyPosFilt(2,1,:) = HD%Input(1)%WAMITMesh%TranslationDisp(2,i) - END DO - END IF - END IF - END IF - !---------------------------------------------------------------------------- ! Initialize data for VTK output !---------------------------------------------------------------------------- @@ -1941,6 +1899,8 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%MHK /= MHK_None .and. p%MHK /= MHK_FixedBottom .and. p%MHK /= MHK_Floating) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%MHK /= MHK_None .and. p%Linearize) CALL SetErrStat( ErrID_Warn, 'Linearization is not fully implemented for an MHK turbine (buoyancy not included in perturbations, and added mass not included anywhere).', ErrStat, ErrMsg, RoutineName ) + IF (p%Gravity < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'Gravity must not be negative.', ErrStat, ErrMsg, RoutineName ) IF (p%WtrDpth < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'WtrDpth must not be negative.', ErrStat, ErrMsg, RoutineName ) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index a845083114..a2f5443b4e 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -804,14 +804,14 @@ subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurface integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_BLSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -848,7 +848,7 @@ subroutine FAST_UnPackVTK_BLSurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_VTK_BLSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_BLSurfaceType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -861,8 +861,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_SurfaceType' @@ -873,8 +873,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox if (allocated(SrcVTK_SurfaceTypeData%TowerRad)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad) if (.not. allocated(DstVTK_SurfaceTypeData%TowerRad)) then allocate(DstVTK_SurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -886,8 +886,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end if DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisX)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisX, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisX, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisX) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisX) if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisX)) then allocate(DstVTK_SurfaceTypeData%WaveElevVisX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -898,8 +898,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%WaveElevVisX = SrcVTK_SurfaceTypeData%WaveElevVisX end if if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisY)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisY, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisY, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisY) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisY) if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisY)) then allocate(DstVTK_SurfaceTypeData%WaveElevVisY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -910,8 +910,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%WaveElevVisY = SrcVTK_SurfaceTypeData%WaveElevVisY end if if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisGrid)) then - LB(1:3) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisGrid, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisGrid, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisGrid) + UB(1:3) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisGrid) if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisGrid)) then allocate(DstVTK_SurfaceTypeData%WaveElevVisGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -922,8 +922,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%WaveElevVisGrid = SrcVTK_SurfaceTypeData%WaveElevVisGrid end if if (allocated(SrcVTK_SurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape) if (.not. allocated(DstVTK_SurfaceTypeData%BladeShape)) then allocate(DstVTK_SurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -938,8 +938,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end do end if if (allocated(SrcVTK_SurfaceTypeData%MorisonVisRad)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonVisRad, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonVisRad, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonVisRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonVisRad) if (.not. allocated(DstVTK_SurfaceTypeData%MorisonVisRad)) then allocate(DstVTK_SurfaceTypeData%MorisonVisRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -955,8 +955,8 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) type(FAST_VTK_SurfaceType), intent(inout) :: VTK_SurfaceTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyVTK_SurfaceType' @@ -975,8 +975,8 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) deallocate(VTK_SurfaceTypeData%WaveElevVisGrid) end if if (allocated(VTK_SurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape) do i1 = LB(1), UB(1) call FAST_DestroyVTK_BLSurfaceType(VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -992,8 +992,8 @@ subroutine FAST_PackVTK_SurfaceType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_VTK_SurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_SurfaceType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%NumSectors) call RegPack(RF, InData%HubRad) @@ -1006,9 +1006,9 @@ subroutine FAST_PackVTK_SurfaceType(RF, Indata) call RegPackAlloc(RF, InData%WaveElevVisGrid) call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) do i1 = LB(1), UB(1) call FAST_PackVTK_BLSurfaceType(RF, InData%BladeShape(i1)) end do @@ -1021,8 +1021,8 @@ subroutine FAST_UnPackVTK_SurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_VTK_SurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_SurfaceType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1057,7 +1057,7 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_ModeShapeType' ErrStat = ErrID_None @@ -1066,8 +1066,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes if (allocated(SrcVTK_ModeShapeTypeData%VTKModes)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes) if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1082,8 +1082,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio) if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1094,8 +1094,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio end if if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1106,8 +1106,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz end if if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1118,8 +1118,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz end if if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1130,8 +1130,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude end if if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase) if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1195,7 +1195,7 @@ subroutine FAST_UnPackVTK_ModeShapeType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_VTK_ModeShapeType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1267,7 +1267,7 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyParam' @@ -1381,8 +1381,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindSpeedOrTSR = SrcParamData%WindSpeedOrTSR DstParamData%RotSpeedInit = SrcParamData%RotSpeedInit if (allocated(SrcParamData%RotSpeed)) then - LB(1:1) = lbound(SrcParamData%RotSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%RotSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%RotSpeed) + UB(1:1) = ubound(SrcParamData%RotSpeed) if (.not. allocated(DstParamData%RotSpeed)) then allocate(DstParamData%RotSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1393,8 +1393,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotSpeed = SrcParamData%RotSpeed end if if (allocated(SrcParamData%WS_TSR)) then - LB(1:1) = lbound(SrcParamData%WS_TSR, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WS_TSR, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WS_TSR) + UB(1:1) = ubound(SrcParamData%WS_TSR) if (.not. allocated(DstParamData%WS_TSR)) then allocate(DstParamData%WS_TSR(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1405,8 +1405,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WS_TSR = SrcParamData%WS_TSR end if if (allocated(SrcParamData%Pitch)) then - LB(1:1) = lbound(SrcParamData%Pitch, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Pitch, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Pitch) + UB(1:1) = ubound(SrcParamData%Pitch) if (.not. allocated(DstParamData%Pitch)) then allocate(DstParamData%Pitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1562,7 +1562,7 @@ subroutine FAST_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1681,14 +1681,14 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcLinTypeData%Names_u)) then - LB(1:1) = lbound(SrcLinTypeData%Names_u, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_u, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%Names_u) + UB(1:1) = ubound(SrcLinTypeData%Names_u) if (.not. allocated(DstLinTypeData%Names_u)) then allocate(DstLinTypeData%Names_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1699,8 +1699,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_u = SrcLinTypeData%Names_u end if if (allocated(SrcLinTypeData%Names_y)) then - LB(1:1) = lbound(SrcLinTypeData%Names_y, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_y, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%Names_y) + UB(1:1) = ubound(SrcLinTypeData%Names_y) if (.not. allocated(DstLinTypeData%Names_y)) then allocate(DstLinTypeData%Names_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1711,8 +1711,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_y = SrcLinTypeData%Names_y end if if (allocated(SrcLinTypeData%Names_x)) then - LB(1:1) = lbound(SrcLinTypeData%Names_x, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_x, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%Names_x) + UB(1:1) = ubound(SrcLinTypeData%Names_x) if (.not. allocated(DstLinTypeData%Names_x)) then allocate(DstLinTypeData%Names_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1723,8 +1723,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_x = SrcLinTypeData%Names_x end if if (allocated(SrcLinTypeData%Names_xd)) then - LB(1:1) = lbound(SrcLinTypeData%Names_xd, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_xd, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%Names_xd) + UB(1:1) = ubound(SrcLinTypeData%Names_xd) if (.not. allocated(DstLinTypeData%Names_xd)) then allocate(DstLinTypeData%Names_xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1735,8 +1735,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd end if if (allocated(SrcLinTypeData%Names_z)) then - LB(1:1) = lbound(SrcLinTypeData%Names_z, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_z, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%Names_z) + UB(1:1) = ubound(SrcLinTypeData%Names_z) if (.not. allocated(DstLinTypeData%Names_z)) then allocate(DstLinTypeData%Names_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1747,8 +1747,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_z = SrcLinTypeData%Names_z end if if (allocated(SrcLinTypeData%op_u)) then - LB(1:1) = lbound(SrcLinTypeData%op_u, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_u, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%op_u) + UB(1:1) = ubound(SrcLinTypeData%op_u) if (.not. allocated(DstLinTypeData%op_u)) then allocate(DstLinTypeData%op_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1759,8 +1759,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_u = SrcLinTypeData%op_u end if if (allocated(SrcLinTypeData%op_y)) then - LB(1:1) = lbound(SrcLinTypeData%op_y, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_y, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%op_y) + UB(1:1) = ubound(SrcLinTypeData%op_y) if (.not. allocated(DstLinTypeData%op_y)) then allocate(DstLinTypeData%op_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1771,8 +1771,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_y = SrcLinTypeData%op_y end if if (allocated(SrcLinTypeData%op_x)) then - LB(1:1) = lbound(SrcLinTypeData%op_x, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_x, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%op_x) + UB(1:1) = ubound(SrcLinTypeData%op_x) if (.not. allocated(DstLinTypeData%op_x)) then allocate(DstLinTypeData%op_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1783,8 +1783,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_x = SrcLinTypeData%op_x end if if (allocated(SrcLinTypeData%op_dx)) then - LB(1:1) = lbound(SrcLinTypeData%op_dx, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_dx, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%op_dx) + UB(1:1) = ubound(SrcLinTypeData%op_dx) if (.not. allocated(DstLinTypeData%op_dx)) then allocate(DstLinTypeData%op_dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1795,8 +1795,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_dx = SrcLinTypeData%op_dx end if if (allocated(SrcLinTypeData%op_xd)) then - LB(1:1) = lbound(SrcLinTypeData%op_xd, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_xd, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%op_xd) + UB(1:1) = ubound(SrcLinTypeData%op_xd) if (.not. allocated(DstLinTypeData%op_xd)) then allocate(DstLinTypeData%op_xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1807,8 +1807,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_xd = SrcLinTypeData%op_xd end if if (allocated(SrcLinTypeData%op_z)) then - LB(1:1) = lbound(SrcLinTypeData%op_z, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_z, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%op_z) + UB(1:1) = ubound(SrcLinTypeData%op_z) if (.not. allocated(DstLinTypeData%op_z)) then allocate(DstLinTypeData%op_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1819,8 +1819,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_z = SrcLinTypeData%op_z end if if (allocated(SrcLinTypeData%op_x_eig_mag)) then - LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag) if (.not. allocated(DstLinTypeData%op_x_eig_mag)) then allocate(DstLinTypeData%op_x_eig_mag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1831,8 +1831,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag end if if (allocated(SrcLinTypeData%op_x_eig_phase)) then - LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase) if (.not. allocated(DstLinTypeData%op_x_eig_phase)) then allocate(DstLinTypeData%op_x_eig_phase(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1843,8 +1843,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase end if if (allocated(SrcLinTypeData%Use_u)) then - LB(1:1) = lbound(SrcLinTypeData%Use_u, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Use_u, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%Use_u) + UB(1:1) = ubound(SrcLinTypeData%Use_u) if (.not. allocated(DstLinTypeData%Use_u)) then allocate(DstLinTypeData%Use_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1855,8 +1855,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Use_u = SrcLinTypeData%Use_u end if if (allocated(SrcLinTypeData%Use_y)) then - LB(1:1) = lbound(SrcLinTypeData%Use_y, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Use_y, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%Use_y) + UB(1:1) = ubound(SrcLinTypeData%Use_y) if (.not. allocated(DstLinTypeData%Use_y)) then allocate(DstLinTypeData%Use_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1867,8 +1867,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Use_y = SrcLinTypeData%Use_y end if if (allocated(SrcLinTypeData%A)) then - LB(1:2) = lbound(SrcLinTypeData%A, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%A, kind=B8Ki) + LB(1:2) = lbound(SrcLinTypeData%A) + UB(1:2) = ubound(SrcLinTypeData%A) if (.not. allocated(DstLinTypeData%A)) then allocate(DstLinTypeData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1879,8 +1879,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%A = SrcLinTypeData%A end if if (allocated(SrcLinTypeData%B)) then - LB(1:2) = lbound(SrcLinTypeData%B, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%B, kind=B8Ki) + LB(1:2) = lbound(SrcLinTypeData%B) + UB(1:2) = ubound(SrcLinTypeData%B) if (.not. allocated(DstLinTypeData%B)) then allocate(DstLinTypeData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1891,8 +1891,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%B = SrcLinTypeData%B end if if (allocated(SrcLinTypeData%C)) then - LB(1:2) = lbound(SrcLinTypeData%C, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%C, kind=B8Ki) + LB(1:2) = lbound(SrcLinTypeData%C) + UB(1:2) = ubound(SrcLinTypeData%C) if (.not. allocated(DstLinTypeData%C)) then allocate(DstLinTypeData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1903,8 +1903,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%C = SrcLinTypeData%C end if if (allocated(SrcLinTypeData%D)) then - LB(1:2) = lbound(SrcLinTypeData%D, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%D, kind=B8Ki) + LB(1:2) = lbound(SrcLinTypeData%D) + UB(1:2) = ubound(SrcLinTypeData%D) if (.not. allocated(DstLinTypeData%D)) then allocate(DstLinTypeData%D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1915,8 +1915,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%D = SrcLinTypeData%D end if if (allocated(SrcLinTypeData%StateRotation)) then - LB(1:2) = lbound(SrcLinTypeData%StateRotation, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%StateRotation, kind=B8Ki) + LB(1:2) = lbound(SrcLinTypeData%StateRotation) + UB(1:2) = ubound(SrcLinTypeData%StateRotation) if (.not. allocated(DstLinTypeData%StateRotation)) then allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1927,8 +1927,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation end if if (allocated(SrcLinTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcLinTypeData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLinTypeData%IsLoad_u) if (.not. allocated(DstLinTypeData%IsLoad_u)) then allocate(DstLinTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1939,8 +1939,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u end if if (allocated(SrcLinTypeData%RotFrame_u)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%RotFrame_u) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_u) if (.not. allocated(DstLinTypeData%RotFrame_u)) then allocate(DstLinTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1951,8 +1951,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u end if if (allocated(SrcLinTypeData%RotFrame_y)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%RotFrame_y) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_y) if (.not. allocated(DstLinTypeData%RotFrame_y)) then allocate(DstLinTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1963,8 +1963,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y end if if (allocated(SrcLinTypeData%RotFrame_x)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%RotFrame_x) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_x) if (.not. allocated(DstLinTypeData%RotFrame_x)) then allocate(DstLinTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1975,8 +1975,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x end if if (allocated(SrcLinTypeData%RotFrame_z)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_z, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_z, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%RotFrame_z) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_z) if (.not. allocated(DstLinTypeData%RotFrame_z)) then allocate(DstLinTypeData%RotFrame_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1987,8 +1987,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z end if if (allocated(SrcLinTypeData%DerivOrder_x)) then - LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x) if (.not. allocated(DstLinTypeData%DerivOrder_x)) then allocate(DstLinTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2131,7 +2131,7 @@ subroutine FAST_UnPackLinType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_LinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2172,16 +2172,16 @@ subroutine FAST_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyModLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModLinTypeData%Instance)) then - LB(1:1) = lbound(SrcModLinTypeData%Instance, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%Instance, kind=B8Ki) + LB(1:1) = lbound(SrcModLinTypeData%Instance) + UB(1:1) = ubound(SrcModLinTypeData%Instance) if (.not. allocated(DstModLinTypeData%Instance)) then allocate(DstModLinTypeData%Instance(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2201,16 +2201,16 @@ subroutine FAST_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) type(FAST_ModLinType), intent(inout) :: ModLinTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyModLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModLinTypeData%Instance)) then - LB(1:1) = lbound(ModLinTypeData%Instance, kind=B8Ki) - UB(1:1) = ubound(ModLinTypeData%Instance, kind=B8Ki) + LB(1:1) = lbound(ModLinTypeData%Instance) + UB(1:1) = ubound(ModLinTypeData%Instance) do i1 = LB(1), UB(1) call FAST_DestroyLinType(ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2223,14 +2223,14 @@ subroutine FAST_PackModLinType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_ModLinType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackModLinType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Instance)) if (allocated(InData%Instance)) then - call RegPackBounds(RF, 1, lbound(InData%Instance, kind=B8Ki), ubound(InData%Instance, kind=B8Ki)) - LB(1:1) = lbound(InData%Instance, kind=B8Ki) - UB(1:1) = ubound(InData%Instance, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Instance), ubound(InData%Instance)) + LB(1:1) = lbound(InData%Instance) + UB(1:1) = ubound(InData%Instance) do i1 = LB(1), UB(1) call FAST_PackLinType(RF, InData%Instance(i1)) end do @@ -2242,8 +2242,8 @@ subroutine FAST_UnPackModLinType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_ModLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2268,15 +2268,15 @@ subroutine FAST_CopyLinFileType(SrcLinFileTypeData, DstLinFileTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyLinFileType' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcLinFileTypeData%Modules, kind=B8Ki) - UB(1:1) = ubound(SrcLinFileTypeData%Modules, kind=B8Ki) + LB(1:1) = lbound(SrcLinFileTypeData%Modules) + UB(1:1) = ubound(SrcLinFileTypeData%Modules) do i1 = LB(1), UB(1) call FAST_CopyModLinType(SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2294,15 +2294,15 @@ subroutine FAST_DestroyLinFileType(LinFileTypeData, ErrStat, ErrMsg) type(FAST_LinFileType), intent(inout) :: LinFileTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyLinFileType' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(LinFileTypeData%Modules, kind=B8Ki) - UB(1:1) = ubound(LinFileTypeData%Modules, kind=B8Ki) + LB(1:1) = lbound(LinFileTypeData%Modules) + UB(1:1) = ubound(LinFileTypeData%Modules) do i1 = LB(1), UB(1) call FAST_DestroyModLinType(LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2315,11 +2315,11 @@ subroutine FAST_PackLinFileType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_LinFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackLinFileType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%Modules, kind=B8Ki) - UB(1:1) = ubound(InData%Modules, kind=B8Ki) + LB(1:1) = lbound(InData%Modules) + UB(1:1) = ubound(InData%Modules) do i1 = LB(1), UB(1) call FAST_PackModLinType(RF, InData%Modules(i1)) end do @@ -2334,11 +2334,11 @@ subroutine FAST_UnPackLinFileType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_LinFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%Modules, kind=B8Ki) - UB(1:1) = ubound(OutData%Modules, kind=B8Ki) + LB(1:1) = lbound(OutData%Modules) + UB(1:1) = ubound(OutData%Modules) do i1 = LB(1), UB(1) call FAST_UnpackModLinType(RF, OutData%Modules(i1)) ! Modules end do @@ -2354,14 +2354,14 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyMiscLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscLinTypeData%LinTimes)) then - LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes) + UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes) if (.not. allocated(DstMiscLinTypeData%LinTimes)) then allocate(DstMiscLinTypeData%LinTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2373,8 +2373,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode if (allocated(SrcMiscLinTypeData%AzimTarget)) then - LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget) + UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget) if (.not. allocated(DstMiscLinTypeData%AzimTarget)) then allocate(DstMiscLinTypeData%AzimTarget(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2391,8 +2391,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx if (allocated(SrcMiscLinTypeData%Psi)) then - LB(1:1) = lbound(SrcMiscLinTypeData%Psi, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%Psi, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%Psi) + UB(1:1) = ubound(SrcMiscLinTypeData%Psi) if (.not. allocated(DstMiscLinTypeData%Psi)) then allocate(DstMiscLinTypeData%Psi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2403,8 +2403,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi end if if (allocated(SrcMiscLinTypeData%y_interp)) then - LB(1:1) = lbound(SrcMiscLinTypeData%y_interp, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%y_interp, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%y_interp) + UB(1:1) = ubound(SrcMiscLinTypeData%y_interp) if (.not. allocated(DstMiscLinTypeData%y_interp)) then allocate(DstMiscLinTypeData%y_interp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2415,8 +2415,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp end if if (allocated(SrcMiscLinTypeData%y_ref)) then - LB(1:1) = lbound(SrcMiscLinTypeData%y_ref, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%y_ref, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%y_ref) + UB(1:1) = ubound(SrcMiscLinTypeData%y_ref) if (.not. allocated(DstMiscLinTypeData%y_ref)) then allocate(DstMiscLinTypeData%y_ref(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2427,8 +2427,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref end if if (allocated(SrcMiscLinTypeData%Y_prevRot)) then - LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot, kind=B8Ki) - UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot, kind=B8Ki) + LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot) + UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot) if (.not. allocated(DstMiscLinTypeData%Y_prevRot)) then allocate(DstMiscLinTypeData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2492,7 +2492,7 @@ subroutine FAST_UnPackMiscLinType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_MiscLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2517,16 +2517,16 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyOutputFileType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputFileTypeData%TimeData)) then - LB(1:1) = lbound(SrcOutputFileTypeData%TimeData, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%TimeData, kind=B8Ki) + LB(1:1) = lbound(SrcOutputFileTypeData%TimeData) + UB(1:1) = ubound(SrcOutputFileTypeData%TimeData) if (.not. allocated(DstOutputFileTypeData%TimeData)) then allocate(DstOutputFileTypeData%TimeData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2537,8 +2537,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData end if if (allocated(SrcOutputFileTypeData%AllOutData)) then - LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData, kind=B8Ki) - UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData, kind=B8Ki) + LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData) + UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData) if (.not. allocated(DstOutputFileTypeData%AllOutData)) then allocate(DstOutputFileTypeData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2556,8 +2556,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines if (allocated(SrcOutputFileTypeData%ChannelNames)) then - LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames, kind=B8Ki) + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames) if (.not. allocated(DstOutputFileTypeData%ChannelNames)) then allocate(DstOutputFileTypeData%ChannelNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2568,8 +2568,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames end if if (allocated(SrcOutputFileTypeData%ChannelUnits)) then - LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits, kind=B8Ki) + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits) if (.not. allocated(DstOutputFileTypeData%ChannelUnits)) then allocate(DstOutputFileTypeData%ChannelUnits(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2579,8 +2579,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, end if DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits end if - LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver) + UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_CopyProgDesc(SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2601,8 +2601,8 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) type(FAST_OutputFileType), intent(inout) :: OutputFileTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyOutputFileType' @@ -2620,8 +2620,8 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) if (allocated(OutputFileTypeData%ChannelUnits)) then deallocate(OutputFileTypeData%ChannelUnits) end if - LB(1:1) = lbound(OutputFileTypeData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(OutputFileTypeData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(OutputFileTypeData%Module_Ver) + UB(1:1) = ubound(OutputFileTypeData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_DestroyProgDesc(OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2634,8 +2634,8 @@ subroutine FAST_PackOutputFileType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_OutputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%TimeData) call RegPackAlloc(RF, InData%AllOutData) @@ -2648,8 +2648,8 @@ subroutine FAST_PackOutputFileType(RF, Indata) call RegPack(RF, InData%FileDescLines) call RegPackAlloc(RF, InData%ChannelNames) call RegPackAlloc(RF, InData%ChannelUnits) - LB(1:1) = lbound(InData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(InData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(RF, InData%Module_Ver(i1)) end do @@ -2667,8 +2667,8 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_OutputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2683,8 +2683,8 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) call RegUnpack(RF, OutData%FileDescLines); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ChannelNames); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ChannelUnits); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(OutData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_UnpackProgDesc(RF, OutData%Module_Ver(i1)) ! Module_Ver end do @@ -2703,16 +2703,16 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyIceDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcIceDyn_DataData%x)) then - LB(1:2) = lbound(SrcIceDyn_DataData%x, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%x, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%x) + UB(1:2) = ubound(SrcIceDyn_DataData%x) if (.not. allocated(DstIceDyn_DataData%x)) then allocate(DstIceDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2729,8 +2729,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%xd)) then - LB(1:2) = lbound(SrcIceDyn_DataData%xd, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%xd, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%xd) + UB(1:2) = ubound(SrcIceDyn_DataData%xd) if (.not. allocated(DstIceDyn_DataData%xd)) then allocate(DstIceDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2747,8 +2747,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%z)) then - LB(1:2) = lbound(SrcIceDyn_DataData%z, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%z, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%z) + UB(1:2) = ubound(SrcIceDyn_DataData%z) if (.not. allocated(DstIceDyn_DataData%z)) then allocate(DstIceDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2765,8 +2765,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%OtherSt)) then - LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt) if (.not. allocated(DstIceDyn_DataData%OtherSt)) then allocate(DstIceDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2783,8 +2783,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%p)) then - LB(1:1) = lbound(SrcIceDyn_DataData%p, kind=B8Ki) - UB(1:1) = ubound(SrcIceDyn_DataData%p, kind=B8Ki) + LB(1:1) = lbound(SrcIceDyn_DataData%p) + UB(1:1) = ubound(SrcIceDyn_DataData%p) if (.not. allocated(DstIceDyn_DataData%p)) then allocate(DstIceDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2799,8 +2799,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%y)) then - LB(1:1) = lbound(SrcIceDyn_DataData%y, kind=B8Ki) - UB(1:1) = ubound(SrcIceDyn_DataData%y, kind=B8Ki) + LB(1:1) = lbound(SrcIceDyn_DataData%y) + UB(1:1) = ubound(SrcIceDyn_DataData%y) if (.not. allocated(DstIceDyn_DataData%y)) then allocate(DstIceDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2815,8 +2815,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%m)) then - LB(1:1) = lbound(SrcIceDyn_DataData%m, kind=B8Ki) - UB(1:1) = ubound(SrcIceDyn_DataData%m, kind=B8Ki) + LB(1:1) = lbound(SrcIceDyn_DataData%m) + UB(1:1) = ubound(SrcIceDyn_DataData%m) if (.not. allocated(DstIceDyn_DataData%m)) then allocate(DstIceDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2831,8 +2831,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%Input)) then - LB(1:2) = lbound(SrcIceDyn_DataData%Input, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%Input, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%Input) + UB(1:2) = ubound(SrcIceDyn_DataData%Input) if (.not. allocated(DstIceDyn_DataData%Input)) then allocate(DstIceDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2849,8 +2849,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%InputTimes)) then - LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes) if (.not. allocated(DstIceDyn_DataData%InputTimes)) then allocate(DstIceDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2866,16 +2866,16 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) type(IceDyn_Data), intent(inout) :: IceDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyIceDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(IceDyn_DataData%x)) then - LB(1:2) = lbound(IceDyn_DataData%x, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%x, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%x) + UB(1:2) = ubound(IceDyn_DataData%x) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyContState(IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) @@ -2885,8 +2885,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%x) end if if (allocated(IceDyn_DataData%xd)) then - LB(1:2) = lbound(IceDyn_DataData%xd, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%xd, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%xd) + UB(1:2) = ubound(IceDyn_DataData%xd) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyDiscState(IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) @@ -2896,8 +2896,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%xd) end if if (allocated(IceDyn_DataData%z)) then - LB(1:2) = lbound(IceDyn_DataData%z, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%z, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%z) + UB(1:2) = ubound(IceDyn_DataData%z) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyConstrState(IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) @@ -2907,8 +2907,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%z) end if if (allocated(IceDyn_DataData%OtherSt)) then - LB(1:2) = lbound(IceDyn_DataData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%OtherSt) + UB(1:2) = ubound(IceDyn_DataData%OtherSt) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyOtherState(IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) @@ -2918,8 +2918,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%OtherSt) end if if (allocated(IceDyn_DataData%p)) then - LB(1:1) = lbound(IceDyn_DataData%p, kind=B8Ki) - UB(1:1) = ubound(IceDyn_DataData%p, kind=B8Ki) + LB(1:1) = lbound(IceDyn_DataData%p) + UB(1:1) = ubound(IceDyn_DataData%p) do i1 = LB(1), UB(1) call IceD_DestroyParam(IceDyn_DataData%p(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2927,8 +2927,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%p) end if if (allocated(IceDyn_DataData%y)) then - LB(1:1) = lbound(IceDyn_DataData%y, kind=B8Ki) - UB(1:1) = ubound(IceDyn_DataData%y, kind=B8Ki) + LB(1:1) = lbound(IceDyn_DataData%y) + UB(1:1) = ubound(IceDyn_DataData%y) do i1 = LB(1), UB(1) call IceD_DestroyOutput(IceDyn_DataData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2936,8 +2936,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%y) end if if (allocated(IceDyn_DataData%m)) then - LB(1:1) = lbound(IceDyn_DataData%m, kind=B8Ki) - UB(1:1) = ubound(IceDyn_DataData%m, kind=B8Ki) + LB(1:1) = lbound(IceDyn_DataData%m) + UB(1:1) = ubound(IceDyn_DataData%m) do i1 = LB(1), UB(1) call IceD_DestroyMisc(IceDyn_DataData%m(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2945,8 +2945,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%m) end if if (allocated(IceDyn_DataData%Input)) then - LB(1:2) = lbound(IceDyn_DataData%Input, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%Input, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%Input) + UB(1:2) = ubound(IceDyn_DataData%Input) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyInput(IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) @@ -2964,14 +2964,14 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(IceDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:2) = lbound(InData%x, kind=B8Ki) - UB(1:2) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackContState(RF, InData%x(i1,i2)) @@ -2980,9 +2980,9 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:2) = lbound(InData%xd, kind=B8Ki) - UB(1:2) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackDiscState(RF, InData%xd(i1,i2)) @@ -2991,9 +2991,9 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:2) = lbound(InData%z, kind=B8Ki) - UB(1:2) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackConstrState(RF, InData%z(i1,i2)) @@ -3002,9 +3002,9 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:2) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackOtherState(RF, InData%OtherSt(i1,i2)) @@ -3013,36 +3013,36 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%p)) if (allocated(InData%p)) then - call RegPackBounds(RF, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) - LB(1:1) = lbound(InData%p, kind=B8Ki) - UB(1:1) = ubound(InData%p, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) do i1 = LB(1), UB(1) call IceD_PackParam(RF, InData%p(i1)) end do end if call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - LB(1:1) = lbound(InData%y, kind=B8Ki) - UB(1:1) = ubound(InData%y, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) do i1 = LB(1), UB(1) call IceD_PackOutput(RF, InData%y(i1)) end do end if call RegPack(RF, allocated(InData%m)) if (allocated(InData%m)) then - call RegPackBounds(RF, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) - LB(1:1) = lbound(InData%m, kind=B8Ki) - UB(1:1) = ubound(InData%m, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) do i1 = LB(1), UB(1) call IceD_PackMisc(RF, InData%m(i1)) end do end if call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:2) = lbound(InData%Input, kind=B8Ki) - UB(1:2) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackInput(RF, InData%Input(i1,i2)) @@ -3057,8 +3057,8 @@ subroutine FAST_UnPackIceDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(IceDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3185,16 +3185,16 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyBeamDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBeamDyn_DataData%x)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%x, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%x, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%x) + UB(1:2) = ubound(SrcBeamDyn_DataData%x) if (.not. allocated(DstBeamDyn_DataData%x)) then allocate(DstBeamDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3211,8 +3211,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%dxdt)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%dxdt, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%dxdt, kind=B8Ki) + LB(1:1) = lbound(SrcBeamDyn_DataData%dxdt) + UB(1:1) = ubound(SrcBeamDyn_DataData%dxdt) if (.not. allocated(DstBeamDyn_DataData%dxdt)) then allocate(DstBeamDyn_DataData%dxdt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3227,8 +3227,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%xd)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%xd, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%xd, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%xd) + UB(1:2) = ubound(SrcBeamDyn_DataData%xd) if (.not. allocated(DstBeamDyn_DataData%xd)) then allocate(DstBeamDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3245,8 +3245,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%z)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%z, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%z, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%z) + UB(1:2) = ubound(SrcBeamDyn_DataData%z) if (.not. allocated(DstBeamDyn_DataData%z)) then allocate(DstBeamDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3263,8 +3263,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%OtherSt)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt) if (.not. allocated(DstBeamDyn_DataData%OtherSt)) then allocate(DstBeamDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3281,8 +3281,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%p)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%p, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%p, kind=B8Ki) + LB(1:1) = lbound(SrcBeamDyn_DataData%p) + UB(1:1) = ubound(SrcBeamDyn_DataData%p) if (.not. allocated(DstBeamDyn_DataData%p)) then allocate(DstBeamDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3297,8 +3297,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%y)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%y, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%y, kind=B8Ki) + LB(1:1) = lbound(SrcBeamDyn_DataData%y) + UB(1:1) = ubound(SrcBeamDyn_DataData%y) if (.not. allocated(DstBeamDyn_DataData%y)) then allocate(DstBeamDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3313,8 +3313,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%m)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%m, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%m, kind=B8Ki) + LB(1:1) = lbound(SrcBeamDyn_DataData%m) + UB(1:1) = ubound(SrcBeamDyn_DataData%m) if (.not. allocated(DstBeamDyn_DataData%m)) then allocate(DstBeamDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3329,8 +3329,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%Input)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%Input, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%Input, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%Input) + UB(1:2) = ubound(SrcBeamDyn_DataData%Input) if (.not. allocated(DstBeamDyn_DataData%Input)) then allocate(DstBeamDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3347,8 +3347,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%InputTimes)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes) if (.not. allocated(DstBeamDyn_DataData%InputTimes)) then allocate(DstBeamDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3364,16 +3364,16 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) type(BeamDyn_Data), intent(inout) :: BeamDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyBeamDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(BeamDyn_DataData%x)) then - LB(1:2) = lbound(BeamDyn_DataData%x, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%x, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%x) + UB(1:2) = ubound(BeamDyn_DataData%x) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyContState(BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) @@ -3383,8 +3383,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%x) end if if (allocated(BeamDyn_DataData%dxdt)) then - LB(1:1) = lbound(BeamDyn_DataData%dxdt, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%dxdt, kind=B8Ki) + LB(1:1) = lbound(BeamDyn_DataData%dxdt) + UB(1:1) = ubound(BeamDyn_DataData%dxdt) do i1 = LB(1), UB(1) call BD_DestroyContState(BeamDyn_DataData%dxdt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3392,8 +3392,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%dxdt) end if if (allocated(BeamDyn_DataData%xd)) then - LB(1:2) = lbound(BeamDyn_DataData%xd, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%xd, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%xd) + UB(1:2) = ubound(BeamDyn_DataData%xd) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyDiscState(BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) @@ -3403,8 +3403,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%xd) end if if (allocated(BeamDyn_DataData%z)) then - LB(1:2) = lbound(BeamDyn_DataData%z, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%z, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%z) + UB(1:2) = ubound(BeamDyn_DataData%z) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyConstrState(BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) @@ -3414,8 +3414,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%z) end if if (allocated(BeamDyn_DataData%OtherSt)) then - LB(1:2) = lbound(BeamDyn_DataData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%OtherSt) + UB(1:2) = ubound(BeamDyn_DataData%OtherSt) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyOtherState(BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) @@ -3425,8 +3425,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%OtherSt) end if if (allocated(BeamDyn_DataData%p)) then - LB(1:1) = lbound(BeamDyn_DataData%p, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%p, kind=B8Ki) + LB(1:1) = lbound(BeamDyn_DataData%p) + UB(1:1) = ubound(BeamDyn_DataData%p) do i1 = LB(1), UB(1) call BD_DestroyParam(BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3434,8 +3434,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%p) end if if (allocated(BeamDyn_DataData%y)) then - LB(1:1) = lbound(BeamDyn_DataData%y, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%y, kind=B8Ki) + LB(1:1) = lbound(BeamDyn_DataData%y) + UB(1:1) = ubound(BeamDyn_DataData%y) do i1 = LB(1), UB(1) call BD_DestroyOutput(BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3443,8 +3443,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%y) end if if (allocated(BeamDyn_DataData%m)) then - LB(1:1) = lbound(BeamDyn_DataData%m, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%m, kind=B8Ki) + LB(1:1) = lbound(BeamDyn_DataData%m) + UB(1:1) = ubound(BeamDyn_DataData%m) do i1 = LB(1), UB(1) call BD_DestroyMisc(BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3452,8 +3452,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%m) end if if (allocated(BeamDyn_DataData%Input)) then - LB(1:2) = lbound(BeamDyn_DataData%Input, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%Input, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%Input) + UB(1:2) = ubound(BeamDyn_DataData%Input) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyInput(BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) @@ -3471,14 +3471,14 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(BeamDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:2) = lbound(InData%x, kind=B8Ki) - UB(1:2) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackContState(RF, InData%x(i1,i2)) @@ -3487,18 +3487,18 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%dxdt)) if (allocated(InData%dxdt)) then - call RegPackBounds(RF, 1, lbound(InData%dxdt, kind=B8Ki), ubound(InData%dxdt, kind=B8Ki)) - LB(1:1) = lbound(InData%dxdt, kind=B8Ki) - UB(1:1) = ubound(InData%dxdt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%dxdt), ubound(InData%dxdt)) + LB(1:1) = lbound(InData%dxdt) + UB(1:1) = ubound(InData%dxdt) do i1 = LB(1), UB(1) call BD_PackContState(RF, InData%dxdt(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:2) = lbound(InData%xd, kind=B8Ki) - UB(1:2) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackDiscState(RF, InData%xd(i1,i2)) @@ -3507,9 +3507,9 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:2) = lbound(InData%z, kind=B8Ki) - UB(1:2) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackConstrState(RF, InData%z(i1,i2)) @@ -3518,9 +3518,9 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:2) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackOtherState(RF, InData%OtherSt(i1,i2)) @@ -3529,36 +3529,36 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%p)) if (allocated(InData%p)) then - call RegPackBounds(RF, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) - LB(1:1) = lbound(InData%p, kind=B8Ki) - UB(1:1) = ubound(InData%p, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) do i1 = LB(1), UB(1) call BD_PackParam(RF, InData%p(i1)) end do end if call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - LB(1:1) = lbound(InData%y, kind=B8Ki) - UB(1:1) = ubound(InData%y, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) do i1 = LB(1), UB(1) call BD_PackOutput(RF, InData%y(i1)) end do end if call RegPack(RF, allocated(InData%m)) if (allocated(InData%m)) then - call RegPackBounds(RF, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) - LB(1:1) = lbound(InData%m, kind=B8Ki) - UB(1:1) = ubound(InData%m, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) do i1 = LB(1), UB(1) call BD_PackMisc(RF, InData%m(i1)) end do end if call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:2) = lbound(InData%Input, kind=B8Ki) - UB(1:2) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackInput(RF, InData%Input(i1,i2)) @@ -3573,8 +3573,8 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(BeamDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3714,16 +3714,16 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcElastoDyn_DataData%x)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcElastoDyn_DataData%x) + UB(1:1) = ubound(SrcElastoDyn_DataData%x) if (.not. allocated(DstElastoDyn_DataData%x)) then allocate(DstElastoDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3741,8 +3741,8 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcElastoDyn_DataData%xd)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcElastoDyn_DataData%xd) + UB(1:1) = ubound(SrcElastoDyn_DataData%xd) if (.not. allocated(DstElastoDyn_DataData%xd)) then allocate(DstElastoDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3757,8 +3757,8 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, end do end if if (allocated(SrcElastoDyn_DataData%z)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcElastoDyn_DataData%z) + UB(1:1) = ubound(SrcElastoDyn_DataData%z) if (.not. allocated(DstElastoDyn_DataData%z)) then allocate(DstElastoDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3773,8 +3773,8 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, end do end if if (allocated(SrcElastoDyn_DataData%OtherSt)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt) if (.not. allocated(DstElastoDyn_DataData%OtherSt)) then allocate(DstElastoDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3798,8 +3798,8 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcElastoDyn_DataData%Input)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcElastoDyn_DataData%Input) + UB(1:1) = ubound(SrcElastoDyn_DataData%Input) if (.not. allocated(DstElastoDyn_DataData%Input)) then allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3814,8 +3814,8 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, end do end if if (allocated(SrcElastoDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes) if (.not. allocated(DstElastoDyn_DataData%InputTimes)) then allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3831,16 +3831,16 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) type(ElastoDyn_Data), intent(inout) :: ElastoDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(ElastoDyn_DataData%x)) then - LB(1:1) = lbound(ElastoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(ElastoDyn_DataData%x) + UB(1:1) = ubound(ElastoDyn_DataData%x) do i1 = LB(1), UB(1) call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3850,8 +3850,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) call ED_DestroyContState(ElastoDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ElastoDyn_DataData%xd)) then - LB(1:1) = lbound(ElastoDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(ElastoDyn_DataData%xd) + UB(1:1) = ubound(ElastoDyn_DataData%xd) do i1 = LB(1), UB(1) call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3859,8 +3859,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) deallocate(ElastoDyn_DataData%xd) end if if (allocated(ElastoDyn_DataData%z)) then - LB(1:1) = lbound(ElastoDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(ElastoDyn_DataData%z) + UB(1:1) = ubound(ElastoDyn_DataData%z) do i1 = LB(1), UB(1) call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3868,8 +3868,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) deallocate(ElastoDyn_DataData%z) end if if (allocated(ElastoDyn_DataData%OtherSt)) then - LB(1:1) = lbound(ElastoDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(ElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(ElastoDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3883,8 +3883,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ElastoDyn_DataData%Input)) then - LB(1:1) = lbound(ElastoDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(ElastoDyn_DataData%Input) + UB(1:1) = ubound(ElastoDyn_DataData%Input) do i1 = LB(1), UB(1) call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3900,14 +3900,14 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(ElastoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call ED_PackContState(RF, InData%x(i1)) end do @@ -3915,27 +3915,27 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) call ED_PackContState(RF, InData%dxdt) call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call ED_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call ED_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call ED_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -3945,9 +3945,9 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) call ED_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call ED_PackInput(RF, InData%Input(i1)) end do @@ -3960,8 +3960,8 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ElastoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4043,16 +4043,16 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopySED_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcSED_DataData%x)) then - LB(1:1) = lbound(SrcSED_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcSED_DataData%x) + UB(1:1) = ubound(SrcSED_DataData%x) if (.not. allocated(DstSED_DataData%x)) then allocate(DstSED_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4067,8 +4067,8 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcSED_DataData%xd)) then - LB(1:1) = lbound(SrcSED_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcSED_DataData%xd) + UB(1:1) = ubound(SrcSED_DataData%xd) if (.not. allocated(DstSED_DataData%xd)) then allocate(DstSED_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4083,8 +4083,8 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcSED_DataData%z)) then - LB(1:1) = lbound(SrcSED_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcSED_DataData%z) + UB(1:1) = ubound(SrcSED_DataData%z) if (.not. allocated(DstSED_DataData%z)) then allocate(DstSED_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4099,8 +4099,8 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcSED_DataData%OtherSt)) then - LB(1:1) = lbound(SrcSED_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcSED_DataData%OtherSt) + UB(1:1) = ubound(SrcSED_DataData%OtherSt) if (.not. allocated(DstSED_DataData%OtherSt)) then allocate(DstSED_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4124,8 +4124,8 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSED_DataData%Input)) then - LB(1:1) = lbound(SrcSED_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcSED_DataData%Input) + UB(1:1) = ubound(SrcSED_DataData%Input) if (.not. allocated(DstSED_DataData%Input)) then allocate(DstSED_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4140,8 +4140,8 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcSED_DataData%InputTimes)) then - LB(1:1) = lbound(SrcSED_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcSED_DataData%InputTimes) + UB(1:1) = ubound(SrcSED_DataData%InputTimes) if (.not. allocated(DstSED_DataData%InputTimes)) then allocate(DstSED_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4157,16 +4157,16 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) type(SED_Data), intent(inout) :: SED_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroySED_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SED_DataData%x)) then - LB(1:1) = lbound(SED_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SED_DataData%x) + UB(1:1) = ubound(SED_DataData%x) do i1 = LB(1), UB(1) call SED_DestroyContState(SED_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4174,8 +4174,8 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) deallocate(SED_DataData%x) end if if (allocated(SED_DataData%xd)) then - LB(1:1) = lbound(SED_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SED_DataData%xd) + UB(1:1) = ubound(SED_DataData%xd) do i1 = LB(1), UB(1) call SED_DestroyDiscState(SED_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4183,8 +4183,8 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) deallocate(SED_DataData%xd) end if if (allocated(SED_DataData%z)) then - LB(1:1) = lbound(SED_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SED_DataData%z) + UB(1:1) = ubound(SED_DataData%z) do i1 = LB(1), UB(1) call SED_DestroyConstrState(SED_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4192,8 +4192,8 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) deallocate(SED_DataData%z) end if if (allocated(SED_DataData%OtherSt)) then - LB(1:1) = lbound(SED_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SED_DataData%OtherSt) + UB(1:1) = ubound(SED_DataData%OtherSt) do i1 = LB(1), UB(1) call SED_DestroyOtherState(SED_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4207,8 +4207,8 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) call SED_DestroyMisc(SED_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SED_DataData%Input)) then - LB(1:1) = lbound(SED_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SED_DataData%Input) + UB(1:1) = ubound(SED_DataData%Input) do i1 = LB(1), UB(1) call SED_DestroyInput(SED_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4224,41 +4224,41 @@ subroutine FAST_PackSED_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(SED_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSED_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call SED_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call SED_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call SED_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call SED_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -4268,9 +4268,9 @@ subroutine FAST_PackSED_Data(RF, Indata) call SED_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call SED_PackInput(RF, InData%Input(i1)) end do @@ -4283,8 +4283,8 @@ subroutine FAST_UnPackSED_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSED_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4365,16 +4365,16 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcServoDyn_DataData%x)) then - LB(1:1) = lbound(SrcServoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcServoDyn_DataData%x) + UB(1:1) = ubound(SrcServoDyn_DataData%x) if (.not. allocated(DstServoDyn_DataData%x)) then allocate(DstServoDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4389,8 +4389,8 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct end do end if if (allocated(SrcServoDyn_DataData%xd)) then - LB(1:1) = lbound(SrcServoDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcServoDyn_DataData%xd) + UB(1:1) = ubound(SrcServoDyn_DataData%xd) if (.not. allocated(DstServoDyn_DataData%xd)) then allocate(DstServoDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4405,8 +4405,8 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct end do end if if (allocated(SrcServoDyn_DataData%z)) then - LB(1:1) = lbound(SrcServoDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcServoDyn_DataData%z) + UB(1:1) = ubound(SrcServoDyn_DataData%z) if (.not. allocated(DstServoDyn_DataData%z)) then allocate(DstServoDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4421,8 +4421,8 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct end do end if if (allocated(SrcServoDyn_DataData%OtherSt)) then - LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt) if (.not. allocated(DstServoDyn_DataData%OtherSt)) then allocate(DstServoDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4446,8 +4446,8 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcServoDyn_DataData%Input)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcServoDyn_DataData%Input) + UB(1:1) = ubound(SrcServoDyn_DataData%Input) if (.not. allocated(DstServoDyn_DataData%Input)) then allocate(DstServoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4462,8 +4462,8 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct end do end if if (allocated(SrcServoDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes) if (.not. allocated(DstServoDyn_DataData%InputTimes)) then allocate(DstServoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4479,16 +4479,16 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) type(ServoDyn_Data), intent(inout) :: ServoDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(ServoDyn_DataData%x)) then - LB(1:1) = lbound(ServoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(ServoDyn_DataData%x) + UB(1:1) = ubound(ServoDyn_DataData%x) do i1 = LB(1), UB(1) call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4496,8 +4496,8 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) deallocate(ServoDyn_DataData%x) end if if (allocated(ServoDyn_DataData%xd)) then - LB(1:1) = lbound(ServoDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(ServoDyn_DataData%xd) + UB(1:1) = ubound(ServoDyn_DataData%xd) do i1 = LB(1), UB(1) call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4505,8 +4505,8 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) deallocate(ServoDyn_DataData%xd) end if if (allocated(ServoDyn_DataData%z)) then - LB(1:1) = lbound(ServoDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(ServoDyn_DataData%z) + UB(1:1) = ubound(ServoDyn_DataData%z) do i1 = LB(1), UB(1) call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4514,8 +4514,8 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) deallocate(ServoDyn_DataData%z) end if if (allocated(ServoDyn_DataData%OtherSt)) then - LB(1:1) = lbound(ServoDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(ServoDyn_DataData%OtherSt) + UB(1:1) = ubound(ServoDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4529,8 +4529,8 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) call SrvD_DestroyMisc(ServoDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ServoDyn_DataData%Input)) then - LB(1:1) = lbound(ServoDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(ServoDyn_DataData%Input) + UB(1:1) = ubound(ServoDyn_DataData%Input) do i1 = LB(1), UB(1) call SrvD_DestroyInput(ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4546,41 +4546,41 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(ServoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call SrvD_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call SrvD_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call SrvD_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call SrvD_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -4590,9 +4590,9 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) call SrvD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call SrvD_PackInput(RF, InData%Input(i1)) end do @@ -4605,8 +4605,8 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ServoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4687,16 +4687,16 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcAeroDyn_DataData%x)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDyn_DataData%x) + UB(1:1) = ubound(SrcAeroDyn_DataData%x) if (.not. allocated(DstAeroDyn_DataData%x)) then allocate(DstAeroDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4711,8 +4711,8 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC end do end if if (allocated(SrcAeroDyn_DataData%xd)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDyn_DataData%xd) + UB(1:1) = ubound(SrcAeroDyn_DataData%xd) if (.not. allocated(DstAeroDyn_DataData%xd)) then allocate(DstAeroDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4727,8 +4727,8 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC end do end if if (allocated(SrcAeroDyn_DataData%z)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDyn_DataData%z) + UB(1:1) = ubound(SrcAeroDyn_DataData%z) if (.not. allocated(DstAeroDyn_DataData%z)) then allocate(DstAeroDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4743,8 +4743,8 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC end do end if if (allocated(SrcAeroDyn_DataData%OtherSt)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt) if (.not. allocated(DstAeroDyn_DataData%OtherSt)) then allocate(DstAeroDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4768,8 +4768,8 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroDyn_DataData%Input)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDyn_DataData%Input) + UB(1:1) = ubound(SrcAeroDyn_DataData%Input) if (.not. allocated(DstAeroDyn_DataData%Input)) then allocate(DstAeroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4784,8 +4784,8 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC end do end if if (allocated(SrcAeroDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes) if (.not. allocated(DstAeroDyn_DataData%InputTimes)) then allocate(DstAeroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4801,16 +4801,16 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) type(AeroDyn_Data), intent(inout) :: AeroDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(AeroDyn_DataData%x)) then - LB(1:1) = lbound(AeroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(AeroDyn_DataData%x) + UB(1:1) = ubound(AeroDyn_DataData%x) do i1 = LB(1), UB(1) call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4818,8 +4818,8 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) deallocate(AeroDyn_DataData%x) end if if (allocated(AeroDyn_DataData%xd)) then - LB(1:1) = lbound(AeroDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(AeroDyn_DataData%xd) + UB(1:1) = ubound(AeroDyn_DataData%xd) do i1 = LB(1), UB(1) call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4827,8 +4827,8 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) deallocate(AeroDyn_DataData%xd) end if if (allocated(AeroDyn_DataData%z)) then - LB(1:1) = lbound(AeroDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(AeroDyn_DataData%z) + UB(1:1) = ubound(AeroDyn_DataData%z) do i1 = LB(1), UB(1) call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4836,8 +4836,8 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) deallocate(AeroDyn_DataData%z) end if if (allocated(AeroDyn_DataData%OtherSt)) then - LB(1:1) = lbound(AeroDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(AeroDyn_DataData%OtherSt) + UB(1:1) = ubound(AeroDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4851,8 +4851,8 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) call AD_DestroyMisc(AeroDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn_DataData%Input)) then - LB(1:1) = lbound(AeroDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(AeroDyn_DataData%Input) + UB(1:1) = ubound(AeroDyn_DataData%Input) do i1 = LB(1), UB(1) call AD_DestroyInput(AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4868,41 +4868,41 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(AeroDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call AD_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call AD_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call AD_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call AD_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -4912,9 +4912,9 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) call AD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call AD_PackInput(RF, InData%Input(i1)) end do @@ -4927,8 +4927,8 @@ subroutine FAST_UnPackAeroDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(AeroDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5009,36 +5009,36 @@ subroutine FAST_CopyExtLoads_Data(SrcExtLoads_DataData, DstExtLoads_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyExtLoads_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcExtLoads_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%x) + UB(1:1) = ubound(SrcExtLoads_DataData%x) do i1 = LB(1), UB(1) call ExtLd_CopyContState(SrcExtLoads_DataData%x(i1), DstExtLoads_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtLoads_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%xd) + UB(1:1) = ubound(SrcExtLoads_DataData%xd) do i1 = LB(1), UB(1) call ExtLd_CopyDiscState(SrcExtLoads_DataData%xd(i1), DstExtLoads_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtLoads_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%z) + UB(1:1) = ubound(SrcExtLoads_DataData%z) do i1 = LB(1), UB(1) call ExtLd_CopyConstrState(SrcExtLoads_DataData%z(i1), DstExtLoads_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtLoads_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%OtherSt) + UB(1:1) = ubound(SrcExtLoads_DataData%OtherSt) do i1 = LB(1), UB(1) call ExtLd_CopyOtherState(SrcExtLoads_DataData%OtherSt(i1), DstExtLoads_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5057,8 +5057,8 @@ subroutine FAST_CopyExtLoads_Data(SrcExtLoads_DataData, DstExtLoads_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcExtLoads_DataData%InputTimes)) then - LB(1:1) = lbound(SrcExtLoads_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%InputTimes) + UB(1:1) = ubound(SrcExtLoads_DataData%InputTimes) if (.not. allocated(DstExtLoads_DataData%InputTimes)) then allocate(DstExtLoads_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5074,33 +5074,33 @@ subroutine FAST_DestroyExtLoads_Data(ExtLoads_DataData, ErrStat, ErrMsg) type(ExtLoads_Data), intent(inout) :: ExtLoads_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyExtLoads_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ExtLoads_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ExtLoads_DataData%x, kind=B8Ki) + LB(1:1) = lbound(ExtLoads_DataData%x) + UB(1:1) = ubound(ExtLoads_DataData%x) do i1 = LB(1), UB(1) call ExtLd_DestroyContState(ExtLoads_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtLoads_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(ExtLoads_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(ExtLoads_DataData%xd) + UB(1:1) = ubound(ExtLoads_DataData%xd) do i1 = LB(1), UB(1) call ExtLd_DestroyDiscState(ExtLoads_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtLoads_DataData%z, kind=B8Ki) - UB(1:1) = ubound(ExtLoads_DataData%z, kind=B8Ki) + LB(1:1) = lbound(ExtLoads_DataData%z) + UB(1:1) = ubound(ExtLoads_DataData%z) do i1 = LB(1), UB(1) call ExtLd_DestroyConstrState(ExtLoads_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtLoads_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(ExtLoads_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(ExtLoads_DataData%OtherSt) + UB(1:1) = ubound(ExtLoads_DataData%OtherSt) do i1 = LB(1), UB(1) call ExtLd_DestroyOtherState(ExtLoads_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5122,26 +5122,26 @@ subroutine FAST_PackExtLoads_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLoads_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExtLoads_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call ExtLd_PackContState(RF, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call ExtLd_PackDiscState(RF, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call ExtLd_PackConstrState(RF, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call ExtLd_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -5157,28 +5157,28 @@ subroutine FAST_UnPackExtLoads_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLoads_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExtLoads_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) call ExtLd_UnpackContState(RF, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) call ExtLd_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) call ExtLd_UnpackConstrState(RF, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) call ExtLd_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do @@ -5195,16 +5195,16 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyAeroDisk_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcAeroDisk_DataData%x)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDisk_DataData%x) + UB(1:1) = ubound(SrcAeroDisk_DataData%x) if (.not. allocated(DstAeroDisk_DataData%x)) then allocate(DstAeroDisk_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5219,8 +5219,8 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct end do end if if (allocated(SrcAeroDisk_DataData%xd)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDisk_DataData%xd) + UB(1:1) = ubound(SrcAeroDisk_DataData%xd) if (.not. allocated(DstAeroDisk_DataData%xd)) then allocate(DstAeroDisk_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5235,8 +5235,8 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct end do end if if (allocated(SrcAeroDisk_DataData%z)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDisk_DataData%z) + UB(1:1) = ubound(SrcAeroDisk_DataData%z) if (.not. allocated(DstAeroDisk_DataData%z)) then allocate(DstAeroDisk_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5251,8 +5251,8 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct end do end if if (allocated(SrcAeroDisk_DataData%OtherSt)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDisk_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDisk_DataData%OtherSt) if (.not. allocated(DstAeroDisk_DataData%OtherSt)) then allocate(DstAeroDisk_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5276,8 +5276,8 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroDisk_DataData%Input)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDisk_DataData%Input) + UB(1:1) = ubound(SrcAeroDisk_DataData%Input) if (.not. allocated(DstAeroDisk_DataData%Input)) then allocate(DstAeroDisk_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5292,8 +5292,8 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct end do end if if (allocated(SrcAeroDisk_DataData%InputTimes)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDisk_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDisk_DataData%InputTimes) if (.not. allocated(DstAeroDisk_DataData%InputTimes)) then allocate(DstAeroDisk_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5309,16 +5309,16 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) type(AeroDisk_Data), intent(inout) :: AeroDisk_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyAeroDisk_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(AeroDisk_DataData%x)) then - LB(1:1) = lbound(AeroDisk_DataData%x, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%x, kind=B8Ki) + LB(1:1) = lbound(AeroDisk_DataData%x) + UB(1:1) = ubound(AeroDisk_DataData%x) do i1 = LB(1), UB(1) call ADsk_DestroyContState(AeroDisk_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5326,8 +5326,8 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) deallocate(AeroDisk_DataData%x) end if if (allocated(AeroDisk_DataData%xd)) then - LB(1:1) = lbound(AeroDisk_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(AeroDisk_DataData%xd) + UB(1:1) = ubound(AeroDisk_DataData%xd) do i1 = LB(1), UB(1) call ADsk_DestroyDiscState(AeroDisk_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5335,8 +5335,8 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) deallocate(AeroDisk_DataData%xd) end if if (allocated(AeroDisk_DataData%z)) then - LB(1:1) = lbound(AeroDisk_DataData%z, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%z, kind=B8Ki) + LB(1:1) = lbound(AeroDisk_DataData%z) + UB(1:1) = ubound(AeroDisk_DataData%z) do i1 = LB(1), UB(1) call ADsk_DestroyConstrState(AeroDisk_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5344,8 +5344,8 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) deallocate(AeroDisk_DataData%z) end if if (allocated(AeroDisk_DataData%OtherSt)) then - LB(1:1) = lbound(AeroDisk_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(AeroDisk_DataData%OtherSt) + UB(1:1) = ubound(AeroDisk_DataData%OtherSt) do i1 = LB(1), UB(1) call ADsk_DestroyOtherState(AeroDisk_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5359,8 +5359,8 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) call ADsk_DestroyMisc(AeroDisk_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDisk_DataData%Input)) then - LB(1:1) = lbound(AeroDisk_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(AeroDisk_DataData%Input) + UB(1:1) = ubound(AeroDisk_DataData%Input) do i1 = LB(1), UB(1) call ADsk_DestroyInput(AeroDisk_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5376,41 +5376,41 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(AeroDisk_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackAeroDisk_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call ADsk_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call ADsk_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call ADsk_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call ADsk_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -5420,9 +5420,9 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) call ADsk_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call ADsk_PackInput(RF, InData%Input(i1)) end do @@ -5435,8 +5435,8 @@ subroutine FAST_UnPackAeroDisk_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(AeroDisk_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackAeroDisk_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5517,16 +5517,16 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInflowWind_DataData%x)) then - LB(1:1) = lbound(SrcInflowWind_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcInflowWind_DataData%x) + UB(1:1) = ubound(SrcInflowWind_DataData%x) if (.not. allocated(DstInflowWind_DataData%x)) then allocate(DstInflowWind_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5541,8 +5541,8 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa end do end if if (allocated(SrcInflowWind_DataData%xd)) then - LB(1:1) = lbound(SrcInflowWind_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcInflowWind_DataData%xd) + UB(1:1) = ubound(SrcInflowWind_DataData%xd) if (.not. allocated(DstInflowWind_DataData%xd)) then allocate(DstInflowWind_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5557,8 +5557,8 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa end do end if if (allocated(SrcInflowWind_DataData%z)) then - LB(1:1) = lbound(SrcInflowWind_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcInflowWind_DataData%z) + UB(1:1) = ubound(SrcInflowWind_DataData%z) if (.not. allocated(DstInflowWind_DataData%z)) then allocate(DstInflowWind_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5573,8 +5573,8 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa end do end if if (allocated(SrcInflowWind_DataData%OtherSt)) then - LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt) + UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt) if (.not. allocated(DstInflowWind_DataData%OtherSt)) then allocate(DstInflowWind_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5598,8 +5598,8 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInflowWind_DataData%Input)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcInflowWind_DataData%Input) + UB(1:1) = ubound(SrcInflowWind_DataData%Input) if (.not. allocated(DstInflowWind_DataData%Input)) then allocate(DstInflowWind_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5614,8 +5614,8 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa end do end if if (allocated(SrcInflowWind_DataData%InputTimes)) then - LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes) + UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes) if (.not. allocated(DstInflowWind_DataData%InputTimes)) then allocate(DstInflowWind_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5631,16 +5631,16 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) type(InflowWind_Data), intent(inout) :: InflowWind_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(InflowWind_DataData%x)) then - LB(1:1) = lbound(InflowWind_DataData%x, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%x, kind=B8Ki) + LB(1:1) = lbound(InflowWind_DataData%x) + UB(1:1) = ubound(InflowWind_DataData%x) do i1 = LB(1), UB(1) call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5648,8 +5648,8 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) deallocate(InflowWind_DataData%x) end if if (allocated(InflowWind_DataData%xd)) then - LB(1:1) = lbound(InflowWind_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(InflowWind_DataData%xd) + UB(1:1) = ubound(InflowWind_DataData%xd) do i1 = LB(1), UB(1) call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5657,8 +5657,8 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) deallocate(InflowWind_DataData%xd) end if if (allocated(InflowWind_DataData%z)) then - LB(1:1) = lbound(InflowWind_DataData%z, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%z, kind=B8Ki) + LB(1:1) = lbound(InflowWind_DataData%z) + UB(1:1) = ubound(InflowWind_DataData%z) do i1 = LB(1), UB(1) call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5666,8 +5666,8 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) deallocate(InflowWind_DataData%z) end if if (allocated(InflowWind_DataData%OtherSt)) then - LB(1:1) = lbound(InflowWind_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(InflowWind_DataData%OtherSt) + UB(1:1) = ubound(InflowWind_DataData%OtherSt) do i1 = LB(1), UB(1) call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5681,8 +5681,8 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) call InflowWind_DestroyMisc(InflowWind_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InflowWind_DataData%Input)) then - LB(1:1) = lbound(InflowWind_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(InflowWind_DataData%Input) + UB(1:1) = ubound(InflowWind_DataData%Input) do i1 = LB(1), UB(1) call InflowWind_DestroyInput(InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5698,41 +5698,41 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(InflowWind_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call InflowWind_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call InflowWind_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call InflowWind_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call InflowWind_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -5742,9 +5742,9 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) call InflowWind_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call InflowWind_PackInput(RF, InData%Input(i1)) end do @@ -5757,8 +5757,8 @@ subroutine FAST_UnPackInflowWind_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5966,16 +5966,16 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcSubDyn_DataData%x)) then - LB(1:1) = lbound(SrcSubDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcSubDyn_DataData%x) + UB(1:1) = ubound(SrcSubDyn_DataData%x) if (.not. allocated(DstSubDyn_DataData%x)) then allocate(DstSubDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5993,8 +5993,8 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSubDyn_DataData%xd)) then - LB(1:1) = lbound(SrcSubDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcSubDyn_DataData%xd) + UB(1:1) = ubound(SrcSubDyn_DataData%xd) if (.not. allocated(DstSubDyn_DataData%xd)) then allocate(DstSubDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6009,8 +6009,8 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode end do end if if (allocated(SrcSubDyn_DataData%z)) then - LB(1:1) = lbound(SrcSubDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcSubDyn_DataData%z) + UB(1:1) = ubound(SrcSubDyn_DataData%z) if (.not. allocated(DstSubDyn_DataData%z)) then allocate(DstSubDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6025,8 +6025,8 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode end do end if if (allocated(SrcSubDyn_DataData%OtherSt)) then - LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt) if (.not. allocated(DstSubDyn_DataData%OtherSt)) then allocate(DstSubDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6050,8 +6050,8 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSubDyn_DataData%Input)) then - LB(1:1) = lbound(SrcSubDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcSubDyn_DataData%Input) + UB(1:1) = ubound(SrcSubDyn_DataData%Input) if (.not. allocated(DstSubDyn_DataData%Input)) then allocate(DstSubDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6066,8 +6066,8 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode end do end if if (allocated(SrcSubDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes) if (.not. allocated(DstSubDyn_DataData%InputTimes)) then allocate(DstSubDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6083,16 +6083,16 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) type(SubDyn_Data), intent(inout) :: SubDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SubDyn_DataData%x)) then - LB(1:1) = lbound(SubDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SubDyn_DataData%x) + UB(1:1) = ubound(SubDyn_DataData%x) do i1 = LB(1), UB(1) call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6102,8 +6102,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) call SD_DestroyContState(SubDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SubDyn_DataData%xd)) then - LB(1:1) = lbound(SubDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SubDyn_DataData%xd) + UB(1:1) = ubound(SubDyn_DataData%xd) do i1 = LB(1), UB(1) call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6111,8 +6111,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) deallocate(SubDyn_DataData%xd) end if if (allocated(SubDyn_DataData%z)) then - LB(1:1) = lbound(SubDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SubDyn_DataData%z) + UB(1:1) = ubound(SubDyn_DataData%z) do i1 = LB(1), UB(1) call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6120,8 +6120,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) deallocate(SubDyn_DataData%z) end if if (allocated(SubDyn_DataData%OtherSt)) then - LB(1:1) = lbound(SubDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SubDyn_DataData%OtherSt) + UB(1:1) = ubound(SubDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6135,8 +6135,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SubDyn_DataData%Input)) then - LB(1:1) = lbound(SubDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SubDyn_DataData%Input) + UB(1:1) = ubound(SubDyn_DataData%Input) do i1 = LB(1), UB(1) call SD_DestroyInput(SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6152,14 +6152,14 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(SubDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call SD_PackContState(RF, InData%x(i1)) end do @@ -6167,27 +6167,27 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) call SD_PackContState(RF, InData%dxdt) call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call SD_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call SD_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call SD_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -6197,9 +6197,9 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) call SD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call SD_PackInput(RF, InData%Input(i1)) end do @@ -6212,8 +6212,8 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(SubDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6295,16 +6295,16 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcExtPtfm_DataData%x)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcExtPtfm_DataData%x) + UB(1:1) = ubound(SrcExtPtfm_DataData%x) if (.not. allocated(DstExtPtfm_DataData%x)) then allocate(DstExtPtfm_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6319,8 +6319,8 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC end do end if if (allocated(SrcExtPtfm_DataData%xd)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcExtPtfm_DataData%xd) + UB(1:1) = ubound(SrcExtPtfm_DataData%xd) if (.not. allocated(DstExtPtfm_DataData%xd)) then allocate(DstExtPtfm_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6335,8 +6335,8 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC end do end if if (allocated(SrcExtPtfm_DataData%z)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcExtPtfm_DataData%z) + UB(1:1) = ubound(SrcExtPtfm_DataData%z) if (.not. allocated(DstExtPtfm_DataData%z)) then allocate(DstExtPtfm_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6351,8 +6351,8 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC end do end if if (allocated(SrcExtPtfm_DataData%OtherSt)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt) if (.not. allocated(DstExtPtfm_DataData%OtherSt)) then allocate(DstExtPtfm_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6376,8 +6376,8 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcExtPtfm_DataData%Input)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcExtPtfm_DataData%Input) + UB(1:1) = ubound(SrcExtPtfm_DataData%Input) if (.not. allocated(DstExtPtfm_DataData%Input)) then allocate(DstExtPtfm_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6392,8 +6392,8 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC end do end if if (allocated(SrcExtPtfm_DataData%InputTimes)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes) + UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes) if (.not. allocated(DstExtPtfm_DataData%InputTimes)) then allocate(DstExtPtfm_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6409,16 +6409,16 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) type(ExtPtfm_Data), intent(inout) :: ExtPtfm_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(ExtPtfm_DataData%x)) then - LB(1:1) = lbound(ExtPtfm_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%x, kind=B8Ki) + LB(1:1) = lbound(ExtPtfm_DataData%x) + UB(1:1) = ubound(ExtPtfm_DataData%x) do i1 = LB(1), UB(1) call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6426,8 +6426,8 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) deallocate(ExtPtfm_DataData%x) end if if (allocated(ExtPtfm_DataData%xd)) then - LB(1:1) = lbound(ExtPtfm_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(ExtPtfm_DataData%xd) + UB(1:1) = ubound(ExtPtfm_DataData%xd) do i1 = LB(1), UB(1) call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6435,8 +6435,8 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) deallocate(ExtPtfm_DataData%xd) end if if (allocated(ExtPtfm_DataData%z)) then - LB(1:1) = lbound(ExtPtfm_DataData%z, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%z, kind=B8Ki) + LB(1:1) = lbound(ExtPtfm_DataData%z) + UB(1:1) = ubound(ExtPtfm_DataData%z) do i1 = LB(1), UB(1) call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6444,8 +6444,8 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) deallocate(ExtPtfm_DataData%z) end if if (allocated(ExtPtfm_DataData%OtherSt)) then - LB(1:1) = lbound(ExtPtfm_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(ExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(ExtPtfm_DataData%OtherSt) do i1 = LB(1), UB(1) call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6459,8 +6459,8 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) call ExtPtfm_DestroyMisc(ExtPtfm_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ExtPtfm_DataData%Input)) then - LB(1:1) = lbound(ExtPtfm_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(ExtPtfm_DataData%Input) + UB(1:1) = ubound(ExtPtfm_DataData%Input) do i1 = LB(1), UB(1) call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6476,41 +6476,41 @@ subroutine FAST_PackExtPtfm_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtPtfm_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call ExtPtfm_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call ExtPtfm_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call ExtPtfm_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call ExtPtfm_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -6520,9 +6520,9 @@ subroutine FAST_PackExtPtfm_Data(RF, Indata) call ExtPtfm_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call ExtPtfm_PackInput(RF, InData%Input(i1)) end do @@ -6535,8 +6535,8 @@ subroutine FAST_UnPackExtPtfm_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6617,16 +6617,16 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcSeaState_DataData%x)) then - LB(1:1) = lbound(SrcSeaState_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcSeaState_DataData%x) + UB(1:1) = ubound(SrcSeaState_DataData%x) if (.not. allocated(DstSeaState_DataData%x)) then allocate(DstSeaState_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6641,8 +6641,8 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct end do end if if (allocated(SrcSeaState_DataData%xd)) then - LB(1:1) = lbound(SrcSeaState_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcSeaState_DataData%xd) + UB(1:1) = ubound(SrcSeaState_DataData%xd) if (.not. allocated(DstSeaState_DataData%xd)) then allocate(DstSeaState_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6657,8 +6657,8 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct end do end if if (allocated(SrcSeaState_DataData%z)) then - LB(1:1) = lbound(SrcSeaState_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcSeaState_DataData%z) + UB(1:1) = ubound(SrcSeaState_DataData%z) if (.not. allocated(DstSeaState_DataData%z)) then allocate(DstSeaState_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6673,8 +6673,8 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct end do end if if (allocated(SrcSeaState_DataData%OtherSt)) then - LB(1:1) = lbound(SrcSeaState_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcSeaState_DataData%OtherSt) + UB(1:1) = ubound(SrcSeaState_DataData%OtherSt) if (.not. allocated(DstSeaState_DataData%OtherSt)) then allocate(DstSeaState_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6698,8 +6698,8 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSeaState_DataData%Input)) then - LB(1:1) = lbound(SrcSeaState_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcSeaState_DataData%Input) + UB(1:1) = ubound(SrcSeaState_DataData%Input) if (.not. allocated(DstSeaState_DataData%Input)) then allocate(DstSeaState_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6714,8 +6714,8 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct end do end if if (allocated(SrcSeaState_DataData%InputTimes)) then - LB(1:1) = lbound(SrcSeaState_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcSeaState_DataData%InputTimes) + UB(1:1) = ubound(SrcSeaState_DataData%InputTimes) if (.not. allocated(DstSeaState_DataData%InputTimes)) then allocate(DstSeaState_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6731,16 +6731,16 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) type(SeaState_Data), intent(inout) :: SeaState_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SeaState_DataData%x)) then - LB(1:1) = lbound(SeaState_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SeaState_DataData%x) + UB(1:1) = ubound(SeaState_DataData%x) do i1 = LB(1), UB(1) call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6748,8 +6748,8 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) deallocate(SeaState_DataData%x) end if if (allocated(SeaState_DataData%xd)) then - LB(1:1) = lbound(SeaState_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SeaState_DataData%xd) + UB(1:1) = ubound(SeaState_DataData%xd) do i1 = LB(1), UB(1) call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6757,8 +6757,8 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) deallocate(SeaState_DataData%xd) end if if (allocated(SeaState_DataData%z)) then - LB(1:1) = lbound(SeaState_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SeaState_DataData%z) + UB(1:1) = ubound(SeaState_DataData%z) do i1 = LB(1), UB(1) call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6766,8 +6766,8 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) deallocate(SeaState_DataData%z) end if if (allocated(SeaState_DataData%OtherSt)) then - LB(1:1) = lbound(SeaState_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SeaState_DataData%OtherSt) + UB(1:1) = ubound(SeaState_DataData%OtherSt) do i1 = LB(1), UB(1) call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6781,8 +6781,8 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaState_DataData%Input)) then - LB(1:1) = lbound(SeaState_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SeaState_DataData%Input) + UB(1:1) = ubound(SeaState_DataData%Input) do i1 = LB(1), UB(1) call SeaSt_DestroyInput(SeaState_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6798,41 +6798,41 @@ subroutine FAST_PackSeaState_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(SeaState_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call SeaSt_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call SeaSt_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call SeaSt_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -6842,9 +6842,9 @@ subroutine FAST_PackSeaState_Data(RF, Indata) call SeaSt_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call SeaSt_PackInput(RF, InData%Input(i1)) end do @@ -6857,8 +6857,8 @@ subroutine FAST_UnPackSeaState_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaState_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6939,16 +6939,16 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcHydroDyn_DataData%x)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcHydroDyn_DataData%x) + UB(1:1) = ubound(SrcHydroDyn_DataData%x) if (.not. allocated(DstHydroDyn_DataData%x)) then allocate(DstHydroDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6966,8 +6966,8 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcHydroDyn_DataData%xd)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcHydroDyn_DataData%xd) + UB(1:1) = ubound(SrcHydroDyn_DataData%xd) if (.not. allocated(DstHydroDyn_DataData%xd)) then allocate(DstHydroDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6982,8 +6982,8 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct end do end if if (allocated(SrcHydroDyn_DataData%z)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcHydroDyn_DataData%z) + UB(1:1) = ubound(SrcHydroDyn_DataData%z) if (.not. allocated(DstHydroDyn_DataData%z)) then allocate(DstHydroDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6998,8 +6998,8 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct end do end if if (allocated(SrcHydroDyn_DataData%OtherSt)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt) if (.not. allocated(DstHydroDyn_DataData%OtherSt)) then allocate(DstHydroDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7023,8 +7023,8 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcHydroDyn_DataData%Input)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcHydroDyn_DataData%Input) + UB(1:1) = ubound(SrcHydroDyn_DataData%Input) if (.not. allocated(DstHydroDyn_DataData%Input)) then allocate(DstHydroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7039,8 +7039,8 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct end do end if if (allocated(SrcHydroDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes) if (.not. allocated(DstHydroDyn_DataData%InputTimes)) then allocate(DstHydroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7056,16 +7056,16 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) type(HydroDyn_Data), intent(inout) :: HydroDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(HydroDyn_DataData%x)) then - LB(1:1) = lbound(HydroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(HydroDyn_DataData%x) + UB(1:1) = ubound(HydroDyn_DataData%x) do i1 = LB(1), UB(1) call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7075,8 +7075,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) call HydroDyn_DestroyContState(HydroDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(HydroDyn_DataData%xd)) then - LB(1:1) = lbound(HydroDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(HydroDyn_DataData%xd) + UB(1:1) = ubound(HydroDyn_DataData%xd) do i1 = LB(1), UB(1) call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7084,8 +7084,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) deallocate(HydroDyn_DataData%xd) end if if (allocated(HydroDyn_DataData%z)) then - LB(1:1) = lbound(HydroDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(HydroDyn_DataData%z) + UB(1:1) = ubound(HydroDyn_DataData%z) do i1 = LB(1), UB(1) call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7093,8 +7093,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) deallocate(HydroDyn_DataData%z) end if if (allocated(HydroDyn_DataData%OtherSt)) then - LB(1:1) = lbound(HydroDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(HydroDyn_DataData%OtherSt) + UB(1:1) = ubound(HydroDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7108,8 +7108,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(HydroDyn_DataData%Input)) then - LB(1:1) = lbound(HydroDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(HydroDyn_DataData%Input) + UB(1:1) = ubound(HydroDyn_DataData%Input) do i1 = LB(1), UB(1) call HydroDyn_DestroyInput(HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7125,14 +7125,14 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call HydroDyn_PackContState(RF, InData%x(i1)) end do @@ -7140,27 +7140,27 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) call HydroDyn_PackContState(RF, InData%dxdt) call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call HydroDyn_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call HydroDyn_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call HydroDyn_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -7170,9 +7170,9 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) call HydroDyn_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call HydroDyn_PackInput(RF, InData%Input(i1)) end do @@ -7185,8 +7185,8 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -7268,16 +7268,16 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcIceFloe_DataData%x)) then - LB(1:1) = lbound(SrcIceFloe_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcIceFloe_DataData%x) + UB(1:1) = ubound(SrcIceFloe_DataData%x) if (.not. allocated(DstIceFloe_DataData%x)) then allocate(DstIceFloe_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7292,8 +7292,8 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC end do end if if (allocated(SrcIceFloe_DataData%xd)) then - LB(1:1) = lbound(SrcIceFloe_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcIceFloe_DataData%xd) + UB(1:1) = ubound(SrcIceFloe_DataData%xd) if (.not. allocated(DstIceFloe_DataData%xd)) then allocate(DstIceFloe_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7308,8 +7308,8 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC end do end if if (allocated(SrcIceFloe_DataData%z)) then - LB(1:1) = lbound(SrcIceFloe_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcIceFloe_DataData%z) + UB(1:1) = ubound(SrcIceFloe_DataData%z) if (.not. allocated(DstIceFloe_DataData%z)) then allocate(DstIceFloe_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7324,8 +7324,8 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC end do end if if (allocated(SrcIceFloe_DataData%OtherSt)) then - LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt) + UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt) if (.not. allocated(DstIceFloe_DataData%OtherSt)) then allocate(DstIceFloe_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7349,8 +7349,8 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcIceFloe_DataData%Input)) then - LB(1:1) = lbound(SrcIceFloe_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcIceFloe_DataData%Input) + UB(1:1) = ubound(SrcIceFloe_DataData%Input) if (.not. allocated(DstIceFloe_DataData%Input)) then allocate(DstIceFloe_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7365,8 +7365,8 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC end do end if if (allocated(SrcIceFloe_DataData%InputTimes)) then - LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes) + UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes) if (.not. allocated(DstIceFloe_DataData%InputTimes)) then allocate(DstIceFloe_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7382,16 +7382,16 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) type(IceFloe_Data), intent(inout) :: IceFloe_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(IceFloe_DataData%x)) then - LB(1:1) = lbound(IceFloe_DataData%x, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%x, kind=B8Ki) + LB(1:1) = lbound(IceFloe_DataData%x) + UB(1:1) = ubound(IceFloe_DataData%x) do i1 = LB(1), UB(1) call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7399,8 +7399,8 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) deallocate(IceFloe_DataData%x) end if if (allocated(IceFloe_DataData%xd)) then - LB(1:1) = lbound(IceFloe_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(IceFloe_DataData%xd) + UB(1:1) = ubound(IceFloe_DataData%xd) do i1 = LB(1), UB(1) call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7408,8 +7408,8 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) deallocate(IceFloe_DataData%xd) end if if (allocated(IceFloe_DataData%z)) then - LB(1:1) = lbound(IceFloe_DataData%z, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%z, kind=B8Ki) + LB(1:1) = lbound(IceFloe_DataData%z) + UB(1:1) = ubound(IceFloe_DataData%z) do i1 = LB(1), UB(1) call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7417,8 +7417,8 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) deallocate(IceFloe_DataData%z) end if if (allocated(IceFloe_DataData%OtherSt)) then - LB(1:1) = lbound(IceFloe_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(IceFloe_DataData%OtherSt) + UB(1:1) = ubound(IceFloe_DataData%OtherSt) do i1 = LB(1), UB(1) call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7432,8 +7432,8 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) call IceFloe_DestroyMisc(IceFloe_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(IceFloe_DataData%Input)) then - LB(1:1) = lbound(IceFloe_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(IceFloe_DataData%Input) + UB(1:1) = ubound(IceFloe_DataData%Input) do i1 = LB(1), UB(1) call IceFloe_DestroyInput(IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7449,41 +7449,41 @@ subroutine FAST_PackIceFloe_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(IceFloe_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call IceFloe_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call IceFloe_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call IceFloe_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call IceFloe_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -7493,9 +7493,9 @@ subroutine FAST_PackIceFloe_Data(RF, Indata) call IceFloe_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call IceFloe_PackInput(RF, InData%Input(i1)) end do @@ -7508,8 +7508,8 @@ subroutine FAST_UnPackIceFloe_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(IceFloe_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -7590,16 +7590,16 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMAP_DataData%x)) then - LB(1:1) = lbound(SrcMAP_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcMAP_DataData%x) + UB(1:1) = ubound(SrcMAP_DataData%x) if (.not. allocated(DstMAP_DataData%x)) then allocate(DstMAP_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7614,8 +7614,8 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcMAP_DataData%xd)) then - LB(1:1) = lbound(SrcMAP_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcMAP_DataData%xd) + UB(1:1) = ubound(SrcMAP_DataData%xd) if (.not. allocated(DstMAP_DataData%xd)) then allocate(DstMAP_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7630,8 +7630,8 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcMAP_DataData%z)) then - LB(1:1) = lbound(SrcMAP_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcMAP_DataData%z) + UB(1:1) = ubound(SrcMAP_DataData%z) if (.not. allocated(DstMAP_DataData%z)) then allocate(DstMAP_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7661,8 +7661,8 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMAP_DataData%Input)) then - LB(1:1) = lbound(SrcMAP_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcMAP_DataData%Input) + UB(1:1) = ubound(SrcMAP_DataData%Input) if (.not. allocated(DstMAP_DataData%Input)) then allocate(DstMAP_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7677,8 +7677,8 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcMAP_DataData%InputTimes)) then - LB(1:1) = lbound(SrcMAP_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcMAP_DataData%InputTimes) + UB(1:1) = ubound(SrcMAP_DataData%InputTimes) if (.not. allocated(DstMAP_DataData%InputTimes)) then allocate(DstMAP_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7694,16 +7694,16 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) type(MAP_Data), intent(inout) :: MAP_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(MAP_DataData%x)) then - LB(1:1) = lbound(MAP_DataData%x, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%x, kind=B8Ki) + LB(1:1) = lbound(MAP_DataData%x) + UB(1:1) = ubound(MAP_DataData%x) do i1 = LB(1), UB(1) call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7711,8 +7711,8 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) deallocate(MAP_DataData%x) end if if (allocated(MAP_DataData%xd)) then - LB(1:1) = lbound(MAP_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(MAP_DataData%xd) + UB(1:1) = ubound(MAP_DataData%xd) do i1 = LB(1), UB(1) call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7720,8 +7720,8 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) deallocate(MAP_DataData%xd) end if if (allocated(MAP_DataData%z)) then - LB(1:1) = lbound(MAP_DataData%z, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%z, kind=B8Ki) + LB(1:1) = lbound(MAP_DataData%z) + UB(1:1) = ubound(MAP_DataData%z) do i1 = LB(1), UB(1) call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7739,8 +7739,8 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MAP_DataData%Input)) then - LB(1:1) = lbound(MAP_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(MAP_DataData%Input) + UB(1:1) = ubound(MAP_DataData%Input) do i1 = LB(1), UB(1) call MAP_DestroyInput(MAP_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7756,32 +7756,32 @@ subroutine FAST_PackMAP_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(MAP_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call MAP_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call MAP_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call MAP_PackConstrState(RF, InData%z(i1)) end do @@ -7793,9 +7793,9 @@ subroutine FAST_PackMAP_Data(RF, Indata) call MAP_PackOtherState(RF, InData%OtherSt_old) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call MAP_PackInput(RF, InData%Input(i1)) end do @@ -7808,8 +7808,8 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -7879,16 +7879,16 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcFEAMooring_DataData%x)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcFEAMooring_DataData%x) + UB(1:1) = ubound(SrcFEAMooring_DataData%x) if (.not. allocated(DstFEAMooring_DataData%x)) then allocate(DstFEAMooring_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7903,8 +7903,8 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa end do end if if (allocated(SrcFEAMooring_DataData%xd)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcFEAMooring_DataData%xd) + UB(1:1) = ubound(SrcFEAMooring_DataData%xd) if (.not. allocated(DstFEAMooring_DataData%xd)) then allocate(DstFEAMooring_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7919,8 +7919,8 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa end do end if if (allocated(SrcFEAMooring_DataData%z)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcFEAMooring_DataData%z) + UB(1:1) = ubound(SrcFEAMooring_DataData%z) if (.not. allocated(DstFEAMooring_DataData%z)) then allocate(DstFEAMooring_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7935,8 +7935,8 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa end do end if if (allocated(SrcFEAMooring_DataData%OtherSt)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt) + UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt) if (.not. allocated(DstFEAMooring_DataData%OtherSt)) then allocate(DstFEAMooring_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7960,8 +7960,8 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcFEAMooring_DataData%Input)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcFEAMooring_DataData%Input) + UB(1:1) = ubound(SrcFEAMooring_DataData%Input) if (.not. allocated(DstFEAMooring_DataData%Input)) then allocate(DstFEAMooring_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7976,8 +7976,8 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa end do end if if (allocated(SrcFEAMooring_DataData%InputTimes)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes) + UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes) if (.not. allocated(DstFEAMooring_DataData%InputTimes)) then allocate(DstFEAMooring_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7993,16 +7993,16 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) type(FEAMooring_Data), intent(inout) :: FEAMooring_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(FEAMooring_DataData%x)) then - LB(1:1) = lbound(FEAMooring_DataData%x, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%x, kind=B8Ki) + LB(1:1) = lbound(FEAMooring_DataData%x) + UB(1:1) = ubound(FEAMooring_DataData%x) do i1 = LB(1), UB(1) call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8010,8 +8010,8 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) deallocate(FEAMooring_DataData%x) end if if (allocated(FEAMooring_DataData%xd)) then - LB(1:1) = lbound(FEAMooring_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(FEAMooring_DataData%xd) + UB(1:1) = ubound(FEAMooring_DataData%xd) do i1 = LB(1), UB(1) call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8019,8 +8019,8 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) deallocate(FEAMooring_DataData%xd) end if if (allocated(FEAMooring_DataData%z)) then - LB(1:1) = lbound(FEAMooring_DataData%z, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%z, kind=B8Ki) + LB(1:1) = lbound(FEAMooring_DataData%z) + UB(1:1) = ubound(FEAMooring_DataData%z) do i1 = LB(1), UB(1) call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8028,8 +8028,8 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) deallocate(FEAMooring_DataData%z) end if if (allocated(FEAMooring_DataData%OtherSt)) then - LB(1:1) = lbound(FEAMooring_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(FEAMooring_DataData%OtherSt) + UB(1:1) = ubound(FEAMooring_DataData%OtherSt) do i1 = LB(1), UB(1) call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8043,8 +8043,8 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) call FEAM_DestroyMisc(FEAMooring_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(FEAMooring_DataData%Input)) then - LB(1:1) = lbound(FEAMooring_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(FEAMooring_DataData%Input) + UB(1:1) = ubound(FEAMooring_DataData%Input) do i1 = LB(1), UB(1) call FEAM_DestroyInput(FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8060,41 +8060,41 @@ subroutine FAST_PackFEAMooring_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(FEAMooring_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call FEAM_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call FEAM_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call FEAM_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call FEAM_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -8104,9 +8104,9 @@ subroutine FAST_PackFEAMooring_Data(RF, Indata) call FEAM_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call FEAM_PackInput(RF, InData%Input(i1)) end do @@ -8119,8 +8119,8 @@ subroutine FAST_UnPackFEAMooring_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAMooring_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -8201,16 +8201,16 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMoorDyn_DataData%x)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcMoorDyn_DataData%x) + UB(1:1) = ubound(SrcMoorDyn_DataData%x) if (.not. allocated(DstMoorDyn_DataData%x)) then allocate(DstMoorDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8225,8 +8225,8 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC end do end if if (allocated(SrcMoorDyn_DataData%xd)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcMoorDyn_DataData%xd) + UB(1:1) = ubound(SrcMoorDyn_DataData%xd) if (.not. allocated(DstMoorDyn_DataData%xd)) then allocate(DstMoorDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8241,8 +8241,8 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC end do end if if (allocated(SrcMoorDyn_DataData%z)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcMoorDyn_DataData%z) + UB(1:1) = ubound(SrcMoorDyn_DataData%z) if (.not. allocated(DstMoorDyn_DataData%z)) then allocate(DstMoorDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8257,8 +8257,8 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC end do end if if (allocated(SrcMoorDyn_DataData%OtherSt)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt) if (.not. allocated(DstMoorDyn_DataData%OtherSt)) then allocate(DstMoorDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8282,8 +8282,8 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMoorDyn_DataData%Input)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcMoorDyn_DataData%Input) + UB(1:1) = ubound(SrcMoorDyn_DataData%Input) if (.not. allocated(DstMoorDyn_DataData%Input)) then allocate(DstMoorDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8298,8 +8298,8 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC end do end if if (allocated(SrcMoorDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes) if (.not. allocated(DstMoorDyn_DataData%InputTimes)) then allocate(DstMoorDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8315,16 +8315,16 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) type(MoorDyn_Data), intent(inout) :: MoorDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(MoorDyn_DataData%x)) then - LB(1:1) = lbound(MoorDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%x, kind=B8Ki) + LB(1:1) = lbound(MoorDyn_DataData%x) + UB(1:1) = ubound(MoorDyn_DataData%x) do i1 = LB(1), UB(1) call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8332,8 +8332,8 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) deallocate(MoorDyn_DataData%x) end if if (allocated(MoorDyn_DataData%xd)) then - LB(1:1) = lbound(MoorDyn_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(MoorDyn_DataData%xd) + UB(1:1) = ubound(MoorDyn_DataData%xd) do i1 = LB(1), UB(1) call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8341,8 +8341,8 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) deallocate(MoorDyn_DataData%xd) end if if (allocated(MoorDyn_DataData%z)) then - LB(1:1) = lbound(MoorDyn_DataData%z, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%z, kind=B8Ki) + LB(1:1) = lbound(MoorDyn_DataData%z) + UB(1:1) = ubound(MoorDyn_DataData%z) do i1 = LB(1), UB(1) call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8350,8 +8350,8 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) deallocate(MoorDyn_DataData%z) end if if (allocated(MoorDyn_DataData%OtherSt)) then - LB(1:1) = lbound(MoorDyn_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(MoorDyn_DataData%OtherSt) + UB(1:1) = ubound(MoorDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8365,8 +8365,8 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) call MD_DestroyMisc(MoorDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MoorDyn_DataData%Input)) then - LB(1:1) = lbound(MoorDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(MoorDyn_DataData%Input) + UB(1:1) = ubound(MoorDyn_DataData%Input) do i1 = LB(1), UB(1) call MD_DestroyInput(MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8382,41 +8382,41 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(MoorDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call MD_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call MD_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call MD_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call MD_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -8426,9 +8426,9 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) call MD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call MD_PackInput(RF, InData%Input(i1)) end do @@ -8441,8 +8441,8 @@ subroutine FAST_UnPackMoorDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(MoorDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -8523,16 +8523,16 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOrcaFlex_DataData%x)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcOrcaFlex_DataData%x) + UB(1:1) = ubound(SrcOrcaFlex_DataData%x) if (.not. allocated(DstOrcaFlex_DataData%x)) then allocate(DstOrcaFlex_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8547,8 +8547,8 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct end do end if if (allocated(SrcOrcaFlex_DataData%xd)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcOrcaFlex_DataData%xd) + UB(1:1) = ubound(SrcOrcaFlex_DataData%xd) if (.not. allocated(DstOrcaFlex_DataData%xd)) then allocate(DstOrcaFlex_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8563,8 +8563,8 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct end do end if if (allocated(SrcOrcaFlex_DataData%z)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcOrcaFlex_DataData%z) + UB(1:1) = ubound(SrcOrcaFlex_DataData%z) if (.not. allocated(DstOrcaFlex_DataData%z)) then allocate(DstOrcaFlex_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8579,8 +8579,8 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct end do end if if (allocated(SrcOrcaFlex_DataData%OtherSt)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt) if (.not. allocated(DstOrcaFlex_DataData%OtherSt)) then allocate(DstOrcaFlex_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8604,8 +8604,8 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOrcaFlex_DataData%Input)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcOrcaFlex_DataData%Input) + UB(1:1) = ubound(SrcOrcaFlex_DataData%Input) if (.not. allocated(DstOrcaFlex_DataData%Input)) then allocate(DstOrcaFlex_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8620,8 +8620,8 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct end do end if if (allocated(SrcOrcaFlex_DataData%InputTimes)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes) + UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes) if (.not. allocated(DstOrcaFlex_DataData%InputTimes)) then allocate(DstOrcaFlex_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8637,16 +8637,16 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) type(OrcaFlex_Data), intent(inout) :: OrcaFlex_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(OrcaFlex_DataData%x)) then - LB(1:1) = lbound(OrcaFlex_DataData%x, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%x, kind=B8Ki) + LB(1:1) = lbound(OrcaFlex_DataData%x) + UB(1:1) = ubound(OrcaFlex_DataData%x) do i1 = LB(1), UB(1) call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8654,8 +8654,8 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) deallocate(OrcaFlex_DataData%x) end if if (allocated(OrcaFlex_DataData%xd)) then - LB(1:1) = lbound(OrcaFlex_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(OrcaFlex_DataData%xd) + UB(1:1) = ubound(OrcaFlex_DataData%xd) do i1 = LB(1), UB(1) call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8663,8 +8663,8 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) deallocate(OrcaFlex_DataData%xd) end if if (allocated(OrcaFlex_DataData%z)) then - LB(1:1) = lbound(OrcaFlex_DataData%z, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%z, kind=B8Ki) + LB(1:1) = lbound(OrcaFlex_DataData%z) + UB(1:1) = ubound(OrcaFlex_DataData%z) do i1 = LB(1), UB(1) call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8672,8 +8672,8 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) deallocate(OrcaFlex_DataData%z) end if if (allocated(OrcaFlex_DataData%OtherSt)) then - LB(1:1) = lbound(OrcaFlex_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(OrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(OrcaFlex_DataData%OtherSt) do i1 = LB(1), UB(1) call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8687,8 +8687,8 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) call Orca_DestroyMisc(OrcaFlex_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OrcaFlex_DataData%Input)) then - LB(1:1) = lbound(OrcaFlex_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(OrcaFlex_DataData%Input) + UB(1:1) = ubound(OrcaFlex_DataData%Input) do i1 = LB(1), UB(1) call Orca_DestroyInput(OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8704,41 +8704,41 @@ subroutine FAST_PackOrcaFlex_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(OrcaFlex_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call Orca_PackContState(RF, InData%x(i1)) end do end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call Orca_PackDiscState(RF, InData%xd(i1)) end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call Orca_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call Orca_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -8748,9 +8748,9 @@ subroutine FAST_PackOrcaFlex_Data(RF, Indata) call Orca_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) call Orca_PackInput(RF, InData%Input(i1)) end do @@ -8763,8 +8763,8 @@ subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(OrcaFlex_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -8845,16 +8845,16 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P) if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P)) then allocate(DstModuleMapTypeData%ED_P_2_BD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8869,8 +8869,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_P_2_ED_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P) if (.not. allocated(DstModuleMapTypeData%BD_P_2_ED_P)) then allocate(DstModuleMapTypeData%BD_P_2_ED_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8885,8 +8885,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) then allocate(DstModuleMapTypeData%ED_P_2_BD_P_Hub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8928,8 +8928,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) if (.not. allocated(DstModuleMapTypeData%ED_P_2_NStC_P_N)) then allocate(DstModuleMapTypeData%ED_P_2_NStC_P_N(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8944,8 +8944,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) then - LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) if (.not. allocated(DstModuleMapTypeData%NStC_P_2_ED_P_N)) then allocate(DstModuleMapTypeData%NStC_P_2_ED_P_N(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8960,8 +8960,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) if (.not. allocated(DstModuleMapTypeData%ED_L_2_TStC_P_T)) then allocate(DstModuleMapTypeData%ED_L_2_TStC_P_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8976,8 +8976,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) then - LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) if (.not. allocated(DstModuleMapTypeData%TStC_P_2_ED_P_T)) then allocate(DstModuleMapTypeData%TStC_P_2_ED_P_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8992,8 +8992,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) if (.not. allocated(DstModuleMapTypeData%ED_L_2_BStC_P_B)) then allocate(DstModuleMapTypeData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9010,8 +9010,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) if (.not. allocated(DstModuleMapTypeData%BStC_P_2_ED_P_B)) then allocate(DstModuleMapTypeData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9028,8 +9028,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) if (.not. allocated(DstModuleMapTypeData%BD_L_2_BStC_P_B)) then allocate(DstModuleMapTypeData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9046,8 +9046,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) if (.not. allocated(DstModuleMapTypeData%BStC_P_2_BD_P_B)) then allocate(DstModuleMapTypeData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9064,8 +9064,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) if (.not. allocated(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) then allocate(DstModuleMapTypeData%SStC_P_P_2_SubStructure(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9080,8 +9080,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) if (.not. allocated(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) then allocate(DstModuleMapTypeData%SubStructure_2_SStC_P_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9099,8 +9099,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) if (.not. allocated(DstModuleMapTypeData%BDED_L_2_AD_L_B)) then allocate(DstModuleMapTypeData%BDED_L_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9115,8 +9115,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%AD_L_2_BDED_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B) if (.not. allocated(DstModuleMapTypeData%AD_L_2_BDED_B)) then allocate(DstModuleMapTypeData%AD_L_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9131,8 +9131,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_L_2_BD_L)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L) if (.not. allocated(DstModuleMapTypeData%BD_L_2_BD_L)) then allocate(DstModuleMapTypeData%BD_L_2_BD_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9147,8 +9147,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SED_P_2_AD_L_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_L_B) + UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_L_B) if (.not. allocated(DstModuleMapTypeData%SED_P_2_AD_L_B)) then allocate(DstModuleMapTypeData%SED_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9163,8 +9163,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SED_P_2_AD_P_R)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_P_R) if (.not. allocated(DstModuleMapTypeData%SED_P_2_AD_P_R)) then allocate(DstModuleMapTypeData%SED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9179,8 +9179,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%AD_L_2_SED_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_SED_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_SED_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_SED_P) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_SED_P) if (.not. allocated(DstModuleMapTypeData%AD_L_2_SED_P)) then allocate(DstModuleMapTypeData%AD_L_2_SED_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9213,8 +9213,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R) if (.not. allocated(DstModuleMapTypeData%ED_P_2_AD_P_R)) then allocate(DstModuleMapTypeData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9256,8 +9256,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B) if (.not. allocated(DstModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then allocate(DstModuleMapTypeData%BDED_L_2_ExtLd_P_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9272,8 +9272,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ExtLd_P_2_BDED_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B) if (.not. allocated(DstModuleMapTypeData%ExtLd_P_2_BDED_B)) then allocate(DstModuleMapTypeData%ExtLd_P_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9294,8 +9294,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R) if (.not. allocated(DstModuleMapTypeData%ED_P_2_ExtLd_P_R)) then allocate(DstModuleMapTypeData%ED_P_2_ExtLd_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9313,8 +9313,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%AD_L_2_ExtLd_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_ExtLd_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_ExtLd_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_ExtLd_B) if (.not. allocated(DstModuleMapTypeData%AD_L_2_ExtLd_B)) then allocate(DstModuleMapTypeData%AD_L_2_ExtLd_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9338,8 +9338,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%IceD_P_2_SD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P) if (.not. allocated(DstModuleMapTypeData%IceD_P_2_SD_P)) then allocate(DstModuleMapTypeData%IceD_P_2_SD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9354,8 +9354,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) if (.not. allocated(DstModuleMapTypeData%SDy3_P_2_IceD_P)) then allocate(DstModuleMapTypeData%SDy3_P_2_IceD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9370,8 +9370,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%Jacobian_Opt1)) then - LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1) + UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1) if (.not. allocated(DstModuleMapTypeData%Jacobian_Opt1)) then allocate(DstModuleMapTypeData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9382,8 +9382,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 end if if (allocated(SrcModuleMapTypeData%Jacobian_pivot)) then - LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot) + UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot) if (.not. allocated(DstModuleMapTypeData%Jacobian_pivot)) then allocate(DstModuleMapTypeData%Jacobian_pivot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9394,8 +9394,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot end if if (allocated(SrcModuleMapTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx) if (.not. allocated(DstModuleMapTypeData%Jac_u_indx)) then allocate(DstModuleMapTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9427,8 +9427,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%u_ED_BladePtLoads)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads) if (.not. allocated(DstModuleMapTypeData%u_ED_BladePtLoads)) then allocate(DstModuleMapTypeData%u_ED_BladePtLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9458,8 +9458,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%u_BD_RootMotion)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion) if (.not. allocated(DstModuleMapTypeData%u_BD_RootMotion)) then allocate(DstModuleMapTypeData%u_BD_RootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9474,8 +9474,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) then - LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) if (.not. allocated(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) then allocate(DstModuleMapTypeData%y_BD_BldMotion_4Loads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9490,8 +9490,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_BD_Distrload)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload) if (.not. allocated(DstModuleMapTypeData%u_BD_Distrload)) then allocate(DstModuleMapTypeData%u_BD_Distrload(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9515,8 +9515,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%HubOrient)) then - LB(1:3) = lbound(SrcModuleMapTypeData%HubOrient, kind=B8Ki) - UB(1:3) = ubound(SrcModuleMapTypeData%HubOrient, kind=B8Ki) + LB(1:3) = lbound(SrcModuleMapTypeData%HubOrient) + UB(1:3) = ubound(SrcModuleMapTypeData%HubOrient) if (.not. allocated(DstModuleMapTypeData%HubOrient)) then allocate(DstModuleMapTypeData%HubOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9532,16 +9532,16 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) type(FAST_ModuleMapType), intent(inout) :: ModuleMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModuleMapTypeData%ED_P_2_BD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9549,8 +9549,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_P_2_BD_P) end if if (allocated(ModuleMapTypeData%BD_P_2_ED_P)) then - LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9558,8 +9558,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BD_P_2_ED_P) end if if (allocated(ModuleMapTypeData%ED_P_2_BD_P_Hub)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9585,8 +9585,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_NStC_P_N)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9594,8 +9594,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_P_2_NStC_P_N) end if if (allocated(ModuleMapTypeData%NStC_P_2_ED_P_N)) then - LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9603,8 +9603,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%NStC_P_2_ED_P_N) end if if (allocated(ModuleMapTypeData%ED_L_2_TStC_P_T)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9612,8 +9612,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_L_2_TStC_P_T) end if if (allocated(ModuleMapTypeData%TStC_P_2_ED_P_T)) then - LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9621,8 +9621,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%TStC_P_2_ED_P_T) end if if (allocated(ModuleMapTypeData%ED_L_2_BStC_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -9632,8 +9632,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_L_2_BStC_P_B) end if if (allocated(ModuleMapTypeData%BStC_P_2_ED_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -9643,8 +9643,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_P_2_ED_P_B) end if if (allocated(ModuleMapTypeData%BD_L_2_BStC_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -9654,8 +9654,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BD_L_2_BStC_P_B) end if if (allocated(ModuleMapTypeData%BStC_P_2_BD_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -9665,8 +9665,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_P_2_BD_P_B) end if if (allocated(ModuleMapTypeData%SStC_P_P_2_SubStructure)) then - LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9674,8 +9674,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%SStC_P_P_2_SubStructure) end if if (allocated(ModuleMapTypeData%SubStructure_2_SStC_P_P)) then - LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9685,8 +9685,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%BDED_L_2_AD_L_B)) then - LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9694,8 +9694,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BDED_L_2_AD_L_B) end if if (allocated(ModuleMapTypeData%AD_L_2_BDED_B)) then - LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9703,8 +9703,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%AD_L_2_BDED_B) end if if (allocated(ModuleMapTypeData%BD_L_2_BD_L)) then - LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9712,8 +9712,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BD_L_2_BD_L) end if if (allocated(ModuleMapTypeData%SED_P_2_AD_L_B)) then - LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_L_B) + UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9721,8 +9721,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%SED_P_2_AD_L_B) end if if (allocated(ModuleMapTypeData%SED_P_2_AD_P_R)) then - LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_P_R) + UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9730,8 +9730,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%SED_P_2_AD_P_R) end if if (allocated(ModuleMapTypeData%AD_L_2_SED_P)) then - LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_SED_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_SED_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_SED_P) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_SED_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_SED_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9751,8 +9751,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9778,8 +9778,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then - LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9787,8 +9787,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) end if if (allocated(ModuleMapTypeData%ExtLd_P_2_BDED_B)) then - LB(1:1) = lbound(ModuleMapTypeData%ExtLd_P_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ExtLd_P_2_BDED_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(ModuleMapTypeData%ExtLd_P_2_BDED_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ExtLd_P_2_BDED_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9800,8 +9800,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_ExtLd_P_R)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_ExtLd_P_R, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_ExtLd_P_R, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_ExtLd_P_R) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_ExtLd_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9811,8 +9811,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%AD_L_2_ExtLd_B)) then - LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_ExtLd_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_ExtLd_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_ExtLd_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ExtLd_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9826,8 +9826,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%IceD_P_2_SD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9835,8 +9835,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%IceD_P_2_SD_P) end if if (allocated(ModuleMapTypeData%SDy3_P_2_IceD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9867,8 +9867,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%u_ED_BladePtLoads)) then - LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9886,8 +9886,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%u_BD_RootMotion)) then - LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9895,8 +9895,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_BD_RootMotion) end if if (allocated(ModuleMapTypeData%y_BD_BldMotion_4Loads)) then - LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9904,8 +9904,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%y_BD_BldMotion_4Loads) end if if (allocated(ModuleMapTypeData%u_BD_Distrload)) then - LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9927,32 +9927,32 @@ subroutine FAST_PackModuleMapType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackModuleMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%ED_P_2_BD_P)) if (allocated(InData%ED_P_2_BD_P)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P, kind=B8Ki), ubound(InData%ED_P_2_BD_P, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_BD_P, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_BD_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P), ubound(InData%ED_P_2_BD_P)) + LB(1:1) = lbound(InData%ED_P_2_BD_P) + UB(1:1) = ubound(InData%ED_P_2_BD_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_BD_P(i1)) end do end if call RegPack(RF, allocated(InData%BD_P_2_ED_P)) if (allocated(InData%BD_P_2_ED_P)) then - call RegPackBounds(RF, 1, lbound(InData%BD_P_2_ED_P, kind=B8Ki), ubound(InData%BD_P_2_ED_P, kind=B8Ki)) - LB(1:1) = lbound(InData%BD_P_2_ED_P, kind=B8Ki) - UB(1:1) = ubound(InData%BD_P_2_ED_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BD_P_2_ED_P), ubound(InData%BD_P_2_ED_P)) + LB(1:1) = lbound(InData%BD_P_2_ED_P) + UB(1:1) = ubound(InData%BD_P_2_ED_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BD_P_2_ED_P(i1)) end do end if call RegPack(RF, allocated(InData%ED_P_2_BD_P_Hub)) if (allocated(InData%ED_P_2_BD_P_Hub)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki), ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P_Hub), ubound(InData%ED_P_2_BD_P_Hub)) + LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_BD_P_Hub(i1)) end do @@ -9968,45 +9968,45 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%SD_TP_2_ED_P) call RegPack(RF, allocated(InData%ED_P_2_NStC_P_N)) if (allocated(InData%ED_P_2_NStC_P_N)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki), ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_NStC_P_N), ubound(InData%ED_P_2_NStC_P_N)) + LB(1:1) = lbound(InData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(InData%ED_P_2_NStC_P_N) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_NStC_P_N(i1)) end do end if call RegPack(RF, allocated(InData%NStC_P_2_ED_P_N)) if (allocated(InData%NStC_P_2_ED_P_N)) then - call RegPackBounds(RF, 1, lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki), ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki) - UB(1:1) = ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC_P_2_ED_P_N), ubound(InData%NStC_P_2_ED_P_N)) + LB(1:1) = lbound(InData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(InData%NStC_P_2_ED_P_N) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%NStC_P_2_ED_P_N(i1)) end do end if call RegPack(RF, allocated(InData%ED_L_2_TStC_P_T)) if (allocated(InData%ED_L_2_TStC_P_T)) then - call RegPackBounds(RF, 1, lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki), ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki) - UB(1:1) = ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_L_2_TStC_P_T), ubound(InData%ED_L_2_TStC_P_T)) + LB(1:1) = lbound(InData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(InData%ED_L_2_TStC_P_T) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_TStC_P_T(i1)) end do end if call RegPack(RF, allocated(InData%TStC_P_2_ED_P_T)) if (allocated(InData%TStC_P_2_ED_P_T)) then - call RegPackBounds(RF, 1, lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki), ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki) - UB(1:1) = ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC_P_2_ED_P_T), ubound(InData%TStC_P_2_ED_P_T)) + LB(1:1) = lbound(InData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(InData%TStC_P_2_ED_P_T) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%TStC_P_2_ED_P_T(i1)) end do end if call RegPack(RF, allocated(InData%ED_L_2_BStC_P_B)) if (allocated(InData%ED_L_2_BStC_P_B)) then - call RegPackBounds(RF, 2, lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki), ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki)) - LB(1:2) = lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%ED_L_2_BStC_P_B), ubound(InData%ED_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(InData%ED_L_2_BStC_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_BStC_P_B(i1,i2)) @@ -10015,9 +10015,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%BStC_P_2_ED_P_B)) if (allocated(InData%BStC_P_2_ED_P_B)) then - call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki), ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki)) - LB(1:2) = lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki) - UB(1:2) = ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_ED_P_B), ubound(InData%BStC_P_2_ED_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(InData%BStC_P_2_ED_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BStC_P_2_ED_P_B(i1,i2)) @@ -10026,9 +10026,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%BD_L_2_BStC_P_B)) if (allocated(InData%BD_L_2_BStC_P_B)) then - call RegPackBounds(RF, 2, lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki), ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki)) - LB(1:2) = lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BD_L_2_BStC_P_B), ubound(InData%BD_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(InData%BD_L_2_BStC_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BD_L_2_BStC_P_B(i1,i2)) @@ -10037,9 +10037,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%BStC_P_2_BD_P_B)) if (allocated(InData%BStC_P_2_BD_P_B)) then - call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki), ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki)) - LB(1:2) = lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki) - UB(1:2) = ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_BD_P_B), ubound(InData%BStC_P_2_BD_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(InData%BStC_P_2_BD_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BStC_P_2_BD_P_B(i1,i2)) @@ -10048,18 +10048,18 @@ subroutine FAST_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%SStC_P_P_2_SubStructure)) if (allocated(InData%SStC_P_P_2_SubStructure)) then - call RegPackBounds(RF, 1, lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki), ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki) - UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC_P_P_2_SubStructure), ubound(InData%SStC_P_P_2_SubStructure)) + LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SStC_P_P_2_SubStructure(i1)) end do end if call RegPack(RF, allocated(InData%SubStructure_2_SStC_P_P)) if (allocated(InData%SubStructure_2_SStC_P_P)) then - call RegPackBounds(RF, 1, lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki), ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki)) - LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki) - UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SubStructure_2_SStC_P_P), ubound(InData%SubStructure_2_SStC_P_P)) + LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SubStructure_2_SStC_P_P(i1)) end do @@ -10067,54 +10067,54 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_SrvD_P_P) call RegPack(RF, allocated(InData%BDED_L_2_AD_L_B)) if (allocated(InData%BDED_L_2_AD_L_B)) then - call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki), ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki)) - LB(1:1) = lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_AD_L_B), ubound(InData%BDED_L_2_AD_L_B)) + LB(1:1) = lbound(InData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(InData%BDED_L_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BDED_L_2_AD_L_B(i1)) end do end if call RegPack(RF, allocated(InData%AD_L_2_BDED_B)) if (allocated(InData%AD_L_2_BDED_B)) then - call RegPackBounds(RF, 1, lbound(InData%AD_L_2_BDED_B, kind=B8Ki), ubound(InData%AD_L_2_BDED_B, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_L_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(InData%AD_L_2_BDED_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_BDED_B), ubound(InData%AD_L_2_BDED_B)) + LB(1:1) = lbound(InData%AD_L_2_BDED_B) + UB(1:1) = ubound(InData%AD_L_2_BDED_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_BDED_B(i1)) end do end if call RegPack(RF, allocated(InData%BD_L_2_BD_L)) if (allocated(InData%BD_L_2_BD_L)) then - call RegPackBounds(RF, 1, lbound(InData%BD_L_2_BD_L, kind=B8Ki), ubound(InData%BD_L_2_BD_L, kind=B8Ki)) - LB(1:1) = lbound(InData%BD_L_2_BD_L, kind=B8Ki) - UB(1:1) = ubound(InData%BD_L_2_BD_L, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BD_L_2_BD_L), ubound(InData%BD_L_2_BD_L)) + LB(1:1) = lbound(InData%BD_L_2_BD_L) + UB(1:1) = ubound(InData%BD_L_2_BD_L) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BD_L_2_BD_L(i1)) end do end if call RegPack(RF, allocated(InData%SED_P_2_AD_L_B)) if (allocated(InData%SED_P_2_AD_L_B)) then - call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_L_B, kind=B8Ki), ubound(InData%SED_P_2_AD_L_B, kind=B8Ki)) - LB(1:1) = lbound(InData%SED_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(InData%SED_P_2_AD_L_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_L_B), ubound(InData%SED_P_2_AD_L_B)) + LB(1:1) = lbound(InData%SED_P_2_AD_L_B) + UB(1:1) = ubound(InData%SED_P_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_AD_L_B(i1)) end do end if call RegPack(RF, allocated(InData%SED_P_2_AD_P_R)) if (allocated(InData%SED_P_2_AD_P_R)) then - call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_P_R, kind=B8Ki), ubound(InData%SED_P_2_AD_P_R, kind=B8Ki)) - LB(1:1) = lbound(InData%SED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(InData%SED_P_2_AD_P_R, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_P_R), ubound(InData%SED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%SED_P_2_AD_P_R) + UB(1:1) = ubound(InData%SED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_AD_P_R(i1)) end do end if call RegPack(RF, allocated(InData%AD_L_2_SED_P)) if (allocated(InData%AD_L_2_SED_P)) then - call RegPackBounds(RF, 1, lbound(InData%AD_L_2_SED_P, kind=B8Ki), ubound(InData%AD_L_2_SED_P, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_L_2_SED_P, kind=B8Ki) - UB(1:1) = ubound(InData%AD_L_2_SED_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_SED_P), ubound(InData%AD_L_2_SED_P)) + LB(1:1) = lbound(InData%AD_L_2_SED_P) + UB(1:1) = ubound(InData%AD_L_2_SED_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_SED_P(i1)) end do @@ -10127,9 +10127,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_ED_P_T) call RegPack(RF, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_AD_P_R, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_R(i1)) end do @@ -10145,18 +10145,18 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_ED_P_H) call RegPack(RF, allocated(InData%BDED_L_2_ExtLd_P_B)) if (allocated(InData%BDED_L_2_ExtLd_P_B)) then - call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_ExtLd_P_B, kind=B8Ki), ubound(InData%BDED_L_2_ExtLd_P_B, kind=B8Ki)) - LB(1:1) = lbound(InData%BDED_L_2_ExtLd_P_B, kind=B8Ki) - UB(1:1) = ubound(InData%BDED_L_2_ExtLd_P_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_ExtLd_P_B), ubound(InData%BDED_L_2_ExtLd_P_B)) + LB(1:1) = lbound(InData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(InData%BDED_L_2_ExtLd_P_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BDED_L_2_ExtLd_P_B(i1)) end do end if call RegPack(RF, allocated(InData%ExtLd_P_2_BDED_B)) if (allocated(InData%ExtLd_P_2_BDED_B)) then - call RegPackBounds(RF, 1, lbound(InData%ExtLd_P_2_BDED_B, kind=B8Ki), ubound(InData%ExtLd_P_2_BDED_B, kind=B8Ki)) - LB(1:1) = lbound(InData%ExtLd_P_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(InData%ExtLd_P_2_BDED_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ExtLd_P_2_BDED_B), ubound(InData%ExtLd_P_2_BDED_B)) + LB(1:1) = lbound(InData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(InData%ExtLd_P_2_BDED_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ExtLd_P_2_BDED_B(i1)) end do @@ -10165,9 +10165,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%ExtLd_P_2_ED_P_T) call RegPack(RF, allocated(InData%ED_P_2_ExtLd_P_R)) if (allocated(InData%ED_P_2_ExtLd_P_R)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_ExtLd_P_R, kind=B8Ki), ubound(InData%ED_P_2_ExtLd_P_R, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_ExtLd_P_R, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_ExtLd_P_R, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_ExtLd_P_R), ubound(InData%ED_P_2_ExtLd_P_R)) + LB(1:1) = lbound(InData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(InData%ED_P_2_ExtLd_P_R) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_ExtLd_P_R(i1)) end do @@ -10175,9 +10175,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_ExtLd_P_H) call RegPack(RF, allocated(InData%AD_L_2_ExtLd_B)) if (allocated(InData%AD_L_2_ExtLd_B)) then - call RegPackBounds(RF, 1, lbound(InData%AD_L_2_ExtLd_B, kind=B8Ki), ubound(InData%AD_L_2_ExtLd_B, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_L_2_ExtLd_B, kind=B8Ki) - UB(1:1) = ubound(InData%AD_L_2_ExtLd_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_ExtLd_B), ubound(InData%AD_L_2_ExtLd_B)) + LB(1:1) = lbound(InData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(InData%AD_L_2_ExtLd_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_ExtLd_B(i1)) end do @@ -10187,18 +10187,18 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%SDy3_P_2_IceF_P) call RegPack(RF, allocated(InData%IceD_P_2_SD_P)) if (allocated(InData%IceD_P_2_SD_P)) then - call RegPackBounds(RF, 1, lbound(InData%IceD_P_2_SD_P, kind=B8Ki), ubound(InData%IceD_P_2_SD_P, kind=B8Ki)) - LB(1:1) = lbound(InData%IceD_P_2_SD_P, kind=B8Ki) - UB(1:1) = ubound(InData%IceD_P_2_SD_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IceD_P_2_SD_P), ubound(InData%IceD_P_2_SD_P)) + LB(1:1) = lbound(InData%IceD_P_2_SD_P) + UB(1:1) = ubound(InData%IceD_P_2_SD_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%IceD_P_2_SD_P(i1)) end do end if call RegPack(RF, allocated(InData%SDy3_P_2_IceD_P)) if (allocated(InData%SDy3_P_2_IceD_P)) then - call RegPackBounds(RF, 1, lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki), ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki)) - LB(1:1) = lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki) - UB(1:1) = ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SDy3_P_2_IceD_P), ubound(InData%SDy3_P_2_IceD_P)) + LB(1:1) = lbound(InData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(InData%SDy3_P_2_IceD_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SDy3_P_2_IceD_P(i1)) end do @@ -10215,9 +10215,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) call MeshPack(RF, InData%u_ED_TowerPtloads) call RegPack(RF, allocated(InData%u_ED_BladePtLoads)) if (allocated(InData%u_ED_BladePtLoads)) then - call RegPackBounds(RF, 1, lbound(InData%u_ED_BladePtLoads, kind=B8Ki), ubound(InData%u_ED_BladePtLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%u_ED_BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(InData%u_ED_BladePtLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_ED_BladePtLoads), ubound(InData%u_ED_BladePtLoads)) + LB(1:1) = lbound(InData%u_ED_BladePtLoads) + UB(1:1) = ubound(InData%u_ED_BladePtLoads) do i1 = LB(1), UB(1) call MeshPack(RF, InData%u_ED_BladePtLoads(i1)) end do @@ -10229,27 +10229,27 @@ subroutine FAST_PackModuleMapType(RF, Indata) call MeshPack(RF, InData%u_ED_HubPtLoad_2) call RegPack(RF, allocated(InData%u_BD_RootMotion)) if (allocated(InData%u_BD_RootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%u_BD_RootMotion, kind=B8Ki), ubound(InData%u_BD_RootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%u_BD_RootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%u_BD_RootMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_BD_RootMotion), ubound(InData%u_BD_RootMotion)) + LB(1:1) = lbound(InData%u_BD_RootMotion) + UB(1:1) = ubound(InData%u_BD_RootMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%u_BD_RootMotion(i1)) end do end if call RegPack(RF, allocated(InData%y_BD_BldMotion_4Loads)) if (allocated(InData%y_BD_BldMotion_4Loads)) then - call RegPackBounds(RF, 1, lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki), ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki)) - LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki) - UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y_BD_BldMotion_4Loads), ubound(InData%y_BD_BldMotion_4Loads)) + LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads) do i1 = LB(1), UB(1) call MeshPack(RF, InData%y_BD_BldMotion_4Loads(i1)) end do end if call RegPack(RF, allocated(InData%u_BD_Distrload)) if (allocated(InData%u_BD_Distrload)) then - call RegPackBounds(RF, 1, lbound(InData%u_BD_Distrload, kind=B8Ki), ubound(InData%u_BD_Distrload, kind=B8Ki)) - LB(1:1) = lbound(InData%u_BD_Distrload, kind=B8Ki) - UB(1:1) = ubound(InData%u_BD_Distrload, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_BD_Distrload), ubound(InData%u_BD_Distrload)) + LB(1:1) = lbound(InData%u_BD_Distrload) + UB(1:1) = ubound(InData%u_BD_Distrload) do i1 = LB(1), UB(1) call MeshPack(RF, InData%u_BD_Distrload(i1)) end do @@ -10265,8 +10265,8 @@ subroutine FAST_UnPackModuleMapType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackModuleMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -10871,8 +10871,8 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyInitData' @@ -10894,8 +10894,8 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitDataData%OutData_BD)) then - LB(1:1) = lbound(SrcInitDataData%OutData_BD, kind=B8Ki) - UB(1:1) = ubound(SrcInitDataData%OutData_BD, kind=B8Ki) + LB(1:1) = lbound(SrcInitDataData%OutData_BD) + UB(1:1) = ubound(SrcInitDataData%OutData_BD) if (.not. allocated(DstInitDataData%OutData_BD)) then allocate(DstInitDataData%OutData_BD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11011,8 +11011,8 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) type(FAST_InitData), intent(inout) :: InitDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyInitData' @@ -11029,8 +11029,8 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) call BD_DestroyInitInput(InitDataData%InData_BD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitDataData%OutData_BD)) then - LB(1:1) = lbound(InitDataData%OutData_BD, kind=B8Ki) - UB(1:1) = ubound(InitDataData%OutData_BD, kind=B8Ki) + LB(1:1) = lbound(InitDataData%OutData_BD) + UB(1:1) = ubound(InitDataData%OutData_BD) do i1 = LB(1), UB(1) call BD_DestroyInitOutput(InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11107,8 +11107,8 @@ subroutine FAST_PackInitData(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_InitData), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackInitData' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call ED_PackInitInput(RF, InData%InData_ED) call ED_PackInitOutput(RF, InData%OutData_ED) @@ -11117,9 +11117,9 @@ subroutine FAST_PackInitData(RF, Indata) call BD_PackInitInput(RF, InData%InData_BD) call RegPack(RF, allocated(InData%OutData_BD)) if (allocated(InData%OutData_BD)) then - call RegPackBounds(RF, 1, lbound(InData%OutData_BD, kind=B8Ki), ubound(InData%OutData_BD, kind=B8Ki)) - LB(1:1) = lbound(InData%OutData_BD, kind=B8Ki) - UB(1:1) = ubound(InData%OutData_BD, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutData_BD), ubound(InData%OutData_BD)) + LB(1:1) = lbound(InData%OutData_BD) + UB(1:1) = ubound(InData%OutData_BD) do i1 = LB(1), UB(1) call BD_PackInitOutput(RF, InData%OutData_BD(i1)) end do @@ -11163,8 +11163,8 @@ subroutine FAST_UnPackInitData(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_InitData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackInitData' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -11226,7 +11226,7 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyExternInitType' ErrStat = ErrID_None @@ -11239,8 +11239,8 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC if (allocated(SrcExternInitTypeData%fromSCGlob)) then - LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob, kind=B8Ki) - UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob, kind=B8Ki) + LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob) + UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob) if (.not. allocated(DstExternInitTypeData%fromSCGlob)) then allocate(DstExternInitTypeData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11251,8 +11251,8 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob end if if (allocated(SrcExternInitTypeData%fromSC)) then - LB(1:1) = lbound(SrcExternInitTypeData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcExternInitTypeData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcExternInitTypeData%fromSC) + UB(1:1) = ubound(SrcExternInitTypeData%fromSC) if (.not. allocated(DstExternInitTypeData%fromSC)) then allocate(DstExternInitTypeData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11328,7 +11328,7 @@ subroutine FAST_UnPackExternInitType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_ExternInitType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExternInitType' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 index f1f6a004f1..a10c7f76e6 100644 --- a/modules/openfast-library/src/Glue_Types.f90 +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -311,8 +311,8 @@ subroutine Glue_CopyModGlueType(SrcModGlueTypeData, DstModGlueTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_CopyModGlueType' @@ -320,8 +320,8 @@ subroutine Glue_CopyModGlueType(SrcModGlueTypeData, DstModGlueTypeData, CtrlCode ErrMsg = '' DstModGlueTypeData%Name = SrcModGlueTypeData%Name if (allocated(SrcModGlueTypeData%ModData)) then - LB(1:1) = lbound(SrcModGlueTypeData%ModData, kind=B8Ki) - UB(1:1) = ubound(SrcModGlueTypeData%ModData, kind=B8Ki) + LB(1:1) = lbound(SrcModGlueTypeData%ModData) + UB(1:1) = ubound(SrcModGlueTypeData%ModData) if (.not. allocated(DstModGlueTypeData%ModData)) then allocate(DstModGlueTypeData%ModData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -342,8 +342,8 @@ subroutine Glue_CopyModGlueType(SrcModGlueTypeData, DstModGlueTypeData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModGlueTypeData%VarMaps)) then - LB(1:1) = lbound(SrcModGlueTypeData%VarMaps, kind=B8Ki) - UB(1:1) = ubound(SrcModGlueTypeData%VarMaps, kind=B8Ki) + LB(1:1) = lbound(SrcModGlueTypeData%VarMaps) + UB(1:1) = ubound(SrcModGlueTypeData%VarMaps) if (.not. allocated(DstModGlueTypeData%VarMaps)) then allocate(DstModGlueTypeData%VarMaps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -363,16 +363,16 @@ subroutine Glue_DestroyModGlueType(ModGlueTypeData, ErrStat, ErrMsg) type(ModGlueType), intent(inout) :: ModGlueTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_DestroyModGlueType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModGlueTypeData%ModData)) then - LB(1:1) = lbound(ModGlueTypeData%ModData, kind=B8Ki) - UB(1:1) = ubound(ModGlueTypeData%ModData, kind=B8Ki) + LB(1:1) = lbound(ModGlueTypeData%ModData) + UB(1:1) = ubound(ModGlueTypeData%ModData) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModDataType(ModGlueTypeData%ModData(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -384,8 +384,8 @@ subroutine Glue_DestroyModGlueType(ModGlueTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyModLinType(ModGlueTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModGlueTypeData%VarMaps)) then - LB(1:1) = lbound(ModGlueTypeData%VarMaps, kind=B8Ki) - UB(1:1) = ubound(ModGlueTypeData%VarMaps, kind=B8Ki) + LB(1:1) = lbound(ModGlueTypeData%VarMaps) + UB(1:1) = ubound(ModGlueTypeData%VarMaps) do i1 = LB(1), UB(1) call Glue_DestroyVarMapType(ModGlueTypeData%VarMaps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -398,15 +398,15 @@ subroutine Glue_PackModGlueType(RF, Indata) type(RegFile), intent(inout) :: RF type(ModGlueType), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackModGlueType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Name) call RegPack(RF, allocated(InData%ModData)) if (allocated(InData%ModData)) then - call RegPackBounds(RF, 1, lbound(InData%ModData, kind=B8Ki), ubound(InData%ModData, kind=B8Ki)) - LB(1:1) = lbound(InData%ModData, kind=B8Ki) - UB(1:1) = ubound(InData%ModData, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ModData), ubound(InData%ModData)) + LB(1:1) = lbound(InData%ModData) + UB(1:1) = ubound(InData%ModData) do i1 = LB(1), UB(1) call NWTC_Library_PackModDataType(RF, InData%ModData(i1)) end do @@ -415,9 +415,9 @@ subroutine Glue_PackModGlueType(RF, Indata) call NWTC_Library_PackModLinType(RF, InData%Lin) call RegPack(RF, allocated(InData%VarMaps)) if (allocated(InData%VarMaps)) then - call RegPackBounds(RF, 1, lbound(InData%VarMaps, kind=B8Ki), ubound(InData%VarMaps, kind=B8Ki)) - LB(1:1) = lbound(InData%VarMaps, kind=B8Ki) - UB(1:1) = ubound(InData%VarMaps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VarMaps), ubound(InData%VarMaps)) + LB(1:1) = lbound(InData%VarMaps) + UB(1:1) = ubound(InData%VarMaps) do i1 = LB(1), UB(1) call Glue_PackVarMapType(RF, InData%VarMaps(i1)) end do @@ -429,8 +429,8 @@ subroutine Glue_UnPackModGlueType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModGlueType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackModGlueType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -471,7 +471,7 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_CopyMappingType' @@ -503,8 +503,8 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode DstMappingTypeData%Ready = SrcMappingTypeData%Ready DstMappingTypeData%DstUsesSibling = SrcMappingTypeData%DstUsesSibling if (allocated(SrcMappingTypeData%TmpMatrix)) then - LB(1:2) = lbound(SrcMappingTypeData%TmpMatrix, kind=B8Ki) - UB(1:2) = ubound(SrcMappingTypeData%TmpMatrix, kind=B8Ki) + LB(1:2) = lbound(SrcMappingTypeData%TmpMatrix) + UB(1:2) = ubound(SrcMappingTypeData%TmpMatrix) if (.not. allocated(DstMappingTypeData%TmpMatrix)) then allocate(DstMappingTypeData%TmpMatrix(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -515,8 +515,8 @@ subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode DstMappingTypeData%TmpMatrix = SrcMappingTypeData%TmpMatrix end if if (allocated(SrcMappingTypeData%VarData)) then - LB(1:1) = lbound(SrcMappingTypeData%VarData, kind=B8Ki) - UB(1:1) = ubound(SrcMappingTypeData%VarData, kind=B8Ki) + LB(1:1) = lbound(SrcMappingTypeData%VarData) + UB(1:1) = ubound(SrcMappingTypeData%VarData) if (.not. allocated(DstMappingTypeData%VarData)) then allocate(DstMappingTypeData%VarData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -620,7 +620,7 @@ subroutine Glue_UnPackMappingType(RF, OutData) type(RegFile), intent(inout) :: RF type(MappingType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackMappingType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -657,7 +657,7 @@ subroutine Glue_CopyLinParam(SrcLinParamData, DstLinParamData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Glue_CopyLinParam' ErrStat = ErrID_None @@ -666,8 +666,8 @@ subroutine Glue_CopyLinParam(SrcLinParamData, DstLinParamData, CtrlCode, ErrStat DstLinParamData%InterpOrder = SrcLinParamData%InterpOrder DstLinParamData%SaveOPs = SrcLinParamData%SaveOPs if (allocated(SrcLinParamData%iMod)) then - LB(1:1) = lbound(SrcLinParamData%iMod, kind=B8Ki) - UB(1:1) = ubound(SrcLinParamData%iMod, kind=B8Ki) + LB(1:1) = lbound(SrcLinParamData%iMod) + UB(1:1) = ubound(SrcLinParamData%iMod) if (.not. allocated(DstLinParamData%iMod)) then allocate(DstLinParamData%iMod(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -707,7 +707,7 @@ subroutine Glue_UnPackLinParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Glue_LinParam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackLinParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -723,7 +723,7 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Glue_CopyTCParam' ErrStat = ErrID_None @@ -758,8 +758,8 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E DstTCParamData%iJUT = SrcTCParamData%iJUT DstTCParamData%iJL = SrcTCParamData%iJL if (allocated(SrcTCParamData%iModInit)) then - LB(1:1) = lbound(SrcTCParamData%iModInit, kind=B8Ki) - UB(1:1) = ubound(SrcTCParamData%iModInit, kind=B8Ki) + LB(1:1) = lbound(SrcTCParamData%iModInit) + UB(1:1) = ubound(SrcTCParamData%iModInit) if (.not. allocated(DstTCParamData%iModInit)) then allocate(DstTCParamData%iModInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -770,8 +770,8 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E DstTCParamData%iModInit = SrcTCParamData%iModInit end if if (allocated(SrcTCParamData%iModTC)) then - LB(1:1) = lbound(SrcTCParamData%iModTC, kind=B8Ki) - UB(1:1) = ubound(SrcTCParamData%iModTC, kind=B8Ki) + LB(1:1) = lbound(SrcTCParamData%iModTC) + UB(1:1) = ubound(SrcTCParamData%iModTC) if (.not. allocated(DstTCParamData%iModTC)) then allocate(DstTCParamData%iModTC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -782,8 +782,8 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E DstTCParamData%iModTC = SrcTCParamData%iModTC end if if (allocated(SrcTCParamData%iModOpt1)) then - LB(1:1) = lbound(SrcTCParamData%iModOpt1, kind=B8Ki) - UB(1:1) = ubound(SrcTCParamData%iModOpt1, kind=B8Ki) + LB(1:1) = lbound(SrcTCParamData%iModOpt1) + UB(1:1) = ubound(SrcTCParamData%iModOpt1) if (.not. allocated(DstTCParamData%iModOpt1)) then allocate(DstTCParamData%iModOpt1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -794,8 +794,8 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E DstTCParamData%iModOpt1 = SrcTCParamData%iModOpt1 end if if (allocated(SrcTCParamData%iModOpt2)) then - LB(1:1) = lbound(SrcTCParamData%iModOpt2, kind=B8Ki) - UB(1:1) = ubound(SrcTCParamData%iModOpt2, kind=B8Ki) + LB(1:1) = lbound(SrcTCParamData%iModOpt2) + UB(1:1) = ubound(SrcTCParamData%iModOpt2) if (.not. allocated(DstTCParamData%iModOpt2)) then allocate(DstTCParamData%iModOpt2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -806,8 +806,8 @@ subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, E DstTCParamData%iModOpt2 = SrcTCParamData%iModOpt2 end if if (allocated(SrcTCParamData%iModPost)) then - LB(1:1) = lbound(SrcTCParamData%iModPost, kind=B8Ki) - UB(1:1) = ubound(SrcTCParamData%iModPost, kind=B8Ki) + LB(1:1) = lbound(SrcTCParamData%iModPost) + UB(1:1) = ubound(SrcTCParamData%iModPost) if (.not. allocated(DstTCParamData%iModPost)) then allocate(DstTCParamData%iModPost(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -889,7 +889,7 @@ subroutine Glue_UnPackTCParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Glue_TCParam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackTCParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -988,14 +988,14 @@ subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Glue_CopyLinSave' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcLinSaveData%Times)) then - LB(1:1) = lbound(SrcLinSaveData%Times, kind=B8Ki) - UB(1:1) = ubound(SrcLinSaveData%Times, kind=B8Ki) + LB(1:1) = lbound(SrcLinSaveData%Times) + UB(1:1) = ubound(SrcLinSaveData%Times) if (.not. allocated(DstLinSaveData%Times)) then allocate(DstLinSaveData%Times(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1006,8 +1006,8 @@ subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, E DstLinSaveData%Times = SrcLinSaveData%Times end if if (allocated(SrcLinSaveData%u)) then - LB(1:2) = lbound(SrcLinSaveData%u, kind=B8Ki) - UB(1:2) = ubound(SrcLinSaveData%u, kind=B8Ki) + LB(1:2) = lbound(SrcLinSaveData%u) + UB(1:2) = ubound(SrcLinSaveData%u) if (.not. allocated(DstLinSaveData%u)) then allocate(DstLinSaveData%u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1018,8 +1018,8 @@ subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, E DstLinSaveData%u = SrcLinSaveData%u end if if (allocated(SrcLinSaveData%x)) then - LB(1:2) = lbound(SrcLinSaveData%x, kind=B8Ki) - UB(1:2) = ubound(SrcLinSaveData%x, kind=B8Ki) + LB(1:2) = lbound(SrcLinSaveData%x) + UB(1:2) = ubound(SrcLinSaveData%x) if (.not. allocated(DstLinSaveData%x)) then allocate(DstLinSaveData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1030,8 +1030,8 @@ subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, E DstLinSaveData%x = SrcLinSaveData%x end if if (allocated(SrcLinSaveData%xd)) then - LB(1:2) = lbound(SrcLinSaveData%xd, kind=B8Ki) - UB(1:2) = ubound(SrcLinSaveData%xd, kind=B8Ki) + LB(1:2) = lbound(SrcLinSaveData%xd) + UB(1:2) = ubound(SrcLinSaveData%xd) if (.not. allocated(DstLinSaveData%xd)) then allocate(DstLinSaveData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1042,8 +1042,8 @@ subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, E DstLinSaveData%xd = SrcLinSaveData%xd end if if (allocated(SrcLinSaveData%z)) then - LB(1:2) = lbound(SrcLinSaveData%z, kind=B8Ki) - UB(1:2) = ubound(SrcLinSaveData%z, kind=B8Ki) + LB(1:2) = lbound(SrcLinSaveData%z) + UB(1:2) = ubound(SrcLinSaveData%z) if (.not. allocated(DstLinSaveData%z)) then allocate(DstLinSaveData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1054,8 +1054,8 @@ subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, E DstLinSaveData%z = SrcLinSaveData%z end if if (allocated(SrcLinSaveData%OtherSt)) then - LB(1:2) = lbound(SrcLinSaveData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(SrcLinSaveData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(SrcLinSaveData%OtherSt) + UB(1:2) = ubound(SrcLinSaveData%OtherSt) if (.not. allocated(DstLinSaveData%OtherSt)) then allocate(DstLinSaveData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1112,7 +1112,7 @@ subroutine Glue_UnPackLinSave(RF, OutData) type(RegFile), intent(inout) :: RF type(Glue_LinSave), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackLinSave' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1176,14 +1176,14 @@ subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Glue_CopyCalcSteady' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcCalcSteadyData%AzimuthTarget)) then - LB(1:1) = lbound(SrcCalcSteadyData%AzimuthTarget, kind=B8Ki) - UB(1:1) = ubound(SrcCalcSteadyData%AzimuthTarget, kind=B8Ki) + LB(1:1) = lbound(SrcCalcSteadyData%AzimuthTarget) + UB(1:1) = ubound(SrcCalcSteadyData%AzimuthTarget) if (.not. allocated(DstCalcSteadyData%AzimuthTarget)) then allocate(DstCalcSteadyData%AzimuthTarget(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1200,8 +1200,8 @@ subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, E DstCalcSteadyData%NumRotations = SrcCalcSteadyData%NumRotations DstCalcSteadyData%NumOutputs = SrcCalcSteadyData%NumOutputs if (allocated(SrcCalcSteadyData%psi_buffer)) then - LB(1:1) = lbound(SrcCalcSteadyData%psi_buffer, kind=B8Ki) - UB(1:1) = ubound(SrcCalcSteadyData%psi_buffer, kind=B8Ki) + LB(1:1) = lbound(SrcCalcSteadyData%psi_buffer) + UB(1:1) = ubound(SrcCalcSteadyData%psi_buffer) if (.not. allocated(DstCalcSteadyData%psi_buffer)) then allocate(DstCalcSteadyData%psi_buffer(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1212,8 +1212,8 @@ subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, E DstCalcSteadyData%psi_buffer = SrcCalcSteadyData%psi_buffer end if if (allocated(SrcCalcSteadyData%y_buffer)) then - LB(1:2) = lbound(SrcCalcSteadyData%y_buffer, kind=B8Ki) - UB(1:2) = ubound(SrcCalcSteadyData%y_buffer, kind=B8Ki) + LB(1:2) = lbound(SrcCalcSteadyData%y_buffer) + UB(1:2) = ubound(SrcCalcSteadyData%y_buffer) if (.not. allocated(DstCalcSteadyData%y_buffer)) then allocate(DstCalcSteadyData%y_buffer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1224,8 +1224,8 @@ subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, E DstCalcSteadyData%y_buffer = SrcCalcSteadyData%y_buffer end if if (allocated(SrcCalcSteadyData%y_azimuth)) then - LB(1:2) = lbound(SrcCalcSteadyData%y_azimuth, kind=B8Ki) - UB(1:2) = ubound(SrcCalcSteadyData%y_azimuth, kind=B8Ki) + LB(1:2) = lbound(SrcCalcSteadyData%y_azimuth) + UB(1:2) = ubound(SrcCalcSteadyData%y_azimuth) if (.not. allocated(DstCalcSteadyData%y_azimuth)) then allocate(DstCalcSteadyData%y_azimuth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1236,8 +1236,8 @@ subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, E DstCalcSteadyData%y_azimuth = SrcCalcSteadyData%y_azimuth end if if (allocated(SrcCalcSteadyData%y_interp)) then - LB(1:1) = lbound(SrcCalcSteadyData%y_interp, kind=B8Ki) - UB(1:1) = ubound(SrcCalcSteadyData%y_interp, kind=B8Ki) + LB(1:1) = lbound(SrcCalcSteadyData%y_interp) + UB(1:1) = ubound(SrcCalcSteadyData%y_interp) if (.not. allocated(DstCalcSteadyData%y_interp)) then allocate(DstCalcSteadyData%y_interp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1248,8 +1248,8 @@ subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, E DstCalcSteadyData%y_interp = SrcCalcSteadyData%y_interp end if if (allocated(SrcCalcSteadyData%y_diff)) then - LB(1:1) = lbound(SrcCalcSteadyData%y_diff, kind=B8Ki) - UB(1:1) = ubound(SrcCalcSteadyData%y_diff, kind=B8Ki) + LB(1:1) = lbound(SrcCalcSteadyData%y_diff) + UB(1:1) = ubound(SrcCalcSteadyData%y_diff) if (.not. allocated(DstCalcSteadyData%y_diff)) then allocate(DstCalcSteadyData%y_diff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1260,8 +1260,8 @@ subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, E DstCalcSteadyData%y_diff = SrcCalcSteadyData%y_diff end if if (allocated(SrcCalcSteadyData%y_ref)) then - LB(1:1) = lbound(SrcCalcSteadyData%y_ref, kind=B8Ki) - UB(1:1) = ubound(SrcCalcSteadyData%y_ref, kind=B8Ki) + LB(1:1) = lbound(SrcCalcSteadyData%y_ref) + UB(1:1) = ubound(SrcCalcSteadyData%y_ref) if (.not. allocated(DstCalcSteadyData%y_ref)) then allocate(DstCalcSteadyData%y_ref(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1328,7 +1328,7 @@ subroutine Glue_UnPackCalcSteady(RF, OutData) type(RegFile), intent(inout) :: RF type(Glue_CalcSteady), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackCalcSteady' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1400,16 +1400,16 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_CopyAeroMap' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcAeroMapData%iModOrder)) then - LB(1:1) = lbound(SrcAeroMapData%iModOrder, kind=B8Ki) - UB(1:1) = ubound(SrcAeroMapData%iModOrder, kind=B8Ki) + LB(1:1) = lbound(SrcAeroMapData%iModOrder) + UB(1:1) = ubound(SrcAeroMapData%iModOrder) if (.not. allocated(DstAeroMapData%iModOrder)) then allocate(DstAeroMapData%iModOrder(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1423,8 +1423,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroMapData%Jac11)) then - LB(1:2) = lbound(SrcAeroMapData%Jac11, kind=B8Ki) - UB(1:2) = ubound(SrcAeroMapData%Jac11, kind=B8Ki) + LB(1:2) = lbound(SrcAeroMapData%Jac11) + UB(1:2) = ubound(SrcAeroMapData%Jac11) if (.not. allocated(DstAeroMapData%Jac11)) then allocate(DstAeroMapData%Jac11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1435,8 +1435,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%Jac11 = SrcAeroMapData%Jac11 end if if (allocated(SrcAeroMapData%Jac12)) then - LB(1:2) = lbound(SrcAeroMapData%Jac12, kind=B8Ki) - UB(1:2) = ubound(SrcAeroMapData%Jac12, kind=B8Ki) + LB(1:2) = lbound(SrcAeroMapData%Jac12) + UB(1:2) = ubound(SrcAeroMapData%Jac12) if (.not. allocated(DstAeroMapData%Jac12)) then allocate(DstAeroMapData%Jac12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1447,8 +1447,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%Jac12 = SrcAeroMapData%Jac12 end if if (allocated(SrcAeroMapData%Jac21)) then - LB(1:2) = lbound(SrcAeroMapData%Jac21, kind=B8Ki) - UB(1:2) = ubound(SrcAeroMapData%Jac21, kind=B8Ki) + LB(1:2) = lbound(SrcAeroMapData%Jac21) + UB(1:2) = ubound(SrcAeroMapData%Jac21) if (.not. allocated(DstAeroMapData%Jac21)) then allocate(DstAeroMapData%Jac21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1459,8 +1459,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%Jac21 = SrcAeroMapData%Jac21 end if if (allocated(SrcAeroMapData%Jac22)) then - LB(1:2) = lbound(SrcAeroMapData%Jac22, kind=B8Ki) - UB(1:2) = ubound(SrcAeroMapData%Jac22, kind=B8Ki) + LB(1:2) = lbound(SrcAeroMapData%Jac22) + UB(1:2) = ubound(SrcAeroMapData%Jac22) if (.not. allocated(DstAeroMapData%Jac22)) then allocate(DstAeroMapData%Jac22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1471,8 +1471,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%Jac22 = SrcAeroMapData%Jac22 end if if (allocated(SrcAeroMapData%JacPivot)) then - LB(1:1) = lbound(SrcAeroMapData%JacPivot, kind=B8Ki) - UB(1:1) = ubound(SrcAeroMapData%JacPivot, kind=B8Ki) + LB(1:1) = lbound(SrcAeroMapData%JacPivot) + UB(1:1) = ubound(SrcAeroMapData%JacPivot) if (.not. allocated(DstAeroMapData%JacPivot)) then allocate(DstAeroMapData%JacPivot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1485,8 +1485,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%JacScale = SrcAeroMapData%JacScale DstAeroMapData%SolveTolerance = SrcAeroMapData%SolveTolerance if (allocated(SrcAeroMapData%HubOrientation)) then - LB(1:3) = lbound(SrcAeroMapData%HubOrientation, kind=B8Ki) - UB(1:3) = ubound(SrcAeroMapData%HubOrientation, kind=B8Ki) + LB(1:3) = lbound(SrcAeroMapData%HubOrientation) + UB(1:3) = ubound(SrcAeroMapData%HubOrientation) if (.not. allocated(DstAeroMapData%HubOrientation)) then allocate(DstAeroMapData%HubOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1497,8 +1497,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%HubOrientation = SrcAeroMapData%HubOrientation end if if (allocated(SrcAeroMapData%u1)) then - LB(1:1) = lbound(SrcAeroMapData%u1, kind=B8Ki) - UB(1:1) = ubound(SrcAeroMapData%u1, kind=B8Ki) + LB(1:1) = lbound(SrcAeroMapData%u1) + UB(1:1) = ubound(SrcAeroMapData%u1) if (.not. allocated(DstAeroMapData%u1)) then allocate(DstAeroMapData%u1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1509,8 +1509,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%u1 = SrcAeroMapData%u1 end if if (allocated(SrcAeroMapData%u2)) then - LB(1:1) = lbound(SrcAeroMapData%u2, kind=B8Ki) - UB(1:1) = ubound(SrcAeroMapData%u2, kind=B8Ki) + LB(1:1) = lbound(SrcAeroMapData%u2) + UB(1:1) = ubound(SrcAeroMapData%u2) if (.not. allocated(DstAeroMapData%u2)) then allocate(DstAeroMapData%u2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1521,8 +1521,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%u2 = SrcAeroMapData%u2 end if if (allocated(SrcAeroMapData%Residual)) then - LB(1:1) = lbound(SrcAeroMapData%Residual, kind=B8Ki) - UB(1:1) = ubound(SrcAeroMapData%Residual, kind=B8Ki) + LB(1:1) = lbound(SrcAeroMapData%Residual) + UB(1:1) = ubound(SrcAeroMapData%Residual) if (.not. allocated(DstAeroMapData%Residual)) then allocate(DstAeroMapData%Residual(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1533,8 +1533,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%Residual = SrcAeroMapData%Residual end if if (allocated(SrcAeroMapData%SolveDelta)) then - LB(1:1) = lbound(SrcAeroMapData%SolveDelta, kind=B8Ki) - UB(1:1) = ubound(SrcAeroMapData%SolveDelta, kind=B8Ki) + LB(1:1) = lbound(SrcAeroMapData%SolveDelta) + UB(1:1) = ubound(SrcAeroMapData%SolveDelta) if (.not. allocated(DstAeroMapData%SolveDelta)) then allocate(DstAeroMapData%SolveDelta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1545,8 +1545,8 @@ subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, E DstAeroMapData%SolveDelta = SrcAeroMapData%SolveDelta end if if (allocated(SrcAeroMapData%Cases)) then - LB(1:1) = lbound(SrcAeroMapData%Cases, kind=B8Ki) - UB(1:1) = ubound(SrcAeroMapData%Cases, kind=B8Ki) + LB(1:1) = lbound(SrcAeroMapData%Cases) + UB(1:1) = ubound(SrcAeroMapData%Cases) if (.not. allocated(DstAeroMapData%Cases)) then allocate(DstAeroMapData%Cases(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1567,8 +1567,8 @@ subroutine Glue_DestroyAeroMap(AeroMapData, ErrStat, ErrMsg) type(Glue_AeroMap), intent(inout) :: AeroMapData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_DestroyAeroMap' @@ -1610,8 +1610,8 @@ subroutine Glue_DestroyAeroMap(AeroMapData, ErrStat, ErrMsg) deallocate(AeroMapData%SolveDelta) end if if (allocated(AeroMapData%Cases)) then - LB(1:1) = lbound(AeroMapData%Cases, kind=B8Ki) - UB(1:1) = ubound(AeroMapData%Cases, kind=B8Ki) + LB(1:1) = lbound(AeroMapData%Cases) + UB(1:1) = ubound(AeroMapData%Cases) do i1 = LB(1), UB(1) call Glue_DestroyAeroMapCase(AeroMapData%Cases(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1624,8 +1624,8 @@ subroutine Glue_PackAeroMap(RF, Indata) type(RegFile), intent(inout) :: RF type(Glue_AeroMap), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackAeroMap' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%iModOrder) call Glue_PackModGlueType(RF, InData%Mod) @@ -1643,9 +1643,9 @@ subroutine Glue_PackAeroMap(RF, Indata) call RegPackAlloc(RF, InData%SolveDelta) call RegPack(RF, allocated(InData%Cases)) if (allocated(InData%Cases)) then - call RegPackBounds(RF, 1, lbound(InData%Cases, kind=B8Ki), ubound(InData%Cases, kind=B8Ki)) - LB(1:1) = lbound(InData%Cases, kind=B8Ki) - UB(1:1) = ubound(InData%Cases, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Cases), ubound(InData%Cases)) + LB(1:1) = lbound(InData%Cases) + UB(1:1) = ubound(InData%Cases) do i1 = LB(1), UB(1) call Glue_PackAeroMapCase(RF, InData%Cases(i1)) end do @@ -1658,8 +1658,8 @@ subroutine Glue_UnPackAeroMap(RF, OutData) type(RegFile), intent(inout) :: RF type(Glue_AeroMap), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackAeroMap' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1699,14 +1699,14 @@ subroutine Glue_CopyTC_State(SrcTC_StateData, DstTC_StateData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Glue_CopyTC_State' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcTC_StateData%q_prev)) then - LB(1:1) = lbound(SrcTC_StateData%q_prev, kind=B8Ki) - UB(1:1) = ubound(SrcTC_StateData%q_prev, kind=B8Ki) + LB(1:1) = lbound(SrcTC_StateData%q_prev) + UB(1:1) = ubound(SrcTC_StateData%q_prev) if (.not. allocated(DstTC_StateData%q_prev)) then allocate(DstTC_StateData%q_prev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1717,8 +1717,8 @@ subroutine Glue_CopyTC_State(SrcTC_StateData, DstTC_StateData, CtrlCode, ErrStat DstTC_StateData%q_prev = SrcTC_StateData%q_prev end if if (allocated(SrcTC_StateData%x)) then - LB(1:1) = lbound(SrcTC_StateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcTC_StateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcTC_StateData%x) + UB(1:1) = ubound(SrcTC_StateData%x) if (.not. allocated(DstTC_StateData%x)) then allocate(DstTC_StateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1729,8 +1729,8 @@ subroutine Glue_CopyTC_State(SrcTC_StateData, DstTC_StateData, CtrlCode, ErrStat DstTC_StateData%x = SrcTC_StateData%x end if if (allocated(SrcTC_StateData%q)) then - LB(1:1) = lbound(SrcTC_StateData%q, kind=B8Ki) - UB(1:1) = ubound(SrcTC_StateData%q, kind=B8Ki) + LB(1:1) = lbound(SrcTC_StateData%q) + UB(1:1) = ubound(SrcTC_StateData%q) if (.not. allocated(DstTC_StateData%q)) then allocate(DstTC_StateData%q(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1741,8 +1741,8 @@ subroutine Glue_CopyTC_State(SrcTC_StateData, DstTC_StateData, CtrlCode, ErrStat DstTC_StateData%q = SrcTC_StateData%q end if if (allocated(SrcTC_StateData%v)) then - LB(1:1) = lbound(SrcTC_StateData%v, kind=B8Ki) - UB(1:1) = ubound(SrcTC_StateData%v, kind=B8Ki) + LB(1:1) = lbound(SrcTC_StateData%v) + UB(1:1) = ubound(SrcTC_StateData%v) if (.not. allocated(DstTC_StateData%v)) then allocate(DstTC_StateData%v(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1753,8 +1753,8 @@ subroutine Glue_CopyTC_State(SrcTC_StateData, DstTC_StateData, CtrlCode, ErrStat DstTC_StateData%v = SrcTC_StateData%v end if if (allocated(SrcTC_StateData%vd)) then - LB(1:1) = lbound(SrcTC_StateData%vd, kind=B8Ki) - UB(1:1) = ubound(SrcTC_StateData%vd, kind=B8Ki) + LB(1:1) = lbound(SrcTC_StateData%vd) + UB(1:1) = ubound(SrcTC_StateData%vd) if (.not. allocated(DstTC_StateData%vd)) then allocate(DstTC_StateData%vd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1765,8 +1765,8 @@ subroutine Glue_CopyTC_State(SrcTC_StateData, DstTC_StateData, CtrlCode, ErrStat DstTC_StateData%vd = SrcTC_StateData%vd end if if (allocated(SrcTC_StateData%a)) then - LB(1:1) = lbound(SrcTC_StateData%a, kind=B8Ki) - UB(1:1) = ubound(SrcTC_StateData%a, kind=B8Ki) + LB(1:1) = lbound(SrcTC_StateData%a) + UB(1:1) = ubound(SrcTC_StateData%a) if (.not. allocated(DstTC_StateData%a)) then allocate(DstTC_StateData%a(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1823,7 +1823,7 @@ subroutine Glue_UnPackTC_State(RF, OutData) type(RegFile), intent(inout) :: RF type(TC_State), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackTC_State' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1841,7 +1841,7 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_CopyTCMisc' @@ -1857,8 +1857,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcTCMiscData%UCalc)) then - LB(1:1) = lbound(SrcTCMiscData%UCalc, kind=B8Ki) - UB(1:1) = ubound(SrcTCMiscData%UCalc, kind=B8Ki) + LB(1:1) = lbound(SrcTCMiscData%UCalc) + UB(1:1) = ubound(SrcTCMiscData%UCalc) if (.not. allocated(DstTCMiscData%UCalc)) then allocate(DstTCMiscData%UCalc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1869,8 +1869,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%UCalc = SrcTCMiscData%UCalc end if if (allocated(SrcTCMiscData%XB)) then - LB(1:2) = lbound(SrcTCMiscData%XB, kind=B8Ki) - UB(1:2) = ubound(SrcTCMiscData%XB, kind=B8Ki) + LB(1:2) = lbound(SrcTCMiscData%XB) + UB(1:2) = ubound(SrcTCMiscData%XB) if (.not. allocated(DstTCMiscData%XB)) then allocate(DstTCMiscData%XB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1881,8 +1881,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%XB = SrcTCMiscData%XB end if if (allocated(SrcTCMiscData%IPIV)) then - LB(1:1) = lbound(SrcTCMiscData%IPIV, kind=B8Ki) - UB(1:1) = ubound(SrcTCMiscData%IPIV, kind=B8Ki) + LB(1:1) = lbound(SrcTCMiscData%IPIV) + UB(1:1) = ubound(SrcTCMiscData%IPIV) if (.not. allocated(DstTCMiscData%IPIV)) then allocate(DstTCMiscData%IPIV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1897,8 +1897,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%UJacStepsRemain = SrcTCMiscData%UJacStepsRemain DstTCMiscData%ConvWarn = SrcTCMiscData%ConvWarn if (allocated(SrcTCMiscData%XB_IO)) then - LB(1:2) = lbound(SrcTCMiscData%XB_IO, kind=B8Ki) - UB(1:2) = ubound(SrcTCMiscData%XB_IO, kind=B8Ki) + LB(1:2) = lbound(SrcTCMiscData%XB_IO) + UB(1:2) = ubound(SrcTCMiscData%XB_IO) if (.not. allocated(DstTCMiscData%XB_IO)) then allocate(DstTCMiscData%XB_IO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1909,8 +1909,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%XB_IO = SrcTCMiscData%XB_IO end if if (allocated(SrcTCMiscData%Jac_IO)) then - LB(1:2) = lbound(SrcTCMiscData%Jac_IO, kind=B8Ki) - UB(1:2) = ubound(SrcTCMiscData%Jac_IO, kind=B8Ki) + LB(1:2) = lbound(SrcTCMiscData%Jac_IO) + UB(1:2) = ubound(SrcTCMiscData%Jac_IO) if (.not. allocated(DstTCMiscData%Jac_IO)) then allocate(DstTCMiscData%Jac_IO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1921,8 +1921,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%Jac_IO = SrcTCMiscData%Jac_IO end if if (allocated(SrcTCMiscData%J11)) then - LB(1:2) = lbound(SrcTCMiscData%J11, kind=B8Ki) - UB(1:2) = ubound(SrcTCMiscData%J11, kind=B8Ki) + LB(1:2) = lbound(SrcTCMiscData%J11) + UB(1:2) = ubound(SrcTCMiscData%J11) if (.not. allocated(DstTCMiscData%J11)) then allocate(DstTCMiscData%J11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1933,8 +1933,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%J11 = SrcTCMiscData%J11 end if if (allocated(SrcTCMiscData%J12)) then - LB(1:2) = lbound(SrcTCMiscData%J12, kind=B8Ki) - UB(1:2) = ubound(SrcTCMiscData%J12, kind=B8Ki) + LB(1:2) = lbound(SrcTCMiscData%J12) + UB(1:2) = ubound(SrcTCMiscData%J12) if (.not. allocated(DstTCMiscData%J12)) then allocate(DstTCMiscData%J12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1945,8 +1945,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%J12 = SrcTCMiscData%J12 end if if (allocated(SrcTCMiscData%J21)) then - LB(1:2) = lbound(SrcTCMiscData%J21, kind=B8Ki) - UB(1:2) = ubound(SrcTCMiscData%J21, kind=B8Ki) + LB(1:2) = lbound(SrcTCMiscData%J21) + UB(1:2) = ubound(SrcTCMiscData%J21) if (.not. allocated(DstTCMiscData%J21)) then allocate(DstTCMiscData%J21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1957,8 +1957,8 @@ subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrM DstTCMiscData%J21 = SrcTCMiscData%J21 end if if (allocated(SrcTCMiscData%J22)) then - LB(1:2) = lbound(SrcTCMiscData%J22, kind=B8Ki) - UB(1:2) = ubound(SrcTCMiscData%J22, kind=B8Ki) + LB(1:2) = lbound(SrcTCMiscData%J22) + UB(1:2) = ubound(SrcTCMiscData%J22) if (.not. allocated(DstTCMiscData%J22)) then allocate(DstTCMiscData%J22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2042,7 +2042,7 @@ subroutine Glue_UnPackTCMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Glue_TCMisc), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackTCMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2114,16 +2114,16 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%ModData)) then - LB(1:1) = lbound(SrcMiscData%ModData, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ModData, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ModData) + UB(1:1) = ubound(SrcMiscData%ModData) if (.not. allocated(DstMiscData%ModData)) then allocate(DstMiscData%ModData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2138,8 +2138,8 @@ subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%Mappings)) then - LB(1:1) = lbound(SrcMiscData%Mappings, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Mappings, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Mappings) + UB(1:1) = ubound(SrcMiscData%Mappings) if (.not. allocated(DstMiscData%Mappings)) then allocate(DstMiscData%Mappings(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2174,16 +2174,16 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Glue_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Glue_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(MiscData%ModData)) then - LB(1:1) = lbound(MiscData%ModData, kind=B8Ki) - UB(1:1) = ubound(MiscData%ModData, kind=B8Ki) + LB(1:1) = lbound(MiscData%ModData) + UB(1:1) = ubound(MiscData%ModData) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModDataType(MiscData%ModData(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2191,8 +2191,8 @@ subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ModData) end if if (allocated(MiscData%Mappings)) then - LB(1:1) = lbound(MiscData%Mappings, kind=B8Ki) - UB(1:1) = ubound(MiscData%Mappings, kind=B8Ki) + LB(1:1) = lbound(MiscData%Mappings) + UB(1:1) = ubound(MiscData%Mappings) do i1 = LB(1), UB(1) call Glue_DestroyMappingType(MiscData%Mappings(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2215,23 +2215,23 @@ subroutine Glue_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(Glue_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Glue_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%ModData)) if (allocated(InData%ModData)) then - call RegPackBounds(RF, 1, lbound(InData%ModData, kind=B8Ki), ubound(InData%ModData, kind=B8Ki)) - LB(1:1) = lbound(InData%ModData, kind=B8Ki) - UB(1:1) = ubound(InData%ModData, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ModData), ubound(InData%ModData)) + LB(1:1) = lbound(InData%ModData) + UB(1:1) = ubound(InData%ModData) do i1 = LB(1), UB(1) call NWTC_Library_PackModDataType(RF, InData%ModData(i1)) end do end if call RegPack(RF, allocated(InData%Mappings)) if (allocated(InData%Mappings)) then - call RegPackBounds(RF, 1, lbound(InData%Mappings, kind=B8Ki), ubound(InData%Mappings, kind=B8Ki)) - LB(1:1) = lbound(InData%Mappings, kind=B8Ki) - UB(1:1) = ubound(InData%Mappings, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Mappings), ubound(InData%Mappings)) + LB(1:1) = lbound(InData%Mappings) + UB(1:1) = ubound(InData%Mappings) do i1 = LB(1), UB(1) call Glue_PackMappingType(RF, InData%Mappings(i1)) end do @@ -2248,8 +2248,8 @@ subroutine Glue_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Glue_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Glue_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 7cb92cd30b..105622ef22 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -410,13 +410,13 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "character(*), intent( out) :: ErrMsg"; if (has_ddt_arr) { - w << indent << "integer(B8Ki) :: "; + w << indent << "integer(B4Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; w << ""; } if (has_ddt_arr || has_alloc) - w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; if (has_ddt || has_alloc) w << indent << "integer(IntKi) :: ErrStat2"; if (has_ddt) @@ -451,8 +451,8 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, std::string dims(""); if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; for (int d = 1; d <= field.rank; d++) dims += ",LB(" + std::to_string(d) + "):UB(" + std::to_string(d) + ")"; dims = "(" + dims.substr(1) + ")"; @@ -493,8 +493,8 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, // Get bounds for non-allocated field if (field.rank > 0 && !field.is_allocatable) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; } for (int d = field.rank; d >= 1; d--) @@ -578,10 +578,10 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd w << indent << "character(*), intent( out) :: ErrMsg"; if (has_ddt_arr) { - w << indent << "integer(B8Ki) :: "; + w << indent << "integer(B4Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; - w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_ddt) { @@ -621,8 +621,8 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } for (int d = field.rank; d >= 1; d--) { @@ -701,10 +701,10 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; if (has_ddt_arr) { - w << indent << "integer(B8Ki) :: "; + w << indent << "integer(B4Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; - w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_ptr) { @@ -751,7 +751,7 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, indent += " "; if (field.rank > 0) { - w << indent << "call RegPackBounds(RF, " << field.rank << ", lbound(" << var << ", kind=B8Ki), ubound(" << var << ", kind=B8Ki))"; + w << indent << "call RegPackBounds(RF, " << field.rank << ", lbound(" << var << "), ubound(" << var << "))"; } if (field.is_pointer) { @@ -768,8 +768,8 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } for (int d = field.rank; d >= 1; d--) @@ -844,14 +844,14 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; if (has_ddt_arr) { - w << indent << "integer(B8Ki) :: "; + w << indent << "integer(B4Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; w << ""; } if (has_ddt_arr || has_alloc) { - w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_alloc) { @@ -967,8 +967,8 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt // Get bounds for non-allocated field if (field.rank > 0 && !field.is_allocatable) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } for (int d = field.rank; d >= 1; d--) @@ -1083,7 +1083,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << recurse_level << j << " = LBOUND(" << uy << "_out" << field_var << "," << j << ", kind=B8Ki),UBOUND(" << uy << "_out" << field_var << "," << j << ", kind=B8Ki)"; + w << indent << "do i" << recurse_level << j << " = lbound(" << uy << "_out" << field_var << "," << j << "),ubound(" << uy << "_out" << field_var << "," << j << ")"; indent += " "; } @@ -1112,7 +1112,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << ", kind=B8Ki),UBOUND(" << vout << "," << j << ", kind=B8Ki)"; + w << indent << "do i" << j << " = lbound(" << vout << "," << j << "),ubound(" << vout << "," << j << ")"; indent += " "; } @@ -1179,7 +1179,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << ", kind=B8Ki),UBOUND(" << vout << "," << j << ", kind=B8Ki)"; + w << indent << "do i" << j << " = lbound(" << vout << "," << j << "),ubound(" << vout << "," << j << ")"; indent += " "; } } @@ -1644,7 +1644,7 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d { std::string dims; for (int d = 1; d <= field.rank; d++) - dims += std::string(d > 1 ? "," : "") + "LBOUND(" + var_f + "," + std::to_string(d) + ", kind=B8Ki)"; + dims += std::string(d > 1 ? "," : "") + "lbound(" + var_f + "," + std::to_string(d) + ")"; w << indent; w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; w << indent << "IF (.NOT. SkipPointers_local ) THEN"; diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index fa335d6bfd..7863272314 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -169,7 +169,7 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyInitOutput' @@ -179,8 +179,8 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -191,8 +191,8 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -248,7 +248,7 @@ subroutine Orca_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Orca_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -371,7 +371,7 @@ subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyMisc' @@ -384,8 +384,8 @@ subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PtfmFt = SrcMiscData%PtfmFt DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -432,7 +432,7 @@ subroutine Orca_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Orca_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -450,8 +450,8 @@ subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyParam' @@ -477,8 +477,8 @@ subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SimNamePathLen = SrcParamData%SimNamePathLen DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -498,8 +498,8 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) type(Orca_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_DestroyParam' @@ -514,8 +514,8 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) call FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -528,8 +528,8 @@ subroutine Orca_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(Orca_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, associated(InData%Vars)) @@ -548,9 +548,9 @@ subroutine Orca_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -562,8 +562,8 @@ subroutine Orca_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Orca_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -661,7 +661,7 @@ subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyOutput' @@ -671,8 +671,8 @@ subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -714,7 +714,7 @@ subroutine Orca_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Orca_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index f96a24f0d3..373994e83e 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -67,7 +67,7 @@ subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Current_CopyInitInput' ErrStat = ErrID_None @@ -83,8 +83,8 @@ subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%CurrMod = SrcInitInputData%CurrMod DstInitInputData%EffWtrDpth = SrcInitInputData%EffWtrDpth if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -135,7 +135,7 @@ subroutine Current_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Current_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Current_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -160,14 +160,14 @@ subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Current_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%CurrVxi)) then - LB(1:1) = lbound(SrcInitOutputData%CurrVxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%CurrVxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%CurrVxi) + UB(1:1) = ubound(SrcInitOutputData%CurrVxi) if (.not. allocated(DstInitOutputData%CurrVxi)) then allocate(DstInitOutputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -178,8 +178,8 @@ subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi end if if (allocated(SrcInitOutputData%CurrVyi)) then - LB(1:1) = lbound(SrcInitOutputData%CurrVyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%CurrVyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%CurrVyi) + UB(1:1) = ubound(SrcInitOutputData%CurrVyi) if (.not. allocated(DstInitOutputData%CurrVyi)) then allocate(DstInitOutputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -224,7 +224,7 @@ subroutine Current_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Current_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Current_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 3d2a5b0257..96a847db25 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -211,15 +211,15 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveFieldType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcSeaSt_WaveFieldTypeData%WaveTime)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime, kind=B8Ki) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime, kind=B8Ki) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveTime)) then allocate(DstSeaSt_WaveFieldTypeData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -230,8 +230,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDynP)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP, kind=B8Ki) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP, kind=B8Ki) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDynP)) then allocate(DstSeaSt_WaveFieldTypeData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -242,8 +242,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAcc)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc, kind=B8Ki) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc, kind=B8Ki) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAcc)) then allocate(DstSeaSt_WaveFieldTypeData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -254,8 +254,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF, kind=B8Ki) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF, kind=B8Ki) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) then allocate(DstSeaSt_WaveFieldTypeData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -266,8 +266,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveVel)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel, kind=B8Ki) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel, kind=B8Ki) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveVel)) then allocate(DstSeaSt_WaveFieldTypeData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -278,8 +278,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0, kind=B8Ki) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0, kind=B8Ki) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -290,8 +290,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0, kind=B8Ki) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0, kind=B8Ki) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -302,8 +302,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0, kind=B8Ki) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0, kind=B8Ki) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -314,8 +314,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0, kind=B8Ki) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0, kind=B8Ki) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveVel0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -326,8 +326,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev0)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0, kind=B8Ki) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0, kind=B8Ki) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev0)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -338,8 +338,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElev0 = SrcSeaSt_WaveFieldTypeData%WaveElev0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev1)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1, kind=B8Ki) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1, kind=B8Ki) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev1)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -350,8 +350,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev2)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2, kind=B8Ki) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2, kind=B8Ki) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev2)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -368,8 +368,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC, kind=B8Ki) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC, kind=B8Ki) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -380,8 +380,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElevC = SrcSeaSt_WaveFieldTypeData%WaveElevC end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) then - LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0, kind=B8Ki) - UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0, kind=B8Ki) + LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC0)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -392,8 +392,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElevC0 = SrcSeaSt_WaveFieldTypeData%WaveElevC0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr, kind=B8Ki) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr, kind=B8Ki) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDirArr)) then allocate(DstSeaSt_WaveFieldTypeData%WaveDirArr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -530,7 +530,7 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_WaveFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index d023c8db99..ca3707b3a4 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -197,7 +197,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInputFile' @@ -223,8 +223,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%Echo = SrcInputFileData%Echo DstInputFileData%NWaveElev = SrcInputFileData%NWaveElev if (allocated(SrcInputFileData%WaveElevxi)) then - LB(1:1) = lbound(SrcInputFileData%WaveElevxi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveElevxi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveElevxi) + UB(1:1) = ubound(SrcInputFileData%WaveElevxi) if (.not. allocated(DstInputFileData%WaveElevxi)) then allocate(DstInputFileData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -235,8 +235,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi end if if (allocated(SrcInputFileData%WaveElevyi)) then - LB(1:1) = lbound(SrcInputFileData%WaveElevyi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveElevyi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveElevyi) + UB(1:1) = ubound(SrcInputFileData%WaveElevyi) if (.not. allocated(DstInputFileData%WaveElevyi)) then allocate(DstInputFileData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -248,8 +248,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin if (allocated(SrcInputFileData%WaveKinxi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinxi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveKinxi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveKinxi) + UB(1:1) = ubound(SrcInputFileData%WaveKinxi) if (.not. allocated(DstInputFileData%WaveKinxi)) then allocate(DstInputFileData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -260,8 +260,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi end if if (allocated(SrcInputFileData%WaveKinyi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinyi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveKinyi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveKinyi) + UB(1:1) = ubound(SrcInputFileData%WaveKinyi) if (.not. allocated(DstInputFileData%WaveKinyi)) then allocate(DstInputFileData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -272,8 +272,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi end if if (allocated(SrcInputFileData%WaveKinzi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinzi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveKinzi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveKinzi) + UB(1:1) = ubound(SrcInputFileData%WaveKinzi) if (.not. allocated(DstInputFileData%WaveKinzi)) then allocate(DstInputFileData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -287,8 +287,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%OutAll = SrcInputFileData%OutAll DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -406,7 +406,7 @@ subroutine SeaSt_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -556,15 +556,15 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -575,8 +575,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -591,8 +591,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, if (ErrStat >= AbortErrLev) return DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn if (allocated(SrcInitOutputData%WaveElevVisX)) then - LB(1:1) = lbound(SrcInitOutputData%WaveElevVisX, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WaveElevVisX, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WaveElevVisX) + UB(1:1) = ubound(SrcInitOutputData%WaveElevVisX) if (.not. allocated(DstInitOutputData%WaveElevVisX)) then allocate(DstInitOutputData%WaveElevVisX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -603,8 +603,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElevVisX = SrcInitOutputData%WaveElevVisX end if if (allocated(SrcInitOutputData%WaveElevVisY)) then - LB(1:1) = lbound(SrcInitOutputData%WaveElevVisY, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WaveElevVisY, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WaveElevVisY) + UB(1:1) = ubound(SrcInitOutputData%WaveElevVisY) if (.not. allocated(DstInitOutputData%WaveElevVisY)) then allocate(DstInitOutputData%WaveElevVisY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -615,8 +615,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElevVisY = SrcInitOutputData%WaveElevVisY end if if (allocated(SrcInitOutputData%WaveElevVisGrid)) then - LB(1:3) = lbound(SrcInitOutputData%WaveElevVisGrid, kind=B8Ki) - UB(1:3) = ubound(SrcInitOutputData%WaveElevVisGrid, kind=B8Ki) + LB(1:3) = lbound(SrcInitOutputData%WaveElevVisGrid) + UB(1:3) = ubound(SrcInitOutputData%WaveElevVisGrid) if (.not. allocated(DstInitOutputData%WaveElevVisGrid)) then allocate(DstInitOutputData%WaveElevVisGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -691,7 +691,7 @@ subroutine SeaSt_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -883,8 +883,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyParam' @@ -896,8 +896,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%deltaGrid = SrcParamData%deltaGrid DstParamData%NWaveElev = SrcParamData%NWaveElev if (allocated(SrcParamData%WaveElevxi)) then - LB(1:1) = lbound(SrcParamData%WaveElevxi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveElevxi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveElevxi) + UB(1:1) = ubound(SrcParamData%WaveElevxi) if (.not. allocated(DstParamData%WaveElevxi)) then allocate(DstParamData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -908,8 +908,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveElevxi = SrcParamData%WaveElevxi end if if (allocated(SrcParamData%WaveElevyi)) then - LB(1:1) = lbound(SrcParamData%WaveElevyi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveElevyi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveElevyi) + UB(1:1) = ubound(SrcParamData%WaveElevyi) if (.not. allocated(DstParamData%WaveElevyi)) then allocate(DstParamData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -921,8 +921,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then - LB(1:1) = lbound(SrcParamData%WaveKinxi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveKinxi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveKinxi) + UB(1:1) = ubound(SrcParamData%WaveKinxi) if (.not. allocated(DstParamData%WaveKinxi)) then allocate(DstParamData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -933,8 +933,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinxi = SrcParamData%WaveKinxi end if if (allocated(SrcParamData%WaveKinyi)) then - LB(1:1) = lbound(SrcParamData%WaveKinyi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveKinyi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveKinyi) + UB(1:1) = ubound(SrcParamData%WaveKinyi) if (.not. allocated(DstParamData%WaveKinyi)) then allocate(DstParamData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -945,8 +945,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinyi = SrcParamData%WaveKinyi end if if (allocated(SrcParamData%WaveKinzi)) then - LB(1:1) = lbound(SrcParamData%WaveKinzi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveKinzi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveKinzi) + UB(1:1) = ubound(SrcParamData%WaveKinzi) if (.not. allocated(DstParamData%WaveKinzi)) then allocate(DstParamData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -957,8 +957,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinzi = SrcParamData%WaveKinzi end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -997,8 +997,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) type(SeaSt_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' @@ -1020,8 +1020,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveKinzi) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1040,8 +1040,8 @@ subroutine SeaSt_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(SeaSt_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%WaveDT) @@ -1057,9 +1057,9 @@ subroutine SeaSt_PackParam(RF, Indata) call RegPackAlloc(RF, InData%WaveKinzi) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1085,8 +1085,8 @@ subroutine SeaSt_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1187,14 +1187,14 @@ subroutine SeaSt_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SeaSt_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1231,7 +1231,7 @@ subroutine SeaSt_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index f3fc051ff7..34e1bb24f2 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -65,7 +65,7 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves2_CopyInitInput' ErrStat = ErrID_None @@ -75,8 +75,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid if (allocated(SrcInitInputData%WaveKinGridxi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) if (.not. allocated(DstInitInputData%WaveKinGridxi)) then allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -87,8 +87,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi end if if (allocated(SrcInitInputData%WaveKinGridyi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) if (.not. allocated(DstInitInputData%WaveKinGridyi)) then allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -99,8 +99,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi end if if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -153,7 +153,7 @@ subroutine Waves2_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Waves2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -174,14 +174,14 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves2_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WaveAcc2D)) then - LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D, kind=B8Ki) - UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D, kind=B8Ki) + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D) if (.not. allocated(DstInitOutputData%WaveAcc2D)) then allocate(DstInitOutputData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -192,8 +192,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D end if if (allocated(SrcInitOutputData%WaveDynP2D)) then - LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D, kind=B8Ki) - UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D, kind=B8Ki) + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D) if (.not. allocated(DstInitOutputData%WaveDynP2D)) then allocate(DstInitOutputData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -204,8 +204,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D end if if (allocated(SrcInitOutputData%WaveAcc2S)) then - LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S, kind=B8Ki) - UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S, kind=B8Ki) + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S) if (.not. allocated(DstInitOutputData%WaveAcc2S)) then allocate(DstInitOutputData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -216,8 +216,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S end if if (allocated(SrcInitOutputData%WaveDynP2S)) then - LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S, kind=B8Ki) - UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S, kind=B8Ki) + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S) if (.not. allocated(DstInitOutputData%WaveDynP2S)) then allocate(DstInitOutputData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -228,8 +228,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S end if if (allocated(SrcInitOutputData%WaveVel2D)) then - LB(1:5) = lbound(SrcInitOutputData%WaveVel2D, kind=B8Ki) - UB(1:5) = ubound(SrcInitOutputData%WaveVel2D, kind=B8Ki) + LB(1:5) = lbound(SrcInitOutputData%WaveVel2D) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2D) if (.not. allocated(DstInitOutputData%WaveVel2D)) then allocate(DstInitOutputData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -240,8 +240,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D end if if (allocated(SrcInitOutputData%WaveVel2S)) then - LB(1:5) = lbound(SrcInitOutputData%WaveVel2S, kind=B8Ki) - UB(1:5) = ubound(SrcInitOutputData%WaveVel2S, kind=B8Ki) + LB(1:5) = lbound(SrcInitOutputData%WaveVel2S) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2S) if (.not. allocated(DstInitOutputData%WaveVel2S)) then allocate(DstInitOutputData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -298,7 +298,7 @@ subroutine Waves2_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Waves2_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitOutput' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index d5daa2a2d9..fce0e83f2e 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -85,7 +85,7 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Waves_CopyInitInput' @@ -109,8 +109,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid if (allocated(SrcInitInputData%WaveKinGridxi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) if (.not. allocated(DstInitInputData%WaveKinGridxi)) then allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -121,8 +121,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi end if if (allocated(SrcInitInputData%WaveKinGridyi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) if (.not. allocated(DstInitInputData%WaveKinGridyi)) then allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -133,8 +133,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi end if if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -145,8 +145,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi end if if (allocated(SrcInitInputData%CurrVxi)) then - LB(1:1) = lbound(SrcInitInputData%CurrVxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CurrVxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CurrVxi) + UB(1:1) = ubound(SrcInitInputData%CurrVxi) if (.not. allocated(DstInitInputData%CurrVxi)) then allocate(DstInitInputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -157,8 +157,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi end if if (allocated(SrcInitInputData%CurrVyi)) then - LB(1:1) = lbound(SrcInitInputData%CurrVyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CurrVyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CurrVyi) + UB(1:1) = ubound(SrcInitInputData%CurrVyi) if (.not. allocated(DstInitInputData%CurrVyi)) then allocate(DstInitInputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -256,7 +256,7 @@ subroutine Waves_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Waves_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 13cfb36ebe..8360ad2b17 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -670,7 +670,7 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyInitInput' @@ -681,8 +681,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%NumBl = SrcInitInputData%NumBl DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%BlPitchInit)) then - LB(1:1) = lbound(SrcInitInputData%BlPitchInit, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%BlPitchInit, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%BlPitchInit) + UB(1:1) = ubound(SrcInitInputData%BlPitchInit) if (.not. allocated(DstInitInputData%BlPitchInit)) then allocate(DstInitInputData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -715,8 +715,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%TrimGain = SrcInitInputData%TrimGain DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef if (allocated(SrcInitInputData%BladeRootRefPos)) then - LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos) + UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos) if (.not. allocated(DstInitInputData%BladeRootRefPos)) then allocate(DstInitInputData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -727,8 +727,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos end if if (allocated(SrcInitInputData%BladeRootTransDisp)) then - LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp) + UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp) if (.not. allocated(DstInitInputData%BladeRootTransDisp)) then allocate(DstInitInputData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -739,8 +739,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp end if if (allocated(SrcInitInputData%BladeRootOrient)) then - LB(1:3) = lbound(SrcInitInputData%BladeRootOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%BladeRootOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%BladeRootOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootOrient) if (.not. allocated(DstInitInputData%BladeRootOrient)) then allocate(DstInitInputData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -751,8 +751,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient end if if (allocated(SrcInitInputData%BladeRootRefOrient)) then - LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient) if (.not. allocated(DstInitInputData%BladeRootRefOrient)) then allocate(DstInitInputData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -768,8 +768,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS if (ErrStat >= AbortErrLev) return DstInitInputData%NumCableControl = SrcInitInputData%NumCableControl if (allocated(SrcInitInputData%CableControlRequestor)) then - LB(1:1) = lbound(SrcInitInputData%CableControlRequestor, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CableControlRequestor, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CableControlRequestor) + UB(1:1) = ubound(SrcInitInputData%CableControlRequestor) if (.not. allocated(DstInitInputData%CableControlRequestor)) then allocate(DstInitInputData%CableControlRequestor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -781,8 +781,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder if (allocated(SrcInitInputData%fromSCGlob)) then - LB(1:1) = lbound(SrcInitInputData%fromSCGlob, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%fromSCGlob, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) if (.not. allocated(DstInitInputData%fromSCGlob)) then allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -793,8 +793,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob end if if (allocated(SrcInitInputData%fromSC)) then - LB(1:1) = lbound(SrcInitInputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) if (.not. allocated(DstInitInputData%fromSC)) then allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -805,8 +805,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%fromSC = SrcInitInputData%fromSC end if if (allocated(SrcInitInputData%LidSpeed)) then - LB(1:1) = lbound(SrcInitInputData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%LidSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%LidSpeed) + UB(1:1) = ubound(SrcInitInputData%LidSpeed) if (.not. allocated(DstInitInputData%LidSpeed)) then allocate(DstInitInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -817,8 +817,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed end if if (allocated(SrcInitInputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsX, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsX) if (.not. allocated(DstInitInputData%MsrPositionsX)) then allocate(DstInitInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -829,8 +829,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX end if if (allocated(SrcInitInputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsY, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsY) if (.not. allocated(DstInitInputData%MsrPositionsY)) then allocate(DstInitInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -841,8 +841,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY end if if (allocated(SrcInitInputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ) if (.not. allocated(DstInitInputData%MsrPositionsZ)) then allocate(DstInitInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -967,7 +967,7 @@ subroutine SrvD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1026,15 +1026,15 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1045,8 +1045,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1063,8 +1063,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1075,8 +1075,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1087,8 +1087,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1099,8 +1099,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1111,8 +1111,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1123,8 +1123,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1135,8 +1135,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1147,8 +1147,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1237,7 +1237,7 @@ subroutine SrvD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1282,7 +1282,7 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SrvD_CopyInputFile' ErrStat = ErrID_None @@ -1337,8 +1337,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1369,8 +1369,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GenPwr_Dem = SrcInputFileData%GenPwr_Dem DstInputFileData%DLL_NumTrq = SrcInputFileData%DLL_NumTrq if (allocated(SrcInputFileData%GenSpd_TLU)) then - LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU) + UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU) if (.not. allocated(DstInputFileData%GenSpd_TLU)) then allocate(DstInputFileData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1381,8 +1381,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU end if if (allocated(SrcInputFileData%GenTrq_TLU)) then - LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU) + UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU) if (.not. allocated(DstInputFileData%GenTrq_TLU)) then allocate(DstInputFileData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1395,8 +1395,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface DstInputFileData%NumBStC = SrcInputFileData%NumBStC if (allocated(SrcInputFileData%BStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%BStCfiles, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BStCfiles, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BStCfiles) + UB(1:1) = ubound(SrcInputFileData%BStCfiles) if (.not. allocated(DstInputFileData%BStCfiles)) then allocate(DstInputFileData%BStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1408,8 +1408,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumNStC = SrcInputFileData%NumNStC if (allocated(SrcInputFileData%NStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%NStCfiles, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%NStCfiles, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%NStCfiles) + UB(1:1) = ubound(SrcInputFileData%NStCfiles) if (.not. allocated(DstInputFileData%NStCfiles)) then allocate(DstInputFileData%NStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1421,8 +1421,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumTStC = SrcInputFileData%NumTStC if (allocated(SrcInputFileData%TStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%TStCfiles, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TStCfiles, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TStCfiles) + UB(1:1) = ubound(SrcInputFileData%TStCfiles) if (.not. allocated(DstInputFileData%TStCfiles)) then allocate(DstInputFileData%TStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1434,8 +1434,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumSStC = SrcInputFileData%NumSStC if (allocated(SrcInputFileData%SStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%SStCfiles, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%SStCfiles, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%SStCfiles) + UB(1:1) = ubound(SrcInputFileData%SStCfiles) if (.not. allocated(DstInputFileData%SStCfiles)) then allocate(DstInputFileData%SStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1582,7 +1582,7 @@ subroutine SrvD_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1681,16 +1681,16 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyBladedDLLType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBladedDLLTypeData%avrSWAP)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP) + UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP) if (.not. allocated(DstBladedDLLTypeData%avrSWAP)) then allocate(DstBladedDLLTypeData%avrSWAP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1711,8 +1711,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev if (allocated(SrcBladedDLLTypeData%toSC)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%toSC, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%toSC) + UB(1:1) = ubound(SrcBladedDLLTypeData%toSC) if (.not. allocated(DstBladedDLLTypeData%toSC)) then allocate(DstBladedDLLTypeData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1725,8 +1725,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels if (allocated(SrcBladedDLLTypeData%LogChannels_OutParam)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam) if (.not. allocated(DstBladedDLLTypeData%LogChannels_OutParam)) then allocate(DstBladedDLLTypeData%LogChannels_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1741,8 +1741,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end do end if if (allocated(SrcBladedDLLTypeData%LogChannels)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels) if (.not. allocated(DstBladedDLLTypeData%LogChannels)) then allocate(DstBladedDLLTypeData%LogChannels(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1763,8 +1763,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand if (allocated(SrcBladedDLLTypeData%BlPitchInput)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput) + UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput) if (.not. allocated(DstBladedDLLTypeData%BlPitchInput)) then allocate(DstBladedDLLTypeData%BlPitchInput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1801,8 +1801,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs if (allocated(SrcBladedDLLTypeData%LidSpeed)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed) + UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed) if (.not. allocated(DstBladedDLLTypeData%LidSpeed)) then allocate(DstBladedDLLTypeData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1813,8 +1813,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed end if if (allocated(SrcBladedDLLTypeData%MsrPositionsX)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsX)) then allocate(DstBladedDLLTypeData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1825,8 +1825,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX end if if (allocated(SrcBladedDLLTypeData%MsrPositionsY)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsY)) then allocate(DstBladedDLLTypeData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1837,8 +1837,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY end if if (allocated(SrcBladedDLLTypeData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsZ)) then allocate(DstBladedDLLTypeData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1870,8 +1870,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq if (allocated(SrcBladedDLLTypeData%GenSpd_TLU)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU) if (.not. allocated(DstBladedDLLTypeData%GenSpd_TLU)) then allocate(DstBladedDLLTypeData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1882,8 +1882,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU end if if (allocated(SrcBladedDLLTypeData%GenTrq_TLU)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU) if (.not. allocated(DstBladedDLLTypeData%GenTrq_TLU)) then allocate(DstBladedDLLTypeData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1895,8 +1895,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl if (allocated(SrcBladedDLLTypeData%PrevCableDeltaL)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL) if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaL)) then allocate(DstBladedDLLTypeData%PrevCableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1907,8 +1907,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL end if if (allocated(SrcBladedDLLTypeData%PrevCableDeltaLdot)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot) if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaLdot)) then allocate(DstBladedDLLTypeData%PrevCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1919,8 +1919,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot end if if (allocated(SrcBladedDLLTypeData%CableDeltaL)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL) if (.not. allocated(DstBladedDLLTypeData%CableDeltaL)) then allocate(DstBladedDLLTypeData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1931,8 +1931,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL end if if (allocated(SrcBladedDLLTypeData%CableDeltaLdot)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot) if (.not. allocated(DstBladedDLLTypeData%CableDeltaLdot)) then allocate(DstBladedDLLTypeData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1943,8 +1943,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdStiff)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdStiff)) then allocate(DstBladedDLLTypeData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1955,8 +1955,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdDamp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdDamp)) then allocate(DstBladedDLLTypeData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1967,8 +1967,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdBrake)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdBrake)) then allocate(DstBladedDLLTypeData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1979,8 +1979,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdForce)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdForce)) then allocate(DstBladedDLLTypeData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1991,8 +1991,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce end if if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff) if (.not. allocated(DstBladedDLLTypeData%StCCmdStiff)) then allocate(DstBladedDLLTypeData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2003,8 +2003,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff end if if (allocated(SrcBladedDLLTypeData%StCCmdDamp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp) if (.not. allocated(DstBladedDLLTypeData%StCCmdDamp)) then allocate(DstBladedDLLTypeData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2015,8 +2015,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp end if if (allocated(SrcBladedDLLTypeData%StCCmdBrake)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake) if (.not. allocated(DstBladedDLLTypeData%StCCmdBrake)) then allocate(DstBladedDLLTypeData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2027,8 +2027,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake end if if (allocated(SrcBladedDLLTypeData%StCCmdForce)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce) if (.not. allocated(DstBladedDLLTypeData%StCCmdForce)) then allocate(DstBladedDLLTypeData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2039,8 +2039,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce end if if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp) if (.not. allocated(DstBladedDLLTypeData%StCMeasDisp)) then allocate(DstBladedDLLTypeData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2051,8 +2051,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp end if if (allocated(SrcBladedDLLTypeData%StCMeasVel)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel) if (.not. allocated(DstBladedDLLTypeData%StCMeasVel)) then allocate(DstBladedDLLTypeData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2068,8 +2068,8 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) type(BladedDLLType), intent(inout) :: BladedDLLTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyBladedDLLType' @@ -2082,8 +2082,8 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) deallocate(BladedDLLTypeData%toSC) end if if (allocated(BladedDLLTypeData%LogChannels_OutParam)) then - LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) - UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) + LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2162,8 +2162,8 @@ subroutine SrvD_PackBladedDLLType(RF, Indata) type(RegFile), intent(inout) :: RF type(BladedDLLType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackBladedDLLType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%avrSWAP) call RegPack(RF, InData%HSSBrTrqDemand) @@ -2181,9 +2181,9 @@ subroutine SrvD_PackBladedDLLType(RF, Indata) call RegPack(RF, InData%NumLogChannels) call RegPack(RF, allocated(InData%LogChannels_OutParam)) if (allocated(InData%LogChannels_OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%LogChannels_OutParam, kind=B8Ki), ubound(InData%LogChannels_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%LogChannels_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%LogChannels_OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%LogChannels_OutParam), ubound(InData%LogChannels_OutParam)) + LB(1:1) = lbound(InData%LogChannels_OutParam) + UB(1:1) = ubound(InData%LogChannels_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%LogChannels_OutParam(i1)) end do @@ -2275,8 +2275,8 @@ subroutine SrvD_UnPackBladedDLLType(RF, OutData) type(RegFile), intent(inout) :: RF type(BladedDLLType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackBladedDLLType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2395,8 +2395,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyContState' @@ -2404,8 +2404,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS ErrMsg = '' DstContStateData%DummyContState = SrcContStateData%DummyContState if (allocated(SrcContStateData%BStC)) then - LB(1:1) = lbound(SrcContStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%BStC) + UB(1:1) = ubound(SrcContStateData%BStC) if (.not. allocated(DstContStateData%BStC)) then allocate(DstContStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2420,8 +2420,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%NStC)) then - LB(1:1) = lbound(SrcContStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%NStC) + UB(1:1) = ubound(SrcContStateData%NStC) if (.not. allocated(DstContStateData%NStC)) then allocate(DstContStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2436,8 +2436,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%TStC)) then - LB(1:1) = lbound(SrcContStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%TStC) + UB(1:1) = ubound(SrcContStateData%TStC) if (.not. allocated(DstContStateData%TStC)) then allocate(DstContStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2452,8 +2452,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%SStC)) then - LB(1:1) = lbound(SrcContStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%SStC) + UB(1:1) = ubound(SrcContStateData%SStC) if (.not. allocated(DstContStateData%SStC)) then allocate(DstContStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2473,16 +2473,16 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) type(SrvD_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%BStC)) then - LB(1:1) = lbound(ContStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(ContStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(ContStateData%BStC) + UB(1:1) = ubound(ContStateData%BStC) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2490,8 +2490,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%BStC) end if if (allocated(ContStateData%NStC)) then - LB(1:1) = lbound(ContStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(ContStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(ContStateData%NStC) + UB(1:1) = ubound(ContStateData%NStC) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2499,8 +2499,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%NStC) end if if (allocated(ContStateData%TStC)) then - LB(1:1) = lbound(ContStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(ContStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(ContStateData%TStC) + UB(1:1) = ubound(ContStateData%TStC) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2508,8 +2508,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%TStC) end if if (allocated(ContStateData%SStC)) then - LB(1:1) = lbound(ContStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(ContStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(ContStateData%SStC) + UB(1:1) = ubound(ContStateData%SStC) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2522,42 +2522,42 @@ subroutine SrvD_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DummyContState) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) do i1 = LB(1), UB(1) call StC_PackContState(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) do i1 = LB(1), UB(1) call StC_PackContState(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) do i1 = LB(1), UB(1) call StC_PackContState(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) do i1 = LB(1), UB(1) call StC_PackContState(RF, InData%SStC(i1)) end do @@ -2569,8 +2569,8 @@ subroutine SrvD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2635,8 +2635,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyDiscState' @@ -2644,8 +2644,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS ErrMsg = '' DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset if (allocated(SrcDiscStateData%BStC)) then - LB(1:1) = lbound(SrcDiscStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%BStC) + UB(1:1) = ubound(SrcDiscStateData%BStC) if (.not. allocated(DstDiscStateData%BStC)) then allocate(DstDiscStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2660,8 +2660,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%NStC)) then - LB(1:1) = lbound(SrcDiscStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%NStC) + UB(1:1) = ubound(SrcDiscStateData%NStC) if (.not. allocated(DstDiscStateData%NStC)) then allocate(DstDiscStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2676,8 +2676,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%TStC)) then - LB(1:1) = lbound(SrcDiscStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%TStC) + UB(1:1) = ubound(SrcDiscStateData%TStC) if (.not. allocated(DstDiscStateData%TStC)) then allocate(DstDiscStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2692,8 +2692,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%SStC)) then - LB(1:1) = lbound(SrcDiscStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%SStC) + UB(1:1) = ubound(SrcDiscStateData%SStC) if (.not. allocated(DstDiscStateData%SStC)) then allocate(DstDiscStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2713,16 +2713,16 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(SrvD_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%BStC)) then - LB(1:1) = lbound(DiscStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%BStC) + UB(1:1) = ubound(DiscStateData%BStC) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2730,8 +2730,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%BStC) end if if (allocated(DiscStateData%NStC)) then - LB(1:1) = lbound(DiscStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%NStC) + UB(1:1) = ubound(DiscStateData%NStC) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2739,8 +2739,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%NStC) end if if (allocated(DiscStateData%TStC)) then - LB(1:1) = lbound(DiscStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%TStC) + UB(1:1) = ubound(DiscStateData%TStC) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2748,8 +2748,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%TStC) end if if (allocated(DiscStateData%SStC)) then - LB(1:1) = lbound(DiscStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%SStC) + UB(1:1) = ubound(DiscStateData%SStC) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2762,42 +2762,42 @@ subroutine SrvD_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%CtrlOffset) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) do i1 = LB(1), UB(1) call StC_PackDiscState(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) do i1 = LB(1), UB(1) call StC_PackDiscState(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) do i1 = LB(1), UB(1) call StC_PackDiscState(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) do i1 = LB(1), UB(1) call StC_PackDiscState(RF, InData%SStC(i1)) end do @@ -2809,8 +2809,8 @@ subroutine SrvD_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2875,8 +2875,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyConstrState' @@ -2884,8 +2884,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode ErrMsg = '' DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState if (allocated(SrcConstrStateData%BStC)) then - LB(1:1) = lbound(SrcConstrStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%BStC) + UB(1:1) = ubound(SrcConstrStateData%BStC) if (.not. allocated(DstConstrStateData%BStC)) then allocate(DstConstrStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2900,8 +2900,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%NStC)) then - LB(1:1) = lbound(SrcConstrStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%NStC) + UB(1:1) = ubound(SrcConstrStateData%NStC) if (.not. allocated(DstConstrStateData%NStC)) then allocate(DstConstrStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2916,8 +2916,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%TStC)) then - LB(1:1) = lbound(SrcConstrStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%TStC) + UB(1:1) = ubound(SrcConstrStateData%TStC) if (.not. allocated(DstConstrStateData%TStC)) then allocate(DstConstrStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2932,8 +2932,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%SStC)) then - LB(1:1) = lbound(SrcConstrStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%SStC) + UB(1:1) = ubound(SrcConstrStateData%SStC) if (.not. allocated(DstConstrStateData%SStC)) then allocate(DstConstrStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2953,16 +2953,16 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(SrvD_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%BStC)) then - LB(1:1) = lbound(ConstrStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%BStC) + UB(1:1) = ubound(ConstrStateData%BStC) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2970,8 +2970,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%BStC) end if if (allocated(ConstrStateData%NStC)) then - LB(1:1) = lbound(ConstrStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%NStC) + UB(1:1) = ubound(ConstrStateData%NStC) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2979,8 +2979,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%NStC) end if if (allocated(ConstrStateData%TStC)) then - LB(1:1) = lbound(ConstrStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%TStC) + UB(1:1) = ubound(ConstrStateData%TStC) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2988,8 +2988,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%TStC) end if if (allocated(ConstrStateData%SStC)) then - LB(1:1) = lbound(ConstrStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%SStC) + UB(1:1) = ubound(ConstrStateData%SStC) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3002,42 +3002,42 @@ subroutine SrvD_PackConstrState(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DummyConstrState) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) do i1 = LB(1), UB(1) call StC_PackConstrState(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) do i1 = LB(1), UB(1) call StC_PackConstrState(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) do i1 = LB(1), UB(1) call StC_PackConstrState(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) do i1 = LB(1), UB(1) call StC_PackConstrState(RF, InData%SStC(i1)) end do @@ -3049,8 +3049,8 @@ subroutine SrvD_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3115,16 +3115,16 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%BegPitMan)) then - LB(1:1) = lbound(SrcOtherStateData%BegPitMan, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%BegPitMan, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%BegPitMan) + UB(1:1) = ubound(SrcOtherStateData%BegPitMan) if (.not. allocated(DstOtherStateData%BegPitMan)) then allocate(DstOtherStateData%BegPitMan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3135,8 +3135,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan end if if (allocated(SrcOtherStateData%BlPitchI)) then - LB(1:1) = lbound(SrcOtherStateData%BlPitchI, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%BlPitchI, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%BlPitchI) + UB(1:1) = ubound(SrcOtherStateData%BlPitchI) if (.not. allocated(DstOtherStateData%BlPitchI)) then allocate(DstOtherStateData%BlPitchI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3147,8 +3147,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI end if if (allocated(SrcOtherStateData%TPitManE)) then - LB(1:1) = lbound(SrcOtherStateData%TPitManE, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%TPitManE, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%TPitManE) + UB(1:1) = ubound(SrcOtherStateData%TPitManE) if (.not. allocated(DstOtherStateData%TPitManE)) then allocate(DstOtherStateData%TPitManE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3163,8 +3163,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt if (allocated(SrcOtherStateData%BegTpBr)) then - LB(1:1) = lbound(SrcOtherStateData%BegTpBr, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%BegTpBr, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%BegTpBr) + UB(1:1) = ubound(SrcOtherStateData%BegTpBr) if (.not. allocated(DstOtherStateData%BegTpBr)) then allocate(DstOtherStateData%BegTpBr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3175,8 +3175,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr end if if (allocated(SrcOtherStateData%TTpBrDp)) then - LB(1:1) = lbound(SrcOtherStateData%TTpBrDp, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%TTpBrDp, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%TTpBrDp) + UB(1:1) = ubound(SrcOtherStateData%TTpBrDp) if (.not. allocated(DstOtherStateData%TTpBrDp)) then allocate(DstOtherStateData%TTpBrDp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3187,8 +3187,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp end if if (allocated(SrcOtherStateData%TTpBrFl)) then - LB(1:1) = lbound(SrcOtherStateData%TTpBrFl, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%TTpBrFl, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%TTpBrFl) + UB(1:1) = ubound(SrcOtherStateData%TTpBrFl) if (.not. allocated(DstOtherStateData%TTpBrFl)) then allocate(DstOtherStateData%TTpBrFl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3201,8 +3201,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine if (allocated(SrcOtherStateData%BStC)) then - LB(1:1) = lbound(SrcOtherStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%BStC) + UB(1:1) = ubound(SrcOtherStateData%BStC) if (.not. allocated(DstOtherStateData%BStC)) then allocate(DstOtherStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3217,8 +3217,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%NStC)) then - LB(1:1) = lbound(SrcOtherStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%NStC) + UB(1:1) = ubound(SrcOtherStateData%NStC) if (.not. allocated(DstOtherStateData%NStC)) then allocate(DstOtherStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3233,8 +3233,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%TStC)) then - LB(1:1) = lbound(SrcOtherStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%TStC) + UB(1:1) = ubound(SrcOtherStateData%TStC) if (.not. allocated(DstOtherStateData%TStC)) then allocate(DstOtherStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3249,8 +3249,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%SStC)) then - LB(1:1) = lbound(SrcOtherStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%SStC) + UB(1:1) = ubound(SrcOtherStateData%SStC) if (.not. allocated(DstOtherStateData%SStC)) then allocate(DstOtherStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3270,8 +3270,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SrvD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyOtherState' @@ -3296,8 +3296,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%TTpBrFl) end if if (allocated(OtherStateData%BStC)) then - LB(1:1) = lbound(OtherStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%BStC) + UB(1:1) = ubound(OtherStateData%BStC) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3305,8 +3305,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%BStC) end if if (allocated(OtherStateData%NStC)) then - LB(1:1) = lbound(OtherStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%NStC) + UB(1:1) = ubound(OtherStateData%NStC) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3314,8 +3314,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%NStC) end if if (allocated(OtherStateData%TStC)) then - LB(1:1) = lbound(OtherStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%TStC) + UB(1:1) = ubound(OtherStateData%TStC) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3323,8 +3323,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%TStC) end if if (allocated(OtherStateData%SStC)) then - LB(1:1) = lbound(OtherStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%SStC) + UB(1:1) = ubound(OtherStateData%SStC) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3337,8 +3337,8 @@ subroutine SrvD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%BegPitMan) call RegPackAlloc(RF, InData%BlPitchI) @@ -3354,36 +3354,36 @@ subroutine SrvD_PackOtherState(RF, Indata) call RegPack(RF, InData%GenOnLine) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) do i1 = LB(1), UB(1) call StC_PackOtherState(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) do i1 = LB(1), UB(1) call StC_PackOtherState(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) do i1 = LB(1), UB(1) call StC_PackOtherState(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) do i1 = LB(1), UB(1) call StC_PackOtherState(RF, InData%SStC(i1)) end do @@ -3395,8 +3395,8 @@ subroutine SrvD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3472,16 +3472,16 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) then - LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) if (.not. allocated(DstModuleMapTypeData%u_BStC_Mot2_BStC)) then allocate(DstModuleMapTypeData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3498,8 +3498,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) if (.not. allocated(DstModuleMapTypeData%u_NStC_Mot2_NStC)) then allocate(DstModuleMapTypeData%u_NStC_Mot2_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3514,8 +3514,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) if (.not. allocated(DstModuleMapTypeData%u_TStC_Mot2_TStC)) then allocate(DstModuleMapTypeData%u_TStC_Mot2_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3530,8 +3530,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) if (.not. allocated(DstModuleMapTypeData%u_SStC_Mot2_SStC)) then allocate(DstModuleMapTypeData%u_SStC_Mot2_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3546,8 +3546,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) if (.not. allocated(DstModuleMapTypeData%BStC_Frc2_y_BStC)) then allocate(DstModuleMapTypeData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3564,8 +3564,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) if (.not. allocated(DstModuleMapTypeData%NStC_Frc2_y_NStC)) then allocate(DstModuleMapTypeData%NStC_Frc2_y_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3580,8 +3580,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) if (.not. allocated(DstModuleMapTypeData%TStC_Frc2_y_TStC)) then allocate(DstModuleMapTypeData%TStC_Frc2_y_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3596,8 +3596,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) if (.not. allocated(DstModuleMapTypeData%SStC_Frc2_y_SStC)) then allocate(DstModuleMapTypeData%SStC_Frc2_y_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3617,16 +3617,16 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) type(SrvD_ModuleMapType), intent(inout) :: ModuleMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModuleMapTypeData%u_BStC_Mot2_BStC)) then - LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2) @@ -3636,8 +3636,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_BStC_Mot2_BStC) end if if (allocated(ModuleMapTypeData%u_NStC_Mot2_NStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3645,8 +3645,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_NStC_Mot2_NStC) end if if (allocated(ModuleMapTypeData%u_TStC_Mot2_TStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3654,8 +3654,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_TStC_Mot2_TStC) end if if (allocated(ModuleMapTypeData%u_SStC_Mot2_SStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3663,8 +3663,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_SStC_Mot2_SStC) end if if (allocated(ModuleMapTypeData%BStC_Frc2_y_BStC)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2) @@ -3674,8 +3674,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_Frc2_y_BStC) end if if (allocated(ModuleMapTypeData%NStC_Frc2_y_NStC)) then - LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3683,8 +3683,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%NStC_Frc2_y_NStC) end if if (allocated(ModuleMapTypeData%TStC_Frc2_y_TStC)) then - LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3692,8 +3692,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%TStC_Frc2_y_TStC) end if if (allocated(ModuleMapTypeData%SStC_Frc2_y_SStC)) then - LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3706,14 +3706,14 @@ subroutine SrvD_PackModuleMapType(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%u_BStC_Mot2_BStC)) if (allocated(InData%u_BStC_Mot2_BStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki), ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%u_BStC_Mot2_BStC), ubound(InData%u_BStC_Mot2_BStC)) + LB(1:2) = lbound(InData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(InData%u_BStC_Mot2_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%u_BStC_Mot2_BStC(i1,i2)) @@ -3722,36 +3722,36 @@ subroutine SrvD_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%u_NStC_Mot2_NStC)) if (allocated(InData%u_NStC_Mot2_NStC)) then - call RegPackBounds(RF, 1, lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki), ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki) - UB(1:1) = ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_NStC_Mot2_NStC), ubound(InData%u_NStC_Mot2_NStC)) + LB(1:1) = lbound(InData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(InData%u_NStC_Mot2_NStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%u_NStC_Mot2_NStC(i1)) end do end if call RegPack(RF, allocated(InData%u_TStC_Mot2_TStC)) if (allocated(InData%u_TStC_Mot2_TStC)) then - call RegPackBounds(RF, 1, lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki), ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki) - UB(1:1) = ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_TStC_Mot2_TStC), ubound(InData%u_TStC_Mot2_TStC)) + LB(1:1) = lbound(InData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(InData%u_TStC_Mot2_TStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%u_TStC_Mot2_TStC(i1)) end do end if call RegPack(RF, allocated(InData%u_SStC_Mot2_SStC)) if (allocated(InData%u_SStC_Mot2_SStC)) then - call RegPackBounds(RF, 1, lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki), ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki) - UB(1:1) = ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_SStC_Mot2_SStC), ubound(InData%u_SStC_Mot2_SStC)) + LB(1:1) = lbound(InData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(InData%u_SStC_Mot2_SStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%u_SStC_Mot2_SStC(i1)) end do end if call RegPack(RF, allocated(InData%BStC_Frc2_y_BStC)) if (allocated(InData%BStC_Frc2_y_BStC)) then - call RegPackBounds(RF, 2, lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki), ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki)) - LB(1:2) = lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki) - UB(1:2) = ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BStC_Frc2_y_BStC), ubound(InData%BStC_Frc2_y_BStC)) + LB(1:2) = lbound(InData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(InData%BStC_Frc2_y_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BStC_Frc2_y_BStC(i1,i2)) @@ -3760,27 +3760,27 @@ subroutine SrvD_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%NStC_Frc2_y_NStC)) if (allocated(InData%NStC_Frc2_y_NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki), ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC_Frc2_y_NStC), ubound(InData%NStC_Frc2_y_NStC)) + LB(1:1) = lbound(InData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(InData%NStC_Frc2_y_NStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%NStC_Frc2_y_NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC_Frc2_y_TStC)) if (allocated(InData%TStC_Frc2_y_TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki), ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC_Frc2_y_TStC), ubound(InData%TStC_Frc2_y_TStC)) + LB(1:1) = lbound(InData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(InData%TStC_Frc2_y_TStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%TStC_Frc2_y_TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC_Frc2_y_SStC)) if (allocated(InData%SStC_Frc2_y_SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki), ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC_Frc2_y_SStC), ubound(InData%SStC_Frc2_y_SStC)) + LB(1:1) = lbound(InData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(InData%SStC_Frc2_y_SStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SStC_Frc2_y_SStC(i1)) end do @@ -3792,8 +3792,8 @@ subroutine SrvD_UnPackModuleMapType(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackModuleMapType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3913,8 +3913,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyParam' @@ -3944,8 +3944,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 DstParamData%GenEff = SrcParamData%GenEff if (allocated(SrcParamData%BlPitchInit)) then - LB(1:1) = lbound(SrcParamData%BlPitchInit, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BlPitchInit, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BlPitchInit) + UB(1:1) = ubound(SrcParamData%BlPitchInit) if (.not. allocated(DstParamData%BlPitchInit)) then allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3956,8 +3956,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlPitchInit = SrcParamData%BlPitchInit end if if (allocated(SrcParamData%BlPitchF)) then - LB(1:1) = lbound(SrcParamData%BlPitchF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BlPitchF, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BlPitchF) + UB(1:1) = ubound(SrcParamData%BlPitchF) if (.not. allocated(DstParamData%BlPitchF)) then allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3968,8 +3968,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlPitchF = SrcParamData%BlPitchF end if if (allocated(SrcParamData%PitManRat)) then - LB(1:1) = lbound(SrcParamData%PitManRat, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%PitManRat, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%PitManRat) + UB(1:1) = ubound(SrcParamData%PitManRat) if (.not. allocated(DstParamData%PitManRat)) then allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3988,8 +3988,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TimGenOn = SrcParamData%TimGenOn DstParamData%TPCOn = SrcParamData%TPCOn if (allocated(SrcParamData%TPitManS)) then - LB(1:1) = lbound(SrcParamData%TPitManS, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TPitManS, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%TPitManS) + UB(1:1) = ubound(SrcParamData%TPitManS) if (.not. allocated(DstParamData%TPitManS)) then allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4022,8 +4022,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%YawDamp = SrcParamData%YawDamp DstParamData%TpBrDT = SrcParamData%TpBrDT if (allocated(SrcParamData%TBDepISp)) then - LB(1:1) = lbound(SrcParamData%TBDepISp, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TBDepISp, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%TBDepISp) + UB(1:1) = ubound(SrcParamData%TBDepISp) if (.not. allocated(DstParamData%TBDepISp)) then allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4051,8 +4051,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RootName = SrcParamData%RootName DstParamData%PriPath = SrcParamData%PriPath if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4081,8 +4081,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TrimGain = SrcParamData%TrimGain DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef if (allocated(SrcParamData%BStC)) then - LB(1:1) = lbound(SrcParamData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BStC) + UB(1:1) = ubound(SrcParamData%BStC) if (.not. allocated(DstParamData%BStC)) then allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4097,8 +4097,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%NStC)) then - LB(1:1) = lbound(SrcParamData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NStC) + UB(1:1) = ubound(SrcParamData%NStC) if (.not. allocated(DstParamData%NStC)) then allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4113,8 +4113,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%TStC)) then - LB(1:1) = lbound(SrcParamData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%TStC) + UB(1:1) = ubound(SrcParamData%TStC) if (.not. allocated(DstParamData%TStC)) then allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4129,8 +4129,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%SStC)) then - LB(1:1) = lbound(SrcParamData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%SStC) + UB(1:1) = ubound(SrcParamData%SStC) if (.not. allocated(DstParamData%SStC)) then allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4149,8 +4149,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumCableControl = SrcParamData%NumCableControl DstParamData%NumStC_Control = SrcParamData%NumStC_Control if (allocated(SrcParamData%StCMeasNumPerChan)) then - LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan) + UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan) if (.not. allocated(DstParamData%StCMeasNumPerChan)) then allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4162,8 +4162,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%UseSC = SrcParamData%UseSC if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4174,8 +4174,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%Jac_x_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_x_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_x_indx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_x_indx) + UB(1:2) = ubound(SrcParamData%Jac_x_indx) if (.not. allocated(DstParamData%Jac_x_indx)) then allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4186,8 +4186,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4198,8 +4198,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) if (.not. allocated(DstParamData%dx)) then allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4213,8 +4213,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_ny = SrcParamData%Jac_ny DstParamData%Jac_nx = SrcParamData%Jac_nx if (allocated(SrcParamData%Jac_Idx_BStC_u)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u) if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4225,8 +4225,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u end if if (allocated(SrcParamData%Jac_Idx_NStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u) if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4237,8 +4237,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u end if if (allocated(SrcParamData%Jac_Idx_TStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u) if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4249,8 +4249,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u end if if (allocated(SrcParamData%Jac_Idx_SStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u) if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4261,8 +4261,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u end if if (allocated(SrcParamData%Jac_Idx_BStC_x)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x) if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4273,8 +4273,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x end if if (allocated(SrcParamData%Jac_Idx_NStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x) if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4285,8 +4285,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x end if if (allocated(SrcParamData%Jac_Idx_TStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x) if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4297,8 +4297,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x end if if (allocated(SrcParamData%Jac_Idx_SStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x) if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4309,8 +4309,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x end if if (allocated(SrcParamData%Jac_Idx_BStC_y)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y) if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4321,8 +4321,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y end if if (allocated(SrcParamData%Jac_Idx_NStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y) if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4333,8 +4333,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y end if if (allocated(SrcParamData%Jac_Idx_TStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y) if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4345,8 +4345,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y end if if (allocated(SrcParamData%Jac_Idx_SStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y) if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4379,8 +4379,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) type(SrvD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyParam' @@ -4402,8 +4402,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%TBDepISp) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4413,8 +4413,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%BStC)) then - LB(1:1) = lbound(ParamData%BStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%BStC, kind=B8Ki) + LB(1:1) = lbound(ParamData%BStC) + UB(1:1) = ubound(ParamData%BStC) do i1 = LB(1), UB(1) call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4422,8 +4422,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%BStC) end if if (allocated(ParamData%NStC)) then - LB(1:1) = lbound(ParamData%NStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%NStC, kind=B8Ki) + LB(1:1) = lbound(ParamData%NStC) + UB(1:1) = ubound(ParamData%NStC) do i1 = LB(1), UB(1) call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4431,8 +4431,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%NStC) end if if (allocated(ParamData%TStC)) then - LB(1:1) = lbound(ParamData%TStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%TStC, kind=B8Ki) + LB(1:1) = lbound(ParamData%TStC) + UB(1:1) = ubound(ParamData%TStC) do i1 = LB(1), UB(1) call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4440,8 +4440,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%TStC) end if if (allocated(ParamData%SStC)) then - LB(1:1) = lbound(ParamData%SStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%SStC, kind=B8Ki) + LB(1:1) = lbound(ParamData%SStC) + UB(1:1) = ubound(ParamData%SStC) do i1 = LB(1), UB(1) call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4511,8 +4511,8 @@ subroutine SrvD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) @@ -4592,9 +4592,9 @@ subroutine SrvD_PackParam(RF, Indata) call RegPack(RF, InData%PriPath) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -4615,36 +4615,36 @@ subroutine SrvD_PackParam(RF, Indata) call RegPack(RF, InData%RotSpeedRef) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) do i1 = LB(1), UB(1) call StC_PackParam(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) do i1 = LB(1), UB(1) call StC_PackParam(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) do i1 = LB(1), UB(1) call StC_PackParam(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) do i1 = LB(1), UB(1) call StC_PackParam(RF, InData%SStC(i1)) end do @@ -4693,8 +4693,8 @@ subroutine SrvD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -4910,16 +4910,16 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%BlPitch)) then - LB(1:1) = lbound(SrcInputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BlPitch) + UB(1:1) = ubound(SrcInputData%BlPitch) if (.not. allocated(DstInputData%BlPitch)) then allocate(DstInputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4937,8 +4937,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom if (allocated(SrcInputData%ExternalBlPitchCom)) then - LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom) + UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom) if (.not. allocated(DstInputData%ExternalBlPitchCom)) then allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4952,8 +4952,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac if (allocated(SrcInputData%ExternalBlAirfoilCom)) then - LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom) + UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom) if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4964,8 +4964,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom end if if (allocated(SrcInputData%ExternalCableDeltaL)) then - LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL) if (.not. allocated(DstInputData%ExternalCableDeltaL)) then allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4976,8 +4976,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL end if if (allocated(SrcInputData%ExternalCableDeltaLdot)) then - LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot) if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5012,8 +5012,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%LSShftFys = SrcInputData%LSShftFys DstInputData%LSShftFzs = SrcInputData%LSShftFzs if (allocated(SrcInputData%fromSC)) then - LB(1:1) = lbound(SrcInputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) if (.not. allocated(DstInputData%fromSC)) then allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5024,8 +5024,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%fromSC = SrcInputData%fromSC end if if (allocated(SrcInputData%fromSCglob)) then - LB(1:1) = lbound(SrcInputData%fromSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSCglob, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) if (.not. allocated(DstInputData%fromSCglob)) then allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5039,8 +5039,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%BStCMotionMesh)) then - LB(1:2) = lbound(SrcInputData%BStCMotionMesh, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%BStCMotionMesh, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%BStCMotionMesh) + UB(1:2) = ubound(SrcInputData%BStCMotionMesh) if (.not. allocated(DstInputData%BStCMotionMesh)) then allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5057,8 +5057,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%NStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%NStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%NStCMotionMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%NStCMotionMesh) + UB(1:1) = ubound(SrcInputData%NStCMotionMesh) if (.not. allocated(DstInputData%NStCMotionMesh)) then allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5073,8 +5073,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%TStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%TStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%TStCMotionMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%TStCMotionMesh) + UB(1:1) = ubound(SrcInputData%TStCMotionMesh) if (.not. allocated(DstInputData%TStCMotionMesh)) then allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5089,8 +5089,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%SStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%SStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%SStCMotionMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%SStCMotionMesh) + UB(1:1) = ubound(SrcInputData%SStCMotionMesh) if (.not. allocated(DstInputData%SStCMotionMesh)) then allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5105,8 +5105,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%LidSpeed)) then - LB(1:1) = lbound(SrcInputData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%LidSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%LidSpeed) + UB(1:1) = ubound(SrcInputData%LidSpeed) if (.not. allocated(DstInputData%LidSpeed)) then allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5117,8 +5117,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%LidSpeed = SrcInputData%LidSpeed end if if (allocated(SrcInputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsX, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInputData%MsrPositionsX) if (.not. allocated(DstInputData%MsrPositionsX)) then allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5129,8 +5129,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX end if if (allocated(SrcInputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsY, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInputData%MsrPositionsY) if (.not. allocated(DstInputData%MsrPositionsY)) then allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5141,8 +5141,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY end if if (allocated(SrcInputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsZ, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInputData%MsrPositionsZ) if (.not. allocated(DstInputData%MsrPositionsZ)) then allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5158,8 +5158,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) type(SrvD_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyInput' @@ -5189,8 +5189,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%BStCMotionMesh)) then - LB(1:2) = lbound(InputData%BStCMotionMesh, kind=B8Ki) - UB(1:2) = ubound(InputData%BStCMotionMesh, kind=B8Ki) + LB(1:2) = lbound(InputData%BStCMotionMesh) + UB(1:2) = ubound(InputData%BStCMotionMesh) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) @@ -5200,8 +5200,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%BStCMotionMesh) end if if (allocated(InputData%NStCMotionMesh)) then - LB(1:1) = lbound(InputData%NStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InputData%NStCMotionMesh, kind=B8Ki) + LB(1:1) = lbound(InputData%NStCMotionMesh) + UB(1:1) = ubound(InputData%NStCMotionMesh) do i1 = LB(1), UB(1) call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5209,8 +5209,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%NStCMotionMesh) end if if (allocated(InputData%TStCMotionMesh)) then - LB(1:1) = lbound(InputData%TStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InputData%TStCMotionMesh, kind=B8Ki) + LB(1:1) = lbound(InputData%TStCMotionMesh) + UB(1:1) = ubound(InputData%TStCMotionMesh) do i1 = LB(1), UB(1) call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5218,8 +5218,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%TStCMotionMesh) end if if (allocated(InputData%SStCMotionMesh)) then - LB(1:1) = lbound(InputData%SStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InputData%SStCMotionMesh, kind=B8Ki) + LB(1:1) = lbound(InputData%SStCMotionMesh) + UB(1:1) = ubound(InputData%SStCMotionMesh) do i1 = LB(1), UB(1) call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5244,8 +5244,8 @@ subroutine SrvD_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%BlPitch) call RegPack(RF, InData%Yaw) @@ -5291,9 +5291,9 @@ subroutine SrvD_PackInput(RF, Indata) call MeshPack(RF, InData%PtfmMotionMesh) call RegPack(RF, allocated(InData%BStCMotionMesh)) if (allocated(InData%BStCMotionMesh)) then - call RegPackBounds(RF, 2, lbound(InData%BStCMotionMesh, kind=B8Ki), ubound(InData%BStCMotionMesh, kind=B8Ki)) - LB(1:2) = lbound(InData%BStCMotionMesh, kind=B8Ki) - UB(1:2) = ubound(InData%BStCMotionMesh, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) + LB(1:2) = lbound(InData%BStCMotionMesh) + UB(1:2) = ubound(InData%BStCMotionMesh) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BStCMotionMesh(i1,i2)) @@ -5302,27 +5302,27 @@ subroutine SrvD_PackInput(RF, Indata) end if call RegPack(RF, allocated(InData%NStCMotionMesh)) if (allocated(InData%NStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%NStCMotionMesh, kind=B8Ki), ubound(InData%NStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%NStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%NStCMotionMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) + LB(1:1) = lbound(InData%NStCMotionMesh) + UB(1:1) = ubound(InData%NStCMotionMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%NStCMotionMesh(i1)) end do end if call RegPack(RF, allocated(InData%TStCMotionMesh)) if (allocated(InData%TStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%TStCMotionMesh, kind=B8Ki), ubound(InData%TStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%TStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%TStCMotionMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) + LB(1:1) = lbound(InData%TStCMotionMesh) + UB(1:1) = ubound(InData%TStCMotionMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%TStCMotionMesh(i1)) end do end if call RegPack(RF, allocated(InData%SStCMotionMesh)) if (allocated(InData%SStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%SStCMotionMesh, kind=B8Ki), ubound(InData%SStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%SStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%SStCMotionMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) + LB(1:1) = lbound(InData%SStCMotionMesh) + UB(1:1) = ubound(InData%SStCMotionMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%SStCMotionMesh(i1)) end do @@ -5338,8 +5338,8 @@ subroutine SrvD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5451,16 +5451,16 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5471,8 +5471,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%BlPitchCom)) then - LB(1:1) = lbound(SrcOutputData%BlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlPitchCom, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BlPitchCom) + UB(1:1) = ubound(SrcOutputData%BlPitchCom) if (.not. allocated(DstOutputData%BlPitchCom)) then allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5483,8 +5483,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom end if if (allocated(SrcOutputData%BlAirfoilCom)) then - LB(1:1) = lbound(SrcOutputData%BlAirfoilCom, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlAirfoilCom, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BlAirfoilCom) + UB(1:1) = ubound(SrcOutputData%BlAirfoilCom) if (.not. allocated(DstOutputData%BlAirfoilCom)) then allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5501,8 +5501,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC DstOutputData%ElecPwr = SrcOutputData%ElecPwr if (allocated(SrcOutputData%TBDrCon)) then - LB(1:1) = lbound(SrcOutputData%TBDrCon, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%TBDrCon, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%TBDrCon) + UB(1:1) = ubound(SrcOutputData%TBDrCon) if (.not. allocated(DstOutputData%TBDrCon)) then allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5513,8 +5513,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%TBDrCon = SrcOutputData%TBDrCon end if if (allocated(SrcOutputData%CableDeltaL)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CableDeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%CableDeltaL) + UB(1:1) = ubound(SrcOutputData%CableDeltaL) if (.not. allocated(DstOutputData%CableDeltaL)) then allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5525,8 +5525,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL end if if (allocated(SrcOutputData%CableDeltaLdot)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CableDeltaLdot, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%CableDeltaLdot) + UB(1:1) = ubound(SrcOutputData%CableDeltaLdot) if (.not. allocated(DstOutputData%CableDeltaLdot)) then allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5537,8 +5537,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot end if if (allocated(SrcOutputData%BStCLoadMesh)) then - LB(1:2) = lbound(SrcOutputData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%BStCLoadMesh, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%BStCLoadMesh) + UB(1:2) = ubound(SrcOutputData%BStCLoadMesh) if (.not. allocated(DstOutputData%BStCLoadMesh)) then allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5555,8 +5555,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%NStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%NStCLoadMesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%NStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%NStCLoadMesh) if (.not. allocated(DstOutputData%NStCLoadMesh)) then allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5571,8 +5571,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%TStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%TStCLoadMesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%TStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%TStCLoadMesh) if (.not. allocated(DstOutputData%TStCLoadMesh)) then allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5587,8 +5587,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%SStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%SStCLoadMesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%SStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%SStCLoadMesh) if (.not. allocated(DstOutputData%SStCLoadMesh)) then allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5603,8 +5603,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%toSC)) then - LB(1:1) = lbound(SrcOutputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%toSC, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) if (.not. allocated(DstOutputData%toSC)) then allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5620,8 +5620,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) type(SrvD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' @@ -5646,8 +5646,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%CableDeltaLdot) end if if (allocated(OutputData%BStCLoadMesh)) then - LB(1:2) = lbound(OutputData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(OutputData%BStCLoadMesh, kind=B8Ki) + LB(1:2) = lbound(OutputData%BStCLoadMesh) + UB(1:2) = ubound(OutputData%BStCLoadMesh) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) @@ -5657,8 +5657,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%BStCLoadMesh) end if if (allocated(OutputData%NStCLoadMesh)) then - LB(1:1) = lbound(OutputData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%NStCLoadMesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%NStCLoadMesh) + UB(1:1) = ubound(OutputData%NStCLoadMesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5666,8 +5666,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%NStCLoadMesh) end if if (allocated(OutputData%TStCLoadMesh)) then - LB(1:1) = lbound(OutputData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%TStCLoadMesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%TStCLoadMesh) + UB(1:1) = ubound(OutputData%TStCLoadMesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5675,8 +5675,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%TStCLoadMesh) end if if (allocated(OutputData%SStCLoadMesh)) then - LB(1:1) = lbound(OutputData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%SStCLoadMesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%SStCLoadMesh) + UB(1:1) = ubound(OutputData%SStCLoadMesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5692,8 +5692,8 @@ subroutine SrvD_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackOutput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutput) call RegPackAlloc(RF, InData%BlPitchCom) @@ -5709,9 +5709,9 @@ subroutine SrvD_PackOutput(RF, Indata) call RegPackAlloc(RF, InData%CableDeltaLdot) call RegPack(RF, allocated(InData%BStCLoadMesh)) if (allocated(InData%BStCLoadMesh)) then - call RegPackBounds(RF, 2, lbound(InData%BStCLoadMesh, kind=B8Ki), ubound(InData%BStCLoadMesh, kind=B8Ki)) - LB(1:2) = lbound(InData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(InData%BStCLoadMesh, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) + LB(1:2) = lbound(InData%BStCLoadMesh) + UB(1:2) = ubound(InData%BStCLoadMesh) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BStCLoadMesh(i1,i2)) @@ -5720,27 +5720,27 @@ subroutine SrvD_PackOutput(RF, Indata) end if call RegPack(RF, allocated(InData%NStCLoadMesh)) if (allocated(InData%NStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%NStCLoadMesh, kind=B8Ki), ubound(InData%NStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%NStCLoadMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) + LB(1:1) = lbound(InData%NStCLoadMesh) + UB(1:1) = ubound(InData%NStCLoadMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%NStCLoadMesh(i1)) end do end if call RegPack(RF, allocated(InData%TStCLoadMesh)) if (allocated(InData%TStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh, kind=B8Ki), ubound(InData%TStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%TStCLoadMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) + LB(1:1) = lbound(InData%TStCLoadMesh) + UB(1:1) = ubound(InData%TStCLoadMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%TStCLoadMesh(i1)) end do end if call RegPack(RF, allocated(InData%SStCLoadMesh)) if (allocated(InData%SStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh, kind=B8Ki), ubound(InData%SStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%SStCLoadMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) + LB(1:1) = lbound(InData%SStCLoadMesh) + UB(1:1) = ubound(InData%SStCLoadMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%SStCLoadMesh(i1)) end do @@ -5753,8 +5753,8 @@ subroutine SrvD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5833,8 +5833,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyMisc' @@ -5847,8 +5847,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FirstWarn = SrcMiscData%FirstWarn DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered if (allocated(SrcMiscData%xd_BlPitchFilter)) then - LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter) + UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter) if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5859,8 +5859,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter end if if (allocated(SrcMiscData%BStC)) then - LB(1:1) = lbound(SrcMiscData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%BStC) + UB(1:1) = ubound(SrcMiscData%BStC) if (.not. allocated(DstMiscData%BStC)) then allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5875,8 +5875,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%NStC)) then - LB(1:1) = lbound(SrcMiscData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%NStC) + UB(1:1) = ubound(SrcMiscData%NStC) if (.not. allocated(DstMiscData%NStC)) then allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5891,8 +5891,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%TStC)) then - LB(1:1) = lbound(SrcMiscData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%TStC) + UB(1:1) = ubound(SrcMiscData%TStC) if (.not. allocated(DstMiscData%TStC)) then allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5907,8 +5907,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%SStC)) then - LB(1:1) = lbound(SrcMiscData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SStC) + UB(1:1) = ubound(SrcMiscData%SStC) if (.not. allocated(DstMiscData%SStC)) then allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5923,8 +5923,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%u_BStC)) then - LB(1:2) = lbound(SrcMiscData%u_BStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_BStC, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%u_BStC) + UB(1:2) = ubound(SrcMiscData%u_BStC) if (.not. allocated(DstMiscData%u_BStC)) then allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5941,8 +5941,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%u_NStC)) then - LB(1:2) = lbound(SrcMiscData%u_NStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_NStC, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%u_NStC) + UB(1:2) = ubound(SrcMiscData%u_NStC) if (.not. allocated(DstMiscData%u_NStC)) then allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5959,8 +5959,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%u_TStC)) then - LB(1:2) = lbound(SrcMiscData%u_TStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_TStC, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%u_TStC) + UB(1:2) = ubound(SrcMiscData%u_TStC) if (.not. allocated(DstMiscData%u_TStC)) then allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5977,8 +5977,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%u_SStC)) then - LB(1:2) = lbound(SrcMiscData%u_SStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_SStC, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%u_SStC) + UB(1:2) = ubound(SrcMiscData%u_SStC) if (.not. allocated(DstMiscData%u_SStC)) then allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5995,8 +5995,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%y_BStC)) then - LB(1:1) = lbound(SrcMiscData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_BStC, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%y_BStC) + UB(1:1) = ubound(SrcMiscData%y_BStC) if (.not. allocated(DstMiscData%y_BStC)) then allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6011,8 +6011,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%y_NStC)) then - LB(1:1) = lbound(SrcMiscData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_NStC, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%y_NStC) + UB(1:1) = ubound(SrcMiscData%y_NStC) if (.not. allocated(DstMiscData%y_NStC)) then allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6027,8 +6027,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%y_TStC)) then - LB(1:1) = lbound(SrcMiscData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_TStC, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%y_TStC) + UB(1:1) = ubound(SrcMiscData%y_TStC) if (.not. allocated(DstMiscData%y_TStC)) then allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6043,8 +6043,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%y_SStC)) then - LB(1:1) = lbound(SrcMiscData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_SStC, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%y_SStC) + UB(1:1) = ubound(SrcMiscData%y_SStC) if (.not. allocated(DstMiscData%y_SStC)) then allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6083,8 +6083,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) type(SrvD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' @@ -6096,8 +6096,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%xd_BlPitchFilter) end if if (allocated(MiscData%BStC)) then - LB(1:1) = lbound(MiscData%BStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%BStC, kind=B8Ki) + LB(1:1) = lbound(MiscData%BStC) + UB(1:1) = ubound(MiscData%BStC) do i1 = LB(1), UB(1) call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6105,8 +6105,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%BStC) end if if (allocated(MiscData%NStC)) then - LB(1:1) = lbound(MiscData%NStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%NStC, kind=B8Ki) + LB(1:1) = lbound(MiscData%NStC) + UB(1:1) = ubound(MiscData%NStC) do i1 = LB(1), UB(1) call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6114,8 +6114,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%NStC) end if if (allocated(MiscData%TStC)) then - LB(1:1) = lbound(MiscData%TStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%TStC, kind=B8Ki) + LB(1:1) = lbound(MiscData%TStC) + UB(1:1) = ubound(MiscData%TStC) do i1 = LB(1), UB(1) call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6123,8 +6123,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%TStC) end if if (allocated(MiscData%SStC)) then - LB(1:1) = lbound(MiscData%SStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%SStC, kind=B8Ki) + LB(1:1) = lbound(MiscData%SStC) + UB(1:1) = ubound(MiscData%SStC) do i1 = LB(1), UB(1) call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6132,8 +6132,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%SStC) end if if (allocated(MiscData%u_BStC)) then - LB(1:2) = lbound(MiscData%u_BStC, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_BStC, kind=B8Ki) + LB(1:2) = lbound(MiscData%u_BStC) + UB(1:2) = ubound(MiscData%u_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) @@ -6143,8 +6143,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%u_BStC) end if if (allocated(MiscData%u_NStC)) then - LB(1:2) = lbound(MiscData%u_NStC, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_NStC, kind=B8Ki) + LB(1:2) = lbound(MiscData%u_NStC) + UB(1:2) = ubound(MiscData%u_NStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) @@ -6154,8 +6154,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%u_NStC) end if if (allocated(MiscData%u_TStC)) then - LB(1:2) = lbound(MiscData%u_TStC, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_TStC, kind=B8Ki) + LB(1:2) = lbound(MiscData%u_TStC) + UB(1:2) = ubound(MiscData%u_TStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) @@ -6165,8 +6165,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%u_TStC) end if if (allocated(MiscData%u_SStC)) then - LB(1:2) = lbound(MiscData%u_SStC, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_SStC, kind=B8Ki) + LB(1:2) = lbound(MiscData%u_SStC) + UB(1:2) = ubound(MiscData%u_SStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) @@ -6176,8 +6176,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%u_SStC) end if if (allocated(MiscData%y_BStC)) then - LB(1:1) = lbound(MiscData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_BStC, kind=B8Ki) + LB(1:1) = lbound(MiscData%y_BStC) + UB(1:1) = ubound(MiscData%y_BStC) do i1 = LB(1), UB(1) call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6185,8 +6185,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%y_BStC) end if if (allocated(MiscData%y_NStC)) then - LB(1:1) = lbound(MiscData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_NStC, kind=B8Ki) + LB(1:1) = lbound(MiscData%y_NStC) + UB(1:1) = ubound(MiscData%y_NStC) do i1 = LB(1), UB(1) call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6194,8 +6194,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%y_NStC) end if if (allocated(MiscData%y_TStC)) then - LB(1:1) = lbound(MiscData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_TStC, kind=B8Ki) + LB(1:1) = lbound(MiscData%y_TStC) + UB(1:1) = ubound(MiscData%y_TStC) do i1 = LB(1), UB(1) call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6203,8 +6203,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%y_TStC) end if if (allocated(MiscData%y_SStC)) then - LB(1:1) = lbound(MiscData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_SStC, kind=B8Ki) + LB(1:1) = lbound(MiscData%y_SStC) + UB(1:1) = ubound(MiscData%y_SStC) do i1 = LB(1), UB(1) call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6229,8 +6229,8 @@ subroutine SrvD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%LastTimeCalled) call SrvD_PackBladedDLLType(RF, InData%dll_data) @@ -6239,45 +6239,45 @@ subroutine SrvD_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%xd_BlPitchFilter) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) do i1 = LB(1), UB(1) call StC_PackMisc(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) do i1 = LB(1), UB(1) call StC_PackMisc(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) do i1 = LB(1), UB(1) call StC_PackMisc(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) do i1 = LB(1), UB(1) call StC_PackMisc(RF, InData%SStC(i1)) end do end if call RegPack(RF, allocated(InData%u_BStC)) if (allocated(InData%u_BStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_BStC, kind=B8Ki), ubound(InData%u_BStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_BStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_BStC, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) + LB(1:2) = lbound(InData%u_BStC) + UB(1:2) = ubound(InData%u_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_PackInput(RF, InData%u_BStC(i1,i2)) @@ -6286,9 +6286,9 @@ subroutine SrvD_PackMisc(RF, Indata) end if call RegPack(RF, allocated(InData%u_NStC)) if (allocated(InData%u_NStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_NStC, kind=B8Ki), ubound(InData%u_NStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_NStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_NStC, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) + LB(1:2) = lbound(InData%u_NStC) + UB(1:2) = ubound(InData%u_NStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_PackInput(RF, InData%u_NStC(i1,i2)) @@ -6297,9 +6297,9 @@ subroutine SrvD_PackMisc(RF, Indata) end if call RegPack(RF, allocated(InData%u_TStC)) if (allocated(InData%u_TStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_TStC, kind=B8Ki), ubound(InData%u_TStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_TStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_TStC, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) + LB(1:2) = lbound(InData%u_TStC) + UB(1:2) = ubound(InData%u_TStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_PackInput(RF, InData%u_TStC(i1,i2)) @@ -6308,9 +6308,9 @@ subroutine SrvD_PackMisc(RF, Indata) end if call RegPack(RF, allocated(InData%u_SStC)) if (allocated(InData%u_SStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_SStC, kind=B8Ki), ubound(InData%u_SStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_SStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_SStC, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) + LB(1:2) = lbound(InData%u_SStC) + UB(1:2) = ubound(InData%u_SStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_PackInput(RF, InData%u_SStC(i1,i2)) @@ -6319,36 +6319,36 @@ subroutine SrvD_PackMisc(RF, Indata) end if call RegPack(RF, allocated(InData%y_BStC)) if (allocated(InData%y_BStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_BStC, kind=B8Ki), ubound(InData%y_BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_BStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) + LB(1:1) = lbound(InData%y_BStC) + UB(1:1) = ubound(InData%y_BStC) do i1 = LB(1), UB(1) call StC_PackOutput(RF, InData%y_BStC(i1)) end do end if call RegPack(RF, allocated(InData%y_NStC)) if (allocated(InData%y_NStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_NStC, kind=B8Ki), ubound(InData%y_NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) + LB(1:1) = lbound(InData%y_NStC) + UB(1:1) = ubound(InData%y_NStC) do i1 = LB(1), UB(1) call StC_PackOutput(RF, InData%y_NStC(i1)) end do end if call RegPack(RF, allocated(InData%y_TStC)) if (allocated(InData%y_TStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_TStC, kind=B8Ki), ubound(InData%y_TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) + LB(1:1) = lbound(InData%y_TStC) + UB(1:1) = ubound(InData%y_TStC) do i1 = LB(1), UB(1) call StC_PackOutput(RF, InData%y_TStC(i1)) end do end if call RegPack(RF, allocated(InData%y_SStC)) if (allocated(InData%y_SStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_SStC, kind=B8Ki), ubound(InData%y_SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) + LB(1:1) = lbound(InData%y_SStC) + UB(1:1) = ubound(InData%y_SStC) do i1 = LB(1), UB(1) call StC_PackOutput(RF, InData%y_SStC(i1)) end do @@ -6367,8 +6367,8 @@ subroutine SrvD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6650,7 +6650,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1, kind=B8Ki),UBOUND(u_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitch,1),ubound(u_out%BlPitch,1) CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -6662,7 +6662,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki),UBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%ExternalBlPitchCom,1),ubound(u_out%ExternalBlPitchCom,1) CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -6711,27 +6711,27 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,2, kind=B8Ki) - DO i1 = LBOUND(u_out%BStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,1, kind=B8Ki) + do i2 = lbound(u_out%BStCMotionMesh,2),ubound(u_out%BStCMotionMesh,2) + do i1 = lbound(u_out%BStCMotionMesh,1),ubound(u_out%BStCMotionMesh,1) CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%NStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%NStCMotionMesh,1),ubound(u_out%NStCMotionMesh,1) CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%TStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%TStCMotionMesh,1),ubound(u_out%TStCMotionMesh,1) CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%SStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%SStCMotionMesh,1),ubound(u_out%SStCMotionMesh,1) CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6808,7 +6808,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1, kind=B8Ki),UBOUND(u_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitch,1),ubound(u_out%BlPitch,1) CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -6820,7 +6820,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + a3*u3%ExternalYawRateCom IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki),UBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%ExternalBlPitchCom,1),ubound(u_out%ExternalBlPitchCom,1) CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -6869,27 +6869,27 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,2, kind=B8Ki) - DO i1 = LBOUND(u_out%BStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,1, kind=B8Ki) + do i2 = lbound(u_out%BStCMotionMesh,2),ubound(u_out%BStCMotionMesh,2) + do i1 = lbound(u_out%BStCMotionMesh,1),ubound(u_out%BStCMotionMesh,1) CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%NStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%NStCMotionMesh,1),ubound(u_out%NStCMotionMesh,1) CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%TStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%TStCMotionMesh,1),ubound(u_out%TStCMotionMesh,1) CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%SStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%SStCMotionMesh,1),ubound(u_out%SStCMotionMesh,1) CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7011,7 +7011,7 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1, kind=B8Ki),UBOUND(y_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitchCom,1),ubound(y_out%BlPitchCom,1) CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -7034,27 +7034,27 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot END IF ! check if allocated IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,2, kind=B8Ki) - DO i1 = LBOUND(y_out%BStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,1, kind=B8Ki) + do i2 = lbound(y_out%BStCLoadMesh,2),ubound(y_out%BStCLoadMesh,2) + do i1 = lbound(y_out%BStCLoadMesh,1),ubound(y_out%BStCLoadMesh,1) CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%NStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%NStCLoadMesh,1),ubound(y_out%NStCLoadMesh,1) CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%TStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%TStCLoadMesh,1),ubound(y_out%TStCLoadMesh,1) CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%SStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%SStCLoadMesh,1),ubound(y_out%SStCLoadMesh,1) CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7125,7 +7125,7 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1, kind=B8Ki),UBOUND(y_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitchCom,1),ubound(y_out%BlPitchCom,1) CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -7148,27 +7148,27 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + a3*y3%CableDeltaLdot END IF ! check if allocated IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,2, kind=B8Ki) - DO i1 = LBOUND(y_out%BStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,1, kind=B8Ki) + do i2 = lbound(y_out%BStCLoadMesh,2),ubound(y_out%BStCLoadMesh,2) + do i1 = lbound(y_out%BStCLoadMesh,1),ubound(y_out%BStCLoadMesh,1) CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%NStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%NStCLoadMesh,1),ubound(y_out%NStCLoadMesh,1) CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%TStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%TStCLoadMesh,1),ubound(y_out%TStCLoadMesh,1) CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%SStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%SStCLoadMesh,1),ubound(y_out%SStCLoadMesh,1) CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 2b5d9827c1..c184ed194c 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -267,7 +267,7 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyInputFile' ErrStat = ErrID_None @@ -334,8 +334,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%NKInpSt = SrcInputFileData%NKInpSt DstInputFileData%StC_F_TBL_FILE = SrcInputFileData%StC_F_TBL_FILE if (allocated(SrcInputFileData%F_TBL)) then - LB(1:2) = lbound(SrcInputFileData%F_TBL, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%F_TBL, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%F_TBL) + UB(1:2) = ubound(SrcInputFileData%F_TBL) if (.not. allocated(DstInputFileData%F_TBL)) then allocate(DstInputFileData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -348,8 +348,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile if (allocated(SrcInputFileData%StC_PrescribedForce)) then - LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce) + UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce) if (.not. allocated(DstInputFileData%StC_PrescribedForce)) then allocate(DstInputFileData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -360,8 +360,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce end if if (allocated(SrcInputFileData%StC_CChan)) then - LB(1:1) = lbound(SrcInputFileData%StC_CChan, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%StC_CChan, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%StC_CChan) + UB(1:1) = ubound(SrcInputFileData%StC_CChan) if (.not. allocated(DstInputFileData%StC_CChan)) then allocate(DstInputFileData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -469,7 +469,7 @@ subroutine StC_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInputFile' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -547,7 +547,7 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyInitInput' @@ -558,8 +558,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts if (allocated(SrcInitInputData%InitRefPos)) then - LB(1:2) = lbound(SrcInitInputData%InitRefPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%InitRefPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%InitRefPos) + UB(1:2) = ubound(SrcInitInputData%InitRefPos) if (.not. allocated(DstInitInputData%InitRefPos)) then allocate(DstInitInputData%InitRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -570,8 +570,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos end if if (allocated(SrcInitInputData%InitTransDisp)) then - LB(1:2) = lbound(SrcInitInputData%InitTransDisp, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%InitTransDisp, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%InitTransDisp) + UB(1:2) = ubound(SrcInitInputData%InitTransDisp) if (.not. allocated(DstInitInputData%InitTransDisp)) then allocate(DstInitInputData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -582,8 +582,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp end if if (allocated(SrcInitInputData%InitOrient)) then - LB(1:3) = lbound(SrcInitInputData%InitOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%InitOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%InitOrient) + UB(1:3) = ubound(SrcInitInputData%InitOrient) if (.not. allocated(DstInitInputData%InitOrient)) then allocate(DstInitInputData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -594,8 +594,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitOrient = SrcInitInputData%InitOrient end if if (allocated(SrcInitInputData%InitRefOrient)) then - LB(1:3) = lbound(SrcInitInputData%InitRefOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%InitRefOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%InitRefOrient) + UB(1:3) = ubound(SrcInitInputData%InitRefOrient) if (.not. allocated(DstInitInputData%InitRefOrient)) then allocate(DstInitInputData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -666,7 +666,7 @@ subroutine StC_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -690,14 +690,14 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyCtrlChanInitInfoType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcCtrlChanInitInfoTypeData%Requestor)) then - LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor, kind=B8Ki) - UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor, kind=B8Ki) + LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor) + UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor) if (.not. allocated(DstCtrlChanInitInfoTypeData%Requestor)) then allocate(DstCtrlChanInitInfoTypeData%Requestor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -708,8 +708,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor end if if (allocated(SrcCtrlChanInitInfoTypeData%InitStiff)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitStiff)) then allocate(DstCtrlChanInitInfoTypeData%InitStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -720,8 +720,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff end if if (allocated(SrcCtrlChanInitInfoTypeData%InitDamp)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitDamp)) then allocate(DstCtrlChanInitInfoTypeData%InitDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -732,8 +732,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp end if if (allocated(SrcCtrlChanInitInfoTypeData%InitBrake)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitBrake)) then allocate(DstCtrlChanInitInfoTypeData%InitBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -744,8 +744,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake end if if (allocated(SrcCtrlChanInitInfoTypeData%InitForce)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitForce)) then allocate(DstCtrlChanInitInfoTypeData%InitForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -756,8 +756,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasDisp)) then allocate(DstCtrlChanInitInfoTypeData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -768,8 +768,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasVel)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasVel)) then allocate(DstCtrlChanInitInfoTypeData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -830,7 +830,7 @@ subroutine StC_UnPackCtrlChanInitInfoType(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_CtrlChanInitInfoType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackCtrlChanInitInfoType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -849,14 +849,14 @@ subroutine StC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%RelPosition)) then - LB(1:2) = lbound(SrcInitOutputData%RelPosition, kind=B8Ki) - UB(1:2) = ubound(SrcInitOutputData%RelPosition, kind=B8Ki) + LB(1:2) = lbound(SrcInitOutputData%RelPosition) + UB(1:2) = ubound(SrcInitOutputData%RelPosition) if (.not. allocated(DstInitOutputData%RelPosition)) then allocate(DstInitOutputData%RelPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -893,7 +893,7 @@ subroutine StC_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInitOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -906,14 +906,14 @@ subroutine StC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%StC_x)) then - LB(1:2) = lbound(SrcContStateData%StC_x, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%StC_x, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%StC_x) + UB(1:2) = ubound(SrcContStateData%StC_x) if (.not. allocated(DstContStateData%StC_x)) then allocate(DstContStateData%StC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -950,7 +950,7 @@ subroutine StC_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackContState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1077,14 +1077,14 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%F_stop)) then - LB(1:2) = lbound(SrcMiscData%F_stop, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_stop, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_stop) + UB(1:2) = ubound(SrcMiscData%F_stop) if (.not. allocated(DstMiscData%F_stop)) then allocate(DstMiscData%F_stop(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1095,8 +1095,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_stop = SrcMiscData%F_stop end if if (allocated(SrcMiscData%F_ext)) then - LB(1:2) = lbound(SrcMiscData%F_ext, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_ext, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_ext) + UB(1:2) = ubound(SrcMiscData%F_ext) if (.not. allocated(DstMiscData%F_ext)) then allocate(DstMiscData%F_ext(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1107,8 +1107,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_ext = SrcMiscData%F_ext end if if (allocated(SrcMiscData%F_fr)) then - LB(1:2) = lbound(SrcMiscData%F_fr, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_fr, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_fr) + UB(1:2) = ubound(SrcMiscData%F_fr) if (.not. allocated(DstMiscData%F_fr)) then allocate(DstMiscData%F_fr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1119,8 +1119,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_fr = SrcMiscData%F_fr end if if (allocated(SrcMiscData%K)) then - LB(1:2) = lbound(SrcMiscData%K, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%K, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%K) + UB(1:2) = ubound(SrcMiscData%K) if (.not. allocated(DstMiscData%K)) then allocate(DstMiscData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1131,8 +1131,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%K = SrcMiscData%K end if if (allocated(SrcMiscData%C_ctrl)) then - LB(1:2) = lbound(SrcMiscData%C_ctrl, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%C_ctrl, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%C_ctrl) + UB(1:2) = ubound(SrcMiscData%C_ctrl) if (.not. allocated(DstMiscData%C_ctrl)) then allocate(DstMiscData%C_ctrl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1143,8 +1143,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%C_ctrl = SrcMiscData%C_ctrl end if if (allocated(SrcMiscData%C_Brake)) then - LB(1:2) = lbound(SrcMiscData%C_Brake, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%C_Brake, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%C_Brake) + UB(1:2) = ubound(SrcMiscData%C_Brake) if (.not. allocated(DstMiscData%C_Brake)) then allocate(DstMiscData%C_Brake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1155,8 +1155,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%C_Brake = SrcMiscData%C_Brake end if if (allocated(SrcMiscData%F_table)) then - LB(1:2) = lbound(SrcMiscData%F_table, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_table, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_table) + UB(1:2) = ubound(SrcMiscData%F_table) if (.not. allocated(DstMiscData%F_table)) then allocate(DstMiscData%F_table(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1167,8 +1167,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_table = SrcMiscData%F_table end if if (allocated(SrcMiscData%F_k)) then - LB(1:2) = lbound(SrcMiscData%F_k, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_k, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_k) + UB(1:2) = ubound(SrcMiscData%F_k) if (.not. allocated(DstMiscData%F_k)) then allocate(DstMiscData%F_k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1179,8 +1179,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_k = SrcMiscData%F_k end if if (allocated(SrcMiscData%a_G)) then - LB(1:2) = lbound(SrcMiscData%a_G, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%a_G, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%a_G) + UB(1:2) = ubound(SrcMiscData%a_G) if (.not. allocated(DstMiscData%a_G)) then allocate(DstMiscData%a_G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1191,8 +1191,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%a_G = SrcMiscData%a_G end if if (allocated(SrcMiscData%rdisp_P)) then - LB(1:2) = lbound(SrcMiscData%rdisp_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%rdisp_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%rdisp_P) + UB(1:2) = ubound(SrcMiscData%rdisp_P) if (.not. allocated(DstMiscData%rdisp_P)) then allocate(DstMiscData%rdisp_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1203,8 +1203,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rdisp_P = SrcMiscData%rdisp_P end if if (allocated(SrcMiscData%rdot_P)) then - LB(1:2) = lbound(SrcMiscData%rdot_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%rdot_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%rdot_P) + UB(1:2) = ubound(SrcMiscData%rdot_P) if (.not. allocated(DstMiscData%rdot_P)) then allocate(DstMiscData%rdot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1215,8 +1215,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rdot_P = SrcMiscData%rdot_P end if if (allocated(SrcMiscData%rddot_P)) then - LB(1:2) = lbound(SrcMiscData%rddot_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%rddot_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%rddot_P) + UB(1:2) = ubound(SrcMiscData%rddot_P) if (.not. allocated(DstMiscData%rddot_P)) then allocate(DstMiscData%rddot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1227,8 +1227,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rddot_P = SrcMiscData%rddot_P end if if (allocated(SrcMiscData%omega_P)) then - LB(1:2) = lbound(SrcMiscData%omega_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%omega_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%omega_P) + UB(1:2) = ubound(SrcMiscData%omega_P) if (.not. allocated(DstMiscData%omega_P)) then allocate(DstMiscData%omega_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1239,8 +1239,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%omega_P = SrcMiscData%omega_P end if if (allocated(SrcMiscData%alpha_P)) then - LB(1:2) = lbound(SrcMiscData%alpha_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%alpha_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%alpha_P) + UB(1:2) = ubound(SrcMiscData%alpha_P) if (.not. allocated(DstMiscData%alpha_P)) then allocate(DstMiscData%alpha_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1251,8 +1251,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%alpha_P = SrcMiscData%alpha_P end if if (allocated(SrcMiscData%F_P)) then - LB(1:2) = lbound(SrcMiscData%F_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_P) + UB(1:2) = ubound(SrcMiscData%F_P) if (.not. allocated(DstMiscData%F_P)) then allocate(DstMiscData%F_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1263,8 +1263,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_P = SrcMiscData%F_P end if if (allocated(SrcMiscData%M_P)) then - LB(1:2) = lbound(SrcMiscData%M_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%M_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%M_P) + UB(1:2) = ubound(SrcMiscData%M_P) if (.not. allocated(DstMiscData%M_P)) then allocate(DstMiscData%M_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1275,8 +1275,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%M_P = SrcMiscData%M_P end if if (allocated(SrcMiscData%Acc)) then - LB(1:2) = lbound(SrcMiscData%Acc, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Acc, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%Acc) + UB(1:2) = ubound(SrcMiscData%Acc) if (.not. allocated(DstMiscData%Acc)) then allocate(DstMiscData%Acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1379,7 +1379,7 @@ subroutine StC_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1409,7 +1409,7 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyParam' ErrStat = ErrID_None @@ -1461,8 +1461,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rho_Y = SrcParamData%rho_Y DstParamData%Use_F_TBL = SrcParamData%Use_F_TBL if (allocated(SrcParamData%F_TBL)) then - LB(1:2) = lbound(SrcParamData%F_TBL, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%F_TBL, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%F_TBL) + UB(1:2) = ubound(SrcParamData%F_TBL) if (.not. allocated(DstParamData%F_TBL)) then allocate(DstParamData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1475,8 +1475,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumMeshPts = SrcParamData%NumMeshPts DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys if (allocated(SrcParamData%StC_PrescribedForce)) then - LB(1:2) = lbound(SrcParamData%StC_PrescribedForce, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%StC_PrescribedForce, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%StC_PrescribedForce) + UB(1:2) = ubound(SrcParamData%StC_PrescribedForce) if (.not. allocated(DstParamData%StC_PrescribedForce)) then allocate(DstParamData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1487,8 +1487,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce end if if (allocated(SrcParamData%StC_CChan)) then - LB(1:1) = lbound(SrcParamData%StC_CChan, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StC_CChan, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%StC_CChan) + UB(1:1) = ubound(SrcParamData%StC_CChan) if (.not. allocated(DstParamData%StC_CChan)) then allocate(DstParamData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1581,7 +1581,7 @@ subroutine StC_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1644,16 +1644,16 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%Mesh)) then - LB(1:1) = lbound(SrcInputData%Mesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Mesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Mesh) + UB(1:1) = ubound(SrcInputData%Mesh) if (.not. allocated(DstInputData%Mesh)) then allocate(DstInputData%Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1668,8 +1668,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%CmdStiff)) then - LB(1:2) = lbound(SrcInputData%CmdStiff, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CmdStiff, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CmdStiff) + UB(1:2) = ubound(SrcInputData%CmdStiff) if (.not. allocated(DstInputData%CmdStiff)) then allocate(DstInputData%CmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1680,8 +1680,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdStiff = SrcInputData%CmdStiff end if if (allocated(SrcInputData%CmdDamp)) then - LB(1:2) = lbound(SrcInputData%CmdDamp, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CmdDamp, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CmdDamp) + UB(1:2) = ubound(SrcInputData%CmdDamp) if (.not. allocated(DstInputData%CmdDamp)) then allocate(DstInputData%CmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1692,8 +1692,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdDamp = SrcInputData%CmdDamp end if if (allocated(SrcInputData%CmdBrake)) then - LB(1:2) = lbound(SrcInputData%CmdBrake, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CmdBrake, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CmdBrake) + UB(1:2) = ubound(SrcInputData%CmdBrake) if (.not. allocated(DstInputData%CmdBrake)) then allocate(DstInputData%CmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1704,8 +1704,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdBrake = SrcInputData%CmdBrake end if if (allocated(SrcInputData%CmdForce)) then - LB(1:2) = lbound(SrcInputData%CmdForce, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CmdForce, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CmdForce) + UB(1:2) = ubound(SrcInputData%CmdForce) if (.not. allocated(DstInputData%CmdForce)) then allocate(DstInputData%CmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1721,16 +1721,16 @@ subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) type(StC_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%Mesh)) then - LB(1:1) = lbound(InputData%Mesh, kind=B8Ki) - UB(1:1) = ubound(InputData%Mesh, kind=B8Ki) + LB(1:1) = lbound(InputData%Mesh) + UB(1:1) = ubound(InputData%Mesh) do i1 = LB(1), UB(1) call MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1755,14 +1755,14 @@ subroutine StC_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(StC_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then - call RegPackBounds(RF, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) - LB(1:1) = lbound(InData%Mesh, kind=B8Ki) - UB(1:1) = ubound(InData%Mesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%Mesh(i1)) end do @@ -1778,8 +1778,8 @@ subroutine StC_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1808,16 +1808,16 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Mesh)) then - LB(1:1) = lbound(SrcOutputData%Mesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Mesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Mesh) + UB(1:1) = ubound(SrcOutputData%Mesh) if (.not. allocated(DstOutputData%Mesh)) then allocate(DstOutputData%Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1832,8 +1832,8 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end do end if if (allocated(SrcOutputData%MeasDisp)) then - LB(1:2) = lbound(SrcOutputData%MeasDisp, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%MeasDisp, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%MeasDisp) + UB(1:2) = ubound(SrcOutputData%MeasDisp) if (.not. allocated(DstOutputData%MeasDisp)) then allocate(DstOutputData%MeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1844,8 +1844,8 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%MeasDisp = SrcOutputData%MeasDisp end if if (allocated(SrcOutputData%MeasVel)) then - LB(1:2) = lbound(SrcOutputData%MeasVel, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%MeasVel, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%MeasVel) + UB(1:2) = ubound(SrcOutputData%MeasVel) if (.not. allocated(DstOutputData%MeasVel)) then allocate(DstOutputData%MeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1861,16 +1861,16 @@ subroutine StC_DestroyOutput(OutputData, ErrStat, ErrMsg) type(StC_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%Mesh)) then - LB(1:1) = lbound(OutputData%Mesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%Mesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%Mesh) + UB(1:1) = ubound(OutputData%Mesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1889,14 +1889,14 @@ subroutine StC_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(StC_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackOutput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then - call RegPackBounds(RF, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) - LB(1:1) = lbound(InData%Mesh, kind=B8Ki) - UB(1:1) = ubound(InData%Mesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%Mesh(i1)) end do @@ -1910,8 +1910,8 @@ subroutine StC_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackOutput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2032,7 +2032,7 @@ SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1, kind=B8Ki),UBOUND(u_out%Mesh,1, kind=B8Ki) + do i1 = lbound(u_out%Mesh,1),ubound(u_out%Mesh,1) CALL MeshExtrapInterp1(u1%Mesh(i1), u2%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2109,7 +2109,7 @@ SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1, kind=B8Ki),UBOUND(u_out%Mesh,1, kind=B8Ki) + do i1 = lbound(u_out%Mesh,1),ubound(u_out%Mesh,1) CALL MeshExtrapInterp2(u1%Mesh(i1), u2%Mesh(i1), u3%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2228,7 +2228,7 @@ SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1, kind=B8Ki),UBOUND(y_out%Mesh,1, kind=B8Ki) + do i1 = lbound(y_out%Mesh,1),ubound(y_out%Mesh,1) CALL MeshExtrapInterp1(y1%Mesh(i1), y2%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2299,7 +2299,7 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1, kind=B8Ki),UBOUND(y_out%Mesh,1, kind=B8Ki) + do i1 = lbound(y_out%Mesh,1),ubound(y_out%Mesh,1) CALL MeshExtrapInterp2(y1%Mesh(i1), y2%Mesh(i1), y3%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/simple-elastodyn/src/SED_Types.f90 b/modules/simple-elastodyn/src/SED_Types.f90 index 68b659a649..5b72b2b336 100644 --- a/modules/simple-elastodyn/src/SED_Types.f90 +++ b/modules/simple-elastodyn/src/SED_Types.f90 @@ -218,7 +218,7 @@ subroutine SED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SED_CopyInputFile' ErrStat = ErrID_None @@ -247,8 +247,8 @@ subroutine SED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -308,7 +308,7 @@ subroutine SED_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -402,15 +402,15 @@ subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -421,8 +421,8 @@ subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -437,8 +437,8 @@ subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er if (ErrStat >= AbortErrLev) return DstInitOutputData%NumBl = SrcInitOutputData%NumBl if (allocated(SrcInitOutputData%BlPitch)) then - LB(1:1) = lbound(SrcInitOutputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%BlPitch) + UB(1:1) = ubound(SrcInitOutputData%BlPitch) if (.not. allocated(DstInitOutputData%BlPitch)) then allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -509,7 +509,7 @@ subroutine SED_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -534,7 +534,7 @@ subroutine SED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyInput' @@ -546,8 +546,8 @@ subroutine SED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC DstInputData%GenTrq = SrcInputData%GenTrq if (allocated(SrcInputData%BlPitchCom)) then - LB(1:1) = lbound(SrcInputData%BlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BlPitchCom, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BlPitchCom) + UB(1:1) = ubound(SrcInputData%BlPitchCom) if (.not. allocated(DstInputData%BlPitchCom)) then allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -595,7 +595,7 @@ subroutine SED_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -613,16 +613,16 @@ subroutine SED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%BladeRootMotion)) then - LB(1:1) = lbound(SrcOutputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BladeRootMotion) + UB(1:1) = ubound(SrcOutputData%BladeRootMotion) if (.not. allocated(DstOutputData%BladeRootMotion)) then allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -656,8 +656,8 @@ subroutine SED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Yaw = SrcOutputData%Yaw DstOutputData%YawRate = SrcOutputData%YawRate if (allocated(SrcOutputData%BlPitch)) then - LB(1:1) = lbound(SrcOutputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BlPitch) + UB(1:1) = ubound(SrcOutputData%BlPitch) if (.not. allocated(DstOutputData%BlPitch)) then allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -668,8 +668,8 @@ subroutine SED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%BlPitch = SrcOutputData%BlPitch end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -685,16 +685,16 @@ subroutine SED_DestroyOutput(OutputData, ErrStat, ErrMsg) type(SED_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%BladeRootMotion)) then - LB(1:1) = lbound(OutputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(OutputData%BladeRootMotion) + UB(1:1) = ubound(OutputData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -721,14 +721,14 @@ subroutine SED_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(SED_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SED_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%BladeRootMotion(i1)) end do @@ -753,8 +753,8 @@ subroutine SED_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -792,14 +792,14 @@ subroutine SED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SED_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%QT)) then - LB(1:1) = lbound(SrcContStateData%QT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%QT) + UB(1:1) = ubound(SrcContStateData%QT) if (.not. allocated(DstContStateData%QT)) then allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -810,8 +810,8 @@ subroutine SED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt DstContStateData%QT = SrcContStateData%QT end if if (allocated(SrcContStateData%QDT)) then - LB(1:1) = lbound(SrcContStateData%QDT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QDT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%QDT) + UB(1:1) = ubound(SrcContStateData%QDT) if (.not. allocated(DstContStateData%QDT)) then allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -852,7 +852,7 @@ subroutine SED_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -942,16 +942,16 @@ subroutine SED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call SED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -968,15 +968,15 @@ subroutine SED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SED_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call SED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -987,12 +987,12 @@ subroutine SED_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SED_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SED_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call SED_PackContState(RF, InData%xdot(i1)) end do @@ -1008,12 +1008,12 @@ subroutine SED_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call SED_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -1030,8 +1030,8 @@ subroutine SED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyParam' @@ -1062,8 +1062,8 @@ subroutine SED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%HubHt = SrcParamData%HubHt DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1083,16 +1083,16 @@ subroutine SED_DestroyParam(ParamData, ErrStat, ErrMsg) type(SED_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1105,8 +1105,8 @@ subroutine SED_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(SED_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SED_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%RootName) call RegPack(RF, InData%GenDOF) @@ -1134,9 +1134,9 @@ subroutine SED_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -1148,8 +1148,8 @@ subroutine SED_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1198,16 +1198,16 @@ subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1221,8 +1221,8 @@ subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%mapHub2Root)) then - LB(1:1) = lbound(SrcMiscData%mapHub2Root, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%mapHub2Root, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%mapHub2Root) + UB(1:1) = ubound(SrcMiscData%mapHub2Root) if (.not. allocated(DstMiscData%mapHub2Root)) then allocate(DstMiscData%mapHub2Root(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1237,8 +1237,8 @@ subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%QD2T)) then - LB(1:1) = lbound(SrcMiscData%QD2T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%QD2T, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%QD2T) + UB(1:1) = ubound(SrcMiscData%QD2T) if (.not. allocated(DstMiscData%QD2T)) then allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1270,8 +1270,8 @@ subroutine SED_DestroyMisc(MiscData, ErrStat, ErrMsg) type(SED_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_DestroyMisc' @@ -1283,8 +1283,8 @@ subroutine SED_DestroyMisc(MiscData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(MiscData%mapNac2Hub, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%mapHub2Root)) then - LB(1:1) = lbound(MiscData%mapHub2Root, kind=B8Ki) - UB(1:1) = ubound(MiscData%mapHub2Root, kind=B8Ki) + LB(1:1) = lbound(MiscData%mapHub2Root) + UB(1:1) = ubound(MiscData%mapHub2Root) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%mapHub2Root(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1310,16 +1310,16 @@ subroutine SED_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(SED_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SED_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%AllOuts) call NWTC_Library_PackMeshMapType(RF, InData%mapNac2Hub) call RegPack(RF, allocated(InData%mapHub2Root)) if (allocated(InData%mapHub2Root)) then - call RegPackBounds(RF, 1, lbound(InData%mapHub2Root, kind=B8Ki), ubound(InData%mapHub2Root, kind=B8Ki)) - LB(1:1) = lbound(InData%mapHub2Root, kind=B8Ki) - UB(1:1) = ubound(InData%mapHub2Root, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%mapHub2Root), ubound(InData%mapHub2Root)) + LB(1:1) = lbound(InData%mapHub2Root) + UB(1:1) = ubound(InData%mapHub2Root) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%mapHub2Root(i1)) end do @@ -1338,8 +1338,8 @@ subroutine SED_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1469,7 +1469,7 @@ SUBROUTINE SED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -1537,7 +1537,7 @@ SUBROUTINE SED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC + a3*u3%HSSBrTrqC u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + a3*u3%GenTrq IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -1643,7 +1643,7 @@ SUBROUTINE SED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1664,7 +1664,7 @@ SUBROUTINE SED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%Yaw = a1*y1%Yaw + a2*y2%Yaw y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -1729,7 +1729,7 @@ SUBROUTINE SED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1750,7 +1750,7 @@ SUBROUTINE SED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er y_out%Yaw = a1*y1%Yaw + a2*y2%Yaw + a3*y3%Yaw y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + a3*y3%YawRate IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index f2284d8ba8..27e72964b0 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -1249,6 +1249,9 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) ENDDO ! Add concentrated mass to mass matrix + CALL AllocAry( p%CMassNode, Init%nCMass, 'p%CMassNode', ErrStat2, ErrMsg2); if(Failed()) return; + CALL AllocAry( p%CMassWeight, Init%nCMass, 'p%CMassWeight', ErrStat2, ErrMsg2); if(Failed()) return; + CALL AllocAry( p%CMassOffset, Init%nCMass, 3, 'p%CMassOffset', ErrStat2, ErrMsg2); if(Failed()) return; DO I = 1, Init%nCMass iNode = NINT(Init%CMass(I, 1)) ! Note index where concentrated mass is to be added ! Safety check (otherwise we might have more than 6 DOF) @@ -1271,14 +1274,20 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) Init%M(jGlob, kGlob) = Init%M(jGlob, kGlob) + M66(J,K) ENDDO ENDDO - ENDDO ! Loop on concentrated mass - ! Add concentrated mass induced gravity force - DO I = 1, Init%nCMass - iNode = NINT(Init%CMass(I, 1)) ! Note index where concentrated mass is to be added - iGlob = p%NodesDOF(iNode)%List(3) ! uz - p%FG(iGlob) = p%FG(iGlob) - Init%CMass(I, 2)*Init%g - ENDDO + ! Add concentrated mass contribution to gravity force and moment + iGlob = p%NodesDOF(iNode)%List(3); p%FG(iGlob) = p%FG(iGlob) - m*Init%g ! uz: -mg + iGlob = p%NodesDOF(iNode)%List(4); p%FG(iGlob) = p%FG(iGlob) - m*Init%g * y ! tx: -mgy + iGlob = p%NodesDOF(iNode)%List(5); p%FG(iGlob) = p%FG(iGlob) + m*Init%g * x ! ty: mgx + + ! Save concentrated mass information for GuyanLoadCorrection + p%CMassNode(I) = iNode + p%CMassWeight(I) = m*Init%g + p%CMassOffset(I,1) = x + p%CMassOffset(I,2) = y + p%CMassOffset(I,3) = z + + ENDDO ! Loop on concentrated mass CALL CleanUp_AssembleKM() diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index bfd4907d09..d8474282dc 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -994,7 +994,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CHARACTER(64), ALLOCATABLE :: StrArray(:) ! Array of strings, for better control of table inputs LOGICAL :: Echo LOGICAL :: LegacyFormat -LOGICAL :: bNumeric, bInteger +LOGICAL :: bNumeric, bInteger, bCableHasPretension INTEGER(IntKi) :: UnIn INTEGER(IntKi) :: nColumns, nColValid, nColNumeric INTEGER(IntKi) :: IOS @@ -1377,6 +1377,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CALL ReadCom ( UnIn, SDInputFile, 'Cable properties Unit ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return IF (Check( Init%NPropSetsC < 0, 'NPropSetsCable must be >=0')) return CALL AllocAry(Init%PropSetsC, Init%NPropSetsC, PropSetsCCol, 'PropSetsC', ErrStat2, ErrMsg2); if(Failed()) return + bCableHasPretension = .false. DO I = 1, Init%NPropSetsC !CALL ReadAry( UnIn, SDInputFile, Init%PropSetsC(I,:), PropSetsCCol, 'PropSetsC', 'PropSetsC ID and values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading cable property line'; if (Failed()) return @@ -1389,7 +1390,18 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) call LegacyWarning('Using 4 values instead of 5 for cable properties. Cable will have constant properties and wont be controllable.') Init%PropSetsC(:,5:PropSetsCCol)=0 ! No CtrlChannel endif + if (Init%PropSetsC(I,4)>0.0) then + bCableHasPretension = .true. + end if ENDDO + if (bCableHasPretension) then + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + call WrScr('Warning: Cable with non-zero pretension specified.') + call WrScr(' SubDyn currently does not account for geometric stiffness from pretension.' ) + call WrScr(' Avoid non-zero cable pretension if possible.' ) + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + end if + !----------------------- RIGID LINK PROPERTIES ------------------------------------ CALL ReadCom ( UnIn, SDInputFile, 'Rigid link properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsR, 'NPropSetsR', 'Number of rigid link properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return @@ -3237,7 +3249,7 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC real(ReKi) :: CableTension ! Controllable Cable force real(ReKi) :: DeltaL ! Change of length real(ReKi) :: rotations(3) - real(ReKi) :: du(3), Moment(3), Force(3) + real(ReKi) :: du(3), Moment(3), Force(3), CMassOffset(3), CMassWeight(3) real(ReKi) :: u_TP(6) real(FEKi) :: FGe(12) ! element gravity force vector ! Variables for Guyan Rigid motion @@ -3246,6 +3258,10 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global real(R8Ki), dimension(3,3) :: Rg2b ! Rotation matrix global 2 body coordinates + real(ReKi), dimension(3,3) :: orientation ! Nodal orientation matrix + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None ErrStat = ErrID_None ErrMsg = "" @@ -3309,9 +3325,9 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC ! --- Build vector of external moment ! For floating structure with potentially large Guyan (rigid-body) rotation, nodal self-weight needs to be recomputed based on the current rigid-body orientation m%FG = 0.0_R8Ki - if ( RotateLoads ) then + if ( RotateLoads ) then ! if and only if floating Rb2g = transpose(Rg2b) ! Body (Guyan) to global - do i = 1, size(p%ElemProps) + do i = 1, size(p%ElemProps) ! Loop through all elements ! --- Element Fg in the earth-fixed frame CALL ElemG(p%ElemProps(i)%Area, p%ElemProps(i)%Length, p%ElemProps(i)%Rho, matmul(Rb2g,p%ElemProps(i)%DirCos), FGe, p%g) ! --- Element Fg in the Guyan rigid-body frame @@ -3323,6 +3339,25 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC IDOF = p%ElemsDOF(1:12,i) m%FG( IDOF ) = m%FG( IDOF ) + FGe(1:12) end do + do i = 1,size(p%CMassNode) ! Loop through all concentrated masses + iNode = p%CMassNode(i) + IDOF(1:6) = p%NodesDOF(iNode)%List(1:6) + CMassOffset = p%CMassOffset(i,:) + CMassWeight = matmul(Rg2b, (/0.0,0.0,-p%CMassWeight(i)/) ) + m%FG(IDOF(1:3)) = m%FG(IDOF(1:3)) + CMassWeight + m%FG(IDOF(4:6)) = m%FG(IDOF(4:6)) + cross_product(CMassOffset,CMassWeight) + end do + end if + + if (GuyanLoadCorrection) then ! if and only if fixed-bottom + ! Additional GuyanLoadCorrection coming from the weight of concentrated masses with CoG offset + do i = 1,size(p%CMassNode) ! Loop through all concentrated masses + iNode = p%CMassNode(i) + IDOF(4:6) = p%NodesDOF(iNode)%List(4:6) + call SmllRotTrans('Nodal rotation',m%DU_full(IDOF(4)),m%DU_full(IDOF(5)),m%DU_full(IDOF(6)),orientation,'',ErrStat2,ErrMsg2); if(Failed()) return + CMassOffset = matmul(p%CMassOffset(i,:),orientation) + m%Fext(IDOF(4:6)) = m%Fext(IDOF(4:6)) + cross_product( CMassOffset-p%CMassOffset(i,:), (/0.0,0.0,-p%CMassWeight(i)/) ) + end do end if do iNode = 1,p%nNodes @@ -3337,7 +3372,7 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC endif ! Extra moment dm = Delta u x (fe + fg) - if (GuyanLoadCorrection) then + if (GuyanLoadCorrection) then ! if and only if fixed-bottom du = m%DU_full(p%NodesDOF(iNode)%List(1:3)) ! Lever arm Moment(1) = Moment(1) + du(2) * Force(3) - du(3) * Force(2) Moment(2) = Moment(2) + du(3) * Force(1) - du(1) * Force(3) @@ -3362,8 +3397,14 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC contains subroutine Fatal(ErrMsg_in) character(len=*), intent(in) :: ErrMsg_in - call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'GetExtForce'); + call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'GetExtForceOnInternalDOF'); end subroutine Fatal + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetExtForceOnInternalDOF') + Failed = ErrStat >= AbortErrLev + end function Failed + END SUBROUTINE GetExtForceOnInternalDOF !------------------------------------------------------------------------------------------------------ diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index bdeffef084..c795507747 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -178,10 +178,13 @@ typedef ^ ParameterType IntKi Nmembers - - - "Number of mem typedef ^ ParameterType IntKi Elems {:}{:} - - "Element nodes connections" typedef ^ ParameterType ElemPropType ElemProps {:} - - "List of element properties" typedef ^ ParameterType R8Ki FC {:} - - "Initial cable force T0, not reduced" N -typedef ^ ParameterType R8Ki FG {:} - - "Gravity force vector (with initial cable force T0), not reduced" N +typedef ^ ParameterType R8Ki FG {:} - - "Gravity force vector, not reduced" N typedef ^ ParameterType ReKi DP0 {:}{:} - - "Vector from TP to a Node at t=0, used for Floating Rigid Body motion" m typedef ^ ParameterType ReKi rPG {:} - - "Vector from TP to rigid-body CoG in the Guyan (rigid-body) frame, used for Floating Rigid Body Motion" m typedef ^ ParameterType IntKi NodeID2JointID {:} - - "Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes)" "-" +typedef ^ ParameterType IntKi CMassNode {:} - - "Node indices for concentrated masses" +typedef ^ ParameterType ReKi CMassWeight {:} - - "Weight of concentrated masses" N +typedef ^ ParameterType ReKi CMassOffset {:}{:} - - "Concentrated mass CoG offset from attached nodes" m # --- Parameters - Constraints reduction typedef ^ ParameterType Logical reduced - - - "True if system has been reduced to account for constraints" "-" typedef ^ ParameterType R8Ki T_red {:}{:} - - "Transformation matrix performing the constraint reduction x = T. xtilde" "-" diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index edbbb2564c..a8e15c6146 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -229,10 +229,13 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Elems !< Element nodes connections [-] TYPE(ElemPropType) , DIMENSION(:), ALLOCATABLE :: ElemProps !< List of element properties [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FC !< Initial cable force T0, not reduced [N] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (with initial cable force T0), not reduced [N] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector, not reduced [N] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP0 !< Vector from TP to a Node at t=0, used for Floating Rigid Body motion [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rPG !< Vector from TP to rigid-body CoG in the Guyan (rigid-body) frame, used for Floating Rigid Body Motion [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeID2JointID !< Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: CMassNode !< Node indices for concentrated masses [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMassWeight !< Weight of concentrated masses [N] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMassOffset !< Concentrated mass CoG offset from attached nodes [m] LOGICAL :: reduced = .false. !< True if system has been reduced to account for constraints [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red !< Transformation matrix performing the constraint reduction x = T. xtilde [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red_T !< Transpose of T_red [-] @@ -396,14 +399,14 @@ subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyIList' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcIListData%List)) then - LB(1:1) = lbound(SrcIListData%List, kind=B8Ki) - UB(1:1) = ubound(SrcIListData%List, kind=B8Ki) + LB(1:1) = lbound(SrcIListData%List) + UB(1:1) = ubound(SrcIListData%List) if (.not. allocated(DstIListData%List)) then allocate(DstIListData%List(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -440,7 +443,7 @@ subroutine SD_UnPackIList(RF, OutData) type(RegFile), intent(inout) :: RF type(IList), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackIList' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -453,7 +456,7 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyMeshAuxDataType' ErrStat = ErrID_None @@ -461,8 +464,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt if (allocated(SrcMeshAuxDataTypeData%NodeCnt)) then - LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt, kind=B8Ki) - UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt, kind=B8Ki) + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt) if (.not. allocated(DstMeshAuxDataTypeData%NodeCnt)) then allocate(DstMeshAuxDataTypeData%NodeCnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -473,8 +476,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt end if if (allocated(SrcMeshAuxDataTypeData%NodeIDs)) then - LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs, kind=B8Ki) - UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs, kind=B8Ki) + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs) if (.not. allocated(DstMeshAuxDataTypeData%NodeIDs)) then allocate(DstMeshAuxDataTypeData%NodeIDs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -485,8 +488,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs end if if (allocated(SrcMeshAuxDataTypeData%ElmIDs)) then - LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs, kind=B8Ki) - UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs, kind=B8Ki) + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs) if (.not. allocated(DstMeshAuxDataTypeData%ElmIDs)) then allocate(DstMeshAuxDataTypeData%ElmIDs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -497,8 +500,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs end if if (allocated(SrcMeshAuxDataTypeData%ElmNds)) then - LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds, kind=B8Ki) - UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds, kind=B8Ki) + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds) if (.not. allocated(DstMeshAuxDataTypeData%ElmNds)) then allocate(DstMeshAuxDataTypeData%ElmNds(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -509,8 +512,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds end if if (allocated(SrcMeshAuxDataTypeData%Me)) then - LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me, kind=B8Ki) - UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me, kind=B8Ki) + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me) if (.not. allocated(DstMeshAuxDataTypeData%Me)) then allocate(DstMeshAuxDataTypeData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -521,8 +524,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me end if if (allocated(SrcMeshAuxDataTypeData%Ke)) then - LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke, kind=B8Ki) - UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke, kind=B8Ki) + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke) if (.not. allocated(DstMeshAuxDataTypeData%Ke)) then allocate(DstMeshAuxDataTypeData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -533,8 +536,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke end if if (allocated(SrcMeshAuxDataTypeData%Fg)) then - LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg, kind=B8Ki) - UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg, kind=B8Ki) + LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg) + UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg) if (.not. allocated(DstMeshAuxDataTypeData%Fg)) then allocate(DstMeshAuxDataTypeData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -597,7 +600,7 @@ subroutine SD_UnPackMeshAuxDataType(RF, OutData) type(RegFile), intent(inout) :: RF type(MeshAuxDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMeshAuxDataType' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -618,14 +621,14 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyCB_MatArrays' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcCB_MatArraysData%MBB)) then - LB(1:2) = lbound(SrcCB_MatArraysData%MBB, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%MBB, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%MBB) + UB(1:2) = ubound(SrcCB_MatArraysData%MBB) if (.not. allocated(DstCB_MatArraysData%MBB)) then allocate(DstCB_MatArraysData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -636,8 +639,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB end if if (allocated(SrcCB_MatArraysData%MBM)) then - LB(1:2) = lbound(SrcCB_MatArraysData%MBM, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%MBM, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%MBM) + UB(1:2) = ubound(SrcCB_MatArraysData%MBM) if (.not. allocated(DstCB_MatArraysData%MBM)) then allocate(DstCB_MatArraysData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -648,8 +651,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM end if if (allocated(SrcCB_MatArraysData%KBB)) then - LB(1:2) = lbound(SrcCB_MatArraysData%KBB, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%KBB, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%KBB) + UB(1:2) = ubound(SrcCB_MatArraysData%KBB) if (.not. allocated(DstCB_MatArraysData%KBB)) then allocate(DstCB_MatArraysData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -660,8 +663,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB end if if (allocated(SrcCB_MatArraysData%PhiL)) then - LB(1:2) = lbound(SrcCB_MatArraysData%PhiL, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%PhiL, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%PhiL) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiL) if (.not. allocated(DstCB_MatArraysData%PhiL)) then allocate(DstCB_MatArraysData%PhiL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -672,8 +675,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL end if if (allocated(SrcCB_MatArraysData%PhiR)) then - LB(1:2) = lbound(SrcCB_MatArraysData%PhiR, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%PhiR, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%PhiR) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiR) if (.not. allocated(DstCB_MatArraysData%PhiR)) then allocate(DstCB_MatArraysData%PhiR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -684,8 +687,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR end if if (allocated(SrcCB_MatArraysData%OmegaL)) then - LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL, kind=B8Ki) - UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL, kind=B8Ki) + LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL) + UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL) if (.not. allocated(DstCB_MatArraysData%OmegaL)) then allocate(DstCB_MatArraysData%OmegaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -742,7 +745,7 @@ subroutine SD_UnPackCB_MatArrays(RF, OutData) type(RegFile), intent(inout) :: RF type(CB_MatArrays), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackCB_MatArrays' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -903,7 +906,7 @@ subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInitInput' @@ -916,8 +919,8 @@ subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ if (allocated(SrcInitInputData%SoilStiffness)) then - LB(1:3) = lbound(SrcInitInputData%SoilStiffness, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%SoilStiffness, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%SoilStiffness) + UB(1:3) = ubound(SrcInitInputData%SoilStiffness) if (.not. allocated(DstInitInputData%SoilStiffness)) then allocate(DstInitInputData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -970,7 +973,7 @@ subroutine SD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -991,15 +994,15 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1010,8 +1013,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1028,8 +1031,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1040,8 +1043,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1052,8 +1055,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1064,8 +1067,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1076,8 +1079,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1088,8 +1091,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1100,8 +1103,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1112,8 +1115,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1124,8 +1127,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%CableCChanRqst)) then - LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) if (.not. allocated(DstInitOutputData%CableCChanRqst)) then allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1210,7 +1213,7 @@ subroutine SD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1235,7 +1238,7 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyInitType' ErrStat = ErrID_None @@ -1257,8 +1260,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NDiv = SrcInitTypeData%NDiv DstInitTypeData%CBMod = SrcInitTypeData%CBMod if (allocated(SrcInitTypeData%Joints)) then - LB(1:2) = lbound(SrcInitTypeData%Joints, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%Joints, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%Joints) + UB(1:2) = ubound(SrcInitTypeData%Joints) if (.not. allocated(DstInitTypeData%Joints)) then allocate(DstInitTypeData%Joints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1269,8 +1272,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Joints = SrcInitTypeData%Joints end if if (allocated(SrcInitTypeData%PropSetsB)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsB, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsB, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsB) + UB(1:2) = ubound(SrcInitTypeData%PropSetsB) if (.not. allocated(DstInitTypeData%PropSetsB)) then allocate(DstInitTypeData%PropSetsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1281,8 +1284,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB end if if (allocated(SrcInitTypeData%PropSetsC)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsC, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsC, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsC) + UB(1:2) = ubound(SrcInitTypeData%PropSetsC) if (.not. allocated(DstInitTypeData%PropSetsC)) then allocate(DstInitTypeData%PropSetsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1293,8 +1296,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC end if if (allocated(SrcInitTypeData%PropSetsR)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsR, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsR, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsR) + UB(1:2) = ubound(SrcInitTypeData%PropSetsR) if (.not. allocated(DstInitTypeData%PropSetsR)) then allocate(DstInitTypeData%PropSetsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1305,8 +1308,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR end if if (allocated(SrcInitTypeData%PropSetsS)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsS, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsS, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsS) + UB(1:2) = ubound(SrcInitTypeData%PropSetsS) if (.not. allocated(DstInitTypeData%PropSetsS)) then allocate(DstInitTypeData%PropSetsS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1317,8 +1320,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsS = SrcInitTypeData%PropSetsS end if if (allocated(SrcInitTypeData%PropSetsX)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsX, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsX, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsX) + UB(1:2) = ubound(SrcInitTypeData%PropSetsX) if (.not. allocated(DstInitTypeData%PropSetsX)) then allocate(DstInitTypeData%PropSetsX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1329,8 +1332,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX end if if (allocated(SrcInitTypeData%COSMs)) then - LB(1:2) = lbound(SrcInitTypeData%COSMs, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%COSMs, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%COSMs) + UB(1:2) = ubound(SrcInitTypeData%COSMs) if (.not. allocated(DstInitTypeData%COSMs)) then allocate(DstInitTypeData%COSMs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1341,8 +1344,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%COSMs = SrcInitTypeData%COSMs end if if (allocated(SrcInitTypeData%CMass)) then - LB(1:2) = lbound(SrcInitTypeData%CMass, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%CMass, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%CMass) + UB(1:2) = ubound(SrcInitTypeData%CMass) if (.not. allocated(DstInitTypeData%CMass)) then allocate(DstInitTypeData%CMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1353,8 +1356,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%CMass = SrcInitTypeData%CMass end if if (allocated(SrcInitTypeData%JDampings)) then - LB(1:1) = lbound(SrcInitTypeData%JDampings, kind=B8Ki) - UB(1:1) = ubound(SrcInitTypeData%JDampings, kind=B8Ki) + LB(1:1) = lbound(SrcInitTypeData%JDampings) + UB(1:1) = ubound(SrcInitTypeData%JDampings) if (.not. allocated(DstInitTypeData%JDampings)) then allocate(DstInitTypeData%JDampings(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1368,8 +1371,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat if (allocated(SrcInitTypeData%Members)) then - LB(1:2) = lbound(SrcInitTypeData%Members, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%Members, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%Members) + UB(1:2) = ubound(SrcInitTypeData%Members) if (.not. allocated(DstInitTypeData%Members)) then allocate(DstInitTypeData%Members(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1380,8 +1383,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Members = SrcInitTypeData%Members end if if (allocated(SrcInitTypeData%SSOutList)) then - LB(1:1) = lbound(SrcInitTypeData%SSOutList, kind=B8Ki) - UB(1:1) = ubound(SrcInitTypeData%SSOutList, kind=B8Ki) + LB(1:1) = lbound(SrcInitTypeData%SSOutList) + UB(1:1) = ubound(SrcInitTypeData%SSOutList) if (.not. allocated(DstInitTypeData%SSOutList)) then allocate(DstInitTypeData%SSOutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1394,8 +1397,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim if (allocated(SrcInitTypeData%SSIK)) then - LB(1:2) = lbound(SrcInitTypeData%SSIK, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%SSIK, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%SSIK) + UB(1:2) = ubound(SrcInitTypeData%SSIK) if (.not. allocated(DstInitTypeData%SSIK)) then allocate(DstInitTypeData%SSIK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1406,8 +1409,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIK = SrcInitTypeData%SSIK end if if (allocated(SrcInitTypeData%SSIM)) then - LB(1:2) = lbound(SrcInitTypeData%SSIM, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%SSIM, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%SSIM) + UB(1:2) = ubound(SrcInitTypeData%SSIM) if (.not. allocated(DstInitTypeData%SSIM)) then allocate(DstInitTypeData%SSIM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1418,8 +1421,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIM = SrcInitTypeData%SSIM end if if (allocated(SrcInitTypeData%SSIfile)) then - LB(1:1) = lbound(SrcInitTypeData%SSIfile, kind=B8Ki) - UB(1:1) = ubound(SrcInitTypeData%SSIfile, kind=B8Ki) + LB(1:1) = lbound(SrcInitTypeData%SSIfile) + UB(1:1) = ubound(SrcInitTypeData%SSIfile) if (.not. allocated(DstInitTypeData%SSIfile)) then allocate(DstInitTypeData%SSIfile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1430,8 +1433,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile end if if (allocated(SrcInitTypeData%Soil_K)) then - LB(1:3) = lbound(SrcInitTypeData%Soil_K, kind=B8Ki) - UB(1:3) = ubound(SrcInitTypeData%Soil_K, kind=B8Ki) + LB(1:3) = lbound(SrcInitTypeData%Soil_K) + UB(1:3) = ubound(SrcInitTypeData%Soil_K) if (.not. allocated(DstInitTypeData%Soil_K)) then allocate(DstInitTypeData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1442,8 +1445,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K end if if (allocated(SrcInitTypeData%Soil_Points)) then - LB(1:2) = lbound(SrcInitTypeData%Soil_Points, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%Soil_Points, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%Soil_Points) + UB(1:2) = ubound(SrcInitTypeData%Soil_Points) if (.not. allocated(DstInitTypeData%Soil_Points)) then allocate(DstInitTypeData%Soil_Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1454,8 +1457,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points end if if (allocated(SrcInitTypeData%Soil_Nodes)) then - LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes) + UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes) if (.not. allocated(DstInitTypeData%Soil_Nodes)) then allocate(DstInitTypeData%Soil_Nodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1471,8 +1474,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NPropR = SrcInitTypeData%NPropR DstInitTypeData%NPropS = SrcInitTypeData%NPropS if (allocated(SrcInitTypeData%Nodes)) then - LB(1:2) = lbound(SrcInitTypeData%Nodes, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%Nodes, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%Nodes) + UB(1:2) = ubound(SrcInitTypeData%Nodes) if (.not. allocated(DstInitTypeData%Nodes)) then allocate(DstInitTypeData%Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1483,8 +1486,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Nodes = SrcInitTypeData%Nodes end if if (allocated(SrcInitTypeData%PropsB)) then - LB(1:2) = lbound(SrcInitTypeData%PropsB, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropsB, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropsB) + UB(1:2) = ubound(SrcInitTypeData%PropsB) if (.not. allocated(DstInitTypeData%PropsB)) then allocate(DstInitTypeData%PropsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1495,8 +1498,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsB = SrcInitTypeData%PropsB end if if (allocated(SrcInitTypeData%PropsC)) then - LB(1:2) = lbound(SrcInitTypeData%PropsC, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropsC, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropsC) + UB(1:2) = ubound(SrcInitTypeData%PropsC) if (.not. allocated(DstInitTypeData%PropsC)) then allocate(DstInitTypeData%PropsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1507,8 +1510,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsC = SrcInitTypeData%PropsC end if if (allocated(SrcInitTypeData%PropsR)) then - LB(1:2) = lbound(SrcInitTypeData%PropsR, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropsR, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropsR) + UB(1:2) = ubound(SrcInitTypeData%PropsR) if (.not. allocated(DstInitTypeData%PropsR)) then allocate(DstInitTypeData%PropsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1519,8 +1522,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsR = SrcInitTypeData%PropsR end if if (allocated(SrcInitTypeData%PropsS)) then - LB(1:2) = lbound(SrcInitTypeData%PropsS, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropsS, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropsS) + UB(1:2) = ubound(SrcInitTypeData%PropsS) if (.not. allocated(DstInitTypeData%PropsS)) then allocate(DstInitTypeData%PropsS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1531,8 +1534,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsS = SrcInitTypeData%PropsS end if if (allocated(SrcInitTypeData%K)) then - LB(1:2) = lbound(SrcInitTypeData%K, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%K, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%K) + UB(1:2) = ubound(SrcInitTypeData%K) if (.not. allocated(DstInitTypeData%K)) then allocate(DstInitTypeData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1543,8 +1546,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%K = SrcInitTypeData%K end if if (allocated(SrcInitTypeData%M)) then - LB(1:2) = lbound(SrcInitTypeData%M, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%M, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%M) + UB(1:2) = ubound(SrcInitTypeData%M) if (.not. allocated(DstInitTypeData%M)) then allocate(DstInitTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1555,8 +1558,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%M = SrcInitTypeData%M end if if (allocated(SrcInitTypeData%ElemProps)) then - LB(1:2) = lbound(SrcInitTypeData%ElemProps, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%ElemProps, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%ElemProps) + UB(1:2) = ubound(SrcInitTypeData%ElemProps) if (.not. allocated(DstInitTypeData%ElemProps)) then allocate(DstInitTypeData%ElemProps(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1567,8 +1570,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps end if if (allocated(SrcInitTypeData%MemberNodes)) then - LB(1:2) = lbound(SrcInitTypeData%MemberNodes, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%MemberNodes, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%MemberNodes) + UB(1:2) = ubound(SrcInitTypeData%MemberNodes) if (.not. allocated(DstInitTypeData%MemberNodes)) then allocate(DstInitTypeData%MemberNodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1579,8 +1582,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes end if if (allocated(SrcInitTypeData%NodesConnN)) then - LB(1:2) = lbound(SrcInitTypeData%NodesConnN, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%NodesConnN, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%NodesConnN) + UB(1:2) = ubound(SrcInitTypeData%NodesConnN) if (.not. allocated(DstInitTypeData%NodesConnN)) then allocate(DstInitTypeData%NodesConnN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1591,8 +1594,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN end if if (allocated(SrcInitTypeData%NodesConnE)) then - LB(1:2) = lbound(SrcInitTypeData%NodesConnE, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%NodesConnE, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%NodesConnE) + UB(1:2) = ubound(SrcInitTypeData%NodesConnE) if (.not. allocated(DstInitTypeData%NodesConnE)) then allocate(DstInitTypeData%NodesConnE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1765,7 +1768,7 @@ subroutine SD_UnPackInitType(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_InitType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1832,14 +1835,14 @@ subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%qm)) then - LB(1:1) = lbound(SrcContStateData%qm, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qm, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) if (.not. allocated(DstContStateData%qm)) then allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1850,8 +1853,8 @@ subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%qm = SrcContStateData%qm end if if (allocated(SrcContStateData%qmdot)) then - LB(1:1) = lbound(SrcContStateData%qmdot, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qmdot, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) if (.not. allocated(DstContStateData%qmdot)) then allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1892,7 +1895,7 @@ subroutine SD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1982,16 +1985,16 @@ subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2012,16 +2015,16 @@ subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call SD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2034,14 +2037,14 @@ subroutine SD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call SD_PackContState(RF, InData%xdot(i1)) end do @@ -2054,8 +2057,8 @@ subroutine SD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2081,8 +2084,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyParam' @@ -2101,8 +2104,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nDOF_red = SrcParamData%nDOF_red DstParamData%Nmembers = SrcParamData%Nmembers if (allocated(SrcParamData%Elems)) then - LB(1:2) = lbound(SrcParamData%Elems, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Elems, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Elems) + UB(1:2) = ubound(SrcParamData%Elems) if (.not. allocated(DstParamData%Elems)) then allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2113,8 +2116,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Elems = SrcParamData%Elems end if if (allocated(SrcParamData%ElemProps)) then - LB(1:1) = lbound(SrcParamData%ElemProps, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ElemProps, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ElemProps) + UB(1:1) = ubound(SrcParamData%ElemProps) if (.not. allocated(DstParamData%ElemProps)) then allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2129,8 +2132,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%FC)) then - LB(1:1) = lbound(SrcParamData%FC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FC, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FC) + UB(1:1) = ubound(SrcParamData%FC) if (.not. allocated(DstParamData%FC)) then allocate(DstParamData%FC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2141,8 +2144,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FC = SrcParamData%FC end if if (allocated(SrcParamData%FG)) then - LB(1:1) = lbound(SrcParamData%FG, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FG, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FG) + UB(1:1) = ubound(SrcParamData%FG) if (.not. allocated(DstParamData%FG)) then allocate(DstParamData%FG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2153,8 +2156,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FG = SrcParamData%FG end if if (allocated(SrcParamData%DP0)) then - LB(1:2) = lbound(SrcParamData%DP0, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DP0, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%DP0) + UB(1:2) = ubound(SrcParamData%DP0) if (.not. allocated(DstParamData%DP0)) then allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2165,8 +2168,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DP0 = SrcParamData%DP0 end if if (allocated(SrcParamData%rPG)) then - LB(1:1) = lbound(SrcParamData%rPG, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rPG, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rPG) + UB(1:1) = ubound(SrcParamData%rPG) if (.not. allocated(DstParamData%rPG)) then allocate(DstParamData%rPG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2177,8 +2180,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rPG = SrcParamData%rPG end if if (allocated(SrcParamData%NodeID2JointID)) then - LB(1:1) = lbound(SrcParamData%NodeID2JointID, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodeID2JointID, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NodeID2JointID) + UB(1:1) = ubound(SrcParamData%NodeID2JointID) if (.not. allocated(DstParamData%NodeID2JointID)) then allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2188,10 +2191,46 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID end if + if (allocated(SrcParamData%CMassNode)) then + LB(1:1) = lbound(SrcParamData%CMassNode) + UB(1:1) = ubound(SrcParamData%CMassNode) + if (.not. allocated(DstParamData%CMassNode)) then + allocate(DstParamData%CMassNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMassNode = SrcParamData%CMassNode + end if + if (allocated(SrcParamData%CMassWeight)) then + LB(1:1) = lbound(SrcParamData%CMassWeight) + UB(1:1) = ubound(SrcParamData%CMassWeight) + if (.not. allocated(DstParamData%CMassWeight)) then + allocate(DstParamData%CMassWeight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassWeight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMassWeight = SrcParamData%CMassWeight + end if + if (allocated(SrcParamData%CMassOffset)) then + LB(1:2) = lbound(SrcParamData%CMassOffset) + UB(1:2) = ubound(SrcParamData%CMassOffset) + if (.not. allocated(DstParamData%CMassOffset)) then + allocate(DstParamData%CMassOffset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassOffset.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMassOffset = SrcParamData%CMassOffset + end if DstParamData%reduced = SrcParamData%reduced if (allocated(SrcParamData%T_red)) then - LB(1:2) = lbound(SrcParamData%T_red, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%T_red, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%T_red) + UB(1:2) = ubound(SrcParamData%T_red) if (.not. allocated(DstParamData%T_red)) then allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2202,8 +2241,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%T_red = SrcParamData%T_red end if if (allocated(SrcParamData%T_red_T)) then - LB(1:2) = lbound(SrcParamData%T_red_T, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%T_red_T, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%T_red_T) + UB(1:2) = ubound(SrcParamData%T_red_T) if (.not. allocated(DstParamData%T_red_T)) then allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2214,8 +2253,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%T_red_T = SrcParamData%T_red_T end if if (allocated(SrcParamData%NodesDOF)) then - LB(1:1) = lbound(SrcParamData%NodesDOF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodesDOF, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NodesDOF) + UB(1:1) = ubound(SrcParamData%NodesDOF) if (.not. allocated(DstParamData%NodesDOF)) then allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2230,8 +2269,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%NodesDOFred)) then - LB(1:1) = lbound(SrcParamData%NodesDOFred, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodesDOFred, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NodesDOFred) + UB(1:1) = ubound(SrcParamData%NodesDOFred) if (.not. allocated(DstParamData%NodesDOFred)) then allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2246,8 +2285,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%ElemsDOF)) then - LB(1:2) = lbound(SrcParamData%ElemsDOF, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%ElemsDOF, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%ElemsDOF) + UB(1:2) = ubound(SrcParamData%ElemsDOF) if (.not. allocated(DstParamData%ElemsDOF)) then allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2258,8 +2297,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ElemsDOF = SrcParamData%ElemsDOF end if if (allocated(SrcParamData%DOFred2Nodes)) then - LB(1:2) = lbound(SrcParamData%DOFred2Nodes, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DOFred2Nodes, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%DOFred2Nodes) + UB(1:2) = ubound(SrcParamData%DOFred2Nodes) if (.not. allocated(DstParamData%DOFred2Nodes)) then allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2270,8 +2309,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes end if if (allocated(SrcParamData%CtrlElem2Channel)) then - LB(1:2) = lbound(SrcParamData%CtrlElem2Channel, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CtrlElem2Channel, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CtrlElem2Channel) + UB(1:2) = ubound(SrcParamData%CtrlElem2Channel) if (.not. allocated(DstParamData%CtrlElem2Channel)) then allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2286,8 +2325,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection DstParamData%Floating = SrcParamData%Floating if (allocated(SrcParamData%KMMDiag)) then - LB(1:1) = lbound(SrcParamData%KMMDiag, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%KMMDiag, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%KMMDiag) + UB(1:1) = ubound(SrcParamData%KMMDiag) if (.not. allocated(DstParamData%KMMDiag)) then allocate(DstParamData%KMMDiag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2298,8 +2337,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KMMDiag = SrcParamData%KMMDiag end if if (allocated(SrcParamData%CMMDiag)) then - LB(1:1) = lbound(SrcParamData%CMMDiag, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%CMMDiag, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%CMMDiag) + UB(1:1) = ubound(SrcParamData%CMMDiag) if (.not. allocated(DstParamData%CMMDiag)) then allocate(DstParamData%CMMDiag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2310,8 +2349,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CMMDiag = SrcParamData%CMMDiag end if if (allocated(SrcParamData%MMB)) then - LB(1:2) = lbound(SrcParamData%MMB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MMB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MMB) + UB(1:2) = ubound(SrcParamData%MMB) if (.not. allocated(DstParamData%MMB)) then allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2322,8 +2361,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MMB = SrcParamData%MMB end if if (allocated(SrcParamData%MBmmB)) then - LB(1:2) = lbound(SrcParamData%MBmmB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBmmB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MBmmB) + UB(1:2) = ubound(SrcParamData%MBmmB) if (.not. allocated(DstParamData%MBmmB)) then allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2334,8 +2373,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MBmmB = SrcParamData%MBmmB end if if (allocated(SrcParamData%C1_11)) then - LB(1:2) = lbound(SrcParamData%C1_11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C1_11, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C1_11) + UB(1:2) = ubound(SrcParamData%C1_11) if (.not. allocated(DstParamData%C1_11)) then allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2346,8 +2385,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C1_11 = SrcParamData%C1_11 end if if (allocated(SrcParamData%C1_12)) then - LB(1:2) = lbound(SrcParamData%C1_12, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C1_12, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C1_12) + UB(1:2) = ubound(SrcParamData%C1_12) if (.not. allocated(DstParamData%C1_12)) then allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2358,8 +2397,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C1_12 = SrcParamData%C1_12 end if if (allocated(SrcParamData%D1_141)) then - LB(1:2) = lbound(SrcParamData%D1_141, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D1_141, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%D1_141) + UB(1:2) = ubound(SrcParamData%D1_141) if (.not. allocated(DstParamData%D1_141)) then allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2370,8 +2409,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%D1_141 = SrcParamData%D1_141 end if if (allocated(SrcParamData%D1_142)) then - LB(1:2) = lbound(SrcParamData%D1_142, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D1_142, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%D1_142) + UB(1:2) = ubound(SrcParamData%D1_142) if (.not. allocated(DstParamData%D1_142)) then allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2382,8 +2421,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%D1_142 = SrcParamData%D1_142 end if if (allocated(SrcParamData%PhiM)) then - LB(1:2) = lbound(SrcParamData%PhiM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiM, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PhiM) + UB(1:2) = ubound(SrcParamData%PhiM) if (.not. allocated(DstParamData%PhiM)) then allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2394,8 +2433,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PhiM = SrcParamData%PhiM end if if (allocated(SrcParamData%C2_61)) then - LB(1:2) = lbound(SrcParamData%C2_61, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C2_61, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C2_61) + UB(1:2) = ubound(SrcParamData%C2_61) if (.not. allocated(DstParamData%C2_61)) then allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2406,8 +2445,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C2_61 = SrcParamData%C2_61 end if if (allocated(SrcParamData%C2_62)) then - LB(1:2) = lbound(SrcParamData%C2_62, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C2_62, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C2_62) + UB(1:2) = ubound(SrcParamData%C2_62) if (.not. allocated(DstParamData%C2_62)) then allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2418,8 +2457,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C2_62 = SrcParamData%C2_62 end if if (allocated(SrcParamData%PhiRb_TI)) then - LB(1:2) = lbound(SrcParamData%PhiRb_TI, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiRb_TI, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PhiRb_TI) + UB(1:2) = ubound(SrcParamData%PhiRb_TI) if (.not. allocated(DstParamData%PhiRb_TI)) then allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2430,8 +2469,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI end if if (allocated(SrcParamData%D2_63)) then - LB(1:2) = lbound(SrcParamData%D2_63, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D2_63, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%D2_63) + UB(1:2) = ubound(SrcParamData%D2_63) if (.not. allocated(DstParamData%D2_63)) then allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2442,8 +2481,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%D2_63 = SrcParamData%D2_63 end if if (allocated(SrcParamData%D2_64)) then - LB(1:2) = lbound(SrcParamData%D2_64, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D2_64, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%D2_64) + UB(1:2) = ubound(SrcParamData%D2_64) if (.not. allocated(DstParamData%D2_64)) then allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2454,8 +2493,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%D2_64 = SrcParamData%D2_64 end if if (allocated(SrcParamData%MBB)) then - LB(1:2) = lbound(SrcParamData%MBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MBB) + UB(1:2) = ubound(SrcParamData%MBB) if (.not. allocated(DstParamData%MBB)) then allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2466,8 +2505,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MBB = SrcParamData%MBB end if if (allocated(SrcParamData%KBB)) then - LB(1:2) = lbound(SrcParamData%KBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%KBB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%KBB) + UB(1:2) = ubound(SrcParamData%KBB) if (.not. allocated(DstParamData%KBB)) then allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2478,8 +2517,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KBB = SrcParamData%KBB end if if (allocated(SrcParamData%CBB)) then - LB(1:2) = lbound(SrcParamData%CBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CBB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CBB) + UB(1:2) = ubound(SrcParamData%CBB) if (.not. allocated(DstParamData%CBB)) then allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2490,8 +2529,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CBB = SrcParamData%CBB end if if (allocated(SrcParamData%CMM)) then - LB(1:2) = lbound(SrcParamData%CMM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CMM, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CMM) + UB(1:2) = ubound(SrcParamData%CMM) if (.not. allocated(DstParamData%CMM)) then allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2502,8 +2541,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CMM = SrcParamData%CMM end if if (allocated(SrcParamData%MBM)) then - LB(1:2) = lbound(SrcParamData%MBM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBM, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MBM) + UB(1:2) = ubound(SrcParamData%MBM) if (.not. allocated(DstParamData%MBM)) then allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2514,8 +2553,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MBM = SrcParamData%MBM end if if (allocated(SrcParamData%PhiL_T)) then - LB(1:2) = lbound(SrcParamData%PhiL_T, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiL_T, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PhiL_T) + UB(1:2) = ubound(SrcParamData%PhiL_T) if (.not. allocated(DstParamData%PhiL_T)) then allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2526,8 +2565,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PhiL_T = SrcParamData%PhiL_T end if if (allocated(SrcParamData%PhiLInvOmgL2)) then - LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) + UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2) if (.not. allocated(DstParamData%PhiLInvOmgL2)) then allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2538,8 +2577,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 end if if (allocated(SrcParamData%KLLm1)) then - LB(1:2) = lbound(SrcParamData%KLLm1, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%KLLm1, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%KLLm1) + UB(1:2) = ubound(SrcParamData%KLLm1) if (.not. allocated(DstParamData%KLLm1)) then allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2550,8 +2589,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KLLm1 = SrcParamData%KLLm1 end if if (allocated(SrcParamData%AM2Jac)) then - LB(1:2) = lbound(SrcParamData%AM2Jac, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AM2Jac, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AM2Jac) + UB(1:2) = ubound(SrcParamData%AM2Jac) if (.not. allocated(DstParamData%AM2Jac)) then allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2562,8 +2601,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AM2Jac = SrcParamData%AM2Jac end if if (allocated(SrcParamData%AM2JacPiv)) then - LB(1:1) = lbound(SrcParamData%AM2JacPiv, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AM2JacPiv, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%AM2JacPiv) + UB(1:1) = ubound(SrcParamData%AM2JacPiv) if (.not. allocated(DstParamData%AM2JacPiv)) then allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2574,8 +2613,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv end if if (allocated(SrcParamData%TI)) then - LB(1:2) = lbound(SrcParamData%TI, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TI, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%TI) + UB(1:2) = ubound(SrcParamData%TI) if (.not. allocated(DstParamData%TI)) then allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2586,8 +2625,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TI = SrcParamData%TI end if if (allocated(SrcParamData%TIreact)) then - LB(1:2) = lbound(SrcParamData%TIreact, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TIreact, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%TIreact) + UB(1:2) = ubound(SrcParamData%TIreact) if (.not. allocated(DstParamData%TIreact)) then allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2602,8 +2641,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nNodes_L = SrcParamData%nNodes_L DstParamData%nNodes_C = SrcParamData%nNodes_C if (allocated(SrcParamData%Nodes_I)) then - LB(1:2) = lbound(SrcParamData%Nodes_I, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_I, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Nodes_I) + UB(1:2) = ubound(SrcParamData%Nodes_I) if (.not. allocated(DstParamData%Nodes_I)) then allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2614,8 +2653,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Nodes_I = SrcParamData%Nodes_I end if if (allocated(SrcParamData%Nodes_L)) then - LB(1:2) = lbound(SrcParamData%Nodes_L, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_L, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Nodes_L) + UB(1:2) = ubound(SrcParamData%Nodes_L) if (.not. allocated(DstParamData%Nodes_L)) then allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2626,8 +2665,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Nodes_L = SrcParamData%Nodes_L end if if (allocated(SrcParamData%Nodes_C)) then - LB(1:2) = lbound(SrcParamData%Nodes_C, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_C, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Nodes_C) + UB(1:2) = ubound(SrcParamData%Nodes_C) if (.not. allocated(DstParamData%Nodes_C)) then allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2650,8 +2689,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nDOF__L = SrcParamData%nDOF__L DstParamData%nDOF__F = SrcParamData%nDOF__F if (allocated(SrcParamData%IDI__)) then - LB(1:1) = lbound(SrcParamData%IDI__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI__, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDI__) + UB(1:1) = ubound(SrcParamData%IDI__) if (.not. allocated(DstParamData%IDI__)) then allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2662,8 +2701,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDI__ = SrcParamData%IDI__ end if if (allocated(SrcParamData%IDI_Rb)) then - LB(1:1) = lbound(SrcParamData%IDI_Rb, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI_Rb, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDI_Rb) + UB(1:1) = ubound(SrcParamData%IDI_Rb) if (.not. allocated(DstParamData%IDI_Rb)) then allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2674,8 +2713,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDI_Rb = SrcParamData%IDI_Rb end if if (allocated(SrcParamData%IDI_F)) then - LB(1:1) = lbound(SrcParamData%IDI_F, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI_F, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDI_F) + UB(1:1) = ubound(SrcParamData%IDI_F) if (.not. allocated(DstParamData%IDI_F)) then allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2686,8 +2725,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDI_F = SrcParamData%IDI_F end if if (allocated(SrcParamData%IDL_L)) then - LB(1:1) = lbound(SrcParamData%IDL_L, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDL_L, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDL_L) + UB(1:1) = ubound(SrcParamData%IDL_L) if (.not. allocated(DstParamData%IDL_L)) then allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2698,8 +2737,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDL_L = SrcParamData%IDL_L end if if (allocated(SrcParamData%IDC__)) then - LB(1:1) = lbound(SrcParamData%IDC__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC__, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDC__) + UB(1:1) = ubound(SrcParamData%IDC__) if (.not. allocated(DstParamData%IDC__)) then allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2710,8 +2749,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDC__ = SrcParamData%IDC__ end if if (allocated(SrcParamData%IDC_Rb)) then - LB(1:1) = lbound(SrcParamData%IDC_Rb, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_Rb, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDC_Rb) + UB(1:1) = ubound(SrcParamData%IDC_Rb) if (.not. allocated(DstParamData%IDC_Rb)) then allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2722,8 +2761,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDC_Rb = SrcParamData%IDC_Rb end if if (allocated(SrcParamData%IDC_L)) then - LB(1:1) = lbound(SrcParamData%IDC_L, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_L, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDC_L) + UB(1:1) = ubound(SrcParamData%IDC_L) if (.not. allocated(DstParamData%IDC_L)) then allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2734,8 +2773,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDC_L = SrcParamData%IDC_L end if if (allocated(SrcParamData%IDC_F)) then - LB(1:1) = lbound(SrcParamData%IDC_F, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_F, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDC_F) + UB(1:1) = ubound(SrcParamData%IDC_F) if (.not. allocated(DstParamData%IDC_F)) then allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2746,8 +2785,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDC_F = SrcParamData%IDC_F end if if (allocated(SrcParamData%IDR__)) then - LB(1:1) = lbound(SrcParamData%IDR__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDR__, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IDR__) + UB(1:1) = ubound(SrcParamData%IDR__) if (.not. allocated(DstParamData%IDR__)) then allocate(DstParamData%IDR__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2758,8 +2797,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDR__ = SrcParamData%IDR__ end if if (allocated(SrcParamData%ID__Rb)) then - LB(1:1) = lbound(SrcParamData%ID__Rb, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__Rb, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ID__Rb) + UB(1:1) = ubound(SrcParamData%ID__Rb) if (.not. allocated(DstParamData%ID__Rb)) then allocate(DstParamData%ID__Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2770,8 +2809,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ID__Rb = SrcParamData%ID__Rb end if if (allocated(SrcParamData%ID__L)) then - LB(1:1) = lbound(SrcParamData%ID__L, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__L, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ID__L) + UB(1:1) = ubound(SrcParamData%ID__L) if (.not. allocated(DstParamData%ID__L)) then allocate(DstParamData%ID__L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2782,8 +2821,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ID__L = SrcParamData%ID__L end if if (allocated(SrcParamData%ID__F)) then - LB(1:1) = lbound(SrcParamData%ID__F, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__F, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ID__F) + UB(1:1) = ubound(SrcParamData%ID__F) if (.not. allocated(DstParamData%ID__F)) then allocate(DstParamData%ID__F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2801,8 +2840,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutFmt = SrcParamData%OutFmt DstParamData%OutSFmt = SrcParamData%OutSFmt if (allocated(SrcParamData%MoutLst)) then - LB(1:1) = lbound(SrcParamData%MoutLst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%MoutLst) + UB(1:1) = ubound(SrcParamData%MoutLst) if (.not. allocated(DstParamData%MoutLst)) then allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2817,8 +2856,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%MoutLst2)) then - LB(1:1) = lbound(SrcParamData%MoutLst2, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst2, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%MoutLst2) + UB(1:1) = ubound(SrcParamData%MoutLst2) if (.not. allocated(DstParamData%MoutLst2)) then allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2833,8 +2872,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%MoutLst3)) then - LB(1:1) = lbound(SrcParamData%MoutLst3, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst3, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%MoutLst3) + UB(1:1) = ubound(SrcParamData%MoutLst3) if (.not. allocated(DstParamData%MoutLst3)) then allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2849,8 +2888,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2877,8 +2916,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) type(SD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_DestroyParam' @@ -2888,8 +2927,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Elems) end if if (allocated(ParamData%ElemProps)) then - LB(1:1) = lbound(ParamData%ElemProps, kind=B8Ki) - UB(1:1) = ubound(ParamData%ElemProps, kind=B8Ki) + LB(1:1) = lbound(ParamData%ElemProps) + UB(1:1) = ubound(ParamData%ElemProps) do i1 = LB(1), UB(1) call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2911,6 +2950,15 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%NodeID2JointID)) then deallocate(ParamData%NodeID2JointID) end if + if (allocated(ParamData%CMassNode)) then + deallocate(ParamData%CMassNode) + end if + if (allocated(ParamData%CMassWeight)) then + deallocate(ParamData%CMassWeight) + end if + if (allocated(ParamData%CMassOffset)) then + deallocate(ParamData%CMassOffset) + end if if (allocated(ParamData%T_red)) then deallocate(ParamData%T_red) end if @@ -2918,8 +2966,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%T_red_T) end if if (allocated(ParamData%NodesDOF)) then - LB(1:1) = lbound(ParamData%NodesDOF, kind=B8Ki) - UB(1:1) = ubound(ParamData%NodesDOF, kind=B8Ki) + LB(1:1) = lbound(ParamData%NodesDOF) + UB(1:1) = ubound(ParamData%NodesDOF) do i1 = LB(1), UB(1) call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2927,8 +2975,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%NodesDOF) end if if (allocated(ParamData%NodesDOFred)) then - LB(1:1) = lbound(ParamData%NodesDOFred, kind=B8Ki) - UB(1:1) = ubound(ParamData%NodesDOFred, kind=B8Ki) + LB(1:1) = lbound(ParamData%NodesDOFred) + UB(1:1) = ubound(ParamData%NodesDOFred) do i1 = LB(1), UB(1) call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3068,8 +3116,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%ID__F) end if if (allocated(ParamData%MoutLst)) then - LB(1:1) = lbound(ParamData%MoutLst, kind=B8Ki) - UB(1:1) = ubound(ParamData%MoutLst, kind=B8Ki) + LB(1:1) = lbound(ParamData%MoutLst) + UB(1:1) = ubound(ParamData%MoutLst) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3077,8 +3125,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst) end if if (allocated(ParamData%MoutLst2)) then - LB(1:1) = lbound(ParamData%MoutLst2, kind=B8Ki) - UB(1:1) = ubound(ParamData%MoutLst2, kind=B8Ki) + LB(1:1) = lbound(ParamData%MoutLst2) + UB(1:1) = ubound(ParamData%MoutLst2) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3086,8 +3134,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst2) end if if (allocated(ParamData%MoutLst3)) then - LB(1:1) = lbound(ParamData%MoutLst3, kind=B8Ki) - UB(1:1) = ubound(ParamData%MoutLst3, kind=B8Ki) + LB(1:1) = lbound(ParamData%MoutLst3) + UB(1:1) = ubound(ParamData%MoutLst3) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst3(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3095,8 +3143,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst3) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3109,8 +3157,8 @@ subroutine SD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(SD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%iVarTPMesh) call RegPack(RF, InData%iVarLMesh) @@ -3127,9 +3175,9 @@ subroutine SD_PackParam(RF, Indata) call RegPackAlloc(RF, InData%Elems) call RegPack(RF, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then - call RegPackBounds(RF, 1, lbound(InData%ElemProps, kind=B8Ki), ubound(InData%ElemProps, kind=B8Ki)) - LB(1:1) = lbound(InData%ElemProps, kind=B8Ki) - UB(1:1) = ubound(InData%ElemProps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ElemProps), ubound(InData%ElemProps)) + LB(1:1) = lbound(InData%ElemProps) + UB(1:1) = ubound(InData%ElemProps) do i1 = LB(1), UB(1) call SD_PackElemPropType(RF, InData%ElemProps(i1)) end do @@ -3139,23 +3187,26 @@ subroutine SD_PackParam(RF, Indata) call RegPackAlloc(RF, InData%DP0) call RegPackAlloc(RF, InData%rPG) call RegPackAlloc(RF, InData%NodeID2JointID) + call RegPackAlloc(RF, InData%CMassNode) + call RegPackAlloc(RF, InData%CMassWeight) + call RegPackAlloc(RF, InData%CMassOffset) call RegPack(RF, InData%reduced) call RegPackAlloc(RF, InData%T_red) call RegPackAlloc(RF, InData%T_red_T) call RegPack(RF, allocated(InData%NodesDOF)) if (allocated(InData%NodesDOF)) then - call RegPackBounds(RF, 1, lbound(InData%NodesDOF, kind=B8Ki), ubound(InData%NodesDOF, kind=B8Ki)) - LB(1:1) = lbound(InData%NodesDOF, kind=B8Ki) - UB(1:1) = ubound(InData%NodesDOF, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NodesDOF), ubound(InData%NodesDOF)) + LB(1:1) = lbound(InData%NodesDOF) + UB(1:1) = ubound(InData%NodesDOF) do i1 = LB(1), UB(1) call SD_PackIList(RF, InData%NodesDOF(i1)) end do end if call RegPack(RF, allocated(InData%NodesDOFred)) if (allocated(InData%NodesDOFred)) then - call RegPackBounds(RF, 1, lbound(InData%NodesDOFred, kind=B8Ki), ubound(InData%NodesDOFred, kind=B8Ki)) - LB(1:1) = lbound(InData%NodesDOFred, kind=B8Ki) - UB(1:1) = ubound(InData%NodesDOFred, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NodesDOFred), ubound(InData%NodesDOFred)) + LB(1:1) = lbound(InData%NodesDOFred) + UB(1:1) = ubound(InData%NodesDOFred) do i1 = LB(1), UB(1) call SD_PackIList(RF, InData%NodesDOFred(i1)) end do @@ -3233,36 +3284,36 @@ subroutine SD_PackParam(RF, Indata) call RegPack(RF, InData%OutSFmt) call RegPack(RF, allocated(InData%MoutLst)) if (allocated(InData%MoutLst)) then - call RegPackBounds(RF, 1, lbound(InData%MoutLst, kind=B8Ki), ubound(InData%MoutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%MoutLst, kind=B8Ki) - UB(1:1) = ubound(InData%MoutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MoutLst), ubound(InData%MoutLst)) + LB(1:1) = lbound(InData%MoutLst) + UB(1:1) = ubound(InData%MoutLst) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(RF, InData%MoutLst(i1)) end do end if call RegPack(RF, allocated(InData%MoutLst2)) if (allocated(InData%MoutLst2)) then - call RegPackBounds(RF, 1, lbound(InData%MoutLst2, kind=B8Ki), ubound(InData%MoutLst2, kind=B8Ki)) - LB(1:1) = lbound(InData%MoutLst2, kind=B8Ki) - UB(1:1) = ubound(InData%MoutLst2, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MoutLst2), ubound(InData%MoutLst2)) + LB(1:1) = lbound(InData%MoutLst2) + UB(1:1) = ubound(InData%MoutLst2) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(RF, InData%MoutLst2(i1)) end do end if call RegPack(RF, allocated(InData%MoutLst3)) if (allocated(InData%MoutLst3)) then - call RegPackBounds(RF, 1, lbound(InData%MoutLst3, kind=B8Ki), ubound(InData%MoutLst3, kind=B8Ki)) - LB(1:1) = lbound(InData%MoutLst3, kind=B8Ki) - UB(1:1) = ubound(InData%MoutLst3, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MoutLst3), ubound(InData%MoutLst3)) + LB(1:1) = lbound(InData%MoutLst3) + UB(1:1) = ubound(InData%MoutLst3) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(RF, InData%MoutLst3(i1)) end do end if call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do @@ -3281,8 +3332,8 @@ subroutine SD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3317,6 +3368,9 @@ subroutine SD_UnPackParam(RF, OutData) call RegUnpackAlloc(RF, OutData%DP0); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%rPG); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%NodeID2JointID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassWeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassOffset); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%reduced); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%T_red); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%T_red_T); if (RegCheckErr(RF, RoutineName)) return @@ -3484,7 +3538,7 @@ subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInput' @@ -3497,8 +3551,8 @@ subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%CableDeltaL)) then - LB(1:1) = lbound(SrcInputData%CableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%CableDeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%CableDeltaL) + UB(1:1) = ubound(SrcInputData%CableDeltaL) if (.not. allocated(DstInputData%CableDeltaL)) then allocate(DstInputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3543,7 +3597,7 @@ subroutine SD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3558,7 +3612,7 @@ subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyOutput' @@ -3574,8 +3628,8 @@ subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3623,7 +3677,7 @@ subroutine SD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3639,7 +3693,7 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyMisc' @@ -3661,8 +3715,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%qmdotdot)) then - LB(1:1) = lbound(SrcMiscData%qmdotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%qmdotdot, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%qmdotdot) + UB(1:1) = ubound(SrcMiscData%qmdotdot) if (.not. allocated(DstMiscData%qmdotdot)) then allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3676,8 +3730,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%udot_TP = SrcMiscData%udot_TP DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP if (allocated(SrcMiscData%F_L)) then - LB(1:1) = lbound(SrcMiscData%F_L, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_L, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_L) + UB(1:1) = ubound(SrcMiscData%F_L) if (.not. allocated(DstMiscData%F_L)) then allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3688,8 +3742,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_L = SrcMiscData%F_L end if if (allocated(SrcMiscData%F_L2)) then - LB(1:1) = lbound(SrcMiscData%F_L2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_L2, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_L2) + UB(1:1) = ubound(SrcMiscData%F_L2) if (.not. allocated(DstMiscData%F_L2)) then allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3700,8 +3754,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_L2 = SrcMiscData%F_L2 end if if (allocated(SrcMiscData%UR_bar)) then - LB(1:1) = lbound(SrcMiscData%UR_bar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UR_bar) + UB(1:1) = ubound(SrcMiscData%UR_bar) if (.not. allocated(DstMiscData%UR_bar)) then allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3712,8 +3766,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UR_bar = SrcMiscData%UR_bar end if if (allocated(SrcMiscData%UR_bar_dot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar_dot, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UR_bar_dot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dot) if (.not. allocated(DstMiscData%UR_bar_dot)) then allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3724,8 +3778,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot end if if (allocated(SrcMiscData%UR_bar_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot) if (.not. allocated(DstMiscData%UR_bar_dotdot)) then allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3736,8 +3790,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot end if if (allocated(SrcMiscData%UL)) then - LB(1:1) = lbound(SrcMiscData%UL, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UL) + UB(1:1) = ubound(SrcMiscData%UL) if (.not. allocated(DstMiscData%UL)) then allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3748,8 +3802,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL = SrcMiscData%UL end if if (allocated(SrcMiscData%UL_NS)) then - LB(1:1) = lbound(SrcMiscData%UL_NS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_NS, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UL_NS) + UB(1:1) = ubound(SrcMiscData%UL_NS) if (.not. allocated(DstMiscData%UL_NS)) then allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3760,8 +3814,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL_NS = SrcMiscData%UL_NS end if if (allocated(SrcMiscData%UL_dot)) then - LB(1:1) = lbound(SrcMiscData%UL_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_dot, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UL_dot) + UB(1:1) = ubound(SrcMiscData%UL_dot) if (.not. allocated(DstMiscData%UL_dot)) then allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3772,8 +3826,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL_dot = SrcMiscData%UL_dot end if if (allocated(SrcMiscData%UL_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UL_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_dotdot, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UL_dotdot) + UB(1:1) = ubound(SrcMiscData%UL_dotdot) if (.not. allocated(DstMiscData%UL_dotdot)) then allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3784,8 +3838,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot end if if (allocated(SrcMiscData%DU_full)) then - LB(1:1) = lbound(SrcMiscData%DU_full, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%DU_full, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%DU_full) + UB(1:1) = ubound(SrcMiscData%DU_full) if (.not. allocated(DstMiscData%DU_full)) then allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3796,8 +3850,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DU_full = SrcMiscData%DU_full end if if (allocated(SrcMiscData%U_full)) then - LB(1:1) = lbound(SrcMiscData%U_full, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%U_full) + UB(1:1) = ubound(SrcMiscData%U_full) if (.not. allocated(DstMiscData%U_full)) then allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3808,8 +3862,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full = SrcMiscData%U_full end if if (allocated(SrcMiscData%U_full_NS)) then - LB(1:1) = lbound(SrcMiscData%U_full_NS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_NS, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%U_full_NS) + UB(1:1) = ubound(SrcMiscData%U_full_NS) if (.not. allocated(DstMiscData%U_full_NS)) then allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3820,8 +3874,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_NS = SrcMiscData%U_full_NS end if if (allocated(SrcMiscData%U_full_dot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_dot, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%U_full_dot) + UB(1:1) = ubound(SrcMiscData%U_full_dot) if (.not. allocated(DstMiscData%U_full_dot)) then allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3832,8 +3886,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_dot = SrcMiscData%U_full_dot end if if (allocated(SrcMiscData%U_full_dotdot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dotdot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_dotdot, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%U_full_dotdot) + UB(1:1) = ubound(SrcMiscData%U_full_dotdot) if (.not. allocated(DstMiscData%U_full_dotdot)) then allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3844,8 +3898,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot end if if (allocated(SrcMiscData%U_full_elast)) then - LB(1:1) = lbound(SrcMiscData%U_full_elast, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_elast, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%U_full_elast) + UB(1:1) = ubound(SrcMiscData%U_full_elast) if (.not. allocated(DstMiscData%U_full_elast)) then allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3856,8 +3910,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_elast = SrcMiscData%U_full_elast end if if (allocated(SrcMiscData%U_red)) then - LB(1:1) = lbound(SrcMiscData%U_red, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_red, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%U_red) + UB(1:1) = ubound(SrcMiscData%U_red) if (.not. allocated(DstMiscData%U_red)) then allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3868,8 +3922,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_red = SrcMiscData%U_red end if if (allocated(SrcMiscData%x_full)) then - LB(1:1) = lbound(SrcMiscData%x_full, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%x_full, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%x_full) + UB(1:1) = ubound(SrcMiscData%x_full) if (.not. allocated(DstMiscData%x_full)) then allocate(DstMiscData%x_full(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3880,8 +3934,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%x_full = SrcMiscData%x_full end if if (allocated(SrcMiscData%FC_unit)) then - LB(1:1) = lbound(SrcMiscData%FC_unit, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FC_unit, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FC_unit) + UB(1:1) = ubound(SrcMiscData%FC_unit) if (.not. allocated(DstMiscData%FC_unit)) then allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3892,8 +3946,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FC_unit = SrcMiscData%FC_unit end if if (allocated(SrcMiscData%SDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%SDWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SDWrOutput, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SDWrOutput) + UB(1:1) = ubound(SrcMiscData%SDWrOutput) if (.not. allocated(DstMiscData%SDWrOutput)) then allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3904,8 +3958,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput end if if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3918,8 +3972,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%Decimat = SrcMiscData%Decimat if (allocated(SrcMiscData%Fext)) then - LB(1:1) = lbound(SrcMiscData%Fext, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Fext, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Fext) + UB(1:1) = ubound(SrcMiscData%Fext) if (.not. allocated(DstMiscData%Fext)) then allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3930,8 +3984,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Fext = SrcMiscData%Fext end if if (allocated(SrcMiscData%Fext_red)) then - LB(1:1) = lbound(SrcMiscData%Fext_red, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Fext_red, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Fext_red) + UB(1:1) = ubound(SrcMiscData%Fext_red) if (.not. allocated(DstMiscData%Fext_red)) then allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3942,8 +3996,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Fext_red = SrcMiscData%Fext_red end if if (allocated(SrcMiscData%FG)) then - LB(1:1) = lbound(SrcMiscData%FG, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FG, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FG) + UB(1:1) = ubound(SrcMiscData%FG) if (.not. allocated(DstMiscData%FG)) then allocate(DstMiscData%FG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3954,8 +4008,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FG = SrcMiscData%FG end if if (allocated(SrcMiscData%UL_SIM)) then - LB(1:1) = lbound(SrcMiscData%UL_SIM, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_SIM, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UL_SIM) + UB(1:1) = ubound(SrcMiscData%UL_SIM) if (.not. allocated(DstMiscData%UL_SIM)) then allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3966,8 +4020,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL_SIM = SrcMiscData%UL_SIM end if if (allocated(SrcMiscData%UL_0m)) then - LB(1:1) = lbound(SrcMiscData%UL_0m, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_0m, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%UL_0m) + UB(1:1) = ubound(SrcMiscData%UL_0m) if (.not. allocated(DstMiscData%UL_0m)) then allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4126,7 +4180,7 @@ subroutine SD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 4dec1e70f8..0dae968b1b 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -361,14 +361,14 @@ subroutine SC_DX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_DX_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%toSC)) then - LB(1:1) = lbound(SrcInputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%toSC, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) if (.not. associated(DstInputData%toSC)) then allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -416,7 +416,7 @@ subroutine SC_DX_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_DX_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -479,7 +479,7 @@ SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSC_Len = SIZE(InputData%toSC) IF (InputData%C_obj%toSC_Len > 0) & - InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1, kind=B8Ki))) + InputData%C_obj%toSC = C_LOC(InputData%toSC(lbound(InputData%toSC,1))) END IF END IF END SUBROUTINE @@ -490,14 +490,14 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_DX_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%fromSC)) then - LB(1:1) = lbound(SrcOutputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) if (.not. associated(DstOutputData%fromSC)) then allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -511,8 +511,8 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%fromSC = SrcOutputData%fromSC end if if (associated(SrcOutputData%fromSCglob)) then - LB(1:1) = lbound(SrcOutputData%fromSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%fromSCglob, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) if (.not. associated(DstOutputData%fromSCglob)) then allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -567,7 +567,7 @@ subroutine SC_DX_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_DX_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -644,7 +644,7 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) IF (OutputData%C_obj%fromSC_Len > 0) & - OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1, kind=B8Ki))) + OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(lbound(OutputData%fromSC,1))) END IF END IF @@ -656,7 +656,7 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) IF (OutputData%C_obj%fromSCglob_Len > 0) & - OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1, kind=B8Ki))) + OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(lbound(OutputData%fromSCglob,1))) END IF END IF END SUBROUTINE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 926f49ab60..241ba3fa3f 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -393,7 +393,7 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SC_CopyParam' @@ -420,8 +420,8 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumParamTurbine = SrcParamData%NumParamTurbine DstParamData%C_obj%NumParamTurbine = SrcParamData%C_obj%NumParamTurbine if (associated(SrcParamData%ParamGlobal)) then - LB(1:1) = lbound(SrcParamData%ParamGlobal, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ParamGlobal, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ParamGlobal) + UB(1:1) = ubound(SrcParamData%ParamGlobal) if (.not. associated(DstParamData%ParamGlobal)) then allocate(DstParamData%ParamGlobal(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -435,8 +435,8 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ParamGlobal = SrcParamData%ParamGlobal end if if (associated(SrcParamData%ParamTurbine)) then - LB(1:1) = lbound(SrcParamData%ParamTurbine, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ParamTurbine, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ParamTurbine) + UB(1:1) = ubound(SrcParamData%ParamTurbine) if (.not. associated(DstParamData%ParamTurbine)) then allocate(DstParamData%ParamTurbine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -507,7 +507,7 @@ subroutine SC_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -625,7 +625,7 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%ParamGlobal_Len = SIZE(ParamData%ParamGlobal) IF (ParamData%C_obj%ParamGlobal_Len > 0) & - ParamData%C_obj%ParamGlobal = C_LOC(ParamData%ParamGlobal(LBOUND(ParamData%ParamGlobal,1, kind=B8Ki))) + ParamData%C_obj%ParamGlobal = C_LOC(ParamData%ParamGlobal(lbound(ParamData%ParamGlobal,1))) END IF END IF @@ -637,7 +637,7 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%ParamTurbine_Len = SIZE(ParamData%ParamTurbine) IF (ParamData%C_obj%ParamTurbine_Len > 0) & - ParamData%C_obj%ParamTurbine = C_LOC(ParamData%ParamTurbine(LBOUND(ParamData%ParamTurbine,1, kind=B8Ki))) + ParamData%C_obj%ParamTurbine = C_LOC(ParamData%ParamTurbine(lbound(ParamData%ParamTurbine,1))) END IF END IF END SUBROUTINE @@ -648,14 +648,14 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcDiscStateData%Global)) then - LB(1:1) = lbound(SrcDiscStateData%Global, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Global, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Global) + UB(1:1) = ubound(SrcDiscStateData%Global) if (.not. associated(DstDiscStateData%Global)) then allocate(DstDiscStateData%Global(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -669,8 +669,8 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Global = SrcDiscStateData%Global end if if (associated(SrcDiscStateData%Turbine)) then - LB(1:1) = lbound(SrcDiscStateData%Turbine, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Turbine, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Turbine) + UB(1:1) = ubound(SrcDiscStateData%Turbine) if (.not. associated(DstDiscStateData%Turbine)) then allocate(DstDiscStateData%Turbine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -725,7 +725,7 @@ subroutine SC_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackDiscState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -802,7 +802,7 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) ELSE DiscStateData%C_obj%Global_Len = SIZE(DiscStateData%Global) IF (DiscStateData%C_obj%Global_Len > 0) & - DiscStateData%C_obj%Global = C_LOC(DiscStateData%Global(LBOUND(DiscStateData%Global,1, kind=B8Ki))) + DiscStateData%C_obj%Global = C_LOC(DiscStateData%Global(lbound(DiscStateData%Global,1))) END IF END IF @@ -814,7 +814,7 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) ELSE DiscStateData%C_obj%Turbine_Len = SIZE(DiscStateData%Turbine) IF (DiscStateData%C_obj%Turbine_Len > 0) & - DiscStateData%C_obj%Turbine = C_LOC(DiscStateData%Turbine(LBOUND(DiscStateData%Turbine,1, kind=B8Ki))) + DiscStateData%C_obj%Turbine = C_LOC(DiscStateData%Turbine(lbound(DiscStateData%Turbine,1))) END IF END IF END SUBROUTINE @@ -1145,14 +1145,14 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%toSCglob)) then - LB(1:1) = lbound(SrcInputData%toSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%toSCglob, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%toSCglob) + UB(1:1) = ubound(SrcInputData%toSCglob) if (.not. associated(DstInputData%toSCglob)) then allocate(DstInputData%toSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1166,8 +1166,8 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%toSCglob = SrcInputData%toSCglob end if if (associated(SrcInputData%toSC)) then - LB(1:1) = lbound(SrcInputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%toSC, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) if (.not. associated(DstInputData%toSC)) then allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1222,7 +1222,7 @@ subroutine SC_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1299,7 +1299,7 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSCglob_Len = SIZE(InputData%toSCglob) IF (InputData%C_obj%toSCglob_Len > 0) & - InputData%C_obj%toSCglob = C_LOC(InputData%toSCglob(LBOUND(InputData%toSCglob,1, kind=B8Ki))) + InputData%C_obj%toSCglob = C_LOC(InputData%toSCglob(lbound(InputData%toSCglob,1))) END IF END IF @@ -1311,7 +1311,7 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSC_Len = SIZE(InputData%toSC) IF (InputData%C_obj%toSC_Len > 0) & - InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1, kind=B8Ki))) + InputData%C_obj%toSC = C_LOC(InputData%toSC(lbound(InputData%toSC,1))) END IF END IF END SUBROUTINE @@ -1322,14 +1322,14 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%fromSCglob)) then - LB(1:1) = lbound(SrcOutputData%fromSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%fromSCglob, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) if (.not. associated(DstOutputData%fromSCglob)) then allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1343,8 +1343,8 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%fromSCglob = SrcOutputData%fromSCglob end if if (associated(SrcOutputData%fromSC)) then - LB(1:1) = lbound(SrcOutputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) if (.not. associated(DstOutputData%fromSC)) then allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1399,7 +1399,7 @@ subroutine SC_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1476,7 +1476,7 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) IF (OutputData%C_obj%fromSCglob_Len > 0) & - OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1, kind=B8Ki))) + OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(lbound(OutputData%fromSCglob,1))) END IF END IF @@ -1488,7 +1488,7 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) IF (OutputData%C_obj%fromSC_Len > 0) & - OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1, kind=B8Ki))) + OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(lbound(OutputData%fromSC,1))) END IF END IF END SUBROUTINE diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 6a373bd9d3..455ca50cfc 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -484,15 +484,15 @@ subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -503,8 +503,8 @@ subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -553,7 +553,7 @@ subroutine WD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -606,14 +606,14 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%xhat_plane)) then - LB(1:2) = lbound(SrcDiscStateData%xhat_plane, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%xhat_plane, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%xhat_plane) + UB(1:2) = ubound(SrcDiscStateData%xhat_plane) if (.not. allocated(DstDiscStateData%xhat_plane)) then allocate(DstDiscStateData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -624,8 +624,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane end if if (allocated(SrcDiscStateData%YawErr_filt)) then - LB(1:1) = lbound(SrcDiscStateData%YawErr_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%YawErr_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%YawErr_filt) + UB(1:1) = ubound(SrcDiscStateData%YawErr_filt) if (.not. allocated(DstDiscStateData%YawErr_filt)) then allocate(DstDiscStateData%YawErr_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -638,8 +638,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt if (allocated(SrcDiscStateData%V_plane_filt)) then - LB(1:2) = lbound(SrcDiscStateData%V_plane_filt, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%V_plane_filt, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%V_plane_filt) + UB(1:2) = ubound(SrcDiscStateData%V_plane_filt) if (.not. allocated(DstDiscStateData%V_plane_filt)) then allocate(DstDiscStateData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -650,8 +650,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt end if if (allocated(SrcDiscStateData%p_plane)) then - LB(1:2) = lbound(SrcDiscStateData%p_plane, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%p_plane, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%p_plane) + UB(1:2) = ubound(SrcDiscStateData%p_plane) if (.not. allocated(DstDiscStateData%p_plane)) then allocate(DstDiscStateData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -662,8 +662,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%p_plane = SrcDiscStateData%p_plane end if if (allocated(SrcDiscStateData%x_plane)) then - LB(1:1) = lbound(SrcDiscStateData%x_plane, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%x_plane, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%x_plane) + UB(1:1) = ubound(SrcDiscStateData%x_plane) if (.not. allocated(DstDiscStateData%x_plane)) then allocate(DstDiscStateData%x_plane(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -674,8 +674,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%x_plane = SrcDiscStateData%x_plane end if if (allocated(SrcDiscStateData%Vx_wake)) then - LB(1:2) = lbound(SrcDiscStateData%Vx_wake, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Vx_wake, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Vx_wake) + UB(1:2) = ubound(SrcDiscStateData%Vx_wake) if (.not. allocated(DstDiscStateData%Vx_wake)) then allocate(DstDiscStateData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -686,8 +686,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake end if if (allocated(SrcDiscStateData%Vr_wake)) then - LB(1:2) = lbound(SrcDiscStateData%Vr_wake, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Vr_wake, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Vr_wake) + UB(1:2) = ubound(SrcDiscStateData%Vr_wake) if (.not. allocated(DstDiscStateData%Vr_wake)) then allocate(DstDiscStateData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -698,8 +698,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake end if if (allocated(SrcDiscStateData%Vx_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vx_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%Vx_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%Vx_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vx_wake2) if (.not. allocated(DstDiscStateData%Vx_wake2)) then allocate(DstDiscStateData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -710,8 +710,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 end if if (allocated(SrcDiscStateData%Vy_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vy_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%Vy_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%Vy_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vy_wake2) if (.not. allocated(DstDiscStateData%Vy_wake2)) then allocate(DstDiscStateData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -722,8 +722,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 end if if (allocated(SrcDiscStateData%Vz_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vz_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%Vz_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%Vz_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vz_wake2) if (.not. allocated(DstDiscStateData%Vz_wake2)) then allocate(DstDiscStateData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -734,8 +734,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 end if if (allocated(SrcDiscStateData%Vx_wind_disk_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt) + UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt) if (.not. allocated(DstDiscStateData%Vx_wind_disk_filt)) then allocate(DstDiscStateData%Vx_wind_disk_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -746,8 +746,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt end if if (allocated(SrcDiscStateData%TI_amb_filt)) then - LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt) + UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt) if (.not. allocated(DstDiscStateData%TI_amb_filt)) then allocate(DstDiscStateData%TI_amb_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -758,8 +758,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt end if if (allocated(SrcDiscStateData%D_rotor_filt)) then - LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt) + UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt) if (.not. allocated(DstDiscStateData%D_rotor_filt)) then allocate(DstDiscStateData%D_rotor_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -771,8 +771,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt if (allocated(SrcDiscStateData%Ct_azavg_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt) if (.not. allocated(DstDiscStateData%Ct_azavg_filt)) then allocate(DstDiscStateData%Ct_azavg_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -783,8 +783,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt end if if (allocated(SrcDiscStateData%Cq_azavg_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt) if (.not. allocated(DstDiscStateData%Cq_azavg_filt)) then allocate(DstDiscStateData%Cq_azavg_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -880,7 +880,7 @@ subroutine WD_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackDiscState' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -986,14 +986,14 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%dvtdr)) then - LB(1:1) = lbound(SrcMiscData%dvtdr, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%dvtdr, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%dvtdr) + UB(1:1) = ubound(SrcMiscData%dvtdr) if (.not. allocated(DstMiscData%dvtdr)) then allocate(DstMiscData%dvtdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1004,8 +1004,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvtdr = SrcMiscData%dvtdr end if if (allocated(SrcMiscData%vt_tot)) then - LB(1:2) = lbound(SrcMiscData%vt_tot, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%vt_tot, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%vt_tot) + UB(1:2) = ubound(SrcMiscData%vt_tot) if (.not. allocated(DstMiscData%vt_tot)) then allocate(DstMiscData%vt_tot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1016,8 +1016,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_tot = SrcMiscData%vt_tot end if if (allocated(SrcMiscData%vt_amb)) then - LB(1:2) = lbound(SrcMiscData%vt_amb, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%vt_amb, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%vt_amb) + UB(1:2) = ubound(SrcMiscData%vt_amb) if (.not. allocated(DstMiscData%vt_amb)) then allocate(DstMiscData%vt_amb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1028,8 +1028,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_amb = SrcMiscData%vt_amb end if if (allocated(SrcMiscData%vt_shr)) then - LB(1:2) = lbound(SrcMiscData%vt_shr, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%vt_shr, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%vt_shr) + UB(1:2) = ubound(SrcMiscData%vt_shr) if (.not. allocated(DstMiscData%vt_shr)) then allocate(DstMiscData%vt_shr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1040,8 +1040,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_shr = SrcMiscData%vt_shr end if if (allocated(SrcMiscData%vt_tot2)) then - LB(1:3) = lbound(SrcMiscData%vt_tot2, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%vt_tot2, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%vt_tot2) + UB(1:3) = ubound(SrcMiscData%vt_tot2) if (.not. allocated(DstMiscData%vt_tot2)) then allocate(DstMiscData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1052,8 +1052,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 end if if (allocated(SrcMiscData%vt_amb2)) then - LB(1:3) = lbound(SrcMiscData%vt_amb2, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%vt_amb2, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%vt_amb2) + UB(1:3) = ubound(SrcMiscData%vt_amb2) if (.not. allocated(DstMiscData%vt_amb2)) then allocate(DstMiscData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1064,8 +1064,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 end if if (allocated(SrcMiscData%vt_shr2)) then - LB(1:3) = lbound(SrcMiscData%vt_shr2, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%vt_shr2, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%vt_shr2) + UB(1:3) = ubound(SrcMiscData%vt_shr2) if (.not. allocated(DstMiscData%vt_shr2)) then allocate(DstMiscData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1076,8 +1076,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 end if if (allocated(SrcMiscData%dvx_dy)) then - LB(1:3) = lbound(SrcMiscData%dvx_dy, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%dvx_dy, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%dvx_dy) + UB(1:3) = ubound(SrcMiscData%dvx_dy) if (.not. allocated(DstMiscData%dvx_dy)) then allocate(DstMiscData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1088,8 +1088,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvx_dy = SrcMiscData%dvx_dy end if if (allocated(SrcMiscData%dvx_dz)) then - LB(1:3) = lbound(SrcMiscData%dvx_dz, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%dvx_dz, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%dvx_dz) + UB(1:3) = ubound(SrcMiscData%dvx_dz) if (.not. allocated(DstMiscData%dvx_dz)) then allocate(DstMiscData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1100,8 +1100,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvx_dz = SrcMiscData%dvx_dz end if if (allocated(SrcMiscData%nu_dvx_dy)) then - LB(1:2) = lbound(SrcMiscData%nu_dvx_dy, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%nu_dvx_dy, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%nu_dvx_dy) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dy) if (.not. allocated(DstMiscData%nu_dvx_dy)) then allocate(DstMiscData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1112,8 +1112,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy end if if (allocated(SrcMiscData%nu_dvx_dz)) then - LB(1:2) = lbound(SrcMiscData%nu_dvx_dz, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%nu_dvx_dz, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%nu_dvx_dz) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dz) if (.not. allocated(DstMiscData%nu_dvx_dz)) then allocate(DstMiscData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1124,8 +1124,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz end if if (allocated(SrcMiscData%dnuvx_dy)) then - LB(1:2) = lbound(SrcMiscData%dnuvx_dy, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dnuvx_dy, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%dnuvx_dy) + UB(1:2) = ubound(SrcMiscData%dnuvx_dy) if (.not. allocated(DstMiscData%dnuvx_dy)) then allocate(DstMiscData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1136,8 +1136,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy end if if (allocated(SrcMiscData%dnuvx_dz)) then - LB(1:2) = lbound(SrcMiscData%dnuvx_dz, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dnuvx_dz, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%dnuvx_dz) + UB(1:2) = ubound(SrcMiscData%dnuvx_dz) if (.not. allocated(DstMiscData%dnuvx_dz)) then allocate(DstMiscData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1148,8 +1148,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz end if if (allocated(SrcMiscData%a)) then - LB(1:1) = lbound(SrcMiscData%a, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%a, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%a) + UB(1:1) = ubound(SrcMiscData%a) if (.not. allocated(DstMiscData%a)) then allocate(DstMiscData%a(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1160,8 +1160,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%a = SrcMiscData%a end if if (allocated(SrcMiscData%b)) then - LB(1:1) = lbound(SrcMiscData%b, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%b, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%b) + UB(1:1) = ubound(SrcMiscData%b) if (.not. allocated(DstMiscData%b)) then allocate(DstMiscData%b(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1172,8 +1172,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%b = SrcMiscData%b end if if (allocated(SrcMiscData%c)) then - LB(1:1) = lbound(SrcMiscData%c, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%c, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%c) + UB(1:1) = ubound(SrcMiscData%c) if (.not. allocated(DstMiscData%c)) then allocate(DstMiscData%c(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1184,8 +1184,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%c = SrcMiscData%c end if if (allocated(SrcMiscData%d)) then - LB(1:1) = lbound(SrcMiscData%d, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%d, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%d) + UB(1:1) = ubound(SrcMiscData%d) if (.not. allocated(DstMiscData%d)) then allocate(DstMiscData%d(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1196,8 +1196,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%d = SrcMiscData%d end if if (allocated(SrcMiscData%r_wake)) then - LB(1:1) = lbound(SrcMiscData%r_wake, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%r_wake, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%r_wake) + UB(1:1) = ubound(SrcMiscData%r_wake) if (.not. allocated(DstMiscData%r_wake)) then allocate(DstMiscData%r_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1208,8 +1208,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_wake = SrcMiscData%r_wake end if if (allocated(SrcMiscData%Vx_high)) then - LB(1:1) = lbound(SrcMiscData%Vx_high, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Vx_high, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Vx_high) + UB(1:1) = ubound(SrcMiscData%Vx_high) if (.not. allocated(DstMiscData%Vx_high)) then allocate(DstMiscData%Vx_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1220,8 +1220,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vx_high = SrcMiscData%Vx_high end if if (allocated(SrcMiscData%Vx_polar)) then - LB(1:1) = lbound(SrcMiscData%Vx_polar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Vx_polar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Vx_polar) + UB(1:1) = ubound(SrcMiscData%Vx_polar) if (.not. allocated(DstMiscData%Vx_polar)) then allocate(DstMiscData%Vx_polar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1232,8 +1232,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vx_polar = SrcMiscData%Vx_polar end if if (allocated(SrcMiscData%Vt_wake)) then - LB(1:1) = lbound(SrcMiscData%Vt_wake, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Vt_wake, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Vt_wake) + UB(1:1) = ubound(SrcMiscData%Vt_wake) if (.not. allocated(DstMiscData%Vt_wake)) then allocate(DstMiscData%Vt_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1354,7 +1354,7 @@ subroutine WD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackMisc' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1389,7 +1389,7 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyParam' ErrStat = ErrID_None @@ -1399,8 +1399,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumRadii = SrcParamData%NumRadii DstParamData%dr = SrcParamData%dr if (allocated(SrcParamData%r)) then - LB(1:1) = lbound(SrcParamData%r, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%r, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) if (.not. allocated(DstParamData%r)) then allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1411,8 +1411,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%r = SrcParamData%r end if if (allocated(SrcParamData%y)) then - LB(1:1) = lbound(SrcParamData%y, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%y, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) if (.not. allocated(DstParamData%y)) then allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1423,8 +1423,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%y = SrcParamData%y end if if (allocated(SrcParamData%z)) then - LB(1:1) = lbound(SrcParamData%z, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%z, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) if (.not. allocated(DstParamData%z)) then allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1555,7 +1555,7 @@ subroutine WD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1615,7 +1615,7 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyInput' ErrStat = ErrID_None @@ -1626,8 +1626,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%chi_skew = SrcInputData%chi_skew DstInputData%p_hub = SrcInputData%p_hub if (allocated(SrcInputData%V_plane)) then - LB(1:2) = lbound(SrcInputData%V_plane, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%V_plane, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%V_plane) + UB(1:2) = ubound(SrcInputData%V_plane) if (.not. allocated(DstInputData%V_plane)) then allocate(DstInputData%V_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1642,8 +1642,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%D_rotor = SrcInputData%D_rotor DstInputData%Vx_rel_disk = SrcInputData%Vx_rel_disk if (allocated(SrcInputData%Ct_azavg)) then - LB(1:1) = lbound(SrcInputData%Ct_azavg, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Ct_azavg, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Ct_azavg) + UB(1:1) = ubound(SrcInputData%Ct_azavg) if (.not. allocated(DstInputData%Ct_azavg)) then allocate(DstInputData%Ct_azavg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1654,8 +1654,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Ct_azavg = SrcInputData%Ct_azavg end if if (allocated(SrcInputData%Cq_azavg)) then - LB(1:1) = lbound(SrcInputData%Cq_azavg, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Cq_azavg, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Cq_azavg) + UB(1:1) = ubound(SrcInputData%Cq_azavg) if (.not. allocated(DstInputData%Cq_azavg)) then allocate(DstInputData%Cq_azavg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1709,7 +1709,7 @@ subroutine WD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1733,14 +1733,14 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%xhat_plane)) then - LB(1:2) = lbound(SrcOutputData%xhat_plane, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%xhat_plane, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%xhat_plane) + UB(1:2) = ubound(SrcOutputData%xhat_plane) if (.not. allocated(DstOutputData%xhat_plane)) then allocate(DstOutputData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1751,8 +1751,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%xhat_plane = SrcOutputData%xhat_plane end if if (allocated(SrcOutputData%p_plane)) then - LB(1:2) = lbound(SrcOutputData%p_plane, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%p_plane, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%p_plane) + UB(1:2) = ubound(SrcOutputData%p_plane) if (.not. allocated(DstOutputData%p_plane)) then allocate(DstOutputData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1763,8 +1763,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%p_plane = SrcOutputData%p_plane end if if (allocated(SrcOutputData%Vx_wake)) then - LB(1:2) = lbound(SrcOutputData%Vx_wake, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Vx_wake, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Vx_wake) + UB(1:2) = ubound(SrcOutputData%Vx_wake) if (.not. allocated(DstOutputData%Vx_wake)) then allocate(DstOutputData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1775,8 +1775,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vx_wake = SrcOutputData%Vx_wake end if if (allocated(SrcOutputData%Vr_wake)) then - LB(1:2) = lbound(SrcOutputData%Vr_wake, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Vr_wake, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Vr_wake) + UB(1:2) = ubound(SrcOutputData%Vr_wake) if (.not. allocated(DstOutputData%Vr_wake)) then allocate(DstOutputData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1787,8 +1787,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vr_wake = SrcOutputData%Vr_wake end if if (allocated(SrcOutputData%Vx_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vx_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%Vx_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%Vx_wake2) + UB(1:3) = ubound(SrcOutputData%Vx_wake2) if (.not. allocated(DstOutputData%Vx_wake2)) then allocate(DstOutputData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1799,8 +1799,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 end if if (allocated(SrcOutputData%Vy_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vy_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%Vy_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%Vy_wake2) + UB(1:3) = ubound(SrcOutputData%Vy_wake2) if (.not. allocated(DstOutputData%Vy_wake2)) then allocate(DstOutputData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1811,8 +1811,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 end if if (allocated(SrcOutputData%Vz_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vz_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%Vz_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%Vz_wake2) + UB(1:3) = ubound(SrcOutputData%Vz_wake2) if (.not. allocated(DstOutputData%Vz_wake2)) then allocate(DstOutputData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1823,8 +1823,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 end if if (allocated(SrcOutputData%D_wake)) then - LB(1:1) = lbound(SrcOutputData%D_wake, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%D_wake, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%D_wake) + UB(1:1) = ubound(SrcOutputData%D_wake) if (.not. allocated(DstOutputData%D_wake)) then allocate(DstOutputData%D_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1835,8 +1835,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%D_wake = SrcOutputData%D_wake end if if (allocated(SrcOutputData%x_plane)) then - LB(1:1) = lbound(SrcOutputData%x_plane, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%x_plane, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%x_plane) + UB(1:1) = ubound(SrcOutputData%x_plane) if (.not. allocated(DstOutputData%x_plane)) then allocate(DstOutputData%x_plane(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1847,8 +1847,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%x_plane = SrcOutputData%x_plane end if if (allocated(SrcOutputData%WAT_k)) then - LB(1:3) = lbound(SrcOutputData%WAT_k, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%WAT_k, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%WAT_k) + UB(1:3) = ubound(SrcOutputData%WAT_k) if (.not. allocated(DstOutputData%WAT_k)) then allocate(DstOutputData%WAT_k(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1921,7 +1921,7 @@ subroutine WD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackOutput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return diff --git a/vs-build/FAST-farm/FAST-Farm.vfproj b/vs-build/FAST-farm/FAST-Farm.vfproj index e7c3152f30..5f1d3153bd 100644 --- a/vs-build/FAST-farm/FAST-Farm.vfproj +++ b/vs-build/FAST-farm/FAST-Farm.vfproj @@ -25,7 +25,7 @@ - + @@ -35,7 +35,7 @@ - + @@ -55,7 +55,7 @@ - + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 9dd24a3ddc..4d87a023a7 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -23,7 +23,7 @@ - + @@ -32,7 +32,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -68,7 +68,7 @@ - + @@ -86,7 +86,7 @@ - + @@ -104,7 +104,7 @@ - + @@ -122,7 +122,7 @@ - + diff --git a/vs-build/MAPlib/MAP_dll.vcxproj b/vs-build/MAPlib/MAP_dll.vcxproj index 022b29cb38..db43418ded 100644 --- a/vs-build/MAPlib/MAP_dll.vcxproj +++ b/vs-build/MAPlib/MAP_dll.vcxproj @@ -1,4 +1,4 @@ - + @@ -75,6 +75,7 @@ MAP_$(PlatformName) true ..\..\build\bin\ +$(PlatformName)\$(ConfigurationName) false @@ -85,6 +86,7 @@ MAP_$(PlatformName) false ..\..\build\bin\ +$(PlatformName)\$(ConfigurationName) From a866b343fa42850c8b28cdc5a7fd83c1ae256b4e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 10 Dec 2024 19:24:02 +0000 Subject: [PATCH 294/319] Fix single precision compile --- modules/seastate/src/SeaState.f90 | 2 +- modules/subdyn/src/SubDyn.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 5aedb424d9..d5c05ea1d4 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -486,7 +486,7 @@ subroutine SeaSt_InitVars(Vars, u, p, x, y, m, InitOut, InputFileData, Linearize ! Extended input call MV_AddVar(Vars%u, "WaveElev0", FieldScalar, DatLoc(SeaSt_u_WaveElev0), & Flags=VF_ExtLin, & - Perturb=0.02_R8Ki * Pi / 180.0_R8Ki * max(1.0_R8Ki, p%WaveField%WtrDpth), & + Perturb=0.02_R8Ki * Pi / 180.0_R8Ki * max(1.0_R8Ki, real(p%WaveField%WtrDpth, R8Ki)), & LinNames=['Extended input: wave elevation at platform ref point, m']) !---------------------------------------------------------------------------- diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index d8474282dc..2fba9a0ebc 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -3258,7 +3258,7 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global real(R8Ki), dimension(3,3) :: Rg2b ! Rotation matrix global 2 body coordinates - real(ReKi), dimension(3,3) :: orientation ! Nodal orientation matrix + real(R8Ki), dimension(3,3) :: orientation ! Nodal orientation matrix INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None From 8e79b8ffd20a4740b6dc281879fe679a945ceb42 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 10 Dec 2024 19:24:21 +0000 Subject: [PATCH 295/319] Fix duplicated allocation in BeamDyn --- modules/beamdyn/src/BeamDyn.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index e006498846..d3dbcffd8d 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -1655,7 +1655,6 @@ subroutine Init_MiscVars( p, u, y, m, ErrStat, ErrMsg ) ! Array for storing the position information for the quadrature points. CALL AllocAry(m%qp%uuu, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uuu displacement at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%uup, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry(m%qp%uup, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%vvv, p%dof_node ,p%nqp,p%elem_total, 'm%qp%vvv velocity at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%vvp, p%dof_node ,p%nqp,p%elem_total, 'm%qp%vvp velocity prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%aaa, p%dof_node ,p%nqp,p%elem_total, 'm%qp%aaa acceleration at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) From ce519b7b11cd408ff68d108446771baf0cb809f3 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 16 Dec 2024 08:21:49 -0700 Subject: [PATCH 296/319] Add added mass and inertia columns to function that reads AeroDyn blade input file --- modules/aerodyn/src/AeroDyn_IO.f90 | 34 ++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 80a51b31bf..b43235901d 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -1651,19 +1651,49 @@ SUBROUTINE ConvertLineToCols(Line, i, Indx, BladeKInputFileData, ErrStat, ErrMsg c=Indx(8) IF (c > 0) THEN - READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCb(I) + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%t_c(I) END IF c=Indx(9) IF (c > 0) THEN - READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCenBn(I) + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCb(I) END IF c=Indx(10) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCenBn(I) + END IF + + c=Indx(11) IF (c > 0) THEN READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCenBt(I) END IF + c=Indx(12) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCpn(I) + END IF + + c=Indx(13) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCpt(I) + END IF + + c=Indx(14) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCan(I) + END IF + + c=Indx(15) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCat(I) + END IF + + c=Indx(16) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCam(I) + END IF + IF (ANY(IOS /= 0)) THEN CALL SetErrStat(ErrID_Fatal, "Unable to read numeric data from all columns in the table on row "//trim(num2lstr(i))//".", ErrStat, ErrMsg, RoutineName) RETURN From e86526f57915bd13c6013eca3a50ce8f9f3d8496 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 16 Dec 2024 13:11:51 -0700 Subject: [PATCH 297/319] Update regression tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 331988f451..eacdd3bb44 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 331988f45177d63d321cec844d16ea23b994242a +Subproject commit eacdd3bb44254936d273f42bbf49d9ea008d4355 From 460428cfac532c8c082f4cdcb0d626aa65689e8b Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 16 Dec 2024 13:29:02 -0700 Subject: [PATCH 298/319] Update regression tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index eacdd3bb44..1e16eae75f 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit eacdd3bb44254936d273f42bbf49d9ea008d4355 +Subproject commit 1e16eae75f618342fbc12e4e88bda9a461d91b0e From 0dfd571802bb715280df40d5cb9dfdff947735fb Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 16 Dec 2024 14:15:55 -0700 Subject: [PATCH 299/319] Update regression tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 1e16eae75f..8457e7ec5a 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 1e16eae75f618342fbc12e4e88bda9a461d91b0e +Subproject commit 8457e7ec5afbcc452487c65ceb0f6bc85edb8bb5 From 78fc82490941eca9d694b7f09cef022330ebac43 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 23 Dec 2024 12:29:09 -0700 Subject: [PATCH 300/319] Comment out negative time error in SetTimeIndex subroutine --- modules/seastate/src/SeaSt_WaveField.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index c0117403da..00392f201c 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -836,10 +836,10 @@ subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, Er isopc = -1.0 Indx_Lo = 0 Indx_Hi = 0 - if ( Time < 0.0_DbKi ) then - CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeIndex') !error out if time is outside the lower bounds - RETURN - end if + !if ( Time < 0.0_DbKi ) then + ! CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeIndex') !error out if time is outside the lower bounds + ! RETURN + !end if ! if there are no timesteps, don't proceed if (EqualRealNos(deltaT,0.0_ReKi) .or. deltaT < 0.0_ReKi) return; @@ -850,7 +850,7 @@ subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, Er ! wrap it back to index 0, if Indx_Lo = 11 we want to wrap back to index 1. Tmp = real( (Time/ real(deltaT,DbKi)) ,ReKi) - Tmp = MOD(Tmp,real((nMax), ReKi)) + Tmp = MODULO(Tmp,real((nMax), ReKi)) Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 From 0832bc62970f2f676106663600afbab39451c8c2 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 23 Dec 2024 14:12:59 -0700 Subject: [PATCH 301/319] Update regression tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 8457e7ec5a..9e337b3b04 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 8457e7ec5afbcc452487c65ceb0f6bc85edb8bb5 +Subproject commit 9e337b3b046bf9f14ecdfd6fb0f1bd7cbc617df6 From 962a54c203f62215804cc0f83968bcbd57f5051f Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 23 Dec 2024 17:47:31 -0700 Subject: [PATCH 302/319] Update regression tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 9e337b3b04..56fcb4bb63 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 9e337b3b046bf9f14ecdfd6fb0f1bd7cbc617df6 +Subproject commit 56fcb4bb6367e76c73f3a5af610f1a87780b3abf From c358186211d0ad7255d06eda6956e1c12d4d8855 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 23 Dec 2024 19:15:29 -0700 Subject: [PATCH 303/319] Update regression tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 56fcb4bb63..147158fe8d 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 56fcb4bb6367e76c73f3a5af610f1a87780b3abf +Subproject commit 147158fe8d48d69d4315391bdba52ba8cc20140a From 621edda91831c6a29c5946ac51a7418f163c9d7b Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 26 Dec 2024 16:53:31 -0700 Subject: [PATCH 304/319] Update regression tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 71a5adcc12..2cbf63b270 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 71a5adcc1246d48ef65f2341e1f894a64d47b459 +Subproject commit 2cbf63b270801ef47fb87717b570230ca84e72b8 From 32c06e002884ea694be7820708a7b36a5b81669c Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 26 Dec 2024 18:00:07 -0700 Subject: [PATCH 305/319] Update openfast_io for new added mass AeroDyn inputs --- openfast_io/openfast_io/FAST_reader.py | 5 ++++- openfast_io/openfast_io/FAST_writer.py | 17 ++++++++--------- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/openfast_io/openfast_io/FAST_reader.py b/openfast_io/openfast_io/FAST_reader.py index 72bf38087e..8e25898213 100644 --- a/openfast_io/openfast_io/FAST_reader.py +++ b/openfast_io/openfast_io/FAST_reader.py @@ -1039,7 +1039,6 @@ def read_AeroDyn(self): self.fst_vt['AeroDyn']['TwrShadow'] = int(f.readline().split()[0]) self.fst_vt['AeroDyn']['TwrAero'] = bool_read(f.readline().split()[0]) self.fst_vt['AeroDyn']['CavitCheck'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn']['Buoyancy'] = bool_read(f.readline().split()[0]) self.fst_vt['AeroDyn']['NacelleDrag'] = bool_read(f.readline().split()[0]) self.fst_vt['AeroDyn']['CompAA'] = bool_read(f.readline().split()[0]) self.fst_vt['AeroDyn']['AA_InputFile'] = f.readline().split()[0] @@ -1157,6 +1156,8 @@ def read_AeroDyn(self): self.fst_vt['AeroDyn']['TwrCd'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] self.fst_vt['AeroDyn']['TwrTI'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] self.fst_vt['AeroDyn']['TwrCb'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + self.fst_vt['AeroDyn']['TwrCp'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + self.fst_vt['AeroDyn']['TwrCa'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] for i in range(self.fst_vt['AeroDyn']['NumTwrNds']): data = [float(val) for val in f.readline().split()] self.fst_vt['AeroDyn']['TwrElev'][i] = data[0] @@ -1164,6 +1165,8 @@ def read_AeroDyn(self): self.fst_vt['AeroDyn']['TwrCd'][i] = data[2] self.fst_vt['AeroDyn']['TwrTI'][i] = data[3] self.fst_vt['AeroDyn']['TwrCb'][i] = data[4] + self.fst_vt['AeroDyn']['TwrCp'][i] = data[5] + self.fst_vt['AeroDyn']['TwrCa'][i] = data[6] # Outputs f.readline() diff --git a/openfast_io/openfast_io/FAST_writer.py b/openfast_io/openfast_io/FAST_writer.py index e993752f1e..30a61336aa 100644 --- a/openfast_io/openfast_io/FAST_writer.py +++ b/openfast_io/openfast_io/FAST_writer.py @@ -890,7 +890,6 @@ def write_AeroDyn(self): f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TwrShadow'], 'TwrShadow', '- Calculate tower influence on wind based on downstream tower shadow (switch) {0=none, 1=Powles model, 2=Eames model}\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TwrAero'], 'TwrAero', '- Calculate tower aerodynamic loads? (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['CavitCheck'], 'CavitCheck', '- Perform cavitation check? (flag) [UA_Mod must be 0 when CavitCheck=true]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['Buoyancy'], 'Buoyancy', '- Include buoyancy effects? (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NacelleDrag'], 'NacelleDrag', '- Include Nacelle Drag effects? (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['CompAA'], 'CompAA', '- Flag to compute AeroAcoustics calculation [used only when Wake_Mod = 1 or 2]\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['AA_InputFile'], 'AA_InputFile', '- AeroAcoustics input file [used only when CompAA=true]\n')) @@ -954,10 +953,10 @@ def write_AeroDyn(self): f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile1']+'"', 'ADBlFile(1)', '- Name of file containing distributed aerodynamic properties for Blade #1 (-)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile2']+'"', 'ADBlFile(2)', '- Name of file containing distributed aerodynamic properties for Blade #2 (-) [unused if NumBl < 2]\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile3']+'"', 'ADBlFile(3)', '- Name of file containing distributed aerodynamic properties for Blade #3 (-) [unused if NumBl < 3]\n')) - f.write('====== Hub Properties ============================================================================== [used only when Buoyancy=True]\n') + f.write('====== Hub Properties ============================================================================== [used only when MHK=1 or 2]\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['VolHub'], 'VolHub', '- Hub volume (m^3)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['HubCenBx'], 'HubCenBx', '- Hub center of buoyancy x direction offset (m)\n')) - f.write('====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True]\n') + f.write('====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2 or when NacelleDrag=True]\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['VolNac'], 'VolNac', '- Nacelle volume (m^3)\n')) f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn']['NacCenB'], dtype=str)), 'NacCenB', '- Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m)\n')) f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn']['NacArea'], dtype=str)), 'NacArea', '- Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2)\n')) @@ -966,12 +965,12 @@ def write_AeroDyn(self): f.write('====== Tail Fin Aerodynamics ========================================================================\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TFinAero'], 'TFinAero', '- Calculate tail fin aerodynamics model (flag)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['TFinFile']+'"', 'TFinFile', '- Input file for tail fin aerodynamics [used only when TFinAero=True]\n')) - f.write('====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True]\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NumTwrNds'], 'NumTwrNds', '- Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True]\n')) - f.write('TwrElev TwrDiam TwrCd TwrTI TwrCb !TwrTI used only when TwrShadow=2; TwrCb used only when Buoyancy=True\n') - f.write('(m) (m) (-) (-) (-)\n') - for TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb in zip(self.fst_vt['AeroDyn']['TwrElev'], self.fst_vt['AeroDyn']['TwrDiam'], self.fst_vt['AeroDyn']['TwrCd'], self.fst_vt['AeroDyn']['TwrTI'], self.fst_vt['AeroDyn']['TwrCb']): - f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} \n'.format(TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb)) + f.write('====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2]\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NumTwrNds'], 'NumTwrNds', '- Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2]\n')) + f.write('TwrElev TwrDiam TwrCd TwrTI TwrCb TwrCp TwrCa !TwrTI used only with TwrShadow=2, TwrCb/TwrCp/TwrCa used only with MHK=1 or 2\n') + f.write('(m) (m) (-) (-) (-) (-) (-)\n') + for TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb, TwrCp, TwrCa in zip(self.fst_vt['AeroDyn']['TwrElev'], self.fst_vt['AeroDyn']['TwrDiam'], self.fst_vt['AeroDyn']['TwrCd'], self.fst_vt['AeroDyn']['TwrTI'], self.fst_vt['AeroDyn']['TwrCb'], self.fst_vt['AeroDyn']['TwrCp'], self.fst_vt['AeroDyn']['TwrCa']): + f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} \n'.format(TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb, TwrCp, TwrCa)) f.write('====== Outputs ====================================================================================\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SumPrint'], 'SumPrint', '- Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag)\n')) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NBlOuts'], 'NBlOuts', '- Number of blade node outputs [0 - 9] (-)\n')) From 4c17e4d343b2e90da83f895ccf5dcca6d0dddd27 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Thu, 26 Dec 2024 19:09:51 -0700 Subject: [PATCH 306/319] Update openfast_io for new added mass AeroDyn blade inputs --- openfast_io/openfast_io/FAST_reader.py | 26 ++++++++++++++++++++++---- openfast_io/openfast_io/FAST_writer.py | 14 ++++++++++---- 2 files changed, 32 insertions(+), 8 deletions(-) diff --git a/openfast_io/openfast_io/FAST_reader.py b/openfast_io/openfast_io/FAST_reader.py index 8e25898213..626d25e819 100644 --- a/openfast_io/openfast_io/FAST_reader.py +++ b/openfast_io/openfast_io/FAST_reader.py @@ -1251,9 +1251,15 @@ def read_AeroDynBlade(self): self.fst_vt['AeroDynBlade']['BlTwist'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlChord'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlAFID'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['t_c'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlCb'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlCenBn'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlCenBt'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCpn'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCpt'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCan'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCat'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCam'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] for i in range(self.fst_vt['AeroDynBlade']['NumBlNds']): data = [float(val) for val in f.readline().split()] self.fst_vt['AeroDynBlade']['BlSpn'][i] = data[0] @@ -1263,14 +1269,26 @@ def read_AeroDynBlade(self): self.fst_vt['AeroDynBlade']['BlTwist'][i] = data[4] self.fst_vt['AeroDynBlade']['BlChord'][i] = data[5] self.fst_vt['AeroDynBlade']['BlAFID'][i] = data[6] - if len(data) == 9: - self.fst_vt['AeroDynBlade']['BlCb'][i] = data[7] - self.fst_vt['AeroDynBlade']['BlCenBn'][i] = data[8] - self.fst_vt['AeroDynBlade']['BlCenBt'][i] = data[9] + if len(data) == 16: + self.fst_vt['AeroDynBlade']['t_c'][i] = data[7] + self.fst_vt['AeroDynBlade']['BlCb'][i] = data[8] + self.fst_vt['AeroDynBlade']['BlCenBn'][i] = data[9] + self.fst_vt['AeroDynBlade']['BlCenBt'][i] = data[10] + self.fst_vt['AeroDynBlade']['BlCpn'][i] = data[11] + self.fst_vt['AeroDynBlade']['BlCpt'][i] = data[12] + self.fst_vt['AeroDynBlade']['BlCan'][i] = data[13] + self.fst_vt['AeroDynBlade']['BlCat'][i] = data[14] + self.fst_vt['AeroDynBlade']['BlCam'][i] = data[15] else: + self.fst_vt['AeroDynBlade']['t_c'][i] = 0.0 self.fst_vt['AeroDynBlade']['BlCb'][i] = 0.0 self.fst_vt['AeroDynBlade']['BlCenBn'][i] = 0.0 self.fst_vt['AeroDynBlade']['BlCenBt'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCpn'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCpt'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCan'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCat'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCam'][i] = 0.0 f.close() diff --git a/openfast_io/openfast_io/FAST_writer.py b/openfast_io/openfast_io/FAST_writer.py index 30a61336aa..184425eecc 100644 --- a/openfast_io/openfast_io/FAST_writer.py +++ b/openfast_io/openfast_io/FAST_writer.py @@ -1019,8 +1019,8 @@ def write_AeroDynBlade(self): f.write('Generated with OpenFAST_IO\n') f.write('====== Blade Properties =================================================================\n') f.write('{:<11d} {:<11} {:}'.format(self.fst_vt['AeroDynBlade']['NumBlNds'], 'NumBlNds', '- Number of blade nodes used in the analysis (-)\n')) - f.write(' BlSpn BlCrvAC BlSwpAC BlCrvAng BlTwist BlChord BlAFID BlCb BlCenBn BlCenBt\n') - f.write(' (m) (m) (m) (deg) (deg) (m) (-) (-) (m) (m)\n') + f.write(' BlSpn BlCrvAC BlSwpAC BlCrvAng BlTwist BlChord BlAFID t_c BlCb BlCenBn BlCenBt BlCpn BlCpt BlCan BlCat BlCam\n') + f.write(' (m) (m) (m) (deg) (deg) (m) (-) (-) (-) (m) (m) (-) (-) (-) (-) (-)\n') BlSpn = self.fst_vt['AeroDynBlade']['BlSpn'] BlCrvAC = self.fst_vt['AeroDynBlade']['BlCrvAC'] BlSwpAC = self.fst_vt['AeroDynBlade']['BlSwpAC'] @@ -1028,11 +1028,17 @@ def write_AeroDynBlade(self): BlTwist = self.fst_vt['AeroDynBlade']['BlTwist'] BlChord = self.fst_vt['AeroDynBlade']['BlChord'] BlAFID = self.fst_vt['AeroDynBlade']['BlAFID'] + t_c = self.fst_vt['AeroDynBlade']['t_c'] BlCb = self.fst_vt['AeroDynBlade']['BlCb'] BlCenBn = self.fst_vt['AeroDynBlade']['BlCenBn'] BlCenBt = self.fst_vt['AeroDynBlade']['BlCenBt'] - for Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, AFID, BlCb, BlCenBn, BlCenBt in zip(BlSpn, BlCrvAC, BlSwpAC, BlCrvAng, BlTwist, BlChord, BlAFID, BlCb, BlCenBn, BlCenBt): - f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 8d} {: 2.15e} {: 2.15e} {: 2.15e}\n'.format(Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, int(AFID), BlCb, BlCenBn, BlCenBt)) + BlCpn = self.fst_vt['AeroDynBlade']['BlCpn'] + BlCpt = self.fst_vt['AeroDynBlade']['BlCpt'] + BlCan = self.fst_vt['AeroDynBlade']['BlCan'] + BlCat = self.fst_vt['AeroDynBlade']['BlCat'] + BlCam = self.fst_vt['AeroDynBlade']['BlCam'] + for Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, AFID, t_c, BlCb, BlCenBn, BlCenBt, BlCpn, BlCpt, BlCan, BlCat, BlCam in zip(BlSpn, BlCrvAC, BlSwpAC, BlCrvAng, BlTwist, BlChord, BlAFID, t_c, BlCb, BlCenBn, BlCenBt, BlCpn, BlCpt, BlCan, BlCat, BlCam): + f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 8d} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e}\n'.format(Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, int(AFID), t_c, BlCb, BlCenBn, BlCenBt, BlCpn, BlCpt, BlCan, BlCat, BlCam)) f.flush() os.fsync(f) From aa3fa50d775b2e9cb2f604107693c91c9467c60e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 30 Dec 2024 20:37:06 +0000 Subject: [PATCH 307/319] Allow multiple ElastoDyn instances --- modules/beamdyn/src/BeamDyn.f90 | 13 +- modules/openfast-library/src/FAST_AeroMap.f90 | 53 +- modules/openfast-library/src/FAST_Funcs.f90 | 210 +- modules/openfast-library/src/FAST_Library.f90 | 13 +- modules/openfast-library/src/FAST_Mapping.f90 | 142 +- modules/openfast-library/src/FAST_ModGlue.f90 | 20 +- .../openfast-library/src/FAST_Registry.txt | 22 +- .../openfast-library/src/FAST_SS_Solver.f90 | 2167 ----------------- modules/openfast-library/src/FAST_SS_Subs.f90 | 323 --- .../openfast-library/src/FAST_SolverTC.f90 | 2 +- modules/openfast-library/src/FAST_Subs.f90 | 840 +++---- modules/openfast-library/src/FAST_Types.f90 | 550 +++-- 12 files changed, 955 insertions(+), 3400 deletions(-) delete mode 100644 modules/openfast-library/src/FAST_SS_Solver.f90 delete mode 100644 modules/openfast-library/src/FAST_SS_Subs.f90 diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index d3dbcffd8d..ae4fe2c9bd 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -3139,6 +3139,7 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) ffd_t) call Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(m%qp%E1(:,idx_qp,nelem), & + m%qp%vvv(:,idx_qp,nelem), & m%qp%vvp(:,idx_qp,nelem), & m%qp%betaC(:,:,idx_qp,nelem), & ffd_t, & @@ -3153,8 +3154,8 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) ENDIF CONTAINS - subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, ffd, Sd, Od, Qd, Gd, Xd, Yd, Pd) - REAL(BDKi), intent(in) :: E1(:), vvp(:), betaC(:,:), ffd(:) + subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvv, vvp, betaC, ffd, Sd, Od, Qd, Gd, Xd, Yd, Pd) + REAL(BDKi), intent(in) :: E1(:), vvv(:), vvp(:), betaC(:,:), ffd(:) REAL(BDKi), intent(out) :: Sd(:,:), Od(:,:), Qd(:,:), Gd(:,:), Xd(:,:), Yd(:,:), Pd(:,:) REAL(BDKi) :: D11(3,3), D12(3,3), D21(3,3), D22(3,3) REAL(BDKi) :: b11(3,3), b12(3,3) @@ -3169,7 +3170,7 @@ subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, ffd, Sd, Od, Qd, Gd, Xd, Yd b11(1:3,1:3) = -MATMUL(SkewSymMat(E1),D11) b12(1:3,1:3) = -MATMUL(SkewSymMat(E1),D12) - SS_ome = SkewSymMat( m%qp%vvv(4:6,idx_qp,nelem) ) + SS_ome = SkewSymMat(vvv(4:6)) ! Compute stiffness matrix Sd Sd(1:3,1:3) = -MATMUL(D11,SS_ome) @@ -3183,7 +3184,7 @@ subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, ffd, Sd, Od, Qd, Gd, Xd, Yd Pd(4:6,4:6) = -MATMUL(b12,SS_ome) ! Compute stiffness matrix Od - alpha = SkewSymMat(vvp(1:3)) - MATMUL(SS_ome,SkewSymMat(E1)) + alpha = SkewSymMat(vvv(1:3)) - MATMUL(SS_ome,SkewSymMat(E1)) Od(:,1:3) = 0.0_BDKi Od(1:3,4:6) = MATMUL(D11,alpha) - SkewSymMat(ffd(1:3)) Od(4:6,4:6) = MATMUL(D21,alpha) - SkewSymMat(ffd(4:6)) @@ -3213,8 +3214,8 @@ SUBROUTINE Calc_FC_FD_ffd(E1, vvv, vvp, betaC, Fc, Fd, ffd) REAL(BDKi) :: eed(6) ! Compute strain rates - eed = vvp - eed(1:3) = eed(1:3) + cross_product(E1,vvv(4:6)) + eed(1:3) = vvv(1:3) + cross_product(E1,vvv(4:6)) + eed(4:6) = vvp(4:6) ! Compute dissipative force ffd(1:6) = MATMUL(betaC(:,:),eed) diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index f25d246e1d..8fdf69a5e5 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -33,9 +33,10 @@ module FAST_AeroMap real(DbKi), parameter :: SS_t_global = 0.0_DbKi real(DbKi), parameter :: UJacSclFact_x = 1.0d3 -logical, parameter :: output_debugging = .false. -integer(IntKi), parameter :: iModStruct = 1 -integer(IntKi), parameter :: iModAero = 2 +logical, parameter :: output_debugging = .false. +integer(IntKi), parameter :: iModStruct = 1 +integer(IntKi), parameter :: iModAero = 2 +integer(IntKi), private, parameter :: iED = 1 contains @@ -305,7 +306,7 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) n_global = real(n_case, DbKi) ! n_global is double-precision so that we can reuse existing code. - call WrOutputLine(n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, T%ED%y%WriteOutput, UnusedAry, & + call WrOutputLine(n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, T%ED%y, UnusedAry, & T%AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & UnusedAry, UnusedAry, UnusedAry, UnusedAry, T%IceD%y, T%BD%y, ErrStat2, ErrMsg2) if (Failed()) return @@ -375,7 +376,7 @@ subroutine SS_Solve(AM, m, Mappings, caseData, p_FAST, y_FAST, m_FAST, T, ErrSta nx = AM%Mod%Vars%Nx ! Set the rotor speed in ElastoDyn - T%ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed + T%ED%x(iED,STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed ! Set prescribed inputs from case data call SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD) @@ -642,17 +643,17 @@ subroutine SS_UpdateInputsStates(AM, delta, T, ErrStat, ErrMsg) case (Module_ED) ! Copy blade1 flap and edge states to other blades - do j = 2, T%ED%p%NumBl - T%ED%x(STATE_CURR)%QT(DOF_BF(j, 1)) = T%ED%x(STATE_CURR)%QT(DOF_BF(1, 1)) - T%ED%x(STATE_CURR)%QT(DOF_BF(j, 2)) = T%ED%x(STATE_CURR)%QT(DOF_BF(1, 2)) - T%ED%x(STATE_CURR)%QT(DOF_BE(j, 1)) = T%ED%x(STATE_CURR)%QT(DOF_BE(1, 1)) + do j = 2, T%ED%p(iED)%NumBl + T%ED%x(iED,STATE_CURR)%QT(DOF_BF(j, 1)) = T%ED%x(iED,STATE_CURR)%QT(DOF_BF(1, 1)) + T%ED%x(iED,STATE_CURR)%QT(DOF_BF(j, 2)) = T%ED%x(iED,STATE_CURR)%QT(DOF_BF(1, 2)) + T%ED%x(iED,STATE_CURR)%QT(DOF_BE(j, 1)) = T%ED%x(iED,STATE_CURR)%QT(DOF_BE(1, 1)) end do ! Set velocities to zero - do j = 1, T%ED%p%NumBl - T%ED%x(STATE_CURR)%QDT(DOF_BF(j, 1)) = 0.0_R8Ki - T%ED%x(STATE_CURR)%QDT(DOF_BF(j, 2)) = 0.0_R8Ki - T%ED%x(STATE_CURR)%QDT(DOF_BE(j, 1)) = 0.0_R8Ki + do j = 1, T%ED%p(iED)%NumBl + T%ED%x(iED,STATE_CURR)%QDT(DOF_BF(j, 1)) = 0.0_R8Ki + T%ED%x(iED,STATE_CURR)%QDT(DOF_BF(j, 2)) = 0.0_R8Ki + T%ED%x(iED,STATE_CURR)%QDT(DOF_BE(j, 1)) = 0.0_R8Ki end do ! Transfer loads from ED blade 1 to other blades @@ -958,7 +959,7 @@ subroutine SS_ED_InputSolve_OtherBlades(AM, InputIndex, T) integer(IntKi), intent(in) :: InputIndex !< Input index to transfer type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi) :: j, k - associate (BladePtLoads => T%ED%Input(InputIndex)%BladePtLoads) + associate (BladePtLoads => T%ED%Input(InputIndex,iED)%BladePtLoads) do k = 2, size(BladePtLoads, 1) do j = 1, BladePtLoads(k)%NNodes BladePtLoads(k)%Force(:, j) = matmul(BladePtLoads(1)%Force(:, j), AM%HubOrientation(:, :, k)) @@ -1181,20 +1182,20 @@ subroutine SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) ! Set prescribed inputs for all of the modules in the steady-state solve - ED%Input(1)%TwrAddedMass = 0.0_ReKi - ED%Input(1)%PtfmAddedMass = 0.0_ReKi + ED%Input(1,iED)%TwrAddedMass = 0.0_ReKi + ED%Input(1,iED)%PtfmAddedMass = 0.0_ReKi - ED%Input(1)%TowerPtLoads%Force = 0.0 - ED%Input(1)%TowerPtLoads%Moment = 0.0 - ED%Input(1)%NacelleLoads%Force = 0.0 - ED%Input(1)%NacelleLoads%Moment = 0.0 - ED%Input(1)%HubPtLoad%Force = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 - ED%Input(1)%HubPtLoad%Moment = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 + ED%Input(1,iED)%TowerPtLoads%Force = 0.0 + ED%Input(1,iED)%TowerPtLoads%Moment = 0.0 + ED%Input(1,iED)%NacelleLoads%Force = 0.0 + ED%Input(1,iED)%NacelleLoads%Moment = 0.0 + ED%Input(1,iED)%HubPtLoad%Force = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 + ED%Input(1,iED)%HubPtLoad%Moment = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 - ED%Input(1)%BlPitchCom = caseData%Pitch - ED%Input(1)%YawMom = 0.0 - ED%Input(1)%HSSBrTrqC = 0.0 - ED%Input(1)%GenTrq = 0.0 + ED%Input(1,iED)%BlPitchCom = caseData%Pitch + ED%Input(1,iED)%YawMom = 0.0 + ED%Input(1,iED)%HSSBrTrqC = 0.0 + ED%Input(1,iED)%GenTrq = 0.0 ! BeamDyn if (p_FAST%CompElast == Module_BD) then diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index b369a0da47..9814ed8050 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -89,11 +89,11 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) call ShiftInputTimes(T%BD%InputTimes(:, ModData%Ins)) case (Module_ED) - call ED_Input_ExtrapInterp(T%ED%Input(1:), T%ED%InputTimes, T%ED%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call ED_Input_ExtrapInterp(T%ED%Input(1:, ModData%Ins), T%ED%InputTimes(:, ModData%Ins), T%ED%Input(INPUT_TEMP, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 0, -1 - call ED_CopyInput(T%ED%Input(j), T%ED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyInput(T%ED%Input(j, ModData%Ins), T%ED%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return end do - call ShiftInputTimes(T%ED%InputTimes) + call ShiftInputTimes(T%ED%InputTimes(:, ModData%Ins)) case (Module_SED) call SED_Input_ExtrapInterp(T%SED%Input(1:), T%SED%InputTimes, T%SED%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return @@ -265,7 +265,7 @@ subroutine FAST_InitInputStateArrays(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) case (Module_BD) T%BD%InputTimes(:, ModData%Ins) = InputTimes case (Module_ED) - T%ED%InputTimes = InputTimes + T%ED%InputTimes(:, ModData%Ins) = InputTimes case (Module_SED) T%SED%InputTimes = InputTimes case (Module_ExtPtfm) @@ -592,9 +592,10 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, CalcWriteOutput) case (Module_ED) - call ED_CalcOutput(ThisTime, T%ED%Input(iInput), T%ED%p, & - T%ED%x(iState), T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & - T%ED%y, T%ED%m, ErrStat2, ErrMsg2) + call ED_CalcOutput(ThisTime, T%ED%Input(iInput, ModData%Ins), T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, iState), T%ED%xd(ModData%Ins, iState), & + T%ED%z(ModData%Ins, iState), T%ED%OtherSt(ModData%Ins, iState), & + T%ED%y(ModData%Ins), T%ED%m(ModData%Ins), ErrStat2, ErrMsg2) case (Module_SED) call SED_CalcOutput(ThisTime, T%SED%Input(iInput), T%SED%p, & @@ -733,8 +734,8 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & case (Module_BD) call BD_VarsPackInput(ModData%Vars, T%BD%Input(iInput, ModData%Ins), u_op) case (Module_ED) - call ED_VarsPackInput(ModData%Vars, T%ED%Input(iInput), u_op) - call ED_PackExtInputAry(ModData%Vars, T%ED%Input(iInput), u_op, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackInput(ModData%Vars, T%ED%Input(iInput, ModData%Ins), u_op) + call ED_PackExtInputAry(ModData%Vars, T%ED%Input(iInput, ModData%Ins), u_op, ErrStat2, ErrMsg2); if (Failed()) return case (Module_SED) call SED_VarsPackInput(ModData%Vars, T%SED%Input(iInput), u_op) case (Module_ExtPtfm) @@ -792,7 +793,7 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & case (Module_BD) call BD_VarsPackOutput(ModData%Vars, T%BD%y(ModData%Ins), y_op) case (Module_ED) - call ED_VarsPackOutput(ModData%Vars, T%ED%y, y_op) + call ED_VarsPackOutput(ModData%Vars, T%ED%y(ModData%Ins), y_op) case (Module_SED) call SED_VarsPackOutput(ModData%Vars, T%SED%y, y_op) case (Module_ExtPtfm) @@ -849,7 +850,7 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & case (Module_BD) call BD_VarsPackContState(ModData%Vars, T%BD%x(ModData%Ins, iState), x_op) case (Module_ED) - call ED_VarsPackContState(ModData%Vars, T%ED%x(iState), x_op) + call ED_VarsPackContState(ModData%Vars, T%ED%x(ModData%Ins, iState), x_op) case (Module_SED) call SED_VarsPackContState(ModData%Vars, T%SED%x(iState), x_op) case (Module_ExtPtfm) @@ -938,11 +939,17 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & call BD_VarsPackContStateDeriv(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) case (Module_ED) - call ED_CalcContStateDeriv(ThisTime, T%ED%Input(iInput), T%ED%p, T%ED%x(iState), & - T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & - T%ED%m, T%ED%m%dxdt_lin, ErrStat2, ErrMsg2) + call ED_CalcContStateDeriv(ThisTime, T%ED%Input(iInput, ModData%Ins), & + T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, iState), & + T%ED%xd(ModData%Ins, iState), & + T%ED%z(ModData%Ins, iState), & + T%ED%OtherSt(ModData%Ins, iState), & + T%ED%m(ModData%Ins), & + T%ED%m(ModData%Ins)%dxdt_lin, & + ErrStat2, ErrMsg2) if (Failed()) return - call ED_VarsPackContStateDeriv(ModData%Vars, T%ED%m%dxdt_lin, dx_op) + call ED_VarsPackContStateDeriv(ModData%Vars, T%ED%m(ModData%Ins)%dxdt_lin, dx_op) case (Module_SED) call SED_CalcContStateDeriv(ThisTime, T%SED%Input(iInput), T%SED%p, T%SED%x(iState), & @@ -1041,7 +1048,7 @@ subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & case (Module_BD) call BD_VarsPackConstrState(ModData%Vars, T%BD%z(ModData%Ins, iState), z_op) case (Module_ED) - call ED_VarsPackConstrState(ModData%Vars, T%ED%z(iState), z_op) + call ED_VarsPackConstrState(ModData%Vars, T%ED%z(ModData%Ins, iState), z_op) case (Module_SED) call SED_VarsPackConstrState(ModData%Vars, T%SED%z(iState), z_op) case (Module_ExtPtfm) @@ -1121,7 +1128,7 @@ subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & case (Module_BD) call BD_VarsUnpackInput(ModData%Vars, u_op, T%BD%Input(iInput, ModData%Ins)) case (Module_ED) - call ED_VarsUnpackInput(ModData%Vars, u_op, T%ED%Input(iInput)) + call ED_VarsUnpackInput(ModData%Vars, u_op, T%ED%Input(iInput, ModData%Ins)) case (Module_SED) call SED_VarsUnpackInput(ModData%Vars, u_op, T%SED%Input(iInput)) case (Module_ExtPtfm) @@ -1172,7 +1179,7 @@ subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & case (Module_BD) call BD_VarsUnpackContState(ModData%Vars, x_op, T%BD%x(ModData%Ins, iState)) case (Module_ED) - call ED_VarsUnpackContState(ModData%Vars, x_op, T%ED%x(iState)) + call ED_VarsUnpackContState(ModData%Vars, x_op, T%ED%x(ModData%Ins, iState)) case (Module_SED) call SED_VarsUnpackContState(ModData%Vars, x_op, T%SED%x(iState)) case (Module_ExtPtfm) @@ -1223,7 +1230,7 @@ subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & case (Module_BD) call BD_VarsUnpackConstrState(ModData%Vars, z_op, T%BD%z(ModData%Ins, iState)) case (Module_ED) - call ED_VarsUnpackConstrState(ModData%Vars, z_op, T%ED%z(iState)) + call ED_VarsUnpackConstrState(ModData%Vars, z_op, T%ED%z(ModData%Ins, iState)) case (Module_SED) call SED_VarsUnpackConstrState(ModData%Vars, z_op, T%SED%z(iState)) case (Module_ExtPtfm) @@ -1307,8 +1314,10 @@ subroutine FAST_JacobianPInput(ModData, ThisTime, iInput, iState, T, ErrStat, Er dYdu=dYdu, dXdu=dXdu) case (Module_ED) - call ED_JacobianPInput(ModData%Vars, ThisTime, T%ED%Input(iInput), T%ED%p, T%ED%x(iState), T%ED%xd(iState), & - T%ED%z(iState), T%ED%OtherSt(iState), T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + call ED_JacobianPInput(ModData%Vars, ThisTime, T%ED%Input(iInput, ModData%Ins), T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, iState), T%ED%xd(ModData%Ins, iState), & + T%ED%z(ModData%Ins, iState), T%ED%OtherSt(ModData%Ins, iState), & + T%ED%y(ModData%Ins), T%ED%m(ModData%Ins), ErrStat2, ErrMsg2, & dYdu=dYdu, dXdu=dXdu) case (Module_SED) @@ -1412,18 +1421,18 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, iInput, iState, T, ErrStat dYdx=dYdx, dXdx=dXdx, StateRotation=ModData%Lin%StateRotation) case (Module_ED) - call ED_JacobianPContState(ModData%Vars, ThisTime, T%ED%Input(iInput), T%ED%p, & - T%ED%x(iState), T%ED%xd(iState), & - T%ED%z(iState), T%ED%OtherSt(iState), & - T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + call ED_JacobianPContState(ModData%Vars, ThisTime, T%ED%Input(iInput, ModData%Ins), T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, iState), T%ED%xd(ModData%Ins, iState), & + T%ED%z(ModData%Ins, iState), T%ED%OtherSt(ModData%Ins, iState), & + T%ED%y(ModData%Ins), T%ED%m(ModData%Ins), ErrStat2, ErrMsg2, & dYdx=dYdx, dXdx=dXdx) case (Module_SED) call SED_JacobianPContState(ModData%Vars, ThisTime, T%SED%Input(iInput), T%SED%p, & - T%SED%x(iState), T%SED%xd(iState), & - T%SED%z(iState), T%SED%OtherSt(iState), & - T%SED%y, T%SED%m, ErrStat2, ErrMsg2, & - dYdx=dYdx, dXdx=dXdx) + T%SED%x(iState), T%SED%xd(iState), & + T%SED%z(iState), T%SED%OtherSt(iState), & + T%SED%y, T%SED%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) case (Module_ExtPtfm) call ExtPtfm_JacobianPContState(ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, & @@ -1541,10 +1550,10 @@ subroutine FAST_CopyStates(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) case (Module_ED) - call ED_CopyContState(T%ED%x(iSrc), T%ED%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyDiscState(T%ED%xd(iSrc), T%ED%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyConstrState(T%ED%z(iSrc), T%ED%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyOtherState(T%ED%OtherSt(iSrc), T%ED%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyContState(T%ED%x(ModData%Ins, iSrc), T%ED%x(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(ModData%Ins, iSrc), T%ED%xd(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(ModData%Ins, iSrc), T%ED%z(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(ModData%Ins, iSrc), T%ED%OtherSt(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_SED) @@ -1699,7 +1708,7 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) case (Module_ED) - call ED_CopyInput(T%ED%Input(iSrc), T%ED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + call ED_CopyInput(T%ED%Input(iSrc, ModData%Ins), T%ED%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) case (Module_SED) call SED_CopyInput(T%SED%Input(iSrc), T%SED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) @@ -1793,4 +1802,137 @@ subroutine XfrModToGlueMatrix(RowVarAry, ColVarAry, ModMat, GluMat) end do end subroutine +subroutine FAST_ModEnd(Mods, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CopyInput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through modules and call end function + do i = 1, size(Mods) + associate (ModData => Mods(i)) + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + ! Call end on first instance since each rotor has an instance + if (ModData%Ins == 1) then + call AD_End(T%AD%Input(1), T%AD%p, T%AD%x(STATE_CURR), & + T%AD%xd(STATE_CURR), T%AD%z(STATE_CURR), & + T%AD%OtherSt(STATE_CURR), T%AD%y, T%AD%m, ErrStat2, ErrMsg2) + end if + + case (Module_ADsk) + call ADsk_End(T%ADsk%Input(1), T%ADsk%p, T%ADsk%x(STATE_CURR), & + T%ADsk%xd(STATE_CURR), T%ADsk%z(STATE_CURR), & + T%ADsk%OtherSt(STATE_CURR), T%ADsk%y, T%ADsk%m, ErrStat2, ErrMsg2) + + case (Module_BD) + call BD_End(T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, STATE_CURR), T%BD%xd(ModData%Ins, STATE_CURR), & + T%BD%z(ModData%Ins, STATE_CURR), T%BD%OtherSt(ModData%Ins, STATE_CURR), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_ED) + call ED_End(T%ED%Input(1, ModData%Ins), T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, STATE_CURR), T%ED%xd(ModData%Ins, STATE_CURR), & + T%ED%z(ModData%Ins, STATE_CURR), T%ED%OtherSt(ModData%Ins, STATE_CURR), & + T%ED%y(ModData%Ins), T%ED%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_SED) + call SED_End(T%SED%Input(1), T%SED%p, T%SED%x(STATE_CURR), & + T%SED%xd(STATE_CURR), T%SED%z(STATE_CURR), T%SED%OtherSt(STATE_CURR), & + T%SED%y, T%SED%m, ErrStat2, ErrMsg2) + + case (Module_ExtInfw) + ! Missing ExtInfw_End + ErrStat2 = ErrID_None + ErrMsg2 = '' + + case (Module_ExtLd) + call ExtLd_End(T%ExtLd%u, T%ExtLd%p, T%ExtLd%x(STATE_CURR), T%ExtLd%xd(STATE_CURR), & + T%ExtLd%z(STATE_CURR), T%ExtLd%OtherSt(STATE_CURR), & + T%ExtLd%y, T%ExtLd%m, ErrStat2, ErrMsg2) + + case (Module_ExtPtfm) + call ExtPtfm_End(T%ExtPtfm%Input(1), T%ExtPtfm%p, T%ExtPtfm%x(STATE_CURR), T%ExtPtfm%xd(STATE_CURR), & + T%ExtPtfm%z(STATE_CURR), T%ExtPtfm%OtherSt(STATE_CURR), T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2) + + case (Module_FEAM) + call FEAM_End(T%FEAM%Input(1), T%FEAM%p, T%FEAM%x(STATE_CURR), T%FEAM%xd(STATE_CURR), T%FEAM%z(STATE_CURR), & + T%FEAM%OtherSt(STATE_CURR), T%FEAM%y, T%FEAM%m, ErrStat2, ErrMsg2) + + case (Module_HD) + call HydroDyn_End(T%HD%Input(1), T%HD%p, T%HD%x(STATE_CURR), T%HD%xd(STATE_CURR), T%HD%z(STATE_CURR), T%HD%OtherSt(STATE_CURR), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2) + + case (Module_IceD) + call IceD_End(T%IceD%Input(1, ModData%Ins), T%IceD%p(ModData%Ins), & + T%IceD%x(ModData%Ins, STATE_CURR), T%IceD%xd(ModData%Ins, STATE_CURR), & + T%IceD%z(ModData%Ins, STATE_CURR), T%IceD%OtherSt(ModData%Ins, STATE_CURR), & + T%IceD%y(ModData%Ins), T%IceD%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_IceF) + call IceFloe_End(T%IceF%Input(1), T%IceF%p, T%IceF%x(STATE_CURR), T%IceF%xd(STATE_CURR), & + T%IceF%z(STATE_CURR), T%IceF%OtherSt(STATE_CURR), T%IceF%y, T%IceF%m, ErrStat2, ErrMsg2) + + case (Module_IfW) + call InflowWind_End(T%IfW%Input(1), T%IfW%p, T%IfW%x(STATE_CURR), T%IfW%xd(STATE_CURR), & + T%IfW%z(STATE_CURR), T%IfW%OtherSt(STATE_CURR), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) + + case (Module_MAP) + call MAP_End(T%MAP%Input(1), T%MAP%p, T%MAP%x(STATE_CURR), T%MAP%xd(STATE_CURR), & + T%MAP%z(STATE_CURR), T%MAP%OtherSt, T%MAP%y, ErrStat2, ErrMsg2) + + case (Module_MD) + call MD_End(T%MD%Input(1), T%MD%p, T%MD%x(STATE_CURR), T%MD%xd(STATE_CURR), T%MD%z(STATE_CURR), & + T%MD%OtherSt(STATE_CURR), T%MD%y, T%MD%m, ErrStat2, ErrMsg2) + + case (Module_Orca) + call Orca_End(T%Orca%Input(1), T%Orca%p, T%Orca%x(STATE_CURR), T%Orca%xd(STATE_CURR), & + T%Orca%z(STATE_CURR), T%Orca%OtherSt(STATE_CURR), T%Orca%y, T%Orca%m, ErrStat2, ErrMsg2) + + case (Module_SD) + call SD_End(T%SD%Input(1), T%SD%p, T%SD%x(STATE_CURR), T%SD%xd(STATE_CURR), & + T%SD%z(STATE_CURR), T%SD%OtherSt(STATE_CURR), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2) + + case (Module_SeaSt) + call SeaSt_End(T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(STATE_CURR), T%SeaSt%xd(STATE_CURR), & + T%SeaSt%z(STATE_CURR), T%SeaSt%OtherSt(STATE_CURR), & + T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2) + + case (Module_SrvD) + call SrvD_End(T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(STATE_CURR), T%SrvD%xd(STATE_CURR), & + T%SrvD%z(STATE_CURR), T%SrvD%OtherSt(STATE_CURR), & + T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) + + case default + call SetErrStat(ErrID_Fatal, "Unknown module "//trim(ModData%Abbr), ErrStat, ErrMsg, RoutineName) + return + end select + + end associate + + ! Collect errors + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + end module diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 445c61b899..5c374b0c5d 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -24,6 +24,7 @@ MODULE FAST_Data INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 4000 ! Maximum number of outputs INTEGER(IntKi), PARAMETER :: MAXInitINPUTS = 53 ! Maximum number of initialization values from Simulink INTEGER(IntKi), PARAMETER :: NumFixedInputs = 51 + integer(IntKi), parameter, private :: iED = 1 ! Global (static) data: @@ -358,16 +359,16 @@ subroutine FAST_HubPosition(iTurb_c, AbsPosition_c, RotationalVel_c, Orientation return end if - if (.NOT. Turbine(iTurb)%ED%y%HubPtMotion%Committed) then + if (.NOT. Turbine(iTurb)%ED%y(iED)%HubPtMotion%Committed) then ErrStat_c = ErrID_Fatal ErrMsg = "HubPtMotion mesh has not been committed."//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) return end if - AbsPosition_c = REAL(Turbine(iTurb)%ED%y%HubPtMotion%Position(:,1), C_FLOAT) + REAL(Turbine(iTurb)%ED%y%HubPtMotion%TranslationDisp(:,1), C_FLOAT) - Orientation_c = reshape( Turbine(iTurb)%ED%y%HubPtMotion%Orientation(1:3,1:3,1), (/9/) ) - RotationalVel_c = Turbine(iTurb)%ED%y%HubPtMotion%RotationVel(:,1) + AbsPosition_c = REAL(Turbine(iTurb)%ED%y(iED)%HubPtMotion%Position(:,1), C_FLOAT) + REAL(Turbine(iTurb)%ED%y(iED)%HubPtMotion%TranslationDisp(:,1), C_FLOAT) + Orientation_c = reshape( Turbine(iTurb)%ED%y(iED)%HubPtMotion%Orientation(1:3,1:3,1), (/9/) ) + RotationalVel_c = Turbine(iTurb)%ED%y(iED)%HubPtMotion%RotationVel(:,1) end subroutine FAST_HubPosition !================================================================================================================================== @@ -600,7 +601,7 @@ subroutine FAST_ExtLoads_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, Out dt_c = DBLE(Turbine(iTurb)%p_FAST%DT) - NumBl_c = Turbine(iTurb)%ED%p%NumBl + NumBl_c = Turbine(iTurb)%ED%p(iED)%NumBl CompLoadsType = Turbine(iTurb)%p_FAST%CompAero @@ -998,7 +999,7 @@ subroutine FAST_ExtLoads_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, d n_t_global_c = n_t_global AbortErrLev_c = AbortErrLev NumOuts_c = min(MAXOUTPUTS, 1 + SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time - numblades_c = Turbine(iTurb)%ED%p%NumBl + numblades_c = Turbine(iTurb)%ED%p(iED)%NumBl dt_c = Turbine(iTurb)%p_FAST%dt #ifdef CONSOLE_FILE diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index bc251e2f01..bdebcdb664 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -84,7 +84,7 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, iInput, ErrSta case (Module_BD) Mesh => BD_InputMeshPointer(Turbine%BD%Input(iInput, ModData%Ins), MeshLoc) case (Module_ED) - Mesh => ED_InputMeshPointer(Turbine%ED%Input(iInput), MeshLoc) + Mesh => ED_InputMeshPointer(Turbine%ED%Input(iInput, ModData%Ins), MeshLoc) case (Module_SED) Mesh => SED_InputMeshPointer(Turbine%SED%Input(iInput), MeshLoc) case (Module_ExtInfw) @@ -155,7 +155,7 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM case (Module_BD) Mesh => BD_OutputMeshPointer(Turbine%BD%y(ModData%Ins), MeshLoc) case (Module_ED) - Mesh => ED_OutputMeshPointer(Turbine%ED%y, MeshLoc) + Mesh => ED_OutputMeshPointer(Turbine%ED%y(ModData%Ins), MeshLoc) case (Module_SED) Mesh => SED_OutputMeshPointer(Turbine%SED%y, MeshLoc) case (Module_ExtInfw) @@ -392,7 +392,8 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) case (Module_ED) call MapCustom(MappingsTmp, Custom_ED_Tower_Damping, Mods(iModDst), Mods(iModDst), & Active=Turbine%p_FAST%CalcSteady) - do i = 1, Turbine%ED%p%NumBl + + do i = 1, Turbine%ED%p(Mods(iModDst)%Ins)%NumBl call MapCustom(MappingsTmp, Custom_ED_Blade_Damping, Mods(iModDst), Mods(iModDst), & i=i, Active=Turbine%p_FAST%CalcSteady .and. (Turbine%p_FAST%CompElast == Module_ED)) end do @@ -502,7 +503,7 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) ! Create temporary motion mesh as cousin of load mesh, to compute get ! velocities at load locations for computing damping forces - call MeshCopy(SrcMesh=Turbine%ED%Input(INPUT_CURR)%TowerPtLoads, & + call MeshCopy(SrcMesh=Turbine%ED%Input(INPUT_CURR, Mapping%DstIns)%TowerPtLoads, & DestMesh=Mapping%TmpMotionMesh, & CtrlCode=MESH_COUSIN, & IOS=COMPONENT_OUTPUT, & @@ -513,17 +514,17 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) if (Failed()) return ! Create motion mapping from original motion mesh to temporary motion mesh - call MeshMapCreate(Turbine%ED%y%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + call MeshMapCreate(Turbine%ED%y(Mapping%DstIns)%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) if (Failed()) return ! Determine mesh transfer type and save to mapping - Mapping%XfrType = MeshTransferType(Turbine%ED%y%TowerLn2Mesh, Mapping%TmpMotionMesh) + Mapping%XfrType = MeshTransferType(Turbine%ED%y(Mapping%DstIns)%TowerLn2Mesh, Mapping%TmpMotionMesh) case (Custom_ED_Blade_Damping) ! Create temporary motion mesh as cousin of load mesh, to compute get ! velocities at load locations for computing damping forces - call MeshCopy(SrcMesh=Turbine%ED%Input(INPUT_CURR)%BladePtLoads(Mapping%i), & + call MeshCopy(SrcMesh=Turbine%ED%Input(INPUT_CURR, Mapping%DstIns)%BladePtLoads(Mapping%i), & DestMesh=Mapping%TmpMotionMesh, & CtrlCode=MESH_COUSIN, & IOS=COMPONENT_OUTPUT, & @@ -534,11 +535,11 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) if (Failed()) return ! Create motion mapping from original motion mesh to temporary motion mesh - call MeshMapCreate(Turbine%ED%y%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + call MeshMapCreate(Turbine%ED%y(Mapping%DstIns)%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) if (Failed()) return ! Determine mesh transfer type and save to mapping - Mapping%XfrType = MeshTransferType(Turbine%ED%y%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh) + Mapping%XfrType = MeshTransferType(Turbine%ED%y(Mapping%DstIns)%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh) case (Custom_BD_Blade_Damping) @@ -610,7 +611,7 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Blade motion if (Turbine%p_FAST%CompElast == Module_ED) then - do i = 1, size(Turbine%ED%y%BladeLn2Mesh) + do i = 1, size(Turbine%ED%y(SrcMod%Ins)%BladeLn2Mesh) call MapMotionMesh(Turbine, Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) DstMod=DstMod, DstDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) @@ -621,7 +622,7 @@ subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) end if ! Blade root motion - do i = 1, size(Turbine%ED%y%BladeRootMotion) + do i = 1, size(Turbine%ED%y(SrcMod%Ins)%BladeRootMotion) call MapMotionMesh(Turbine, Mappings, & SrcMod=SrcMod, SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) DstMod=DstMod, DstDL=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) @@ -904,7 +905,7 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_AD) ! Blade Loads - do i = 1, Turbine%ED%p%NumBl + do i = 1, Turbine%ED%p(DstMod%Ins)%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(i) SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(i) @@ -984,7 +985,7 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) case (Module_ExtLd) ! Blade loads - do i = 1, Turbine%ED%p%NumBl + do i = 1, Turbine%ED%p(DstMod%Ins)%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ExtLd_y_BladeLoad, i), & ! ExtLd%y%BladeLoad(i) SrcDispDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) @@ -1138,7 +1139,7 @@ subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Blade Structural Controller (if ElastoDyn is used for blades) do j = 1, Turbine%SrvD%p%NumBStC - do i = 1, Turbine%ED%p%NumBl + do i = 1, Turbine%ED%p(DstMod%Ins)%NumBl call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & SrcDispDL=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) @@ -1302,7 +1303,7 @@ subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg case (Module_AD) ! Blade Loads - do i = 1, Turbine%ED%p%NumBl + do i = 1, size(Turbine%AD%y%rotors(SrcMod%Ins)%BladeLoad) call MapLoadMesh(Turbine, Mappings, & SrcMod=SrcMod, & SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(i) @@ -1340,7 +1341,7 @@ subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg call MapCustom(Mappings, Custom_ED_to_ExtLd, SrcMod, DstMod) ! Blade motion - do i = 1, Turbine%ED%p%NumBl + do i = 1, Turbine%ED%p(SrcMod%Ins)%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) DstDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) @@ -1350,7 +1351,7 @@ subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg end do ! Blade root motion - do i = 1, Turbine%ED%p%NumBl + do i = 1, Turbine%ED%p(SrcMod%Ins)%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) DstDL=DatLoc(ExtLd_u_BladeRootMotion, i), & ! ExtLd%u%BladeRootMotion(i) @@ -1964,7 +1965,7 @@ subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) ! Blade Structural Controller (if ElastoDyn blades) do j = 1, Turbine%SrvD%p%NumBStC - do i = 1, Turbine%ED%p%NumBl + do i = 1, Turbine%ED%p(SrcMod%Ins)%NumBl call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) DstDL=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) @@ -2691,7 +2692,7 @@ subroutine VarUnpackInput(ModData, Var, ValAry, T, iInput, ErrStat, ErrMsg) case (Module_BD) call BD_VarUnpackInput(Var, ValAry, T%BD%Input(iInput, ModData%Ins)) case (Module_ED) - call ED_VarUnpackInput(Var, ValAry, T%ED%Input(iInput)) + call ED_VarUnpackInput(Var, ValAry, T%ED%Input(iInput, ModData%Ins)) case (Module_SED) call SED_VarUnpackInput(Var, ValAry, T%SED%Input(iInput)) case (Module_ExtLd) @@ -2744,7 +2745,7 @@ subroutine VarPackOutput(ModData, Var, ValAry, T, ErrStat, ErrMsg) case (Module_BD) call BD_VarPackOutput(Var, T%BD%y(ModData%Ins), ValAry) case (Module_ED) - call ED_VarPackOutput(Var, T%ED%y, ValAry) + call ED_VarPackOutput(Var, T%ED%y(ModData%Ins), ValAry) case (Module_SED) call SED_VarPackOutput(Var, T%SED%y, ValAry) case (Module_ExtLd) @@ -3056,8 +3057,8 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg case (Custom_ED_to_ADsk) - T%ADsk%Input(iInput)%RotSpeed = T%ED%y%RotSpeed - T%ADsk%Input(iInput)%BlPitch = T%ED%y%BlPitch(1) ! ADsk only uses collective blade pitch + T%ADsk%Input(iInput)%RotSpeed = T%ED%y(ModSrc%Ins)%RotSpeed + T%ADsk%Input(iInput)%BlPitch = T%ED%y(ModSrc%Ins)%BlPitch(1) ! ADsk only uses collective blade pitch case (Custom_SED_to_ADsk) @@ -3071,8 +3072,9 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg case (Custom_BD_Blade_Damping) ! Get rotational velocity and current hub position - omega_c = T%ED%y%RotSpeed * T%ED%y%HubPtMotion%Orientation(1,:,1) - r_hub = T%ED%y%HubPtMotion%Position(:,1) + T%ED%y%HubPtMotion%TranslationDisp(:,1) + ! TODO: correlate ED instance with BD instance + omega_c = T%ED%y(1)%RotSpeed * T%ED%y(1)%HubPtMotion%Orientation(1,:,1) + r_hub = T%ED%y(1)%HubPtMotion%Position(:,1) + T%ED%y(1)%HubPtMotion%TranslationDisp(:,1) ! Get blade velocities at load mesh locations call TransferMesh(Mapping%XfrType, T%BD%y(Mapping%DstIns)%BldMotion, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) @@ -3094,28 +3096,29 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg case (Custom_SrvD_to_ED) - T%ED%Input(iInput)%GenTrq = T%SrvD%y%GenTrq - T%ED%Input(iInput)%HSSBrTrqC = T%SrvD%y%HSSBrTrqC - T%ED%Input(iInput)%BlPitchCom = T%SrvD%y%BlPitchCom - T%ED%Input(iInput)%YawMom = T%SrvD%y%YawMom + T%ED%Input(iInput, ModDst%Ins)%GenTrq = T%SrvD%y%GenTrq + T%ED%Input(iInput, ModDst%Ins)%HSSBrTrqC = T%SrvD%y%HSSBrTrqC + T%ED%Input(iInput, ModDst%Ins)%BlPitchCom = T%SrvD%y%BlPitchCom + T%ED%Input(iInput, ModDst%Ins)%YawMom = T%SrvD%y%YawMom case (Custom_ED_Tower_Damping) ! Get tower velocities at load mesh locations - call TransferMesh(Mapping%XfrType, T%ED%y%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call TransferMesh(Mapping%XfrType, T%ED%y(ModDst%Ins)%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return ! Apply damping force as Twr_Kdmp*(node velocity) - T%ED%Input(iInput)%TowerPtLoads%Force = T%ED%Input(iInput)%TowerPtLoads%Force - T%p_FAST%Twr_Kdmp * Mapping%TmpMotionMesh%TranslationVel + T%ED%Input(iInput, Mapping%DstIns)%TowerPtLoads%Force = T%ED%Input(iInput, Mapping%DstIns)%TowerPtLoads%Force - T%p_FAST%Twr_Kdmp * Mapping%TmpMotionMesh%TranslationVel case (Custom_ED_Blade_Damping) ! Get rotational velocity and current hub position - omega_c = T%ED%y%RotSpeed * T%ED%y%HubPtMotion%Orientation(1,:,1) - r_hub = T%ED%y%HubPtMotion%Position(:,1) + T%ED%y%HubPtMotion%TranslationDisp(:,1) + ! TODO: correlate ED instance with BD instance + omega_c = T%ED%y(ModDst%Ins)%RotSpeed * T%ED%y(ModDst%Ins)%HubPtMotion%Orientation(1,:,1) + r_hub = T%ED%y(ModDst%Ins)%HubPtMotion%Position(:,1) + T%ED%y(ModDst%Ins)%HubPtMotion%TranslationDisp(:,1) ! Get blade velocities at load mesh locations - call TransferMesh(Mapping%XfrType, T%ED%y%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call TransferMesh(Mapping%XfrType, T%ED%y(1)%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) if (Failed()) return ! Remove rotor rotational velocity from node velocity @@ -3126,7 +3129,7 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg end do ! Apply damping force as Bld_Kdmp*(node velocity) - T%ED%Input(iInput)%BladePtLoads(Mapping%i)%Force = T%ED%Input(iInput)%BladePtLoads(Mapping%i)%Force - T%p_FAST%Bld_Kdmp * Mapping%TmpMotionMesh%TranslationVel + T%ED%Input(iInput, Mapping%DstIns)%BladePtLoads(Mapping%i)%Force = T%ED%Input(iInput, Mapping%DstIns)%BladePtLoads(Mapping%i)%Force - T%p_FAST%Bld_Kdmp * Mapping%TmpMotionMesh%TranslationVel !------------------------------------------------------------------------------- ! SED Inputs @@ -3146,8 +3149,8 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg case (Custom_ED_to_ExtLd) - T%ExtLd%u%az = T%ED%y%LSSTipPxa - T%ExtLd%u%DX_u%bldPitch(:) = T%ED%y%BlPitch + T%ExtLd%u%az = T%ED%y(ModSrc%Ins)%LSSTipPxa + T%ExtLd%u%DX_u%bldPitch(:) = T%ED%y(ModSrc%Ins)%BlPitch ! Note: this may be better inside CalcOutput call ExtLd_ConvertInpDataForExtProg(T%ExtLd%u, T%ExtLd%p, ErrStat2, ErrMsg2) @@ -3161,14 +3164,14 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg case (Custom_ED_to_IfW) ! This section should be refactored so that IfW uses a hub point mesh - T%IfW%Input(iInput)%HubPosition = T%ED%y%HubPtMotion%Position(:, 1) + & - T%ED%y%HubPtMotion%TranslationDisp(:, 1) - T%IfW%Input(iInput)%HubOrientation = T%ED%y%HubPtMotion%Orientation(:, :, 1) + T%IfW%Input(iInput)%HubPosition = T%ED%y(ModSrc%Ins)%HubPtMotion%Position(:, 1) + & + T%ED%y(ModSrc%Ins)%HubPtMotion%TranslationDisp(:, 1) + T%IfW%Input(iInput)%HubOrientation = T%ED%y(ModSrc%Ins)%HubPtMotion%Orientation(:, :, 1) ! Set Lidar position directly from hub motion mesh - T%IfW%Input(iInput)%lidar%HubDisplacementX = T%ED%y%HubPtMotion%TranslationDisp(1, 1) - T%IfW%Input(iInput)%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) - T%IfW%Input(iInput)%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementX = T%ED%y(ModSrc%Ins)%HubPtMotion%TranslationDisp(1, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementY = T%ED%y(ModSrc%Ins)%HubPtMotion%TranslationDisp(2, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementZ = T%ED%y(ModSrc%Ins)%HubPtMotion%TranslationDisp(3, 1) case (Custom_SED_to_IfW) @@ -3214,47 +3217,48 @@ subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg case (Custom_BD_to_SrvD) - T%SrvD%Input(iInput)%RootMxc(Mapping%SrcIns) = T%BD%y(Mapping%SrcIns)%RootMxr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) + & - T%BD%y(Mapping%SrcIns)%RootMyr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) - T%SrvD%Input(iInput)%RootMyc(Mapping%SrcIns) = -T%BD%y(Mapping%SrcIns)%RootMxr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) + & - T%BD%y(Mapping%SrcIns)%RootMyr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) + ! TODO: correlate BD instance to ED instance + T%SrvD%Input(iInput)%RootMxc(Mapping%SrcIns) = T%BD%y(Mapping%SrcIns)%RootMxr*cos(T%ED%y(1)%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*sin(T%ED%y(1)%BlPitch(Mapping%SrcIns)) + T%SrvD%Input(iInput)%RootMyc(Mapping%SrcIns) = -T%BD%y(Mapping%SrcIns)%RootMxr*sin(T%ED%y(1)%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*cos(T%ED%y(1)%BlPitch(Mapping%SrcIns)) case (Custom_ED_to_SrvD) ! Blade root moment if not using BeamDyn if (T%p_FAST%CompElast /= Module_BD) then - T%SrvD%Input(iInput)%RootMxc = T%ED%y%RootMxc ! fixed-size arrays: always size 3 - T%SrvD%Input(iInput)%RootMyc = T%ED%y%RootMyc ! fixed-size arrays: always size 3 + T%SrvD%Input(iInput)%RootMxc = T%ED%y(ModSrc%Ins)%RootMxc ! fixed-size arrays: always size 3 + T%SrvD%Input(iInput)%RootMyc = T%ED%y(ModSrc%Ins)%RootMyc ! fixed-size arrays: always size 3 end if - T%SrvD%Input(iInput)%YawAngle = T%ED%y%YawAngle ! nacelle yaw plus platform yaw + T%SrvD%Input(iInput)%YawAngle = T%ED%y(ModSrc%Ins)%YawAngle ! nacelle yaw plus platform yaw T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) - T%SrvD%Input(iInput)%BlPitch = T%ED%y%BlPitch - T%SrvD%Input(iInput)%LSS_Spd = T%ED%y%LSS_Spd - T%SrvD%Input(iInput)%RotSpeed = T%ED%y%RotSpeed + T%SrvD%Input(iInput)%BlPitch = T%ED%y(ModSrc%Ins)%BlPitch + T%SrvD%Input(iInput)%LSS_Spd = T%ED%y(ModSrc%Ins)%LSS_Spd + T%SrvD%Input(iInput)%RotSpeed = T%ED%y(ModSrc%Ins)%RotSpeed - T%SrvD%Input(iInput)%YawBrTAxp = T%ED%y%YawBrTAxp - T%SrvD%Input(iInput)%YawBrTAyp = T%ED%y%YawBrTAyp - T%SrvD%Input(iInput)%LSSTipPxa = T%ED%y%LSSTipPxa + T%SrvD%Input(iInput)%YawBrTAxp = T%ED%y(ModSrc%Ins)%YawBrTAxp + T%SrvD%Input(iInput)%YawBrTAyp = T%ED%y(ModSrc%Ins)%YawBrTAyp + T%SrvD%Input(iInput)%LSSTipPxa = T%ED%y(ModSrc%Ins)%LSSTipPxa - T%SrvD%Input(iInput)%LSSTipMxa = T%ED%y%LSSTipMxa - T%SrvD%Input(iInput)%LSSTipMya = T%ED%y%LSSTipMya - T%SrvD%Input(iInput)%LSSTipMza = T%ED%y%LSSTipMza - T%SrvD%Input(iInput)%LSSTipMys = T%ED%y%LSSTipMys - T%SrvD%Input(iInput)%LSSTipMzs = T%ED%y%LSSTipMzs + T%SrvD%Input(iInput)%LSSTipMxa = T%ED%y(ModSrc%Ins)%LSSTipMxa + T%SrvD%Input(iInput)%LSSTipMya = T%ED%y(ModSrc%Ins)%LSSTipMya + T%SrvD%Input(iInput)%LSSTipMza = T%ED%y(ModSrc%Ins)%LSSTipMza + T%SrvD%Input(iInput)%LSSTipMys = T%ED%y(ModSrc%Ins)%LSSTipMys + T%SrvD%Input(iInput)%LSSTipMzs = T%ED%y(ModSrc%Ins)%LSSTipMzs - T%SrvD%Input(iInput)%YawBrMyn = T%ED%y%YawBrMyn - T%SrvD%Input(iInput)%YawBrMzn = T%ED%y%YawBrMzn - T%SrvD%Input(iInput)%NcIMURAxs = T%ED%y%NcIMURAxs - T%SrvD%Input(iInput)%NcIMURAys = T%ED%y%NcIMURAys - T%SrvD%Input(iInput)%NcIMURAzs = T%ED%y%NcIMURAzs + T%SrvD%Input(iInput)%YawBrMyn = T%ED%y(ModSrc%Ins)%YawBrMyn + T%SrvD%Input(iInput)%YawBrMzn = T%ED%y(ModSrc%Ins)%YawBrMzn + T%SrvD%Input(iInput)%NcIMURAxs = T%ED%y(ModSrc%Ins)%NcIMURAxs + T%SrvD%Input(iInput)%NcIMURAys = T%ED%y(ModSrc%Ins)%NcIMURAys + T%SrvD%Input(iInput)%NcIMURAzs = T%ED%y(ModSrc%Ins)%NcIMURAzs - T%SrvD%Input(iInput)%RotPwr = T%ED%y%RotPwr + T%SrvD%Input(iInput)%RotPwr = T%ED%y(ModSrc%Ins)%RotPwr - T%SrvD%Input(iInput)%LSShftFxa = T%ED%y%LSShftFxa - T%SrvD%Input(iInput)%LSShftFys = T%ED%y%LSShftFys - T%SrvD%Input(iInput)%LSShftFzs = T%ED%y%LSShftFzs + T%SrvD%Input(iInput)%LSShftFxa = T%ED%y(ModSrc%Ins)%LSShftFxa + T%SrvD%Input(iInput)%LSShftFys = T%ED%y(ModSrc%Ins)%LSShftFys + T%SrvD%Input(iInput)%LSShftFzs = T%ED%y(ModSrc%Ins)%LSShftFzs case (Custom_SED_to_SrvD) diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 index b75a16582f..858c28618d 100644 --- a/modules/openfast-library/src/FAST_ModGlue.f90 +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -663,12 +663,13 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, real(DbKi) :: error logical :: ProcessAzimuth integer(IntKi) :: i, j, iy + integer(IntKi), parameter :: iED = 1 ErrStat = ErrID_None ErrMsg = "" ! Get current azimuth angle from ElastoDyn output - psi = real(T%ED%y%LSSTipPxa, R8Ki) + psi = real(T%ED%y(iED)%LSSTipPxa, R8Ki) call Zero2TwoPi(psi) ! Cyclic shift psi buffer and set first index to new psi @@ -714,7 +715,7 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ! Initialize psi buffer for interpolation based on time step and rotor speed do i = 1, size(m%CS%psi_buffer) - m%CS%psi_buffer(i) = psi - (i - 1)*p_FAST%DT*T%ED%y%LSS_Spd + m%CS%psi_buffer(i) = psi - (i - 1)*p_FAST%DT*T%ED%y(iED)%LSS_Spd end do ! Initialize output buffer by copying outputs from first buffer location @@ -809,12 +810,12 @@ subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ! Forcing linearization if time is close to tmax (with sufficient margin) ! If rotor has nonzero speed - if (T%ED%p%RotSpeed > 0) then + if (T%ED%p(iED)%RotSpeed > 0) then ! If simulation is at least 10 revolutions, and error in rotor speed less than 0.1% - if ((p_FAST%TMax > 10*(TwoPi_D)/T%ED%p%RotSpeed) .and. & - (t_global >= p_FAST%TMax - 2._DbKi*(TwoPi_D)/T%ED%p%RotSpeed)) then - if (abs(T%ED%y%RotSpeed - T%ED%p%RotSpeed)/T%ED%p%RotSpeed < 0.001) then + if ((p_FAST%TMax > 10*(TwoPi_D)/T%ED%p(iED)%RotSpeed) .and. & + (t_global >= p_FAST%TMax - 2._DbKi*(TwoPi_D)/T%ED%p(iED)%RotSpeed)) then + if (abs(T%ED%y(iED)%RotSpeed - T%ED%p(iED)%RotSpeed)/T%ED%p(iED)%RotSpeed < 0.001) then m%CS%ForceLin = .true. end if end if @@ -895,6 +896,7 @@ subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbi integer(IntKi) :: ix, iz, iu, iy integer(IntKi) :: Un integer(IntKi) :: StateLinIndex, InputLinIndex + integer(IntKi), parameter :: iED = 1 character(200) :: SimStr character(MaxWrScrLen) :: BlankLine character(1024) :: LinRootName @@ -907,7 +909,7 @@ subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbi ! Write message to screen BlankLine = "" call WrOver(BlankLine) ! BlankLine contains MaxWrScrLen spaces - SimStr = '(RotSpeed='//trim(Num2LStr(Turbine%ED%y%RotSpeed*RPS2RPM, Fmt))//' rpm, BldPitch1='//trim(Num2LStr(Turbine%ED%y%BlPitch(1)*R2D, Fmt))//' deg)' + SimStr = '(RotSpeed='//trim(Num2LStr(Turbine%ED%y(iED)%RotSpeed*RPS2RPM, Fmt))//' rpm, BldPitch1='//trim(Num2LStr(Turbine%ED%y(iED)%BlPitch(1)*R2D, Fmt))//' deg)' call WrOver(' Performing linearization '//trim(Num2LStr(m%Lin%TimeIndex))//' at simulation time '//TRIM(Num2LStr(t_global))//' s. '//trim(SimStr)) call WrScr('') @@ -926,8 +928,8 @@ subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbi !---------------------------------------------------------------------------- ! Get parameters - y_FAST%Lin%RotSpeed = Turbine%ED%y%RotSpeed - y_FAST%Lin%Azimuth = Turbine%ED%y%LSSTipPxa + y_FAST%Lin%RotSpeed = Turbine%ED%y(iED)%RotSpeed + y_FAST%Lin%Azimuth = Turbine%ED%y(iED)%LSSTipPxa ! Assemble linearization root file name LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(m%Lin%TimeIndex)) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 4113cb4ef5..2d83f23c4a 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -336,7 +336,6 @@ typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Arr # [ the last dimension of each allocatable array is for the instance of BeamDyn being used ] # note that I'm making the allocatable-for-instance-used part INSIDE the data type (as opposed to an array of IceDyn_Data types) because I want to pass arrays of x, xd, z, x_pred, etc) typedef FAST BeamDyn_Data BD_ContinuousStateType x {:}{:} - - "Continuous states" -typedef ^ ^ BD_ContinuousStateType dxdt {:} - - "Continuous state derivatives" typedef ^ ^ BD_DiscreteStateType xd {:}{:} - - "Discrete states" typedef ^ ^ BD_ConstraintStateType z {:}{:} - - "Constraint states" typedef ^ ^ BD_OtherStateType OtherSt {:}{:} - - "Other states" @@ -347,16 +346,15 @@ typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with Input typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" # ..... ElastoDyn data ....................................................................................................... -typedef FAST ElastoDyn_Data ED_ContinuousStateType x {:} - - "Continuous states" -typedef ^ ^ ED_ContinuousStateType dxdt - - - "Continuous state derivatives" -typedef ^ ^ ED_DiscreteStateType xd {:} - - "Discrete states" -typedef ^ ^ ED_ConstraintStateType z {:} - - "Constraint states" -typedef ^ ^ ED_OtherStateType OtherSt {:} - - "Other states" -typedef ^ ^ ED_ParameterType p - - - "Parameters" -typedef ^ ^ ED_OutputType y - - - "System outputs" -typedef ^ ^ ED_MiscVarType m - - - "Misc (optimization) variables not associated with time" -typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef FAST ElastoDyn_Data ED_ContinuousStateType x {:}{:} - - "Continuous states" +typedef ^ ^ ED_DiscreteStateType xd {:}{:} - - "Discrete states" +typedef ^ ^ ED_ConstraintStateType z {:}{:} - - "Constraint states" +typedef ^ ^ ED_OtherStateType OtherSt {:}{:} - - "Other states" +typedef ^ ^ ED_ParameterType p {:} - - "Parameters" +typedef ^ ^ ED_OutputType y {:} - - "System outputs" +typedef ^ ^ ED_MiscVarType m {:} - - "Misc (optimization) variables not associated with time" +typedef ^ ^ ED_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" # ..... Simplified-ElastoDyn data ............................................................................................ @@ -673,7 +671,7 @@ typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearizati # ..... FAST_InitData data ....................................................................................................... typedef ^ FAST_InitData ED_InitInputType InData_ED - - - "ED Initialization input data" -typedef ^ FAST_InitData ED_InitOutputType OutData_ED - - - "ED Initialization output data" +typedef ^ FAST_InitData ED_InitOutputType OutData_ED : - - "ED Initialization output data" typedef ^ FAST_InitData SED_InitInputType InData_SED - - - "SED Initialization input data" typedef ^ FAST_InitData SED_InitOutputType OutData_SED - - - "SED Initialization output data" typedef ^ FAST_InitData BD_InitInputType InData_BD - - - "BD Initialization input data" diff --git a/modules/openfast-library/src/FAST_SS_Solver.f90 b/modules/openfast-library/src/FAST_SS_Solver.f90 deleted file mode 100644 index d5da13d704..0000000000 --- a/modules/openfast-library/src/FAST_SS_Solver.f90 +++ /dev/null @@ -1,2167 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2020 Envision Energy USA, National Renewable Energy Laboratory -! -! This file is part of FAST. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -!********************************************************************************************************************************** -!> This module contains the routines used by FAST to solve input-output equations and to advance states. -MODULE FAST_SS_Solver - - USE FAST_SOLVER - USE FAST_Linear - USE FAST_Subs - USE BeamDyn_Subs, ONLY: BD_CrvMatrixR, BD_CrvExtractCrv - - IMPLICIT NONE - - REAL(DbKi), PARAMETER :: SS_t_global = 0.0_DbKi - REAL(DbKi), PARAMETER :: UJacSclFact_x = 1.0d3 - - LOGICAL, PARAMETER :: output_debugging = .false. - -CONTAINS -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SteadyStateCCSD( caseData, p_FAST, y_FAST, m_FAST, ED, BD, InputIndex, ErrStat, ErrMsg ) - - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - INTEGER(IntKi) :: i - INTEGER(IntKi) :: k - INTEGER(IntKi) :: BldMeshNode - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateCCSD' - REAL(R8Ki) :: Omega_Hub(3) - REAL(R8Ki) :: position(3) - REAL(R8Ki) :: omega_cross_position(3) - - ErrStat = ErrID_None - ErrMsg = "" - - IF (p_FAST%CompElast == Module_ED) THEN - CALL ED_CalcContStateDeriv( SS_t_global, ED%Input(InputIndex), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), & - ED%OtherSt(STATE_CURR), ED%m, ED%x(STATE_PRED), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ELSEIF (p_FAST%CompElast == Module_BD) THEN - Omega_Hub(1) = caseData%RotSpeed - Omega_Hub(2:3) = 0.0_R8Ki - - DO K = 1,p_FAST%nBeams - CALL BD_CalcContStateDeriv( SS_t_global, BD%Input(InputIndex,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & - BD%OtherSt(k,STATE_CURR), BD%m(k), BD%x(k,STATE_PRED), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! subtract xdot(y) here: - ! note that this only works when the BldMotion mesh is on the FE nodes - do i=2,BD%p(k)%node_total ! the first node isn't technically a state - BldMeshNode = BD%p(k)%NdIndx(i) - position = BD%y(k)%BldMotion%Position(:,BldMeshNode) + BD%y(k)%BldMotion%TranslationDisp(:,BldMeshNode) - omega_cross_position = cross_product( Omega_Hub, position ) - - BD%x(k, STATE_PRED)%q( 1:3,i) = BD%x(k, STATE_PRED)%q( 1:3,i) - omega_cross_position - BD%x(k, STATE_PRED)%q( 4:6,i) = BD%x(k, STATE_PRED)%q( 4:6,i) - Omega_Hub - BD%x(k, STATE_PRED)%dqdt( 1:3,i) = BD%x(k, STATE_PRED)%dqdt( 1:3,i) - cross_product( Omega_Hub, omega_cross_position ) - end do - - END DO - END IF - -END SUBROUTINE SteadyStateCCSD -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SteadyStateCalculatedInputs( p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, InputIndex, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateCalculatedInputs' - - ErrStat = ErrID_None - ErrMsg = "" - - ! transfer the motions first: - CALL SS_AD_InputSolve( p_FAST, AD%Input(InputIndex), ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! transfer the loads next: - IF (p_FAST%CompElast == Module_ED) THEN - CALL SS_ED_InputSolve( p_FAST, ED%Input(InputIndex), ED%y, AD%y, AD%Input(InputIndex), MeshMapData, ErrStat2, ErrMsg2 ) - - ELSEIF (p_FAST%CompElast == Module_BD) THEN - CALL SS_BD_InputSolve( p_FAST, BD, AD%y, AD%Input(InputIndex), MeshMapData, InputIndex, ErrStat2, ErrMsg2 ) - END IF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - -END SUBROUTINE SteadyStateCalculatedInputs -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade load inputs required for BD. -SUBROUTINE SS_BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, InputIndex, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-BD load transfer) - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SS_BD_InputSolve' - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - - ! BD inputs on blade from AeroDyn - - if (p_FAST%BD_OutputSibling) then - - DO K = 1, p_FAST%NumBl_Lin ! we don't need all blades here: p_FAST%nBeams ! Loop through all blades - - CALL Transfer_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(InputIndex,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), BD%y(k)%BldMotion ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - END DO - - else - DO K = 1, p_FAST%NumBl_Lin ! we don't need all blades here: p_FAST%nBeams ! Loop through all blades - - ! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: - CALL Transfer_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL Transfer_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(InputIndex,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - END DO - end if - - - -END SUBROUTINE SS_BD_InputSolve -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade-load ElastoDyn inputs from blade 1 to the other blades. -SUBROUTINE SS_BD_InputSolve_OtherBlades( p_FAST, BD, MeshMapData, InputIndex ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t - - TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: J ! Loops through nodes - - - DO k = p_FAST%NumBl_Lin+1,p_FAST%nBeams - DO j=1,BD%Input(InputIndex,k)%DistrLoad%NNodes - BD%Input(InputIndex,k)%DistrLoad%Force( :,j) = MATMUL(BD%Input(InputIndex,1)%DistrLoad%Force( :,j), MeshMapData%HubOrient(:,:,k) ) - BD%Input(InputIndex,k)%DistrLoad%Moment(:,j) = MATMUL(BD%Input(InputIndex,1)%DistrLoad%Moment(:,j), MeshMapData%HubOrient(:,:,k) ) - END DO - END DO - -END SUBROUTINE SS_BD_InputSolve_OtherBlades - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade load inputs required for ED. -SUBROUTINE SS_ED_InputSolve( p_FAST, u_ED, y_ED, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-ED load transfer) - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SS_ED_InputSolve' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - ! ED inputs on blade from AeroDyn - - DO K = 1, p_FAST%NumBl_Lin !we don't need all blades here: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) - CALL Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - -END SUBROUTINE SS_ED_InputSolve -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade-load ElastoDyn inputs from blade 1 to the other blades. -SUBROUTINE SS_ED_InputSolve_OtherBlades( p_FAST, u_ED, MeshMapData ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t - TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: J ! Loops through nodes - - - DO k = p_FAST%NumBl_Lin+1,size(u_ED%BladePtLoads,1) - DO j=1,u_ED%BladePtLoads(k)%NNodes - u_ED%BladePtLoads(k)%Force( :,j) = MATMUL(u_ED%BladePtLoads(1)%Force( :,j), MeshMapData%HubOrient(:,:,k) ) - u_ED%BladePtLoads(k)%Moment(:,j) = MATMUL(u_ED%BladePtLoads(1)%Moment(:,j), MeshMapData%HubOrient(:,:,k) ) - END DO - END DO - -END SUBROUTINE SS_ED_InputSolve_OtherBlades - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade-motion AeroDyn inputs. -SUBROUTINE SS_AD_InputSolve( p_FAST, u_AD, y_ED, BD, MeshMapData, ErrStat, ErrMsg ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module - TYPE(BeamDyn_Data), INTENT(IN) :: BD !< The data from BeamDyn (want the outputs only, but it's in an array) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_AD_InputSolve' - - - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Set the inputs from structure: - !------------------------------------------------------------------------------------------------- - IF (p_FAST%CompElast == Module_ED ) THEN - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: size(y_ED%BladeLn2Mesh) - CALL Transfer_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) - END DO - - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - - ! get them from BeamDyn - DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: size(u_AD%BladeMotion) - CALL Transfer_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) - END DO - - END IF - - ! make sure these are the prescribed values: - DO k = 1,p_FAST%NumBl_Lin !we don't need all blades here: size(u_AD%BladeMotion,1) - u_AD%rotors(1)%BladeMotion(k)%RotationVel = 0.0_ReKi - u_AD%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi - END DO - - -END SUBROUTINE SS_AD_InputSolve -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade-motion AeroDyn inputs. -SUBROUTINE SS_AD_InputSolve_OtherBlades( p_FAST, u_AD, MeshMapData ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: J ! Loops through nodes - - - DO k = p_FAST%NumBl_Lin+1,size(u_AD%rotors(1)%BladeMotion,1) - DO j=1,u_AD%rotors(1)%BladeMotion(k)%NNodes - u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(:,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%TranslationDisp(:,j), MeshMapData%HubOrient(:,:,k) ) - u_AD%rotors(1)%BladeMotion(k)%Orientation( :,:,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%Orientation( :,:,j), MeshMapData%HubOrient(:,:,k) ) - u_AD%rotors(1)%BladeMotion(k)%TranslationVel( :,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%TranslationVel( :,j), MeshMapData%HubOrient(:,:,k) ) - END DO - END DO - -END SUBROUTINE SS_AD_InputSolve_OtherBlades - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine performs the Input-Output solve for the steady-state solver. -!! Note that this has been customized for the physics in the problems and is not a general solution. -SUBROUTINE SolveSteadyState( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData , ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< temporary storage space for jacobian matrix - - TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType) , INTENT(INOUT) :: y_FAST !< Glue-code output file values - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - CHARACTER(*), PARAMETER :: RoutineName = 'SolveSteadyState' - -!bjj: store these so that we don't reallocate every time? - REAL(R8Ki) :: u( p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules - REAL(R8Ki) :: u_delta( p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules - REAL(R8Ki) :: Fn_U_Resid( p_FAST%SizeJac_Opt1(1)) ! Residual of U - REAL(R8Ki) :: err - REAL(R8Ki) :: err_prev - REAL(R8Ki), PARAMETER :: reduction_factor = 0.1_R8Ki - - INTEGER(IntKi) :: nb ! loop counter (blade number) - INTEGER(IntKi) :: MaxIter ! maximum number of iterations - INTEGER(IntKi) :: K ! Input-output-solve iteration counter - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - LOGICAL :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput - - ! Note: p_FAST%UJacSclFact is a scaling factor that gets us similar magnitudes between loads and accelerations... - -!bjj: note, that this routine may have a problem if there is remapping done - - ErrStat = ErrID_None - ErrMsg = "" - !---------------------------------------------------------------------------------------------------- - ! Some record keeping stuff: - !---------------------------------------------------------------------------------------------------- - - CALL SteadyStateUpdateStates( caseData, p_FAST, ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL SteadyStatePrescribedInputs( caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD ) - CALL CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat2, ErrMsg2, MESH_UPDATECOPY ) ! COPY the inputs to the temp copy (so we get updated input values) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - K = 0 - err = 1.0E3 - err_prev = err - - y_FAST%DriverWriteOutput(SS_Indx_Err) = -1 - y_FAST%DriverWriteOutput(SS_Indx_Iter) = 0 - y_FAST%DriverWriteOutput(SS_Indx_TSR) = caseData%tsr - y_FAST%DriverWriteOutput(SS_Indx_WS) = caseData%windSpeed - y_FAST%DriverWriteOutput(SS_Indx_Pitch) = caseData%Pitch*R2D - y_FAST%DriverWriteOutput(SS_Indx_RotSpeed) = caseData%RotSpeed*RPS2RPM - - MaxIter = p_FAST%KMax + 1 ! adding 1 here so that we get the error calculated correctly when we hit the max iteration - DO - - !------------------------------------------------------------------------------------------------- - ! Calculate outputs, based on inputs at this time - !------------------------------------------------------------------------------------------------- - GetWriteOutput = K > 0 ! we can skip this on the first call (because we always calculate outputs twice) - - IF ( p_FAST%CompElast == Module_ED ) THEN - CALL ED_CalcOutput( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompElast == Module_BD) THEN - do nb=1,p_FAST%nBeams - CALL BD_CalcOutput( SS_t_global, BD%Input(1,nb), BD%p(nb), BD%x(nb, STATE_CURR), BD%xd(nb, STATE_CURR), BD%z(nb, STATE_CURR), BD%OtherSt(nb, STATE_CURR), & - BD%y(nb), BD%m(nb), ErrStat2, ErrMsg2, GetWriteOutput ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end do - END IF - - IF (K==0) THEN - - ! set the AD input guess based on the structural output (this will ensure that the pitch is accounted for in the fixed aero-map solve:): - CALL SS_AD_InputSolve( p_FAST, AD%Input(1), ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SS_AD_InputSolve_OtherBlades( p_FAST, AD%Input(1), MeshMapData ) ! transfer results from blade 1 to other blades - - !---------------------------------------------------------------------------------------------------- - ! set up x-u vector, using local initial guesses: - !---------------------------------------------------------------------------------------------------- - CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) - - END IF - - CALL AD_CalcOutput(SS_t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, GetWriteOutput ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - call resetInputsAndStates() - RETURN - END IF - - IF (K >= MaxIter) EXIT - - - !------------------------------------------------------------------------------------------------- - ! Calculate residual and the Jacobian: - ! (note that we don't want to change module%Input(1), here) - ! Also, the residual uses values from y_FAST, so do this before calculating the jacobian - !------------------------------------------------------------------------------------------------- - CALL SteadyStateSolve_Residual(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, u, Fn_U_Resid, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - call resetInputsAndStates() - RETURN - END IF - - IF ( mod( K, p_FAST%N_UJac ) == 0 ) THEN - CALL FormSteadyStateJacobian( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - call Precondition_Jmat(p_FAST, y_FAST, Jmat) - - ! Get the LU decomposition of this matrix using a LAPACK routine: - ! The result is of the form Jmat = P * L * U - - CALL LAPACK_getrf( M=size(Jmat,1), N=size(Jmat,2), & - A=Jmat, IPIV=MeshMapData%Jacobian_pivot, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - call resetInputsAndStates() - RETURN - END IF - - END IF - - !------------------------------------------------------------------------------------------------- - ! Solve for delta u: Jac*u_delta = - Fn_U_Resid - ! using the LAPACK routine - !------------------------------------------------------------------------------------------------- - - u_delta = -Fn_U_Resid - CALL LAPACK_getrs( TRANS="N", N=SIZE(Jmat,1), A=Jmat, & - IPIV=MeshMapData%Jacobian_pivot, B=u_delta, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - !------------------------------------------------------------------------------------------------- - ! check for error, update inputs if necessary, and iterate again - !------------------------------------------------------------------------------------------------- - err_prev = err - err = DOT_PRODUCT(u_delta, u_delta) - y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err) / p_FAST%SizeJac_Opt1(1) - - IF ( err <= p_FAST%TolerSquared) THEN - IF (K==0) THEN ! the error will be incorrect in this instance, but the outputs will be better - MaxIter = K - ELSE - EXIT - END IF - END IF - - IF (K >= p_FAST%KMax ) EXIT - IF (K > 5 .and. err > 1.0E35) EXIT ! this is obviously not converging. Let's try something else. - - !------------------------------------------------------------------------------------------------- - ! modify inputs and states for next iteration - !------------------------------------------------------------------------------------------------- - if (err > err_prev ) then - u_delta = u_delta * reduction_factor ! don't take a full step if we're getting farther from the solution! - err_prev = err_prev * reduction_factor - end if - - CALL Add_SteadyState_delta( p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData ) - - !u = u + u_delta - CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) - - K = K + 1 - y_FAST%DriverWriteOutput(SS_Indx_Iter) = k - - END DO ! K - - IF ( p_FAST%CompElast == Module_BD ) THEN - ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: - CALL ED_CalcOutput( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - call resetInputsAndStates() - -contains - subroutine resetInputsAndStates() - - IF ( err > p_FAST%TolerSquared ) THEN - CALL SetErrStat(ErrID_Severe, 'Steady-state solver did not converge.', ErrStat, ErrMsg, RoutineName) - - IF ( err > 100.0 ) THEN - ! if we didn't get close on the solution, we should reset the states and inputs because they very well could - ! lead to numerical issues on the next iteration. Here, set the initial values to 0: - - ! because loads occasionally get very large when it fails, manually set these to zero (otherwise - ! roundoff can lead to non-zero values with the method below, which is most useful for states) - IF( p_FAST%CompElast == Module_BD ) THEN - DO K = 1,p_FAST%nBeams - BD%Input(1,k)%DistrLoad%Force = 0.0_ReKi - BD%Input(1,k)%DistrLoad%Moment = 0.0_ReKi - END DO - - END IF - - CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) ! find the values we have been modifying (in u... continuous states and inputs) - CALL Add_SteadyState_delta( p_FAST, y_FAST, -u, AD, ED, BD, MeshMapData ) ! and reset them to 0 (by adding -u) - - END IF - END IF - end subroutine resetInputsAndStates - -END SUBROUTINE SolveSteadyState -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SteadyStateSolve_Residual(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, u_in, u_resid, ErrStat, ErrMsg) - ! Passed variables - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType) , INTENT(INOUT) :: y_FAST !< Glue-code output file values - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules - REAL( R8Ki ) , INTENT(IN ) :: u_in(:) !< The residual of the array of states and inputs we are trying to solve for - REAL( R8Ki ) , INTENT( OUT) :: u_resid(:) !< The residual of the array of states and inputs we are trying to solve for - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - INTEGER(IntKi) :: Indx_u_start - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateSolve_Residual' - - integer, parameter :: InputIndex = 2 - - ErrStat = ErrID_None - ErrMsg = "" - - !note: prescribed inputs are already set in both InputIndex=1 and InputIndex=2 so we can ignore them here - - call SteadyStateCCSD( caseData, p_FAST, y_FAST, m_FAST, ED, BD, 1, ErrStat2, ErrMsg2 ) ! use current inputs and calculate CCSD in STATE_PRED - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the Create_SS_Vector - call SteadyStateCalculatedInputs( p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, InputIndex, ErrStat2, ErrMsg2 ) ! calculate new inputs and store in InputIndex=2 - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !.................. - ! Pack the output "residual vector" with these state derivatives and new inputs: - !.................. - CALL Create_SS_Vector( p_FAST, y_FAST, U_Resid, AD, ED, BD, InputIndex, STATE_PRED ) - - ! Make the inputs a residual (subtract from previous inputs) - Indx_u_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - U_Resid(Indx_u_start : ) = u_in(Indx_u_start : ) - U_Resid(Indx_u_start : ) - -END SUBROUTINE SteadyStateSolve_Residual -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine saves the current states so they can be used to compute the residual. -SUBROUTINE CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat, ErrMsg, CtrlCode ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi), INTENT(IN ) :: CtrlCode !< mesh copy control code (new, vs update) - - ! local variables - INTEGER(IntKi) :: k ! generic loop counters - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'CopyStatesInputs' - - - ErrStat = ErrID_None - ErrMsg = "" - - - !---------------------------------------------------------------------------------------- - !! copy the operating point of the states and inputs - !---------------------------------------------------------------------------------------- - - ! ElastoDyn: copy states and inputs - IF ( CtrlCode == MESH_NEWCOPY ) THEN - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - CALL ED_CopyInput (ED%Input(1), ED%Input(2), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! BeamDyn: copy states and inputs to OP array - IF ( p_FAST%CompElast == Module_BD ) THEN - - IF ( CtrlCode == MESH_NEWCOPY ) THEN - DO k=1,p_FAST%nBeams - CALL BD_CopyContState (BD%x( k,STATE_CURR),BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR),BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR),BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR),BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF - - DO k=1,p_FAST%nBeams - CALL BD_CopyInput (BD%Input(1,k), BD%Input(2,k), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF - - - - ! AeroDyn: copy states and inputs to OP array - IF ( CtrlCode == MESH_NEWCOPY ) THEN - CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState( AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - CALL AD_CopyInput (AD%Input(1), AD%Input(2), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE CopyStatesInputs -!---------------------------------------------------------------------------------------------------------------------------------- -! This routine sets the rotor speed for the steady state cases. Rotor speed is a continuous state. -SUBROUTINE SteadyStateUpdateStates(CaseData, p_FAST, ED, ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: k ! generic loop counters - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateUpdateStates' - - - ErrStat = ErrID_None - ErrMsg = "" - - - ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed - -END SUBROUTINE SteadyStateUpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the preconditioned matrix, \f$ \hat{J} \f$, such that \f$ \hat{J} = S^(-1) J S \f$ with \f$S^(-1)\f$ defined -!! such that loads are scaled by p_FAST\%UJacSclFact. -SUBROUTINE Precondition_Jmat(p_FAST, y_FAST, Jmat) - - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - REAL(R8Ki), INTENT(INOUT) :: JMat(:,:) !< variable for steady-state solve (in is Jmat; out is Jmat_hat) - - - integer :: r, c, nx - - nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) - - !! Change J to J_hat: - do c=1,nx ! states are not loads: - - do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) - if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then - ! column is motion, but row is a load: - JMat(nx+r,c) = JMat(nx+r,c) / p_FAST%UJacSclFact - end if - end do - - end do - - - do c = 1,size(y_FAST%Lin%Glue%IsLoad_u) - - if ( y_FAST%Lin%Glue%IsLoad_u(c) ) then - - do r=1,nx ! states are not loads: - ! column is load, but row is a motion: - JMat(r,nx+c) = JMat(r,nx+c) * p_FAST%UJacSclFact - end do - - do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) - if ( .not. y_FAST%Lin%Glue%IsLoad_u(r) ) then - ! column is load, but row is a motion: - JMat(nx+r,nx+c) = JMat(nx+r,nx+c) * p_FAST%UJacSclFact - end if - end do - - else - - do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) - if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then - ! column is motion, but row is a load: - JMat(nx+r,nx+c) = JMat(nx+r,nx+c) / p_FAST%UJacSclFact - end if - end do - - end if - - end do - - - -END SUBROUTINE Precondition_Jmat - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine basically packs the relevant parts of the modules' inputs and states for use in the steady-state solver. -SUBROUTINE Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, InputIndex, StateIndex ) -!.................................................................................................................................. - TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Output variables for the glue code - REAL( R8Ki ) , INTENT(INOUT) :: u(:) !< The array of states and inputs we are trying to solve for - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - INTEGER(IntKi), INTENT(IN ) :: InputIndex - INTEGER(IntKi), INTENT(IN ) :: StateIndex - - ! local variables: - INTEGER :: n - INTEGER :: fieldIndx - INTEGER :: node - INTEGER :: indx, indx_last - INTEGER :: i, j, k - INTEGER :: nx, nStates - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - - - nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) ! make sure this is only STRUCTURAL states!!! - - ! structural code states: - IF ( p_FAST%CompElast == Module_ED ) THEN !bjj: QUESTION/FIXME: does this work when BD is used? Don't we have a combination of ED and BD states then??? Or are these only states on the blades? - nStates = nx - - if (StateIndex == STATE_PRED) then !this is actually the derivative of the current states instead of the value of the current states - do j = 1, nStates - indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + 1) - u(j) = ED%x( StateIndex )%QDT(indx) - end do - else - do j = 1, nStates - indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + 1) - u(j) = ED%x( StateIndex )%QT(indx) - end do - end if - - ELSEIF ( p_FAST%CompElast == Module_BD ) THEN - nStates = nx / 2 - - DO k=1,p_FAST%nBeams - indx = 1 - do i=2,BD%p(k)%node_total ! the first node isn't technically a state - indx_last = indx + BD%p(k)%dof_node - 1 - u( indx:indx_last ) = BD%x(k, StateIndex)%q( :,i) - u(nStates+indx:indx_last+nStates) = BD%x(k, StateIndex)%dqdt( :,i) - indx = indx_last+1 - end do - END DO - END IF !CompElast - - - - ! inputs: - ! we are at u_delta(nx+1 : end) - n = nx+1 - IF ( p_FAST%CompElast == Module_ED ) THEN - - do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(ED%Input(InputIndex)%BladePtLoads,1) ! Loop through all blades - - do node = 1, ED%Input(InputIndex)%BladePtLoads(k)%NNodes - do fieldIndx = 1,3 - u(n) = ED%Input(InputIndex)%BladePtLoads(k)%Force( fieldIndx,node) / p_FAST%UJacSclFact - n = n+1 - end do - end do - - do node = 1, ED%Input(InputIndex)%BladePtLoads(k)%NNodes - do fieldIndx = 1,3 - u(n) = ED%Input(InputIndex)%BladePtLoads(k)%Moment( fieldIndx,node) / p_FAST%UJacSclFact - n = n+1 - end do - end do - - end do - - ELSEIF ( p_FAST%CompElast == Module_BD ) THEN - - do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: p_FAST%nBeams ! Loop through all blades - - do node = 1, BD%Input(InputIndex,k)%DistrLoad%NNodes - do fieldIndx = 1,3 - u(n) = BD%Input(InputIndex,k)%DistrLoad%Force( fieldIndx,node) / p_FAST%UJacSclFact - n = n+1 - end do - end do - - do node = 1, BD%Input(InputIndex,k)%DistrLoad%NNodes - do fieldIndx = 1,3 - u(n) = BD%Input(InputIndex,k)%DistrLoad%Moment( fieldIndx,node) / p_FAST%UJacSclFact - n = n+1 - end do - end do - - end do - END IF !CompElast - - - ! AeroDyn - DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(AD%Input(InputIndex)%BladeMotion) - do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes - do fieldIndx = 1,3 - u(n) = AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) - n = n+1 - end do - end do - - do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes - CALL DCM_LogMap( AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%Orientation(:,:,node), u(n:n+2), ErrStat2, ErrMsg2 ) - n = n+3 - end do - - do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes - do fieldIndx = 1,3 - u(n) = AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%TranslationVel( fieldIndx,node) - n = n+1 - end do - end do - - END DO - - -END SUBROUTINE Create_SS_Vector - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine adds u_delta to the corresponding mesh field and scales it as appropriate -SUBROUTINE Add_SteadyState_delta( p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData ) -!.................................................................................................................................. - TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Output variables for the glue code - REAL( R8Ki ) , INTENT(IN ) :: u_delta(:) !< The delta amount to add to the appropriate mesh fields - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(FAST_ModuleMapType) , INTENT(IN ) :: MeshMapData !< data for mapping meshes between modules - - ! local variables - INTEGER :: n - INTEGER :: fieldIndx - INTEGER :: node - INTEGER :: indx, indx_last - INTEGER :: i, j, k - INTEGER :: nx, nStates - - REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: rotation(3,3) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - - nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) - - ! structural code states: - IF ( p_FAST%CompElast == Module_ED ) THEN - nStates = nx - - do j = 1, nStates - - do k=1,ED%p%NActvDOF_Stride ! transfer these states to the other blades (this means that the original states MUST be set the same for all blades!!!) - indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + k) - - ED%x( STATE_CURR)%QT(indx) = ED%x( STATE_CURR)%QT( indx) + u_delta(j) - ED%x( STATE_CURR)%QDT(indx) = 0.0_R8Ki !ED%x( STATE_CURR)%QDT(indx) + u_delta(j+nStates) - end do - - end do - - - ELSEIF ( p_FAST%CompElast == Module_BD ) THEN - nStates = nx / 2 - - ! see BD's Perturb_x function: - - DO k=1,p_FAST%nBeams - indx = 1 - do i=2,BD%p(k)%node_total - indx_last = indx + BD%p(k)%dof_node - 1 - BD%x(k, STATE_CURR)%dqdt( :,i) = BD%x(k, STATE_CURR)%dqdt(:,i) + u_delta(nStates+indx:indx_last+nStates) - BD%x(k, STATE_CURR)%q( 1:3,i) = BD%x(k, STATE_CURR)%q( 1:3,i) + u_delta( indx:indx+2 ) - - ! w-m parameters - call BD_CrvMatrixR( BD%x(k, STATE_CURR)%q( 4:6,i), rotation ) ! returns the rotation matrix (transpose of DCM) that was stored in the state as a w-m parameter - orientation = transpose(rotation) - - call PerturbOrientationMatrix( Orientation, Perturbations = u_delta( indx+3:indx_last) ) - - rotation = transpose(orientation) - call BD_CrvExtractCrv( rotation, BD%x(k, STATE_CURR)%q( 4:6,i), ErrStat2, ErrMsg2 ) ! return the w-m parameters of the new orientation - - indx = indx_last+1 - end do - END DO - END IF !CompElast - - - - ! inputs: - ! we are at u_delta(nx+1 : end) - n = nx+1 - IF ( p_FAST%CompElast == Module_ED ) THEN - - do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(ED%Input(1)%BladePtLoads,1) ! Loop through all blades - - do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes - do fieldIndx = 1,3 - ED%Input(1)%BladePtLoads(k)%Force( fieldIndx,node) = ED%Input(1)%BladePtLoads(k)%Force( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact - n = n+1 - end do - end do - - do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes - do fieldIndx = 1,3 - ED%Input(1)%BladePtLoads(k)%Moment( fieldIndx,node) = ED%Input(1)%BladePtLoads(k)%Moment( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact - n = n+1 - end do - end do - - end do - - call SS_ED_InputSolve_OtherBlades( p_FAST, ED%Input(1), MeshMapData ) - - ELSEIF ( p_FAST%CompElast == Module_BD ) THEN - - do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: p_FAST%nBeams ! Loop through all blades - - do node = 1, BD%Input(1,k)%DistrLoad%NNodes - do fieldIndx = 1,3 - BD%Input(1,k)%DistrLoad%Force( fieldIndx,node) = BD%Input(1,k)%DistrLoad%Force( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact - n = n+1 - end do - end do - - do node = 1, BD%Input(1,k)%DistrLoad%NNodes - do fieldIndx = 1,3 - BD%Input(1,k)%DistrLoad%Moment( fieldIndx,node) = BD%Input(1,k)%DistrLoad%Moment( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact - n = n+1 - end do - end do - - end do - - call SS_BD_InputSolve_OtherBlades( p_FAST, BD, MeshMapData, 1 ) ! 1 is for the input index (i.e., Input(1,Blades2-end) - - END IF !CompElast - - - ! AeroDyn - DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(AD%Input(1)%BladeMotion) - do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes - do fieldIndx = 1,3 - AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) + u_delta(n) - n = n+1 - end do - end do - - do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes - CALL PerturbOrientationMatrix( AD%Input(1)%rotors(1)%BladeMotion(k)%Orientation(:,:,node), Perturbations = u_delta(n:n+2) ) - n = n+3 - end do - - do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes - AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel( :,node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel( :,node) + u_delta(n:n+2) - - n = n+3 - end do - - END DO - - - ! now update the inputs on other blades: - CALL SS_AD_InputSolve_OtherBlades( p_FAST, AD%Input(1), MeshMapData ) ! transfer results from blade 1 to other blades - - -END SUBROUTINE Add_SteadyState_delta - -!---------------------------------------------------------------------------------------------------------------------------------- - - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SteadyStatePrescribedInputs( caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD ) - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - INTEGER(IntKi) :: k - REAL(R8Ki) :: theta(3) - - ! Set prescribed inputs for all of the modules in the steady-state solve - - - ED%Input(1)%TwrAddedMass = 0.0_ReKi - ED%Input(1)%PtfmAddedMass = 0.0_ReKi - - ED%Input(1)%TowerPtLoads%Force = 0.0 - ED%Input(1)%TowerPtLoads%Moment = 0.0 - ED%Input(1)%NacelleLoads%Force = 0.0 - ED%Input(1)%NacelleLoads%Moment = 0.0 - ED%Input(1)%HubPtLoad%Force = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 - ED%Input(1)%HubPtLoad%Moment = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 - - ED%Input(1)%BlPitchCom = caseData%Pitch - ED%Input(1)%YawMom = 0.0 - ED%Input(1)%HSSBrTrqC = 0.0 - ED%Input(1)%GenTrq = 0.0 - - ! BeamDyn - IF (p_FAST%CompElast == Module_BD) THEN - - !CALL ED_CalcOutput( 0.0_DbKi, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - DO k = 1,p_FAST%nBeams - BD%Input(1,k)%RootMotion%TranslationDisp = 0.0_ReKi - - theta = EulerExtract(BD%Input(1,k)%RootMotion%RefOrientation(:,:,1)) - theta(3) = -caseData%Pitch - BD%Input(1,k)%RootMotion%Orientation(:,:,1) = EulerConstruct(theta) - - BD%Input(1,k)%RootMotion%RotationVel(1,1) = caseData%RotSpeed !BD%Input(1,k)%RootMotion%RotationVel = ED%y_interp%BladeRootMotion(k)%RotationVel - BD%Input(1,k)%RootMotion%RotationVel(2:3,1) = 0.0_ReKi - - BD%Input(1,k)%RootMotion%TranslationVel(:,1) = cross_product( BD%Input(1,k)%RootMotion%RotationVel(:,1), BD%Input(1,k)%RootMotion%Position(:,1) - AD%Input(1)%rotors(1)%HubMotion%Position(:,1) ) ! ED%y_interp%BladeRootMotion(k)%TranslationVel - BD%Input(1,k)%RootMotion%TranslationAcc(:,1) = cross_product( BD%Input(1,k)%RootMotion%RotationVel(:,1), BD%Input(1,k)%RootMotion%TranslationVel(:,1) ) ! ED%y_interp%BladeRootMotion(k)%TranslationAcc - - BD%Input(1,k)%RootMotion%RotationAcc = 0.0_ReKi - END DO ! k=p_FAST%nBeams - - END IF ! BeamDyn - !BeamDyn's first "state" is not actually the state. So, do we need to do something with that????? - - - !AeroDyn - !note: i'm skipping the (unused) TowerMotion mesh - AD%Input(1)%rotors(1)%HubMotion%TranslationDisp = 0.0 - AD%Input(1)%rotors(1)%HubMotion%Orientation = AD%Input(1)%rotors(1)%HubMotion%RefOrientation - AD%Input(1)%rotors(1)%HubMotion%RotationVel(1, :) = caseData%RotSpeed - AD%Input(1)%rotors(1)%HubMotion%RotationVel(2:3,:) = 0.0_ReKi - - DO k = 1,size(AD%Input(1)%rotors(1)%BladeRootMotion,1) - theta = EulerExtract(AD%Input(1)%rotors(1)%BladeRootMotion(k)%RefOrientation(:,:,1)) - theta(3) = -caseData%Pitch - AD%Input(1)%rotors(1)%BladeRootMotion(k)%Orientation(:,:,1) = EulerConstruct(theta) !AD%Input(1)%BladeRootMotion(k)%RefOrientation - - AD%Input(1)%rotors(1)%BladeMotion(k)%RotationVel = 0.0_ReKi - !AD%Input(1)%rotors(1)%BladeMotion(k)%RotationAcc = 0.0_ReKi - AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi - END DO - - ! Set FlowField information -- AD calculates everything from the data stored in the FlowField pointer - AD%p%FlowField%Uniform%VelH(:) = caseData%WindSpeed - AD%p%FlowField%Uniform%LinShrV(:) = 0.0_ReKi - AD%p%FlowField%Uniform%AngleH(:) = 0.0_ReKi - AD%p%FlowField%PropagationDir = 0.0_ReKi - - AD%Input(1)%rotors(1)%UserProp = 0.0_ReKi - - -END SUBROUTINE SteadyStatePrescribedInputs -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE FormSteadyStateJacobian( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< temporary storage space for jacobian matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(1024) :: LinRootName - REAL(R8Ki), ALLOCATABLE :: dUdu(:,:) !< temporary storage space for jacobian matrix - REAL(R8Ki), ALLOCATABLE :: dUdy(:,:) !< temporary storage space for jacobian matrix - REAL(R8Ki), ALLOCATABLE :: dxdotdy(:,:) !< temporary storage space for jacobian matrix - - - INTEGER(IntKi) :: Un - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FormSteadyStateJacobian' - - ErrStat = ErrID_None - ErrMsg = "" - - Jmat = 0.0_R8Ki ! initialize everything we are not spec - Un = -1 - - ! these values may get printed in the linearization output files, so we'll set them here: - y_FAST%Lin%WindSpeed = caseData%WindSpeed - y_FAST%Lin%RotSpeed = caseData%RotSpeed - y_FAST%Lin%Azimuth = 0.0 - - LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) - - call GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, LinRootName, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - call GetGlueJacobians( dUdu, dUdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - if (output_debugging) then - call WrLinFile_txt_Head(SS_t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, Module_Glue, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - if (p_FAST%LinOutJac) then ! write these before they possibly get modified with LAPACK routines (in particular, dUdu) - call WrPartialMatrix( dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_u ) - call WrPartialMatrix( dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) - call WrPartialMatrix( dxdotdy, Un, p_FAST%OutFmt, 'dxdotdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) - end if - end if - - !----------------------------------------- - ! form J matrix - !----------------------------------------- - CALL GetBlock11(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL GetBlock12(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL GetBlock21(Jmat, dUdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL GetBlock22(Jmat, dUdy, dUdu, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - - if (output_debugging) then - if (p_FAST%LinOutJac) then - ! Jacobians - call WrPartialMatrix( Jmat, Un, p_FAST%OutFmt, 'J' ) - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) - end if - - m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 -CONTAINS - SUBROUTINE Cleanup() - - IF (ALLOCATED(dUdu)) DEALLOCATE(dUdu) - IF (ALLOCATED(dUdy)) DEALLOCATE(dUdy) - IF (ALLOCATED(dxdotdy)) DEALLOCATE(dxdotdy) - - if (Un > 0) close(Un) - - END SUBROUTINE Cleanup - -END SUBROUTINE FormSteadyStateJacobian -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, LinRootName, ErrStat, ErrMsg ) - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - REAL(R8Ki), ALLOCATABLE ,INTENT(INOUT) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - CHARACTER(*), INTENT(IN ) :: LinRootName - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki) :: OmegaSquared - INTEGER(IntKi) :: k - INTEGER(IntKi) :: i, r, c, nx - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'GetModuleJacobians' - - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------ - ! dx_dot/dy: - !------------------------ - if (.not. allocated(dxdotdy)) then - call AllocAry(dxdotdy, y_FAST%Lin%Glue%SizeLin(LIN_ContState_COL), y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'dxdotdy', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - dxdotdy = 0.0_R8Ki - - !..................... - ! Structure - !..................... - - y_FAST%Lin%RotSpeed = ED%y%RotSpeed - y_FAST%Lin%Azimuth = ED%y%LSSTipPxa - - !..................... - ! ElastoDyn - !..................... - if ( p_FAST%CompElast == Module_ED ) then - ! get the jacobians - call ED_JacobianPInput( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B, ModIdx=ED%p%IdxAeroMap ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call ED_JacobianPContState( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A, ModIdx=ED%p%IdxAeroMap ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get the operating point - if (output_debugging) then - call ED_GetOP( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, & - y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & - x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, & - dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx, ModIdx=ED%p%IdxAeroMap ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) return - - ! write the module matrices: - call WriteModuleLinearMatrices(Module_ED, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - !..................... - ! BeamDyn - !..................... - elseif ( p_FAST%CompElast == Module_BD ) then - - OmegaSquared = caseData%RotSpeed**2 - nx = size(dxdotdy,1)/2 - - do k=1,p_FAST%nBeams - - ! get the jacobians - call BD_JacobianPInput( SS_t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & - dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call BD_JacobianPContState( SS_t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, dXdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, & - StateRotation=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRotation) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (output_debugging) then - ! get the operating point (for writing to file only) - call BD_GetOP( SS_t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_u, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, & - x_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_x, dx_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) return - - ! write the module matrices: - call WriteModuleLinearMatrices(Module_BD, k, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - ! calculate dxdotdy here: - ! NOTE that this implies that the FEA nodes (states) are the same as the output nodes!!!! (note that we have overlapping nodes at the element end points) - r = 1 - do i=2,BD%p(k)%node_total ! the first node isn't technically a state - c = (BD%p(k)%NdIndx(i)-1)*3 + 1 ! BldMeshNode = BD%p(k)%NdIndx(i) - - !dxdotdy(r:r+2,c:c+2) = SkewSymMat( [p_FAST%RotSpeed, 0.0_ReKi, 0.0_ReKi] ) - dxdotdy(r+2,c+1) = caseData%RotSpeed - dxdotdy(r+1,c+2) = -caseData%RotSpeed - - ! derivative - dxdotdy(r+nx+1,c+1) = -OmegaSquared - dxdotdy(r+nx+2,c+2) = -OmegaSquared - - r = r + BD%p(k)%dof_node - end do - - end do ! k - - end if !BeamDyn - - - !..................... - ! AeroDyn - !..................... - if ( p_FAST%CompAero == Module_AD ) then - ! get the jacobians - call AD_JacobianPInput( SS_t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & - AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & - dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (output_debugging) then - ! get the operating point - call AD_GetOP( SS_t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & - AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & - u_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_u, & - y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) return - - - ! write the module matrices: - call WriteModuleLinearMatrices(Module_AD, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) RETURN - end if - - end if - - ! move all module-level matrices into system-wide glue matrices: - call Glue_FormDiag( p_FAST, y_FAST, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - -END SUBROUTINE GetModuleJacobians -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetGlueJacobians( dUdu, dUdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) - REAL(R8Ki), ALLOCATABLE, INTENT(INOUT) :: dUdu(:,:) !< temporary storage space for jacobian matrix - REAL(R8Ki), ALLOCATABLE, INTENT(INOUT) :: dUdy(:,:) !< temporary storage space for jacobian matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ThisModule - INTEGER(IntKi) :: i, j - INTEGER(IntKi) :: k - INTEGER(IntKi) :: r_start, r_end - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'GetGlueJacobians' - - - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------ - ! dU/du: - !------------------------ - if (.not. allocated(dUdu)) then - call AllocAry(dUdu, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'dUdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - dUdu = 0.0_R8Ki ! most of this matrix is zero, so we'll just initialize everything and set only the non-zero parts below - do j = 1,p_FAST%Lin_NumMods - ThisModule = p_FAST%Lin_ModOrder(j) - do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) - r_start = y_FAST%Lin%Modules(ThisModule)%Instance(k)%LinStartIndx(LIN_INPUT_COL) - r_end = r_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin( LIN_INPUT_COL) - 1 - do i = r_start,r_end - dUdu(i,i) = 1.0_R8Ki - end do - end do - end do - - - call LinearSS_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - IF (p_FAST%CompElast == Module_ED) THEN - call LinearSS_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), MeshMapData, dUdu, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ELSEIF (p_FAST%CompElast == Module_BD) THEN - call LinearSS_BD_InputSolve_du( p_FAST, y_FAST, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END IF - -!!! write the module matrices: -!!!call WriteModuleLinearMatrices(Module_AD, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) -!!! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -!!! if (ErrStat >=AbortErrLev) RETURN - - !------------------------ - ! dU/dy: - !------------------------ - if (.not. allocated(dUdy)) then - call AllocAry(dUdy, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'dUdy', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - dUdy = 0.0_R8Ki ! most of this matrix is zero, so we'll just initialize everything and set only the non-zero parts below - - - if (p_FAST%CompElast == Module_ED) then - call LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, ED%p, ED%Input(1), ED%y, AD%y, AD%Input(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - elseif (p_FAST%CompElast == MODULE_BD) then - call LinearSS_BD_InputSolve_dy( p_FAST, y_FAST, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - call LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - if (output_debugging) then - ! for debugging: - call Glue_GetOP(p_FAST, y_FAST, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) return - end if - -END SUBROUTINE GetGlueJacobians -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetBlock11(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat, ErrMsg) - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the upper left block: (1,1) - REAL(R8Ki), INTENT(IN ) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki), ALLOCATABLE :: blockMat(:,:) - INTEGER(IntKi) :: r_start, c_start, r, c - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock11' - - ErrStat = ErrID_None - ErrMsg = "" - - !--------------- - ! upper left corner of J matrix: size of A (uses only blade DOFs from the structural module) - !--------------- - call AllocAry(blockMat, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'block matrix 1,1', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - blockMat = y_FAST%Lin%Glue%A ! copy this so we don't overwrite y_FAST%Lin%Glue%A here - call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dxdotdy, y_FAST%Lin%Glue%C, 1.0_R8Ki, blockMat, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - r_start = 1 - c_start = 1 - - ! dX/dx - dx_dot/dy * dY/dx = A - dx_dot/dy * C: - do c=1,size( blockMat, 2) - do r=1,size( blockMat, 1) - Jmat(r_start + r - 1, c_start + c - 1) = blockMat(r,c) - end do - end do - - - if (allocated (blockMat)) deallocate(blockMat) - - -END SUBROUTINE GetBlock11 -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetBlock12(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat, ErrMsg) - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the upper right block: (1,2) - REAL(R8Ki), INTENT(IN ) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki), ALLOCATABLE :: blockMat(:,:) - INTEGER(IntKi) :: r_start, c_start, r, c - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock11' - - ErrStat = ErrID_None - ErrMsg = "" - - !--------------- - ! upper right corner of J matrix: size of B (uses only blade DOFs from the structural module) - !--------------- - call AllocAry(blockMat, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'block matrix 1,2', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - blockMat = y_FAST%Lin%Glue%B ! copy this so we don't overwrite y_FAST%Lin%Glue%B here - call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dxdotdy, y_FAST%Lin%Glue%D, 1.0_R8Ki, blockMat, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - r_start = 1 - c_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - - ! dX/du - dx_dot/dy * dY/du = B - dx_dot/dy * D: - do c=1,size( blockMat, 2) - do r=1,size( blockMat, 1) - Jmat(r_start + r - 1, c_start + c - 1) = blockMat(r,c) - end do - end do - - - if (allocated (blockMat)) deallocate(blockMat) - - -END SUBROUTINE GetBlock12 -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetBlock21(Jmat, dUdy, p_FAST, y_FAST, ErrStat, ErrMsg) - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the lower left block: (2,1) - REAL(R8Ki), INTENT(IN ) :: dUdy(:,:) !< dUdy matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki), ALLOCATABLE :: dUdx(:,:) - INTEGER(IntKi) :: r_start, c_start, r, c - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock21' - - ErrStat = ErrID_None - ErrMsg = "" - - !--------------- - ! lower left corner of J matrix: - !--------------- - call AllocAry(dUdx, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'block matrix 2,1', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, dUdy, y_FAST%Lin%Glue%C, 0.0_R8Ki, dUdx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - r_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - c_start = 1 - - ! dU/dy * dY/dx: - do c=1,size( dUdx, 2) - do r=1,size( dUdx, 1) - Jmat(r_start + r - 1, c_start + c - 1) = dUdx(r,c) - end do - end do - - if (allocated (dUdx)) deallocate(dUdx) - -END SUBROUTINE GetBlock21 -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetBlock22(Jmat, dUdy, dUdu, p_FAST, y_FAST, ErrStat, ErrMsg) - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the lower left block: (2,1) - REAL(R8Ki), INTENT(IN ) :: dUdy(:,:) !< dUdy matrix - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< dUdu matrix (note that it is modified on exit of this routine!) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: r_start, c_start, r, c - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock22' - - ErrStat = ErrID_None - ErrMsg = "" - - !--------------- - ! lower right corner of J matrix: - !--------------- - call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, dUdy, y_FAST%Lin%Glue%D, 1.0_R8Ki, dUdu, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - r_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - c_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - - ! dU/du + dU/dy * dY/du: - do c=1,size( dUdu, 2) - do r=1,size( dUdu, 1) - Jmat(r_start + r - 1, c_start + c - 1) = dUdu(r,c) - end do - end do - - -END SUBROUTINE GetBlock22 -!---------------------------------------------------------------------------------------------------------------------------------- - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{ED}/du^{BD} and dU^{ED}/du^{AD} blocks (ED row) of dUdu. (i.e., how do changes in the AD and BD inputs affect the ED inputs?) -SUBROUTINE LinearSS_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, MeshMapData, dUdu, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located - INTEGER(IntKi) :: ED_Start_mt ! starting index of dUdu (row) where ED blade/tower or hub moment inputs are located - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_ED_InputSolve_du' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - !.......... - ! dU^{ED}/du^{AD} - !.......... - IF ( p_FAST%CompAero == Module_AD ) THEN - - ! ED inputs on blade from AeroDyn - IF (p_FAST%CompElast == Module_ED) THEN - - ED_Start_mt = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) - ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes*3 ! skip the forces on this blade - AD_Start_Bl = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) - - CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! AD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, ED_Start_mt, AD_Start_Bl ) - end if - - ! get starting index of next blade - ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes* 3 ! skip the moments on this blade - - END DO - - END IF - - END IF - - -END SUBROUTINE LinearSS_ED_InputSolve_du -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{BD}/du^{BD} and dU^{BD}/du^{AD} blocks (BD row) of dUdu. (i.e., how do changes in the AD and BD inputs -!! affect the BD inputs?) This should be called only when p_FAST%CompElast == Module_BD. -SUBROUTINE LinearSS_BD_InputSolve_du( p_FAST, y_FAST, y_AD, u_AD, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: k ! Loops through blades - INTEGER(IntKi) :: BD_Start ! starting index of dUdu (row) where BD inputs are located - INTEGER(IntKi) :: AD_Start ! starting index of dUdu (column) where AD inputs are located - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_BD_InputSolve_du' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - !.......... - ! dU^{BD}/du^{AD} - !.......... - IF ( p_FAST%CompAero == Module_AD ) THEN - - ! BD inputs on blade from AeroDyn - - - if (p_FAST%BD_OutputSibling) then - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades - CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), BD%y(k)%BldMotion ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - - else - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades - !linearization for dUdy will need some matrix multiplies because of the transfer (chain rule!), but we will perform individual linearization calculations here - !!! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: - CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - - end if - - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades - - ! AD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then - AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! index for the start of u_AD%BladeMotion(k)%translationDisp field - - BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & - + BD%Input(1,k)%DistrLoad%NNodes * 3 ! force field for each node (start with moment field) - - call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, BD_Start, AD_Start ) - end if - - END DO - - END IF - -END SUBROUTINE LinearSS_BD_InputSolve_du -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{AD}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect the AD inputs?) -SUBROUTINE LinearSS_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs from the structural dynamics module - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT(INOUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT(INOUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Start_td ! starting index of dUdu (column) where AD translation displacements are located - INTEGER(IntKi) :: AD_Start_tv ! starting index of dUdu (column) where AD translation velocities are located - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_AD_InputSolve_du' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! note that we assume this block matrix has been initialized to the identity matrix before calling this routine - - ! look at how the translational displacement gets transfered to the translational velocity: - !------------------------------------------------------------------------------------------------- - ! Set the inputs from ElastoDyn and/or BeamDyn: - !------------------------------------------------------------------------------------------------- - - ! blades - IF (p_FAST%CompElast == Module_ED ) THEN - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) - CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) - END DO - - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) - CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) - END DO - - END IF - - - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) - - AD_Start_td = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! index for u_AD%BladeMotion(k)%translationDisp field - - !AD is the destination here, so we need tv_ud - if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud)) then - ! index for u_AD%BladeMotion(k+1)%translationVel field - AD_Start_tv = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - - call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud, AD_Start_tv, AD_Start_td ) - end if - - - END DO - - - -END SUBROUTINE LinearSS_AD_InputSolve_du - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{ED}/dy^{SrvD}, dU^{ED}/dy^{ED}, dU^{ED}/dy^{BD}, dU^{ED}/dy^{AD}, dU^{ED}/dy^{HD}, and dU^{ED}/dy^{MAP} -!! blocks of dUdy. (i.e., how do changes in the SrvD, ED, BD, AD, HD, and MAP outputs effect the ED inputs?) -SUBROUTINE LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, p_ED, u_ED, y_ED, y_AD, u_AD, MeshMapData, dUdy, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters - TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located - INTEGER(IntKi) :: ED_Start ! starting index of dUdy (row) where ED input fields are located - INTEGER(IntKi) :: ED_Out_Start ! starting index of dUdy (column) where ED output fields are located - CHARACTER(*), PARAMETER :: RoutineName = 'Linear_ED_InputSolve_dy' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - ! parts of dU^{ED}/dy^{AD} and dU^{ED}/dy^{ED}: - - ! ElastoDyn inputs on blade from AeroDyn and ElastoDyn - - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%rotors(1)%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) - !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) - - ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): - ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field - call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ED_Start, AD_Out_Start, dUdy) - - ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) - ED_Out_Start = SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, ED_Start, ED_Out_Start ) - - AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip 2 fields to forces on next blade] - END DO - - -END SUBROUTINE LinearSS_ED_InputSolve_dy -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{BD}/dy^{ED}, dU^{BD}/dy^{BD}, and dU^{BD}/dy^{AD} blocks of dUdy. (i.e., how do -!! changes in the ED, BD, and AD outputs effect the BD inputs?) -SUBROUTINE LinearSS_BD_InputSolve_dy( p_FAST, y_FAST, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linearization) - TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located - INTEGER(IntKi) :: BD_Start ! starting index of dUdy (column) where particular BD fields are located - INTEGER(IntKi) :: BD_Out_Start ! starting index of dUdy (column) where BD output fields are located - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - REAL(R8Ki), ALLOCATABLE :: TempMat(:,:) ! temporary matrix for getting linearization matrices when BD input and output meshes are not siblings - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_BD_InputSolve_dy' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - ! parts of dU^{BD}/dy^{AD} and dU^{BD}/dy^{BD}: - - ! BeamDyn inputs on blade from AeroDyn and BeamDyn - - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%rotors(1)%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades - - BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) ! start of BD%Input(1,k)%DistrLoad%Force field - - ! AD loads-to-BD loads transfer (dU^{BD}/dy^{AD}): - call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), BD_Start, AD_Out_Start, dUdy) - AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip the moments to get to forces on next blade] - - - ! BD translation displacement-to-BD moment transfer (dU^{BD}/dy^{BD}): - BD_Start = BD_Start + BD%Input(1,k)%DistrLoad%NNodes * 3 ! start of BD%Input(1,k)%DistrLoad%Moment field (start with moment field) - BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! start of BD%y(k)%BldMotion%TranslationDisp field - - - if (p_FAST%BD_OutputSibling) then - call SetBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, BD_Start, BD_Out_Start ) - else - call AllocAry(TempMat, size(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,1), size(MeshMapData%BD_L_2_BD_L(k)%dM%mi,2), 'TempMat', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat>=AbortErrLev) return - - ! these blocks should be small enough that we can use matmul instead of calling a LAPACK routine to do it. - TempMat = matmul(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,MeshMapData%BD_L_2_BD_L(k)%dM%mi) - call SetBlockMatrix( dUdy, TempMat, BD_Start, BD_Out_Start ) - - BD_Out_Start = BD_Out_Start + BD%y(k)%BldMotion%NNodes*3 ! start of BD%y(k)%BldMotion%Orientation field - TempMat = matmul(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,MeshMapData%BD_L_2_BD_L(k)%dM%fx_p) - call SetBlockMatrix( dUdy, TempMat, BD_Start, BD_Out_Start ) - - deallocate(TempMat) ! the next blade may have a different number of nodes - end if - - END DO - - -END SUBROUTINE LinearSS_BD_InputSolve_dy -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{AD}/dy^{ED} and dU^{AD}/dy^{BD} blocks of dUdy. (i.e., how do changes in the ED and BD outputs affect -!! the AD inputs?) -SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module - TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{ED} block - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Start ! starting index of dUdy (column) where particular AD fields are located - INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located - INTEGER(IntKi) :: BD_Out_Start! starting index of dUdy (row) where particular BD fields are located - LOGICAL :: FieldMask(FIELDMASK_SIZE) -! INTEGER(IntKi) :: ErrStat2 -! CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_AD_InputSolve_NoIfW_dy' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! Only assemble from the following source fields - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - FieldMask(MASKID_ROTATIONVEL) = .false. - FieldMask(MASKID_TRANSLATIONACC) = .false. - FieldMask(MASKID_ROTATIONACC) = .false. - - !------------------------------------------------------------------------------------------------- - ! Set the inputs from ElastoDyn and/or BeamDyn: - !------------------------------------------------------------------------------------------------- - !................................... - ! blades - !................................... - IF (p_FAST%CompElast == Module_ED ) THEN - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(y_ED%BladeLn2Mesh) - !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - - AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field - ED_Out_Start = SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field - CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, FieldMask) - - END DO - - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams - AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field - BD_Out_Start = y_FAST%Lin%Modules(Module_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) - - CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, FieldMask) - END DO - - END IF - - -END SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy -!---------------------------------------------------------------------------------------------------------------------------------- - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%BladeMotion(k) mesh in the FAST linearization inputs. -FUNCTION SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, BladeNum) RESULT(AD_Start) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t - INTEGER(IntKi), INTENT(IN ) :: BladeNum !< blade number to find index for - INTEGER :: k !< blade number loop - - INTEGER(IntKi) :: AD_Start !< starting index of this mesh in AeroDyn inputs - - AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - - do k = 1,min(BladeNum-1,p_FAST%NumBl_Lin) !size(u_AD%BladeMotion)) - AD_Start = AD_Start + u_AD%rotors(1)%BladeMotion(k)%NNodes * 9 ! 3 fields (TranslationDisp, MASKID_Orientation, TranslationVel) with 3 components - end do -END FUNCTION SS_Indx_u_AD_Blade_Start -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the y_ED%BladeLn2Mesh(BladeNum) mesh in the FAST linearization outputs. -FUNCTION SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, BladeNum) RESULT(ED_Out_Start) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t - INTEGER(IntKi), INTENT(IN ) :: BladeNum !< blade number to find index for - INTEGER :: k !< blade number loop - - INTEGER(IntKi) :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field (blade motions in y_ED) - if (allocated(y_ED%BladeLn2Mesh)) then - do k = 1,min(BladeNum-1,p_FAST%NumBl_Lin) ! we don't need all blades: SIZE(y_ED%BladeLn2Mesh,1)) ! Loop through all blades (p_ED%NumBl) - ED_Out_Start = ED_Out_Start + y_ED%BladeLn2Mesh(k)%NNodes*12 ! 4 fields with 3 components on each blade - end do - end if - -END FUNCTION SS_Indx_y_ED_Blade_Start -!---------------------------------------------------------------------------------------------------------------------------------- - - - -END MODULE FAST_SS_Solver diff --git a/modules/openfast-library/src/FAST_SS_Subs.f90 b/modules/openfast-library/src/FAST_SS_Subs.f90 deleted file mode 100644 index c06c67beff..0000000000 --- a/modules/openfast-library/src/FAST_SS_Subs.f90 +++ /dev/null @@ -1,323 +0,0 @@ -!********************************************************************************************************************************** -! FAST_Solver.f90, FAST_Subs.f90, FAST_Lin.f90, and FAST_Mods.f90 make up the FAST glue code in the FAST Modularization Framework. -! FAST_Prog.f90, FAST_Library.f90, FAST_Prog.c are different drivers for this code. -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of FAST. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -!********************************************************************************************************************************** -MODULE FAST_SS_Subs - - USE FAST_SS_Solver - - IMPLICIT NONE - - -CONTAINS -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! DRIVER ROUTINE (runs + ends simulation) -! Put here so that we can call from either stand-alone code or from the ENFAST executable. -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -SUBROUTINE FAST_RunSteadyStateDriver( Turbine ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ProgName = TRIM(FAST_Ver%Name)//' Steady State' - FAST_Ver%Name = ProgName - - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! initialization - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - CALL FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) - CALL CheckError( ErrStat, ErrMsg, 'during module initialization' ) - - - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! Calculate steady-state solutions: - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_SteadyState_T( Turbine, ErrStat, ErrMsg ) - CALL CheckError( ErrStat, ErrMsg, 'during steady-state solve' ) - - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! Clean up and stop - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - CALL ExitThisProgram_T( Turbine, ErrID_None, .true. ) - - CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg,SimMsg) - ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - CHARACTER(*), INTENT(IN) :: SimMsg ! a message describing the location of the error - - IF ( ErrID /= ErrID_None ) THEN - CALL WrScr( NewLine//TRIM(Msg)//NewLine ) - - IF ( ErrID >= AbortErrLev ) THEN - CALL ExitThisProgram_T( Turbine, ErrID, .true., SimMsg ) - END IF - - END IF - - END SUBROUTINE CheckError -END SUBROUTINE FAST_RunSteadyStateDriver -!---------------------------------------------------------------------------------------------------------------------------------- - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! INITIALIZATION ROUTINES -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - LOGICAL, PARAMETER :: CompAeroMaps = .true. - REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi - - Turbine%TurbID = 1 - - CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) - - call InitFlowField() - -contains - !> AD15 now directly accesses FlowField data from IfW. Since we don't use IfW, we need to manually set the FlowField data - !! NOTE: we deallocate(AD%p%FlowField) at the end of the simulation if CompAeroMaps is true - subroutine InitFlowField() - use InflowWind_IO, only: IfW_SteadyWind_Init - use InflowWind_IO_Types, only: InflowWind_IO_DestroySteady_InitInputType, InflowWind_IO_DestroyWindFileDat - type(Steady_InitInputType) :: InitInp - integer(IntKi) :: SumFileUnit = -1 - type(WindFileDat) :: WFileDat ! throw away data returned form init - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - allocate(Turbine%AD%p%FlowField) - Turbine%AD%p%FlowField%FieldType = 1 ! Steady wind, init below. - InitInp%RefHt = 100.0_ReKi ! Any value will do here. No exponent, so this doesn't matter - InitInp%HWindSpeed = 8.0_ReKi ! This gets overwritten later before used - InitInp%PLExp = 0.0_ReKi ! no shear used - call IfW_SteadyWind_Init(InitInp, SumFileUnit, Turbine%AD%p%FlowField%Uniform, WFileDat, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'FAST_InitializeSteadyState_T:InitFlowField') - if (ErrStat >= AbortErrLev) deallocate(Turbine%AD%p%FlowField) - - call InflowWind_IO_DestroySteady_InitInputType(InitInp, ErrStat2, ErrMsg2) ! ignore errors here because I'm lazy - call InflowWind_IO_DestroyWindFileDat(WFileDat, ErrStat2, ErrMsg2) ! ignore errors here because I'm lazy - end subroutine -END SUBROUTINE FAST_InitializeSteadyState_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_SteadyState_T( Turbine, ErrStat, ErrMsg ) - - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_SteadyState( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%AD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_SteadyState_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and gets values at n_t_global + 1 -SUBROUTINE FAST_SteadyState(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: n_case !< loop counter - REAL(DbKi) :: n_global - REAL(ReKi), ALLOCATABLE :: UnusedAry(:) - REAL(R8Ki), ALLOCATABLE :: Jmat(:,:) - TYPE(FAST_SS_CaseType) :: caseData ! tsr, windSpeed, pitch, and rotor speed for this case - TYPE(FAST_SS_CaseType) :: caseData_try2 ! tsr, windSpeed, pitch, and rotor speed for this case (to try a different operating point first) - - INTEGER(IntKi) :: NStatus - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - TYPE(IceD_OutputType), ALLOCATABLE :: y_IceD (:) !< IceDyn outputs (WriteOutput values are subset) - CHARACTER(MaxWrScrLen), PARAMETER :: BlankLine = " " - - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_SteadyState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InitSSVariables(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, JMat, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! how often do we inform the user which case we are on? - NStatus = min( 100, p_FAST%NumSSCases/100 + 1) ! at least 100 every 100 cases or 100 times per simulation - call WrScr(NewLine) - - DO n_case = 1, p_FAST%NumSSCases - - if (mod(n_case,NStatus) == 0 .or. n_case==p_FAST%NumSSCases .or. n_case==1) then - call WrOver( ' Case '//trim(num2lstr(n_case))//' of '//trim(num2lstr(p_FAST%NumSSCases)) ) - end if - - - if (p_FAST%WindSpeedOrTSR==1) then - caseData%windSpeed = p_FAST%WS_TSR(n_case) - caseData%tsr = p_FAST%RotSpeed(n_case) * AD%p%rotors(1)%BEMT%rTipFixMax / caseData%windSpeed - else - caseData%tsr = p_FAST%WS_TSR(n_case) - caseData%windSpeed = p_FAST%RotSpeed(n_case) * AD%p%rotors(1)%BEMT%rTipFixMax / caseData%tsr - end if - caseData%pitch = p_FAST%Pitch(n_case) - caseData%RotSpeed = p_FAST%RotSpeed(n_case) - - ! Call steady-state solve for this pitch and rotor speed - call SolveSteadyState(caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) - - if (ErrStat2 >= ErrID_Severe) then - ! we didn't converge; let's try a different operating point and see if that helps: - caseData_try2%RotSpeed = caseData%RotSpeed - caseData_try2%Pitch = caseData%Pitch * 0.5_ReKi - caseData_try2%TSR = caseData%TSR * 0.5_ReKi - caseData_try2%WindSpeed = caseData%WindSpeed * 0.5_ReKi - - call WrScr('Retrying case '//trim(num2lstr(n_case))//', first trying to get a better initial guess. Average error is '// & - trim(num2lstr(y_FAST%DriverWriteOutput(SS_Indx_Err)))//'.') - call SolveSteadyState(caseData_try2, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) - - ! if that worked, try the real case again: - if (ErrStat2 < AbortErrLev) then - call SolveSteadyState(caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) - call WrOver(BlankLine) - end if - - end if - - if (ErrStat2 > ErrID_None) then - ErrMsg2 = trim(ErrMsg2)//" case "//trim(num2lstr(n_case))//& - ' (tsr='//trim(num2lstr(caseData%tsr))//& - ', wind speed='//trim(num2lstr(caseData%windSpeed))//' m/s'//& - ', pitch='//trim(num2lstr(caseData%pitch*R2D))//' deg'//& - ', rotor speed='//trim(num2lstr(caseData%RotSpeed*RPS2RPM))//' rpm)' - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - !---------------------------------------------------------------------------------------- - ! Write results to file - !---------------------------------------------------------------------------------------- - n_global = real(n_case, DbKi) ! n_global is double-precision so that we can reuse existing code. - - CALL WrOutputLine( n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, ED%y%WriteOutput, UnusedAry, & - AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & - UnusedAry, UnusedAry, UnusedAry, UnusedAry, y_IceD, BD%y, ErrStat2, ErrMsg2 ) - - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! in case we have a lot of error messages, let's print the non fatal ones here: - if (ErrStat > ErrID_None) then - call WrScr(trim(ErrMsg)) - call WrScr("") - ErrStat = ErrID_None - ErrMsg = "" - end if - - END DO - -CONTAINS - SUBROUTINE Cleanup() - if (allocated(Jmat)) deallocate(Jmat) - END SUBROUTINE Cleanup - - -END SUBROUTINE FAST_SteadyState -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE InitSSVariables(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, JMat, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), ALLOCATABLE , INTENT(INOUT) :: Jmat(:,:) !< Matrix for storing Jacobian - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: NumBlades !< number of blades - - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - - CHARACTER(*), PARAMETER :: RoutineName = 'SS_InitVariables' - - ErrStat = ErrID_None - ErrMsg = "" - - NumBlades = size(AD%y%rotors(1)%BladeLoad) - - - call AllocAry(Jmat, p_FAST%SizeJac_Opt1(1), p_FAST%SizeJac_Opt1(1), 'Jmat', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL AllocAry( MeshMapData%Jacobian_pivot, p_FAST%SizeJac_Opt1(1), 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !CALL AllocAry( MeshMapData%HubOrient, 3, 3, NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - if (ErrStat >= AbortErrLev) return - - - CALL CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat2, ErrMsg2, MESH_NEWCOPY ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - -END SUBROUTINE InitSSVariables -!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE FAST_SS_Subs -!---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 index c87dbcbbd6..fe5a30331f 100644 --- a/modules/openfast-library/src/FAST_SolverTC.f90 +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -1116,7 +1116,7 @@ subroutine FAST_SolverStep(n_t_global, t_initial, p, m, GlueModData, GlueModMaps case (Module_ED) ! Update the azimuth angle - call ED_UpdateAzimuth(Turbine%ED%p, Turbine%ED%x(STATE_PRED), ModData%DT) + call ED_UpdateAzimuth(Turbine%ED%p(ModData%Ins), Turbine%ED%x(ModData%Ins, STATE_PRED), ModData%DT) case (Module_BD) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index f38ebecd32..57a9d6e283 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -33,6 +33,9 @@ MODULE FAST_Subs IMPLICIT NONE + INTEGER(IntKi), private, parameter :: iED = 1 + INTEGER(IntKi), private, parameter :: NumED = 1 + CONTAINS !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! INITIALIZATION ROUTINES @@ -138,9 +141,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE INTEGER(IntKi) :: NumBl - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitializeAll' + CHARACTER(ErrMsgLen) :: ErrMsg2 !.......... @@ -292,12 +294,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE case default ! ElastoDyn ! Allocate module data arrays - allocate(ED%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("ED%Input")) return - allocate(ED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return - allocate(ED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%x")) return - allocate(ED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return - allocate(ED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%z")) return - allocate(ED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return + allocate(ED%Input (InputAryLB:InputAryUB, NumED), stat=ErrStat2); if (FailedAlloc("ED%Input")) return + allocate(ED%InputTimes (InputAryUB, NumED ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return + allocate(ED%x (NumED, StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%x")) return + allocate(ED%xd (NumED, StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return + allocate(ED%z (NumED, StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%z")) return + allocate(ED%OtherSt (NumED, StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return + allocate(ED%p (NumED ), stat=ErrStat2); if (FailedAlloc("ED%p")) return + allocate(ED%y (NumED ), stat=ErrStat2); if (FailedAlloc("ED%y")) return + allocate(ED%m (NumED ), stat=ErrStat2); if (FailedAlloc("ED%m")) return + + allocate(Init%OutData_ED(NumED ), stat=ErrStat2); if (FailedAlloc("Init%OutData_ED")) return ! Set initialization input Init%InData_ED%Linearize = p_FAST%Linearize @@ -312,25 +319,26 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_ED%WtrDpth = p_FAST%WtrDpth ! Call module initialization routine - CALL ED_Init(Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, p_FAST%dt_module(MODULE_ED), Init%OutData_ED, ErrStat2, ErrMsg2) + CALL ED_Init(Init%InData_ED, ED%Input(1, iED), ED%p(iED), ED%x(iED, STATE_CURR), & + ED%xd(iED, STATE_CURR), ED%z(iED, STATE_CURR), ED%OtherSt(iED, STATE_CURR), & + ED%y(iED), ED%m(iED), p_FAST%dt_module(MODULE_ED), Init%OutData_ED(iED), ErrStat2, ErrMsg2) if (Failed()) return ! Add module to array of modules, return if errors occurred CALL MV_AddModule(m_Glue%ModData, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & - Init%OutData_ED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + Init%OutData_ED(iED)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) if (Failed()) return p_FAST%ModuleInitialized(Module_ED) = .TRUE. - NumBl = Init%OutData_ED%NumBl - p_FAST%GearBox_index = Init%OutData_ED%GearBox_index + NumBl = Init%OutData_ED(iED)%NumBl + p_FAST%GearBox_index = Init%OutData_ED(iED)%GearBox_index if (p_FAST%CalcSteady) then - if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then + if ( EqualRealNos(Init%OutData_ED(iED)%RotSpeed, 0.0_ReKi) ) then p_FAST%TrimCase = TrimCase_none p_FAST%NLinTimes = 1 p_FAST%LinInterpOrder = 0 ! constant values - elseif ( Init%OutData_ED%isFixed_GenDOF ) then + elseif ( Init%OutData_ED(iED)%isFixed_GenDOF ) then p_FAST%TrimCase = TrimCase_none end if end if @@ -346,7 +354,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE if (p_FAST%CompAeroMaps) then p_FAST%nBeams = 1 ! initialize number of BeamDyn instances = 1 blade for aero maps else - p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades + p_FAST%nBeams = Init%OutData_ED(iED)%NumBl ! initialize number of BeamDyn instances = number of blades end if else p_FAST%nBeams = 0 @@ -372,8 +380,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_BD%Linearize = p_FAST%Linearize Init%InData_BD%CompAeroMaps = p_FAST%CompAeroMaps Init%InData_BD%gravity = [0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity] ! "Gravitational acceleration" m/s^2 - Init%InData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) - Init%InData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) + Init%InData_BD%HubPos = ED%y(iED)%HubPtMotion%Position(:,1) + Init%InData_BD%HubRot = ED%y(iED)%HubPtMotion%RefOrientation(:,:,1) ! now initialize BeamDyn for all beams dt_BD = p_FAST%dt_module(MODULE_BD) @@ -384,14 +392,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM(Num2LStr(k)) Init%InData_BD%InputFile = p_FAST%BDBldFile(k) - Init%InData_BD%GlbPos = ED%y%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" - Init%InData_BD%GlbRot = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" + Init%InData_BD%GlbPos = ED%y(iED)%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" + Init%InData_BD%GlbRot = ED%y(iED)%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" ! These outputs are set in ElastoDyn only when BeamDyn is used: - Init%InData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" - Init%InData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" - Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" - Init%InData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" + Init%InData_BD%RootDisp = ED%y(iED)%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" + Init%InData_BD%RootOri = ED%y(iED)%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" + Init%InData_BD%RootVel(1:3) = ED%y(iED)%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" + Init%InData_BD%RootVel(4:6) = ED%y(iED)%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" ! Call module initialization routine CALL BD_Init(Init%InData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & @@ -456,10 +464,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_IfW%lidar%HubPosition = SED%y%HubPtMotion%Position(:,1) Init%InData_IfW%RadAvg = Init%OutData_SED%BladeLength elseif ( p_FAST%CompElast == Module_ED ) then - Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) - Init%InData_IfW%RadAvg = Init%OutData_ED%BladeLength + Init%InData_IfW%lidar%HubPosition = ED%y(iED)%HubPtMotion%Position(:,1) + Init%InData_IfW%RadAvg = Init%OutData_ED(iED)%BladeLength elseif ( p_FAST%CompElast == Module_BD ) then - Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_IfW%lidar%HubPosition = ED%y(iED)%HubPtMotion%Position(:,1) Init%InData_IfW%RadAvg = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) end if @@ -646,13 +654,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = SED%y%BladeRootMotion(k)%RefOrientation(:,:,1) end do elseif (p_FAST%CompElast == Module_ED .or. p_FAST%CompElast == Module_BD) then - Init%InData_AD%rotors(1)%HubPosition = ED%y%HubPtMotion%Position(:,1) - Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) - Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) - Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%HubPosition = ED%y(iED)%HubPtMotion%Position(:,1) + Init%InData_AD%rotors(1)%HubOrientation = ED%y(iED)%HubPtMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%NacellePosition = ED%y(iED)%NacelleMotion%Position(:,1) + Init%InData_AD%rotors(1)%NacelleOrientation = ED%y(iED)%NacelleMotion%RefOrientation(:,:,1) do k=1,NumBl - Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) - Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y(iED)%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y(iED)%BladeRootMotion(k)%RefOrientation(:,:,1) end do endif @@ -697,9 +705,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_ADsk%HubPosition = SED%y%HubPtMotion%Position(:,1) Init%InData_ADsk%HubOrientation = SED%y%HubPtMotion%RefOrientation(:,:,1) else - Init%InData_ADsk%RotorRad = Init%OutData_ED%HubRad + Init%OutData_ED%BladeLength - Init%InData_ADsk%HubPosition = ED%y%HubPtMotion%Position(:,1) - Init%InData_ADsk%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + Init%InData_ADsk%RotorRad = Init%OutData_ED(iED)%HubRad + Init%OutData_ED(iED)%BladeLength + Init%InData_ADsk%HubPosition = ED%y(iED)%HubPtMotion%Position(:,1) + Init%InData_ADsk%HubOrientation = ED%y(iED)%HubPtMotion%RefOrientation(:,:,1) endif Init%InData_ADsk%defAirDens = p_FAST%AirDens @@ -731,7 +739,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE IF ( (p_FAST%CompAero == Module_ExtLd) .and. PRESENT(ExternInitData) ) THEN ! set initialization data for ExtLoads - CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) + CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED(iED), ED%y(iED), Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) if (Failed()) return @@ -844,7 +852,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) Init%InData_HD%TMax = p_FAST%TMax Init%InData_HD%Linearize = p_FAST%Linearize - Init%InData_HD%PlatformPos = Init%OutData_ED%PlatformPos ! Initial platform position; PlatformPos(1:3) is effectively the initial position of the HD origin + Init%InData_HD%PlatformPos = Init%OutData_ED(iED)%PlatformPos ! Initial platform position; PlatformPos(1:3) is effectively the initial position of the HD origin if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true @@ -898,7 +906,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_SD%g = p_FAST%Gravity Init%InData_SD%SDInputFile = p_FAST%SubFile Init%InData_SD%RootName = p_FAST%OutFileRoot - Init%InData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! "Interface point" where loads will be transferred to + Init%InData_SD%TP_RefPoint = ED%y(iED)%PlatformPtMesh%Position(:,1) ! "Interface point" where loads will be transferred to Init%InData_SD%SubRotateZ = 0.0 ! Used by driver to rotate structure around z CALL SD_Init( Init%InData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & @@ -917,7 +925,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_ExtPtfm%InputFile = p_FAST%SubFile Init%InData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//y_FAST%Module_Abrev(Module_ExtPtfm) Init%InData_ExtPtfm%Linearize = p_FAST%Linearize - Init%InData_ExtPtfm%PtfmRefzt = ED%p%PtfmRefzt ! Required + Init%InData_ExtPtfm%PtfmRefzt = ED%p(iED)%PtfmRefzt ! Required CALL ExtPtfm_Init(Init%InData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), & @@ -1007,7 +1015,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_MD%RootName = p_FAST%OutFileRoot - Init%InData_MD%PtfmInit(:,1) = Init%OutData_ED%PlatformPos ! initial position of the platform (when a FAST module, MoorDyn just takes one row in this matrix) + Init%InData_MD%PtfmInit(:,1) = Init%OutData_ED(iED)%PlatformPos ! initial position of the platform (when a FAST module, MoorDyn just takes one row in this matrix) Init%InData_MD%FarmSize = 0 ! 0 here indicates normal FAST module use of MoorDyn, for a single turbine Init%InData_MD%TurbineRefPos(:,1) = 0.0_DbKi ! for normal FAST use, the global reference frame is at 0,0,0 Init%InData_MD%g = p_FAST%Gravity ! This need to be according to g used in ElastoDyn @@ -1033,7 +1041,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_FEAM%InputFile = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) - Init%InData_FEAM%PtfmInit = Init%OutData_ED%PlatformPos ! ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED + Init%InData_FEAM%PtfmInit = Init%OutData_ED(iED)%PlatformPos ! ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) Init%InData_FEAM%gravity = p_FAST%Gravity ! This need to be according to g from driver Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState @@ -1218,20 +1226,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_SrvD%RotSpeedRef = Init%OutData_SED%RotSpeed Init%InData_SrvD%BlPitchInit = Init%OutData_SED%BlPitch else - Init%InData_SrvD%NacRefPos(1:3) = ED%y%NacelleMotion%Position(1:3,1) - Init%InData_SrvD%NacTransDisp(1:3) = ED%y%NacelleMotion%TranslationDisp(1:3,1) ! R8Ki - Init%InData_SrvD%NacRefOrient(1:3,1:3) = ED%y%NacelleMotion%RefOrientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%NacOrient(1:3,1:3) = ED%y%NacelleMotion%Orientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%TwrBaseRefPos = Init%OutData_ED%TwrBaseRefPos - Init%InData_SrvD%TwrBaseTransDisp = Init%OutData_ED%TwrBaseTransDisp ! R8Ki - Init%InData_SrvD%TwrBaseRefOrient = Init%OutData_ED%TwrBaseRefOrient ! R8Ki - Init%InData_SrvD%TwrBaseOrient = Init%OutData_ED%TwrBaseOrient ! R8Ki - Init%InData_SrvD%PtfmRefPos(1:3) = ED%y%PlatformPtMesh%Position(1:3,1) - Init%InData_SrvD%PtfmTransDisp(1:3) = ED%y%PlatformPtMesh%TranslationDisp(1:3,1) ! R8Ki - Init%InData_SrvD%PtfmRefOrient(1:3,1:3)= ED%y%PlatformPtMesh%RefOrientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%PtfmOrient(1:3,1:3) = ED%y%PlatformPtMesh%Orientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed - Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch + Init%InData_SrvD%NacRefPos(1:3) = ED%y(iED)%NacelleMotion%Position(1:3,1) + Init%InData_SrvD%NacTransDisp(1:3) = ED%y(iED)%NacelleMotion%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%NacRefOrient(1:3,1:3) = ED%y(iED)%NacelleMotion%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%NacOrient(1:3,1:3) = ED%y(iED)%NacelleMotion%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%TwrBaseRefPos = Init%OutData_ED(iED)%TwrBaseRefPos + Init%InData_SrvD%TwrBaseTransDisp = Init%OutData_ED(iED)%TwrBaseTransDisp ! R8Ki + Init%InData_SrvD%TwrBaseRefOrient = Init%OutData_ED(iED)%TwrBaseRefOrient ! R8Ki + Init%InData_SrvD%TwrBaseOrient = Init%OutData_ED(iED)%TwrBaseOrient ! R8Ki + Init%InData_SrvD%PtfmRefPos(1:3) = ED%y(iED)%PlatformPtMesh%Position(1:3,1) + Init%InData_SrvD%PtfmTransDisp(1:3) = ED%y(iED)%PlatformPtMesh%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%PtfmRefOrient(1:3,1:3)= ED%y(iED)%PlatformPtMesh%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%PtfmOrient(1:3,1:3) = ED%y(iED)%PlatformPtMesh%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%RotSpeedRef = Init%OutData_ED(iED)%RotSpeed + Init%InData_SrvD%BlPitchInit = Init%OutData_ED(iED)%BlPitch endif Init%InData_SrvD%TMax = p_FAST%TMax Init%InData_SrvD%AirDens = AirDens @@ -1257,10 +1265,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE enddo else do k=1,NumBl - Init%InData_SrvD%BladeRootRefPos(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) - Init%InData_SrvD%BladeRootTransDisp(:,k) = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) - Init%InData_SrvD%BladeRootRefOrient(:,:,k)= ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) - Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y%BladeRootMotion(k)%Orientation(:,:,1) + Init%InData_SrvD%BladeRootRefPos(:,k) = ED%y(iED)%BladeRootMotion(k)%Position(:,1) + Init%InData_SrvD%BladeRootTransDisp(:,k) = ED%y(iED)%BladeRootMotion(k)%TranslationDisp(:,1) + Init%InData_SrvD%BladeRootRefOrient(:,:,k)= ED%y(iED)%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y(iED)%BladeRootMotion(k)%Orientation(:,:,1) enddo endif @@ -1317,7 +1325,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE ! bjj: this is a hack to get high-speed shaft braking in FAST v8 IF ( Init%OutData_SrvD%UseHSSBrake ) THEN - IF ( ED%p%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters + IF ( ED%p(iED)%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters CALL SetErrStat(ErrID_Fatal,'ElastoDyn must use the AB4 or ABM4 integration method to implement high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) ENDIF END IF ! Init%OutData_SrvD%UseHSSBrake @@ -1345,7 +1353,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE !---------------------------------------------------------------------------- if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_SED, Init%OutData_AD, Init%OutData_SeaSt, Init%OutData_HD, ED, SED, BD, AD, HD, ErrStat2, ErrMsg2) + call SetVTKParameters(p_FAST, Init%OutData_ED(iED), Init%OutData_SED, Init%OutData_AD, Init%OutData_SeaSt, Init%OutData_HD, ED, SED, BD, AD, HD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -2049,7 +2057,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%Module_Ver( Module_SED ) = Init%OutData_SED%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SED ) )) ELSE - y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED%Ver + y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED(iED)%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) END IF @@ -2127,7 +2135,9 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_ExtInfw%WriteOutputHdr ) ) y_FAST%numOuts(Module_ExtInfw) = SIZE(Init%OutData_ExtInfw%WriteOutputHdr) - IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) +do i=1,NumED + IF ( ALLOCATED( Init%OutData_ED(i)%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = y_FAST%numOuts(Module_ED) + SIZE(Init%OutData_ED(iED)%WriteOutputHdr) +end do IF ( ALLOCATED( Init%OutData_SED%WriteOutputHdr ) ) y_FAST%numOuts(Module_SED) = SIZE(Init%OutData_SED%WriteOutputHdr) do i=1,p_FAST%nBeams IF ( ALLOCATED( Init%OutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(Init%OutData_BD(i)%WriteOutputHdr) @@ -2217,8 +2227,8 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) END DO DO i=1,y_FAST%numOuts(Module_ED) !ElastoDyn - y_FAST%ChannelNames(indxNext) = Init%OutData_ED%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = Init%OutData_ED%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_ED(iED)%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ED(iED)%WriteOutputUnt(i) indxNext = indxNext + 1 END DO @@ -3830,8 +3840,8 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_SED, InitOutData y = SED%y%HubPtMotion%Position(3, 1) - SED%y%NacelleMotion%Position(3, 1) x = TwoNorm( SED%y%HubPtMotion%Position(1:2,1) - SED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad else - y = ED%y%HubPtMotion%Position(3, 1) - ED%y%NacelleMotion%Position(3, 1) - x = TwoNorm( ED%y%HubPtMotion%Position(1:2,1) - ED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad + y = ED%y(iED)%HubPtMotion%Position(3, 1) - ED%y(iED)%NacelleMotion%Position(3, 1) + x = TwoNorm( ED%y(iED)%HubPtMotion%Position(1:2,1) - ED%y(iED)%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad endif @@ -3847,7 +3857,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_SED, InitOutData !....................... ! Create the tower surface data !....................... - TowerMotionMesh => ED%y%TowerLn2Mesh + TowerMotionMesh => ED%y(iED)%TowerLn2Mesh CALL AllocAry(p_FAST%VTK_Surface%TowerRad,TowerMotionMesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -3936,11 +3946,11 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_SED, InitOutData ELSE call WrScr('Using generic blade surfaces for ElastoDyn (rectangular airfoil, constant chord). ') ! TODO make this an option DO K=1,NumBl - rootNode = ED%y%BladeLn2Mesh(K)%NNodes - tipNode = ED%y%BladeLn2Mesh(K)%NNodes-1 - cylNode = min(2,ED%y%BladeLn2Mesh(K)%NNodes) + rootNode = ED%y(iED)%BladeLn2Mesh(K)%NNodes + tipNode = ED%y(iED)%BladeLn2Mesh(K)%NNodes-1 + cylNode = min(2,ED%y(iED)%BladeLn2Mesh(K)%NNodes) - call SetVTKDefaultBladeParams(ED%y%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 4, ErrStat2, ErrMsg2) + call SetVTKDefaultBladeParams(ED%y(iED)%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 4, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN END DO @@ -4931,7 +4941,7 @@ SUBROUTINE FAST_Reset_SubStep_T(t_initial, n_t_global, n_timesteps, Turbine, Err case (Module_BD) Turbine%BD%InputTimes(:, ModData%Ins) = InputTimes case (Module_ED) - Turbine%ED%InputTimes = InputTimes + Turbine%ED%InputTimes(:, ModData%Ins) = InputTimes case (Module_ExtPtfm) Turbine%ExtPtfm%InputTimes = InputTimes case (Module_FEAM) @@ -5372,7 +5382,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, IF ( y_FAST%WriteThisStep ) THEN ! Generate glue-code output file - CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, ExtInfw%y%WriteOutput, ED%y%WriteOutput, SED%y%WriteOutput, & + CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, ExtInfw%y%WriteOutput, ED%y, SED%y%WriteOutput, & AD%y, ADsk%y%WriteOutput, SrvD%y%WriteOutput, SeaSt%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) @@ -5389,7 +5399,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). -SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput,& +SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput,& MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, ErrStat, ErrMsg) IMPLICIT NONE @@ -5402,7 +5412,7 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IfWOutput (:) !< InflowWind WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtInfwOutput (:) !< ExternalInflow WriteOutput values - REAL(ReKi), ALLOCATABLE, INTENT(IN) :: EDOutput (:) !< ElastoDyn WriteOutput values + TYPE(ED_OutputType), INTENT(IN) :: y_ED (:) !< ElastoDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SEDOutput (:) !< Simplified-ElastoDyn WriteOutput values TYPE(AD_OutputType), INTENT(IN) :: y_AD !< AeroDyn outputs (WriteOutput values are subset of allocated Rotors) REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ADskOutput (:) !< AeroDisk WriteOutput values @@ -5432,7 +5442,7 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, ErrStat = ErrID_None ErrMsg = '' - CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & + CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) IF (p_FAST%WrTxtOutFile) THEN @@ -5492,7 +5502,7 @@ SUBROUTINE FillOutputAry_T(Turbine, Outputs) CALL FillOutputAry(Turbine%p_FAST, Turbine%y_FAST, Turbine%IfW%y%WriteOutput, Turbine%ExtInfw%y%WriteOutput, & - Turbine%ED%y%WriteOutput, Turbine%SED%y%WriteOutput, Turbine%AD%y, Turbine%ADsk%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & + Turbine%ED%y, Turbine%SED%y%WriteOutput, Turbine%AD%y, Turbine%ADsk%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & Turbine%SeaSt%y%WriteOutput, Turbine%HD%y%WriteOutput, Turbine%SD%y%WriteOutput, Turbine%ExtPtfm%y%WriteOutput, Turbine%MAP%y%WriteOutput, & Turbine%FEAM%y%WriteOutput, Turbine%MD%y%WriteOutput, Turbine%Orca%y%WriteOutput, & Turbine%IceF%y%WriteOutput, Turbine%IceD%y, Turbine%BD%y, Outputs) @@ -5501,7 +5511,7 @@ END SUBROUTINE FillOutputAry_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine concatenates all of the WriteOutput values from the module Output into one array to be written to the FAST !! output file. -SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & +SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters @@ -5509,7 +5519,7 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SED REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IfWOutput (:) !< InflowWind WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtInfwOutput (:) !< ExternalInflow WriteOutput values - REAL(ReKi), ALLOCATABLE, INTENT(IN) :: EDOutput (:) !< ElastoDyn WriteOutput values + TYPE(ED_OutputType), INTENT(IN) :: y_ED (:) !< ElastoDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SEDOutput (:) !< Simplified-ElastoDyn WriteOutput values TYPE(AD_OutputType), INTENT(IN) :: y_AD !< AeroDyn outputs (WriteOutput values are subset of allocated Rotors) REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ADskOutput (:) !< AeroDisk WriteOutput values @@ -5555,9 +5565,11 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SED END IF IF ( y_FAST%numOuts(Module_ED) > 0 ) THEN - indxLast = indxNext + SIZE(EDOutput) - 1 - OutputAry(indxNext:indxLast) = EDOutput - indxNext = IndxLast + 1 + do i=1,SIZE(y_ED) + indxLast = indxNext + SIZE(y_ED(i)%WriteOutput) - 1 + OutputAry(indxNext:indxLast) = y_ED(i)%WriteOutput + indxNext = IndxLast + 1 + end do END IF IF ( y_FAST%numOuts(Module_SED) > 0 ) THEN @@ -5688,7 +5700,7 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN if (p_FAST%CompElast /= Module_SED) then !FIXME: SED is not included in these routines!!!! - CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) + CALL WriteInputMeshesToFile( ED%Input(1,:), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) CALL WriteMotionMeshesToFile(t_global, ED%y, SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') endif !unOut = -1 @@ -5729,8 +5741,7 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex ! logical :: outputFields ! flag to determine if we want to output the HD mesh fields - INTEGER(IntKi) :: NumBl, k - INTEGER(IntKi) :: j ! counter for StC instance at location + INTEGER(IntKi) :: NumBl, k, j INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -5739,8 +5750,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex NumBl = 0 - if (allocated(ED%y%BladeRootMotion)) then - NumBl = SIZE(ED%y%BladeRootMotion) + if (allocated(ED%y(iED)%BladeRootMotion)) then + NumBl = SIZE(ED%y(iED)%BladeRootMotion) elseif (allocated(SED%y%BladeRootMotion)) then NumBl = SIZE(SED%y%BladeRootMotion) end if @@ -5755,10 +5766,10 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex ! ElastoDyn outputs (motions) DO K=1,NumBl !%BladeLn2Mesh(K) used only when not BD (see below) - call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y(iED)%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y(iED)%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! these will get output with their sibling input meshes !call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) @@ -5767,11 +5778,13 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex ! ElastoDyn inputs (loads) ! %BladePtLoads used only when not BD (see below) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TowerPtLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerPtLoads', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%TowerLn2Mesh ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%HubPtLoad, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%HubPtMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%NacelleLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%NacelleMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TFinCMLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%TFinCMMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%PlatformPtMesh ) + do j = 1, size(ED%Input,2) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%TowerPtLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerPtLoads'//Num2LStr(j), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%TowerLn2Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%HubPtLoad, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub'//Num2LStr(j), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%HubPtMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%NacelleLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle'//Num2LStr(j) ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%NacelleMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%TFinCMLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin'//Num2LStr(j) ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%TFinCMMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh'//Num2LStr(j), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%PlatformPtMesh ) + end do end if @@ -5810,9 +5823,11 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex ELSE if (p_FAST%CompElast == Module_ED .and. allocated(ED%Input)) then ! ElastoDyn - DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%BladeLn2Mesh(K) ) + DO j = 1, size(ED%y) + DO K = 1, size(ED%y(j)%BladeLn2Mesh) + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(j))//'-'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%BladePtLoads(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladePtLoads'//trim(num2lstr(j))//'-'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%BladeLn2Mesh(K) ) + END DO END DO ELSE if (p_FAST%CompElast == Module_SED .and. allocated(SED%Input)) then ! Simplified-ElastoDyn @@ -6017,8 +6032,8 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, NumBl = 0 - if (allocated(ED%y%BladeRootMotion)) then - NumBl = SIZE(ED%y%BladeRootMotion) + if (allocated(ED%y(iED)%BladeRootMotion)) then + NumBl = SIZE(ED%y(iED)%BladeRootMotion) elseif (allocated(SED%y%BladeRootMotion)) then NumBl = SIZE(SED%y%BladeRootMotion) end if @@ -6038,13 +6053,14 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO ELSE IF ( p_FAST%CompElast == Module_ED ) THEN - DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - END DO + do j = 1, size(ED%y) + DO k = 1, size(ED%y(j)%BladeLn2Mesh) + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(j))//'-'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + END DO + end do END IF -! Nacelle if (p_FAST%CompElast == Module_SED) then if (allocated(SED%Input)) then ! Nacelle @@ -6059,18 +6075,20 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, end if else if (allocated(ED%Input)) then - ! Nacelle - call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%NacelleLoads ) - ! TailFin - call MeshWrVTK(p_FAST%TurbinePos, ED%y%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%TFinCMLoads ) - ! Hub - call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%HubPtLoad ) - ! Tower motions - call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + do j = 1, size(ED%y) + ! Nacelle + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle'//Num2LStr(j), y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1,j)%NacelleLoads ) + ! TailFin + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin'//Num2LStr(j), y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1,j)%TFinCMLoads ) + ! Hub + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub'//Num2LStr(j), y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1,j)%HubPtLoad ) + ! Tower motions + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion'//Num2LStr(j), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end do end if endif @@ -6151,14 +6169,14 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: NumBl, k, L + INTEGER(IntKi) :: NumBl, j, k, L INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' NumBl = 0 - if (allocated(ED%y%BladeRootMotion)) then - NumBl = SIZE(ED%y%BladeRootMotion) + if (allocated(ED%y(iED)%BladeRootMotion)) then + NumBl = SIZE(ED%y(iED)%BladeRootMotion) elseif (allocated(SED%y%BladeRootMotion)) then NumBl = SIZE(SED%y%BladeRootMotion) end if @@ -6169,21 +6187,24 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD if ( allocated( p_FAST%VTK_Surface%WaveElevVisGrid ) ) call WrVTK_WaveElevVisGrid( t_global, p_FAST, y_FAST, SeaSt) if (allocated(ED%Input)) then - ! Nacelle - call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.NacelleSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1)%NacelleLoads ) - ! TailFin TODO TailFin - !call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.TailFinSurface', & - ! y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%TFinBox, Sib=ED%Input(1)%TFinCMLoads ) - - ! Hub - call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.HubSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & - NumSegments=p_FAST%VTK_Surface%NumSectors, radius=p_FAST%VTK_Surface%HubRad, Sib=ED%Input(1)%HubPtLoad ) - - ! Tower motions - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.TowerSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) + do j = 1, size(ED%Input,2) + ! Nacelle + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y(j)%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.NacelleSurface'//Num2LStr(j), & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1,j)%NacelleLoads ) + + ! TailFin TODO TailFin + !call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y(j)%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.TailFinSurface'//Num2LStr(j), & + ! y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%TFinBox, Sib=ED%Input(1,j)%TFinCMLoads ) + + ! Hub + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y(j)%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.HubSurface'//Num2LStr(j), & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & + NumSegments=p_FAST%VTK_Surface%NumSectors, radius=p_FAST%VTK_Surface%HubRad, Sib=ED%Input(1,j)%HubPtLoad ) + + ! Tower motions + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y(j)%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.TowerSurface'//Num2LStr(j), & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) + end do end if ! Blades @@ -6201,10 +6222,12 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO ELSE IF ( p_FAST%CompElast == Module_ED ) THEN - DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) - END DO + do j = 1, size(ED%y) + DO k = 1, size(ED%y(j)%BladeLn2Mesh) + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y(j)%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED'//trim(Num2LStr(j))//'Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + END DO + end do ! ELSE IF ( p_FAST%CompElast == Module_SED ) THEN ! No surface info from SED END IF @@ -6424,7 +6447,7 @@ END SUBROUTINE GetWaveElevIndx !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes Input Mesh information to a binary file (for debugging). It both opens and closes the file. SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, ErrStat, ErrMsg) - TYPE(ED_InputType), INTENT(IN) :: u_ED !< ElastoDyn inputs + TYPE(ED_InputType), INTENT(IN) :: u_ED(:) !< ElastoDyn inputs TYPE(AD_InputType), INTENT(IN) :: u_AD !< AeroDyn inputs TYPE(SD_InputType), INTENT(IN) :: u_SD !< SubDyn inputs TYPE(HydroDyn_InputType), INTENT(IN) :: u_HD !< HydroDyn inputs @@ -6435,7 +6458,7 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: unOut - INTEGER(IntKi) :: K_local + INTEGER(IntKi) :: J_local, K_local INTEGER(B4Ki), PARAMETER :: File_ID = 3 INTEGER(B4Ki) :: NumBl @@ -6451,16 +6474,18 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, ! Add a file identification number (in case we ever have to change this): WRITE( unOut, IOSTAT=ErrStat ) File_ID + do J_local = 1,size(u_ED) ! Add how many blade meshes there are: - NumBl = SIZE(u_ED%BladePtLoads,1) ! Note that NumBl is B4Ki - WRITE( unOut, IOSTAT=ErrStat ) NumBl + NumBl = SIZE(u_ED(J_local)%BladePtLoads,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl ! Add all of the input meshes: - DO K_local = 1,NumBl - CALL MeshWrBin( unOut, u_ED%BladePtLoads(K_local), ErrStat, ErrMsg ) - END DO - CALL MeshWrBin( unOut, u_ED%TowerPtLoads, ErrStat, ErrMsg ) - CALL MeshWrBin( unOut, u_ED%PlatformPtMesh, ErrStat, ErrMsg ) + DO K_local = 1,NumBl + CALL MeshWrBin( unOut, u_ED(J_local)%BladePtLoads(K_local), ErrStat, ErrMsg ) + END DO + CALL MeshWrBin( unOut, u_ED(J_local)%TowerPtLoads, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_ED(J_local)%PlatformPtMesh, ErrStat, ErrMsg ) + end do CALL MeshWrBin( unOut, u_SD%TPMesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, u_SD%LMesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, u_HD%Morison%Mesh, ErrStat, ErrMsg ) @@ -6493,7 +6518,7 @@ END SUBROUTINE WriteInputMeshesToFile !! will be opened for writing (FileName). It is up to the caller of this routine to close the file. SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_BD, UnOut, ErrStat, ErrMsg, FileName) REAL(DbKi), INTENT(IN) :: time !< current simulation time - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< ElastoDyn outputs + TYPE(ED_OutputType), INTENT(IN) :: y_ED(:) !< ElastoDyn outputs TYPE(SD_InputType), INTENT(IN) :: u_SD !< SubDyn inputs TYPE(SD_OutputType), INTENT(IN) :: y_SD !< SubDyn outputs TYPE(HydroDyn_InputType), INTENT(IN) :: u_HD !< HydroDyn inputs @@ -6509,7 +6534,7 @@ SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_ REAL(R8Ki) :: t - INTEGER(IntKi) :: K_local + INTEGER(IntKi) :: J_local, K_local INTEGER(B4Ki), PARAMETER :: File_ID = 101 INTEGER(B4Ki) :: NumBl @@ -6530,8 +6555,10 @@ SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_ WRITE( unOut, IOSTAT=ErrStat ) File_ID ! Add how many blade meshes there are: - NumBl = SIZE(y_ED%BladeLn2Mesh,1) ! Note that NumBl is B4Ki - WRITE( unOut, IOSTAT=ErrStat ) NumBl + do J_local = 1,size(y_ED) + NumBl = SIZE(y_ED(J_local)%BladeLn2Mesh,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl + end do !FIXME: if y_BD is not allocated, size could return garbage here!!!! NumBl = SIZE(y_BD,1) ! Note that NumBl is B4Ki WRITE( unOut, IOSTAT=ErrStat ) NumBl @@ -6540,11 +6567,13 @@ SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_ WRITE( unOut, IOSTAT=ErrStat ) t ! Add all of the meshes with motions: - DO K_local = 1,SIZE(y_ED%BladeLn2Mesh,1) - CALL MeshWrBin( unOut, y_ED%BladeLn2Mesh(K_local), ErrStat, ErrMsg ) - END DO - CALL MeshWrBin( unOut, y_ED%TowerLn2Mesh, ErrStat, ErrMsg ) - CALL MeshWrBin( unOut, y_ED%PlatformPtMesh, ErrStat, ErrMsg ) + do J_local = 1,size(y_ED) + DO K_local = 1,SIZE(y_ED(J_local)%BladeLn2Mesh,1) + CALL MeshWrBin( unOut, y_ED(J_local)%BladeLn2Mesh(K_local), ErrStat, ErrMsg ) + END DO + CALL MeshWrBin( unOut, y_ED(J_local)%TowerLn2Mesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, y_ED(J_local)%PlatformPtMesh, ErrStat, ErrMsg ) + end do CALL MeshWrBin( unOut, u_SD%TPMesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, y_SD%y2Mesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, y_SD%y3Mesh, ErrStat, ErrMsg ) @@ -6742,36 +6771,127 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, S CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats - LOGICAL :: SkipRunTimes + CHARACTER(*), PARAMETER :: RoutineName = 'ExitThisProgram' INTEGER(IntKi) :: ErrStat CHARACTER(ErrMsgLen) :: ErrMsg + INTEGER(IntKi) :: UnSum + INTEGER(IntKi) :: ErrorLevel + LOGICAL :: PrintRunTimes + CHARACTER(1224) :: SimMsg ! optional message to print about where the error took place in the simulation + INTEGER(IntKi) :: StrtTime(8) + REAL(ReKi) :: UsrTime1 + INTEGER(IntKi) :: SimStrtTime(8) + REAL(ReKi) :: UsrTime2 + REAL(DbKi) :: t_global + CHARACTER(4) :: TDesc + + ! Store incomming error level + ErrorLevel = ErrLevel_in - IF (PRESENT(SkipRunTimeMsg)) THEN - SkipRunTimes = SkipRunTimeMsg - ELSE - SkipRunTimes = .FALSE. + ! Set flag to print runtimes depending on argument + if (present(SkipRunTimeMsg)) then + PrintRunTimes = .not. SkipRunTimeMsg + else + PrintRunTimes = .true. + end if + + ! Print runtime if write status flag is set + PrintRunTimes = PrintRunTimes .and. Turbine%p_FAST%WrSttsTime + + ! Save some data before destorying TurbineType + unSum = Turbine%y_FAST%UnSum + StrtTime = Turbine%m_FAST%StrtTime + UsrTime1 = Turbine%m_FAST%UsrTime1 + SimStrtTime = Turbine%m_FAST%SimStrtTime + UsrTime2 = Turbine%m_FAST%UsrTime2 + t_global = Turbine%m_FAST%t_global + TDesc = Turbine%p_FAST%TDesc + + ! for debugging, let's output the meshes and all of their fields + IF ((ErrorLevel >= AbortErrLev) .and. & + (Turbine%p_FAST%WrVTK > VTK_None) .and. & + (.not. Turbine%m_FAST%Lin%FoundSteady)) THEN + Turbine%p_FAST%VTK_OutFileRoot = trim(Turbine%p_FAST%VTK_OutFileRoot)//'.DebugError' + Turbine%p_FAST%VTK_fields = .true. + CALL WrVTK_AllMeshes(Turbine%p_FAST, Turbine%y_FAST, Turbine%MeshMapData, Turbine%ED, & + Turbine%SED, Turbine%BD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & + Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD) + end if + + ! If we are doing AeroMaps, there is leftover data in AD15 parameters + if (Turbine%p_FAST%CompAeroMaps) then + if (associated(Turbine%AD%p%FlowField)) deallocate(Turbine%AD%p%FlowField) + endif + + ! End all modules + CALL FAST_ModEnd(Turbine%m_Glue%ModData, Turbine, ErrStat, ErrMsg) + IF (ErrStat /= ErrID_None) THEN + CALL WrScr(NewLine//RoutineName//':'//TRIM(ErrMsg)//NewLine) + ErrorLevel = MAX(ErrorLevel,ErrStat) END IF + ! Write output to file (do this after ending modules so that we have more memory to use if needed) + call FAST_EndOutput(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, ErrStat, ErrMsg) + IF (ErrStat /= ErrID_None) THEN + CALL WrScr(NewLine//RoutineName//':'//TRIM(ErrMsg)//NewLine) + ErrorLevel = MAX(ErrorLevel,ErrStat) + END IF + + ! Destroy all data associated with FAST variables: + call FAST_DestroyTurbineType(Turbine, ErrStat, ErrMsg) + IF (ErrStat /= ErrID_None) THEN + CALL WrScr(NewLine//RoutineName//':'//TRIM(ErrMsg)//NewLine) + ErrorLevel = MAX(ErrorLevel,ErrStat) + END IF - IF (PRESENT(ErrLocMsg)) THEN + !---------------------------------------------------------------------------- + ! Set exit error code if there was an error + !---------------------------------------------------------------------------- - CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) + IF (ErrorLevel >= AbortErrLev) THEN - ELSE + IF (PRESENT(ErrLocMsg)) THEN + SimMsg = ErrLocMsg + ELSE + SimMsg = 'after the simulation completed' + END IF - CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) + IF (UnSum > 0) THEN + CLOSE(UnSum) + UnSum = -1 + END IF + + SimMsg = trim(FAST_Ver%Name)//' encountered an error '//trim(SimMsg)//'.'//NewLine//' Simulation error level: '//GetErrStr(ErrorLevel) + if (StopTheProgram) then + CALL ProgAbort(SimMsg, TrapErrors=.FALSE., TimeWait=3._ReKi) ! wait 3 seconds (in case they double-clicked and got an error) + else + CALL WrScr(trim(SimMsg)) + end if END IF + !---------------------------------------------------------------------------- + ! Write simulation times and stop + !---------------------------------------------------------------------------- - CALL FAST_DestroyTurbineType( Turbine, ErrStat, ErrMsg) ! just in case we missed some data in ExitThisProgram() + ! Print runtime if write status time + IF (PrintRunTimes) THEN + CALL RunTimes(StrtTime, UsrTime1, SimStrtTime, UsrTime2, t_global, & + UnSum=UnSum, DescStrIn=TDesc) + END IF + ! Close summary file if opened + IF (UnSum > 0) CLOSE(UnSum) + + if (StopTheProgram) then +#if (defined COMPILE_SIMULINK || defined COMPILE_LABVIEW) + ! for Simulink, this may not be a normal stop. It might call this after an error in the model. + CALL WrScr(NewLine//' '//TRIM(FAST_Ver%Name)//' completed.'//NewLine) +#else + CALL NormStop() +#endif + end if END SUBROUTINE ExitThisProgram_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -6816,6 +6936,7 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ! Local variables: + TYPE(FAST_TurbineType) :: T INTEGER(IntKi) :: ErrorLevel LOGICAL :: PrintRunTimes @@ -6826,89 +6947,7 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, CHARACTER(*), PARAMETER :: RoutineName = 'ExitThisProgram' - ErrorLevel = ErrLevel_in - - ! for debugging, let's output the meshes and all of their fields - IF ( ErrorLevel >= AbortErrLev .AND. p_FAST%WrVTK > VTK_None .and. .not. m_FAST%Lin%FoundSteady) THEN - p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot)//'.DebugError' - p_FAST%VTK_fields = .true. - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - end if - - - ! If we are doing AeroMaps, there is leftover data in AD15 parameters - if (p_FAST%CompAeroMaps) then - if (associated(AD%p%FlowField)) deallocate(AD%p%FlowField) - endif - - - ! End all modules - CALL FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - IF (ErrStat2 /= ErrID_None) THEN - CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) - ErrorLevel = MAX(ErrorLevel,ErrStat2) - END IF - - ! Destroy all data associated with FAST variables: - - CALL FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - IF (ErrStat2 /= ErrID_None) THEN - CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) - ErrorLevel = MAX(ErrorLevel,ErrStat2) - END IF - - - !............................................................................................................................ - ! Set exit error code if there was an error; - !............................................................................................................................ - IF ( ErrorLevel >= AbortErrLev ) THEN - - IF (PRESENT(ErrLocMsg)) THEN - SimMsg = ErrLocMsg - ELSE - SimMsg = 'after the simulation completed' - END IF - - IF (y_FAST%UnSum > 0) THEN - CLOSE(y_FAST%UnSum) - y_FAST%UnSum = -1 - END IF - - - SimMsg = TRIM(FAST_Ver%Name)//' encountered an error '//TRIM(SimMsg)//'.'//NewLine//' Simulation error level: '//TRIM(GetErrStr(ErrorLevel)) - if (StopTheProgram) then - CALL ProgAbort( trim(SimMsg), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) - else - CALL WrScr(trim(SimMsg)) - end if - - END IF - - !............................................................................................................................ - ! Write simulation times and stop - !............................................................................................................................ - if (present(SkipRunTimeMsg)) then - PrintRunTimes = .not. SkipRunTimeMsg - else - PrintRunTimes = .true. - end if - - IF (p_FAST%WrSttsTime .and. PrintRunTimes) THEN - CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, UnSum=y_FAST%UnSum, DescStrIn=p_FAST%TDesc ) - END IF - IF (y_FAST%UnSum > 0) THEN - CLOSE(y_FAST%UnSum) - y_FAST%UnSum = -1 - END IF - - if (StopTheProgram) then -#if (defined COMPILE_SIMULINK || defined COMPILE_LABVIEW) - ! for Simulink, this may not be a normal stop. It might call this after an error in the model. - CALL WrScr( NewLine//' '//TRIM(FAST_Ver%Name)//' completed.'//NewLine ) -#else - CALL NormStop( ) -#endif - end if + END SUBROUTINE ExitThisProgram @@ -6979,293 +7018,6 @@ SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat, ErrMsg ) END SUBROUTINE FAST_EndOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calls the end routines for each module that was previously initialized. -SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: i, k ! loop counter - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_EndMods' - - !............................................................................................................................... - ! End all modules (and write binary FAST output file) - !............................................................................................................................... - - ErrStat = ErrID_None - ErrMsg = "" - - - IF ( p_FAST%ModuleInitialized(Module_ED) ) THEN - CALL ED_End( ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_SED) ) THEN - CALL SED_End( SED%Input(1), SED%p, SED%x(STATE_CURR), SED%xd(STATE_CURR), SED%z(STATE_CURR), SED%OtherSt(STATE_CURR), & - SED%y, SED%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_BD) ) THEN - - DO k=1,p_FAST%nBeams - CALL BD_End(BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & - BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - - END IF - - - IF ( p_FAST%ModuleInitialized(Module_AD) ) THEN - CALL AD_End( AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & - AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_ADsk) ) THEN - CALL ADsk_End( ADsk%Input(1), ADsk%p, ADsk%x(STATE_CURR), ADsk%xd(STATE_CURR), ADsk%z(STATE_CURR), & - ADsk%OtherSt(STATE_CURR), ADsk%y, ADsk%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_IfW) ) THEN - CALL InflowWind_End( IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), IfW%OtherSt(STATE_CURR), & - IfW%y, IfW%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_SrvD) ) THEN - CALL SrvD_End( SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), SrvD%OtherSt(STATE_CURR), & - SrvD%y, SrvD%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_HD) ) THEN - CALL HydroDyn_End( HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & - HD%y, HD%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_SD) ) THEN - CALL SD_End( SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), & - SD%y, SD%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSE IF ( p_FAST%ModuleInitialized(Module_ExtPtfm) ) THEN - CALL ExtPtfm_End( ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR), & - ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_MAP) ) THEN - CALL MAP_End( MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & - MAPp%y, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_MD) ) THEN - CALL MD_End( MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), MD%OtherSt(STATE_CURR), & - MD%y, MD%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_FEAM) ) THEN - CALL FEAM_End( FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & - FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_Orca) ) THEN - CALL Orca_End( Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & - Orca%y, Orca%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_IceF) ) THEN - CALL IceFloe_End(IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & - IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_IceD) ) THEN - - DO i=1,p_FAST%numIceLegs - CALL IceD_End(IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & - IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - - END IF - - IF ( p_FAST%ModuleInitialized(Module_SeaSt) ) THEN - ! make sure this is done AFTER any module that may be pointing to SeaSt data -- we deallocate the pointer targets here - CALL SeaSt_End( SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), SeaSt%OtherSt(STATE_CURR), & - SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - - - ! Write output to file (do this after ending modules so that we have more memory to use if needed) - CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - -END SUBROUTINE FAST_EndMods -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calls the destroy routines for each module. (It is basically a duplicate of FAST_DestroyTurbineType().) -SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAll' - - - - ! ------------------------------------------------------------------------- - ! Deallocate/Destroy structures associated with mesh mapping - ! ------------------------------------------------------------------------- - - ErrStat = ErrID_None - ErrMsg = "" - - - ! FAST - CALL FAST_DestroyParam( p_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL FAST_DestroyOutputFileType( y_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL FAST_DestroyMisc( m_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ElastoDyn - CALL FAST_DestroyElastoDyn_Data( ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Simplified-ElastoDyn - CALL FAST_DestroySED_Data( SED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! BeamDyn - CALL FAST_DestroyBeamDyn_Data( BD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ServoDyn - CALL FAST_DestroyServoDyn_Data( SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! AeroDyn - CALL FAST_DestroyAeroDyn_Data( AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! InflowWind - CALL FAST_DestroyInflowWind_Data( IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ExternalInflow - CALL FAST_DestroyExternalInflow_Data( ExtInfw, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! SeaState - CALL FAST_DestroySeaState_Data( SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! HydroDyn - CALL FAST_DestroyHydroDyn_Data( HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! SubDyn - CALL FAST_DestroySubDyn_Data( SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ExtPtfm - CALL FAST_DestroyExtPtfm_Data( ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! MAP - CALL FAST_DestroyMAP_Data( MAPp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! FEAMooring - CALL FAST_DestroyFEAMooring_Data( FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! MoorDyn - CALL FAST_DestroyMoorDyn_Data( MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Orca - CALL FAST_DestroyOrcaFlex_Data( Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! IceFloe - CALL FAST_DestroyIceFloe_Data( IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! IceDyn - CALL FAST_DestroyIceDyn_Data( IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Module (Mesh) Mapping data - CALL FAST_DestroyModuleMapType( MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - - END SUBROUTINE FAST_DestroyAll -!---------------------------------------------------------------------------------------------------------------------------------- - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! CHECKPOINT/RESTART ROUTINES diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index a2f5443b4e..487d412ccd 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -344,7 +344,6 @@ MODULE FAST_Types ! ========= BeamDyn_Data ======= TYPE, PUBLIC :: BeamDyn_Data TYPE(BD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x !< Continuous states [-] - TYPE(BD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: dxdt !< Continuous state derivatives [-] TYPE(BD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd !< Discrete states [-] TYPE(BD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] TYPE(BD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] @@ -357,16 +356,15 @@ MODULE FAST_Types ! ======================= ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data - TYPE(ED_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] - TYPE(ED_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] - TYPE(ED_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] - TYPE(ED_ParameterType) :: p !< Parameters [-] - TYPE(ED_OutputType) :: y !< System outputs [-] - TYPE(ED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] - TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + TYPE(ED_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] + TYPE(ED_ParameterType) , DIMENSION(:), ALLOCATABLE :: p !< Parameters [-] + TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] + TYPE(ED_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc (optimization) variables not associated with time [-] + TYPE(ED_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ElastoDyn_Data ! ======================= ! ========= SED_Data ======= @@ -698,7 +696,7 @@ MODULE FAST_Types ! ========= FAST_InitData ======= TYPE, PUBLIC :: FAST_InitData TYPE(ED_InitInputType) :: InData_ED !< ED Initialization input data [-] - TYPE(ED_InitOutputType) :: OutData_ED !< ED Initialization output data [-] + TYPE(ED_InitOutputType) , DIMENSION(:), ALLOCATABLE :: OutData_ED !< ED Initialization output data [-] TYPE(SED_InitInputType) :: InData_SED !< SED Initialization input data [-] TYPE(SED_InitOutputType) :: OutData_SED !< SED Initialization output data [-] TYPE(BD_InitInputType) :: InData_BD !< BD Initialization input data [-] @@ -3210,22 +3208,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end do end if - if (allocated(SrcBeamDyn_DataData%dxdt)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%dxdt) - UB(1:1) = ubound(SrcBeamDyn_DataData%dxdt) - if (.not. allocated(DstBeamDyn_DataData%dxdt)) then - allocate(DstBeamDyn_DataData%dxdt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%dxdt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call BD_CopyContState(SrcBeamDyn_DataData%dxdt(i1), DstBeamDyn_DataData%dxdt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcBeamDyn_DataData%xd)) then LB(1:2) = lbound(SrcBeamDyn_DataData%xd) UB(1:2) = ubound(SrcBeamDyn_DataData%xd) @@ -3382,15 +3364,6 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%x) end if - if (allocated(BeamDyn_DataData%dxdt)) then - LB(1:1) = lbound(BeamDyn_DataData%dxdt) - UB(1:1) = ubound(BeamDyn_DataData%dxdt) - do i1 = LB(1), UB(1) - call BD_DestroyContState(BeamDyn_DataData%dxdt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(BeamDyn_DataData%dxdt) - end if if (allocated(BeamDyn_DataData%xd)) then LB(1:2) = lbound(BeamDyn_DataData%xd) UB(1:2) = ubound(BeamDyn_DataData%xd) @@ -3485,15 +3458,6 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end do end do end if - call RegPack(RF, allocated(InData%dxdt)) - if (allocated(InData%dxdt)) then - call RegPackBounds(RF, 1, lbound(InData%dxdt), ubound(InData%dxdt)) - LB(1:1) = lbound(InData%dxdt) - UB(1:1) = ubound(InData%dxdt) - do i1 = LB(1), UB(1) - call BD_PackContState(RF, InData%dxdt(i1)) - end do - end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then call RegPackBounds(RF, 2, lbound(InData%xd), ubound(InData%xd)) @@ -3593,19 +3557,6 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) end do end do end if - if (allocated(OutData%dxdt)) deallocate(OutData%dxdt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%dxdt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxdt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call BD_UnpackContState(RF, OutData%dxdt(i1)) ! dxdt - end do - end if if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -3714,110 +3665,156 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcElastoDyn_DataData%x)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%x) - UB(1:1) = ubound(SrcElastoDyn_DataData%x) + LB(1:2) = lbound(SrcElastoDyn_DataData%x) + UB(1:2) = ubound(SrcElastoDyn_DataData%x) if (.not. allocated(DstElastoDyn_DataData%x)) then - allocate(DstElastoDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + allocate(DstElastoDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcElastoDyn_DataData%x(i1,i2), DstElastoDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end do end if - call ED_CopyContState(SrcElastoDyn_DataData%dxdt, DstElastoDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcElastoDyn_DataData%xd)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%xd) - UB(1:1) = ubound(SrcElastoDyn_DataData%xd) + LB(1:2) = lbound(SrcElastoDyn_DataData%xd) + UB(1:2) = ubound(SrcElastoDyn_DataData%xd) if (.not. allocated(DstElastoDyn_DataData%xd)) then - allocate(DstElastoDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + allocate(DstElastoDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1,i2), DstElastoDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end do end if if (allocated(SrcElastoDyn_DataData%z)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%z) - UB(1:1) = ubound(SrcElastoDyn_DataData%z) + LB(1:2) = lbound(SrcElastoDyn_DataData%z) + UB(1:2) = ubound(SrcElastoDyn_DataData%z) if (.not. allocated(DstElastoDyn_DataData%z)) then - allocate(DstElastoDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + allocate(DstElastoDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1,i2), DstElastoDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end do end if if (allocated(SrcElastoDyn_DataData%OtherSt)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt) + LB(1:2) = lbound(SrcElastoDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcElastoDyn_DataData%OtherSt) if (.not. allocated(DstElastoDyn_DataData%OtherSt)) then - allocate(DstElastoDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + allocate(DstElastoDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1,i2), DstElastoDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcElastoDyn_DataData%p)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%p) + UB(1:1) = ubound(SrcElastoDyn_DataData%p) + if (.not. allocated(DstElastoDyn_DataData%p)) then + allocate(DstElastoDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call ED_CopyParam(SrcElastoDyn_DataData%p(i1), DstElastoDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call ED_CopyParam(SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyOutput(SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyMisc(SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcElastoDyn_DataData%Input)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Input) - UB(1:1) = ubound(SrcElastoDyn_DataData%Input) - if (.not. allocated(DstElastoDyn_DataData%Input)) then - allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcElastoDyn_DataData%y)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%y) + UB(1:1) = ubound(SrcElastoDyn_DataData%y) + if (.not. allocated(DstElastoDyn_DataData%y)) then + allocate(DstElastoDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyOutput(SrcElastoDyn_DataData%y(i1), DstElastoDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcElastoDyn_DataData%m)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%m) + UB(1:1) = ubound(SrcElastoDyn_DataData%m) + if (.not. allocated(DstElastoDyn_DataData%m)) then + allocate(DstElastoDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%m.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call ED_CopyInput(SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call ED_CopyMisc(SrcElastoDyn_DataData%m(i1), DstElastoDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if + if (allocated(SrcElastoDyn_DataData%Input)) then + LB(1:2) = lbound(SrcElastoDyn_DataData%Input) + UB(1:2) = ubound(SrcElastoDyn_DataData%Input) + if (.not. allocated(DstElastoDyn_DataData%Input)) then + allocate(DstElastoDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_CopyInput(SrcElastoDyn_DataData%Input(i1,i2), DstElastoDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if if (allocated(SrcElastoDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) - UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes) + LB(1:2) = lbound(SrcElastoDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcElastoDyn_DataData%InputTimes) if (.not. allocated(DstElastoDyn_DataData%InputTimes)) then - allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return @@ -3831,64 +3828,93 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) type(ElastoDyn_Data), intent(inout) :: ElastoDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(ElastoDyn_DataData%x)) then - LB(1:1) = lbound(ElastoDyn_DataData%x) - UB(1:1) = ubound(ElastoDyn_DataData%x) - do i1 = LB(1), UB(1) - call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + LB(1:2) = lbound(ElastoDyn_DataData%x) + UB(1:2) = ubound(ElastoDyn_DataData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyContState(ElastoDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end do deallocate(ElastoDyn_DataData%x) end if - call ED_DestroyContState(ElastoDyn_DataData%dxdt, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ElastoDyn_DataData%xd)) then - LB(1:1) = lbound(ElastoDyn_DataData%xd) - UB(1:1) = ubound(ElastoDyn_DataData%xd) - do i1 = LB(1), UB(1) - call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + LB(1:2) = lbound(ElastoDyn_DataData%xd) + UB(1:2) = ubound(ElastoDyn_DataData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end do deallocate(ElastoDyn_DataData%xd) end if if (allocated(ElastoDyn_DataData%z)) then - LB(1:1) = lbound(ElastoDyn_DataData%z) - UB(1:1) = ubound(ElastoDyn_DataData%z) - do i1 = LB(1), UB(1) - call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + LB(1:2) = lbound(ElastoDyn_DataData%z) + UB(1:2) = ubound(ElastoDyn_DataData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyConstrState(ElastoDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end do deallocate(ElastoDyn_DataData%z) end if if (allocated(ElastoDyn_DataData%OtherSt)) then - LB(1:1) = lbound(ElastoDyn_DataData%OtherSt) - UB(1:1) = ubound(ElastoDyn_DataData%OtherSt) + LB(1:2) = lbound(ElastoDyn_DataData%OtherSt) + UB(1:2) = ubound(ElastoDyn_DataData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ElastoDyn_DataData%OtherSt) + end if + if (allocated(ElastoDyn_DataData%p)) then + LB(1:1) = lbound(ElastoDyn_DataData%p) + UB(1:1) = ubound(ElastoDyn_DataData%p) do i1 = LB(1), UB(1) - call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call ED_DestroyParam(ElastoDyn_DataData%p(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ElastoDyn_DataData%OtherSt) + deallocate(ElastoDyn_DataData%p) end if - call ED_DestroyParam(ElastoDyn_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyOutput(ElastoDyn_DataData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ElastoDyn_DataData%Input)) then - LB(1:1) = lbound(ElastoDyn_DataData%Input) - UB(1:1) = ubound(ElastoDyn_DataData%Input) + if (allocated(ElastoDyn_DataData%y)) then + LB(1:1) = lbound(ElastoDyn_DataData%y) + UB(1:1) = ubound(ElastoDyn_DataData%y) + do i1 = LB(1), UB(1) + call ED_DestroyOutput(ElastoDyn_DataData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%y) + end if + if (allocated(ElastoDyn_DataData%m)) then + LB(1:1) = lbound(ElastoDyn_DataData%m) + UB(1:1) = ubound(ElastoDyn_DataData%m) do i1 = LB(1), UB(1) - call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call ED_DestroyMisc(ElastoDyn_DataData%m(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(ElastoDyn_DataData%m) + end if + if (allocated(ElastoDyn_DataData%Input)) then + LB(1:2) = lbound(ElastoDyn_DataData%Input) + UB(1:2) = ubound(ElastoDyn_DataData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyInput(ElastoDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do deallocate(ElastoDyn_DataData%Input) end if if (allocated(ElastoDyn_DataData%InputTimes)) then @@ -3900,56 +3926,89 @@ subroutine FAST_PackElastoDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(ElastoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call ED_PackContState(RF, InData%x(i1)) + call RegPackBounds(RF, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackContState(RF, InData%x(i1,i2)) + end do end do end if - call ED_PackContState(RF, InData%dxdt) call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call ED_PackDiscState(RF, InData%xd(i1)) + call RegPackBounds(RF, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackDiscState(RF, InData%xd(i1,i2)) + end do end do end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call ED_PackConstrState(RF, InData%z(i1)) + call RegPackBounds(RF, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackConstrState(RF, InData%z(i1,i2)) + end do end do end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + call RegPackBounds(RF, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackOtherState(RF, InData%OtherSt(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(RF, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call ED_PackParam(RF, InData%p(i1)) + end do + end if + call RegPack(RF, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call ED_PackOutput(RF, InData%y(i1)) + end do + end if + call RegPack(RF, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(RF, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) do i1 = LB(1), UB(1) - call ED_PackOtherState(RF, InData%OtherSt(i1)) + call ED_PackMisc(RF, InData%m(i1)) end do end if - call ED_PackParam(RF, InData%p) - call ED_PackOutput(RF, InData%y) - call ED_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) - do i1 = LB(1), UB(1) - call ED_PackInput(RF, InData%Input(i1)) + call RegPackBounds(RF, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackInput(RF, InData%Input(i1,i2)) + end do end do end if call RegPackAlloc(RF, InData%InputTimes) @@ -3960,78 +4019,123 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ElastoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - do i1 = LB(1), UB(1) - call ED_UnpackContState(RF, OutData%x(i1)) ! x + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackContState(RF, OutData%x(i1,i2)) ! x + end do end do end if - call ED_UnpackContState(RF, OutData%dxdt) ! dxdt if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - do i1 = LB(1), UB(1) - call ED_UnpackDiscState(RF, OutData%xd(i1)) ! xd + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(RF, OutData%xd(i1,i2)) ! xd + end do end do end if if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - do i1 = LB(1), UB(1) - call ED_UnpackConstrState(RF, OutData%z(i1)) ! z + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(RF, OutData%z(i1,i2)) ! z + end do end do end if if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(RF, OutData%OtherSt(i1,i2)) ! OtherSt + end do + end do + end if + if (allocated(OutData%p)) deallocate(OutData%p) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%p(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call ED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + call ED_UnpackParam(RF, OutData%p(i1)) ! p end do end if - call ED_UnpackParam(RF, OutData%p) ! p - call ED_UnpackOutput(RF, OutData%y) ! y - call ED_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%y(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOutput(RF, OutData%y(i1)) ! y + end do + end if + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackInput(RF, OutData%Input(i1)) ! Input + call ED_UnpackMisc(RF, OutData%m(i1)) ! m + end do + end if + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackInput(RF, OutData%Input(i1,i2)) ! Input + end do end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return @@ -10881,9 +10985,22 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat call ED_CopyInitInput(SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call ED_CopyInitOutput(SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitDataData%OutData_ED)) then + LB(1:1) = lbound(SrcInitDataData%OutData_ED) + UB(1:1) = ubound(SrcInitDataData%OutData_ED) + if (.not. allocated(DstInitDataData%OutData_ED)) then + allocate(DstInitDataData%OutData_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyInitOutput(SrcInitDataData%OutData_ED(i1), DstInitDataData%OutData_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call SED_CopyInitInput(SrcInitDataData%InData_SED, DstInitDataData%InData_SED, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -11020,8 +11137,15 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) ErrMsg = '' call ED_DestroyInitInput(InitDataData%InData_ED, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyInitOutput(InitDataData%OutData_ED, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitDataData%OutData_ED)) then + LB(1:1) = lbound(InitDataData%OutData_ED) + UB(1:1) = ubound(InitDataData%OutData_ED) + do i1 = LB(1), UB(1) + call ED_DestroyInitOutput(InitDataData%OutData_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitDataData%OutData_ED) + end if call SED_DestroyInitInput(InitDataData%InData_SED, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SED_DestroyInitOutput(InitDataData%OutData_SED, ErrStat2, ErrMsg2) @@ -11111,7 +11235,15 @@ subroutine FAST_PackInitData(RF, Indata) integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call ED_PackInitInput(RF, InData%InData_ED) - call ED_PackInitOutput(RF, InData%OutData_ED) + call RegPack(RF, allocated(InData%OutData_ED)) + if (allocated(InData%OutData_ED)) then + call RegPackBounds(RF, 1, lbound(InData%OutData_ED), ubound(InData%OutData_ED)) + LB(1:1) = lbound(InData%OutData_ED) + UB(1:1) = ubound(InData%OutData_ED) + do i1 = LB(1), UB(1) + call ED_PackInitOutput(RF, InData%OutData_ED(i1)) + end do + end if call SED_PackInitInput(RF, InData%InData_SED) call SED_PackInitOutput(RF, InData%OutData_SED) call BD_PackInitInput(RF, InData%InData_BD) @@ -11169,7 +11301,19 @@ subroutine FAST_UnPackInitData(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call ED_UnpackInitInput(RF, OutData%InData_ED) ! InData_ED - call ED_UnpackInitOutput(RF, OutData%OutData_ED) ! OutData_ED + if (allocated(OutData%OutData_ED)) deallocate(OutData%OutData_ED) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutData_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInitOutput(RF, OutData%OutData_ED(i1)) ! OutData_ED + end do + end if call SED_UnpackInitInput(RF, OutData%InData_SED) ! InData_SED call SED_UnpackInitOutput(RF, OutData%OutData_SED) ! OutData_SED call BD_UnpackInitInput(RF, OutData%InData_BD) ! InData_BD From 05c3e4dbb5d6f1deffb900ba07e7bdba9d3ed148 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 30 Dec 2024 21:50:02 +0000 Subject: [PATCH 308/319] Fix FAST.Farm, revert BD changes --- glue-codes/fast-farm/src/FAST_Farm_Subs.f90 | 8 +++++--- modules/beamdyn/src/BeamDyn.f90 | 13 ++++++------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 index 813a3243cc..edc0b224fc 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 @@ -39,6 +39,8 @@ MODULE FAST_Farm_Subs #endif IMPLICIT NONE + + integer(IntKi), private, parameter :: iED = 1 CONTAINS @@ -881,7 +883,7 @@ SUBROUTINE Farm_InitMD( farm, ErrStat, ErrMsg ) IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh ELSE - SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y(iED)%PlatformPtMesh END IF CALL MeshMapCreate( SubstructureMotion, farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) @@ -965,7 +967,7 @@ subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh ELSE - SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y(iED)%PlatformPtMesh END IF CALL Transfer_Point_to_Point( SubstructureMotion, farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) @@ -995,7 +997,7 @@ subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh ELSE - SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y(iED)%PlatformPtMesh END IF ! mapping; Note: SubstructureLoads_Tmp_Farm contains loads from the farm-level (at a previous step); gets integrated into individual turbines inside FWrap_Increment() diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index ae4fe2c9bd..d3dbcffd8d 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -3139,7 +3139,6 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) ffd_t) call Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(m%qp%E1(:,idx_qp,nelem), & - m%qp%vvv(:,idx_qp,nelem), & m%qp%vvp(:,idx_qp,nelem), & m%qp%betaC(:,:,idx_qp,nelem), & ffd_t, & @@ -3154,8 +3153,8 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) ENDIF CONTAINS - subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvv, vvp, betaC, ffd, Sd, Od, Qd, Gd, Xd, Yd, Pd) - REAL(BDKi), intent(in) :: E1(:), vvv(:), vvp(:), betaC(:,:), ffd(:) + subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, ffd, Sd, Od, Qd, Gd, Xd, Yd, Pd) + REAL(BDKi), intent(in) :: E1(:), vvp(:), betaC(:,:), ffd(:) REAL(BDKi), intent(out) :: Sd(:,:), Od(:,:), Qd(:,:), Gd(:,:), Xd(:,:), Yd(:,:), Pd(:,:) REAL(BDKi) :: D11(3,3), D12(3,3), D21(3,3), D22(3,3) REAL(BDKi) :: b11(3,3), b12(3,3) @@ -3170,7 +3169,7 @@ subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvv, vvp, betaC, ffd, Sd, Od, Qd, Gd, X b11(1:3,1:3) = -MATMUL(SkewSymMat(E1),D11) b12(1:3,1:3) = -MATMUL(SkewSymMat(E1),D12) - SS_ome = SkewSymMat(vvv(4:6)) + SS_ome = SkewSymMat( m%qp%vvv(4:6,idx_qp,nelem) ) ! Compute stiffness matrix Sd Sd(1:3,1:3) = -MATMUL(D11,SS_ome) @@ -3184,7 +3183,7 @@ subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvv, vvp, betaC, ffd, Sd, Od, Qd, Gd, X Pd(4:6,4:6) = -MATMUL(b12,SS_ome) ! Compute stiffness matrix Od - alpha = SkewSymMat(vvv(1:3)) - MATMUL(SS_ome,SkewSymMat(E1)) + alpha = SkewSymMat(vvp(1:3)) - MATMUL(SS_ome,SkewSymMat(E1)) Od(:,1:3) = 0.0_BDKi Od(1:3,4:6) = MATMUL(D11,alpha) - SkewSymMat(ffd(1:3)) Od(4:6,4:6) = MATMUL(D21,alpha) - SkewSymMat(ffd(4:6)) @@ -3214,8 +3213,8 @@ SUBROUTINE Calc_FC_FD_ffd(E1, vvv, vvp, betaC, Fc, Fd, ffd) REAL(BDKi) :: eed(6) ! Compute strain rates - eed(1:3) = vvv(1:3) + cross_product(E1,vvv(4:6)) - eed(4:6) = vvp(4:6) + eed = vvp + eed(1:3) = eed(1:3) + cross_product(E1,vvv(4:6)) ! Compute dissipative force ffd(1:6) = MATMUL(betaC(:,:),eed) From 41d408cd916c2aa80dc8a03f6007b989a0bef0d6 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 31 Dec 2024 19:34:10 +0000 Subject: [PATCH 309/319] Fix incorrect indexing for RdtnKrnl in HydroDyn --- modules/hydrodyn/src/HydroDyn.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index c6caee100e..36c5a152f6 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -623,7 +623,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I WRITE( InputFileData%UnSum, '(1X,I10,2X,E12.5)',ADVANCE='no' ) K, K*p%WAMIT(1)%Conv_Rdtn%RdtnDT do i = 1,6*p%NBody do j = 1,6*p%NBody - WRITE( InputFileData%UnSum, '(2X,ES16.5)',ADVANCE='no' ) p%WAMIT(1)%Conv_Rdtn%RdtnKrnl(k,i,j) + WRITE( InputFileData%UnSum, '(2X,ES16.5)',ADVANCE='no' ) p%WAMIT(1)%Conv_Rdtn%RdtnKrnl(i,j,k) end do end do write(InputFileData%UnSum,'()') ! end of line character From 4c15dbdbfa72a424e26701475523fa1187be138c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 31 Dec 2024 19:34:35 +0000 Subject: [PATCH 310/319] Add check for OutData_ED being allocated in FAST_Subs --- modules/openfast-library/src/FAST_Subs.f90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index e6a7b1324f..c6c565126e 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -2143,13 +2143,15 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_ExtInfw%WriteOutputHdr ) ) y_FAST%numOuts(Module_ExtInfw) = SIZE(Init%OutData_ExtInfw%WriteOutputHdr) -do i=1,NumED - IF ( ALLOCATED( Init%OutData_ED(i)%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = y_FAST%numOuts(Module_ED) + SIZE(Init%OutData_ED(iED)%WriteOutputHdr) -end do + IF ( ALLOCATED( Init%OutData_ED ) ) then + do i = 1, NumED + IF ( ALLOCATED( Init%OutData_ED(i)%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = y_FAST%numOuts(Module_ED) + SIZE(Init%OutData_ED(iED)%WriteOutputHdr) + end do + end if IF ( ALLOCATED( Init%OutData_SED%WriteOutputHdr ) ) y_FAST%numOuts(Module_SED) = SIZE(Init%OutData_SED%WriteOutputHdr) -do i=1,p_FAST%nBeams - IF ( ALLOCATED( Init%OutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(Init%OutData_BD(i)%WriteOutputHdr) -end do + do i=1,p_FAST%nBeams + IF ( ALLOCATED( Init%OutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(Init%OutData_BD(i)%WriteOutputHdr) + end do IF ( ALLOCATED( Init%OutData_AD%rotors)) then IF ( ALLOCATED( Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%numOuts(Module_AD) = SIZE(Init%OutData_AD%rotors(1)%WriteOutputHdr) From 3802b169540e5b3e9bef10075c47f203c705c683 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 31 Dec 2024 19:40:52 +0000 Subject: [PATCH 311/319] Update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 790b7c6bb1..936a49254d 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 790b7c6bb16f5683c204f5e59a4579e03a44b061 +Subproject commit 936a49254dea657454b375932e3a5eba38aeb17f From a898dc15c592f0994c5c2ad0254755e1005d7058 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Tue, 31 Dec 2024 14:52:20 -0700 Subject: [PATCH 312/319] Update documentation for added mass and fluid inertia calculations --- ...nertia_Added_Mass_Implementation_Plan.docx | Bin 0 -> 47597 bytes .../AeroDyn/UMERC24-Poster.pdf | Bin 0 -> 2813632 bytes docs/source/user/aerodyn/index.rst | 4 + docs/source/user/aerodyn/input.rst | 42 ++++++++-- docs/source/user/aerodyn/introduction.rst | 29 +++---- docs/source/user/aerodyn/theory.rst | 79 ++++++++++++++++++ 6 files changed, 131 insertions(+), 23 deletions(-) create mode 100644 docs/OtherSupporting/AeroDyn/Fluid_Inertia_Added_Mass_Implementation_Plan.docx create mode 100644 docs/OtherSupporting/AeroDyn/UMERC24-Poster.pdf diff --git a/docs/OtherSupporting/AeroDyn/Fluid_Inertia_Added_Mass_Implementation_Plan.docx b/docs/OtherSupporting/AeroDyn/Fluid_Inertia_Added_Mass_Implementation_Plan.docx new file mode 100644 index 0000000000000000000000000000000000000000..61d4a373ce23390be0a1e83e6a7bf9807932b5ff GIT binary patch literal 47597 zcmeF1Q?n?rwxySC+qP}n+RL_W+qP}nwy~FO+vKHOtfeAzqX)1&?tEIz$BMC2n?;$)tb^!9R5?;WJyDq-nx(w)zVp3NMat~4uI)7- zSxq09e%%k5H^!zzt9@!ma4L4EGF5SMjhlp@btr`$`M+07$nwhb-V9a-O#>qo`LHb&Ipk@6c1nOFFSZ$Se|vElr8#YRI}%e zeaf9>7R>|Ti4s90=N4ou$&Yde|65ojhjz4w!^#e)!gvtAydbDwW-TA^ZRJWhJFeq$dCX z00{sLfcS5Oo1LREy|JB-3KD`5K%3wZ^WYeTf#7bgP_NWf~LWl+|^SjQz*7u08eXAhf=ul7`j(|x*DwUdZ z6?I))9*%s9rkBm(aNySW+n6qYbJ#7>__R&^Eabr&v1Gv}y}0RC_wz>SZPb&AVv;;t z=#e^ltIIn&Qnjo1z54sm71q{d-KjZj!6_(PJhB;f{Ip%w)u`Ru(@j(Ac27h_hc>}7 z7kO3Moo*U6b#+3PF`5Sdhp!7HvNFCe)q^c23h4P%^xQ|KyD~G&_x$e$O&s2QnnTdX z@e|$T)Z0`mY>ON5Xo-)-H5 zzYDWsqVG-+(Nm2qG_=j%F3?BEgqed5Hm$bA9`3x_ls_8o%;JFByyE*IigCa^8~lgn4U zR7-JXD@PkX)S=b^x+C>Qt!c{R2Q<}^AQlJYEIVhyfLkZo2_TER*25l+AqMs9Gw;8! z{yAWKEH@l~syFK^+33o&E=R9PaAz#H;ZmS%$=8|GuFrr)4b#C)t8`@nY-GWILi%Q# zRi`J{b^1>JGIb8`#!Q~kQL%{$YjvNWLHwn?kcmej-hDmD+ z!@S@>S-0%4q2;V@dDTk$_8(A=Yo!V@%TaK^V8p*IBz-uFI^TS4vq%+RbrL~j+J$WF zhfDzYi9o^pCGs298+WSaU%_X0`Wmxl9iY2kK?Mp}UB5#7)h&d7YMY{n+abmdOvPOb z2q@+GLXj;X^{re-&`?;JUuuJ}pY`>4l~UAR_3z*1c{t26XQjUs?^_|AX3K>cc(y11T_O?uBv&2!o+vpi3Q zmCW;E`MgWrJ8T;_eEkZozIO||QKS)p*zY|H@lW$)T@s5e9t(^1Sa75h5wnDn z;_>`Z!ZrveS%tTDVOx|5Po5vmLS^|w(-`^7WW?jNpA2^bT5;3GrSt<5J0)eRRcEKk zLsH_O@35?7s<uCdc4A=Grk%Xa{ zFN!+8ZPF2vKQyO}e`XtHy~L|JObY5d&=acp}5l?&Bu$7;lIVsgvJzA+4GuI|NKu?Ago>kkh1inZq=U44YO3f~P5#XxYzEx^cfCk>^tquV* z%e-0*_iCbB+Y=Gs^;3Vo$gdXjBvc`W1a;tH)Ykx)aIvuj_Ptnml?mw^g;DStHx0MQ zw~ctx`4`V*SL~-&BW~oUj`#*AnIR7$07VUKl;}ZLV4XL~1hQjfDg|CqbtV&Mi^`r> zs7u-=A311G9ER97)BpuY{lLGw!nE(X# zKLYtY^GTh!o4L;&0~*~BF@x$KzjQzzLN@hParzQ3&byt*f~zB$k-}yhhMuD zhhSUc*FmyxOMxVxU#>I6p|AV!c*%Zqc#e9<5zR<8Q#FASLCa=CAQj$Lmv9mHEGX{R ztt!S5JmMoBLKO<1VeZ)V4m_b~OgA0zWz-bDw~9B13R;S34v3sWcw~R?7}<)*9;|z7Vw-fGo6p zQd2b`jk!>t)XX?j81Nxl6P;M zmt`7waqeaQQMmVRE?#sH$RZq409tyiv3X>Dw8h4(gk?2qQo^=JGp-k%qB%><$5{xF zw_#*JrkFopv<%8=UwC??9rRig-lGX9)Syl6A`J30VelbWVF6}NO8~md2gJ3Cs&QT4 zpbB9C;aUqWyD&Sf$~*j;p^}|sf8^+)y*0L8^j>m!0T?pOYBoBD+JyP{Kub&AS#4{Eq2Ow@*nduF*O=@GOZ z@Z*tZTm>Y{J^hdcQfL-u(JWEA)}&1&S|ZSpP2a}rX z;B0`>vTdF)Ci6;+6oprD#4{jK!xO)ixdOE+RE`}=3;QN|uXe+-zRwUzM@Hfn-LEKv z`|Mid@XW@A?cQ-rd=s_EFODZ|JFfk92;PYtM79E6ytyVn^7hNle&1XinmO9$^c2U+ zq&FO86qcewtlR3$V!$JPIgjR!$>ws7Zy4ogZU)eSWaoJFLPFnz$2d)=7ya5DyjJwZcU zSH@@p6xcJawRdF8!?G2o@{oFvE=C%KJ5EcO3ME{tVs5HuMQ~YbpeRJGh^j1)GciR z>AOp)-b7Jzzxd0+1kD6u3_NycGusfs1*w65CWGB1FT)%Hm?xyi9 zsj%pa`1FIUAZPGc#+W0|(heV9c{M2L8H9CPhb>hB*bQ>IBZ5_J{8hx$4`7XKS>BSy zcn|W1^1{V%d?Cj>UvPnC{vf{ku7e%jjw!#$G44;0Z=I$?2agd2Lyw!ZI=n5y~Zqm``dGO#LAl z7X@2kCS-4h#NpW*Av!sVu}pryH|BHqyPcfMp}TCEWRoS%&%Xtzxj@lkMcEyW>R0!+ zUQzN6;-w9#0E*ma4}tp&pJ9*n>nUxmx}+lQ=3ie1sXe0<&?k$z83glFJ`>L!U2D@LgTNGm$Zn)e~h7*NFa+o!7=ZM1D+RUr~%Y6-yF~@3qVrLa>Kv{7Q9bJ9g~Z) zb`$+jbX#KtV|6A_La?TsU-qJh*9HonUZU;;EEy^7oBunqE)^@>}{O!a&SBqFZ z(;8^aeX}NqKRWNM8Y2uqGA(sb8Ko-7=EzsJF1(QnGmsdo{1@?N6cBLH)j5mo7;4PM z&b+rtMXCUkIslaY1gq2#jEvWD2k*vhy} zOT2j7G;Mo1yvH;x=UF^z7RQtnJTm%EQf|%~7u}D>#sxT~e4=SaaGZkmAd$}zMQ~~Z zb$KGSB`~KqNQ=n?CIE}p#HctMA=8DMLv?@y!R7WT9HHHch*M#6-WgX_q5PvYmF4vP z)1DPOuX$Ns@B!QrYle>m){H6CU?WOX*)fqzz&`k8`x*K9XdF_1|DQ0n;sLc<#dGie zHqMT?6YBR_oXsaZ+we>JN$$A9f-0sDoHFM;_)DT7ykpni?Hs$vPttpBJQv%tTF{qf zWWjt%F)?B0Jh&n=M07XW(A|JiVE6-vN)LB5&#tjC!axu}vGw|%c@-V3Li3f$7d-N+ z<7n$v!)j0ZU2|dSlzH7CB}(n9dAkgn14+fvsoCEBK(EI}-vm%qY!9J(Ya1QQgbS-! zO|8w4-(Z?XXY3lcGvlsPBI#bN8vGbbK-3KZ4W_@bWDKmro3*3q3wL=u$L3E6g@_Rr zda38_2L1H@E^~JhhG;$_tEsI8)YC#4n1yyiE}s*Uq3wVF3Sx~|UYn2zgOCS%dyBX> zoF(&=aJ!mw2|;Ci(b;b3GgFNQ@?-Yss)nqbo{VzpWa zTeO;XCMKx_A+w10f6TZ9yQ$(Kb(g4-_Vwa{L`h9#IS*F;KFOVjs_AGgNNU`wR1YC5 zr)YDCBQJj$E|TeBT$ElNo$QgAva^F~x{u81w6e{6D)G6x2x;ZW?ExN@i@a+wEs-HsY$Mmzkm)sw5`%Z&|)09RGX$kgs;8 z3U@~CQza6S56PBiji@Ov!;Zv*5RcMTQ*7(gpQhqmQ5{Z@W1j0>GTTeFub@63nifP-iAcx^_qd?T91M3JGT=y$NqaYL5lyqNI~=EB-gM$Z|fh_1@E~&>~RP zEFg*Vh=ScecBQX=AC3k$GNaK{M}6g(H3GsvcEaMxGLM~DRWf);^O>!bGN2Y1eQEoo z+M|fGf7FtPLzAxxATjZ8b_I2AEvL7viafiDym7bzg=Rfz8gJ302bhr9GgCp~LJos^zG^8E0ss#+|JzJxxajVk0CycvhX*zZKJ|?O1@$g z^ZE3gFF2Z0KFQ?8v*Z76P+bC;{n`w^||%8dYl=No0}j={mP4lkx< zc-!%&7P9dRG1KtCvAa)`O@|JWhB&emq{bL<+BNf@M@3MIm1bVvN~^ufv&fPV8OnL3 z+4Ey5J+K^WnH*b1x$NQIk?#%R<*hCij4apj^D-?#sppr?I{)g7%=g2&;zLd1V$||e zxtx;jRb52CmHJ|dkD2%oMH{&X2uravK#S^E1f1Rvq@Rpn{7McPTEEB83IDaoF@uOL z@|m$TC*i>q)Q8`5kt1NZ00n|qNjVLDgKLTY=){pN;-!n^h5~-|w+#hq;AH#s*yrB@^yJzViS`MfPA;FHVc`NlQDDc>{7L(~L8x*ME z9iQ=I0*Z?n%;vt+$PS>3>p%Ph95(_P06vIOOyn*+ai=`3d}z%xJ1U+X!z&N(qeTN_ zC`hd`zD{n6rr>XNoegJKjW*c#LsNDZglby9{-z)`$uH|wd0oI8>tqdX`PX?_Ey#P2 zvsGU8Nf;GWk7|A2H_RaQQQdBs53aTP3R6jk-*27+tfK0@2L$elmlA(6v`y zvlE%>=!>}PE@XZMC}a)@f#}BO4}cNhLC0KQ9-gD!y0SyuV4{QOjlfK1?BnJG|7|>X z&@FtX5<6;%Ne-ij+)$TW!=Z54Q_TsIbzKzi2*nt|AZFzclRTQ@jt1x(2=PV8qO%TQ zYGKrfna<3jOkAJo1}hBy6^elcO!#tsv%}oMl|rU_w6BN-vDBqFv|O#nJ4Fp4qoEh( z`26E|TN^NQU>PD0Fa2FHMylPVz?y6zAD`2uH8Q7!@$w>XPr=*E2cec%u2+sf`R;;E z4Zizeh$jBd>>>7YDH!##3gcepSJ50V=sc{7>Hp*t0a+vvWS ze3Ry!i{}VuH-(hWIwQ_sc}>ik&6JQxNSW37I}Hpu45>Yh$`0CF5e~roMrCw7&B#(~ z{6@^tE%GOSWS?d6n;b!Ae;!Ly49WFCm&Mo0jVSu-1 z=@YZvuS?+1s@Ln_iN*met_KWN#)+U{4~>s?0UmymZ)*nN{(b0TvsU6xJ-ldLaQeHd920V)5#a zDB3V#LnWD(o-OUkem(-)SeoHHwYKittBiFG15q+1nJ0Vx5$`pnxZ4ysWq8yRx&$` zISZRZbfH8duMrwovLA|B<5LZ|9tNH#{2GflU>a%Hlw|=mc;Vd=Rh83;cO+fvI9cGsR_jLw!J32J#5A9?z zs9s?_27H2lU(GE|1TvwzN%!_W&c=U2lx>rrA$a{>`oXmz&KES1^!VnC8+`}8zQ`D+GXTN?fQZyc~Tz?t*+{nz(D|DR#k70x z@r25lIfYZ5Th+$Xg_1}dl*Y!$?CXIw3r;(&t0@afJBFaw%LK|n(d7&HiN14O>n(J} zR068M#wqwk)Q!D+;M}}m4o#a^lAS?wBSxKjRgLK&ZUmE5aJ)N`e*{Dj0L3UPj@vL0 z5&22SHa30lig5rL!eJPMn9P0lE9N_b{Hm(n0L@GI)dLc(zO^ZXQN*}>Q$T1 z4ZQQ`*q^)8PZT??Q_lkAo4s+>>q3@QIKu`XowLmn1fy&`Aik|iW*2yhl;>}8N@W-L z7Ka+Fx0>uVxlc>5?p5ZN+(q;Rz~N{`mqWm3Bs}EBC#c0?iB(dedEn;7$}DOP+tr`W zD|WSrJ7g$G;+x>;C(u?CwQjsA$V=`bvgHxU+#%k$J2LB$HbH8}ph-@oX;{_+Ky&mK z9v1ami^W=i#MV3{umJ$7w6XRa3$|Pw7ghO-JQ*clg=6RgXmW{1e|}3fQFfYKZC|ejQrt-J7N#t zTiev@_w*y=dU=26-L9F|-4Ri0lFGl*-{56*BjA}TC)WgE&#Nba${?!;t6e}KH8Qy{ zq1f81K)!nJ{HG_0yRt@AuJ$I=We2+(qzWYS;DTGSC$uIr!15uWMOSS?!n}FX%s6FR zDv~Eh^(6p6%=}_DTcqrj(=e0(ovQv<-EW(SK+)7W;dqZO<;35DLR* z_VIzUvZy@LCW>$DSx7#NXS8Ct%~zytIXKKwe3+vDEIc=f*izoa+F4`>qh|||Hp$U* zOl{jo&FUt+2H8&%yb{u4Ms~DzKr%m^~cO3Y7J@df$r;Ku!&QDN9#v zy$U3Op}u6$H(K%d-X1K&FIQr^;Ea_p%jUMEDc8lvKFqbW|ISHI7; zzVA-z1(%%*izK!6=#{c3DS0oYYf`M`t6;Dd+kak16*+h1nC3$&WZA4?sbBRf6Ao52 z_yB^&yo$u4&E}+-2IUoCV8-zfL||Xa*|`Se@$pbPVkb_;Ct_#xyh;3x9)a`1KZh6w z8JuM^e~K^78*v6jj_({0WWa9*v2Hbl>M7%L9FvJhRbA+Z%9vYZ3W=_) z3Tc?Np!$&YP&JKKZ*1|`LX}S4B#j0d*g=+gcq-3jciwvB`1YIu1w^NnlG?_4PmkRC zPG+XLlK7v0LS47Bv@RA3fEqqMTUjP*D)%*VD9h_?8>_3W>(ui4Tm+$?=8^i3vE3B? zV{E38|7C1N*&rRqI1UFqkN8V+vS8=cEdyj`Nl0e@acGL(jWbQ&X(Sii$wrJ6N1;Q# zOhR{)CCd|C?63~#F|5kkfG0w?7V(bXs9v5^F8)N&%j+38t?=O%pFRKU0V`648mZd%iwy>j-or0^AUrPu}eBVvRXPW z4D89S-lJr>x3kGp6Zekpy{|?LsK;USt#SvzfzYYgFv3nl(Cj*AXa#|l{o~NB#w*_# z{M9R>mSnND>4psja8M81Sc#8#F_u1MsFgwOSVDjRRh9@Fl~Z$mytw>!?<{2*t^H?$ zoti38jD2}^oPT7O&zfE}q{o@_RkLe)8~&nokUFOe85dc;QcE8RsaYs7u?ioUdyWA# ztXjEgh9HU9ZH%b#;-{xl<`b<1(<$KiCOEzwZ7GUb(qrPXT>5yv-QNxdoupIePCeZ8 zLfpdf_4vLX&#-9GG_lA@R(}uF8=GGl19WNWjeCaqYqSP@PPMEmuFC4rQt^jv2a`)geNO+T%FLCO za565pWhPwxp~KEA+L-xOb*1Gc{SyY6wg^{;!l>M`w-kJK{^#iHgzxoM?m~XC=rhU5 zk>CLH4l88m!Vx{JFo>bqKT-$0OJZRg;SA7^0(0L--44Tw-Q+pp^`Nb&kI{s-kJ6-u zTfn=1kSf#wcz5v92d$<8Ezm(IVJ#PGs!tB3)pNPDeyHXL$AH&6b0yQ(s?#98oFs}0 zW#u7XA!E;&hnE#7R<1YPuuV8rFs$^PnhZf&l)CcJJhzt?@VoKY{Q-3J&QT@63Nw;U zMTnJE->P6#yj{034jU!qQgg2>k_^X;Eg#Z5h{tEWRnT898E=~{7>{)Mf=t;5fkUy0rvxP+)xn9UJXfw~WyH zBb>1$`zP_L%GO4VA)@lswuYxWM_lw>I(zn?egBQKJ!*^hk0jd?JC(O?Z?f6BaqU=@ zq4CE{ZUfK5v?3qamZ{r70^w4K%xZ`Q9ao@L+^)+Ar!+B6FlWb!*^v<*UdnB%w#iy; z+N&V_n6Rk0d6#pr>7917QEXKge1eC-2R>adz9*-c_aoomFS9 zzFclQ__MAtK^Nwm3rO*51w*liMCa%27y`w zq#J87?A#J4eKTQ_esGUm`s5OgwpLwH70uR#p@#tM&wwp@hPCjCD{JW`PRHSHs3jjY zWxg_nO_9W%qrm&b46zM1E$=d{7F$IfQ*9eF6f43QrRa?nTWBc)lRjsLwT(Wo;xA%w zR#pd+o|bCWnGvGm!5XO-yB~^h*kHFsQDv#*_f=vUVi$HKN}O3|dSXy$wprL-pbBk> zMC9jYy#nmBE% z+n_H0LO+;2jGJ8Bm)vY)5!9}f7 zZTJAo$62i>pfngSBvxMn)LOeUq5cbhsIoR*@EybMdr4hN_58;t!3U(CvJIRD@kmjlFx^iH*BssyRU zz;i65dGdiS%oR9s26fGOWWWymLLQQQ03zJTWh)3kTFi?!zj$zcv*t1(eBnv!xWKP{1g6wWt>{evH8?G z8z^kGdhH-&0Z&5<8$-y67bNCr+{~OsCs(suE{I@zD8RZ1=io0exkcdLi-i*x{J~}w zsY^y_NkB%mU@9D=(Sfau^DB>ck(SDNy{z6daKriX@0mQ?q#BW37~K>LPh%JNw+P#t zS-`BM$19uF&fm50uu@pbksY~Lgf4)Nrt|>vK~Q7pt=G^IeVh0cdF&h{k0ftQ0-V0H zsYW=W-=`wEW!*;X(mmNm9w?)+Wn4qqdbCm3-#{RU&T(F*QIiJ20$!5Rwg`T(Q+NJ| zhgC0gww_+ExU9k+8%hOm>qNuF_KizyiNj$d4*5@xcJ1wyW`7Mfm-Dkgxa4XrHLfhY zYwQ6Vu&E(7A zv(Dg08katts8&j_7eR0O>5?0 z)*n;h9i_>30prp63JrRs#q1|}diB=__G5Z8eZ%s}eU@^`ZL0N0L?fJ+;7(rEjC4r% zO1efKEeUcX$tWF3&XaU10~MoFCVZ7UmH?`Z*uy5`$-3d~qIO*An|-9R@a7~A?6l^% zv7&5)v1Dr}mN+(xq&sGiYfvLFX`v)#@o35Tjz1KSFaG;@@oI?lduiz=sAeZM4~wcF zCd5Th4^&RsijX>AaA@npg}pBX*5SfBoLrff7ewhI!af~7d42zBqu(x>B)N`ViB~-x zhF($;QeY*x-_HZkYxswYpPj`^)Hjfz5Qdc*gayIZP*F;5lpTUo`ZhuDif&AkfY=El zmn^iZ>5=8JG6%IZADfV=2CD$_n+ZF;RZ)>?5}6AZY`J=k75IT=Nrl6jH`@@~OO`YxZ6KCFG770e zEO~UjvfNU(UQ56IWIHY~+e|f3snV_tKvKGW1nLQukxdxbv^EJevEP9oA~L4ZaADl67F-< zXrC7ShP=Ur-r95MtCFnh)sVbYJv8V!186lr8$xGwG-H-C`N zd49?-&kMNC`q)riA zf{fiDa$cpy@Iz^fB~pIVU5QHg)W6Fg-cJeLn|+6CuHj9#E^Z|g58(gIc%<>JxuIZ{ zpkKo*kDbE#;F#F&{(j4At!|J3tV>oEN$p)kGfVz|6` zE{^6KJ0}rZ%-9Q3QSl8YPd8dp%{`np&Gvftk85=Z!R2z7Ux87bVR{+A-XIoNNW2S) zViXc50k))D2Ih-i$Tpqudl>!`5rjR?#;VJrSV%(;S&F?DK#$VxA`=z?q4fC7 zG6UU7M1%~qd2C5`U3GLR$Xa61J4~CFg=OzZ!}0KQlvO?^;l{;{`18y!PccN&V~f1s z&g_vd=_;9eogib>-dp(&$X7W-wiKLe`!T4Rq+3oM+RkLhH?4gbQ(%XM)y9Y0bD!aP z7{H7#X7>fM(~i?~-_YZb_VkXoqv6DZUGp1U82em8YJMObb9l^OU?p|Yi8;1O%FsSl z(ROF+%atcb(n)|TtOsR{k z4GkeqI--E04(Es)@7X~4N1;h&@9m)BveRQs;b}X*vRZ}ilZ%#22A|QkleK^S6Q|=M z1kc{NfTD6AAm1J4nN=AEH@;4Is;0(Bk-4j~)R0@8Dt;cPp@uZQ{Nn_tL&e9cpf zljkGa#kS+Oh59J2iuCa`x3itx<}%RAF=jiSl`Quqt9g#Zq5Z*GWlnB7UcL*h-53?R zkCmAJjD7S2T^xV8P4V}j`)_x%-}G0)EAZow{|7p7QsFX8*9F?IA>PdR9G-zF>mBP5 zDm@K8OhytMC4OvuBD4#gnNHAy-bxyXRWm*$}M;P zfVv~|q8-vY4thavB+Y1TjZhUuBiIJ`Fuo$qf* zU9iXXq~HWBdOQT&O>a(GL}sdxFwh?BL)!QPBRdd=co*yMX20q+sk3y6c*lo(I~Hgs zKla(Mw<&;CuK{lWL)a>4t~-z$5&o~ktCLP@Ntt^8x&DtL0Z4%X(0#k{wqqfAY#k&Z zOxz(h*zu>qp4DK!|0zefMz`HJ4>~zLBJtPrFYNIiI3Of3RJl7tp?{BJf5iE_oY(iu z=fAYvH>bEDM$=dqRV>2WLJI>chEi^sNqdCj0#4it#Nzh3(=Y&GsOad$F8)hTz9Kek z6n(pQ6RRR4qPAD=ZWJ<80xh%)iTk5lFq9y*0>pg481~r_!a0g_W5??1Zh6WF^}`al z+lNzYEygiy*Jk#Vw0*@Cw-~5fj63t*W23qKJW~3Um0NaLwfy!+Yt?6o_34`L!NKf0 zi-dj>UJ|QsZ}8bDqw?@0*X+o%azoW7x2z$4g}L_p3L_U^Lx@EgQe`L*i%*TE7BTdd z2Uu$Z8s3Sm)ODq@V^7){RwL5=^jp9~Z(^2rK>l*19-14O{ONh3WNDZf1aB4edREHQ z_-2AxbF|g;z#~I{)jqoakrwcZ3Ja(!Gwc#3THh_5@-z#eYYfV?PrsS^o`W9t0&D(B zWgC&oG{+No@2MNmK=8v$EXGfviZkY90c0=&7Nx856vYjC_HrLlh&kwz88pnN-OK zAvnMd;hL4e5I&0IWJGjV1aFQK9*xV0bE!z6Nf~WEYSgiG%+#T*h~PJ`$7s_Ar|l8*Uvl*n`j^okmpUWZ!lVki9F;)Z@(s`Lvv83r(=c7cZA3b2&9C zZ+hgDE=US9MC0^8jCv57@evNDD>I^*xkv573V$UFmW6PX!x_YiFe6%b$?~+0%Ul1HUMybW z%p8=<|1x}h1`7hW6)}Y10iLj#tfCOEZ@iF8mTn8{L6<(UYi#7g-~ol-gm;>59bGzj z3}V@856j}&nFKwK3C2Pk3{-KPsZbpVmTm}80h+@_J5(@;a;IK=u&X{IZxlu2#nbSX z;zls?*-ZJhKK-fc)xt?n158I!pqZi5p`Sy@7TW<(`%k#^;nGTF443xtQm5sTrp~n> zw4?BxEUj+M1uxOsqfkL;zkHgEoIjAjBzLQ1m7UxRuH2UTiUxCTdQ&n@GV*73=l*_q zZ2Alr9}X7GU#9@cCK5VmQ@ge~NMyK3P1I5xh0z?Ec7>y%al}kN95Kay+~U8nkcjsB zpIfvpZ>$-&q6J%>K_cEb9H=c~kIEkUFsio}UAgG;8rz;Y@Q?&LlH0np*kz~MMIX%ei#J32OFSoA#y5XV%}>_rV76O{@_)10XRqeLj3^ zeNmyz$zZX2^)Wd*W*|L0G#2|8cLB|Jk+KN{_T@VfUrJ9QS$asH?#DuuT#%95oexT2iHr?EXj| zK)q>a9%uX(Nz>rJ0lZbu;JVB}dsgqJIL-vS53J!dhC z;UDE4os7ME^2w5I8u#wV;k^5#koPrD9-Vx4CWM%#$2mVItRG(Z4;ueWc{f$XP*PAQ z1aO(yhZs(!i)ZLk%~#jB4d~pD3(&$j044ZV%tB}gY{geC162$ud|G*ingE1G2#@_U zt^%#@E@w=WMl5?Jm3|b$^n)Rf!!Y#H@)e`%-8NTg56`WsiN(lipHCXTxolmVWO+7g zO68-vBs;U>&K=r)V%?ThAEJ^4z;-LaPUO_*4+ z!J-3*yJ@&oXX8x}AA^)2xQzPK1?2TYk^7(cmzcKVmD=Y{=^o<4FDX}|pfKICYOdJU zQde@QJn2fU-#SG4Da z1v^bM+cwc}tAN_dDMEy4i`0WEB;@L!>>%iVWlY@blLHFb!8i0=s zgK=qFVS(6D1W!__?jg~|NckK%6*ingyWBCQ2WQ0$t_BH`P$HJ|f#0`peTk_hYZ7T# z4D=;f$@7b7c%NymL-r2=m?9k!i-n|=t7F82#K#R1xhAu@hFMUF$)ps*R-wa|>P>bq zrQ*8rJu;CbD&mxx)agUb!+Iq~15rQ|O|r8_4T1<2^BPDp28GUteEPg~rk5bx@5k42-rrEx0uxaNaaCJ?#b;^5ccbQ}A?C6LuU% z$wHRXG4upBP=4a^9Sgs@I2meUHt@s$ypa2u2R*S#_&r&hv~rlr#&}^D^W$IHBwalY z?66I=Hk3P!71jccv@#wiR8#9Mbwu3t?p}7mjSQ0SBXWH=q@qSUdFf*-|jWz9u+TFHG=`SHv$&n)Rp4a99|QB&UmQ> z+40FFp3gn57-tGuH2U~@PVQ?wee`(kST_#NC5p=UO&}S)_S^nDQgGyhwXKqO_*zcV zi`%sGD>~c|fo1eLzbuh#u@|pA`BhhBajkq+QWkw+XR!Z$T>w8~f!qXF?AC8RfQX=g zVqBnW6FiuDAq|sRog_vXk31Ul>WM93mNkmU?&WzdF#Eu6Y8=J49vdN4;IM3~6*bIq zfrUL(iwMC*f(IZ*8MvA?`D01I4k1A%jkV_ROv*JC`ziLFeznFX-+c8Z72xgAF^ap! z2unORp#=EhZ9(Sw*-}^XU1e{c85$i?lxJ2 zYk4ep$#T_7Re5*|y{f}+$C3yMt(M+9Os8sIa@VTb%YpCh_jMN)V*Kpj3AZ(xbo%66 zDk(=O*%ZkhgD4k1mSTV27_7B0N{rn}w#e`?R00F?=v*}cA-X({=iJ+RP2qXu)0b^I zYCO?5eIa`E(GLl34uXeH=5Q3rM zMm!hKrow&sROm+=Rut-#9hW*+SBzN~HKnubS_z+5(&e#9ujP`f-q}@(R(%LAbh&gp zdMhVwkD|61-3C*BzhE%yAsR9MTXv4f8(7pU>pp%|GJ0bzQ%+5%=}OB^$87rju~t=W z4*W}N?Ap7&-DUW*2%tQ@Ry|xj*|j2RJ+)v%4Y4c9<>acfEm8M1XAZiPoWS44Qwpa+ zV1SO%O5GY54P0AUPj9Hgk)cDTZ~hFF)Jxl5?NL2hDc_OU4D`-~`7BaVKvWpqn+O<_ zjx~@b_A@YgA;C9wxt!~@>D)-IrCk5w#}ossFg2Rb%GX9(ohp#^3OnIfoxHC8j3@#HOSa6+S1A`6D^1fSJyB~i4 z!FE;mm+q>*b?>=Ho^#G~!$f_gLtVIs?Y|SFG}mk$jssd12Z%W7F4WKeSjIEZ4b~{m z(VPFpi~-wLwhW@7JN(4Uwcq?4?{B@?S{q}(`TqHK;#lb3Pbe`qxT9Lje0msKwUr)~ zOA+i@NLO6?0xL&gajVlc_9yPG09aWdHtU0^k`rHYESDQ`k{3~M2zip^pyw#^$dcyG z!=G)|4E*O9IQ$G|Kx97ofY=Yw%GwEP5-Aj;U3neW@kEOD$f82GE{)|+uUx&+;< z!7ozM(tk>v|F3k#c5gNHPM-Z0vrzkWZ{X_rbqtTdzATzuQIZ}}qGTNsM}#g?@L3lP zbn=JWfnH2F$5!#(+^d=H4;or8s-hS4Nng4&m9b;biVrH4@`(td**5!A4w1&njL)(9 zO~MC<;n_bS^~cng$HjjzDF9!Ir%8-z7e%pN`3X$BzEfwO)csv7p?(qjXCwPvi*AEf z_?J5Pj9ofS=D`v4+ES2Pqt~_Z$7%LdWf5dzH{B0uS4cC~IUZWlHJK!v zieD-rOPc#g?bv}@$I)!hG;n!B6zK}dljTF$#WkjKU989sbvjkb?#V73s_@~aE9qgj z&kw>QK`j5iCE4Tc?Tb-QC#qoojbbk2!p?ac3{u$Fzdjczq1AuRmiF2DorS6qeIZ{- zfI)G$qU+A(lADnb>Y)6nE;!QWIuFu|t^Xsd@Q6H;n}mmAZj6=0BmA1_JS>6TDop(` ztfFN26F`wLY{c5=Oz`I2LS*5OuW2Xk>_v3hXgRfNzg`h404`;#-yT+W@`~eob(^mn zZ82kQ2YtR~%2=K+WPtt=$aCF-s6(I7hAjo zEu@CSuieV9}_}8 z*GB3K?5|!Gm z@AAE-&}nMrZ;L?ehazu0%rD?KFWPsA6kiBJx6>JI>(#z6rtLGR3GrP(Q!S$KIwK9` zdMY0}Dmyxafg79mIg%$36%mows5oD_SJC=pWZ&)$M&`|01)EU^mQM4VJsk|YFq4gryGKj9Ox#eEU)WK9B`IB;4&i{)tXW?UyMWbUM}*$pv5B&xhaNL7yFa z`{cwif~oM~lCpm84OF5ZP0$!mQ5oVOq7ebGn6_+nl4kA6^lOIc z`#5z{1CeMhZHV>nZfvJP#HCCJNQ*Vw&iM_3dGK^tHXoZf!O>`vHU4yg$L2Xx!k2ta zQ#FCJ=pV9I=xi~Fo;URy2uRV<5;*n{z1U%Q*^gB~2(}feP1MSDe7d08V4+<-HI*Ot z_T#aQ=9D0f?cs8dO@C9a^;y#SENi^(WY> z4GWT2mxRT#^!nz{i(GVb-v$xOy^qeN`hBzCS~A+0Y;410Og-KXUItir_J<#P z56bVZ;ta2&K1VFpM8Hu28*`DrEii8U5xZAX;@cwSf z+pYe7y*4kb48N{Um#DIv(%lctz zoWKt$(~tLHCkh2%`Y$IgiqwuUY1IAP*#=ywE~E6{61fvi+wPPbgzc=nL;0i$PPonUF1hg3mTx&l zDZN_OBxx5&T0dQ&leM>k2xZfpXL7YV37awY&vVDSZe!==$iS&4%~xa|Xe8N+T^i zMTI-(?^j0xUjJe-5lHv7er0G=Aj4$ryFjOUtg>Yb2Txw}VaA^38`}RAB=&Zj5Zq{A zpR8_6tNpAp6|k00uczclY`V&MZCBXm8?40vA)N35zIO<3&+XTh*n>h4OEG_xUO7>i z1NP^d;i;+qBXDE;z_kxq-w_k$^Oidu#b%q^l!_^)tvL!>f~~q^Z?&Aujfu8Do5eXy z(R=-c{BrnHiEm^0et&f?(akS_khzy|cK?g|w~D?xij>G%o)KZve^Z8j?feB29P}uK zf#V>B2}1R(&vKlBzIFP}*DFC42e%jdKkJNcy8pfrNJ!eOEUJ}>X1w)j2=S;Jf~>9# zRq5X@g9hxsAFMZ0%pD`DS~mSr1n6VZAOFN21$EAIwj8Wjj~t*(%lv--%eqPay2yBm z(L2i^>r=q;^0MRNr^^e|vbQ3*>Xs$N{~&+MzQ3>X?RJ2OoOBRox5gIK^}OGm?ecrT z`k##8H@2Du0WmZ*Ea1jC!UFCtuVqg!wjgUgVb>>nj73EOH!fkQA(gqUvEwz_uHc8OL@ODYE(KbK zwa_cX#Vujc+U4cit?18V+1~Bc$2pZd{8(r8p1kO`e5m}roD6ba_*nMjVGp^} zA4f>_72+W)c5=}v_vm>ukQjDz)H~o2egjRd>)Toly_K>OHdhTv%&YCE@ZXVuuGecoVZI5lKkB1hFmNLCJi1}{B z8C9rnQ7H0mvy+lBEH6#22e~BHi%8yc^tkhi><$dMhRKD)`|A#x?`H7B18(7hcPC>G zX(sn9H;hk{biTQ#l8baw?+v}akh|Yl*_ugQ>s0^>wDkTwyxX)rK!n?ZkL6?^kQ-LA z54TH@qKA{C{97EK`?WWv_Xk^BOZ*S#7q@Zc*~atWxW&-xS**40u#1z4+c+_g`ohbZ znXQ?)qKAv{;2A2-=nMH!!@L#F5Y z4rM9x02_kiwckYBKkmh+>R-abZ+2DUlQ~wq0}^X*9!pO=7_DTMKZib^-_$YA-2NQ0 zLS4h@WC`yBVe|T$^Uway z+p$OdjD3H(u5fWe{=!}rv3rjDg`qTY56j-iqXQ|XhrJaZ&F_!RjKTLu5JH`+i1{3s z-huPL`}3>v)cdb)x|&9QKXR2VGP;}IE$TKiV_Xv=c# z)f0YkwugVQJsSrLzgkO8g~{C;I@VO1guCvQg|lDv7Gfe_xoIm>M`ir8Az?k_RFzTz z>(OuocIe1FW|u~@fo3a)Ki+9{7kvYg_^n&*+deO%xUovloZl|hoPA~%ff8vgd{EoJ zk7S+l__Zji9dgozg)V=mos*I3r236(I+)1LSC&xmGBH(gcp%;gE(kr&%(|Aw{oHy* z?~;M~cy5top2UQd1qsq4H7nClA`I~%1(Beh6bWD1H5x`egwsW+?-~`ZlVCRP0v?$+=T;k!vQrx`uoJz~9G5*}R&|g3aC4eA_Du;Xwc*;c z4;(Kh^fr&zC{0==cH@~kOB;)wl~?ncKsw4pLogP*2or{a$Vy$OBEivQJX{j19%TlC z!HMmhrXRRYO$;@YQzb;+jPDGpOd|XS<2`aw5i#Odhb_9#Jz8SOuR@yYyRQoCDH$aa zr_Owx8|YR`C?H^|&pPY2&TJG&&Dpmh= zV3v#^tx{z02_ZZ#K+G=hZP4{l1PM2IpfV|}E@T*CjvoAm|Cm;mH(@UheY)KGwFJHU z-M;YZFlZ-v(1k^H@R9(H=&sz?!ZoX~`yZnnt+ zsb-vdM%(xLZ$17M$~9Xmdvxijf2lRf^g_z@+w37#jOH>}YSS&Jq)WxWvhet|R2=u} z=hQ8pfb2r$-mD{5V$;8$gO1x{>j7@3)P&5eYe*gtL_rtis7MSvhw>Vo#A__%aY&HD zJ^*)1LcK|4Gv8@bhJHwML4PofXvSiAj6Zi{!1gb8>nF{C{OrW+R|5C#q{Ion`=^OX z-KC=7P+GP6#)99cAc!;Dg!phTfvNz9VWnS26X1r_JIOh_^Ox_qqUVh2QVGq82!A4Q zYl^#}w2Pm*l{jU{2;akYN8SwqkRyuY!9Os$N^0lM@7 zQD$+nc3Z8~ha+5r!a)r}*Hm9GyhsLm)&(Ww>tcTRgcIrw+{b5wR^tbN*Vx|JS*o%U zEsgrB=BL-uhz+YeoAtjLI!+F&C0vw<35>;kw*jCVQ7P5&lz|^9%$T?Y94g*b2Rt{w zx&0yu`TId6?}lDTa7`Y&sASP^Td4E{;dY6|31d%K0^{;`ER*HVP3tJ{;9r!QuB$j~ zfe7o!g%OQrv|Z8cS6KQM5)*F?x_6j`amJRE@YT2d>cv7TKhn~0 zn0`?EXXr0jxi%65sks5z*~DybxK&x>^3{Cj3@T@@+H|Y%?rp3SkZtpEqGFOIRe&Ov z6<>6%nGV~Cv>F!#m{l+T9UwT2nOoFf4+{s=k?kp_i~Yk1v2P)X32`A}E_Qpm{ng<; zFV}eeS0fRFn=JF)e<_1hi|eEe$X4fN7>4|l3hN8-rlpRj3TL+OvGe~1^j^4D5~>p& z_*?;+^N6J&SNt2Fs~AVT>X<;{^cW43y=1LSa`@f1)%8DPVio6)rgD!8fT)XwqE^#l!mYGz0?|9 zJ>}BZUd6Y%&C@c*9AzypdZ!@TqWwC@C|sBrIiIz9LCdd9~byW_p^8)v1ZM#`XJF6HhT14QS`$z(MZM69%T0dt6X>KCPozJfkVq;pRg&0!FsyRB&~jud-J?pRY>&VqS}S zE~nBQ*VrqFz=pk%HEG7>BD0K}oRy(5NZqYp55 zx-%k?8N=XBeGd)heNJwkmd_8Z9s*rz2r!SH#jV; z*{#U&q!aevs*5Odr;a>Zv{5N41M1)nb9U90Uk}bdd#h62zLRcTKBmR6h|w7HwyVoa zF3@;E_*&CkPpyYsDpm41J}qEg)W}qNRj%5cq(}OJf0?1;6HTx52Xpu|vXs^6Wb)175}e_~^TxnTvrpO?*V%=1Bpyp#eOoW|uj5~~ zmN5y>+B&`qBtkx#$6*mq^#Kxxyp;VXEEFUei~beUBU{DWYeQbDGxU;LESf`-RD2fC;2g9H6-wx4%&3;cd>bxlYnN8T=l5 z#&Dd7sAqpm3gs-ot!=bM?R_pRVv6>QnTYU0Z zM%rd6Y`LT(|B)ba6Q@MibZotI4^#m$2Oa=sSwY2Q%IVi-BQ3(<2^|KTQMKx$OnlUS z#P8XN+h`j<_EM^9x2ed(awvmX`uHYGbH)GTa84Hgpz27p6$nKoTv@*>DQXHU2tucFg7E zO-r+zzcFB-)x|QiZoV2>(0ia>MR^+YDe2dq&RZFX(NgWTz+$ zlzt|?nnThPHs1PsdYnM6Jb9KJ){CPwJVir?3LBt#_hfWsPWfw00$LTgVfvsJ;jmYv z`D2O*;rVt7db5u>}>&o^P4*dZ zY3NJkPY}1x5g974+tE-0#`qwI=eLgiAJ(6^2z~(IH92X!4xUKLEKw1*|gcfdJeUXGrJp+NYl#vQgjCu zYS(RVO{=xn2_`G$>je)3#QmsMwHy*&-Op4 zZ+EmKplqEIHMI7^FU&IinUO$NHy3L!IWgRX2)pxaiomaJUPif^_o4ORX2Xi+4S5x& zQg!-|*Kso<1J_BZa{+W->S4&U^l0==DM`?=z9T-eYfWE}As$b^eb!IL&m5&PlXT0c0JVJDKVf-|XXYHe(Z>#4!7vdr@UZ`R zCQIQatD7Yo=Kjh0;tXB~Un(4f_}orhlPsX?c- z&HPEzl94OxPn#8Q7TtA)^e`Do1!o zDl~#aD5B%=l(uck%`9Rv_9ana5v~o72F5}m_kZk`-{5<u zpc;wSfs+H<+OC##shtGus7NEa+SKyP=O|vmt!z1)A!D%{V=$|5961f@xRiVV&%o6F zZ03I zzKxtwr+YMLO1^ouLE+ug8GltM+}2BJceb1mlDHo4n1F0U1NRGEo$~d*eQz{a=lQ68 zx#w9Wx%S6<6$c>ghh=w0_5E<-NoWaH1I{%G^z2l2(Abj0o$8@wuR);TQR2ixl!A}5 zW{FhSq)v+L$ypG1SR{mqm>;{b4fbjX-0q(15h&X+_KB+QI~wyOEl@Mpj8Pz534yP= z3C|V-7X-SSSfoM4eR4(g!|Fu>F9?YAkWXq9 zx7fUIqs8YnuZ)@!JIBrL32v6FHuPiUi=KJMvtmmQ)t$e9;SGtZ#Sb25B97Ma)PyYw zOC|v3UO}@{=}rvRgzl+yBwdTEiJh?nPm0RCgV07Vw#l;P@GM6Ih4ZPoKe`~3zjI~R z90TSti4-ZWoZQ6AQOV;23cC3^1!)*DTKuV7zDoVB3(nc>LNRD=l+Ue!#*9F*Ln=^Tz^(x(C6!i2?D!XQwY>o@~#LKmiYFF%B*~9-Qdl3I!$d25I0n(nD-3-|>9c zq%ntS>?I<&Bl>ph>~s(oe)>ED?zxS%qEDPQRP?@L`TN8Yxu7>~Cwq}${Xsh;*BVXH zorc)q+lR7S_S@(Bfzj%#CVw)qD*F6-qESnO=G#?Xj%n~b2sy*IXUzNiyIaZ*+@Rqj z43j<^2`}%pAlZ3J-r}xVTE-bsm?uVQ$lk@8!nUAT8z+Cg5to$?uRJ!+!(_VGQ zuOHH{zAp1%e_Tpv(%<9ef+VmVK{nrPn%M6cxqWr{CLgo&*%CPd%%@;QE_i~+RnXrm zY#NEEZdiWV)L6eblu!SsXEg`!tO`>LKrD1;ep+%6FpgfsVm%wL@g}YOH_E*+r$w%` zo$yH$0pw&d=%G5sG(DvUw#G?!nk?R-M+pihWPwIS z8GyDlr)RWne3#b-@lTj6kL!LgIIC3Hkt7PR>JQkp{GGqmU(zBkTDN76c(z-Tj8(d7 zLh#~j&he>3vc!Kyq>Tb6XkbK&{veL|+LXWLf zleEWom_@Iogm~@t*EY=c|R-*>s?0pUSr?AAs`Mu`1wd#>DBNq(&M*?(%{EM zLEr&>DNw5Ir#E@0(BZqOXU3V*HZPS7c6d2_7#@wZ4TQE!dABe0$bZQv4XH=GXb>u( zJ^F^5y2Z^QWf}UC75NdHNN=f>jz`)Gn|6Jpe8=y=c-m;G<|W4}h0@MxXMwlWn7bC9 zq_-bXVvlp7##?^=S*Fq!gZxuj;p(oYoppqPdrYJcL#H<>Z+o))1H*S*X7>W&VkPAjSpihp%|L7SS^1YY!gmRtDtX z4)8+1{-sEMUyqZ!+>3Eh156x1D9AF#9C%W=@x(p7wn;ywCb8JbRRFvRaXOFqPZV8*mBp{xi*MWRs?2!CWf4C`(oa*J0_QTKaQX~|0hs>`pf+9;CVbF$?Wb5 zO+iwRbi(7P7Z$l=m4_7bT=K0s^Et;h6ZUdf@yRSukv-aI1}Mpd2l@=$7g zRd`zOZ!k&SA%3^i>4FiFUImpM5cb7dYNy9ns3>5ZOLa$36Od7qAAze=Z!&&&eo7K{ ziw-*3Rlr+R>*B+=Sp0eeOdV&Fp2L7bHH8ecHJGC43vnj^Uz&r?VCqT&IaLuH*?!o6b$lt*CUyg(&+=|xH~nt~{5 z)4cEOyL)UiSV{;7v4j>cjj^}tIU)0_wN?NQP1HmKPjuh<2{~Pbm@%DE34ytVH_Nzp z7a~WPS1ID^E8mlGh_>nzi4LmA+}62eL7T|r6TnC@b(N&P3$S;wyG$#e$lZ~$g~d_> z?g*p=FRa7?daN(pe`=qcF#H~Rq}42;yU#MU=up1 zO|}>SFkJY=kpT3O60^<7APGdgR;8dpcB7O-Dtz6=jNl}wpig9$GtcZi?`iB#e~bqC z8~km(L5^B!-)$1N&kjNT*};7m|AB5LT`vaOSnI^zzHOeM%SK*UDsir2cgLbWdZr9X zJXzP!cTto)ZL#1#$I;M(+bGasiblZsi{TB&x8y-$sLVfLWji{u5Lk^fc%Xz@o ziZ~-KRS}9hd4j*sp0|i7B8`;(I8{$2P%-9EnTKQKnll?3 zv2hY@mG86!q;27O2e6v(LD~d3Dv$x;M8pGT4c4B7lEY-77V0|>1qpcktmzVZwB&Z6 z9#O_NF}k-ccqaBp+`tbNUi`Gf+n<%X{R=@5`=OF{g=eVDPfB6m-`C}9bxlyn!769t z^U45mD(Qx<5jJbJJ*PkBpGWXrRzF`+Zsx;6h+yVQ@3+|W#fN@drNULulUjDDoJj1X zQcyB_F-)T09y88!_K8Z)wt{b$%aoo&uI2|{pk;fpC@v4OjJt0UP?ULTP#2dI>nScTP=tZ--6{5uY#ovOpQ+Zr)$F!d;gU6HXua zif(w@%gGn|OJ)g>X!e$zf;3epT4J${|0}_nbU1;X*DcOA?n<~~8r&`4J>fWa_00J% z!0-?_&mX=^3c2T?p z!_>YRQA}O>7brawAlU`_k|ySA`bCCSTHi$g5wV6RUY)>m;hBs02B2B!0>`jAP&VRe#ML{}le!`keUq+}X{Spug<0fp3(X2+E&;-=%{yOtE zedj+H;nR>UycTdrFznRjwm=u?&ZxRMYob7tYUj=;`UKPG-ktZh{E6{#T5OYn`)RS?SsJBpbrfHS-R|FjJ=?S(|)r?)@8jQ##&>jg9ShGpMYp?t@JNO0aVwyR8{ zbErn!GIiP6 zKSwZ2=}tXBIMbT>EjH^J9RU&BKy3Wojc5UUYA^fb9VVFf9K5G&-zM5mv<2kJIXTYN zJ%S!@^YMPhJJ7vLG5qGnJ1(}0qp?yt^I69RX8P+X<~N%}eH~RRPxrxauuU;V0U2i1_m>lQKef{G&dj7%v2L`APc!g1bBFcqH^xu66(Ra09b+Rga7SyYR7L!!Za{7c zBdBwi*!;A_-<6sWX4P%@YXEcI%O$^^+(wulWq$&JTEa9er*aoU zYyT6VdbR`cAjTcLSF%MB*+yPJOKL}^mFWLI7Z+~cD}!R>m8VB*9??jq#8vR z=8WYld`e0H9_5indD6g7Kp7gfZ5aj1l~k+L|* z^XHNddXEoaCc(Cgm*G(vax(=_vXFkD!)9Qd271{v1GyCY9DMn8V7t*iBfHo1I8QL= z+w)DOvSE!jij~Al4K!QG3GfAx*B1ZqW}rm3lHM9tX`)3F+1AvLdy0S!7DxB9t0;nt zWXG*v0sPBi3w+p9&k~FES%Iod$4Lc1Rpkjpi3hdF){gYWuPrMgSTGUSdn^)eZei(Vxa2|hOw$si4t$@n3-;z-fn0ARN1fRRKiOYnKGt+U

HclIcfNKQW=g*51IE>;7Wt+160#4)Jv7|_9N)u=4xKbBU?24U#L z*P4L1p^ukXEpMBDLXXHogNH&7LgQFj4^y(>N0B}a`PL}n!fJZR?`uDjz}Zkr;+;7d zpF11qG?AWT5_*dqJ@ASol^Vn|Jj~+&&FqBPY;zE1pPXTVS$XF%gmUWE--*I35JS)- zoGnXDt@-7j)4M&B!MXIQ!&qv|v;>U-nj@bYf7vF+Y7`Egz0AgtgFPGRlI0!V-HLMh zSWrtsl*W(YjTsTJ^?B;V@@g(_XtH#8^Jely(2JVzb-RU}G=zsOT@Owwt}M*xhCQFS{_08qR?(ru@3uT9ePkJx)xYEUL==ay@DQ*r<| z$2|mrNt)Knq6j_{OwM5ru~)W&Iw$=?3VDJ1j{~BZY^6unNdyUPT+Jylh$ZN@Zm=uJ zXs47W>4!Hv7gck5y0AtFd-&y%6k?+Uyd;RHk04g5nKJXw8>r|>q?MGi7};_a1Z%6b&$e(1!mk4dHXxT;&Lw%|#( zCUmW&p`4dLuI{2e&9U-f0Y9RO3BO9>%7p#Q*$hqA%2}EO^c@p620+iL%DiBrpp%Le zo_g}du4nx@za;~!98VN=zF6aFeSEt?h_3f}RWqUpnQD^BC)5xbc+C4gK$;hX6@(65m2d;btFh&9fmYJl`mY2W43sZlL!}oQPJ^ZZ8dr3F($Z$$A6oGW zY#g^1F#uUb{7Dvcb;r+00+W9<9D!u6#D`c;u$#q@t)$Fy?HJTu*iiAsvmbb1?z<-h zv)Gm{OZizNv^LOP*+W4T@{_%Ay}SotBQhBrCpa4n?+*QRIoZ_``)@RF)jq6Pw40Kg z(7Ge>DWp_du_dy${lv>q;e!W3FV{(d<32gJYlSFmmmVb8&Xz6}~r$m8%XkZe=( zB&Ud4ad#>OP+Yt5Lhla*)5)A$$F)2}EdLwTytSk5Y&pC;H@~)>`nW|rQgcd5;JnT7 zrH#$DeA^t}bb$G}CZt+|-l}V-3NVdIX#Cf*gf04Pv$kC>NHKG z%)17=^lUT%z&se}kR6bDF>ZZgL8^2$#}Q2>hmkK4pYe)F&o^M#JiuUKoDI3J1c)gL zm9H4FVW(INjNayDdfxu7_y@0?#^~~aSDoCBB-Zf8GR ziuAUNd6?>+{_Wc?SDPtD24n~SdWm9Li6rSVU2JCMrkOCKRc!_&ihB@w-FV~8SIH|S zw>UvUG69Cw)d|V@kPd8OtYvByp>iU3Fbl z5>$WS*fQQN-n8QROo4sASfSOpTx_5SrGQ_|{OGD@XKvLeVnd{-W!>t!jEzZ5J%46I zL*m9`QQeMUc}h5wx$lgp)O<$y>J*dUsBT|!sgidX>*N=uPu3#13Rfgi$KxB({#Z&2 z&AXfMODa z^e?>5ZA|;eFFDc4VVfJ&QVaj+VRJZKUDN$+cbSf>!GErD3VDOeK|uuBKi0Skic%(Q z3*kNynuvE62+J5AP@5xe=^4^wGI0r%jju>*`j}eVw356fT5?iD^iWRu_wLLxXaOIA5vaNMWvFMTh5G4KCb~WDe zem8WtT^W!yzfL0>jzAY?WI@H{=wt;aj>E@&1!>Cz&vJ2zs~@!YLMWRABrF#{{EA<; z1?R%i2$!I6-_*y`DW7^E=c70Zo_|GmdZk8y8T+Cq|; z>61(cswKbIS&HOK>n&pQMX`kA56FsV*2*i#`DGl2&);WP9_#{m~mCvNj2Wm_n&7LuE43Y z-lq1!rc2i|z3LgQz^4=gBl}XMxY*MKj>~77FGPxu1Q8+dTKN)4zbiO|X=f)3LCMs* zRN~xzt6VoNencA`!Og~J4)XaV+>n?{2~VMZ0kCfG%Oo<*i!mI>z-O;^PAtwSH+ed^ z0E^YDH&KC{q|-ZJ8Ws0~`C&%1q5+%uvmUV63JzF4_Ly*Fc!QnWUcO4Rni>!(fN#;x zHU#{rKyn=J#+N8t4iG{qoAGELmbiUs;sc4xOx>_Ld)7#86-pe)Cbq1UY*8Q0y(0<= zf$1IA1EgbJyOj|4&KbZEjv*y7j!#hrg|kokjsTmu=cT4)+Sc+1(NkF}x6v4Q=O^67 zh41O@b)==I4epZ?ufpY@XXgPn>H2m<)^D|eOx`k>rKi%zy9QZ`z(ucPL6E;sPlT(q z<+M3+IsIc;!ZPr0SCusXOK6)V7Bly7K8gp1?kXD%C^g!jzw9lo@fy7r1DHdqRcI&~qt=B|6Pk&bQM}FIBp0w-z!|h@XS~H1 zoORG0vBO;GQ0l$`m3Mw zH2%#%|9jEAx%fv8qe3Ti8=F)eF0VDd;ZfUKz>RycO*7j+sSr0u{?~ua1_{ON9zlO4E6I=Y358%O)Y&ZI3h`3&h8X)mEVE*5LWy{+wkvD*X z`JHCNSt&@1&#Ha-tlBvQllY>%rsF42*z6(^yd+|`N{U^2I*tj}I%EQLr8LfRPCn2@ z7p39qM-z0u^oVC(w!$Kb(Qas09=_q@?MlbyHYGEKQzXNAAbePbZqsiSCBpG(jqt4G z%$~MLH&-GfD{@#2^p6H}I$FCSYxF=?UX*FV^;G)yg&na}j5YTO$~J66Vsaw#U-u$! z%|4ztStIn6_Z%XsCH)$+_}pb7R?)fD>pT}w_@t7RRN}Ft@>O;ex)!cYi2_%nPCf>@ zcx_P!yxfX+W3L4Ncce5z6y z6e^Y^V`A9ZlNEn8@q{-r$zr=}JtbfseToL~=mA+8Nr*&v>$qy>4)Gqt9TeEF@cgL+ zw=~(`cfUV_4e^<#&i&Y0*pe6;;6q*cVVB{YbVEnxx%t&{eC^Y^$9a#nG&A%=4+Q0* z@e}}jR7VkRcsa2YuT`?3kKmkOkbCHP4oT`~RL%h2U??5%i5M?ayHMhpjkNQuN+Rb& z!8U%X>B~N#UC{Gl9uC!w)%!x54G~?Lol%x5nXEowtHPg3SjIn{DU}%&S;@u3eMRth z1clOJ30ydSK4rilh_ z8d)x)F>6;If}56Cv5C7eZt0}!N-#|VDR*Rtln3{LrfpZ=8F4))+*83VHp{)wfU^<5ymH~xgm?zMt2ze5i(;?5LrR>%`K-dO6$dVSC zoHF$NCXfD@9J}#(vWwwU;pZqH(z4*6;P0wb8^#*01dHnLqqc7W`QXG4*WsI&o9^`$$Xz#hz(3OK(Ra;eXU@esQND=-=@gUyV(c zvEaA3=86QFo_6I0xrxMAqutj28?d=eXx01;F2kwB-*mX(wrryh=7`?EkQ&XWU{^oD zf$NV7?0)+x6>%*qsdh%aR`5d#lh~2ahe}J4F~*7Y5`)On?FF;;>=FH@inKzKVlk@i zWWoB_X$x6Ia1jsZi5gdQN13;)G`-m&xzXlN^WVlW(#9!oh5>ZHl5UJHo~6e!HR>$ZM)?g*G9$fGl(<;<%DDe%RBnW9PNIwZ<-hg*44B^ zUpE2W+_T`}E0XaVv1CyZdU743l7~xq)SdfCqo+b`Ygq{RlBr zs$I?Pa&$N|$y29L(;;!gv#&7I)2Ve^v*K~vc5O?=sTD)BqIbr0Z%f6cH9@mt%lc@7 z7U`k;>($bZqowDgwHinswzkjqo>z&APo9YxP-|xs$J&uB?GHA#JrFIPO;%TKYhR^y z9x@}bW=an>7FZ&YW)vHmGXty7Na!+o+-n}To`%jGGx5#bZr5%c8|U%QL?zcZQ&-&Y zYGIysl-qP1)HQUw+Mc(r*Pphx@So52IxQ;*B2R8WB0hHVbkg=@r3ZZkc1+vetdNoO?-H@zXy+F6<_nVZoX+v%JC{KEWo4hi5*7U&!F|I1PqC4uNehb&mh=K=_!Q35#- z&QYZ&wALI1NX%o8BSKkNPVK^~Np8E-UP#QDjgTRob|NdRM;Q>omRU(BAX9piq%<9d zMkrJgl0<)zzKl;wPUIWRGPI)1s|9>n5?-c=$ju}P&;4da*2>PC&_^|-Z|P!cbZ(OD zcozLAH02HXmCmkZ!Kt2eNiu!TsSQ3rx8|DK=o^lo9UL>1#;W{h7$F6cn-e&jkBR4s zjUF%lO&qd*WR7c~`;-TX1M9!UA#G!6W&8gmleDN#lWscrfD_+V-)~EGvN0AE)}jln zV+XTYiZj;04`$E{*tohU+=1y$8O!u$GcuekV%2?wpy>-lv< zUc#3P!2`;@9qg==kx25G*Xcn-{5w;ml)f?_3SEq`+|HKR3Z)8PH0*?J`0P+~pNHuT z4v~!x%8I}}A-pLzXGg^fqaShQ^TCTp(cUo7pZMgs9F#PM)N|FEP-1OEKPXt8Zzr@F zbGdCoRy4!ezCc@obkiuP+VWJnRbUzG;EQ>23!7KbPcSv;SXtx=64HNb6JL9>_Bb2> zkdF)o0D{i=>9N4V-dsoD2K2e+Pj?0B3lS&v9z@%pFZ_X0G^1O>gR`2h0(PpHnrZa0(s_jA}mJ24)`9)=0SE zqp$bCWk;9Oo+w_F4pdVqCQj_Rw1tgZJ+g)G2(*n@4vt=Mrf-9SHFKsc@AT@3A`4Dw zmJ($O9n_6kcOTNIN!8n2Kr__|pe%=m=D$uIN!0!*h$MyM^eKqGu24ZW$OtAF2e_D! zY=RJ?rvNW1gxt>*EE#M4Sc7Z*lY?HKRcD^dgm4^sH`ktuEHN2q?=KmcviB9 zFQd+Mwq`?aGlS{X%s7|s*xnVQz%gCtY|p?6TY~1f;9xA1*rJI->^~g`{EAK~;PjN< z9Fs@no7txHmeIAdHza*j(yJEYmQ$uh`H-=!{EOYwrbRL8+j)~h*@lqG;LI1H=noy; zU5Bt#%)TTrOYtAt`iE|6r$cS3@W>iWbBkM;sk-$WEyQKtF28Yr;1H-UR3cZ38BKi> zHxcaiF<|tG+|$6Vu;|0S8Wm_$<|^*pm~7*=pSy|4fHE>iXkURX??c~i&~F5CIkUHa zcS+q6a7qsX!aiugKx@cRzkWs!rqV3o$qn3Z9L_uKK zyM3$%r|XTplE_#dayu1~ca%S;5_qnytYB|hP}j*hT5(MI){MroKT$a{0o5NyoU~?VmR*JQ)%q;sV9{3 zFAk%8VCGvd-DH!;c1+y3XYXu$KaZ!zf5D2-ph;HS7R<4DT*I?A`t_`R#8D`Ax1bEE z@=2pVku~-zF0hg;PEkNPV9wls;k=dAv5CuB#TY-~6+yzQg((zkUsT6|X5ox%g;bLE z$PmpOnOXtI@cvaCZ9QYT;Mx*KT-kijP2(i{nIMO$q9DseF8S)Q3(8<{TE$?8%_NO@ z7uyH~3ql>_a15P7F?QX?aF~gr80+f1jqccpd1!TCnenp;l61C4f2^53jNu8=bf!j8 zD2`o>xDvf|s=dQCk-oF{Ggc&f1)~-hGWm&Mn+T??;7Rp;YTTu8r9*)J{6+g)Y=(|U z{VI3Z^D?y|hK;hg{6<)T-iAVj9RSS_dc%rn1!kqKHV#J9f=|=GtPYNe$6sVV<3H8w zpDc!DIBdfAjS*t?1&F$as395wAhJ>-?eK5thMYr3?1St>fFE@{=-OZR+0q8Nmi0gl zDInAec>fK%1MrLP;a@*QtijXOm<__$(3H`DL-aUCuU#WyTaA8#feq4Gtz;1an)^B- zUp_xQWp=vHjG_2iaYb&F4p>I+*=NWlvJ+X1BH~3*^sAts-H=%{TT0^^b%ddWt~Uh> z`jZpjq$L`y8`&+o$@YA-J~Opz$IS7~y|91iQG`*4Gl)9FNxnMi?Bv+Qm|A@lOQR;B z(>(D%zN^yqRWL^@sWElRylI+t4ffOMb$!e>)&_+sx+=-WHfv6F+CMU%A*jRnoPFQ_ zmV8pHuP*DT6>ny{BXX@Vk?s^C!jyh1&}vbP?ru54RQmwhS}jybYNyc~nQDUx%cm;s zG^Hv!axQ66|COO=Sd`JpiPHU z$R^}OFKADLG>Jx`7jiDF+q#n;K`=bJkr(@e_l7wE=YnOBZ6~A_;0HnCf`J3T!^GIN zyc%=?$~$ZDtEdEX*Zuy+W)`;)#gA|B4TdrVfkHwr4Eiq5p$+=991i&-eCO!7`Z^D1 zg=ax~N%**E4HwDyvCll%5lvwBY<+_2o=0=^qq-Qd0DI`1<5F_gtdrm-NM6k!cLR36 z&xSaLIi@&j?bYTI!9j4@Tb<@Rmv}qN;>K=6PwxYHH^0-uF5Ha2Hb9qzJ}n`Ygs$Ml zDRAkdtPR?$1P;G^d*L&!vW4~)kJDD@Dd-)H+st|NL{E+}EY@3&muPg4y;W-KlQ%#uB z0U4M#!sZu(HIA4reXt$f;Q~Cp-NEdBP^!g_#CyyljG}A)>wA=94CL!cn9@4Tm#H5k z(&zd$ACxjq8Yjsl>{1;d{T`!HFaj*SO}tH{MC$0=;IiPdTt&zH*A|dE+Ei4tu!3~h zZ5zNV=iBWZle~<;XBETU@x#syC&vNIt}2;n z&O+_mPqcrMoF-~j1ZW%y>XqhwgIXjUcR%= zD&(qvHx3vr;3wfJz&foRIb{Q^Dg;Y54y*j=5&W=#0+*hy`& zI!S`={50)Y_@2XiW0g(aN%Dp(V}kVE*MJ(!Rp(&=;u6*qgf7$>M}j%Scvl%y!J{v=yl`GkJ$ z2!SrEqm>I)bX;^?og-E^znPnF^3gZBtT6wcL_cvnrq)al76{2zVSH_*U^-qGIsl^+ zV0;}^{py>^T1rBZaZ*xfeRX8$H7Qy`#^D>vdWtSQRW9tQnft~CSv>mCK3WG z2|0tQ+dP(sQZAUtVu#ca21)FbAun#RDc6Vwe)E7Hi8vg0{Ufn57mmIJstO-b*RqfY zD(RE-iIBJP=K3jIC3!3r=_5o~gbO-lm2e$XN4rU8g`fE^QZaVi9yDt#=9U-t>oGqh zNc5zakn3944R%*8@D{f78?yn`#WhE+{S)jK#NrZg1HNJUy1ohQ z)0ndGB-ESl=WQw6*herc>@)-8T(8%^WW?MPt8l3;v1fS=@@jX{MzV`~)Mkp^)3xr= z;qrnv!=C=il*{dU>)(3-dy+C*%m@I0ga-fs@|gEW55U&W*-ZbZvzC_h1)Bv{V8BU( z$%=P==~5{Fxrl?zhWK1{tAj+Eli*JOJ>-MlmJehy@|Wsg^jPxH6NoeNy3GPWnH*k^6z$U zq&%M&EJq10)|m>NUjvMv=wU~NN^_Jv@ggs*1W;qzcT7`4!o@O3^N>9aq&EEYcm}VU zqsUEVK0$^mpRseNi5C!u58O-N+6?fy^mf0?HqJim!w!dxF1!mVzeu@W47?t$F-kv+ z+Wx$22UKkF`()?K#tN0?=Z`&lSM5a0o~xQC-Su57hnw^a!^#I7??ne=9xdyaWP>pO z`~hv02!C(WQdV}_Y^&jn5s+^`hcRu`nxYEkqA2R zTJ%VsN#Y^4^8-+~Dg9VvYkkdyafW&*a54RZyd(-)9p}$P+~)*W(QQR1`Kp(J`cynH zmF~dta3?2$#JsRjwWnk*y?d$0#QU9qLV;JDo+Qrwv$;ltofz(^m2a0z4WH+L8>RlM z8Ii)*79NBMeNDPk?ShUosqH1L4sOJQA#dJYluQSg+ubSi#|vKYnXwW`Y-aZ)t{lI5 z_l4o(=!g&j_b%-Yqjm#Th>^)*QiT$Kd!^Amb>X+`2Odkg!ChKDje_-yZ+mjRZ%1+u z5~C{g{ZUnAi9puWI6XEeG3H1W!_TVSh_$2hhl+9i?+EY?iR3Om27NG&#%(n>OyF== zbj?PzyHtQ?_b3HVZ<+Egu(Z#bXkZ_kQ^gn7_So`P!U+y3zYYupn{>wu#rcL8Iy;6J zngCkmKr3(zPb?>wErC5jl491hy0K5KZMPyTe9hm*}%ZgQfe zONU&%1X7Q$G2utglTl<+nVYkgD6v{ET3=FEN`@393swow@uW&)-W=gm&KC?Saml^J zG;HbLNWU84$Ycf|A>q`-K^Z4gac*v>a60RLV>~}>OWDnTV+Kr#>lF?0a~9tB^TQ@s zW|V9Jxn!XtIDQKYOEbh;kfEgcJugWIK@<1Q@M*qx7rZ7mXvg0hg+Y^MoKY$Rv?5M0 zN_mu?Pb97|evSQOHE&#brHoPvv>ahayw7Y-?NxhHp>M>uy^aIYgJE$m?%Eb~f)Dh| z3Qm{uX7E__rMQ22wG$&$*_j(jZ~oz&sZx>R9crtAG23D`LJF<5xl_hw-I_CSHh@J< z=SC-mirlEdW18W@=3{M$LbOY;gXDU3${3;|E=7RhtO9_AYN&M}3;%%7x4nO_48AaO zu)%!mG{9WBTfa^z5;W2CxM3_4jPXKwvpBAg9F2T-eBsSS=_|cPdH~{Trg+%wfC5rYVmy0)cA;N{t z837I=t-Yqx>elesOtth5!IYe$@&}Ot*6)rh`{F)w zA{B0;ooHf*wm^R9bQ9p~bn}1T>DJ5J*#f0?i_Q*ZcB}tmQ^$@zJb~8XbvMXR+1*~K z=?tG#$tg>x>0F@Ib}ruOwl()no;Oj99`>502TNF!&G7Xj0;BQ!Sf)|o>wQ>f{0Z{) zH3(w?*Zy0XW!tWaeIg4aVdn_;Yu336t2UqS=`<}&64h??L*3XPfqiMN><#t!R&n|l z^L6e9`x&8~5>7!P!it;`Mh1JaOA2L)JEp+>iObcUHjP3qo|-~=lwrlxnnyAN_Bm5! z+F4wK2c+5Ui#_eYIj(S}>80KNBNDJ}8xI^`5oJWH>0dhW} zbaCw%9lMtkVM}e9PKVc6=yMcUY;zQ?_WDA0u!pqwu>;ZgvW!z_%!*Q8O_gNdS}Auj zNh?PdSUjxuJ!NOolUVcF5LDQN9z7dPkM=Wbe_iNDehB|Ni&K&Q;2?-Kpa1m_2xd0l%b&UUi|rqo0#edB0x9$U zyg0w2$A0D;^TauV)lnCf%Gs0WiFk`i&F%6v8u@O&*a+X)GimwED zU{rg;N@XV#GN&Xenn+$;b??k5-{5nTxvzdmylh3@XORW)9Gk+96yrJOw;01>IQOY1 zTd4Rb?^r8dF;REYIW5ZD#nT*w%Jf)4gf$O_X}f9BpOj1ou-REFhBL!w2R2jIXv5$y z%10t}$MRzAs2{{;c%)cV&_eoE*fGKsI`Ao~bSX`3VZF??96R)D`&NT`9{}=C+dC1` z2|XRbCo~&j1IHAH%{+O`SBLs3I{>0k8a&Lkh;Wc?5_t>5Luhvjg7j zNPmb^E$XDi#{U7q0seNeDRdKijC>RmIX?v3MUr8<9)$h?!U|U00K`(#?s@AvJ!CvZ zF**hNVe3*-1|tW)mEAd5_iiKdtaanwRd7?GY+^H^&;B?KDkgAs&C*ApJcCX&1#R+2 zq&F1A(zCymCmjCR%=3k-QrG#L^#{NDANE7O>}zG z(x@6!`SRWOHNTbdux-vKk=zbTMV?$2HV=!IC(-IDvFDyA|I=i*7fsg9GICsC3gA-_ zj^DPKQYnhVnSjhhYQYMA_r(ecg1dzi z78aEA2G;x zlzUm%&`)LFKU!dTDoX9oC}JqZ$}1FOIF=5n1-Q&F*9Sx~mq+(4E~7Lqypfk`NPSxg zw9c!Px#HFPG$(Xl0@nOpl1IGKz$HyZk)lh^qkng>)b(-Rsl@@V$U-3ZR6i+Q4R`(XH;o{TFbq)_0mKO70CSY)7JFBgPUzOPH&N zs6Kdm2PX)};{5uVi2;m6~&xquD=x_XqU=xmfpzO@1}Z2-_v*KP0)5BaE+-m z89ipn8Oe4^c`o$~{cn>jXryD&o1por z5s<%3w7I!$wtgRV^6(dUXyRT0Xe_3dkp)dAM>rm*8w0umkkd`ZT*vVxv`paM~HELXz@%hLxl}{~I9e%b- zkqTT=vc@Ax-;ZDBk=Cqcoik7w^cQ`|<{V|0DuvTRflkr{OAyD~z$*2Q&aoMc=8UM} zv?a;3dZJB+^*YH#zF44-)berbvRS-fM`Stvh*LW`kp9iV_{~a31P}HW8X-Hjlb1 zxL@&(=sBhmqXA@Be7jeb$|-I3L2?|q_uxTY&LhlVXP5SK=`)H)z&3j$WU$Xk`M*1%WUWXZi0Lyp+J#z(d1SjH|CO^!kf=J1Rf zCU;~R9TwEJlC#H_aui0MPq*_2aAsHw zm&6f}X*meBDw~iVbem_CD5tIG5fr&{JFW$A@`dvsdPoig!%TXJw30h4?aB7Y%G)6= zlH3E}BY9{Wql_}JV?^=|eYV&>Ju;8>JvEX!JKC4#n~@}&W0^W`4PQ;`MkIl?$_U2Y z#Fw>N`Vbz|^rK*g_-&`4zr*oDX9jSMK}X;5PK12#&&L=$03L z-}n-D%|qWXx1@F+>qs%8mL6S9B)ArqEh;>FpgVjh=&Rr)1+I7xf4x6(_6Z4hR9K+F zyPRdxn6n8p6bDl|=&o;0btyp^BLop9w^!b2z=%(}tkQxzF|T003`2Ic5u>8aQec@# z#ItwjfaR_UV1z^4svem_K|~sq2Z^GNeDOTBD(m7f|h zaSa3$Yz&>%`NBRXD_6QHM4m; zl&zq9+JWj!M8nPE-u~6^f`eNZk=zCr5o&fQ=7*pt zS}4@G`^O-6!v9i&J}D2O+JNfS6Od&93MiHXD1gJy34dB$OPiks=yeXn{{lFGL>CsL zDdkIt*1IC{9WigT`n-=S03bF=#ogGm8}_APe%ai9jM<#!OG874R*viG(Q<~Zr!?9yUKzMVZ8&CWXo>B0I5ZuiV#3>p&{)9^fLtoeB9H%D}Fd z9EW->K#(3y+UFBgU@UTG3x=KX2x9FZlHq`P`D$4mCiG3`X{VC>R9=W`=>kvBNoZf< zwW2#sO4*w%PJPCzMU1GzTe+seL+*C3`C}&|H3=r`rgbflr@l|Zi1?N1KG|Pk4#!?+l1ouLq zH%ez$TNS*=d^AOzyh~3cYBpF3=-{)0#2fPCf$$t+ELc;jm46e z{ofP$uXU)cm_pu2wjydpGs)NKod#%e>{@)MQj!cgKz*t-+L1fQ%v`7;=jv3&YKewf zH@%;rVh;p2WEfHn9Itf&d_(4fb|XhZ?u8y9>(Er&%`w_H7?|_ByME&Q-vc~+0_6Zo*3#i%#V2bTi&q;g} zFoufFUJ9DI^}JRI52)R7@^e;>xGFE|d+}n%Uzg71wcC*eCn5K>9n1H?Id&Efm!vWS z2OGmgh9~KzrcN<2Y6FHGM9)a6Hv1dn_aG4oo5zk44ei?e$_)j{vlFnN-Xt8ht0DohRu2&^;;VMZuudq}L4gC6dG7YpENA7(wM zSd4+%#i)NT7Jt~Z{jX&FEEGRCwQ&-m3v|cE(%DV~vd0dx3 zG~*Wf*_f*M+U(1A#l0D3e+@M^G~!m54DF=#Yugzpa;z_3Qh)+15Rh7NQ{m1u-yV** zMx^Q3jcd)yy@Bc4{0*Tql_7$OS`?uhFFmF;{sv9NbbW6>zefBB#U54mqFhvn) z#kjaJh*%iZ`g{^8Vae*q8fkLbVuDWmLwi$}l|s9*8n5c&tdsAhZ--g5w4#ov;`TNP zjqo_t8f0TqUVa6e5I0Vnr0P_TkshuI69H6kc2EJ`N_x_5Jc1wd-}45^#b61A*{115 zt(OIaqLbp~Es9}$&54$nQc~XdPN~X#T;23UcZX?kTOESA@~`SHQ+#=P1v>Hpr1IFH zUr=*JLf=kXPuotLR$N<0-%P~9!19OE%Z-hi^t?ufI#q;S4zIv91;$WaD$HiwLkRYT zuV#`;CMJwKR_+zIy2B4gS{gLD^^9?9(Q+3ir>RKd2$QL1S}-^Z3Av7=O%Ciwp$>1N zzWhuT3u}tyt3jyd-dR9Y9M)$=hP&>rSC)j3Lt}nvFiOf{CJ{l!v4cR@32FFkr84mJ zWl_1H#8Y*61H&E8<|)b1YYMDx<3fnS(im{A&lhucFUqR#AB@Uo0QPJADKL#&I4d4v zC-u`eFtmXMpHY3~c?B$~j?xZ|R_uLB+7fYiv6nAOlGBiZ+^$p%#m}>Z+kM$H!wJEU zpjZGPY5aH9V8_Ge(gl*y8_>~LpsL}QmFpj|y8dJ9`oBP3ASwN|gpF2(fQ(n6Rv%ZF zJB=*U7NrMK3dJbwI7AVfaD+s}b%&Hpj91#W3*Or8z6pMQ_}JX)FQ86eQ)rY`Y$Az@<~nm*6F);u%*~yL|<<=EF9@at~Czk@Lb16VnpT6r+ zhLD#LRC_B<(|75_ap8re>Vqgop0LaeuZ_6qu~Ye zeh)GBJB!~#vixE}_wlb8|G$kz{SN=9$@woZ01z1j_%{Re-x>VVNc-;$GJ=0+@XKWT zcP_u%D*xiM6!Pa?{KInjcl_^`4!`g#34cl9KXwnlgMS~x`vvC9`xE@zh~DoUejo4o z#X+gyPY(YW{rMgL&))7YGysrN{PSh<&%W>P@PGC}{to|8_BZ&SJ(Azi|7@!L9j#LN zH}tQD+wTm1fBF4lAyWPS^D6wE%|G7@znB03_BDUkqbZW38RVHyTnR(O(~-N{*aSSB_$06oA)-yEKci%!za+DOmd%-zTk zz(6MnU}R@tVr62alL0WXanK0?7}+>D*csXAq=Bu9e_9#Yndn3T8US_%Rsb^-qZSVj zypgrxZ#2NaA9z@1c9#E~L(s^;#?VMs&)&)bct!ymOD8L92LKD5ti6$;nSrB?J%E9c zhlfts%+k@wo=(_O&(Y|wA#`Gb8eD?>Y>f2me2o13tn7lq%&h!u0?dN^^bGv`^n!vy zY{EQT{LBJO0&Hw-9Q-WI41&x;>@4*BLP89}LPGo;f&wgzJX&;O)`mu|8ow=PU}pba zHMRj-$O_~rPbX<)ZQ^JO0NVYVk@MeHGSkW1*f;_^vH$6$0CW+6g^`6$(aqL~PF3E> zm`+850l)-c0D8c|(cVbU3Le&UV=Z=^N>C1SaPph6wKXOMNz7!%RfRF%vV8pDkgOra z$56HEWSDOs)kdg;EQyt`Vj?0EW@Hr>=S))vjlUPv;{0+eOn>j$U#$Ao{)_vZNq(+<;15G>aL|IDMpMmEISo)Xo;^?l++i( z9SVyj{-;#)zGV&Eda#F40*e~G_Q0Fo9udX<>(=0h2oOo@V zH1I|EkyF^!vuJ*RzcuoyNQiADtCp-Iy1r%6l3Qi8088D6$m(p*0zKeJS;Hk{`ULd@#o;EXYc50Z)6M)OAilALLww13=jKn zO#Z(X;9*%9ng0{J0stl!w*MNMe`d%(vBSjvd&)2~&?x|z*#Boh=7Hp9&Ij*fI|bY~Abn}Y3H-+hJ&KVCwx);-xv=k^VWDR=?xr&Je!F?R0d1 z%btaKxLT-2Vo)iVuOomjdbjS`Cx;_&v5?mbjG|oROG5yx>XWbjX}x_&fXj9iQB7_L z;xl|hS#sBH_&H~qIKH=T3mt$(8z(rp@RXUAO3(*_U0lF;e|CexS9W%+y_v02cFcP1 zx8TwhSR`GL+bRQ*|8m{`nxg;cnVz)?xsWuCk^%*tl%BoC@0ku1o!>>E#5vkK83C0> z%E(dAP|r~h@RtC{2*}#o*c#b8ni>5TC_&&?#@^7#UW1waPX{eJd43Ul8z)-_4d7&_ zlMxVc__yhI-O14ssG<%42KqlzA**L%B&p|S@<1`Qb~Lhf zbkJa8XZU>p7=4U?@Bcso>%W8f_whd`2JZiu1l<1t0Pg?jn--k_&;|T9t{U{TKr4V> zMxZ4?^SFqJH zF#5d~D9{5<`AcC16c~Wz-=+f1QeXrybNuB_0R<*t`HywLE^It&07`o9bSwlD%Kf3+wo(gRrjzIcj?z)lQ* z&OoQA2<*e~$A7>w6R`YOyeKL%1Iz!6WdVBSFQ$r$tibX=?EY6wNeTQm^v`f0JyjWf zb0dS_48^Q~$Nz>BvjRHcZzy0H*zgw?uoJ`YmcNJqD?r~c{>21X0Xm2AFDk$a&^t_j zaRF9Xey`7e+zG7wUabEGU;|eE1z-nO{srIwR{pvKVphP@F#qLtU>V4U`5!PwARFd? zzSH*5y*!5pVI)@Gqe1|lM%><jZ@T_i6%B|1ASS|0?qUKfsjZ zcQ^y+|JH}UrjY}%uBfN)K&S9m^6^_q{)amJ;qkZn{g)I<*v#GmI1?F}{>gI~I2f3K z`5bV?`Xe{MP*iZV`kzbIn3|Q%Dm&a8)zgyxf!cYjZw~Klr51vxMxB-l=HnKNHV(B^ zXn%*s`zv>R2C4H-yH)o(m`c5MQmA@?cGuH?6&a)I5HI#YepW)seRNmE;co`5)0 zk~qygB}qzuWu}4;>V5GlrZjb-d!HR5A7p=t@fhRPZ>J9go0Q~+!+GUN(P6TN`AdOk!>^1O7-{dwN#4aKTO!Tndf z!Mr3ro3BqVPw7G`LnhNnVo%Y0JJ{pFe0TBi4((3boj-}EIlsWYqXeGrofM`Cp6by( zr`+boot(dUIy)@r*Bb{CneBWGY}hHr9@>RQi>!``Dxk1*%k%o!2y2<_HFs8hey9t! zOP4!3{Xp?qa7aY*r6;fKIM%_*vqx}_L;vxCB#aZ|a1Tl_SgnQz-)r9_gKNC*fCqk8 zcyge*PvD>n`@YuB`=NUAOt0$c@z~2Tj{An}@xkf5nC&U?)ZjidE3CqhE1V;BZ8mIc zMtJBnPCBtqUkY7h=ZmT5M3wO>7BY00^* zo4&;xCYE$G^!2=8iN}_VKz@n~Kj=OW58-vZ+CR$1Vb*aeYC1^|pC7A{OOlCcS4D4k z*EI-RMIeI7JqVkkpU~X(fNlpMU?QHG=u>W*gGCK!(7AhZOgM7tYvB*fBwYC!^%aH{8L)ZjO<1n#Mw^6C!q4Q7-M3<5UHKch0Fh-{( zEXhy>-3cB2@&llgFh|>BB@Sv^sXF|t!$K}X;yS}l`uN%)2po5~MW}NyD0Cx9`AHT; zkzk2h2*9}0{iguBfbYHXNVLpB+WVtmDDAopSl3TtcoK zGYEX`UCD*&w0%*J0|>celPepQN!xF}uI_nX2e%x!tq$31xm(O%Z&W&bxiIfV%E@*9~mX&s;r|Woewxw*SLRCy>Hx24(`u71sR8JYCmAQ?V=WNin zTgv`K_J*{rxmGvgVO#sOS7$iXDnZ-fe^)H>matFc!wSX-ZMo zF1Q48Rsp_}0t$6q#X)8P+>H_>fhu%gdpiQD1hR$;cBw$X6vb}sP|z3zQEQmfRBLY$ z>}UlQzE;rlyVB1(B3LE(z@RGO9GxisCu7|XI6L{k;NWwDnfRF5Y@~}u6c!cknJ30d zw2GpK{R1k90VW8?)D~57_FOF25Vm2WT(y2q&Fk%NQ0(duW>0ql!!A=T%&{}nywn4` zQ@vmVQX$6R<&bcxen3K2TMR-U$9DJ&5s_|Uh)jKq>c6VTK$shxdt93`gS-PG}acL-{{l&@@&zMDB`eGl zR`lb9q%}t5IzdAWL0NVeXLBb5C)a3t8F?&U{o#@W96Ay<2 z7A%EVgUzcJwie!lT@!eT+RU!7`NuZX;myM`5&G+9rst^OV(`z0wpZzqb=$AU+uL1W za3F4SiGBa=m(8D~{{MSz|NGY`BQrhIe-?1jkU14C85}Wm&-<$4A~bI7q~m7+?1)bQ zVm0_LOd$naf^NFupe7)wtJG=UUB4DY+Ey{?e7UOmo7>84);aIfHJYrWv}u&<>f%O1 zU#~_F=FOcLTaq(tW%4dxf+FsImCe6|MtG%VRxBO7p1kM}@I>9+|9aQU`hY5FcAm`2 zujlx3Y8;A17S}b2alLx1aCcnw91LYi|Mcn;5sCOgLPiIQP)1ZC_|Tc*vxniLD~tOz zU-k7*kaOxNhM;1iJSSb!S)Z9m$Yvydcax<(b9#3dlBI2r3$nKli_$v{JzWZ!G!y6W z9o|enQC~=xF<7BP$%qq!yW82;s90|@S3j7)7ky~LG4>TlfYjOc-w-DiQdA{fz9d%y zXx@Z+aU%{gBYRa5#oe ze=1fzw!nl>LNA;9c?8nFXLQv46R=w`nd?Nl5=iPF))U;@$}$yl%u9?D=bEI6T^R0X z-5<6M`iT<$bNBYLK>vmdM8}7kj8`{4cFEuQETxy8oEA7#IODg>1q=9AZ~C&we~Z||IsFiQGaD)A;S z{#Y+m96C?IPa+p4+ma?pAEUTBW?PI=G|Bvq$pZDUR{$*?B}U|YG`DwN#@!d-X!p)^pi8D;E)+MRS6F5Ph;BZLw^~p zUhAJ(H$$l@yZiCkRJ#9jDzhTJaiVhZm&f|cQ6E5gWwS5XdYO+nU=Mp&2(M89s zgKon?>QxE zlJ&lqBJQrQc;RoR_ifhC@;6=n)2@;{Lni(N>JIS-mjMZBUy^e*Oa$yRY>X6rCEzg_ z#gk$kJXjv;?<;#whVLqI`X}xt4yJ25Mvap*f4PkRy8J2udIT{0+CH;VTS;SPWtf=H zK3H_&Z94-;!Zwn(6MCvu@wrpj(Z=X_u1NhZk(DH>%;g@B6+y#GBAJ{}x38h5)a2T?7bD^zJY+h{r zFEAs5tV&N%C|%>66=x1<9KpVBl2dESV8F*N)tA3Z75Ak^=JHcnd@Y2*VVgibZAysj zvQJ)rj7PWZni2Rh)jLblR&k{`QKjKbkFe@*`K7D(3dAL@XU#aPOc-0;{mXg=^^X)~ zV)5eA_dMbwBemDYi3%(sj?W=wt#v|DG!hgU^m+(hWTOq4istGSD^eNxjKm2HRzf39 zLL`EytEbEpIof;7w96hDbVf*PLxzGmD^f(lH2`Sn_^Z#HLsDs3I594fxy4_NBaNkU z_iJ6mHg>>S6)ZWVm>-v}Q;TkrxW@NtnpWv`?sGfH3(s*16wvo5M%yQuwvXX`6h!Q| ziE!}!I-?@)IF{{Gs}9szS?Fmnji{{OOcj54R=X}{yRj@2J4!~1r;a;tH?N~hw~bMo zX!)uaxMmH!K;hYO7}_w}5R2VfYD}`-*Y~t}8+8p#A5$;cu>5LFx9xmYj(-eLAi-bN zoa;}mv!dPC5c=Hy9gn7_aSc{Yy6IAg0!~5sZmMTmFU^edyiYImywx&kmeGGb-q(%6 z$1j$c;N~!%4;)#F=ht1(_=7~^{7jk5H?{#ON=1e`2okcC$3y!RjugEj1*dTig_^k$ zZn7L+JBzV_RUy6~iA_H%+YidouMcVM8RKWXA1g*sXD^W!YBmxBt41400!3#nK#JDy zZJ8_BPD)d$lPrmT1*bHpKFpCwR%3iol%ZO)-!C9Hj$6KIh54x{F-og8s^3$j5D`$8 zdvz`%B?(1Rg}(a(y+BZYk3k~oSOBE@qtGF4bckaekDZGgwgY%{WMFiYZX<1;cf+9u zs+;r1H11?HlC2sQuT;w6J}2fdrb-J61G9&9hwi8@e1(9*gzL=5EdLT&Ut57Xael1{ zoD9)}y^9X^Fssq2#jBmhVAqUx^0AWG*YveUt}1~ntHO6<>cBM4wargX%R+Wq3N3+s zt+CDM{83q&YO#v%nKW$jCGP6zrA^U7LKJHd}oOgK3i|zf-k)@jLMUnyUT2 zgY^H9sYq9De3FM?7R|?;O#uB`?UAR4_Hc0S1tOJ@H4+T7CCo~@7 z{dsPFooP=tu>;hvJ(`Jo-O1}#>GmKgFKbd}e)F=f6>!m#h9gQh+ z{+o{5b@K4ij!H)GRb@R@D_cX}M_gs|yoUrC96k5q@Ehh+a3=AV-@tR*v0tw0ScUfI zwiFS?jAuZDxAVqfS(@j%qV8VHueVGxTV{%JKlmYNlsq5j<+#2S<9;v3d59Iz6;`l4 z0Fx|MpZS`3_#@W8wHpy?t|fb-_&5(&2r*+MHCIt!mkIox_*Icj4R+`e>LGYBiU>|w zh_5UzZ9O|9y##gn-S?|zb_C1mHRchj72JvkEY#NR`DYgHa#9F*ND}c6n^*rQ)u{$(+RNr)!W$O%ydGi!rk6X!boGcnD+Grmy z`w!Ug0#&P8DM>TQ=F?c(Z~sgM+tf}bwh?WmNlz|e-A#0Mk*?M;fx?K#4>$P!@eWwsJ(|w{C2CZ0b+%SadSa%XBU0(+cL&XflrUyfP{+ znDseFp2`(Air469_!gQdJv0L+OusmY_J$paT16WPcHV?si~I2a11?V~7~#8hX$M$KD1+#0{!y&QYLBwU zP$wS(Uq}~(_Xape&PYfjc?`WMm-C@{ZbZOpy@skTU5((F)(4J4tBsGRb*f%yk>7I#WXi^6M1ENBgFy zZgD94iYenbQ&RPF=mi4|+`1taQyw@ImYt3=taoq)UWcaMKa2_tpeSXiJLaI5WvElP zppU*jlFe;3qzC)vTB@vym(q~K{c`_RyzrKVV4ua&?HL?|Y;#mzYX5Ep#w@d5>Eb^R$YCV*%Y&Z9_lJY%bJT!FQtV;|_ zfvQB*!eWZe9sHY5PZh-w0>!nS(9}LN!Pa&{B?4Xj&o=Ey7nI}sq62CDff@BD4T zyYMW6br)rYe2clpebiMSNq9Q8j|?R0gq(es7q58yh9LqDL2mT~Od~l9Q}~aqq@C7` z1`K&>v#Q1?B<@a4LN9hzIkfgov3pj{?&tf>pm7|DVO6m>t1O*KhkF=Wm!={F2>PGO z-6@A)5houiYZI%!jN+tF3i8KXCWyG_nd~{9zV=@IgcHt^)(Y{{SVj-e`td})mLge` z=iGbW-PM zKGEgOGFKr^7dE^mf#a)<+||ZjCQO-XU}(y*=oyY(c4+Nv<>1ATK=Z-(b?$RgxUQ5m zuLKuD@5PyJTEf zPcoGd5Lu?&b{&Oc?m(QFt?Yep0K~-^y#-n5Zar+Ch3pyhW|JP5j=ys|@EUi(G^MHN zDVH#&D|a(L1WhEc8|Yf$N$4U748M{GXr{27sUcB56U=?C&El7pn7@8XRZJUgs|aa% z(fBNlaJ_HqQ6jd?X}Vsq9DGP!F9$8>>rdT2WQ4ns8@3z55?xCUyt%Ob!j ziXolc#3{|UAk+%2Ie@TDn62kjt>!%9v|h0H&G==Bu4vs$jnP1)zB{6<(Qk8`$4gCT z|B4d?bJ#$@c;dqdyDmB-Jtr1s23+zR1?Dq;K#f&4UKWG_$ZVFsoraR19at;@?H6_m zhVnbc^;tT_kM&=otyqQ;bUnc=3E){gWYA@C&H>E_JB#m&7puSK2|h%G} zYP`@zUb(BliK6PfADm5mHQRdo#fE3?CbQ<+3aL}8Ug%6TOoJLL&%ljn!zC93y}=8UN#8&|0YYqzs| z5xW-&x2tot>W_0nx8%B%pYWF*&#a@*MXEdlFBGXZhev(H5y2FD>0zA=yCVcdh)hAE zH4N>sdjbUIUi1NlkX~$)X7L;6!PUWyS2J}zT9~Jreceftq}x|fQW}UBoQiFq1y{_F9xjRjin@#({ZR;&l<+rb0P^CpLPBrIU223^ z8ZINWfsE37I4eO;EGA^jEmrVK%NpL28P?iu#0Qy^FAKQ1!CvFGOb~{&pUr!cL9I!# zG~9GX4lP`*2x~9yx?Sc7Xk^4@PZGOIJxQT3bPe{d<^(+tGK8`php$<$JVw&mZTR6f zXaH@Nl?Ju36dCSQN9rf(*RIdisr9U~_=C#=@0D*v-5}v*hfn`C+57!3^8Y>Aqi6YF z$=;aCi1n^8QpYou>!%pKwtEQK5B)gN0Pqjrt)-EmW19qtuo6vh-#tsqFwPQ!?~l_tG8INx2>aX-Ji*J^QN%pP72&1Ox)7Fsf-Wu!l{UAK^{GIa6e4tS__ zcNO_z@f*p>J)l`*q4jf)ZU@=xr^gJu%ueqiPAGA_KOa2AzYq8$OD7v{{5Ucdhi_tX z9cPbWP3_YlwW9x(PUHt+q2O+B{_<-pCL9mhK$D)8sJf!4VP6_FmJ6U?~`Qx zfUC;McvI3VCOcM4D3j3PzMZLWy9aKQpd_TN8!}iJE8aSCgs7ZbxjP-)8Ij-Krk3MS zst@Y42HJ}JP>Phm!Oe+%#`MQv`(W94 z9@0-F9;AO@VbZ*4o8SFAeg2*{*CSqCWtj=MvAS~ecP?i{*hkNM1y~-0z-|+ ztkrnIFk@K+4Pj)?oVvX;(iY8r6Yj{$FkeaQ*#E(dPJoa#MJd|Sn$2WP?9td-YTkTjsJ#@5L$a-(Kv8KUutQ3nPZ^3W2 znu5@igU|(|xwEN3e;~<9*EMY`R~IAnBK-=#Xw#9-{1NKwh!LmJ9Mg{$N7cMNu$R+6 zq*4IYH5iVXP;f24agZhPrqm*`kFFMYi{@|LL%$ryaYEhKIFR3cntD@G2T{VXULuN; zA@A2DEaIiG#Ao8~Co)z6CcP$>B-v4^tG#W(MkRSUp`~DAErTsH31f;&WjH z-_(#ZqIJr_w`ZILk-zycjBLU%a0FqRMl|whlkgJ z0mZN@Y(>D;Q(4NfH6pay;=!^rpAf`RhW-W1fVW)#i_*Ng)ys z)(yR{DxX`j6tNN;qXi_GlnXI=0*z}xqC!Wk?{mrpwKADLA=*2x>Uft@b^fp+LDR&i!uT1DAk`iF8BGqi*r)zb5mF=_`F_?DR43;cI z+D^7`!eHb!lJ?w1NvW6nSq@a{ahR45D|su|w3%+G`6hFbV6mf8;)bl2OXG5tYP)_yiVuMK7l6KpOqZNMm{!QUYi~waxM2oBtCxxW9(?K^O2?YsB z7mdZ4xl>6}Mw~#n*75^^!@QLnI8&J&Ax~wzZ zkNvk?N6*Bn6!dhht+_VFW~b>vx*=PiRx^>m)gdE=QaY+I?>}>1SqFovTBX|OLn{a| z&CxU5lM$MIM_RWDlTN}BB)TtL%x3UlKg!ug^oPo3*!l(FMNk*U&pty^jB5@~bF-BX$)Ti?uZ6CWD?);5HZhB+Xm z8BMh@l+`G;(C+Zoil7a~MGAM|Ul_+kFri*>1<8Ie_^NW5YAbjkg@GuGscy1W39r7T z!40mQ3T><|z@dwV#m&4c=<)mP6F<+6iwZ? zLVaF3XptwIzP}$kM7YsR%U|KwHEV@r?)*qQ$!bZRVoSqK@*vHp5DY!|T>><*4)~^T zzf^!q_|8$X&iEnXN0pw-{uQ~q`AQyn_MvLF(q$I#;Z;TmJgonkQv81C=>MKlu>9|o z;zVWD8hHQ6^OwqvLie)IX{Qbd9dcN{AN<|UI!QI+24HHYwm>k~Qb=3GJ4?Yc1#1G1 zq(Tqe4H_*<-5{*A{8&bKZtnzeDaq0@XBAl99I;>3?)jr%!1`DCZyDp+}Y zjP4ScBkbO$>03NM;LP4WHCZ+?5rL&lYQ`IK$N6bIh}aKUPny_tre;{;Uukn77&6%B zG1ayZulwa=jyE1JYf7~!D7%O=Vl9!ZjbtPZ6r?>QOUMkAzTq`9OSZ&+%L#jxCxBc6 z!yI&Bs4rzF`RsWY%XjKhX0ssqG@Lj}jCUrwnwvHp{2Xo(TX&1F z_yEkCb6er3!FsvI-o=>kSNVFy^r@@GG;N8AGSu3GnGk#wF4>m4fiC=1v|a>Fzm=+?ef}W+$)95F_ep=3o%3@+0BD; z&E6SNvmX=MjV?azhTkj~NMoL@v^vHfZwrVO#^4h{d*cy&uN2T7_yl$gvrh)FEdcq< znPcYeCXW1kx3_=mNvCBcr810;X1u+z19~Nf7t4y%k^qfq_8d_pYDeI(Jd~(So;{n`^A4my`~5T9#f&MbdL&#SRgb{v<57 z;T|D)58^FU?p&4lGU>BJDdsTpQx<2TE{e6ADomB##W8C5Ugq+hxaR{DAm z$*h33thDT0N5o-oi*R)w^~`ld_M{mgbN$E`03%yfH)4asT;S`!qPoWVQKsx$Ik|Ke zUL5=P5Kn5-eE?}8WpOYWk$#(Ntw%Cg^gBvy-$6PCs$4oDg~YGYbjtg}B)l}cOp#5C zQ3cR1soR52MCus*A}gjigLLb{0%KZpOa3($yZ97I^4*kQn9q;pX$ts@`0MB^!!^a> zzUbI+atSI<@YgPSijuW#>mJah9g5}JG=Jy|+t{Cfa%5-4))CgAw^&jNptovaeQeB* zF9%hvfWLh<5IE;TJIz5h6(~u&iAc6CS?_O+91>3Qold5naa~}0LId@z`B3sXZ)hCF zkBhsK)y%^?n%7y$TLUcT$`PE(W6CbX0>2HB=Ut})&&aH3uXsjNDGETjXW|5N_~(K zMJtJaR-*L{~_>6P-`%hHkcQ<;;}0 z@xgI=Zno22DOWy<@Fc3U3B79M_)FK1ltK|YlW*@Tp+$xC~6b0S-g|?KTNfrpKLB#XPCJ+sN{kV;{uWB19R}|L>ZMIS~J03@*hD4{)x@=M3 zecvZ%gHpU{T%vxNEn!b_DaL6L&^v5vAC(O<&!ggQFG{SmOtUPuX;B)C^<{*h;P5Yu zzYU!O^ol2P>~^p0+YaI>u@afHV&f<4YDm*t{CjZc3_J!O-gFg(?c1{Y*6Lk zMcVQ)gyh@uaDFoBQ`9Nj%&gp^-|?$ohp7Yr%|zpzw+P<4d^rg5dC>&kc2kSA;BcJ> zyjk3PS*97K`Z4REFZHz{W@P5>p^YdpwX>kNKvHo3M|_ANV(%rl*f+(Fu|=vU`;F*J zczw0>8;y;GuXR%E4YFuIHRSEGzItm+T)f?0+rL-gog~KdR%|hU277ZqUOrt_v$sP? zrUm^%JhZKKIB>fDGp%l2OU9#kXOrnDemFDIY492eseJu5yi?Nv&o*A&Pis7W9=HCO z8|(w+Po;Imq+HL|?3C>x+S}rqo9O<~{3MV;;Y!?WRl}r_m*Btzk>Fi)4^$2Q^>h;T zv$(8BpLpA(Vgo@cc#v9VcYs-8-Y=T`ZF9xiVyj=DQ_QApT;7dz*v(K8zjL&!xx#jk z2}4AxblvlN9l$uLVyMpr5vg}5n)kW8Ki>77y2B7^E;SL{E~Sh}ohMKu5W!pg^TVC-3Kr zMtX=0`wo*9%BMvhEm5;xUMbc3G%s*q8>y_OsePJF{MFZ}_^`CRHs6EitIF~tTgf<- zAS+D7i^$8jsjE+#zK{HoT0R7zSfaGua*p1M4!)2E3h%XCkcbX)25=6Vd`EuRE{v%Q zg_YY>E4Ww2mPA;WQT{9h2MkMFa-Ri5la$v?r@_;tgZAXGB_xUC*qu1yU2U5q^x) zW|2pW;(`#xlp12#52diiif?hMwcA+Ue5I=2Rw$wBY%mm{tj3G0q>~gtwbdH{af_m~ z(1KpPOL#Lbs*+?*GA-3eJ1k&%42T~D#9gDn=TcaY?-7LR9SvcKJ%(6SCsKj&R$KkR z3Bb_~k_~5V-aR$dj`Z`>{oL8pMP4b!!U7Nx%^ju%HONW!JCo<(#cn@u5j#AdnF@nz z8dx_)8(hS=$cFr8Iz|h%g0t$+eVdNaT?}B_$^^#aBeOd0uv5ZT7+*v2!6(abE#c8F^(*oEZG`L)rT|#BENtv zJm05Vi;KIgLzpa`l5hGbem-)|z+H`okN!xQ@{q_KoIXJS_9xnFw{Ja(jb^@|l=n#Z z-F)t9lPH-B)13||BnXS=N8JCKM*ffY?*7Zu;Qu@^#zy}?-ck|`=~o$zByK`(zgM|{ zN+pc5;hpM<&fGp91^!B0G&5~r2W<`biaBkgW;s% zXyzJ1v&~BZ<9EG<=hdgPY3}gwr4|(*#qbf2YEX-Fu=O#~0}WzP-zC{Fkeze#W&vcg zX)q#rp?Efju^IWRTw!x#5fFKB6Jo$Sj@&l4$=8Fn0!W9_ZJF4_N&@PzPy@D_9;~jPE${gbezz2K)KE^P?3{ zifCG5XwIzok7#8rt^44^!CGj)N|SO)izwMuJkFvyJWL0S^sB`n-$~F`F-IWL{95we z6GqrEqoP*F)NA_cTe@eZ3IH1kR}*Mp^F3dN7cuzOBnQrZL&N8&H7C_ZUmo*TJI_U_ozg*M6o{DRK6DP%n?CiIZtmDJ z1(Mfj9EoL`-Tep`DkaQACX!T@y39Q^j~v*}&NSKgXMk7hHJZR65m3PI8e65e0G|;g ztHIKFw8%4z|CD8@CS+D3OmF|SiK(YswVWBUfm0A-E({F=UQIQx0JM>i1B_Z(ohtMr ztkPTt_$_FHSnc#mgJ2JiOPP8uTuJ|qat7g$8i%zm8Y3^4g`zXHT%bX7%tldEYNj5a zK2M*b$!@N?6~-H74gN359iQ0^TXgX8wUU9W`*(?ouD6%GHqZMe@7KF5nXcyZuJ^NF z`0sCVsGlbAy>o9s~s-=-a|d{1H@Qklfy0Z$?kE&Ni1o!=gE`%#g;OR&>1=rN5b$JBU=f>e5FW6>v^G@!>OW1b~h! zBqkr^SQlruq?L5bNJ58QD)D}mXUSX&Gle#`2|@CxQDKs}4!H|0qE6u{_P@@x&fkFy#ru_ClL#JE)clqZMt$=2Bg9e($@NiU-(7LqO@?Z znb!?d)ajqo^2IHa2-JPesgt(XWRKjE%Xc#%l{zwN?}lKDY{@^jHiY9$eM0PCfON`5 z6g!LOk=bPm9#dE?YR{LFWn^?zO3uV2O-i0xV67ICaM5p&5!QExYDfGiqn{N|!rWwt zqfU?aOReEzC)768%u2T>q@v}G7b*=!bJeFi``}|9?5!$%G_UvA!x|x$Wc4WSlmL!&yyIa3~xx_yQL*h1%ar`xE}>&hq$aC&Wtg zZxz;R-y$@x_F}cgvt|&den!vZEo#$Q1i!3oXpA~lM7S*8EpKdUX{fR$6|t;&4jD=9 z&>c6IYW=UznnFT1;f-;6ButCNyPy)KhVfcU0%N$ygvQjU#r;JHJ@!8JZxD z8Dep-`Dz&3|1?-N|J8WLtRg^Qp(gP;ynw`W;AXH|c|z4??_;ITt~(0dDAeIMBmM01 z7gqVGhQ3^ZC%s#oPVEh;8S4rdWEpT}0ZouG8>+`3Pr;CUcBoo)+)jN@0{d`=Qu zC;B~xdyn<{>m9c`*-hiklO9{+n21|+W8uYVi}%2&tW*!dsI+to;D2wJ%DMD@epJ9v zb?f_qq523`W~urUtV~lk0si-fshm@9o~hjZb}LAUuKEZ3rTc z+jYAWl%{fLcWwj4*zAH(BoC<#MDdeuN*nC$z^(6XX$4a=DUI4dw+zX^3FE8L4x=Ai zrAJQ!a5I=d*L*dY5Dw)bdS^>0;_Tl>26n8~1d6%0^;FPg3sMFPP=;>^l$;pe^OIy{ z{*_g>RPRi%@)7`2coA3Qp+4B4p1ocX5^${hhn1R=SkCrZ6t zx%#F17m-a4+9+FYkxPnpnw_tAv=91HmUi>~krL+ZbN$8C>uR%Zo62w1m<^O0D$-6u ztcwP+W5<%8MkkWzc#;X#q2{l)Ks7#NB@(4wwedI_x#DsDAf(0(#Libc*puZL_fL>( z=c`1oRW*K{?)tu&$jp-~&CFwoli38fu-9jy?!*9HM`PPFMd#SKQ}_JGoMmAA{IAyVUpmWoJFaoA4Pvo$9uHgj4pWnR<%A^5Dl!4LCLU?1*El&Qde!s(w&x=!6A9(u<#>vR$ax^1*q?u#`yl8<1t<@SueV5< z=oy*+_ak^4~Lm41UC(k7GaDutS?7iI`sf6k9+_Myj)#A6l8rim zdFCq|Xwrg$7HOXw6&x=1xr+IVN(P!4b{XCm3dtx?WAhiAw(B$QH=TC3%GSK3Bn%xJ zm!r1x$PF%U&+_u|qv!Li&jyE{_ZCU((4d@Y47`ER5t=Eft6KMLPX1Ev;Wb;tR699F zk}KH72%e8g`lme}$#&~lPSdZY;U}y=dIP0J>@22jCHC+twOj-OcIZvM+vVR77$?US zpxry94^1_GLfFzLhla9CD|%9MZZ(^Tyo%9l^6EBvNRZzjoQ?4Rh@{@O!ONS?+RBQq zle?Qx1jj6A?UUAFYBqEfGw^fsCIKdL_56AG!SCl$p6;DzKs28O8Nky1^ulCS3}d4K zj_Rg4std)+NniC2u8eNFpVGQ`=beVAoF?7lW)QxYg2jTcz13ycI6iu48%e(erHZ%E zO-hr+-bHhUndnMHrGw@k>u5}(-ZUZ@6Y&{Nz^&TX0iCerOP$1!*&vKef($XCW-*gk z;zI?Mreoe-u8G7pPpv?Wf6=NWHp!N)5sLO2AwK$1q_vz6dJJ-TE!J*nnH&8uZZdYW zQ=l=J2xb7182&U?_}FI5vQfrz&n^ADmte9ZR?EzD<*iX8Tm{iC{ngP@G1G z*Cf{`-a+OOP8p3ltTqEEgSMA|u^wP2)e|V=kbd@dohR_~ zZ&mm|w7qk5X2II#{UqshoOIktM;+U?ZQHhO8y(vn+qP}nwl&Y0d1uX;wa&bAX6E~9 z?Z5Y~Rrl|@t9I?$*F6o2R|d8KX)ET7qjxV^2`lKLxVKNYHetwNlb^$`Xt3>rZ1>`q z8W!sxgZp!iSz$u4-dMXonNN%rfZY;U zAl?N98Na4#0D&zev8s)bitCn6-`31j0ueXXkHSIt*{`H6Yz7jn#h7cTh#dz;$!8Rx zb?vgKtfHIC_2S1h@M{%0^++Fr@!HnJ@3pd2wm06mc_i|sHw@W@yo}}NXI|@1-_)dT zSkYVZnrYY(I{fTEXXq`q_n=|G-&XYZ!qlprKm_-EHHe@lV;eO2p5GRdG2RPJzj0f` zgd$J0(hF*m{^0yYAWDx$i?D4LNhyz;DiT9%oWj_FOSFKf1#JYIg>G~V(9I{B#qb|h zzzL0U^}TI}z{gBS36#~ zLYAZZrkmK4->k(_-hN>YVwy0R2aF?U$EEjryNAc@FXiq_)wCcG!Yli!x zE7a1`4envap>|4Vy%28^H36Z^y>qp9})IWG&FBLB@^IS(PzKj z{B~O8xO$0;qfUZ~tUj0H4Q%GK-FM8>wW`=UFXFnFA4^EORx&=E@BDt*`YoXZmXLd` z#cS}9>ss6u(qPrw;DH`}yf%n&nuA<}ZaNh z_6a2(8&Zm!n#gK=`Aaf}+`;w_rWkIKpc`lHT$(tZEWSKV{KlUbBr5oCnCM#3K_@gS2=-yUqeztW zpxuLo3HCwygQ;%xyHDEDbVenn6jDE0zWk{1AzKZV)4|wRNSs#p+KU5Rhxkb-GLl11 zDanHbup%bG{6S|)GP|3Q*s3A@sfpw;$#bYk*(JDJiyWaTCSj;i{2Yrt-=%nmx!&P1 z&ZSTW2@GP;TtUm&+bIIcQpo0+{PwhZgG}zPYRI$l&bow zK5F(17F%CQd95WLx6McBgB|ng3B+i_#aw%iQmD1J23(jim}W1+t@^ojXVzK|bIz%A z3L!Ki-s)?I<6nz6U424jm}GocKXxb2hBjbxVGSgGDLH&Cyfv|>I zobdcW8D7pl1Im+pD945*LeDSd${~;Ke7EuB&Kqz zWZ6=7!K=RtB+Ji&*DKWuIsYkghv#|no1=>Jj`r49fO$_Z&H482-=_k2^on|&{MaF} z>*Ub{>a%0vZ{EsIj_~C8p85cD{rC!x7`N7Bx4!j3ZcX!e7qrRm@s5e5PHGs*?IK_2`7Y(x&lQM*~C<51|g=>uv0h zmkI5v#J4`T4VkWM$7@3QhRN5N$pMZ^+t+*yP&~San|xQ~I&B$HL~e(V26b0ZZSXTS z&HC$At<7J}5sPBcs@pNz9YeK>%RRYbEgk3Z28=ld&RbruzNMD?Lazqj1Zk%rQFllx zCLa?Z3knC>V@}l{bHV)-i+!mujvsA7-(lQrSmVNcjF}v6t)v4)$aNv-ahPJ7^ZGE| z5(5&@U~jrP?rEmDGd~)e@lQNrw=oHarJ9=Hu3g;Max^$C7rU=g_EPq>>R#F!{1B!* z%=G@c-hh$=l3$d_&#`{rIz&vBJ$f&fFy9n*D8)$ z{U(clLe}V27@;SHm;%>c#QgW9hnZTRNRRddf||Utc9_&>l#g6)4ydx4-qJmb%Elwm z+PN~7EPGb%%(?p7VNhkCzv6n{sMa1DRZHW=@&f%A29F=42o&qu`0vr>gUc&fbwyxq ze#;%A-V0N9;)O-d(S-xzVZ{*|uHTu@otKy}-#r^5LCFjia{TX)C%DdF{@!0fOlBL`*>E2JH3J#xrwywS1}3SqR7HQ+b4vVioK_U`>zy2g%n1k?0nG!o`mN+oPE%JZ zg1lkv+Q3*OW9(e%lH{)2J=7HGm!A3kg%HdMo?U1XYvd8)2>cT%^gKmcFz;^+m(?Px zF6{|f4c9%jBc>KF?e7xw1NcML#T&wj6|R_Wsr(Vzb@WE{r#-yn+5R|NLH1pke{E zIYIll)ai*?)GrJz$l{g5v-%q`Y3V{&?DsMaixzev)?S@CFNS%)b#>qsi$YXLh6WZX zAAx_hm*Ie*(nan4a<5G_`T25beW%so=J0s(F$81Os@~!CcG=sZR#84{{;-s%Sk~bG z#Z^{oS})f^EonAyUZ<*!sbEs})jAN2c4Q=%gxTfGL;jRVEk4%@#~eX37Bd8!#Ax2K zb3`5RVcwu=vWg;1RaGlZh09Q}F?J!4w3a6?@sP4}s_|*=G5X5ir(on(4@DhPG-}?Y zU>&Ya^)xcpM(M&~-0H}|V_5MP_rzn=O0KTH_n2&IgE9zX)A)qMpBDB7B2Pv+@ZC&t zZ$nYJrF%WqDgpVxUrzuI-afXUM(ox^=Hx~^`US?>HsrnKH8Cwj%1nz!*(U&}n?2%y zR?)Tm&AO{AFOC1EhOYj+m^!(3uC6qE@Nsr*i+)2t4{JK>tJ$tg0jz%PE_92=AtV9H z(^IYUXi{`Y`chz-l$?oiOt?7~Ra~5WfmIVCaQe>}Y)p2bhfe3WC#+hE^e==f^o-SS zmfv0J=D$`8dHi9R=J__M-qH#(b}!o`*1ecV!u#fIA1a0j(PNK)haeIgL9E;yrc@{6 zuiuRLjm=L@bN53G-i&WIOV!1aOVZ&GU=}F3F^}j)dYHqQCS7fT*Y8!s(T&(;5idJ# z2U-<)v>61~@VZaOd|=BK+UHJzm12U8CRWz)1jprw#_-;gfsy`+Ha&~ATaC_RPIH68 z=vl-`aw`_pqok=pZyxligt1E7Ir0V`a3CKDf#FozLkUIOLo{~nN1siG=Hu(ePvGIx zus~sYXPV7mE=N6abN;%N%kcj$6ym@q&q1Zlqiw{>4aG zsZuCqudI~PC__DQh8PaNGTc>P$ruT60=Uli?{7-po7g%aBbC+aMX?EfS&J9o#h5D#ve;$P zBAjKmz0F#`yB_wUU)+xp6h-`AneT;lU$&!p$=-|_Sl_DK+}N!M*v&s{`MXMII^w<;EYH3=$7XuO?y;LVTdT@q=GK~M{% zr|=llpiAwsV#lt9?r&+3XU`K*V z+U{xGGs<~SR!c0qqbJV#Nk5Qop3O(MCkV!JEB(v#iZwGwnO7XLvpx}Q=U2DUS5mjS zh%PG8^aNzX(YY&2Iu%8?Fm?uEqqNk9jQ(52b5?httsF1=e2`gtH`uE=f@8@#JGs}H zxHnA$Hj;pM(iBPR40!o@%b=!$HdBA7=iUoH^Ms3p^4Ln#dqGty4$@bhq|hKLh&s0% zm|#QaNc0yw|1viqUhD;qmmXmH#_%J1K2}Y$CpNW5X%oeX34-$EqX5#I5R95h%b>R- z#jF$SoA>=v15~vEA;*^0n*a!Z0JM# z-9x?jOR;#X({Yw$yfCxh-LV1)>+@`&>(qLx>z3*8wY-fN8eO zDc|tHPJYmv7K2_m?J*~5-*|mvQ4cV5MF}`Gm4ZxkE2B~~RCuFZnq}nCv9M1Cb0UnD zhp&G#Ll=M=@I`Sz`_}f&14n$*&R@PhQ}d{MiP5mAtW(Oy&wh;dlRMdRvV0jr1<`;_ zl+q!vT4qP^LjU`Bepz$P&<)~1c)0Re3Eq&O^~&X58_y#F(4r((!G2fBBcIZ;idk#{ zGnveMf-Z~k)7bh2sPSBRfAi9a9>rycl+eiJ`)&qfJ|xyJbb2<_!oJkQjlxDvB7~&CSrXMb& z$?kXF2>myfp0mZCHMi3?T9%{n+BI7UYnpMrCT*A)=@d3$X&KU4HcVwXd@A)36j3Vl zO?E*H;;Kz%led}rkjlx7(>SO>Al)9i0w1au|B+C-^|sUH5G{$GN7NAhK^4=)0_XkK&)jI2xglOnzd0T0*6CB*> zTP1BPXeJl$-xxI#gG64xm~`0G#sSs!_EolXN4+)`Wc{;sS?tz@hr zJ@l`2F3COXlqZvYh8)OyLd0@RAtSrnPLwFn41Y44TIXbi6(2$IGz&LwTHjSkR<=lB zO-1i-BHk=Ws{<2R%BmEdld_yuc`-B2PR^NbB>@%qK~>#SxfQYiJC~6Q zLd^pmpPyRVGKLt`6Mj$gdbDTXc(X*XnK~zvHOY4oKM|Gy=ku>Dq^#FQeGY@3_uBV~ zme6gO_X-K>((}lj%B8@y;J3{=E?9Wy<;L@P3B z@xT2gce{jo2hkP>2}Rs=Ty8^EBQ;`ci?bJ@s)K#uKKF~$EOuE?AF#;V@L(*7xX8aT z90Mp$AbxhB=8?goUlaj+rom(C9mJSj-7tP^hx55z9D?KpELtU|C!2n>^Ok)<(E{Ea zKJNeJy6zu#egE72UV3JFmVaK?t*c1c0M9aXOjT{m!4+t{pA(};gH%~Uz_j5rW@YWJeQs(DkodSR&+X2t<GzM@n6j%)&EkcZn5w5Un$xnX$t}(I>k9kLvZ^lc52`3lZFZyi zg9-6DtHzpN<)DfeC&E+Sjm*k|slM-b*QdfEf5p*4yJ!icWV`e-Tdq4U2`* zIge9E)u5_bXZZD%K>Fx`Y5qCEc zeT?*Sajt%buSrbPj+~qzTNhTcS<*(hw&z0X;r!wj%5B36FJHcC9A2gs-p+6%*GSWL z%so3s+Z>wXj#sUuUOCia0Utui4E+UT=cD$LqG;o3;(pN3r;j&~ zE_QmY_n^|ymvG1Pu2!}df*Qr4S@Q55y%bfZUftp>F{Vc1xuu|eXu!h?G^^@L<%nm! zuWIX3#fB(6D_0DBLc`Ly{-kY_BHsTmseK2LWyJ%|rE73lh=902cx2dLIM@P}l>`a0 z>9L%+Szl%%4c&(#U2v{|gJ8dH0Gd8{aWMSO7d<&YArB&|U4Ocb(R3r( z2;st%7d!P!`Xv%qZ&qptT<}QgF2GW?h}O#Qmm9K5+(o~e;-{qZ+MJ&%6omw$K8b2< zu|(_JIIOw8UJ<84%N_kVgX~pdi(Jsb#3hBf_(kmsQ7(nj6dW&HSsMdqGC>m+ziUPM z;rc4DVP|O4HrTb3HUu7{10R)mk5r4bT?Hy}I6ma+w6bgP*_c?PC2*siWOG;*e*SYb zHTbLrZ_B!>K>PriNzdQJh5aJXTaqIYzo%f*o|DLfJ_{*m9LcVZs2`KmoYEet*pTVg z$~bh6B#eV{P=W6t)PqF##x*>^<9Alzf<*PW*zRHmYtn4Br276Iyq_P*TE1X2A8VVL zx=525y^(_+X-0!0CU)E+y;)bT%leT!Rja<%DQkhb(znG~4p>5ll4DJW61)SXwKU4N z+wbjqySt<3t1QgO7=K89RIIB1*=s)4gx08`E*rI2;17N(m49p%^qsKGK)|Kf)5yB} zJVA^X_>^T?E)l4Bj9Z8r3z2AfY;>-_4kNGi#i&)R(2(e;%9f;FN9M6|Tcf1!UFULM z;X*#jQkgNK;CMEtL^aj9GR{^Q{Rr_K<3Kt+k8OD#>lhxcSsbMPn-hveW~3owbY=g( zQDJ(!TOhX#gNW3@9nE>0DRrr8Xe@q0cFymwlNDaE8=dDiW9Rr+6ZD;n^BR4ekidtgqo15i%MN^ zjThD+hA*M0*O|i{Hz%pP^Xy1By+x<=YN#%)JpBp-Dy!GUR6k&qCAW=v9#q&tMyY*A z(Cm3?0E5}z7*trfmI3j4#~gtXFvUNIZz_7|vd_{v#c@XAaPOlIaTAo81zo}~5ikjJ zYq~9Z9BU8G_E3U_rnh`Xq?o_EFAC^v zIM%NGy8n~z&G0uh8;y2AVbrm>Ar?t@oBcO}#A!W5lo#)Mh;MW$%dDIh{|>mctar;k zJX7rs&vZ6Y#|`z7YVlGxS7=HYO?ru-MMNfu8HXXqCpQ<9L=Z8=x>|xkUed;)CX}?QK(p_-AWSKzd9#s_eHnFt-P12t$hg8 z7bMp*$%V7w;m%s0^27)FrxsWLHq|kg44)Ng&VxS+TB=}3!3nTEM(9Hlff6Qz#X;)} z^);ypPC0uB)%puT=C2R8Zv?jUbZ%C4NkVGI@4p-rD(Id}B%m*EO5ES&pTy0?fx3e~ zIWM{i%*Y%e1pZK=u^yD)Fe)8sgR`?3_Z8`Vg$T4Xb*V##63i@0`3` zj^9%Yd|59dPV*o*g+!_`g61b^JWnSD9#f+CAmD4wAM=M&!g*}p(QEv8RP{2TEZD0Y zPMAws#Tl{6;<|hpEd!w?rySfhL{vP<9PR=W+s^9$tH~`$+(g1j8;fgOYay!Z9!ICv z77zB-iGdLF8DtztJ+^wRLyVBtWprErojD`dd+w;<)kg+V+n{*I@}s%O?^dU4IuFG0 z^oxX$PeVl%>673OB%QIQT`!VJ@|i(6a_}*kz;QyD7NUcHPZu3ncql=f(N0rACZgR8 z?7H5`x`_O#5cdHyBYLA&pARX6S7uY9u`(C40F>6~gR1AuzH}Ism~0>7K~{9kjuR@3 z!>qktpulga7Xic{K6%~_KEpYezv5F(8A>&Anq}6@A_igpwD-c&1Y9fpXyDv;4`HT{ z>fJ7~kC9YcHA3_gzaaAa;T;o;gdzSwi7&5}+RQ;s zTs+vdeTxwZ7EEg!I%tOs`woSKw1I+zNsxFkjn^B6CnurXoeMj1mb$O}g`^8$W*8a% zmrK!qvS9yTZ!t160_#}(_hJyDVc&Yd06zc#K#tW~<3C>)SN=X^7t=DZoS}m3|J5EPYlWE!>%I2?z20^qT#eY(8f&NnQkaN1nf8pb9wozJVi z+N{x0EMAN~;l@r!Y|+wVK_QL!x2I$axtVZWQhdP-asV6A3U9| zH~mo*(pWVH5vUU5Df<0CxLQqT1f$5sQQ`<9P{jH}@dbZyx7+Rn!cj>6%oTt^6(5e} z5B$N|tlRSqj$HJI9~caZXtyuuw`ZDeK!g70kADU7e>K(rk9Vs7Uc7?spIi#QzP{ex z-d$&dM#q%F4>Z zCCtFaN6W-XLqkK&z)np~O-@cuL_|bLMomac1uXM{OF)A2n-~iV3sdn66B83d@$0AT z%}<%DpVAjUrO(l&PSDZO(L~qKL|4%;uuz3&P=%&ZQBhI&22fB?kdcv**sGC{kPuml zfBg7?fPer`6#_>Y2#0_O2L}gB<^c-}3j+fK4GsP6+c&Up-#|gZKtMnMz5sv^0N@1x zcme?K0Dvn1;0ypb0syuEfDHg(4FFgI0A>JyF#uo$0O$b#x&VMS0H6T?r~?2h0Dw3E zAOryL0{}b#02ctj1OU(h0KnS<0RJ+C|1jnMpF_w(|4#<6zz}|Qb$$8xeDU&r0RSH# zAMfw)z@Waqz5?U={QL|I?c?JkFuHelcQ-dTSHNa#dwF?zadB~eetvd#c6xexe0+R( zczAGdu)n{*x3{;uySu%;y|wkV1#G%LTe`X%8yjnDYpbiPD=RC@%gakkON)z(Kse^- z=l{XS?Ci|U%=Gm1)YR1ED=oh^78WZ^aR4~?(Poc+tt+-NVv1J zvy+pPqobpPgM*!&ovkf!$Zc(GY^<%Vt*oppEG*2-%uG#9fif^OG}PAzmW=t*)ddc7 zwyv%Zuy%|t9-g+gwx*`0hK7c^y1JU0nyRX*ii(P|va*trlA_|=KV+kz0F;fatSnGD z($dmWQc{wVk`fXUKoyCIhyaBoC@A>fw8Y292SkIHcZ-)7IL1D_yu85T1Du?k?Ck7p zzhn z`1tsEcwcyUTX=ZDq4mK7I*#M<;^E=p;NW0kz5PRtn3z9*{zOAV1Ii2$5fLaYprU|U zf`WpAfPer82L}TK0|0=)ZUF#Y06_MCl@u=kfcL+W!9N-9{YNGP_V$0wzd#lIJLv!W z-2eYd{Qni`NB<7!|0k56{qI2U0;2xk5dZ&%uvAS z{L881-!d7XWBMNt77a7k&0#kMK+*!p=RrXJ*7#V5*qXr2b9t-f4?mtag zqG9#QUbZME7+)9K)GjUiqo|<5Q@I{mm&7T7j^Ywz!pn!3{QQE$5Daa8jX(>5W)x5r zZvGr!6Ei3+UbzBw2@ttlbF-}gb?VS0{KYEen$MYNr+W7H+b9@#fHGW_-;<4O>2`poO{ z`R%_u*k5dIDc2v}t4B+fGW|7zX5h{ran~>bH#_$ksoAOs?*=?86lc2uBbfqAEXds8 z&C-8a2n7J+uZsV2$HY$XC1{V`Kr+jB&@V@Q zu!gGKP`lSe6qwk;l3ZKSwg+eLSiK`u)l^LKDY8xGVa@rzhrE;-kQ|T573_`k@z0GW z*b!fib@7CG_?+u*vLsPtL&un&C2rwA>dZd8huq>v-`%k$iHK(5tG~}V8J-u`#K)UY z`{9)LlXHgt+)ePomH(MDTHd1$tDnhxCfby?`4NaiT=q@P&TZYCYxdrxL99S5TSR;wW8& ztX3lTQqt7r2rtIT>>+e(@~doL_~{QJ&#=S3WIITiy)s6ctbrY|bCqvjOjtc~X$+b! zp(*+NyQ_Du*js%Ou25B>>cqw7%0kdiC+JL)3UG}I!ENIBji*h8suh_D98(kZ4A{h< zH-FFsoUvODsB7!nRrk6(&Qlb_z!Cz8VoVHk1@OP@8tciM^kE)YHRV%Hz;|a2AB}J4 zT%(n@mrf?iMho`{HD=|0C*O*MHx7OK{N5R6GozY;BEMrnM%4bf-tPzF6!E~D?sEcpEgx@l31sEgkVh+Wm{ zIZ=<=GrqTAiiX;;(|e$EarPd%D_B==4Ah5wyN~!W{bsMtb>lwK$a|ubk+@BOMB^4ELSY>wjyF`MKWP%Nn^?KrxDP+i0Ott6Ph9zoA>NE1U zWKyQ)#VUEFy_=E6;?k!l(_)*ra&SRfsJHUJlY_opBSC&E4nnFB6G9;#NFcSq5Ko;^ z4SYAE;L>BtxM!RvI4dEn`9r8&_P0*{f?o{M-pY|LDO#T9Dv8a1#uZm%GgpM*lehZ^ zR&Osl1p-6zbs_9^N{!0Mq7LoTf#-45g3?2Y*NqapLw`x!Nod+3WLrn{gffBUV>oCWk2FD|5m(*T_FVw~dac)$-Gf7tHI7 zcmsQfbaN!orOu7Z*~gE&(l)}Ggb6sQiOdJ_m3`NfS94?Ztv@@?xx&B3HP^uchI)(x z&1CuI6t2!pT>9U=7g4oeLV%!(^0f;^L2$gmeDlRwnKagep(-pL)c(iKR`tKI&I(+ zc45ae46hS)dJ3W#)V{WunIiSM&oEjHgZX{lHf`3Z1KZ_$fNsW z{bgI0Kcayx>y7}Y?p+i+ZS+?^uuC=8L5s%A9{nsQ{AS`>)swVYQ@+Bp*5lO8JnIgiV%pJBuBv zIjF-&5saQ+gBa2enGMPxSZD_-EW^@{yDUHUSTsN~jb0)jwR|kpK|^z}wz8pOqu|DF zf^C`)G`GHz($$YCM!~@XRXy=Mv7{h_U22@Iwj$Q{ulTL_C*{jIilg+XAqC@C@%6l! zhVk$phg5u#IEOkUk@@Vz=kOa?<@;lkQr^#jbjq|Bp}J~fA&1b(_~O~2qb+9wqe0kC z58dw*O0Qy)^635}r~Ki~?cr|oh74tj>1=-_vbcjU@}CQj{a% zy9_IsAY4lJZ(ppruK#|OBIY#IhiBnrD$URA9KurnZX0+HL+nT~LbAhwP(E(2pjb|# zHPu4H`XlzM3=aXd5u(-<(dyYfUl=OQ!cHkvaBeYFQasmiWyh^ENdI`OHtPHc$R8VCYGI{9KWTM^fpkuR8X?!P!zqw=&btsnTlA< z!&{A%3@2tw*}v!jQrVrWTpymT05_T9=$dN?!x1AGwVjus5#-^*AQ45bxFEq9tQ5Xv z)s^!8SFUW!iN(5<2z=%#tyLzc>CT9d`5|26z=>nsstQv6Bn_kUomBPgquq$U7Uvy# zDTftQ%e$D9Mb3U+M?ki>=VuR(IItoSTdFR_8RqFmyjoR`)Z9gf9ax#RwapEMC|k;Q z5vbQoAo875*loW22hH9AD9VA;0Pq9Po7Wb#Fisn%AewEm5xAONTnO|}Rot9n$UJ#o z#UDNWYEggl>D_)Bc=ltD5JqG3W0ozSNJ`NLU}FPMHKs>ra_gT+3QOT47Zp^**VCG@ zGgaVQem!|_;rpio-XGUJ9@p=@p4Nxh%A32DJqi^IU@L720%&6ZLGVL2c5F?HFcj_f z4eeu{Goly|ai-~5K4L1xs86OI9IULDtfazfk__ zxB-u@fvKrgYZ$L%_d9(a&88ev3>=$3pG&n$)|&m#z7I*PHt65iO=D-))~G~|>BTu3 z2g~;Dm66fcholaBlui6p24UShr)&7!>i&7WTg&@GgqD0B(`rBaQQHw$1Tt6T*8&xZ z=>I5CJJo@4eaq#)KiwIojl6~w*nM)X85V z&IrN84n1Kx6(hiWq5e{hz?ViNFA!Ik%IpZ~a8ikbG$-{7PmoC7O{Q)z*5H;+!qZ_* zbQ(4cukFXJs2v^?6DzzN0~QBvQqq*GrAbm}|Cv9#v)1R;xw97V$iJ1d`&R$u>@%+7 z)yS`-{T21u!Upf7DZhUJ2u5qBfq-t_MBHwar`yCuBz<6z5CKRdNpy&LZE|NfO~J5i zX0$wnPZ-7b3(-XoNxKwH=z(J}90B)_lB)gRQ!ndDiJe~V4wJ9j*A)l%dee}IU!lLA z`M|0$7gxMp%&fAK(onF`ODrhaX0ke_k?WiTOm;F*V499K>(uFwXrwhTNG0Cl2a=Go zWA&TVFUX*7$e72jvm1)vz83R>lZyRv<27llDW#5Vq-*GvmZ}PfrKiZ9mF9(q28(6- z2bYn`(b}xc4`&B=2yRAtMeIG>cPyHb3I`UabCM>io<(@<&Z%{c@SXEp{xpkG- z?FL4_hDC6UAJ#59OT)>)!Q-OC%X@~!zjBnt3Im>n9HAvpx8VApg}W-Mr;qAZV2l#_ z9^=#k{D#FRcz$*R0qL@j4K2aQh1FsKD~#YB5WvPw9yK(yGQQun(v$i$6|GQz^gsMC zsw*2q?{7n3qH^zSA!TNpNd1v|nROT*F+4gZKB+^urj~J0y_y*oHmPc%`PWDK@wNqc z6vODGhFV1P&qWy7oN)osTH3M!2pf==)^wo9jQpbwWG2CvTRg~gcnt>L zSZe0;eOb32>jWG7S(L2=j#@d)vN5d*X}Dv6&R;pwOoH$rUm5PasbphP>fOfIwIx?O zMDqE&~hcP5g9eMp$g&0SOGSn;*NTLm=m>wAw$?(*%Le!&aH z2ub9-5JzAZFiMbfvEeWU*l$xff%4?*#}kr$3DCt0S-^S`%PO57;?6`5D@pMiG9)sY|HmU$Ub3%ZtbhLZKJ?iE98qs_yqK#cH{eIZlleC7ud7e zURQseuRF*EUp?GtL3ti@z_ix&gK1aRA2%=4{@CRhY)8y?t5NCdAxjxwgm?*>+?Tzb zB{Li!a0}+FBD0b(rP1_x*68`6W5U)c-iadWjO_363)>t!od+1^(>&neAeQO#d%7IM zMaJBMzevE=q;Ni{ZdGmmh(p_3&SW>u z8Td2wM-0b13VM*>h&_&)iN{e}3#qkeJ+E)HVp@9Gbol%Bw<&-2YB={_$Gbd5edgpH zrSAlea|J<* zV654aPv$$u*_Xb|WBR__R5@+iT-9L$(9s%IsrHG{JjeWTOFp4^6)Um9!1lu;*@)=z z36}(7^N!GUB0+?gh}F1JCORlPkMRN;H8SL?FVit?mY6o;REkobI>*F~!Rp{*xs0nm z;Ug2&vLRt?1y%j8r|3yJvc)|(cmkTavUA|4uQ%^X;9EIbqYI&tJ=P$pj=1Kt-RrdUIHirw@CxClPk||y5Bq(D_mpLTqdXt z#qawqP?MgR!cJ7i8^`B17%jGC;s=v%?<_xW@MZ4PJt1z?4^!RvRvg>t4!;{4e+Ky{ z@aM?fLESDuvhLgOW08s9Wib#;x|Opb?E7fP4BeXK;3;drhmV#eqP;x)K*eC{AFdLVW;hLs!wp@xoQEOc;j@w@IP<-db7$Qm7_^AO!V!-(h;4dl zE0&7njPzuyRS@Mun-b(+2-99FHH%l~vZu*F7NRy3pdV@$alp7#X0UN8Lob;a)<{|7 zHO(9s`7nez!uC#Jjyn9~OyF}3S1%7Vk8x=V77g>zD$CEu?-KPdZusV%F{gPxggorU zR{e(fNUGa4h+Pf61%U#$Fr^RL_y>B;ib z?^UwcGc~cJ1NTe%l?bL$yicFmG0x_Q+sM7C%eJ>S@KIlQsG`}la7|@eP$K}y0WlvK zT_8cq4?HZyznZxy>W&4QTYRD7aqzN=>)|)u^i9&Ys{m;;!w_Nx8o%(I>n> zZ#_O{#r4cL9kqtaH_VAvenAT~)8u3fsylAC*1be(c7%OB**p(PwKqX!ItRc`Hb>Rv zrQLnN(s@^CUR5L^J^ehoWg`pF>lbNsi>NK*H2sV;J{xtLPF%Jo4bUYS4-~sbPJu+F z#R=AUtz{l7Y;g;9uthu4OI$Z3W{CDG@6kOGwcJlTGGg5u2|1ue9L?d7tTosae7D5c zc02Oev+!8hJ9BKgx$%Lu@8lOaPttS=S>MS@SiDr|A11>P(4Ms0%Kb!PKM=qWW*g_C z7Mi@1hbHhDZn7?Pbm)xL*w~q!!9i7V#*&?Xus(6VR;kk~+7!c2XQZYKt9iym-lPrx z_-uizMvGR(9IZ4IDDu!;?2=$6Y~9%yEv%^f#&wOG?&5*eU9h1p0w zS~5B{v9e9+`6JP!Avz-sJbf?2O-)(H&vM1u?cg@Bl^p+oCg4aH;T)ky;cuma(}3Aa zVf+g-E5;2o)|~t8m{gj9IhT|z8h1HW$=W;D_ci)Qh^iu0v_!D_$lItgqLwD#hAT7+ z-aEHz(Dt8+A^EL+TS2X=xRVInemvdA%g_|XT}kUY2+BqG+s>X7&aY)uV;v4Ex@>mf z-pb){a%>`FvLfHn8`?{oJ;X*oe$7aUgGSYbGbp{F?ujsz6e&#PcA`!#vlH9-P(6p9 ztv?wBiN&@#7zMqFs1ADZTn-IGACa*VcfRqQwmkj4v4lT5#Im34x_B_Pw~6D>`EJYX zdR&bE6j^`$>Y#jHcu`obb32ogj8er3IZH=Fwx9ex0ZzWK42R#&A5S!d`IPL^*^N~{ z)1O2wMH&6}*C6a7O+`Y`dq{HeRN&yEO<|7AgW74fC3i4f?h_K!wI!3={fm{T6mar} zNG#rxT-D)C1usLX>luORLO8;X*62t|VtUK7Gc?y}g=Y_Go@#ZCHgu0>kkxQ#I%_K* zu=u@`X4Y}>RIN`vy7TOIzEr$r`FO0_cNIS{%b-?n#6HVm#|ep2DJ6(|l;Bv~PQw=N zN%VojA|@>hG(Ou^yp=Aj7^@L{Anqj#`$;`P>61*H1lCVl{nrYtsRZno>+(R+t`O}8xQ955eGL~2xkq#-yu?l9A8h0y-r*gVop+fQ$o^W z3PmzvP7l#15bD1gmuOtKA`_Dix$L{mQ@53>8$Z;VnCuBYxOc4M2(?W(af-l?TqQVg zJq`QaAKcF6l(dc=^!odzF>v%dF0h;;&FUBaxH$!3wCW(HW2m4y`pJ{3bYbM5-C>`O zPq|N@4_5_`OI^5WZNfb99M--y2fhQI=hsjls>3JhAPC0>Bl0ZVXqQ7}%u7C2I#T$$ zidG`L_v^8bb35jx5}8lix*4XH-&MoEew_iUh7!K6zCIj^ac*PJ4!#F55F&IfNC>aE zdt#cr!ZC{|&gpQh&Z|<1K*%J$7gR1qm=-Cwd+-ZyLq%9xUs57;8=S;0jk%f>^mfUe zAAlE4{9b$)JHa_}TkQmwQ8QmVNX708+vY9CaNRNwNLxBK!DruY_uj*SGj0(%z^r00 z;WcraA2c?pe<~YSXmG?ah-MU-pV}z-oCaL#s~vguzo#1LCngZ%6kXBZwz?~3($tJL zacyw-B!^dK|Eg9lnn7f!SV}FqV$a^WTD9|jkN(+bW1ci|0Ls$HCj19cF%3@832cLV|VZRx|Yvyl^Lx0O4Ne9XAYCdc#_U$Z| zULfw4f19L6Cy-JtZ)ai<#=M><2d&}L4m4#AqKA_Nqs#A=Z(+3#d8p@Jis;AP?q@bU zd4gSay16h%){svbJa?JC;~IEJbZQZy8fT&q>%>!G0P{n>5e&{>@*A0zKN;g+q1px6 ze#&=L$qhA~5n&BQI#?NtH7hsRJrKgHaomK~8rek9GuB46D;guu+z8t652R@xov==m z3s^-}I@cQyk85{5%!hP--u;gQt{ra2diU9GsWmhP@NrpEbESG+F!)lQlAkgjE#1aS z8zApKS8Pw-{IT@q_y}%jFaxl`@P~>C&|p;jerRM<@}ywfn2O3t7Z6nf zz|#KBHQW zdJj@TUIEAN*W4fpNDd;EpP{)Gouh8-j|Y?spx<(uQdvxq&75hVf@)pu8^RZJyzBgM z2VIkG(fs%Ms-caFw3jMg1xyuyCr?V|stm>kVuUWA8xOh{66BYoZGM`v z4FVMjo;`FFS_V&MT7ts7tqKDWI2<}uHLEV+wj1t- zzqd>cK-~^oc!HA=@-CBx0YCW%GNzHoZ4(wTOx6Wq;@Vet1FCch3I2W}aBv`ZCYHe+YWs5k6hq1)MI>*WL1=>)<>X+eh;*=BF;n5}K%7Oz;&dhpB@nYj_r5pEP<~?q-KGCAdh$moeZXCo`{*dv0Jq}+K|R$ zuk^3UQ|{Bw)Dgo}Fw(9N-d!w(I&lh-JpIC;rF=Et zk)YXn(x*RwW~kKQsK+s&p1FImd(eM8N)J#vNO^ zHkggnX&7b7`$i6qDqebYF-74#VSV75ZZS@oAM8#2DFB|!%P`k|2K2iKJ@6IZw*JO* zJ>q@Wzdtpie%;U68PfBDQ8*uzc&YxE(FmnJ<3-+rBzxWKgwVSKmZOftVMvcuFAF@e z^eT~$GC4Nh?2yp(PhWMiahePtGkUZe0G_$6@UV*)z<&T{<~&noyLNSiFT9DfsJs-2 z_ngj)uqkU4kTtFs6vqOZ7te8s^luVq;*adY@Wbu*B=zA4eMAIS=JDgMVj(;^RXeRN zuS%F)wvyKFRbK7$oIeWb54k<2hS^PtJs!O(0zUn z&r$p#_Z9h*+9hSrcAP2R^)%a_W;GRW+_~6*udW^=^`%fK^;D)*%HEE{+g(kLF(n=JHdoH&yQrW z+g(rQBs)KIRjk~GA2Up+zeZXbJhZFRGJvt}ehOyMJo*W-7`xC4wm)NoX7b_pwa6}b zZSW`$K84(#)$ZZE2GM#GO&FWbrIcNJ8!}T59}sG`6*=?70Ac1|nYWNK4W;m+U$=sb z@`du-$Fb;udutE@HX=hy)lubWw!uHsY9&9 zV4do1waRLo>*vPB7(zGDLt5vu2w??c-@`bQn)YdW>S`pd>q41`(jR7RudLO|g<~%8 zSk3_Ob6?!{1ZUYM>t8182PW%HCU5W&F1ZgSaF%KtB2N37ydUGeSw1C)@hFDNF%^nZ zRQ94ep7YhvG2;pO(g$&)2nga+hPNxz4?06u&l%pIjrRI9PH~Z3iVByd=eppH!?Kl= zo(UQh&^2~2=Mq1KQzZqj;|7r!$Besyw;diz-q^a69gSoL3TE~;N(rAqPEimnkBj~z z{~~$lf9NY*fTwX^9GW*0#_?-MY9yYJUg?ZDrTFup5fGJT(Sd)g z9|&v;U&$0jN#7e+XPOl($Fkz3!05w0va8W7ZWr*)cax=`nU&u^juK^3`pa+IKPP`0 zo!An)zjJ+n#2Nk?q;ZvXH#KpW8l~P-Kw6gz5SwpVlrKaSb@$O)OcpM5j?!1DmEUQm zGH=DZuvE1lX4-LveIbq0wTh;H|C|eKWN$CG z%d$WJQhR&C*O3jcD6!MTcTpYoU8@K%PI6Vh-)ezmW5)2*g$81lQ7|_6^~x!v+|dhJ zl%$};;EbdiOcts`5QovmE5z%JVRU{yZ_r9=8}lm8H1abw zCVKzDYVag|0{?t^hu2(c`4{n%57%`aYe(nb^;2^EN!~7_i2LPjByc^7&3lIQGENzd zBX@S2=gk9RrdOUryFV&tu#dwD{6G@^;TNH}gl=tM?4TDbi54Owg*Fgm$@sKW5zQJH z@N~ib6ds?*hA=He69fTqKu#?jOq2)#jcyz$i;Rj&11+f(vA1ANRS3Z>E%sMB zuP>zqx>}9KFiMhs25gNdEV!8U*7E0!JTYf!FTaI@Z1BwIJnvm5f2YTE&WC&NF`{X1 z&1HHs#;U|2fdzn0{aOmor=sCaDt{9Ump-1alfA_~H@Q;vsuJqSIFI8kHh;<_LZ`eQ zL^Ch4Ovd9Xk1E1wm{ff6lklJ^<*LuF$&H1Z4bO**PA^16zd?gXV)CDDKv_=Z>@7EW z;)P-3x8JO5uP{IN+H$_*TO@~<0BDH9&G_la&qg|l>tD+G z8LK-5|xv-dh5glo65w|`kblL=zs zgBU$($8IeXTk~X_e0cO1p3kb1(pQuBS3Vxd(m6oOVqL<$f{-x^2F60RP4NS(*Vj=5 zq}R8P!+lt{y0llUw4o_+Ae#+ac8$Q-Fc@t6_5~g?t;UHb?gV#XyNo?IeQQ_l->_YK zXD(h;)>zgmn|{N0o&=18rVDc!Lj-8AH;wNCRAvJIIj_wN?BeCV;t)D)F8iJd7T{Yj z-Sx*Y`yc&&I$!Pwr}sqUz$(GYIownWhaGSeJ*Y~-UBbb@A$Tb7-9_^sP&7%iU^<@j zBtW4MuGp0qjl(EnFFk$T;x@%@Ku~w-YFs?-F8`5<(27I25gaLRd+SEx+Y0JVx%TO> zW}jWfI1k;vEg$JPZ+#7oV=wLb6@s9lMA>ysn*E*f@Qnx4N<6#>f-vFB)hO{PSg$dr z{_ew>1`##0JW4rjM=F)?E7go4PVp!T)vv!b!kaO#z6M=PP zn~=U_BsKqnb91;J#PSrkWO0DOORjU7ls`CR7BsJnZq@ysmUhG^dZkC9=Z09dbbG}+ zSY!OitdMwFn>a5^rY{%ItYiYr-8U8gy4ayGM`LDC*78|MpV7CcyV}X^kI=v=69oq= ztFK0ynyqQ;S?3(co0njXPh_KzvRnl{hTD(h&rzAZYCdGBE&outj26O`;qP4vU;VI- z>XSF%B7x~MOB4YxX>40ig?oO`JY|rLtKw|0Q+UzH*4#GbQYMXT{Jxf-=dNB8*Uyv% z0KF4Z_!ld9S0qwQJ+p+5V5Nuzv-7`RZiV=6gou$5DO4A4m9-ESiEHiWJUE;B335EK z>QYo>UrALX$tP;y{^UAs3b7*n!17?+{=Mg07*9QRDptb*ja^zG6G0Bi-zMSqN7o`& zBkq6;`{D_;V^QVx{2kC3t3E$Usv%i2^&?#{mNlcsO?DYxiE<{Qbdy$p@*fTJb+}KM zc42jC;YP?q2AN}=-cE zSM#<;k#H!6HcHLXXuOsP{bilb{_dKiLJ0?OdTv3t2;QZu1Av+gu7FbehF?roi$KcU zUqN81d3%H^rs?8i?f$K)(t*Kc*5QgAwT*lVRIndew^C`MY1&eH(VSsCEC!CvgM?O4k_hTddRR z!1du|)5DWusU4gM>G2!$7(UYTL^$|!tA|{T;Fg5^7c&KUU?V8rY$;FL(c;Ag=bmTi zC_Cr~BoYAlWIws-y+CDx+k1_`IPW{N}?RaFA3gFs&JzPr9vRsh3Ri zk&;bH{`j3*Nu#*cO^s*oOR`~8Jm;@O10FEka(e=bZ`7lLyC`lDic<=3Q_S22KU*?8 zxj%mgxjduvxRlD?Zgo<1Us@DVx>@UVLOl#3r;(YtqrBV~F3=nok#5&Cxs=ChPL~%E z_^1!Bl^)kcr4M zj`beBJ+L7$`85?;mD2^RFl!N)PW%jS1zGzt+@3KjY?ZL!w%>q}lh~0l7&fjb4`5h#-YNnXW=kqe z8c=`IcJLz13&^hpjd=LDNO-wfcL44-45}YD*Bp4eJ#$VU z8l%9QnYQ%f;wU-J+6H*kx_b5Acx}Z;g2;Nf<&M#D?u#&_n?cKO76H6$JSFwH=_#bR zY}VaKQdv+PnnfIWtOKS^q^M}@s*pTTrh(ez;05bre^2BK{N|1y^#)Cd2qGIr&w`hW z2BEx)ZT!62TtXuA=<^y4ft4#1N*CE1xW_I0aD>Z3B`FggNj6H|q$7vE8|l zWU?3KhBcqYN!Ue7koUJ@8Il&KpbiYeZj-evSX`d^KNJz;{&tj{Ykt8Vo1@zc`g;U`NSI2>BHOsERR6Q2d=ONMW-T`MRHzh_Im%Q^5U zbpKt+PBc=h>xK0K9~MH5346;!BEt#)yPU`G8p2D2wr9jtBvj$mOX4BW5~tYTdIf`UEY$#a$8B;q_ExF-H+MBgLZOQCmr zY4D9$X!4Xs(7r3Tdq(wRqB@oC0;Bn4iB8kZr@fqnlMjit$n=p1U3V z<75f$`p5SOb6uXyT6mvsHMuCYXm{DKYy^&t@b2`kNK;2&j$FF^-F*U9!bTF_;&N{V zNL%bT-l23GL~STqqYiA=3CLg{rbzLopNtYV=81gay>HWQy?t)l68KU*YbcMGG5F3{ zE@su^YpRO36w9jWruxXus@*g$FBNiw8^^Y*(8hkEuGpB0(v@yUY-7D7 z&ut{vR{0?`9V)pk9OK$97oK5hFmIbv_%F)}{N-7Mzn_{E#T&`W09%@g5w9${7au3G zPW*w_v-r#BVrD*9xxd)wAACPMrEkvUiJv-d3DFO*-&k7E((?KSxot8}1He|QZI^77@MC*0R z9kGaLZR_!wLEu6%(K$u8~S5R}bC;WPw1$nZpe~M1q-rXL^iD={gzy?1)yVTwYFJmIWU&)O1}k z(SY79f#sk;wbAsoP};NyZjMp46J0U!J+^w5WD8Iw>>7@(N{LIQ1*wQIgK>;ZE?-3O z1wmCgKe9x`kK&aV>{$VKB|idoNN*5{NcJx~*S-rg<-hC3dI`+>C9yITY){5wxFX@K zHmkc7r3Q;{w1NWZfs}Vyogm5*QJjtIm7y0xVx4bub>^oEaGx?(X$qEWTfy zGN)_=7`Xa^TA9K_aTks}W!c`q>gKf2!tPJdSP*ikc%9bS^@oQs&HaHEH zvO#*0Aef~kVQ2h7-n)!0i8U0^8p^KtZxLL~GtFe)*!mxSqO&t9FJpWorDFtZJV@1^5fC>Np1sjp&qjLuZs*@^N;NR6)%z^pxj|cpc0+am8}El14e9*LCP^=wF7!^9-Fk39_tdU+!hxL>1=y>A8hsB2Za zBwTiXV-R>NodYZqh4dC?k%eUz&@&iE+oP$Z#oMCZbVruahMvr5?t}4}a9a8#srGCV zZcyIoAp3>Wz&%rrQhkw7gb;wkfQ+x(@ zMJ7GWfc9IyNt&F}3r_sUf8Fwj?o;jZ9=VlO7F(ii$;Us5jvwqmZvjw~PeP{xaE+J$@jw3^RH>FrIF72Nf}p=9q9zhu|Y^Vx*|y5D*+!-*Bo z2oU|TMn>BEWB4rgS!M?AB|zds-o5wLH8h|Me`H&Jtl<>gh*-RH-l(G)81{u=KYJC^h%sTTVQ(G{4SzzFW z0qJ;f=pI`(IA;clM}!90P)e+kE$U(P6Fy9e2?yh^2-df-9Qf#eS%uK_vtx^hI*q?_ z{!psxwC9+h?_S0e5|(`Qv%oKUT<<`$!6Dvdrh z?|N?K);F*P%yFhC4WYY)YFYzS4Va;5mM3AF`tGScCQQxLCb28ZxGTG~T%=ZYRm3_c zJf+fY5!EO%>c_0_-+I!E{B0?$a7GkoAx)=qsq zfTx`|&qps$fZt6P%fn?`3BnQA4I(~z^+{eroJY)$$DeBzYaf9vGiwoEMG%(Qzt(hq z4O?{)z7syc_rLj+a#Z6=PS?F9`9;!ure>eoosOo zRTA>Z{FvfFn!=mv7F0s$Aylc^-poS)A>~8b+NDnr(qN#3@*5=^1tA*tJuX=dD@!Yte+)<=GYlJM`A-$~_hB!|T>W*n9ruSb^3t=YTEt zdk<8=+CwwvjKvT71ztnHX|Xi<`JcZzM2c={&sEq5SpEna*{ulCJNgyI@X=t1T1IHf za2xaY6HAUL0v_Q4d?P+NQi*F+=MYVL1O-P793lmKVg{sG6v~_Y>BBXBn#mW`jw*4> zk%m|D(^ZKm96^Sr{Fb@ZTRZo3*5u;*uRY>XubMRK5?ZZhI@f$O?$#*38}#pMw1rI6 zvRk5XpKDaT^-xDFqn_h$-3pYu$*a*M%FtaHeo9nZcMBfc*xcaL=ZT7I99$N#B@-^S z&hmBh-wL)?#BKp~enp58+}08Y;1^pNDDv_Z4jBJ1`%S`^q(&uEK6iX7tfpeJSeAo)5l)kTYRqmqV}ZXXUSUP9@D>Xwa#_S5aDPsrL;hVG?6P#2h3j` zH{u)a2H?K;*x z+rQREnm_g***LgXH^{3BFtNmcc-B7)U{@69*WZ?FVhQM`tosuX5W_p1DL8Z=arEy^ z_9^#%DKn$jyo+%`$fnzEINd$34RokTd;II{&Z2u;N+B)lmjl9 z2>NU5??u{X{qNQP@1OmkZ_#BZ?|)@^WMT`14+@RgqU?!q1THUBRCn}?^P3_BKj2@& z+jDa;XT0sHYvrutuV1^~tja*cT~I3ylRl9jfG$kMV$ioZ)u6tvBS#Remj)XT`b1}3 zc=+(q=JZF>ErDU}v`=I=|Fv(!@en&z24F{hm>3Dk}G!Hf>u+SgbZ} zi>nvBX|;KZhOOna^t`3!q?=qR={J$D+#9g*J=QKG0bHY3$-JVSw5f8l`nj*`lg;pN9DQVeXatedeNvSV9w#^10bf2e}G|tIWCELBBJhFIm z-#ttvWs0IeUE0Dp#lFgJ7QuZ`x~Te#Ax&rJ)}lRI_H)r`zOqoAC$S;v>e9>SSGDX4 zpi~BPnWIX#!&te$~h zR}9L}_04}j0Xg{J|Mr@O)RvO5`XTomAqaNWX?L77+^y2P2@H5x3piAm>goHeFzbo% z9eI{u8h$bq$SsE5R%zPsNW7DpLVNKIzH^$|&x&&r7<+*}MwuGOir_+;bB2A+DJhqQ z+b67}YE0suf+!EsP#j;`0O5RyE&dd z-iAm+v?ka#+%{Mjru};Z${fP#x6|ON2vcHgNgQWxG8iW!7)eSp#M3}s$a-RCN!}s^ zW8s2$=%Syf;Z-43VO2p@;kvNx5Dl;ms14tpnGZ;S&XRDZ*hSb4=yMQS-?iYaLfM4Q zh~46~B@s+fOo>gwOa+Q?Sdf%|q{F3yrz5l@v%o3Cq{F0xl?Td3$cE^CONUMWP8}f| zo-9luEKPhJA{#0jn1#fRLzo3a%_-`WE^i3*7< zgtuV0(O6JfzO&%nA_AF!*zx)C#PRdQrNXepA;cj>KjM+epkajGkqLhZQ!!Q$-f95P z4{@ft+EVegQ)Ho#h<-q82&w=O_x;53n7SQoq(%q(E-*0Zafr`K?Gjd22wkcGlVmiGqf|ZGvfgPaGB_9N7x3!3+w>{ z&|ea<0jUA=)(l7hOeOLV>49zsZ@_JUyZr&YjGq>D7ZHGZp*vuWUnj~9zXa?TP7l8ktLK6dcFW^2aNt+8P;c{e$9Yo9%lv0EG5EYXAe&KQ@+b;48Cg1xS<8aHU)@n1 zx=QpC)lnI`O86rrXmBoK4|s6SVhDJ5a;lkW7By<=UM_MI%y;IQZ8L*(tPOL6vaEjL zQLt$9aT%ai3!o8pctUg)p(@q0fB@^I`4#C&F0<- zg-b~LRI|;5n!LUd18Zv9?+xdm!aKa|{S!KuaO(Xvt0Qzu1s2M*{Rw7!?y*^vqdNHO zD7?g7{`imyF!?KsM`oXN{te}^i=zVubIQh$)hYV*wCb#lep_=6X54gyjrN>Ew+U@? zgk^QsO0M=qtv))7Ps0?a<7>Q+;rB5*vlL+6uU}(zc&5zzCjLhL=KjY1rd<ZZNMEG9~I-$Gx~ULs%OIeq`mzD@W{bn5y< zly*&a4K=?^@R>8PMtCLhf`(=V(*u|q(>c?$=9ZAssqH=zuqRxt#wALaRf^?^$mhZd zhtJThYyh(6(Oz$4Tbv2$M0Q?4&n*D}_IQjDpDckBwD&4U&k|YX$lWZwlTd zoJBOPugd{h<*!1@^g0xa*9Lds>GZwHD~n&6u7In9e}ld(A|X$vgvCuPOM1?G8~?L- zaH%QNsjLTuoOZTkMbqmxv6%KpKvz<+8_%4aHd=hmM&h7rg8F-}(B*^@WeF*z-W(71 zDN(fp(Pgn4?3}!|OneK=LRgbgmMqC#2mDa)wY3f4>&}KTm*^#@{T{%kZ-zHFhhjxc zpDyWQH7cIrboukh%*raVYcN}`cnD-DS2P6jXk?y`Y^D5%|MfHEs{%tC88~BoNb8Wr zx4Ho_ESg*2Ol0siLL&V>q{dOnei~w$jmeHOCMj;`L?xbVmuzEu67I*sH8HDT&hP5$ z$DPPxV%=>}iLT+;3lX-M=Bf z?`Q{A)4K1CThodYVW|@n(mXjVyhdRX)PnM4|JUo>2%l?wdCv`@DqO9vu=!7)y`7k2 zehXil%<|g8$r;|J(+bf{3h6;rhp04?=pj>wdM5PBaAO}Q z<(olchnpK?3(LbiDdXU@lWd~l-}S~>9#xt(nZ*a^<~%x4%=&R(;0b;)f)BsAvxl-v zervS23Kc$cg(?X`U9ydWnRAS2-bKB=$98b-*9|lK>^=36ls~n4do3Cs`BPH%g{$n^ zG3bR|q(hPKyT;H0JBAWLSO@gTF91H~nM_JZuGioGfS!W5!dBqJBStsgD#=JDeFI*4 z0p;V9qbc<6B=RYMZFV!0LK$zA1p96iPpY7jQ_9uJ6*ap%`_0JfvZ!AWV4=h5f6*A^g)+oH+2D<$Z<@h z%?V3bYIrVU?@t27No;~;U~y>rfbqaR2dFX3ZQN0ft)73qNo%Ol+Nk-gLzZLFbl$cD zvDNmBPONsgqM{%J#gFKbPR%YurWaNvT3JeI@kLtPcdkLG*e8*ZiG8GW>Tyx(sh4NI z!S9d78+t-^QoE+wu{piE+a-(dQc;sFz+x)BaIi`4cBsfg`Xl%Uvt47NFZriUY2#kU zMnJWpjJmIVekqf{{Hk_+vX;HheGB`Ma^sY#vRsLC(v($y1ZS8fF%L+_D{>2at|@HX zbRp)e)viQ%#AZAU@_h(a`I@&5F`tS0B^oV!%tqGY!i@kUrwh8tl6jvV^#CxA4awLW zDftd@ifdJj2*x~3zxKlYW_kqOs>b|z?)})~C{iHqiT>o*x_|Qcs0}CwT_XJhftoe@ z3=$?d4m+@=bL@F!L&_Dus~EDN50IrnqZ#tWgw!)Z@+m@uG2w{!Nn(Kw7-7MO5i?;y z3WFUC2mwRDW(Z$}4Nkz@XK=lR5luxgOhpt5v4qV zW;pqFnUCKT#<3In%M)K)l-3fawy$z05Mu@}qmT9Fg6Vgei?yoCsF zMa(lHyRskb`H+Lbkc-5S1$~H0$S^3#h(?Csw5lPBb%EHj$lt}GA;BSp)u2OZ6tQW9 zg)*JH&V-?8sHAhExgQif!KQby`NAmwVG;C+dVYJ_CD;h#b;PyrlWPN8-o?=kqjkh) z=o4%EcD#$16~?Lv`5&<)6wUF!g_7?PyU2K<;B|zLeflfl#dWyueex?{>qfY?Vf1y_ z9DU*|-@byy*HXPY9Q8hF%^S>SH)r%8=;2DqnPI2MkhmLIVAs{-HcU%}7Y2%oFALrzXzmmzY@_q{AudG1}x5j-a#*xN<@ zIO4i({V3%5yJ75gRYN~#iq;O0)GQ@+hvGwhr)2&({*tZ_L_mKY-Blcgi z`?9e9FH|(iDBbuz>j5VC@N0iq{B=>M3_W$|paf=M{-$ONl%p*0anl1bJ;KSut@Y!XlEPM4fdssnF&S<~N59?C3joZt$Y znQM}%C=D*Y_L+U9Qw?`ujyRVu$0mwv>)>-NnsV^>GaNibmJ{o}Nm*zflhUQAt9ftK zqv@M^@lckh<83AmuB^g(V7R!d8nK$_1Bn_f*^|O{xqqEO_>i7H!H^ywTk6HuHm7_K z)RUsSQ3{_I6gLo~4{d81T@)g}rO+P&>svL@q31t6TK^^I+5eN|_6;2BKLpDVlHdCN z(@y_O!i_H)Bz5UU9)>7(j22v&I;yE@l7>ulz1Q?@l% z#|h0*GL`BNti0pypB3r#pvSMJf7!JjSKP;2V@q8OhWS_L*^!4_(TfNYOXi26x@>XAcksBsG9~5&zkme9*8<+DiPeBD%i)v1?sp&jD{}R{ z=KL3Qyf)g$DjTo^q+m;=k4amRt#DgGm7d|g`hg#&ygx8wYpI-}TnF^Bq%8-|xquat zzlYz^E%?1W6nlC@6?Prc0L5jyR<}-d+2#yUtHuZO5^a{^%ykf%j-)L+0@2)mxiY1c zI2*dFl1?w^kYJ0Adk^BxN9E9e1kL6s6vD<@ZinGyaDShU6O-GC1J>c#Fh|!KQy$Jl zgoLh7OdhE$BXsqPiZuKSYt#2lnqj0*LeeISrVoZ#%@bna6IOe%1Xz!?6D;*{pfMu1 zs4yCYa^|5S_9;aUK>f2Zk#B?7*ky1Vk!L!~2y=1dCYH49!*9!copmSFA6~A963lxS z=#N|dRlyTPQ6Z3U$lxBBZAw_b-DqPQxM^zOvZLOUA@NM%pXPA`_a0oQd4i4zqY+9= z65X*%9g)mXowx>l*`TKX#Q+PSBTU|Il#8IN7#DL>`|Dg`O{>;`{}^muqn+i5xV^DPW{gJ`Cm_VJ*9dnA1nNFK|VZhNTnMaw@O zX|97DZW}{7%&ecL;v%*j)ED|z^()K?|WoA-#Bgm zsD4}ZOm`o++mP3fc6!uo*f6y-u`!=xwNs4<9qq&NFnf6m2tj@t;Q* z`1IUF<|-Q()SDq=OYjdKx)J8EDQ&{cNV~nv_t2S9zdc0XEOjP{i{tHx^mwpQrk@nE z`k2J{zox5J8*``_XtI=;HZR9=ADH|g4+ojN_u;uSauP4$#R~3T$`}pGw2TyO* zoE&BaS+%1+zE+u=^5{>f+KT(V=(BG(j6REb1xOk1s7aW&vczE!rAa-CzWasxVk7Z; z^B>hplbE;4U7m^6vh+4}?RvwDjC-S4gO}zRlVLE%d36h$a7btw z#+~MfU1_aDI=3C+ZkJ&dlw2y^Po4e!P%mYM3_)MGtkA`AR9>p6)ngvh#9^Y%%j4<^ zOk{HvPmc=5Rn5(ZsaA2V>`;ugJ{M`yT+Kj~Y2{Hc)$o*$eaEKpjaJ81%zk~xW5;@w zk1P#oakWusm!J-q*>fLKnMchA2pac}kd{;R$1b zDdQQ>wu47#6t2vav%iN(;8~OWfU_zm9~OyhFRv)r1Y3hX+o^_P-}S+v=6pcJs;bu; zZoylX@ZuLV$mN(^p?1cmr#Dl#9%J3CQSVl^lUKW!w#HWdaZ+d~1=hTA%BJ34y$p_m zdavn5L`;i3$_?=V;KcV z2Muh**UjJDP&)}vELME?GODJhWGrfiva))2MQ5L^rSYdP3iFXLMp2VeYxXoNUb=vb zO z!>iGz*>4M91~Bwa&$ZDVu;OXZ!IO-{q-)kmfti?Q`-;07tjnbgR#qY>K!)B&0Ry4|n#cvTWU{xeO7LIsebG>6YX~c`L_d<2mxqPy83r>7QZWe7V zM(VKZ4Yt22g<`aQ1#Wd6^72n@gmoV3HUVa z`9Zcp@nY=e(Jw zIO~mj+{|8k?*K}$NCIP5kf;`}XL@#odvG8Rujg&Y2S-~*B4pFmwZ1mdfR6zzhWi=o zy?Kl4D#e64wtzlHN7(0`5B*Lh=Nn^Q7ePjn%VAPkFLp-$OM^HM-rqHDy2r4G3oUUU z6sUL?!&U7K!+)o|$GLx8+~2gOnhvgSzsqmM$+&3#!F)q~%=o$PZZt6NJN@oOS+nmqtkIUCuKbmLI)%FAxepbbX zZWIE$Vdp&5Y$okZw!g4%Oo^2QpDkKv=9{k;j_`!542`PTBSemsDaAhyG|SF7AYCvwYaXTX2cC0cLtff+ zajV?*J^kl1y5hy8t=QLX;+O@=5%Vc@R-mkq*nIfXlxYPtuvx38Jt$u7asZ zHcngzer;i$*1hRkZ~8d*s2>LFt2NLE@w6Ao$*si`(&-7#%40Ul@{;K(bM(bBV;t1X z)JoJkMSMhNg~@rzf#|*H7?&abP&I)LeP;idxuCYdOZ)J+ewhE2VnP6fX#Bm~L6!{K zw9hOxn|D#(O1v#e<}B)BIBZLXDt47zr7PBpCMo_EtpF=lIOFhFV+Zva-WQf3_^Gec zke~}({|9662hrxwa_Va8O+&`ID9cvkT*Zr2bRX$@w;=+xix}g|=x&*M4;puo`iNxS z7ku4+>o3*s7zBH6UEvycH2R~op4i8HK=6%`8~TLaRl=tsC=) ze;2F49J0yF8P`zjh{((1aMv}{aIc?bkRJcQO2VjPPlwA1AG5ogGtGq+iLhJjvVMNS z7w#4W)daBntKJK!&ed4*E8yA^_Ox5J;niP%2wz$Cj~+~#zHEnuUZ<&BXrvEg%`Y$e(0%0kvzx&cpE0DjF4+vp=p4K8E9RnBV%dK1D%8@7PNZa|{^HJHxr}jFj0!KvZCW_f&oT zgWpgJgP3a<0I^xi?7ttAoEKaI7EuWA&2cj{0o`F(I`x&{y8pKXS1eTKbh_8b*0JrE zNdkgg*_m`j&@06v)qhKHjhYO?8{c-BJ1cc`Hr{-W4tyMu%rwkLRooSW51@1Y^^{vw*MKS!=Oz5!upByVTCZ_-CxcEQ&cG&+ngt)aK)@NXGLUD755ll%ac(?A~!BC37 zz=^Q~B3L6%raGh9{-KxjrJ4c)!|z`>^UHFG%l~xf|3$Cye;%5JlY{GjX2D!c%v}GQ z`sYI3$5C|=8#J}mEd?*N(q*`-?6aI{=^6w<<(eO8<<5z^B$U&ETec;~VT1+^8JVK& z6#Uc3oyd_)-&J0akKQmQv9zlv@nEima|)II{rl_h0-}R1`?LQWzuc|H7aLMWs}KHmuo%1hc;wzQ4du(9 zaPK;DbOcCIbGRZ?PZmqo`<3{?cTS!@cQ9gRv>WxD`SDwOCDN{9l0l|{U#wv@f{I*S z{0B4ckcL@x#T=0mT}p$eDKi`|D8WaU{IO_93f#H7PCoG+xfl)1C7!p&A{TK*drk-s zfG~m>$uCS;jvbc2DUm+MGKOBda%(csLhL;F=G3FrLtE#AL{dJnxPW?Y`At z5vP&Gi;_H(1BA2AzZUAsEKW(i6ZFD2K4~wm!~RSzAj!O0kx%K!3l7*3<{Qi=q31yb z#nyOC_yI9WIMzgZi4ZrT#pJBXFY|sjVf6eVmCm#zt>T=4bB)O;k0Sv03$#8l9CM(W zT%u_6Xx9`lO^&Y8PP_w;-17%7|YiI4@Y9>d)iM!}0!;gvb41PGDmXY%L^< zLvp-`MoQu6(fS->&keSIHM)u~#22qfUtKb8o?&f@<>VVe-OGN#o!S!2S>NjZvcoC) z;3f2JCltzhaMwHPmWG_FnHU|u+q^ge-EW53Y)~m>QZ3>_zq;ziM_nT}Cz3K;#kqY~ zq34zSYeOV`=_c@X-WJgh+8cXQ0yq8lpBbB`Ol~XO1Ej!L=xkH+_)U=!O_UGZzXuL$9+2ouHVu7(-jps0T>3aM4-z{opx4LF1E#S|)Y}Pq7WSW_{Y+sJ zeM;}q2rI^f9bh-o+jw3>+)mOd#P2*Lob)bZSN8=P-EySr7rk7YPW$fVdZsVH)D{6%Alm(K|znb9Xn^* zJ(tiL*^`9-fNuU1`nd|T;+yr&`Wlxl_3{VuUu+ffRGG#8W`8!-KC*^=3dRw1{9f!o z#^1Whb)_$)kK`9(f0s{=l*!q0!N{hOd+{xMm;Oj^(yR0V{T`Klmi{W0NUuuoNf+(9 zJw-kzKSjswbLofl=*08v8|_hhwf(TY!9G{M0r)I@t7_Q z*VR^6tzK1Ad23*0#fn?XecrO~m)^X5+0ySVS?u}lqJ`gCFn?Z2@!UDH-8bD>bi?(9 z1=@8k_1o8eYnC!|hI9I~{Jh+pY{%5B%#11N*QBMU$acxbXf|_lr#I+t<1@TE&(M6D zL**H(hAWFX;8Yb9Pk-!v4~XP( zg|OEI`Lzi&6q?M*moTsfC%Cza8IHb;8D1Z!ygtf!pHsdN8}{IzjHSHD4M!Y+%+sit zv%HI(<#Lu^375y45Nbo7Nn+rSv}yiGDh6q)774Enaw!afK9UOk z(KhHZ*Z4uP~kav z`+2sTXF@D<+lPu|_?@k)Kn-J;$`8TaFgTP)77N;c{D8T+`pC8r{w2ReQ{DK5!Fxi&~6C&qndxzATAC-Dx9e6a`72%p=cO>;bJ%f@8d3mG3vkQ3B}FekC&I$ znJ=m{a{!B_VPD81Spp40O>lHyDCCOg9ilw7aF;w+Qw?!qY9Y^aJ6x}TH#lc@peE?| zDdz3D%^O^H!KqvT9H>f?nG-Tb@dYIwqd=_|sE$`bG_mP*@dmafGY?Tq-aPf3Q#luh z*9ObAa@{b>HMQK(jc|Xgt5H)On$ee$VRZO))ogzT`pIsEm-mFYLyxj0W`@LZs;Is4 zngGwOUL#Ufu13T0!Ev+Z@+hwCq)gR+V_Q9k>PHWVo--Wh;ae7_lcJW3QPYnJp>T&s zv@9H|527cU%=$Gq^hzxbS47uHp+bLatraX(rd2#*23A{C9O80`e(LTorA8pUt2!9R zRccgzO{K+dT|t8NwHawO_2nY?#3uv%BQuA1Xrn(hHJSxBni(5*@vdoAl@5Q$EHH^?|NTu+J1 zXXj|*hQBk%n>Doy%SB%)uDHa?5YG~`nP;6hH~6b~gDNHwI=9*cRKFS($>yr=Ge<&5 z8B6Yu4e35H0^za{QLGZj9uMvKTAMTbe=YPb6#9;yP;?1SDZL3dP#40i*)4TJD@q>4 z>L_8WLR@7$KN-b@43dw=bMcayXPhY1na&HL$wD5e8;6ZCX7W7A$xs*MYCF_zPq3w@FOQH5Xq9Ha7kM#{|p`UkT7OgurG8 zXl#s0vNRcqls4_U6?IEsH~Uf4CF#1gQl^SlYkpj}n?~Ag-KuQA!c=MMwEd`5P1UAJ zjk@m7rZt$o@41GMXtVD1z2`medC&8Hp9?P{>Z~Yp*iL{!_Ldm>qU*n!RgVO-qB?ICN=cT{hG;UVu)}kTcr4Sc`N2*`nb8TTrqDL~ zN+Pp-v?Mdj$Bt)iTL}@CCo*rd4BMaU%a)p8E^}KTM5a_0sYt|ufCH2?4g(|Q_uiHX zS){W(CD3tUjUkj~+@dk0u*PaMtG1CuH|@Aak6O*O_LP## zVyF_gmcCFI#57S^F%5|I)oPVk>{HERAJTh~-mB5|NH>UmP&}Zt2v{hUoCw7e+E<2n znJg9nOg1(ktZi;W|5=B=S1+m?{#0V~DQ79tw*J5Mp_ez5*Fa%VJi|265BOX%rv`aGE?McBy(vlc|$% zqexb-DP9=DW?9WhhH5}w5Mip26SNpP2C2+TcvX2dN)gUP zyi}xjmA5iUwEAPVRH>#gc6tMSH-|wWT!w5`15Zaw6$aSbs+s|jw8NB@1z;VR8b&N| zEdf+y{SAsax<OOk{PZy^lqQ#LC`*@H(8TwR4pxwYqyrKJZkWhYME{j|u zmU=8||Cfo`!Gy;}DqOMd-x@KMk>*}SJ^AqP)b?-)Z#-g$E9XaEqK(F{e$A^s39-7x zfydS=mWF7ko%0 zWC{b}1cFccUZu^sdJu zaP@xt$Mu-a&UjK0_*vJj>$bRcJ!bv*chPpHBavp4X|5w7iH$X^LG0-4jK_Se%L#)T z&gJsB#16*hx8cnu_3qXtkL0aAkQUmTcA0YB-|ZhNr0Z*&x9_#E(#yP#% zD0L+4_NI8u&A-{5Gfowid&-jwqYJa`xt{mde{tvZuNnQTQ$N(j%3plrZ27bD{tsS$ zvF%K*{AuD(AHKvaGL0|05km^>{af86SUW23YHrqtRvH@guBIkqU7c^mx$5Ff`c$6M$S~mR!!3sJUD;OVVz) z`zP*j!pvP6%<;B{P^f(O>GwiivA|S5V+kbhFya&G2GPn#qk3=qV1Z-jx}p*nEw3NW zHrH%?QrG)f`FJtzK?6#U!t9>_tu!vFUaIFL8 zIDqzps|}nUv2R09ih2Vha#Axqxrb&dS~+x6%zm@v_j+A#S&VHR=JJB3%jNo}nufFG z)Y)Tpx3jTz-i32NuIO1+9f_Nn;sxDg)aY!P%-#R@{=xdTz?N?8)Hk2o|FaDn`|ahw ze)4`fcB1FO9LEM9Z;1rB=>1O6w084z-UpEqCVORPINWNlYHaj)yxdA#tHZnEvhxI@ z1ujrAWs9SSqU{bEEC63>4znEz40X2$yu*r(n(`RC!-fXTAu!BqMJ!R`}Fs}(=#)fjO8zlJoVGrUB2?>WWIIa z;-S&=hX>AFI`Zrb|P{=gT88o=Oj zxZ(^N8te=NbVQhKPO?UGDC*?utC*4`&6$}Wn7z>+d1LW%KksUbn!%>J*3sVD(T%1t z&N5h#CalpY?>~I*%Uk@^ftiFM3KixwpqSy-iJ!!YBs)pVwFavza-+`etTvmCuhqI4 zE9nI&k$9ZOND43|Jv0Kqc1e$3%d=#2<;9Lh|!}Mu5km z&|z3pzp{@2x1-lR2KEcq6$ut^&X0{vT^{Lq;{9_g*T-J@{l&`*QTFa*1C2M!e_oz1 z436}i%H4YX3`0K1`TnwHJ>7NEO41}G*R?kK{l3=%?mEWxhMQR0uT@z|@&@N7TNzfd zWVAi7(_H^$yXs?`xXw^)i4Gb>I~6ftX|u5*ZJkTCiH;6!E2{XXlU9Nj*eX?MBQg7(&oGr$ zKgH)bk@Y^$`@YZf{EVrjG=(Wqx1MBH`wcD|uoUvEN7SV^CgT-KgEygkQ2*~TyK5%f z0J}+5W5}vI0fbS=nbk%0l`LyI$r(uh>y)|z#?Q(iNJ3QtmH{kFasYrBOZ%kP z5&sV)!3{AF<|G3CO^U9k~v>->9yRdq>7|+STW<=f=D~ z2NIVrEWswXkFCo*Tl~+KUrEp!nw~<4W>{SrU%LMO`r^d)VcSI0Qc%fapicGZ zr%(%EkpbvqHy5e(I-TmKMeV%;&7gNnlNx1WrI$z;ca#LFtga=Z+zqJY#Imw9i?bk2 zhV(Z;H7$cjtZoxYD|{HPGid`spC-&L?(7Y^!Yqj(HF70M+egO7`%;|U*W#)*<=Q%( ztyxDy@93^Q`x$GZ)nB`>5!RdhB-H z+_D7M1I1fw_7dcMY+YkvMIuT|&a zjI=4J9(<+V6DDDTZQr-|%*jn{`D9w3Qu(_Ab#Ef)@52?Dc0Co(`ZumnR5%-#b$qw@ zx82`^l^->P9B3qZeeU+(KObtc8VK2MvqvGY<*H&g#sX9fyjUN|X{SXA9cW@O@ zY<`-vS}j){Gw44q;y4(j`xi)CiC^&t_=htJ@?1jyqeghSoia_**Fqm%C$7~L@70TsXd@E-2PrXU5xXDLVy23ScU z5Gp5dDD+Y6R`eRkqab@+6CIBc7<rNLL_}*#w9=x#d6+*v(&s zEe0`>BM`&@H3A5^IvestxWR6>jNzmu>?{6aydYG&ob1TJpiJj+{E6Z#wF+}}6i>JIN4v*@fk5=p0VmA|(Gxf#eCf-X1% z5M@D9y9yBH0U~*$gUj zXGjODFj>r6MYv8;e3i0#IF^}`%d68Wcyd3IgFCT5%V}><*Mc*WW_<#dPRrC3*);UR zfma%;hKE)d=QpF5vcK6^JvzR5U8k}1A2{Xf?M7~Tn%RI8&dl#d4@ykn*8me)C^l_@ z{I!KTv8T#lA;9|zdOuGWDDc5WML{Wbwsa4WS}TSV5j847E5%sBMIvs{)^A4-bOxgo z4kIJjw81nD@1Pu>N;C7t>xr#nLmmpJ87(O{TUY}n!M1s9k72J04G*kx!jbIxwJj%( z>~x737Lh9dvW|KB5Uc}7eSllGZY1hjzhl=}pIL%T`+GYdLw;#t{_CCPdA<%X2O!7$ zegM=ys}nJjvs&=D1Q#G)0t!wf9248B1&V?Zf)?B+#GQ77D}^Ao9snXfq|8+otwy8# z{SkY$%Px4?u_aj3(oLwW0w+{P-hAp4g&Za=0fA1-iTg*-A9X-)bKONdMcCA~{qAKZaSgo3G1K5W6n&D#6$E;@%U zKpx0G4Myv#yJ`lLO&fvxeqoux^lEHXO!bQM(L-7v(`3;#lVMffk?W@q|JJ1T2|KO6M;+M6F;OgDMt)dSG zixb#Ez+?n!gJKs$g~$x1nsyp2HNb$t6f|D3h|DTT62GDb@5;I**^ae#d`E6I9Il{aE*jxO)`FXPn$)YO%R&wYiEkPs4X!Xpn-9wC4P z6G#jRBnAP4JS2b!5FvnoEKWt#qV-X`yREEscRH@t>d-pEqO!A6Tf6IaI?V3u z?AYma-PzqbZW**YZgs|~aHt0L(w>(y#)^z&rj{)0nmt$&_qPIF+dl3*9Z44f+#+GL5z8Aw}kQF2kaSls$? zYf_%Zw3E{76!tuqEls%XGyF()aZEsh$!(A~m92{BjqTy{{%g;~)N6`sTTM(7;&}|# zd@Feu=s@BXQOtal0>&a(UeiFQOPHlrR6TnZ!jcjbY?+%;F&WVW<)Sa!wkZ1&q^WN6 zrd5OeLc!ofq&-g&u2ia|r>t0|g86WpK*T4E){M^lPplhF3g3>zniQN@qKFjhv&*uW zZl*pZ&zvT+uPZD@byUJslJ7$o<-h=9rZhL@GE_dPH$!HidjJ^Na)-{rNX2DdF{y*q zA>-JfqChc5jANm{n^QI)nd~Ut-fV>z%9n);x*F`;Jh>@!WLkl7P4lJ# zrjmGf_h(~;s~Zn(uD$T~a7_lLRAJZRi;LF9So1P#hsNGqmsw@kW_Zsc2d~1NP9^6+ z4A9S@O}{LnBO>9}T_smv;V*>5Q42h7CQD(2HDLxs7}YL~l2%p(7tAr3y=eS^h521LiIEPoCIYXoCnOrP13!@vx7N{$h0>=zaQ)*j<1Lc6VB%ae z1L8=jQ_Pb{k`;2f>~>fJKPndT2qr#$Tp-_=V4J~D42A)N^?oq>5!x(tB;s5jEeAgy z%G3BaCUcxz-bz3Hz<8nOV6VmJeRYra@aWf7eJ5%YviDz@_M8>aac1VOW&5AHM)wce zn|rr3{61@yabu@-{qS2S&+I}w`g8vRWhRwC3o~ijbaYe{?N`EE&1FF7=EWkxRnk0} zzDRKQ9FqwS1n#1f$jw)20_q5hV(G56bXSxGZa_RdIFyML@5eiaUq6KjPro{n(p>jW zxX`7quoZhxRh4h%6@^!p^-eXp*4nnemKXcrjop_f&SMR8$uTbZVzaYQRp@lMy<6I< zbxLfi&{$q@nfYp@%bRm_Zy(xqsDm^?9ZL4BAm(FXYn!LVB9UM*BEWvdS+RoFGGBBF zP!PmWZvOU*{neZ5-|jE#y?5Zu#e(-Aym9U=8~&uJ;yvceL*4!E?%IKY+4F5r{yC=g zBM-0n7w|t*lYjskpqo^Fp}I;+rql$cMifM0VWED>GKE`nl1J>h8gF@?Wr1{)Xu`*h zUz?)B!(94G+XiTmr%h8L;^(@;v6xC~^3I(nSMpt)B|TN;$FZtxyCOkNl!%}gGmy_5 zbsBa++_W?zLhPsE@{`mTyx)=%5JGB!R$-C4fmiJIH$9%Rr9fv|-O0j+ZuG7973=_sCr^m&Py+A56hFKc;U9{y!=B@{qPAx6kJkd%rpr zvlbc(rEJ<*6C!H-)cZGF&^YVu>r&<`_)w*t^}0Q2b$nw^XOAlaFFKsxQ?hrro8jXp zeU?IJ?s{)idv$`68XdhQ69`6!2X9eyyuvm0zf3Hm$ydaC*WJasdp^(81@qKo?{Q52ZinQDf4N;^2R|)&CfG|h#DR3 z??M`C%=G_jc%E)pITwp#O5=I_9|C^$;d~ z@?UUW9k786XK3OLT?D;qUW4YbH=Px-?FW(Fb*8d-+r2=iVY_&bWMqbIg0HTSC#c$Y;w9%O5JX= zL5lyEMnIt=&`7RS9clwSR&5 z1nNr$X-=V9AV`crlT4S0gwb@=yeu%uOze>XzeS(}3@Ssx5wVslklk#?w3y^b1ZwUi zln$U$n1NRdTG~8aT2INrt!-C#UjNk8Ncp`5cRtMODh^)_d6!AM=> zJEfWTHrG`b6?k%7hs!FDdeXmzEYCoe=O`iU+~i9_XnMkL(1isC0nIc}tCfCY#kdWI z6s~FmAti9O!H5!Y+Ct>?PSlT#hO_a+ZPuqvSg?*L=4V}+EPLy|8@sj)bSHUJajGK5 zRDFPXGRWlbskY|73A>B&k^B5*R5uU;$y6x8gSVG-;F!Y~&ktVP*2ZxABM{36=xgTgcnn41PoFez%KG6eBJ=@4gC2v zFocgo>;x(*H1MAHI_Rf*A+o_Bc^C|_pO3*1@fi5XS>U1!pqBhAkcTt^Ir&pSlgELS zECCJdIxhj-kC`|2eRHk%uSX z`rm?$WE03B#( zTK>m&pzi|-;RQypePU&6kkLmAv{df1Vji5L3MWwhB-hT|s%_5MPi@Z3bEM7NwfFNc4rc3U7tr3E ztV2SyP!)bnzMZi~+`=4e&GN8z-z0oZl|g^@VU2p&x(2W4Lcg|$fUSL7Y!BMv_ah;! z$Nz!&R;%;FaoJ4R#M*sKeZ8iJ9VzcnJ!fVL_oqIng%SkXEZQGeee@e$7j98qcpJ|P z>1TE-&(`99v5LccSd$91kJsWuXU=2?b#Oa5Z#K>$5O>L8{(KYf-v(W3KK@tC|F$rf z@FPE;3;mpG)h?*b?!jIFy}%{y_2G~GoKyKZALM!NXCu#T{%x@}_;w~3@toXR<*_yU zCVma`*jgR}w$^R2HE)Zpe;)6zt>LB2@nc=#%GEb`NaNgajSK#vaj6e9H26ZLZiq@# z&uVyTlTL6a>EhIr+@+lw?nXjy`j1cr|E&prpy9z9RRt&O95hk@9ZXLAf&=Mfr93 zgZ&>q^#9j^^*k#zC}$0x?T1#%zlJAxw$;F&g$CvRw6|iHP%o$aZ|t1ZTAj!`4T1HP zZ-_(f3)ZQ@Gel3rX2aF028J4`=QRZ?^46ue3#qRx?>Q&<8|&Smy0#Dxzs`pm7%b5j zp~%y4SVElOT6Awvrd6p{-RX|eCO9i^gKgRk2QBAeJbY!Z*YL2LZtzIggqw&ld3|v? zY*C@l&6bDe=d^>*x0YvLBljoTg0no`=gsSAM`MH&b)L_Of64wc9;}(BE8Sd z{7iB5OEkmH$kEjZaq@Yzi+Vpag!Mlfdms0#Ne>f;=7z^)-yvR2a?3Q;6><-+$$m*5 zn;Txsf6KKYyhwvtrw-H~i8fg7i&j);KpFYcn@`0bOPOT&~l+{u!kO;klfJd)TjL^)USqZPxK_ zJ<5Dad$ZMyLtUb9kn#*38?zzkN=@r*&su6yo;%Gni6vlZD zjnmyf?`UJXD$2uENPE4{|A~f4^vG#me z{=C<_?bwwnu>FrWtH|xqxR7^y?uVyU;LlWY)()O0%dvKzI;m$=ts0-dUu3LVIx~KT zcR|!g#qkyNA42~xH7>r5@^YPMW0Jq>qme3hA8D-5Wl1j1pFgi75+CBloRiEE`0QQtBPu?Rx0$^a)yO#D7$yL3}tp z{xf&1TJxf`x`##T?rkF+#n~y+LT?-OfZxY{x`eht-ZpZ_=4I~--zFCo>2&M>+6vjP zM%SR(hgA}%K35~p=91gaau4f#_bBnLNd3_WSBHId3vGj`H&U*%e()=p2Dey0co62p zoxWd@CNst@!8_{h-c~QS3t#GpNAI%-)tc?z;C+q!e+;pkey}02%V8L-gj->S@7GAI zC?i&tX+C@pWDoc!Z+MztP`7ietskUE7U zw2Hh{bEy9M@1sZ2LieJ5u4H{*$Bu>eu!j0xwA07%cVfvSv~}Xnnf(-Y@cin;u0m(E zYND%QuV3XmV1>FyW7Wk?Qg>Ge-Oyy;(Kz3g{yR9I<6tTA$mV17+?(^&=HutGns}3+ z%V;!-&0{xZo6`l%!{)M7$A+^t+U60iP+#=MAa^VKc$JpB^K_EysmcQr?FxLMso(m;Zw~ z*td&2Q4@k*+6aBzFkNqidsUk+dwS|BXo3Rh2WP`YFbT#$3H;CALwuix4(Sc(^GrMH zGoU4>zcVx8GUx@T(3ZjWz<#NPnQfFyD8HQWK70lfX>ZBtaj)^SxpyDf32T#YgXa=` zzbW}HFzw$tVF7HE_CJgLDO|_@$79JyneNynrtc|_N&4@}eUBVyO8osV-n&W0^joZrIy-DTabag{3 zcSGMCO`oOiX7nlg#Qx{j5kJ?dlrt>8C&U>O-y}+nrZPP@L*j0=r$k=_$Em?JsexG1 z!1;VU!0T{_n$!I?Dmt4!Eokk#(SB*_9W*q$UG3u=(Rz<*K~#qRe?%40v%1OW`hMt? zCFs0U)Eu`%YyFFU+tE@#r_VGEj7Dc)4=%~R=f5-1uu+MolUqkKzmn(-jSpYYJ^0m) z+}_*0L@qx^4e2X1B`W65tl_;iUXykTU(yP6e@`Qvr&HrujJ1sQ+M^cYWR07ct%~Z^ z5-rk^@g{P}Q@S#-BhawkMt!vyCL}Dj=LWjPs7=qK-yYTFZTtbxjn?FSt$NhnW8ZS| zO4?UyNxCcl?W!q@c^kFIF4D|+4&R$|^!?~cRi{hz+qhKoU|8M{ z*PJS1&qsW%-uxf(%Qd*F>Wbt4oV)iqmjDUaKoTWaB?g0Fsxbkgi2+0Yx~*XvGK&c6=dVtCfmHD|N8r)Y8a+P-rPAiJ?TPBHBtD1ueI~b8eDB z8CyTMAO5rUW9_}y+Iy|F*9!EgcdymdfcmJ^yb|cRK#hBtoZvUAgl_O@fL3b4GtsWQ zykz~-&C;`=!XNVpfS;YBUOE|*zX_2dsX zVm~YG`C5s6ub|x+pjwUY@VFFmib?jAR{8Mru~4%bLMyZs`%Mq<1UYGgTI?u|3ou8u zPMKPqD7o^>YQYBc$n|r;5L=@seVEOv^eR;u-v>Q+tJ+(u>i8n|=?xOV734Up^{5YL zo?fB0+GLybeQKXo?hs`83m{*%N9fnWf0sr&$JIpL`om6H&%%+f(Uaf62mEttj>pU=8oP7_0zue1vng)Q5LUnc9e5;A2Pcz;vKs`Ec3BZ27Jq9-UDt_>) z9&-Dr$%p*`_%3&HI)-k?VsM=pI>&9x*WTru?!NQAKJ363?9*MVoW**>eVh0A6n_Bh zQDshRqnU>fp2in_oYD5rfUaU}6@C(<2eiW3r8Y3Ai?&inwrX~_eP%(oeLCv))<NwB=DJ7N;{mXV|I35Vrwf?NQzd`kP1wa`J6Pv?JCtEgsE_$X=b4Sz*bEh$gDMEM zXtsF|{#!Jgzwt(MlL}0mikx*SbCxO1yi0qPim=Tx-lfd^JmB}&&gCC13++%vD4uxs zp2nC`rMZhZCr7>fcIX7>_l};h!-;v@`4g5yiG$_{e`-AaeZ<5tNQjQMs~I1mJa@N- z+CyNL8i?_EKDDXL~IrJhqZl-F3xk;S&frgrq z>`^a|yGji`u3nsx6)I49=rFVjl!FJj)85MRYa?d^dHnm(e<}-^vrH=UP4M5>L4OQ& zHIRHiGjvjo{2xQ@SaRh*aA(t@w=rH!J&~?b=W*yba{ZmqR3(He*qeVP?oX<5Drxsu zY24eIZ$6;TTL8|1Z#?VMS@S!kJF~Iv68_r-&^M^pM(N^EvXZE2&ULmy|Ht&{vbSb% z6r1tw4g2tI&Cchq#@>8e!-f(&Z4DcW1a|goc-v!q{0o7-@%Lww!%XsR%}rGm{+YnO zo6Sz_>mWQi;6~(GkDTaavay@H(IrVYoAH`rE@B?N%sJ@#4u0d?+iTQ<_cFGLHMQV5 z`aP6Fu260^M)%sMXun0fM%AIMoU<9;$IxLB`9YDUyVJOr&Uc##W^-@;yK&F{oB40z zznlMNyhX3BH)~XmKNs+HzTHID`tSCHvdwiW_1}!Tp`0B566|0?s2=&&Gky{0rSS&q zG{MPuKv5-sSIk2vB)>cd60D*bRK+>P&@lR zq9l`rUtI%V0dv2Cu4S%P7Z{KBAoO0t`u`I>Z83KHCbnm(7vi9WpdTowUqXyr49cUU z-E?fUL3v(@hPp|C{Wg&A;ieSBSzF|kt@^EYHT6w^1*2|k;vnmXV1q6i4|rKa*^*l&+2y5g1$?Tp)Wkk@ZSsZ zL-etW@w?9%@6J2yXH63Qhn3>?RJk1y-RlmcJp&tQ#t%<&P9f{RM2CL(;THVxl+wL) z-mV(G_aIv3=FEm$K=&8U4ZdFe= zLp}Jv6`muxjm#gVe>Zf1itRD>+pin!b;!SxTH{^%Tl}$TJO94I!{IvxUP8x{@Hew> z37D)t*3U;if+v~&PFeeBXsuGb2F`8c-gBtq<{~c4loaj>&p_H0iuWp@eWh+o z*dvAZZq0K2vFDZLqO18m`|Lsfr;zuj@E{NOBe#nF%V4aE$+Kh%nA@0HqMXue@#X2uMlePWXzmj^+L;lI=!+z#2P_6!M0`nj|0iHp!*pINo6uV9N z?q%54ZMxbPQ44y$6toPGkOhI~O}kRj#*P zxwaR!u^l`AEA{Cq4R$`p4vymIIjVLR@b?Ix@RaQgR*r)V&SrAFft-B7AJU)%O^*PPAcW9)265E@qzTvCL9p`gb*XbPdI(C?;%cwbK*Q>@k25XAQ zHxu2X#LdU?{|4f1vBr|`<-51wtGhMLycD$NzC4@YR1aUarAW zS7#W1vj59&0>M&*Oj0v6P6DO|heU40&#9Y zm|7zj8$qVf7>5=l!jKRVq?Q)wkP?&uby}sB!7y%rXUXP6KXqrGdC&ix_nbY?Ip@9I z>z2{isc5?rIaVXEt5~~HZTOH9>Yg_4xQ)ANvp?o8Myky-)*#ew*U*1XZE$FFmVlAm z&8#lDjjqY9EdBCIRJtqIK$T>3A z5Eas!QK3*PIjLzkU`Gw6-+nx--(cpDcQ;r$deUlFUdEwQ1S2cDK=dRFwoL7w9FLaT$M?2Bj)#dqb^)@P z@A1m=%mlka`Pe{~HD06L11*^QDQFE@vzfa{X zk04XocL{48C8nGS$CU!>WsR}lrl!c`Kc<5H#K~!Q|C9U4GX3x_VEudS#pusxeop8% zF@6s^5F9ADSU`S_F3kV>vq?#re+;P zu4U?1>P=I-!eP0oUrp^wJ=-r*yJAa=!*%Ng`nzga`!^aKu3vwSpKq1l)UNJfr8ynE z=|T9sA5n*P=pB1)=$ieO=3qDTIiGn>ROpUW-Bc_#sSHJ>L z2qu8tU^OTLbHQ}(unaVU<)8wXzQbU3*Y^Ujgjo14I1FmQJ76X_4)%g=pbAvrS0C^s z5xdrCtfxr5qK;{N)Is%)NY8q0^t6ZaJ&9Tubs)5~TXyA%k^CbPzq?~$#2G=LPv=uah3a}GQ0Q?$k*gV7Njrl);S6gQYoKp1v2lO~I!VN$R=r>saZmr!t&)oDNb8tXH155dZ4sep}JEG@H5Q)(I6^*R{+_;=OdzSF2R_KN@Dw z<_*>ALGsta2p{`B_A`V17(V>J;bQh`_!ute#C3Ct)0!|3@_NGw`^gM*nIqTzod1W1 z+o`dvk>~u3Z%1eCKgh>91#F+zSZ~4SHoo`^RePFs&OT3WyaV2yv}Y>OI>NZ&F;DTx z24}EJtuN>s%=cyWbf2WX2svLf-5QnB7qBkSx1E@~g*bJG_9*$?^?WzzSJv>TXlppW z?lblcyalYu-P$4EG{FD+oadEoUr?p(12hMtkxj4j|?Z}8os&!Am#?}|EbnxrBjb?W-NtVD#P8#JAWUa-J7|Y zN~C`Ckt=6&p4m<;`RXr`!<6DqLQdfPpCFg*O?$Zd@NTl)U%+J`xmP>br z1F_%+-vI@!G|*q8u!A6W5G3CXy34^>)#C&1%4_W7ir&D^bKD&4<+6tPTHyO@&Uh`C7Ls{MmjU#S7V%m0@O1t^^z(<-I=EMIRE@rQWPngSfB}ce8FKW9PBliv( zPQ>{f!-e_r-aOt0JiMzl!`-U6&IhU{Z~YQmNp`&j==XCiw` z)G(vRTX~519t`t1uVg1($H>dKlZyw5OUb;8c(<8$JMy|-@Vbm$Cg;9@PdrGx+#((B88yJF)WnE=`;t``zTf$JH;jKOfp?Wl?f4osMy^u_D!@6u8_1zK zKWs7HeGYj+x!yC>9Zg_}UUN=%$@7eTOP=G$cGl=?{Kqt3Bem`r@{4WMO_kWmTy1w! zh%LFuCG5Kz*;jGSdd^~o)>%>dqjiIJvMR{An|!@^3%fxKdL_(HVNRufYJH1+pX43w zRysEGkk{mCKji(F;j>GT5k94$hV={|{@-vhdo_Fv7xtJC;o|&Vd1lP$baN_YE_|G? zHPLI~+u`DU8lA0rl=G>ij@?e}Re^6vaPDJo6IE$%;(I)M4(K3t>|Sbu3f|U(&MBm@ z!F^gC=5v5L^tZHYn3vAH$>dxG2qH1O;g)iZ;n52u+R*7>Au6186(iArKz7-#!oSBMCyC=^wvYd+ojUKKpU@T5D5Jr=Ctd zoqD>u1$F9w_@?@l`FaaBQTI~!Quk8#^8L}ucS0-uY^%s-`5^nWGNyDR*+^GD#Y&0# z4Kl+lKSwgDXHw7ns_)-wpWQ`!vso8CMl%L?VmB#<0fhCgJ+jPywLkyEe!2_&^}ghO z^ymKe*WW^#{vOhdrATw9Auawxq=`fD>&xJG=fWSyT-f+E{GRRbCp=EQnDPYtJ#rY2 z&SJ4+7iIIKu#MKs8q2fDwb3a{`^d8A9@ih@wxUmu9oUmHjBlr8_U{RQ(lGc_3gB0> z!~bTt0RPog`F^9$x^6|(W81T1+NJ&4P{`C5JG$NO=u4@s!eQJk7mY3g>nn;Ni*MB3g2YYct0dHq@6sD0QEBJ zWz@@*m(iw_lQ+>OMw11k5^cs=6qsx?33#rM#dnTTYN3B-@}m2@(K_EN1rqJg7R*Zm zk+}0|SI4>5BTu4Vq<+z=cW~+)V#m;~pv)vA8a<2hLRc~nwYU(CY&SW=@h@A5RTkXG z5{X`nBC^t^h$V$dqi#og*LBPS7jGa|XB~iDn>Bbvt+}+*X8h3YhcXw!@aoD)K zySqce@;%aQmL29s-$KrV~xx?z9Hu6f#Z`0ZUw1H=X#qz)EbUk z$4YXVBOrk2iGtLF`;&tN`-BsU4$!AE8)znl+^OYqW$H{1K0z+d} zy+iKgfUB{RHIbq5awwa z!JQBVy_wb4ocSne6xBpcdEwb;ZkFM}@ycii4Q_SSXvC03foK^&#exHt8U>?wO`C0s z`!s_i)&PbBp5y#M+r~88an9FXDZH)tu>5!j?)kRp%lfups?(}3ch3?n%S`SWtj%t! z*gHQA3Ju;MwYQn}FyF*eR3&Vmc?1P)*up)*dBjer2VSruz=I~-Vp$-InH1R6g z+!IS|;;cei9o;oFw$TJU|5^~Y8^4sf9>ps_P8@<7h4q?kBH#VeHW)AAjWCAG0N|m^lm+?As1O6 z&joS_zm|E^fOg6O&3ff9e^zXx7SBIpTW~F>-+Y~^b;a7Q`1+R4VoDEs%A(OX`QQrG z!=Q8El8tLsMd{e!lvotc@N$2xa6j#{7mD358EMs*(Q^c|qMixv-)KSyFU7Z`Cy z*Z`Oy&aBa@ld8>_ZXpiuF?tdj9CxPy@Gc3a+p)k!!7pp_c~=q(*$v~JgBl`crw{i&P7n1!PDd5%fd@Wc%KxX*h;J@}DA-r%EG=Joj5UNO=FulCsa#@t>9 znOJa#j0v4zO75uz#zhWbR$jR;a}2MtVo7R7Mtc06(%q0)2m>%ed?_bUDQ}ttl1#GT zWA=GIy&*3lE}f}WnB+1C+~m#Pdp&CujDxtKVkBQxbmYV5Y7?}OAD`Eqf0Wl1FCr!M zoBm-pKfy5*^!czeg-(~w81+^bk&j0(#j$F!8y^KqLV1OD89yhwFCF~UlK3&o(y%8#m3wO8OK~Th&(swy>Rp466T_)#V#$@ce#YCqYZ@3f zMs&%9qSP$8rQLDu{QC#zQ+`Md>?ly@DWr$T-wK+;JDSEf2LM#>+L82o%({|%2av;o z`(n;A1u;7mz0M|?tCF2sSu3VJgcK%u>zUUP+oR6Y65WGtx__|_QKsWvm%`c)nCsI$ zd{~Fe_?-Ynl`FU4drK+#L7q$XRfJKlbCL%0;gqYbYEQArXA+yov1JaTnJH%()Aia@ zx5kHN;}cCA0FGPYbuRZxJVEuyKuhw|aeu%Hg59{$xRmoyJ|0U@^znKl%p-28B&p*k zPC48;=Tn?D$+^25$+PC&k@c|EXN@O5<6s)mCozk#7yflgojo^bx z9zpZ}S7Kpm;0b=^a2nGyil7HILlNVk%hmJQngmiDlCNWphNnSAl2Jb0`!c~1JDId_G8uJ)J^+qSB+ww7^LN3oY1-?YQTtO^;+qOKTipZ+G3WH+a>&M(DN_y*dR|m-<|ZT_Q!8 zaRkKtF|Gtw^_L(bypVyLx!WeYAE%8s#FJqL{^HsYt%M32HNiHhO(}0Dmeb0c8#HFy z+0LwsFDv7Rffjc%-Rwt*Q-^vv$1xEZv-IrSBMGOQqzmm1-2S110}&VJ7iCh{nssqc zq*m{3gIlCsb}FVs?;iD6#OsuZD}_28KKq^?5|Yi&dfVq4rrP4!i^EScc6DNVU97h^ zdg-VP$=u%0*vGmq0hj!8 z-l7;n^h#s*C-PmsUl&UGQ@|w1?SRt=RWHmg_sGXOdS;fz_ADkIuQ|{Mt@;sgFt0&) zog3jkT|Ga+$YgTZ)an)Xm3Wd99l!3%a~t6_9D$2_f)}e&LVfPMLt{c1Ri68u$44He zSpj-}r8SNN4)sYY#IIIfVkJkq)aMoF8UOD*#5M}|MBQpmD%nuNF}j2gHt)*Clpa%H zeRDKxbPmABECB($o8}C0;8<0NAj3txNf*|7E*teWK6S#gRJ~&-igm6*>`T{oj12oo zeL`;feqP}d5YY1Asxi@Q56*m{*EJVA@mf#tz$t$h%tNg#7<-MpUzsSt4e8N~MhOh= zqx=*#j+lIo}BbW&NUi(1&g~F z-wcjzfq6~O#lk>{XBzB-71n8((~<6K#m#2r6ZNr}5<5=pUmN|?NX1bu(C;^X+f}$y zR_Ao#`cBW%0H0uZm+xyqp{skcajaQi^F<~&8#!$FzVl~oma$tV6_8m^AQo-xVO&7}yD7t;pS_Qhws?>6^QIc~*NW`a@unU= zvet;wLh`f3S1CC@86SL`O7}Im%W5sS+^(*|zjRp7BE)xDnRvXSX*z;dK6N0nzmUOG zo+OAR2@t&J>&xI6l?*5tV|bvH)Z^mFcf_ijpY(b=6cK|*!#Oc_Z>!a1U9UiI^POtWCyJ-`NuLu$nR^iJh+rWTLnO|4^ zsiK2My~85~lvt%|BLZ+$9NnN8&f!Y{P@pq2g9v>1_F`CSJja+6* zsQc}g+C>SzLx9rHUD64!jq&clhZ&yr4Ua`ubn#%t5)QZAzv`=fev-pC=8vVdHTp&c z*{rg{*GjDFDJ@PN$rFMflfWo3*nlBM6g?@vf))@dO<5RPdOTnLm;Z5`m|a(-6rGW=e_^?8!F z{fwG3OZpYJ3pfj7gKjswDXzvG_ZE2%f0WHGW>RN%oi_Au z((|t@TUeeQib*7nKZtWySp#qWln(Hl>E|g@gor;wT-FXZot>8(P25}M^JqW z=YubsC}#rjQtonh43f{2nSf51cu`>dU7NZp~9Qe=e_BzQcJSJX%7|os;z{D;CqxalV4Ycjl)pOo}4yx#~_Mj$%nYP%;u$fpaIhrxbmx( zC;42d0h)YZ)o+*VAWP_~{m#e-B0k9Hegpb*Y9II?uQim9Qa}MAg(6m60;alF5K&hkFHKROE`gr#I;2f+OjO8=-mG|Q!0OtLIfWQ1u>nAc$UFb9Y;TH2~QBn}@)!>&PV}d`ewfm1l|5Y$r z;wv<9++8AH%U(eeU?b3n4%e=8+n10+?-D*q{KIFHI-&gQ`}StFGwiL^CT$$vwOT}2 z)Ep|g@>C|e#g&tw0t2l0xMPf-2;o1DfYG*%-#~8SF2#|W_CeJS`dPbk`SobAzG!!9 z0fyKJThUw31FUVbR6m0zASZ_?aiGmKtm7$QZsxu!U-am8MW&?{8?=?H zYEq?k(tjVJqn~_bkJ@n!HIDI@^Wgl8+;UV<@yVkcUV1c>YC-N|HOd!PCI8&}_5Fn~ zLa!Gb2UB49tuFw@XK9vUx+|B+59N-0B=_&UU62fy!C7JS}T! zX`6-Zn+$4qCcd2wvFvmXsLQG;Gx(7sdR<*`$#c=W@b>F0LzC#V@Lij*ss+lQ+C4x9bS;DYT%`Iu2*PO@DXG|qNg)JlEM`15NAn3l@LIV+OyyQ7 z^aGi7UliK(TyuT(0K-tK^2A5>1Hi`|P@jUFJ76Bsu0 z=_>%7dA>)^o;9d8(WN?U&rF+PBxW>fL7uv|Cz2q{_a#NPVT~iZ@A4l_3PzT}Js1^x ziAb|m4^K7^@r9{3PSYa7i2FRUBhB#`gG@E88Ovgn(I-X6qN%yl5{Ug-jy$D1Gl9pT z^H@0LGq((x^w|2)&DHqJjq`d`gGq+}s#XGL8JkcUSgN()o)C) z*I<|bX8wp#nNp=}pEPMfVmVPmE34EZTiv4Mg>jt81 zSr|j@NK0uE_d(EoTb#Hm-0=xqwV>Pm&EE zcdFa?6V-Bsm<2U90+%D*m{)md0*kC7{=hS}XEmL9AMY|p`ptRzU3XylNa@I3?*=@5 zn0FJZJbKH-l&gpG>|YFkVK?6IX%>tHHTab+G2W|G>YQT%t1qt@7u_Z|LqL6G#{?^q z)~!$#JIFkX9aOGQD#)%d=6fGH$uu+0Uxmbwc5Fue_=^5n_51dO&Kr9v9Che~ie@(P zS{Sz(onaY=-5SGhYu(}7zig%^A3m4lo`=uurfZgAX4>V3l4f6R9P|G>z}vN8FyL~{FV44E&$VZ zG4`^9hi;=={K*SUERQ{@@}Klp%NZd+FcyRVRJWi|N%e&CJAvuEKzT~f={2h;HwEw2 z4Sw^()uBV|K6mg9=^89)*~0W56N@PZ%OJZmSnSQ@D@%xTv0>IeeU8{?ROy_?2S8xg z_+m{`u#g^4V`pDqV8myX+~nek<&cyly4?p$I0>5eJDMg}j#&LkOuuQ`mO^R35;Jv2zgfq`wV~1ofnMs@zWe`?U&vfh1Q1 z5xyNtS)z6s23cB375jN`8EG?KZS#hYugN}8kk3(^={d2moX(${r@1c$Tu*ye^(yc6 z=?l4f^p1%8YHVH^K;*Zn0Z>0^dA?qaqyxz#_R_%$bs#La0vVdW`D`}M_+742Nw{cb zj0%B(HjPNPUEnUo!S#`T@iUzsiC@xbQ50G|w0<1HLl`h4(w<@j(o#+$v{CJ0xkd#r zW6|+rB&k05rd0~U^&$8g4lnx!mm|@|KPLBK_rF2tjF5c=j#X_&-?u($As(FpNIwGD zb+)<3(`jpN=+`44yY@R>Y34mw#1nm4A|@O5Q=sRF<&VDj(^opuCOj|db4HSq6~PiIsk(%6Yxqe}No8jt<|T9N)9n!_9UP9>-Q{I*C>K?_40 z+hKfW!X`xtc|grFuCNt_F)7$ql7X)3=3s%w620QJZ7|80y*Akj`i*Fh*{i}dgB9X= zMnCM9-Og?Uv0@~+jFTMct2f>H>eka8Jb6AWdQ`%E#C{AjJk~5}&cLiqFWwa8u4t2P zv3b~O+t2PyeIJ{SH4Yr?ihLEtzUTUO7-?GL8hw3Eapdvd#u02IxVMR)G!$g>0@7`L zbT=3lzJ+^8QYh%mn%TUiGkGBCIj2k?IIIhZaF`t#tvmVxzMB2i$@Bxo&I-WMceVre z7+gvqGI5e1sSwUmPlGj$ce{cw5flT=Fz&AXGbU>TYwH6dy_8`wSUhM}+MDjZ*RP+O zqCg;<^hA&5bBJZAX#?V<>-F%XaMqVD*b%3yc-E7JKl>;0?poCl0;zUVobzF#5Z~4t z=ugGp;$S4Pchjt!-|(atMXJcncc>pJ7%EuX$~^Y5J=#pXCApuPfq|&_&|D?AJ*H=5 zE-^i3R~q~OxN%n&+4aB^qpOuiTLV_w7*g|MmwK(!NOsx{JXTsaJo|Ghm+UEZ({q%! zt61;@=Fqe%mxeL@@f$>6@oyEnV`V>X^TxTM$*1XW+FJ{0T+v2Ilu#Prdu9{MtaHO@ z9+@LOb7gS;O|SH?nEL-0 zlQAUBZA0=F32({4SziwBJ@s_rn|07S5tRk@c^HcYTQBg@gm2_}_W-%7;jtmTqxQH9 z?2Wa`F;_hKy(z;ypCiL2V}R$GMCyouwrt^69ca#BQ&^tFizIXDBsk`-)9(}&dL8=2 zKlpQNwxg6N(^F50YWccwm8;*=wP{W7^(QV}bnA|q9=3{9@U^Bt>LwC@P(sW8ZWNaM z2IPg^+NIzH+|$5Xt!H1B{KbfXC7}uUvgQZoam)G&@+t*`QKk#;em{#T%UnFm`|zrqGNOBb(o-UWP3O0 z?d(kX#|6qU4 zDG5$;emL=+W<^ku66krwrm_l5dGw6GMufW%>~y}f4jU!z-^Y)3xU{#KZy#ZkYGKAK z%5eFodGt-)8ikYZFaDZbYOT{%Ck^ykU|9;e!y9Q$ns_)9J~)+30ARntMlW5ife??% z@u?byV;(=Ij~%!|NS2Mo#MwrW96_GTu`V}$(|+nm#~nFcnUry*0)5u}Kk_^9m(NW7 zLD>3wA@Eo1Vj9kjfYX+6qv|&8tvwKEw4((2`7&1Q?fA&+>+ARd({qq&1T8t__6++g z0RL;qza31>E!*j%^LX2@?zg34Tq>Q=JVg`?0|L3BX}?r;e3-TYb0iF06<-P+9F0Jo zm9a{$)v(owWkvRxYr?5zWbB-KL9~1HDcO?fLVbw}^Kf)w$vhx&-JI$ZIKbaifz4_% zZ}r~)@dX6=9{=0LXL{?sY_J``ZcSBm{Y&>Z&_f_*BrD7@moWButo;eW@>nU88TuOK zg!8U^NHgei-3q)1wRBg9W<5=a!;jAo0hpUy5Rz~xFz;w@qZo!$m{T&A)&6PwW52sj zs0DL(jRWzx6>LS0BF2rNz-s!rKXZpj&gF2fwKibjGS6t8f=|9h33Z$Nc~6g3giq8- zG`BnGc|y#SGutA_XBonTn!YhviT9*#MJdxiMjH?F)=yK?rCz>y)uLNp9x3Bm{E6Rl znn3)EX*+v4!2l@kg3nWYLZ}$xA4qY6OEvXz#MaCC2;qCY_m22{%Hl^;*5}jqS{-(+ zfn0*7^b2w0?rTN2?W@imyG5Lj@%ah#_m$4f(4HlFXh#=>c&v610MX%ec{oQlro%SU z7HR{}MKR~AL3@ZzNzHH<)&{^mp?-&@iKZHCv|#K$-~#Le1{#ko+G=G-`2CRLBlcN0 zk1_W=>H-NGLGe%P9+8I_u;7;U;Iqr`QOh1-x);^q90vw%oDb>G>a2>#n?|DF3Mu4d z8vnxIFpOdseLB){;=6-f}?*ej!{jX<_YA(KfNf3@eIY3}`89~8GqKCQS z2pIEP?!X)_{8bxgC>{PzU_3_H*Ly_uC(28jlyY_(@;4tszv~6TiBohIS#<* zmoTzY!8--uC%N4J|7txG6QpCXnOqhbqANljdw6=c}8hP>hwjAQC=Ama6;vyfVt+PznuqpG} zcnJmnnY!bNL90*U{MT>i5SDA_g%^8Lq%js_GFI|0qL;Q9Oid*`Xz_Zsh@ zRaA@VEvH%BL0s+_c>KzAH^BVS(wugBW~d^g=F$hucubc4qRW7hF3*Y_bJ>Cm`&3x6i&jLZL1vVnE|NpdCj(!j_k}@Xd3m?-Nvhwk08x@ zYA2=5%xUkFSQ?Yk%O^dO$`#EMSQKbjmC_}W$JEW6SPGNIR4Ih9!&q7h{7-A7KPwk| zB`=e`#m*>|8D+Yu9=jG}i*gdZ)z5N^a#Fmd&tS{1CH-{H9Ey9$AIla=l>wwOtOq2@4cV}u$A!pYg5>K6Y`^jL3pv7zsucSp&t#&%sd*#Y zLe>V`JK{b3*54T{(~mwI`VSX!OaL+FQhV97m>WZdi&A#fnJ!;80Q=MxO7|Pj&@YvK zE=AZDtW&YmmTjcwmG_Q!Q4ip4PfpLafC;N9QfhK>r#-_mp1UjD(~MN;TuWV9RDcDJ5)HZX-Vw25MbBt=|wl|@`E zsF*i7Ts57yzDwGH?bQ-y9MlGUr4RmDZUZFzX&NHxPbK{q1N=*og>AvrxX@F}wt%W$ zy$balStDY}7(q-aVO6s7n>=g>%~0~E@axE8QxRPTo|~Xuz6CwNE0TJ2J_Ok4{!J`Du3w|CYMBV8`qQ#qRC^Z45|*Y zC^675CC3-Q%TlDKi9p^o?raF*u4m3}2fsjzrotFTLCIROi{Ft>4@ll4gR4?i^z$)6 z%R-qMc2OlYs*{8o=JOSdS_=YNyp~Odeon5V_85)YJU~3a{44UUld5OpbX3O~vhG(YUM8j`4fL7?rZPP4H~H5sy{1=XSVGC=L4slR5-EmI+P7)19| zk3{W~e2YS%E)ZoaP!WYm)y1O>A3PY@x6IbelBAO-!=NOH+8^8-G;zv0Q5eC%){I7r zPKrzmk552esQ*b#ggh85xl<%;SD|j5ldf()bh^H9q-(WM#RWb$nY%2%w|z7xuXWqC zY?71iz8uNFPL5qml<}C_ER%Ll(#7a1)^=lZz8qbXg*UMy(OBE-^PE|J<*Rz4m!AIG zJMW61GMD^j_~yTGbwditeMIJ_>Z7*h8br?ya>nOb7j;>Y}x-hxf z>q+0aN>xDxm|0s}Yq)SPZ9>%RcoIozY4fNziwcnnbL~)6N(r;mlACz@{WLg8DcA7= zRUH^IKQA1C{zLRhh%g!{dn-c`{*N>moV`%r&tHcFK^fY%kJ_zn2H0_qRT$ z0#A={pOynZ<**;3GZh+gK`rO#ZhO|E?y&P=v z$1SN;k861Ez^Df0Zezlas|=`%6JnM(5l1Nx@I?Tb2m;yb)*rO8t&vxa!iE1_(boTi zx>|N1Pk-0RpOT&CP$q5PC~ZP;&p_yujCq^>YU``8$%@+nn-*U0@(fI}7vVxWO`00D z6{q@Te ztt)Y^Dsk?YS>k5%hlW%jmoKXXKMAph?Q@~HIFvy8_-JfIBGBAUL64nRomM<5>hQcU zFX!f9;!`S+oSOM;=kD;%FgIE60#y?z?yYMul|!4$_d`rCZV6I+6fkaPegaT7MLkpq~x z#oYU_aq?t9Om?D*2(~Ccs7WfaD83+1&?M#tPw=ZZrA>WdiSQAhCkz+!ZnvkVcB7|5 z_nSPl*z>Km3DlsYaz#gv%!(t|Ogdx;Ls9WY*PqPTZ<=xEvcqo7>QZx@hx==_UwkNrkmUyAG;3RdvNKjjF@EkMEK0h`A4cTIBBugTY7hu>&=JT1mjXR^IoIe*{SHyPtgg`a6Rm~ zi`vuh9TzSZ)ykXHh)nuERM>_tHKr~)RI`evzl$b-R}=mZpSLF*pO*q&WD~3n35Rea z_Ne_kgw2O*Jr3f;nyk{?s*snb;2-&uj%TR}yZ~iohXmN;Sg-x1^by!>k}zD*;Z%n%&@%Hlx@5Q<}q$ z9ga;U{UO)-QIU`u?cPX`_37(`T%?b0-&njZ%_w4sz$GgmX#hlMZ9aH3vf;RZn&TYt z*~t-r>tegE;9|3s^tYFXtbf$3O`uFmy$f%?PM`?=PvLnpp9517f>JdL-jeP%(U5%( z9rJ!~{+i@q68)H#x@ZE%zG0yV+q&WcM1Ug<5={0>Oq;@owCvCQL4`qlWSt1AdVnPvPB;uQ#qv*LV|FE} zBvi9OlD`V85%9u_1|vS6m;uAEcq6=Ap@p8f4!bbhgEpS%jQe7E!)!VI3tWFnZy*Rp zg!n=w>IoB9!w7fY)A|@L2Ju$|FWd0<+aNhjXj^tDHp6R;@k4LD;0xd^Hkmz4rQHaHU_xlqM2K zQZxibjmckTMfm%7A_+Sb_W_9mu)h&iV+n`)mHq7_b_6^}lVGu5mNu$)!;9-IIh&GI z+b{FlefFY=F)<<`DQ2P0U-T-V?MVhL`1Pf&`pui^n0x(N>jQkpt{Lg+PGFky6K4o` zQFdv{aB-N**VFLgX^t3gODO$tBAZ0^jmVp{y zKqS_1UqrGME{pziS}aH@N-47D>U5l|ob>N?5_%D?mEnLzDA|zY4T@e*WEF{60iTr= zGogACN87YUl8dqg3jvo=y4kP!Kb^j2S1ahS)Cr5ILXm^HEmV?vZgQBb&GBM+9x-(M zQj&Vl#Sf*4MJKPNg5=cR>v^SczLd)URC63pEY0`NnzUI$@-ha@*x?!IB|5y*K|C@SXW#(XE`Y$Fs7Z)cB$NyU&i^*P!suBbv zy}c{7KrrO=-JeK1-Pq=e$cu4}!6CBRUS5IAWS%=M>VVvkxURDT8l7i&8MdId^=tp*?gBCsARD3SSa zB|YOOzAHP7_{_g0CC5c;6pU0f-^ws&Yq+|J49<19zrOu+hEi0QZJioj(^vt){3L+( zgq|GD5&T@J`hpL~f$nPV&qzb&dyD=B zM)a=uRQ13nV53ELGvv2RI3|^8aeiYY`RydT+PEtvGbPchNFrJ6h4R~0Ym1iGYmK`m z6i(gRmP2Nul@EpwwZh9tpn7Znfzdp+qv!4A2f{6eksN!aa4`gcApZ<=7LI5;Gs-pMcIb`amO5ee!SRD_Tlma@;YQo1-~6Vrs|pv)@067m zAY+6J3l2a`^8SJU-LI5Bcj3@)UzRaHMf3OzW+D0K;QW4u1%{7s$@YmB5rL~85EI_l zgNaq8t*xT8M9}Ajk;N09meYqQK}#1zu!S^GWtz|Bmi@+9kk*#7Da&%7b>dMVoTGG& z7ce2GOHFQ=A|Tfx!ZN}NB0GqajpjO)Bqsbp5~IqZ%vG%XL$270EjO|(F0%Yj%B&QR zP-$60waNP$^aYI03`PS&Q_Q7V=bAu8s;hIri%}DwE&&-*N?2W?b3+zUY>I?b<)LUr z0pnr(fy{&^NmOdsIBAmG9T<0nmKH`Pk-U^I0#;ysQ_x}K_mscNYoZ)dfaH-`pdyur zA+#3MMA0-`T5_Y9Esjj8k1#a)k7$^o^YH%6lSl}%NKQOJx+kUI}`T-dnaiPhZKQ zOt2iGLS?~*Vya5aQm>h_IY*n2US4L&+{SF3;j!Rc3nSz1QO+Gun-Z105 zdY69Ka5(ZLrnIKiQdVFo7FERt<)qoxv8 zCN*VUTrqS8`-u9O;Vo0GksD5Xb*)6J95vTr)BQ)AIzw(^WxTn2z1+N6ySqR=$SJ9Q zQS*zi8D6-WqomHfxg>*y&)Vv!{D`OVoYUIRu>C-(lE~Ux)n3(~En}&I$8q1VN|AQ8 zW=-y?`N`QQ?6y1Cu>#Y03-aGj! zJ<1V#FTw0r7Gr9oYR}bLf%w(g%Df%!rgp}5zIMMZZThy>I}O_Rmk7aQizFWEZaV>M zi4Bxfx;%|+dN)Hj#t1Df4N%i63~Z`Q?MDAR{U^PU_sUWtii0G|H4K# z@NK;6scR#3-6hJ{C7`oM7dw9GDg5hqe}hL(xiCRLM9i(#wzXEe-dJuOxK_KFdZfRt zys2EAcuSE(_M`P{=ur-k18IUbf0{F48^e!XwGnHq@(qwE_{8TcCZUI(%elZWF>0{s za&EG*VdZ?Bz57h|rlUX|(~{=CynncJ%5_7P_UcbYyzHmHN_uYQ69AVbH0H@+kz3cvzG58MgZ@S{W%}~wxT_@8 z3H-&3S}Azs664HtN{+(FUKs+zFng~sIFPX0Rs?&+Fh}hXm^5h`RAm};;Tj|(^DIK$iS}1>rA^XxqhVb) zI9`S1&A-5~e@cE?iUq2T@Nv#?Zyq1;9rM*=daM`{D@tqSduovV znr#yjMnNHhkou0+x~IOmwYAmVFyDMX!_xtnv)5~V`ZNj{dhDjDsqq}}I`qY*8Pz`K z)jj?g@QOKi0{2I!xe@=sN!_`=d47TZD7+tjB@lG?cl-*;%nINY+%rEGY#VxoZRG(C z*-e8SJMUSqVB9Pzp&T*4Uk&q*Ix?yc`kn0fi}L+Wz9H)HgyAL-50t25As8}|q`Kvz z;R`e>n;S?(H_dZ~#8*Uzf;2DeSFyZhd-H@ExTO={;f@}>#|pt@!eKQ2$!LV$g?INC zy((0LmJBjQLlU8C;LH=jX2-26g0l`|dvM(o?tI6tD$1jdV0-Az6A5?6&o&&X4q0GO z;sq-gg5{Q4U|@I^BG*L4Hk9!O)fSLz3}+irUB~Vp%KXCJ($82&-!tg`Qmg~C+u?A< zZI9WauvckK-`KR+87_)~DbLAt{g$yI1&%l{1>?$)d1Z&KFa9 z51%vE_*Gk7LhQA)v*t@jIO5{TKsa;nDZsdc>PgIqf*wMusESgvBOE>+^aoA)4=g>O z(I5047))dmWzmR}J|OtNdF>!@?V(>>Y=6cpC?N9PcPy6Fn>FfbWQ_Cd{rR zr#@sINu#8)LNuG*eaY+lK2os&_EQ88p4q5Ut=Fxk3UyK=cQ#yWAmprst&I#pw& z@_gz3Y`}bVkNpNmxoZ?<&6v*i4yPYS6S~?EyeU}o1fqM#k18Z(7RNXbp(*5P_8X5d zUKga^j@`+R>tCFnm>nWWo=D!pgeP#Hd4jH?+i^&VhCgJ(%;KOS6=B4fkSRo%lls`G zf}PV~8x1)o1HG6CG5&tngoxTD)%-?lgg*JZm!r)0dIg~0gLp< z&@X1?g9vzLNqCIgI?Shj)>YWpT^78+LPvP{el1T#${i-%;Eg);mVWouZ=FU+7h&Lz zKN0(#xL`|n;j@C_9FZCN(c6A-{yS#|@j7B&_4|2(A?+gb1(rsqnHtHm=8Dx>VwkFF zs;NgU89i$HEyuB&%W1JL2Q?epY3eKk+zjihNTW=$H7%Ynd@|k4;^`v02l$pl*e#Z{ z5Y!Ww%n&p=)ic#hs8%C^f+ClK~~EyL6_ zVsYy*q!Ny!I|Fp7kH^)Vb9CvCC)gV_yOn_z*NZkY}i5q%y70 z?DFTDl80wGq>C<-M0u&w-Iae_7O1YvSv7^tTQQo=3XB(hCW%2)Wg^aN@`&!AFdfb! zj~5rR=$f1L*5qtQ9 zv7n+YJYz}CUuyP1Qq-Yf$?Ydid%~(MmAgRmhEQF?Xo=8W)cinRT?m}_ev9OoUE#?S zYK*(bi|I&kXI~N4SS~77=aIF!v?{EAa`Tk@9nT{zah_LGPzePWEY`niDDUW8$Hhf$ zI`GXqkDv(p+>>7vX=%VUh@f2JbdE=f^3*iDV8OLxdN!R$Cw7UOMn%QmNUD2YL{>=71_SjwrMRF**=Ox1?QA(J&5g5E_94d zYg;(+5_seARx2BkZe5aoY930>ZdS6%#}+$jazDt&J~QcpYgK65gs@K2Qc-PQxq;JC zZD+BufylA!-sIGhcxfB9Zp6_)-PCyD-8r+}{Cwf}-Y3u$dx87jO?Wi&zV6|71t+)} zdqet3CAba>*?aS^JRASZ#gKEj-m$#(e9<^V;aneuZ^iKweK7QgGFoR4yI$g|4oWB0 zs!x=Yam?@TV2JEVlWPiQiu*~~JFMjBn<7V;tNRE0gT^vN>a% zkZ(FFwm+tvT>fUUlulv0EN8JEPeHoOZ6Y9YK2MUn0Qq15FaXz*jQO~_I38j*k+YCR zB&$5qEURf({PIHACcvDWtBOT_qa^3TR5o@;2w=&nqgZD_&e5EwF>7rak8&mbeA4AE z%h#fZw=a7i19Akql|{@uC8zrMM3-MMoEAUF*Beip*`$C@?FgMJO zIw{Huq+^1cB5JM9JTO1Menj9Lu`3OjC4G>*pXFnToicMF=b~tf_?p8%K;)>pfAsxS zxCU=K6JQUXBK!9-+%_^R`>m#pIVY#shjm?e+kB!K74fKG@!+!HeNnmaxd_|vJTW{8 zJdr)IJ<&b!Us!K6$}r3F4@IgKVXA-P6zsdvZfUp9!SX1zE=hG{+t>1*06G%om$Th4 zx712cRJY_xPhGR~S=~IgL@Z8oI#L6|dh3MK14;u@17ZVmLBBz9pzz*RgFVI}&8`q9 zPh6cnMy%LgW7-b{o&D=osB6RTUx5*xm>YZivVY%K5eW@_e8cf?klhDIR$+4uSpkRPIA@@o%iC9Ul2#$ELDi6Hz@p+Ou6QrQXfey#2#r z$ZRT3;u9M@Mw}gpxu2Ag;#^XH_D$!oO2c73G)4C)Nu))iu;xVB(5FOQI^*%}S6Xlf zuwHPZLl_P5Y=ds=uqpa5(qMFqP;7(8>hMeYQg4_qekLRn16A@acD?%>(}fxF?(Y9+mpzvB03vX~opS$SU zkGi#eTiF*^mF%>lyeuYJ7wNS8r+2=$9<^*nqP8PY&QbG7Se$&%F1dG2VQ|*C8ZOV8 zrp^*yIpKXv=_z$M;jwTcyc+s!qkKNx-pu`)8hEkuPXr$BejxS^UC#xaYIMl;F3`Wl z_~-LZ%Iap?IGG?G%WuZBatA{@A;#`JYt?f~_y^-7ny1n(uxN|XS|ZSwE;S`AJEL(P zV%bm6ZANE0!tsa>x&8sn8PVhys*V%hVG#`NzmO746ngP(m5w~b<;;V73&);dziT=F zwnH=`44X&MmW{F`rhhbh^?v7h?RfKc#FKEQlW>%w$-{U3{j?xtP{BB~64U8uVLx-p zmCie>)*+mFn!vb~dNi?<&-VxV4(w{0-;>E=LGCTxzW_8F+jG?;Yk-+EO8C!>9!ord z?hx`gMd~;{zmQ3JGy`8#||XOR}4!20L3Bu|+J(lv>X9W7(oWU&hk|1)cI zmw-4VI@)XM0Cv@39k^<-Wm7f1B}H~MdNmykp{^f|p;`lGLCM6Z)s)VykAJQ{f<POcbL&cJF~a>3v;O2<1{W3r;Qbn)iSUmCCz?$)QN(mQL-1`z*61%iJCnE8?M0T##T7jjO%pxix$`qidi49EW%^@!5Fx7e5>&p=q|5qOMa01R5fs?JN&N7 zTGHcb!9|6ZN{elQ@>I*?E}$ktZK_h+@~CY^TSWnj6>8Fgh(&C6``tUUn+MoGJl&ny zx!>=5-0yzBJ9j@_zE+-!oxvN}9~{U2;7#meUXo8?zwkQt3Mb_A%0xv_BzZs?tyC+w zC^MB=N?5s7i6~JerszsssZnZ`I%T#}ugp>AVrMZy0mZL0D2@KD{%!sp{+<3^{@s4+ zPx<%w_xktwpR{{Au~R-MzaoBB{Dyo+3CJHRUhMDg6qktI;=|%*dB5C?onDW)O5B3| z-ZSEAajSSla)~Fz^Wss-EuIwL!w%3Ro)Rx$A2<;^!4UR>I(CC`><90bTBO^tD_kPA zN_Svy_=xm?vYbOXQgA( z3G5sN>5?>n{bN)P$W_=ycFHaCV(caFm+z66VMn=1UM;V~>OU>-miJCkpvADTDvpCw;%?b|`lBLLQ6*$Xw2xO+TJF3*Z?&1X+X9ICtqFk`Xig zBeC?Fba(n_UJ>}XuTMCH=sD7#xh%|La^^-R3(MJOShu~pY1*_rv@B>%_KZHkME&K?64C~-g_zBkW zXRsbNI65Y;$M0IMWtvT}4IYOb_}mOzU@L5g$54I(tG@$wA!Z}Cyc3a)@N-1BA6 zwi~|`Qm_a1!an58ma|ef^ukl{G(LNf&HZoyehJSakG;t3a~xwxR{nTP`}cWx0S>}% z;6?Z?{0?`kBmLW z&K6#0#>Z}y8AIE1-0Z{}??gVC#Kw<0Z0thY6jm@>zpGd6sKbt3?*nMVYQZ!|oLao- zFu~$HoAW)yb$htqbGfL46}4A*Y)EyE52@kX@ONGryLz^EuzJkmG}^E#vlzo``xg4z z)n~p8AL_$&uc3SvPlrCNG<&|wnRpl8$&KG}^!@Np_!nH{zvtjQo+lUJeUv{yZyX<&qA0Mf`Y5JCjvg7n~M5aqXC2+3#)^!F3^H{G3ByLuZSXZuXXXPkA#>hS zlj(C`&h(L~nfJl#+UQz@@4+ee9Jn_e|H^G&UihU2rZK;{XXAFSuv?JG*O!{zC`x>#uOKM3k&k|JZ_gjphDN;mP$)4 z>Mqr4Yb%+oB@jpq0W7K_6d!IwRg0Uc!!5&TxoCuC*tQJkEQwF8hU&@+Ro7H{B&Mm| zWI>~WSC5N ztW;AKy~zi=eb8c+k80D}5(^FLN}yBHr6-fislS|-X)#*1^mGX>xt&&MF`brc7_5F? zZURC*A)lruF9Ig7_4f@&5)P6V@?8WrWJ}DI3H8}AU~ZTpt}hs5xvcCCLkkMDtI@D! z6 zuxFw@sl{S;-I@&=j^QAjaMr4)rc|MQ!oo!?W@TtJXqDDUWi4VGAfPf17B?B(#c`u@ zl!Ddjc+o07#`042q!qIhWU;hHqX(|foJ>tq1ADKBX<)KE=-4QdQmQA7wncQj6==i# zxkxnvK^iu(e5Pi!n~WvRN6Sv)bU{8N_rkS}u+AE@mFI^FR6_{3OvV-hY8-#GNHr>a zNEa6wqmgRWAOXml;Vg~?8x4ztf-4lQWhxhQjn)Q&X3+lpkCXyVPM#1g7!u2eKrSbH zo{vqR)9}@d13h7YF0OTRfXl7j1UOcZ#R#-^3pVD< zVgh1r8w+!ceUPM*4lFSqx4PQK=(*SINLnU)xnL|(i5HV=1HWEM) zCo}CL<&VP5TQyX*S}IoC4XsVM)$Oy?8?cdfJQCfd?fmuz93`-2xk5$7URpRA1LDQT zMU&Yp=?Ufkm-cE4ZsIz_=j^Ul(q44GtZpkyE3ItH^6FyC2!btwN#g>cHa1|W34{=6 zhAAOwntGZJeJEjIV44Y#G$ACNq%=t1C&^yP z`XWHYKl3s3Gm{6!k&3Q^7cU)yG@F>YF~!^Q3Z*)8qZ}bpQV;jyHD($^(!jug%U@dHEI0vJs9+1hS{?_q zjT6$9eBm2=r>C(ry>Y@2vpJMbhvw^Wh6w+|S=n4VJ)ZRWj5|xwF|&3$$o&(;hm2pI=v>^>JTwg zx4C(S^>-@FvraEh)4b1pss0<_;z5L%BCt|MX|w_ef;aQ^g&XvUwEj3)a#DwKN!4D`Bmc*J{8|R|)tT zI(2uuWOL&{X-0{~)m~>$u@D15yoBR2jeEK&MR5{>yJtnFs4ks&V)sLhw_}-13@>}; z_^$h;?xpFziDm7Lcctvm;ys5-gBjmadExp8U%lA3yf2Eswd{#C{q62l7qh)9)js^} zsJ42r$HC=SJ&u2u>hJJ1PKLCB`t8i;vcbml{>)MY8En_2 zyN9+uuyS&&OI!Q(l@B~Nq=}qhVWtC0z~xWGd?RoE{f*-oomlURs3BKa4a=QDK}jnE zPk(>=lW*%jhj1TB)i^C~hZE%S0N|~L<_%yK=T&ARH4iXzeXYav|1~sUE zav~+>{EP_3advC{s{|S9IjfB`nScc^d?M-T;XUq+|&Fd}EsT zLo!hPT;mWgrHGdtocWmE0(hm+xh7s_ca=I^_K6WBN6hVZywWTQB3@y3@F2d2*CO}K z&9fl8-2t{b^ZV2A2CExu!z&T!LDG-`AH<#-3|db1e>tUv=DdJZ>~li4 z(~A%tV<(CBvtxQ^N&=ugq?!I5c#nl@m3CEy*Tp63w1(_FS_^&`&|H2vzD(#h>7zgL1&% zIg-$ENu0-9pjH&1Xz`G-U5E;l0Hwmb;y|wo(gZlHU9IIEMtMMfp|bUEw`#e+PTINr zHIjiB=2{}NTa@!^st^$yVL>)HEXoBnm6rwl2QgAesd-sUa1M@Tp`rNtt(MGOYDtYG zzSfcrOz{!G)QdV=m?G-%nKI`XF?7XRkVN;>t?@j4Tbkh`VoRTBp6D~H#q7y&8a?wT zDg>vsqqTERn~K=R)QpRiwg$P2FsQic5W;x8Z3TM5-zN04L%DkA(`ZbN~mZV^ndUPt069f)~ zb0|?94hXz-9%q2G-7`0*9167}2SKIWMkK$3w4%}aAp&)?(e~l!*c~R5l9_k_)XMq1 z;TO(=gEY?4Vy#ec7QpB;_wHJFd^#mu|i_h;J#EHU^W#8+!@6W1Btr-XLblGd^wtEaV+Rxf+? zTFI7QS{vcFjIjYjv5c`Pp#&Nz1`~=C!X%zf3zIY?ahtRyrO!-<4%n`v1WMZ^)9H`& zAJcX^)0xun2PXd2PBR58_wGt-3urqn>9pe+tt9VW-S4~SobMdA$`x$%U9tI@3Lrb~ z-KwGq6qn|L{oY4w-#?c~={)Js{S_1rHFcjXV1Q>Sz4VSERk{K^^EQ~?(&Xd8`!%RY>X8Q4Jsk$ponF_X z2wiIS{HI@1>2RsB9Ow6#OvXpsYjC3G1Xlr9tf05~42M05aDXXZw>Oy)3?ps4*TY+h zhQK*a2zm|oP2m7n4WlS!=e;b?5Tj-woLXNdj^tA_&D}5duk0d9ub;m;mn(i;n>#(e=ggqHw*T}V z>59De?c$aE=8JcK^v!#h#|AEbvb669)9pPczq9MWTPHHzr@kk-bbulhaM=z8p=Zi2 z&8xbKoQG)0f&4<$K(tTZB*?ho1(k~ODCQIFI=m=jXM>})D!^bn*Qg-x(Lq9y)Qk-1l&)G;sZEoBB z>_m1)h%EN7t=r0V=Rn;lC=0z&s(Vq-(?Q}Y@=I{O4aghw!3-@;b33nBwyp=6bwL!( zt;!dzAhs@v?k#3TNtANZ;LPJUmSy_`Vyx}TV=YplM1GV_jDBss=4*grEMVgY)*9824+Thw>Z|~NYn=mhjc{oQd37wqW<`7 z)~Et-PevHpa$Xjtp!T%8|7$<)YnuKmfaZ3b;1-NUbP9(1p`qZ(HgziNwR zC3VWI-Ue~P2lYVjDD$fwnfr-1?u}En0`iS{h~g!^Zh#25eu-`Xf2J0tBP|8EUZmP> zcyQPxgUD2XcT_M$Qj;)Uib?uq3375~k~nq^;{Q9Vu5%E3VAcz3vtMO=(9f#Sv;Aj& zJh}1cj%F)~ftaLC3_jHp?N8dHxrzM~x#*^27k2WagKafxT=E7a8SNZx2#aB3Wb@wr zdk3QM^ZQptcF_@JsC&z6Kr&EF(BTX*q!fU_-p{Vy#x4QJ z6Na{x_I?ejMP342GyyM75!{e|$R;0~4TxvOv1Jr_70G{oPo<)+yPuke{Tp_v^Gm-v zbMn2}E;+*iE5vn8wzf@VeUwyI4EW$bO~lJC{;8MF~A<>7QGC`m^O_+ zSQm>>7|UV~kex&=1rE(&(Ze~%UA|Y6Mo|MkwB8b_90pk;<-r&(1)F?+cU}&b;rx;1 z{1E_v57L0Naj9LR?*F?PS+i9t5No+)Qo5Eol1P>(c=;Pl2AsO29i~J))qoza35V)~ zbi=vrUDG4c)~6SzM`(Y0G&9+s(33Q&BJ7=GPc?t;)$zJd##^_in66B6C-2hg)oQ)A ztGUD1bFh2hXrDI~%7kj{tX*s6%r39P<1_@f&5r)Q+M94UiYY-l)n@?LAp9^C0`BpZ z@~IN;)Kz301hp{oJQ({%B9(MwcvMk@XaVjMtGHfUr@lWeb1YqedjZFC3dcZ8fR8R4 z0O=@}9&?EbvigmWvQ`56x*<~2CX+nxAYtOgUG)Q9o4i0!oUR~4P{5J0L^3ht379-$*~k75st2H@efn`ak}r4J0n zv}`I+{9U#yKDZBXyLPCM9B^CEDZ-@NXkts+ESzs6Bg1qITy#?4cZ|KF|g}b2` zfFeo4xmcZCeO&?WoEJ5@a=r{NXQY%Vp*b#3vQN2C$vvnlTqKxSs?xwxDLztaB`5?} zTbg=D_$MwLY}k0>yAy%j#-vGuqcwV(6T0IQ`>lywLg;Jcsx*`uyKMDXbY{0zFU~AZ z&AxxS4Gbld&f;O3A^>)CFL!^w*XQC~ge@dttq&;3hxj3ggVNCXa<52R`YJL8v^|1+ zK_m?BPBQJcVcL*_6hPA+QDf;9?9B&g~2&CSKm%cd~_);by1qrY2LduCTE>m=&zCM5>lm zpf%Y$1kf}oL9VqK{z$>uijeJ&4ShD*cwjiLV;cfe*Lp$MmVoYtApu59U0X01+;s(H z<9t}a3R2(PXq}-BvDLkgNg8Laf^!h2$B_O(Y#c-0#4ckX9@!(HAqzSX=?Q(cE_YtpkTI z?2G;d-L*T~6=4wgE?<|F@lLpp1H|}7s=}sX<_o|Wz$wzypr6nr0D5x0dTO$ETj;1sUCIt2xVI=hi&e?8v z$6WMVvJJEHZ_%D?INar>zQ^-A7&;oRo!lK8?XZ{#;#yK%;x~{IGJ!0hh>D6d$z%+8K2+_leq6=< zRkZq-D>Mq*O<$QoeKV+I2A%oGH378?C?c=|#t6cJJpNU&91kQ$-XFn`5p?8QzRJv@ zEIxNt3QQ{c0EIEMHa`y*NReAvdEs*YQ{|w@hFjXx`eCYyKK$ETpDvDE9l?kZl=)Ae z-@i41yS_iK=@x8>&8DhWG^U3>YqK{~npUnka0Wen%CFjKAjm;<+jIgYjE5i>v*67u z{7oDCq>b-cJUc5+2sGcF`fU8Ryh2?DATE`BofYE2Q8fWWhO)^QzYIxK+u6E>R=#_hn;^mhg>Gsy{ z%_)8Ws(rg*P(8AMU#C4?;YgQ<=EH?(=3uYp547X(nabSrwf1(c;L*l#wbwhkqj6pv zY4rxuQ1S4OpOAa?k&Qd(PjnMtor1^?b?qNQYWWcHAObil67i#_FG)_eqE7x(*P0et z-rfGMyVulQ0x#>fTs2TG=+eFO=1a4C1_t-c7B^>(FM-;?JYfx)@&0^ee4wE25V{0A zBp{_GPZ_g-f{&m`)Qq4Mfxu2(l1O$`oei3nr=wWhdH0Godfy3dpH%yH%$ilAH-WBA zA-`!R)KOmUpFUrfgyZs5DJHwnEW)*S6`jxwW~x~g^d{Pqi9|DAiVO8dlKc7qrmzeX*WMRS?b|Fx z($(n?#O-ADm8sk}9?NnawXw0--leg?CY%_Tyr(F)kKjMh&JImY*~MZ+EXDZZp_gl$ zJcS*|B0p^IK%AE$_bGHme89WEuYk8y_(yB}qkw;LXSlKnQJVsgsM>uE=KtcsN8_&W zFz#*w_WI02xO*2U0LCIPw+uOm04#VUh8)$HYsF50GxfnQ34*UyinEToBok8&DQ+@U zM?EdEMJc!@pC9po7CqM-j237#pGgqKrTXcUZy(POE?qu->g{Lq>kT10GnAk0bKAOR zONH4!7kca1`!7{TUZ{Wn*av5-!!Oi-G;(x0)j4@|7aWtF6GvtLz5WaQDy&h?dYb?C zQ=;s@<4CvcBZWwX8WjBmo6?ApQp~ffnpb9@SIje8(@j3ue}BzawBo>7@K!wRy$?3v zGMQlasj!^v4nnf)`PR=5M0W11Bq(P`z}M*@x0&$ukF+*~{yNyD#5%=@GhlTVwaS2e zr#kT?(@iI?@CADh@asmNZt^9{K%bOo#Kn+)GEL%UoRpm|ls;I%8Htp{YLpQI6+tQZ zW-D2c9rS9GDda{+jCxIaM5F=E|=RIa$z(MH<3?B=p zT%>I9!o@`6=5}fv%??Ky++ZSUAr5P=Y}~?b!`dsz7n-IIW2sBwY&c7U?cFK0BQ%jh zQ=jKRLdY+;oFwx<7sz3Fj>~a2rid1yok(uE28y2#yLFva8%vwfam0qQgzdJ*2|!1b zm%b*>bA>`Wy)ZAbYxD3Y_m?(#M5dP%`2T)v3v@y&KDpp}ds6!5wO(j-;Z}hEcH!{3 zne1FSW1|TpZK6bJPhWd)%o-W2?XC?*vir}>#wVo&ZzOQsKpRcb!dRv~8(^cQ$=#Es zDC!$OJ`rQ=4k4NFh6IDt=d!puTs|@2X-`Ps9FmTV$LThKVFbV3-EK7q4#DCIS^e>V zCzz1-!XDW-zQoQE7m$ABXX+kZ<~Z{}ClX4^dTKW(HAW^OTC9Z1Ub8k}hJj^!xvP%u zT9yndHo(hkN<-^zWLLAC8u#8sl3(K;YKJH8A5QL$Fg7jLVdto}P&(%sd%E0ygty8i z`CZDZcK$z*N`Cn`HDC=mIfI_k>y{E}9*j72@%>r4k7?UdMJwl$Xt0SOV|wXNz@A zl*|&&4p+J>Y=&aW{q>DMt-vt>N68|e^s~49zu_ z+`-;dE((P<1uRB><$WF=QYAodz}4;_!(&^gT0{ad;O#kH^-?XTx*K}q-*jwnu&b*S zVu@EV>}7%pm%6fpaP_502k=EYvK|V*fMLJF&8~DLl5$h{GLHQgQzRtqCh<3@fbU?owgtjA)wj(?=* z6FITqHm zkllXodoLj_nK6H~Z|5`T-t+E#_wKp(o^$T$=F{*N7Z%K~$;@c{8FhBT8?LXctPi{0 zru1gkMWCvo)aNU0sEQ;?b-gq(-d+`#ig;C3qm+%(()%%=V{9(D$Z^~uR$vPAYs#kH zkd7_s>q{=_?@j(}U9x%2`ed{0#Z!L~tJJq~`w6~?ds!E{6YoCm)K!YbaH{`~2s7K< zd5f62zid}ky&w{z%Qh9AXG@K4E=KA&{TS1#rguBtJ% zb=2PwFD{OUtQ;jY;krY3m-N&Iv}ms$H+)!pjNNoRsr8v@>H;%HMsSak1s0QW^TKHv zF?HB#U4(EmWVjk8XMb&Sn3PZa4+nmSQjM*Z29O;wF+TcaL_$F2&^8C-Vjp5*4kx7FmXcyQNYmcn7z zwiQ(7x$HUBCE-|EN%m(q?7pR^G~8GnEG#Q>=f~#c6y^AH%Sv)<*Y0m`-aGuv-H*A0 zl~}ocM3_;m+#1$w`C5A$bKbyQ0~1R&z-q?$sidd7x4b)9-rZfE6yDGY{x2e!M>g=n zPUaGNVMuT5Nw$g_$-&l-`Wx{J)LZtfpRi~B80$aY(OW&nl%&77SncQyoA$4nE-;G>=JC4O-i22u+H;{QIEYim7`iD|}} zo=n7e$)rb_)J(Vd*@Z%kE^iiUX0B=)#*jYTb6XUE!J|t7-kd_Vo{Ksx3^cj0>1uBXP%ChXC1#OXVVJj^v88z$+J+h9H{9}Vkc{Pq_r z6ouxU;0_9;KTmq_G7ySZ7`Cl|ZC_CEFC$}Y^9#xFN@u^Bh``9T(lvPAnc|NPqS%sICd)PEnGG;R40nN3vMzJ0l>Pt$pCsU%ygKT-+ zY`^s1B`hq?WzX8}E}UOpT2tUk`Mm+3P1rn6_OO~8SsJTtk7VuEb5dJ*>KV40-BVk4 zej?vFZwtmMieu$-X7kq_9*2Td&~^1<4L>;kob;?jTH>RZhE6x#;#+)?f_9S6$$#Jf zM=9UyxOe51Gvjs6JbMq?I^0}(SI%4>a^@M@DNm?M@m{O3w~3SwC}*Z< z3)AmNl>2E|Sxh%hhw7qXg97qN#3wWiny1LcpbPYa?^^m{@htiTspC4_&`Xw)&galD zpOYSdEQf3X?Vua11wVj(4k%Pkq1`bO{8;*VWdr64#H|Lq#NAeT4`nNZG_0lY?bc}s zgRRu_jqEbPcY2hi7z?QTQ9gjO$#l_(7~B>q4H)1f>>L*RgNjLIcq1Z_vC)RM&(1zHz? zV7FvQd6o{&m^un+4^ku(xZQGbnq1d0LQNI{Lw-SR87!JcXQ0)ZD4jGYZlZRJ#wq1? z+kRlDcFk*oww=lwU>J1L3dKgtX99nKg4(MTbT}xe{Ao&gX9fo{u=Lt!25)6x>A%*# z3;y-zQ@(xv+B-F1(MmzvdJ1BnhcYq#>-7vOo#~^>#`IV05^ZCb(%*y3gWLobfjwY5 z*bTiM3@U=QDGA!aUFpABY!~mr<`%LISipB1vYF>ome@#x+7IPeUt^OYFQ*R~vJ30+ zO$?Z5FB@w&@tscoJ`I|rKZjf`YN*2`ora`|y85n(auMTOn<;%L3s~+!JTOP6}U)oqo3?UkO^AM zE~6j%@F%hNLR8G32FGB#1bpA^@Mj0X<1%VrO@WX39oOm3ih8UEe4lvC&^-!n%g`MH zo7q*=e+nK3hYbBTaEJId>OQa?JYeX547Q6R)Z4%gL-z#OE3#0}2c?GYDR7h@#e9AR zo-%Z2!G|0<27eX&8f`yDzL5=DjrU35V`zoFOoluw_2bJVd^>G{+`xwn+0QxM&Z{T# zmGmx|gJ4d>%2A4#IYjCgGNzgNLTay!&1SxkdIY(_jYb~u3gu12d+`}{nK3-=lYL~| z7O&EB8H3Gund*{KgY9HI)%MW6i1QuluGANkaZ$#?S@82-3Qxu|_}0m|^(FP2aSOSN zo?dChqeAje#2xVnt)7e}N6h#k_ENVI52pBT^(5v1zplPdJCu*mR&oM9Rk9A}bS146 zFJa!WoOl{O8}Rd##CaYxxEcA#2q}Cy-3N#-Pwxi>hF>{{Z^M6x*Rj{L5f=)nWzr}7 zl8Tikx=mS2H;5%T=cUAzO>~dNZZKDUl$L@P>@SD<3GGo|Mh^I2(#t)#i|UHw=eKuv ze<5H2jUpkWmWPT$z()chfDj&0!c#z_MIJ$eLP16lgB4IzOtA>0R0U0go&EtdbU+1W z>R4qM3fL+gs3KT#Y*E8dd>}Z0f$itq-A#T8amJbc@tM1Ocklb$bG`?hU)i&C%_)1< zc}^EuSWhnZrj3kO?0G&U&)M^QIAQ^3R4VBynsJ1`LHe4HWPsP3ZxN9m9Hm+>)>~eh zq$jVFbbHR6YqEQaj!O^ES#@fxz1*piX88=i@J@KvXwBtblK-BQk;xwPF~jQFR{k{V zX2EFoX0(h>j^_DA8AyC+<+X-P+N)h;NrknIpGEZLytmmH9P6QM&hiHC-f(v_-y$N7 zGfwr3+lo46su*i8FGrf>AiNOSit4UdM|>dd6wW)7`CEIzK9;&G;YJzjql^6KZ9i9f z2Pxar{&TsTBqmq|zd@5nxiKbUcU!9T=*_Drm8oyM9|aAQ;pfSv-qz5L{kx-BbsG$`@n=E3=Fm8k zEiE+G)%)hNoY{0KRNw6`=Km3VtCe1U2l^Vr`y<%otKnE?G3Wib4EKGW>(EKFg0mW% z-9ggU{GPQ%V5`4XoR{Qtcu6r^WiE_U+;l17eD=XAGf8Hd2{M#(YiDgbSJpY5Wudo4 z9;0rit&d91=-x=@*)po@;OwBk9kL-Vv8%h_g}5|x#4)!Jo8C>#F?ES&c+cX!KN_Gw zF?GRdB{@KzOoh6$taEk!om<2_7Rgj+ja0#%#H2iUz`09i!8GR)sf7D}=s%;nxlX3Q zRJg<4Be!#Ack-MK`H3UM)+MsQ!~c8pMbZX|BzwV-u=F>{?-YFH1Kv)#(L02Xc#}P^ zBUjlb{iwf+=i4Z6cS~dh&l_L}@A^CqySSX^j^-2TVXBG0XSl=FG9ElXSMt*);VbGS zD|rjH+*>lS%Tdk|^x8@O`&tI$|Fg|8a@0cN_g|!^J5WaQTtuJwuo_BW0%XDz7!PBi zKNMoaCC(=Hew~apPm{kM;2tlN$>u#NF_WdM`6vGAU--#tbaXX)Q7vO&9O!&YVJH+q zALXL?4f)aY>(bo(OiygWla9{oGQio49yuYMomXYBa}*6%B{{tJ<2lbch~50dYL()| zZW#$h|4&=udQaMRb>>JfXCCbyCf3c68=ObwI%g_LDLyyH+S1%46@w?&5VJj9zL-M#m*heeX_Jto7FCpeQjxfy!Hc<2P< zqUW({V^9V|VS?H=^z@FABj!sd|8?%+2y8GRKjBVYP`#l#Kx3v~h(DMPLnV(pR|(I+ zHpSmA^Zo6Kw75+FrBwP?%R;wIu1y?9>j2LY!AEeU;r+*wSRd-4db}p@7ZJr&rO12{ z)WVzaafl2frgn#l`k2`aem3RmX2_RcD}KA?33XLSLw*^&18bvlS5!wC?1epXT}piE z1}q9{ zVP{m+!|2Gv#MZFvqjlc1&EwX{Q;N5& zc~Z4xgWajk{eWHVkTP;GtCPJvG|pCh>Q10k&7?V<#xBiU-3OUtgukr;bD3Oe(xu#7 z!9ANP<<54f!*mIbJFD1x#-%<3F0=WTk`axmd6wo+HXg%sVV%f@j{!A){#?j~ZXxIYq(tLp z(EpQ^mxI2GSsTJX=ObFAQvV-g=|1Qh;xU`zCM3g6B#N}RxSfux)bCeVzeh3O$e#Fn zoUc*8&TNsV;`Ygj(hsBwxA^wZTS-*mGl9C! zmKKt)m=?rRNKBUgmfNL`WvBR-w-1swgTSne;zqEDl zCAY}JXAb3?`qde<&!#PTjM;}?B_AbsYp-|C=AQUg_da|ld9FE5uJ(-#BleF2Ov z^!a({7u-X^i7=i7@3PJbPNxesj5U#V1=`kqB6y2+lrv7gj-~U}e9Y@i+k9g3f90k) z9yN_GHbxvG9u5l*qqW+)>A@e-mIdzf($bqGt=+dJ)6@p5oSkCGyGFZJ)V(fAyB_k$ zddTyik@xCF_8a=oHCtmWFsR$^A7S&z!4?lkt4@jTYx{+)48a~A!` z*=oqKj!{=B-8AoVCkNk~Z8km@lm88ODuOfqY@3%YG6(T3Pms?XMRV|uUc1%S_eDdT z!0w0m=_!& z=k37Qg>jrW8;F}NgPGc|ezSA9a3$jx|TUo`}Xn12}&mUe&SwecYWYDfX)wyEORJ=BT>fN4fjoqjRT- zr|ABfG|u8AXShmoRm+>MXzGr##vGD0?rX#v@=ZHtak#&6-fQ>1DGgev9^z#Cc>NL6 z-D3O}&#XN+;sHIkh?&Iihp3wsQR=IvjYyq`rO7_T_3WcE7cOC6&)Gd_z-Xzq5E2|w zqVt^{m3P}S*o(db?>n?Sm`&t^it4T$N!WeOL2u}oe+|~#fAkxB=CoxDwe4>u(>WWw z;8rlV9;~rHZBF51rjgTpDc6`$*y$Q<=R3|MODf#!(Pe*=fo?bEP%Z7f(YAgNdaTsl zkI#M{?NSmP;BJ-hZ-!GYOPxCWo+nHFm9oU$%{O$J-w6%&25q~dj~=w=KZuMC7hAfZX1q`VS}NO^`wLn;*noLWPobMNliyZ7F`d(QWGTX@%Wo~v%2 zZ|bjN9TU~-{ugH6%$G4D`p=~{VhvF}8>3Yt??qpld+*5*3st7qZ+DRPDqR{fmZ(nj zm!RDy(%z`wh0g*1qP><}(}DW0omB9S3bjGT;&aHXGoAND_#xwtP)ljY!I&+e4HQ5_ z=w}b(USw~|W2mkz>&<{d{T-t)UyVR>Xz2Fmn*^ABizR;DH<<(I?;lVUoP|CCt?X(3 z7pATEB!;_wU-n7kE|5nxN=cf=X!s>k%bcSn)C8=BF%q;-bnnf+7y7H2kLWo#ZS^-ay-Il)-^2c@&YS_Yob#!i)gtM}KK3Sl*QO3BM?WU0A7B~7Stq4@=Lbzan8G}D zo!N~4K3ZqK#sB|Rb>^a=*1ReMO}(jW&7jUSHRkW7Gc{(mb(u5PiuPq0q1)Cz*e-3X z*?iBLuv#7r&60fU5A0P5K39!jS1U_eTBorZo()|?r(EaW3D&Cpekt{=^<4Wm?YW%G zze*ST1LE->X=}z4u3r!QqCRKY&%nohiF5l8sY(3FwOdQg@C-?I22+RZl(0Px-PIG$ zKx>!|S~shSGC>J*xgf5x2oO_FQ9LN46KzciWil`S(|^aA-K zn(t?jmj~D-{vI@CUDbvhJy`mx?P!<7JTnO%kR1Nq$Upjk46>e-$@+iR|AKmlT)$9y zS)WKAdz5ZXg%8=InbI-zzBCB!_OI(b)obUhC5N`iVD_UZ^dItXYih5ZwBM8>t3NTe zB(mprD`H+NY$|z!y|>?Dyl&{L1WB~&a8`%%f3=g|*5@+V`WSYz{%+EdIMC607k+{E zt;?LQNA^7QWB<6`|Iig`&_vkEdmfTT)~_Tbv=`0ahx3snlOY8r>3UFOtz_?3$|(DW zWWhN0tG&h=#JveH9%yq`BW-=HE7}ikjq$4dD2|5kBGe5%$^7)XHZT|co+Mcwj~aSA zT@q7gnM7&?NMq3wXz{R>tY`YVW2N`v|+3bJ|HN zxF-QCG^&?>MPpmCLZ5L%lZa2awj9xzxVoJfs$--+$NQvb=s0IT25bK9==T{~#L*<+ zj_bZ}xI{aasQ))1nRoe-_nCey$#KMuW6dK6f-_MHR1e8l-yzOLZCh%Twq8GN?bp%v z+GnyPI=j%~`_UvF@XMr~gN|87PFyBEh@G|7F-ddZCO3DJ(JI6Lm(KS_14V2b=jY_K z7l`>fkM3ifbHwBK(G1ztJ~jLk>bw4H>SNCAG4dWd*=W6p?TOxNs1m#m+8SNFmpKiQ z_RbL6Wzq#*Wi+fh?k`ivy*x;Rv-HAxUHXR?vICJE7czf z&o~pkzq_4zM`tfHXwQHw+AqNlbLx3;GAcSu!A;E|+pO(XL=zW*= zG+n!XowzwLymHWLO|2wvB>sOWBQI&XJm3SDhJ?vF+IwMwF#OR4z z`T?C_wU?Je=fA{xo;<%$YUzA$|AaU{O%{dgQ`er540VZnZ^CL~|D))GG3?o4?hnIe zM|6dKg*+eR2l9Gj*P;KOd`m4hEOL8FLyeV6djr~}-BWZXVbmb%bZn<%+qT`YZL?#u zW81cEqhs627h7L!O#gHKf6mODxtO)iTD7n0;=QO{>#e=3YCobEF-D1oPkrePw{RyW zLAqCN58sylG`=|k%K7uNOldezCy9G5dl?KUJ*eVGMU(`Te&R-a)}7+lXn(z)q)6F? zajK{nwsIKxbrXJ8HZ?<2N{Mh~G%UP~xRTBH5{1bBY&hT?I%cxTk8ReIYFwSv*)@6mV?e}y#d!XFbhIs*@4d*k*_^iSGaLe*niMMk^7^89jr*Rvj{ z`c7uMpaKF=t4EV0o+OS_XgloO$6d{T$$V&cUXiWiPiPKD-{aY&2e0H!Y}KN6ojba@ zOj%yOXD2yvsu47$$;3*Z=tGhfPI8WkTJ|`V(LQ53Uj+#r6fC>aG2I#l7jwU!jshD} zpA>_?rL2mHQ&V{TQ%6-9bA8op(O4D0{H~+ch-!IdK2(N|`Fd>vBm@U_ZM}ayPS)Kn zo@%<&1^Q-cx~M7_GU?|6(%tbFFO0THxdma*r8=F#a*gz;6A#?bH*@Sm|SZg zzXfBc=H}NT?|l}(1uz%z`SkweUF>%}JD2j!qqEf2sK1=mG{zg#RPpOF6;F+h`we4_ zdQ@#8`@WZQ)p2Knt8U>mmOqG|Jx%H_*r{VhGm`yCFXIV8ZQ8Z4j&&x4Q$$agRoQJD zoLtRzl;1ar=p*-Wccg0u=_$Q$5Ta9!pk(a3VB^JDITP{hLhL*z#r8bsgaG}LM4|@+ z#iQ*^FufUso6;E1@@0{tV900eL6>4?Q&~qRBgf)2+4A&)P7iSaffQa3qK?e6#%_$= zkh+T1yrh}p3$^>L=)LDl`zw_$sY#&7wVC~!Q!(6Esjuds?+Ycfck5PNoYX}#*y-o0 zviYdCi-l7JW-(f;MhT&bLP>TKr3Scn{pU zXN$Rep5wlMttln1kig&7Lo0}r@cb$p#nUEJYD1}M#w1;S?3FS*hkO)6Jhg-w9%vnQ ziIiw{h2Ng1H5JrSJ5*f{#99aVi6uXC-4|w>Kfe(Y4&&EC&lzO2R1WX`=knz*efGLI zONH?~7z8Z(=x$kBc7InixWV6&W}SUOOLjwbkmle{zp}G^(% z5i#x=4)mt+?=JUo6PzA1h@*)b^qiDEM~AGxj@>CF_>E^0-&3vfxSXqAW$~HvARd+M zvW|9SWH;#sy9b9Xv&w2x?}mbo^;|1VD?gRXw-ar;r85RSRoh#qj>kAo9t?;>Ka)Q~ zvUR5qH;Y~_R>=%@tPXk(s~lh2x{A53e$3Q_!OLGrdH2C1eoOEM;@v^4?A$D;cJF#Q zt@wGNHoW0K3BX`)6Ni>=j~DeQgclqwklc2>uH{+lFN#j@36UO*vJ^}48asqniyu;w zAE);zHdbUb1_{?^o`gh;=Iy17-O+gUh)gW;U%s~;YHpf=cuG?^H6y;uxEniA9^zIW zOY2+rs#eW3)R8OE0a0#$ylxL3mKNRY?aHOe`llt|7^rz<-fv8=wKlVIrCnujGV9Q$ zCtaGg7j6qfshx|SIp;cA&3J0OejeP*$ILgCXkMiXs3TdoyF8@be7m1AvNKi=AM-!L zneL3byF29~C5`^(wAb;z2_xlndV8KvT`b*hngT8Zr(kB<$WOM02!GMhB&2%5aDN-! zm3=O#JSO6P^hu{Kvva7F>c~irxHrG%2*$8e#9Pd!fo8#xY%0!_&uygFU}qj0R(VgM z=&(|ertq*y+SZ_~Q+f5TXnU4T&32cKKhnk*4LK&Di$%vz7!tlF44!i=*xTIYs5DMh z#abuRw5ZiC*^5HWJR&Kla{bmf&Fy$QSs1vUEJUhbr7YYilUibEat%8xP0O%5|9W#) z`n@1c;oZWr-IeA0n4o?L!9D-k=J*PCSLeGBxlx(fO4Ba>1_jpPPn~r>%gT||xIVX% z43whP$%2H>IV7m&Lp8KP~XItJsC;duF9%LH2pH*8DH}c@=Pyt0jqh@yM7z&b61e z>C)%RZ@fr;a*?v6YA29qx%MF6uXAc8)lL8DE8?o@{w;0{x+l-xz$jPyEHJMl`=bxm zQyUU{Dq$#1=M`rnJ#ldyXFRG}-P|6gH?E`TlW>5Lxb7H);IhgiNe=2f+ycRhVxdIW~<3WVZe9?tf55Pgwi&plPjtmFg)@ z#sP4+ZzeUH?c?`aH2Zw@H8E;yN~v%z8_cmoTCAgnbO{}F`{r-YHVaXo!rbxtmeiW8 z!Y|5G!4c2wVIaDUdk=KpcIJu5b!<L}pd#YIVUOB3V$HU8!27MWTFSL#L|4(-{gS1|zY zM5Bho*x8~uV?#!E@?g`uA*4)9Yo`cPNJ*@~AI0QqV@1PaFYD_2<=WD=H+f*0W9Fc( zss`BVmxZM$_fgTxv&_*;_g5eTd6tiVXj^5aK` zdF^>s#r%~(PNp&SRjxhs2Yoaqu)*H+D{BUWhD?AFaVaWqF+9RrND%+wmJs|Xz2R&p%QfIg z!SYlk(S7;%5)!pq?-=LZD$p^crmR`s^J>gSc)RK)7S9t)<`_rZ!_VfF4=)H63qESi z<(H{55l9ko&@6@!4*Gx|6Phx&#);Y8>-e>DCkW*p3bYV%st5tRMU)YVsW8f+^ET4! z7M%bG!LjqUYZ2}2)-DO&5zCWmBLb6s1xh{09oIQ`&3f+WvQVx? zk|8=>AlI118f!&GJVM*wU%vukVlPlH`665cw;(l?6oOr_LcI|7dDh@n47mvheGezQ z&D-;8!b*G;dL*!>Zq=`Wid_BAxmfzCYv1EZZmMftl>#5nX99L{$Z>p^fF*F`Km0}A z(Wgh==N8O=Ov>>AVN%&?)2j*ZWmr+PYFQUrk0lpcG(sH&I7)&s_NuD}LB6#VkG&Ux zou}3V**n1pm`f-!Xv5B*5NlWKve-Rxae|x``=Q*k4+8d}W)B?mE4))=YOAz?J)%Cb zevhCB)Y@x$h4#Lov#%;-J9|f_KjNgKEPhT)W8$BeH^LhS^t zaz+qw2T0)~Im>H%zWau`9a9xl8`d6XkXJtXxEj!-DxVJekt2_=H{>$`(}Z}nB_!+Y z4}afmDdf#*2zmP%;5ft(#iyHQu_G#JLJsHPL+GhMlvmV+{TY)#s};+nS3CRyK)atG z;SA^B{c6iatCb4-q9Ywxq8hC|8{xS+-rm{6+ObF2-a{>KAghng3g}?er%NDwhrQVZ zC519qQZFZ1H}IXg!>6e~-4VjY2p3m1`S*(l+|DmZ3;bf&R&2<=+x_T)f~T6 zDUQSr#_3_Kyoc3~*mHcSmUqxRW)eIPtQp0ieY|s~9T3P{ke-^HbO03&GM%zsX<~zv z0_v;;|+(K@KDC4!07 zvqLThe$UVA6_^KmDkB77qx2Psj5$$``8)L_k`FSh5s(XJOpdSaP07Sk@j8oG=i@DO z=ub}M<5U(Nra5*@6)Y*a9gAZMAT9}U7d!W)o^@N7MbbvVs=HuGu=9~x2}rNN~+fa z`^x`X;!F2G7kANTR}~*eYEe2?Jg4HlFN|bad7Khr@6m82aP}@udxpyy`O@Ua*0UEB zoCPv-x{10!^X5A54K+Gw&UVAi8cnm|?voy8S;q>GHslxSUzKa<(T>(XT`IrWcV(K) zInte$Yw(_{txoXciB1>eLc2|O$fNr58usW~tk8NRH2<&>sJ4IDP_2^`o$t|GMj7|A z42*I}o_rR^RqppAnxI$ zx*z8H$Cl)sw{%0%Q=X~`W{zu+duEN8mGBfkmO zEd}38eUAjvUSW2D!n*syXSFt3L6Pj?PbZp|C)0~PBHR5Pp(;`VIei22ggOXs#)k!e zkazN%D`gAc-{;YN$~ljO>K1&A#(g3D*(X0WLww7Sn4VtW2T@*rdh;^wvw7eh?1PQj z46{EI`TY>5suRt&XH8qYTbPL z!s9+LBE6LK1^1baHSfkB&P&*|MWeJ`J*VcN^@lP*%0=aULnDSdaVkI`4f2_d;X8)9 zIxt6oZ~T_0<%~Gm7~e{Y2d$|> z!uIIXVXC&)A3_r($p^%nVlb&DEekqE{3h5UcVXq2Rua2OqeB#IP^s%KcO-CNVPBfiDp_l=@00zD15cND$rjgFCw*CHq~l zFTHS+iaT*U6Wcuwu(3-0_g15hzCF*hysLd7ppJz>->8L9x8%|>G9qH{UsZ~773#07 zGw(R7{!5NqoxNkR*Uw8L8>C>h2P~`nBF8vL6H*dA-8$Lv8OJ70sh*14W`0!n!`5eL z-X*I&a!;;h<4UTle(O2Jk{y1FUobf~-$Rd+Pd{T~$Cw{-@eV5E2kF9&EKTBNS@(}L zn{&){<9FI7YMi3g{Kd_2(#%RvbUpw|FN=kPoO5#+K!If!M(ovcFn0{X8-9XqJCekS3CtF4zhCaCl-rda zc zAXyucv9cwtGmJsQ!KxPZ0y%o1XkS2bFFL{2WEJ#^x-r1)47$-JE51)Q!>N*Ri`nd% zd7OSgHKQwhKb1zkSYk;I@8DbdHR-qhM?-DZ@uSUqrUzaOH50rsW{~$f=C6b-)UD(?n#Ex>TDh?M{*yuYm~!8dGe=9R#e=SBesP~ z4KL*cen~-=WgiQlT`R{og#v78mXVeT-10VUd9!Pf7&m&7HVcU3JcWisgsZcLc;niJ z=JgO@oDDR6%M8!DxDDOX`zhojf3^`1z0&gm{~I*@ZMC=$o#TivuNuues>KqAb|i2P z)!n^vs73Q)JJxwZ)OTkHTLJzAd$?&S(1IG`Rgda@&Vtg(=G4m-ZF_wBR3)$%W+{c# zKpu`6sQrkXVq7PajPKTCz;2b@898vxGz0oOIVicTTiRqv`{UgeYo-Lf!z8&Due1uV zhzi9&nE;H@rE?^~R*zEbO@)6}I&4)zVizI>j3)F&!Ylk66YshY-b5k-Fy{MMlQME!APtCbLl~Tzsvhk{S<;_J=o>n)^ z!B@WkM%|k??wR9ByHX&!=XwOYdc?0@0Vy}sj{VTRYR#RygiJ81lisoo;-n9zqa(R? zKbyaeNIzDWX2suZ-?VLV?wA4RphEmzGDm>bp(i#!2ZM27>)8Y;?!c>qNdl6*YV;OQ z%#$F?NK*#l?OO7^<}|9MLSZ+9>(9GT8H5MHNkvEdYUu$%7Q_KT(>1?t)lXM><0MyL z$M%r3dgS}U1po0;TcNMcet4&V<4}iz$vNMQx7|=jokDkXL+bh~jp49bc^~$>t$4Q0 ziO!NyyZnkXYhEgK+k$O#R0TN}*j2LBi`~f_dgC{loMoJi=&DjIas|*m+S}jzW(A1; zVy*K0oA8)r6$;udH}`;X-(mDYTj-(Ugy%StUa#nR1n%M0!dp2I-`Q+M{G;mr0YDE; z80YuwlJoV_cLvhpTpVk!upyH}`Z?s!xiLP&d>R7>ukUV!wNPdf+KPg(`7sY~|LGCE zCd%fd;mz`qLwY}>5L=z1NBV9$de}__9Y_SNXR)N~FiL)$6FW|i{FR608%ZS?VtEPp zck2KDp+^#7DHN(LnIB40O? zmUgRgF%A)^sdhHTxDArO6z&E@bSV`yV$vrqU1K%HojdK5;ap2O8e=}*MY|hAys}WL zqi}LJKsjcinegXYSkhXtg*sWWVGvak1^J+pBn{-Jl8mJg!79ytJ(8FZSr_6hp(}y- zvsa4L#-1x-w#x8S7d;w(yv^S^(TJ)BMaxfHGQ$;}VHIT>yA>;OOT-#&mGhf`DCP8^ zBBWcQiS9T%Tb`_D%Xo%|<}t<;(RuqZN-n@RQ zlG?9%L;Dx`OW6ovA%^~%A(hNJXKhY zt!{R}W`?qBm6@!4W?nkeH@{!F!R6pEm$^>(y=yqDyVTa0pA0^+v)89OYXAoXs^6g1 zjq)w9$`p-(BlYga**jsY`YEoTpHJB(R!lO(1kMku3c==4Uox^ZZr`4}$qR4HB!74lqVbm!YI&8me#FUyAO*^X}6I+(NR zjq3buReZQ}?G8?J2~zF;YF3}jS@;nVb);z=ZcYVUJ1gB(^&sSvQ*j`*GXkK6s z@$UWKQ@n;O=2=orRx~rr_l2Ay9B#i0FWc&z@K^BaS9dxD(i)fj59NjpTnohnwWaVs zBHT5$X{1%8Z_F4}BX7DS#!I{dqEyY$UxmT(Kr0h#Om{PI%T2jwR9W^Rz{0M@Zi(yh zsUq}#Az~}NHRBgsmxv3PfnrdFut{Pg8GvE-AMDN!nC$s*ArXKgg+l$snJ$nuLsefg z{G>taKr9hC45cZmz-hmv+M&*Yq$!~ywPf+Yr_y|cZr+mxZw};efX;>-*L*XKPLIP* zn$r-qL8!Sk4S=?UAXpXLKeGaJZ=V@iWG(0$U2Mu{t$x-l>$tYp7FP#W{v-7M6C0CW0grq( zNEejVfNH`fw+6Sn^w|c#p>Yc>K~w%gugsR9NAwG*YG6}qQ?BW-)=pGeY(TD|FK2Eh z)Nd2tut%;7=9RXCilTy=YRQfr(&{j+9b^8XHwqg#cmMd7jFyN;kPE*RU%rQ)>X@xh z+-h%41B>5=zA^7D4J%F8=78bOq(`+C9s)0V_r9Q(&_|3F>lK=72VNWUi^*#BmEYAE z|61mAX_}K-lbZC^CDn|Lz5Sgj7$)>a>`gzL3ag=Mr(hfGj3BhkKPnp((W(+K4B6}L z%(1Jz)bXoQOPW6D2&+Pm{>{~;Hw6s6@!9;Vn`{U!Mm)Y9=T0;^>yI0c>npWZn<_P% zv{I_Isxzu#)wyjTZFp>Os-oFb)Fv_qGN)*aFq$GYlQdTwYR%+KK$^dPK>#MF2aeC=E3>~=M<75F^Ln&R^`XPHelNu0_8r$|&8 z2WQERCM}C^FomaiM=DSC3;Sct5aX6d{D-U`iD07sf~X(SP7-je z?GX2l{Wa2O{J@vEN3{Rs@Xy0OBwAjALWw)cOR$R!kgeXpYZinsDQ+xmffxTWX`ATf zPq)JM!4fdhoojtF+m_KYs(XBVd-voi9&qS-hvS*jJuurdRbfEFcz0+(^pF0Ul>(~P zM-h6YLV1N+e6mq)O1Z^fnc}WXx5k%oJ(|k{hAZ+8mlWbh$0-ObNfS)Lkg|w!4w>aY zsXT*+#s?3H&;I6h?F*k}fD#Zr%goX_=)8|FNm?h+uL?Z&$yc4UcO z@AvX@JJIg|{wA~~ZN3EPjMFcu{IEM7U5(Egi{UH5<#J+|Y)w#GP=Qf*I($6bIW$<% zL-?Wwup5TB%z}N#U%&1G7x>ZW(yn?5Y4O8{_J_t!DBL;8W42L?V`MA|+0qp8x2Aa9A<-%F7XtXAky8Ja7-^cx z3`V3{WJ#v+e#LdoIx+ysx*)-P;Jo{(&I7_5&SVFnZ?u32VWICS*n>do5&r|jMr>)UP(T%7QE>Drvm)Lhh>m8o;(6&}> zl}Y3J{dScZ`Mp&!!BA`kJ8OoWF{qX|&00lQFV?j6w!_e$KpfO8(#5@{nwe>7w}I@M&I$NWEQEkp316RHW=2JurD2 zj*(deRcwjwiFCAbHuF*1m^+~irO>M;(2^0YTV)e-BGYVaBy0>~W>RFfQX9077hEyw zAq5p98zXxo?G;diB!%C1uJ2yH+Kc_$0oIcsdvuo6mb7!(9?GxDz*+lA`&rtY@+pE|K!1h@*C4>erSI z!T6brMm?*Iu9Akbb5_rrkJv?58)rpVNmoa1HPZ|(-iEe{ZAkbi*|xN8>}$<#S#!S! zB_X_7k}@iDBk=jL$KlyCh|%TXQAJSJg)YKc*2(z3@>>zI(8={sj9Zk|R5zA6xx3ir z>k1i&)yYDq8*(2fHpKEUV1~oDLes4L?#=PjL;nxPfS1tRIEDg2b7`9z!6Hx}{Kn2JxikZi=3 z24oQ;GZ83``w?wpOF49a=PIJHoTGVfT-ThhtOWc1o;TmXut41P&Z?qsUs7#OuM-&DBkj%he?xn-v9bNnl(%lur1c;ZviS2CEd8dqBf$a{1RAsyoYsTz zqTe4A+KPgNn0>mt=bS1X?Q-II=DX-w_9CYqfUOB<<{kUvG(+_9+%QLov%i!a)4Ri^ zF>_8vtIbGW*T+uwc>z_6hdY1VUUN)XZ#j)h@7b}ZtcG)w^}BC7{Y2VQ=+bae$EzmL zPOhU1eo%uegex;bi$M+-apSatAooIr$&8_Ev$b<4W|g<*)qDSw2b^{CS!IIF7k5S! z5Ue_CLRA@|FQdYL-a;p0`+cJuW$+`wa4ZTXG-^H2c5Il zVdIop!sIP4mk*Sr0+ho49!C1Y`bLDpg#T-d`=)EeYy6K;idRbie`9`edT{#x6QhHp zi^7=jYqMlVOAlh{JKS~*)MwBqCP@~UDx1SM-i@JtOxhs^xAgrWB3pp@|6>ZU|KFql z3nvFB>;KT*Ik{Mwx&G&r_@}$8qHFvN1J=Cjv%6__3J*b)pO@ld{74~-+QmOyaHZ$QSw$fS(P8nTej_@GLcjZ+8;g^V*RJA)m$%p5>gtPrIO zXz~}AC4tWNtBd(%<>U?sU`9!kiGjkY&9xvR?z4+^+&gbG22 zd?6zS8Ig$%QiTUK#DgpvQA`E8jG@3Xgpg>$ROKg6j7i&Aan=l|C(l8-u3-i_f>0dL zWe0ht$3@+^x5KaQnr}sJ)}ub}g?S(fjwmz`2o^cf6uUlj>PRU-|1k^?Go=y=4aQ@q zD*E}UBo2Xq6^NZ4o56*tVN9KBh@E<%%@;6wOO{)R?~=Y<;BG}(Q>xdVR(VE*Kfob1 zs1He)K0wjnXv-H>WZ;sXrjrYMHOcrse)<% zCL3z?LW42SB3%ZbDc+<-mlf$BfXeYFRvGcgm@KwTnx?cPd0HY65EjzeI z>6>E^8)AHz@2+9m@URaDMz14glt%G{%`(e!$*opV@kRCm|&n}km= z{KyresXmn#DFsyb4vQFwkfuze{)RE4o%Hu~!tFBR@j87V}8QsIV>#TZeS& zd@Ax+>9aZn`zHG~^Ur)W0M-)#^V`^q>nrQq>u1o8 z=-d-{_=shTpJ^~Hs^zJ7#oF597a`ghF6liJVRspPQTE5YuaeyXg7LzLD`eiP-gwV1 z+U06j>Q%(`EH|>q;5l$kR6Q7K5gLhI%M*$d$p;f<6XZvk3#EL@!jG<17^M;wgUgl$ z>YdhVQA^S-+WhM^>U9=N(rm@pE7&yOHL3dL%cEFZHR`3zqcy446KpN%*?o!^`1hV| z+LHsUgK&dUB>6fup`;qIBd{%?ww2SCn|4*r%Nqo%@D<|?L4a8TQ$mKN$dH_ zupdU}v(DGXCL#wzBU}yFKc3Hna7FFHFa3)u%p_z)WLzeVG@3o-?~{*{kBg6k&HIi| zK1Jbvry?^$9bbfR~)WBVvqx~@pDw$HY)-u7)y-1h@_df^N`z(J) zew(E&+tm6K{`mv<0~4(G#&h!D?41Jx0CC>*VXi>wxPB0ZscQ$uku_N8bV} z+J|AgE=>cHbM4QgTJE=zGTL*-i@Nj8$2h+yU%+r%7OK}MD=FctwSPxet$xp-2IX<^ z*Ga}}=;s6`+Y|e%{Kb>`OUE77OV6WA@Q!fbGvGg9_i)s$2QHCOOO&f*HWy^vu>p#3 zfQF1dNmg``|D0e$OvwTRP3piYvwl9`&zS*DbaEK^F%o<4cIsnNuAgMTN}(a)&&-7c z|F%fkA#FySSXFEetqWgs$J5RB;G z=ucsBQuuy!tndotP%9?rG9mDp&|f|fxubL*C{0FK$NdgdAv?Q#SONEYZSBbV1E6%l zSj_{Lx}Xj1SR;lg-O(~ecno1M?XV*Uu(}9n4Oq$!_{IBPzXlN)A_r`@5S<;Mx&txd z19*wi-2dusA!xnetUB@^?)#<3K@kytgM@hC{M?f?9A>S@`i7Rdp`#n+(F{5%0H3&V zrW$25qW23>yEFGo@Ta%m^G|8Jllj2)#Qje7A7z}}Jc9KLF*sU%**V1j@b=TIJ>>Kt zwNG>(uN&`rmHP_%;Q3CtGPQW6_e8Q!-PvvX*BD6KNvNAt`>5@XYip!Yp9S8&2NJ!1 z4?F37TezD3z&ha{a=T5wD z_W|;pALE^HAb{RZIJx_SFFY6(sbFAG^CvrxM{)8)3U!HZr7EET1rA>%1A!<~ToIvy zAva&d(Ji`q|DqFr21%zDn4@{sDe|Owt!w-%j zi5C#u15w++xO!@V5%ZU!T62vyn>F?;ZMWZDv3jeu7OQQzYY0~oZYEt3fF(O~sEz3> zqJL7PZCkU>dW|R47Y1;Q_jaZm4miZ!J0;DeesHR!<=x0}EhDS1!L z7djfbFn~%WfZY0zc4zqy+C3RVn`;1C!()JPBI2$vu>ACW{W%NhUN2NNvKxk@D4`Y# zQojGL!v0U6`~^{^UKwLuwGl9DZSSgRQ2A6Dv{lMeDPP%iUf5Y_SJ`D<>{VX3JgSI$ zUYT2&c3$&V-dmY>UI$qoU>%QB9jZxMGryu~(~VOaT7_a=j8ihAnV{Z`QRK92qFJ$B z>1Z7YtAwUjo>@JhRvg*5pw=9zUN8Y!)2MI&lfsbw8Ip}cP0JD~)( zOwuAoud-8_@?XGv)5f_ew{woI1wnPt$ZT{Tg#9okAL?kbnXVmr$y7SXLsK zpCV*pqVPi^c(Orf$Vd_KuvYPi*zx~#cSKWRj;WA;z=5H( zEYi2AAIACVbR!X(%$mVbdnDTMs7A)&;mCtx$$0dX6U;2Cu_;N1?TIvTX+} zBGDKJ;^FBeUJ**h%~-_7V)o3cVv#U~ai_Fze-YPU#Oonock%wa;2t{w(+(D9M5r5F zRsVxyfMN}P(~$Qv5bz&VAu$)|=q^`w@S+3c%z$S*NE$I_Z9jWE;(s^Z`NqOT+NZ;% z)KjgF8=R_1;0y^H`|1_e$}U;eW0nnDH1XBbmMsvp&{mS!O{TSwZT<#o$*e@SnCCUM zR`XT$_ZlMF44yZ{X_2dEsF^Km@v4XT4&gKiWl)_A=sjscyh`ee{Jn`Y_~ zEgp$v5cdVBR8#00$C#Dsl37d)JEiK9SWK4uBi<>R4xPC5KFj@-`^pW>x@Gf)n=>I7 zad1RzjA&Wel2_)Lv=s)ez+&=a*b+JBsWxPbtl(k_YS>a+=eaiI53Hc%@^jEdx-3bq zN)it#F#I*W{PuKasZ0CU7{MP z;*OOC%v63%7l~vlv{8peTK)hOgt)YcxjtK>0Lq3R{-n-{YD@3Tvv`S3o-zB%C|E-9 zm!v#It1C4i&ZD`O=N405FyYsdx)jGQ%zH(~&NuMLD=aTQxbTaPUV!J6C%H7r&sXrs zl|k{rc;Gk)?&|m7|H1q*{MIf|pm478)+|sod+z+!-K%&<-SHOLTUwX)F(H>zcJCU% zup~|%+Fb^`fO_No)D)aocx2V9HaOLIYw;`UTNONYpCLbKOuEo@tmRqFzL-HcDRrJ4 zcfQL3Et~7OLeF4Avm=o$j;KVoD^15jv)P|gJ&|9BnBhO^?F;kI>9DeUy~yDEUZvPU zf3M0sIS$#JLU76Ig0U;?8qhn-b)454e_qHK` z70*pO_p8s(x6ka0Q!cE7Ls{TSmWi^BQp^<;)5TfvNmk~WTIQ`8CXG|NNmqPy3D=}2 z4fjKy=X}nQIVUr4Cnfh2o>$$>j6KBWxztP{$F29<=&!ghxNq+n8pkc3CST^goPz0X z$2qu%tqwteR6E+Xmdz14rz8M6=dzshA^@IqF-NO#b@>{{y{2nM4`}DW*_pNFeC_!h z_+Ip$6sFHzSFt(;_mJr=tPf{j&N&rzKjWd&1I@S)b%)w5#yBqXq};6vEOa05y8MjW z@BCNG{-fV>vzi(?s$HM?-GROwFi>ekFa$&aLVt*aMWC;*H$-6c3j#%{uH_xv-C>s` zHxg#q z8uTtnHkVgg0JiR3Lkw!1zeC!&9i0!3hmS_4R9}Hi-k&o|k+dh4@wDmJY@!Ju2^}$?yB4T5zu@aI1i4?{5Kq<%DOW zZxL3e3)6J0o3`v}JzRD5C*BqM{Pu~Q>skAs=by(%-m~2&+iFeIwwwkTBc%}?#%}4Q zZwF;+6Z^;5Rv%zk` zZo}DdS1?xyS4jBq_=xxj_((bMIj}i@O}k^MJ-{w@<*K9Fm@w>3_`8E1Zy8GW_-+3@ zHxLW-OS~X2-lA}fjIM#_8LIe1PBRg*-e7Z#o~(fy7|QrW)ZAd0@7vhM*fYWH7~!IX ztdsotEzZ`8hS-Yv2VV@{4Lv+3xPPV)#0>?ap^E5|0;?;E=m{CsI}-T`mEq~9(IqMR z69&#ZOweb@KLUO@pb!}mwSh}>Xb)KlD-4z}EP{kf7kwC|5Gxja*fE(Z02q<@(n}Rm zByNRAIzx3h9*jt)VH2g5b`Pv~8UKsK1338r9{=bqy?UK>r2)>F-HBVecO>CIrL*7cOwtU8bpEQYN_A0b4Fe=UuL; z5Huzvc@c)}z*h&HpZ!{z&?kl{*VA0Jz=pacug4K;hv&6hA;&=Juw&=GZ1J%J$=E!e1Rqa>!1S+duW6-+$nAMtM2B#4O!Kq@t}y}nd`2sQqlHStFvAnWCc{ZXZ}~l%?5UIv z#H-?eeHO&|bwl%dwR-lp-Q%tFMed-iIfK*L2g*0*HHvhMspGG$IBzE;yV0u-#^=KC z1^-j`x0o*sTTEMA+rMb9{JH%_9;lxp-^K4Par)p{P^_k&TEgndFf2;yi793nT59S^ z%Vr1}WHu8yPHC(XD^4Rk2iY(zTBTfo>}z>Jt|Bgo zdUsL44W7jxR>e~8^~QiC#%FHE9E};9lbHJzPbekiKb8(4px>cbLdc3Bu%JIgk;#Jl zLzt-M3{6Qh7;q;k8Y^rmSWTVRMOu?3BDu+B zhgO~vxhW@Gnje}=BMJ^Qel&^VuznQhyC;PVe#FY+{Mp1f;i1>s?m1oCfL%Km&Wa%D435e-#^u`02e2)UT)xA+dz(Ialr3)sA_s0CMcB$aovW(I!@tEfTO@NCkh92(AUwmFCz< z^u`O-#*2hHL|>PNoq_`t^2!+JFwcPp}EdSj4z@R7IRlFkwoELZl$1g!5?RqbI z=*5fwBImUVUy<=o2wIR^53!AtYBS|@>J2+g=8K-PkJ}>MiTeOL-GyH*_@6pA@`wgnUX#R{Jo=|4RO|qS+&`|lp*&L5hy;0ve zQgd83jHL;0FuGNT+!N4QuNl%<)lP7P6g=podsi>O>F@Lg1zQ3tlsvvgO zgK>kfAItNFZsv*Y?Mia|y_OiF&1k8*-_F_O zRuq*^pLH`zLoN=ZE`fdc!VnWF0xgpxmjDOv6u9XIv}me*Hl91ZEEYL6@H)RPgkfbnGFER(4`!oifvC++pJ#m13qN-SH% z+^U<{Mq&lRg$RN0FBRLf6r7V)Q9NGzCcT<+1l+Z=K<^0nZva6+zQ1b3Qg`v3;iy_@ zJez-N+5@B62Im+X%WY5VVh)}1VltmUta}^udX~`Z4_@)%lE?K%mPqOi41@LdFHAsm zbJ)Yw{0+e5+3eNDNUn@n!k!zzhkS_(WkP*r444~ci0cakcrHh$H5f%fpXy7OWEDpJ zr$CD~WOO0RHD@atI>a?o70rTsmIZjLlG*aPZ_=kvjjBzJSbgIRr}dJp;|f%Y_!zf4Ui3Aj9*}YvS0HNHU)uo6uKe{bRU4 zC)Bh*plcZ{UxuZ}GrUX8qt{=?=>o=#h8M2wF6)XhU%54GQ`3T9%ix7`uTgTO*g zrFs5qY9(u)P`#QQPu!8aQY1`6#ZM@b-e|ra5Z{Kj*=yrLR3@(yN`nCmKd87+*+<@H;{z^{`d6OY8 zh^f2OJr%W@x3S)VJde!E0YSyb2Ul!~^yH4VNiFzXcH^s!b?2DsQM>cG>EhIAzMyIO zy~*t41|Ea;jOE!ty2Edz)}MaFe~?clK`-eYj5RglizilK@ILbjTs9fNY`cbeM_Wl_SV9L;%48V|gP7^RNTLmMqb6O~2 zo(d))W-4Ktf$;-7zlv?s{q6cNJ2!gLOX1Q z&046*Dr`8Fa38Nt;7=gx37d%sD{Mq$>nvj55^qnJi9qz?rHhv?bm8Td+S^I=;>Am| zd=!m(X7P9Nx2x9>{5CKy#VuH^iiHJN3F}t2tZ!~!+bOJTiLjtsFtC>Ot({`?+Is|1 zsUV$#Az%17Ck}l4q41T^#&nChhT7eBvuP<+)@-cvrbkzHtyZm~)hwEA*1FbsAUP2a zUbeVvy^^omVyX5?-dZ;jtlQVk?vL6`kAL*2SktjXW8`IN0BTt!?MU^)`EE*Ls`DlITdY@BGMGEc6BA|B=Jz&y!|U z;~fh>(lD|EuW(JNoGZnE=oa~?m6QryYh_}oBIWudx=b!xrl}Q zQgq6GujH2<;vo4a`Fnk}Y!^j~-AXd^FInwYlgTbso8GoLEQmU6d*)KOjgTsWcm?;; zJ&{Tjh5l+{)40cL`^N5y8`I0#MDbI0iC&u zIA3KBjvVd|4yPNn^7!yxOdB0)T9XfZTQ}w&2~(}kyu_Xy2dg~u>}!H1&0t5og4Tir z7L<*KyADr=8zM6G;k&X?B$ZoSg1@Nx^QA>F1-Dj7Rfw75i{gf|=e0Hr_5o)>&=?`% zgssPVk9>5x=cNk|jyArssmm-OFdQ(gj1IjvH2&Tz$%b7&+%|A{G_IngBz{AoQPNz% zZyTBW_vIfg|6)StTx+IP9IfP4(&|Wc*SSBw^~T4i(x4<69aJxv4RH|6MuXT9i=gBd z5K~rW$S4QQ8L}`6G_P)qYM%p##> zM2yiYB?XicC9h<(j3l3sFreaSD)$srBHm~J#d`r>FPJtb;j)Ysu~{VO1SYPkcDjey$~dTdjuFqGx1U zR<4STZP^;S`1r@e2qW2G0W$4w;7+Ol9p~a<0 zSt=somE0G0j0ew3B@w5T237;2A$O$2f9VN!vh+k-A|4yh&94mM%Tks58)hrjMSXVw z#3n>1$oVWHQw{P(Ndq-6tZj86h*r- z`~Y3yJBuq>3C;OAuOTWt8^4y^KX>qY88<5Nc5mC6_P)`&d1vr9H%9jNRpUPxdv|wp zo?T@&`qcRB!0>EBmHRZ%J5$2<7~qQ`ZP0tvLAF}HfW#N7Q*71}RA&T1pUgN0^hL#$ z!hI>SxFp(8qAWBo9>iVGD@>=i;l-@ib2=Sf=kauVi|5cRFD5oA{LX$A43$-Ru zn8?b$uWY`jE*7iU_f?gI9KadgtkGC_2G4(r<^O>xI5VfU>cGbfBxBa;OiB_%+fg)t zQ7W^J1!j+-9T=L#NTq?-nHZGNl@3S3yZo1x`jJ{wI5L+n5PQK&tg7L`2{rigvnSx1 z%_31mK(>B(so{eLtQOwk^>QZd;~F?j&Y3t&sxpAjGJV}m#Ot*K`WkPs>-^W8F6&&d z{;EzF>`uf;1Z%K#baN{YXFtjB+@!fvstMlpI zY1g)~&ZF&Gxq>7W^6A#JyL~Fzv$xyb*ZA#bo3+YHC|H^|8l6^6&G6B_JEllSP2WUU zFXZC`z{fpuKjH_z*e^s6H=Sz24hK&KG1ABTu$N^hiSxjp<&M}*K5z@+<*|APL5Al% z-R2H;Z(@$z07D8ct3FY570^9s9{iLJ1uy?%o)*F;dotfoMO zsdxrt75F};XQ)75cb9kS^hV$7hQ=*vS9^LxpyzZ?`&5es{o>%A;~lK0v3j;Nb+WDG zi@66iNw>Q9_|Ip1&+S>S4R*!yhsL+A-~Bci>UPk(9cZB*nHJi1_z(F{`tcp^L++Dq zT%k6rvG)|$6_`R{R$vye#8Sk2OBuuGYK?RDaIH{_rR@E7tkzy@Ut2ZDb+4V5iBy1Z zBH;L(n1EknMM+Ff0G}24c=4jA3U?G$dC%i^aL=2Pz26E=UYLre_FNpU8ElUkWhBPR zmDR#{>iAht=MJHHQ(KLKl2Q0&no}xFJ{y-h`peljfBRa3wNx1y_5T>JwwN~3GdlB+ z?XkxmJcB)B#s=RR8yhpe#b6-V+>EaTg42Xh$7!;KB^OAP4Y@4oHfcj3%{I|?H>ujL zw%R&bb)~9n+RekRR_a5f=A~~@-&4}n0s71%JNk^O()ch33F zF_0}Lx8MEvi}LNVz<2Pto)PDL64rcGc^YQWIC3GW>+~8~B)NNM99i=x3-Y05?`4FzS5 z6;GudD%wU4;M8&|_rrM!6S6X_ zKs5M~C~`d6zYtmqfr}mJy|$0qz+LYHFVMI+7tq)^8&FT<3pg+s9PO)!AN5BStByVG zzfdTe1;~r0N`q5VX@+2cqEKJAunplaOEvpks*wY-L*;U8nLD!`9f0w~q%Ppt3g5VX z&yl}8nRqQD@?V7kSX;C>pPc=0F5WZu)AID4lK)NY=J$tYMtBV1ZcB0bTT#}+s$ko2 zQcDmVXH2~L@Z!0LZw(He`*Bfw=fg;Gz87-9|NI$PR9=L8A(8Y%>}p+_r6|OX1Q86e zRD*gS>Pxhutwbd@V&*Hsj6F|fq~#nI6JP03DY6boIp4!=I^OggkUrnEKCgo4l!mY&kU zNfl`zIqs|9%R|ND90zZyX39%Np44k82G%gR@gr;zPPGpiMasx$$t!Jp;(LHD)Eol- zU{4STb{&=0`J4Sf9rtFupv#qZ0kg~J0;U#E3y5(k4lrCReABdQK;tKYk!mEditnph z6#5_*!2=Q8V!$vV%eIM@*Wk`4AxXPJTh!L;iiekr1u)5 z9AVJ~ZElu6V1S+oZtVIMw%FKk+vf-!Ud-*Cvl-2q?tk~4-X9Fj{Cxhzdu2c62-zdS zptHpuo?Og&hFefAt^d>6*Y}J?&1a`$<56?@;2YR-khuB*tJwwR;ivEiF}c-bg|QkIZeJqSbLiKJsC=y}3_ z4Tg}-u6od2+F5sfPzi7pg_e90`d5R|3|YEy=;ad7D{9(krfH5+>+~CU(RWCq=DcAY z0IYB9Z0uLRL$7L}E&!DVCk*LF4ksFYL!Z0&B1-Pugz&abL} zsW&+U52cfXF?+scxt4J0@D7*=CIJjgeb$=TLRtzg=*-~iK> z1q+xpT{3|ijp#iZRnbc{P?PAg8r9${I9%|k+PIn&>s%$gTt%OC-LKhd$vD6&WkX%s zW~*hRAe(5}E@6+m<{!+R_~7K8&iM!PCq6h4`;IlWaAwGVDK~g!^~|Y< z*RumxRxcNBolJDk+!`N!`$S*&^er(Nz|HvutVc`+nPkUo&!rx4s0W?xxFm)HmsV$NO5)zrFFEW`ffzHB5r{rF__$ zH1PUr8QwD!_x)L3&)74Jh(3v=sPL#HVsESK*$s12O)Bs{P~s|0lbttNqVWX(GU7Y~ zy>Tn)^w@L?48`VQ?!h&L#uO>;UH{om%-xQsJPnvytHHGfkw*uf{{wsu&zwP~lYKYR z_tL=3qgozi0IC3J|0iyDIIOc&#Yc77j!GwSpFY}orW1_OXeZrCv%Qsmi?S`t*5?N6 zdnv@!BtI-X-9AKxj6iWrFx0AE1e+~Z&}WQ66Fy(J z-{JE07JG!Lbi1~Zp|m<$2h$MFnpxHxv$yxQJDqLa<6_~S=l=pzijR?Q$PllgG-a zm1-rHWz2d~qjYD^yl|z(#SLas1nv-MjOheRsY)?tJHq z!NHI71KY8U%^9!_7{9PhjBOlVwnHww%&T==97HHYLBx%eK%hmGCKS2ERn;J4iKLBW zl_D4Qp$HYxBJyq$l|W@kR7XXCef{t3o_)O_)hqq<&3rpEyEF66_kDxhShgf$z60t# zkG~7wioD*O=u2c-_Mn}Kd#%ZmDctJp^Uis7nHI%cmo|NGQ>|OgL40hw4IqEL>=0Lc-DZH=+u&kBYCV_uTw)7n?hkDt*SysXT=XlOUiSH8W|&XVnteMwzWU0JT3d(!JX4RKmz!L7AI^1}9$gw=bo z%WC42WWOeALDZ%)bM-zesi}>X3!la_ja)BEkt7_E*Xb#BYQ8P1h#9fTub9R0m}^#w z)55MYHp=2rborfTHhCM43TrvbmtbIb8N0!Zs>^U&4eU0P?l7a(>$1DxElw*5riZVY z5Trz!^k7e zgV%;su9;4$Ga~~lQ>C#Bk#d&P@fHVTjRKFPE1heQat&o)J`LmOpbT#birZq_{o0l zeOUEnE&nqbwOuN8M)pW*SK?i^S7eLLg^Qz6l3y`7@JYWT?)l{0K*0SscqNf$N{-#` zWYuve6XDJm{zeWfwbV*mXdk^mPge%(dioUETvb(^;$173w+)*+hh1~e=bK&m`7Sdr z-#ScnJ;f<~-nB;C&a+L8Sy{H=*{a6SFKm=A?uPk#)EpZXS3>PBnCJ->sdvMIC!Fdv zFON_87Iii$9Le4MX?LUPa5BYpQL{%OWT#6cg7ftd%k_)_1EK-n>#y9_n7uIFp3&C7 zv8lHykluQDWBOBFp~9pLzfFnvIBXu9X;ykkYSD_4$1UbWi$Rjj$v$VnlJ>H|noT{+ z%DdMr&-ebvo?7^L^Uh@{p2DWmh0VpDJ?V8jY6{w)tWH_5V^c?9VN<^AzEocl>Rgv! zw!W!4t!#U1QASl~uwV)gN1mNRiG{iEASZ4Sj|0Tu-?5~1;T@JC& z@K3|Asn5lCBlLriD6arVXxIN`KtuT&_WTyU1>}<`UqM+TDCA=7vmks2j7`;R$j@uS z_cTdg47pF4#sFm+-kurw&w(gj(&cMlKR6owo*$wtRJllRDvN2GvN#-? zii?Pa>@NKKfQV;WEQ4>=C?aIN%>npsmU-+Ab)-IZdUVd@rTQ8E7{E-wm+dtK}-ZQz@jaayJ=SIt^%q`@nm` zubjmE+9CJDZtqbW8>dxM{$M5L^80iE{x!rKX%lynjQD<9=S5X2M4gI>I`Q7E9Hz6% zUc^Hn-J@gJw=w<&4Pu`^mcFI45txrwLGDu#dl?k@q?(gyAb(Q~n9FqTxZO~Nf4E33 ziU;p>^!;sCbG@m23-)IC6kHN{Af*B#k0MD3LV*MXfdGaW#56{NG8z%&RR$j!q_!dv)5d}X zD}tB_rP!jAYLub2Xt7XGtDUhFYhx8rY;7Ur^jrI$bGgJ|ndu+j?0p{lz4lta6`XZP z{`m;z%i8E6`Zz`X4Yb)Ol$o%QSXj=Sj!~bB-uaAvj={f~v)aWG&QWzz=YUH&@0-zm z=k(A}?^>C{I*Z*3zEu$OE4T-7J1J28lF$>Jy|tH;Buz3cuocx^p^jK3y&%m^l?->M z6sWzpchhDD|Gg_Ky#GjjbU4qWIi~{Ny$;8u!h9-=qK5i$DP>yq^pt~!@bEe-V_lFa`>LZ8Ryt|Rb^uyam`d=Z@^xsdhbgY zFGm)*qljajf>_lD(x|7!|Xu9g^?W$u{pG z&x56-m(IJV;1SwaF}EkF*Rwa*`lmHEv%fvfG}ac7@MSfT%kX1|75vJNpv1CY7C42{ z0*C1%_U2g1@c%YE>xu*4rnoE>tR z*&L}hD2U*>4{>6WVw(LglvtK*PKI}&#B_lR@00L5!7R$8Lbta0m3Zb4VfoNWs6RaKBTe z5IbB%EJ`(Z;9qZLej6ndUq2svTgDw6YJP@&?Z6f{OA%DV9k2k#1ZDVKtp9vzeyJBd zzhQ07&-6fhd}_7U_0CQiPo9(MY^HoyN}P4r*`H)O^?dw$k@Eo@ks{7)0o?Tev~?bq z(df|;POgl_euh9-TaKb#y7Z;&51AMJUyWag4$AW;!ZgWq{dh^fo97LNIw`PBlqp^f zEQdNY-8>mbeVnKM`)Qfl?kbt;t(3CZ9_$1g1GS@4P&+FL>P0Xvc-DVrLV>>XnuvW( zk{$gkd!8i=onwTCX6dYYLv?`0%;-|SO|rH+lRLL5;Bdh2V_6Y>e^AQ~!(>x5S9ZCj z(hr?<0;;i}8)4K}l$)Ru?u6Tto>##F^{ELxbddxxRmo1OhfE@-X2H%dX12)<7oe*= zZ+ZMn?AFrisz&0Vmgnc6ZRMiL%>Q3`BYSbB-H)%zZ}Kldm>+CuoAdI4e{e@jWkf;) zUM!(LT#CP5Dz&XhC-#qlO^F!a7Ihb3h14lt=LA0q$}%nEI?{hzOSL_8XH|j&ut0td zTWxtjwz!RQlh+g7ln#{cGIT?LY9`I;RC7d*N=JP4fDrP~1g0-B>I+%pG|4nmK=~|G z5--bTGP%>5$enONx;bz1emYw6QNFE$Dtypk%B__Dv~69p|VF zM7!oJYqcCU+x#cOgIA2pjme(Xs{YK>p;u7Ke2$Cg)l$;(tS=rHL_L zjnndjfGov%C(_gQxt3VGOS(|6QOx?tbqZ}B56INqkMezZ$+l6RknXw)myTHw>7}?wBE6j5@;4>S+xY%tQ*Hm-uEg$^yad(o zSU^XaXbHbHN*+0HwxvmO6!}Q5R~%2WEJo%iky?CGt$iL7P^cI$PGoMtROw@BkiM3k z)WP{!7AM0#9Y#BDz~8O0d?+g|$22PVbn_-YvPrVw26Iq`w!2Rn+R>M{8wN{5tcHF+V_x`s z@}uF_XNSHyi7+NaQ~X!GK2q*^%&)zSA->(N(0{)~-+YVBq|e8wr^WjY;>kLV9gH)I zd(Bww;?)SNMiL2f+9+zW^G zyh8A$%7CD3(0nsQ_vbuXtT$3?6gVx8o>isrD2jk9~u zG3>SFcDdTrN+-7`>(aCNCS&(u+!r|u?3X>5ZwB!$PcG5C%N-~K(Yqz&yyfPk%yvrr zrszcSr%#}g{4Y&9aQD;554U-}Y#iN&7M`y0!N!Q4*y~WV%W|~Ubu!wFkO{FV^i{+E zKL761xa}Xeu{n&vNf6h|Lk$oeNcp0F%Dlv#sPr!lV>*3bqdBGRmv43s`y|)4`&=f( zwSj*HoC@1GFZ;)xm*uDYyUdRBgiLn(`MuGa3)zqPCWC(C?aNwg2-N^iwQThq*54?Z z(SEW}F&p^yEt%<@rvHCQck+}nXCk>8FvddXD0BZM@7rPXXRz@M^sw4qA^SZ}8Z_V3 zG3~zhJD2xTmba!Y{X>p6fb|dKy9DiTh3;Bs?X>|PvUg|o?3B0<_pgHY;4j4OZ6V3? zu(Z}v!F%>msbWuCD2q)h8oCvsJ%qG**7u{WzjHw)l1S zAN{5_^qxHF+{;;0clP+7x!J65BWRm@iMb19g7ZGQ;RtiyOCNdC%^X3?ye8w(JNel5 z68A>#%uCY493rMH$1Y~bBC{AjJJvt#E|(?TrBo+X>LcWq=4q*qc0v!`<)2ht=FQ^Y zv&``Y`kX@hNixaIz;C0G+^4XOKa$(!@jR0`uEl3RNWZfrJ60?8?M849dq}6BMzl-@jEptPi$QV7szV%zQh`Dyw`7*zA zdUT}fQN|euEs3@V^GAVXT&mJ=44l$)3?b(Q|KoVcc^o^3?%R3% zm-%u5uBtfW_;=3Pb1ozh2u;NpL?HBI193pqB9U~ip8Y-CTgrtSaMuK98H;c>|fQl!9uE|0VrA78As z-A7>NLLc32o6_k2m30q$>C(k}foT4ZwX}H#=JSo&>seA_%GR@A(Tcc_H_t;MFXrVd zV$5sh@6B^%6#Pv8^Rg~Vu|Frr0I?R0u9anK79^v$ zm+6mV?W(+H&irz@94$$WX-ib6E|V^nOsREe$dBBYCBf|{xz2vx-(WSbHU{nWAvDg` zb03uZb78Sm`XaN?xXe~W^=|`xZs3g9Gwwz}^U%{nZhw8+*{2UWf7k2Ly|BBK^;jl3 zDpzKE3uAh>*y>n@m(Q4U8T;huorXq?H=YOby+M*j+jV{+xx-70DH#uu!rEMehJU1g z&G%Qi4b7NE z{w4Z-?%FDHr>hx9xw@S9c|4C|UaUFmwUsptkvrCrCuI4fq*C!t4YT7eWPVdrl}zvl z%B8^@^z#Sm&#>pH&|K4z(mob;2+~W^Qy1SR}ct`s> z(}&t3EAclMn;cW6=}&E*c?w;Q=b5|E*Y@(vm9bp2S*|ttrp+~Dd8W-VAC(DEP0l%$ zwVCQRkvlZW6mq;t?jF8d%lox5-K~*4r@w@bAePn+YG32uaZP>B3*|jBzVbC!WwoZ&f?7Djoc6U{S}fP9AYfyEbPP!?nV=< z@q_P4u01OScon>aDndiKL!F~?7w5cAjcB>=@3MFLefp5Sv)6ET&AmJf@A6d3S^Y`N z8RfjXSCC6CkcsTolWH4x{bX{uqs-|#_V^su>JaO@T*fXbG_L;Cf9m5a@GdQIA^7Fa^7Nmy<`w;SmeGT zOWZ}Q`5G9?Z_kAVP$hZp`~2pc(f^+_TQ{2ZcRr(CH+Y7=8zqTAo*U6J6^V!XMCc4wsj|^(ekW( z!PpPG&&l?4SjzrbeQ zSD?O@_!X$%-m3rBTxc8*e1~zIuYJ7F|Ce#J9ZTDBeC@hjV4c6qIJTW{9I8T^4Bjfo zQ~z<2y|CmdaZ;fttcGguN_mC-`Wo7E1Rs*+Jt{wTFOd`8Oum~b`&(ifI%D{~6nXvS z5Ip5&$bHmJ3-yqF2CJ(^Lybn7eO%A^ZjwzgYAnt6oNOlEPuwJOW;dijvzKkl&0eBx z@_M5y8B#;}6!paaCb%bT`DCnqm-mj;5g#Yk@Xca;Qw`@&ypV|L+u$WoPK2)9w;lhOVgGElkPKS}ys<9*^D2nvn&Ah)o280$aZPv`kp zGQ^uG6;7i*Y_)s6*qp)mWb5_faV>r_j`78nvY7iW-`~V@3Lbo(%rO2Hua>3O=?ZmJ zk0m}txvwoB&=K{#E%RQ2Sj-Bx#L*SOhk7jWAC_UoO{VPBxL z4)YxGld1ngM@&5wsLypcNQ4yHP7sYD1bs(;pgkpAe;VX(qBIPTn&Zv zm9NX8Ky_z63DJ4^sXVXHzL}d!)&=BL{S5vH`pBV=GWw{{KIKR-9E$knNn0+5f>4Q6 zhD!AHoyIc970huhb1Y$g#Zb;1|6JptGxZsG9v*>XHYdo$A7$zWD24gvoLva-wA^kW|J?B{Sp;|bt7P%_g~|{x~$>l*gejw^80B4Z$9?=`}cl2A$GA=@!xCD**y1S$8ozww6?}#3@_z&Yf@EzQ-#usdA@flt5>UazLjHihE3G-dtPgq~j z4=ou4Irz4#7+W)bg8SZEEq&0927Ev{x!85;Zr)YGLh3)4WdDbFg~z$Sd}2w|S9r%c zm(ly7k1CT~{}D-6cgRMy8VYE4ha?#AFb%;NbZIpGeai1qHvOqNvN3pv7{9NR^a1aL zl+b2{!Fyo2- zNOh1T5{#goFLPBcb7+tX^(y1K5p7PDUN(96)tHvZ<1GQs+v2I*n&C(`Fu${BL8x`s$!-V-vx zzf&sBT6r(Yl`uOPg#Y?nB2Z+Dtx6kr~WVm}7W1rZ3 z7?Zb9hA@^Ye;t1CUb&oa%KYhavA>NmG}FgH#%%6BkFhV)J24-itDZ`BkWA?Vj)My&|{zH;VW#GKQO&!@rnAwM5t#qC}*VoQ>}9 zfanxcH--2D1>C$N@ju-JIsaq5+=HvA?l}Itdv^CG#77DdQ-~QU5Q2abL;;mYL6OEd z69nXC3WZc2!N3q95+8tl06qdDiq$be9&@Qx22oIupdx}+d=(0`PC*$T;B-o@GF5Z$ z-F|+%=cdsPwSV-^eCF)k-E;Q*&hMPx@B4Gl5l1m6Y z!tz+5K67f=(^Ybv`#k=61i!x`z1_29tUnq*J|pE>k8+mY;T--_#(MiXJDuesJ%?GH zrPP}v1Kj0unRf^K`a}9X$lkwQs{Hfi25*a;=N*>ky^Zp=NlGR2Ur0OMIUXx;j*II` zaF|+ZPekTAIN~3X?d~x2)e<>?f5y2ZT!Z zE!yK6sq_ah)Dx9fWf2h2p-o-ynk&n}p zV%%}M$f4Li{C}g&bRG*PwpkNv>;6$znsG75jFZ>6-a@-s?|&cEge#&wlzcU_n~3>O znJw&{p7NaK-teBreCkH0UgpxyAnwn^=5U?8^4QVXA7oqjZUgU>$&Jo^Qp&v7D$ZUh z4{Od$?Rf!g!@q6G8)KxN`}M>&%`11CBg|nL*Ktc`KD`*1_(jaB5AWx|P2{LYdEQgj z>RvZ9xwlrHVvfaTlBjJ@!!&D}UOxvFBIz!tCOQ8m;Tm4@MRgBR<+dCrdM5KNZ zk=zIma6Q!WW7|G$dDHS|OO2)0G9KoBntAx}Ekb%X-*g$5yW8`MvOwOpS`!&{(s$$zt5uUkc>#rh)5leNS_mt z{HNus@9+hLdRrE2j|W9LMAT=N_;HPquRI=s;GB)NfpPFGnM)^Dnd=c9X1kk3nGre7fa{Te8U zP`&H6gP*}q;VLxkYiR6t_Wqsd+0Ue_pCdiE?&|+Zx~dNLR>*Ml%kZ!TbkQT`1?K-T zJPYrm*{+oK;XUOgbZH-Q=WJ=q_1Wm>v(ZZhXuk)|KpEAF!caSw$i?2BP!hqtbx@}* zx-)@>LMOvYv~tH#6DLA`g(f{F-O-7c>a{mZF7-Q-x6#I`Z^+RJzdC%k8});Zxz4{H zrgB{(IjUn7^jgAOA8Pe(_Pfi`SL0x~H%L@(b&8LbBBxS1Ll3uzT)i6|F$A4+HQIF- zTA&j)E(t#IcZc;ycQi$lcRPA$H*1JaKxfv)CI^R2SMpUOxoxWqc1Fw6*io65X~Wu% zxqGG5M?KNj)JbnNTy z4gb%U8fzH2cZ8cQh0OKuv>SCDGyly&X>zC^$ZLhMJ;68LRl!GYm*8`67rJPhRAzUS z>UcYB%~ikA{}U;91L`!Q5&EbE-CwQ#^iQIL)^qj>(Q=pZPD5C$RlBqC7k-MLCD(eZ zWw6;vE={0?GvnEo8luS<=5Y=BTKN>ar&2%U%S6SQBG-6B(0m8+@f>-R>jdkZKyPiv zC*9By)0lgbxy&-7v59A_f9Dn^NFK2w;T1&doq2~^vy8sw>IWw+d0xlpxm!gYxhgoK zHCgDNTj&gXd@gJ$~oVl4{!UVHXI zACoUvdsF0G^|k6y^O5B7et*^A-cZRiliA;krA+rTdU=Z0p1Q~MtY;nJ+3et(u&!G# z3(S|Ck0!|t_b9eIRea|mX@f79YyZ#|wRfNVL}5SG`Ulai7WHlD-|eV?$O|odu6aZd%QUDPpK2Pv&Y|Mf1Sb~7xJAvDMYU>2Xb|Q zrV4V&F-dcwtme8u41fuM2ZM=#rU|z34$3_BuC2#zj1blAN+th?z(_mBWSAAblio#p zi|sSSKA#o6qrdb`T$jrK^b6Gtu>#{pBjSv>Y^`Xw9`S*Qo)vgldf|eAmA9mX`mDfB@LYLJCM#jT z52b`WcQLW?hi(UINTpP6Q_Mv6!+!kHhwp%nqwiM6`I_%Fa(#ejJ7~XVj3npT+Ly60V`s+J*7iCVN;mz6;w&H^V6Wb5 zu{UG0wcBh6ZdKIg7JFOUX>Dw6AB@hlEw=7v4xQvj-hTEsxxo~XGY-pG)0Y}d^F_Xl zaRw8Y$o1Yi@*6#)UKzP(o|MOv)RIqgj=BYD&Y$>=#ExgkZ%NM5RL;urFdkPDqno_B ztj!|UUi0N1DYCU~lh(Pcoujp_mxCRHzNp8P|~sYq}cQMZbcX$L%ZX(GRnVO z#`u4gW!}3|=2h@~AM(keRCK!uK>*d-z-@d;vP03F#(bu6PBy@5GfFlnoco>sqP^aOtElb(j{o*?UuuQ=K*Um& zfWZfdsfuDuqC*0R7zmA3f?8gI5{Y1)R@;DYK%|0JZ!#*9!Hg3h^--m$RXQCUtI$@d zgHu6ki(oBSA5|xRRCfD4cYjy*UN+(8(LX-(JLl{m81U_AE7 zp~=Dgw_oA^vsg+}@8E4I;Td!=9#f2X6Z7k1@_GF4^0~8}F}jp*=X-K-qFhQCW6R{N zPyKdhBITRq2D#jCcl%qvz!i+m?=T))u@UPqSv_a^wFk&#`%J!%3aN9($+kmEWI4~~ zVfQLop4U$$evTzr9qz}jkxh)%GTJY6PPd(nkd6$kd}xkGH{RZu3`Yn+7f8Jl<=1?%C?j z;CQB zI+b)KtJbP-$#j|vuAuIZf}OYZ`Uj~qDBVK0YR$~!k1Wphz(-0mw!eigsKGJpN*(P{ ziGJ;~!8_%Gd$CUg^|^`8h-Rm3w-r?aL}69XxAbR#qt8dGmxby}5V; zGgSOz38mBz`WM9K6wN!rB8o|`M7wkU2WE@>>VMp!Fz=`QpLhMMH4HCEz2sDq`>NS8 zzcm;*xw8-L9%VTpOrA=KtutQFz7Ier=MprJRj=ThCV_%>GekfCl)^k*y?c%_Uc+Bn z((Sr93*C7v0DpQ__?a(FBu+L*On1OXE;;(654Z>JcYbI}5%;zEc|hexdwODh+B_J( zumvZNzXBR4L^*QOEMTVf@)fXZa~2*A&xuP*=Df3S@MGAL>%`L@Igf9&b!9XzI7Qk~ zFH72v&Cn0*aK@FavK#yAFr7yN0EGTc^irs>{kTQ-{I#6FleuGzDecMq>pC(K` zy-)W44tnC5>34c@iLY>I&d`3ERuMJ{5IjJ$1XHx6DuYH};uEq*neZE?jiat%?ssfK z$67WSUZbzOR7oOUPZsnz<>`5%fXmXA9dC7 zA1rkxcA#X&Caf^2|M}U>u#=ensZRI-b+9m&KFn%ch>T;1dB6DLlgm6XL+s=BJJ1{W z`%cYlQOV!dG~priV4ws)E*tkUrF2%8!6=+q^}{^ z&9(0u9onV~P4O@;*`*xy_O!uYM@6uMW5*ftM7Of)1^ZaL^#gsQ?D}=S*KNC)o*m%Www;6(?f-{L2!Qs zKjI)5IfbEkoRsGNf4sa}`nVm(V+MCMg+0T;qcY|N5_Iw_2xB>n8>ie=17D8&1uci z=0vvT2#>uzxj}lpEvF-kNjt6DPrUD)q=9*>z(O&9>#!xlm8KW*F6hzz6sWt7O4+Y*%#AE?S057}(G#g9lj?`8!(k|TyxkVF92UJl z)q^p1j@wKZPN{a^$L=G}cAxNFGs;oJp`8|4s9sg*U$vSwloOgOpOYWlU1IAy z9zAP=ptWcjtlSXTnI5{aF)aQTjz0N!wEJ{_Ub=aiZ#>~g7dLPO35)640v_727(Aw} z5`Uy-*79CNx4j}#395;*1wBC`lRm-CAlA)Rqr$G}6OrWoZJ6^-n5r8TM9+4W3udUHcDjD7aWQ$7*vfg6Ky*>q z_M=!VP%MuRK}eanJv8InE<{Xfg={c%?Ic#TUf;o4ltKpKXcU_o){{?i4|FBT zUg{Lf3CY>FU$22m%6JA0Xn(f)?y6s}Xi)ZGTK4J0IN`U6Ygo>>NOnc-pmAH!U+9W3 zaN3q^SnQF#;!nnd-J)3f#env@cRFGhNYh~F|+n0*zAt{oJml+e2a|PAD6!)z8Y3msB znd=0Vj?f%&z?yPMho^Zd9=X1~KH>6QcQUb(9-zhoas>+#{*z3qwY8MiyqBRxzSqSl9xVdYT<(A@c5R&xbGC>aKzsSt=vUI-M`^Rc~ zbE4_gt4-0d61GVie(4ea<^*G4IDCtS1p1s5>gfgZJ!1U^D&nMM_u1)XgNx6fiv$t4 z?ymP}xd}sX_bqDyH+`=%@0tI?%b7I~?VJ>*F6?-gi zQ!R=FYAo7DZzNMtd4c|tk7Kb}?>v~mX0w3%#&8LpR22cJ$4n(n$7 z@34DZUVKlxYMrq*z796JZ!Hct79PDFy=Sk|t};o9Oz8}(%rT_pZD3saEN0&qaK{rO z_QEdylE#VIpTA&E9j8d$8w&4Uj^k;zP@HPR9#$YBn3v38?jI8<-C&Il_}GXB_J~XD}u(N_{;_Ve*)&xlr>+ zB8WxgDQD6nAmW3s;f|=&2}tMj%lJF=qcaotC{Cn~t65XAkaD0}Y*Je9Ac@$G@J4IW zU)bmJdJ@GotIS9IkCn*?SBg^O%@^1lqeX2 zp+`&9yWQd?Fe4E1v(1!wq3j3{d~%V48*(Xu&cXtfnDRDES1F9t_8B zJt{k<|14`}z0@(WUEJwpfIi+%iMh}Z+vC$k5J`54Y6H1rb0Gmn4 zm7o>!7kT`z$j&2Ag}!js%bn-3%zSv3LF$z}97CKb*AM3?oEV79eFU~B z%oQ05yy9DIQ40H701xUm*59avIt^SKuz9yP$VZ-2o|_Vb*s2=lat6CS;EvoW=1LYS z=^$s9t#gDF5Wb<_L>7P2+n-YOnW^}N+_8^~qF`8eis((GAHBZND_vOL9*tig4Z6L9 zn2l63VCigl1bFc8_d4G)nM0j$2H7X`H0*A!?W_w$nvNI|?MC!>7%wQ}Hg5KIV0#2+ z0UzP6U)eWizF}%-+8c#d4cKCn4A(qhJ$fW2qMy%K6<9l{&DK^^sMT=$J<27nH)@1H zE%!f~1STTao-`+Cwn`=1noADcQ?z~C$df%do})Ae+1GZaR8Lz?ifmBy59LI&g5I*E zaN>Q&QG*Z2u(&9+om`Gh3qIGQHlfV**rqr}9pQi8@15%rB7Foh(zy7u ze+(lp^it;-z6Vdm+>=cCXGT+3c``MmBO}E=ep=ElvC$RiYYI+yPMWz^?n*EjplycF z!hZZ+ghlS#EGAdEGdFT@(HUO6-948%*adf@=$sj#252YATKl2sDnj(og8x6XRJmNZ zDOd51gklN?GCwTFIQr7aQTSz<{77~2{D4=bKWrrHJ@U8$8?y3-X^B805}GPz_3aGR z7PCE=D^908p%(_Gb-$rmA1V$506*8e5j1}y}LYlA(ipz?Fc91TT>WkTp1NQql znFUD0S7@luRtqgj8X*dA-uf2K-_(dnA^dpo&LwMh!V=lu1C z{OPyb!8$aYBMN^S9Nm`a~U?_j2^sn$V?ia@lrf4##?#UdW=7xHCMqmxKlF`HQgmu-? z15^$5D?5}QjSbrbBPz`Qc4BU_?bWLJb_BMc%@y-4Ya)poBz*c(bJ%D$RIS|nzhiqU z*Hw>UK|c9hnvQD3S?s;I4Z4)H<*@0OGw>N&ryh%AXlNw@jH~LHb(N7d2NK}=bj*9IeIi-W<*iv_yWiDPSTgm@=a?36eT>9i1C#9K;VT+YAF#crmP0u-!C32 zVJRLg5rkbhcC9aba|;@jFi*@80bRuV9$6Yge$yaxb88gOO*2R{zl+-I>p2KBmrh|_ zRcZShzng{ZD4v90o!if8&L6%DyChu1#S5OGy@u@BKhn50RbQn z?STEidSlH0FWwji=5k6EdY_+Wj4c)_?~^__BD{Phi0jl z%M{w~et4s#Qq;WwGZQwMJ-oOw#_X6ovMIB1W^Wfj-6%Zyj>mBF;BuzR_}y(W{mz2v zD?@?HunqX8`b17C3uvTWxYCEaoD&I(6CMmz=9O$+Ko$x+_&gm2Rub0}gUBLgcV0}2Z|GW0V1A175W z)$9lf=ljaV{#%vAmWvHjN@8VIv2yl1c-ErO*Y$HAZl=)Q1UE1mz*gaC#{YG6S^i%} zmw}CeiS~bMa&)wG^t25BbGZMTlN;{QsL^I}6l_=fZ%&R6T5OS(XulgTwAJR{-+2n% z2p|{U&Hdok!B#Bff)QtZd&UzqCSehVkwFG&`gl{x{dhszxLmXWI4R51>=kHqso%Uw zo~4tn_LuG#>z;S*r7u5#*E}Ssv4Y{p(5lylUX6Js5noVyfFVR_YLWk|}orVuJu=^$G@Kd9aiQ!j#>n*nKkWpMs ziWJc2HcSq5jmh3q_ zozBF}=ma&jxwp{k2SC;Uw~2OM2coi{G1Nok24ww}AKNiZe@ob-OW&cj;vX2??f@Rr zY=X|C>GE1}e^??PYO(l9qBrLDj+wrCRl~bWs4xRY=sVwus$O9BnhioBbG#Ol$gEu} zuAgAMIf>g-P(6ki;vj*z$83N+r^7KJ{pQ0aqR*QOBVq%>)r(6Y4x*mX<_4?E)TCPb zH)7^!sj?2y4`%v;+WG@ZqA4!i?^@ zH2b&oAbPY2w0{z4(aT2tp&w*JgH!_%l*cbE(Kp6X7d3&3DeN*=HvL?AxNSW z>E(cmtTI)-o=sn!~7!Gt4+D3_Vu4&0`(!0bUI% zIpuK(V3R`X2<^i&$zqa5L@y4B%JXH8<_<+FR1qX%LnaCme>qdOw6#@9X0gn8S4>)n zgEJ-N(Qs7?34??+BsOgv5g(Dd%^+;UUtg|$K~}jhx%TXz!ZjqeA{i|{)C>X2OaUoE z98tC{k+B}L@jR3}kv0(zId8ovzI|vFMs826%zm+>-Vnw?PanIQgRE4Qke=Xz#QiG^eHqjlvg zt*c7sg+Zxb%O=5?K7&ANORBDzNFm)U$SmY6R*jz0*vG+_ZFO_5GQA_cBP}G2VR8*# zJ`lg(FwMlQv7bV1Llt@%&%)z^`$F$xWLaYQh9gDrM0le>LcfwO%Rs+91nc$O_ha`u zzyli_n`FdXr0u|JgahVfuW?{adJTR5@+i`w`||Pz>+rMp%zE6?-12&5b9Qre^D^8P zxjnfpUDLYdg%Z)+tTfSBTx5-)nZHzN`gx+}-sFuayKm)I>XWf%9~OyhuiY?5Jm-L0 zB~U#{yQ!R?l7A);|57tm!m7snoR+Cgsfw{lk*nIfP+Q5S9Qs@UTHRNrii}G6qF@NT zNuH@gxm3wCX?;w&X`QP`Io~YOtgUQ+#~eLK9eZ-G%DgC}q0`(f*-;{E=!>IiyHWeG zTnQ-)Cks~#EkL=c97dA|jb;(T&J?D>AfTY%Zt?Eac4k0LniVihZ_!f=ACl)9Ap6ef3P|L$=ko0|4oa|g3~ z#jECB+YZ_uy0zo|tgeG{sOGXKsc6K&Lhz~bMR_!R{KoS*OvMLmGv!*rYk@_}q2y3Htx13RUJ_)L-wMCkxj8peLd~PW`Hy+IiSupe zuK#YE_QgtW0dFXkp|WW652jxiS6wrz`gwV&QA?0IF#D-s(K7Ja`+M`X5)E0t%p9ci zsmnQ!MMINRfR0EHwU1&S%}&kaPw5YNfTigM0$n3RA(}LLH3kkE4(33Vu|Xx>5F*QQ zM00QJpal&bO2l{Ro%#fZ!Baxyu*ERuu<*ga&L@Bkq-jy$+|%M@$e;I}n_{EIQwZ8n zrnnzB<3Dmfw*x{AK#?|2Bp~kRXn%KH=?QIRcIj&Fex`7T5jr1Pd!uXFEE5V1JW9jY z4)^q5lHzkpNd#7DE>+B96;_R#1;h1YP8FCHqLT{_Rg;NW^FrIN4vJEHc2!gH(kReo z8y*8(A$b>wFKb1ebeKLd{P2fksXxswNe;2eZRoTNlq zq(mO1OgJ!0%H0NseL1yhRIU}3;dTx7oJ(HEi;V=!2WTw715&_amnC&9luaG;2dnSr zkE@k8F*OuM#fYj-^e4jzux3P|V+7tZqsT6R>f}v36;eADSUZ(sxFtB+m0`rBk;6GE zz+Icmfq;{7po@i|^F7uBn;NlI56o-yMKJ)P>N8c3MpE~qYn&I5lgxuo6~?4X8jlms zh?UNu%W5VFXto7pA;@sX4{;_;*%sjLieYoaaApr^dqhQ=Rhuk%P!&g&ig;! z%eOpgd2<=J`1Ei~@J!y3Yra!Ia{30WQD}bX7;hPe@s?Q|yEwwW?@_J3`1x1E0C3Rx za^~=mIp8Hd?J$iP-`U!MhzCS&6tu4u2f%j#B8LzU$H;3(X+5;{dr(qpar{&kT%cVo zJ6Y`DKC5W{?z8tW{>H2r+cfRcI{g;%fU$A_@=2k%8}-UW-M6!Ma|in>@=Hu`d0&3+ zenPUa{WyCMPEGsRMm!)|JAFrNWd7_qpO|dIpU+A|?NS46MtQ{UX?sGxwG^nD_ z=mBMqh<5tQxxxpyf>-Pw#iCa0GIgrs)75tJi|b-5k65Sz))+{2`Ze8>EDvj_g4!5p z{bDn>)XO6ts{l6!0-nB6xA@%sBd#Rvz8a9Gn4sY(XJ6Uc9KJL9cd2sOzj7Y!#;Esac^?8ED90mtDizy0daEb(Dvkle<)Cm$#f3yq9~I_h96zSG+9MC^?z_omvDn z&&4PNslca@hE^I_v_-BFE{&7+PdF@OH8XF-C>SmWN-B-d;w@8g<$682=$Ym z#oP`#n?+C;z%+%N`xWGPMM8t9XOXvqt#4r*LtOGe9|K=r2+#P{NBvPAx<7kQ)y#mR^zchl8u|?UW1;b{^6gGN+ z<8Y)n68b?PI$5G{B06QHa6bLSQN%O-S~P-vU7E`PlUhWa0VCGGB710={tdTS(!F}E zAT4^7mH}6_fX)LrtFWNEcv$`iwg}P#=&Ycqy9Ap4l(xv$y;7~fF1ys50Ux&jIQ@jK ze`V0=#`;r@xhp2~Rb!R(l+>t{LzWDl)C87OnT)1XA%6)uqq$1#i(Y+I5tIq`y6H+t zj|?XR_d0#d9Vpl`=VZ|*q3XPm5d45w`=}086~dQ zq)uWuqGyxv20BqAY@J>oU9)fdl&y|+I2317sg8d*G-uPPjw?D(dRO);(Vn1ZOWQXi zjLMBMBeL?>nw>^EeVK>Lj`!gWqS+R89Ajk0VQ%0#m21QAevcPFM@~jduM?Y$Lbgld` z$F$;E7ImdH==`yfpf4K64 z9#c`~5Y;7R%)q${iXJnQ=OSXyx$}-5$*Xc_Oo_duD^6J&)4Ow-9^;qiQyQbaB`(e= z*Lig=d_ku8ryUs2!`GKIA+^L3lGV>>tC~upn%7tM@c#&(ieeW9w1-z?{DVRPcJN>8 zi`O-)Wi=e|bC1QT3^`@xQiNR?aO%V<61kvb=OaBQ%BoawN|#+pl0&_a*D5BxAa_sCuAb1QkXmYAv(; z4_Qagr!b_*v?S@IFtEtjBx$8US~%^lot<)n?26dQUqeQ8pkFgc2|d<2nQ42$6Xq5=PPSIRm zWn8g=!MxtwaAgIGX~40rx-sV5JaB1?X=Adk=G?Vqa z!Tl11d#&h+XFUu6EE#SHjn_070{-jciNlOCG1C4bCAM+@w#Y_2_;*a_8L82S_HPTh>o` zHuN5*YAWRRFcBBeVzH1;k~^$t(wR)LIc#gvqE2n?+B(c=(!Wdv?1t`&nzXZ_AfU*T z7FvsT#lGW1I|ecgq?HjmB}OmPu`9FK-De54msuZA&QCdIMz2t9rd#JTY@{7bIvumE zO?#U7B^(^GyIu3TWNRR0!fnnYow2!BXO}cQd3N!hoZdV-wIpk7NZEt7acpT_TffwM z46zDhu1L}+NM);;-cP}`L}gqWpWQq`yVPdn`^*+Rnm){O(#K30IS{jwuqywY!q|mi zEVr@C{49I`RJY4a$ubOa(#dQ!ADi2@H>^TCG(^#@Y&u`#96%-li35rNk^=4kNrO&< zQiEm#XM<`3X@h73YlD76eIlO&o14DLQX=tF1_qx3ZOOOHS2^WN&s+V6ShRBD*wS{H zEo(2hF66ji+!AtGI&06Eo=t1-xX$x9*KTj|3F)cjPxC49N%4vC$@%g9iS1d{*{6BJ z9boMYx^uz941dv0PD@p|ND#(+7;Bx zolo$LoK%~GcS(Z=3Wf`Vga8W8V+@W73K=927$6Wdtk*xZ*S`w}A4xcb`C42WX%hzL zsR4A04Ih3JPVt&u8h#UD&MK}rGM5kHjc2|el8@p|WPX4KA8a6mjYWFC?`z6(X4* z{a?UA?eC-n@ybydSfhvh3Ao%VrV3f2i=7$#WDCL_&~Q`?k`)MT3&Y$G{E9Wb0q zt9k;u?H5RO-wcH?W4S8qQWW&~)#MI>tJc7Dp1X)h~wy{Bg2>APadwaR*Qu~&tes{C3 zdTk9Kbss)9F#mhqKR{oQ6afCd;j-XhXr6d|u*_t(yaAL6M&Xu}8)MJ)0g_4BMx<+M z#eG5+5tjrV?AXvA_X(0FNPlv|#T1`ApF5e5h-n@`gMeo!I)Im$Dt< zT1)?%dbY2b^w+j6<0p1gMVTP17fc>6xKI5QPhLy9Q<%dlIe^L}-xuVZMxe577VTxr zFEah*BgGo)GB)g-JGc6!Yc=@ z%Z|*0)XSnv5tPcK%awlly(r#IeMdci0)0)_mMP95>L!BuLtf))Q^iaa}tlrGiMyvPA{Z0 z=N;G3FU8&a%JVEw3SMhfr9R6tk4z~~R9~Bve{#C3bX<|)uA6uXYk)C4tYl{%c(y40 z6=mKS5smjb_ZXxE7S<8FQ^IJ+vY)vmTgC1pcMi#W-hNoP4kjk)99A!xKcxKF44u=w zvd`rD;`-*M5lqS&Ce^MhZI#(8GMAo!6*hE*<2W8&1;{-A28?9FJj72bD7k*I!2PPdCv4ZuM2BdyyqOQOQER1wuV1-EQ zj7VfNjl{M_33vkQu_ikBMQ4qZj8^zrpQgtA?2HL8Q&7r19xCxhGP^1r6ReeSvTh1*2_|7CZTGNC6`vwb`8^tYY8PT|+0R&t(_|)dXHjm=9x!=399L_5Y?o}L z8(gSdDx5c?z}XVnK6!wSuG=r3{@k`C?0h`#eYEX;VDEiQ_AQ-AT6^kj)HDJ%trFY+ zY(zp@HKa#5W=V09UdBM@sJLlvQeg8;JhgC=W=2O2Sq>BKCr;6M5`V~a1W!y8YQ|S) zc|eeBJc+FbEWXiRNfEBS4R#w7OL+Q^FlK9E!(cN za&tsi=5yAL?YO-#Ppk%VOTyq)!k?pa(0JI1L8}&pTo!&qnE6NopInPFfTNRuk9br? zM*bQgYY3emy<4DFtc|Q(c~5ZA`)Yi!3xtgjFLu5$5=_ZRE@|^-s#OcDcj6p z8-5??@6^i!FTe9hF|Mu_r-(;!?hfiJtQpPKK>A+27Vk57xP(q|%c&5%H0ddE+yraA zu@O;53U}N9-=QuS!Di}7T~g0dn7T zNr%oY=ouWgFjX|fe?EjTH)j4}b%UoUXO3?3_X#7fm<7mu`^b1k{sKpYB+oEuIq_YV zcrP68^ga>$QM9aL237o?+y+)N?SU*IZ%NdfO%UZF2c>^HBz*7ywIPIt}KX>+?ev0ck-Ras{ z-R3rh++_mpm~LFYm6l0FnV4-7>3q}vJqi4z3qQ>?!!76QIoMwZpz}Xaj$BWN1C%QN za6L`e=0R~=eR6%obZlf^yk52&UazSaPA^SuEUeltFe9!lwO1Eg@ep8uF^@ryr@9Kh zFC4m^KU8c!#J4Wj)62zwB)^W)k;6BbsyY|d(ga}S+Tf8hh>zcylWCz~vHLbI@*kiw%2*(tIJ zlL4Q;Na0D39HbY`+j%0liw{YaKs;1S-^Jt<^yJ2UF_NI*-O^o^tz z*GQC@HYPSFO@T5ZZrhXF8j(PbHukP~r(Bh7QPv2!jL5;|8D%oAiF6+Mcw<@4m=(aM zw7~{}4CDpUPg5Njqgm$TK@oxjY#gk|Om%~uRY6qdowfPZ?{^?Ei7UK#mI zGH-G&Tr*Zt*s)qEkvdIkj8p)(fpk?#AJaLiQ;E)8vvs)iH&^I(9`hXEHc!+42-&K1 z1!_z}jcGD|Zg-K0L-+Dqmk@RBZC1Bn#pJ#60)*O)ft&5Kl658-l6RWaBKxA<*vuis z*lcfGHaj38lARvLxYDaThdDc9au7{!a$+qNdF^Ypt=E#45KnsuB1$g8__V9N%m5l# z9qN}dYAUsH=-A#|Hwra3Q5G8^nvUPGwu|(HGeOsYv!Io~no3r>g#^kmz$^*PsMpW> zND_S{8oNG`Sj$KR+5@wuThm%9o^G#j!hLCICQ*|#>W(&r^I-Bnkd7I2oGKDRs8e(= z<%oj9622i%t6G(Pe67E1lKuyUc`HYK&Q&)+1^#_y|$z_#A zAZtk4h?R$l0$_vQLI@L{D6}8T2%KX6Q&N~`DAvnC@~_E=F(h}aE)NT2rcFH?f6@ea zn+=}NB!y00xRz#n)^rzDSx<;(8SY!AUmaG*=VIzxaPhDNRBA+hNJc-NJ0(>r2Qmh7 zB30qWO1H=zaOA|!Gdl>?z7vd6C!IQP^>bEA&*rH~wO^hl@+6ArKVSAz& z*29c0n>rv#@nB|ZPY0|E_%rOUc5m=L-8HBahNop*54p9zjxjWUQCLzhzu53!Mgo1P z9UC;H5%q{Of1t<$gHc0crkq7I+97WzI`hSo+J5ng;(~Y?MU&qp`IMo(fUfID*asPK z&jRNG{!U%GG&AC|QmE_^r_g=5DRsiD)rsYtpal#3F4hM~3Xh?KN8`Z3f%*@LiL6RP zW~lvsGq@m6e?ax8D>&)8QmZv zq%P{J6#l769~s{gCQrl6cG-6?T^t|NKVIA$tlS)RUawg8BqTnWgMq`>czSx!u{=}p za4q0}+UGRTjWXK()fcTjYmwy4lvb?D8_O=1^C2ur(XUt4*^ed|$v4VPahv-FL!>-S z;j(5){y0B(x}3nBV!Um?xb1jslfHaz?>v~GlxKKvgK)^pe9?-;=T6nuRo>JOI&kd5 zkmuEZOPqDgN%_Qbh&~a13haZzm73Pyo(kW^)^m+?K8mA^fcFD;lVNn+$nd30H}yo16O0AMo`c;RP$RC$%nQUWg(z9 z4tR_)0H!p;qwxCZVuPnQIK+hw@H*47(kh^l#iBS_FZ)it$_$+(hDh>j>f*to5nLn9 z;6zSJ3LED#4Gkd9m4eNIIUJ%rmd*bo2L^TWfsr<=8n^V5#o{ZWCr42ulN>RQ5tl2) z6N>k9d>mt;7hc7ylZ}NCqOu0%MW392a}F@{-(f*EdnPl>i;07IFLibX;8qa`QAPY9 z4m~QUt`N=E zoS-YJ(l{8FkMsA?qB}3~-tx0A`k5o|bUf1-x!ck(-?g?ne+Us?nnK820=AQA`XH_> z%so4Q?1Imi1+)@j>`XKcBZIbDgo8&kI{XQ8A*L@{Ss?QDH%R`(&PesQSf@2c5^PC& zE+;iJRQTU`E`B5KSM95p(LReTm~bra)u4n#H~ zU!^0PRd&f+AH;Tds?iBKgi*yx1!dX!6O#-{Q?SB{wPw%Ww`I^wA-i?uw&@1`aVOu1 z5pr~K(S&(A^GpR}4)KWt3R6bGsvB}7P`$XVkeV1dB}A&6bEA|#_qavOidbFc%D*A? zGDrUF^HbBCg88g^BnSC*Z4(t2+^xB7(Yft+XONW;feI2mI3T zj}G*w?Tf}X7xs=M?}c%>$TdwfD8|M|VbBpR|BO0t>+P93obBySlXmxMR03vx?i}k1 zb|72v3zxJMNo^zn`ge}LFTh5pujBl!sGL}eU_6y&8=7_A+9hC0ur|E7eQSF5#<}XK zHe)Q(ngnLfMy2=zmrG_3Je1^0m`jt((d%Y~l){)o9`Q!Ql*{bf&=awR1hR}NcltC% ziky=cLsz&rm=|@9ow;T}N;jbofpCIjjJ`rHZ;>rahlVWPt=V97;L6^kp)c%Ok09Stm$;X|Y^$+hD{({zWm--2+%&T=Xi=^$y2QDz)YS;X7FcVlM4>~^ z9N(G6v(Zs<^b_=rpEE+>UDnmukA@)G930L+$1x5|s)sPfv#nqEg9<~hNr=m*W1Dhu zb`tz!feW53jN#HOA3vBd3Xc;CWqr;@>tbK)Y&X$trBVA?wQ{olHGV*KcJ_U&&a}$V zRMXk%QTSUH<$2REKOAqfXfPA`*z}r?Fi9C!e7G7RP-WoZ!MXf6>VPE86$i6) zFMs2A-js#dk#5eFcMT5&{dDe&!s*%~m{Q;w#07w-O0j(bk+V3c?W3~cvf z$b&$E&F9-u_JIN*fk{64^f227Y$hiyw@)Dl*UNfdp29#D^|E;}O$Q)OiHin5*2kNP z&DZ63k(o}RkRt?N3=5GeLYd%CTg*)6_tiwq1o_$|3%^f|-5aOvT0r`221dfb8W{>0 z4{*OsAEYQaj;|OPfN(!@zYNkMJTyiq2(L?I zi>XAfE$e0FfiA&@#(;{}W1y2&o`UVaJ}bEg@hhDH&PF=Ig+F76TFV3G4Ri|5f2Rd7{XdR6q+S=Usv&dkv?ZFFq~I0 zMR7I?{zyn^AsC@nu8!x#p$l(CE^nmQrx^rwz&|EE^Pn?M7w`B8AnuQqiyD|;gO2f5 zz6_k3#8XaX08^T-E;Rye|L#lPlg1=uG1z#%g}Y}Ue>Ff@%zxV0&Yy}b(OnB)+W|jr z@m*1ZlvJ@<@D#uJ3EnXyL)?@&FHI2fYKW!o)bqhCIFRKb)qe@+9sX6bLTY!-_Qs2l zZAFO~q?Z0rgBQ8zZJtayI@_YhKwW5cca%wJbWeV*x#{%F5ZleA#=;7N@@i617me!5 zuT!Dii6QOnZu|`KC5)MF@prg})WL3kdzY16CuJ%n*Z~%2KDBq=Ji8xO)?B(D)=q9#?J`%xu7;;n ztV+;>7;&o<()-RGiTS_qE=Ix?Dema{Rtu3+g$wGChgWeGYyTLSEd(Y-;Wa@?{e=ck zN$D&%$~FHdE<^UG3IO!kuXF+ zlhaWmW0bdNBp(DqlD6dDs2!zuLi>*C(eEM+?0ki54z~>67}G zlqhy&6jTh>kHnWsz*z_eOYTqmM4?RR?PVk;e9&28u8No_Wg|LEY=DqZnPv#h&UC0M z{Nf-#2zpsJ4nKq%#|kYHGp2u#>cb*JBxAkTGN}-Q<_YiNi?)@Ut%fG#df(0Irjy-C zBeR`CdNTo-VrgHGv8VN2ZZRN{lztzkKn%Ssw%Qr|S{Q|g5JrS>11>@YBbKZR$*)c0 zH9;WsRVQ6jgku9TE+&WkSIDNGnmFG~FJ|bvS|+b2JQ)BC;^Mc$t|rUsND?x*i6>oL zIU|Vf0KB8PvZ_XFmQ&Ed#lW(082URp9#eJ{2qKLaACb)PZ%|}jtE5_%k{fzaSZV&H zj(YV`e8YIZ3{~4EMZ#1pwAyM^(M-Fulvq=~2V~^7_1I0FKK!Q?L+}!6rGBnmjwQy$ zHr|uW0k;|+booIC)l#D6;sdvOjK(y)576|!!FP>(g4(e{YhRQL1! zH!3`b(+oXjEqo0?gaID7$V?t|ldxT^WXGaOilNEu-iJE1-w*+y=f%0}!g3~AuIi0x z%*RwEt8u|q{*okwJp?K;9Uikcm1jep5uC4hIB-$)Cv70!yA4=drvzs3@XZiQ-8^|2 z>^8{6Z2#Kdu{6yhZp6syzdM{h_o+MI7l|!gw6^pO?HKoM+c{&W4A;PdnC z6)^^y&E|HW7Em^b>hpM82FY+$T$0oAFy40-f%|j0wn2lt`STFt?e^K^fcVkv@^m{u zc{2RM_2w}EZE)occ;fCWE;oZoO*$PftA;=!F`q$vHuc-Ziz7G($b|tor_R8RI-6ZO zYi*{H)yGWKPj1?~4V1Xo-XQr{$Xzwo8SOtGV(Zileo8rsgm&S`{Y_C1Su>0}V;MK` z{%U$qmKg+PU&+I7Gx$6eFen@HJ5xV-;K^qFOk?%>o|TD)U1q2P8ceJsD*`krA&o)C zviPysVcO^of~TeKS_FGa@B3c>PC&80l%Ojk7C9VS5n?SGu@)irBCw^1*|L;^jyF{j z0Wdrg34kI2P$U3~1V9l3xDd#=upPc~vW&`QWeCT;7}={3*)v=;w6OPduzeV?g-jW? zF3#bN5!iWUj%pJ8`@&@@ef$0sJ1d7L`z1$uaH6OFpSVtcckHNQVe4a&fjw9Ocdg%~XK}864z)Kb zXJ!4yWv2^`RS29F0&|7vUxmP0SvGZ+)48%oLSwnIh{of&c+TcmVXq&`kKg5jFTBMM zSLc7#)B`o>lHYJnE0=uaDK(x~oFW>dY?-SlNfog(arPDRnO&5?KZn1Tj@WX~E6f?^xxiBYU`D5@PpZ$Hyl;l zLSEf%iMGdr#Xb4r#6VAe$G%gOd%v~6%jpYw1X1<410HK2rt96qZM_qNx%|-7DR8(> ztUqt#Jc~BG2ggj&2&~E8OZ*ti3erUjZJ?**%7%#B8 z+vu_Mro!Yl8mv}=M4Iwzn5egn{&Bu(6!D1km-M4XcWLxht3PeA{7ak|@OX4L*XXID zSWk{%9~h?|YxGockdpQ|(%_lUP`iQ>cGT%ZohtGz6RH~n5E`{P1B0>~rhKYTO|*ro zs@dIe_U^ut=td1P0F|g(4b^J3bS>>)YAsWZbs!6d@nN7^_x5hGJ2|hHwV0L|hcBsn zBdTb#(Dg5H$lV?dMBG*eokr*=&0%2(#qBf~6dW9luD{<8D#wN1OS5kD9|x;eTViLIEJzr(l! zsbDA_a4_``O}A->mI_BY15UdBB8$XCI289-OeltsL|dh{U?3t{X_PV{on}2TJs5K# zbHX8l7ZDxw-|l3aW9B7A1K=FO>NTccaAMiyoWkm#m;oM-%??e$_2>Xr!xH@_?y<_$ z#|DGK&f(B-c9<5dO2LLRp#aiW06{CbfGLG#^xv|BN+z8YvQbd8sD7f9{lq!;ljP}d zva5gD#FZscxlR>a1=GMv0Z|21C}b)f%LwE7Run~}jQ)ORbm$%1I74N@*cdfRgzr-` zwWiIvmY%8gWgFE!hl|w=z7D&fpn`IJ4$g}j2YTnIDDpD+%#8m2TxQfZ^v)cdt7gFk z;Uf>u)Y5Qtx@HtImWAGK+ctQT+{|wy#)!-?|0lfMW7@jzIDQ|tuiw7*&As;J0=6;s z1z#KE2L=?QZ%)dQgu@H$CQQ$Y29CKRmjdc_n0_Ir%Cue?0b&!_xC;D-{&B%WVD16l8JOH zonxz|DzAOxo1^_lMx)uIfBNa15Z{#P+&37v8UY(JQup}5)V|lZgx>v4?}2Xb_RU>~ zJ3Uq_01@ksTt1jT*j1b<1oNrQEmBRO#>k2ev8F0e!$r3KYRheRG}o9P>+S_Lng=!d zTt7>M0kz+RHM)_@k!F7yM^zd}R~oAh?~&^1MeMX;`E~uoa6?a!~|!#Rx%;U!7y~t0L@T=`k+f2v?gsR z!#>oV_ECC9>=>Ge?fczyOV{lDc4f4;#bYv1E}KK{*xG*Lj9;DX$c*O{E8J)P(J4A@ zVz9=gp1ywUmA{?Z$X3;P?3~9Xd;JamTkmf>KcUns0V7ufoVypO`i}k(5h60gUs1Yv za~nyEl!2L&F$2{ykeM>jjTvap%o6z>K@c%b^B9&ohNX_-oQYwnW6;26&Y!nrWJzZa zL+g18AfR;D?Zf&aY|_ZSx%EvF243V})m$Fvfg=}6o`M~YT_~Z!uze%@<|<(Ksf+-W zyY6Bd;BCb=s+E3+aaM2O!G^Mbe&_yQZ)-?Qy}4)Pyvl6wLJym+^!&0n2OJ9=+~x07 z^Rier?1|y=;qzCgjxJs3@9Uu~du4gR)`d_jMNRs z(z*2EG|j=)&iR039OsWfB8@}r*I`GadkZ>i zF|LDp`~8uRU)EjHQ6K8ayE;;*tB!pYDtMOn+Gp&P-Lzbd>^zAReDtIf}hss{#RR>oqWDVnjQ$7j{U@4eLCF?)Ic&wjf%dWHVQiOyZwI*OuX z|Io?tCccVi?4rxYIjk1Z!(~q`o;v!Mvwgisem}vTd%LMP-3k*U`1pJ3RsBgoAFo60 zuL&%S3KS6%PGqT^#1f8b2^&`e>R)RP2NxgTRb4FD1_aG3>HezFO7noP$PS=AS|SIO zQ*I}}(b6D!8-{^1ZC)vXC!0enCHySflqGT%oUU;=uW4hb+?#v>qR4Jj1duInM+J4iy63^;W=M4$f`Yn=B?za%E$T&gyQi!6>vI!7~|WEkj97HRsSY6BP1BqK>o zGOB}hP*boF6Ywi0d@L9?5e}*ra1J_}8M>|TrFHCUp5NO>KkOI?`?~M76?We9jSw1m zB6&{U2avFfJAFX#tP$@ys`eR5ofRGm4?pk`iVS-(9Qd}w|%XS*y(HA+#*+6w-^5spf`z4pVEB&Zv=7pxz&#%lLnxBfW{GWA5pl@qw6oY|rRJU!%u#;rP&WR-%svy!G2+n@)~JY6MqP zZJ>!VQ~u8F8?!T8<3V+M%AajZiefR+xi=J?>>fU~C2BJI*S^{H6JOh4!}f#T)`8XC z?K#RQMjIRWuAZ9aEL=(RV6S!=@J)jF1N6p1E=7hpyi&OG65{X@;_%wyAl$fXEwG7L zV6ItU!dXzbS>R`8LIocYwPBG3{qa_`P@flzs3}0E0d>Mq|eirjV=vVJWYem*|}bDD}oiplo_V~(%_EMMZZ{HIh12~ zcW?c~*3~!4?^J@z&|v4mi~9(W`L8_wo*dQ32%hj0@1dP-E-(@}9H0fv-U8MM-E-)S zmWhDZlz@d5mZ({xn&34xc|3~8pYmndc_8IYvsVQpy^CaaL1YJ!hF`2GIM;DcMTve@ zgb&>)X-@&^K2o064a>wq6oFm_CML7bYQse~wkzH(X?R5=Js%72E4Fu=74Wf z#C4P@)?AuwjFWNIMGgZxx{H2595=N%#4;;7qox*LqGY0uu;Slo#kR6yA*@&kE3{IT z5RDR00?krFokia;Se)a>7IgA>C6Za7C{K)P-g1w)54&jsi$h>>2rLd!b_oGgS}?PDqzCo| zT2SaM@S}g!1pjF;tYlI4z~jsdWWFLL*5d=Z zpTq9wFr1_GsI3*iWo>Q33`4{WL&OXxHKPzQgC2crv+5*=H)mx$Z3W~1`MOZh(m^}iB}*AmN(4X3}W1s7-B5b15o9O;87;P!Kj5b0^k99_>bgR9yt z{Fm@*i;d$d!*k}cbKTvUy?fWYv-kV@wzfBRZ0{J`wb%B>xsXeR9H(wjMYL(7h9-if zt#G4CMM7Lufq+Q702LB#aGECR1*s2}5D$)cAT6l0Z_reg#S2g($cF#SoLO((pjy_R znKS3iNZy)nTl9j}E!$NASRbNpnykAm*6|N15WATrbz!#xfayp~#(joWCvYaP%7$4n;Q0+w zDopQ}DvQOQbi<|#r-4qbAjQIFD6(ml3%S*`CuD8F%m$0kl*1awaT zx|a#MH!Nodcy+mik7-FVVZ(r#c3gTB-G!A^ONdn>&?@osDiLm#5KzS+Oa4qlo-FCC z+K2H8FYdXC*jLpi2RYvi`oS@~SdkQCVQfhDzA)Z+trcEW@z!fCb1xk5k_mCWTZx*B z=~iU0(~UCOY_~LP%w-Xublt}n78e>h4C&CL-(Sl=G&f%qJiUHjug3p!=IPn`v09IR z_{el(5}o`P}CE*WbJ}uVwZYPTNqo|9R->#QH^JZsX*nr#Lf6DmwiV zU|gl1H?#Gb5tMZk*}4f>Zd<-?qH8ynuZJ?cIPpLMq_B>uFsM3Xh^57>+aGWEu{)Zj z%#1#zofN%UG8am%os}U{rFQkG5As7(m=5|S+93);Fq-!F42+DYcDrF_dVDPEOr)a< z%OGYw5Yt3a6nuTlwR^w$ydOR{I-7Gdf+UHq2w-yH{x*FJFlivw%8mU?^`(`iXP2%l zanl5XX@b!-5gLqd<2XG{%8oh8ctn3O^z=}ANQq$CMzCxnxY$H+rHWu@jJ$#Vg{{z# zaD-G0GgiWF7T#A^t|+w9_d!kiMBA^O(9UQ~O{-~viT9@?TwyVA$1(&!Z(AFK4s=!B zR!!q9k=OvO2~2loa3fRe`=F&spR_1V)#4iCvffyjc)w-7lMCFjtpfIz%-60Rhd1u9 z!`kY_iX9p5bC7$7zl%Lkw1d7?J-)GT;ON{yKw=#-FPG{^_7rD_A~|FK;R8mlaPY#x z^ul<-&ohuVC5MU9Ece3>g^V+4H`k` zb}P8R;|*6^JSk0Kb;~aNtfgzS%>nGH9Y64sV4q59KGSsZJ$+hGsGj0zj zIEAO}Q2ddgh^)u`QEfh$?)3?r$gy9ECRLZ{$Sj@RN4w%_Z&>5soDsZ8Nz3F&c zT3r(*k#mIrqZc6sTxQb804YhTCTapbXvTp zJ4=l?9J`t&(^*GroeAbL?}_?@QO(i(p&6QZUpxfvAq4vu2Bt2|@je~Q#3OdH)cM2v zCLViXole?@aqk~1YcrW+hv}#68LYG!AzyH>0DNbrC}W zf`*@rzMY1|96e;z;JHzQiyGuH4dqmn=TI^a6O&1lPND?9tS3-9f#T+D9HrwZ=SJre zC;>gLA!`1GL>!z1?(P^Oh&vH?TX&eR1b)8)8x#3PLJl`%%eH|96ML$(YG$sI^^b7! zve|5=VP&a zkBe>JVmTyu^vY!u~s zQJzHw2957Ud&kk<3YsV*HSR}E73W^n8Vw2Lug2jGs+&yX(NJ)q#MAEShPe*IURPJt zC)8(ERy90<1-079G{(PIMrHi0j6GlV1{NMGpD)vMFdJMJF&(!t=Bw}2>sx@i#Z15D z<`m`wbuzI@i4mP{xK&-npJEm3JBIn8{bj_MAMwCPvgOe-O@mZf>odUEZJ=wlw1&SF z-YOkmwepLjLmiXj8Jopy_5mz*U2>OLuKg+F4CZ5cu}5KkOVd{vXSfj4b8y$b%dyZn z278kpf%!8{|Be`I7;AAd=0{W?+TM8Hi6f{tMKX$f0>}h-ZPzcV#b+{Z3p&)Uu zfISsJB0ecaxTf%)2@35=p-~yhaojj!o@IG(pwLLkTC|~cn!~ZW=0Riqge-)KBxeVh zlDn6O$a?H$0iR`JImQG$n;oqofZXZ@gI*KkKmeFwW(03ekEQ%F`=|F<*`Mrd2{h-$|tc~e_$m|k3=&bT5R7fySxg=@G_6S+WsjF4EI0Et28#Qs|vsSw(+cQ zn|;Q!c*f%yPiFCK_PDlZ>NVbCC#mC%6HoTIq0=;OR@#uXO_M5=ln4m{5>P>-1dynd z#7Tyf(nhL~3UVRHN{d9H{zLdtCm28!03xmp?H8u0Mr;JqL*t9Z`^p2%WMa-oO|*)a(Z*-^-pGm%YN z!jKOR| zd0Ny_TP=1IL)CG{|4(-G5l+U-urPsUG_!?q(j4g-#iooxW0hT&r;F+(1 zmHWXndLp9O$O4dDhpcC{6r?&B7`=tvq%Be-vT?GPSef2H$gF68qN^j0uO|l*@jkd@ ze^ZCiLFO3v+ok$@0CcJD9$3|b{!ec+A#XYnv%jY?$Y`KN(n+UJWLeRN_e8b3l#clc zVIgetm+%acNWhl(!JbIKel~S0q(GVGd$iG9Z*llVnkA=cqvWvw?V_1K8M!)IW0Z{S zvqnw}8<~w*e;=A7<76kn5k8r35*qyyO(cLT;t!jn^-C2RHd5F$8}KV0@?(-07lm3` zgg^A%IwR!o-?r?WM6^aA0apKK=ox>Uq$ZA|4TbfO426< zNfagOmX^~pWG)m4gc<`{0rxzoYnRZUnU{%xl7mGHg+Y@+tB9r<~O8~mUmli zZk}XzzFRBZdA~OGbAzB~NVbmId;5bAXJ>!&>tD^#EDMmtW4}HF7TyI5{X~y~LZZT) zM3u|q@fx;NByei#<&IRbIGR#T#sbx3oKvgVniI1bvMHq2GpmU1y4%+0D1+n_o%Ke< zY%Q0|G|9Vd7PnAG&KxEkvmbtNdoNSRl8jz3{0v=s{|>tJu9nwL zGekT_JWd=ZzCcuDzv>1LW<19nQyOl66;apLjYc9|zKYmuy`#H7=KAHvLd+-NX3OJ- zLjURfb$G#zioBv1FDYs(y`$Xjk1McD?k@1UD6E6eld%7lFevQ=e65GFby3*|eTE_f zW^A>>vr^aPfkwcX@!X8k$Wdmc(F27r0aZN3nZaSDZKI9o*I7vc&sa zvV#fhp+N86p2)g^qAN4Az0{cMiHNmDG|{?idU8!}^GIKyYj!dn>fhD*$j+@>QjyZs zWZ2a=Ivxq?j9Qx1a7IU4Wu_bsCOrnS&hBt{I9;77&=GHFkJzk{uCbjI>1yljk4E~6 z#bA9lVt2(lmcyA%g@8~WvBh@m+!6N`3PtKPK~NAsBYTXA69#EVK_banQWy|Id( zEVjfA_E;P7tbM{hLGKI%QRSOKlViF=jtDYza|Tmj9X zx;%WpQpN|q@J{rz+My*C(h3SFt)?1U2tO@nd8<-MH57}ROj?aKYf)pZW(}O@piK2x znbd_sFo(7%eQ7IVj|ri!siUKj{#>IbJiNBgAMH*D?K+dMZR67;zDIH?r$DJZ+g3XH z!{42|aQ~Yl%Rdf{r<;3I0joA!u&3Gzp?`itq25={9Gyx_!F*#lALIppvSV#?^r<7W zrB=?D^lvtqXbq5=%;d&M|MW~HHTkWh1DVpHQ)f>eXnLx8W=N0(4QCTfB4^N<&8E#4 ze*a45rEk3Y^_TXvkDdR;+r{3A@_YREKC6i~2$3RSYFXg0XrhG(+qb6GT;MeSJ>&7v&)aQy&*d;n^= zVF2uc@eemZ4Use;Lv`gJMIF2t+E zc;zXDsg}Dadfk?r>TVqB zD>(gya-mr6szmpI<%aqH*%6mbn&D%Q4(sSng3|6)qq|p)?pBTN#%U?&Fh|#AJDJ$Bqtv(jX=3FeuNHA{ z8C{U?>Whpl^1#ai<&HCrh^l|CA_wXmvE_=R#PltHCeiW_vDE*pOO%{qGWOVVIVmHf zm5eeu>So96#V7v7cD2PuabDs1XLe?HXLe_2_U84DcRhQXy?X6kvo`DXWiaMq3o3XLkFR8hfPSEN#TppBH4J~UOtWBXK!gwzt0 zL;;(g|DW+CC~Il{nem+SaK7_>=R42+`cPMD=+L_ENj*|{_UAKuPEO?_`c(IZ*`eg^ z(CTWbHmj6(bnmTYqU-hz^zH6xe&a{SUq_oqUZ2Qkw!gfkXJ%|D+PrRfvSZ-8O{2T%-I;;5#yz9SwcX|BRjaw+j*60qjZYlG1_*BXyu>cX$rRz ze&QvgWo{7tpm>UJ$tiWjUvyPrZ1HpK7=amYqy$gAh=OcnmmxJkoicyQoC}9vuDPl# zP5|;TW}x~liwEe01?z-4K`hM2t>3xu!&ly)$+p!l96tu<1yRX%Z)qDn(BluU*}HM| zXb)^5^qZ%@n48}5!Ix*>`I4L;PXFSi(ay$gC;m|T*Fci2-Rt6fQoMt{Wv!nW=~)F1_ib6l)J62PF?mt9&#!RDJd zL}V++k%3KjCJg=d$@t2g;drNYe$wg?IL_|0A@OTZgUB+RU`H8?!yRx3U`4uX6YcDP zCn#C1QqbcL%68`VY2M-tH^>3W!Tpi3SYSvC+{2T0ypvEz0Fz$)J_r*I{eYetGZ&H!(wB|ArsW-lE%WE`iH{n80pn?rbS-`SWAk{A5Y8UEsN$0m# zwXItN9<&93xua|FiKfCuhqs!}hzgEWaHK*a6&$IUbWi}VE0j$ztjcAqE~44?qRAu? z!|eg^#EK4&6&)vOtsp`RlOD!|s>l`D-%&>bY(v%D=c>vMR{ij3>Jzp%WeI>K8U;MT z;Np2?&Y}i*kKf4d^70%~bcd^g1cu}uB*~q%s+#+}M$)r5|B`%R^Me70M7wuQEo&K9 zT18ATwmAg!C4F0Z^KEV5g9&!3_r>2GT=T+sm&?X6qSIcg&JOfHHxSKMzqjQWpl#&@ z(f&gJ{=sB$)o`h6dUKJ7)?i@U^>mHS>JvYCx<&1ssH~mc)`E`gJUP?p3pIq zsR=dOJ6h}<*Q3BnpQq7fjp{o)Q-dANu~dw8DSm8YJn+Ob~{4CGtpXLCGA7CsABOi6*2eC`RNn5kQFsr1_ENLz)+95`rd)vnXys zSp^X-bsJjR;t#-$A4{y?Yy*5=1N8k(`Mgwr{74VM7ZRqugnLSoKx8F61SJW&NcxDD z!M|AyCAGi+!?d?x+Vk*li>0kKspLtESh5jG;v?JnQK}Ck=PtM3D;Dt#!%fg`jxE@B zZjp1D`A__mOG!l{DTUgKoPoup*(*2A*IgurZ5;_#2co?8PzzVJFo}GB7nl2*|}Eva!oD@2)>SSL?2gbhtQ{W^96$ z&urMgaqZ#Zd~*2vV?Evb=LVuNk7=Vr_3?DOx7{$8jl9BSgE)q127Vui_LOa{$tYhXb z)p`$H-oK`B?QTK|%iv7lp}3M8zz*G|>i1ztSu-6EYMH7P=eSt2jxBCat)|xoZ=JWS zBts|1t+3w~t2vzv``y8u^R^8i``~bPcumd=brozvs%Lxq^jqUOy7bO7wYPUBiwAyt zWcUY@dQv_g?SH0k&19viarH$1&JL~E?mWG0%iX`94!rW3TCNgpPyV;XE86VpNAp8j{wxri6r z!1(jq{m!1fXU~57{l8OIzrTH2Q>S-~r+j(dgk{AUkIB6$Fu!Ii*b#gyWm2Kqo2VE{ z4vtLF5;`Mxrle_Uo%%C)J?rsL^IZP;^4Kv_xDz_P5j*v?PA@M0pU;Z{>nmhzg?rlC z86{6mPDw3ZTT;HZX!wE1)clOJajB8fX?gCf+>|hFdfASJIX{@cy`p4W)wujcTT2S& zj~|g#P+3sCC@(g7LM3Ttsrdwl4{gCz~$3ihjwb*Ynj!3Yj_`Yt+M zNwF~_TxbP_1snKkaB3w^*NB+dB$sT3h3Kp(Ix))WYk`>Qx>Pi;Gb%AU3O=;Lf^;3< z7r2UIl~J`;z}t8Ug;Amv5$7q~5gYQh7EFR%_&=UJx3A%(#lDS-8QA7LD-R<_x&q_|t%5b~! zMv08^H-hWSe^nDP@eU<8N&da{#WtB?=z7VP@_Tptnu5BW`RE2=6`I-yGRQ~TmEaTi z?%q8S)UCV&{t~lA`2C*t2O`l8g{1$b9skWVF zQwM6m)3(2ZpQa8ylokaddNCi+i)bVh)WL)~6E+L>hhQwI0OjDP@F#;zaR}oMl7k&I zPl+tt5BL(r(|noTUPnoynmUZ@m^=F+IKY!s_q~)`7++GIaO1atz6|XJXj@cDi}g*n zi3Rcf{hJgq5Zz6$4HdDU+>T_L6o|;AF_;5%y+d_|~3`Z7a@GF!Th+6AlTE#f?w3uS{XxC_ucFk;njexBJBf$o+0IY)F1zPzf z+9Q(bS?ynDmrWgi1%4Yj24u4&WlObtl*Ia|)mScn>j7pdd(v!EwgCI_AmxL66D^Dn z)!zB%S<2q0RtvKSwt=V8k1P#I7=MOR*%ct|+w_RINvUGf(7?M+ zb(A8$|2#DCoGsva+wKKrpxJJ>41~9lTfazof$%NJNyo`Oh(~FmjYHW2+Q4gRId4R) zc2F_Fg->=yURFbyTa>n}0&zt5qYP&BNH6imB>8+@pO5i|+*O zGfI>9usxK*zogM@2Q+RkrLf0oGMj^Zwh6RI)$T(n(0hx`8|=gL5w8Kt*LxhS3h=do z)tZU^OW-87+J9&_8|$xE z%w}1G@Ji_GZW?dZ5We3^O|$9+-^)^)t$M+C4zEUjrXZkm-Us6T@O~sTCcy}`i!`77hJdMMhCxN$B7hnY@m(CH<%+C?Jp?8h=(l#%V>$HrDYB$+Urr@nYjNO z)NTlD6&wGild4XNvB|`KH&OV2dT6xX2n}wc`Jx%un&}8QY}Yt*W&MJ+wo9n?vC(T139L(T2MI)bfu5zphE)fjh|>WwtiJ5$lGp<((i_-=uJ&|3Z# z>X#g}P3U_KrHDF!69^60lpp#prr^EE*y=)FzhcuRHOO3mI&YZNiGdo9`3q4Kl!{8k zUL|U(N@$v;fg7Z*@e7DIAYv)bU=*#drW!FFI+kT?)mV_N^k;8>%^`Irfr6#h*||BM z|B>9n2S0K*VzE`^Dh-{ie@v~q5B-@Gtj~e(UGN-Y`yig}J+wcd0#Rx9NNvV`$MXiP z%?7dhs)QZWg4r>8N5bEvJ)m0gSH$*Gx(&|q<+K%AP=h$mmN5<9lJTwYr6ceikbb|# z9z6?2`K|36#V*iBaLI2)0&2bloCn+TVWhFYK@&Q){k&H@gMJA5kFlRXLjdnZJqa9z zba)`}_3&Q0+<)fkX%E=SHeyX1sfz8Ud0-POLS8L`ek%FX?3;JrR#OW7Q5a; zf{HY4)mze9>||ppGHO>$qOzo#rqYR2qNG?66OmTUR6{33yhNoFov^o`=iGaL`?HZr zX7a~p&b{Z}^Y)x`p6B`6-DRaqOmc}$@y~#`5$_X}-VS+5L4PiGw@QXvCBs;+&^E() zS+c0_#Pb+R&7H>b{3jU7`zXrU*y0|ZyV=)>)tkA$e?~uU=D*G4X{{wI<$ip{4gC9A z&iI|u!YP+YRyBV4qD+Q7&PN;jZN;C%dHm9)2~GmqWaAWJ%PHnQzKGLre^!fGgj$F z5!S&WLqmBf-Z0iHD(erIjb2Z*Td{PAm5>ko!^GWhNbFdU4<%>@O`t{ies>b4E{v(l z1NM3UJbV-5c>p^)UAKZ?v+0J;iWwCSdOIXdh0=G$m zjbXV!%OH>RuWI?V&fS|*?6xIuQao~;HTYEJXUw0RNj0739I9KH;jXe+5;#&Wro_A+9-xlCE7Z7v)Zl1>zd&gLdWe~o>A&(kk zot5U!Kzzk3^t}>Zm0WVnn~GEH`^ngED#VutlnoN4r5Zws`M#eFebiH|?Xomvy@DoL zo>Uj`3+4<)FO|u1?%_@9Q=zfZTL~Cbb(ZQU6OUnIpuI$VG+Rv$V}2e`lM!%ppAwFn zO8?6!o4^{y-WbaX+6U_n=B-*w%bMNcJW_QmwS%r98nZ4=Oj4a#Y_RrbZP$OX#nFJk zW?FB?J*e1MMDLHl@t^obW}nT%w3$9!Mm*$(L!J1t!d=cKD5*CkW2 z;=}}{p5!R8P5iUT)O9t4^>#>XQpiZT%kURzYS_ye1?-=f47PvKew}mD92+Q2C1z+| zhnQH&=oo4T)@^LT-D_mDOFwC8G{GkHm@jGWB2%A(KYiG3hc-LRncv~R?=~b>lyGiy z(Jk%C)zPH!dicgpe8aDLooWAX+M;8OK0%K<8AgvbGTIa0>I}elqH|RXX}`q&=_xNt zRZ0`7@>J^#rqA7w%Du(kqmOzSpB?$;B%-+CrTItP1~NfmPV*x_PyZwZp>zKnhopmgouj(=NDa?78eMNdl@u+Tm z(fC0BC!I|Hoc)lb*&h-E%4MoE3)>FFZfm72r2OSx*L3JK` zR8<$oTpqF%y1^3cZPuuBOrnF9tg8pi)%^;oU|vHJ1#BKMng!lmH)E_9SVHFc+_ev9UUKF+EKL1&CQksru_F^vMo?$OCiD^5? zhhCv>rlhOx0>^&Y#K%JP-$T}1|FZX>so!8fhX(8~>GmJ+Avx%+zB10#qto!|txb%$ z!FV0%Q_pHKdGK_}jjO%hAa`oXzb9lgnsAJX&E4b)_*F8*^~wA*R^e_GI63|qdp|aR zPI^Ugp1$uxQx=+j`DW&D!rvR@4E%3$gPNm^Q$!wcN!wV5{rT2mxx?v(59lVpG-tCL zx%bgc?e$5#}Z|az#-Ib?Q_Zr*RAt@J9a<#PPO1o(NA=99- z<~6LnWypBlw~$%H?-kUI4H@T6WnV&)=V1tJkg!Aa9Xl!|P#?Sc#s;<6<~-~S&V#kn ze^;U13do0_!Z5SeO%j7PnqC8p}X^zoMYN55gS*i{*2&f*E_ z$hURQ6xMeNGHJ6_N>}H&sUJl?HqY5A z#de8Iw{yuKm&(KF&c;?(a+ZsJjeSTey{=N`l<|$c%zZ}YaHmr2OXNo*Xg`7TzKnNr zBxhHUpP>`)u+cI0)8w~nWR|^N^5aLPG9{mTI9@8zFjd|=QW>AleI#FGoWUmNTP^FN z{4OHOJ>3HTjLyx>?+`jL%pDm+qQ3Q;mrw3CSt^_|=J%<8Ajn6_xfjc@*u|P-jP)q( zT9~$%{H?5GD&vS5i}^Z_lMj>s*$0^WD%KF@vq`yXFz&K2C$5&Z_<(eKod2=?eYCEF zKUvNDO?<*)@`S$hy;8@bZkaS-jC}o%`%uLmSDE`zD3`P^+E#|lq2Jj~5zhfj!g4Kh z=>+YeKL`x9bNQyWd7Ls}Bec?I*4qj4bss|(G2coM=m2d!k39}iyWK+FbssRcsWkf^ z&=<-$3t35sDLE4%cR{moPk$1Y3yjUxPT=*G2Ne4VXINQg&X8-)(Trd%^ikjZ6WZR` zeIoke03~yA{>VR9K-=h9&&7Xipgzjm2Zu!OBW{z=FAa&_SJXZ`3(zNDfp_w&;qI;r z{aX-UxU=@Nwf@h<0&vr$Nc|#YJKdo-zOR4aV-0zH+a%wykC8*%Z**PYr|=K>xNF?u za%&pC=$!w8^*^oS`&0P5DN=4QzR%xh+KmEyol6Ylj!$)aNIrhSg!zS0T?|y0RK7p+puxC5@ zcLp}TBKN|htoMX7%s*kjk56gjpC#5#cD_ZQ)iRU3V1qM`Tq1-2ACY|Q^`xbGrVM@b ziF9#i$RuN@A7l4wa+}|BC$`}eJ4mW`gf&c0iq+fb;~nCwl0gnKlRH@?+3sH@+nb86 z`KPq<8e)$TGQjRkKB6&%eYF1bf7;6hIIH3cz~|n(_x>1=P>rGldBiBMj!TAc zqM;BVM8d<6U{XYohm=<+&;%&2j!Hu%7OG)TFoU%)4nr$A(1KFNDd?0DhfZx(7-(q) zD$EGUz5RCY{o|iMPpA6Nd~^13cK@?`ch8=~IQmo$k~!SIQqCJ{=^T?dTy&mkU&G#b zp1FfJvE@87%r$q*aGh_OTrL5T8VMRNq;BX3QIWH+S-+R5HT&FvgiGnZ)R}P`qb>Z@XfwW-%|#? zr}s#fT>-DaTw*o-oz8`OZpN|yaEI-{I_BoC*sG+gbx3lZ0g`J4vL1RH`Da<7u`8t* zW)M#dgJP8}LpAnjxn$>ILoQGz2Mx=*?R(rKsGFl&%96;2U)Y80&12Zdy6mOAQTl&6 z$S;#okJg8_2arwCHyQM`ydxRfJ0TlDdls@WlI>_pFRK|l8f(83*?|Aoj%Mb)9oc|p z?8`}kkcn%$-j;eG@8RXs#%N;KNW zdStA9RcvK3kY&T*hz19a(ADC7!Fw_{DAKqRH?mLO!Zt4Us z1UD7su!t4Zesn(-C;gkLYNSgU!fwhVc@!k>j5-WkH)s$My#_zEe&x$(U$Y;$+_X6@ zcK>~RGpSupLVB&pzhz%8wS0%W^zy}~b-nvI6+c}A;d^X^(7gijSOonNwl2_zj52CI zX?k_he!)CP`e4?u#$?ypg2c5!j}9KZ4DWGbcr(%C>7Gwwcp2ke$~}s`j_Z|6-qE+8 zd`7pGIB%KJFW0-TC=>WeqRVO-dDd&S^P^Ksht+Wb!bC%e`0J=->xcQL`1R+b>D z2tv;~P9Mi>N*^n;axMQA#xJ6}qA{y~k!gqKcoFxgLxvWYnL5FUM5Z057n^_>cN@D@ zveZtp)an*(v}*RqSIhOw06j?r#U@`^BOG*^h~K9JHti`Ud9;W}q>$$>XX ztkS&D7tGoJKrz=8dORREtz#Eg_$X)#{PId`NKuHE z^o2uPP;C0ItygFQ9YlBYI{j9c=qF`$=y!674(0xJ7lSZQ-;Uowz>M}q5!4m88TnQx z*cXT=eA9a2g+twpUXbH%K8o zYqHQBF{7VeN6BvIc(V&E$6H7&_Rja-qLX8;J8mAfU>p`B`VOPH5hWSkkl7E#&sNAg zvmln)1dHAGj3eJ@79YGu9@|DI^blR)6Y(CDtxf65k(w@g)U!;o9-C z5~^mau{fRv5)zFO{BQzIAb!oNk+RmQ4B0UZAT9;)&S6q!kAB5Y3knCZ3AQ-WQ|$l` zupv3*vFCB>L-9Di((=2r#K5?hD_Xwpp=eDx+E?1g%J@|H)um3HUGLGA^@JYP`?=?u zTYJ9p@6|R#8g9eeac)hjosNLm*661 zyck_8pE$Sbnw_I$cf65~2weYM(L1?${%-3Ev-$QqxY%u1FrQSrj)^uZwlOtj=JcP@ zBL!{Nuv}tr?ago7(XNEiDj8KG&0~2;!?eb0you}{Z2vyzE;GGAd+;%><~nUzKf@T| zJ(8aV&7@Y*r&4IPm!Je{ETpuvi<)w|-FA9j>yiK`5JmBrRG`k-POlOO-*l7=38l5H z(cBy%n|6cNn-WfJBnaXi>Im%#V}HBJhf6>HK4MQC-yke>Ve|C4bRMy9Z8){{UN{3D zBwRKg$i*aOZm1Xac?fX+#2rfCq($qXeTRE}jrQ^~DSngay3=S4@X{On;s<8jzvb@4 zrskHllaabA{$5u}Km15(2=8jZ-emGPq3Rl&>bEPf0A zT%K=8fCAfF06n`dQ_0VTl{*8@5+{J8r3S}w*A9xdNOTN@_}9`kDKLEW!JGus!cH>! z;n7#hP$mUgeS(Ca3pG#*7`dJ~khn$8Zn_z!kb3a(GQ{`uLc+bzgmjWcjQp?xbDXZ++);lVKs~ z;w^EuEs~T_jO;;e{i!A0+F2lbZhG{pDI3(1@OkjDjORqN>SJ+u47KlC{RnC}CC^^b z+RO5x+lOy{8-E2fyjeM#hKBHTWbyvd5C0c|mk?HkQ6`jQEKUd*SMlEeLhBS<+}q;m zH8+Rrd?#_fL{C7WNub}vJAqHnSgZOXIG&&|-=;dwxoN9mvW$88<;gkU#LqOYPf5P1 zH&W*r^L*Pc+3Kq8MAMqfI1qC@eoWb2Qk!%{h899;UAOmy?O`J@Fx-v#r!REeT|-r~s?-*~D;C zvL#;~%gyHZ{qSXA8r1@W%ed(FR%Q5W#gmVM&7fFc z{M&`?42#wSl+f_bT1p~UuGU?dY>FXqq`ay!vd%Y0{U%%e<(OmF52`U;Cm)1w4wp{s z^Us$uPdbB;0pSHt*cQ)>c+HNs-4Op{FDdF@WttHVwUc(BVoG}4j~MGGi3R~Ma(0s9A$_~#|&_{@jJc* zXMBSzrxZ)tKEus6m60>?cP4;^z<-3p9Mnx_XFOSh;zAQbt z3}7U=X+hBqcnE6?vAEHEYguY0Sp_zN5r>pljQ!5IEHZo=59!p#S98X7Pj%zb?{J;0 zGv{g-bqkw*xT(Y8!hVg{M-FzT%!gPnzW++@tN4|%9UJ&qB3N+G1mB(tLndSkEY3%s zmT5Al&LtWSZ#KuXW?xLb3cLp6XdIKx29~yxQ;zutzv!0VY>zp2{fQ5;Z2wtA7W4GC zzQIfla3?|(7_cB0j6?UBsa^DRUpQ*{iH749`Vu1d%do?{8Ue`DBK~Aj^GvcXQLcRm zP+1%KsWx>@wMJG{>(>@fJj`DatCz@adQy zdl`qm3VXWiOImr$(R{SfE_4Hm;tSTR6gvdQnmg4mXOKqunquE8lC|Kj0L_yJGGC!z zen?Y$JRGCPf48Jg@(7b{_sb?+)Ndnv8MQ`Ts61bX_o;`A*qj&^LiWX@j~K`ay@W$g z`W*}Sg<_i`Jn;7AH%92ZmK`+x<`-8SKA?(Z?DDQKhPdcDITJ6uSC6Y^smrnUqTvzG zrR$mgnDs68=vg4-4#N^T>L`zSmAP26l`r3W$6VTt0)I zu1U%Bg*M_LZ#BD_vbdQFxLt^?en?OxM#(lZ(J4~w{%}iaS80r0w^g%lInO)Ke;oS} zt8wyDhGTdYEF9x8$UJjJjnd^M?d{NYN)uAYVdC!G4j(7>?c&RI%wzM%&S{hF3YrYPFAc z?j|*g-KC{XOncz-ppR zp-3Z)>;RfIsMMIi;?w|tBR0F+ns9Liply__$KgmlAF>&EEv$KH955mx2=5kp6zxvp zJ7r)V%pBS{VF)rTN+=qxlkbp-E>jRF@~v5CNR$b&#d*R0c~X2!z2A?x3{La6r>^%a z{``h}MB&Ocy}&k}C&Hl}Cw0v53;%wJ%mWz1653SLbHNBl;7^%2d;>XZ*C}@XD{F$ZN4PcAx}=Pzu5eQq%-A)|8&fI9NeMhe6sWvr&s~O(Q+%c%`@K;# zE6Xdp#q4`DXl_}1V227r!Ut*RQT}te532Y}?i^V02bnd99{{7P^JP1|`XG&zQ!>J| z3~B=SCXnKe4k3tD0tT)9g%0icm?os?!;jTdfCeM}hF6>NEHNf0N%KM6vdJoch3yLP zYcacJoeOuYi<)9@LUb~bIF(mw3ch6g$sFK44iHE;HP~x-V8hknLgp5f!}6L)tj@jI zS|5D#6`ZtC!Qzmu&Wz$684nBF&|uNQzf-YsFj_yTJ)?8FsD^oiG6~HbK8@Sr%63qm zI4Vc8XQiF^xm42LaB-rgBi#;`^m55FUY`+q%QHPPVR3PBet2=Ym~gbZ@}LXBbOp+~ z%6mg9O@@XcewhAY&ssl_^~fCbv{B38IBp%|O@vdW_ydlVFs-{6C8uHIjqs1zKN(n@ z4B%4nE{Uc?9=qO-*xh-^s%TupCZzb44Uy|k2@XiNPyb(i6Ilche&=)YJ3Fd2wI zNULwM;YG1?%foi?d8=_3D(i|cb=(wl#5Z-QI$VaBXOymmyYnr5S+N4~tSzZ?DNWSG zF7jJ;rfW%5JHMz@H33i3kF$U*TOEYz{z+qBJ+y4O>O>i)Jsp1)LqF=eEZ)j(;pc2F zzrSi>Q*AIG)$m8PMW=+jomV+Wv(=avx+k5zKBXZa3Wfi zzBE-tF(8+DuB&P1Ie@}`uzNNTyUssD^z_T*@7_@ls+Ixo-W*nef@TFXU&FqwP;QF4 z4)5oi?QdR5N}DyP1Uu*ipuYnJB|`-LlY#*OLxPM*L&?^_;iA{tn`pX8W$1-2`X8cZ*d{0?U zSC>BLoxGF02&XT2W7ZF(y-Er9Xut>8eHU>mUl$4y zaeHl@J#L@(2ayCEY@qHm|K||bD834(b4f0b?72(Tp}^tab}3~q+ltn)rx5MO&qL-` zn9JLzIk0DrrohEbxBGYd<=nnrk3$!Q2o_lktc3xOhHsn-HN@ci!z?~K2{bPo3(}1$ zJm?d*wy@i+4FbB|$KdS5(_f^)he98Q9*}+Qk#{jJ?44v&r2xya)-WI^JbjSWwn*6? zh0!Y!Vc0t)5Yobc;2R!x7$9P^@t%@2V}NoDqC^g5;zM!_CmzIPP(oVWaA6h=b};S2 z2p`>S6rC%`|ARe1VDoB!wR8W3p6J@{$WD}x9Q4fTBgj-0J zG~Y(wiQ*U`CEr`*G|2ePr|A3=h{o_S;C4*0nMha!)l=e�PveltC>`<%SWRabycg zffm*GU?mr^P2yS_d5TEcI^drsw1!CR!C(YU8goN=?R2CK4e~Ky>e0Z-9kELz>mD&r zw~J2V|9+sC%x)Ts;4?AwbL*4qn(rE)5%cE{%XzaE{k^n;?gD(D-UmIX1f|?lt-}I@4VbsR8Bl`eG-(i3jPeFZ3tu)Zd+Zz)! z?er%+Q2J07jbx*+aM?6aNwS4;=yj2eB!L$`V~sa*;0#M%s@5TrYN zCAa|ORFFzuMdFFcc|b*r+)5?vdrbYZct$UzGVdGoQ#> zQD0XkHwe`pNfIovN8~RuJXoCPp+eG;O{8JOp?A}k4)AWAw`(Ztic3au6MDWVXn`nd z$csnt6aJCjRr46jXe_iYW>(*M8RhCF@8T>9Vk!_;0Zz>y1o+o|ixN=L!&6UtuVfE@ zF8D5w?~2kr{ivGD9A%LhUwY20r237h8#`pJX1qSk665~KV3g4`o>pqZYI?IW)af0< zB;>P>RjtEV{EhrlqQjDqobZa~T>ptQs{C+8oq0MnjYz8ZcbxfB(GQ43| zuJVh}>hRhueo~T;L1F%495{h|VHpVkQyf-eTR_>>vch{cx5ae}TAGZ%GC6>Ld&s`x zCx?VWGe4?$E)JFgq&(iK{i|b&Ek8l0r5)>nJ;(=acOBfrtVse!b{g`&9b2M&an$a#HV0Nzsi{Ik`Mep9D>bw}6|RDdLh6sO$_7hP8d(CuoT(tHd;2M`@^2^AT@{S#bG9!LsK6T?}2k z5&0>a8}ts*Acy-K!kTVzM&!P76SoOJDfaba6=QUXyZ1TtHups{_wSDX>kHx^`EUyJuLDm|^IxQ|=@jsh*76|CNZL(9WnbXu4oKv0rXl zv?+1d1NNZq$>N)-E#zG6e8bB;i5*xum@%>EyKI`?n4?c>20n_SlE2W?6b9MgltwBq z(ha&cX3hi0gmO&i2u=9Dc8(=*IL3O9#BDgctVj|c<|pXe^z(|DppK<9JccDs<2_~e zp2!<%R%QR!j#0c3_cwM7dc_;EzEHvR*N+)HezdE4G}PlYA`YYVv0v&>N|f^Y)C;WC z2P4aKv3U$Nd7rA~^E5WNelQob#fImY$*Y>9^N{&p3&&$DNmV7pUo_W#1TV971pMOT zPSa+2zPMtBIy5)(mxDYB`7hIQh+R)A_tMkx%noW)+rubdu%D;w3(JWFuf<1)vLAavJm))vdP`CTzjZhp#m6-45RO$&1pms_d>B0n}llAvv zyIAn1GAH`IvVggd5IPoIHr$f2?Q^c&v3m=b|K7yL%)j0sxr>A6Jd${HJ^$rYF9)=n z_>QFh%eoXFdwKnlpVMtk(AgF|$1~0QiudtFar<#Nv$fUZPhVwb&;{0?T{;yWI>0tD zz57+KO|h-0YKFychT0b!P81MquOJ$N)klEZMCLCA{6TCTIc9uF(Q3-fGASJ1Za&kr zXzSeIS_0S9_+Y8MO48KygPQ)F$F?P~WxH#~?@B=bSL3SzA$6R*pL>_bmeXbHQ;t_y z@YNi-8x3XLB)*=Hv$!##wz%BOIkV+SotaFm(%!g)vLK(2ce*G^yd+sJNd;%fd>pJg zft2E<15lPQ(I*Rrd>BiM$6@7*Kk+QKuw~~iGa)F;0#4q#c8ufxl8CM^4K)J@2HZ3ts)x@%)CP^WnZU8EV9TZu0-9`cj|yZGs@npyK0F zd|K#TUV>9?t5CkQ-20{~@l<-6XInDG8hQKREWmeFiZLVUWmLrTl2Xho`ykoQb#SuZ zT+AEv-jw8~B4$BjQ6zUIvvi*9`s+Z;#LQW;RsI2pm2}IRL6~#ve2YyrMPw(#bwRnu z-6)LBrgTt&Qtn^*dxiS1A$9(45@hnbTgS704fKpG~aRe{@>^BEJmnk#e-ZXC*t^V%wt_3CYQ+vi%}gINuc zH5)piOY)RA@{%`f76{u~OMd%+>hx-Bw|&g1*(v?-z1Np7;ELn2$3T91T&iTamBU zm%N%{FST+A%an|o(2unmkf(N=!tBrvUBB7Uug7JWm*oC0J{lKJWjfWbohkh6xk$6O z#h1ltq!Gcb)t^tLKepu9hMR+0Vp{kHs|M%>CI(~&Vg?WfyuvFY+|bm^xTrUprDKZc z6=zrJBsJw$WKRBOocz{uDY|Psy=YgLEdr;48D;(rrPZDhOIJc;Y2v-KwZNsUo|fEo zMkGzNBwQV!gU|}=NWKpXJOGRl*#HIsYCsZ6)CB(l;#A>$05loAML;mo1VEaIy%1&= z+QMH0Ktu*o7WPbxDMBBp1KkQzkL<|5&kOtk^ak<*b%1!1_{Qvo7|d|YXi8vZp(;Yu z#4JSU07pseeI1}PkQJyRNmU501fTvR9X=gA9XcI^D)6W9kO(Z%9+45T5m5ng0TC%N zDbWjH2fz#D0_Xr4feOGCKm(DPaH!y_1~F&6+7U@eJJC{Rd9hBk}o zNL`3j$g%%Zk^wjZ$N?l0@eyqhZxHDc>k?%XXA|KQV*?NY&XPC-P&3HMs6JS?p!+^R zFMu2ImEdM*2ZRUOE#$rn&|P$#Yt)C=tZ=YsY?aRjL+y#2B70dxYG5l;!`gq{cS zLU^Fwg6}&3jR2hhKEMV*7my9W2V4Mb0961wzyv@R5CcE}ND#*f5`^-CYa)3d--7J> z0=a=&KpdbCz)$!Sv=#H#4Y)=0B&a5G8Cn_mj(&>?%q6BF_6vMRxrGAi0(giK_Yr|t z#N9#bh%a>e8~}Y0+n`GSci3BLAOn#=7;V@){H-!jo=70{9r{)Th(y#Z+=bK%amxpE zBi;(|#=WHjG6Ok?xBR{FZ`pwA#2g}BKU!gKO@OIH`oZhat)TTkZy}&9pJ1#BxkuJMa`?=d z0dr$k&J|@CjJUvPkb;~YGoA64a0lXCH_$i?=1H@xVU3=&skGs=v9$hDqjA%DW>Y3p zW=pJvXlikCBglfj5o*dLmeH(A*uK{26S+nBK32+#1jb~=(QiX)(0lXekTJg`%7fu4rYCdZYpl`JBGvLC*BJ z2ji@PL_Vwy?2Ts)b#Y8_GycVhnfUmf`%J0h?fXnINwdP6!Z?YHJl^B}XrvDES094T zVfWM$5B9>=79c7M4+s`lL{>!Yg zKcu9o?8~9UAt2DhVNunvLh3#L(kZBYld{{0isyyHCwDdjLmB%(e<~QaL0yKxUecAe zNL+Ee=e#ZX5PWq$Ver4?+~qiJlJRyhWX)tP^2nd8NKL>@ICMS+AEqJlS9{1fsW^!` zXkNVQ_xTN4`TzJ}KnpT)b znKqav9{!mSpAg|*fy_4PG|kr2uFx#dtkNt(s+?~?&p601@w6$MtQT$2sG*ysou{21 zUmBm|A)If3VtukYv^+F7T?^rGFO(4;^;Uh*$y^~yfZt(H$>&Ho@SvD)a3#0X0Njzec zAEJfbTS=m8Q+L+C#)=RrTv^FEEvFLQ7{9Her4%KU2Ta{){;qqm z7=^w=^Nx2G(3vTK*fv}?`Gu$$#rHyU5sc$iqarXH?oX&6s+ zz+iCr5F667k7LU{dghAFJ$S}``gLdVBzZ^m1brvvR_76FCeN}(l_grb3tlsP10G8* z&qydAn-)i&nkJDbJweJDErIO^9@gRtu!6#Bs3UYZcamj(YNN>X(ovq+sAgt4%rL#| zlRNKmweD9_H*$j8h?eEOW865#vEd)Mfs9=;!XLIuw?c5LGObpPt{Q-)9cHE-M9tA2 z_l`<%91oG&n1GNPJbW*#I_xOCIHWb>yW=;T&Y}{!)2mp|K%r?a);3xEr;&a@ji#vY)EEFkj9fw^(vI4oZ&|>lR z&1-P04i|On4mR6o4XdAo_Qti#I4Cqtp-@qkf9goA%$`o*G_T9n%cm5G_#GeD`R_W7XldU z=5H5AD-Z4|_yy(Y_#@(pZ8D96ndyynMoW#22Uz5cIV(IYGuZGE_)cc4z1pJXb91^F zH%`hNnnFoc3jP$-QeIfEzWj@_NG=bX#o5GSSL!TFFPjwHZ7*^iL(sQ4dt5D^sP5|)3Dd*b+j@WgKO11 zF%_Fi87q=UGmIW#6r_FI04tqOuIZ7d7J3zUl`w_PdC7O?;?BE!qvDQ7j6}GZXjsgN z%79KasqlLa<4@e0GtYO=*31$(A-Vg;CV3f;``99r+HZMrdg&OfQ?(W%QavQw_jSXE zMAlW(<)mgo%n(9eq^a)fl)^AGV4-HndedH*bT?3Qoa{t;M(B6X&RiRuJL`v(@_DEH zbtZ7T^$GIzCGdujBB_@NJM1GKZ$xo92%lucU7QE6%mk6h1oLD-aw-0^=vOcJddLk{ zSRGc-3|2@yR)8V=FyqfZzd{WdA^#A;GJ$-|AVB~n2wwA%X!r9uJo6|$|MECaBk0D* z&>u(39fvb=|K(fFqgy2kUTi_Dnnrcoc3lr8()!Dlv7@#gm^t%P)*j7P)QD9W!&Xp4 zCl0bS&a(y4#euF`h(cyw$Yx#`(vk$94G^jVzAfRR5`?7Z4*0>5up^9GEv~8)LR}jD z+lJcRr4KaV&rcYmTaM4Z+-I=vJ&yNC{c9HAK9l!w!fQVI9g?p8=4VL#JsR%_hHEbV z{*q^K!aY*&a5&C5q-*}oey)xvw`=yzzD#$pnmx9TNcC&x$zAe}aLjAooc;!PNclY~ z-Ut@X7-h}~G|pH`d-%9LCcHruyrBYj@GyI1C<7yb-Q}>(<)Dr5KbWqDP)$a-O@?sn zMrZ^>;=I8K8gVWfQEVD9su~gK8nGrCk>ncDVjAHPX>lIz$Vl71?yZGS7X z^req;?C2gI1PpNPL56}K9F#<0K?a1!fk88Zpblb>Ai$c~8ap{Vn*6ar_-@%5S|YGA zauP8T{YQ(JmqFaZ+S$aBLEQR}vx%sQk)5##gN%u-nX@?&8#4z#|9{Pdm5k7t--z55 zM26UY;}z4N)PbLIc1adS#>)m}cnouS0yUg%3t)p`(tCbfqclqkK{w?^RrW3Un|Ouz zCbA?)|Hc3Kz$ACM?mB^G_u*4nz%wYlW-`{tX7lZP$@p4YvIO2b-`zN5?mkRszg5!e zev;~T$nN#?*<^nH%x!pITOO#ppuap>x_myr-Sffv9I!g4XtvLcvD)QAcvV8suds4{ z@m?FtlUiCkxk>w+?%yh>s=Z;l%i_mP9tcju7nzKqAtbVy_t9D;I z(fO(#s-(R>7$oT|!b=0IXQsK0^a$xN)g$d@?k2fPa|3!E^4;Rz;okB%1t#ZopWU?k zj&z99r@grt!)-G^JkgHFo639vHZgZv`J9jpK=;)ThUd;S!GgjT=9RG z|Lm)bt4z*&P`Fhux7OF>*Zg;-t|qT$#+ng#0B~oTdm^yztJitP8LSS|57m~ zA~q&=#{Wahyi+`Ml+`hYr$)wjf{_8LKczOMw+9<72mj3HVJtbUmODF}FO(~Qg9<5> z1VOVO*RlLknL{=B&QHTNaxtfdqw(`M3x;IEdkUaDPs}l(2zNiXpG!HB8W~al@d2m%O^29ZV-- z4Lw+cW+r}H#lS|w+Ab$F>yI0_{ynGP1pI~`Wd4@O_Uky~-~>P45jW$q^OrI+to)(V zD*{u$T?3{xw`y4Cogfh`%hZqK2B!l|B;bMOHhY=0gax@9lC&`3|Fo(=9Qpi)nsD72 z8NhG_Aj58qP&}DPkFAXxWlVAJ-uk$?xa3`7y^4ZHXUZ}gqAD`mCETV6_&Pm3D%b)` z7hax!zi#@xKAs6|X9om9cJmC_9p}D(@mfEJcY}9u+Z77Rz@b9~l(TadkBgtA$z zT*rIe^69T}+w%O`>^?(gEM^mkFdGgE2;W) z`teEc4;(bgYCi3r6RYzs7AM$eEF9MB|2(7@7j4$uda5_P9!-z-FW3CG4L0-oC1M?4 zAVS0jhkwWBa%yV1o;tszHyll>>$E_pQZuOQwt7~z9eQ5Gw0WAFTeo?fJwDk#<@7#_ zIKcroh8lumO(YtF>S}*fF)Omms`b3sC$^I7pr(!%IdJLVKPg@Q${k1A4SHF5x8zUO zpVHqUykP)lR=P?>qD4BvR&ZB1mZ7r$GRO z{svWwPNFT6v?^q^NK7I z=rpp^X@WP_T5;ASJ{p5?7;E_{&J?sZyx>%`FLz7ysq2eFI9hWs_k!Tf_Z98W>M9gz zEmpQ$jDt0Zk~=L zK}+!)!~)LzD8m;13`O`qKl$#QJ*;jc@AUBT$A1N`OjNQX8T|yCFdE;RkhN)8&1r^m zR`9k#p}R>LOfkk4JM(e%%Vo9#-`?_a!lzSYXQ(k#6aYD(GfAvhT=`oGW?o@e@$wb* z7F;%~{4y5-QcUI#<*3%4t|PM{6HAdi(p$*7l6fv;yepd}Wf~~av<0uF?&4ltRwYd! z;Wl6r7Y4@r`H!v9g-cM{d2DvkQTgHnv{vn4?*u*`t}CahxHmgzn~Cn+WD=e--~zWKz5eZuSx|&G$~d-aVcFlFE+p!q77}7J#c#QR!hB=>9>GxnEI5E*;(H~LmwOs z8TCA{LzKbAFJ4>43*@mOegEU|%dMsVT^e0kF?oG4KcRwKP1VJZMVRfx#!0o`x)^6B z{pIUMt~>MO-ZU;&;~|C8>%&xbA-Fo;V!Xbs9xk>>P7Xv4f9hnupx?{I)v*>y$pD=r z%BPc{rx^fxX25|L`mqgP27mK=8GLFRQ!=co7Bb!^F1L?>^GA1|lRIcD07*R$7IxbS zI!GoBYylZjeH&-pAEyPe@tPsrAF?#a^H*@|H8^{Zta&g+c(7j(%%U)>XfJPg2v!=> z3NjQN5dlUY$@33X118#lFaY$J0hKq**bdFFAUw%H^mF~brE6${ev9$Gs$U|A2f!fg zReN09Vf+@f)!x8h*HRFg%f5{ks3$}A!@qpgGoY$zQE%Ji9ep3}AV`J;1bzMP;Bkih z7zV@`f0zjRQF#%&d+B5bUEF`j8&ak0P&tcI^2Qu2BV^A&=;on+M%W(5nqAX+8o0^y zJGm3kT>sD;xSB@u5=8lFB!Ay0tr5{Vjk{3VJEj5g74V&Kzb*kPHlL4Jv#r_@x}XuX zREJ^r7wI)W*t4?V)4E68x-U~9wzCfDanSb~?LE5rSMs7FPLVQXRf){1Ag%?PO)*`P zn6?G(mGqhg6kcKWzbMx^f>r62B$3vCagTGL+>#!*<}bY5qG2b{_(k5-e}$>@4Y|e1 zowMYCM*DTn3BSvt(GFH7kIQH>!>JgU#eq34<}{+iu0F2n zG@--6F)n*l>NL)EnPo4>UBcN5$^H+9eI}*hzy?BlMy+0|DYD8k(I!&1alzUpb0|V5 zcC5jkICrPPJ2vW>SARR|`yS)<)Cr{*@ia~IK;U7rX>=9wH1BmN;XMqc-M{$nguUN% zl~#MqbPX?i61^oq+tzG3-8CiK=4iRqH7DB+bJ^{@-8E0w7;}x>wM^GEbq(FMNEe+8 zhw5Ji>F@y%Chc>tN1wNVk7?VOtnjSptjM3Dv0}Fu?Cl%A#%{~m zuBjU~Ps^RIxf^x@O;G2QkILW7QNU!*2pT8!>d}#`zA~Md3MZVU?ToBR?5q*ZnS&Yh zWo~YWH3NdCLDyyeS8msy*ku?VBh2&2jar_^o}6VkFC)V9sE=9!#GU|7XsA78yvTlg z&e-tkU9GGMuB@@fR>Y+PPw$YLTehxAjuw87?a&rz%so_{$T54a>Yn5lSoJ*|ov1T= zKHHv{+249ei?fg%JEkLvO)Z1!zVl1*N!zkVDNbvxds(iR+=Jg1TY&N|uk-J03AtG1 zLtfV$PWkNhmPHce5}IG(fskMr$j~|^?2PW)BJkippou|I^RkqoMnxb>s+Ezbg~=rY zM-?E-g_#QlEp>e0_6((*PI(aihRz{d3UeC^QWy)-0YmXDhGSZoa(CylrZ`?Owhnoo z+4hBPO2J(62 zwTJXf`WY;+NBjAwqdOJkl;ZxpuQU#~rT_-c1&-zVwKYQIYApHP07_`@d& z^=kM2+rBXHWF$?)9)~rZ6T}e>vVcY?`oo$fJ}u3f;458V&Ki@qHKTzu{AAAikwY;p z>Y1*WCoo-ck0YDEbP{(DNgFs=3!c))tbs^lKwcTR;7z#Lqoo0L_6N*5Shg0sY1-Jg zhx{F|b%gXR^36LE$W+H*_!aAe{YL%BmfGjCIl1;sy4lO)fq8Yv*Opf(g-}Lyk^ssP zIP(r|`sj+ zKr(hdIdoPuqu<6w5?_&0rHi|QzLe%Pw5{l}2fqbw&>rcsAM95^SX-H|9>-p1N8FPW zw!k6fds40kiU;WL9h9VAqwk->PI}}oi2x;P9MPmjO>T9LB|2y64Qk<)mmywxG+x z_7lCE6r4h(2Sz@nxS73&u~)W_(9wD2dsaT(sriNn9X3?h&GG24N&aBxoW^;qiY#TCebN%e)OuSn4_-Yi_L+Cox^m3MZ&vqZK zU){kvh&Q3_k~kJ|uVll~hawGA4VMf#4BZR|>)z^Sm(d(VBQR*lx`LJTnxKqKQqL3R z_or@K-*rF9^+%d-JKwQnpeZ10z!L*UdUFHCdh6|-Iq9>ox^U!RDZ`ZeoBLaLI_!O0 zh`cGiIdrh-VKKv``-*nz?LAsZbg(NEat{FSBw+{YTqF_)X?UqmW2|(YM_hDW z`Ig*_s#^kZ+hA<-wdEkkkh?qKT_UsYW}s#gj{D6m?iK&ZgpSx_6EloRzA!A95Nyt+ z58gO!9(=ZNa9mxLlSgQwT8RQmagd7Al*mXTY`A}tQq`4UMK7l=tNxDETFr05E}($7 zglTjE8d}h?#5IC9POzxX?YbRhroR|b9C_rv?SEeSY~AHNWliyI^}3?Bm+MZ%){-oYB*a%IR8$7+yGL!{?1Z5s&ty1#fmPED+7h_zi`} zDj?Sb!>y;`pdqDUv8?&6a4t|SU=v}zT)nNm(c2_;wHn7dd8+q-*jb9vJ=cFpYj<`Y z*he>EyaA7nvC1=5JB!X%t&JPz979!mi!Nua4;zrSA{>hshRia>9#a>mu1<;T;=UVVu<-0^;ByzFn7c}74=*gNYkXl z${0BrI0agWTBdQ#Vwx$!(I)wi%NVl3CWVdwPRmrzvEhlkNzYpEVp$kwqVc~l$n#aQ z(2oW@98`7CmIe_Vl-E(WBGz_ee}Oq{g8Z4yd-WXAs&9%;VcH%y$j)Qw&H1?@QWD4u zb}z^W&3am#=*;}=AVauB*#lr{lf(>?FnZwRBQVCP8a}pO5oAxQt4D!m(>yw+`a9>% zNR1h-1#K#u=upoj*(ftKMp0j8O@U^dZ%wZc=HWXn{}A_g8tg+s;D=Y>U-_b2w%(kK zMaFBh7B*pDhASgp5UbT7cKiu%d^?O|3e!AWONgg;>2alO1AfLa8G>V1-K}X3 zp-K(=3eXnx5+2QoN^tv10xS$9$Ht~r4ZC9ve5;g9bc!u+W3>!b)5e$ON+zob?uJco zLw>g0bOh6a6*6t$(t*G}QhkHBwrjku2}g5Wx;e!N9@pSJYhyOax3!yoVj7xmVVb^T z8k=tAIKkVQOTv_YZyKrc00TSA(BGo%i(vBNHs;6B9r>n^_DWtAkfANtYCOZ!!jd~{fb*2uk;~cMSGJTD6Pi zjcYyxNHfjncnUJnACmd;J``A4Vl)<#9RrzoH?GbYZtmV=O0#`#lfDx0A_Il-WyC&7 zeMY`;2lryoOKYsM)EziFBUFp`MjEGcDop$aKas!8+>sF=v_vBl%EIBq@Jy!)nPa!{ zR!|zOuiajUujeb~2|Zoe{%OKp(&oDe2&^#Vmunc2nCgnP_ayO!j|jE({dtY(p79fo zpHFKu5P(n_4`IG{6feamDMl&Munf@`pCjg$Dw_6}7%;~#M!WI($o31MR{rr2*qnKD zi0>PEiS|*#oAQE=kU$k=89vrs96_&TymuxzTzfla4B}sac7#DpuKidt_YA58@usCs|qd* z%plz!X<|!8+Y)n~aNoYN4{Q8!&P-UbssJC_!;bu}6UvYRFD$BtL%}7GGV zGs*}B=aS!VvZ9O<&rP^=pth^m30=sJaj0kJWr1j#0uhV43ycdDiG;$%R7M&l8Q0RMMu~*u`j9U5cRe@ zuvI$`VbL<=(j^g%ZoQao;|{*^91TPNG_=zGGz=U)Hct;$kvxyQkJ)Mkf8W6Jzi8&1grL)=ZyTIIME4xR0y`hx;q?{);^y$E$=NyLa6=A{vGRqc`En#|DH zg0raJzTaEoSGi5~FyfHe8knYoLemnEQmZ--k13;M*6tQP?z6L>=)lo!`zPJQfyh_M zgJi_jXnyh?`c(ez9&&d+iUmG!5X%aRHt#4?*z|$3oJcJORJGz}g-DwASB(P*bQ4;K z^^l9^**Hta`^3_+v18h>a(Mk|`3G+&{lB!9de8g?cM2*4n5iNg-=DJcz$H%nfTtSv zCFK>t7TmPbe8;SxSfnb-WOjja=fcRL9E`hM6+N8fhLO)IOhTr{+hExn5 zQN1j~5X==qC9)8T=D5F(8^;NR3O;xuAQ7EDaVJ}Y?G}{Q`vF1;mT*fVhdPHOTat+< zaz33JgmizLmT?AUf4nPSLg32sJ|g}cn6_v zCkHR`Eb4miy2TsU?pP`WC<`p)3gAw=ljjWhkSiBU+>eY+{&Trn zR7H1`Ic&tQN%b|W9d)hatqF^Q~AZ{MtF;Jn}d6q;aw4|d+YqVMo&^K5@JLXdod=; z?XSh+#AzR`mvzgOZu=EQUVw(;P2{qQoSjH(tRjlkBEHz!pz$6Vbic%S{^3-%>$um% zEE69M$PSnPS$Q~L+quE!-K!Qu5-$guN1qo46o#9705p>}0-(kYWDY7fUuExF4@hE| z6^A=s8v#7w;>y=h*gPoNH8t!Q$zL*$jz@6XJT&cab|s$J_12?UJb;F26PKd+qhg!V zaatQ!Ra5*jjW*mgnsL$8MmK9M#ONxKNBle!YA|)lUx)jJeX)PR(Ws!VvQa zTyC_kuC~+5%;{I1FhhaYQi3MgwM$wGUk)0Ao1sj}eL@klUMEYj{b8OoT1D*>Ny;|m z*h;*(co{(@7I`PEp@ycJB;=A@88+Zhd|*@dxJ?MNAk29+Z_k! z!|{!XdLFWJ0bi3L$sm){pWsawmVnb|pua+ej$^W#QrKTO=%*hy>WIOPHwf)bpS+KMJQ%zt0eoamqE za{z8l@*JI{Tj;Tg9LL0}ikqH}$mmF;nd3<1!3|}ID=1COFY;;iV%By3$;DE&6H=v{ zv#9z9#xNPO+8cB_7-CtQV1E-!wLRzirGP*u~l#Zy9)L7y!s zqw615| ztqV#BDLG|0?8PFt_t1nHPSEUFHfMB9$#qGKi;`I5XKu`HRn1MwRY^0~-*A?$a?&Pj z*Sqwe zs$jNGafBeH3_UUwyJaQ|^JZH)#(OZ58&C>9WH4puFkP)FOfBUDFFD|Rqst4$X`kst zwUohl)`*z(W?8XkQD#PAQp>yB*9f0ujT)~p^0S0k!a0H+h&~AletYHN#k;wbJv4BK zb=*2ibqHn+Ok=(=(kxH(zVZlETh%5(n%u>WiztUGV_$jTvSfyw|_^mtwQB za=p8IgJL5)oY;*Fz%)Q>TRFB_nCyS6liH@m^GGBD$QwHZEIr0`yQ4YOq~tKhg1|cq zM4DSSz>o5iZ8UJ%2cfyOR3yhZxivN}o%~y<_j!@yIb5H@WVnJ+9k(BfIWgaR4VGKA z1w9nF@1`iT0@5m-_~PA}wf2y`0zznEq7R%!igQS9lLzth;d57iqVPr9z|_d|kUmHG zxbc0ielQkh{$7puwh4hU;Lnhfb!uyaS-ZA-G>z6X5f@G-9B}0DgrXEfRtR|)+qJ() z0;_JLke3~2@1T4&Vn6M6BGgsIJDm!t9xP~9GWut0vthOGlvj^Q%(6GHMNH64hn&_Iuis8v@lNR2X!0VkT_IOD={NeUdV z@C^U;36bR2?$?Qi<|&I4l~l%9wrYbm={tWcc#5xcHtZzejqXFr;F@)s%3c7eRHMz$2uK8XMD1$F)* z2J+~!?IQrgKw^19C!zh4n&7kOo<1BvKP$O&GOs+?vDYE3>}TCuL&0T`9o)N#;xFZrE$Q^ z^OQdI4}8x1k85Hv{$cQ3M6M;w4v^!f4rjrR4re^4NN4oh8EL*;a{jB}96+pFpB>mq zL+^Q9D1k94A>3-AuT;ka>jUR7`s8;mw|%c}dNP1+8v6AZ@aE&r*QStvBN z*at0Ui^p{Zz9)eLblsO)X+kCZiQBCXB+_}f4q`0<=tUo3?1$W__ty}x?Wek`uA}!B z;OSqHl=NQ`TKJ-~Mj%K*47o(4aYjM2ZzRwtSb~P7q`7EGebK?IH&7P1`V6QH5I=*- zIE4IR;FK*(r21f#OZ=5iBOyM1q}9YfEG<(bMKtIKtdIUjC-E#^rP8CAA=JRKnoa=D%OA z!In>9yl27Sz;pbYa&h4x_XYHy(4SnYx{R2uGM4#j;q4K*MA)nwPMH^1-(}t>(;aBH zjy-(~5<^?{R#bcyGenc8=GM=Yt(cLt-|1RhzuU5vZOhYcc^3%XD&UqO>#D+*u46Sn z4bzlqRFm1Iiq_eLMupA5jnEA*o*BzOBD;kYk zVHsy9GhR{OmA-aFy1tJI*#81%hSp_d{`4Sh(hhM*d7l5Wj7*`9e+)m}wwu-rq`?EmE&PR6CLHJjZA%JDws#7@e*yg*+SWhh zZAtH_Mnq6vSLdjVn@keVG#zAlazcq96O7@XH7XWu;2bw~CgWRkdx{2++%pw#Rm5=tli$h zwsGKw!1>_m{s!+f;B8M`$W$f=mo?h`Le%U^jM_HzFi&puu`T>_JW*c~hbs9TPDz`Xc za1R(hkkTHmYUZMdeO#t$;t_X=^;UiD)9;6~k4^h6N*-njFc`s75(Oq{Au8j~S;m)L=|@m|o# zy3lHU z>hbta%8LiWUfg!-Q=)a&Yjr$xhxhDtXJaH>i$aPq z%s|#)8$y;11~#SOfx$ELJatpk%YDk$w4v|{PGfMnb%PGXpvY8Yl1b~vuEq7n{7iw~ zI#&8jyJ?5yrnj;uUhx||H7FtC!{s7WuYr=6Cg-F3pv6!M~1a*?(Tw+E^n>U_x3GY~byr zB1R+2xh33|yG)9M`38P@^_Xr{+C!K+C3Fax_Wyiuw0VD)A_!i<(d;Ca_eTRglHa~Q$d_vd7?(fSnR~(i*TUTl zLG#)0*9laum`3+dpF{7{=aD2P)(O;u3+U^hoIgFkt5XZ!ZG!jhqfWlGjp@Cm8xI=s z-I?)yxM_ankBo9kr|k#AkUAoQ5+2Z{Y9Yyqc@eSleRfsEu`ul#;|8 z0$1ZiD_!E7ykNc}9gyB+W0v|Z?^b{V)`P{)UkOI7I=(?0LXoP2fZL_~ zrcK~f+XoXT7qk3#%O%B(xCOJ)9qL%XzkR2d(p(CrW!a*3tY^!u=cePrt(GEk$)WW@ z(9%_!eM+{Kj&$Eq5!_8X*$ms{OCr1(lkrJwQ&7;sB#3*0b2QuZH)k*s-wzk9Q_9Qk z40cSqi`JvD;)e(0D5UZuzq>}h)*vTNX2~bYI^LAH>qXEnW$lLJ)-5Zb-MO%{+5X=N zs-8{Is~=gtW(>^j)^_{k28V=*9Kn?g+D#Rr6zKzBP3v;ADfDfBJSO3am zuiu;KcGBKG1Tw_QJI9yM)9?KC#t|0+%ZN;SFO@A_inQ%yO?1cu+ONLRy%q4;UP7Xf~t@29Qb~{ib=e(N# z-7s`DwWSJHxec$aE4R~DKnSMi-w|C)eQ1stw&SXg?0?`WaiXoNt1F!0nt8+Xy>WC0 zz^AX2rdgT#Kn?%2U-MwT=$!isBqV4nW~^c3@Byj+3mULrtdXpdOW(y$PQD5<c1>yGsW_Z5wkS-rHCvF~@#j>!XZ_f{_cPGk^10a@aqXGW?8OrWYCmI3s!UE`{F)sLH$?^-=N0j(rcT;FcMmM+*q zJ^aLIkw1Dos(&M@f~Ji>nxmyID9dd(fR<#|6vX)W^~5wAc2A2mQ>wubuOxQfKjIiu*U4 zjNAA7`gdX$Z3dhrfoy&Ek2BKmAmVMXNZsEq+knWr^frcQU#4ezFxzS;ILG}+#O^6P z>#0_nMpbSa*h8zH%%P;`F`>5g2%1FoM&_94GZ&Va=<$gL1w9|oqdCPMum%Ob8;<)9 z2G~Q4FM|6Mi!4afJnvb@BSucx!-R(WUjDcdwrfImAn1F@pXY01azjqwRL?R0t0>b3 zZ_n=8Cmi;!AO|=ag0~)10vG%$q5-drWu6E56DnhmbEXMICXDi>#(MKB1b1^^)Y?a* zt?z~8g>>36eZL-eHkLN<+U!C=qw(bv;-hwLGnAS)apuE|8@aUDqvkmsN`xLiI)~;`#p>uD zDUSp=sHbttA^4Ma^`dmvcTXX{PsM7l=AkTp4lY!(G)`uHXN_NQqA_`CGM!%t z)=K6_%$ob=H?81bL~%F5M$aNx$QT7(A!G4-+x1*;LDylkWx}QgJ~GaJJ0ypt%*Qjgb}sv5yRsfy;`nTBVng7Sh4EJAp3<7YmT6gb zREw1Ah4IS7#Yw0Vir!%RLt?sn#zWYMwEdE~qmA>HPSo6PiNzc?rMdku2&bqMp2K(i z=~eVfgRgJkL~CS92h%LCyj*_ga?>I3jyJp09|mW!;#!?lR3+Y%bfRw|wN{0@+Obsg-Md$tzv8wB%-faX6h^^489rv9eQT z6W@AV?a{TJmPIur=EjAy^M_v~uy{Gijk;DbAEZ<2#~7g}8eeX=`}R`4*FPTJ#XCsX#a|*f z%iBlE3!vzabY$|b5)W8=khuFCG3^Yxl@GP->oSjKl99G6PO_B7?E^eMuA?r0F6*ENXBCO)SlRgcwY z2_AWvNC`xDQ`*0guCI%?)Pit64-rc);X-X*Y+#7})0IIwvuRl|>rTJADF^x;qU zbue*#h~UG_B>Yxnb-aL1qlf6p<>MT0tGIO~?{LCNl?It(p`_iW+g}r=oNu4@!~w~u zV7-;#ScoUyh>vQPzeCvBVl4pd!yeFGIg)DVn>4A>uP2{u?SBuE4Ob_0KOC&#mZvRA zJ@765#gVdL9@^Ta%q(H`Y|cbiiFyrsHlMOilg=?|P^bOW*^su?OQ#8f%#H9NAdBG? zAH$PUqk@>pNJ9C<-TZA1Vcw7V6=V56=@aeHxV~}X!>JBEU69QrEcd8xsok-X#Vd|6 zVK9UPRK&U}_LxYeD8>zof)&xgCCLH~K9{~6%L;dSD( zk@GOfu3Bn8I76_6xx1$i_KB~kd-gp1T|qBQ-TuWYpPqZEdc6NkR(=iJL)LU=y;PE( z>W{v}1MjO`(mk|6N!(Si40-5^BLa-u!P`;n!=;X7{q9oEk}r!jvM1T8@85HicE!$F zTzaF?Ke^_7G#}JIuX%d|R({{3}7nST-bX#85) z96FTWdO+BtA9gKH$!y+Ct)nk&X4XAfw{f;zU(Wf>+DA7%X7wazeD~)r$ss*6ai&8= z?CdSnOSYTI|G8XH%ei})Cn~`#XSG0!We#M_^gh6#W$|P?bwo|Va461r`(=a4?hJpi6b*w7A{_L~`7rD~SOnWI(00SJS&%hQ+5l`>{G@;sgIA z&}v$;D00_><9h_WC2t8*SuZB}%U>s;>TyCN)YHhgYi@_t8DN2!wZOwpE^g=R6vp|9 z*#Z3(H%k-xvgAYyHUAv>LtW1NBk2amJ&Q977Jj#N`CK(@nssKR z>ezOfL3D-bPxa;ZD*f}{(hBP6oKM~>J3kRZ@L2H|Xcpved|uPQk7;0zmtDla!235m&vn|UV`xpKF!m%!O}GxM8{!G% zEZaGcUG=?OeM~3h0lp;}ZPV9k!ejl8{rHz1BcCwhSa%*?!_V#?)-i2=x!^4`#y%Sr zeMTM?$W~(Chwnc?(I)sZ6TK>;Hx8Y$N6zI01-( zv~yv1maP?ZL@`)7Gzp(>BS}}>HT=(bY*U*iJ4n)YeOOf(4F(mz9(#gXKl+?!`+Pt)!O2=ZNDYuu;i)!RCQk2geYIXXeYN-!`FidJcPk)*Q7DIh@%A4OF~H16Jj*Z{I`H=f3B0DcDhR*9*R17+yBsiYb*Y~4$*SCp;h6*? zI~Wpn-&|y6-eBKo5~BSPIge$Xrg1W|q=#{)Nw2}epl1}@*b$j>>QPOPR=AkfQ7gY9QSOu+_gXM; zQf5tPLG!|Q4K$$H2MZ1k1u~(xfiODr8E;;E1nzQv%VX*nr$zc8S*PY9zUyrQSl6yO zj1fP;B}y8$RoAW?4QED?GI_~d5dzsEq%us)fUvG>JIJJryuCBg_~ZZw`|}{FmuFDt>Ts4f#8m`8Vqv_uxVou zK7JJheww}XDPbRLN|V;sX>H0w9Ocw~`}~Ynf`9UiT6`w-Y4TJ~(}s%RI<(-p3f$4lC6`}EV@ zh?h@;wgrC=1WbiDPI^c3(cc`Qu;=%fJ|G*-*P0hC?5`d1)cgasX9K2x8^frEgJ^}e z*3Yblb9nx!M`={7`eGxwn<8t0ZdEau+ONv>C{L*ukP-ImnS= z+1wp9Q*gf1@WIJzMC!i%XhMFv9$GE#XO9j>EqgZR0^-;%;}2!9$r;!A2KCZ{5lHFz zyPp75c=za0Z|q8}H2LL>2k%*?FGjriKyy0L3%5hePkru*FVePHq-#VkI>oaK+Fs~J z2#=!{H|C(`bv}7tS_^sO>a7n3uGN)uzTjw$;qU-6JRxqlv&{p`!mGz4mR-+;PZtBL z-0!98zpfzoz4tBGQY34eBzh8lwoSh9Z3j%Y9Ar2k4Y%ku?&)L;aogcFglRD%PPpSe zM6t+C=9<@;0aszaMSAe)63!Q*9czk&P-@h=D<;i0Sx5Y|GwT>bGyve3Ng^Z5fgW9Gq)L+_iP)i%R>LSn+WQ>MhQe_t|z7l*5gZH>P%M~b4VS8M1|1|oKW*T&hlFf^FIREJ3BD6*RmfDgQEaYL5&DObe zR9~T#|4y&KnQdur_v;>6>QX5t5R;9G1Iq}0%c#D}qwIHZiMk6qJmb2P*4gsYJ3a&T ztf=rR6Rj)&sV~j^m&HYu$Ew7=7W;=%3Mn=h|16%H*Htk;uFZBAi6-I{>5jP(cTX7}#NV9J zH!klBRLA}KRE63K{cS#+DC#kcmgHyAi}6*?1uTRk6J=_vdV%)FOeHu?0ZvCW2PMnK zNN#1Urn)jc6tdksGi4w=ldi41FUZltJ%6SOw+P9hwiCyEXY~2n5hP9_2>EV z+qBW<%b`YT-CDTO7zj6#Ex#ByFX2J2Gg9~MYb;tUg@U@0*zFh&*>2QxYhM`5B7FV% zERTxX;}~FWnBH2CZo5abLCLXS=JSHq>pk$pH88ryb90GDsRs$&Zlh~vw0m_h9mI;I zLPIZ;5S4UDlxieZio7d`Ko+fhCVI9ZP8+vfZ?zP(l_I@6Ec~4NkifeupzNuhnaqAw zkW^8%Dw5jjItFfg?3nYp{%i6$t_AB~c^7}@0>uX*#`&HQqY!X$r>iG;($?m%*p0*y z5#X**zUt#i7?VM4A5MC|^6U|Dc`Kv5@BbX%_IxC!NPc`ve(QV8GpFXjd0q{oVY~4@ zb2A`2hV}%*)n=n2% zMNV+Lwr9HcC)v7~#@ILyobS=qXze@YQW`I z4gO5sqZE@NjkR7R-fxhC&Vx~=Q2Rlzqgbk}h!vhx2dYg1(!Zv^Ms61ZjMrAf!iwP? z<0DG((-bfy*!_qFO32kgFdo-l_Hr=5>Oi1_AZqu%f=oZJy$_CT6VnQC&q79mHS`kw zHNEb8TkF^Z$Y|}hfJJt}o||9)t>5;4ti!pntHr@wzs@>I9!+$POwJ$3h>&x!or6{p zy}NLmu3FMiM{E|c9QS(PocYvzrWnGyLN*(!jp*Q6-E%B0<~j({XS_{F#iT?kY)^RIKfPvpQN+HdE#3Q121a(F3$FRW{meMD{wDRqh0Dk*D<(()=Z zRiKur`qd<3H8nex3iBtuW=DC`Xj#EJTdPKqTADUXOLoz!Fj=g?EPIJt-X=CNG4W4$ zD8h#Zjw=B{#Yp6`@zjd3d}?qP464akkc73v5Vddsj?>hooyXSlC=`AUr%L94Z7MOr z57JgafQA^r!UO^S#bCpq?=MU(6zUJeMR?4Y)JDGlZ747~kUxIn2(oP0O zv$RA0ZlI(#2ppOh26g{;n0L=q{_={O(Ch4#(AnzKRWlWbJSz! zH7L19h6k6YvZ?P<0kGQapK%2)sj!pKy8;|1Dbav8lDl4{B9ak*6P#L)HXeMsc3 zkW1dt-68S|ruoYxJ!l`y-yEst4&TU`yS|Heq>H=00tZWyU#>Saz73=`L{6GB%Cn7R zMaq3sA59*VyitP?p*g55V?8(*e?tSA7!Syv%oLe`-YMGy1ma%dfBEdp=8j105w8w6 zbe6~z&EsoEe!;ES4jZULnwISTBC5HUmFGp9S^zu3zV@(R-#7&>;@no>E_=1LOlzO( zR{vD#X_o;i&?>7g6(pC+ke=On8}_l>7wWTkpTKrGn!qUI&!RUnqExoES53vE5-%^`JUs*E0azlo zPoF%bTcpQQx5S#q=NuJ~OHE5EtF)q`Mdd=Oaza)gH8v<> zT(GFJKOkpSzqG!U{z_(%o?ciyPIRxttZxb(wM9nSM@W*Fn>ZUPp&%9T@SAcCAU>~@ znAt_kN$sU{f+st>q(VbuNrj%v__btAVTZ}Gl8$vDix8afxqI+y)}9~uArNJIxzHHi z7b#)Uod0}{!$at9FghI+iu`22ktf^uv`xN6Jzupu2!1N-T0-tQl^3*N)l4=37A{j= zU~T-6-95d1Wo^6y#6CxkvPA{Dh+HQ`M>vO`P*c4{M09gaBCKJ=Nq156=Eb|4dDTpC zs_BK8Zs=?0gsZ>CG>)-uYUu;&|ApA-=o6fXjrlR7H_-efs-mi*!cp;QFLI{+fk|M<&R+1H~(^hw?yRTZ=y%6vLR8^(!zYdei2aLx!$5`*pP`& z{Tk9Aj5G>W+JfU2azm_cY9Z&1LZrT}9yN3D*R-0wP{J89#QEtsA)<4SEEa>-wWkw_ zzE%}ZwN^yg1`HcxvYS~gwNaBRnahZ#RmNA*UNKJT;s*O44VEE&PL)HM=Q$`$qW zlK<+-2hcaAGk*Q<{lUYheEwe{eHa=3J4hcUX14zXii+*C8eo76x%Pp<+YolNS~dIy zS6~`DuwG|__;*#xOv9#tBee6=q{W%R-*)iZcdzB3jN7fxJoXyZHU>+K0CyKzy&eio zjxVeL^w_rB?XkH*Qiy5OUV69<))>_m_AYRUbm3U|N9#agbeU&Wy|fm8*Gx%J)vZ)K`GF9kk%mmpiO+!2l`NACvx|eA`x*#u^(uASXep#9|ehnnVEs<|2LttDx`+0I`S8NXsDRSjW@G;GhEV~yXhFWb;Dy08gqN^r(W)_sSIsIbnVFlcnk*dSTmBk_89Vms zd#`=Z7X8lj^VDP-GvN5k{3@+Y;YTVX9;jm696ZiU4bZl$?mnu|5nA##`fN>p15}DS zS4~66DuOPk9buLX42_+fD})pcH(rfU05n;6KulK3TbFYI*1{3*h0yzD_T_g^OqUBh z6g$pqIy^gDB}U*jrYrYAGrYW1+Un(?jPC&c&%!UjVrr0kXE!qn2fFp@b^IPV7btcF zIE5fslsnMbdwy0lm>Cl5301(xEmBgBGV2d2MPHMS&q!-t^dNrAF{Ue~0_l(btum9| zpon7lVlpuivoZWHL9z-J>rk{G#33r1rebcJXtrY0#n~{NJR%r8>PO zA-EE0>2f$M&-Oht6d8$=e(Rz=1bI~rhw#~|%!3)4vdW^Mh_q`^p#P~V4k_*~)>z?&z2`fYV(mPhZvy^b#is1Q z8~ul2(V81_&*!&WtiNOQbkH2%KlCoXcA(570l9!5H#ODYV@dn*{M195Lm3h5s5LHp z&f9L=F6dkfSqYg4Dc7%s?7KDfx)lVXiqHxVv!l%GrsU6Z(cs=YOBXt>8GidxRuJ03 zKLvu((Tx10D1Vl;;U*P(YIXK^5_PJ%naxdlD{x@Nh4-S+By_R4X&)Ef8R zCPm+u(%#gyxvdS-^3*KWD%L(q=C@q4ah9}5QoB%i2C?eadO4O#Oz^BNFYs1fQhW@S zR`=DKX0>5GYrDV(xfTw-Q(-}w%kNsvyFiky%3Dsh<2ynaH!hO!*!#&SNAd@iQLhkt zi&0UA$!-<((Cd&JP}r8iDdjg^|0YV(kcrFX*?tpcI;3zMq69};;< z0gv_Ox0Tj_2#Pfh5=lT3Fg18BHLxu;^i{(zSR-giBcMnl1de6|rgD&~au~aEh^uns zr;SK)Q&NVJEiE?Ii7zsqsQH}M!>_2Va%v2burQ_Vw1Oleq;egkk;yEPbP08Y2!I{y zWL6TSQTj>Q$8RT*>QUv)Qi!P&9R0-*JP->%F^fnti-?#x^j(V>tS~Wx2T^|SfUhGc zxM7J%A>?5LCbKn)pO4YqtDag71=kA($MQuLctdM+3+3n@DSykmcZ-L711@|6hI~sL zk{=d^IdF?he8ViZPvGzuZFrA$I1h8o-FWhShXJI=7)FW#Z6Pv5QhhVFn8JOSD=Ihc zLb{-pjdaf9sethyx6a0xJF4IxP~-MOzKq2m%z{WZe@rI^tc_1Luj~U!w&6(QS`nK) z*V#^D!SW~MoJ{s;lm$9_@!E3NG9*jr(L9fx&^>1=`mB)M_>?;`?cNbj+W8%7_V@xv z6#4?PouITOR;a>H+G7Q+K3YrCmVDLCbTt5G)h=6OGJmnlX7VzCqon|TGn>r`a{M5= zF`RqOEIOBVGp)WA*7mTvG3wu+&AQy$W}p*Cyptv5o`K@3^}$=Y0<3D+s~KmunD=A_r0l1hJoiXUN=P-Vk3#oFgRKi3V?~?pkHk}7Pad;J!X=O4&Z1i=%@cy>oHjC#Mpanh z95piMB3F#VlWpfjwY3NB6sJRzQi`)A)26ajXqP;(NRyUlmo#w*)239d)H1f@6qQc9 zGVbEkwV8WV>fuz-E^Ia~>(tP$Y!|0_M%Silr|dRy$)tTWs*^_UHkx&Y-zI&f_B_t( zRMRehmGFKD;vunBgRg*C9=hnAMh|;n=plly3VXolp_3g;en{z|l^th($myY{7mIO7 z>Y<4~UU8S+NoPNrahKdld_7Ko!24SCA+?>Nudc0b3vBX50mtyu#M8tSxTm{!00MlE zd=j4buMmc^U=}H^lqhts>9(rXD6i(x-BL(`I3)f4ULmU^Z|ZtZE71%%RrX3%_FGl< zY5iXYlbKDQn$3Xgg+qQO$AvS3F-HHdXs8P@k|#o#xiCSRy$!U)Z zQKI4;-c`Q1h1O>qVl5*uR8sr^rKXln*E|S`(VtC+k4y>e!48+ zgMxp35b_T6)gLq+?LtP`f~qP1bTNHhLEB0m&ywU7wUA0Bsa(;eT#&U4eW{pBCFM*J zXe9t&hQwM-wwRc%2(S{QEyHuk{mqgXGUtFTomI;0Qe?N7<*6WlCJH>!^^DmrK`fRZehcC&mM`N6ih)`Ff-gp52@#vKz&;*njh42n6EGv3P^~^kcav@<-BPl%Y>Cuf zraew}qi#jBO^s^aWg8Y-)#%t5UX#GFe_jR0F@0`N(wSMJ>i}t~w+7|(?-#HlNfDRYa9#M3skbOxdGIMy3q^cQ~ZW!&>~N%^zwE^2yUbW!I9L zu;8r9O=^r#Tfo+mKDXet&5dddXInsDm)fx4zRb;X_ES0`#LFLW4vL;<L z_($)V=lti9Cq(}kF3!Q#^Q=-uEK((K?b6RDd|P=N z4}SRT32agEr*XWd3zwD|hBK=&Udv`{0Je?n7S5-DsUqM*>eB*>*WA&XG~13|GsIIl zZR3hfoNN>O1!IOq!lh4!QOxT8Q;=l55t(M<8aZ9CV)h#S&=d%zp;BQXCq>cZZ%SJP zX)J)qczS`-G;YG(QL73Ad0{>$Wzr<&?WE=0QDiMAH3&eCD&yX05&{XJXh0XvnnJp$ zgS4Z=x1R1_hZP)?>>o(5ND$5ixBtd_1cVIpmtKRHx5u6bsE!TFT^ zGV}e@v$S($|Lpd{{i&M=6n=j-{139;f~&4*iP8-aAc5enCqRJU?(Xg!+}+*n1b26L zcX#*T?ylkB?lkvy_j}!=$NB?%@3BYKtg2Pt^l_`PtTC<8tWmA;tZ}UotC5TG_tiVd zK}gdxn?@qWPM~rCR!Ni?BEMG78g+ChqB}_JNMgIjB(mfG4Fioer~pZ-09U90W2}I9pa6lP@STtu8$vnA z_e;&U!04Z4Ih19&oEAA`7P+h^IkYFaytp|;xVa2zITUHR92z;K8o4a1IW(&~1Px-a zpA0%DQ7k7BHYYKpTVc9eQ9wud!zC{-zwT{+@Z&eY9-3F!`{NHNdSrikY$1B|etLWo zdenS+Ttj-yJ$k}yLrAh+c0`M05pin|_BAA%9-7aPvPhrPM32lwpY>3W_E7(SLGqHeu{Ly(ru}dAc$ATrNbbyd zRHB#AZiRUyvJY+VaNcFJ4=(OF-UYIc0C&*u61w{o&!`_2bT`W0fyMvIxwUooa5xi9 zPnfd`=iHknw>dcDkN#0-RoA=wPVNM9CS(2M)~UF052fAKy>ot-!Maw|9vHht(5bS$ zhVu?rJz49J{PbLZrmdcNaI5T^0^fcb=mM@`-a^<;hC3wqb|#)FY-gt2%6%r+Zs9kp zbgvQL!dy?5I;6UH=--n1IRZ$QcQ&N)M?b+{R8a=W`K|23cHg58;_!zH*|Ve^A(MAH zwUW?U@yYGoWf4>Huc`OJF-JsO0Ui5r9nn6mjjEwC3A1aUCAE?AcUt?Hsno+jMaqIBeiFPiH!ZuX8jn zXSzzQ2YPj0^Vmskh%}FDJB)1{*y*@wyLr0_xf!~}x0QU7vXa}%irdOvPcxTcYaa|g zB0KS3=ExOAm8aHS!F*NJ&Q3Mr&Y|0=hUm6T-7%z4NT-d2Q_2OOH` zVw%++TE;pw3Il;c_GN_@Wu+%&m5mzJ&Z{Nd*7Dvg%1|tecoqfLtAzxs`Dd$@nXBcP zoMrKxRdbw0N}Rb&7UfYE)voihw&nhtK;1iqy10aVtIBye>qRnxS%J(sb%a@Zgqd#$ zi*^VL;sVj7f3lG8TJr7+$Sm86EQ*TEf{M(OB>#yd&PY*KI#8Bhx0RH)Re;+HEZgz` zcfPzcV$afm6D9A8DHi@W77ZvC$v0-vtUPpi-UFmcxP!pMAO|5T7O{9{O*9r&l)yW` zEY;EJyy?DagUT5TnmNVFS%=OlkFs*k+`?SaTw~5WK!ff}gNUZH8tlAi<$@&50(Ap% z19t;IAK1@l)_p@>iDky~q~Jm5M(F1C+y@C=P`|r)YwQ96Ac8FVRpgD=N4GnBi_eb6 z4q-4aFYj6mW$;bFR~M=q+UCh03Iy{Gw|*Zij1fkOk8y@{d6*N>JOMb7K_Y`?dfj>F zueSZUiFb@}4dW@)k-JH6+rrj|_b>8V6gIAdVN;E66Yq%BZLd?9ZdB@Cu|t_|Lh6CB zL%O^EqjPKU;>0yvIYc>3IZ8QHIZ`=%K&0%2iPc2ml^_*?av8>d1afxUqPW z@Ttq*Eq*rlY0KU*eOBK&wG(8g$v~TglZ!w{NS`k<9<`cX#ku>UVH5+`Q1!@t7OOb6PXZCrz^&T1N<4 zS-9{xy(EG%mW{+#Buz}iZGo6Z0b`*fGDOIEo?m7@jMslv2meGkJG$#n+su*zQguG> zCO;IjaK3oCxFxeF8nXyfM`-gjKFu_0PoC@NIc`ZTYYsc~~C#pLkEev*8yQ17sM( zZ$SpwL55#N4bVjme+&^5?#2AM5*J2|i}h13AR@pS5ym9@iN}!=B9Rh7krHN}5`~iz zs-66B?KUy(4rA3eWz`O+ z&w$(`4x1fX_qOV5(AE{~r?JW--p4kk%^u?UF5&qe1mUhOw*fBIuh4@hM%|rquSg8F*hIBdpjzSr_V7tXZ(7CRYDIrr#qg4PwrvdrUL6Wv z{rB`boUMILt4U0&Q5CBRR;w`=t0~0Ok>)4FEo1Vo;fE)p|B30la`fq?d&1~GWP458 zs%7dn#d0xbb1_A_H=?^Y0o)t&-5-5H-2aJqh>UnZk9hPgYX5iCA$F88_b`L+Uh2p% zGN!;%X+ut?lu>F~Jyu8d*m(9-CHBNQ_Dm-B_1wYu0Hp%{Z)cCM#Cy{WR+qj@DTd&Cp4f@Yb<3O{7ipNh=PT`c&45 zl}#*7i`Q0}mCXoEGps8nYX+Lu>DJ8zO>-_QHfx5S*4byxP%hJmEBY_JQOgQkCc|d| znGH%VtCP#>T&727e%cLEE-O{bz;=_RGqIOZpC&w)IiFhHGq#tF_Zq%4x|g;0T1}U= z^JVRJ(}y!(o(9mFf^=63zqE1$Ry-dJLj(o#4S-?+VsRmM;Nfb?)xyZ<=CYc2susd8 zZ)kIH6E9D##uuYj0i*r5i^wTP#c~ZBwHa!>6m@8=K`0MyBv}?m=h)z<7p;)tq*v?3 z*xTlVi>Ybx+4$*U?X|{J#Y4qwQn?5wbrbd21f?Fw#MJoS;rE*Y_rI^}uYKIsKIT~r zQ)x%zH;2$Sd8y_)jCAR$5{hb%X3?)@F+n~b*UuH)5}ekw%eH3v2rwcONelop}D zaY~!S8cB^pYPqqo>n2G}-lS^a5T)gl`hk{ijDRro$Of%}=gOvw`P%S(bSrG(jbE zT$y4V=6I7Ct2Cid=Hxgt!ii$&h8WBl0}a8?_6tohMnha2MWD)zg@%x&IYDKy@+v=` zIof|X$)cL(c-F-P4e>5BHmgFO=76(eCr*CYf5-$yKR5-&{y{w>Z~jIAJm&rQ+lO=@ zPl$2JOPPmCnGaW%hg+5pW08kxk&k$iNBF7$K$u33oW_=!MxXeV28w3}z7xey{#HQuRtWT?hd)3cxsTz0iExwYTYYw@qP$9lL#_)HF6gF@VWu8)M#S8Uw9NRM1u zyEyN@pk1+7c)lHu_eiWq9J<)SFa#HU*rVNbt7~0$q@x3`SHdGxRWcYR&C?<1v5X)mNxy?tpv?SU(S1c*JHWtkzEgI z*Av_A>0OTq*W*3yZ4r0m&-=Yw0S`wI+%f%b$iX*ygndHp*hv3hayUTYj@xrXk3MAJ zP8z;)%j!Yn$RfWolHI1@UZ~nP;e_X!V&BLV$snAppLCR6bKg{-ckiW`3|Exw2&+Ps zyNaJxoJ{>kecrL#LD{9K@>d+AlomLs=~W>Oj=P)vd);zszolka!PbObDynhLL7A=C z>W@yvml&xP$dU;qHUv7ZAXgu)9$I=$_U)e4@Jx1ao>!`>u4q9Y_t z+pmCa$~qThjwyhuom4{f@76# z!yk}mq>=>FSt=zet6AM?#d7WPg{8o<#W%V<`XV-xzWPpA0QT}Oa6~IE zuM=1z5h2Cdv}jE$8p3%3*8QcY{2=23!ThsmYI^(p=7=X9g(uHsClMmxHmlhg*w^N= z9n1YWZ?q~u1jQ-f#RpT|mRP`fAp3@Wd_(qc@9QdyKj&3yJi-6??q#SK5I`*2s@|Cj zIvWeGq81&vCJD@xWpWEn{o0X>*Q06e@&t^O7At0rOP4@C^Oub~iY;FsB=#d7`RemR z1@SF3Z#IG{-AV!^-EP=wv3@B6&=oeoRS%qThu)>QdP zyE>aynbQVyeQ?p}cIPiJX(=6Eiaq4`D%j*KDCP^Qyhelf7coPBc`680Ze{za1`xZrS{1aW;lRU6)OPlBSn z#h4oCJ<~gTRT}lJvAA8?JTdl;YSxThpzqsZ!hU(m%x!98*-?ue5kuT}I}0>`tc9#S z;8L%(_m|>BaovRy7H!nvcL-FxbFXVzN9g9~W#*58WSeN}q^v)br zzjfW8tOA|S7ciGjKI`Bu;`EO{UW8(mZWrzsPkg+&%iWt{?+nTjnFt^xmw(#>aK6ZNIl1yi_i5df&+&b|c*^Hw+z|ez zaV~liXlly)6dIk)$#J$!{#OZYFB(6a`#yG7?dmvIke2INAAFe`jKs@)t#>E{@Y;Td zde~?OxtVQk-txF!v|7?PYI^nTUv%Giw?|}h#jQ146C7WF7cQ1(!CsA(fIlNGUl?)>&gd{hmx=LXe694E3 ze+N0-uwyj}b1O9qD7L~yy2i@koa-Tykh8mSYpa-Q+7K^iLd?pxW-E{W=8{pKbD7mn z*cxTYjFyCi)(*Y zl48Nf`fvRC*BxkHRY_ef#!%C!^7j5$RnW!AcwE(QN~)ZA1=aRc`zk4&Gu?hJw5&u$ zc7;(3Lcl*z=}ANVoH9}lDj=VJ9hcnoXkK`7?+N#zhFk-yek68|t*5+^Be_r5Q3R2l z#*!|LD(JMIi_UYd4%Ub#`eXE)=hHrSape(>!xQzqb});%DDtn|wqz`JguZL|{QbC{ zrZr_|%<{h+i;96`&*Odo&%^_j*Yqq}G!WYk!6R%&7z4fWg7(iuEJ~+|SICE?!+Bux z!UA$NcXv#_Ktza-3*`EoOBdO7GvdHt?YCmqo3x_!STfP6vG}k=%7zCZ%x=Tli zLEe99L;S$*(7o_kU|^c%9Zs+F4h!n{3$4uq$~TrCIy#)Xnp5$ON^_FGpO_S-Qw%bx zI?(Q~*0LT;jBY!8Op_sc&o$<~i_h5=;!HGtPR7lx<+L??S$r?NvPD`6a?m_eLY@3^ zKx9S=@T#0_|1Wv~UIL3gd17`pTtwi=55HiGZQ(D0$a4i=8WtK>FnH?OHE%qoOhY0j z2*o>M$@Ek-ZmXw!u1UH-hv4TaN^0YxV2UlY-`&*pdyFx|M+VS)kU!0*i_3M^i zV=A91`(FR0_YPwav&mhhZq`ylyJe|k6(bcqlr4dty20hpbYLr%^fRo0Wn0p5bySAT zWsJoZ2r;~uX=hlxKYP=K>WtzCS*(;s@`pJi+4KNw=*VKtBW@Wyu6T@8@}BilR4D}iaxo` zy5YkMxZZbAHliV`i3%x&o4Jg}Mi&qena=j1-{UuCuuG*Fv%!Pn2t;xr_j=?0M(Om| zjRYAnDlZ!>pefx8Y$1796eRvFDKbmXN66JqF;iO&EH!_Lo5b#xZ=wrokY6Nl#%=el zr?VfThDJb1_|ve{KqL{rJb=+@KWb1>Rf7U8|FTjvgigKbXKvMmbFJS7n$F=IF(A?- z<{h$75c?ATQqv~aNuCo0m5+AF*k6pNB>rJe&sej7(YUKpocQf7Ku-cv`|CcV85hgF zpdffA0>(&|(oU(Ijgw|CE{+*Teo;W8#sd##BGfALXU384>p&%5MoN>eIQ@t!({Is# z0!Xrp$ox(Gf0YYaZ1{HOxtDU~jn`gpMYNHFQ+|XBO}CH`wGXV9oMPsG<&(bb=k4&{ zW?%^0^_}f2mG`LPzY>0_OU>m_{_=Z8kYZCy^V2##tjqXs)I7zHhT_SFeg&u@e%F8? z_)8S^?8+Fzgnj*!fI)S!p*2VW#e~e5X&mt{A_7%nK!ZfjuUqzxz@!zOJ%vX%P zVW$dGioyI_GJcHV@In)TIhsFag#2{_mUER$KE=_TQp-MZ(C`* z2<7)W7yZE2BghFWfcFWPPZY0?NeLxON7vqelC!Rz}P9wbRqplq(ri#Gla+byBOvopK8 ztkY1|q?i}mZ4~@PJU_G|45d*d>O5*f<=RSo_tp5C0pWaHjOi%_*f*H~lbnKeqoO@N zJP=(3&SyuFV;W_a81R2DJct<0HZz+x1V;2DW;*QJu@k(1ZF;V_)sO4YQabzLL8(&M zIb$(6yY;w!(scHZ6k{Q>aWkj?7s1fOk$YTwH~v=40ly4!ftknOtp&^KC?JnEM(O-o z67-ymwR6|1yxaGWy}4rer4_91)n1>g16u)s>2A{<+SH%!=)w#go(95i@0#D}#Hw~$tokkJsVkxHmeYt0v}T`nPuEqPIq zs)#l0`N9M#e?FnXD!7T~k}{9UM$www83&>K>Bnsf`9s5U&>Xb-qJ}OaplWd5T{ z9(B$lLwo)Sm41sq-T}HQyo}I(&~>!{x)sr=H!x$fZ!0fz#&wD!{s3MIB3fj^DHXrjQsIE$FEtOorqpHZAC~ z3F;CFYee*t95V*2bnyD-1t)!d7-4&qJ)bP?KXy7IWox8|0tDq%rtcyXA}CU4yI;tn zY?0Z_y1y4l)#I}Sa#gnhXeZU2>A$)tatjE4$8CktBOUuv{?!Oz$=w%#DnW2TBWJTQ z*CvSPz+$#wnTDah1n=p`t4aYbtA1$+9WiotMfi{q@|Ka)Y`B~~RH-iP>QcUDZQi+A z5o0dq(1BF3$FSL1FvCpD744@){TNbKUsPPw8A|_~Qtv0PAj{)q?ZFwuyx<*9Y3$Ap z+j@+BmvLHi(?OA7f_jB4n;_D4zJK+Gx$#jRLf~$oJh{q5SWb+sGS`La(FA2avO2s-pKIM++!gU z%Yd3mt`xq6r&-PRBdQ0RaE@fR4mq2O!3%Qt@k%uuyKmBBu%_B+HY678(;azuTrX4d zrP+|BbpG@DPUA5e4=R#zg9mXFiH!DR!}W<3fn#A!F0@vN@s|?ydE%Ip1D+rX2^Ps^ z1A79+2Fo@RaW*!zu{pZg2<&VX=aBmplr`FkG(TNsrYU0h`gTQL-p80O4ljpkX?_0W zQfA@^jCo6j-^rX;0;$rhzbNQ`r(lhd^%Q2LxS=trZ>gOjFKJ%rs_43zWOs4@3$wXs zYdPuh1yy)@&MGv!j7{$sDHTecH1q|}Xak}U*qSd+=GwB%x)>8@b$PRv8?J(*&$_u~ ztr?pxO>O?XQK81X$uQ|MO3=6Qn-Fo|Jz>*qsdO(SU-}ApAL$lFVVU{60yxeLjUnhu?wo7T}KhI=hia)k?KuR5zNoaM| z>{wc2`V^0t+B%~18ko?j*gqZ-f$l&;q6YbI5(`&?=7Dk`_3mNhR{}DoxgMzE zK!91nA+0PHC=5Y9wY}bmSJej_D8(LF&XcXvuZyWeS#f-RK6LXa=7y#7$3!1vfnCka zNS1n*IoEd9NKhhac3%(yHS6WE2v&7Zc}H;vY6&4H)bk2JL8Qg5h)stq>611q9Fh%a zbDvpkt<1aH8Zi{T^#I4`%iMCIy`4TEU1?@sXMho%XypBm;oKe*1JNfrK$q@b?-=fr z*l(*qj!%=3P8{hsr7QgllB~`s#G3wNaxJXYsjhElv~KU;-?H*V zK?58oa%|m<5Xn_uyIe&qQL<>MV7Tu*UjkOk*%C_Q`TF#X=5#YD%=QM?b^_xxi^kAj zF$b4nYX*hleJ*@kPfjvkDx3&P5;e!O(90zt$(F$9%i zDHLJlNP9zP1AVQWF(}$Hd?bXU7O?HjjAH1$bSt`ZP2>RtJ*1WX${SBVf^)~L;K zk?d8+C}(9)C>+uAdgzQTQWh$~Mc6UmyY-ANo~I~wdf3bgC1O@FzAOytLDb8wT*O3H z%><3tz{|fQ$67wrtKJ7DDLV_nE;th2cC@{I`rR>=pIuSHUWB2Kd=WFMUXSS39TBF= zoT3`Gx#GsTBhN4*Ss;BsXM|Epw9+i3n1hwzsuO{TyNvq)TBNR`#+W9GcG#4caS!FVhl(XtKyU3OMxu?#$Gc`Rq~} zzoz=79W*C}lFoyVe)KqXMl+CU>2k{;l5Fmqj0!pDuJ-P0j@D;0KD0MNPdOxxrq^>! z;tD0}m5hdh;NRD9qD2%{+2x2Qv!>Ku3GiQ3D{xe5P`BX3d7GzdvIlSl51WhE$30a- zHzI@@+k`Ih_ZILQ2@fc<9_&0W$!^ptvwB_UYQ^|`uWpst?jLTl)~iKtvcz9`ht{)$ z?&d3%X$q#~ax$~vmOZiIqc0IZ=lZJ`h8c$Tyi4&HW6cNYzlJ1{2-&uFxb(-@?bf}M zIT3{tLfakqrUDGgLWLsuJhbSMqgqce!(_NQ#_fl6?p(P|c7?raMkkH4^g9}x_5Se6 ze2hGhA_f_f{_`@VU%O@3E$+GEV^nopBbzaJ*^Jvk=P^R+aWV=!%!j-{Ng}i~#Tgmbx);aO` zhMAD{Zc3SYNyrUT=fDR@qH+TJ@`bZh+sh@!un%3a|3Rwc0;0(n0H#ofN?k4G@}63^ zSaSH}U##dI{&4d8jdj~B-e9Y6f5-`_8wzEeY9C9ZOg^I?a9lUN?$+#Yxf|&(dUtTP z^O!LuwW?2Ic+zq*+g+8I&y6!BPgT74OyjuVbV=;6`o^%N;U_Tp^7+DhF~{8fPpKIoG?7VoE4G~AiqY4DddHZO zE>Yi6V;fq;Y(6Ei7EX4$>x_=!CniC#La+muul0;6U7j0Rx1HfVYv{^&``TIOW9|U` zP#yZ=Z@0-EV~p_RPHhD`c2JP6p4aikYoaSPV9bgx&lxf=@;2Uuo9nxpaRI57jbx#vgv{uwj zC3-+ID$;ao%B6Iiq?_nwR5Dd;^Oy5JDH9!pW9yJ47$2sbjzK;%m$ooM467CPNv(|c z=;76iFS<7UW`t0cH73*u%{|MC`Q|kO!#o0LUP8k66J7#UUFI;(_}q;)Rmh9DQmaF7 z_k6H@o?)#ufYTQJ_bFuSGgrPhJriS9GwZqGGiC1J+W6X=c42IR428(tYgse)3p*$#xLJ2%bMC&%i z6{Z{k#W?~9gZ^c7a1|S`x+h1^9B%xDc^O-_@`fdv=+A$-!PJCxDmSgmwZ3;(KdBXf zBh5{-u%0V`QI_W#Z+}ML#%s5eYmlD*tE&PJ{TOaY=Py~A0d4`dJoa_gA3f-b5(eU^ z?h)JqhcVo7((k5Q`d-;noJREe-h{{F?}Bx-${<+GSbL+N|0Zg`7*ij}RKVdIbETdc z(qfIe76j~p1@Br)ul#du*|Leb)<0kXZFg_H40)~9Nzs%%t+cu@f`YSu8QD@h-Wk(}wRCAijwyiHpJTBc-{YurYX z+C~=XGin8gOr|pYks5y1C*Lm44GO@Nw}zGL(RVVQlclOuYT0$Xu@CdILsOaJ2RJYv za(_&JyvjjNF}surVlti|;>FodoP>M=dEkcP;IgJ%D?VaAMVLC~rwBW8cg-gMDiH!B zo)93lA7x$$5dlf822C8RsbOQC2eD85oeZJWoEj0%SK4Y28~?ZjBf#9c(7-=Y!)a9` z4DlOuq1G>hPpiYR_a7hCgEh{=C#jLUCi7GRq4y7_4J%OoU;0H|sjRv%ZaO94yYapTpszVw%Yua4 z7}pp+Ke)4Y#k+b66YkWOPvskyuQTb+-vRHR0_H`Ut^NhrP4N>D# z2_|}T?&1VjOf&mB=6sK%bJO$Woo z{}5+&`;NWQd^+(t3B-1HxY0H&yEwkh`S!P4fJM(hD_R`bM}O`$Oa2VZC0KY@b@mh| zkaYSW|NRYBIkp9Y0QERqzuUBgVk!nr0Bv~i`JVnBprVgw;V=Ej)X2mBjR(7)qk)gZ z#5UuZ{O(7|HFa!O?sK(qSz4$WOmXkk5%;6Ns8n z@~afyo37aI>3*Q+{Wzi83v-z+?(q-kB-eoJ7HEegVJd;K0mw}y60wWC|a zu!(b)XY*#GwKTOoP<-4vwF6}X2%buWF5!9K^J=fiVnC)!@A~#(YImw+W-iq60ex^u z-nhqfv)0Oo++fiU8st4|!*)TmyeSod8zIj=dS5H~H?;xvUT?z3?}CYq0}eKP7<_(I zMsW*xsf4)Gixt|HueAFn8o0+2i=ttbv3}H#>mqsV2xjS*RiMQ_L=q(XDW-lNIWt!T z@Unc8Vq@GS5@um#4dl_1 zINf`=)4}5vl@(+0VDVVt>+|;N@%%EPW<_gOuil5((WB|qQgU|xhm~=0ge!DLsO;gs z1p0?X@o*_gw55J9R8dDiMCP^9-Mh%hwbDdoRG+3D%Cnm%YL?5qiszhFqYr+*J{Rxe z@F;U@+(s!BB7vMaG`7Vg^3fmf#OCE-eA_?`{&rfQ^7DxPs-4&96A=)8lXf*nld|?1 z^GVw$AFn&;{7WNcJ=$?|$+#yH{w(qf@*WlNFq?k}N)P^u>d(}S!{N2E;E#+5-SImA z1rj%)_qe(<184!mgo&3`?&+{bR5Yz|x&!Kits!QaeMWjwd@k>56GrAig=(%tq+Ma} zYU1DenA6Q%%vL20NtA4KN7=48>c z@ZU0X^mtAF9#uxoCr8O{=4Xp5_WGKM^~U94yn|O?Te!(ZNW%(mzEn23Rpexm?8KDR z?M!j2ve;2%6KgtZ|5DDFkv{5kVbOx)A7KHV0TkV5a5jm~7!k)1*$kqE5!r^AWCn6n zv0k&r4rd4Wl;Ar}GT@9~_<@Y^-gxJizFfb($2wa4^!d>oKa%*-lR6Q&IpoHBC)`xz z5iL+01HK3{`OTpiVYMsShgWtfY4)%FuZSgS!1yKL`uI0f!KBHT~W%f*p4h8ciVoDOv(_Q%7Mp>I(9PG*ogHzxUxB;GUzQi~ zq1SPI>3e{d?LjGKt7u*a<2!a*!>S}I|efXLPP z;okZ#cPJ&mhpF?T)+WB{4;|HP*m`iHiG!P};SS#DI$aJprCeDKZJID(Bf94OV?Z`N zdaKLtLj5H0>+xL<*Y7;t9)LPjSl-^Nl~;p`yMS-di+S$HV%)_+V1sWfr`Lh*tLDoi zdG%qo)nRr;cvcZ>imlQk`9`-JdbhMe2i;k#9tR8YMVOXj(*ugLEZN6CSA!-Hi@Fc1 zx~~{8X!`-d^9|J1hSSf-A(iOz)6jDso*=kC-q?kLzB6&gMlSghN$&fZKFBnjXOwGz z&=j7tXuz5QBoxeMcpt>tYuetp!lWtmD&`ivEU43+;zfefs>zWJ-I0#&_=Q`7XU(5& zL|6Yl7wf6(A>o{UV!0ikpslYy?O`q4HH4=r$n^nbkDxW!zd|DaBWCtZma>jb_~B(~ zIx9FDe~%!`FdMA?A!l_w$z`=mkfrJpGqI6q@WAWDg;<&Yt||4ZOAZZ0y(TLRU(0i4Pl%caw>U8S-<0Bylnm0jXdTfKMmH_u$}L|ZwMiyX4$^l1=6 zu`+b7n9O(=ckdEOQ-y9&Bb>VjndnkByUaj2d$G9 zk>igdI6)kBNvYGXQ(smGCE>zywF?o)Vq;}Jt1%yKPR$PqPlGV; ze@;xD^#T!g`{he?iNmSl9BR7 z4pbxTebt-0zv(?HbVLuTr|F+!WM*D2&23`pszu}bV7mL~j&T3(2gumXJSv-~BEJt| zLoo|sQ)?yUbkiKYf~k4<>Vy+26Fkz|UQXAgbmGl_PA}BoVX^t<_8w!1dtCg}GmSH~ z>X~iofKYkCIq)j_rVR@tlHspjcqxv2s-CE{mvSxf>NoxQ$Dh2RCBg#8{y%-6ApsbJ zs*!?p!V+WyVuEF<7T<9+0m9_iUTiEt(}K8xnS#bjYkYX7=5EJ>>tQy_Z0~zsQ;_FH z<6?6bTOq@-D=dxLskAamS}`_&T6FF(JzUu;3Rp51-BnI`FU>zJrr7LLz|AEVdf&d@ z8F;cs5a}{*Sgo@-w`hL8^AjQWaHLLbw_Yq!A}h<_Ob>8mQ86P+`#!Wa*@R8dgtGThrC>GS-Lnc~gXDHZSs0#tVQ><0!41gZbN{c* zV6t--hIMLT^3$CTUSg0J!R3N!hT`)ox<#U4JPT?!T>Z&{^bd-HbMwQ9bdGWpFsdno z7RB?TCD3jxUv=zE{rY_)e~wsRa~65-kJe zixsLZH|P(if7(*+-q%dNzi`Ow-%qLaTb+z#F6aJ~M!2`jYA)?9vD>k2q7KRI==X$>#PB5k1*^O5@Cf;4R+1VYJLb$QE5lah4n|LUWv*kT-ai ze10e&O4;e#8o+^BoupZ4c^lAo^@`+z{U{+qie_77&weW#pzF&7K2y9b44&+Dk2Vjl ze}{=-KA5T_@%%!tqbYLWBxQ}uwoN%bso0Fn_A z@}P4g6pfm`8yc1)vfUS}`|DqXg)Wfd~v(?A9>6%wNRyVDKct`x?VCGCw(?Yq=+{N>89 zhoL*~a5LRaB=RG(K{?Ch-j43>o5W^xK(wWpl5snzHrxF+4&YA^Yi)12H@C z@(GT2p9l=+IMbGSSFTx)C~DbyM|D@E+1{7CT&cUUn&{CaSK~66tn&3_5%1P@zGkr< z7qvu}9QkOfyr)t-6D_P!vvtlt)SWLE(RyKck?cbo3`H|!n^eb_>Jrku!C5Z2M@3Ml zaoIb8tM?{1T&aH&c0XnZR=svpUF@Fd;MejJ&JI4Z0F}>W-$Q9vmy&wyn;|5;*Qnx(5 znBc*${?$TV%oCiU0_Owez>k>%hvY;4+6my$IomnH}s4z zz-_}Am`T5WJ+_iB#sdoiq9BJQQBu5>6G8{kc%i6L*J)hMh6%H)V!YT@{OeGVaq-!7 zsK6V__*P~sJ$5wLbp&4jx*KK$l)%ULO|FwV;e5&XkxHHktwBe!`f>e%w$_37hX(k0 zf5sXlX=t$?7rQSB8tP_!<(&8dt!iRDjxIE=V>MLUe*22yl=AwABIZD|CKSm&_!HKurJwcZ&<7f&3sROGO2>`2#&#nHOtw^)^gIZ z)mX`x<70_+>&j}W%R0LAat#Fv^E|3CMQ%~9slgT-&O>S@oQx88d9ZKYM6fmfX$4O> z{$;)REGwtH&GV}@7$!lVl&2novc;R@rHY>bu+kz^^j(YBWB1sgcKO)wL0`(HEbY!J z_O@@8E5{Ds6$EYg0sGb!$c^1v@({1|p3bewdGOi4<5Vg1U_tZ->XDla6I3mkudq}B zHrwmGw8_u>G++L8p-q??*0Z=G)Uf!P)kVa;rNU+kcgB6HSjYj?kkSox_wVA_U(ehx zby+o3-nQClmF;E~3kXOf331-4v)LZqPS2=3IFg0h?OxI;5(WqTJ(~*o9^3OJzj1>h zQM@zBZ1YzaD-JT)N(W>y~K~438yUnb+XMjoU+TluJMX%h(rTok? z>R6gV7RG* ze|LFeGr+^% z7BypOhY|T~0Ww|EMn>?*$E}2!& zSXg8=E`E8BN9>OE!0c?pMQB`@)3z4?9IrPsUHi)Q(%OA1@S75VX5XCYhIs?Ae`{Dr zp`ZUJ)p<<(L)SJI$y*WJ5k>>8zs);EdYxLktsdEn z;hha@<_83WU54ueS$B@&yHiaF76YXAc=|)wLx>rCzV0C0h3@1-q|+6ic3anr^A$(-kM04}DX}1MDv}&ymO9dh z?V`b<#iHS2AO1^#rTyk2`<#iD#u9UOSH_ZVL^jO($2@N!8>im)x~I{tR7c+1V8D&?BP zRjL)~ZQU@TyT|5-HB&6;$j3?{w>{{ZbhVG8i?{=7r%Rn|Q=8Zw35_a4l;c_84@vnn zj^08H)2QA_!4#5Er!T(DBePF2V(-|jSfH1sVLhsaO#2(*l_7=8M45##tfyUJ7K`x< zH%7xEAefFZXR|Xc#e&84!@(U6?lSrB!_=LsJ5y7&tE;>E zZ9R0awbx$XC#={*XZ;&tUkW@Y7<$Ll@sC3WEioHeg#J|X;pD(_TGHF!U?(CS3g>CY z!ygJI8nB12egL>XB)a#YIDr(P<5h{gtb;*i1`kyGz8q#09$`$aXJRD_JgnORb2QFLf<`Ku?6cXs-XT%5i@&#(`J?Ppk z9!{eAR(J__sHUEd^2sNmO3Mx!z9RW8j|;2g=IFHYg+C zY4}ws%NU0U-<+Nf#_i;*wi~KFw3p}QO`rCl&l!sbVfFgSfFN%C9uN;T>kAoZCv)u1 ze~1au0vswD!kIVLMR5*;a->_Squ5zIDZEpS7Nmk@x);|hlqLRsV)g17{=%3?8rJjM zD|+aS2mgcNzzriBV>&M0Af#{1)!%8feu6v?^eWll9w?v3ii9Zv$YVqUPm;0zNb9?3 zGQf4}XbI>|heVqPzR^cg_!Z>ODI&4Ov3gRlPHdVIy?jlnM^$2|1&F_C({cEL_kg!TRp zZ`xg_n(1m)(p}Oxr|&G*ePyzs5&G3rq*s-?e`YO9|FMtevwE}hOT`fvqx}GsCsC@s zwD3W(CI3jXA8`T3h*b%A&PLN#U^1hI8gFsUP4w0;BoT6UT?Z@F_XXpfg6QivNgkv8 z*AYgxEmpQ}w^*AUriNV#^0@R{MI!OlcakG?Wpz|y&)NZ70KWCN;W$Z3YUkfteypA2Ffw0wKjh_tb;L|(e zPKudRZ%tg#u?30d#Xj*VO8=%5K^}3ko5C4f;(*o)QHzxM`TbMXG&>c3{saYPji;d`qHKWCQFDwMYOCkni| z$~WHtF;zgOpdk5VBd?y_&A~QjmiFqJ?)BpHL%Pmu!tpi;7U~h}UnR2x&pX4F5xh$W zQZ>zXu{sAF{9hBD{)lw}J6>0$UiqGV%+cUF*ocN-r`){1MbvLJ&~pcFEZveg@oKYL;@?qijDpko67rMXb>9O3*wGKWesD(#Jz?HcbFLYxjTawuR>} zC`Z*V!{J`^44rt){;}`QtMzit!pVI9jW%2PK&+-x#BJW!eM1CVb<^QqRm*!b+JUN6 zP0(wwGOv7&vji`0buPnm)&?!qX`8s4>Jnrhh*xj6x5Db?%RdfWlbIWhhFE4y5=2on zA+HjM3rhBo^*40;;~rtPIgi5W^+}?Q^fjp`)bR$7CDL5}wGqoT-WfZiHC_)TrWg40 z<>kzP^V6U{hx>HB={LDABIxbh^s=CEx;Mu|Zq%Ctj?7m2E0S6Lp3wyyo#E9I90{4yT8 zkKJnoJxOP__gol_=lY=U>#ZgH_zdnGHL41{_;SL1i5v7gz(2*$C0Cl?n(c6vzyvaU z!Et9IM3E25ArOk$Kwt4GknSom80ELw4e}&7HmFfm!adC^3%n=GhfJ4TNZdJ({D|@E zuJ^bmx8|qD>o62LlktE)m0NjIsaU;7i>IuVm&6+Fbx!gCCW4j*r>W?zg%F>q&l9V= zv%Fum6v>pcevmFrU6>4ex9$@xXS@IX*W=WVJFB~zhFRuIxDUEEbeg4o!QnI6d!yr{ zm-xWGP^cB*p>q1!N@sH`#QG%y&b-Y(;w+aSh}b^ZrI9p4f~g0N!9 zNTk|Z97t;gd7=pW`iYdI&+g|h+p}CQ@;Hg^JMDb3O40HN5|_7S{Nxyrm0ieN)&;9w ztP+iJ&Az}U#`i-O2X{@U^8`Utr}(%yU^rND2diL*M5M~Wk?;M+YYmq$3LRAEU_|FM zVR_rhnDcEjqu)1-_YuSJ_=4hHUhJjrUaOY~voep zFi^(h!`lX8UHFh{OnsO?-L4?|SGAPIs6e8i6vWThu$g>wBwTYhBEMvqARf~S9ne1R zW5?qfX4E8t@cc(*S@_H7Uy@)$@=Rb@CgF8!t|{`-uW{94tX(Ukk08pxZs zuHbZe;H0Ih@^`+-xMlvaP28)Y*~6gql$LeU&c3Fz4fT<5yPCLJWbI4oDAx%fa{yFY z@qnG{mfGoy*cJt;zSrwGp@s|9A} z9PY$^H4(BYo6s-hP0OmX(%SHM4c|rV+FCr=Cv{}+0uo9@VuVvo)i9N@xY;IoO`G9; z6HxbT$GRB5THMq8Zb=N`^;5#`6^V~B2Ae%ICY&iV=J}}#`kps&`eeX+L$(y7i!$Wx z2IjYbl4BVf>F1>8XBKYU%71i*mpwL2ca9s!)9YvDappZgaaVp(i{`U_wBvL{bUEa; zw{XI@N&n7a??Py{%4p5pX7LlHG4|h<7wU1vdBTE{-s-7kn&C9*y{!K&^)aSxG;llR zAVV&r?Pi69?VqMA)x1&pyXPWl2ikR9*thtmg%WNO(1ULN8;4#)HABJ?s{g29{L+ju zD$VIjT$*E&rpPpu+1uyo2kk{K^7p@PX#OgBL1TY~`$;GR^4N#*$wA)jPXvCY7Hi?` ztGB(17iAEk<$?LhXTHNrbN^)v%7D7?cj1>T%2h1O;QetWv#9)Kou`U)+H_xq<_DQS}TFf)0ILR_HqNf`AVbn0MmdP$3wG)o-)&a`$#1q_LQihhG?1epguc=(k4P z;t&aQDS z6;H%isyppLOF69Dj{it&z0!_L)CCyyrCgmo>y!n%DzX+VN5)SMwC`6N9a$6Ky%COZ zJW<0HD?zH?ko<;7Rv0Y53Nv6BPH9?|6>^CR-u2+umR^{1Ws0m*SR}SeV%Ayxnmb|< z4+`chm80v3o7k-vJku>$#S%J%V{fsjD{NfWXf}qLY{r--wba9IHf|bh;K3oT?hhO? zaoRE(GQE&sRLpmvZldWR^hPdPYc4#eXv*&tfwEFOVs$9-d#|8eb9#QsR+iyF2UYy+ zJQ98`=u32%dk8G)DFcT!F;J=W>l$u}v`JW*P26bkU6Qn-avbrxLs+B+Em1g-pAdf>bO_gvy7V*kM zdou!nv94y=he3g@x!c+ThHva1V+;?=76c?mkt-?mXI&xG5`uI6B zU%&QE%HPjKJU?=gk^4e8o*l4V+KYFo<|U6Wx^F8dS7BySjK6nl-Wtl~_B~oUQa?Ea z#>;g2CI2#}h<^4EbgygMghb>w7yeaSvb4S#2cU~ zk89dG-e-^0EdG@QbL~H+;tRF82nDRR#Qvl4CL;hv7uib(|2=R;yz7e(l2M599|0)M z#a@K$vWX(YsxXm7X)4!G(2(=EO0t*Me^bYMt_e!Zf)a07;nBcl=64r@@_=J7Af z7DNolcN`=RON8#tRFz9omP#;0qD_8cZGLv{;g*&40JjtHux60?MiTuNF)MmD>Nb3k z=0nj0=39a6lNUS9L440HgwHPES4hr;+S&*RHE{Kqu2J!F%O)aA4}I;|neFw3&#g;# z8z!qi3&oDHNY3bw`n}mQsN?o)c|-lts^~*i>c9FHkmHI|mIz~y{M{kZ=vCuf4M0r;b)>}S^#itfFgT(RBm`X3S;f@dZs4sw?QEfvCstb5L zWnX#q;o_QK1IY;J`|@YpY6zci-rI5d3Odn$EV!iM$Z1={VFq;NcOw|~XLr&xlGf5e zSlqa}5({Dp{`hCr7WZMxs4`e)tjXto;&6mJY}0NSY1n&j)0!|%RB%S`C)hb|Vjn}6 z*H&(L6FKq;<=Pt+wC-`&Y%uG?N`6jkP4I3+{>XSJ3pbSA;7RTpx)kbMKNdrIqB(gd zgLOo++_mU>5_m7Xb49PO>Dsx36a-9nK1id?h6N{-k$pk>shLFHLjMgjCkf_@7@`i6 z^fx$WxsoC^+g*y$Ez!lTPinLdu&^?!V#UODZAf>~4GBBu_Dd$kJC8pJpew<`57e75 zEs4jZV9-lmH|Z&$^?uFHV?Us#g1q7MBw+C7>Bs|nrR&lWh~9I4WCwLqFLuGyvTmC7 z?91`5%~efT-M|Qxu{%}Fr65_96qp$|yXjV0mKpF#=Vn218xSFeZ1-RPDLvsHzb| z!&E^6Pn&QD!olz0??a;h4hV|M$4x5^nbg`fx~X}9sEPqEYs*px44Z`j;krf=Fxxsy z6Idc(m2C1#;3i%wup*|>Bbu)W^TYM-`uw3-A0luR>YD~RvqZx%KDYwv4IKn7f2d&b z(kuWJd;HxKl^ixn4z2@CfUZ}$(V?qOHVSe&p0|C7SbxjJw3ZQEfJM|66ZOZgKp)B5sf=%Aq|p8yvXZjqJNn!lGKc? zKAB{faud(aXDC9Fb?tretL|0fB`nknuA12bC(*Wpy%#-jnc1~9NUXl*RlOCyp}mn zYB8+P+jM`g@zl=x7iU{>_&zl;yThqx;$HP+xT(ZXIZ4sr74I63>Y_7jwJ%ytaLoyY zXC;m6PGU^CM%Kdn-LuN9`msN6mV|G@#|23ugA^>cPkj!QZX1>Gaz+}53~*N5wmtU* zH-9z+hOnTiEBld5L9aL^D)FE`F8R8Dz@1}v#JP3Cfk@}6k`qly%^`{gQWby|9X^vU zYQ(w?lby*P!;~Yf3DKsfi(fye-L-K9t#(73IUl?GcpfYL&|ew7$0kwHa^_7MR>cD@ zJufp>qlHCAW^AKm{FX*U0G}(h4D;hprh1)!b}O;j##4Lo10Db7mNsqrtOR`Plne3? z!n!vUC2DTU$XR}FxeD!K^~5X{2UEdC96FGBZdS^2Glw^Mw^pn^FWYN&y2(5Lt}~0@ zf7FVW=Ffe~$ef$OZ#m@@bQLuxpJ7OC=3EN&vk0n+-A=aVV!qDq;?3@-S#fi=h@5r_ z99UziWnA3O2t!MBQNm>c;My{-^*V%0OQVU!#FbSd@Z^7Anrq0@?j+nf>y;Qd z_u?b1!E>P-K=~82zOa!XmRD)DFN$j+@i$5As7&{Q4F&1*0uhnoE&}Hbkk7vFpf+jm zS+`nf{)w7zZTuhTbDb^B^(f8!2ZPtzqx0L@?&!6Ht3T63lWW=WF5y0J!p8QqVIsvu zUn&LNL=h*b;#9yU^B_$K*fztn)})zm|Enb#`U6aGodo9!XO)A{6a(bQY<^&SN7^f) z06=n{lbZ9o_at#^*Q)2)s~l_;nd~U});qPr2S>##Q(8U0oXS)!V-7Ecj&*!}W@}o+ z@e%xjzBemPeO($15TyOyCNm;4xZG&e0YSf@(&TCg{!mJQ> zY`P&w%R?b|0nY8=mS#>x0N+KBT_J8fAzt^wTvKrlIP3{4ebL6+t3{lO_E3|$eK^6) zuN`u>(bGp2Q4j*>+19GR;Y{{U5fb#Aqk2$Rw$J$hUMl3G_5XGRc39JR@jx;#Qg>^d zt!*mSmC>C^Ewh&h#Qp0yA@utEu2hVl=@ThhkIb>tL{SY;DN>0#m&D)u^9D3jB44E4 zG)}-HfkCLk@foR3A5!_dYz48L6QtE4M@%f9!5cXQWcS{f0wYYz22QA6Hvt>Hp`p<4 z;d>Q6{qIMtJ9}z4De`fy4H}Lp0v+;W9Kb!JHr5dXsdqL-i6`o7`s--8YhD>g0CMNN z+eSm}D1^k!k&e5uWiq+D>!g<9qAoBV(9q$kTjq<82Cv^FgsL^pV4%{vWNVy`N-!uimvA;=}-^4n*^@0^B z)rJ!=f9jvcDnR!1g?*l!K+K2)sCQ~dLJA5?V!mRk9HtFuS$K=z1;!JYhucnmuVVA9 zJ}L3476yvN6H8y$$DXj`Rsjb{xI78!r5~gWCw%Jdvat-ypSgEqH452`C-jE>@|Q*? z<~|L3Mbq4NWv)K^Q{3SBShocv7)4IKM}QjCes-M;9#Wj&lUNumu-!XdZpzQ4Emwr( zp)R7M&KVRGD(rxN-|#utJ0jivA^?$E8X!SDm}2@$h94O&EMonv8_R?iJ0YTEc8ubc zcq@UUD7K}s$=!0=;gD49h;!*peZ2zxwaPSjBYDEU@B1pm6RLF&Ew*oXQ8L}@`RUdz z^E)B{+japq96kS$XGPz>0p_KA?~s$`nSM_?KmG2v$biT|+_!izdj;X!tCRkSaWz%O zhZ%VHzSq9aYjf%O2yUnUbG-83Xb!CWJvu^?=69@lcYxDiTgz|)n+;o80O34l(AtY; z&pj`2rHtu(ZCAbSu9#Fhd9`3b+VIqAI1p#Wh2hSGi#veu$gkci+`98yN36gF+D=p* zJWjX*d2O?r?ZlS)(wq!){ME?k-(C@e#V{tzI?u9L~}d)S^KebIPamaO~0))f9IUCsq^%G=Hp`J%TS3Z+%v-TAExh zlc zifw98XMdQ571vdo)YYtErQTTL1JcxhAML_HXJH=~5d30nZcrwB@1RkiId31p^~|FR zd*M-Hq-eTMGD!6pa5#%Cc*DARquy9xU;&QvY=OsR!sPSGZi)4V{B$S=5A<8rpyZQAzRP_~fRe$`q?V-B56VpO4L}F) z^7}3Z=D6;uZ%l{(%i%E!8XHhUQnq8##UFMnp1- zEqGrRGkzt;gngf!Z*o=|8C~n{6yp9Y70{K;E4mwdy?22zvqNq~I48h3i z-)r!)KN(PzmySr>J$jLo7U^A=vXJWwOOl##v=F4j^45pYTjt~8KUPzRg8(oW(x=nF5~N+DPqN-XI&oZbpnd{}xyvyaUS*|C$yZJob`Pb1T$4Opu*>hTXoT|e7WX^^H08I+22+!C8w`s&ruHF>)I{Nq8qtg zuwPu>30a;%-!@8kEU|rOFh)JClx^bTJzx%s9Ibx4S$ceFJ)RC-1E)Xbvh$>O7Ee}= zyVJR8W;2ZYmrPn(z5^yl#{J7CVJ)W_Zi?9t(~dO`TG%19ZgSaJ<2`kgE|!~WR+a3z zX{%L}dX@#M2R4>#>AFRerQ?&@Rt4-}tqRF(a!V^(4#RAjv@s28iEOs7g)iPy3<~y8fk<2db6UXZAvWv7X)f2et)AIV%F0B)R z{NvxU=9ymrE6_ht1f2(yUxYkps=*`eVg5f{)IZmgAus7xO^bWr)-BOTr<(H56$k`xK@Z<1v?IAk$8S~zvddVgEk5)onA%+cnx)LCwbZ^=<&CHE2sf=_&fI2cA;L9`G0 zjW6l|WT}5wUFDUfyxQv|s+K?_YoSAYtVI<1qrjwP$y4{rl;}qXaDPljp8~o|-)J6Y zy8^$6psq@n;aW<>#}>VWZ{9-kW`0Ef$w}`DgCTGrMv1{ncO<^mtRg*VG{zY3%^BHF zDE@~XCyej+xB(_~+=o~Tf7;%`K5wS(71|owgqhVh!Yyk%8BE)Jnug$)eS65X08o6nW5nD#w zg%Z2+%g~s(3zBLc`?J`?npP9KPgr$_sKF z+P4~dg&{fj3+|sG+|o1){Bnnr`EyS#1*P&CN}`G%E?r>;c8|SD?pC{vsL4XQhWQs; zvncOuEf96%>d)wG_$c&{&r4y~^y^USE{*vL8 z`Q>mB3K7l);~q;VDiHeKt+FEhN&Pv)nH>X*I5w)jJRSzs2R2A<1nZal5b+gUW)I5J ztq>IYuB!(X;5Xlo>yPt3UU96JaNVC2+Ao&-U?mn((rct!-UEzW*%U%+v+mCCU9hw6 z6_Bh5AOdK4+T-aS-hXm(=7iR zc?B05)=3g1S4!{sVXt?2L*e0lhO(p#r=i8svwy0jr&jzEY=UrR`fNnzLSB33mF$_cTH(|U;AqyXg^UhP3FH3%!Od3_E#V{JhfksD8LplhP`+TnA6r?p1skX-v^(Rv46CV^%| zT@SgJRydJKrx^9j<>B=01Ql>Yt&oxTnuy!Ow7zV3(MU7xrlKQnHHCqKV}fdpnAu;f zgI)5%k51Gzn39iiSFuS{hjDn&E4*PJMK(!N*616fb6b?^;lz%SX+yKNFjWUyk|Z(p~2J?gdffQfOXgMyJnr=r6kwg@306prSFGSi%(KTcKdDtwD)gVp?~=7 z@^Ch%?}yv_Q?gB^1BAA7c7XRbha+Uu-hb`$M~O3|I;J*XwRJNatare&NNtZ8I;UVQ zJfRkoRjO94D&ZQ_$8FWRuZ+ax`pt&hy?|4;xR!EMcE4E#6>j&$6^UEc`-iiolzq2f z9Bb!xi~Jcl{%JkOJT=fa*(eh8eW|!`QcpS~+#476icxZHnPml+>u!BA5yfA!bn33|w)^)nHS6z&Ex1Qm11PL58fW~t zQ28xCRwU-1$Xf!=Bze#y{cM+1k3>YU6yIPmO&E@#42!VrVF*RB0iT$P@Hs;eyivmX z)l`scM5(e+fBr^f50UT-F+TkJs2Lcpd^zEtmw2Tbm~6at_=F#rQ@A(sgrIyy@ybei zPl<|%_ zy!I1j`|z=Q3aWTg4~F^_F)(xYKN@w}|9_0S?7V#c-JolbtmqiZ`X&59c!)7o%Ho?` z&Ub|B5J|H+()9aJgCuJ5LpsBZ9RVW>X>zSFH@Y_k_yv}_+O1qrd)=fOp-}whts^d3 zJ>nfZQ##33Me#@vplhvw(=bXmjzp-JHP6sdwLqJ3u5ueYpP(L2na}PC)t; zfdvQOL#WW&Cq!)6A7@8JnajOxLO%`cbM@50VLlQCB14B~Uw&B@UbEWH@^)zzJDsCS z70l9q>zk#A(R*tsbX@g3U-UYaDv)wXQ6Up%B_$`#PE1ywtQ@6s!+)CePw+RbNIY0~ zH>DrMcf;*8tB-mBtjbIUj`UCjnhB-zz6Ojx5~gtrva6*&V9&Tx$uqNIm|y+F)H{pT zKSmit!F>`ki_QHXGAmbd}tdPucn*5Ksca>7-U)^FjE_CkmwBU$BVRyOn`&?!ka3 zxr(r|xWTg+uI;B!s4)IBR7_)YG{(^daF2AsRe700BBcP+?^Gtj2=15Jg+Tw!klr9; z86^Qy(P!9AH%S1>Gje)Fw-I!;BpmEziryZ|p3h4t$1?zggr(d^$@^2fTe(X_^! zusU-RYfJdi6Tj|sLDZiL1ykPcCI{ov%4$X^g53gxy9@GLc`KK0OsFrj7YYk{X{r2D z*PpQF3+T4EYrd?BpKx;oB0Fk z2R^s7AhiTfcb%(>yQ`!($LDWTAKL%R*lbP{r{`0ssJ@7^6-_DXPt2f?ZN}7=Z3T%q zP~Z~|v^AUC_dS1J@87iYVJvjeGPX!vCFhPWZ_FU`3 zuGP`l*OV;Rm7*uIY@DH1>ICKLxV_@?KX7`L{&_NR=9Kuwt&hz4We$%q87#8xQT^nH z!B8ZZ65piB;PA^ZDU=*3M@4~UsnWPeCEhs_h@6=j>camK*v;GWOUoSd=3D5m7C}LR$P#L`$@lV6iM~N68sU% z@xZNjKrv7kTtPZlduxa5c-8c%>mIv=X%^jh+oaGqsK2Zy$M{kgqp2fQx2a`Z+o#zq zY<_M@Y^m5%0YfKdB$lx?)c@enNXLzyn_1UfS6er!W!i1=vT^T__}X~ec-HvptnZz8 zd5O?>%`&e4aK8DF00KKU_1S{$gJ#}=y{+Ux@}Xk>SE4r}Xkr#VIDrVh68)cgdiwf? zhwHQumFkoVBCAgOx{}r{GTO=kqF0rS2NTg`Cz%es?E4l44)d-acWK9X6SnWw%@MUJa4W1ewgr%dbw+ zt$-%%w=fx+Xc-6E(K2b~Rpyeh7k@(aNO{RH4!A%6;M>gbW4zZn zN=E$(bk>V#;2&%Y6s1dJgiM{mXObH9cs$vxb$F-(gWkEsJH6_(u8q`NnhpF)ZMr%7 ze3qUZ0JVGu>!ek5fU$;iO+ppC4+vX4h28LSTs1!R+j3V=pBk1s2+E+rVP!#OLuJKz zL07-8J<$5?{@LMf=x*VZMoypvSZkM&APO4pLiIQWj>)mev*+Eh zPk+Bttd|F(xj#*>u0Mo9T)^hR*1eTY@o$v!dC=Z@RT%M@nURiA7hDc5_~Mo)c3*Go zPB|G__k1*biMam!_)*K|OGxuIk>JD3o>Q3fDfhD?2KC`oxJ`%xUxj7;HM@HKt5!~Z zTRdC9TeHl9<^ov3OL0nMRXJ~Lao$lVu*SN%^3jshp{`=2fW*~u`6FSOV^73BDBFET z_FT)r@9v`=jg@+`^Qer9AJ3G1;GhLX46Qtw#5nR5zHMzoRnGu{P z)s)JCFw}fd)NuUEFOHb^vne1+>OPZde%EEs*x&c*G)jN;Y809)y%j6lgf7BBca~Ck z1V;;QN#xIF_soU!4`lk!#&-=Ael{sLfk{T~$No%s7p$apTNdpdK~0usHW$0|MTrAL ztof3NYKJE+EHEwZJ?-bA4T(|F(<4)F93EXLJ6qH*wk%w-7+f>jeG>$xVFbOHxwP2i zmN+dFl)6Dly-?W}+@_Z4YO5?+ClhXme#W&pZ+hv^4nqcO5t6>CUI)PM|Jdfr-N{Nc zNwTD5u}WmQO6Fv5h_QQxQ)>LNn(k0Ov_%uNWiw4V!ljs3)P2K!xa*HRJ52BBfrdR( zcHT^VWNop;JqbY*eY=J#Ta@w_(>TqA? z^S$4@C}&jfYccI%;v(jq;77>EC~2&SbL7fM;bjm~_X>;S74B925A1Hq)DEVLsBVMz z=xFGlVdV5MST$AH20b)kytEsGWZTSWv1mI1re8>-5_S^*NchtxAe8dbE9|WF>C_{C z)Fd*-4LlTN`yKEMWOurSc6WFC>2HASCfcyQB8$p9TEBlDjPD@)g2~v?&16ZpevT_Q zhctCz{Sp1}(sML~(vlS|JSi?RIlPkDp6l)(&2>yNn(exf;!V2I`wrPhGD4l!~QT)}XTH=NzJE+GEUps>@ci@FQC z5v^e4UsZRyEd@x-Y=klzj_`&h+}5;@``d_UG*aOWox81QpU{5E{ZGVqA?u9}F-NwK zMsLJv8;+EE`3pyCs&5~8-UJ<(NPNZS`G;l&Kj=5}<6`!if=dPeLf-K-igg9Y#J{;b zmjnKryr=2U*2T@Ex@U|o8T=D@`w4x`e{_!lDTMpfow|<6`up6Sh8IZ!t$jvhUSlBF z#0>^$i=qvhhY4u*?{MA5-9edTMV9|uUEA#9(&M!FOy+xH_zb%iJqk(DAKJ>H%TAZ)yAkYano60Ktiics!ws{!<-ELiEouuo;ofZF_ zy=vcgbu3FO~aV_cZN~c2``yYU!CPWYvJk8e&zr>V%f{4a;6!FjYuhXhDcW zF$<9ggL+;v`|FI^jM|KA!_{)Is1pa4-Hzf@ZIi{Uiv%6^-b6V){p)dQHCpf~jXwawL#{Al4P5wuIi#BJxY% z9U*~=1pE<5#n6usdy80ZL*H3H@r#pY!6KWmF-D%VVp$CsWWnE|IYDCfcL$8Bs zXTk&sy=#Qx?w4Lc(KmtrSJm`0Uq(7yqS}XpfXDP|LsbE`ef&jg8h~-letO05T1K2Q zHO(kFZBu%6nNvyP($rhAe1N$}Ou|AnKd`D3k>8M5!-ZbVvKB-yCsm7(UV2}pl3u*C zWQ0@ndHdVoAI+#Rd1vetGFUY-EY~f9G6_tgP;rECR)k1|sEDsoq2AwvCBKKFjQ+GA z4IglZx&B6qv;~tFrtVBI{acq8{&4%VLD+c6Euz6VCYoMTw^j&tbqCrGumUH^b9N!XJ z&O*{;gH&+eWLMK9AavT@M@gOwrl{_c9ODal3ATyS<9~l5wMdM#l-inWwYh7(9Od1Y-gNOA&QcwfFw17T({%yl7jO(C>Q8>TD`u9Sb_s%JagHkL zzqh+nb=5H}5F3VHoYc50YnQ%s@e9pz9TnHhe$2KWCD$v0Px;#-&u#wc{@N1H?Os;j zJ%fpVz_0duMiJXau5NpV5!=YD&UwZW+l{PVdH#G`2{aSA>wR#0+I-%8WD~i7_sj%2 zJgoF`|At!&@C=%(Mfg?BJsGk7ozSw>Auhhvg?p2Fg)-M(-62P@J)3*|V8y_1l%&mv z8;tu3$<1#GKj`$?=5sL0(LRXxc`(NCH8i?pZ-DRKaXX9XGx72dA>C?tBm@4FtmEAO z{=0$&HevCP?Y$zt?*})syeGU}qMs!O?R@f2gbqiBNBrIYbNfrbOV#BTYY49a0udPz z5gm2{=8$vCHzEqo1RS^#M3w|RTp9$@K*rZgEL9>A9I8tWRZJ1Q@=K=@P9<#1OGpW0 zAldkKW{IE@Ce9^;Dh5rg9IuqdaCHfi5|*Y*S5*Xuq(>f|?G~ddmUXNiugv0bX9?Og zmWKTz<`!ui+t`2UaWM7B2_iF=qD$wGgPdLAlbq9OuPHB5iJ&|UGuX-(5=Th)RUtNswgt z@WvS!EOQwyn8LE7>d%&VAn%Q0JdS>CDVV`>=(15ba`W%k(y$lpkE6U(>%(q5p#G>= zFy41y<4>%72);xC7Fb`S3dTC^t@>llZ0CNM_3{stbaY*I3S=7gSVN`(Lef(^(u2w> zH@c;8$c$zzb1;NOKe_Iu&xXI6i+%ZmgCid&6hkR&WD^bh;e^tuJm+z<;owvZ!CbJm6!ScXy76BCr9DTkIBO;V{ZcR0N!P< zKN)xg@9Ir3pEQ`w9^H5n{kr^>)%Xv3^}yox34%u%zg+x)vwieb6BqZtS;EijQK36k zyo?F45<6MEfFJ z!aHE_w#*E|om4<`-B?y|vok?p!WA#^#1^3rfxPaa zjyj;agFt&5uLI?9+utC1q6z68p27SRf87nhtq!pRwQr>Ek=Str=_slTrHLgC%c8qsYJe z=~K}e&hJo(Tcp=Yf+;dr%sm{C@$M@$K^^>w^~(%b3@38D+HKo1f^z9v&=QHQGM99` zreAgMzItb#*Pcv3%=d!+5+z(V@(fK=Ogn8EFId`K|0LWd{+->jyyF8L)n3JOqdA#+wtB>8QPJ?V zREy)B=9X;Y_8^Dgq_e%PAh+VAN%d+r@r+jexuHnhtJcJqk3Vk;-FHFsMPasJFK?{L6y z$Y}3f!=A`*=|>Fiy$`3Kg(e*KA$5Bvp4UFs?@lD@Uq2pVpc|1r2WBpjU(xS>8=a)T zg%O8II6sm;o;LQid&8Mq~TiGMqUHfL_5!Er}o!jEin>d%xGjdrMEZ=38?`CGY>3&u`PN>Kh;(kgx zC3PlF@o1u^nb>WHmN}O$lU5;@m70w>HbpLwN3+tFyrmED_lJj>9j_tYY_!U2N)d_HIX`UWL_0BT@Yna{+tQ-TY z!&018JQVQH4gt3xS;bQb7v{m=xoNmtl#o0NvSJFjmv|}e7+qP}nNyq8f zw$ZU|+eyb?Y-7i^z2hC{^f^D_)Xlo6x~p01S8%9#{$p`SS{A|THGnaimG!Lr`+{H~ zQKu^KQ4V4PKdf_7f-diY^QSn9GW;XmVrCwu`G~gjMuhxACD&kd)55DlQXkH*Xcj$E zf4CnIz9DHvl>)9T!aNfE-rnOyUrh3ZH%6F|oQ*C=53(nvv&cqiI_|$hmW!j?btF4; zcFqTCNnO#@l3ttT9)E}BC-CKSl9aO|m@}F5FeEOQgGe*OdK>`UGZozZJXYUAho+`N zE#E+n)^MIlWpxy$;I^M&NppbH^mCDtzm?+-23>A981s!o@7J5H_KTgGQ&=-OVcbZr zVc{IsTb0JQzDO6VzU>Zq8?DuvNbrca4KHoYgL-8#o1B`(GzYexCWWP&-d3D&b+@K_QLEZ?Z!q`dKgb~Xgl7N)L|#scGyVe6NW=9EGw(Jr?nHx7PUy40X-i@$P1e*_4lA;8Ix zEux}H>pOHvOT%LUfwHnzM`p!J;?MW; zD`z{+YvTw^m*zDqVv-NcLdAx&@JV!@VRN>S(0QTP;8@5Qs>s-f+V=E4$b0pAiOzRz zXC@zuCl?X3Qy_(jY-5}eOz*iVShZ24;M>dFu%#l3d192x0B*3q+RO&1Q_XQ>fnVomW2kd!2-5@d-o zF(jGpzWYV7bMf`&?jjkhH5d!5uIMFmK51MmTIeNUrbr4atoOlGukAr5JPrs4(AEI_ zi(h4>$unWyb8`RD#0{#;l-w;bNxFK>L~}Q1BU!@blX{Kz^Zt2Y!MUwLI7(!%QX6zq z8W5qCDU4M$laXoEZD6J^q83v`8mKe~eg9LeW8(CjQ>t#nEq;U6&%QD1lXVpQ3*%r) z-u03$)}EatbJ`j!(#TrkM~wA$L@YT^ow#FRaOXEN>_&Wb6>C#vQ{Bbk)xsPDQA8U) zt0HQXiddc3?cZK*V|wkfoTDl5jv~qt5y+p$tji=(?cyhwI2xCfsB0GUZ)mZd&gr^P z5bL4jNpW@;?V46JsI)OjcE~jrxIsZqNtT;G)|08Cv^2@R4La9Zf?5r-k=UZUMa+l5 z*1(ntCZOtb66sh!3E|XhizPoyd30nJd?<*Pvcs%O6k_G><+AoG5ft8W`6J_4oD1&Wb$D z`e)Y9jlei>=ydt>?cjsRxil(Gul;o&N*AMs_kJEDcRY2?$UX>+?ce^$ zlZ%U|N*Pjryh{SZi^y}5j!#gSucD>mB`9@QA5xPZ$Sj<04$Lzx2X&sWj(n`xC7x$= z8xZC5Squ`kNwlpV!csVy32Y2xd8aqupX6(B>3i`K?|ehpdg$h|Hlnw?)Rv8$M27PX z)_nvFANhTGraW9e*nM5@vfa$jG|S#(4@u=PoOp_fIXRK7Q9*6RV?``ZczU?scUO!= zD`S8HOwTbOenl)E*tBng8;I5{Iyl_jg#9!K)CipYnp+AVr1|qtVU%TIk%$&Tn6IZw zB=hVbowk!i*c&+${n^WMar3NG^9Tfz7ig4G9S6k@1wfOL6K`&s0Gk$(M;$9+m$y zcHRU`1WUF zmibBV{xlj3OpV)BkBqX}AR-D#)vQvkkA72+5nT|>3t%bc>aS^Y957ZjPuKdOxpu#r)Y)~cMpl6+&9La_ea$B!!!#BTtczQmYeicT4h|nriTmP(XOxX zl1n9ESiB%`VzJaz2Y3a1Li^xoS#pI9u6VtHH+6Nio`tLO{ub`*JhLZFH;kpDK1%t_ zX(kl_0Q`5!I!9FoHOVMCxfofZjF?&{I1Www{08ES9GLR^!H}ef-Wy zK`!9)ZKp1y!i2r1W9M+2IvwqLTl|*lUzYV0y#I>M=Y8Dn?f&xg4s+h{X7=07S`A`iSXL0*K61ADuc-OEThdwRE zl6A8aO*jOK|Lm7($846lE$r-kOy((vu}ay8&o_Sm<`m|seWYghUcG?dU+rT(eV&2B zgJH`Ei$_uF2$ih1{M}l7FPb&rp9sBRdXjVBfpjF5WlLK zO#}7KvB~kq_4$3==OR_g^?7kAW%&e#_)&P);a*I7j&NOv-$e#TGgzkbO6D~PAK)&x z31mI$2x3wN^LByEe^I2iyBV48wYl{0|JsJB;k^9RRd_tQsh&bFZpef>7=N=J9Rpi zw-={o=*j&3W#C#i3ks|r_TuuRWRn7ddwchtA%+f%O(&9eM3Y9CZ8rs%J(NLdqPsZ&hw4> zvnBI+C9wICW|I)>?{d3L?bxzm=$R7)KSjtN*9qa~l32F+Jh@EW;1||xrlZUx+?zLe zxsr5DlJp{Vb3-qv$wgb7#g=$T)DeT54Ree$NTa%MNrPQH!-ar0{dK)l&cPU2zCDnl zh9t?6BuQdMcBIl$WF;+%nkvT2VJd)lt$PPmzsbPtXhB5 z-;8iW21{4-sED8!FxM{YfK5SWGwCJ ziPE`eN0rwjU9_VXW&AGrSV^Nv&+~umU18FqAw##_kj3;Q4-lsfpGmE}_4wGi#xQ9M zA;lRaSs`%ER)9N@%=U|D#nF0J5xP`{tLFr+@p;q}P03$HS zMPY*Jli*Tga=rnK7Z>C)z~&VsbsKolDP%NNY7nTrvHeAUeGoLgv@7|I_V(1%@@Nu& zx#{!TjqUnz^3)dra~HqN1o+xtX>JK9*SBt08uY>{1C92j;`(5bTeW4R90b;aWN(Yj?Re23+BslPF-oj1sw!{NLX@1uWr%vr#Zlj>)el= zbwE!AEr-l}Mo9r>0>3KJJH(D-Xxoll(In^YN+M4 zrD=5l;Y0whI{FU>KfrhEZ5Y8F*O=lITQq7!ERJ0-80IrXEQNoH(7)+|=ss@Fb1val zB4hk;1eW`qD@d(eC^($?kvy_ntCjzY6IMvQ`YbWfedTAomZp;H3PSuZdp=G6OQ!Lfeuwq#6yU4(xzmZ$n528c9r ztTA~MmKxE@gvx%`t0>&H>)^0BBSP2>bvLjLo=kgWuL`5f-Gn*81@>7m$#Xm>?N)08{2?!p2s5sXALbSmR_WYe8EkU>wvc&*@*S&h%mG!fx2D2@gO9bQSfr$^1 zG?CQKEofO4VfcY=W0qQ#W#uYEN})oPH)eR3RgV_Rb{%PPANGU5wgrJGBxJ7iW?%k@ ztu4Yr42dDE;-?m;3Q~1nCi5tWw0xCnYYST0uQOWr37Mn~1a z`Q@=^8;E49ErrM@M*2=AVTOwnE{S2TDw1S?s*Y#^UKvzECeHv5&yX$~O(*jcG0Gg) zRGW&SMB-;Im;x+3Pe>SvF~?6c{cw^T;8EA-81Yix1RWzkWZbv#VylCWM>W&wFk9tn_De8^3A-Ua*zWC3kY z`bTs)@__P;YY+dTLyML7Nw2(^nh~wq8?kzSq<)6w!jFFsxFxk1lHEPeQO9zR+?UM- ze+yt-B^wN&>R7ckpK7@!^x^hstK+dMahh}r>sPyca(!zi>NPlR4-t>^R!8mdGU0lp zEj417;?4IHHexN%U!(Tc(chPNQP0|0-ml;<>=GPq2M!VZK9Bg)-gZ>BrM2W8`+{QJ zRM&m)dEy_nLjj5X3(kdr_J4l_z;1Oq9D~}wG;mGsd4Jce13S>#VQ@XcPM!K54}Gm{ zQDp6XHL|;&MA{4_19T`kNrG~U$PvRYoDeSY2i^?L{PRDffi)EnhbeknziNIw~jl%A5GNBo*M>^piY(kR63xYL$Jau*3% z9@vt#z@JI2bBC~$M!x{_CS}ndxv_|0F>k0ZVFIth-M${z|w;6m9mwpT!%Rx&y zN5&*!M|PY6R#Dd8nUbKpjf*#cKRFJrfFbc!l( zB&Xp(IUO(HSMu6P%~~g0|F1M~J>@T(f@JV!D3ny{SC4-@@I-|JD=lgrwP8ug`I)OWU@^|Knp%7hTR)Qxn^O^_oZ5e(al$HhRN zN5$zO+_%+Y58vGEuMGdT&KqY#h$ew28xgLhU?wVRXK=Y0-A|gRRkSys_oq@F`2yRl zvYdU_O^QYU!>0rG16Mf!P1}^8GCsVNTBvCmo%*_Xm~@jxHNAFoV~lB`V(*Vkaj3hp zr)>gFWaa7Yb5{qBYn9hY zwzntP*Ib+^ll}nc?A&fQ1(e5UawYqBauZl4?)z-Z{*l)KG>x5Qf$dpducJTGURa&a zci>jxU-1F;o8HZzJ>hIs1qJu}INR}Atex9zai-KNXhZ{Q95P;QNV)oSlRS=-Xm_Bej`#H{F9@OT28B_W6yp*lKqt8(b zr^VlG+`G)FHxGUAt4cv3-TvwD(iJBfYd-*5@Cu^~ke7tS$MPpz(kugB{#6S4!lZS0 zi|GPm9l~38j~NttW!%`EwBRkv5|m58DodXIZmc}~Wr&l= zicyd65&XaPfL4LCECPNV&qv4lo6Jr0KJ$9%v(=fWr_;puJjW?B;moPJ)z`Kkgo-^md=iAX0l!n1G!dyM^(^> zuy=6obEllKeeC^Lh<6D$zpc9E()#Oyr4rw;;jqJd)G03Q%#G%FJ^R*1*Jl6| zX7;iu;mFPpXx;VYn_0HCY3fsyvYv(j8~M_ztdK9hB1bjT94PwS-@}XU#XD&wP%%fU z!Uhgao>pOkG3~k4uUCs{UdX$H881CVwIR+`j6=m6LRS%MQ(hr5%EN5q*IC)vK58dQ z=V0$J2G`vc_^Y3%E6Eor3t0cykq=c>LMIT`CzZJotb+l*XR9iF|8Z8l{az-V_p^d} zuw}d#9uX&+YcOSQH~Z%gr$he<+*p%n`BA=UjbGcostcOswLaf2yp>mWA28AI9{&-ifQZO!J+CQbv{X zhtGfRRn$-}R_^?4rhIes%4}mMgBHzLqu5cD;85cGEQn|n-a-KN5>9+7q)Ph@3gK+( zpHi8636AB#sFwn=i-(og#=XdkND&+SQ1~aT`JYsr3@v!gJk zTv5PwGo*%;8Y09^z2fbQcmJ{|gHe9sdcn`#ai_l47PbyHJVC7!m<6gf38F`C>-0sZ z#?5(K$Nf{hq)ny>zsuwkKnI}XEv1CYQDo;UqA=woh1}c zbbg=+1Mz3t-xwLnxS)f=AO>(&SXP;Ju@+YFFxaLuBh->6*`OdUW7UC53=CYPVsnYo zGb=_Tek@hFK`e9D#I40sLx)>=@B*F-VnFw4&neSs{;_AkslswsPv@L%uJ5l*^6A!J z!d_a$#2e!Zk4nTrd=&7^xFJ{)5gnK1$cir zT~hFd49{9y*@2I&I9+3Yu4A2pb{&N*AdZ&bfb5S5FP|RB4;Y<$D}Q*Mu@<$J zos}1vy>CgT`MG=RN(lvUvuOa{Yh0%^w}O4#5wi=SfjUFJv7RXI=%3!|!Kdez2Ug19 z*Z)mgi|hF;^j3I>cg*?;*^kW?pyv1Dp;wLGH57t`#d!9|;4o!-_$uZa^K!{o zRE0!egJY=g5z*poK%jkogmHEVIe=8dY!!C@E0v#Ts-yCYwf!DJI>A{_`|lCox6+D# zzuhA~%}^{G$gMO9IT(;ogjWdKVFr+<=X#l6hUjt~31ni3#?uQLp{$h-Z4UDGc%$|H|?40~(<{v#y1R-~GUj zZHhjWW>S3J;Oyy>u+H8cE+ehW9N5Kc$Hl~j0R=hpmv2a7%GI*#J zvvzFc9(`~d_;XC(*p0rIFBOtb?~ID_jg>Ai;P|81R0{fm+mTF2!x>vKr!*`xPt+C# zy*j!Z{;we1g(Y7qjd3AAiR8ggiis-bDywmpQyp2PCu4_zAw$h+-7^w{N7cjoUQr>& znVMM%_H7W>%)FU$-{O3W+Z(^)#@Su2vr?9UP4{{csOYmI&iTtiX>I*+(Wd2-@#FP3 zP6PE>1LQfLPwbbMdNvD{U{T)AR5twpdLG42Tzdck5EQiJ+?y<~)4scwA>(ldx`N9( zDI}WQu#1qUVb$aDq&%2d**rYr+i}iQCqY^7nSSpK-m?Bp8#u?>lz*pRJvQOfsv2#S zJ(~o2q|vd(oX{QhYT;8Npp^8;uU!TV>UZxw+y~QTXd33#OZzAJl~Yd$U!5LT`bb+; zXB^9F(oN0fWmQX@REsyovg#M_{0nBOj>>bb-q%eeS4W%I`xhKlJ08>KPiS$gf#SM< zbR3b_EjGn>lC^5NoB_x*X>yk6a7%kREtfRb3wskSpT?S0d*})4CM?>~{5-OFNBprs zZd&S!WqfwxN`bD?%_8YUvuo~Q;$9~baF;N+ z89BF=tK%j;06PT60bjFmOq(oy;{+DoXCZ5=K=}OC$ua)g6FaqjUA(c63+w05wkE9n z$Ca{E`?aC3Nuo4k-F;=Y>y?+Jua_b2(%vEcLjjK!%lN0&Gvsb5SI%J0B%8Kos<%!2 zTTa($>c=6sWyyPuat6)clO_$!bq2+Cj33PY)ssh<0v8yUoH~l%LZ<%ADVoI`OLADwU1-w!git%oigQ< z5!Y-|JtRGD;-jUpjr>%uwL0ZX)rtC-6o+^Sm#?$SYPG*6^=(V07q-o@e2;yd3Zk1C zY%5ar`0J*YOls#d&S!x7Oa%&_+2x9)3>a6p9=%b zgj!sRVJm?qG$OM5OT_}y#R7ysa`@(Vwh~9W8d%=f^*ji(Qb)f5nLK1W^`JIl=>w$% zh&eZ%i{3jWt;b&L+euaqPTR;QeH%zu$mHH{Nb(b6?8n01c=NSmXs*x11&Eh72D;@y zb9q~UD*<|FVy@_J+x`+3Jwa0;jgo1nm3NlUG~B8Jm+vx%MDD70qWFPDmSH6>e}NVg zM|;`>bU<#PDuw=Up->I?aRQAT#Vk6`vGp!^+V8QAnO?MDpJG0;GOT|5xUh`TXq5z_aW6sJuqGdyZNLRJBK3$n?!AREXXnV7^&phWy!N)0=5O(Mu zV(LEk9gDu5U?8wRe;Fx3Nc(2_p)4ieQSMs5W94g0BYdZ#9w9q-I4iZep2&DIJzJ&XC8JeSjRf?^xJr{30~^*y`h>htVFshispe0TM2o}qu!VvRKoGk@#} z@Pl|<=0n`p@&^$~&U07?5YaH8UB?0F5h1F_BbBeL5d18<1A$h^^CxTxDa_;6Ah7}( z$b(DAGV)hIV-Go`%_&x(AQSw$N1xb<`w}88p?@efhJ5mTZa2z(*TaOKdSECOUxf8I zN;H77bm#|lI=g9YSNx@^G30Tls1Vb*srXgHzhj@`K4{x+99H-sK!aUtW(%azJb8X= zIjIOpNeIVSo<S{)m#y0Ru}GVN#yyBQiLf8gmD9DNL_($U1+6>4@04vDpGP8Y zoSkw^J1tgNk z!wqu-4|LikV=fV>qZYJ|xccldcF}1t z5s}3Eg5PJ?vLf=M6QoMOkNd>ujjz@EQkOj_S| zD{m_Sppz~3t7d>upMNU*Uqq})&iXQe^Y9|fHaQ2kprekdBfbV|g|g`r2W|Mzc^LDe zLvILoKrIE~(8&S-J$DK?(z%NDaQ(v|>f3d@^$cl4@|{iUtsa^GqQ|1I#UszGa4hif zR7@am&~=Q$D%-~Hca@}~?>U^s1k#c_;SfH>ZftTS<02bBnnQ-}{?Gys28Vh6bll2v z+B|#akmI=H(-B;=7QDWvfi-YM*?C2Z&|2(b;k49RyLMNdny5_4#->XQ;@sG>IK<-a zeb*(QKRS;J+nW$$Czxn=n0JH1-md?@lKJLS8OMtmF?_X(E6Jg&G~|7Rx1J}TFCqie z_q#9JiwuZ`O~M889j&Dfa42I_Ydd7ySYWfj7r!uevo?0(VS}uAeFlP{Mbiy;nad~~ zvWzRc#>Ic!M=mSq*`euKXeY<-4g=X^<4zCxv9O!x*|#o_KEFH0g-Ci7l9pOMS=!}X zw8S~G0Ju8SRruZ)3fso{SX2KoUMnVo#Y~Xrl%-uxe_P7NnAP8HI23Okxi_=FeA6Izxq;l3q zi!W~gRpAn)vc@JkTCy{z20&|U?s4`@)gNqQuC?#$Bwh&HA2wF(OSAB|Oi~egUU%CnN# z8EtD1OS*1TS<#-Cqfhcw)A(MQJUeGwHl$zt9E5SWv+@y1_lV1uur`T!Nr%TCeLTq%e%oYRXO+@6&GgZQaE}j3@*jK=ciHj7yR%O=^aao$T zZpMFrqk!kV##k|0H(r-8$4l8!cbz6C!BAm>_xCWFgUNBK6)qK}gw)1wP_jB3y00x` zB7B#k1`q`ZFY?4c|LXe^}%K-YF#)GxxU^Rr8}kCb{jJo ziRx0CieGJYI>xPNhVLf9^~`}L7O}h}q*?jmL5t_L;l%HDNa=l3#x{la$(u=eh7m1O zp1f5NC3D6Rc65@=)wLA!x-VFeMfiA#!goQMerV=+HZKPULU_IH4xUG9#)mWZBWy+f z0ih>tw04zPO{SpWJPNN9ED(DDWA9gNA1&Gx1R0kH*cPOvsI(Qz>JTLh+^x@55#Gvo zAdmkCT$36FmkG8hf*QrxpUm>eu?2x-GFIxD4~)AuTC{2MJCRO<&6G;0ZCG64UsMWZ zK%~Fvp2Ypa`v&>#M%aTwB=zyY6N3zlyD|0a!&6gXi&|$E?6v{a9pb?irGGolHs($U zvoR%$lpXt=V=WY*qlG#ANu)2T!E21*pzFu?XxET^i^15pVYpg;y_IzJyj>g&kUL$h6+^Zza|H&DW{jd8l+r)4iq{|S%#K~a({V42DX z79=^;J`h=yH>-xs+hboE_{X)>789=ae6ccA%I8V zS-Fo@CRNh;#@N!o-g|5HYs3wLL#osZdHgmmFV*4v__cM;p-^JQ7QIW}t3F=#{9Eff zG$0UnQ|%%YXj7%9I#jQy(;{i*Q?)^M zZq`;Jsod5+&OU(3F~QQ2_?mkSU95xfA2FlncYCsOKO$1!(bsjjGT){9jYD0rg)Y{~ zM8Oa%+s3vWznjIQK#NZn#@cApKx~q%M_#UJOvn4KiJ+~!RS z#Y@Mx&!7Bj8mQ!;OQn_n5DYnfpWB|O=0!U=SiYa%?0G!)limCUyMK@Muo{$`;8HB@ z=z{9IN+JCzy8_=+8k1E7vmTOHPC%&7RAI{9*c);8E~Ta1*NScB?T*i{VWC{-&-)-NWlT z71E~j-z`I$)Vey=6A6@M)wfZ0(hK~)z!@QqaE}oz+@&;aVc%Uz;Tj;dCr*_i+OHbf=%KW0*`1nKU5d1=lywk;U?M%KUylBpN>i&Ii?Xd_S**Y7)xlX)3mH}_^KgOnNYg^{*{jxKY{%* z!yuw-bN91lbN8a=&zrqxkBPo|Y)Le0>!mJ;#|F$gzGN(Fq@w~6q4S*a(%Luo)9-Bf z7W|k!n7@!XBNqL?OS3<`@NS4phm_|pr*0;>UrHFP+&*cZ)c`AexC`tXu%$@HhujZH zS+FpQ3e466oL$fR_$RbqO;^sK9N4bY@rGqhPkg|!EX4yNMa-%<%xhXFuF6H{Vii;K zF3a^P1<;!ml~VJJ`nkBkHy1SA_t5R2wmQPJf%cwq9eJORg$b;(bs@QqGwt$W7<@la z+hNRbzVexU4P{#Vybqv|k-SiJ>6Kk36d9x9$Dp^@RTPq=UXXhJz;!shp zYrvV|WH`z*BLaXnZDMkY6#q^s;){jKug2MtRyAY^-vU~WYJ7iH($H9E#58z!dol1IBip2yDPz{tIv&U4-VhhhRJEpf&=`4l z!;KWz=W^+uY33y+c`J2%)+=C0-_zfS0;CH#m8}1r{f-9Mwy$+jF4ne~FW@jqc9r>* zc_+GqY&r{J=eP%(Htsq-uL)#8zk|JGZv}GMQyW3xRvrp`dQh24!hCv!Pn+(jgcDr9 zrbq5*f4OEvbQx`8JY}{l z$|`LFaLrb%;YKL1{pk=d5BK;jvJy?NpMtGIQlMV2;CRY1mPILj0Jom;<%(qD0`(5Y zH3b%H@OwaD@}c{Oj$S)wz`HMUtV~E`g zCap>M^G@-~vfC=LLngyMbD*h?jWA~zX6c>aQdq3sH_j4Bc3~FXY4Z3gR6h5dPgNEy zY#P^$#1BEdXMf6X6u-?o8B-X^`WT*1Zf{qdIRjdc_0PZwX zK0j0*$D9U2n-BnQx^8qw{hAr5$?<_zz> zh-@U1tFaCnrSvt^9OB>Vd8UQDOkIdo)wfIQ+lLWjpLz$JscTG4*r4aJ9XqgZLp~b~(ff5()w#y@u!>(ZD+b;?woXF&1ZB_pL61djA|R z$sT~04moi#khrd14koS%>`%wM{k>Lwma?#hTuv^N()<^|`Kp1f&2WsPBgxqW*Hnh? z65e|>{Q;4wlt>^)AOl?z+T~Rr=;p-C?#<-B&gz;@o$cC{)A2~8@L==kO&NxB!THZg ztqLTx&#{#*(31E=bvkSDiFKnK>Owaf$!x;%P%homlPbT23JiYSQ@8xBqqZ5Z2!Le#@mT#GIM-0XR#sY}97JiWxEa|17XSLJSdJaKeSj zz>uL$__%(2MhNnNi>;dcFx+pD-$PvLlR_@eas+#b7x~jH$kZj{<~e3A`s$?rOj8gw zB|7cg&}c65Xj~97ocJGsNGCTb6F<&gUCb2I6#ZdS;YZznSE{`@8N9>|=+gV-gjF)) zTxDgjB?PJxKgrXq%yhuYXz->TY2^n~FOmkc{g&=`$K=vAi?ZEWAFvMChgW7k>Wrqo zv}LMdDM?%Yj<`HynGn~^+fWe8ues8{+q03cs8zGE-^qsB>%Q6pZ~}n2>Z~CPp*!si z3Y>=-O%c#-PrMGaWApy0B~&|YiH^$*%dLvJziYJ$mKjj+32nYF{pe=+UNQk7ww1F5 zwPtwG<=VC~MSYc{l(mU{$9%h`yWWfaQYuHIW|$6V!SQmr9W9o#l8^h~NtaJ^z3ViH zbdfBSFTP5vWANkc4)>|$Nzr@y$~x2ae7z^|vgi_@H-@Dz))^B%mdm(A_CKuzHFo-* zZ%hjX!Arc7-^czBpMXVm^PL6aD20=T1JH*5lZkqAS@pYa0W<7xE>fZA7Ibw57N{ZqD#QmzbnIUVrGVb{rk1i z7Vf$iSTe%9RA*s*=u|Z;d~IO91{L;6|Mk-kH@xT{Wgl~RVqgp7-h?(nEyHZ^sp+M>aHx?9H7 zft;)pZyr;{$c#?RVp@JBWySH9;U0T#J)(3I|2E!cchAOvVQbP*UTz_!H0R@gd5yR( zi7%^xw2Inh%=UG2LzAFa5 zr`1V+3Dxz8a=InHSG_p`B568o6A1W^HE|sSl5y7Vh+IBz`g=Z}K;MMGmj;1LmjLYX zfTj-%59cA+p}?1BI+?p1th1!nnSe!w9y3B?L@S@DPBBNB5ap+Xr!b{C)XB?{;xHE# zEC!=+HWfTMQMky^0~LjYNY?kbj6E{_pa&=9*+E<$q>4R?+@M1z$oK(O9>j<}k`MU4 z{(v3rz)eKv^(hZmS5l>m;f>$WXwsISyP?|ih3WCAf&_z za>bSL6}R2p2?u#VR~sTg>JC2>8VrA6-szTQkbECO28{dh zPky&S81gM#ON7TQXG_=$3;w~LycHB<5fleXVW`UzMz*MgQKW(-DdvXAKUgR#4PqDx z2D}*9I11@c#Jiuva}LHAT3ca7@|xBWG|sX5rP{u%#wwcji{m*jEx9)CGxMxKh?Kf8o_cZsB|LcUNOvxQK04DZ+QA{Gj@@w?aCteY+$WtXSg2F)jhed3Dz?l_ZT za@;L`Mf2JsNmiKbAEG%z{k>2LnIAB2A$%%1=G9P~`-GKX%LDMLwaT312;L-~$d_s9 za=AqI^*uUK>>TL_l$5?PxwUGH7XEw8l4K?yqsKnl|8<}93o@wP4z&AddmH02gi&t2 zm}o;H7=tN<(X!xDu_mA!gS&+>Z3SAsVDO1bpZzEh@wI}X8y45If~YIPYzh5Wt~J{K zS95T5Vo)?F$At_C_F(M)Ub})3WQcvGf_2+t#iOndWlyT%xb_#RV8)G{XX)kw<9WH8 zcqh}Lw_+!qK@ze|pIo2Jdzt?NV8QSogF$bD^0myJZP2!in4-@aivM14I(VHWhA<0` z-3StK6+th|xOPVc2Ry|1Ct@go6aiW!@Sg-k^!Iq^|9xFBNIv3tUL=@m{YXgtqvigP z#Dg%mLJ~v1D#RC}25q+nG>}CqKjB3JVE3ai5JeLKzYMym`CY{Lm+7RlIkD|8z16W-3HSgLHJ#p^AU=J3s9qmkR(kvmC~nJGZEqf}sb)5`x3#ZpyKDXRKkU6_KptI|F8bmUB)Cg(ch}(V z4#Az^?oMzC65O5O?h@SHT>`<~?U1jhr@O!IduHyv=bk%fpng=X+ErWDvsUf*sa@~h zOGABgij95s$AYBA(dRstnuTfAbWICG)+fK_qIofN$RC`VvR#((h~cPY&az>qpqFd? z{;)l+zkm=#Z^R0$bYg0a>l3W`+(Dc{LQdDZZy@g=n}M2vj($ux5lI`h-EJEjlg@W8 zZ4WKLwho<0g-m=(wP)p)39QAl7m3IAC>nJ*$k`?@i~&vhMFb8d$u3Gc#<1`a%S@kI zG9GkLx*01TyXL#NF@-|gbRj1Ho@m@JZ@Arr4aAz=Fd7pRN!?<13TqDMarwoc}#`iSShoyvlf7|RT)*(1cM#*)q{U&VH6 zO$egH0p54jcOX1LSd}N!pF+TYKo$nj7MQ6XCx^OG1})V9{{j<1@hM({VQ~d2V%E5X zYPZt|o^W8Es~8xLd!9NbY%u|I&3y_HA#9l|_bpuuqrT<0?vlV1UcA)or2Eu)$>wSi zFT$0+KLHT2^pG*&LJR(}DwLxV4l`SKduTX>;^86Syb;7Y^J&I{|7IWPspequ5btG$ z-?^C+`G2{>FVlZ&gds7NDhe!Fi80?U#}dtInL1~r6h93a0CR}W?6RR_Xu3?k!g_y zg%r8;Q*7|H#J+Tq=}OI*8r6c|_BA%$79YEn?X{GuFki~F%)&wf;NC+}-AJY^HKh-V zOfnRT$aK&0PSG|y<0ON5YXM5-o+JqUxq1OAfI0$zi@c7r?5{9MUJ*bpE1(b>Iv8%t z-9ieGRtpF_YzDM7jAr3L164DDgO6mxEdm#3T#-&)rJ!LVC{>jhu-A0{!u;^z-Q(j& z3^9N(H!!+7(jFSh5yP+%-bYE?R9gSr0Pv_fM$arql;u_AR%_J`dx$b`U;1`aj#hM)K`6To!qR+{&1#6WHi$C@@TS7 z`x(d!lg;ELD%0!gZm@iPg-|#GliTP(yVv8Pf0YM^S2t^Pl~gM2Y<@@Eo!w#K0)x?b z`0CP+{mBjl*l&9nUh6#~W-Xoj_y#e;SBZEbAzJMUTO~>Jr9H3WVC|-(@BWv;SkWvb zR^s!`hWoXLg`AE@3$Uhc*M~BreM219beyEuvMahQ&!T+m<*0=L-Te! zw6U80XCZ@eDy3TA8?`((w@WbVJ$8;-?%`X%SmEwoM8ekK+a(IYV+u!71kwfZy(6Rp zNh};f*v8oJkT!^~s4yo;?lLN`n`32wm=`Q%y=G@kz7LVuVzE(SBb*iGKnmqjmdjzw zFK2^O0jESG8;nyD52aA9(Y{P_+KhWZ_vCs8~epJz(SFRLfK_@`t2tChJQczawcNx&g`+qX8~*>fLq_KVW+?@+LI57z9AVrsadj9 zl29^R3QY>NU)VM_CD(Jp#59XZ=`7wi*P2}Z2ep z3S(Vj-3dgqhq_CC(5{{q`jkqU*=(xZ9XI>d* zQ+*S2(@ejZzNdbmexm*dxqO=27oZ;n92ja_WnrXc6 z62%&q76um97WSH^9`X6yd(q*rH4Qa|UlaxMbV0m7EMjWxTdEo)NR{w_TM2mi<$D%; zhOJ2O3i8UXYOji{N|lW}O*HMvUCXPK-D_Qcy6(cv{XV5RmO2|ZHg34gr zzoESJNHk+kYzj&DRJ!mL8#Mu5jP4Sar9Kvl_ajm7s`ob=HBq~8*i6Ny0TQ_uA)~w} zog-wY;H&9RAmO+ohNs6SC<{iZ#Rb(;9VPl4#$1k~)$w@_k`o{3t0(IN%soE5 zrw_P^zhqzFcUdSA9k`p9Rm1`)AiXKAVJ&|+6nw!t!2$jK*2pXi;5$KN>Ex~lani+o z09=;i`s(sfdCNj(T79)wg$%{VM(sol@`qG~9$a$^^8NW9mQn|$*dMXaTQw+CoAG-G zB<~MX$!?rJ{7{Cic2LBlF3ozZ>yJnYUo)^#bUK)pLhr44^Yp0axsCKtn|-uT z0k~b}Lmi*E{9T;U&rcyybw1#B>pNr1v|Cx@A=!YSu8UFiAaVu3{R+yjKwiv1sueOW z@Ut2R(>#Sq6Jj+F6my0f-2|iR40VQDuHZ)gA$Q=7Q-MwS^3pF%Ty(;q{G)A+n#(7@ zFWcK}Y7M11WVRf-OrLqBJ^7bU8d(;ql`iZ`52rKQF(0{ON9i1F)5}+Zi0gimXnvL$ zY6Hr7;o2C*O1}f5rasHcK%;prX@RS+k5N(+V&MHmYFhwy(MmD6e&Rq;Tz1Jb!*j!q zEl6_wfGsk1;fNTdoS+n z3MY)7bx#%aUw8fZF8Yo^8P3q1S!5cwd% z^G#-J^{mjHBz+L=EZ45T;UI@YCFT1FvlXae)=+Ffr98`kG&>pT&#a}`_|^>f*mP)F zJ_^Brmakg%tl~<_N{ULCaYcEp%F{})N($2x)b>G^g&Mmv9Ex@077m;^d5im2_7KbC zR`cpEThZ&Hzmkt1@93&TL?c zL?kD-CbtgVhLC@hCQ*Q<&Pg{xpw3G-g`&MGCKMyr{XnT;^vV;i{0gwb8N zXFhc`Gn;?yxZ?sJrzzTD9(Q&8)wn0eM~L0`IC+Hju@U1o9DJm^$fM6Xy*6E;yJJEx@E9l?|K0s&ba&=iVC%gRP?~E+AH0QV*fW55uioUOUu9!Da&*F3CqlFT>RKPRjz zx8SQ=8t%!*CwLE}t3Tb`)A3FOf&vTaVDma*M77UjyRWxPSTQ^?O4)l(J2W=1}-kdY(>|8*tv6 zMG`VKv(tD3A|o3_(}* znA5c-QNOJEuG?wuw%FlVyKD}RWl4D8%-P>Fzsu4wQX$6DO;aIp$k4P@T26UL(X>!n z@%fOWX~nV}>yQM?&@pk@D02SuRpR5eH@gX3V&`@cyIDly=C(h(sdVDxb{PBTk;LqYo}Pw1)NRc zdi`Y^%N(qq!q4%)Y<)&{2R3e2jMLqI-W`ceGfkmKIunT|6pT3&8QAB^@kinBePvjY z-$02J6eZ$=gtBOv2@|Rj;M!yU97~Q-6yrMeeTptuE0MvhCO4I))oq8iM!BuY(z3Oe z`#PoN`q}GhRBa2HLntp@%!W1T$vwtuH}LN36W?>ebG{b?$k4|avxy;m#yN6FR8EPM zTuyew0I_Ju-W_l{0CxMTDH>V7KvNldYv@+dB8W5IVBe=@7C$$5@YAsn zYq!=`qsck2o7E)yTg*L5v#E7vbB;~YslB{nTB|7_i9J$~w5#!M0l+!g&*J+_<4$Zxzb ze`W4g%7JTwXo3j|&-9K7z8bO`Mi7)>nshI{NZg}Hx*%pRmZOA6!FWo|K{{1MyXf;? zgbsXa8EiQK~^ZOC|HpMD3Jt^ zz`j_r;4idWVj8BTZE@(Pw6tOn!2u&y8cxM#CQqv~@iWY1shJLgwTJ4mt_hlWW?ti# z_}5!BBhUQvr(=#zP)X*?y+bqoMiGhM?~`1VbNcBUl>HN}&W3=U`_=YS9B`k;5NXD- zX%I}i7seem>V?^`vzgsD3^_-RiXndakgOsn2<43-C+bzrQPE3C1*;i-OO~(tQOsnR zw^SS*F(K9(A9z+oBu48Z<=WI_m=YEb#UMx0Z_pphY8WCJN0mr2`IG&e5()K}4#RM= zQAna$;4FqNiM&S2q((r`m$W|FfqZcZ!b^HZGGYv0x~8lN@!^i@MK9Glg_Kz zI~^LhI}=92pT9J1v|H+%w-Wp!-4QOYy`fY{an zf7hOp&!*Y^z4Hli$P{ur3Ida>LoUf4d^#8C=8`~N0OA+n*fyFDA$VrZ2AE7?f7TlP zal+~#-cOm#RRwMFOt70;gkKbLuyL7lGPGb;uCtFl=$t4^>{!hWz+4(WX%7sVJ{_~l zg%nbbvH~IbnHkFrT?aBj1}K`F?<0QFEct~xHznl~JBRr*1$^)oV;-l?z6{z$wO*s= z5HP0St_v#khRS9O5452{vn4MB54MDGTM^i~2fJDfxT|m7(Y*M4zyDC;Y$-hB-R_(agO9 zGI~w<0RNEv)SvX=_`}YX0Ho8DLaMBP&Xa3LpKfpVMA--{Y%wIJo^_@Pd{cXqlq~=K z#l+&cZr7lA;RNgjW?5PMZprD@U4|_oukQ#6CHbz9u&~vC6|6+HgnNvD&{Xm*N>9>y*TWSS#0Q zylEZcq4UY2k{sMlGT$aapJql|F!#cEs+VQxl(Hz#t?$+;D4@KvttTvbYO92FJ2fm3 ze%l^5RG&*m@Bz&l?08+k-Jh}{MCOEDb`r!|4t*{sbq^XPr?5h`lS3(!M>gJuOP*KE zUvQSq$k#xJxw{g5-$kT!z@o%H!LkfukLxj*cm{9WxTI`1|0qkv^)XT8VFTZ}UrebG z$$-Hk2f5nQsY1qn^V4O*s!Di0qReL^^5`trqSE#nzk)MK*UTB$dZT(*pS`I8XAW?V z%~}Rkkst}i3|4u84l#@iT)eDa3aB_13F*Rcvz+4DpBz54a=2+?11IpYqQNQNOR4!( z1_dPt6Zz>8CINj&lnNMaswx`dBOMT%YW?|KvB!4MqUF&|Me=45*A6#4r7aolg9Q&D zTnQT&4r+N?3Mwb_2I}2$s+)XC#c*dNTf}g#DLv%Pd<&EABm7JplY%u#Nri<)7<=sD ztvl{;eztgotkhGg6M9o7jTsYPFBw0n)NI}sOiEI$=OV)*t6IGJ+qCgP>Gm;C=-+{2~EbL=r)T5`KpV2XP=U`duU?n`9DH zi%|OzRiUM$v4fa=VE$yna^e5V# zpPA`Lfo_B)vd0v|LiW*Xmc(Q7h>xNBr;tZw9@854PxwW$O&3aSJWbfr#vWuti=)f+ z0jsf94}fctfXMPX@Yy{?%>v^+>;tLD^&}xh>HRST59wpQ)eu4Kd;Fx%HEyJGk*+a` zsnh2$6%TWTSrp#u`3fA);B=gwNhq#!(Qh06Rwk%0E?pHuXyb^81vol(8|a90%5#cL zA!I9fkj``nED0PIxuP+Rrsm7ck!tR-TG;BFNVy@Pp1av_-8{g60rT9Ot%7(0TBut3K(B&lxqEahq|A zaxmIV7ZC+_dlp(uVEiv;jc=C9F-K~5%UafO@`Hyu%(l6qx zG4;WaYHM?avYA#R2NR{mc#U-J3itU5;!redb5l4P=h9t?aM<%{7a+rRB z!+^4-{jbZ0xx_Ta6`hupmFh&o!wAetvd;Rx8d%c~`|4ev4k0q1G5CEc@r8^Bt%-F* z$g7B%MJ=Cc#i&UOhea9GpyUd2)q)G4(+?EmsP^|GfS$GTF;#A2gUeV?5s+xXa3OVk z5DRhl6xk%m5O9|{b3_nRUmjlePBXTj=B9aJlVDR|VJd}9jKyZKj0lAk6W_k}$wB8k zmn>kcGn?g~cxzx1Jo>o{I8jaP!h>#552pmg>;Xt?{F?moAOoZrmr%DIC&L)190ht~ zCC}?UxhN+;5~wm1z+G8|+emnQnmYm2t&34@C?N*#8vK6oQ0=+ zFn2mov-}u#%4V-qGWA~Sms|o*1is@XSvd(#NG}^FXiUgl@SKvR7dbNlS#T;etup7- z2M=Rl5ryw|3-z?tt+mQn%$Bkig5z%bX5Mx8)6QPTnmr;pfry6p5bHaojFS`uS^AVAG~M=fsBzn>;v$KA787Ek0^p0x-m4~ zY{EGT^{`vjM0ulz@`>NcICxhr?@BG?Iy`6>5Z<5}lQ)!%Q?IRE0Qkd>m%?AzQy}p72Q72)25!XAtY=*D4IjoMj z-BN7h2%|#~v@AvMO-Ymx75R{ngd__>Ka7uN+asSn$%T_y*p`rVq>xsHNhW1~)Q=q! zXHQCDoHD_jkZmTZn!y&K6xHCf+cMcru~*Pq0E(bu(=Tw7oq#ktLZ}n2XT37#Nx(~V z(e>_39Jv0z3T03peWsMaXQkZ))2NGJhnm975%E_l5ZbZFfip6JTCsRvW(Fren88a0f>Nn94B4ke`(XA{ zt>%?(WNftjjBanao$>B0cj4KgQbdS%Hx5~CeaIm(&;aHp+7k2Owv}4k?e{q4;2RR3l(!#^J{aVTB;_8OxKRGqN?IsSy|8ea4Rwh9=KyfCCux74Wb`zKEyin}y53{N$;V z5tTI2!k0D<4vRx43U#v#0wZU;4`#$GJU8jKRj-Xb7{r=(sfE`5S(!^&l1Zv?EW>r1 z;zGJ&{4?1yjoVEDaDRCd<2GdHlH!uKbbpxGrsZ``%37LSmv(rRd9XgJ(Yg)CZH>%1 z)cBkayZpFuoh>A?{N-_#a7H8oKd(CqjS`TxApj?Z>6krw*OxP5hFu&((ChDyKCihg zi06!T;=deQTY=grL^wBvo-BCn0+C{O!D%mwG$esH!K=!iY*12gD{l|&u-LoBH|rWT zA`8=^nB=J2&3>V3T9g;SS|~u(-7%NWX^D{9b^M8XL$a$@+lB0nN>U0c(>lO zvN2`nx~>+)hvdPH}BqyCRADIqn)-DF-v}%Ki z&q--Uegf>Fcm3w_y=TKYCqT_360E_`O;u%*qrPkdQwc7C!hA5JFGj+@NNEp-{Kbb1 z*8UC&PA||SXx1treI!rmBXOxW#JA4Jt6?Rc zJc{jr;idrVDiHx2Q@G4=MB)owPFC>yQ#_Lw<3tURYEECS(x zK9sE3&?z5`xqzkRfYM#KtSjV|&XCZ);=v%L4{5vZT<_?IyU%M9RZ%m5ZfQm?^e0=< zFzS39H@_oa0DDJ1K#wChYXh^R-4a8bZ6ex58FBS^&S1iu`q;!h8G06yt2P^X=Gq7f zxM%Zv*L!=xF)OdQKxUL z5Ez&tO3^=J5(b!&SdQ^Mt|8UScvv<9BqT91i7)bJYk$=^V?6%cg!T1bS9YFFPHHdF zUhs~bMxGpxTiSXbA4hJ}j&0ID!8mg8!ihOu@x~35!&l8ghf(9k^HYrP6s*}cOr|;@ z3#rHrQQXx#NM?YW105XnY%V7jJAt{?y>CkrO&)1;r_%G!;RqTa(%+Bvg zvfPdo)*75t9Y~cqYwL=Ye&B;pJLr8vEN#xi9g@(H0(nf!*!)Ad&;DDWO4|V#2F4)ewgOKd_J3wHlZ)g;D`*WYJN+!; z$~|{}f?p3^59M<5e`L5%_TxRXACAOwD#V%;4h!!^|6K1RuyTPrF3;o%&z%#v^*M$| zz06Rx#j@S(GS;(LLASQ7TDA9AWOW>gsf=1l{Lkj=dfZvcq%3acxR@3UuNp1DJlfc0 zqnrSTMEaI`fb@*^hTHtn*BRS*w@U8)@=<8V6}>^8{&t>Z-2vKMnEUAbnfLF!_01oIH4_m&`74;HaH&-g&yJ zYKOFZ_oBWl4PRj9SQt9=nb-W<5?m9U&NBWOT)Pl_9{%~UrQ1!W-jVav@>-+6s&u(X zWBJnR)a>3Xpk^WP+UB@YEzRjUA1Rx5fTPe`jIN9@KU}-7%z*9Q26|Pr1B9gH;A;F(Bp$?`ynVmLlIy%BBSEj5R2XfYQ4Ix-5q#Ok$lyq#H zWJO*HHL&Pde|SiNiyU!M1|^wXHAhbKpj|S%J<^>SQoRu<K@v+pkVHM5 zI_b0iJ=FIMjbdo~1{TA^pb4^M;Zfcnf-}-#?F?|!f*;fj)0GiBt4`|-TDEdK zneOdtamU$pLNA<(t;Md1(|p_Z>28(l+<+K70u*n#(5%8{v8d~&B+faizWlV+R7gQ3 zw^Jtu!HNCS7B1{j-7YC)Y|A>D$c?~{w-|>w&zHl~TTMJgh#@$Mk$>da>5K7+*$|DW zkzu!Pn7j$IdXgex`ocDf?4DjGQC@4u8k$+&Z?q(u%Pi^L84QXLWz>+XIzpKkequw= zr$ekspVsZ_L=QMs(%c*IoU&yJBd|Ocqz2L-^i7s>8Ad$tH+wvw1WAsGpR6gbL@I(t zTLQeoG>l|BFKwaCN!p6juyz?9U~X|#LHR4c8uvy=<_+Rj=a6qLE5;Qbd=j?5K6B9{ zQZvdOa)hi9xOAt5=q;#%=~YXe_B*!5RYv0JY712~%B=*0UyKMyaQINQfOQb7oqZs_ zl)6Pm((CycY{mdPG{JQUcD9vnARvS#SF_8irBOzGIrClxtQDWu*{_dm+8v@_Vfx#< zC8VEld=K>{aAOD@d=Pu@pCAgKZt}n@7Y_OK@;~}rlx7b@u!uNjWMfe>{0KnNhnKl*k*90+z(Wlrq?5C8=fjM0bFir z^Wx;PC*}Gvw~JvLqe1rpKnSgZA>f6Ep=;$mMN4a|XntbP_FiJY2l068)`6O8r@(#Q?zFF@On4t0)C z7sb^d{=l$sE{r;zz20GfR<>)Iu8PKS4_k80AgB5L(tic56}#Z)?A}M7#s~Z-r2yI~ zyPtB8oU3tM+GS0^x9fvtWevoP0V56>AyiaMZ|GF$4TpYk^rCd{&M2@Wg zULS9@xHh~F&N;xUhyV0jfmSVh=};*BSF0Yu;H!|$@nlEN?n&Hq`oS+)Ly{E<7!nwf zw=CbD;H@pdjyc$YY|^cFtc}A39=P?^l!-3RJ7`-7JQ2|u?nmMx?OD~_75w08C+0zH1q`(r( zZBUQD15AZ4NT_9TfFFvZk zCa^GO>}Si2mj!gd4L#x2ERng=yP2CNR!h6se?r?&Gic_%`^6dDXk9i7WpO-P^F*pG zzgALe@IYgdT3Qgp1>#mEg&W2l7lDH1m*pPltJup&EOB_ZHO`8 zkR88kD9eW|&Rw%+s-lG5jV4_=a$FP=qzrm$wmKUVY(aQ=M0x3tIn6qaPCqb@ruZ~4NH`{R`zPCL3&&$aM9fmzNvh*y0NC}+T$YnaJn zQ;OEJ;?BprAeV2RK7lw6cOM{*vHB9#wWvraiOOLJg~mvH1&t=Z;XgH!UvUeH(AGDn z4hrSr_l(tU#@jge>DJwfhb>aW$22&&gH~!^*|m1j99vd!1nzkGv5?!VFIFZPQV#-u z-E+)*QsSNDp}F%La!8Lgso*Jl2|7G7i($R%E}J!PP>dL_v^`+ziI#!OQGw)g$F2(c zwD~^Po;$~D#_1QcR9#e!6aBf`#V~M##+?}F%Tk|HY_N1A5Cv76YdLAN3I>mnw=3(p znKV{JcNRk`C&_ay_Cns zlQRz8qaL#zU%Ec%Zo&5l(fWf2nP%YgFO1EBM}HIr217jg0p8;YN*Qsu5JiSZGGP%% zfgrw6vP_T=T{v0oIBYF719T`n<6$yuAh9j`-b6&zVep`YtWtT zr@B3s8}LWH%R(*o$M4TBKhKece^9J#*&NiQSK(E~&uJVeWh38jxqjO?It2CnVKjGt z;NfTZuF02n8LzVJ`}17g{Ne>Id^OzAqf9+B>$pVUCA0fGPq3XG>?h996X7JV#)1^} zleTlND|4)oNzR)d${({6B*nd`H%G!bSf_zAfI`Sd(%sMtk%NR!2WONA5GT*fj@~W7 z-0rB?cku-n&q_FZ%{;+ncDzEWHrvN+y6HW8kI>p(v{}d6jBT0l;}iZU4*;u21vZO- z`U;*e3gl zI7}n)y57K3>qGp~R5lmFn!d4W@0%R^f4J4dhnYNLKLgi{8xDN%W07UP4Zgvfxrl~! zV4AGsWB=I0A{J+!Pi7`L9n2nXOqDoE^5jdrh~K8y&mI*|H7^bOU|eoc`{`y$SL1Vk znB$J3dL`e!T_bg(0A9HP))th+h|dF#gfJI--L4^`q6G5=B=g6;Oaz9GNV%}Ab~4S3 z`U$4&Z{AdBWk+_*z}0+FpK=EKj+STRHFC-;Of$)q_YHUisJEc z=+EQwS%9j~b9_OMp|p#3f&A_wh>Jd2J`j*WG8H&RPy-Yf?6#9|iBx4oF-4|t0$X%D zut4XYF0$%B5!OMG!$6v$trf}AMO1~P{Fp^icdz87pq5~dsy`qZh>W5vI9SWS8#C7T z(5<3;a>QkDPnHFlZH)M`9{dK3Mg?}8F%J+*>e9Op%(Y=pVM#kDUX_trs5Q)yOhIV~ z3fQ4S`q^k3c_tCW8x?{&OxU4E2(6-m_5m`HVI)HFiA+d4Lu0t>_O(d@Q0L9Rf|AE^ z=XXrj_|44~1@-bf`4GaoX^9N*J}l2p1#3n#D+ZT-B;p}Z2N~C)at2=@toT}Bg7c2} zrzkh!dQMRB6(hDpP~M3w5jKpVKQn>39=altzJ7296bqLtPZV9ZDw6?8S3!!1MkE_1 zT+(<>gEoVC;U}{ zp56YS8LfEhOrbMJ-N@$mZB}x)A>cXy7OZ!K2BtKPEIfXVLeV3pm!EvQ)Ef6kGt^8q zeArmh5H1ua0FK*54A7iZBAp>T|H?^ni0|0QZ2pL%@cdwoe5Y%+wRanpYjTm== zmesi9L7~)foG}<39ZSaDPMn%|;wC1FKQ1bbT;VX|%YsJni!cP4{R)iUPvgjfmrahz z2=Kx_R!_(vDU^y+P^)~Siy2upH^sj>t4~kw5_3A`3B5jx*;Sv7wu(yk-d7VUJH;I% z7lJ@Ol(qj<6G6$Ix0MjhEq~*fcGV&wJX*h^;$`Rgl7VtcwN1jyUi5Dn2`=wp%ottbx?D1{VoZ8@ zLfdJ`(Qwr?VJaEIc^AThwM#`1XCG;u_o^VgO21SB>Wk?3QM?ic*1mVu3kIzH*r3t( zb@V=_Bbng*q@`VIy(G7Y7q37l#V@*b#DuqdGiDra(5DC7Jb! zKe2red89FZspq3dv1hYq(UaMu`J;TxBP^jeg9(i5xyiZFr>|gGIE(IBFj$u{F&+iK z9E6ZUTv3)cmS>J1EZWXfJ$K?fciugYw0iEGdhTR;8auSvrNO$?)u*=EbJ8}Yk}i+5 zSQ@u1s_i%`H>S3R4~@E>uAh1cB_o$8RV$9`%_KX@A0;0k$FW%htKNo3=YMLWOsuP@ z-ajWkhbtd7{G4BD-lo`kR7B2xSTtbfXsD*ve{Fv9k#z36fw84k+@r`9P}A&Ffk)({ zu3JFMQtRYVB^n1bHWv0i&OWvaTp(eut{pm@E%J!5=b^(OtElb>c)zWA^g?WNN7Phb zs}9UI-N}0N9jF!SLQ}G;+n!O>LZILt?K0<%+6q#-c**>Hmps_v)XHQv^Yof!dYy5j z{Qc5l;nIkLM;ZN9FWv^4pMx(m@3o9^Yykna_0GF5vJ=kGnmQ zYTB)e+FKSB;vDXa`Bx5y#|myQdtk!4Z+7C&kzB(V>$)7)M;%!t(^$Ac_`0AMhc^`8 zcw=Xq>z1P1btepBsxrhEyOIs+XR+T2Y@_AwK_Qnf>O?rId9}t(FX;~yS8x#6OBdmg z7TQp=g9#LJ9>B@@mcisQ&hd;A8_wv5qonT0x7c`OnNhV_;5J-L~t)GC%T6qEA;|LDvr(_b+*ekKTAMLl|(u*vT%Hgt`H@WB&*&q z;Y(*%_vv_?Oy*<`yD}2}70-B0(Ono7UWAg*&*M4(qlJMaHl$VjEvm}s znHlQa)2f&n*qi)Y(RTK>hPoE8(4xTyBNb4Eu*6KRURIen{E(r9SwkZG>+HCb01g0r0gCbpWR%5Y9M6F#dn5C&!SZiE@BqN*5%wei&`t+9JGKVj(nr|M%u`r?D@JYbZzCVu|0DJCecPiQ^)*Rh?JzYgL2uSlT% z^YG6_s|Gx$Ew^ytGBCl3!^CkMo{+ak8S*03; zL;-xhAwrTrS6YV;ItS!E8R?*RF5oS18EOh>{usai7eY%`;~$s$kk8M7+SBKbCapmM zYqQwW(;{D87w1);(RT)Gj1yZ+0&N-`b}owVasIgdZTH_1f#!KXkUu`~;6Kj_%PPHX zuNeVdcsS7CPVW7njm7txfq2thDS(^p{U06PnU@9V8y>G30hFt?kAL_=-*XLu;;V+@ zP5HSu!tmw<|AxRDVR& z_;)B?z3@gDUcC$a4S+Yo@HZ@8yYxmFUb_eUP5(E-@HZ@8yYxmFUb_eUo&Ilx;qSnB z<>DJ*c;yc8cj~_phQ9;jm5XnL;gvhU->d&d82%oO*Db#hhSzQXzt{eaF#J6luUmd2 z46ob%|DgRFVfY6)UiHZvVR+T%{|DvY2*W?X@v2YW2*ay3|351KMi~APkJo(mMi^eR z_5V@#H^T6bc)aGbH^T6mt^X(8-w4B>0C~lyZ-n6$8~;zLzY&H%0rHAZ-w4AiHvXSg ze;WuaaK@ zg5a3?BognBm?Lky*Mop3ejXHnBBzxcxhJqnj6Sv&0B}~|1f-7*&jJBZMyP3p&Kg$_ zMmog60LUO6Py6KnJ}cMvJXfdEg#sGyVFV5Ge3pA@74T?z&4B>r7Y}z=a1TJ~GPl6L zA$h`X)JA$~opK&aoX z#Qnqb--3Al7YX8-@n(_V-44iaul%22@z-F}7k~9%?Z0L*lg8q|5|V%G<=&pn7q0#vV8PX7C;7tjI{`y&BXW3*a=&88ME}D~|B2tA z|ES)#A^_fRoebdr-%ciNnVmux-&+r`y}FpUF@ButpGbxrA;_2X)^q&FJ;&P<{J-`I z{(1lIH#tAS9NnR92N>VDN5MiHS{m5d+ZyUxz`jUUdSep+Eub9+NuT0sFtK|_5j14CL- zLsMfDdwdo)dInlaLrY_O6MP1C26{FIT4`MiLt0f@1u0#-&-hIAtS^@cdg#p`YiTj{tCdFYPr182nZV=y?&) z4FCrPg#&{_f`LIoMS72ffP{vEf`*2QjEsqiiH44bhK7rchK_-SjZKV&f%khO_+$UK z9S{UKI3xrl0vsF?CJF)yCLZBS&VRa*%LaJ4;g9X*A}AO* z1mw%b_doz3U|=wCNH8!UFqhv~fq+3k5x~Gd(90nr@#)%pMJ8a7_sOgnM`5(>ScgF6 z*E@-ZBxF+Xg@S&843mhMgp`b&f|-Stjh#b4P)JxrR7_k^Nm)fzO(8$=t)XdJ_ z!O_Xt#nsP0;7edoa7avS+_(6I#H6h3oZP(pg2JN8s_L5By84F3ADvy@J-vPX0~3=| z(=)Sk^9viBTR*pVe(mm^o}FJ@UR~eZ-XZ*@$skaWz~F9w=<`RD5kJuL$$=rAAT!GA z+W36UtN=$LU|{YTUq>Y*V&Ye@t^BR;?c1#$Pmm&Z!r2=`+FufE60C}k! z!1Pk53CxS|yK>B)aDdKBabqw0zf=sO8~(c`>c2tr9s~CV%)QhJ{&ENU%uD^=1~nOU zFIO^Nvcq8hF8;R`;8An{9gzP)%zKALb**jVLpZ@$fFKr%V3Z?76lA2AL86pIDTlxS z(t-@VN^e3)G&C91AkvEv2brNGWq?5t8Kg7f&_NLqhAM`lsLA)NJ$l;jT-W!0a-Vgpo30{J_iQ|J#@S;vaW9UKDAV2q2 zFhi&dP?aA&iQ`MeMglFtG(t~dRJfC#d`{SO@u9KfaBd1dI(RxyniKYNv0Y-ke9QfT#W8V;)QiViBIV(BDN?4V2*!~I1`1c^1wG!J|OLH`M)upc^uQxRiUV4a07DR6}oEdpONyo_WGo#BV6 z=QhC|lp8N!^>tR>$5kVXgX}4QNI`G;aY#6!A#S%o7||6}83qOYk-m%u1qF#7$R2#| zCl1( zAYS-l5CSA7X!K|kV*t?Xg)fIK3^IjH7fyVa7oZdp4VX%vJbpCD0&MF-ZCGYr9Zwi6 z?>EH`Ff;wAju>ozcpi7CIHnw{CeH7GKm!&T=7#6;h2ogYNFcaS0dI9cfP^iAG8tCP z^H3hh5G)T`awPgnA1msJeW`-bmz4*%VSnb~crSp6DU*4i8g5WU1Oyb-!=aT!LITr_ z6Vqwt0wsS8!diruyjH9{Bw9%7t(4$3s5u;8D~tvn>4(9ABtu<3G%HX8hK(Q?s-hPn z0EJ$n8fcWT6>xknTCk7kGY;pY!+gPqB!Vv*_5MFd7rOXQ1qmBMIRLbiq%-)-{$fZx zaX1h+7bBj_R@gWIiQzde!neSp^}~Yj!G3eViQ<2|3}ZpFwF^`LybOBFEO&#Y5K+Di z6K>TH0QUI*iG=Y*H-lgyF+r*a(~?Msioo_RMp6R8#mj|R)E%4`2nU~X9v~c= zc0ef{Km3n9_n$T7$2|}YFbU-!=mlMa@1SWM&}%Wt!h~M@dNX{*#>+$J6~7McAp!se zP3k|DX7m}mfn)^R1Ao5@2nm9LkqQT-(4as|yVCmq9l-d2U_kpw^}!~={iRjRkoS{h zfiOD2go^Zch;;LG5y?R<&iH?E)hbKrkXw4i&?2Ocs=yNC)JC3nivu7I&Ci0LTt zT-N!d0IvTX1jNvDgU!6KiTOXG4J(fci$$`6n!utk=tJ@WME^4$#D(~jyzqJd%)ZK* ztsqQjOT#O;+zKf@C}@)-)rf=v3dj!9pKy%}A{g2X!;JEi^rIC(T(DZhFv-R6B7iNN z+mSp>nh>%e^@*18F&_?8KTNb2z8JnDFh+_KFbRN-|ED}mKO-qnfjahHou&e(c4~d_P_1g{v?byjH;5&`!efia=-K3h*t^e4xR=OWcBmK)T8tTuWM$XqXt;U!JfyYY zGS@`F_BhN6t2ie5qi6w{K%xcwf*)i73<;fKBog|Uq2m~@2QByyUjI|^Es!`Q8c4ID zn!Gw-$%1_UE9-*k#EbarRh9WVarW}q1!aF)rjLoVns2gJy0V_8eRl97JD?*z=TUHG_{m-Y#k8c+lI;)JPG$FO^nvx1qe>Pj?nZ>gqt=rOgq-orAbDken>`0!ey zxOZ=)S*79Fe#Z!tv$8YvT6LnR$@X&=XuAHtg-eb=EOh{>96-zvI2HhfK(YX9&8ve< zlaKHNqM@9}T~h>W&6sR`GGu|kL0vvFOf-lf5`$03c;-Av7Q$o|u}4UfdGavOQ}9y0 z-cQ1eV5p11`zIvhD)KKMgOp$uxmb$Gs{%qiU}8MjCgCXo8H5*uK)LfC$pd2+gqg4P zJfIAMq<*N6bri$cLFHco4M{qfj(f?Fs7mUN#8`HE`8KYNM4~UJb5j7@GfA#iEilee=k4@ zL3Dw$kj20d!R~%STfTCzIR?QY*HWO5Zh$olc#5`XGauRV5Hm3}yS)1Kn5976 zySkIkz0_H)0?&*LIk)=Ipq2FSESCzleV1QH65-UDmRgUOH)x4#eY%8YK^<1?Ds8o} zEKt#0M%I0-)IMQy-?BzPTt@wDNXg>y`5vv3uyuD9|px!Rhch`IbGEREnuo$Sg{ z^5bmTM+sYf&8WP;FMOlbuU;V0gluqCixgO;eLSODM8iWza3b=5fCMz1F z1(=No8+{OMm})W!?sM%I7cGxzHxr{E5VUO(s3ji7@|I8Xd2kpoUmvxY^Vw;NVWP=v?ns?zuSa~?y z8Q4tNa4>9wm+)GBiBuD|MS!&->I#$>{=$Zb_aW;NFzhyfKUBmQ=)iTpk8T3wm_ifw z2>@_zqOgT7quKemB@w=0cCAQD9>!JR)~E955$@xEpRS;P5srW!hpmZF4znrIKQJz^ zhQM9*$+|=K8yXi*33;QMVRN>?I&p~*%xs6-E~L0Y>j47<1qXBdO`<2T4sgK_{de~3 z=cbm29Yba`3;lH>7VRta%nejUiJDtEd}LM%sZf2y#PGw!37(bmt?*2X%DB$EBSNgv zp13p?*+lz~!;@DF#OBB3`|NY8eVq*ZoYb1=cc(0i2AOj$J>M_wTTfs|{GK%I-z(Xxt>W)mS zPIb?kcFK@Z7SEX#rzPu;1>~BqgsKsw0(jH|0|!n8x2OL!C|0sapEi)py|d&eaxUCB z$2?q?ytrI-)}3w9DtNW_H%@1yQt#%S$Km@fHYsbmuebX$rk|Gw&CTbBT%<}a=yB>E zzDZf6v87v&7T9`)W}GnoJVLpZg;bO)j(nvCSH0q zoMPrL<1`m3qu>dZ*Sld#qckjE@}9h`OvoG&ifBnp+aLQ1K_ihCoApL>zb&+||g0 z!l)^tbRyugZ06c4VEG^qCgv%!W&(hK4+mqMh$4eTM{|vNcq6c8wBxuwO!$sm-Uxrt zMn+9>=?S(ufr*^vYsT0rzz>&UaO;89&KIqNJOYRq!-mO&x-pnniw_#)b?`jGZ65By zp5`)xFT|loh`;k7dX0hBCqEG{PdV&qpd?U8`e1}3hY-B!lZA)40aW0@Av5n2!c+h= zMw=C!vWT^C=`zAeKtqHnpt0c(6hJJP>5n*yUD*}AE2En!s-!4-BUuL_1e8_@^Am!Vu35z!P>=*a_ZlEJ=iDI98*3JDv=#!;_A&I8VvRZ#{6WR1m z(wz|{m&`7Mq_t{BihOAN*EyDgn`u*L@!*eu>rhU|P)}HBt6ywf1CTA(M-bBZB z+InqZIec6oxr~>KBCU1Kdp!$1WGOF`Xq5DI6UMTFb-Pi7yuKMzRf{GvW_?y&F|{Lm zW#@j{`K4O*Ad|+?4r)di#olwKSd!D8{!~W&?eH_-60gx{ z`MC{uURu(sjG8Q>wBIHr)&(mACiEnVu)RU!@<0ppR_GRb)|k*@hNZ6)=%N4A}Edtk=N_=lt9mD8Hr22;nj znr^bGL4lSMkKN3BsnusC2p|`r5gZ2AK+$>OX|Rq4F>fToWrTwt-8o-5 zK{OJ%iaZY$qqoAS(F7s>$HyN7O#u1;JY66IRYJ(EfUF3ZkG}`uz(o!Z02IJn@Sgt) z>kPz!aOeZTB^L{IknQkszOgoV@{sSM1-ap&@LcEBcTtp%MsU2}qsKDXOqdY;(_-=b zhpx=mg|$Bx&7Nm>9(_%5t#Wj!zmRNxri^;kEFjQu<4pA^>(-JFg`gQ(CM}grR}9kd zq510Cl`Z-&4Zr@HJvw{oVfaLxiTd$@)H?+h)0EP=05jU)^rh}C`+k>f{hN(D0wwOw zt#?lAj$W&XP3v&ES*0GjT2RtH-0t^G<^Aw-*e=Cn)osyZxfMw-jgx9mktF)QQoQwY zRYuP`w<1=;diRqxlS_>os%H&n7G&A)0_t53D9_LCXqZ~o=RBD>8Z^K5d1r{BNzwE; zD@1OE5-D!?o0sh^&N<4EF01JziB2>*7BzG=L~pF2DQ(Tm+}0Z+Bx6R{lpX&-(CF(UQ(@W`{hYnM23542u zC)%mA)HiC|!=eShMLqc+76Owz@Vjdpy+&=Vow4MnCLVrP-Hxrl`F+5Jil7UH8ZswH z(n3T=7_%tMs%K}w&Ki|=5ug3W;}w;zDH2he~7RT|~8q9&5TI7?qO zWaBxvpPwJJmVKR1s`7k9R&;s!_L^a&;J)SJ0c|5Qi3WRR>nd9xD#3-~>|;MLr71LE z64IZr{xe&g0#2A3Wsh00NFQru$EeP`Yv0^u)wb2HXLc73oH{f3w0(lvYoLV{WnxuyV!oqBfmeFVUNiAS^B1ifh&{DhR#O9O1O{=G6*$vCquA5- z7pGWOjyn%&I?v17W+rEwWvwP3O>tve45j}TSZy_tSv0j0`c>h#anb)Yw-`Pl8nw$4 zJd%Keh%%t~1hTcbaR|Ty#4 zFglp|_HQ0ZF^GmZ;7c&1K+U1N07;8&`j+I}-70?BtzCK_ zar2zz@GRqMGn2Lf#Uaf@O);qlRwk!Yf0o>klIt1gY_7+wPYiS{#$FB(CO(xd${D$3 zbg}*-v3DdSW7XW|sks5=fU>)%`G;)6@{Q}g{&pl@ll{SOT>5f%6rLTW1qE)_>-75D zJW=vXjVur{>S60{U3m0>Ye5gF=v-6|&fNrJ*NKFG5;zX>|P!`G@Ks1N~iT z<7>l_&JDhuop%>Tv*bRf zb3>EuA!8wj7hMe>wp%=Lym-@*B>VhGvX83#qzW~NC|WPFS@*#zLuE8;`pQc9*|`jv zqltxA=!S-bnq`*1@>v}c1oJ;>CqQ4!(F74O@L(1onu-~($oC8?p&8bk_ZvBY-aH&& z0xS>W+TfZ72u6IH*MSeNGoz6Y8&iOg^8to6iVr{?6lViX02N49ykJlxevMK(5U5~5 zR&HCLA&)+K>&Mq~V;m$MP$U0LVlfLJ*d(S;A>y9bDveS-KyQbI8to6*`-0i4SSdNZ zlXlN$%=UF*%$(uSm+90)LrdqWi!+9XeP$z5)xiy!o@o@#86YKBO;hkf5=H@;Rdiv0 zd%lC;j8-+Nn++|8JsH^JMJ6A3>0+jM5`iBp8ss17D?cz;CK)LxL}hh{bZtlQxt=Ze zZ_ABOJnyrZEf>#f4d@uE5EE#KG9gRWmX*fm`=@o|By1$YI$?BNtob@-_#;0ZGW=oI@x>yn%LWjm&C~9B+l(8mv=%hxTTzV9 zFBO*LpTkAH;d|(!KFQF_kfs)X9rMtIRj_JX(7AWo$F(wTL_#&@eDo^I&SE~E;-B_( zJ2mUq7nAXcu?ug-Z_2ifrj^R3{KFRsNrc{BN15?foQmTM9qJeUQc_=K55yV5q z*RgjX4h0K|oFdR=e#{M^h=q$TSH_vvZ|lUYg* zQZA$Q9-OVcM(T9?hh`p{mn3WT=bspmBUZFGoAT2rC&@Qj+T$LY#U>F0ZfZ>aI;c_h zrslnM=!cu{QmLs4M;qd4)z2duqta?GkC@L|e(`io;}2Du6e}dEdNgh{4dOemb^@lmx=0W zD%U3+JUwy0K0R()Q}RJC)l!>iDv@cI8u9an#zd~{-D~Fp4<03=NlvL#-CoHsmL4LVMojNh4d^KXEoSmqu1@5@{B$iQ%@V>;l88 z!&8j!jb*QzhkTdKmn5x5c}Zm zGL$;{o_{?y9eeJf+d|rpvgt{T)%nnse#w0&PLHPX3gK3bgzz5duzAVGw*94n;xH} z@T}c!6kn0zSDR0|q!BDEYQHfq zo6lBgdtb}K)4XoiO8d)a=U+w`)82)rZs{fA$G z=d$%9u8ROFFl#V8LC}n0_P>#I#0B6fB)tGY&<1>i4=9d{whdV9|H9ExssNtL9dS;8 z@))xhJO&mZGYnsqxE#Do;Bowm#VWA4h`%yRGzS)ndRH}jQ)%M|GY7@8P>aZ9r3y=`S}ZXPGR z3)^x^Ci+YgSnE@@%w9Zwq~jMovmFW9S`qKGY!#GH|uhi4#=tOIHs_XTD& z!W*DEcF_SQ3u5tkTvX&r6)r4XRiB+iOE!K){=KE`a%-rOpT3`H@7s_|(z~;c;Po^M zn!?A7)ax8i{BC;F+eL7j@$MWWp{gN*55LSE_h$WxYU8M5R`S6<>I{$RSpB&M>EGOk!tggjD_ki>029&a__Fd`W#?1Ir|uY)BwL zvClPDpaV%ZWUYJUW}BiJJNUys($`}Ej={yw)AsMWFTLIzTxz@9nbxUx+D|0o;%aB9 zf2{3eu^!^YtwyWqfwg1A6Mxkk*WG9|`SEHy>&oj{`O=)(-`YIQd%FU+T*udxiOR+S zH8y&}wlhLm>(ZX-;oehU7y8s{OMPeiFpOy8GPkbfl{3Uo3-R@)$&$)`3?yWeiTSzm zMY-mR`pyASJq&vTOT`cy>wP_pCkBO{j|#WzX%-dM3;5X1N*K?jp6-qh`NJ_sXyOan z=Xw#G!g}$ZDq6wi{2S^%A>#ErdipB5sz}WbJ&H|kn75lR8IGl%^}99eQ%HNjX{d{2 zyB?77oN!prx!NFaARW3A`&-*wM4ergu^&^V^?^%@IhCg3!}Obqo!eu%m+7b8E)rVz zVXwYwC%KUnarfEk`m8q8KiBly>6>va8cuhU68t@8#-5Cu3^k2|+#2&#ivkH%m5=OxtWAWU|5! zQ(e_^QcqLU^Zm1vB?M&*II^!4vo-5U`R9$oyzSoq)v`4E`^8bS(*sFk;>V`jtDmf@ zd6cvLJrnPYzY^0=40JXABaIU?UA|}9{l$<(^1u#i9L-kk{6nHkpvTCIK))G|gs26d zKg}!9MEAo9p-z$v3j$+`)+>|^K$Zh$O|8uq@)loJr$8b3(Ml_G70O&20ew50H z&qE2d3J9i@e?^=ZllFi3nUu*+|H+wxQCYF(zdKV@M35&2a>pQ|Bc|(0@6z90ziCEz z%rtzc7Mo(6&|o=ycKY;0ZpC`5|E+*~`fpw}9-1}2f@1rMx0l<8`-;-P>m8ex+#jQr zaWAMdghl8TD=`v(PGTL-r@A`bF77G*8}tpb$sG`lM!6=q&-f~JFfNYL4q*%PRU+aE z#vcz-DWC|@UWI}sTZ^#ZAt)UMitqwpI+CphZXOkxuFhJa8z)^3CF2Emu+te@86@?H zrGvBz19FJhtGO-vf$cvRZWlF`s2Y%W6)Wvt^ryb)Wty4DIQh7#=fRu6g_h{XipJp- zyebO#D#*|-ga<_WJ#lU=#o*XRNoIW2;9Vx^IC|zEODy#I+S5K)Ja5Z;Ga@IS>Jr}> ze6F_fl09FRdFa@iwNhDg^ZDsc=G<0!!$$l5glg1hAEM!q;YaX*s$D z)+)r*crjNMuv3Qt;90+}nliWuds=qrt>h;yX!F>e;!iVP|J(mORy?SIxN2Z<%zxBVC()U+LDp z$i2e3p2xFDnO`}*{jIh>{#Bj9@qrANpB7sEm-lT@8GqT>2>qK1Nm{VT$kg0b>={~@ z|7t;^3NHl1Tm)RD+z2Q)ii%(x$LoM1Hb4xJ#KJ!)&j+6epOCwdo7x6cxDZLP{fk0|Bnq(A|{U#c*Y7_@S0c8crg>A*v=kwjE>O|eps+Dky z8tDtlW0bm~9dv)6ZnpWXVw1f~0*gqR{RQ6?<+c!d%RPY_NA*wK=xUsj8}LcH8f9#A za-$|A!2jW7rumGxbDfv6nulYC)Yq}`ca(b6zUYdK6k55+DNz+UwVPc1PCM1SlwKN; zT}6X!3L`S4i%tcP;0?_WFP%;Tnlp1I`vcLZ*#&WqIxFbE-!ewIaBCR#N7N$6}I=`$oo0L?$@T zUj2~Q?XnhbV)1;I>sg+Sc{2l{8Cc9vvRlm#=gu94qKl6+nS!*Twjo#@Jf)Dy+H91+l=X> z>n5byxuv7}8j6KZYwacsLxKd_`f#>bjfU|-Aqz=h>ShA$ z{CjM*r~85}Tk|6%e*A7Oqg=Swn;^UridXlJRinD6R?g5u69QhHyKh&uA4ESiqcfM$sT4*TaQ=@#BXZM zjG1|aDeId_?4Bkno_p%Cu1d1}>8m48&_0E*!fA0Mt)fnquBUSh+jqyFhHbvf+|y$m z;xpi(m>Pe3?fCQA6#GuX{WDcVF_amt__!A{w~W6{tU1GSFVXDiohTX`ue;7HUbzx>8f0^i;9k&`8=C^opbStb)NVKbs=NK?JNTfhP zN~e2}z>1)37uH;JZ{;|b?Dv?QCk<53h#u2F#H0<$j-AYKO9;_D zU8UExHue-RnHIXv@idRT8F5~5SAs0f$*{3vVSZq+fD&;>xY(j;jIQywx{81+jI{M1 zZ7u#7qnj4*E4&t0HjF#zYU>AS_GTdq~{zT-sUrF!P67 zl5!KDdoWn|krNk$bEcAaP-X%b)5DLA*5Y3fb3KQivQm%xQv9dIFO1o2&$uv}W%p>T zgw^i*aPD2`HQBU2@Y5Arlp1>1szcZ=S!9qs%`2}WbzVu(+ks96Q zhR)RBzHkFqnht0YbbphiF6?`5tyFkSv7;Q#T7o50}B7(E7Umg$> zz=7bZeK$B;Jm0-VKVlxBYgj&#MeBkE-{RajZr4rM;$SQMy3QP!gV@v@4Dv-WI z?kxu}fE|Dhz)ZD6nq@OMwjQC3Sr{7%)FEpQ(zT%rCvA1%Gd z$X9TCuadK996k7IfSB2>fSV!T<6tWOONDE-gPRHL?BqfW(QHa= zGmXnvXWS4!$@#@hv@1z^#)8A13K*%{=XjKIGHxzZ%+hG!=T(yTB@LC6pxDTAVDleND@nWea>65b^x5)Zb9N0A>J$nNXTIuzul^ z^?Q#fN_OVB* z@I=L%?dR^zWowGu-^WPVy2DW_jiK?XGe^~4EroBYrBm!jm&P8N<&vK++g!bYH+L0o zl5joe@qX%kM1(shDQ&YgQ+HwCdD94%<^9P;y!ukC5wW#ZIAG@wo^2=kCj0a_o#jz- z_R0q|NEJ(grDgh3%-YIQ3E|~b>joFEKIyxiq}!d2ZmIPdOV5vXJzNp7wNtwbBYxnQ zwgZ17#czb5zzMx%WaSRm&Xqq?zLl9N|E8+FU@kD>d2nN@LiJb{XJ{r=WXZOaIjZHh zzDY1_mvLGN*^*6|RvQyIV7w#IB-PNQmXTsj?yMzKl_4mgusF1CozR#-(F|^VK&K8# z1r88i&8p1DQnQHET86?#GA*PaUvtd3#6Cx2kwyFY?K``hguiXxTDPFTrp7Jy+Iy3& zY7J5pEve%B=5G?ORvW*cuuq%uB3Evt5$xzcdfOilT3HVE(%zkT>W1N&U#WCWS0{Nn z{mqP*8bxar$!*PZ^$PZe-qV_s#IXt&b)vDU#0fL2$5Z zRZ4^hCk6Q1Qx(khCw!eFtmG{lWFw>|UzJWDYnUM_axPX2E1u9( zxm)O@!%s=41>(I9JbAW23sRgoMivc@dJvI#CnJ#gCbYHljr?Nd6-r=aC%X9CKtZBb zfXopK*}_YP;YW6v8++t0j!h^^{Q7#4L#t`((w->$LebgW%wjmAORQsdfD>EU>aH1j zO}eB}#;HDT;;3KQcAt`r>}hF@oc(8QTYa*#WV{GX`>ovRm31%rBwmeAdc3M;jYVkQ zdj7)M+*QKYERj7-^QL!ELkNt$ZGKtC7ax;UHRLUQf;7C}6Rg5I?{?by%!c=<7RVN; zg&PJ(XJ~mwkYY_9$H&$T%4Sp>7lr#(iF)0_bFgy@a31+vY(+6!2-G!p@D%>#bpZVW zE_?*l0KMSc<7P-8ZG@b+I6*}Nx6X>Hn_h8GPlcRI)^kf|_99R{rKCyB6mmSALHauO zSgKNx{u4|4Zyz{t9+-9H6JEc(ezB+3ldt?U9XMkE!h~fhxj*zx_g=NTogr%`=N|E}E3D3z52V<~&!zI#I4Z2hB^lXdhlu}_b$mv%{>bBu zDqCaUJ)ff?@Dw{>ECf^u=I_LzxCXCVzGqgxVrp&6+<}epT-}I=mi`%1Hcw1_e2h&+ z`^<(ftnr7auv73)PegdI)!ase47IfMv+@T!FS*Z;59Rm{*=~s#W%K%6JEp#_)fFlx zw@lH@`E?_Q{zGz#Ha#>1A2j}&n!Z+@)i%1(RoxTF8UR1lt4^uK0>+b&+RPl`@!{mV z)0Y}9Io_o$7Bq<~nFZv_)Z1yeb>&f-j5!_khV$~fmsA6dXqg;vW3}9;RcPzk$A>Ry zd_PmdHYxP%YhBo%YeFIP^rpM2#?@8^aK^$HjjxsQ&*=B!Ya|tGrz#+9+LpCdACV)k zc$)R2S7;TxfnI-L2R_}H$TYs!o_w|0@=C6lir-x5-0=E8_ZBMtbB(U zvl$j0Y+!H_v{a&{hdV%}P*U4A$aZfYLT&)K4{2omSU#@TnZqav8JNp~lP~>u6gMC)X-k9<+@o zUQb;r-^~9&^(4Q-X+XRGmGVi@`N5f?3`RfZz~$;^AQ}!R-w6cMuT{8uOARij~+ z5jXvGdY3v8;1dv!QtsCDa}y2X1Dx%IS=yW+2TD<_W{rD;*wZ|=$uXzpAch=mz*A$% zJ1HZaR8^EAW#uwxZZ~G4XNMnqvUrcZSKqHjt$x1r;Hil;>n&%{;q7`HYPpS!_W`wF zLT^g{p687oDwgx9Rt!g)a0m5dntxixk>&iEMm_b=?5Eok3-=$O%7E$V;a9Jn=;Ul0 zY+|V4A}(wp28QSNiy4|$MfabNuX;>xC@u$5>S&%FAv^7gdb4v>iyn*ZXp|maEt(ep zps;?e-_icQc;3?UjhPNwVnjNzX=gQg!txjP#k$c~4Q}bzTm!~0R8vUKodFBi0@~W< zXSy`qR|{xA1`Jy2j*XZ*6Cw`$PE9S;@A+f*(njEV=6#5hIlZ21Gqs=3k5rh8IeWEo z#^SU1k&`R$?@miBX5Ns%KNYx~7QpyzecOP&Oc?!It#4%DW~1h4o6968qd{tN{`{`Y z%KD2+`XlKPIsye?il#@2ez7eh}R6H3u?T^?N&k^9`2zgFISH8)^HKGW7#e!A97;%%t)DP7jj zuY=jlkPm{=>+@divPGRzcb>WP6ZH2xg|aV_C)0z9U9=mWW^FeNbXBOFLUVPSR$GQT zyJFVeTT|`+KJv}**}3prEZre>{gIqlCzi%%$7k#&ssjylBjru^TAuJG+O+=dS%1A? zN=jEnReo-cU5x8tYUP-G6(#WLl{dHE=cG@sY0TFO?$YZf_72@>Da5ZmUsxqMdG%4E zVoSGe&zf1A%m12kSd~|-4K|$$m`tA7p>Qna0jNCE|42L$6kv{E1=#D#dH?uni%*9l zdHGs(FdG0TIiNRp{^1+;V&RZnT*e($c{3ky0{qNcC&_RF5%MSyvFS}q{4gd-q?vlC zD=|$ab_7$#zki#$O0;8FigjewbUke6oK=X}U_Vg(AV5!g95f9M1~vVaJ1IkZZe6UN z7=pA2@!~zBBfiWW!ohQ_=M~k@3lY_d<+b%F^@tR=3YYUDU;4(P#Au{5Ej_2O=E3|7 zafz;#b9d}`f(y}qY2QZIfL50FHG14@_ne9T#bNLLzJm4HjjmpeciNgx90~n{sU?5k z)qbV8Ory7Kv>+;AOnbKS*S)vDoU)K!vUxACGjwM#tafi`Vy$pRo4x$ii21m+ z7Ai<==~#yIwcU&p9=VmV2RLJ<1M|0BcV1PM349|Ny1rUi;+MlQcW*G;urG4CIO#IG z{gu}H@t|SK%Qx|BXA;Oqd>Cwlh@6b)jDg)UvPDZ;n)UnGSbU>}L5p&>`xAF&60i8> zg5JBED?x_(aSfzPt_Mh-tsx--QoQ;yopCvg$LV+G3dFUyuJINM1|_gN$ThRtMNcQ! z_ZPEW{HfA1C5oa1bG!VP9rog)_F@6~{u_klohAbz&VBnr*CGYz{4QZ9XENlyN0(XZ z)lXho8#hWXRXhlZ6lneFvAN@>SB@}){&Ll>mF-)*tKF>=AF)AXYA=;GBsLSTWKqf4 z!YujmOfHoX?(c{heMt1R7!IT`N`LJSaAnrkY|;*yS$wQ#43;GfKk& ze}x!734ZPb{1o7z2ZsT&&ml$&xrEqRQ)pcQf`C@am-&<+!T$?}%LxPNl8R$IgB8Qu zADD<_KVJ0@?izGl^Y<9ry^yxJXG-Sigyx-(1jTa?C?52CD(E;gluynBtzv;|wEdbY z28Q%Nm#bNpWQ)$ovPiqYDfh9;G^eg##zr*?JT9imUaUybPUnP%PN*7{+zcIPFW`hP zMy1g9R;rk_QX*_c4EI_Ub*8PY34K9nZ=xAX?YB4_P#UnIt}v?6Xpk(f*83=;STZ)B zIRaRX$ctgNy0CzqVZ9hZ~?A8uVxo^pe{ z&fGJ14V@Z7=4)Scx8DJZqfSoIm&KTH?UI<*; zUqgJ}XTQAeam&Qqda3=FAs6W8MVP#M0KXw?sc&<-}qnh{2^?UV1G~;xlMb&U(`5tZXjVq zQ+BGo!W3^Yq)}qq+8ekKdp@lrsqeQyBQ-`vWvNz#o&Se~ViPcJ&A{h5;POG0WHBkA zAhL+E$`A>{owVj=Ct)n0h3piKj!J=xDS8*60iFLlUNu+2aBYc`qw z01K!q|32Wa=%+p&;B!GyaKK+cdqRaW5u|HqT>Q>WoSqmJiy-^IQh>*BJ$gLk7!|Y& zQNaA4&b0mo&eLPRvx8+Uiw9E;( zuzxA&teAB%yJC&-hoIHc(-F(7gouWT2+{myhxd0!AhP^Wmq?Un4_AjPuC}i2@Ic;- z?Q{?MMe5-QlB#}1LYZJqeA;4!rdW^vHQB>u=3A-z9fKR$4zz3M)EPY!ye_lDGb8F+ z*6Y^e%hbEeH%AAlG7##hIvS<~DM z_VMgfF4|peX>--Aw&3@Y13#0ks*T@LBh|HN)?z&+PudGT+sn>-n>DDfX?fPO50VTn zy-S>nadV_izlaz;nxLZVJW^g-m#>)Ksj;C^@`2P45Ny6-z*s2zfx0nDaji}c-mlL` zA5+)VKW4QwGGam|*fdNgi&IJ+HwUMNikX zGT$U{(-MC9EpS4FaATVIKs&^WNun{0gZi8TPg6^evIQ*4H&67Y*ht!^3=m0|tbtNIpU`jHwnB?*oGw9kS%cj6rt6 zJBfrHoiAwRe#9+mh@S}vv!#oNOU2r*Q!`wO0vO?$=Ckqyp}bAYV9ld%XU8}5eI~A& zDihUp33~?iw7#%yu$!++aZQGds#B>~JqIisCSR@Pq-FhZ)wq)oFuLBWJke)P7`}8s zzrN;`H_^YQcSG=$!CXQ`W{6q)_>7R^31{MfuB*oFDO25XFl%!J1AbwsH&Tc zCSe}^-6!)21o;qaZ(Z-u6C@8BQR8+yNzf>+GcGRnn6&@ciSt(ncN||VWae6iQye8d z+)7`}51nvZtq{|nJlIK9oNBW3-Fs)*F{Ib@fr^%ldPB=%?N5t^&6}I+x1=5wg2lW4 z-pp9GdaxFcux%GxUyQAp>i@w~t0;Y~;Hw^amgr|iwaPy6%eEIhb1QNX>`5qkDm-!M&KE~>jGqVZGV83mBhSr=d?(gn9v1j;!ze zj){}YGH-c3CvKV819)JY42Z@;R30emu3rCuh_n z!&PnacfT#^V(E#s)y>8|=O&EIheVm}jjXMRQ~OpX87o1;Im3ae*#&DQR)kE>)H3Ak zMeGzV&E>tvu>ZBc;zwqIv#rLF*{KTi=cE+FS;^X?C*+igJ|)(79)Ao9KCr7gSWv{& zpGaoOS6yvk{{rV3M+m#yn|iiB#^BLEAl?mxfCRq;8RGo0r zm{gUpkPpb75Nc^r?q=E@knGZR>;18v))7B);Ji@s6;q?M^jmHdLTcB<7&o_OR%EGJ zaRf6O7ed4?m4y z%u)GdJ@p>DE3;6ZS#WGq^KXlLF1Xd!r(HWu4;*NHGEbbOGJaR&_|+;FNe6e;%^2Cr z(Az=`Z0JpC8ydeE8%J0z+-l4y9G#F3I$~N`SpCprT{%oR)qE+I+UB(O3m@vO)6{6T3&^7o6@24~<0e*4$9V{F+bZJMpFj#vhwiOa~BXVz>-N!dE<+ zwq2drkRN{Jh1}-s3j*g6E9~`Cs>5ttJ&=j+Xh&~lWQ6V zr+W`F3%s@KWDDdj(nRWL{cNgz`CkYQkP!~ln-X+E9rp^dP>f>hISo!ms*uhw#o8W zp}J%zS6aPT$04o{rtP=rmzt1?i+-if0S^82e`Ia_5a>gO2X=x$2^b&f38Kl-0z0oC z=&_};kO%K)q<*BggK{MO)HgA|8yL>hO`-^~d-Q#*5)<4zO5#G*ZBktKTaYDx)ru_V zYx)+)5A+XGJo9Ouf9+UknfAS~Y*t|2rq1+hXkKkTw;2sB{1*z?PhhbCJrd!)K#uuz zSP%tfv1ltFT>VJffJSLu71^2kKEWkYP-C#zzU-22aHlL?Pt&>Vd%_2?T-%k>v^7Jz zlv!cldgRghtF{KVUYfh+1J~f#-t#hZAG3O@Ytt9^eL^bcMmP3XM|~)(=&L#!sw&sR zNYQ<`zGzF_>viilV16*HfA*;TUk@Vgx{-%!@LEy0N#{CJ2@(a9-Fhg?`p=z zxwY-#i}pWN$3bF9C=(7mb%om7hHKaxv;aiW_gjO;o2mj!~y@7TEt+X+A1Mf zinvhlD2>KGVHaUAUNK{ap9`_EBxYMp?|Grwb)6v_}xN! zpI%)-plSleL;%rhSOBs?q23^oFqc=9wpsYfIzC-EZ*^RKhz-GlGR;7{LKF z=3-jUG2iVo#*;!dc0V30-upb*?D+uuK4ZRJqZHEV%Wo|$j7eDyslrM^^gIuxOhCK{ z>;cdd=qKj>{$ojqD`D&is5$(6AQ_zx_!54R3uEk`j?=(-(!XIYSHZ}|hC+iBlXm6Oisf&COP24gRm|Eck$vW~#7RNB#C_olue7pUZj|kxG42(jPxEur zsk9EYYfa8kGDsG8zugouvZXR=Ws(m_c`=y#4QyJ&@U@9cDSGtOooQWxUPJP=u`J6I z%Z09@BZ4H7#igx=rc}oMo`+i1Bp+gx+0bZzaLJnM*a_LmeODuj;?~rY&0mMq96rSK zv9uUT(Qj4#+-f1vm#R5VboVsfxY+&dYEUmHEIqyPM2uV*Yr#&#nEiw6uHL;pL*j+a zuVriZuEgb@VK(HK*giE3SJ6s1VP?;XUwhD<|1Fgo(oG;N*-*+3qm!6+as8>s*Zd1; z<4cEK(t->2`{z6jdMtf%k30y$lP;Cfc4YB9>*G!tCri}=CrUThYUEK#i7+ph1U!t z#`bE3Tuk?bWH2*PhRTh8yd{=(B^g^&6@CKFE%fdiNt}!bk*(FpmZrL-LuRBz*};ON zK&Vmz&y_qcPr2ZlYz}ENqT0V?u8l8O@yFBnwWzK~gN-Eaz*9C<&b0uVN(LppSLM4* zpApK7;0bnHTnAJF--X(4%Y%zO;cA%t+-evcwy7Hi+aHqAZdIP>NpiSaQkFBu2cmmzL ze?4?babJyZju3r8=3Bdmi-qiinr-%yGaZ{j9qEg1!wdRiGk#g~v94K$XSAe`3`Pks z?El2s=6oJCxcFgr*hoxQ$*%EF$L|mZb!#95|jA4y)A{ zWHdqo+jSc+Iz2S>^nYHV7*9*F{9tF|nZIT*GM@D4?F?sW{N+p8r1*%AfhVuk&xgL( zj%s0UWa;WD{En~Nx_BeoW=rbMP({Y+Vv7&sQUNhbBMdESq54hbnqo79KwJ>Sp&W4M zyvH*GvK4PukbhcPi^{&5BiEA*84_V{y7{^6tN!Zn+$TykUEycBKWTZNW8hu3mZY{O zkHv0(T8Qr2xks#e`-@F-Ht-uPq^ED{>ceFz_LskNi+}Lu$x`7Ee}+r;MH`0E9IMRp zpYOK9Z$1*CR4?&&o^k1^3?c}R3w}X3^Gch2s zdofhvi1CTw4mh#fD0e6?f0pd)^lEO6AQ5Pk-Wd>oO}A2-s+p8x>bX~xSrmLc_)4Kr zP42!jGuHEaL7~2~Dt_eh-^;^Wh>TPzHRRIk6_?PL=}5~d&6%0eiyV^o|3loId66?+ z^OP05;!9DSA71rfkHIl>(e5V;#@bJodL=Fff6cB}W6%4K_3s0tl2ECa5#K(NBwrzJ zAH4tc_R%t&GZm~qS{G>G`D9vYCS-$q!0a+f(Bg2I64T#kj%?ndFF-9kyO@@!XB9s~RPUN_ zi{yXQIn(n&==ZK%{W-S>Z`j^6w!r@(?M>jCy85+ItgY5MP()Nfu$8xww;P`#_x~xw8FT@>Zw4fPE_F!fsF4F_b+|7G_}f)zoA-ul?tu z9I;k`FB!j5BcsKR_3ar?QBOJRci$v}u$uGb2Tib~eZE{a`Guc|L5 zkQk539qW@>=}rRS>V|TiBg|9(U0WT+^|Yj@99b}2bCq^W9j+|CMsr+j>$i=$sOc-L zZKSGaT<#hmW{soko!<18Z|SyG4Xy+^r|`1vWR-B&2wh&R36JW#UHYK)rHTo=JF1G{ zrwDM4wS1zipw_4$L5a5cOMd7ik_{IQ$4R?*>$y=(>IUH4Tk&nY)YN%Fp`&e>4t-Ea zmnSr@E{m!k{ELw$oDi^0q9WW>iUOY7W+)n}r*V4R$j@eq!lJGl0-*-9M1e+7$e{E; z-1&E0ilEU3n(e@N`&%_H6`;@#EoPw0;qOk;OP@gf|Fe_y6Un=yK!Hf!9Xa66i95{O zL8+T^Hi~F;R~0$fd8d)~8;(b|osA1xzm8FM?99j!ZV4Ar!?jUnJXEA038Q5QvFG+| zhBj`%uus{itS_EWLj2JuA$u{Px1JIqGora4--#(3up|wyYj_iXO4ThMS_$?uVl+}I z19MTrm$I<@Qsj}jd$&QwMgijW0W%`C+XGS@-`;72`EL}*U@x-MO%C0JfW`SFMF4l- z0bmed0d{CWr^(^C62#|LJ0E>>L-Q|$+M$%?SZZej;EG{Awm#q7@Mm${qOL`-nuTxO z3rht`%!k*j&P!|QnUpU;ua!@DtVkL`^;m(?=VQDb)7p^nsWWSq*7eWyPdaFaf#o3l zN`_1#O~z5ZgyR~l8>vbkpYd4g8B7(s{yOJG{jlPfIys<&xl7qUj;bxU$7thKpA0vd z7xyvZ1#flaoH7)ejsgPYk7Ii+j%pWa&q~4$_3(~7yE$YY>Eq5hsNA4PIo&*$p+GMa zEn23$>C-Y2pB`0|MTLA-bB7sLbEq}x&4Z=);@~d<-+1e)cT94u_F6n)C=Yk@?L431 z(#3kRAR2LS%UAvm)s36-`c>82J=vE`%*_1lfYa;G^bF?47p|`O7i>ytd#VKpoq7$Y zSH{!?=Y8(+9Tw-fXGV>boPzGx_1$4O2GlJch&ZSEd-?te4o9|DdG!m*>6Snm=+PPm z4k8oGyY%!S<3_|`g0+{c&ph^ATs%#>HUn&NjTC=O}WVlt%PR-!~%1NnZ6o9b$T*wFC*4Cc5$D`pORe} z2|tweIxC=!QEP}Mo80MwKhV;0pw_ak2z|Tt^%|}6{iX|Yx0N5Gd2UDgz&-`Ims%U;v)OOY zw6amb(*?hKyy2+&35=Aiqn$)b4u>%d(*+61K)_j4%#rea2*D|-dyq{hR9?|Yk-Js^ zc2LYE1?^IIQP1+G(V=7e5J$BsP2{WE5Nc#+r?RH$4;F_n3XC2p zx&uXu>y0*iL zdZt!B#2W1MWT7vE%|GZ*g7^!t$v1eK>(`1pf_xS?Hvs!>b?s2<5|tSdt+OqTuc=$= z_iaWVLDrkh4OQ5l4Qs>91>_Nml$~ea+-H{da|7w30>ps1aBD7s%}Q%Xquw0dz|F9D zLy|eBxPU#}^xzff+IzfZ@}1(g&r~$t>e$;JA4TyEkICiR(ZW#cy%!KoWM|v z&J-y(RJhd~LqjsZKujt@Kf_{rF~O;PCIjnpu_!TJ(WiILuz{}Q=QlNzZq7*@ksVlw zY`H!*X*hoE81|`Cqpl%Rfic^?pkrYYY!UWM&(>wY(|6J$_~@DBNaIeN@0y9_Y2HQu zd3P?)ti^gcDQ31x;VPSQkNx}mo7X`p4(Rsfb#{LPoEmmS^YLKc50$}FA?gf33pP{< zhv;Ho@Qp!MJ3wv!9I}_V!46_Re(Jv8fvXycBW5iU zJYD<4j$%(<1IWR5gotPh$Wk3Z6!891y?~ng2Y~s}7th5y{m3DTw0N4Gci8-tRLNSK zRWbA2a6YVq9GZ=Ew}pSu)sL9Vse9urZK}{mE)3(_xjFb;sf7_f4*8=31PhAxWXidb<&=+@n+N<2(~_Ve$)JN`?Y#6b@ggN(D{WYV0%u zRx$n!YBVMfG`CH)cGXw~yliz(9%=-`o(UVQ|d^zw{XT&bIR4LVV3N3%B3j(j2CV0^5=b z^H&2J1dF4rim@nDS4WdRW}7>q;Tpm%Q`$qJ#+C?wJxOxB$$#b@YoP!ATvfpfenZRb zW`(XBkRZ-K=zr;W>lN9jfBtAVs==is1JS23hdLg$O#Ze4ok|W_u1v;8ek)nRH}FG2 zpBOF$Q~Z)&rS6wNYYjMptQ_(Ib~2I*r@>_yF|5$>duAtQBjA37iHeL#dT6>bU+8zx zbVKji`U2MfH1)%zd^d7<<*A`+BQz@%=Jh{y`s$aEY@= z)oIxVoQ=cAi;s6?7y$C#sQ&HxLBQQY{OyIEfQGjw{H<3|(93hs?fLCPuxo~#F931? z{{ue&iQLr2r_)y3s4{NhJVe;j#O`L2jt%zv7`OZE?Rt~E$b%JZa@Iqg~5;x{?v$2h-Rvkhk5cf@^L* zgg||4&!M4md}ko(_-fsTC~{~rg&;Mw2ZR`NaEny@@B6!aT93h704MBkpnl~YWbi4n zVW&k0y6b!|U4rZroWaY-f%0_+{abzNEs%mdW7xNMJQ$>a4-=%i1-I(ouKLhH4hWvN}A_jWWJu={oR?mI2kUYebVr*=A_l#W&GM-D5o1#zl`T2`g0g>uw2 z7;NVGd!wUPesNN$$PV=bhSTLVO*LwT{N}&_{24SzAMNSA;HYvsKKK91- zr#f%P)nj4&^WR|S)yOLQ#`v|*lw<}M4Up3LHoBtn)Xw(Sale-qkj$WyKEBo+RhBu% z2kL_a>_l~)Sq2M3DjtG2IU=9Ms+;UT}_$)O5V0q^QrxmPR z$*Gcpeo2Du-9eU~Pqy`>Msj8JqDKjnu4`3)5eVHw?AqzDjpi4;dVeit4IEgr259z; za!5C7%}fsJje=&W@=kqP4YR{Va<4pIJ0V=2pHI(~q_^0dznN-}qL!5-HU?ofHibv0 z20>xYB!McQ&vUB>rU4>9>eyU6_5ucyf5_^ce`z39^#qzHdl*2Ho#7;XUYewNO(btA-@g%cbC-=`0AZVS1E%AM zP1a}Weri?GXTI<~&8VFk80D?8o&as2Hd*_ws@G(>49Z3KvdnKOjG`_d`$_2^Gx%YV zt&GZxYg}gDDN#L*XsiE&#J4%BdY&ebz8pF+RDePfIuuF^W-()l$`<>-aL_CzMOrU8 z?6nl65c5^YZduX^6zLQANNulU<>m?`zkAJWtR=Hk_|cH{!QpS%`VwYUiNj?2v$2Kol)XUv}zHZ8AGfSQsJ? z&sPdfeoZQm8@EQ6ypF=sC^3N)dWmQ;Tx2ic-kYI*+{!Cb3s#^?)jfKF~9QtW-H#Fm>{wzX5-45qP~G_kC@uyI=JN+{nONbSw{oe?k=o+;?mU8=rZGi zplhC^JGFeuz^zXniNJxpvpBBbGkINgp697lh$OLFv5%>jm%M+NhudLqE!iSE=mWH^+Y} z!WS_)p4wEx>RSB={|C9xxk4F)X3waM*8YdFu^l`uQerj8EhxWooUdY&GU9r~pO zeWpm|BEvmKgek=J$iQuC$9rr(6_%7hUm;JbPbM31{L2{2Zi}OPEyoGqI{V2Gl;KVE)(U)S$AOq zFvtUz4Bq;1TI z2v}D+e*s+1HeBCg;>5<`vWl?{W&J)S&XH}N`%^dC9jvlXZ&&o{P<=#D;)p#L95z=) zc)?zj<%`}pYA#Y^3)(VlV6JmQ_yRBZduI~KWT1PJACxasc`A49if1db_Ugs=;WI^r zS9_msADW!6I*~iO31>@R7FN{8_|1xjhAap*K9p>@`({b2-}b^Br8UEugl7nI3<&Nj zlH4U+a5QA?lc9iFl0W9O)FZoms_w2N0F{UZwVXu9H8Mu6+=Z+nlGqMiC7 zO%nL?62C1>vQ97Z79+!zsd6v^3sEYVhikn+1_JfQ$VUu|(@$OfN zamZsGxdfZ5-AI|2x|epl?`jSmcJb)aM(bDYN@xDs@C4Dl+&Xs1<-v;Z&_4p>Mh+%3 zk{NP5gSM=iZ+1Tg7xMq-@xO-VppEJ;XbvPy`TJ~i9c4m8De$U8TQ>Giq>CM=6W4Bh zSnnJ~g&H)9vkIcajr&uLhjaTX>;*-uYn*&S%!=QDSx`DWbh$b%yH__VqDAair}MM!TZF+EFi-i{ipr`ST$C-0ejH+RBA^1TvEHFZ z`$;ov)<&w}S|w{UcWbi$bP)k=U}4W!PIQZ+o)%d9Ox*Z+HrK|ETE5J9a06v zOTFq0tnR$76)UO^4@zjUTAEc)*8Ky;Zp7*}K3|F8FpD8SAo;oJ_E5{B*F3FAfd z+j=)SgKrSpx4o*OKvOyU9VCO=9nuxEDtz7ZvwN04fsbfm;s9 zt))%Pr?G2y<_2tS+!wUlZ*+k+_zcVG!R1vgOS7AKLvMFfdiGvg&y+U*ZP2+nI#m-d zb`+gX>?o|16h6u{VDc~l<=&K%UG(Swb9C1(0Oy?`1BjilN-%eW5F=l$Qi$dO{5Y5y zKrSYB#6K||Jl zV8#P=4iMC^m%*zKy&1*OYcpGG?%5Nq+7Lbjuz1PeSUfI^w%6DXXcH<&|6+3YCv~p| zJ5hT!>KYHKJ@WihDlHgjOVuP1Gmru9z=ef!=^uPMLNZ^{lQt_odfDnAjH3+|<`EL% z0X7xypX3rWoctyP^0p-{2~8+Fwo>`7$3UjnogLoX8BRTmSGzcHVRPHargh{K>oqmC z?A~l+DCysDTv{7b$+Gu3#Cog)cXF!+rC}v{hpar)nT28sD&8b`v`t@Rjk^pO8>$Vh z>6fCsfjP|2c?qu>*!;|r_PcDdBpU4v;@`>>MvFs1K7yD)9(Uiwai7 z{6c)X@$RMvnU&2(0-?P7PfG%RmCK;uMA`34i@rEVtoB_0O5oTT)U8uvV{@z6!34^J~LPqgSsZqbzZipVd>vetjjckEz|ky7u_b ztqDZZm|oc==J~4ums}`uVKdRSzudpN;+Gi82s<$~iMsh)RL0N4DTZ}6`6qb@FY++5C;h`4#?3A6Ci=sJG|mMec_(}i)w;?Z2Vd-77DLfQSb zh${2xrhUuQl~{VKO#8rryigX-(*9;dAm+2ue@q&ITnAX4JHw{KTV3>KCUPv78g1mq zMSF(17JZ|! zF8Vdg%{Zc&7s+!W(^uL2s%)7R!k{{#j4#CsaKuXva)K&{#Ed=tP&^VucO-?^#Zd--);j9lwdEk*I`C1GhthJjM)c=)cx=(Ld40OhAKYpt ztlw4fa%^NbBUo!#_3#+!phJEwqf;#$ln>FQd97kLT)B`zKEp}sC|)TcE-$8o#_8Pl z)gTwD2nk9%&)L5^vE!XOvs-0gu=^HUM6T?Qk`!m{0@PsTsNzh)t8k68l=6V@Lc9gA zBfvCRGE0q{cGIzOYb)RXFJ@w2WvZzKlpiJQmKMXje*c?e{*$grdBn!jBA**R{H&qfqr(lT*=$DxA6P+Is?;S= zUjWjnfSn|9sqfNurTX^nKsKO02VWS-3<8Yr0C zi@qyMRMK!~dWRL2B+Vntu3R$f>Jl4W0v{2ez8_Q#P3%h@Ca7vJ9G=RS6{Yb-QC-n; z!pV!|o|mfHaZO)z^v9sI=x1nmxLL`2Dl&?|X$M1jK1nk9+!XfJmv&EFCtvDwLt5J< z=ni~X|1v`lt(Ko z4FZj+#qA5x_2+*QkY+f2wJr5c;jZ zbE+>&Rx#L!Xeda2y*B-BptfYhvEh!fjT3c5Mcufml6&hTLc^%^1RFDNo5nXbB$bV` z+&Tr*7R9b+X5OnhbRucj*cNJObZ{njUM)<~pwH-HxUnB$qfc z4PSwD98Nd~$v%D%13y+~ipDM4tu{Y(G{1-sB~Z!e+LHywACHj(c&k-6;X3c@th&Rb zW$DDy+-N-7QEfjFv%%wo9@vE9<}vl=E|l4%)|6*{3lqvXgC{n2v=bj9O`4F@|bYL*h61Q)%BSVo-|I_l)Mp);7!zj5T1rE2d+; zxa#L^y?`<=+O32f_9P48JUU(RAHG5bZ8=5ZlTHWor$?JBgcVNCA>k_lsbg_-qdjZ% z+vU5*k>hr4WFwSK2jB}U0GsGmwKt6<4~*$;Hzacs|!DWRyDxfaZC@s zCr#km7%&o@QQ*E!Eonv)CV?I(5jzxD>CzlXX`|61ai!zc*-;V>bAYGxwU>5cQA1Wa zn#(tQak1&}aEGA}Xqqp3>7m{#I07s~sD?v>`sR)qgpvUzUBon0X(@TmZzu8L+M*PC z{Y?wInlYhZHe5J01tYFHB4XkakZg}e1t#etff8eMh{*rYyE6zK4;9Zw&@fYTt-ziK zR=KA?c_lCJht;(QcguIl=-y0{q$j;yQkaK~F`<|)F!CTnlTQTx-$w0#TK`L4(|i>W z&JRDCW&uY2Ud2N;XlR3I7jOzFqwmale<5!4_n$(WAyE8(&jEYA2jqT%`2|?RgBP8k zE@-{a_CP7oV4Lgo+V|g3Hqf_1FcPDU^uMi|EkF#K)N`r5ddH4A9F4Z;*1Kx#O9W8^|A|?? zPNYdg^5Iji^wE-XSO1)lkg*FrV=7QF{=*?6c?0S>mg709ECbC}xIDS* zptSkzVB%y@^aCAu=MGCQhdMH!ld!+Wo5s)9BCw_uFCi@k#o03nl?;Ck3wyR*Puo|^ z_U!Ip+dHq7^woIEn~a*B7yemmy@KIPS#`U0&<6XCs>vY~VARkJR-8Vfbq6({w0a|A z=~E0T2HFvf1Zr9Rqe(Pqp)1R*EKuIOqo)G@4St`0g#FL9Djxn+FytPQVEs{A#nRW^ zHZAOy8E#mVbsjzkVDmpL)o#c>&6}9ddH4qJQn-A21?!XXx{GjAnE$)q%`@D0_oLyk zwrTA1fDv;UGcRD^dIcEO>=dGQ+>Z|4mbz}{y|4}Y;w@&ZfVet1Ti@{OQVO9&gcz~C zQroyW)0cI3hH=1mY~uN@+n=2W5<4A^1gq$%&dUZ)L)h_@r*&Gnh9P$Mx7FhBo$Bh# zwx6Nu8C`8SB9^WEX^h||dtWRoZC4ch4jyLiW&}Tt5AtmvXb@hGL(Zm{VH zOL#!_uW{TLhkH_^zL7>FzU&gn)M^j7;{KRVX{ zbMuIxPm9rnYci0nh2bQV3PF4lHcfN59fT7Ib{`Dum_!QY-=A15KmNmegZJI;;)5SA zzZ??DAqO0r^bf=$p8gRLySxxw|K8g*-*A;~yhm*&!E+?jCc@T76&`Gv+Sg@a7=852 zg!rWa%1G~|-P77gzHSVa9GeGcANwMBpS%nCOnULFH${3^&@#8HB&YEd3FUjU3OLR3->0=E?oJ5uggmHREY+bsW zt4XgRsqehqx=zon_%o@fckkcZN8RW4BjKj%vH#q3-YUJeYm`dOd%txp#WHZQ&$u|jW(Pux#o@LzbGcAYl{p$Q%Os5_$(bGm`EN5H z6KfO$h&2Lsd3aF558J=bj2PID2U)!0RSAQ0?IU`N#j7mPoM;z{ZOyXl^=GTNn zQ8RC)-kph7(BF5w;l41h(_my8V_Ql!-dad-dO7B^-`)}NZfLH4w^I;WGb~a&Hy5*=Pr_Rmud^r>$V8yUua9U}PKpyKW1!^mAT|iy3wa zLRDeS ztye9binB3kqgG)8fp^in+}s$WHNN>aDcm+if3OOL>L*8bVL5{JEYRfsdN4wD#3lku zP&jrqXe_8zZc@tuM^f{TE!9mudWxv-wW^(Ee?bfR($N2LeZz3|jwQCh%D8QcrE=aJM#=N}y9kHkY2XcKeCiYo`yq%CrmU)*JHdXHCjxrmjg!(r zACc}xjUdz~(U(8EZ#tv8;TvFacbl>KU>wrlv7RET2G_p+;=18!G3$M)|gLFgzp5 zRL;LVTb+_27)yNp@#GKJ$K`{lYGgRDWO?XEGIu7Ji&kMWN=Ak%weBY@)sW`z5(&k? z?f;&O`;h5rlv`e2>TFVnQS@BcbzMz7+K3M`R=I(joQtbj`oo7FyLbiXrYSJd&}oSf z!&c!B?)Db5QAZanRZB!#_1J=xW6>twXA;vt;LgL}N4-m;dgJ(WFvXGw3zj2Hyw5ZE z!jse&f_SPgT|4)ERUBbcIB*}hY+Xqr^Z}(7XLTqV0DR7fD_3P{V(}PicCiWkAJrjHdccQ$d zI;Lwbar}H0It%FND3LE-ESImObux4`qM{lDoS!6+Vqx$q4JI`g`$wB*dyai;fW`+i zamPg4SD4r{&9idvWeJWjfsu!j%dcF`V8_s7Jx)VaV%<%zg^xZNJ0O zlA=0bUb(#|o-gxwdNPQrhdLQ~nW6(X{3-QWhjHFkgVOnxSX%Gee3ZTwG5wzn-cxr+ z4!w&DpEEp$lDyFyn-FNhVDe^`SIR-K9Za^;Gc>2-dBDM;gT~3)ok8!qSAP*)B{yL# zLb4=dek_#oEP-MwJ7Q796AMI#T(DW*#8vxkPZOV-*Y6~4&g6-?ytHR+dFPqId+&nk z{+ZM#OLTOIy#R#S5=_s(d`oTZ>*mRKb^R&TJO56@s>a{s4}{FD8D>YsBhi$)(WG6hR+l;?@XEx~KP)&iGFyB8H}PN#acYs-Y~&I(VS)m}e99 zI4-kNHE&$j)FkK$xmv?nvy^fZRv)*J6UX}?K4mb+j5P?tehjKO_RG5U$JCa#xNAnj zlox~aE`g09Or}tJe``EjRP+Ifa<+rzocz3gcj3NY%jF$ahkQ&i8*eY5&;cpoi-nHz zacQJ*F9nlya~UBVX6&{4)agtMCybgKdoIY3pyQ=5L*z94+7q}TqVa5>xpRh#N2lM* z7YyX&kab!OwbM~9-jP7z><)82Kj!1*nmdZ%x^F&PwDZvQ6`PzqD;}7c^RACTA=4c;F~OFvm;px@x9yRV#cjANra*@A$DlG<$5^+ zX>oP&Pbp+sRA5Bz8#3!0<5t;pbwL7?L^+#TRfG<2RGY~y)woFY22LJ1Q}tH6FDhoc z6eJDwDIH!Nf9htdrA5!f{&IYwBq?d__41{tYnS7lv_>Va=S|HfpXs%6W`o|&8d@EE zyWSO!=yy9@?=^P21~?D_5?ZR=xAy`ll4*hPSSU?=$Gd;0(kaF6gbHX*QU~?{Z2zBu zE&o!v1OjB9Lr0>oegjC2>kuz;`@k(=96Y~w5Lop|eW?Jlb-^|pdcVKe1I4eOC;k`m z;9%m8a_%}f>^Y#veJ|YL<5gR%e$xhKLHaTYYuQ~GMwGIy!_iK@vD|L z&gB+vbps;_=~UlI&HNLtJb4+bXQnx&1C+C1>Q#D;*I2RN->EhkJi?4)QkfjfFJ?k> z412imh2IV7An=qQEL>=ki~^}T_Z``*B)o{-VO zrKffEPpdkLLbC-y!17%+mxivAz@5l|Kn`f7CG>Ndy&?axjRviZWjdmP$kqZ=^cq}X z&yUlCtWEEZH|_ZycO#xATd^-*TnF-dgim0~LV@Mu0#Nmit$Z)HIB z8k*_df8=8!)%92ewcCh^obDW)3Gt>f%r>oF)f6p=MCNYnyBEUjuMCdq)>9jkJq^VH zJ!4=5UCXiOI!rG__v*UObI+>dd`!`UqY*!gST$V&`0F7_{7*m~j+RDkO@I!ho;d|0 zROoWK?Wopj=g2?>LRp)9DtD%TJ@?}c#=QaC3`d8B4Ik~K1~+U8&h*$pTXP^V{I<86 zU1>8nT~k?rulK3C1NS!lu`iu4OC-uDKICm{H-=A|1xgAM11+qIy6otbFY;knPe{?2 z@XPDLqZed4h&7z8QNf{`@uv_FT{PP7_e^1?=k2LrB#s-Y`>2h z$DO^0ymV2Dj227zE#hTIO`CSmoIDlT;k@R|I6AI+yY)7tx4RDAx{$v4e~}$@2~>%s zAjKT062&{S<3DZB+2A~I{9h47VCN1wWPkbPzqP`EBmO=OByU5!*(cE**ysQc{4bA# zau{I!4g%Yzzfz09(-$BkB~Tj!R@#-9J`n*s7Y9|`AR-RBl$|r6{6z3L-uwI#FhK*; z3dA@-R|xz$z&q?z%dUezEC6G)xjn>~FXIj8o!Hw6xRe?-L-^U-8O zMLA=}(+Y=rOhdr)Hwvl*ci^dh5?A;|2IZJM-w2C-GI2JbO%_#OXGH;d@g6?vBtB2` zSXhISN`|<%4c8C>P%Zz@n#b=6q-UKyDZE4o!Aj5 z4xcX+a1H6x(GJy0RQ(oiVB>OP{-zpM!-?FNC8Lz$g=$sYFgDuu7SRdfVrwKSjON0z z`BZ*di(LPe+L+i$2UY#yCX@t}pU^yuqb0(Ug=J?VBD!C)=@KEdJDfbAi8`R9A< z@t(OIQow*03>GkUrS8Q;T<)IVq@>T9j~Z)E>V*3cHZ0bj!{yKg8%C$mQN>JUgf?>gMI3Ij?Lm({x?7Ke@hS;5>5abF(cM zBV|FUSA&i-*Fw9yW{AqFd{G+ygVY{`v4tu@7v|Pcgh$78O@94>;TlKPMZ=okh9&#l z80uuxsJSCb4dO?=0z92Vi7`=_+^(cF85Ia;;@8d7lw|L{gnP`*lkv>@i#~;Ejv}5kPxrl($>+@|6l`;)>2UhMh)H6EZONhX zXs3?xv?I6tX;X`_?iS<=P64^~wQQ*s^1BPRj%+ZLn7N;ayP3~7x>e*gR8p^8r%K@MkD zVSX#;onzPg50pg*`sRa^(pjuI{>X|IP3i-GEvUQ1X!e7e7(+qz5ZC{ZU2Q`UL!5c}%QQ z)m+ZBG)*0^)JJ388aYk;qs<)i5mR_L z@qKV!kFqj~>LZi$WkSR6lEh{)`$nXOHA{C8A2Y~maMKmmsJ$wmw5%ZHz>eoGSVbdF z{lXU|+z2NIH4*z6if4+5qOclKVPU`tabkHb{I_l6a{JcAbnUGVS=KgN1z)dIizbA* z;1+CoT(Sgf->mH3PNQyx$g)qlD-%dLo)fX9jRdt!+x84}ymgGtty8fXy{>)UxPq#c z+I6?|MfwNP;=2A9T(|tJ`osa@`OAkUOY~N1P_6+RW~Qd?y<@;accJ(F2U4hSv*5u; zM9VZ@lq@dqh97A$!+8yha7t8}6gn--wM{*&^K@*wT@_}%n4HLUXS|x2?JX7IX~aR| zIm}|I|E)c?;U}GX{y0!D9aCte1B2SE_ZrJ7@9F%I!nZZI=h6ZiSVvO?PQ1-i z6OOP4IPJvY&GPd04f@q8l0!-Nioy5m4Sm%mee#B?3=e~pp<{zyfO7jl>Nu*_elS_fm~`{2RgiY z^}(X=wd9q7^KV?MI8Jz2=f$|=3nuF% zygcU5deUM$HseOebn^Ha zkw)6j78KhPIdiMJHZY#1z9SIb4WKW9HTo~h?p5rj6LgWl8U&%uuhFL##i zUGc!t6ln56)NsX9DX4P>9J%9s1PO93?8^AFcS$Oivih6Ue{G++yL;zoaB}~*52e7H zC_GpE`tvK7d;wqpkl-~ard|gaVGsB#0OX&ksU^7?-*2ohnGBBF)L1z&MJTME;5ac- z63Jz#rSYMSuXmqx0&gZ~19OjSC`z&rBqu5bWL zAov1eN!V#X`2$IAzylaW{uS=cThKvNpzbUOEEli0`7kAHlr>7BJ$2-f$Fj~?$)uf@ zmMNyMVeJPI86@_7?qaoR&YLHKNH>rl4BGlX|YbESspkxUK-7rL(OY2+O zO9ZN=t%_A=^KIC^36z$AH?)|Iw0YMN3cTQ(`Qy3{B2n#>UxDJN9Y!s{a{|$qcDHw~ z)|JAyt#{|JpI&8w3h`V-7lQ6yQEy-;VDzl_Y1jbwq_)5tqOa8ZeeE3DruCNX`z8dk z0~aQ^`r@zYu5H$vRd`#NFfOH|y)8`Mya^=LTAP~S$yhHny)Y$41gq5HCeWW|=J$?8 z)cbhV$HEp89@co$o`J@6v(Em}^`Q0n<@WU2Y5u{fd4A2<*cuT6=Ut%5hog8LTh3KY z%qyUHzx01{bYm!wM%4o$4T1d>X?dg!;InidWyRq!@IC2}P|)-aXaTx)gny3$)?D7# z>vjK$&Nr_D3+HA2IERy%*4=mJH4_sthl|xH9cntvS-`V~H{FL1Vow*HPP_Ek;BFAX z<^(+2!MOaZZG0yaM(W$rdrtvy){z3?-O&E^uSS!v062xJSrEdgc=*Yq5e!D?O9vnq zbVos=uAQ3KYp6U00cRk_+Ew=HXkdDO9o!|CK<4*OBskEWN$qI{MJi~22tEDZTR=jR zGB5;pOpZV-B4lLs={J=@p|#)wL9q=S@K@d~RK@-)Clu(!rKB!tirN_ld;{BKjnDnw zmA5ujMy+Ap@7zHA!1T}0EE9P~yIha3KKgt4z6nmq%SiZ!v=uLTpq_rXE;r}ilyXCC zU6|)n9ZwQF!`AA}*xEr%EpHs4OABjN(f0gYza#?LK4A2Z$O9IKKe_TyTl~c~%r#pU zOxml_P3~sTTKp>zC;R}EvugF4+t55YbGs6*&&g13mi>EoFV=M?;sd2;Jsx&ru&C_m zW_W;_0`5sSqQcH-EEdstIiE0klOsmIiyOHXvh?xUGqKx&fu0BNgI*ZE2+}vJo9Vqc zO~wtUdi$qpFlx%30*E}B*{D7pmaxz($Gh#GR*3gd5Gn#Rdi&J;)+#It7?3Hv&Pq~_ zP1_eb^=_igWdLL_9Q{x_Q!tGtI?nT1(>JeD*LGsg2S>v{7t~Hn3KWN@L;$BE+?-haoRL1*g-LL&llp3;kpV8q|n-pw0*>R9Y@&?~in z$Df}5McS=Y2T6~prIJfHm`*9|B`{8Wwc^1xXcveDI1IK)V9;P}>|ajGxfT#JSL=nW z={fyhh2(S@2IEP``c-6B_DtoI38|IFalpWUMBmR3>>V5Q9R96m&fF;-g|vyVUfB=? z73Xo)NkzDNBI8o5^kZn=!c1J3SN?JnJyzGD zi+*dD#Vy`dJ)PmK0pm5xK$nc%nIF??kfT0CfyJOC{r!3)=J%T0>8Ke=k;$N^(pkhu z$5M|l%0X)pjZ=6uBc}cj>6t6ZY}>Okp?I8k5Nct);ojZt91k4~%25_mEGch)-xavn z^}1OoG(-;CySx}!6WD~k)H5}qNI%wHXcQZe;HzVUl&aLt&b2h;c45EZ1MOYsa147f zOG&9ggirPadgs$=JjHKIm`T*S4qfES6XoLpOhlR%$@a@#{J0W4f61o6d+6iG23e(W zKHr4++T#L4E3$-v7%2FCrNw)Cd*tyW%+{!-0d7h;6Z{#WapFV_=d*I%sWcJ(Azn zCpV^^E6E}STx$cevi^1H;IdmgNW90?G-b2m8s=K$zTVRdSNi?`lxpJ%P1@sbfA~|% z@eh;q5&X4>CQT|4_=acICXQ#<2XO_B^}`L(M`B7g46|xy8JU(Hh3FEKTk5!hg3Zju z2`-j5vQqIk*zO@RevV20!yb3YYO_k|PbrmX+u`cXM*6D{@12@HJ3F6o!}M}oZ0WU= z*8*|hu0^9u`J(kFZzs}Oj$wTXW$IrQ?ztARjgfstnP{tcK{ios%5<#Y-dQ=br8W19 zUq({-1Zpm>@>vy}dv)t4!?noR$f+%(2akt1BKxIs;n$Man}daEQ$gLb^>qV6Y3@qI zE0PQXw+_bmX(4`T-K)W+zTP{Z&sbv6itv?*#LW9aofShOQ@0DUHg;HjYcF^ObA8K} zkYd1x$s-!;Ol(!d!f@(EY8M5C$LQPQmgqleHT-mKRY!P%eiJB~!^bdZh2m0g7P> zS)~p*X`KyIy6;LeW&|c~7&~TW0COJo3C9Px4Mecg%Za`xhF8T+`bER{Qhg^M%n|>T zLN)E0UVHB~UqJc$r$Wlh^<<;WiMVTWeX|SP>@BxNK%5O`53f*aV~gXQF-<5%;L94Y zrex3TY~~3F*vWaKi`_D_)qxUYt8S!*t8TLWm43FF4=-($?i?@1Yspy#n;v3J=28vh z1SixB1CkbM%6DCK;XC&C)f!XG&CPUm4@P_?Mtp`j&Kl}bNq=@^se()WDyGQr;|7A}K`p>={gq!(vCo~?U zT|uf9@Br;X6`x;m0*n_VTiNp*=+FUU2h?_7g4ANL&V!}=;cFUh&VJ%QG8z zE7o(HnM$n*i#@V=k#gCo@M(q%)sDPqSI^vFqMa7o2CxrbQ}wIz%Tub559ciVuM`ZY zGlCZv2hSDa0KXECsDXx>>B z){$2*(5;cIcsy!EvopDOS`<`h{r-_81po6Ctdkl#s`%~L!H#cx^TYWS4|T7Daq{rL z_B`)kL1<3^K2u2W1j#}mMHTq?u0PzBwgWuTm%zvJsdNC2`UD=?pR`cm?>m{5;PC$z zPyz_K+X)gt{f~I^KLX?-SPChvq^|2GgD>na>h(5&!vKpyR|UNU{)2WmQVLgo05`#I zD01nu&mfDt-R}PvW$ytN)zz*I4j{Cxj+RWi z;P?cmnC}l$y}9$rhj;SVw4v$9@3>e4l1`J~v6%F9UrmNNW82$L0zczhB<1mF*(rRk zXQTF9sEIp@xHq~_qjz#oxwnUx2@%C#_1Nj$j?8;HeU060#l9pB``NF4c`zsYhWtZ$ z@!1cNC5|uSohDo8`S= z$Tq3G^aQFv-}8E)LK~W^Di}{l5e%75f|cvZMQ$W-l2YIYCG#LHHRTfGLs@d1>te+R zpQ8iz5_h~STt#&C-E0LVH!gIVSIF4QL#g`H{tnOe`Mt{{4R2vqQmz6)S^QK+LWUGf zF1#Ji@a!7UG;@G24U`3nHCWX-WiD8kADzQ@awl&I^mcn|a*mnJf>xieSVV2lOj@1z zku^2}N(ZxCS1$~P)HhbeVE*PiE$WfPZ*$l)y3AdkWWV;HwR^YvKGld*o}7u-ly8vsSq-`$@4aYN4V-s+w)Oi@Myz%8hZGEk}h8|nJgX$MQ zNHcoMxCjb1L|J#@V}ntLq*KiEB-eZCQXv&WBOOs1`=D9Dwh7a&VzZGl@Iip~W9<+{ zG~=jGUFBy39NSV8T3QWLp^vJvx*gLFIVQ}<-~NfQPjxwu!K*$%nTSvEG0o{Li&KuQ z$ouwTVMKX=2eF=V!!5Pfmqu?|_ijv2=}gTmU>eW#Wxj0KY%ztqJT_e9s;#Vs*V6AT za%Rd)=S@X;xrsW3Coi{%XFkm~cbrTo4^KV!_$A>9pSQo5-#d!{L$+CF$`{^F%V%_* z#(Zaz$GG`zj@tOAxPFYHwhh{OjM;NB3VW0*D2rwrjU`if6Wz3`j}dB;JOcQpdO`1J!aTemO67`x}sIAr^KwmV4_UM-a9SN;r(HyrTITjvrs$o z*cdoKE;Q${9;pgxu*{avS|*>d&EXUFisL%as#-TuKBhPpDMzCW_W~(A)%PVV}h#ZmmhF*f|~Sx*e;3L|z3sdSC$`c`i)58;Fivgc52myPQRgJ8s)xIkte%*FpybZ9(0`AL7W zd)xBW*Tds)S7Il9lxf1*ORkc~I^9UyUY_n;&yRB5tbM0;P_IE)fk~bjNvrW3V(+d$ z|MNtpkgNNw;Bk({92x*(==Z`DJwRn&?J7%H$ZM;Fy>D@K>v{6+U6T zPT`58hA-wrO&T5fmKYv1od8*l%iNK*)(#1UG~e4d>PE7|%c!y<0+HFgW&_y)9X_A? zmC6{oI`a8>Y0KH;i_Uv8D&}u=IdneTEXlBMNbFE7stgiJqRso*8_~9SqDeO|nM4IB z==7(bRc3X%=PB0;7+YRsxV04n4?%ErX8QbR9RcJt*T|s#5jID2_4?ARmrhmN%uwwd zyOoO9EyPdhyDmeYi&Py?e5&8J0EsB#lHwQsz9seDhJ13nTTEo6q?V^=>c9|@T{ba% z;+R;Xi&d9m3^9#0D*H1tv&;bh(F~#VN#=3&TaJisBF&<-BfA&R2_KkR)Qb)nPc@jhaaVNt03uX;V^nN#d}+&V2!?YqIC z)*R)LZ}`!G)L61A-u+YkOk#7u{>}AAjn-1C_JTa#%~G0NmOXW()_{({2Zid%N9uh< z;tX74@?*$J74Efky2NCBZo^DndyBzXw^8YlDGEzyikR5R#Z3XxygPU<3WdTwxLh%q zLYJIume`hCCQi%-`Ivi}wYK*rwi|_m!J6t!v$ONJty>($dxq!TP=7&QG?u^m+C8!V zYtB<$;7w&c*Y zZL*MC>%iE}RHnpO=vVvPdeBb)hwYz|r>%g~sO&MAOFAm#{5O{5M#qg z-bqn(2k2VgV4iz05n@H2u*>b_!{FGSeFD>uHQmLreUI5Z;W>Hq)f*wF^sA9iY>v-f znVNa()=aj3tCthIZm^+A-`j3B!RhLw@R@wQ>Oy$*lm|WYimn#)HPRa6zERXq@}-lC zw|;x)+AU;IT5Z=(fv+ynpFxB9WN+usikaNvBqX( ztdl65t}=?*r9X@@*K{ew#>5UXn7LD=ZFAKgfvw)2+EV(w>Om16F6wTtm)mB%X!+Kw2KGT?l56%U z=ADI`W^cUO6MBsl?kuIcD%+<}lqvCfx~I53PL3XUx8~E{;XKuN?9HrmRaj<;ddbwF zVWfJmr!yzR-_>6Ii{vNJLq{4)!EY#XSZ<}*NUjBZJm-|2*e_w&ALlb4J*0a6!b|zs zUtZq3(wPzzXdz_*6_01<#68*~#kke?M;%%3mY+^d`TA8@&ytsGWD(`WO+&{Bhv=~N z4&E8Ruip^}1aGa@35jR6U+-a)bU>B!AdwB+C$L!2+kv`J{Lyp;`?B-8aYHbA39Yci zH!zWRUIzk)!}&86oa5b;_pj@mCeTO`S)==Vk{{;FGrwoISAm4NyKoFkAo=+gW9#%E31~h5)V6?b-IKVD1$pg0p`{3B>xL^?ID9~ZBcYA3`;REM4 zjihd|IQ6SrW-;MKA@yp6c7rkez4{|@my*m}FJ1nSo4vlEpK?&O(E;a$4*y@be{v3? z5h3;IADlxkL5u{$yjI0(F^~lPhvNQ26b}X(V$^kKsg8oGsYiLI6nuoVHr8_ zJ<`DcOlyGyKq_GYIxvVoUz5KSNDvYCLDC|Z#9q{D3g+=R1==ISqk>=@UNMw_g9eXP z?gC)}zoAmPSZW*#$7SR)!2?i4!H}_hngekl(2(?CVFd*S%c-Y8bw=!|g1p3(U7Xb8 zuRz?PMxK9YJNHqoD$p;nh#-)iknO_?%M!iH=w@L>AmNEa!GxeR2mchjvU(8u&ETJV z&iiuuQAs5PhS3*+1vg{k&LvHV+V&ZDj{5dApq`2#PGOY;bV1>llE^HXx183hlI-b!jnEwG#(}>>XH!$T#Sf=tiY<$4ErrDg&+!WoQ3NG=$~^d-yVWpR|20h%i76|X2%Iy# zL;vyaH0|NTNutMwlR`0>um<3bIRE>rMHO(Y-bWS~^on5b&o?SH!3cA~`UFq58i3p7 zTdYJ1f*5!Xm_rqnYWO?;)}VvY%dBmnX8O9uz>LPcM3>-hI3i{JPIkIbvb;DX!y&Y* z*6)6OAH$H)=;jt8h+A7Av-)uDQHff! zXNCdrE%_OpTfLTSWSFO58r9%$F6nzF#hH-Ram0SPAH5Qj>$VGG5F7TMqXdG>Nr||Lr+hL7()?`%-N_?LyntF-x-d zM)|GP0U_ND5 z02mw_d~W#udoW0YY=w2nD|R^;rZO0!I)A6{NE#ICjph-cg5~jFhV2?e1K`2o9)TEQ zg$n?@+&~Bov>PGxSFp}OCZoXzqu;RaT`qW_PoGm;4IU@7y=vQj=F}dMA@X!-y7sE> z^_FJt2b@`MZHLZ9c%<;owUW6x57&$t3>TO5d0sVJQH!FTi{hE9Bg+*}<$v`y?8QN@ zuQucJW%Am+8B#u%uUb5z@4K4h>0LcadqbPjABuXl$bQ?uQR`f!Wc!8~Z`(GXACXhehzRKOi*hOcCns-p- zQi-dlRIJVQ@X`U)2}#K{n$cS_YTgUEtD%+YOr9S|sA+<4lBTx)^UXgPscRn%og_{&KCR4iPKk-{;w|}3MMahtXMnK6iLS{$w#BqPRmTP*T#6G#M z#1$o%=2jU+m(?2#>Y5ip;MLOn^jx2ety1iQ-<=sPug)1i>B3(b3-{J~(H?Gd6RQ$Yf-CTw#&$KtQd{z_gr+4Tbys9q8+)OJrf zT@*oUGm$w~InA2J`*Zdl#iY>!|Krue_}EEU*1QchInD=m>7O&EqE^F-0p%1h5yjMW zMp;2r4esx5gqKLN;B#R&j7-AccA{Ed{plS6hKR+iAjAaut+GRJfy^RG$j8buxT<~R zrldw+ZMx>_X(h!Z$LIr%`L$f~4;ntc@W4}AS01y0&H;rkp28};ZjAkcN&$lJ!V0=) z!{wneAT*a`Th1G)rrChCFB1G4Sd=eoMwJ#y{9N_nwjUAG$F;%>LZ_YG_`& zi{c_AXqtW+8n1M#3jWF|xHeS*omiTZ)2?y&J3*#i@rIB>T!|)UME(Kb ziS7yt7gr=LrdAcZvuZ~&8vMLUg1ED9$Pr5bq5pHtS4-#Ix@?PWWB zTrKMS7yh{LJ?z32K|yccb^J7|aq~uf+h((`VrKM*h*=|wVRscrcu{y!rg}BIh&80& z;81-Mb!3CUoprngRnno@2gdwblK>K>vvefMXo!$^A(&f$IW@;`Uw+?g62X#QNXrW3&JM8iRz}_u&X6 zxd3uQATNLwp%iqa##Ft(g86{jo4{W|%vpgNp8u&N?1dr8pUl&$=cf>D>{b9JSk;3O zN?4)2gsDd>rWSoY63;n?`->6tr5!snO2UTsk1qPYq1mK<$-(0?x}^VX%!1dq`zjMZ z@P^DT(2w^llrnv@t$1(zXX?51_2Sv0jd$hW5c-p(e=tjXlwRtJN~hJ$Cg2XBOZ|3NiD*@3hEpSUKx zbAOV}zZF#2C7XW~RDhmU_Yn>KXEPE@Qz+E5pdwN2Ub1N1_t@JbYqgQb#WwXB;UPut z3aNsh;#f_;bA{^D!F;(^YN_ktnf`hm;?pZ?e_Q<>cV0{1O}1UpRVl{w=Ndv}cC2oO z|2KVQshbanpM)llmsQFL+&pL_irVIs2}i#?F#O)>y;H@HD`#cDxN0y4JKIjLW;|XF zFtvaL+F2PpxrT-0(S<13We%Ze~r3SVz`;1BnP6Nxh787Eu1^i6=5GJF|>bq*0JBn-y^jm z{o5v7}yD{`xI^1sogCtTf?UaiY2DS0$BEm88WkqgZ8QD6B8N>$hDJErMWp)%A~ zyJDnXe3yRn37Oy?+iT_Zkf%e~BbB>q>gp5+yZWgs%3>B-bKW=aPUl1Ie=Yyx^OCNQ z+XTg!`4e7SriX2E3Bu)Kq|6@%R@VkI58lZB62$k(HKo*>bh>?g$+J`?r~y-16-wcS z=mChj*c|SXObyHa40Q*YqDJJlyXU`R&iFzjv~#KV1XAac@OQ@Kv?a=h_T~S!s%Ct$ z1MSyYYM66iwqI9^oRY~A4yW>(3m+1a%!Y!3`^Vx21k4=0?pCzldCBeESolodaVom; zq2F}6V~X1Yr@6z9?R=~PyVl7wBA@-74OyFMP=3-z*fx%Epusc0T0!~Px28#Q_yQZn zyleV7T9>JFZTx1lHYX~$@4jJ|v4YnuI7I6HKcNjIB*A+K?S5-O<#>!4pY`}o^!opf`+4hw?qM$b#8geDlFqH=i2|Vuzvg!@9nMIa zkZrj^N|U)Ocb+4pw%$Ph&IJF&jitNRSCc=IJ(@ZeEiJQ3&vB>WQBxZ6(S;JT$Pw~!y15uFm|gA0jq8Z~a}ePtD~hW|nh0vL0Ej{~ zX4%0cEb|ny*l<|OCmcRl8fXKs1D2dUdr-GMD^?ZgK*m@!dEq>FJ~NLRm?GS^`#x$vY#*6m$P`l=Y0V#o{sJKw;%sx9>l@5kvjVy z=0VW;f!zaEpg|$Wf)ucB&{zMvbr84}tZZbHh=Pm#L&P%bUHktqQn;KA#teN(!@$z? zSm9A3*4`D2nKa<)XLr~<2bSEoOY*@cj9nTC0Wg2?F9@U=Eg5beNrH+{_R6VMWu7@- zq*v@|YyOZ>p>yf&`j)-6uWq=;ZMtGm=r5F2Z{yzP6sAPyo@(m=(PE0?ld0`e^Gasv zSp!@ClVRqPZBUUwal@4!k^uz^D6Eu6HR=WnQ;CC%OIx+tF^6LK0xdNeQ|2;;XX-O; z1xw~Ol!(q{cd7bNLQN;G&9k=GPd4|M=RrtG<9{&9dZV?4sg2jNS4-_a*Mf|4nBWh0Za8MlgIi{dka5LN|qLl zydp<`CK3?vYSrIJr7cget7j@RLqRZa&rOiXP`qmGhm*8y{X4Uy61zds6j3Q%?L5ba zUVHnN=B}W!`t6z7&qt=8cZh~J2VR_$m-&Gng_=Lbcs9IB`T{Qqb@H!Hrg=Tf_M3Tl zC|_S|(mXn)D3;QbZ9Y)Imz>fZlbAU9gp`&HP)B@Ig}CtJtVy3TpN16W&TVu)LhA<7fYJ)IiDMFiuNFJ~&?zpq~kiQp%BR~^$E3F1e7|B;d;bRrd{C*Q`PA+Tm z8ZD_W0xd3VJUP#jc3Sy-5~qLu;)!L=G-PyY_mw||03$|pyFahuZ7AjThbg_G83fNdN*R|X-Ej8KWJP%)7$KME6#xII*9e*rvGlsV~D;`MCGg{9N_4@q7P zBDNtIe4-$;klcn=sZzoF_oMDje`*)d^c(>|Ppu*Ett@8H{hYovT&WXmDp&xS< z{8@wT&t@v0N?phB0O<{2i!At0(T`b^;oNYS;63`sI>%B#r~c3wb_{b?UxSRt95g*d z>+6^^3QY{kgaNR?vB!nKB8)gjI33M|#Z6jZI1n zbo8g=KUaO*gi5ScfuMBHe`0HnpZD!E`d0l|V^IMu0oosTJ)$`zk3h+6lJ>#O^xtve zSR*^-DgTot+U{|>X+E45g1HK0S^3#|L(!>-bh5C(b#>=Y&6Zqe(-hL7vG&|I=~E32 z(3e?PGkf%Dps!r>qux%X{fQBCI=Rtzy6t&&^r^Ia0(tzD$%Y1k#^r_$)5b}Y#d`r% z-^LEM7`oI>19#{uWpXjnGFHJ?XU+f1iY(8KAnqbvUDmAOd~fSad66?jsBw@c7JqWJ zv1AsXw0}^<)huz8Uoev^+vvoyuxRv@&Mz%w0l8V}V|1s~p@Q{wFJ?9*rMNc6>PSZv z5d;>e4|@f+m`L}3u--IbS&a%quh07Ljhvi| z&#!f2NM51Y(H`~g-MHek5l$>p7IK_C-3tx{Ev=Tp$q(ic0nTMXT{8X_eK) zHCg=iQ4~={K3lf-u z8&Rky4OChqU*WwkT*Wv4V#VLSP|AqV+bk`wXV6(!()609Hf$)gTUWYd$)nLcA`W}3Hr~x!cEF>V$ zf;|L0f)E)UiP}H|d!m5#Wi4Umppl_Fw?b;G|5e}8$3>FqN4;%x#~R*DHJHAH+gW+N z`1DFvQL6jhiGM zScO3*HwEJ+^HqPRH1Tni~FJUVT2El}`1-mqrAguXg zyAYkDXfT}jCBDqLnOjn|@-F{f_k_SWM~yEEx7{oW5<2Tjkqxe*i=9Rng0R8`WTRddt{b7vn zL~eC7mc0;L4PqI5IT+!Fsroxp2iX6wJ!u_KPg)?z#&B{hZ4jhB=B&rmQS|t5E>eGV zrA2m9P&@wYN{bnhppiIc48`H^!=(IkEe>#MVon+?S_t)r4Q9oJHkwUop8u(Arg7Kz z$U=qk7-1pdoT1;RlA%z2-WBEIjWUjdP*BE>pf7%Fyw+yAR>w=nqS53G)KxQ6^jS3M zmZMWGMuoBirJ-q(WX16o!lh(tc=$Z&^uBz$k8Q^x-_<})dr}+Eqos7w=rwKXscx+j z{fG)1j}qR-!6z2VKfZn^5YZJ^=;`e~>#4ToG!^~Mt1Q7JchjKN|9CzAHiMhrI@L!{LDVO!Ov|e= zK$hmn@8w2QV4e~=en>RiOKa<2)8TLY`cu)QNOj zJhUjZpDTGOrJ&s6*P>sRGojP$zl>YVFDB*Fl|z_H3el(8LMeNS0-?LN-EF$$u(U>$ z5hwXI@#zPjb-j_s-09{#HGG^{(a*Fo6C;uGv3i^7dR@_y_P`%U*i-H00zVJSI2Vj! zATZ&E(mi)0@?nYabi!h&#yRc=VIT($SV49Y3b3lCY?8n%s-1C>j%JlT~r&-OUOGI7W^mR4PC*|^0>|I~?RS~p*y-Oxvf+Q<~{Bt-_ zFzzIJ88JU-u*+_EBF9cP4tO7)euE|BfUQ^Zb3}jO;b6fPNCmHExqyy`dycXK=iSaG zc@)=lAJMhHZLBIuex}t|Ae%l}=OPF+?lNLXxg@=7g)h8l|5mZ9MT0Rz;-Qc>S;3-| zD6I4ggj@^|hL8Fjy`rVu#os2(H%=XKNZadM5gI1vT-zotA{QRo3!xIzp6QPg=Dx>G z;&2mBLLe2Z6*_dJB=b|`?3VSL4>{MZNVa?1%8eDA8yIGZfrs#C+yu-kRO{i`5o#=G zF(FO|aXul^Af9&ul;8$fq0TPUGzD7(x=$1y3F{B#_Wv0c36c$FBntN3DJF!8mK~n> zD;y7Y3Xp9z!N_^J({BUy*@K`Lw0u#N1MC2j5(z;xv-j~2ARm?oO&$I|`~o|%1y>`= z4=;myEmo5V#V&!(2)!JSS&yUeOpw#n2R<=Dw+9FQS%U~@YcQNAcURa!NJd*ogHcGo zYAgB3H>uEh*7l5FXqSK1@>B;+TC?X8eVyi(7~SLjZPz_UZJPyKn`yzkLLtwzI21&D zRX&v+n$_vyRGQ%{+acUAU9Ph-(#UzyslL-KP){(y>-sUOf~tp$TXx-CH_*LnwrO_V zzg)XCq8MRECdn^Gjzo8=}v z1=t#%eS)wO#Q9Dj)oy|i;OZ`eQO~~*yJ3057}drRzuQ@qM0HfxxaK~ZcyuDap8Y~?8x^~-YlZERo0 zN*T#@_t0tN_X_j9qz}?0243Jv?DIU`9?I-!XL6~n^h~|Zi=<4txQqJDl90@JbBV7$ z2vnVuXfso;PGF|Xsv*{N~ixua%+?$NB48*`yHouzF$$G|ScXq>elcvnstH{!n@PE8}} zACZ2i6glJ*tJwXE7FyYz}`@4B$2>?*-eYGd-*NXze2P#dToYgfNC-+!;p zCs*O8#TI=oDBI^Ef2yUK=lkaa%}S>mGAW;hC##iDxLm>crar*bdynDA3>#|1iO6v? z*ETB8-gGzJ%K;1O+?Xq7O0>25alZ3)k|lwMD;EE?ht}+_ct4Y+utY-Wt!J@Xs9Z z-pBf6sb*)#+;GNBkH1|h^gC%M)pnJI#M8Un4?(K#lfSB$t^J)s%z zTk_+0*MW4q;%3j`UuTW)t*ISYNNg5tnK8j`XmQniGM^Md?d3AiDvRlsf|On539~~& z9Hj7jakg?xVap|>XGX*rTxxO+X2RyqyN3ljqlp)YpGj&=n@)3wv39KKmds2aVYeR* zjnBqcghrU#&zN$JHxAz4>Z^0oqFhS*!h^M-C?VdCC`+xyS^vig@=H=q zP#@aD#ZWv_(z#pVLDyOTC**@g;#%(6_Sxj#{?}>pm6IDSkBMG!ht#ho98soD$jxuP++2!i7y_vx&|zUla8mU$OP$;(S5(h5FM8Wbn2wLv zDQna&S=bUJahtjf^%{D0Sj@k(muV{URvlC7jXCAlu2)1Op8s@HK!*E99{9helI(Mz ze>nG1Fw$0zz(qJW#pm;#PE@vRzv_Idz{TZJIr$t#N7V^U#*MKr+}a}>2ueS4vJPSz z7VZVhb*-O*CH>pZTM7@FIfa^$nV0iyCD&RjxFM|SQ4g+guM3jK5WQi@5*eV$Sd;%WfEfoQ6XV$6i`}>?M5_!MJim&V?#!^i@h|qFpwFGz`HP*z z=lbjCo_oZ-7k`vIHLN5hNwk!oKQvZ3a9-`km?=++#a$Zr%=fI<2XUMbGW{o;`H9u~ zI?{>};ri1qRwe^ls?5q_eBJBFwIrz@Lz&H-N z32Z}HeVva5TI%ub)izA8nAy`+=5wmh&KK^_eS1qk|K4)uZ+b>OxZ_nlT#&(Un{>seAO62%pp_>{Ph^wU;}d+Kq5?o6?_X^ z1gIn^dT@_Gf-nsX)Bixj0|nc-GZ=9oM9D#A>_V9`SgbO{P-ExVAwQs6eUDfOk5raE z)-oJcMnfwM(~?on3&zsme3H0N{)p9?HA(Y1 zNlSf{me_4Q=WVwkQHAZ3 zn`3XMj(Ax)Bu#W4u}>G^E6r{+O5LKSl|fe*#o@UGOu57Ic_Qp0 zinK0|5to-dit{w(UUevLjDNV?pYG7vEa}lA)_c|4oSozqxcS6zD!D?5dn#1A&|#pU zLf6((vUrW!jrX{hPoE35Dp4g~8S5k{_XL%3$J~=y?Ah{Gd(r$>eKSgb&POQf`Er0| z?MR7ouBWSKkwmG8x$=Mk!GNn1wh2&K`X%th^l$?KPJnPU z5^k!#jL;DldcR z=BAlBHNg23Ga-upOzFI4uhU(bScAUQl>GizD}|Y?9j0RqTS_UXs}^Kf4{lGVnYtD9 zTP(SI>Q*{U?Mr1HRxXB>+4(G28)|6kto%!A^ z!A4VjIit9Ue>%;;Es&<0akj@PPp7w+UUVidit09$@!Dt0=U_HZVqJanL_l|1*2qj+ ztcJ_>kxCKQ_xddHXoN?hvl*S(ktEblN@^3X}+) z|FvRHA1WU9H!H7E7yOK97Ha2DjeE#vkXurqp4+d5<4% zz6Gp~I0d^*hj$r?6$%rVNnTrnjk;6Uu0Lv5q(0MM@R*dBJ9HwZFov8v6Xz-87##+A z(v#u@S*^VebIpq9-Wllgav`2kL(J{8b10E7@)45Y z{keoNNgHq;VtV&RKKs6`Tdpr7x3{(3{82zw-F2R}D?5xIQoe6|gUGpOk zBhm+N5afK{f4whJRdKU*CLWS2c5xO}uDuR%T}YnxfG~rTI^$fBq&iDtQLM<0c>x1e1jajv=fKMHZ_HeUb3_%jnPi59!K!L=RyfrLg4w9)35hAU zrse6;6Z0O&yafm2)2K-@u}9WSCv25c&ds=UN956GP)_6)Il2;30P= zR?OOgA*EjV_R3;w75ljB>*XR*^ZJ4A104_M+dDq}t~y9y8v=gVDP8@3ec{6f{v#Hy z*Yo1-!nch=a|>;qj?Ilu`1!M?YDXw2`%IphSvl`~{+hk`_{I10LPkjnCFC{U4bRX^ zjUVw#68KIt-Jpx}ar(`XnGflb1ItU?@qEOd`54`#ONq5s(;Kh**RuS|TU6Cg@oV`T zm&`C`&ns5hC(;~KBQlh(R5|4w_Y{z9Z(6G>S$*r_X4Jo;IA>GqQsmQ~ag_Wdbk?EK zUe-6;w$Hxyj&7{Xh;y~Aj<93DUGbu$wz64DtcJ~dai-K#R7J&^Z@Skma3vGmZqzkq zk{_SH=h3k5tntj<(aSotw=*%PwqlNsW(ouskw~r1^9@b%CqqS$d%_DGf0uC7JYNYpf@V1c7>&PmG-FJlMqwh z(I#GUjnh!jgC;DJyOcLf>q(|Yf1K#a4=)N*+PhIyTz!=Ua@`8V!gXV;qBMuqo)SwL zZpEXvy6oD6I0J|jogsdS+lzy}0lk3_Gl4_3? z`r~69)zSumHLi6_6+@s4?T8fTlKUd>Zu=81rS$m|VX>*DErFkxycr)Y6xYHwr zF4;G>+E^yY4Io^>eOESoOyT9?a<041zRJNoex9z&+h-ctv_UF@IwUF$z0?0hHEEs< z&`uCSesTcRma|}h-uP}ce`1`;w ztAd0i?&aqpb$@r~VY`9|28`T=G|)uRjvOy=FW6#vE3OzUlQetJQEhT3X;C7Kx2c5b zJyhZ3sci9eT@%IT#oG$cWKTV3=$hW?G&rvpGL|fO%=VJ*7lmYkN4_ z;OYRVK{is5+CZYV(sE=%){Q44d2T>T^-?0g4b353C>00nSk!75M^h*%^fJHlT;|QI=0FLGp zcmn95LO3Z? zG18u^nuDdTIW~UxIt3tex?|tlCCg0FLCwxMt9{}`$i0BO&41(Aw|VGPTH*REnLW3Q z&(HAGY>bOiKq8lHKVCs{YPq()ITrs@1-|IJynmHG%j=&w)5(xfdbywzlkM%{1|57A zY8U(p6Q`$-k#6`o1zl^ERP_k-tkMa%^Vs?Lru~cxR<(XUq)w~A?x=vX>4HbbP4_C7 zjoDD^=Y8WRGE%v|ntu0ridgu)*tc~PlQF`A8@j~u{jWQ;W@9v02eLwFC!W7?TwUU2 zEQ)4!bq@xa{+e%~?OPsb@vFUP5UZ-|{HD20$EXZB2ldi3mTg4wESs+050;u(_I%*%|EVRIedyCsSWw|_Ezbe!gqMYS&!9CW??Fnhwa z8$Y32(o-1GZtS~#DRW?^^jzHtjm}Ls^qh-#=<;i>TW>5}FEJ^85>wp^O>qSGj-;7b zetCPYZC~oJ>2ZHHaz8hu~K`sn0{WOsFal5;6r)aQd}u?k0)&GOwqCKz~6Du zCa5W;d7_IP_@D5!%9o2NVjEjKidYNFbl^2NKOv373m&N(ah-#t8x8M{_arhEL|!fa zJG2)1j&>hZ?}=y7!f1&ZB*?#UJ%l&V=B9IY&`j@nO18gCemE#8DD!+ywf$YM(&JS= z#?RxfYA={Z&xD-guGG&+GBbbE9QW|{bec1q_^tL8?wwmsqc@|R^XI{^RA zvUo>SXfF6KBB;U_sl6TX2_^ z$Lqzpb92>?zGo-4J{)nDmM=ekpsl3YE-$e=sQAq03R7@`QBSB28Va8EyOYM!vvSh=4DHL00UH{{TfL-{|IlM7HwYi zMnTY4q?)Ao0(Ruz+3^jwV+^+6{pr0%_M`CyT`59tU#dx{;kl)}Nb;ji^;4%3io;3_ z-T8|Y?OW@a>2tl*gl1XgXg($>w~ip!!j@k%KveN7-2u@$KZ#!D#_wLHA%GnhY07@v z@!zz``#t9ZPQ>?G0VgJ#bL9{wf5#mPaFX?EBr^8hrFA>yirSx4Ywujwd3Y*v%=fM z7q`XhBN_Zg&pK1M8P60RPA(;7kvX3wXGiCLc(tCO?U|7qe==bvDu02TBm8U8&1KQ> z>8W||@w2jdnt1L$#)!wnQn95rO~L=YTf1|*LvqHsRPF-f5BvfYu~CZXsB&e(YN=fk zbUW+q2;?peatwHHDPmUJ;7&_bZW;Pz>`R}ClMEyF9F}1+$_)c?g<&{*dY9%P_(oQg zX0jYj-+yS%q$pBemboX>2JFv##cr>+Q}5#X@!fhCkQoGEi^IIWSUUbKG;I*4&igfj zO1=gFA@FF&8N@T*Zg~_*G+4%u%_JFzW!~^p5$tYs(fqN;ci~M|p1FKx-8PT7Ns05z zfmMU0p}DLO;)IcFHZ-2q?Yvaw`a#}6=PE7%yaHJfM7f@`LPUgF$WnoGy;BJpY1AsRmL=W*>gpE)K0Dl34>a%Q7C@~uJ z863#>5V#eje46?i=-2Be)#!g@p|trt*b42myTR!pdJ=&d+uPl*;FfW0 zZ}+;Y0GWZ!;j9B)lA%hdsI}N9;`xGGvaZ6|^~bv5isPPKwJyHL-x!5bL%I8e%k(VX zdEQeLa^o0JCldM;R=2rlE3PhQ*DS_=MiP!%oRB1NmW7OI37>k^&AXVQKk6PFT6iDn z-f%}4z`|Go;daXGAiF4R5JUq^01z3#Rvr1btKo?t-43Z?$TV6F_k>w>ksb@TkJtn3 zu7X)+u^QhjP&fv&eIhLqMMN3{uo6{JFcVwkjx`l71apR&f_KXJ?2rISL_Bs~>R>sg zsIWZ1zCdx55Wj%TwxHS~r#rX?SaN?z6hniC$;HgFyQyS9-9ow{3>UM?BKor9`GrBD zRzATP`M|MSUx&OGRLTGn|3FcPu_F2dHwn+xWpBu1xLZ`B0QVJeWkf7?DtS2kd7oAs zP+JgoNAw7pd~u+g1_RL}8lwp-GqQVKuU9F2d`sY7zCZM|&{D0E^Wh-WuXL4gSBAHA zDnNuXJ=tzFD0x(-gk{Vxmc}bVKuPCR~G;U*Lus7}0naRpE z$0*zPE&0#v?M0Pc&*gGJj=+(%_v!u;lQVNc_hS8&Q?=9avSF*1;&ThsTsppQs_cA= zN7@NSvv>Pp4&~6XxsCw3&b#nYC7H1ahbuyS(nC>|B*u9kc9T~Y$8E?rXyU!pk{RSZ8~V7j=R}R(0S)z!B~$)l&acdJa_F7U@{$Bww5J|bYY0Q@ zsLA1O@m$Ix!I3{XRU$=yrPwd^?H0AfP=Q-cpSM+OA!W_yn9r4=HlY)A?NYz<9J~xU zeLO$KTd8-buWv&>Gq^>8PA^dQ^Kd2|6Lq9SP7G{3bE%K8Ng}DL>)g)75Au?nVuYnN z?!S$g8H+YeR&9JhF(Vb}3s(J7{zR=(?d^%$x-I!NUAI8}0p=UBz>iN-2u9D3Dli{F z-xc=1I_|i|jE5fNq3M+vxIm}KzVf`HaW{5Z9j!vGxrBD|*83QD>X5)Yt@rIUnIDf< zcBBeiBUCCZCT^x&*L|-Rn5L-2!>K>BO@5JMSg->8iP+I@C#twM|4P%^i856Fq@b<0P?xo>Q${4v zwCtP4+@3*gypuesV*eWTJ|Ak)XK=^=obUqzP*vc`@|Z08MBp! z`$f1Tk|r*Dg@#GR1aI%_{!@bD~gfy0M2i=&W<&+ifw~S@` zo=N{h9u;n57bfg?x53>P>x2qfXk@sQF_Z(w&pjB@&q&Q8pThi)srs-ad-| zj@D@+7!Y)N611i0hD~k3$F;EFCYRK&_tCSrnq-8Z(!6^vUcfymIE?+j4EA$)r==@wb=cG&!}C(o4PV$AWyKp0^(=eUuvBGB8X| zxk8D(rYs4CGt>CFR87kWipSSx&F9uEybx@brJ=R3luC*-DXGSc~Pl zqsB#l7G!^)RK%B(+i-u6mnqT&S$V%c0h2*gv8sko{}53IN-aod9Jl@#p#!!06uX4E z^M{*_e zu0KEg^X_=9y0s)PsTV-|3}!j(Z8 zbml{FYlW(lT~Gn&fDbkI;Ro0!t!f@ajXXdgFn0VAWcHH(D@Yl@c0fB}$Z;RE_v?JS z0Br?d0&v_%|M5sVg69@~LtE3q-iVFbpUV&L@v{+*uwAJ2pq=5Ea)#QM= z(5LQ3p%DY)t@DAcGD-gSgg%cs`mAP+pqj5-R6Ad88~*?`!?ABW!6k^FdrCAsmH$2e z#ZN5m!>Ey}h#@h=V|V7j)e*45J$w#&I?|t!A`HkF9E@2|{|J@cO9b4@wL;`!w}BjJ z@4+x|fON3ChDZXu0@xudE6l=w;xHg07;>Q{3v6&2WDCFw#lc7LHDY0GfQ^{h_$)Hm zLUCp|0L#PM0b&UE`}8`N=M6l;`u}6^-Q#M?{{QivV-7P@Vle8I+=ggex+{`QWQG(H zAvttWN>`Us%rTiHU6>+WMWd*skVMQ$Dcws~gpx|Rl|l_O^LxG4KGDqk{ds&okMHlF zdF;p9k4Npj*It*`TF=*7uk~EF^9!ETL&_Q%I*wk$8`)8cv!%mHmk;|F{rkOfZW$(v zQFIv89S+mJV0cN-umaHRKPD*1dXoq|kd?uVJ)8~=W)`rKLEfDPOVCLl0uG>oX;#vG zAT!s{nZZoM$y$Seo!{%I)yR37XVP)mJN9h)8f7OJ+g0sG#z~s-%I(u#?VoS-Tc2=4 z4SqPHtglLbY3>{m^xXLAalFNFM6i6*cK7zzXWtYU&#Cpl;~_eK^sUB)Gab9yR@Tn= ztfb^Yrqc9R!DIJ?)b&NS%$>c>1jhAFC*Nti|E~P}*c;tlH@51kyh*MM%Kd%!9_^>G_Pbqbhr4<2@I zvwULWweamrud2kCdG4DxA8#^VI7U_LUaDh;vH8wD@7(R&UoKo6p#IZC{Rj8m7Ih>g zRQp`Z93lVCZcBk~ahm-L8J9%`y6)CT^LH-XskcG-+zO=`F~4n_dwqD1=Dn=om?P#M z?crJCtzk8ndtgc4kKWCjRpk_CJoFyx9i4SG=E3a*t(L~%Sy_H9(tBrCTZq@To_m%2 z*_~^1-@Tg_vayhV!6A6F zZjy3-%pWUW?Vk5}yw98`3;WbApZ6%p-2{{3g^AnDZtV5iwP$R6ySQ?cS$nMd@5k@g z>XkL>9`cCkcw6=tv(J0nGoNUgLw`DCEk1Eg-Xh+{x#rc0Eq|CQPxnjjUEHI5rN$-r z!<4;SgjIhrBQ|a+ANJedt?;-XCF25Yk=+e8-Lt^eu znfS!*-~lDs&*heE4%lVbqt$pedCZtyw#^N_)sGXR_3ppu&CDLVIlouytpB6cxBLDu zIU0KZnfC0PGhbWpm^*LYtd+gdiT-WrBX7p6cy{CRpmHrcowCbJ=XK}*Zdo-#EHhW! z*DrXOTz%tRYH!c)Cm+3u*>F#5b|L&)TX5&YCgyUTUYS7{m=o*Lf#+1hqcc^O8@&ad~`k1At7+E#_;b05y^DlrYkz0a@Q z=Ube=_Dp}i%8m~2*lXSPL&tso7U-s~Yq(crd-BgK^fQOoM;t5-mCrY=I_0s~>vZRz zvb(QtDT@d$y!T@F#a}pi~Y_s|iVHA&juU$uYt@?MliVbT=k{m%^>jcwi^(G?}{Y<>P3eha%v;rqbSz*7wk z#}j6kw8-8`yX+M?Eph+C-LWBS-t2U}SoYxc)kz2Lyb~CXHTmLTYHH8}k4o9=g;yMM z*C$oDJc%>nq}EG6HaK} zb4b%;=i}JnOzTr*!BW0fO2=+_YGuVn+*SHzlCG2Ej?!rdJEKC^7(IP{z+ZNi(ej>! zHaL^ZsISCvpql9 zY?@xW9_GF8W)ErbFB%sZ5t*n9><2EimpMUp%Xm{nU#S}qa*Ue_(H=W#S_9hxbLFHK zhfAS(7TQDY$=s~;fED1{tO;eu<)O`%mP+Rtp^<|#G|6%=Y{<38`;(3Am?B<~4Flk# zm2u>a0SgaVfZ|{TWcm|b<#`LhaZ(P_fj&#Jju2vtsyfgwg?J z6jy4;G0+(@5RzU@{|{!Nt$ttw1WIVI>LDsVA_?~PMmIrr^>Ya zG+eC({VZ4mz7OVx!A`@93RX(7BmNEo(A=TelYl#vKhHwlNCeCo*e;9_z~Pkp@$^vW ze89>+!ivd&2(sb<6Sm)@yy+dmbEid_RbAHKwPo)PzdRGcnba7V?^}?*cUINts;kyI zo?WACSNmA4?`c`>vsx>7=6DbiR(D7rFO6Tk{?6~`ips9(NA8|CEW^F}Zgf&$!ko#! zFZCV0FMf>t8snvJ^p3V({ZnxKRF6ZI!XIyx%9ptmzW(j_Gr6RMYa>f*=3ejCFIZ-B z)bGyM?Y+gTYUq`w=voP17!`Bt!QmuEk6eb3KXxMOKNOG;~HFr3_>weF?VZg0$c(B_so&%%=< zpFtIODt^1#>3+KN)Ke3u1s#zVL6{oX-17@ zk5Spf1BRKqldX(PcA6~9@=tnVYi_1ir!nii%dshk)J&`bCQW~&ePdZbYWtStdBJm% zp#6C?eaP)S6X3+*7rRdm9F|U9pJ(o3tD$yRLpp13@{Ls`Z%c}wmgz^_^jPcI{HXMC zpklsqboup%h8H_ra3RsyO*>!JI2M9kIPR4e-YmQO+hV<#E^WIvS&4cV_Z~7IVbxoz zFKasV<$<<86+Ft5ZJK?#lTtBr>PrL2J8lPC7`_EZWgf9k0zFwrW=O=z8*?5N9q`HP)AEUUJ6|W^ zY=TG7FD=pA3g4?-Yw1z7=miTC5!mgS?l~=Q&B&3*OorM+KxiBIS+2*grX5|h-NbC% zPLpS+F8v|bTU>a4KPb`Y5UY`6J-(ciQ7|NGv~Q+=(C)-TJ<;%kbjGl~cwX9@IxVYP zKU#;|6el-bdhuNQc9NZr$s@<&Am{6EuRmJ)w0vsg%V()Ed#)Vx=@oB2_xrkxU3N;Z zgUr)S>j8@E!3sl+1nQ@b2jAZQ`m{{X`*|%sd!)!>snst* zdv5=1!W->TRhN8C{bi(~>AD=3=#D0ZEl;<2US*%1KOmxX6lB#j+j-Q zAse3O3b!@Ac@aBaR-qP_a^P_zyalxx2ga1u-43dL56kK058_lv&*JkZt5lL4quYG0 zu1mCXKGtmI^v$ukKz*U<3p|YW5`qh%VT37TXv$LL7%6h57tf;qt_u8v*MGjw1$p&j zAsK!bzqT*l`>t8nP+sR+m407PO!+p^+-xDlz%bP!{0{@VLY@&$5#z?sg6<<}w^X5J zMKh`mgO$)Ir}4$wV9sEOaloP{CtUsvt>}Q+VLp2znOX`6OV$+wWxeeeh@Sed3Lsiy zunq>qK?sJ%+5kVx@ZrpAbmIdt!#la8#e6$PUc?tl9WR2P{>4z z3wEhbymj>^JfG+vRMDlTzv{v@vxRo4%UZ6gy=x7yKkgsc9q}U1>D85!DUPAfVd=1h z&hdl;kE11)2G5p zqvB*R9eOm-6HPyDv_xh80NQwyKMrcU^!a@ef+4LKfNSOMjYF=O<&U{UU_ zwGbb1sRwV0ySZkmS(sy(W!9pr+moW>11~MCF1Q?Ql4=cSIKIo;TcdGwROyE6he}$; z?@A0kmwz|HGu8c%zMe~Yp0<_=?#JgE4J&c>`nJW%*6Mw6)`;h`!`zS0RDB!&NVP@p zWWb3%HBHV!l^K;Lw?lYGEe_S>o2@F}X~Um!8w9{j3(yP^7y*DY_3)bxSo4qN8iACc zTl`!Yn&Lyd^HT)7r$7j^N_ecR9BiSKO1lMdKt|cUXwboR1*Yp z@W`%Lo3cEjb*&P%CYn9(i@mircXNWXN#HUK`Etdk#~B&-B4_6+!M@3t_F0l6s2!Qj z_pt4Rc%UOGtPH{_B-Aql=(=7Sk2~RUtvw=li4SdDIu7Kq(>st$wr;{W&i{3rBa{JX zH5u)R7v%3}N3?Jt3{K^MoW!F>Leazc73q`mFIj_rK<^XECp`^U{Ri4Z^}pb&;&!8YyuGb$Mv5K*7N*pU!QHCxv(@c)8wA_?oIc` zMXj*BfBg7eHQn6b?9WY*d+%oH@<8pTmGPqN#M#IGkT-FeJ|yNAHtUc%$P~dGsso;F z0EgFz@tgy=a9S2t;>5FStf0UuMX+}OvxB4B?6bUDyocQEDGW30Vq#arA3pxC9o}Bg zKVHx~RzdIVU8Q#`B1-So%zd!UEL-YsHAD&JidbML988j=A_5PP%-c$ZS}i&CU`N@R z(xMmdS6k2N@PGNsmS3h^o_9G*KdYxIOy5K~{DqnP`k-mebK>u=sy)0%Vdt3)c{AC4 z{G`jl2aSXgs0d5Ls**p%E0rje*yrhOliXO4>>PeqS*zF9NJ##Sgoe zRRJ1YFt4zq-vMEUg~og_IWQUYL$c&bjwb~B36aAaQj^ zI~xbGEPyHwa`Z1MW~3q@CAjSQMurRGY;vcFO4y$qL`QNpr{=ACBCmOC{RXGUGwYM* zs6=kbnDuq`H~DQctCr1uD0WMhHGW?G-gBd7Z`AJ8g=>^Pf2(J@t}en#NyWA9=i?7D z@{_ghysx*~n6p`H**cAz=d9)hkH|37d}ST_Y|)BUTLg`SOM=+|t|%F1MU$iHmyQPl zfdWHmd|EOLGLdm($c^Mwg*3nKp)CL%%9tS}wIvR#4Q#rxsIa!cQ)h8Z7NS5y26cvb z0lTU>9!eH#7!Q726)FvMX+Xu_;rh83|x!&)LTMlOUiMMbP6P>VsLOV$PqGr`w@6*b-f z0>K)m0D)-BWs2J zN$Pu#jyw(ve@rk8KY3FiYnZ0LXZy0zHeKe%Rl2H!VfB4~Jp@B!fg7CQC=*zZ z4?m{>H4q98NVf<^;Gx;Td49;C5YC{26_5A~yMztw4B%WP5m?E{X8{xKb}n==JOAwK zUt0G3p4fTb{Y>H#_idW(OKTmbZ*TrK^6Kn`JM@ua+Bs|J}Q=QXSgTD-^J-@p39IdgN% zHjU`FV*G(3VpKrgVPeJEAm@S@;$Z6_l$;DSHlt->HUCLtzZ+2fK*|0$%l0b>g?K}G zV}A_VR5_xQA17gChVsS4U|~X#E}+eW1hM);^r&(ocp)8hGPwiMML_oz)DA|YG@Xra z7sjDiazQ{iCV>xyj}K~b=m-M^x2yyz9Uh-21#G=9Ycx*YKi6buN2GU@o`TY3PlurU zOI$CizAl)V7(cuAopS!ug}W7dTb}7n%dHtZG}2B_g!6N;AE>vmBjomg<)PdUBhKoy;fFMc~N6jzsGpi)FwBNqgOA+ z3Yv@Z)6aOL7K2O!*Y!gu4eFd^UH|{SdJ@-M7=RX4!0O3*Fs#_YB~vNTFJ!Ab>NlQL zgQu&&j18tHsgV6!0|9D0FB*l1z424n`c!DdC$(7;dQ;I9%ub$0x0-8F4H73i=~jtU+sa;C*LiX6{fNyUHYTVfcpMB0Ui|YDA^B|q zSpLCJj{_C!-?7g(#DzG}+tmVBJevrbEME{dCk4`#91jPMaDkDPu`_sl>+#u}Ra!My z^`8gD->MQU6`#G^V)DxSOi9~i%PS?8k2@ke+TSc5@@35;fojhRlR##ML4Sn>CC9dk zRcvIQ>`oUg--Cr_K|OuiCk$7;eH7JgXtir<;(p`aAFG+)W%omGD~`2;I62lJf*+k? zdvh33Mj%u%X-By;KmJwKC6^LWxF@BlSLxJm^?h=)e{o+QJ$BKL>918?zIhUnJ15{T z#`=ly;SYrxzGu$A)&EYgXo`{Rj?sS>+~yle9&)lne`#p!`1X&GBfefUo`0KhGo)<@X$LACIdWR2Lvb+_PUY3*W$4dH#!m88 z)X<;gQ2YMK1gs|mo+Q%#J71DKpp06JcfMtR)V-Wphl37(A2EGayCiU8#f^ z<>im(jvFtPIOHGqA0%<~$90F~NXFVjvz;x1lG3Z&V=xCIJ3C2=S`iVEtXq(LL`33J z;!&WXp~0qivsG5SMkz+d-oBns=BzqKqaE7V#SkeOu_>6kb*y!wg5HPLTc<_k-VZIi46 zO_i#|jyrzsxc~_aBbql6IUN2fafW^B0d&I}3>tyN!kjoS;>L zZW`DNvc>tI+=|dAX!meXgIF2p%?NUQ4Imd}tsi`ls}SK>4NPER+Xh`fG4>3E&5`@bFcKTJ?e&yIoFmt_GHMACi|v&Z8s}#dOzIoMYN`Eo9vJ#3v@}pxjueI zWq73Cte>s-zq^QzFDgQftXwj6$r1^4tpS^nIhxG({PC=fLdBCLd)*+5OG?;->^==QMp7_~J8JQK2)MBz0VG z7Wjb|=fFty?!`aDlm5tHKE4b&fG=MKOIIFyT3lkC*Skb#+~;gkY9X>sQyU=x8F@|H zR#|*0-yiS09c3>#&>6-CgJKbO{`pn#kee&SmH+ic8seNitv?D7i--==P6E-{_>SqB z?vLNs83@uASy@P;%ZY^Cmne;ch#>|nijOa|jh4xK?Wh@LK8$tNHoLL=Va&rCdB_|m`;AHn*Q~<7L9X#`evyqt0!(vP@aAvupTV56*MBV zWYs);Ka(^r-qC2dP26LrcYJ(QHfv}^%M9(3?xFtg$`FYE8e61W(YMN^!JI8?oA!9e zyfSIF`N7~z-R&0ZnvOjC(iP3V3p^gr%JKD5{sw${jL}hD^Uag!7Cn>AZG(fJM2A8f zSYp|jV;TC(LulFl9=$>#w3nWk(5KkhW)p(s!;{IeTZf{@{Z-v1+H;`I016knxRMoD zSk#QuV73zlW7g~7b@*^>w8$6y3Vqc=yaSI*@w72=*G?1|Sdg@Y9_ z(|AZ2bhg<7!ErL^MnfENWW2fG1PmB%{%o=VA=prKg8HF2;D{uFENO;u69|v}aRn(v z2)1j*!Hpc2#c~!bur%TWJI+{+*g1!PYG{t&xH&TB2XGe-Nw3(u>aEW!%eQl6i(<=T z#>|_3;kPC4#_N?q$CrP2I3%f-!WSE$tPp`TOfD14fv3}BQx9K7a?AbJd!E%a*rZ=5sM_mNnMI4(oR<)o-fb9M zq54hro5T8D)pcNuo=5rl==t+P!`wUy^c)P;!>2xO3--#&VI8*cO;%s=YVFPslV3`F zluniSxVqeS=89Y8ie0DqD_ayTyUGR2ZT_cw>%QD_#Xj)Zs;Jjj9tj~g<(5ZF9Nv3% zFOfc7q?6TsLNl(&GWWmJd9|K+Y>smKc9mfJLBKZxC`s6X6u!D+t9CU6)S_0mW|W7~ZYxa4$+j@RGh z0|%e+oqp{^j{Qo*S%D-Ek&T_cH|0;u6j?U=-jp4R*@A~*d$7#ha>`?g?*iHVJCsIL zI~Z!(mehqbja}9m8xI9hrlU9MOlNTX5{0m=f+65#WHrVOk8l3pA0JG$TlsoONRx)R zGorC{s;2D|*>N|w?1T3^zD8CCT_2`+Dvi{W!4Jb^KaU-;%zCtPTs}XN~v#bEF=G=Z6W@KPLD8@wf6Ro$9<2Bpq4pX}SXR4IT-yE883kI{kW$J0;Rfvi|p&F()}UMpR4U z7*XxHcwiiXpl}26of8CAK?jkRnd%&f0HGGd1Her(oqnJ6!O%Ti!%}HDs_N2cSI-4a z(sz6z;bA^)SeJAfK}pM`PkV+;vHG$o_0>#u*KYgsmN$+K8R=Y_6_99UKc+PLo_qMk zMqMdT*7Pu1`S5&t!L6Cv=ObOTZI##5 zH$M)Sd(v9w5UK9fgaNkw+`X(dNM5fKeW?|eDpqOQUT33nO#CI^re}TDvZBq_Hli;D zw^o==i`fm;c44h~t`ecGm0I8CG9@U}=`9*3PaZvNA$cfkX2UV@{CcrWqwLL9Q($e;h`w zVesD`_C%M8jL~LIo#-F!>(fhR#QT)J?lENgI zm_H0-{t7aiqSPIY?CfmNuc0IYO?y>4qixc;lW>Q6WkjYnBk{1zz9ipfD*A*VC4Lyw zIcc#VCqn)bi0%O^pX38Ic&de20Y5|>iSz?Mf%jmFe+qncf^FN3jW(anQKrTOnDAHE z04eVtX0&h}ZDE{zg#5mUh$B%LcT|)S-)Ng$L#`^{#;zWu4P6HjVIYvq5rR5z14r;H zeY@0yc2V4TibG)w|uFgCg1jXYDA>j>MJ`JwBJxlE)DL}C;wer9o;L!vy`HmIuo?)INqmQ568{l2@~d}~s@U`-shUHojk|w5uoZq8 z!IbG^=rPuwu_Pi}xE8=Il&YKU1-ljj(S4=JqSzEfwzW9EK>FSsy{rtHt1#fO) zakLwK{lYCtan|M;^~VDe9Usarev^ytdt5P(=g+uwcIAf0ey!7c`qhy5-!Cy8gPyBb(*bB(vXvxm zzc*r}Y#=313;1*m;`@o9V>#L@{gLwWM@`MXmzO4;sr!$aFW6PQncGznIa~y)OsJ7%ER zP_ApIwkZ^w%Q+rdWn!``%TU%l%Rk0L@f-PwsE57VMn)W;Irw$(`dlleCp8+OFYdN{ zIcihp|6{k>nQN1dL$Jvg^4){Y?)9FNFVeuKdX%zuYh{Xt zoe-KUUueUMYut;$PXgY}J&lGagYN0o+K_j|e?xM~Ht?>!9jwQy1>d|~IY!92n$i~hOj ze=bL=)q;IfWGxd|SD5^VyrYC!$Ksh zTl2}v0L)_!<^X1>E53qBVN#5rCdT0h?AeKJJYyP@0nsE|tY97dr*lAI&5?**_x|Y^ zP+TnwAz-o_Q6i^y0|t_xhC?)z`|NM4;yZ9RWO4F z!NMu%q6itSIM@wC`a7yN8NXmiN7%gr7oYszEi5x2)8k~(G0{Oyr@`=5+VQU%s-gfC zRZ-9eQVIWsDq2fbl&a{zyA`dYDoR!K->sq*R7I(Z{<~GQlBy_G(SNs!-k~Z=RrKGj zqE%Eysfzx)Rg{j4;^-h9bov($I?-`as-pk$p?f+mN>%hO;}A2HA9EdH z1~8`lnCmDH`HS*n?qf{(G50a1{FwU~Q+~{Sj440nKE{+Eb01?mf6RT1DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~ru>-u7*l@CeT*qT=03)hA9EjL%8$8^G3CeH$C&bC?qf{(G50a1{FwU~ zQ+~{Sj440nKE{+Eb01^MkGYRA<;UE|nDS%pV@&xm_c5mYnEM!0e$0K0DL>{u#*`m( zA7jdoxsNgB$K1!5@?-8}O!+bQF{b>O`xsMx%zcb0KjuEhlpk{+W6F=Yk1^%P+{c*m zWA0;2`7!q~u6q-wAK%Dmi5P}wQNdUnFpLm#&4W98*~6_ujy%_DG6IP!-V6*h2fQ(S zMuxmf#SL_2h#x_|=x>gUl#Goeuz-hgY6UTjAU{aR-3KN!5HIAR1+ z=RiUMlT)zc%d7j#>K^9o2-xkyEUlP%XN*I7M!}d`m6y5(>l?wR)=_6im4;jQd%7OD zY6ZFPJG(ngyQ-}5;r8m@HLsCjuTQy3>A!mv=aj&Bd}NmczwhGP!xl7 zAR@VJy<_LzKJQWB?HYT``+QK*1NYcQUUi>{d_;YL3v@$9WEf4S!SE*S_*Vs0 zQL3Wsr|sESe*{dcQq6;)BHqW^9ct)?nURrKGjqBT@Ssfzx)RkW6> zC{@vaw~EqnQ5+ql<)CG+urE5m@=OH7rw~bAd?aQJ~i>9h~yp zT`$Gxu5z8+Ny)R&zn;fS)!QA#e}smf(0wPT0gfgn5KOqk_Rqq?^62+LX(*<9H-=_q z42{)ole2;E#kZfd1$*Vo6AvD3`i~VtF)f>xwz55WtZO&8l0*QR= zNI#0CtJ@sw=7+hC{wSM?iC1>_!Gw>F`A^Cu!jFmGX15GP4nI;@uGk$&GH5eU6p(d1 zo2MAvYPK*Bp`^2?Zdv^ZurTp#i{2DAc0Cq9NqIRb;wNqE%dX^3dBf(+WCxow@KP1S z3I`##w^?ptF$nFCJG?BqgGWkpQFr1T5hfgd#HYRNYvxnH8;@CnfQ67(@M%l^gv%Td=9FZC{ZReEn^-t^*6(m||Uf7J`X=TV}{ea9uOK z99Ngcw7dVhP&{f_(sRN9GITV_lM zn~hqx2$P=5>Ltpr?#sH~FaF+^)Q|uWi9}j_n`C7{O(sSF#RJ~~!2l@33Gw9d5P6jD zXjp9f1am7RHz#w%U9Ztl+=fQO&gJd2TI3PbHe8_kkUS$CmA=VtV*#S3vhkWi5^$rA zhrcA?7zoIJnp1NnxcK&s?QP2isylX0y6_so;_n~3!T)(Sq_{)szmi1CD&Nn__+etl`LKLL zEARB9ruSZt{{4KTLqwgL#>l3(V#P-$b`v#Xd^g`%VrS8_{^E^|VJ$yu3cT)Lytv2G zn<(=(|Lqm0JFi}Yj4MXBm&IvLb6NA)d)CChs#pViGjYcUQ)rqzO4>XOmR&V>2~!(Y zH}dpvmuk~IH{OBiAQ?xTN#hyd%p=Tt!BiC^6_0aOQb7XoC^1fu33v=lhH3eJCT*{l zf>TH^Z6za=f!VYaoU9|0SCueXCl#j(%{9!?NyQ7;sWAhXzGL`2i^@30a4iJjS;*Mq zbQI35$-p;Z1tea}oIG582`2_2u&RANIJ2{IYAK8yPOnMHSd-~2m}9F9B2#gEk*bpx z`v_s=YQ-@9#}Bk8^KwQomkJYGLh>D_@EnCCxQs9#5@Gl_a|qvwcbrdjEu&V{7idv-sAvgDp-$Wwowv9>%QK z$v$4PCwj7ez>b&x_nut$57=o`H$<;_+`3x9p;b>lBzzm@vf0_eBz43vY=W#4XPXW= zaU$y$G-I!MQHj1@@1rddKHaOH8sH3V2tF$QQTA<{$quQ~s+{akkJ0!T>;6GPem5384}ye0qfJNMp`sL|-~E+mr|8VR`v=MU^DkwZ-2{#46TxkmMX1 zm`Prwyj0qTt?L)?pFT0tHB(zuUD!yo|HkU`9!aq(C$@cqE#?c`FTKvy)d+>Z^Oze9TL?AOEWC8Lxk_?>5v` zMo>X&mNd*1%SgrX1oc?^;DUoEbDqt>iG*SEF& zDsS`GeR(8y{veU3O5o`~=F4u>wF|hCXL>MBt(vjtZ%YVBs(<~s&rrtKKkBG$?Ctyd zLj@&wqt59#Jeqaz$I=avyC004_rR*yxPDI6fm3r`LVqlsGUsJsfOUpacB|dFc7+X* zTZ7g`cPeHb%(c3cbT&2O{z%>4Q3?eCNp=xM8?WYW-nMz$t?ee;Z}Y~ArQ+1$7+6IB z^X=G3Y71^V@}Vt*We3=dz)}K>3Tq3sbC`Ek%s*L60B`68+S0?Y!UGGgf;5@1;=mDB zNf5s?Ey13*$rqD=rqCW%31CAmfRTyGV@z=AC7HUSXVPl`Nkt<t5Jcm@Jh@(k8MM#|R!vM(b)iGM+W z85ZLg0Wm02@r;z{ivxe%`B>v%A&m%eP&WWo$3;7pX;8(mra@3humWOa#PAI+@(hU8 z{=%s8iDBW3q`?3}6~T1D8leyn8_{xW0}>197S=s6g3O@AngU3GR5@I>0zt8w0c|H28Bl+J~$ZT{-JGJU;L@s?Q46?cdn1mDkyxQA=U2hA7py_!L~pW+Hv&OZ%=s~Y!4Hu zH8_%0M>3nBZb1IQjEjhs7C?IiwMLLHhT4VQl>TKutRcrb1ld!Iw=mEoB@5M0(wPCU zP)h+7hQA*x73rL)!2%(Guwvi%S|}Yp!`l?Z58Mi6Ni;zY$`R9J7;V0mh^!{U3Wo&+ z36Xk%-3Y$S*7evbB1X7^C=FL20an%q))uOeDE5N-7ZTMAWriLRK^2L&z$64YzLK5_ zKahV3`YV8nKrM@4VGZ9Ej^{@(cB%p~)NmAvpvzN94wWw!r}ot7o*(HQu4~lxWydDf zd!yRs+V(lGZjt}Z!{}g-W?B6sJ*y2VR^F4J%(FgLJ8|3FiGT8yHz*BplAUR8vg$$I z*kgabFB{?f+_E9FJSif(%rze4W>ozA=By(MaP>f>bx^bKfkmUa)}Lj zl{WO11_6w4VGDOoNFGT66FpW-19#|WVh&MFWr*IA{unHn!qUfp*bEM}C-o8fi@yvO zktJGaTj0WGO;u|7Use6J52`J?t3rXwKvi-SveAG8|8Qj-1ORowvXq!KMhof@)E5H) zHeF)vH2GrifDwVVKs5wCVWfN)#K8?)I1E8*9w?XyjGcf-uo=wM!W$!LG{z6L$JJ%f zX#_XCh_s;4csVT?UJC+2kCVK@L%abzf!>PwK?k=kR(W2vs`b6xu#I_*PXp8g&IDCG zzZszsr7(QO*2uXjEi*0itgp+Sj^FR{vT%6CcAvxjHP~sXT;z*eZs$63tY0;zI;@X< z?i|~ZcWdpm$5~sG_Y}PB(>ONW{byaHq<2;NnR0@h!k&AWIc&`txyrP>Qj=pTHSRl{ zd|s|>ahk7O`81w!k}QFDquxZ)D>F%btrb=ck`f_;8!ijwp80OSVXP zyY!Y~YW=C_j-A(ajCVYrytZmiW`5fRrO(DB1eGK`ueo70Ztk;kC!6=7tv}W7-z|Tq z>00g!y?d#*=C%~9o;k@QZ|qa?`k<`hT<>rBdu+D|fX0W0jC_I6SR$0l(m2L>c};ltE~LA^WoN4_x%rr-P&-aMn8M%mZ_!rDOzs# z_XN(5bdq_rEN0~W5NmBwi@BEB<#AT|DrFNjPMt~4(iN%I`(1zrYS5M`%hpb4&+v=P zs7dcjUETe|qUfjTspsA}2e-+0X>ZZy-5oJP-moik=9-;ZNoOM>?yDzlQJ(a3v2p8b z>#29m-ssz;M=aa9W$%^O-}CbS03#&PdKrjb+7Ua1P(qk%=-3b#@Oku#8D;IqU!cyz<4+GZAWuYDGK? zL(&vuN|J6P!`l=jM0SEnN~Prl0jB-SYd_L>2nt`tjD0P;4!RO*BRDYj5HT7`Xgmcd zAXHR-poS2E#EP1fYI4`f$SJ}dEbEdXHb+`uqcZNV8c8L~7eTKG zYm^*=b)j}YL;x2Qu9NyGOa_zyOPX|1@O}w>8bA;R#$i<9W-lW`cV7!g5*`p5h))37 z0Qv@12r7~gpnwZ3rT_%O=pgsdbs>rZFN1*#ilIu1Sxq1n3!K3P>a@Rbp(e&GCJ}>Z zLVrvhqeL6#WH3U8ui0-E0Yr$pLI_a|QXX%UXY6Qx?dZKEl?1yfv-1;LtB>gFy=mIK zbL-wiyw-#_DW`fI3gl|^^Uj_v&3e+kEb_5?;qOZ=GxlX|bqshsQ9G~W1kX%MeT(+I zooQW0S#`6D+%qG;yi)Qs^XazUwrkIsxi^L~U!GcirarR0Dq&N5&gP_>o2O- zw{!ZC!sA67tL;-G+XLb)jkhp^{L(Rt_RuqQg3db*pJ6W$S|zrl33)=@#HH%2)-r1B z;FXw^e!d7-s6+WrAOXb4>L4KG)Jgh(wtP5t1{guHfi0DGG=jcUJTw+W-Pv9+R8=Y8 zb;rb{_X;1N)z$(L6;8WN?hJ&+!FOKv$&V(fVOUVoIdqrRyQB=0~^O zcN)F9pJ`rLr06CW<+)WeIXXU}UqVZc6M1<{;gAb&+|=ZGtN78?Oi{vXqTJE zu_7IBm4uYb+0W#HJ#1cieq*xax6M(N_aC?ID`?26i*`)dnR_=_QGZhSgQ(e z6}lnmY4Wrnm)g6x)?IfoQC{OxXWx`OX2dl|zZ9FYwsorETOWk)XuV!kztrmYGVgVN zBt{0DUo^L+v1aGiM^krCee!3KkL(HW(!uW^2Y+}!;(2yadb&ci`R0z;MBav{H}A#o z`nlW1J(XpS2{o%~u8Urc7~W-EY8L(Muz*xD(ujc0La!A|5h^z-EDwe-8NqF$u`E#s zdH{exp9Dw>T;K_Opn`+Nz%~!+l%EKjG;{_uCd6S;<5!6xA#EEOK!r4z%_sk=C3RU0 zl?Xrplp#R~3?`ez0MZQRZ33|%5!3}DBHZ}CKY%4P62l|x1;APfqCh5~mqgkmXy@ZV z!C?5t0K7mIi#LGA3cP_f#tShA6>?&DW5$C{LjEd6_#(yBvvrV%Zg7#%L<1ome|uHX z992@W;ak1+f;hN|Ajuq$DctK?3Q8bV$7yBG+Fil4U{-AH{1q7 z8cb+5q2O>>1LzlsQ5#4`1E2@W)Wdi%bSE+E(3gY_C)NgR*2qXQ7&>_6r>BV_Ki2D* z!D#zns0^Y&!i~wqTc|qX$TrCi*u#7=RADhzVyJ3tEs`UnE$CgKJz1nV(FmeoYc9l{ z1_l$QgGU^?2DQ=3J$POFbzyUvN~%h}iAT6u!5%%WNZl(D{-u3ZX88{T&E1xnjZiq{ zZL)D_@}Vhj%&KOpJ)BXgaI(8?8h3QnS^SDNfSZU_cRpzF^A) zpkW^IBI7V>ai}gVv|xLnd)!ZQ&7h9lq~bo0qGWDjgq9jn(c+yOD6USm(uNoG8HLF3Ka6o7$1C53QfyL!L}p=?=h zCX&Xec?OUa#t*i?KWEs|vUwOdD#CUF9ie#?Vu%XRYqnPp!G1+HjTM-!m88ca$&122 z$3#R}43ISDuVSJ=+P*)JsFN_9Dn<=RyJb50`OMwz zo%78L^&JwT&*V7<)p+X{i98e3_uhy+n|l0s^y8hz&^?QThz8gEVwdUY>3H;Q{N+Bm zN18f{Q_js$xng#{Al>W9!q(;u!!lhj-Otpxyip_6r*dO~b$k5OgoEX)@7~qOI49RN ze>Dh;!y@+3i9@3dk_W**=*QI#*f7PqffvX)yJ0GRLLA{?kO{STQc~jl3+ou@#YsZ} z@^dZJ*MX`MmB31eECKX@bSlZP%Aij}BUtlDeTQvMa#L;CjvfTHUJuFPXeAbWrASgQ zKans$m|-DJFR^QYv?@P%j&oi~Rn@TX9FE_M{5IiAjqZDc&n+M>07L5(nu?h!=|>bU zr$(9AT~M6)`1#tNnuXgN+myyy6vo_FG~W=JS$thbrOi39{95sq-Fv1lvzoekVoFE& zaQ&Z0J*^s%(|4_I%8R0;m~M?GW+l`K0e_p&M$>K^q(G_*sS`l__-UA1yeeQc4to9; zJR@i#q3IV$VbzvY14)|;9a(u1IKy}cxa2?w7h`}Z<1hxcuZU40&tflP!*OpNT!eWd ziZGV7{I80h@pZL7>S9+4hH>FD*deHXMBP;($}}>3sES`8Mxw~P1;0XFi5G$cjwAx4 zARYt&QzjCFBRqmYa#}(Cbp~lL8#$;mjwTY?G#r~&3D;tn@&EJ4JwH#)80#31AOm+H zjMcy;CYffILmgx5#(%9a+T#o3&^K1agN50bhbBE3z3o7`}wrtP8~3tbP^G_IMJ z{p&D~{h6~)I+o6!djI|^^9TNKE?8}I(<*aa)fImEgjTPA;)bhs-d&Gtv(9R)b{hNQ z?x}~jeSBQLZC1Mxd(LvwD$jXG;-2;A(TpzX~V_tT)n(Ae(kgz|G z;q)cjfdlS}BZY8T8vwvCOb9)DA-?BB+pkGR9mT{V;eZ7rxJd@fD}&IBG&JJ^U@_95 zG3jxtPz9t61;<3B#K8#3;m`%D(%*(Ih(Q9_KMpD~4#3c`_F|P|2RLv{0`SNWL=2&L z!Ol1uz(*m#`fuzcIhltQ6q1KHf%uN5kGJ?-G)HVhx5YKJEmA zfpEbF)OZ5{>`#R<<0T{aSVMTMwqpGt#XVRP`s`52NqYwsK(1CRh1uL}4HIfJ ztT(Rx&`JO-1kV_kqY%;oVBiu1+V}kqx{1=3JMyJ=?TF-(vk* z8J}Hmw8<`A*6OfZY9Wxd0Xvlh!-1?0LsKFLB@e@Tq!|>$5IiGL2ZO**6JSY8qaaY% zj)`EH&KFussdGy={Zb3cPKp}_@6cpp{)nZ)I>xZXiu9d7tqO2lSpi_ZqJq ziaHW*cs*OI@OaJH?k>x-ey0LXsg$`#U#M$#&9$hzvv>Ky!cv{9r*BS4nwIQj_rhhw z&T3<`Rr%iT+sv1(um8fou*`02^bh+RL!?*DhZ!sbm@@{PK$`(~uqSHgL_}O^aB|XO$Ipp!LVd*O zpc1eXS0a4*Z^LwPMC<`m#aeNaK{`?qprZ#tr9jiqK?G!E4~l34_TE8vuw2lY{AXXB z3>Sb_NQsE9L#Z7`aUqV6$_=GyLHvVZhGCEt_!G0L0p-(&Mz@iPZC7a=D#`GX16GA66<~#gn5sZ!VImA zSJquD=Q`|11|)r;%tmZv;vTHpsQ4%GVM@MC3CxU+57b#aFzKZvm0^SauO6k!8^>VL zvVz(dmaWKF5h*3|MUn`FB|bV8NXZp@73t*eOLdWAr6%5q z)J=*Hc?2l(WqQ&2M95w6j|2Tp(`;`Z#?Q*;lTskQm&v2sh|+;+l(KGrOV@TrRpLM8 zQx7$X#ljkp?39%c=6L4r_wbZK`1D9Z5kDlF%DH9~lO#^x_zZJgjeA1I2PWV(E5PJbe4L^V`^M8}8UniP771Q#bpIwkW{zGmlb;?)25|T?dA? zvK~A~musiCe~Jz~m=4Nnt$8qIr9)M|;-n~Xs#gXS{2IM`kOGk|*oAnQAxVK`mPof1 zlns3o>1KYNq&yp7Vg4`G=mu`>ahPriN#i`?Gj8tlS5k9i{hjeot9cnAu7 zEQy``FZoX=k|4-1z!xHV$p3FnC8w{h>T(;l@o&+ium4l@P_EA~*E!#kg3vts__5-R z&o=@{nGz>w$n~Ts_J#b1vH>TMYci3Z{3lL^;qZOSRnx)eOJm#ZRz6Viyb}4ObIFH$ z*M1G0yw~X+6a+{bypep@`|3As?_Z0Sfu{qrep=I7zC9L_op*{XEMZm(`+_VbGXJr!j;xrJwS@Fh~7>6eYUh00V{U702$^Ry%dgzkanG=d7 zG1Y+>puO=}#4}Lh#taZ(deO3}kDL9@=Qu*{*2}FU5@^OB3j7aGPk^j0k7oMaGdZCE5pUO>u>xJ$B%p_cj(_ew14 zsHmA{+VAq-E%i&z*lsqjIN?^&Wy5msaR)A5K2yHm@wM(X97s;w=PyH2ysq zhp@Pf=*z7UQ;}ct8OixdmFKm2$QRuX*Be>ewkP951`GajUbp!iRH_^jiQkm4;%<*Y2VL45%rREhab z@4)?EwyJ>a|L}9=w!saI!eg{+Y$N;l5Z@aPD6GL?B>s~9!%X@;HBZRb)$NZo>ahRT ztp1n4{dRUA<7%EDe`r8@-=Q2HUg-7kJ|B?n3VzK0?z3)4w;2VVJz;>XzZwq^_86Nx zl4zL!n2%D~PF(acwEXw`3h_e($?C5LH|!t}Whk@l6o-;EA4|u1Wl6=S@`?EVlPsl0 z#-F}iftLZf42ytv4dd8CN-tD%Kyggd*st{|Lo2ro9U$NoS3eSq2P^wU9fK#B?K}&} zulx_u6OuobP^b=D_(bN0U(1HqEc#etVG%b!l@o*;SRViQG*NIR9puFHJlv1{U6`;5 z!Jkl^rg1=y2tyPCilu2_@t1v4qAOqx3>Bk4LblSuFleCMOaAV4pbDLiT;BY*kc&rs zf>qPzPVm&NeW($LS&+PDe1IH*tsZmW90OU4`2M5XsLxdJ23>h*apg|zW6ht6QWjg>tMeAta?|u@jZQu9(uJ5|O zN6a}nE9X4V{oM0+-$%Nq2|!EB2A9}HFk!%$$KIkrbp5l*b+!bIB`{qu$aVqq2U+=m zuhjrFl+YAr@JdLqtxMqZ5JwPFXb=oR3kcSt1)v?k8;?T5;6q@_!DYai&qI5Vs}G^F zka>vtUp#!sHo{=*#Yv*D6uK$FR^mk%3v4dr6c=}AfIoQ|Vu=hk90a%Ex^M&N955UA z3lSqiLmt_t48e9xiwIDffvvIb$|@eSbKy}Ik6mM8 z^R=}}O$~HEZ>k*Dw_}fcT51|rRZgqDMTYN3YnS0`!yaiYh33^q8Rqxtbfm_^Au08_ zz8w*`;dY*85ul=R6pAJ@vN81{Zzrc*12*$Di#k%#W-d)nTNfWo@r`j4ORCb=6_ZO- z{@yG#wY1P1E@IiAq7G?v60b^^(uc0b=$mf2n4|-{;CwN$_IrOFUV<+CYn!{n zHgx$42JD8baQ!GGI2zpzUtC*zdxTSJiUx(^5#f}kErYjKrky>TnxdIYA;Cjn(JfHv zXdTW;#fo)sN^lmb@RJl?2|C9iH3hDL(bmQaj_6>DYHN@!+PPwIZ9fW4gcDE2!VL?y zaK*T|_Vz*eeVPnBrKnSC8V0%y)839vO=ZZUzX&)T{@_6{=nsQMKP>#i<9noMlP|bl zh#AqA*m=(4o=-NbvZ249!Oj?RmL6j1HP%(%D0cP%z>7kfwqC`}Z!N>e>Rl5OVr=c! z5ZwxxtkE?Tzpw?OO+Wt$J2fwy9uvf7qC;70BrcR0Pg=9uN(y!8gahFAv9f2y$uOQ;PFUER8ZXnMi!YQ*!I&0^()u$^-lV;uKim6mlz(dr-hC z`UJm%5Xr`ZGe2`c!BViL`-0x8Tz}H1*y*k3<`SNTkoaux46B}qes+%Mp!SPAk9X#y zPnHsR>K=Ai779E*UP~|K)O5#jtVaC%$bNly)$e(mSAQ2*OfE3Wc=)c`D72WF>>Yc1 z!sBC9ZoDsND1Vr>q`$|jG{9<~2Z} z!k+-931COfLU$Igl!+m`6@tTFGY7|0h1!0aOz18i1Nb;ioYb_Ay@T~`!_%owE3bm9 z+Evdl&EBsh!Il@;qa>wEd^ln{zhWmQHU81bk==T&fbrM{L|Tn*V{L0c<8vs_jK0N@P0#D_dQL!7$3FbTn-;l{vkwvqv*63LMA zqzl7Ig_?^VCCIZ15d>U)A(@0=Q{dsQFT|~b;)o@@%VOYwg?IxOLZl!ZL?Y~Y=NOtL zqK;6Gkq3A4^4WHRsW+35-W4HiK3Fb9@WKBsY9>k|iQ41i zvLE%|#wyZ(-|k{Erutkv!pwQ4Y7O1&cd~<`I0^c#Gz)@4WD|xCCbG;Cf~TSmd*Ez) z%p-=FmzLu_+P-h+k;eg{1yECmf61yOT;WQ10z zjPvRCZ8LuPd1b*T^+igxrSka;VRONKZC9GCn~#6Ye7&luQqw@067$h_?5y(%|pCmV(b?pprd855I`-*LgS=89bz-NydW?E@GbBr1~ad9}{2i4_sQ zw`T9X9iB44-Wfk*(@HL!z>ml3I_CPk$hh<}%#c#{xM`Nf(Y%*&?Z@nxw>vb^haD7**VZX|EaTmtZwhV z^OjOQM@~70O)*=3mg}|9XXhDCXLLH``h_}e*{C*CrY9Qty)kv0Oc&s8yw)LfE$|KoK`brBg{kraeJ%EJ7WFU5mm?cg`kyl#i)dI}JYyWPt<4WL^UdVlqLRt_ag<_G3w=V9l4Tg_@J!cR(ytKI zhEj{&^=m)vQ`p_?RM>mPaKmiJiQudTx9s*4oU?7zAq!K@D_<9P;9s7PpeVWS3EQU< z-27F@H~AwKv!AS(+ z&MUz8aJahcPy>EHOdMcZJTA-%G!O91)o8BpZV6|MkTD_15W0B?`$J%>hcVzThXkW|KJ3@ccdnf4yB~OKU zaOnHc>bl9Ytk3N}};ct9BMFAJ&mb4&{#T9Ibg-=20B(W=+lBZF;8DOx0B0+M zSY{T|CJ-zM9UzReiV2gnFkhqe8~|iM7eYfRk@$%H3^)lc^moXcs3W2vM4Yhr%&r9M zD^mYy2K|aO7j#o7^z@C#0W$_ha5>0Xh6~_C_cH{{PDVfj*!sU)LGTkoYK1e=EdxwU zOl~beV})C5^w_0@Zf&Vvg5uZd!2F6g&e950CvN`dl+m=5%kGg^<6fD+FYVQDzy7o; zzRv8^$D3U$P8y4EZANw!I0r2D*o}I2MVM_mcBObBA>&<0#);BR(kD-=%Wb@A+j#mz zHYKFD%*ZMew>D<#+t+ut*1ioH@wgi|fcKQ&IiT>aD5GY-gU4$-mlK^QtVk=2v30o- zJr!QJtGf-Jy`Lz09KdG>+M;~N2j;J4O1lPqiZ&h%tW15C|Nf)3i)vNO3*Ib^z$KV zl_~2#-xLhL2_bj|~jpsL)z;oiabVWb-tyabD(+fQqOA|K`l1EAMXiUF_S% zpG&k;&Rjox;Zz;zh2?Fx*Xk2DU55wtSb{(XF|r*mKYD$lb=lurBCGUC9_?9<~r27 z-83r~HSZNGG~C~|z2gN*lq3?n?UzI3A8uDxwx?Y1CrsC>MKZfDEOffhTrhbuK0e@WLgu5}FPWkmhwYYKV8inPzpRG#bs& z(Ti0@*eanlSs*RRk&3-^JN3y!E8Gu_Kgi^hQY&=cY?-u)oA`Fh=D32K^E(ZWUx0-N zfPOLSfq~W+iA1c}pMyK}5Yc59Rt#64B@CPc_rR?rJT_ZKobZG^BBOGG$8W>Wk!H20a&o0gtQ>&j%Zg;K-_5U zbFMKnMEP(?4{Mt3R$CO=82Dxg~dJnD7fOl62Jb|a;U~wBLlaIP zy#l+VA9y;s9Un@0rP9@Oj74FqoU)K4O5Rp>P9z52Nx7_AeA48ALl4=IdW|X;Tej%+ zrp>47TC&}B>2a<2`~mSui^;S%rgB^VV;(L2^+jy1<65zcUsD0O07@y`u}1{%(S7mA z_{*ztsn8o2Wq|iPa#zSI3YjPdzZKWm+5cnkcYv|{qD}rgcrW0F%P2))erRyIfXg8u z27GSG66Sg9V7c%WqUK1o7jRNoV1=9%2nkk}kz!;sFc<(UEx?L_PYF6&kn{sbUtCVG zK{_`y0q+#Jq*i>T0U96(J+%2>fMIOoS_G64>i2L|7bK%DOeq zB?E(5b85rhT5;zZ`jroPY-f?ZLzXrcGq~SIOZJXXmI%X{rY@S5;mNL*ZqGjM%)Fm` zK%T?;`FjFcQZmVUD`$Y&ZTn$g@>gMtCVtt)zn{QPj#AD&*yVog)WOg})&7JH zAD@4a@^^XONw7VrlD9K`#KT|v;L6aM*atl!Is7wM&jQoQpK?n7z1bqT;eOP#J3iolPu@ARF^b!Pb=`1^=e;a&YteHP72Gz$Yx8;d|;4jmCD z;Fv+S#ZzUv3%&YQ#siFyN$P`n4B$%9{kLpd(^IlzmFq6P@~+xY*+y}1Gz?9x+wC*& zPC2O@C*|6Y-;mumU>Z^^=9447{-wVvD@30l?d+oO@a$5-O#a8LnVtEW-}a^6TPkrL z$gS(#yU-(7nM6t?e}d|id`!!3xH&*` zfpLrhpcv2>^qCms?*n-VSRa_iu*O4QQ6uD+CJk1qv0lI0`cSr7>CuDzy19E5OnU4r zCWCyQ-k|tzAa9xMb#A^Ydr!I1t}=6sQ++`33x$HOOX_4;jw$Lg_R3NG=_!Et^*nxPPhuV63bWEMR((}%0Zww}u74J^4{F9xA52|&1 z_vVnk+F%;}%JnHr=f`ob{PEa@ayjoIagS<}pM!21{piz`7nIVhkNGm+PpXKpUkNsZ4haknnpk87 zV}%EH=VkuaD;eN5fsNV~4>K+R#ujnS`@m$tR2Ov;g_Jab~=1o~yr*aQeI z#4VBF5CIOwK)M?V_P`o&n*Z6Sric;)kfcF_4d6xaq={pN1CIlX32FVP8S_79O>N0S z--XN*_6rj}xFleL=m&v03-Pt+XG_4lZVYH_cx==VK+fwk*Mx6e*d|Qff?tL9-BM1sQwt&40-@)%~o!(lLQKWuf_#SJN+u)cS)*`p>&^atw;c~|}D z6Pq-LBswztiSt34>z8H}^1iLic0U&WJm};Omns(>tJ{>Ie$Hd#(9OS+QTZR5hDedX zw9T>aF1&aNe7wx<;6pP8t_8juUco-+xlnCQcZDsP;rtt}^f2c)4sqcgtn79}pLxr0 ze!o#j@tU1?wI)RI^u(spVDfLfFVeeX$0u3tuN!?Keqs4eUW5Y6ko> zR(xDrCBeY$XsIkM$+6M1%r3Zj7ftiGA^D<`#ayi*>tNqm`i$kv8ZSf52S+#lqTFQN zg@;IE%#$1U+Fz2L*M!@jIXW;r6?c4aaJ(kwLBKA_ASHsv;&e>gz9@X*ce`lCe+*X| z_s8x^OD}(VXdPI(-rK;QgP90An838fh$Ip!;=M56R0a9YAHq+X1ikGk3z4$5D=WIZ zI37fA`txXOj_xi2p3}@nGEBJ6GfDQgepcpsUTLj^Uo+52_^53 zsvpxPoS#QY*IbgyaB>Km9Uj$I+14a^hvINmiYKq=@ycB_hh`OUKX=!VRm+pHY)%fH zrBzd@YrAqP++#Msfhc9wLO-@qmskc#R6S+Yo%#_x`A@xgzr@sBz5A50=#G(&y~udJQ%x@+Q#{6>TZHWW%L2>CsJ8~7-;PpSmgBH-WE255(d`_eLQm9dn9y9p=si+)Z!oi3lw-u1Z5jHAujwAK>ed&gaJ z{XtU;)(+-tE%BJ#$3y0nYh|3L=YBV_o^1ZDfk<~9kWKR&o>9?>uu(*s3<)uF7|Z<( z%`6ObSP8HmvxseO7#;8@0?Shr$*O0FllNZ+eH|SK!b+U9Qf!4;DP(Z~j#w13KLJyU zKZn04N>cPOraCBU2w<5>7;sKf0mzQy#XyM)D(=x)QHQNKUaljsoHAn^@6e&t!P}r- zc7I`%Kx4Pyu27S~tlaqzV5p)Hfvtl(get4>;Sl7#fCYFmxUc}y6!L!or}-bXOCa0N zc?d$?a@ooAS4{)Fu2c=NC8Y7NFFJh!n7SEyrF6QH&Cc3Nyu0c zYlo*n_PDU2$y3kJRRqXr*I(NhkcBLqR~laq>yB^9T0SK7_PQCRKR6#lLady(pNf5! zDQz?7X`OEV8~c`@jiK`9TxQZf`rC7*Wninp>y{ivaaxWoBv6T{;6S^+WjB;cD9ysG z1G5s(Jj=v3V91WVGP8?6h?BV3gmC+Wm;f;aQ^d6-%p9V$4tI6SBzVD zZ8cX|+}>Sr%blV(M@qR%{5IZsAt=NY@2`~|qFGF6I=r$|$%pP~5^T%#h+GNx2eA&+ zvpfd$E>>(cl))gANIN6I(f8Sc)XakT5b!;ef(DY21ObOH$`te*sXoUHT|!`P>Z&MX zX5vceo-Qw<*~}rgaW-o@qd|*qdA#$3gS1Vz`Bv#|DkL0{ zRb}TEm0kSIN{}N4S=Q*P@Cz;RgQ5u|DOH^N9^IEDCG%5tNPQ)!9FqusAokt8`ot@B zmd^>Clml%KH@r$oj(&j~dp&QHW6ND}5l%;f8IhLEa)?nd+hGF<>>zOl@*}}K6Qe>T z1!SYBJx~qIra}_T4B*HRi_Zb`6BG#e0FxQ+Ow`_(7r$b)j2KM^$0b3DC{)XWkMUp} zu}tzB2otWxO^Q z-KUqR+n2N;8cZ5^0xp_#K&^uALDm%l*`tJ1ff*=>E__Z3@)oc(k;}_jL2EHQroh_> z(*ZgHM9M!adVv{=E{!>xV=TaFgEoY|q6q^H{RkxUXDzEJXw!1Z2@>?07iPuvOAsf( zz;0+H7>*Jhn0M$bA!LANEcBHLr{x#GfZ)ntqc@7I6=ECE`J#fd4``rB=qqXhon`s4 z(RY)nTiZ6@a4fhgY3Obg8#1VMC#YA77km1`_Sbo~cYRGAZ5tPVfoPsDvXwwV@j9dd z6I0-;h7cK)2|^xdpnL`t2m}W%OwhvBAZf|&LBkr<`#I80p*Dfz@zne2DyvP#JSBt3 zzul3vlVr#5W^2@XHjhaMT8yMVTb0<+WA>&$HhOq5g;!jY==uhTXB#j=nm|*4sRUA5 z7;ZBLS0$1x-T6qYi-2u}I+lyF`gkSFei@if@MPT)*m7kcn^ahbCQuqlnlQ1Tssjnl z24U+Wb%E&)?i&W`C!`68T*P!yERow0X?9>}V?-1F$PCsByPZEdn_L}I-Ts|AkNF}u zDB!ODkJ`+em{kYkF<5pSo$g`yLPkG_HkV{Ed3#T$8o|+V0x) zB=&UH&ppppeJlw4)sWq*=>_7pw6Mh~J0wy46>cjtFW*Q>R=vT_D7lDZz%X|+Q94aG z&>1icAcHPo8YtEn4|nW%4{5rf)`L~Bk^zE_iaH;A3yd?w?1ACP@MS<6!W@AK;)das z05OX};Wc}3nMXp}%n|%K#>$GzYu5r=0Qi)#4AijPo~64Em9i9*-NV44Ys!g2n4N6j zR|3~thw0N;+1c+1B2Ng=;ezNg7AZOlUJ(IJ0_Fa@ph6CGA>3za5!5#^?k<7#wO|{- z!vJ;xjSHH3Fqu{gXC?-W7<4@7{9b6g2CO4U4|+&cXu%7lALwo95XgiAy$JSzBbxzV z1tW-z4QS$#5ipj>R26(<2$o#bB_btF=zJjw@Jdi5e}5KAUBqC7jvhFdfld z2^;}yb@bWrvXMnws1XC3#gH{60D+?S?2S!uzGK9RL zb9ki@P?-*9Fk?CJ1nxhfSM;nR$Xx~xnev)h=<#K@+C#tcA`baDa*=ly6d@oVP@#bj za0OXMkV(shVTY`6k;0ZN2wK485ww3i{g;j)!Ky4qR&T2!*19$GSI-9&i~_T%Xdcr<$2qN=#IK4aL{$NK_@qPtEMeQvbs1W94y0c*^2P zg$|XOptybum7LBOoLj|DxZo1p=Fvfy_6kP)$RUEey*>x%e7nL`@b zThOTt#2f%-fFdxcKobwen`9sz4tz;Jd=1PJ&)gPy=$=plKDrO-z>Y0Ao5Q<23=2Zk z^&cqhObsdiF<^<<^(uEt*O^GJ-k;uf+?!c;ZAIp9X4sJGnT@vTe>i)*`JwZC=QknQ zg?nt@C`j89b~Ycj(CgOjGUuhVTzozLhhFgEqKz7^)Z?i-0ey?xV*yI!QEC+g#Esv& zzYt#}DJq|`EQ4Vagy7;4a~CMJ=pZ;sbgOdwm$L*LAzQt^1PImePp*N4&A z7gpXqlJuQn{j(bWVP#I+xw#8YBX0Qq>^TM2>4#%S6{-h{-pmGdD$L||rq0bS8koCc zC9DRT-s8AV(7f;1< zMRA89j;NRfPXyfD3&cksOl9yMIReio!CO>GNt(ck;T-f8cmU$tqS%!Y#?W{0Zc&i5 zg3tzZq00v4DkB+t=Enniagu45({3i#&m?`c7M3RzEC6zg9iJH14^$Px|g3Rqq8{<*9BzJ`!7Xh#GR$o)xzC?N0Wv zT^+OIMRTI7RKzcA<%|jXA;DNd{x}os;Q;`haz#t$dphJE;=ySEKP@cn47?9I3y4rg zheF2S#Mmipt)vKrJ8!@7eihu%jBtFzQnD{?kHV0ukbCg6FY0^j%v=(_dGnvuwnPY$ z7c0orR4VuV4lYe)3>Ek+D!3nfxQrqLoUMWw*6+2Rm$gVuE*s6wv!tL6RD3-h!{Eqdzm zQ%K_E?-6+;n1BfL5_tcS`yzvxV5P8ccGRfdWMp7Y4D+EnhgK5P8If4!T8^TgL3b(4Q5ej<`r! z0l0!trN?JsxKMl+sVCb`h@Se*vlpsW)H%3eH_-NrH8n#+EE0Geie|0UIM-<{Lph3Ajzz!2k^(*aO@O zG!mSF0h}^ghpCPl$Tqj<4r$}PkJ#T9D zVI@xV*d2r4##aK1w05zzI^N#+HY0g;afMCUoTkz7+02=m`WMpiNADNx96S2p`upD} zj^bi#5Q_}deLH0v{73S0gSQtt7H*qOOWkLad&)WU0jwDpIW-&U6TFsp`o#0ay42I= z@*MZOmQohKyA2I4*;`UdWB$S<{)RUVO!rMFDweh(8o0fgbFB)~&UFuG97_HPD+)>) z&^?MuBX_qK1eS})4qFd_iHevgSPWedy~T2Y^MC}05~bij(z*1j7%XwqxABcq;clxjPOXohrNM6{nt$4{l}Edqwj9Uv^?;aPFhUW zo!;0H@>d8B$Ar5pW)jq(>L$UEAw?|*qB!CdGfQL#VX$V#|M&xWPU@1q zln9;zPzB>f9=L-mxcKeX#4>rC=+yYD?!0i%LdzO$I`x_=?T;awlaeh1YgBi4jNB=4 z0pIgJ7vf^5q)(dDA2f*2SIZkV9iijDpV?^mb<+~|mg(S)pzgQ_Vfl?sP6Mtu)ge)B z-(aO_e#m>vRKFpuS37DpRvudK5;wHHKCF2w%}I?QQh$jj1VXsQL~!X|s%g#$%kxq57G+$!@IHLt5<|it|E1t%Ra-oE20V~hPo+QQ5XD%A79I8vKkoTOb_4PkfVB9j9>eva@N)c zG5%pa&2ocGBgo?SWX3`=9SdyIesGx%t`NY+DRKrfhaVZHBwF_c1v zmA^_0B1R6#3tU{>kM$+~W!X9K*|dB0|wH`_aXJSh3@Jt}i3T+M{Isb@Ys zUAe;HZW+Zpvu*fBdLsDR_szTAi+nS7%zZTYInRl+k-V3pytgv{eMY>geQ0M4 z>liyIJYKoVrM#@RAfYbtv4l~`k2xOGACd@XI$SfAugM!+S2sV`H>6id%#iA@G#Hzk zeVqI0m`P)^?eyzjKelee^MS^Jy9&SD$V^|~hhOsqMD>Nun||HF?P)6xN{D`z*&LUv zGlko$_4sGg?+h1?7gBUv3zSrl>S8bm;LSo>zrbyDok_a4^=g^i z`d5{PZAU}zbXlg!GwakG3KA=AT<+)4Y7MF=PY7z`p-x-rXG>*kyyduSnYJw&tM3NHj@7$3S7o2)ff_ASL~z%|G(9+Q*4obpVs84e)#cX;;>hB* z1@#{It!P!sc2~Wpb`)Fm$izk?jmbPIsYi=G+1{fUTV~zqp0=h=qhH}I4btB(o;sjB zd~X5dmf;7V*eb1>K-YziF>B}UN(Ew}iCx*rYBfH~K%VB;Uy{->;o9I?`K^6=rFlzC zM0`CkGpYbgjnD7Xkx1NnlrPtZdj-u`#&e7cX{~^w@N=-2I%5O=l!6of@1PXlDNE z896u7EzF*DG?;BTcBXls?Esi7)Fz90e(P?_j;uDo-%QR_x$j`IW4%iy6s87h2w{=> zGx-;^Ms8Hdwl%Wdk0C6+7nHEVLK!WHdm+Cinn|SAr?GF%&C0326iREwbaUpDQ$a>t ze7(mZ?sU<^E0(ua=>3jeugwNpJzI`$xbZY}seiq1a!l~2e!lmQp)A+iZ+9h@>D4;2 zS(R;r&J`Q=8seUW7SOC7IF8>4Ebg!_cj|AX%;c=b`}1EtD{Y@`Q*NIe9)1 zK3CI5QnldQP3tBKBy3NAqZCB5;B>G(8#FKPDwlp4mE3vQsz=r5v25_JAEYR*m9?8! zT_8%Cz2g)}l$^b%&Nop`b_zrb1mIy z;3{5|=uht`Kcg00zWvy`g<`Z2bqP^W>!J9LM(k5^QC)gV+101^&Mx zJXeXL6FzMHGsjMJ=WM1Pf!Mh#=PMYcsRB7kPJ^p1yNYH@iRogNr?td-H~cZ=il4O| z8IVgg!xf|*>jS8h)n@-9R!-HPH^hTqn+Zf8$hudR->Z-3PTwC`^OY&##TBBni6`Lx zt2V@YeRlo|;dBkgUKn1b&_V$@wp?%vQ*>*k_ICq zsEG)t;Qp142_`ZR4qFK)-Gb2oTLl_aROG=W>@koc1#MX-q4j?SR=m;709PECuo#34 z`Kv-TOd(Mcc(9OYf^;AFgiL`*v_R$%5@15h304tD#mKGIh!$j(qMcwLARz~FTfsN@ z@WROI09Abc`u8Q0h|u6hNN9mo>m4X3^dR)|HaXmH^BS!FFkWl!u7tWj7T(!g`d6Iv z4AeP%Dl9`M@TP=c(deqK(pG-Wz7L)HR(E|r9NjE!ri^M~mpR{T_bT=RNts!6!TVfa zIRA8_;f*o7yWtO9*N{E#6kX8SFjH)!ImGmP^J387VVoB{J6Dif96dXsZujd_Zmp+b zEcwzVg4MtWg{wycIMf2}RI7Z|Z#doXrEu|LPBA^T^Vq2ph31*Jm8p~Mhn>H(%%#VF zxRzr6rf~bI+dENGYDj4}JNfCUPGa%oNu!h6xaRX8zy$^Kr_L<1=Tc5iqSa91ZT%B% z$(G)%bqXuv^l6}@_{g9XjJtSx9gDE zzF|ALcNPK3Nl#g#KSK2&|4T<(?|7fAeNAt4m@b&JYQA~7v^%~u{exHUz6Ym7>feCR z6`WfzcHp^!sH0|aNEg2@0V%|G2kZs^rIVWhZPJ z1LV1L|`)__EVVepNO4lLaYu=eqrTdIxD-Tl3qd)e?J zo9#2CSW}fdLym_jE@~!5)rJTK2EzsQnS}0#i;eKkyILm0PmeSlI?AaW=4=?Yb+7at zU3_sfnb0OP_=5GeZ6_QdXDa17lk7Ka&B^w48)tqTu1N$HDZH^Jj7pWSy4g58y3`+V zYH}vMHVR*B*n1bEoR+pdNBh63vG(^M?5x21MJ1c2Tqg$``UI34^vl>s?e1UyGFg7y zT}D@9;qj{9q~a397VhMh+C;`!jOm+`rN7Pnboh|IYD2qzu2%ThNGIYM`Ofw57mCPQ zuQCV!+~_e?|5RD)c#hM9|JXJR+Sn2+rGnd?M;CT*bbO;yk4bIRJzk}Ew6ke7QXHWhDOKgIhdWpvbKLrA!*Sg&>+vpe+|L9$GN*dBbwyqTR}K>O9!1aJ!B#-TUTOm2L5x%6?9!V;2W|rd@f7F<$x$`fU82FnB?|1 zSb!$zG-wApOVGM7Q27w>rpsUdu@K%M)OAH$VSWj}qc3NouD_TXsQS)Z;(@}MZ>?PG zXS0jaRcQL|yE_KSDi0?MPskXQ<4vYCIUhtfQCAlS8mRRoyX<=g23<-;+$+`i->q7f zYNZD_X8bePpr|SB;BRd0vAucq>Kdz5N^h<*_x|zt3B&v$?a5}@cLbe;i+Lg@{Xb{# zrG)I=@ZF}PdpX5*e@J#q)<10+o1UC8*sOjv^oYh4ubyW!O+!|@q>rlR7jrs~&9~f> z$diF=w%)k&*<*Q?Tm|!qUMZ<7cTboe@3$aIrCR}gZ-AhRJ&y|$ zfNUlX`7VUHjEk|ycG68=XX2f5uAjA}8|=7XuA0-C@6gf7w$`@XMDuRRi!WwT3{yLr z9~}J3#Kv{*^2%Q6S+-WDnn6^iWl&d3$bx)qSx6 z#M>(R*ZZ3e4L_zfqDc~Qd0N?Lr1ahj23!afAF#kd(2UbZ7mdSLi4W`TqUrno%ra1L zk!}hnQJT+cUM?C*3(s^JvJM=#^Ya?mO7EBk16*(8o~H0oaePp4Lwosuk_TlCsY$t` zZ%iiNNpRVx4S|V;RG&;^!WtL-6UrPn2<&8f~W*fZs21%)IsI2I73!H}YuN(@HyD zB*(e5+ze4&nx~gGOQs=yui%m<|JZBzm8FbVo8P+&LBm6%uYK4%ht${1bq1N4R70R! z2b^M1j{qw8qdzY6fUp4w2~Z7!2}NRq-}SO6E8Uj2#8c0o5Ld8^JczZ@&Yuv~LhqCb zv~+k0$J2`rie`~jq=}S1 zX=3XrQZS@_`t@Hu&E7G9Njs{P(7&zo5GQy~t$8w~ZbHE{B!vkTC0tn-A+CxAzr5zH zew}%Q>0RW8F4__~&($2`(ng73NM}mdS`Z0VEgiPiqr;2E{It_?4P%t~f#J868tFw9 zeorPjk!>yWv`4YKXNn!7>h2F1WSVn>9P94Sn%5-FZ#F7fENhvuvD-ycp3D5%t0kmw zKFB~phbYCFBpy}??;C$z(lT%wL;_?8apYVEt^*6ipU4{hBhLiMcM`?@+cNA~30 zm64ha?`q|$a;INy)opK5y&IlB8`uMsBPkD7Y@z-1M`Ed@lx?kinF2+1*z=lsgAyHt z59SdAe;HUY3CVcC$Y3zJpo9X8l2R0h)L=&q5rD8@#FBJq_z1b(Af;sYXv;jhK>?Rs zpE%fZkpLt+$4~}uDZpG5eLP_FlXUHc>F3>VEXhB+e0l;NF-6!8?cZolVJI9@eYhYg znQ#E0Py|J1mQ5d25F0icBOVNIa~0SEpV4C%|B3+tLLJ_`2M7K?8aYr!K?7YF(HLs$ z!5G3|xL~US#HK_X6kPBYK_i2h!g9e!0DK9EQ4BVrq7u+xN}$rc-AfdO)k6wZoO{%C zUfZoO?|0^f2`BhfuKcjspoCo#&wSFWt*RGmJ5+vUKa_s;e58Amq=eW;OHB(;38S{F zF2z1tN5k_?A`E=3(?ma$KnwFXWH2LHi_m`}i*o8Qq_LuSFr#By{XI3b%3|>Bb zpTQ#%1~LXG`lHIo2hV@dh5SOOK!DkStjI__)1|HUPO}_@d7LX>9w%0Atn8b+ReNHn zMn|*Q(d$|EX))ILO;xSSO1p+Erc^ttAItutl~Z)9KRNN6slzM_qMgmkc2hZ@A;WL- zr+)9HJ!yYd)vu-s5PTlIYEY1v4V?*nAq=@A1LLdipH*mvv87JB{vkQoPV`ni6g+}H z1xgSH{5VZxRhrKm=Q-kW)9~$2Ad9YWoZzGq(ku>|T`BLalx!`PPpjnelLi{!91g!9 z_HKK@>w_cbdA6IlX=r~nuc&A%)$!s8Sq|sEaO6Ws!xLoX# z21T-u-rtc;9gxuKy-~@V-7^roRpr8&2YUQh#m=!?2_eM(w)Dv@ipWeCG{9y9<`J=8 z63{GkAktD`3FHp2{XTf%pQthP7IYo-E}B5d5(i~ToOA#uu@~O3n06`bzc5=p{6pTj zu=JFUX`btZ1TO*Ggex%WCmiaVv|BR`6wKvTv)rBgO64;WIa4On3mg4ryY%!f1vjhH z{6orR{X=irNzZ$>S=*a8Rt13wnH!EB-45C9v#}flR{N+g8lvaNb8%j+VG6B%;9fn+ zQFDsBbY)&C=t{rURl?qe%sy4`#}#vaUbpoc^-pbJg>C$8jeN&X<1j>=3Y*r^>D*zP z+wyPR2?kF(YWsa(?5b~^=Z_bx)_7Zed;G>!KuGCP-xxYOIwnNh{l-&5>XX;J=?s|= z%_xX2S*`P&*7AuSrF6&y^h88IuIMn8w3^vu&-M=Jk53(@ChA8eqw<2`)erRQCWy|x zb$g;M`UcrkzDYw>_*qEF*ao(XfDP+PT{0OiJ|7(-6yZy|Ng*B8&!T%2?(vW`Z|i z3rad8HyMl~{<5eW;O?NvN(uMSN*%8io|gf*%YY;&NHN9Y^Dm-g&N5@{AyGF)aSs^R zb-XqRtnB0iikGyn<~>&wCj_+uL;4zCga=0mVM@zM;Rtdhh_pi>UJR+*LIoXEbHspA z&1;|~A!`Bx$^zDhh)1BFgAR?>g)ie>hVFhT`LR+!n#(**K$3FeSkQz81PCN3to8*C zA>=Z|@c$PN6S||%^?ndD24V1-_Gj0shW>H9-3|7VP`Shw!#w zCXitBvIk9g0Nmkn6X5{du6v+DTWV@(mTh$Tg_^}ar9#73H&SCJ)|@PQeZ|7aUf%A= z_|BU&v(bq+mwFahBSE9B2geJOkt)!qcHV46v01 z^II6m087hQY%pmWVNZ}BhbwqI4a_Q|bTg;zla13$FDk-(--?B93|MsKk1qP;dJm}U zjz9q1CwteZp59qY=Zpu+qq}0&+;X7?*OrP|CHipdjo7MMoDb_H;YQO`trpS#P)6t8 zk{$`Aw8bOibg`)?9h`)7uUs3&Mr)LtIGIr;qI&0L!hUP9l8UcA*BiX^@s{+mG)ePI z6TNZK!(+vt9^pobC$pn2&?WIp`b6*+j1>ksmg3(MipH`t=G{`uVwIQ|+p64$66PUs zP_Nb@{oOAG#nhpl0^90yECM)DmSz?jAyIgN2C^Vw4bYDwiBP^Xa0CGW?amXi{h{E%LomQl?aYiGM^c632_J>+hKv#MCxqW$K#Ni*WM9R{Pm z_$H?`14oag*Rr!=1(lrq7QPQSs4Rjn#7^jEl(0Q{b5gcOCU%++>4`k&o`_79vk#9hZMi@DJ$^JiY#1ZP$Nvhu3(*~8-rbdc`HcLwpkr9-`ZkwP(^n3r)E z#!aycWg*=|nHh&fkHB<92?-b(9(wO;eIeDJ7oSvS46ckVKhW@6fM+L@1hD`-q(wrq zDC+GmnqiNCDc$Fj-57#-3G}Qh(_I9IfL@8_9z+I6uvmsX_vz4J9oZBAd#qOr)!%>y z?~&_uZar7ay{rT=GpbQG=18oAI z3oJlJf)895CH@GwogmZ45p)#+>4BI9mif0U!G-;V%~S|H_{P>MjUs z!PUDt!pjLixyxU$siJa_5ie}3wx=!Gr$0@Nd7hp*^lecxZ5EaF@OanoFs67!dM(9>~qcSgVQGU)kPZ%Lv5rFy8iilc)VJbQ%zYl>)0IypM_+2ZFb<& z!l$Z;x|c<=AE!u-Xa zcS{iq2{a5Y%7`&WPG-Si06+-!K6!r@FT#uhZ<^yG6vncng`ZvpaKplPwQdo7lWEqR zY53@-jmpdiO7XTB<4Y&W(s9#((15Qp`m#~K>9X6KbacMhc~}2 zh|OEQd%-8d#!#tvcUq5;>Vi+2jDxt9Y=N#}%Dup=J?EpvMwOnH;tgB9Vo&bS4zNCt zv<1n_yY8+R!X&YrQ0b9ay;`U0n44_*aBfS)e#nMH3<`vfu!#uh3D$*dio%1Ggm|xZ zE;w1eFCuc+LMcq>ST1q|GQj%<)JH3LtU`H|n?By>jc?)x2j8jv<$P0eC|ur)n2hM8orcHDI@7Axe$>@99tQDhtF5AbB{};ico!md4SqK)hCF+Mf{bO zQJRGjhd$t<9~FiTbs`yX%Ca5=f>79CKfuxvhz0IN(CPuMiWnlWJV6r$TjDb*FK-eo z1Pl&N0&4y8k}6miuq$+go}w7|4n8+=QC&z)gWcV>-2`6CbN<^97tgw=forPz#H#+f z=Z(Flc;HdAadqHfZ0~vVO1BetV&6LFdcR!q^$7}O4y;IVETk_(V-tSC}NzlMtjTb0V5%zt$ z&=;U<0qTzgiXsvKi029j4R(Orq_3nS0^an8PlYjq2Spu=hz(IJfC^drKR#f>Xc3n=zs2 zC=?!>Mx`9k`f~d`PF)m|EL4%;#kb?yQGN>S2BoK+1%wT&T=*}js{<=AzDS$_j16UO z!)R#$V6zAYN(Zo*#(nXE+(KV`he7%y_v&gH+1lrRO-@&qUgS>pJoM;LN!4Ug+7BQ2 zMN|9R_@AwzUh|B&*n-!w^Ub37vif}NA|A47VEBGg)z=CAiZw^ zAT+b*^);u)N*v}2IBk*juXKCsCR1;B`=4TB_Z~tibD}HAMiXZGyYAW89i;zKwCP^> zDAhJKJ2mX~!d08D@syT%SxC8lJ3XU&{aJI_O;Jl1t8d<%;yv^8Vks+Z!?(C9u=N_4 zH!_Sxw{0Wa9{?W)lv_mkKRDhw(G?;&W;zxn09*jA1xzYP;P@JMDN74VD~d2JZUI{+ zK`x4M5+#6{QCJ*@Fc>- zBuFI8`n(yIa4)Fg#P8o1uED35Y-tvXcm35Q3|8l~`WF*|YVu&d1-TZi)tFupS?in2!4PB+;SUs4j3UilVS) zqm@HbDBk4o>H&4a6x0>Y2uyt8Sm(Dy=+V?1Oy|lxMOhS9eK{WA>)juMb?c_D4SmAUThJj;I~JPGa++}+(>gS)%Cy95X>!6iTl0fM``Cb&az3-0bPy&!v^z3(}5=FXiTcb;da zf2`H3S9h=VRn=QnU)5LDufPB|7gU`1+*-5)Z4M}I?yb~CCx=Asb#7*F@ElZ$w)D&` zUw8cSh3Oae3;|R*6j0w<69=p(5C$wQtT~*%G^lht7V10Dbfp}47Bx^*H7&pzjs-kr zdh!d?LC=P=!e#@m1QLn= z-eKx%J8;yBF#Flu0TY$4z{ght;6RTw^H)p)AU3@$Abk#gf!3}75d$Fq0NVcfFv1s0 z`3&o45BsH6=|6(TFOgv2P5?u|^+9cYUIe%um}yFY#sip4AY=yYu)Q$$86<$}0FD3~ za9d!hX(Z7PNN1LC1o#r5=klS~VUovdO8ezo#_wMnMs1jaA zj9u{b?)I!>N>M4BT*F4$>%Rz#hjUVKU>W(uqj@ho$!m(CL9@o?!Q5Gr*)n1xs-SI# zV^m}{pwswc9*eK%%Liaaf+nidCod495Cyb}1N#|D(+Me|?>QAp)?A4LcMlFckF)oR|PA5G!5`T+H-!YC859Kz)#W zfvPn8pZN{&4jdH5*9T#G(157}n-ncvlTNS0Ah{rkNE`==44jwiZEM4v0`W{GMY}{k70ce5&77h4M1LzwEG9$fVz@GrV0XB#rz-CngrTsJKHqf94 ze?Gf)K*RsP-MwE#?|IxP%Sg{R!e1Y~e7;s>fo=<;)51c>f#tgt20NQ0f zMLqKbbO5L^22l145Fp$Kob#LTEAR^XPp^Q_&m05of&xAIdH-y733>(~Fb3ePzwRuk zQvGGzptJw6J>LZY7od*+W1bGW@ALLAjx3O;0g2(?4eFB&uvY5tpZLeYSJ0%9D()V` z;d$Joy-bFr)l)3P4xG}9t1gurEs5PKxZ_utAIz$}Oq5tgbPuncJGL4EYjpRUVhTbw z7HqP7EW{@?@4fVL=Ko_+_E7qT#+RMviT%vG5;f4oJ_j_h?{kXZi;?DR?ZqFW4Zi?f z<%8b(OPy{{Yq}cEmJKtRi-YKEFD>?+Hmos5#wpI`nz_=Y-+hS(6>ea#xVbp`Ta)< z7(`v*x=4ShNCTh*281r)@diLYb08NC>;D2UaDuvAAC0ZMb~PXen&H}a91-2J>w!auI5O07`4TH5XDu8d$*T6>&g6BcJXbj+daEZS> zefj?7^;x|DmjGi1O)3Ae0SpDU=T$$To!3BYM;){S+E_3FpXu-Kza07d3i~n}0%ue` z{P0{nToMKwni@8AP~JG?*?SY7Q|9M24?t{jD6xBj_jp%0c#t&h%4ETZhM#ub{*G!q z8qMl*`J2Isvmr4TRoH$q^_iz-8ac--ubkP(Y3k`b$_>YyGQ07Ug+IGFyNpAM6jOjgk`2^buh-CJ8z z=NkxQ>Jdt zaKT_P*#LZi9LqSUY9I~+uJ{`U@HG7err`+V7@%t6UQGghUwV1G#gOR^qT)_p$78hs z9j_NQXhLe6OzCo+W z#d=mWuSiHl4qWn$o@U|Rn%EjUIXjvd*uVjMc7~R4ER38433nLS8M*|OF*T~M;MBc#B#_7Mg%!z;zbiIp> zEwIPN%*4k>FJ@uwY~n~SW^LeX@^TY;2@?x5b7uk;MmBmG6I(N9a{@L_HhNhD8xwkU zdLvn7egBT>twh*<$LrSsYy4xMiuPdM z0(<}e_WxN5_|FCkgMmgb_@sB&3Gx3vI<(WihI$p-#5eL^0h5X0{~jBN&-l^Pp7xD` zD?fB*k;AKL;EirfifZEaLyV$bvuWa(c2Zu`vI?`8_$wGi1lB5waI~XIO=QU<^}wZ- zBw4+?JZyDaruSM2ted|$EPh97fo6M?1T&v79i|v;OL8^*X>80=Ac1 zkZDYWz-Ms#-Zyg}MOIF4ZTL)%Bkv_4Wy(!hQd3W{pscT1=ZFPIj<7izf1E7_du%k3 zju}APOUgNET&zJuQyVd4E0d9qaN&Nw>B^_vy~ZiyxWohd^Lp(HTj=Elaa!6U47vmb zSu7s+)oKeByB0L$@~w**+;}q5-X6(8aHF4W`24n*VltYzFlF;PS_*_EWNAax6XS-9 z@Xt4`H`r;kWlc3U;eO9cr&c`Q!ETJ%+tK1>68*;1NlZ~O;nxicIT*k8ySB;2 zhZ2`-7mvlmx$w6;%wyKNsY&R2uFrRBhm!^oo`iaSb=#oU}1+)`V;+(aiEjz&8;#i6{;c#)Uh@U9PIa~>71)=Y?TV$m~8|n^AOOvIgjH9b; zn@Y}S&4`1;Y(zy}BTQ~bv$fv7<>KZ7GlN}7bU5g&`8u5Y+HbT*yfN!_^mTaJ>C>{z zFEirTr>uuw>u{V3-)5V6STAmAb=;jhVbTg{A2JeadPZx?8U!jkqmP31qg z_h%A`PZxdUR#jEt9U4`poXcKvYi`y{G*82|>iyvnD&OTM;MLTM%D>%v5ADHGx-?cW z5_4*}s^#XhPfbDExp-gB-ZnR{l#b`imXs7X8)7~jv;{?RzM&h z;WKZJw)#Av^!U+fU$0NdLARL{EZRbd>K-2GwCV@U-Tu5gx_fwh6z$h@H&_aKgDihK z$ee+T`}we>sc3H_4*89Acnm%8SU6Plu&O+=3DbCIEGqy^7{eLV?)w!2^Y4nM7fnpW z>X~o7TM-c6!(g4%!r^?+qA25j+R5KjErXZ!AR;ENe@va8j!m<~Ei4>oDXDDMj{5re z>+@wE*;GTZMvj-i;TQ9oh|AfX?CYp28--uKMRTaIx z4QxxpcMf;c*bRjAsojUL*bkMBjGijBX3FGRHN?ZVsJ#)%GZ=Y8QX> zNpr1l)a*gs*s{{Klc<@9io)vat8Aj;Z7C?FJHFqDi%UQvzI9{u*&fYLqS^7|zmUy; zOYy5OmC;)LH_C%+Pk2?nEF}3M9d%XId#ug<^`A$JEm}S9yqRshPtBgKeDovhu2*gG zHM6rW<4k58QeuD}jU> z7~I@Bk@YPFl=}eG7Tk|Y>MrFpI9x1kOmf3HC+4tg_p=MBK1@&z3>=_G+&2|fJC6;f zJ{2+8%mwgzkv!ZtIJIfjP+3E2Ft4whB0Oz z!|7+t(_N_!^62c?=d{>Z26K6Untf*;C}b@7{CL`DBf-Ix#9~2kt}>bTB4VHJGi@po z&@hVJv+{6DOH~;~Z*J0NaK``a^!7&nF`m^)%v@4d%g1Z2wura+BViTPYr5cl79W8T zvLM$oQQ!(Fy-w4D5_Y$J7~_^EtC^UiR_^_ijn$8R@mhO(Dt|DN>4vg66fy^dZ*U!h zV$#x?ZP;dYKBvvu@2j6@doN7q*-Gj%n*56O`UH2Ey2$5mpu16Apg@0n^Mx})NfCK) zlfjH7eS`ST_xrp18|5O_+fc1m9@F;WamAnCB|j_TNl9ARS;mz!my{S7!KzaNSA|hPaqXv1tQs0|iTZ5P({^}1)qr)F-dNJj%G253zkgVdAx|5k`bt2af43%z zcDxz@ju45JllgSI8p3a5rv|ylcdb9W(C{V@s&9JD>&VA#OBT(~_~}u6Yb04w=@abd zl38?V4TlP;&ln(r4`DnD@2@dgb~aNI@`1y`^Ygq$E|1eC?jxFt*-0&5E~DQ0vgU6~ zrz2HnbvD1hO3jMLJPtUGKrVwgP&;|sQ&X$5CY{dqV7|a{;eBwrfnQf6DRmZxB1flN z9G&Glqr)vNty2C)A({-qkHOpBKsLIN-UefHvtKxjA9%D<$Xh<4n_3&Eqk3W2I#g6= zS7+}Hij5S6-0u*YE!1>$?xAIE*WZ2~z^Cs$i+X7uEFO)<8QEj9P9>b>Y5$tL%-h!L zZB%>rPt$XjI06u8#8BVhM8SK1g^v>c77d{KHEk<3gCrW@YVt)&^%(6STy-IMo9hSb zFI8l?Ig%tse?|>S!9TbP3<9tuB!t6wEw*GRh~p3DM|OuHTbWNDO*-(GNYSnfS5}JRwtEH-8(r^@k2oHyUi=347 zEw=FV^atd-c8M%br>EhJZCW`z{!$Jv^bcfVJwlo25s;IP0sexB+X2Vii$8t{6grsy z;$l*C*?7xN0-@~g=xa(AH`;Ky9)Is!I1*(Y#ZITCz1I-p$v#hG38rC=|NQ=imefg(n&{=#nlIT?$^AlD5BM6iJ zluEWbZPEMCu1D~f$FGd~cc-RQRPt60(*3lQP=5SSr4U3txnYweLnid1i!ozMeV;k~ zRk3H(e8kC-!!j6*=I7O+&hE~eq;53o?}>?BV#KH3rZw15&}B)90e_^)#GxT)NAhLq z>V{V3WruT0=@^KnI9SeweILn>+7QOKK7X!p7ZTrT)02?i(2RhG9j?Hb*cKxoTnMKKM;P^V0v#!1NtC{)roYAF_W&l z)TyJ-PXwu~C&&`t^EMg|zh^1Znkk*Fg>5RLp?-I9dP*4obWOys&xB1XL^$`$lx@Cs z{+VGvv`%uR;fq4}gB}eB{1zKsB+BZNZ#}&tPESX(-n5+uopt|{NdT|TyxJ{m6eYjE zkzD5${eand&SrIf9;%G4pe$vtrl-js}%$qAHB zK>V`cVf{_a6yxYqo4Xeu2D61t*B2OYwNlX0ir;unIQ1;CrJ7v6ZkK%*+$1Wzc!~UE-$od^9Yd<^ezud-cr&pPJ%9HhdTnm0G*s$IklggoOpIe1PP#hV>MFmg;b1;GRzw zdXvt3mn9w@$?SnMlF7@Rm~|wcEfD9I!C`=jEp*wn?2Q7TLCnCSVAk4|ERmN1znXjd zI9y;wnk+}{D+-H`r-E)~Z9X*TK#w72D>Jn^quXK6+FG066|OhEqm$PZjsa>h0zU-4 zub7ydI5g9y^(>f8Ip6KJqhw#uLwclGm^=&?fiZKs4SnJ}2-uIWEUaW?oP-18!3#P5e*4A1Z*`XsL)(sXnVBeemjS}h z>gty{W4Z|uk|kgAPv&$Pcm+5r71$^!%eNspsuW-QKgsb0?5$xj6aAPR(a2=8>!qcO>1-Vr2=CC9zi@B;;knD= zN!?llQ_vF;zq+_2TJJr!=YMNb)7G}Om6b7gMg2XymFJRbg&Ku!Rxj*X4hObNKOw#2Wf@bEWY zY*9f{e1t96}K6@gkE3K(;7_|RA&}uWkucgUo2Jgx7{+ZCn%RJ&QhT$){ z%ZQ)NLx-ekh4aIMte8bYzcU@ix8J_L7~v5Ixl4zK`?Ol}!*52WUG}i2EF09{i|2Qt zISOr#Z2(-DfP`E@ltL8s=3~+vG)@k54tM-#`MK^-q?V;1V z<`t119*SS>R}29vU;Oe*HA{=^mVEBNiY>R6CKH=&5cOoErt0P&o&X?i#5U4HYTg@p zc!HS^k+vubD)d+RUW){b5t=?DABNDw*)*a`nd+J->{^wB7x1 zBg4bxCTJ{89Gr=7-`XpEZyYU5HiAmhp5^kf)%X<9*1A*}Fqjap$JHDhVqKm0XV-tu zKtMn=HO;#rkLWMlY$Q7^`^79}V&XkM$sqoVUBw)<3YoIZjgzpC)1cAuYl~OF&SlCN z2&SmbS`J<_^eQN;WA~e(iv`P<-7qs&R#S;`0?603vQp-DL{_35=2`D^wz=&H{(@&1 z(oiBkd@NeiDj5=?p{@T+Lr9J?y;|7P6WC8H*C!5*0Kx%MS)Uce4=5!5CqjN~H^^~V zuC=j``l>jR#j^ttaxa-4S~eXjz$9N5Zs!8B$&LQvJjf~M8<;MafqRK|DM%Q;p7>u#;dB+BDHQ6CGey!5h)=JGOQqHXnt5@6VP;Jfx-`x9HDRw;lXm z9SkQ796Q!??c@EiLmjbh5srjZ%)=BkXHbYv!jlV${5lHKS0Iv!DlYUZ$y;I?8hLMi zsVPN^_2PLn6N6(U^r+Hsg!YP9TzO&Bf&iI>S7~2+OM=mYFy92Jae3_?7*7b;Jl0+@ zyD{Bl9NjE=9df!EZ{>Yh(ZoWuKO4_orga=Nw=OOS@WyB2%owUou>0Qk{A5*jMbFTYmnf$kgoVa&vAG3$}mouFkf`qz)-?wd!K81DVzD@uIM>;Efy} z-vTkBfDlKNDk18(mF{bICt+}^$AN`~lL|&^3~RKrG4Zda_8bR}4Pv?dG7|nHQym=_ z$@KH?O4~6)WWxEVrl#;a7piX-GcpQj(0_P;G*6TwbaXz_y*5@X*y!m|?W2c=E(;ae zIXM|^@ndJxlp4KPr>6%-?Y7w1y0kR8G2nBsKmIKTf1$}tI%E9ymO)LeyzDKkh)Hum zi&iZJH>cp|I=h9GlobC^8KPCDR74F7bl1J!r~-5qEgWq`T>>@k6MQr-}mPO zQ3o<&kZyj}*i4=}%SI(3ccVZ}>J#?#xkzP3!ow>!dtu4-UzYg#h;;uLGk1}~ zOUB`_LjQsFUbab_&yZnXS}tUyCpucsZvJxZ#;NFjiSIfD;r%d<_Wn-Gu^v~K2Py#p&fMIeii#?8 zAt6nW-z4`zc$LRbRCIQBJo-w%Tevk86%DPb!Vj+Gq&wVbZ*NILXEFTYG>0^!rgr4X zyEc$7mxBaO4v%Z7SWw>g7ztYPLBVbt`QLcO4^I}~moD;=lmG^p zKjaii7YuHlwD;sq6p0d1U$l*6=F;iGQ#~xYvH$GVEh)a=$ z7hZoK78ah^con%^_`A25wzd*OEB136j-gr9v{7mN_(aEdCbp%Oxjouw)+!0fKTprk zYpSFT8GI)#hw>?mnX2UsOgCe7?ObLLhliEX-zoD6R!ij~ewHNJz6C6>+sO?@XdzYq zP;lY4t7{k`Aw4uyo-3LsSa0I%*8%YG26S|Fc1!Q^ajHy+%5+hklF z-g7Xp9+cf(l8TGn&d&>L3OX_^VE1I3(#41E2PMzU%-6b5ph|eoE&ANA2(o~s43D*V z5&pjGLTHQpJ#6cw{pBKbpnsYX^RZ0ad%Y9#Oq*n;l=Rc5k5)U)9(u+m+1ansqN5+M zuwwVcv#rA-gpWp9I15w@2t1Hdo4GiCpQ6_oIzU80DdHs;sT9$YMoA^Mn8HaIl$HVz z#OL=8UHg=s-8-l0D+9}duFOF}OVyv$Yxs}ZA;<~v*keqUSt3EEc`dl@!iA%wBW1!D z15L-4p-YRbQII2Mq@;s8F$9N<-f}klR&ROH`_VSwRf)Qt-7*%lK)< z)h-%2xllhIGg(Jt5~*R0CiK$>vtig&ZjA5t*d;;~Ech%uEZrwp;up}|oHo*uf~Cbl zL2^r8^o%SllRc2%Vd3+2=tAzzMUYlN;YZnKQI()|LEyXO;6O_U4Wr`meXVwsKg(f5f5r=(xaeGudOIgT;AJk z@Bbh*Zpp$X3*r9<7l)mw3?UUZKgG^W7nYqp1%|{vna0A_oFO`rpzK*q{)$Lzj|scU zWu{i6dsqR7xmBP5z+svAHmbg&Ht7V1n5?;ZH1z39%Jp>zxKr>$OG_s%w|rK|yQb{> z^J{lZXb2;8x@KJ!li{Pi9l?wCc!AX2%gesLKFtb_k79xDFN{mqcfZ(8KbRj2O&(5% z&JpkZ2#2%6n?eusAPMufvZd}{y<`0)Lm9Go_Am%(0YuM?VKKF2#nh4YfQS$IY7rtz zC}N*N=o6Be7Zyf0m1dIa>$#VG*sU2-XysVb+V*Fw7A7XBCj2%BNuZ1XJ9^CjMXU(% z?NCx!*qgo@tBFJW7JWg0mDJuotA0=+6LiVM(jh_>yriV&m-`kv^7amb9TSJP&ph~! z{$jJ(4-WTbOezF6P(+H9!#`@)-0Hht8jAlc5D#jsZ$}FB@tI(&t^TpS&gmp?x_EOo zDuzQ278w;?s8UGWD)Pb@3T_vXxBEJJRtpXwmmj`4NpVl+z*4toA=B3^6Al-evwq7L?P zbkCWsu`!|F8xKL-nyW>VB#q5%(!5z+!GVGt`oK2IN3Lk&Jtz?&{`<@Wk